From 1dbc7196efa6bea0f6b1568275a6a8236fbc1e50 Mon Sep 17 00:00:00 2001 From: Moritz Firsching Date: Sun, 25 Oct 2026 14:06:08 +0000 Subject: [PATCH 1/3] Add deeply embedded first-order Peano Arithmetic, adequacy, and completeness --- Challenge.lean | 408 ++++++- Cryptids.lean | 10 +- Cryptids/Propositions.lean | 388 +++++- Cryptids/README.md | 1 + Cryptids/Semantics/PA.lean | 28 + Cryptids/Semantics/PA/Adequacy.lean | 1438 +++++++++++++++++++++++ Cryptids/Semantics/PA/Completeness.lean | 1272 ++++++++++++++++++++ Cryptids/Semantics/PA/Syntax.lean | 620 ++++++++++ Cryptids/Semantics/README.md | 51 +- README.md | 4 +- comparator/README.md | 27 +- comparator/all.json | 4 + comparator/constructive.json | 3 + comparator/pa_semantics.json | 15 + 14 files changed, 4242 insertions(+), 27 deletions(-) create mode 100644 Cryptids/Semantics/PA.lean create mode 100644 Cryptids/Semantics/PA/Adequacy.lean create mode 100644 Cryptids/Semantics/PA/Completeness.lean create mode 100644 Cryptids/Semantics/PA/Syntax.lean create mode 100644 comparator/pa_semantics.json diff --git a/Challenge.lean b/Challenge.lean index 7e1c9707..96c8ae13 100644 --- a/Challenge.lean +++ b/Challenge.lean @@ -20,20 +20,23 @@ Self-contained specification module audited against `Cryptids` by `leanprover/co - **Constructive gate (`comparator/constructive.json`, `goldbach_21.json`, `zf_380.json`, `riemann_104.json`; `permitted_axioms = ["propext", "Quot.sound"]`):** The direct simulation state reductions (`Goldbach21`, `Zf380`, `Riemann104`), all four - `candidate_fewer_states` theorems (including `Riemann95.candidate_fewer_states`), and all ZF + `candidate_fewer_states` theorems (including `Riemann95.candidate_fewer_states`), all ZF machine-to-proof-search equivalences (`Zf393.halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, - `Semantics.Zf.halts_zf432_iff_wadeZFInconsistent`) are verified **without `Classical.choice`** - (`ListBlank` uses primitive `Quot` rather than `Quotient` so `Halts` is choice-free). Because - `Zf/Soundness.lean` proves `not_zfInconsistent` via `ZFSet.{0}` (`Classical.choice`)—and - `CIC + EM` proves `Con(ZF)` without choice (`digama0/ConZF`)—disallowing `Classical.choice` - blocks classical `Con(ZF)` shortcuts for `Halts M ↔ ZFInconsistent` (though Lean's type theory - remains stronger than `PA`/`ZF`; see `Cryptids/Semantics/README.md`). + `Semantics.Zf.halts_zf432_iff_wadeZFInconsistent`), and first-order Peano Arithmetic (`PA`) + consistency and $\Sigma_1^0$ standard-model adequacy (`Semantics.PA.not_paProvable_false`, + `Semantics.PA.paHalts_holds_iff_halts`, `Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent`) + are verified **without `Classical.choice`** (`ListBlank` uses primitive `Quot` rather than + `Quotient` so `Halts` is choice-free). Because `Zf/Soundness.lean` proves `not_zfInconsistent` + via `ZFSet.{0}` (`Classical.choice`)—and `CIC + EM` proves `Con(ZF)` without choice + (`digama0/ConZF`)—disallowing `Classical.choice` blocks classical `Con(ZF)` shortcuts for + `Halts M ↔ ZFInconsistent`, while deeply embedded `PAProvable` provides a weak first-order + metatheory that cannot prove `Con(PA)` or `Con(ZF)` (see `Cryptids/Semantics/README.md`). - **Full gate (`comparator/all.json`; `permitted_axioms = ["propext", "Quot.sound", "Classical.choice"]`):** - Audits all 22 theorems, including `Riemann95.candidate_equivalent` (which uses - `Classical.choice` via `Nat.Prime`), classical `ZFSet.{0}` soundness/non-halting, negated-`Π₁⁰` - Goldbach (`¬ GoldbachConjecture`, which uses Markov's Principle), and analytic + Audits all 26 theorems, including `Riemann95.candidate_equivalent` (which uses + `Classical.choice` via `Nat.Prime`), classical `PA` and `ZFSet.{0}` soundness/non-halting, + negated-`Π₁⁰` Goldbach (`¬ GoldbachConjecture`, which uses Markov's Principle), and analytic `RiemannHypothesis` equivalences. -/ @@ -170,6 +173,7 @@ def Tape.mk₁ {Γ : Type*} [Inhabited Γ] (l : List Γ) : Tape Γ := structure Machine (states symbols : ℕ) where transition : Fin states → Fin symbols → Option (Fin symbols × Dir × Fin states) +section variable {states symbols : ℕ} [NeZero states] [NeZero symbols] /-- A Turing machine configuration: current state and tape. -/ @@ -190,6 +194,7 @@ def Halts (M : Machine states symbols) : Prop := (StateTransition.eval (step M) /-- Build a `Machine states symbols` from a list of per-state transition rows. -/ def Machine.ofRows (rows : List (List (Option (Fin symbols × Dir × Fin states)))) : Machine states symbols := ⟨fun q a => (rows.getD q.val []).getD a.val none⟩ +end /-- A Turing machine over `symbols` tape symbols bundled with its non-zero state count. -/ structure BundledMachine (symbols : ℕ) where @@ -347,6 +352,379 @@ inductive WadeZFProvable : ℕ → Prop where /-- Inconsistency of `WadeZFProvable` ($v_0 \in v_0$). -/ def WadeZFInconsistent : Prop := WadeZFProvable (zfMem 0 0) +/-- First-order terms in the language of Peano Arithmetic +$\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$. -/ +inductive PATerm : Type where + | var (x : ℕ) : PATerm + | zero : PATerm + | succ (t : PATerm) : PATerm + | add (t₁ t₂ : PATerm) : PATerm + | mul (t₁ t₂ : PATerm) : PATerm + deriving DecidableEq, Repr + +/-- Standard numeral $\overline{n}$ in $\mathcal{L}_{\mathrm{PA}}$. -/ +def PATerm.ofNat : ℕ → PATerm + | 0 => .zero + | n + 1 => .succ (ofNat n) + +/-- Whether variable `x` occurs in a `PATerm`. -/ +def PATerm.hasVar (x : ℕ) : PATerm → Bool + | .var y => y == x + | .zero => false + | .succ t => t.hasVar x + | .add t₁ t₂ | .mul t₁ t₂ => t₁.hasVar x || t₂.hasVar x + +/-- Smallest variable index strictly greater than every variable occurring in a `PATerm`. -/ +def PATerm.freshVar : PATerm → ℕ + | .var x => x + 1 + | .zero => 0 + | .succ t => t.freshVar + | .add t₁ t₂ | .mul t₁ t₂ => max t₁.freshVar t₂.freshVar + +/-- Substitute term `s` for variable `x` in a `PATerm`. -/ +def PATerm.subst : PATerm → ℕ → PATerm → PATerm + | .var y, x, s => if y == x then s else .var y + | .zero, _, _ => .zero + | .succ t, x, s => .succ (t.subst x s) + | .add t₁ t₂, x, s => .add (t₁.subst x s) (t₂.subst x s) + | .mul t₁ t₂, x, s => .mul (t₁.subst x s) (t₂.subst x s) + +/-- Evaluate a `PATerm` in the standard model `ℕ` under assignment `v`. -/ +def PATerm.eval (v : ℕ → ℕ) : PATerm → ℕ + | .var x => v x + | .zero => 0 + | .succ t => t.eval v + 1 + | .add t₁ t₂ => t₁.eval v + t₂.eval v + | .mul t₁ t₂ => t₁.eval v * t₂.eval v + +/-- First-order formulas of Peano Arithmetic with variables indexed by `ℕ`. -/ +inductive PAFormula : Type where + | bot : PAFormula + | eq (t₁ t₂ : PATerm) : PAFormula + | and (φ ψ : PAFormula) : PAFormula + | or (φ ψ : PAFormula) : PAFormula + | imp (φ ψ : PAFormula) : PAFormula + | all (x : ℕ) (φ : PAFormula) : PAFormula + | ex (x : ℕ) (φ : PAFormula) : PAFormula + deriving DecidableEq, Repr + +/-- Negation $\neg \varphi := \varphi \to \bot$. -/ +abbrev PAFormula.not (φ : PAFormula) : PAFormula := .imp φ .bot + +/-- Bi-implication $\varphi \leftrightarrow \psi := (\varphi \to \psi) \land (\psi \to \varphi)$. -/ +abbrev PAFormula.iff (φ ψ : PAFormula) : PAFormula := .and (.imp φ ψ) (.imp ψ φ) + +/-- Inequality $s \neq t := \neg (s = t)$. -/ +abbrev paNe (s t : PATerm) : PAFormula := .not (.eq s t) + +/-- Non-strict inequality $a \le b := \exists k,\, a + k = b$ with a fresh witness variable `k`. -/ +def paLe (a b : PATerm) : PAFormula := + let k := max a.freshVar b.freshVar + .ex k (.eq (.add a (.var k)) b) + +/-- Strict inequality $a < b := S(a) \le b$. -/ +def paLt (a b : PATerm) : PAFormula := + paLe (.succ a) b + +/-- Finite disjunction of a list of `PAFormula`s. -/ +def paDisjList : List PAFormula → PAFormula + | [] => .bot + | [φ] => φ + | φ :: rest => .or φ (paDisjList rest) + +/-- Whether variable `x` occurs free in a `PAFormula`. -/ +def PAFormula.hasFree (x : ℕ) : PAFormula → Bool + | .bot => false + | .eq t₁ t₂ => t₁.hasVar x || t₂.hasVar x + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.hasFree x || ψ.hasFree x + | .all y φ | .ex y φ => !(y == x) && φ.hasFree x + +/-- Whether term `s` is free for `x` in `φ` (no free occurrence of `x` lies under a binder +for any variable occurring in `s`). -/ +def PAFormula.freeFor (x : ℕ) (s : PATerm) : PAFormula → Bool + | .bot | .eq _ _ => true + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.freeFor x s && ψ.freeFor x s + | .all y φ | .ex y φ => (y == x) || ((!φ.hasFree x || !s.hasVar y) && φ.freeFor x s) + +/-- Substitute term `s` for free occurrences of variable `x` in `φ`. -/ +def PAFormula.subst (x : ℕ) (s : PATerm) : PAFormula → PAFormula + | .bot => .bot + | .eq t₁ t₂ => .eq (t₁.subst x s) (t₂.subst x s) + | .and φ ψ => .and (φ.subst x s) (ψ.subst x s) + | .or φ ψ => .or (φ.subst x s) (ψ.subst x s) + | .imp φ ψ => .imp (φ.subst x s) (ψ.subst x s) + | .all y φ => if y == x then .all y φ else .all y (φ.subst x s) + | .ex y φ => if y == x then .ex y φ else .ex y (φ.subst x s) + +/-- Standard Tarski satisfaction of a `PAFormula` in `ℕ` under variable assignment `v`. -/ +def PAFormula.Holds (v : ℕ → ℕ) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => t₁.eval v = t₂.eval v + | .and φ ψ => φ.Holds v ∧ ψ.Holds v + | .or φ ψ => φ.Holds v ∨ ψ.Holds v + | .imp φ ψ => φ.Holds v → ψ.Holds v + | .all x φ => ∀ a : ℕ, φ.Holds (Function.update v x a) + | .ex x φ => ∃ a : ℕ, φ.Holds (Function.update v x a) + +/-- Standard Hilbert proof system for first-order Peano Arithmetic ($\mathrm{PA}$), combining +classical first-order logic with equality, the six defining equations of $0, S, +, \times$, and the +full first-order induction schema. -/ +inductive PAProvable : PAFormula → Prop where + | mp {φ ψ : PAFormula} : PAProvable φ → PAProvable (.imp φ ψ) → PAProvable ψ + | gen (x : ℕ) {φ : PAFormula} : PAProvable φ → PAProvable (.all x φ) + | imp_k (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ φ)) + | imp_s (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ (.imp ψ χ)) (.imp (.imp φ ψ) (.imp φ χ))) + | dne (φ : PAFormula) : PAProvable (.imp (.not (.not φ)) φ) + | and_intro (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ (.and φ ψ))) + | and_left (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) φ) + | and_right (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) ψ) + | or_left (φ ψ : PAFormula) : PAProvable (.imp φ (.or φ ψ)) + | or_right (φ ψ : PAFormula) : PAProvable (.imp ψ (.or φ ψ)) + | or_elim (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ χ) (.imp (.imp ψ χ) (.imp (.or φ ψ) χ))) + | all_imp (x : ℕ) (φ ψ : PAFormula) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.all x φ) (.all x ψ))) + | all_vacuous (x : ℕ) (φ : PAFormula) (h : φ.hasFree x = false) : + PAProvable (.imp φ (.all x φ)) + | all_elim (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (.all x φ) (φ.subst x t)) + | ex_intro (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (φ.subst x t) (.ex x φ)) + | ex_elim (x : ℕ) (φ ψ : PAFormula) (h : ψ.hasFree x = false) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.ex x φ) ψ)) + | eq_refl (t : PATerm) : PAProvable (.eq t t) + | eq_subst (x : ℕ) (s t : PATerm) (φ : PAFormula) + (hs : φ.freeFor x s = true) (ht : φ.freeFor x t = true) : + PAProvable (.imp (.eq s t) (.imp (φ.subst x s) (φ.subst x t))) + | pa_zero_ne_succ : PAProvable (.not (.eq (.succ (.var 0)) .zero)) + | pa_succ_inj : + PAProvable (.imp (.eq (.succ (.var 0)) (.succ (.var 1))) (.eq (.var 0) (.var 1))) + | pa_add_zero : PAProvable (.eq (.add (.var 0) .zero) (.var 0)) + | pa_add_succ : + PAProvable (.eq (.add (.var 0) (.succ (.var 1))) (.succ (.add (.var 0) (.var 1)))) + | pa_mul_zero : PAProvable (.eq (.mul (.var 0) .zero) .zero) + | pa_mul_succ : + PAProvable (.eq (.mul (.var 0) (.succ (.var 1))) (.add (.mul (.var 0) (.var 1)) (.var 0))) + | pa_ind (x : ℕ) (φ : PAFormula) : + PAProvable (.imp (φ.subst x .zero) + (.imp (.all x (.imp φ (φ.subst x (.succ (.var x))))) (.all x φ))) + +/-- Polynomial characterization $2 z = 2 x + (x + y)(x + y + 1)$ of `z = cantorPair x y`. -/ +def paCantorPairEq (x y z : PATerm) : PAFormula := + let s := PATerm.add x y + .eq (.mul (.ofNat 2) z) (.add (.mul (.ofNat 2) x) (.mul s (.succ s))) + +/-- Gödel's $\beta$-function graph $\beta(c, d, i) = r$, defined by +$\exists q,\; c = q \cdot (1 + (i + 1) d) + r \land r < 1 + (i + 1) d$. -/ +def paBetaEq (c d i r : PATerm) : PAFormula := + let m := PATerm.succ (.mul (.succ i) d) + let q := max (max c.freshVar m.freshVar) r.freshVar + .ex q (.and (.eq c (.add (.mul (.var q) m) r)) (paLt r m)) + +/-- Symbolic Cantor-pairing expression over variable indices and small natural constants, +used to arithmetize nested Cantor codes without expanding large numerals. -/ +inductive PAZFTerm : Type where + | var (x : ℕ) : PAZFTerm + | const (n : ℕ) : PAZFTerm + | pair (a b : PAZFTerm) : PAZFTerm + deriving DecidableEq, Repr + +/-- Number of fresh existential variables allocated when translating a `PAZFTerm`. -/ +def PAZFTerm.numVars : PAZFTerm → ℕ + | .var _ | .const _ => 0 + | .pair a b => 2 + a.numVars + b.numVars + +/-- Translate `out = e` into a `PAFormula`, allocating fresh intermediate variables starting at +`base`. -/ +def PAZFTerm.eqFormula : PAZFTerm → PATerm → ℕ → PAFormula + | .var x, out, _ => .eq out (.var x) + | .const n, out, _ => .eq out (.ofNat n) + | .pair a b, out, base => + .ex base (.ex (base + 1) + (.and (paCantorPairEq (.var base) (.var (base + 1)) out) + (.and (a.eqFormula (.var base) (base + 2)) + (b.eqFormula (.var (base + 1)) (base + 2 + a.numVars))))) + +/-- Symbolic Cantor code `(q, (h, (L, R)))` of a binary Turing machine configuration. -/ +def pzPackCfg (q h : ℕ) (L R : PAZFTerm) : PAZFTerm := + .pair (.const q) (.pair (.const h) (.pair L R)) + +/-- Single-step relation of a 2-symbol Turing machine `M` between configuration codes `.var 4` +and `.var 5`. -/ +def paStep {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | none => [] + | some (w, .right, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 8) (.add (.mul (.ofNat 2) (.var 6)) (.ofNat w.val))) + (.eq (.var 7) (.add (.mul (.ofNat 2) (.var 9)) (.ofNat h'))))))))) + | some (w, .left, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 6) (.add (.mul (.ofNat 2) (.var 8)) (.ofNat h'))) + (.eq (.var 9) (.add (.mul (.ofNat 2) (.var 7)) (.ofNat w.val))))))))) + +/-- Undefined-transition (halted) predicate for a 2-symbol Turing machine `M` at configuration +code `.var 4`. -/ +def paHalted {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | some _ => [] + | none => [.ex 6 (.ex 7 ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10))] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting that the 2-symbol Turing +machine `M` halts when started in state `0` on the all-blank tape (encoded by `0`). -/ +def paHalts {states : ℕ} (M : Machine states 2) : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and (paBetaEq (.var 1) (.var 2) .zero .zero) + (.and + (.all 3 (.imp (paLt (.var 3) (.var 0)) + (.ex 4 (.ex 5 + (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) + (.and (paBetaEq (.var 1) (.var 2) (.succ (.var 3)) (.var 5)) + (paStep M))))))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + (paHalted M))))))) + +/-- Symbolic `PAZFTerm` constructors mirroring `zfEq..axInf`. -/ +def pzEq (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 0) +/-- Symbolic `PAZFTerm` for `zfMem`. -/ +def pzMem (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 1) +/-- Symbolic `PAZFTerm` for `zfImp`. -/ +def pzImp (φ ψ : PAZFTerm) : PAZFTerm := .pair (.pair φ ψ) (.const 2) +/-- Symbolic `PAZFTerm` for `zfNot`. -/ +def pzNot (φ : PAZFTerm) : PAZFTerm := .pair φ (.const 3) +/-- Symbolic `PAZFTerm` for `zfAll`. -/ +def pzAll (x φ : PAZFTerm) : PAZFTerm := .pair (.pair x φ) (.const 4) +/-- Symbolic `PAZFTerm` for `zfEx`. -/ +def pzEx (x φ : PAZFTerm) : PAZFTerm := pzNot (pzAll x (pzNot φ)) +/-- Symbolic `PAZFTerm` for `zfAnd`. -/ +def pzAnd (φ ψ : PAZFTerm) : PAZFTerm := pzNot (pzImp φ (pzNot ψ)) +/-- Symbolic `PAZFTerm` for `axB1`. -/ +def pzB1 (φ ψ χ : PAZFTerm) : PAZFTerm := pzImp (pzImp φ ψ) (pzImp (pzImp ψ χ) (pzImp φ χ)) +/-- Symbolic `PAZFTerm` for `axB2`. -/ +def pzB2 (φ : PAZFTerm) : PAZFTerm := pzImp (pzImp (pzNot φ) φ) φ +/-- Symbolic `PAZFTerm` for `axB3`. -/ +def pzB3 (φ ψ : PAZFTerm) : PAZFTerm := pzImp φ (pzImp (pzNot φ) ψ) +/-- Symbolic `PAZFTerm` for `axB4`. -/ +def pzB4 (x φ ψ : PAZFTerm) : PAZFTerm := + pzImp (pzAll x (pzImp φ ψ)) (pzImp (pzAll x φ) (pzAll x ψ)) +/-- Symbolic `PAZFTerm` for `axB6a`. -/ +def pzB6a (x y z : PAZFTerm) : PAZFTerm := + pzAnd (pzImp (pzEq x y) (pzAll z (pzEq x y))) (pzImp (pzMem x y) (pzAll z (pzMem x y))) +/-- Symbolic `PAZFTerm` for `axB6b`. -/ +def pzB6b (x y φ : PAZFTerm) : PAZFTerm := pzImp (pzAll x (pzAll y φ)) (pzAll y (pzAll x φ)) +/-- Symbolic `PAZFTerm` for `axB6c`. -/ +def pzB6c (x φ : PAZFTerm) : PAZFTerm := pzImp (pzEx x (pzAll x φ)) φ +/-- Symbolic `PAZFTerm` for `axB7`. -/ +def pzB7 (x y : PAZFTerm) : PAZFTerm := pzEx x (pzEq x y) +/-- Symbolic `PAZFTerm` for `axB8a`. -/ +def pzB8a (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzEq x z) (pzEq y z)) +/-- Symbolic `PAZFTerm` for `axB8b`. -/ +def pzB8b (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem x z) (pzMem y z)) +/-- Symbolic `PAZFTerm` for `axB8c`. -/ +def pzB8c (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem z x) (pzMem z y)) +/-- Symbolic `PAZFTerm` for `axExt`. -/ +def pzExt : PAZFTerm := + pzImp + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 0)) (pzMem (.const 2) (.const 1))) + (pzImp (pzMem (.const 2) (.const 1)) (pzMem (.const 2) (.const 0))))) + (pzEq (.const 0) (.const 1)) +/-- Symbolic `PAZFTerm` for `axRepRhs`. -/ +def pzRepRhs (φ : PAZFTerm) : PAZFTerm := + pzEx (.const 3) (pzAnd (pzMem (.const 3) (.const 0)) (pzAll (.const 1) φ)) +/-- Symbolic `PAZFTerm` for `axRep`. -/ +def pzRep (φ : PAZFTerm) : PAZFTerm := + pzImp + (pzAll (.const 3) + (pzEx (.const 1) + (pzAll (.const 2) (pzImp (pzAll (.const 1) φ) (pzEq (.const 2) (.const 1)))))) + (pzEx (.const 1) + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 1)) (pzRepRhs φ)) + (pzImp (pzRepRhs φ) (pzMem (.const 2) (.const 1)))))) +/-- Symbolic `PAZFTerm` for `axPow`. -/ +def pzPow : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzAll (.const 3) (pzImp (pzMem (.const 3) (.const 2)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axUni`. -/ +def pzUni : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzEx (.const 3) (pzAnd (pzMem (.const 2) (.const 3)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axInfSingleton`. -/ +def pzInfSingleton : PAZFTerm := + pzAll (.const 1) + (pzAnd (pzImp (pzMem (.const 1) (.const 2)) (pzEq (.const 1) (.const 0))) + (pzImp (pzEq (.const 1) (.const 0)) (pzMem (.const 1) (.const 2)))) +/-- Symbolic `PAZFTerm` for `axInf`. -/ +def pzInf : PAZFTerm := + pzEx (.const 1) + (pzAnd (pzMem (.const 0) (.const 1)) + (pzAll (.const 0) + (pzImp (pzMem (.const 0) (.const 1)) + (pzEx (.const 2) (pzAnd (pzMem (.const 2) (.const 1)) pzInfSingleton))))) + +/-- Validity of step `i = .var 3` (with formula code `w = .var 4`) in a $\beta$-coded `ZFProvable` +derivation `(c = .var 1, d = .var 2)`. -/ +def paIsZFStep : PAFormula := + paDisjList + [ (pzEq (.const 0) (.const 0)).eqFormula (.var 4) 10 + , .ex 5 (.ex 6 (.ex 8 (.ex 9 + (.and (paLt (.var 8) (.var 3)) + (.and (paLt (.var 9) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 5)) + (.and (paBetaEq (.var 1) (.var 2) (.var 9) (.var 6)) + ((pzImp (.var 5) (.var 4)).eqFormula (.var 6) 10)))))))) + , .ex 5 (.ex 6 (.ex 8 + (.and (paLt (.var 8) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 6)) + ((pzAll (.var 5) (.var 6)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB1 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 ((pzB2 (.var 5)).eqFormula (.var 4) 10) + , .ex 5 (.ex 6 ((pzB3 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB4 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 + (.and (paNe (.var 5) (.var 7)) + (.and (paNe (.var 7) (.var 6)) + ((pzB6a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB6b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 ((pzB6c (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 ((pzB7 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB8a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8c (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , pzExt.eqFormula (.var 4) 10 + , .ex 5 ((pzRep (.var 5)).eqFormula (.var 4) 10) + , pzPow.eqFormula (.var 4) 10 + , pzUni.eqFormula (.var 4) 10 + , pzInf.eqFormula (.var 4) 10 ] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting `ZFInconsistent` +($\mathrm{ZF} \vdash v_0 \in v_0$). -/ +def paZFInconsistent : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and + (.all 3 (.imp (paLe (.var 3) (.var 0)) + (.ex 4 (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) paIsZFStep)))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + ((pzMem (.const 0) (.const 0)).eqFormula (.var 4) 10)))))) + namespace Goldbach21 /-- 25-state Goldbach reference machine (`goldbach_25`, Yao & Leng 2024). -/ abbrev reference : BundledMachine 2 := Machines.goldbach25.bundle @@ -389,6 +767,16 @@ theorem halts_zf432_iff_wadeZFInconsistent : ConjectureMachines.Halts Machines.zf432 ↔ WadeZFInconsistent := by sorry end Semantics.Zf +namespace Semantics.PA +theorem not_paProvable_false : ¬ PAProvable .bot := by sorry +theorem paHalts_holds_iff_halts {states : ℕ} [NeZero states] (M : Machine states 2) + (v : ℕ → ℕ) : (paHalts M).Holds v ↔ ConjectureMachines.Halts M := by sorry +theorem paZFInconsistent_holds_iff_zfInconsistent (v : ℕ → ℕ) : + paZFInconsistent.Holds v ↔ ZFInconsistent := by sorry +theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → ℕ) : + φ.Holds v := by sorry +end Semantics.PA + namespace Semantics.Riemann theorem halts_riemann744_iff_exists_counterexample : ConjectureMachines.Halts Machines.riemann744 ↔ ∃ x : ℕ, MatiyasevichRiemannCounterexample x := diff --git a/Cryptids.lean b/Cryptids.lean index 3121e31e..52c3a8d3 100644 --- a/Cryptids.lean +++ b/Cryptids.lean @@ -13,6 +13,7 @@ public import Cryptids.Riemann120 public import Cryptids.Zf380 public import Cryptids.Zf393 public import Cryptids.Semantics.Goldbach +public import Cryptids.Semantics.PA public import Cryptids.Semantics.Riemann public import Cryptids.Semantics.Riemann120 public import Cryptids.Semantics.Riemann95 @@ -29,7 +30,9 @@ known baseline machines (`goldbach_25`, `zf_432`, `zf_393`, `riemann_744`, `riem linking every machine's blank-tape halting problem to Mathlib's statements: - `Cryptids.Propositions` — Shared definitions of `GoldbachConjecture`, - `MatiyasevichRiemannCounterexample`, `ZFInconsistent`, and `WadeZFInconsistent`. + `MatiyasevichRiemannCounterexample`, `ZFInconsistent`, `WadeZFInconsistent`, and deeply embedded + first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`, `paHalts`, + `paZFInconsistent`). - `Cryptids.Machines` — Turing machine execution model, bundled machines (`BundledMachine`), and machine table definitions (`ConjectureMachines.Machines.*`). - `Cryptids.Goldbach21`, `Cryptids.Zf380`, `Cryptids.Riemann104` — Proofs of @@ -47,6 +50,11 @@ linking every machine's blank-tape halting problem to Mathlib's statements: - `Cryptids.Riemann95`, `Cryptids.Semantics.Riemann95` — A 95-state machine with an exact 3,634-step blank initializer, unconditional equivalence to the 104-state machine, and `Halts candidate ↔ ¬ RiemannHypothesis`. +- `Cryptids.Semantics.PA` — First-order Peano Arithmetic metatheory: arbitrary `[PAModel M]` + soundness (`paProvable_sound`, `paProvable_sound_nat`), constructive consistency + (`not_paProvable_false`), constructive $\Sigma_1^0$ standard-model adequacy + (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), and Gödel–Henkin + completeness (`paProvable_iff_holdsIn_all_models`). - `Cryptids.Semantics.Goldbach`, `Cryptids.Semantics.Zf`, `Cryptids.Semantics.Riemann` — End-to-end proofs linking halting from the blank tape to the corresponding mathematical conjectures across all baseline machines (`goldbach25`, `zf432`, `riemann744`). diff --git a/Cryptids/Propositions.lean b/Cryptids/Propositions.lean index f6835d20..9aac66a6 100644 --- a/Cryptids/Propositions.lean +++ b/Cryptids/Propositions.lean @@ -10,6 +10,7 @@ public import Mathlib.Algebra.GCDMonoid.Finset public import Mathlib.Order.Interval.Finset.Nat public import Mathlib.NumberTheory.LSeries.RiemannZeta public import Mathlib.SetTheory.ZFC.Basic +public import Cryptids.Machines /-! # Target Mathematical Propositions (`Cryptids.Propositions`) @@ -63,7 +64,7 @@ In `Cryptids.Semantics.Riemann`, `(∃ x : ℕ, MatiyasevichRiemannCounterexampl equivalent to `¬ RiemannHypothesis`. -/ def MatiyasevichRiemannCounterexample (x : ℕ) : Prop := 253 < x ∧ - let lcm := (Finset.Icc 1 x).lcm id + let lcm := (@Finset.Icc ℕ Nat.instPreorder Nat.instLocallyFiniteOrder 1 x).lcm id let a := (harmNum lcm - lcm.factorial * x) ^ 2 let b := lcm.factorial ^ 2 let c := harmNum x ^ 4 * x @@ -307,4 +308,389 @@ the contradiction formula $v_0 \in v_0$ (`zfMem 0 0 = 1`) is provable. -/ def WadeZFInconsistent : Prop := WadeZFProvable (zfMem 0 0) +/-! +## 4. First-Order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) + +To formalize metamathematical provability in first-order Peano Arithmetic ($\mathrm{PA}$) inside +Lean without relying on Lean's ambient type-theoretic strength, we deeply embed the syntax, +standard `ℕ` Tarski semantics, Hilbert proof system (`PAProvable`), and $\Sigma_1^0$ +arithmetizations of binary Turing machine halting (`paHalts`) and `ZF` inconsistency +(`paZFInconsistent`). +-/ + +/-- First-order terms in the language of Peano Arithmetic +$\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$. -/ +inductive PATerm : Type where + | var (x : ℕ) : PATerm + | zero : PATerm + | succ (t : PATerm) : PATerm + | add (t₁ t₂ : PATerm) : PATerm + | mul (t₁ t₂ : PATerm) : PATerm + deriving DecidableEq, Repr + +/-- Standard numeral $\overline{n}$ in $\mathcal{L}_{\mathrm{PA}}$. -/ +def PATerm.ofNat : ℕ → PATerm + | 0 => .zero + | n + 1 => .succ (ofNat n) + +/-- Whether variable `x` occurs in a `PATerm`. -/ +def PATerm.hasVar (x : ℕ) : PATerm → Bool + | .var y => y == x + | .zero => false + | .succ t => t.hasVar x + | .add t₁ t₂ | .mul t₁ t₂ => t₁.hasVar x || t₂.hasVar x + +/-- Smallest variable index strictly greater than every variable occurring in a `PATerm`. -/ +def PATerm.freshVar : PATerm → ℕ + | .var x => x + 1 + | .zero => 0 + | .succ t => t.freshVar + | .add t₁ t₂ | .mul t₁ t₂ => max t₁.freshVar t₂.freshVar + +/-- Substitute term `s` for variable `x` in a `PATerm`. -/ +def PATerm.subst : PATerm → ℕ → PATerm → PATerm + | .var y, x, s => if y == x then s else .var y + | .zero, _, _ => .zero + | .succ t, x, s => .succ (t.subst x s) + | .add t₁ t₂, x, s => .add (t₁.subst x s) (t₂.subst x s) + | .mul t₁ t₂, x, s => .mul (t₁.subst x s) (t₂.subst x s) + +/-- Evaluate a `PATerm` in the standard model `ℕ` under assignment `v`. -/ +def PATerm.eval (v : ℕ → ℕ) : PATerm → ℕ + | .var x => v x + | .zero => 0 + | .succ t => t.eval v + 1 + | .add t₁ t₂ => t₁.eval v + t₂.eval v + | .mul t₁ t₂ => t₁.eval v * t₂.eval v + +/-- First-order formulas of Peano Arithmetic with variables indexed by `ℕ`. -/ +inductive PAFormula : Type where + | bot : PAFormula + | eq (t₁ t₂ : PATerm) : PAFormula + | and (φ ψ : PAFormula) : PAFormula + | or (φ ψ : PAFormula) : PAFormula + | imp (φ ψ : PAFormula) : PAFormula + | all (x : ℕ) (φ : PAFormula) : PAFormula + | ex (x : ℕ) (φ : PAFormula) : PAFormula + deriving DecidableEq, Repr + +/-- Negation $\neg \varphi := \varphi \to \bot$. -/ +abbrev PAFormula.not (φ : PAFormula) : PAFormula := .imp φ .bot + +/-- Bi-implication $\varphi \leftrightarrow \psi := (\varphi \to \psi) \land (\psi \to \varphi)$. -/ +abbrev PAFormula.iff (φ ψ : PAFormula) : PAFormula := .and (.imp φ ψ) (.imp ψ φ) + +/-- Inequality $s \neq t := \neg (s = t)$. -/ +abbrev paNe (s t : PATerm) : PAFormula := .not (.eq s t) + +/-- Non-strict inequality $a \le b := \exists k,\, a + k = b$ with a fresh witness variable `k`. -/ +def paLe (a b : PATerm) : PAFormula := + let k := max a.freshVar b.freshVar + .ex k (.eq (.add a (.var k)) b) + +/-- Strict inequality $a < b := S(a) \le b$. -/ +def paLt (a b : PATerm) : PAFormula := + paLe (.succ a) b + +/-- Finite disjunction of a list of `PAFormula`s. -/ +def paDisjList : List PAFormula → PAFormula + | [] => .bot + | [φ] => φ + | φ :: rest => .or φ (paDisjList rest) + +/-- Whether variable `x` occurs free in a `PAFormula`. -/ +def PAFormula.hasFree (x : ℕ) : PAFormula → Bool + | .bot => false + | .eq t₁ t₂ => t₁.hasVar x || t₂.hasVar x + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.hasFree x || ψ.hasFree x + | .all y φ | .ex y φ => !(y == x) && φ.hasFree x + +/-- Whether term `s` is free for `x` in `φ` (no free occurrence of `x` lies under a binder +for any variable occurring in `s`). -/ +def PAFormula.freeFor (x : ℕ) (s : PATerm) : PAFormula → Bool + | .bot | .eq _ _ => true + | .and φ ψ | .or φ ψ | .imp φ ψ => φ.freeFor x s && ψ.freeFor x s + | .all y φ | .ex y φ => (y == x) || ((!φ.hasFree x || !s.hasVar y) && φ.freeFor x s) + +/-- Substitute term `s` for free occurrences of variable `x` in `φ`. -/ +def PAFormula.subst (x : ℕ) (s : PATerm) : PAFormula → PAFormula + | .bot => .bot + | .eq t₁ t₂ => .eq (t₁.subst x s) (t₂.subst x s) + | .and φ ψ => .and (φ.subst x s) (ψ.subst x s) + | .or φ ψ => .or (φ.subst x s) (ψ.subst x s) + | .imp φ ψ => .imp (φ.subst x s) (ψ.subst x s) + | .all y φ => if y == x then .all y φ else .all y (φ.subst x s) + | .ex y φ => if y == x then .ex y φ else .ex y (φ.subst x s) + +/-- Standard Tarski satisfaction of a `PAFormula` in `ℕ` under variable assignment `v`. -/ +def PAFormula.Holds (v : ℕ → ℕ) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => t₁.eval v = t₂.eval v + | .and φ ψ => φ.Holds v ∧ ψ.Holds v + | .or φ ψ => φ.Holds v ∨ ψ.Holds v + | .imp φ ψ => φ.Holds v → ψ.Holds v + | .all x φ => ∀ a : ℕ, φ.Holds (Function.update v x a) + | .ex x φ => ∃ a : ℕ, φ.Holds (Function.update v x a) + +/-- Standard Hilbert proof system for first-order Peano Arithmetic ($\mathrm{PA}$), combining +classical first-order logic with equality, the six defining equations of $0, S, +, \times$, and the +full first-order induction schema. -/ +inductive PAProvable : PAFormula → Prop where + | mp {φ ψ : PAFormula} : PAProvable φ → PAProvable (.imp φ ψ) → PAProvable ψ + | gen (x : ℕ) {φ : PAFormula} : PAProvable φ → PAProvable (.all x φ) + | imp_k (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ φ)) + | imp_s (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ (.imp ψ χ)) (.imp (.imp φ ψ) (.imp φ χ))) + | dne (φ : PAFormula) : PAProvable (.imp (.not (.not φ)) φ) + | and_intro (φ ψ : PAFormula) : PAProvable (.imp φ (.imp ψ (.and φ ψ))) + | and_left (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) φ) + | and_right (φ ψ : PAFormula) : PAProvable (.imp (.and φ ψ) ψ) + | or_left (φ ψ : PAFormula) : PAProvable (.imp φ (.or φ ψ)) + | or_right (φ ψ : PAFormula) : PAProvable (.imp ψ (.or φ ψ)) + | or_elim (φ ψ χ : PAFormula) : + PAProvable (.imp (.imp φ χ) (.imp (.imp ψ χ) (.imp (.or φ ψ) χ))) + | all_imp (x : ℕ) (φ ψ : PAFormula) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.all x φ) (.all x ψ))) + | all_vacuous (x : ℕ) (φ : PAFormula) (h : φ.hasFree x = false) : + PAProvable (.imp φ (.all x φ)) + | all_elim (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (.all x φ) (φ.subst x t)) + | ex_intro (x : ℕ) (t : PATerm) (φ : PAFormula) (h : φ.freeFor x t = true) : + PAProvable (.imp (φ.subst x t) (.ex x φ)) + | ex_elim (x : ℕ) (φ ψ : PAFormula) (h : ψ.hasFree x = false) : + PAProvable (.imp (.all x (.imp φ ψ)) (.imp (.ex x φ) ψ)) + | eq_refl (t : PATerm) : PAProvable (.eq t t) + | eq_subst (x : ℕ) (s t : PATerm) (φ : PAFormula) + (hs : φ.freeFor x s = true) (ht : φ.freeFor x t = true) : + PAProvable (.imp (.eq s t) (.imp (φ.subst x s) (φ.subst x t))) + | pa_zero_ne_succ : PAProvable (.not (.eq (.succ (.var 0)) .zero)) + | pa_succ_inj : + PAProvable (.imp (.eq (.succ (.var 0)) (.succ (.var 1))) (.eq (.var 0) (.var 1))) + | pa_add_zero : PAProvable (.eq (.add (.var 0) .zero) (.var 0)) + | pa_add_succ : + PAProvable (.eq (.add (.var 0) (.succ (.var 1))) (.succ (.add (.var 0) (.var 1)))) + | pa_mul_zero : PAProvable (.eq (.mul (.var 0) .zero) .zero) + | pa_mul_succ : + PAProvable (.eq (.mul (.var 0) (.succ (.var 1))) (.add (.mul (.var 0) (.var 1)) (.var 0))) + | pa_ind (x : ℕ) (φ : PAFormula) : + PAProvable (.imp (φ.subst x .zero) + (.imp (.all x (.imp φ (φ.subst x (.succ (.var x))))) (.all x φ))) + +/-! ### 4a. Arithmetization of Pairing, Gödel's $\beta$-Function, `Halts`, and `ZFInconsistent` -/ + +/-- Polynomial characterization $2 z = 2 x + (x + y)(x + y + 1)$ of `z = cantorPair x y`. -/ +def paCantorPairEq (x y z : PATerm) : PAFormula := + let s := PATerm.add x y + .eq (.mul (.ofNat 2) z) (.add (.mul (.ofNat 2) x) (.mul s (.succ s))) + +/-- Gödel's $\beta$-function graph $\beta(c, d, i) = r$, defined by +$\exists q,\; c = q \cdot (1 + (i + 1) d) + r \land r < 1 + (i + 1) d$. -/ +def paBetaEq (c d i r : PATerm) : PAFormula := + let m := PATerm.succ (.mul (.succ i) d) + let q := max (max c.freshVar m.freshVar) r.freshVar + .ex q (.and (.eq c (.add (.mul (.var q) m) r)) (paLt r m)) + +/-- Symbolic Cantor-pairing expression over variable indices and small natural constants, +used to arithmetize nested Cantor codes without expanding large numerals. -/ +inductive PAZFTerm : Type where + | var (x : ℕ) : PAZFTerm + | const (n : ℕ) : PAZFTerm + | pair (a b : PAZFTerm) : PAZFTerm + deriving DecidableEq, Repr + +/-- Number of fresh existential variables allocated when translating a `PAZFTerm`. -/ +def PAZFTerm.numVars : PAZFTerm → ℕ + | .var _ | .const _ => 0 + | .pair a b => 2 + a.numVars + b.numVars + +/-- Translate `out = e` into a `PAFormula`, allocating fresh intermediate variables starting at +`base`. -/ +def PAZFTerm.eqFormula : PAZFTerm → PATerm → ℕ → PAFormula + | .var x, out, _ => .eq out (.var x) + | .const n, out, _ => .eq out (.ofNat n) + | .pair a b, out, base => + .ex base (.ex (base + 1) + (.and (paCantorPairEq (.var base) (.var (base + 1)) out) + (.and (a.eqFormula (.var base) (base + 2)) + (b.eqFormula (.var (base + 1)) (base + 2 + a.numVars))))) + +/-- Symbolic Cantor code `(q, (h, (L, R)))` of a binary Turing machine configuration. -/ +def pzPackCfg (q h : ℕ) (L R : PAZFTerm) : PAZFTerm := + .pair (.const q) (.pair (.const h) (.pair L R)) + +/-- Single-step relation of a 2-symbol Turing machine `M` between configuration codes `.var 4` +and `.var 5`. -/ +def paStep {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | none => [] + | some (w, .right, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 8) (.add (.mul (.ofNat 2) (.var 6)) (.ofNat w.val))) + (.eq (.var 7) (.add (.mul (.ofNat 2) (.var 9)) (.ofNat h'))))))))) + | some (w, .left, q') => + [0, 1].map fun h' => + .ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 6) (.add (.mul (.ofNat 2) (.var 8)) (.ofNat h'))) + (.eq (.var 9) (.add (.mul (.ofNat 2) (.var 7)) (.ofNat w.val))))))))) + +/-- Undefined-transition (halted) predicate for a 2-symbol Turing machine `M` at configuration +code `.var 4`. -/ +def paHalted {states : ℕ} (M : Machine states 2) : PAFormula := + paDisjList <| (List.finRange states).flatMap fun q => + (List.finRange 2).flatMap fun h => + match M.transition q h with + | some _ => [] + | none => [.ex 6 (.ex 7 ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10))] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting that the 2-symbol Turing +machine `M` halts when started in state `0` on the all-blank tape (encoded by `0`). -/ +def paHalts {states : ℕ} (M : Machine states 2) : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and (paBetaEq (.var 1) (.var 2) .zero .zero) + (.and + (.all 3 (.imp (paLt (.var 3) (.var 0)) + (.ex 4 (.ex 5 + (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) + (.and (paBetaEq (.var 1) (.var 2) (.succ (.var 3)) (.var 5)) + (paStep M))))))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + (paHalted M))))))) + +/-- Symbolic `PAZFTerm` constructors mirroring `zfEq..axInf`. -/ +def pzEq (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 0) +/-- Symbolic `PAZFTerm` for `zfMem`. -/ +def pzMem (x y : PAZFTerm) : PAZFTerm := .pair (.pair x y) (.const 1) +/-- Symbolic `PAZFTerm` for `zfImp`. -/ +def pzImp (φ ψ : PAZFTerm) : PAZFTerm := .pair (.pair φ ψ) (.const 2) +/-- Symbolic `PAZFTerm` for `zfNot`. -/ +def pzNot (φ : PAZFTerm) : PAZFTerm := .pair φ (.const 3) +/-- Symbolic `PAZFTerm` for `zfAll`. -/ +def pzAll (x φ : PAZFTerm) : PAZFTerm := .pair (.pair x φ) (.const 4) +/-- Symbolic `PAZFTerm` for `zfEx`. -/ +def pzEx (x φ : PAZFTerm) : PAZFTerm := pzNot (pzAll x (pzNot φ)) +/-- Symbolic `PAZFTerm` for `zfAnd`. -/ +def pzAnd (φ ψ : PAZFTerm) : PAZFTerm := pzNot (pzImp φ (pzNot ψ)) +/-- Symbolic `PAZFTerm` for `axB1`. -/ +def pzB1 (φ ψ χ : PAZFTerm) : PAZFTerm := pzImp (pzImp φ ψ) (pzImp (pzImp ψ χ) (pzImp φ χ)) +/-- Symbolic `PAZFTerm` for `axB2`. -/ +def pzB2 (φ : PAZFTerm) : PAZFTerm := pzImp (pzImp (pzNot φ) φ) φ +/-- Symbolic `PAZFTerm` for `axB3`. -/ +def pzB3 (φ ψ : PAZFTerm) : PAZFTerm := pzImp φ (pzImp (pzNot φ) ψ) +/-- Symbolic `PAZFTerm` for `axB4`. -/ +def pzB4 (x φ ψ : PAZFTerm) : PAZFTerm := + pzImp (pzAll x (pzImp φ ψ)) (pzImp (pzAll x φ) (pzAll x ψ)) +/-- Symbolic `PAZFTerm` for `axB6a`. -/ +def pzB6a (x y z : PAZFTerm) : PAZFTerm := + pzAnd (pzImp (pzEq x y) (pzAll z (pzEq x y))) (pzImp (pzMem x y) (pzAll z (pzMem x y))) +/-- Symbolic `PAZFTerm` for `axB6b`. -/ +def pzB6b (x y φ : PAZFTerm) : PAZFTerm := pzImp (pzAll x (pzAll y φ)) (pzAll y (pzAll x φ)) +/-- Symbolic `PAZFTerm` for `axB6c`. -/ +def pzB6c (x φ : PAZFTerm) : PAZFTerm := pzImp (pzEx x (pzAll x φ)) φ +/-- Symbolic `PAZFTerm` for `axB7`. -/ +def pzB7 (x y : PAZFTerm) : PAZFTerm := pzEx x (pzEq x y) +/-- Symbolic `PAZFTerm` for `axB8a`. -/ +def pzB8a (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzEq x z) (pzEq y z)) +/-- Symbolic `PAZFTerm` for `axB8b`. -/ +def pzB8b (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem x z) (pzMem y z)) +/-- Symbolic `PAZFTerm` for `axB8c`. -/ +def pzB8c (x y z : PAZFTerm) : PAZFTerm := pzImp (pzEq x y) (pzImp (pzMem z x) (pzMem z y)) +/-- Symbolic `PAZFTerm` for `axExt`. -/ +def pzExt : PAZFTerm := + pzImp + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 0)) (pzMem (.const 2) (.const 1))) + (pzImp (pzMem (.const 2) (.const 1)) (pzMem (.const 2) (.const 0))))) + (pzEq (.const 0) (.const 1)) +/-- Symbolic `PAZFTerm` for `axRepRhs`. -/ +def pzRepRhs (φ : PAZFTerm) : PAZFTerm := + pzEx (.const 3) (pzAnd (pzMem (.const 3) (.const 0)) (pzAll (.const 1) φ)) +/-- Symbolic `PAZFTerm` for `axRep`. -/ +def pzRep (φ : PAZFTerm) : PAZFTerm := + pzImp + (pzAll (.const 3) + (pzEx (.const 1) + (pzAll (.const 2) (pzImp (pzAll (.const 1) φ) (pzEq (.const 2) (.const 1)))))) + (pzEx (.const 1) + (pzAll (.const 2) + (pzAnd (pzImp (pzMem (.const 2) (.const 1)) (pzRepRhs φ)) + (pzImp (pzRepRhs φ) (pzMem (.const 2) (.const 1)))))) +/-- Symbolic `PAZFTerm` for `axPow`. -/ +def pzPow : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzAll (.const 3) (pzImp (pzMem (.const 3) (.const 2)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axUni`. -/ +def pzUni : PAZFTerm := + pzEx (.const 1) + (pzAll (.const 2) + (pzImp (pzEx (.const 3) (pzAnd (pzMem (.const 2) (.const 3)) (pzMem (.const 3) (.const 0)))) + (pzMem (.const 2) (.const 1)))) +/-- Symbolic `PAZFTerm` for `axInfSingleton`. -/ +def pzInfSingleton : PAZFTerm := + pzAll (.const 1) + (pzAnd (pzImp (pzMem (.const 1) (.const 2)) (pzEq (.const 1) (.const 0))) + (pzImp (pzEq (.const 1) (.const 0)) (pzMem (.const 1) (.const 2)))) +/-- Symbolic `PAZFTerm` for `axInf`. -/ +def pzInf : PAZFTerm := + pzEx (.const 1) + (pzAnd (pzMem (.const 0) (.const 1)) + (pzAll (.const 0) + (pzImp (pzMem (.const 0) (.const 1)) + (pzEx (.const 2) (pzAnd (pzMem (.const 2) (.const 1)) pzInfSingleton))))) + +/-- Validity of step `i = .var 3` (with formula code `w = .var 4`) in a $\beta$-coded `ZFProvable` +derivation `(c = .var 1, d = .var 2)`. -/ +def paIsZFStep : PAFormula := + paDisjList + [ (pzEq (.const 0) (.const 0)).eqFormula (.var 4) 10 + , .ex 5 (.ex 6 (.ex 8 (.ex 9 + (.and (paLt (.var 8) (.var 3)) + (.and (paLt (.var 9) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 5)) + (.and (paBetaEq (.var 1) (.var 2) (.var 9) (.var 6)) + ((pzImp (.var 5) (.var 4)).eqFormula (.var 6) 10)))))))) + , .ex 5 (.ex 6 (.ex 8 + (.and (paLt (.var 8) (.var 3)) + (.and (paBetaEq (.var 1) (.var 2) (.var 8) (.var 6)) + ((pzAll (.var 5) (.var 6)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB1 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 ((pzB2 (.var 5)).eqFormula (.var 4) 10) + , .ex 5 (.ex 6 ((pzB3 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB4 (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 + (.and (paNe (.var 5) (.var 7)) + (.and (paNe (.var 7) (.var 6)) + ((pzB6a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))))) + , .ex 5 (.ex 6 (.ex 7 ((pzB6b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 ((pzB6c (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 ((pzB7 (.var 5) (.var 6)).eqFormula (.var 4) 10)) + , .ex 5 (.ex 6 (.ex 7 ((pzB8a (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8b (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , .ex 5 (.ex 6 (.ex 7 ((pzB8c (.var 5) (.var 6) (.var 7)).eqFormula (.var 4) 10))) + , pzExt.eqFormula (.var 4) 10 + , .ex 5 ((pzRep (.var 5)).eqFormula (.var 4) 10) + , pzPow.eqFormula (.var 4) 10 + , pzUni.eqFormula (.var 4) 10 + , pzInf.eqFormula (.var 4) 10 ] + +/-- Closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentence asserting `ZFInconsistent` +($\mathrm{ZF} \vdash v_0 \in v_0$). -/ +def paZFInconsistent : PAFormula := + .ex 0 (.ex 1 (.ex 2 + (.and + (.all 3 (.imp (paLe (.var 3) (.var 0)) + (.ex 4 (.and (paBetaEq (.var 1) (.var 2) (.var 3) (.var 4)) paIsZFStep)))) + (.ex 4 + (.and (paBetaEq (.var 1) (.var 2) (.var 0) (.var 4)) + ((pzMem (.const 0) (.const 0)).eqFormula (.var 4) 10)))))) + end ConjectureMachines diff --git a/Cryptids/README.md b/Cryptids/README.md index e15f52a9..0cceaef9 100644 --- a/Cryptids/README.md +++ b/Cryptids/README.md @@ -24,6 +24,7 @@ All proofs in [`Cryptids/`](./) are checked by the Lean 4 kernel (`v4.35.0-rc4`) 1. **State reductions:** Each reduced machine (`goldbach_21`, `zf_380`, `riemann_104`, `riemann_95`) has fewer states than its reference machine (`goldbach_25`, `zf_393`, `riemann_120`, `riemann_104`) and halts from the blank tape if and only if the reference machine halts ([`Goldbach21.lean`](./Goldbach21.lean), [`Zf380.lean`](./Zf380.lean), [`Riemann104.lean`](./Riemann104.lean), [`Riemann95.lean`](./Riemann95.lean)). The direct simulation reductions (`goldbach_21`, `zf_380`, `riemann_104`) and all four `candidate_fewer_states` theorems are completely constructive (`["propext", "Quot.sound"]`, zero `Classical.choice`), audited via [`comparator/constructive.json`](../comparator/constructive.json), [`comparator/goldbach_21.json`](../comparator/goldbach_21.json), [`comparator/zf_380.json`](../comparator/zf_380.json), and [`comparator/riemann_104.json`](../comparator/riemann_104.json), while [`riemann_95`](./Riemann95.lean) routes through the arithmetic stage predicate `ShuniaCounterexample` (`Nat.Prime`, audited via [`comparator/riemann_95.json`](../comparator/riemann_95.json)). 2. **End-to-end mathematical semantics ([`Cryptids/Semantics/`](./Semantics/README.md)):** - **ZF Consistency (`zf_380`, `zf_393`, and `zf_432`):** Both `zf_380` and Wade's 393-state machine `zf_393` (incorporating upstream fix `10fcf152b3`) halt if and only if O'Rear's `zf2.nql` Hilbert system proves $v_0 \in v_0$ (`Halts candidate ↔ ZFInconsistent`, `Halts zf393 ↔ ZFInconsistent`), while `zf_432` halts if and only if the 20-clause deductive system enumerated by `zf_432_wade.tm` derives $v_0 \in v_0$ (`WadeZFInconsistent`). **All three proof-search equivalences are proved constructively in Lean using only `["propext", "Quot.sound"]` (no `Classical.choice`, no Excluded Middle, and no Markov's Principle)** and audited via [`comparator/constructive.json`](../comparator/constructive.json), blocking classical `Con(ZF)` shortcuts via [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) or `Classical.em` (while internalizing the reduction inside `PA`/`ZF` and establishing full `ZF`-independence remain separate from this Lean meta-level correspondence; see [`Semantics/README.md`](./Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). Separately, [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) uses classical `ZFSet.{0}` (`Classical.choice`) to establish `not_zfInconsistent` and deduce unconditional non-halting (`not_halts_zf393`, `not_halts_candidate`) inside Lean's stronger meta-theory. + - **First-Order Peano Arithmetic (`PAProvable`, [`Semantics/PA.lean`](./Semantics/PA.lean)):** Deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) and $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` in [`Propositions.lean`](./Propositions.lean) and [`Challenge.lean`](../Challenge.lean), proving constructive consistency (`not_paProvable_false`), constructive standard-model adequacy (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`; all three audited without `Classical.choice` in [`comparator/constructive.json`](../comparator/constructive.json)), standard-model soundness (`paProvable_sound_nat`), and Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`) across arbitrary `[PAModel M]`. - **Goldbach (`goldbach_21` and `goldbach_25`):** Both `goldbach_21` and `goldbach_25` constructively satisfy `Halts M ↔ ∃ w, ¬ HasGoldbachPair (2 * w + 4)` without `Classical.choice` ([`Goldbach21.lean`](./Goldbach21.lean)), and with `Classical.choice` (for Markov's Principle on `¬ ∀ n, ...`) satisfy `Halts candidate ↔ ¬ GoldbachConjecture` ([`Semantics/Goldbach.lean`](./Semantics/Goldbach.lean)). - **Riemann Hypothesis (`riemann_95`, `riemann_104`, `riemann_120`, and `riemann_744`):** All four machines (`riemann_95`, `riemann_104`, Shunia's 120-state machine `riemann_120`, and the 744-state machine `riemann_744`) halt if and only if Mathlib's `RiemannHypothesis` is false (`Halts candidate ↔ ¬ RiemannHypothesis`, `Halts riemann120 ↔ ¬ RiemannHypothesis`, and `Halts riemann744 ↔ ¬ RiemannHypothesis`). diff --git a/Cryptids/Semantics/PA.lean b/Cryptids/Semantics/PA.lean new file mode 100644 index 00000000..fd085774 --- /dev/null +++ b/Cryptids/Semantics/PA.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Syntax +public import Cryptids.Semantics.PA.Adequacy +public import Cryptids.Semantics.PA.Completeness + +/-! +# First-Order Peano Arithmetic Semantics, Adequacy, and Completeness (`Cryptids.Semantics.PA`) + +Re-exports the foundational metatheory of the deeply embedded Peano Arithmetic system `PAProvable` +(`Cryptids.Propositions`): + +1. [`Cryptids.Semantics.PA.Syntax`](./PA/Syntax.lean): + General $\mathcal{L}_{\mathrm{PA}}$-structures (`PAStructure`), models (`PAModel`), classical + soundness (`paProvable_sound`, `paProvable_sound_nat`), and constructive consistency via the + Gödel–Gentzen negative translation (`not_paProvable_false`, zero `Classical.choice`). +2. [`Cryptids.Semantics.PA.Adequacy`](./PA/Adequacy.lean): + Constructive standard-model adequacy of the $\Sigma_1^0$ arithmetizations of binary Turing + machine halting and `ZF` inconsistency (`paHalts_holds_iff_halts` and + `paZFInconsistent_holds_iff_zfInconsistent`, zero `Classical.choice`). +3. [`Cryptids.Semantics.PA.Completeness`](./PA/Completeness.lean): + Gödel–Henkin soundness and completeness across all first-order `PAModel`s + (`paProvable_iff_holdsIn_all_models`). +-/ diff --git a/Cryptids/Semantics/PA/Adequacy.lean b/Cryptids/Semantics/PA/Adequacy.lean new file mode 100644 index 00000000..84c973c7 --- /dev/null +++ b/Cryptids/Semantics/PA/Adequacy.lean @@ -0,0 +1,1438 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Syntax +public import Mathlib.Data.Nat.Factorial.Basic + +/-! +# Standard-Model Adequacy of `paHalts` and `paZFInconsistent` + +This module proves that the closed $\Sigma_1^0$ $\mathcal{L}_{\mathrm{PA}}$-sentences `paHalts M` +and `paZFInconsistent` (`Cryptids.Propositions`) faithfully represent binary Turing machine halting +and `ZF` inconsistency in the standard model `ℕ`: + +- `paHalts_holds_iff_halts`: `(paHalts M).Holds v ↔ ConjectureMachines.Halts M` +- `paZFInconsistent_holds_iff_zfInconsistent`: `paZFInconsistent.Holds v ↔ ZFInconsistent` + +Both equivalences are proved **constructively** without `Classical.choice` (verified by +`leanprover/comparator` under `comparator/constructive.json`). +-/ + +@[expose] public section + +namespace ConjectureMachines + +/-- Evaluate a symbolic `PAZFTerm` in `ℕ` under assignment `v`. -/ +def PAZFTerm.eval (v : ℕ → ℕ) : PAZFTerm → ℕ + | .var x => v x + | .const n => n + | .pair a b => cantorPair (a.eval v) (b.eval v) + +/-- Smallest variable index strictly greater than every variable in a `PAZFTerm`. -/ +def PAZFTerm.freshVar : PAZFTerm → ℕ + | .var x => x + 1 + | .const _ => 0 + | .pair a b => max a.freshVar b.freshVar + +end ConjectureMachines + +namespace ConjectureMachines.Semantics.PA + +attribute [-simp] Nat.add_eq_right Nat.left_eq_add Nat.right_eq_add + Order.add_one_le_iff Order.lt_add_one_iff Function.update_idem + +@[simp high] private theorem nat_add_eq_right {n m : ℕ} : n + m = n ↔ m = 0 := by + constructor <;> intro h <;> omega + +@[simp high] private theorem nat_left_eq_add {n m : ℕ} : n = n + m ↔ m = 0 := by + constructor <;> intro h <;> omega + +@[simp high] private theorem nat_right_eq_add {n m : ℕ} : n = m + n ↔ m = 0 := by + constructor <;> intro h <;> omega + +/-! ## Section 1: Basic Standard-Model Evaluation and Arithmetic Gadgets -/ + +@[simp] +theorem eval_ofNat (v : ℕ → ℕ) (n : ℕ) : (PATerm.ofNat n).eval v = n := by + induction n with + | zero => rfl + | succ _ ih => exact congrArg (· + 1) ih + +theorem eval_update_of_freshVar_le (v : ℕ → ℕ) {t : PATerm} {x : ℕ} (a : ℕ) + (h : t.freshVar ≤ x) : t.eval (Function.update v x a) = t.eval v := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_update_of_hasVar_false v a (hasVar_false_of_freshVar_le h) + +theorem paLe_holds_iff (v : ℕ → ℕ) (a b : PATerm) : + (paLe a b).Holds v ↔ a.eval v ≤ b.eval v := by + unfold paLe + set k := max a.freshVar b.freshVar + have ha : a.freshVar ≤ k := Nat.le_max_left _ _ + have hb : b.freshVar ≤ k := Nat.le_max_right _ _ + simp only [PAFormula.Holds, PATerm.eval, eval_update_of_freshVar_le v _ ha, + eval_update_of_freshVar_le v _ hb, Function.update_self] + exact ⟨fun ⟨w, hw⟩ ↦ Nat.le.intro hw, fun h ↦ ⟨b.eval v - a.eval v, Nat.add_sub_of_le h⟩⟩ + +theorem paLt_holds_iff (v : ℕ → ℕ) (a b : PATerm) : + (paLt a b).Holds v ↔ a.eval v < b.eval v := by + unfold paLt + rw [paLe_holds_iff] + rfl + +private theorem two_dvd_mul_succ (n : ℕ) : 2 ∣ n * (n + 1) := by + induction n with + | zero => exact ⟨0, rfl⟩ + | succ n ih => + obtain ⟨k, hk⟩ := ih + refine ⟨k + (n + 1), ?_⟩ + calc (n + 1) * (n + 2) + _ = (n + 1) * n + (n + 1) * 2 := Nat.mul_add (n + 1) n 2 + _ = n * (n + 1) + 2 * (n + 1) := by rw [Nat.mul_comm (n + 1) n, Nat.mul_comm (n + 1) 2] + _ = 2 * (k + (n + 1)) := by omega + +theorem paCantorPairEq_holds_iff (v : ℕ → ℕ) (x y z : PATerm) : + (paCantorPairEq x y z).Holds v ↔ z.eval v = cantorPair (x.eval v) (y.eval v) := by + unfold paCantorPairEq cantorPair + simp only [PAFormula.Holds, PATerm.eval, eval_ofNat] + obtain ⟨k, hk⟩ := two_dvd_mul_succ (x.eval v + y.eval v) + rw [hk, Nat.mul_div_right k (by decide : 0 < 2)] + constructor <;> intro h <;> omega + +theorem paBetaEq_holds_iff (v : ℕ → ℕ) (c d i r : PATerm) : + (paBetaEq c d i r).Holds v ↔ + c.eval v % (1 + (i.eval v + 1) * d.eval v) = r.eval v := by + let m := PATerm.succ (.mul (.succ i) d) + let q := max (max c.freshVar m.freshVar) r.freshVar + have hc : c.freshVar ≤ q := le_trans (Nat.le_max_left _ _) (Nat.le_max_left _ _) + have hm : m.freshVar ≤ q := le_trans (Nat.le_max_right _ _) (Nat.le_max_left _ _) + have hr : r.freshVar ≤ q := Nat.le_max_right _ _ + have hmev : m.eval v = 1 + (i.eval v + 1) * d.eval v := by + simp only [m, PATerm.eval] + omega + change (PAFormula.ex q (.and (.eq c (.add (.mul (.var q) m) r)) (paLt r m))).Holds v ↔ _ + simp only [PAFormula.Holds, paLt_holds_iff, PATerm.eval] + set mod := 1 + (i.eval v + 1) * d.eval v + have hpos : 0 < mod := by omega + constructor + · rintro ⟨w, hcw, hrlt⟩ + rw [eval_update_of_freshVar_le v w hc, eval_update_of_freshVar_le v w hm, + eval_update_of_freshVar_le v w hr, Function.update_self, hmev] at hcw + rw [eval_update_of_freshVar_le v w hr, eval_update_of_freshVar_le v w hm, hmev] at hrlt + have hcw' : c.eval v = r.eval v + mod * w := by + rw [hcw, Nat.mul_comm w mod, Nat.add_comm] + rw [hcw', Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt hrlt] + · intro hrem + refine ⟨c.eval v / mod, ?_, ?_⟩ + · rw [eval_update_of_freshVar_le v _ hc, eval_update_of_freshVar_le v _ hm, + eval_update_of_freshVar_le v _ hr, Function.update_self, hmev, ← hrem, + Nat.mul_comm _ mod] + exact (Nat.div_add_mod (c.eval v) mod).symm + · rw [eval_update_of_freshVar_le v _ hr, eval_update_of_freshVar_le v _ hm, hmev, ← hrem] + exact Nat.mod_lt _ hpos + +theorem paDisjList_holds_iff (v : ℕ → ℕ) (L : List PAFormula) : + (paDisjList L).Holds v ↔ ∃ φ ∈ L, φ.Holds v := by + match L with + | [] => + simp [paDisjList, PAFormula.Holds] + | [φ] => + simp [paDisjList] + | φ :: ψ :: rest => + simp only [paDisjList, PAFormula.Holds, paDisjList_holds_iff v (ψ :: rest), List.mem_cons, + exists_eq_or_imp] + +/-! ## Section 2: Cantor Pairing Injectivity and Symbolic `PAZFTerm` Evaluation -/ + +/-- Constructive injectivity of `cantorPair`. -/ +theorem cantorPair_injective {x₁ y₁ x₂ y₂ : ℕ} + (h : cantorPair x₁ y₁ = cantorPair x₂ y₂) : x₁ = x₂ ∧ y₁ = y₂ := by + obtain ⟨k₁, hk₁⟩ := two_dvd_mul_succ (x₁ + y₁) + obtain ⟨k₂, hk₂⟩ := two_dvd_mul_succ (x₂ + y₂) + have h2 : 2 * x₁ + (x₁ + y₁) * (x₁ + y₁ + 1) = 2 * x₂ + (x₂ + y₂) * (x₂ + y₂ + 1) := by + unfold cantorPair at h + rw [hk₁, hk₂, Nat.mul_div_right _ (by decide : 0 < 2), + Nat.mul_div_right _ (by decide : 0 < 2)] at h + rw [hk₁, hk₂] + omega + have hnotlt : ∀ {a₁ b₁ a₂ b₂ : ℕ}, + 2 * a₁ + (a₁ + b₁) * (a₁ + b₁ + 1) = 2 * a₂ + (a₂ + b₂) * (a₂ + b₂ + 1) → + ¬ (a₁ + b₁ < a₂ + b₂) := by + intro a₁ b₁ a₂ b₂ heq hlt + have hle : (a₁ + b₁ + 1) * (a₁ + b₁ + 2) ≤ (a₂ + b₂) * (a₂ + b₂ + 1) := + Nat.mul_le_mul hlt (Nat.succ_le_succ hlt) + have hexp : (a₁ + b₁ + 1) * (a₁ + b₁ + 2) = + (a₁ + b₁) * (a₁ + b₁ + 1) + 2 * (a₁ + b₁) + 2 := by + calc (a₁ + b₁ + 1) * (a₁ + b₁ + 2) + _ = (a₁ + b₁) * (a₁ + b₁ + 2) + (a₁ + b₁ + 2) := Nat.succ_mul _ _ + _ = (a₁ + b₁) * (a₁ + b₁ + 1) + (a₁ + b₁) + (a₁ + b₁ + 2) := by + rw [Nat.mul_succ] + _ = (a₁ + b₁) * (a₁ + b₁ + 1) + 2 * (a₁ + b₁) + 2 := by omega + omega + have hs1 : ¬ (x₁ + y₁ < x₂ + y₂) := hnotlt h2 + have hs2 : ¬ (x₂ + y₂ < x₁ + y₁) := hnotlt h2.symm + have hs : x₁ + y₁ = x₂ + y₂ := by omega + rw [hs] at h2 + exact ⟨by omega, by omega⟩ + +theorem PAZFTerm.eval_congr {v₁ v₂ : ℕ → ℕ} {e : PAZFTerm} + (h : ∀ x < e.freshVar, v₁ x = v₂ x) : e.eval v₁ = e.eval v₂ := by + induction e with + | var x => exact h x (Nat.lt_succ_self x) + | const _ => rfl + | pair a b iha ihb => + refine congrArg₂ cantorPair (iha fun x hx ↦ h x ?_) (ihb fun x hx ↦ h x ?_) + · exact lt_of_lt_of_le hx (Nat.le_max_left _ _) + · exact lt_of_lt_of_le hx (Nat.le_max_right _ _) + +theorem PAZFTerm.eval_update_fresh (v : ℕ → ℕ) {e : PAZFTerm} {x : ℕ} (a : ℕ) + (h : e.freshVar ≤ x) : e.eval (Function.update v x a) = e.eval v := + PAZFTerm.eval_congr fun y hy ↦ Function.update_of_ne (by omega) a v + +theorem PAZFTerm.eqFormula_holds_iff (e : PAZFTerm) (out : PATerm) (base : ℕ) (v : ℕ → ℕ) + (he : e.freshVar ≤ base) (hout : out.freshVar ≤ base) : + (e.eqFormula out base).Holds v ↔ out.eval v = e.eval v := by + induction e generalizing out base v with + | var x => + simp [PAZFTerm.eqFormula, PAFormula.Holds, PATerm.eval, PAZFTerm.eval] + | const n => + simp [PAZFTerm.eqFormula, PAFormula.Holds, PAZFTerm.eval] + | pair a b iha ihb => + simp only [PAZFTerm.freshVar, Nat.max_le] at he + rcases he with ⟨ha, hb⟩ + simp only [PAZFTerm.eqFormula, PAFormula.Holds] + constructor + · rintro ⟨va, vb, hpair, haeq, hbeq⟩ + set v' := Function.update (Function.update v base va) (base + 1) vb + have hv_base : v' base = va := by simp [v'] + have hv_base1 : v' (base + 1) = vb := by simp [v'] + have hout_eq : out.eval v' = out.eval v := by + dsimp only [v'] + rw [eval_update_of_freshVar_le _ _ (by omega), eval_update_of_freshVar_le _ _ hout] + have hpair' : out.eval v = cantorPair va vb := by + have hp := (paCantorPairEq_holds_iff v' (.var base) (.var (base + 1)) out).mp hpair + simpa [PATerm.eval, hv_base, hv_base1, hout_eq] using hp + have ha' : va = a.eval v := by + have h1 := (iha (.var base) (base + 2) v' (by omega) + (by simp [PATerm.freshVar])).mp haeq + dsimp only [v'] at h1 + rw [PATerm.eval, PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ ha] at h1 + simpa [Function.update_of_ne (by omega : base ≠ base + 1)] using h1 + have hb' : vb = b.eval v := by + have h2 := (ihb (.var (base + 1)) (base + 2 + a.numVars) v' (by omega) + (by simp [PATerm.freshVar]; omega)).mp hbeq + dsimp only [v'] at h2 + rw [PATerm.eval, PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ hb] at h2 + simpa using h2 + rw [hpair', ha', hb', PAZFTerm.eval] + · intro heq + refine ⟨a.eval v, b.eval v, ?_⟩ + set v' := Function.update (Function.update v base (a.eval v)) (base + 1) (b.eval v) + have hv_base : v' base = a.eval v := by simp [v'] + have hv_base1 : v' (base + 1) = b.eval v := by simp [v'] + have hout_eq : out.eval v' = out.eval v := by + dsimp only [v'] + rw [eval_update_of_freshVar_le _ _ (by omega), eval_update_of_freshVar_le _ _ hout] + refine ⟨?_, ?_, ?_⟩ + · rw [paCantorPairEq_holds_iff] + simp only [PATerm.eval, hv_base, hv_base1, hout_eq] + exact heq + · rw [iha (.var base) (base + 2) v' (by omega) (by simp [PATerm.freshVar])] + rw [PATerm.eval, hv_base] + dsimp only [v'] + rw [PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ ha] + · rw [ihb (.var (base + 1)) (base + 2 + a.numVars) v' (by omega) + (by simp [PATerm.freshVar]; omega)] + rw [PATerm.eval, hv_base1] + dsimp only [v'] + rw [PAZFTerm.eval_update_fresh _ _ (by omega), + PAZFTerm.eval_update_fresh _ _ hb] + +/-! ## Section 3: Constructive Gödel $\beta$-Lemma in `ℕ` -/ + +private def maxElem : List ℕ → ℕ + | [] => 0 + | x :: xs => max x (maxElem xs) + +private theorem getElem_le_maxElem (L : List ℕ) : + ∀ (i : ℕ) (hi : i < L.length), L[i] ≤ maxElem L := by + induction L with + | nil => intro _ hi; cases hi + | cons x xs ih => + intro i hi + cases i with + | zero => exact Nat.le_max_left x (maxElem xs) + | succ j => + exact le_trans (ih j (Nat.lt_of_succ_lt_succ hi)) (Nat.le_max_right x (maxElem xs)) + +private theorem beta_moduli_coprime {d i j : ℕ} (hij : i < j) (hd : j - i ∣ d) : + Nat.Coprime (1 + (i + 1) * d) (1 + (j + 1) * d) := by + set si := 1 + (i + 1) * d + set sj := 1 + (j + 1) * d + set g := Nat.gcd si sj + have hid : (i + 1) * sj + (j - i) = (j + 1) * si := by + have hmul : (i + 1) * ((j + 1) * d) = (j + 1) * ((i + 1) * d) := by + rw [← Nat.mul_assoc, Nat.mul_comm (i + 1) (j + 1), Nat.mul_assoc] + calc (i + 1) * (1 + (j + 1) * d) + (j - i) + _ = (i + 1) + (i + 1) * ((j + 1) * d) + (j - i) := by rw [Nat.mul_add, Nat.mul_one] + _ = (j + 1) + (j + 1) * ((i + 1) * d) := by rw [hmul]; omega + _ = (j + 1) * (1 + (i + 1) * d) := by rw [Nat.mul_add, Nat.mul_one] + have hg1 : g ∣ (j + 1) * si := dvd_mul_of_dvd_right (Nat.gcd_dvd_left si sj) (j + 1) + have hg2 : g ∣ (i + 1) * sj := dvd_mul_of_dvd_right (Nat.gcd_dvd_right si sj) (i + 1) + have hg_sub : g ∣ j - i := (Nat.dvd_add_right hg2).mp (hid.symm ▸ hg1) + have hg_d : g ∣ d := dvd_trans hg_sub hd + have hg_mul : g ∣ (i + 1) * d := dvd_mul_of_dvd_right hg_d (i + 1) + have hg_si : g ∣ (i + 1) * d + 1 := by + simpa [si, Nat.add_comm] using Nat.gcd_dvd_left si sj + have hg_one : g ∣ 1 := (Nat.dvd_add_right hg_mul).mp hg_si + exact Nat.dvd_one.mp hg_one + +private theorem crt2_constructive {m₁ m₂ : ℕ} (hm₁ : 0 < m₁) (hm₂ : 0 < m₂) + (hco : Nat.Coprime m₁ m₂) (r₁ r₂ : ℕ) : + ∃ x : ℕ, x % m₁ = r₁ % m₁ ∧ x % m₂ = r₂ % m₂ := by + let A : ℤ := Nat.gcdA m₁ m₂ + let B : ℤ := Nat.gcdB m₁ m₂ + have hbz : (m₁ : ℤ) * A + (m₂ : ℤ) * B = 1 := by + have hg := Nat.gcd_eq_gcd_ab m₁ m₂ + rw [hco.gcd_eq_one] at hg + simpa [A, B] using hg.symm + let M : ℕ := m₁ * m₂ + have hM_pos : (0 : ℤ) < (M : ℤ) := Int.natCast_pos.mpr (Nat.mul_pos hm₁ hm₂) + let z : ℤ := (r₁ : ℤ) + (m₁ : ℤ) * (((r₂ : ℤ) - (r₁ : ℤ)) * A) + have hz2 : z = (r₂ : ℤ) + (m₂ : ℤ) * (((r₁ : ℤ) - (r₂ : ℤ)) * B) := by + have h1 : (m₁ : ℤ) * A = 1 - (m₂ : ℤ) * B := by omega + calc z + _ = (r₁ : ℤ) + ((r₂ : ℤ) - (r₁ : ℤ)) * ((m₁ : ℤ) * A) := by + simp only [z] + rw [← Int.mul_assoc, Int.mul_comm (m₁ : ℤ) ((r₂ : ℤ) - (r₁ : ℤ)), Int.mul_assoc] + _ = (r₁ : ℤ) + ((r₂ : ℤ) - (r₁ : ℤ)) * (1 - (m₂ : ℤ) * B) := by rw [h1] + _ = (r₂ : ℤ) + (m₂ : ℤ) * (((r₁ : ℤ) - (r₂ : ℤ)) * B) := by + rw [Int.mul_sub, Int.mul_one, ← Int.mul_assoc, + Int.mul_comm ((r₂ : ℤ) - (r₁ : ℤ)) (m₂ : ℤ), Int.mul_assoc] + have hsub : -((m₂ : ℤ) * (((r₂ : ℤ) - (r₁ : ℤ)) * B)) = + (m₂ : ℤ) * (((r₁ : ℤ) - (r₂ : ℤ)) * B) := by + rw [← Int.mul_neg, ← Int.neg_mul, Int.neg_sub] + omega + let z' : ℤ := z % (M : ℤ) + have hz'_nonneg : 0 ≤ z' := Int.emod_nonneg z (ne_of_gt hM_pos) + let x : ℕ := z'.toNat + have hx_cast : (x : ℤ) = z' := Int.toNat_of_nonneg hz'_nonneg + refine ⟨x, ?_, ?_⟩ + · apply Int.natCast_inj.mp + rw [Int.natCast_emod, Int.natCast_emod, hx_cast] + have hdvd1 : (m₁ : ℤ) ∣ (M : ℤ) := ⟨(m₂ : ℤ), by simp [M]⟩ + rw [Int.emod_emod_of_dvd z hdvd1] + exact Int.add_mul_emod_self_left (r₁ : ℤ) (m₁ : ℤ) (((r₂ : ℤ) - (r₁ : ℤ)) * A) + · apply Int.natCast_inj.mp + rw [Int.natCast_emod, Int.natCast_emod, hx_cast] + have hdvd2 : (m₂ : ℤ) ∣ (M : ℤ) := ⟨(m₁ : ℤ), by simp [M, Int.mul_comm]⟩ + rw [Int.emod_emod_of_dvd z hdvd2, hz2] + exact Int.add_mul_emod_self_left (r₂ : ℤ) (m₂ : ℤ) (((r₁ : ℤ) - (r₂ : ℤ)) * B) + +/-- Constructive Gödel $\beta$-sequence lemma: every finite sequence `L : List ℕ` is represented +by a pair `(c, d)` via $L_i = c \bmod (1 + (i + 1) d)$. -/ +theorem exists_beta_nat (L : List ℕ) : + ∃ c d : ℕ, ∀ (i : ℕ) (hi : i < L.length), c % (1 + (i + 1) * d) = L[i] := by + let B := max (maxElem L) L.length + 1 + let d := B.factorial + let s : ℕ → ℕ := fun i ↦ 1 + (i + 1) * d + have hs_pos : ∀ i, 0 < s i := fun i ↦ by dsimp only [s]; omega + have hco : ∀ i < L.length, ∀ j < L.length, i ≠ j → Nat.Coprime (s i) (s j) := by + intro i hi j hj hij + rcases Nat.lt_trichotomy i j with hlt | rfl | hgt + · refine beta_moduli_coprime hlt (Nat.dvd_factorial (by omega) ?_) + have hB : L.length < B := by simp [B] + omega + · exact absurd rfl hij + · refine Nat.coprime_comm.mp (beta_moduli_coprime hgt (Nat.dvd_factorial (by omega) ?_)) + have hB : L.length < B := by simp [B] + omega + have hstep : ∀ k (hkle : k ≤ L.length), ∃ c P : ℕ, 0 < P ∧ + (∀ i < k, s i ∣ P) ∧ + (∀ m, (∀ i < k, Nat.Coprime (s i) m) → Nat.Coprime P m) ∧ + (∀ (i : ℕ) (hi : i < k), c % s i = L[i]'(lt_of_lt_of_le hi hkle)) := by + intro k + induction k with + | zero => + intro _ + refine ⟨0, 1, Nat.one_pos, fun _ hi ↦ absurd hi (Nat.not_lt_zero _), + fun _ _ ↦ Nat.coprime_one_left _, fun _ hi ↦ absurd hi (Nat.not_lt_zero _)⟩ + | succ k ih => + intro hkle + have hklt : k < L.length := hkle + obtain ⟨c₀, P₀, hP₀_pos, hdvd₀, hcop₀, hmod₀⟩ := ih (Nat.le_of_lt hklt) + have hcop_sk : Nat.Coprime P₀ (s k) := + hcop₀ (s k) fun i hi ↦ hco i (lt_trans hi hklt) k hklt (Nat.ne_of_lt hi) + obtain ⟨c, hc1, hc2⟩ := crt2_constructive hP₀_pos (hs_pos k) hcop_sk c₀ (L[k]'hklt) + refine ⟨c, P₀ * s k, Nat.mul_pos hP₀_pos (hs_pos k), ?_, ?_, ?_⟩ + · intro i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hilt | rfl + · exact dvd_mul_of_dvd_left (hdvd₀ i hilt) (s k) + · exact dvd_mul_left (s i) P₀ + · intro m hm + exact Nat.Coprime.mul_left + (hcop₀ m fun i hi ↦ hm i (Nat.lt_succ_of_lt hi)) + (hm k (Nat.lt_succ_self k)) + · intro i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hilt | rfl + · have hsi_dvd : s i ∣ P₀ := hdvd₀ i hilt + rw [← Nat.mod_mod_of_dvd c hsi_dvd, hc1, Nat.mod_mod_of_dvd c₀ hsi_dvd] + exact hmod₀ i hilt + · have hlt_s : L[i]'hklt < s i := by + have hle1 : L[i]'hklt ≤ maxElem L := getElem_le_maxElem L i hklt + have hltB : L[i]'hklt < B := by simp [B]; omega + have hB_le_d : B ≤ d := Nat.self_le_factorial B + have hd_le : d ≤ (i + 1) * d := Nat.le_mul_of_pos_left d (Nat.succ_pos i) + dsimp only [s] + omega + rw [hc2, Nat.mod_eq_of_lt hlt_s] + obtain ⟨c, _, _, _, _, hc⟩ := hstep L.length (Nat.le_refl _) + exact ⟨c, d, hc⟩ + +/-! ## Section 4: Binary Half-Tape Bijection and Adequacy of `paHalts` -/ + +/-- Little-endian binary encoding of a `List (Fin 2)` that ignores trailing `0` blanks. -/ +def encodeListBin : List (Fin 2) → ℕ + | [] => 0 + | a :: xs => 2 * encodeListBin xs + a.val + +private theorem encodeListBin_replicate_default (k : ℕ) : + encodeListBin (List.replicate k (default : Fin 2)) = 0 := by + induction k with + | zero => rfl + | succ k ih => + simp only [List.replicate_succ, encodeListBin, ih] + rfl + +private theorem encodeListBin_append_replicate (xs : List (Fin 2)) (k : ℕ) : + encodeListBin (xs ++ List.replicate k (default : Fin 2)) = encodeListBin xs := by + induction xs with + | nil => simp only [List.nil_append, encodeListBin_replicate_default, encodeListBin] + | cons a xs ih => simp only [List.cons_append, encodeListBin, ih] + +/-- Constructive binary encoding of a `ListBlank (Fin 2)` half-tape as a natural number. -/ +def encodeHalf (l : ListBlank (Fin 2)) : ℕ := + l.liftOn encodeListBin fun xs _ ⟨k, hk⟩ ↦ by + subst hk + exact (encodeListBin_append_replicate xs k).symm + +/-- Inverse binary decoding from `ℕ` to `List (Fin 2)`. -/ +def decodeListBin : ℕ → List (Fin 2) + | 0 => [] + | n + 1 => ⟨(n + 1) % 2, Nat.mod_lt _ (by decide)⟩ :: decodeListBin ((n + 1) / 2) + +/-- Constructive binary decoding from `ℕ` to `ListBlank (Fin 2)`. -/ +def decodeHalf (n : ℕ) : ListBlank (Fin 2) := + ListBlank.mk (decodeListBin n) + +@[simp] +theorem encodeHalf_mk (xs : List (Fin 2)) : encodeHalf (ListBlank.mk xs) = encodeListBin xs := + rfl + +@[simp] +theorem encodeHalf_default : encodeHalf default = 0 := rfl + +@[simp] +theorem encodeHalf_cons (l : ListBlank (Fin 2)) (a : Fin 2) : + encodeHalf (l.cons a) = 2 * encodeHalf l + a.val := + l.induction_on fun _ ↦ rfl + +theorem encodeHalf_eq_tail_head (l : ListBlank (Fin 2)) : + encodeHalf l = 2 * encodeHalf l.tail + l.head.val := by + conv_lhs => rw [← ListBlank.cons_head_tail l] + exact encodeHalf_cons l.tail l.head + +private theorem encodeListBin_decodeListBin (n : ℕ) : encodeListBin (decodeListBin n) = n := by + induction n using Nat.strongRecOn with + | ind n ih => + cases n with + | zero => simp [decodeListBin, encodeListBin] + | succ m => + simp only [decodeListBin, encodeListBin] + have hrec := ih ((m + 1) / 2) (Nat.div_lt_self (Nat.succ_pos m) (by decide)) + rw [hrec] + omega + +@[simp] +theorem encodeHalf_decodeHalf (n : ℕ) : encodeHalf (decodeHalf n) = n := + encodeListBin_decodeListBin n + +private theorem mk_decodeListBin_encodeListBin (xs : List (Fin 2)) : + ListBlank.mk (decodeListBin (encodeListBin xs)) = ListBlank.mk xs := by + induction xs with + | nil => simp [encodeListBin, decodeListBin] + | cons a xs ih => + simp only [encodeListBin] + rcases Decidable.eq_or_ne (2 * encodeListBin xs + a.val) 0 with h0 | hne + · have hxs0 : encodeListBin xs = 0 := by omega + have ha0 : a = default := by + ext + change a.val = 0 + omega + have hd0 : decodeListBin 0 = [] := by simp [decodeListBin] + rw [h0, ha0, hd0] + rw [hxs0, hd0] at ih + have hcons : ListBlank.mk ((default : Fin 2) :: xs) = + (ListBlank.mk xs).cons default := rfl + rw [hcons, ← ih] + exact Quot.sound (Or.inl ⟨1, rfl⟩) + · obtain ⟨k, hk⟩ := Nat.exists_eq_succ_of_ne_zero hne + rw [hk, decodeListBin] + have hdiv : (k + 1) / 2 = encodeListBin xs := by + have := a.isLt + omega + have hmod : (⟨(k + 1) % 2, Nat.mod_lt _ (by decide)⟩ : Fin 2) = a := by + ext + have := a.isLt + change (k + 1) % 2 = a.val + omega + rw [hdiv, hmod, ← ListBlank.cons_mk, ih, ListBlank.cons_mk] + +@[simp] +theorem decodeHalf_encodeHalf (l : ListBlank (Fin 2)) : decodeHalf (encodeHalf l) = l := + l.induction_on mk_decodeListBin_encodeListBin + +theorem encodeHalf_injective {l₁ l₂ : ListBlank (Fin 2)} (h : encodeHalf l₁ = encodeHalf l₂) : + l₁ = l₂ := by + rw [← decodeHalf_encodeHalf l₁, ← decodeHalf_encodeHalf l₂, h] + +/-- Nested Cantor configuration code `(q, (h, (L, R)))` of a binary Turing machine configuration. -/ +def encodeCfg {states : ℕ} (c : Cfg states 2) : ℕ := + cantorPair c.state.val + (cantorPair c.tape.head.val + (cantorPair (encodeHalf c.tape.left) (encodeHalf c.tape.right))) + +theorem encodeCfg_init {states : ℕ} [NeZero states] : + encodeCfg (init : Cfg states 2) = 0 := by + have hq : (0 : Fin states).val = 0 := Fin.val_zero states + have hh : (Tape.mk₁ ([] : List (Fin 2))).head.val = 0 := rfl + have hl : encodeHalf (Tape.mk₁ ([] : List (Fin 2))).left = 0 := rfl + have hr : encodeHalf (Tape.mk₁ ([] : List (Fin 2))).right = 0 := rfl + simp only [encodeCfg, init, hq, hh, hl, hr] + rfl + +theorem encodeCfg_injective {states : ℕ} {c₁ c₂ : Cfg states 2} + (h : encodeCfg c₁ = encodeCfg c₂) : c₁ = c₂ := by + obtain ⟨hq, h1⟩ := cantorPair_injective h + obtain ⟨hh, h2⟩ := cantorPair_injective h1 + obtain ⟨hl, hr⟩ := cantorPair_injective h2 + rcases c₁ with ⟨q₁, h₁, L₁, R₁⟩ + rcases c₂ with ⟨q₂, h₂, L₂, R₂⟩ + congr 1 + · exact Fin.ext hq + · congr 1 + · exact Fin.ext hh + · exact encodeHalf_injective hl + · exact encodeHalf_injective hr + +private theorem pzPackCfg_eval (v : ℕ → ℕ) (q h : ℕ) (L R : PAZFTerm) : + (pzPackCfg q h L R).eval v = cantorPair q (cantorPair h (cantorPair (L.eval v) (R.eval v))) := + rfl + +private theorem pzPackCfg_freshVar_le (q h : ℕ) (x y : ℕ) (hx : x < 10) (hy : y < 10) : + (pzPackCfg q h (.var x) (.var y)).freshVar ≤ 10 := by + simp only [pzPackCfg, PAZFTerm.freshVar] + omega + +theorem paStep_holds_iff {states : ℕ} (M : Machine states 2) (v : ℕ → ℕ) : + (paStep M).Holds v ↔ + ∃ c c' : Cfg states 2, v 4 = encodeCfg c ∧ v 5 = encodeCfg c' ∧ step M c = some c' := by + unfold paStep + rw [paDisjList_holds_iff] + simp only [List.mem_flatMap] + constructor + · rintro ⟨φ, ⟨q, _, h, _, hmem⟩, hholds⟩ + cases htr : M.transition q h with + | none => + rw [htr] at hmem + cases hmem + | some val => + rcases val with ⟨w, d, q'⟩ + cases d with + | left => + rw [htr, List.mem_map] at hmem + rcases hmem with ⟨h', hh'mem, rfl⟩ + have hh'lt : h' < 2 := by simp at hh'mem; omega + let hFin : Fin 2 := ⟨h', hh'lt⟩ + simp only [PAFormula.Holds] at hholds + rcases hholds with ⟨n6, n7, n8, n9, hc_eq, hc'_eq, hn6, hn9⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 n6) 7 n7) 8 n8) 9 n9 + have hv4 : v' 4 = v 4 := by simp [v'] + have hv5 : v' 5 = v 5 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + have hv8 : v' 8 = n8 := by simp [v'] + have hv9 : v' 9 = n9 := by simp [v'] + have e1 := (PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) + (by decide)).mp hc_eq + have e2 := (PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) + (by decide)).mp hc'_eq + simp only [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, eval_ofNat, + hv4, hv5, hv6, hv7, hv8, hv9] at e1 e2 hn6 hn9 + let L' := decodeHalf n8 + let R := decodeHalf n7 + let L := L'.cons hFin + have hL_enc : encodeHalf L = n6 := by + simp [L, L', hFin, hn6] + have hR_enc : encodeHalf R = n7 := encodeHalf_decodeHalf n7 + let c : Cfg states 2 := ⟨q, ⟨h, L, R⟩⟩ + let c' : Cfg states 2 := ⟨q', ⟨hFin, L', R.cons w⟩⟩ + refine ⟨c, c', ?_, ?_, ?_⟩ + · simp [encodeCfg, c, hL_enc, hR_enc, e1] + · have hRw : encodeHalf (R.cons w) = n9 := by simp [R, hn9] + simp [encodeCfg, c', L', hFin, hRw, e2] + · simp [step, c, c', htr, Tape.write, Tape.move, L] + | right => + rw [htr, List.mem_map] at hmem + rcases hmem with ⟨h', hh'mem, rfl⟩ + have hh'lt : h' < 2 := by simp at hh'mem; omega + let hFin : Fin 2 := ⟨h', hh'lt⟩ + simp only [PAFormula.Holds] at hholds + rcases hholds with ⟨n6, n7, n8, n9, hc_eq, hc'_eq, hn8, hn7⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 n6) 7 n7) 8 n8) 9 n9 + have hv4 : v' 4 = v 4 := by simp [v'] + have hv5 : v' 5 = v 5 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + have hv8 : v' 8 = n8 := by simp [v'] + have hv9 : v' 9 = n9 := by simp [v'] + have e1 := (PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) + (by decide)).mp hc_eq + have e2 := (PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) + (by decide)).mp hc'_eq + simp only [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, eval_ofNat, + hv4, hv5, hv6, hv7, hv8, hv9] at e1 e2 hn8 hn7 + let L := decodeHalf n6 + let R' := decodeHalf n9 + let R := R'.cons hFin + have hL_enc : encodeHalf L = n6 := encodeHalf_decodeHalf n6 + have hR_enc : encodeHalf R = n7 := by + simp [R, R', hFin, hn7] + let c : Cfg states 2 := ⟨q, ⟨h, L, R⟩⟩ + let c' : Cfg states 2 := ⟨q', ⟨hFin, L.cons w, R'⟩⟩ + refine ⟨c, c', ?_, ?_, ?_⟩ + · simp [encodeCfg, c, hL_enc, hR_enc, e1] + · have hLw : encodeHalf (L.cons w) = n8 := by simp [L, hn8] + simp [encodeCfg, c', R', hFin, hLw, e2] + · simp [step, c, c', htr, Tape.write, Tape.move, R] + · rintro ⟨⟨q, ⟨h, L, R⟩⟩, c', hv4, hv5, hstep⟩ + simp only [step] at hstep + cases htr : M.transition q h with + | none => simp [htr] at hstep + | some val => + rcases val with ⟨w, d, q'⟩ + rw [htr, Option.map_some, Option.some.injEq] at hstep + subst hstep + cases d with + | left => + let h' := L.head.val + have hh'mem : h' ∈ ([0, 1] : List ℕ) := by + have := L.head.isLt + simp only [List.mem_cons, List.not_mem_nil, or_false] + omega + let φ := PAFormula.ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 6) (.add (.mul (.ofNat 2) (.var 8)) (.ofNat h'))) + (.eq (.var 9) (.add (.mul (.ofNat 2) (.var 7)) (.ofNat w.val))))))))) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · rw [htr, List.mem_map] + exact ⟨h', hh'mem, rfl⟩ + · simp only [φ, PAFormula.Holds] + refine ⟨encodeHalf L, encodeHalf R, encodeHalf L.tail, encodeHalf (R.cons w), ?_⟩ + set v' := Function.update (Function.update (Function.update + (Function.update v 6 (encodeHalf L)) 7 (encodeHalf R)) + 8 (encodeHalf L.tail)) 9 (encodeHalf (R.cons w)) + have hv4' : v' 4 = v 4 := by simp [v'] + have hv5' : v' 5 = v 5 := by simp [v'] + have hv6' : v' 6 = encodeHalf L := by simp [v'] + have hv7' : v' 7 = encodeHalf R := by simp [v'] + have hv8' : v' 8 = encodeHalf L.tail := by simp [v'] + have hv9' : v' 9 = encodeHalf (R.cons w) := by simp [v'] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4', hv6', hv7', hv4, encodeCfg] + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv5', hv8', hv9', hv5, encodeCfg, + Tape.write, Tape.move, h'] + · simp only [PATerm.eval, eval_ofNat, hv6', hv8', h'] + exact encodeHalf_eq_tail_head L + · simp only [PATerm.eval, eval_ofNat, hv7', hv9'] + exact encodeHalf_cons R w + | right => + let h' := R.head.val + have hh'mem : h' ∈ ([0, 1] : List ℕ) := by + have := R.head.isLt + simp only [List.mem_cons, List.not_mem_nil, or_false] + omega + let φ := PAFormula.ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 8) (.add (.mul (.ofNat 2) (.var 6)) (.ofNat w.val))) + (.eq (.var 7) (.add (.mul (.ofNat 2) (.var 9)) (.ofNat h'))))))))) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · rw [htr, List.mem_map] + exact ⟨h', hh'mem, rfl⟩ + · simp only [φ, PAFormula.Holds] + refine ⟨encodeHalf L, encodeHalf R, encodeHalf (L.cons w), encodeHalf R.tail, ?_⟩ + set v' := Function.update (Function.update (Function.update + (Function.update v 6 (encodeHalf L)) 7 (encodeHalf R)) + 8 (encodeHalf (L.cons w))) 9 (encodeHalf R.tail) + have hv4' : v' 4 = v 4 := by simp [v'] + have hv5' : v' 5 = v 5 := by simp [v'] + have hv6' : v' 6 = encodeHalf L := by simp [v'] + have hv7' : v' 7 = encodeHalf R := by simp [v'] + have hv8' : v' 8 = encodeHalf (L.cons w) := by simp [v'] + have hv9' : v' 9 = encodeHalf R.tail := by simp [v'] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4', hv6', hv7', hv4, encodeCfg] + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 5) 10 v' + (pzPackCfg_freshVar_le q'.val h' 8 9 (by decide) (by decide)) (by decide)] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv5', hv8', hv9', hv5, encodeCfg, + Tape.write, Tape.move, h'] + · simp only [PATerm.eval, eval_ofNat, hv6', hv8'] + exact encodeHalf_cons L w + · simp only [PATerm.eval, eval_ofNat, hv7', hv9', h'] + exact encodeHalf_eq_tail_head R + +theorem paHalted_holds_iff {states : ℕ} (M : Machine states 2) (v : ℕ → ℕ) : + (paHalted M).Holds v ↔ ∃ c : Cfg states 2, v 4 = encodeCfg c ∧ step M c = none := by + unfold paHalted + rw [paDisjList_holds_iff] + simp only [List.mem_flatMap] + constructor + · rintro ⟨φ, ⟨q, _, h, _, hmem⟩, hholds⟩ + cases htr : M.transition q h with + | some _ => rw [htr] at hmem; cases hmem + | none => + rw [htr, List.mem_singleton] at hmem + subst hmem + simp only [PAFormula.Holds] at hholds + rcases hholds with ⟨n6, n7, heq⟩ + set v' := Function.update (Function.update v 6 n6) 7 n7 + have e1 := (PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)).mp heq + have hv4 : v' 4 = v 4 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + simp only [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4, hv6, hv7] at e1 + refine ⟨⟨q, ⟨h, decodeHalf n6, decodeHalf n7⟩⟩, ?_, ?_⟩ + · simp [encodeCfg, e1] + · simp [step, htr] + · rintro ⟨⟨q, ⟨h, L, R⟩⟩, hv4, hstep⟩ + simp only [step, Option.map_eq_none_iff] at hstep + let φ := PAFormula.ex 6 + (.ex 7 ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10)) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · simp [hstep, φ] + · simp only [φ, PAFormula.Holds] + refine ⟨encodeHalf L, encodeHalf R, ?_⟩ + set v' := Function.update (Function.update v 6 (encodeHalf L)) 7 (encodeHalf R) + rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v' + (pzPackCfg_freshVar_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + have hv4' : v' 4 = v 4 := by simp [v'] + have hv6' : v' 6 = encodeHalf L := by simp [v'] + have hv7' : v' 7 = encodeHalf R := by simp [v'] + simp [PATerm.eval, pzPackCfg_eval, PAZFTerm.eval, hv4', hv6', hv7', hv4, encodeCfg] + +private theorem reaches_to_trace {σ : Type*} {f : σ → Option σ} {a b : σ} + (h : StateTransition.Reaches f a b) : + ∃ (n : ℕ) (tr : ℕ → σ), tr 0 = a ∧ (∀ i < n, f (tr i) = some (tr (i + 1))) ∧ tr n = b := by + induction h with + | refl => exact ⟨0, fun _ ↦ a, rfl, fun _ hi ↦ absurd hi (Nat.not_lt_zero _), rfl⟩ + | @tail x y _ hxy ih => + rcases ih with ⟨n, tr, h0, hstep, hn⟩ + refine ⟨n + 1, fun i ↦ if i == n + 1 then y else tr i, ?_, ?_, ?_⟩ + · simp [h0] + · intro i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hlt | rfl + · have hne1 : (i == n + 1) = false := beq_eq_false_iff_ne.mpr (by omega) + have hne2 : (i + 1 == n + 1) = false := beq_eq_false_iff_ne.mpr (by omega) + simp only [hne1, hne2, Bool.false_eq_true, ↓reduceIte] + exact hstep i hlt + · have hne1 : (i == i + 1) = false := beq_eq_false_iff_ne.mpr (by omega) + simp only [hne1, beq_self_eq_true, Bool.false_eq_true, ↓reduceIte, hn] + exact Option.mem_def.mp hxy + · simp + +/-- Standard-model adequacy of `paHalts`: `(paHalts M).Holds v` holds in `ℕ` if and only if `M` +halts from `init` (proved constructively without `Classical.choice`). -/ +theorem paHalts_holds_iff_halts {states : ℕ} [NeZero states] (M : Machine states 2) + (v : ℕ → ℕ) : (paHalts M).Holds v ↔ ConjectureMachines.Halts M := by + unfold paHalts ConjectureMachines.Halts + simp only [PAFormula.Holds] + constructor + · rintro ⟨n, c, d, h0, hsteps, hhalt⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + have hb0 : c % (1 + d) = 0 := by + have := (paBetaEq_holds_iff v2 (.var 1) (.var 2) .zero .zero).mp h0 + simpa [v2, PATerm.eval] using this + have hreach : ∀ i ≤ n, ∃ cfg : Cfg states 2, + c % (1 + (i + 1) * d) = encodeCfg cfg ∧ StateTransition.Reaches (step M) init cfg := by + intro i + induction i with + | zero => + intro _ + refine ⟨init, ?_, Relation.ReflTransGen.refl⟩ + simpa [encodeCfg_init] using hb0 + | succ i ih => + intro hle + obtain ⟨cfg₀, hcfg₀, hr₀⟩ := ih (Nat.le_of_succ_le hle) + have hilt : (paLt (.var 3) (.var 0)).Holds (Function.update v2 3 i) := by + rw [paLt_holds_iff] + simp [v2, PATerm.eval] + omega + obtain ⟨x4, x5, hb_i, hb_i1, hst⟩ := hsteps i hilt + set v5 := Function.update (Function.update (Function.update v2 3 i) 4 x4) 5 x5 + have hx4 : c % (1 + (i + 1) * d) = x4 := by + have := (paBetaEq_holds_iff v5 (.var 1) (.var 2) (.var 3) (.var 4)).mp hb_i + simpa [v5, v2, PATerm.eval] using this + have hx5 : c % (1 + (i + 1 + 1) * d) = x5 := by + have := (paBetaEq_holds_iff v5 (.var 1) (.var 2) (.succ (.var 3)) (.var 5)).mp hb_i1 + simpa [v5, v2, PATerm.eval] using this + obtain ⟨c₁, c₂, hc₁, hc₂, hstep⟩ := (paStep_holds_iff M v5).mp hst + simp only [v5, Function.update_self, + Function.update_of_ne (by decide : (4 : ℕ) ≠ 5)] at hc₁ hc₂ + have heq₀ : cfg₀ = c₁ := encodeCfg_injective (by rw [← hcfg₀, hx4, hc₁]) + subst heq₀ + exact ⟨c₂, by rw [hx5, hc₂], Relation.ReflTransGen.tail hr₀ hstep⟩ + obtain ⟨cfg_n, hcfg_n, hr_n⟩ := hreach n (Nat.le_refl n) + rcases hhalt with ⟨x4, hb_n, hhalted⟩ + set v4 := Function.update v2 4 x4 + have hx4 : c % (1 + (n + 1) * d) = x4 := by + have := (paBetaEq_holds_iff v4 (.var 1) (.var 2) (.var 0) (.var 4)).mp hb_n + simpa [v4, v2, PATerm.eval] using this + obtain ⟨cfg_f, hcfg_f, hnone⟩ := (paHalted_holds_iff M v4).mp hhalted + simp only [v4, Function.update_self] at hcfg_f + have heq_f : cfg_n = cfg_f := encodeCfg_injective (by rw [← hcfg_n, hx4, hcfg_f]) + subst heq_f + have hmem : cfg_n ∈ StateTransition.eval (step M) init := + mem_eval'.mpr ⟨hr_n, hnone⟩ + exact hmem.fst + · intro hdom + have hmem : (StateTransition.eval (step M) init).get hdom ∈ + StateTransition.eval (step M) init := ⟨hdom, rfl⟩ + obtain ⟨hreach, hnone⟩ := mem_eval'.mp hmem + obtain ⟨n, tr, htr0, htr_step, htr_n⟩ := reaches_to_trace hreach + let codes : List ℕ := (List.range (n + 1)).map fun i ↦ encodeCfg (tr i) + obtain ⟨c, d, hbeta⟩ := exists_beta_nat codes + have hcode : ∀ i ≤ n, c % (1 + (i + 1) * d) = encodeCfg (tr i) := by + intro i hi + have hlen : codes.length = n + 1 := by simp [codes] + have hbi := hbeta i (by omega) + simpa [codes] using hbi + refine ⟨n, c, d, ?_⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + refine ⟨?_, ?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v2, PATerm.eval, htr0, encodeCfg_init] using hcode 0 (Nat.zero_le n) + · intro i hilt + rw [paLt_holds_iff] at hilt + have hi_lt : i < n := by simpa [v2, PATerm.eval] using hilt + refine ⟨encodeCfg (tr i), encodeCfg (tr (i + 1)), ?_⟩ + set v5 := Function.update (Function.update + (Function.update v2 3 i) 4 (encodeCfg (tr i))) 5 (encodeCfg (tr (i + 1))) + refine ⟨?_, ?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v5, v2, PATerm.eval] using hcode i (Nat.le_of_lt hi_lt) + · rw [paBetaEq_holds_iff] + simpa [v5, v2, PATerm.eval] using hcode (i + 1) hi_lt + · rw [paStep_holds_iff] + exact ⟨tr i, tr (i + 1), by simp [v5], by simp [v5], htr_step i hi_lt⟩ + · refine ⟨encodeCfg (tr n), ?_⟩ + set v4 := Function.update v2 4 (encodeCfg (tr n)) + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v4, v2, PATerm.eval] using hcode n (Nat.le_refl n) + · rw [paHalted_holds_iff] + exact ⟨tr n, by simp [v4], htr_n ▸ hnone⟩ + +/-! ## Section 5: Standard-Model Adequacy of `paZFInconsistent` -/ + +private theorem pzEq_eval (v : ℕ → ℕ) (x y : PAZFTerm) : + (pzEq x y).eval v = zfEq (x.eval v) (y.eval v) := rfl +private theorem pzMem_eval (v : ℕ → ℕ) (x y : PAZFTerm) : + (pzMem x y).eval v = zfMem (x.eval v) (y.eval v) := rfl +private theorem pzImp_eval (v : ℕ → ℕ) (φ ψ : PAZFTerm) : + (pzImp φ ψ).eval v = zfImp (φ.eval v) (ψ.eval v) := rfl +private theorem pzNot_eval (v : ℕ → ℕ) (φ : PAZFTerm) : + (pzNot φ).eval v = zfNot (φ.eval v) := rfl +private theorem pzAll_eval (v : ℕ → ℕ) (x φ : PAZFTerm) : + (pzAll x φ).eval v = zfAll (x.eval v) (φ.eval v) := rfl +private theorem pzEx_eval (v : ℕ → ℕ) (x φ : PAZFTerm) : + (pzEx x φ).eval v = zfEx (x.eval v) (φ.eval v) := rfl +private theorem pzAnd_eval (v : ℕ → ℕ) (φ ψ : PAZFTerm) : + (pzAnd φ ψ).eval v = zfAnd (φ.eval v) (ψ.eval v) := rfl + +private theorem pzB1_eval (v : ℕ → ℕ) (φ ψ χ : PAZFTerm) : + (pzB1 φ ψ χ).eval v = axB1 (φ.eval v) (ψ.eval v) (χ.eval v) := by + simp only [pzB1, axB1, pzImp_eval] +private theorem pzB2_eval (v : ℕ → ℕ) (φ : PAZFTerm) : + (pzB2 φ).eval v = axB2 (φ.eval v) := by + simp only [pzB2, axB2, pzImp_eval, pzNot_eval] +private theorem pzB3_eval (v : ℕ → ℕ) (φ ψ : PAZFTerm) : + (pzB3 φ ψ).eval v = axB3 (φ.eval v) (ψ.eval v) := by + simp only [pzB3, axB3, pzImp_eval, pzNot_eval] +private theorem pzB4_eval (v : ℕ → ℕ) (x φ ψ : PAZFTerm) : + (pzB4 x φ ψ).eval v = axB4 (x.eval v) (φ.eval v) (ψ.eval v) := by + simp only [pzB4, axB4, pzImp_eval, pzAll_eval] +private theorem pzB6a_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB6a x y z).eval v = axB6a (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB6a, axB6a, pzAnd_eval, pzImp_eval, pzAll_eval, pzEq_eval, pzMem_eval] +private theorem pzB6b_eval (v : ℕ → ℕ) (x y φ : PAZFTerm) : + (pzB6b x y φ).eval v = axB6b (x.eval v) (y.eval v) (φ.eval v) := by + simp only [pzB6b, axB6b, pzImp_eval, pzAll_eval] +private theorem pzB6c_eval (v : ℕ → ℕ) (x φ : PAZFTerm) : + (pzB6c x φ).eval v = axB6c (x.eval v) (φ.eval v) := by + simp only [pzB6c, axB6c, pzImp_eval, pzEx_eval, pzAll_eval] +private theorem pzB7_eval (v : ℕ → ℕ) (x y : PAZFTerm) : + (pzB7 x y).eval v = axB7 (x.eval v) (y.eval v) := by + simp only [pzB7, axB7, pzEx_eval, pzEq_eval] +private theorem pzB8a_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB8a x y z).eval v = axB8a (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB8a, axB8a, pzImp_eval, pzEq_eval] +private theorem pzB8b_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB8b x y z).eval v = axB8b (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB8b, axB8b, pzImp_eval, pzEq_eval, pzMem_eval] +private theorem pzB8c_eval (v : ℕ → ℕ) (x y z : PAZFTerm) : + (pzB8c x y z).eval v = axB8c (x.eval v) (y.eval v) (z.eval v) := by + simp only [pzB8c, axB8c, pzImp_eval, pzEq_eval, pzMem_eval] +private theorem pzExt_eval (v : ℕ → ℕ) : pzExt.eval v = axExt := by + simp only [pzExt, axExt, pzImp_eval, pzAll_eval, pzAnd_eval, pzMem_eval, pzEq_eval, + PAZFTerm.eval] +private theorem pzRep_eval (v : ℕ → ℕ) (φ : PAZFTerm) : + (pzRep φ).eval v = axRep (φ.eval v) := by + simp only [pzRep, pzRepRhs, axRep, axRepRhs, pzImp_eval, pzAll_eval, pzEx_eval, pzAnd_eval, + pzMem_eval, pzEq_eval, PAZFTerm.eval] +private theorem pzPow_eval (v : ℕ → ℕ) : pzPow.eval v = axPow := by + simp only [pzPow, axPow, pzEx_eval, pzAll_eval, pzImp_eval, pzMem_eval, PAZFTerm.eval] +private theorem pzUni_eval (v : ℕ → ℕ) : pzUni.eval v = axUni := by + simp only [pzUni, axUni, pzEx_eval, pzAll_eval, pzImp_eval, pzEx_eval, pzAnd_eval, pzMem_eval, + PAZFTerm.eval] +private theorem pzInf_eval (v : ℕ → ℕ) : pzInf.eval v = axInf := by + simp only [pzInf, pzInfSingleton, axInf, axInfSingleton, pzEx_eval, pzAnd_eval, pzAll_eval, + pzImp_eval, pzMem_eval, pzEq_eval, PAZFTerm.eval] + +/-- Whether formula code `w` is an axiom instance of `ZFProvable` (any constructor except `mp` and +`gen`). -/ +private def IsZFAxiom (w : ℕ) : Prop := + w = zfEq 0 0 ∨ + (∃ φ ψ χ, w = axB1 φ ψ χ) ∨ + (∃ φ, w = axB2 φ) ∨ + (∃ φ ψ, w = axB3 φ ψ) ∨ + (∃ x φ ψ, w = axB4 x φ ψ) ∨ + (∃ x y z, x ≠ z ∧ z ≠ y ∧ w = axB6a x y z) ∨ + (∃ x y φ, w = axB6b x y φ) ∨ + (∃ x φ, w = axB6c x φ) ∨ + (∃ x y, w = axB7 x y) ∨ + (∃ x y z, w = axB8a x y z) ∨ + (∃ x y z, w = axB8b x y z) ∨ + (∃ x y z, w = axB8c x y z) ∨ + w = axExt ∨ + (∃ φ, w = axRep φ) ∨ + w = axPow ∨ + w = axUni ∨ + w = axInf + +private theorem zfProvable_of_axiom {w : ℕ} (h : IsZFAxiom w) : ZFProvable w := by + rcases h with rfl | ⟨φ, ψ, χ, rfl⟩ | ⟨φ, rfl⟩ | ⟨φ, ψ, rfl⟩ | ⟨x, φ, ψ, rfl⟩ | + ⟨x, y, z, hxz, hzy, rfl⟩ | ⟨x, y, φ, rfl⟩ | ⟨x, φ, rfl⟩ | ⟨x, y, rfl⟩ | + ⟨x, y, z, rfl⟩ | ⟨x, y, z, rfl⟩ | ⟨x, y, z, rfl⟩ | rfl | ⟨φ, rfl⟩ | rfl | rfl | rfl + · exact .moot + · exact .b1 φ ψ χ + · exact .b2 φ + · exact .b3 φ ψ + · exact .b4 x φ ψ + · exact .b6a x y z hxz hzy + · exact .b6b x y φ + · exact .b6c x φ + · exact .b7 x y + · exact .b8a x y z + · exact .b8b x y z + · exact .b8c x y z + · exact .ext + · exact .rep φ + · exact .pow + · exact .uni + · exact .inf + +private theorem paIsZFStep_holds_iff (v : ℕ → ℕ) : + paIsZFStep.Holds v ↔ + IsZFAxiom (v 4) ∨ + (∃ φ χ j₁ j₂, j₁ < v 3 ∧ j₂ < v 3 ∧ + v 1 % (1 + (j₁ + 1) * v 2) = φ ∧ + v 1 % (1 + (j₂ + 1) * v 2) = χ ∧ + χ = zfImp φ (v 4)) ∨ + (∃ x φ j, j < v 3 ∧ v 1 % (1 + (j + 1) * v 2) = φ ∧ v 4 = zfAll x φ) := by + unfold paIsZFStep IsZFAxiom + rw [paDisjList_holds_iff] + simp only [List.mem_cons, List.not_mem_nil, or_false, exists_eq_or_imp, exists_eq_left] + have eq_iff : ∀ (e : PAZFTerm) (out : PATerm) (u : ℕ → ℕ), + e.freshVar ≤ 10 → out.freshVar ≤ 10 → + ((e.eqFormula out 10).Holds u ↔ out.eval u = e.eval u) := + fun e out u he ho ↦ PAZFTerm.eqFormula_holds_iff e out 10 u he ho + constructor + · rintro (h0 | hmp | hgen | hb1 | hb2 | hb3 | hb4 | hb6a | hb6b | hb6c | hb7 | + hb8a | hb8b | hb8c | hext | hrep | hpow | huni | hinf) + · rw [eq_iff _ _ _ (by decide) (by decide)] at h0 + exact Or.inl (Or.inl (by simpa [PATerm.eval, pzEq_eval, PAZFTerm.eval] using h0)) + · simp only [PAFormula.Holds] at hmp + rcases hmp with ⟨n5, n6, n8, n9, h8, h9, hb8, hb9, himp⟩ + set u := Function.update (Function.update + (Function.update (Function.update v 5 n5) 6 n6) 8 n8) 9 n9 + rw [paLt_holds_iff] at h8 h9 + rw [paBetaEq_holds_iff] at hb8 hb9 + rw [eq_iff _ _ _ (by decide) (by decide)] at himp + refine Or.inr (Or.inl ⟨n5, n6, n8, n9, ?_, ?_, ?_, ?_, ?_⟩) + · simpa [u, PATerm.eval] using h8 + · simpa [u, PATerm.eval] using h9 + · simpa [u, PATerm.eval] using hb8 + · simpa [u, PATerm.eval] using hb9 + · simpa [u, PATerm.eval, pzImp_eval, PAZFTerm.eval] using himp + · simp only [PAFormula.Holds] at hgen + rcases hgen with ⟨n5, n6, n8, h8, hb8, hall⟩ + set u := Function.update (Function.update (Function.update v 5 n5) 6 n6) 8 n8 + rw [paLt_holds_iff] at h8 + rw [paBetaEq_holds_iff] at hb8 + rw [eq_iff _ _ _ (by decide) (by decide)] at hall + refine Or.inr (Or.inr ⟨n5, n6, n8, ?_, ?_, ?_⟩) + · simpa [u, PATerm.eval] using h8 + · simpa [u, PATerm.eval] using hb8 + · simpa [u, PATerm.eval, pzAll_eval, PAZFTerm.eval] using hall + · simp only [PAFormula.Holds] at hb1 + rcases hb1 with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB1_eval, PAZFTerm.eval] using h⟩)) + · simp only [PAFormula.Holds] at hb2 + rcases hb2 with ⟨n5, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inl ⟨n5, + by simpa [PATerm.eval, pzB2_eval, PAZFTerm.eval] using h⟩))) + · simp only [PAFormula.Holds] at hb3 + rcases hb3 with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, + by simpa [PATerm.eval, pzB3_eval, PAZFTerm.eval] using h⟩)))) + · simp only [PAFormula.Holds] at hb4 + rcases hb4 with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB4_eval, PAZFTerm.eval] using h⟩))))) + · simp only [PAFormula.Holds] at hb6a + rcases hb6a with ⟨n5, n6, n7, hne1, hne2, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨n5, n6, n7, by simpa [PATerm.eval] using hne1, + by simpa [PATerm.eval] using hne2, + by simpa [PATerm.eval, pzB6a_eval, PAZFTerm.eval] using h⟩)))))) + · simp only [PAFormula.Holds] at hb6b + rcases hb6b with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB6b_eval, PAZFTerm.eval] using h⟩))))))) + · simp only [PAFormula.Holds] at hb6c + rcases hb6c with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, + by simpa [PATerm.eval, pzB6c_eval, PAZFTerm.eval] using h⟩)))))))) + · simp only [PAFormula.Holds] at hb7 + rcases hb7 with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨n5, n6, by simpa [PATerm.eval, pzB7_eval, PAZFTerm.eval] using h⟩))))))))) + · simp only [PAFormula.Holds] at hb8a + rcases hb8a with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨n5, n6, n7, by simpa [PATerm.eval, pzB8a_eval, PAZFTerm.eval] using h⟩)))))))))) + · simp only [PAFormula.Holds] at hb8b + rcases hb8b with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB8b_eval, PAZFTerm.eval] using h⟩))))))))))) + · simp only [PAFormula.Holds] at hb8c + rcases hb8c with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [PATerm.eval, pzB8c_eval, PAZFTerm.eval] using h⟩)))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hext + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [PATerm.eval, pzExt_eval] using hext)))))))))))))) + · simp only [PAFormula.Holds] at hrep + rcases hrep with ⟨n5, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, + by simpa [PATerm.eval, pzRep_eval, PAZFTerm.eval] using h⟩)))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hpow + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [PATerm.eval, pzPow_eval] using hpow)))))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at huni + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [PATerm.eval, pzUni_eval] using huni))))))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hinf + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (by simpa [PATerm.eval, pzInf_eval] using hinf))))))))))))))))) + · rintro (hax | ⟨φ, χ, j₁, j₂, hj₁, hj₂, hb₁, hb₂, hχ⟩ | ⟨x, φ, j, hj, hbj, hall⟩) + · rcases hax with h0 | ⟨a, b, c, h⟩ | ⟨a, h⟩ | ⟨a, b, h⟩ | ⟨a, b, c, h⟩ | + ⟨a, b, c, hac, hcb, h⟩ | ⟨a, b, c, h⟩ | ⟨a, b, h⟩ | ⟨a, b, h⟩ | + ⟨a, b, c, h⟩ | ⟨a, b, c, h⟩ | ⟨a, b, c, h⟩ | hext | ⟨a, h⟩ | hpow | huni | hinf + · refine Or.inl ?_ + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzEq_eval, PAZFTerm.eval] using h0 + · refine Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB1_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, ?_⟩)))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB2_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, ?_⟩))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB3_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩)))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB4_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨a, b, c, ?_, ?_, ?_⟩))))))) + · simpa [PAFormula.Holds, PATerm.eval] using hac + · simpa [PAFormula.Holds, PATerm.eval] using hcb + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB6a_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, c, ?_⟩)))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB6b_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨a, b, ?_⟩))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB6c_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨a, b, ?_⟩)))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB7_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB8a_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩)))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB8b_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzB8c_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_)))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzExt_eval] using hext + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, ?_⟩))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzRep_eval, PAZFTerm.eval] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ?_)))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzPow_eval] using hpow + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ?_))))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzUni_eval] using huni + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr ?_))))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzInf_eval] using hinf + · refine Or.inr (Or.inl ⟨φ, χ, j₁, j₂, ?_, ?_, ?_, ?_, ?_⟩) + · rw [paLt_holds_iff]; simpa [PATerm.eval] using hj₁ + · rw [paLt_holds_iff]; simpa [PATerm.eval] using hj₂ + · rw [paBetaEq_holds_iff]; simpa [PATerm.eval] using hb₁ + · rw [paBetaEq_holds_iff]; simpa [PATerm.eval] using hb₂ + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzImp_eval, PAZFTerm.eval] using hχ + · refine Or.inr (Or.inr (Or.inl ⟨x, φ, j, ?_, ?_, ?_⟩)) + · rw [paLt_holds_iff]; simpa [PATerm.eval] using hj + · rw [paBetaEq_holds_iff]; simpa [PATerm.eval] using hbj + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [PATerm.eval, pzAll_eval, PAZFTerm.eval] using hall + +private def ValidZFDeriv (L : List ℕ) : Prop := + ∀ (i : ℕ) (hi : i < L.length), + IsZFAxiom L[i] ∨ + (∃ (j₁ j₂ : ℕ) (hj₁ : j₁ < i) (hj₂ : j₂ < i), + L[j₂]'(lt_trans hj₂ hi) = zfImp (L[j₁]'(lt_trans hj₁ hi)) L[i]) ∨ + (∃ (x j : ℕ) (hj : j < i), L[i] = zfAll x (L[j]'(lt_trans hj hi))) + +private theorem validZFDeriv_append {L₁ L₂ : List ℕ} (h₁ : ValidZFDeriv L₁) + (h₂ : ValidZFDeriv L₂) : ValidZFDeriv (L₁ ++ L₂) := by + intro i hi + rw [List.length_append] at hi + rcases Nat.lt_or_ge i L₁.length with hlt | hge + · rw [List.getElem_append_left hlt] + rcases h₁ i hlt with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨j₁, j₂, hj₁, hj₂, ?_⟩) + rwa [List.getElem_append_left (lt_trans hj₁ hlt), + List.getElem_append_left (lt_trans hj₂ hlt)] + · refine Or.inr (Or.inr ⟨x, j, hj, ?_⟩) + rwa [List.getElem_append_left (lt_trans hj hlt)] + · let k := i - L₁.length + have hk : k < L₂.length := by omega + have hik : i = L₁.length + k := by omega + have hget : ∀ (m : ℕ) (hm : m < L₂.length) (hm' : L₁.length + m < (L₁ ++ L₂).length), + (L₁ ++ L₂)[L₁.length + m]'hm' = L₂[m]'hm := by + intro m hm hm' + simp + have hi_eq : (L₁ ++ L₂)[i] = L₂[k] := by + simp [hik] + rw [hi_eq] + rcases h₂ k hk with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨L₁.length + j₁, L₁.length + j₂, by omega, by omega, ?_⟩) + rw [hget j₁ (lt_trans hj₁ hk), hget j₂ (lt_trans hj₂ hk)] + exact hmp + · refine Or.inr (Or.inr ⟨x, L₁.length + j, by omega, ?_⟩) + rw [hget j (lt_trans hj hk)] + exact hgen + +private theorem exists_validZFDeriv {φ : ℕ} (h : ZFProvable φ) : + ∃ (L : List ℕ) (hne : L ≠ []), ValidZFDeriv L ∧ L[L.length - 1]'(by + exact Nat.sub_lt (List.length_pos_of_ne_nil hne) Nat.one_pos) = φ := by + have single_ax : ∀ {w : ℕ}, IsZFAxiom w → + ∃ (L : List ℕ) (hne : L ≠ []), ValidZFDeriv L ∧ L[L.length - 1]'(by + exact Nat.sub_lt (List.length_pos_of_ne_nil hne) Nat.one_pos) = w := by + intro w hw + refine ⟨[w], List.cons_ne_nil _ _, ?_, rfl⟩ + intro i hi + have hi0 : i = 0 := by + simp only [List.length_singleton] at hi + omega + subst hi0 + exact Or.inl hw + induction h with + | moot => exact single_ax (Or.inl rfl) + | b1 a b c => exact single_ax (Or.inr (Or.inl ⟨a, b, c, rfl⟩)) + | b2 a => exact single_ax (Or.inr (Or.inr (Or.inl ⟨a, rfl⟩))) + | b3 a b => exact single_ax (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, rfl⟩)))) + | b4 a b c => exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, rfl⟩))))) + | b6a a b c hac hcb => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, hac, hcb, rfl⟩)))))) + | b6b a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, rfl⟩))))))) + | b6c a b => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, rfl⟩)))))))) + | b7 a b => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, rfl⟩))))))))) + | b8a a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, c, rfl⟩)))))))))) + | b8b a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨a, b, c, rfl⟩))))))))))) + | b8c a b c => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨a, b, c, rfl⟩)))))))))))) + | ext => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl rfl))))))))))))) + | rep a => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, rfl⟩)))))))))))))) + | pow => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl))))))))))))))) + | uni => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)))))))))))))))) + | inf => + exact single_ax (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr rfl)))))))))))))))) + | @mp φ ψ _ _ ih₁ ih₂ => + rcases ih₁ with ⟨L₁, hne₁, hv₁, hlast₁⟩ + rcases ih₂ with ⟨L₂, hne₂, hv₂, hlast₂⟩ + have hp₁ : 0 < L₁.length := List.length_pos_of_ne_nil hne₁ + have hp₂ : 0 < L₂.length := List.length_pos_of_ne_nil hne₂ + let L₁₂ := L₁ ++ L₂ + have hv₁₂ : ValidZFDeriv L₁₂ := validZFDeriv_append hv₁ hv₂ + let L := L₁₂ ++ [ψ] + have hne : L ≠ [] := List.append_ne_nil_of_right_ne_nil _ (List.cons_ne_nil _ _) + refine ⟨L, hne, ?_, ?_⟩ + · intro i hi + simp only [L, L₁₂, List.length_append, List.length_singleton] at hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hlt | rfl + · have hlt' : i < L₁₂.length := by + simp only [L₁₂, List.length_append] + exact hlt + simp only [L, List.getElem_append_left hlt'] + rcases hv₁₂ i hlt' with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨j₁, j₂, hj₁, hj₂, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj₁ hlt'), + List.getElem_append_left (lt_trans hj₂ hlt')] using hmp + · refine Or.inr (Or.inr ⟨x, j, hj, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj hlt')] using hgen + · refine Or.inr (Or.inl ⟨L₁.length - 1, L₁.length + L₂.length - 1, + by omega, by omega, ?_⟩) + have hget_end : L[L₁.length + L₂.length] = ψ := by + simp [L, L₁₂] + have hget1 : L[L₁.length - 1]'(by simp [L, L₁₂]; omega) = φ := by + rw [List.getElem_append_left (by simp [L₁₂]; omega)] + rw [List.getElem_append_left (by omega)] + exact hlast₁ + have hget2 : L[L₁.length + L₂.length - 1]'(by simp [L, L₁₂]; omega) = zfImp φ ψ := by + rw [List.getElem_append_left (by simp [L₁₂]; omega)] + have hidx : L₁.length + L₂.length - 1 = L₁.length + (L₂.length - 1) := by omega + simp only [L₁₂, hidx, List.getElem_append_right (Nat.le_add_right _ _), + Nat.add_sub_cancel_left] + exact hlast₂ + rw [hget_end, hget1, hget2] + · simp [L, L₁₂] + | @gen x φ _ ih => + rcases ih with ⟨L₁, hne₁, hv₁, hlast₁⟩ + have hp₁ : 0 < L₁.length := List.length_pos_of_ne_nil hne₁ + let L := L₁ ++ [zfAll x φ] + have hne : L ≠ [] := List.append_ne_nil_of_right_ne_nil _ (List.cons_ne_nil _ _) + refine ⟨L, hne, ?_, ?_⟩ + · intro i hi + simp only [L, List.length_append, List.length_singleton] at hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hlt | rfl + · simp only [L, List.getElem_append_left hlt] + rcases hv₁ i hlt with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨y, j, hj, hgen⟩ + · exact Or.inl hax + · refine Or.inr (Or.inl ⟨j₁, j₂, hj₁, hj₂, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj₁ hlt), + List.getElem_append_left (lt_trans hj₂ hlt)] using hmp + · refine Or.inr (Or.inr ⟨y, j, hj, ?_⟩) + simpa only [List.getElem_append_left (lt_trans hj hlt)] using hgen + · refine Or.inr (Or.inr ⟨x, L₁.length - 1, by omega, ?_⟩) + have hget_end : L[L₁.length] = zfAll x φ := by simp [L] + have hget1 : L[L₁.length - 1]'(by simp [L]) = φ := by + rw [List.getElem_append_left (by omega)] + exact hlast₁ + rw [hget_end, hget1] + · simp [L] + +/-- Standard-model adequacy of `paZFInconsistent`: `paZFInconsistent.Holds v` holds in `ℕ` if and +only if `ZFInconsistent` holds (proved constructively without `Classical.choice`). -/ +theorem paZFInconsistent_holds_iff_zfInconsistent (v : ℕ → ℕ) : + paZFInconsistent.Holds v ↔ ZFInconsistent := by + unfold paZFInconsistent ZFInconsistent + simp only [PAFormula.Holds] + constructor + · rintro ⟨n, c, d, hsteps, hfinal⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + have hprov : ∀ i ≤ n, ZFProvable (c % (1 + (i + 1) * d)) := by + intro i + induction i using Nat.strongRecOn with + | ind i ih => + intro hle + have hle_holds : (paLe (.var 3) (.var 0)).Holds (Function.update v2 3 i) := by + rw [paLe_holds_iff] + simp [v2, PATerm.eval, hle] + obtain ⟨w, hbw, hst⟩ := hsteps i hle_holds + set v4 := Function.update (Function.update v2 3 i) 4 w + have hw_eq : c % (1 + (i + 1) * d) = w := by + have := (paBetaEq_holds_iff v4 (.var 1) (.var 2) (.var 3) (.var 4)).mp hbw + simpa [v4, v2, PATerm.eval] using this + rw [hw_eq] + have hst' := (paIsZFStep_holds_iff v4).mp hst + simp only [v4, v2, Function.update_self, + Function.update_of_ne (by decide : (3 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 3), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 2), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 3)] at hst' + rcases hst' with hax | ⟨φ, χ, j₁, j₂, hj₁, hj₂, hb₁, hb₂, hχ⟩ | ⟨x, φ, j, hj, hbj, hall⟩ + · exact zfProvable_of_axiom hax + · have p₁ : ZFProvable φ := by + rw [← hb₁] + exact ih j₁ hj₁ (by omega) + have p₂ : ZFProvable (zfImp φ w) := by + rw [← hχ, ← hb₂] + exact ih j₂ hj₂ (by omega) + exact .mp p₁ p₂ + · rw [hall] + refine .gen x ?_ + rw [← hbj] + exact ih j hj (by omega) + rcases hfinal with ⟨w, hbw, hmem⟩ + set v4 := Function.update v2 4 w + have hw_eq : c % (1 + (n + 1) * d) = w := by + have := (paBetaEq_holds_iff v4 (.var 1) (.var 2) (.var 0) (.var 4)).mp hbw + simpa [v4, v2, PATerm.eval] using this + have hw_mem : w = zfMem 0 0 := by + have := (PAZFTerm.eqFormula_holds_iff (pzMem (.const 0) (.const 0)) (.var 4) 10 v4 + (by decide) (by decide)).mp hmem + simpa [v4, PATerm.eval, pzMem_eval, PAZFTerm.eval] using this + rw [← hw_mem, ← hw_eq] + exact hprov n (Nat.le_refl n) + · intro hinc + obtain ⟨L, hne, hvalid, hlast⟩ := exists_validZFDeriv hinc + have hpos : 0 < L.length := List.length_pos_of_ne_nil hne + let n := L.length - 1 + obtain ⟨c, d, hbeta⟩ := exists_beta_nat L + refine ⟨n, c, d, ?_⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + refine ⟨?_, ?_⟩ + · intro i hle + rw [paLe_holds_iff] at hle + have hi_le : i ≤ n := by simpa [v2, PATerm.eval] using hle + have hi_lt : i < L.length := by omega + refine ⟨L[i], ?_⟩ + set v4 := Function.update (Function.update v2 3 i) 4 L[i] + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holds_iff] + simpa [v4, v2, PATerm.eval] using hbeta i hi_lt + · rw [paIsZFStep_holds_iff] + simp only [v4, v2, Function.update_self, + Function.update_of_ne (by decide : (3 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 3), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 2), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 3)] + rcases hvalid i hi_lt with hax | ⟨j₁, j₂, hj₁, hj₂, hmp⟩ | ⟨x, j, hj, hgen⟩ + · exact Or.inl hax + · exact Or.inr (Or.inl ⟨L[j₁]'(lt_trans hj₁ hi_lt), L[j₂]'(lt_trans hj₂ hi_lt), + j₁, j₂, hj₁, hj₂, hbeta j₁ (lt_trans hj₁ hi_lt), + hbeta j₂ (lt_trans hj₂ hi_lt), hmp⟩) + · exact Or.inr (Or.inr ⟨x, L[j]'(lt_trans hj hi_lt), j, hj, + hbeta j (lt_trans hj hi_lt), hgen⟩) + · refine ⟨zfMem 0 0, ?_⟩ + set v4 := Function.update v2 4 (zfMem 0 0) + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holds_iff] + have hbn := hbeta n (by omega) + rw [hlast] at hbn + simpa [v4, v2, PATerm.eval] using hbn + · rw [PAZFTerm.eqFormula_holds_iff _ (.var 4) 10 v4 (by decide) (by decide)] + simp [v4, PATerm.eval, pzMem_eval, PAZFTerm.eval] + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/PA/Completeness.lean b/Cryptids/Semantics/PA/Completeness.lean new file mode 100644 index 00000000..9f2b9b3b --- /dev/null +++ b/Cryptids/Semantics/PA/Completeness.lean @@ -0,0 +1,1272 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Syntax +public import Mathlib.Data.Nat.Pairing + +/-! +# Gödel–Henkin Completeness of `PAProvable` + +This module proves Gödel's first-order completeness theorem specialized to Peano Arithmetic +(`PAProvable`): a `PAFormula` is provable in `PAProvable` if and only if it holds in every +first-order `PAModel` `M` (`Type`) under every variable assignment: + +- `paProvable_iff_holdsIn_all_models`: + `PAProvable φ ↔ ∀ (M : Type) [PAStructure M] [PAModel M] (v : ℕ → M), PAFormula.HoldsIn v φ` + +This bridge allows semantic proofs in an arbitrary first-order model `[PAModel M]` to be compiled +directly into formal Hilbert derivations `PAProvable φ`. +-/ + +@[expose] public section + +namespace ConjectureMachines + +/-- Smallest variable index strictly greater than every variable (free or bound) occurring in a +`PAFormula`. -/ +def PAFormula.maxVar : PAFormula → ℕ + | .bot => 0 + | .eq t₁ t₂ => max t₁.freshVar t₂.freshVar + | .and φ ψ | .or φ ψ | .imp φ ψ => max φ.maxVar ψ.maxVar + | .all x φ | .ex x φ => max (x + 1) φ.maxVar + +/-- Simultaneous variable-to-variable renaming on `PATerm`. -/ +def PATerm.vsubst (ρ : ℕ → ℕ) : PATerm → PATerm + | .var x => .var (ρ x) + | .zero => .zero + | .succ t => .succ (t.vsubst ρ) + | .add t₁ t₂ => .add (t₁.vsubst ρ) (t₂.vsubst ρ) + | .mul t₁ t₂ => .mul (t₁.vsubst ρ) (t₂.vsubst ρ) + +/-- Simultaneous variable-to-variable renaming on `PAFormula`, preserving bound variable names. -/ +def PAFormula.vsubst (ρ : ℕ → ℕ) : PAFormula → PAFormula + | .bot => .bot + | .eq t₁ t₂ => .eq (t₁.vsubst ρ) (t₂.vsubst ρ) + | .and φ ψ => .and (φ.vsubst ρ) (ψ.vsubst ρ) + | .or φ ψ => .or (φ.vsubst ρ) (ψ.vsubst ρ) + | .imp φ ψ => .imp (φ.vsubst ρ) (ψ.vsubst ρ) + | .all y φ => .all y (φ.vsubst (Function.update ρ y y)) + | .ex y φ => .ex y (φ.vsubst (Function.update ρ y y)) + +end ConjectureMachines + +namespace ConjectureMachines.Semantics.PA + +/-! ## Section 1: Variable Bounds and Simultaneous Variable Renaming -/ + +private theorem term_subst_eq_self_of_hasVar_false {t : PATerm} {x : ℕ} (s : PATerm) + (hx : t.hasVar x = false) : t.subst x s = t := by + induction t with + | var y => + simp only [PATerm.hasVar, beq_eq_false_iff_ne] at hx + simp [PATerm.subst, hx] + | zero => rfl + | succ _ ih => exact congrArg PATerm.succ (ih hx) + | add _ _ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at hx + exact congrArg₂ PATerm.add (ih₁ hx.1) (ih₂ hx.2) + | mul _ _ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at hx + exact congrArg₂ PATerm.mul (ih₁ hx.1) (ih₂ hx.2) + +private theorem lt_freshVar_of_hasVar {t : PATerm} {x : ℕ} (h : t.hasVar x = true) : + x < t.freshVar := by + by_contra hge + have hf := hasVar_false_of_freshVar_le (Nat.le_of_not_lt hge) + rw [hf] at h + cases h + +private theorem hasFree_false_of_maxVar_le {φ : PAFormula} {w : ℕ} (h : φ.maxVar ≤ w) : + φ.hasFree w = false := by + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] + exact ⟨hasVar_false_of_freshVar_le h.1, hasVar_false_of_freshVar_le h.2⟩ + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] + exact ⟨ih₁ h.1, ih₂ h.2⟩ + | all x _ ih | ex x _ ih => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp only [PAFormula.hasFree, Bool.and_eq_false_iff] + exact Or.inr (ih h.2) + +private theorem lt_maxVar_of_hasFree {φ : PAFormula} {x : ℕ} (h : φ.hasFree x = true) : + x < φ.maxVar := by + by_contra hge + have hf := hasFree_false_of_maxVar_le (Nat.le_of_not_lt hge) + rw [hf] at h + cases h + +private theorem freeFor_var_self (x : ℕ) (φ : PAFormula) : + φ.freeFor x (.var x) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.freeFor, ih₁, ih₂] + | all y _ ih | ex y _ ih => + simp only [PAFormula.freeFor, PATerm.hasVar] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, Ne.symm hxy, ih] + +private theorem term_subst_var_self (x : ℕ) (t : PATerm) : + t.subst x (.var x) = t := by + induction t with + | var y => + simp only [PATerm.subst] + by_cases hxy : y = x + · subst hxy; simp + · simp [hxy] + | zero => rfl + | succ _ ih => exact congrArg PATerm.succ ih + | add _ _ ih₁ ih₂ => exact congrArg₂ PATerm.add ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ PATerm.mul ih₁ ih₂ + +private theorem subst_var_self (x : ℕ) (φ : PAFormula) : + φ.subst x (.var x) = φ := by + induction φ with + | bot => rfl + | eq t₁ t₂ => exact congrArg₂ PAFormula.eq (term_subst_var_self x t₁) (term_subst_var_self x t₂) + | and _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.and ih₁ ih₂ + | or _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.or ih₁ ih₂ + | imp _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.imp ih₁ ih₂ + | all y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, ih] + | ex y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, ih] + +private theorem freeFor_var_of_maxVar_le (x : ℕ) {w : ℕ} {φ : PAFormula} (hw : φ.maxVar ≤ w) : + φ.freeFor x (.var w) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.freeFor, ih₁ hw.1, ih₂ hw.2] + | all y _ ih | ex y _ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hwy : w ≠ y := by omega + simp [PAFormula.freeFor, PATerm.hasVar, hwy, ih hw.2] + +private theorem freeFor_of_hasFree_false {w : ℕ} (s : PATerm) {φ : PAFormula} + (hw : φ.maxVar ≤ w) : φ.freeFor w s = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.freeFor, ih₁ hw.1, ih₂ hw.2] + | all y φ ih | ex y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.freeFor, hasFree_false_of_maxVar_le hw.2, ih hw.2] + +private theorem freeFor_inverse_var {x w : ℕ} {φ : PAFormula} (hw : φ.maxVar ≤ w) : + (φ.subst x (.var w)).freeFor w (.var x) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp [PAFormula.subst, PAFormula.freeFor, ih₁ hw.1, ih₂ hw.2] + | all y φ ih | ex y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy + simp only [beq_self_eq_true, ↓reduceIte] + exact freeFor_of_hasFree_false (.var y) (Nat.max_le.mpr hw) + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp [hb, PAFormula.freeFor, PATerm.hasVar, Ne.symm hxy, ih hw.2] + +private theorem term_subst_inverse_var {x w : ℕ} {t : PATerm} (hw : t.freshVar ≤ w) : + (t.subst x (.var w)).subst w (.var x) = t := by + induction t with + | var z => + simp only [PATerm.freshVar] at hw + simp only [PATerm.subst] + by_cases hzx : z = x + · subst hzx; simp [PATerm.subst] + · have hzw : z ≠ w := by omega + simp [hzx, PATerm.subst, hzw] + | zero => rfl + | succ _ ih => exact congrArg PATerm.succ (ih hw) + | add _ _ ih₁ ih₂ => + simp only [PATerm.freshVar, Nat.max_le] at hw + exact congrArg₂ PATerm.add (ih₁ hw.1) (ih₂ hw.2) + | mul _ _ ih₁ ih₂ => + simp only [PATerm.freshVar, Nat.max_le] at hw + exact congrArg₂ PATerm.mul (ih₁ hw.1) (ih₂ hw.2) + +private theorem subst_inverse_var {x w : ℕ} {φ : PAFormula} (hw : φ.maxVar ≤ w) : + (φ.subst x (.var w)).subst w (.var x) = φ := by + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.eq (term_subst_inverse_var hw.1) (term_subst_inverse_var hw.2) + | and _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.and (ih₁ hw.1) (ih₂ hw.2) + | or _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.or (ih₁ hw.1) (ih₂ hw.2) + | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at hw + exact congrArg₂ PAFormula.imp (ih₁ hw.1) (ih₂ hw.2) + | all y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hyw : y ≠ w := by omega + have hbw : (y == w) = false := beq_eq_false_iff_ne.mpr hyw + by_cases hxy : y = x + · subst hxy + simp [PAFormula.subst, hbw, + subst_eq_self_of_hasFree_false (.var y) (hasFree_false_of_maxVar_le hw.2)] + · have hbx : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp [PAFormula.subst, hbx, hbw, ih hw.2] + | ex y φ ih => + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hyw : y ≠ w := by omega + have hbw : (y == w) = false := beq_eq_false_iff_ne.mpr hyw + by_cases hxy : y = x + · subst hxy + simp [PAFormula.subst, hbw, + subst_eq_self_of_hasFree_false (.var y) (hasFree_false_of_maxVar_le hw.2)] + · have hbx : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp [PAFormula.subst, hbx, hbw, ih hw.2] + +private theorem hasVar_subst_var_self_false {t : PATerm} {x w : ℕ} (hwx : w ≠ x) : + (t.subst x (.var w)).hasVar x = false := by + induction t with + | var z => + simp only [PATerm.subst] + by_cases hzx : z = x + · subst hzx; simp [PATerm.hasVar, hwx] + · simp [hzx, PATerm.hasVar] + | zero => rfl + | succ _ ih => exact ih + | add _ _ ih₁ ih₂ | mul _ _ ih₁ ih₂ => + simp [PATerm.subst, PATerm.hasVar, ih₁, ih₂] + +private theorem hasFree_subst_var_self_false {φ : PAFormula} {x w : ℕ} (hwx : w ≠ x) : + (φ.subst x (.var w)).hasFree x = false := by + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp [PAFormula.subst, PAFormula.hasFree, hasVar_subst_var_self_false hwx] + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.subst, PAFormula.hasFree, ih₁, ih₂] + | all y _ ih | ex y _ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy; simp [PAFormula.hasFree] + · simp [hxy, PAFormula.hasFree, ih] + +private theorem update_id_self (y : ℕ) : Function.update (id : ℕ → ℕ) y y = id := by + funext x + by_cases h : x = y + · subst h; simp + · simp [h] + +private theorem term_vsubst_id (t : PATerm) : t.vsubst id = t := by + induction t with + | var _ | zero => rfl + | succ _ ih => exact congrArg PATerm.succ ih + | add _ _ ih₁ ih₂ => exact congrArg₂ PATerm.add ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ PATerm.mul ih₁ ih₂ + +private theorem vsubst_id (φ : PAFormula) : φ.vsubst id = φ := by + induction φ with + | bot => rfl + | eq t₁ t₂ => exact congrArg₂ PAFormula.eq (term_vsubst_id t₁) (term_vsubst_id t₂) + | and _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.and ih₁ ih₂ + | or _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.or ih₁ ih₂ + | imp _ _ ih₁ ih₂ => exact congrArg₂ PAFormula.imp ih₁ ih₂ + | all y _ ih => + simp only [PAFormula.vsubst, update_id_self] + exact congrArg (PAFormula.all y) ih + | ex y _ ih => + simp only [PAFormula.vsubst, update_id_self] + exact congrArg (PAFormula.ex y) ih + +private theorem term_vsubst_subst_var {t : PATerm} {ρ : ℕ → ℕ} {y w : ℕ} + (h : ∀ x, t.hasVar x = true → x ≠ y → ρ x ≠ y) : + (t.vsubst (Function.update ρ y y)).subst y (.var w) = t.vsubst (Function.update ρ y w) := by + induction t with + | var x => + simp only [PATerm.vsubst] + by_cases hxy : x = y + · subst hxy; simp [PATerm.subst] + · have hρ : ρ x ≠ y := h x (by simp [PATerm.hasVar]) hxy + simp [hxy, PATerm.subst, hρ] + | zero => rfl + | succ _ ih => + exact congrArg PATerm.succ (ih h) + | add t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PATerm.add (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + | mul t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PATerm.mul (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + +private theorem vsubst_subst_var {φ : PAFormula} {ρ : ℕ → ℕ} {y w : ℕ} + (h : ∀ x, φ.hasFree x = true → x ≠ y → ρ x ≠ y) : + (φ.vsubst (Function.update ρ y y)).subst y (.var w) = φ.vsubst (Function.update ρ y w) := by + induction φ generalizing ρ with + | bot => rfl + | eq t₁ t₂ => + refine congrArg₂ PAFormula.eq + (term_vsubst_subst_var fun x hx ↦ h x ?_) + (term_vsubst_subst_var fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | and _ _ ih₁ ih₂ => + refine congrArg₂ PAFormula.and (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | or _ _ ih₁ ih₂ => + refine congrArg₂ PAFormula.or (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | imp _ _ ih₁ ih₂ => + refine congrArg₂ PAFormula.imp (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all z χ ih => + simp only [PAFormula.vsubst] + by_cases hzy : z = y + · subst hzy + simp [PAFormula.subst, Function.update_idem] + · have hb : (z == y) = false := beq_eq_false_iff_ne.mpr hzy + simp only [PAFormula.subst, hb, Bool.false_eq_true, ↓reduceIte, + Function.update_comm (Ne.symm hzy)] + refine congrArg (PAFormula.all z) (ih fun x hx hxy ↦ ?_) + by_cases hxz : x = z + · subst hxz; simp [hzy] + · simp only [Function.update_of_ne hxz] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxz, hx]) hxy + | ex z χ ih => + simp only [PAFormula.vsubst] + by_cases hzy : z = y + · subst hzy + simp [PAFormula.subst, Function.update_idem] + · have hb : (z == y) = false := beq_eq_false_iff_ne.mpr hzy + simp only [PAFormula.subst, hb, Bool.false_eq_true, ↓reduceIte, + Function.update_comm (Ne.symm hzy)] + refine congrArg (PAFormula.ex z) (ih fun x hx hxy ↦ ?_) + by_cases hxz : x = z + · subst hxz; simp [hzy] + · simp only [Function.update_of_ne hxz] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxz, hx]) hxy + +private theorem vsubst_update_id_eq_subst (ψ : PAFormula) (x w : ℕ) : + ψ.vsubst (Function.update id x w) = ψ.subst x (.var w) := by + have heq := vsubst_subst_var (φ := ψ) (ρ := id) (y := x) (w := w) + (fun z _ hzx ↦ hzx) + rw [update_id_self, vsubst_id] at heq + exact heq.symm + +/-- Variable renaming `ρ` is capture-safe for `φ`: every free variable `x` of `φ` is either left +fixed (`ρ x = x`) or mapped to a variable ≥ `φ.maxVar` (disjoint from all variables of `φ`). -/ +private def SafeFor (ρ : ℕ → ℕ) (φ : PAFormula) : Prop := + ∀ x, φ.hasFree x = true → ρ x = x ∨ φ.maxVar ≤ ρ x + +private theorem safeFor_id (φ : PAFormula) : SafeFor id φ := + fun _ _ ↦ Or.inl rfl + +private theorem safeFor_mono {ρ : ℕ → ℕ} {φ ψ : PAFormula} (h : SafeFor ρ ψ) + (hmax : φ.maxVar ≤ ψ.maxVar) (hfree : ∀ x, φ.hasFree x = true → ψ.hasFree x = true) : + SafeFor ρ φ := by + intro x hx + rcases h x (hfree x hx) with heq | hge + · exact Or.inl heq + · exact Or.inr (le_trans hmax hge) + +private theorem safeFor_update_fresh {ρ : ℕ → ℕ} {y w : ℕ} {φ : PAFormula} + (h : ∀ x, φ.hasFree x = true → x ≠ y → ρ x = x ∨ φ.maxVar ≤ ρ x) + (hw : φ.maxVar ≤ w) : + SafeFor (Function.update ρ y w) φ := by + intro x hx + by_cases hxy : x = y + · subst hxy; simp [hw] + · simp only [Function.update_of_ne hxy] + exact h x hx hxy + +private theorem freshVar_le_vsubst {t : PATerm} {σ : ℕ → ℕ} + (h : ∀ x, t.hasVar x = true → x ≤ σ x) : + t.freshVar ≤ (t.vsubst σ).freshVar := by + induction t with + | var x => + simp only [PATerm.freshVar, PATerm.vsubst] + have hx := h x (by simp [PATerm.hasVar]) + omega + | zero => exact Nat.le_refl 0 + | succ _ ih => exact ih h + | add t₁ t₂ ih₁ ih₂ | mul t₁ t₂ ih₁ ih₂ => + refine max_le_max (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + +private theorem maxVar_le_vsubst_maxVar {φ : PAFormula} {σ : ℕ → ℕ} + (h : ∀ x, φ.hasFree x = true → x ≤ σ x) : + φ.maxVar ≤ (φ.vsubst σ).maxVar := by + induction φ generalizing σ with + | bot => exact Nat.le_refl 0 + | eq t₁ t₂ => + refine max_le_max + (freshVar_le_vsubst fun x hx ↦ h x ?_) + (freshVar_le_vsubst fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + refine max_le_max (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all z χ ih | ex z χ ih => + refine max_le_max (Nat.le_refl (z + 1)) (ih fun x hx ↦ ?_) + by_cases hxz : x = z + · subst hxz; simp + · simp only [Function.update_of_ne hxz] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxz, hx]) + +/-! ## Section 2: Finite-Context Derivability, Deduction Theorem, and FOL Lemmas -/ + +/-- Derivability from a finite hypothesis list `Δ` over `PAProvable` using only modus ponens +(with universal generalization restricted to theorems of `PAProvable`, ensuring the unconditional +deduction theorem). -/ +private inductive CtxProvable (Δ : List PAFormula) : PAFormula → Prop where + | ax {φ : PAFormula} : PAProvable φ → CtxProvable Δ φ + | hyp {φ : PAFormula} : φ ∈ Δ → CtxProvable Δ φ + | mp {φ ψ : PAFormula} : CtxProvable Δ φ → CtxProvable Δ (.imp φ ψ) → CtxProvable Δ ψ + +private theorem ctx_nil_iff {φ : PAFormula} : CtxProvable [] φ ↔ PAProvable φ := by + refine ⟨fun h ↦ ?_, CtxProvable.ax⟩ + induction h with + | ax hp => exact hp + | hyp hm => cases hm + | mp _ _ ih₁ ih₂ => exact .mp ih₁ ih₂ + +private theorem ctx_mono {Δ₁ Δ₂ : List PAFormula} (hsub : ∀ γ ∈ Δ₁, γ ∈ Δ₂) + {φ : PAFormula} (h : CtxProvable Δ₁ φ) : CtxProvable Δ₂ φ := by + induction h with + | ax hp => exact .ax hp + | hyp hm => exact .hyp (hsub _ hm) + | mp _ _ ih₁ ih₂ => exact .mp ih₁ ih₂ + +private theorem ctx_imp_refl (Δ : List PAFormula) (φ : PAFormula) : + CtxProvable Δ (.imp φ φ) := + .mp (.ax (.imp_k φ φ)) + (.mp (.ax (.imp_k φ (.imp φ φ))) (.ax (.imp_s φ (.imp φ φ) φ))) + +private theorem ctx_deduction {Δ : List PAFormula} {α β : PAFormula} + (h : CtxProvable (α :: Δ) β) : CtxProvable Δ (.imp α β) := by + induction h with + | ax hp => exact .mp (.ax hp) (.ax (.imp_k _ α)) + | hyp hm => + rcases List.mem_cons.mp hm with heq | hm' + · subst heq; exact ctx_imp_refl Δ _ + · exact .mp (.hyp hm') (.ax (.imp_k _ α)) + | mp _ _ ih₁ ih₂ => + exact .mp ih₁ (.mp ih₂ (.ax (.imp_s α _ _))) + +private theorem ctx_by_contra {Δ : List PAFormula} {φ : PAFormula} + (h : CtxProvable (φ.not :: Δ) .bot) : CtxProvable Δ φ := + .mp (ctx_deduction h) (.ax (.dne φ)) + +private theorem ctx_exfalso {Δ : List PAFormula} (φ : PAFormula) + (h : CtxProvable Δ .bot) : CtxProvable Δ φ := + ctx_by_contra (ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) h) + +private theorem ctx_gen (w : ℕ) {Δ : List PAFormula} {α : PAFormula} + (hf : ∀ γ ∈ Δ, γ.hasFree w = false) (h : CtxProvable Δ α) : + CtxProvable Δ (.all w α) := by + induction Δ generalizing α with + | nil => + exact .ax (.gen w (ctx_nil_iff.mp h)) + | cons δ Δ' ih => + have hded : CtxProvable Δ' (.imp δ α) := ctx_deduction h + have hall : CtxProvable Δ' (.all w (.imp δ α)) := + ih (fun γ hγ ↦ hf γ (List.mem_cons_of_mem _ hγ)) hded + have himp : CtxProvable Δ' (.imp (.all w δ) (.all w α)) := + .mp hall (.ax (.all_imp w δ α)) + have himp' : CtxProvable (δ :: Δ') (.imp (.all w δ) (.all w α)) := + ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) himp + have hvac : PAProvable (.imp δ (.all w δ)) := + .all_vacuous w δ (hf δ (List.mem_cons_self ..)) + exact .mp (.mp (.hyp (List.mem_cons_self ..)) (.ax hvac)) himp' + +private theorem pa_all_not_subst_imp_not_ex {x w : ℕ} {ψ : PAFormula} + (hw : (PAFormula.ex x ψ).maxVar ≤ w) : + PAProvable (.imp (.all w (.not (ψ.subst x (.var w)))) (.not (.ex x ψ))) := by + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hwx : w ≠ x := by omega + let γ : PAFormula := .all w (.not (ψ.subst x (.var w))) + have hγx : γ.hasFree x = false := by + simp [γ, PAFormula.hasFree, hasFree_subst_var_self_false hwx] + have hfree : (PAFormula.not (ψ.subst x (.var w))).freeFor w (.var x) = true := by + simp [PAFormula.freeFor, freeFor_inverse_var hw.2] + have hsub : (PAFormula.not (ψ.subst x (.var w))).subst w (.var x) = ψ.not := by + simp [PAFormula.subst, subst_inverse_var hw.2] + have helim : PAProvable (.imp γ ψ.not) := by + have h := PAProvable.all_elim w (.var x) (.not (ψ.subst x (.var w))) hfree + rwa [hsub] at h + have h1 : CtxProvable [γ] ψ.not := + .mp (.hyp (List.mem_singleton.mpr rfl)) (.ax helim) + have h2 : CtxProvable [γ] (.all x (.imp ψ .bot)) := + ctx_gen x (fun δ hδ ↦ by rw [List.mem_singleton.mp hδ]; exact hγx) h1 + have h3 : CtxProvable [γ] (.not (.ex x ψ)) := + .mp h2 (.ax (.ex_elim x ψ .bot rfl)) + exact ctx_nil_iff.mp (ctx_deduction h3) + +private theorem pa_de_morgan_all (y : ℕ) (ψ : PAFormula) : + PAProvable (.imp (.not (.all y ψ)) (.ex y (.not ψ))) := by + let γ₁ : PAFormula := (PAFormula.ex y ψ.not).not + let γ₂ : PAFormula := (PAFormula.all y ψ).not + have hfree : ψ.not.freeFor y (.var y) = true := freeFor_var_self y ψ.not + have hex : PAProvable (.imp ψ.not (.ex y ψ.not)) := by + have h := PAProvable.ex_intro y (.var y) ψ.not hfree + rwa [subst_var_self] at h + have hbot₁ : CtxProvable [ψ.not, γ₁, γ₂] .bot := by + have hn : CtxProvable [ψ.not, γ₁, γ₂] ψ.not := .hyp (by simp) + have hg₁ : CtxProvable [ψ.not, γ₁, γ₂] γ₁ := .hyp (by simp) + exact .mp (.mp hn (.ax hex)) hg₁ + have hψ : CtxProvable [γ₁, γ₂] ψ := ctx_by_contra hbot₁ + have hall : CtxProvable [γ₁, γ₂] (.all y ψ) := by + refine ctx_gen y (fun δ hδ ↦ ?_) hψ + rcases List.mem_cons.mp hδ with rfl | hδ' + · simp [γ₁, PAFormula.hasFree] + · rw [List.mem_singleton.mp hδ'] + simp [γ₂, PAFormula.hasFree] + have hbot₂ : CtxProvable [γ₁, γ₂] .bot := + .mp hall (.hyp (by simp [γ₂])) + exact ctx_nil_iff.mp (ctx_deduction (ctx_by_contra hbot₂)) + +private theorem pa_eq_symm (s t : PATerm) : + PAProvable (.imp (.eq s t) (.eq t s)) := by + let x := max s.freshVar t.freshVar + have hsx : s.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + let φ : PAFormula := .eq (.var x) s + have hsub_s : φ.subst x s = .eq s s := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false s hsx] + have hsub_t : φ.subst x t = .eq t s := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hsx] + have heq := PAProvable.eq_subst x s t φ rfl rfl + rw [hsub_s, hsub_t] at heq + have hctx : CtxProvable [.eq s t] (.eq t s) := + .mp (.ax (.eq_refl s)) (.mp (.hyp (List.mem_singleton.mpr rfl)) (.ax heq)) + exact ctx_nil_iff.mp (ctx_deduction hctx) + +private theorem pa_eq_trans (r s t : PATerm) : + PAProvable (.imp (.eq r s) (.imp (.eq s t) (.eq r t))) := by + let x := r.freshVar + have hrx : r.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_refl _) + let φ : PAFormula := .eq r (.var x) + have hsub_s : φ.subst x s = .eq r s := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false s hrx] + have hsub_t : φ.subst x t = .eq r t := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hrx] + have heq := PAProvable.eq_subst x s t φ rfl rfl + rw [hsub_s, hsub_t] at heq + have hctx : CtxProvable [.eq s t, .eq r s] (.eq r t) := + .mp (.hyp (by simp)) (.mp (.hyp (by simp)) (.ax heq)) + exact ctx_nil_iff.mp (ctx_deduction (ctx_deduction hctx)) + +private theorem pa_eq_succ (s t : PATerm) : + PAProvable (.imp (.eq s t) (.eq (.succ s) (.succ t))) := by + let x := s.freshVar + have hsx : s.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_refl _) + let φ : PAFormula := .eq (.succ s) (.succ (.var x)) + have hsub_s : φ.subst x s = .eq (.succ s) (.succ s) := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false s hsx] + have hsub_t : φ.subst x t = .eq (.succ s) (.succ t) := by + simp [φ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hsx] + have heq := PAProvable.eq_subst x s t φ rfl rfl + rw [hsub_s, hsub_t] at heq + have hctx : CtxProvable [.eq s t] (.eq (.succ s) (.succ t)) := + .mp (.ax (.eq_refl (.succ s))) (.mp (.hyp (List.mem_singleton.mpr rfl)) (.ax heq)) + exact ctx_nil_iff.mp (ctx_deduction hctx) + +private theorem pa_eq_add (s₁ t₁ s₂ t₂ : PATerm) : + PAProvable (.imp (.eq s₁ t₁) (.imp (.eq s₂ t₂) (.eq (.add s₁ s₂) (.add t₁ t₂)))) := by + let x := max s₁.freshVar s₂.freshVar + have hs₁x : s₁.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂x : s₂.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₁ : PAFormula := .eq (.add s₁ s₂) (.add (.var x) s₂) + have heq₁ := PAProvable.eq_subst x s₁ t₁ φ₁ rfl rfl + simp only [φ₁, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₁ hs₁x, term_subst_eq_self_of_hasVar_false t₁ hs₁x, + term_subst_eq_self_of_hasVar_false s₁ hs₂x, term_subst_eq_self_of_hasVar_false t₁ hs₂x] at heq₁ + let y := max t₁.freshVar s₂.freshVar + have ht₁y : t₁.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂y : s₂.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₂ : PAFormula := .eq (.add t₁ s₂) (.add t₁ (.var y)) + have heq₂ := PAProvable.eq_subst y s₂ t₂ φ₂ rfl rfl + simp only [φ₂, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₂ ht₁y, term_subst_eq_self_of_hasVar_false t₂ ht₁y, + term_subst_eq_self_of_hasVar_false s₂ hs₂y, term_subst_eq_self_of_hasVar_false t₂ hs₂y] at heq₂ + have hctx : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.add s₁ s₂) (.add t₁ t₂)) := by + have hA : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.add s₁ s₂) (.add t₁ s₂)) := + .mp (.ax (.eq_refl (.add s₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₁)) + have hB : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.add t₁ s₂) (.add t₁ t₂)) := + .mp (.ax (.eq_refl (.add t₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₂)) + exact .mp hB (.mp hA (.ax (pa_eq_trans (.add s₁ s₂) (.add t₁ s₂) (.add t₁ t₂)))) + exact ctx_nil_iff.mp (ctx_deduction (ctx_deduction hctx)) + +private theorem pa_eq_mul (s₁ t₁ s₂ t₂ : PATerm) : + PAProvable (.imp (.eq s₁ t₁) (.imp (.eq s₂ t₂) (.eq (.mul s₁ s₂) (.mul t₁ t₂)))) := by + let x := max s₁.freshVar s₂.freshVar + have hs₁x : s₁.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂x : s₂.hasVar x = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₁ : PAFormula := .eq (.mul s₁ s₂) (.mul (.var x) s₂) + have heq₁ := PAProvable.eq_subst x s₁ t₁ φ₁ rfl rfl + simp only [φ₁, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₁ hs₁x, term_subst_eq_self_of_hasVar_false t₁ hs₁x, + term_subst_eq_self_of_hasVar_false s₁ hs₂x, term_subst_eq_self_of_hasVar_false t₁ hs₂x] at heq₁ + let y := max t₁.freshVar s₂.freshVar + have ht₁y : t₁.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_left ..) + have hs₂y : s₂.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let φ₂ : PAFormula := .eq (.mul t₁ s₂) (.mul t₁ (.var y)) + have heq₂ := PAProvable.eq_subst y s₂ t₂ φ₂ rfl rfl + simp only [φ₂, PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, + term_subst_eq_self_of_hasVar_false s₂ ht₁y, term_subst_eq_self_of_hasVar_false t₂ ht₁y, + term_subst_eq_self_of_hasVar_false s₂ hs₂y, term_subst_eq_self_of_hasVar_false t₂ hs₂y] at heq₂ + have hctx : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.mul s₁ s₂) (.mul t₁ t₂)) := by + have hA : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.mul s₁ s₂) (.mul t₁ s₂)) := + .mp (.ax (.eq_refl (.mul s₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₁)) + have hB : CtxProvable [.eq s₂ t₂, .eq s₁ t₁] (.eq (.mul t₁ s₂) (.mul t₁ t₂)) := + .mp (.ax (.eq_refl (.mul t₁ s₂))) (.mp (.hyp (by simp)) (.ax heq₂)) + exact .mp hB (.mp hA (.ax (pa_eq_trans (.mul s₁ s₂) (.mul t₁ s₂) (.mul t₁ t₂)))) + exact ctx_nil_iff.mp (ctx_deduction (ctx_deduction hctx)) + +private theorem pa_exists_var_eq (B : ℕ) (t : PATerm) : + let y := max B t.freshVar + PAProvable (.ex y (.eq (.var y) t)) := by + intro y + have hty : t.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + let ψ : PAFormula := .eq (.var y) t + have hsub : ψ.subst y t = .eq t t := by + simp [ψ, PAFormula.subst, PATerm.subst, term_subst_eq_self_of_hasVar_false t hty] + have hex := PAProvable.ex_intro y t ψ rfl + rw [hsub] at hex + exact .mp (.eq_refl t) hex + +/-! ## Section 3: Countable Formula Enumeration and Henkin–Lindenbaum Saturation -/ + +private def encodeTerm : PATerm → ℕ + | .zero => 0 + | .var x => Nat.pair 0 x + 1 + | .succ t => Nat.pair 1 (encodeTerm t) + 1 + | .add t₁ t₂ => Nat.pair 2 (Nat.pair (encodeTerm t₁) (encodeTerm t₂)) + 1 + | .mul t₁ t₂ => Nat.pair 3 (Nat.pair (encodeTerm t₁) (encodeTerm t₂)) + 1 + +private def decodeTerm : ℕ → PATerm + | 0 => .zero + | n + 1 => + let p := Nat.unpair n + let q := Nat.unpair p.2 + match p.1 with + | 0 => .var p.2 + | 1 => .succ (decodeTerm p.2) + | 2 => .add (decodeTerm q.1) (decodeTerm q.2) + | 3 => .mul (decodeTerm q.1) (decodeTerm q.2) + | _ => .zero +termination_by k => k +decreasing_by + · exact Nat.lt_succ_of_le (Nat.unpair_right_le n) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_left_le _) (Nat.unpair_right_le n)) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_right_le _) (Nat.unpair_right_le n)) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_left_le _) (Nat.unpair_right_le n)) + · exact Nat.lt_succ_of_le (le_trans (Nat.unpair_right_le _) (Nat.unpair_right_le n)) + +private theorem decodeTerm_encodeTerm (t : PATerm) : decodeTerm (encodeTerm t) = t := by + induction t with + | zero => simp [encodeTerm, decodeTerm] + | var x => simp [encodeTerm, decodeTerm, Nat.unpair_pair] + | succ t ih => simp [encodeTerm, decodeTerm, Nat.unpair_pair, ih] + | add t₁ t₂ ih₁ ih₂ => simp [encodeTerm, decodeTerm, Nat.unpair_pair, ih₁, ih₂] + | mul t₁ t₂ ih₁ ih₂ => simp [encodeTerm, decodeTerm, Nat.unpair_pair, ih₁, ih₂] + +private def encodeForm : PAFormula → ℕ + | .bot => 0 + | .eq t₁ t₂ => Nat.pair 0 (Nat.pair (encodeTerm t₁) (encodeTerm t₂)) + 1 + | .and φ ψ => Nat.pair 1 (Nat.pair (encodeForm φ) (encodeForm ψ)) + 1 + | .or φ ψ => Nat.pair 2 (Nat.pair (encodeForm φ) (encodeForm ψ)) + 1 + | .imp φ ψ => Nat.pair 3 (Nat.pair (encodeForm φ) (encodeForm ψ)) + 1 + | .all x φ => Nat.pair 4 (Nat.pair x (encodeForm φ)) + 1 + | .ex x φ => Nat.pair 5 (Nat.pair x (encodeForm φ)) + 1 + +private def decodeForm : ℕ → PAFormula + | 0 => .bot + | n + 1 => + let p := Nat.unpair n + let q := Nat.unpair p.2 + match p.1 with + | 0 => .eq (decodeTerm q.1) (decodeTerm q.2) + | 1 => .and (decodeForm q.1) (decodeForm q.2) + | 2 => .or (decodeForm q.1) (decodeForm q.2) + | 3 => .imp (decodeForm q.1) (decodeForm q.2) + | 4 => .all q.1 (decodeForm q.2) + | 5 => .ex q.1 (decodeForm q.2) + | _ => .bot +termination_by k => k +decreasing_by + all_goals + first + | exact Nat.lt_succ_of_le (le_trans (Nat.unpair_left_le _) (Nat.unpair_right_le n)) + | exact Nat.lt_succ_of_le (le_trans (Nat.unpair_right_le _) (Nat.unpair_right_le n)) + +private theorem decodeForm_encodeForm (φ : PAFormula) : decodeForm (encodeForm φ) = φ := by + induction φ with + | bot => simp [encodeForm, decodeForm] + | eq t₁ t₂ => + simp [encodeForm, decodeForm, Nat.unpair_pair, decodeTerm_encodeTerm] + | and _ _ ih₁ ih₂ => simp [encodeForm, decodeForm, Nat.unpair_pair, ih₁, ih₂] + | or _ _ ih₁ ih₂ => simp [encodeForm, decodeForm, Nat.unpair_pair, ih₁, ih₂] + | imp _ _ ih₁ ih₂ => simp [encodeForm, decodeForm, Nat.unpair_pair, ih₁, ih₂] + | all _ _ ih => simp [encodeForm, decodeForm, Nat.unpair_pair, ih] + | ex _ _ ih => simp [encodeForm, decodeForm, Nat.unpair_pair, ih] + +private def maxVarList : List PAFormula → ℕ + | [] => 0 + | φ :: rest => max φ.maxVar (maxVarList rest) + +private theorem maxVar_le_maxVarList {Δ : List PAFormula} {φ : PAFormula} (h : φ ∈ Δ) : + φ.maxVar ≤ maxVarList Δ := by + induction Δ with + | nil => cases h + | cons δ rest ih => + rcases List.mem_cons.mp h with rfl | hm + · exact Nat.le_max_left .. + · exact le_trans (ih hm) (Nat.le_max_right ..) + +private theorem henkin_step_consistent {Δ : List PAFormula} (x : ℕ) (ψ : PAFormula) + (hcons : ¬ CtxProvable Δ .bot) : + let w := max (maxVarList Δ) (PAFormula.ex x ψ).maxVar + ¬ CtxProvable ((.imp (.ex x ψ) (ψ.subst x (.var w))) :: Δ) .bot := by + intro w hbot + apply hcons + let θ := PAFormula.imp (.ex x ψ) (ψ.subst x (.var w)) + have hθ_not : CtxProvable Δ θ.not := ctx_deduction hbot + have hex : CtxProvable Δ (.ex x ψ) := by + refine ctx_by_contra ?_ + have h1 : CtxProvable [.ex x ψ, (PAFormula.ex x ψ).not] (ψ.subst x (.var w)) := + ctx_exfalso _ (.mp (φ := PAFormula.ex x ψ) (.hyp (by simp)) (.hyp (by simp))) + have h2 : CtxProvable [(PAFormula.ex x ψ).not] θ := ctx_deduction h1 + have h3 : CtxProvable ((PAFormula.ex x ψ).not :: Δ) θ := + ctx_mono (fun _ hm ↦ by simp [List.mem_singleton.mp hm]) h2 + have h4 : CtxProvable ((PAFormula.ex x ψ).not :: Δ) θ.not := + ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) hθ_not + exact .mp h3 h4 + have hn_sub : CtxProvable Δ (ψ.subst x (.var w)).not := by + refine ctx_deduction ?_ + have h1 : CtxProvable (ψ.subst x (.var w) :: Δ) θ := + .mp (.hyp (List.mem_cons_self ..)) (.ax (.imp_k _ _)) + have h2 : CtxProvable (ψ.subst x (.var w) :: Δ) θ.not := + ctx_mono (fun _ hm ↦ List.mem_cons_of_mem _ hm) hθ_not + exact .mp h1 h2 + have hfresh : ∀ γ ∈ Δ, γ.hasFree w = false := fun γ hγ ↦ + hasFree_false_of_maxVar_le (le_trans (maxVar_le_maxVarList hγ) (Nat.le_max_left ..)) + have hall : CtxProvable Δ (.all w (ψ.subst x (.var w)).not) := ctx_gen w hfresh hn_sub + have hn_ex : CtxProvable Δ (PAFormula.ex x ψ).not := + .mp hall (.ax (pa_all_not_subst_imp_not_ex (Nat.le_max_right ..))) + exact .mp hex hn_ex + +/-- Add Henkin witness if `ψ` is existential. -/ +private def extendWithWitness (ψ : PAFormula) (Δ : List PAFormula) : List PAFormula := + match ψ with + | .ex x χ => + let w := max (maxVarList (ψ :: Δ)) (PAFormula.ex x χ).maxVar + (.imp (.ex x χ) (χ.subst x (.var w))) :: ψ :: Δ + | _ => ψ :: Δ + +/-- Single-pass Henkin–Lindenbaum chain starting from `[φ₀]`. -/ +private noncomputable def henkinChain (φ₀ : PAFormula) : ℕ → List PAFormula + | 0 => [φ₀] + | n + 1 => + let Δ := henkinChain φ₀ n + let ψ := decodeForm n + open Classical in + if CtxProvable (ψ :: Δ) .bot then + ψ.not :: Δ + else + extendWithWitness ψ Δ + +private theorem henkinChain_subset_succ (φ₀ : PAFormula) (n : ℕ) : + ∀ α ∈ henkinChain φ₀ n, α ∈ henkinChain φ₀ (n + 1) := by + intro α hα + simp only [henkinChain] + split_ifs + · exact List.mem_cons_of_mem _ hα + · unfold extendWithWitness + cases decodeForm n <;> simp [hα] + +private theorem henkinChain_mono (φ₀ : PAFormula) {m n : ℕ} (h : m ≤ n) : + ∀ α ∈ henkinChain φ₀ m, α ∈ henkinChain φ₀ n := by + induction h with + | refl => exact fun _ hα ↦ hα + | step _ ih => exact fun α hα ↦ henkinChain_subset_succ φ₀ _ α (ih α hα) + +private theorem henkinChain_consistent {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) : + ∀ n, ¬ CtxProvable (henkinChain φ₀ n) .bot := by + intro n + induction n with + | zero => exact h₀ + | succ n ih => + simp only [henkinChain] + split_ifs with hbot_ψ + · have hnψ : CtxProvable (henkinChain φ₀ n) (decodeForm n).not := ctx_deduction hbot_ψ + intro hbot + exact ih (.mp hnψ (ctx_deduction hbot)) + · unfold extendWithWitness + cases hdec : decodeForm n with + | ex x χ => + rw [hdec] at hbot_ψ + exact henkin_step_consistent x χ hbot_ψ + | _ => + rwa [hdec] at hbot_ψ + +/-- Maximal consistent Henkin-saturated theory extending `φ₀`. -/ +private def henkinTheory (φ₀ : PAFormula) : Set PAFormula := + { α | ∃ n, α ∈ henkinChain φ₀ n } + +private theorem henkinTheory_mem_zero (φ₀ : PAFormula) : + φ₀ ∈ henkinTheory φ₀ := + ⟨0, List.mem_singleton.mpr rfl⟩ + +private theorem henkinTheory_not_bot {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) : + PAFormula.bot ∉ henkinTheory φ₀ := by + rintro ⟨n, hn⟩ + exact henkinChain_consistent h₀ n (.hyp hn) + +private theorem henkinTheory_complete (φ₀ : PAFormula) (ψ : PAFormula) : + ψ ∈ henkinTheory φ₀ ∨ ψ.not ∈ henkinTheory φ₀ := by + let n := encodeForm ψ + have hdec : decodeForm n = ψ := decodeForm_encodeForm ψ + by_cases hbot : CtxProvable (ψ :: henkinChain φ₀ n) .bot + · refine Or.inr ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte] + exact List.mem_cons_self .. + · refine Or.inl ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte] + unfold extendWithWitness + cases ψ <;> simp + +private theorem henkinChain_fin_subset {φ₀ : PAFormula} (Γ : List PAFormula) + (hΓ : ∀ γ ∈ Γ, γ ∈ henkinTheory φ₀) : + ∃ N, ∀ γ ∈ Γ, γ ∈ henkinChain φ₀ N := by + induction Γ with + | nil => exact ⟨0, fun _ hm ↦ False.elim (List.not_mem_nil hm)⟩ + | cons δ rest ih => + obtain ⟨n₁, hn₁⟩ := hΓ δ (List.mem_cons_self ..) + obtain ⟨n₂, hn₂⟩ := ih fun γ hγ ↦ hΓ γ (List.mem_cons_of_mem _ hγ) + refine ⟨max n₁ n₂, fun γ hγ ↦ ?_⟩ + rcases List.mem_cons.mp hγ with heq | hm + · subst heq + exact henkinChain_mono φ₀ (Nat.le_max_left ..) _ hn₁ + · exact henkinChain_mono φ₀ (Nat.le_max_right ..) γ (hn₂ γ hm) + +private theorem henkinTheory_closed {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {Γ : List PAFormula} {α : PAFormula} (hprov : CtxProvable Γ α) + (hΓ : ∀ γ ∈ Γ, γ ∈ henkinTheory φ₀) : + α ∈ henkinTheory φ₀ := by + obtain ⟨N, hN⟩ := henkinChain_fin_subset Γ hΓ + have hctx : CtxProvable (henkinChain φ₀ N) α := ctx_mono hN hprov + rcases henkinTheory_complete φ₀ α with hα | hnα + · exact hα + · obtain ⟨M, hM⟩ := hnα + let K := max N M + have h₁ : CtxProvable (henkinChain φ₀ K) α := + ctx_mono (henkinChain_mono φ₀ (Nat.le_max_left ..)) hctx + have h₂ : α.not ∈ henkinChain φ₀ K := + henkinChain_mono φ₀ (Nat.le_max_right ..) _ hM + exact False.elim (henkinChain_consistent h₀ K (.mp h₁ (.hyp h₂))) + +private theorem henkinTheory_ax {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {α : PAFormula} (hp : PAProvable α) : α ∈ henkinTheory φ₀ := + henkinTheory_closed h₀ (Γ := []) (.ax hp) (fun _ hm ↦ False.elim (List.not_mem_nil hm)) + +private theorem henkinTheory_mp {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {α β : PAFormula} (hα : α ∈ henkinTheory φ₀) (himp : .imp α β ∈ henkinTheory φ₀) : + β ∈ henkinTheory φ₀ := + henkinTheory_closed h₀ (Γ := [α, .imp α β]) + (.mp (φ := α) (.hyp (by simp)) (.hyp (by simp))) (by + intro γ hγ + rcases List.mem_cons.mp hγ with heq | hγ' + · subst heq; exact hα + · rw [List.mem_singleton.mp hγ'] + exact himp) + +private theorem henkinTheory_witness {φ₀ : PAFormula} (h₀ : ¬ CtxProvable [φ₀] .bot) + {x : ℕ} {χ : PAFormula} (hex : .ex x χ ∈ henkinTheory φ₀) : + ∃ w : ℕ, (PAFormula.ex x χ).maxVar ≤ w ∧ χ.subst x (.var w) ∈ henkinTheory φ₀ := by + let n := encodeForm (.ex x χ) + have hdec : decodeForm n = .ex x χ := decodeForm_encodeForm (.ex x χ) + by_cases hbot : CtxProvable (PAFormula.ex x χ :: henkinChain φ₀ n) .bot + · have hn : (PAFormula.ex x χ).not ∈ henkinTheory φ₀ := by + refine ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte] + exact List.mem_cons_self .. + exact False.elim (henkinTheory_not_bot h₀ (henkinTheory_mp h₀ hex hn)) + · let w := max (maxVarList (PAFormula.ex x χ :: henkinChain φ₀ n)) (PAFormula.ex x χ).maxVar + have himp : PAFormula.imp (.ex x χ) (χ.subst x (.var w)) ∈ henkinTheory φ₀ := by + refine ⟨n + 1, ?_⟩ + simp only [henkinChain, hdec, hbot, ↓reduceIte, extendWithWitness] + exact List.mem_cons_self .. + exact ⟨w, Nat.le_max_right .., henkinTheory_mp h₀ hex himp⟩ + +/-! ## Section 4: Quotient Henkin Model, Truth Lemma, and Completeness -/ + +section HenkinModel + +variable {φ₀ : PAFormula} + +private def HenkinSetoid (h₀ : ¬ CtxProvable [φ₀] .bot) : Setoid PATerm where + r s t := PAFormula.eq s t ∈ henkinTheory φ₀ + iseqv := { + refl := fun t ↦ henkinTheory_ax h₀ (.eq_refl t) + symm := fun {s t} h ↦ henkinTheory_mp h₀ h (henkinTheory_ax h₀ (pa_eq_symm s t)) + trans := fun {r s t} h₁ h₂ ↦ + henkinTheory_mp h₀ h₂ (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (pa_eq_trans r s t))) + } + +private abbrev HenkinCarrier (h₀ : ¬ CtxProvable [φ₀] .bot) : Type := + Quotient (HenkinSetoid h₀) + +private instance instPAStructureHenkin (h₀ : ¬ CtxProvable [φ₀] .bot) : + PAStructure (HenkinCarrier h₀) where + zero := Quotient.mk (HenkinSetoid h₀) .zero + succ := Quotient.lift (fun t ↦ Quotient.mk (HenkinSetoid h₀) (.succ t)) + fun s t hst ↦ Quotient.sound (henkinTheory_mp h₀ hst (henkinTheory_ax h₀ (pa_eq_succ s t))) + add := Quotient.lift₂ (fun s t ↦ Quotient.mk (HenkinSetoid h₀) (.add s t)) + fun s₁ s₂ t₁ t₂ h₁ h₂ ↦ Quotient.sound + (henkinTheory_mp h₀ h₂ (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (pa_eq_add s₁ t₁ s₂ t₂)))) + mul := Quotient.lift₂ (fun s t ↦ Quotient.mk (HenkinSetoid h₀) (.mul s t)) + fun s₁ s₂ t₁ t₂ h₁ h₂ ↦ Quotient.sound + (henkinTheory_mp h₀ h₂ (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (pa_eq_mul s₁ t₁ s₂ t₂)))) + +private theorem evalIn_henkin_vsubst (h₀ : ¬ CtxProvable [φ₀] .bot) (ρ : ℕ → ℕ) (t : PATerm) : + PATerm.evalIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) t = + Quotient.mk (HenkinSetoid h₀) (t.vsubst ρ) := by + induction t with + | var _ | zero => rfl + | succ _ ih => + simp only [PATerm.evalIn, ih, PATerm.vsubst] + rfl + | add _ _ ih₁ ih₂ => + simp only [PATerm.evalIn, ih₁, ih₂, PATerm.vsubst] + rfl + | mul _ _ ih₁ ih₂ => + simp only [PATerm.evalIn, ih₁, ih₂, PATerm.vsubst] + rfl + +private theorem exists_var_rep (h₀ : ¬ CtxProvable [φ₀] .bot) (B : ℕ) (a : HenkinCarrier h₀) : + ∃ w : ℕ, B ≤ w ∧ Quotient.mk (HenkinSetoid h₀) (.var w) = a := by + obtain ⟨t, rfl⟩ := Quotient.exists_rep a + let y := max B t.freshVar + have hex : PAFormula.ex y (.eq (.var y) t) ∈ henkinTheory φ₀ := + henkinTheory_ax h₀ (pa_exists_var_eq B t) + obtain ⟨w, hw, hsub⟩ := henkinTheory_witness h₀ hex + have hty : t.hasVar y = false := hasVar_false_of_freshVar_le (Nat.le_max_right ..) + have ht_w : t.subst y (.var w) = t := term_subst_eq_self_of_hasVar_false (.var w) hty + simp only [PAFormula.subst, PATerm.subst, beq_self_eq_true, ↓reduceIte, ht_w] at hsub + have hBw : B ≤ w := by + simp only [PAFormula.maxVar, Nat.max_le] at hw + have : B ≤ y := Nat.le_max_left .. + omega + exact ⟨w, hBw, Quotient.sound hsub⟩ + +private theorem henkin_truth_vsubst (h₀ : ¬ CtxProvable [φ₀] .bot) (φ : PAFormula) : + ∀ {ρ : ℕ → ℕ}, SafeFor ρ φ → + (PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) φ ↔ + φ.vsubst ρ ∈ henkinTheory φ₀) := by + induction φ with + | bot => + intro ρ _ + exact ⟨False.elim, fun h ↦ henkinTheory_not_bot h₀ h⟩ + | eq t₁ t₂ => + intro ρ _ + simp only [PAFormula.HoldsIn, evalIn_henkin_vsubst, PAFormula.vsubst, Quotient.eq] + rfl + | and φ ψ ih₁ ih₂ => + intro ρ hsafe + have hs₁ : SafeFor ρ φ := + safeFor_mono hsafe (Nat.le_max_left ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + have hs₂ : SafeFor ρ ψ := + safeFor_mono hsafe (Nat.le_max_right ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, ih₁ hs₁, ih₂ hs₂, PAFormula.vsubst] + refine ⟨fun ⟨h₁, h₂⟩ ↦ henkinTheory_mp h₀ h₂ + (henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (.and_intro _ _))), fun h ↦ + ⟨henkinTheory_mp h₀ h (henkinTheory_ax h₀ (.and_left _ _)), + henkinTheory_mp h₀ h (henkinTheory_ax h₀ (.and_right _ _))⟩⟩ + | or φ ψ ih₁ ih₂ => + intro ρ hsafe + have hs₁ : SafeFor ρ φ := + safeFor_mono hsafe (Nat.le_max_left ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + have hs₂ : SafeFor ρ ψ := + safeFor_mono hsafe (Nat.le_max_right ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, ih₁ hs₁, ih₂ hs₂, PAFormula.vsubst] + refine ⟨fun h ↦ ?_, fun hor ↦ ?_⟩ + · rcases h with h₁ | h₂ + · exact henkinTheory_mp h₀ h₁ (henkinTheory_ax h₀ (.or_left _ _)) + · exact henkinTheory_mp h₀ h₂ (henkinTheory_ax h₀ (.or_right _ _)) + · rcases henkinTheory_complete φ₀ (φ.vsubst ρ) with h₁ | hn₁ + · exact Or.inl h₁ + · rcases henkinTheory_complete φ₀ (ψ.vsubst ρ) with h₂ | hn₂ + · exact Or.inr h₂ + · exfalso + have helim := henkinTheory_ax h₀ (.or_elim (φ.vsubst ρ) (ψ.vsubst ρ) .bot) + exact henkinTheory_not_bot h₀ + (henkinTheory_mp h₀ hor (henkinTheory_mp h₀ hn₂ (henkinTheory_mp h₀ hn₁ helim))) + | imp φ ψ ih₁ ih₂ => + intro ρ hsafe + have hs₁ : SafeFor ρ φ := + safeFor_mono hsafe (Nat.le_max_left ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + have hs₂ : SafeFor ρ ψ := + safeFor_mono hsafe (Nat.le_max_right ..) (fun x hx ↦ by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, ih₁ hs₁, ih₂ hs₂, PAFormula.vsubst] + refine ⟨fun h ↦ ?_, fun himp h₁ ↦ henkinTheory_mp h₀ h₁ himp⟩ + rcases henkinTheory_complete φ₀ (φ.vsubst ρ) with h₁ | hn₁ + · exact henkinTheory_mp h₀ (h h₁) (henkinTheory_ax h₀ (.imp_k _ _)) + · have hctx : CtxProvable [(φ.vsubst ρ).not] (.imp (φ.vsubst ρ) (ψ.vsubst ρ)) := + ctx_deduction (ctx_exfalso _ (.mp (φ := φ.vsubst ρ) (.hyp (by simp)) (.hyp (by simp)))) + exact henkinTheory_closed h₀ hctx (fun γ hγ ↦ by rw [List.mem_singleton.mp hγ]; exact hn₁) + | all y φ ih => + intro ρ hsafe + let ψ' := φ.vsubst (Function.update ρ y y) + have hno_cap : ∀ x, φ.hasFree x = true → x ≠ y → ρ x ≠ y := by + intro x hx hxy + have hall_free : (PAFormula.all y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hall_free with heq | hge + · rw [heq]; exact hxy + · simp only [PAFormula.maxVar, Nat.max_le] at hge + omega + have hsafe_base : ∀ x, φ.hasFree x = true → x ≠ y → ρ x = x ∨ φ.maxVar ≤ ρ x := by + intro x hx hxy + have hall_free : (PAFormula.all y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hall_free with heq | hge + · exact Or.inl heq + · simp only [PAFormula.maxVar, Nat.max_le] at hge + exact Or.inr hge.2 + have hmax_le : φ.maxVar ≤ ψ'.maxVar := by + refine maxVar_le_vsubst_maxVar fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + rcases hsafe_base x hx hxy with heq | hge + · omega + · exact le_trans (Nat.le_of_lt (lt_maxVar_of_hasFree hx)) hge + simp only [PAFormula.HoldsIn, PAFormula.vsubst] + refine ⟨fun hsem ↦ ?_, fun hall a ↦ ?_⟩ + · rcases henkinTheory_complete φ₀ (.all y ψ') with hmem | hnmem + · exact hmem + · exfalso + have hex : PAFormula.ex y ψ'.not ∈ henkinTheory φ₀ := + henkinTheory_mp h₀ hnmem (henkinTheory_ax h₀ (pa_de_morgan_all y ψ')) + obtain ⟨w, hw, hsub⟩ := henkinTheory_witness h₀ hex + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hw_φ : φ.maxVar ≤ w := le_trans hmax_le hw.2.1 + have hsub_eq : ψ'.subst y (.var w) = φ.vsubst (Function.update ρ y w) := + vsubst_subst_var hno_cap + simp only [PAFormula.subst, hsub_eq] at hsub + have hval := hsem (Quotient.mk (HenkinSetoid h₀) (.var w)) + have hfun : Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y + (Quotient.mk (HenkinSetoid h₀) (.var w)) = + fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x)) := by + funext x + by_cases hxy : x = y + · subst hxy; simp + · simp [hxy] + rw [hfun, ih (safeFor_update_fresh hsafe_base hw_φ)] at hval + exact henkinTheory_not_bot h₀ (henkinTheory_mp h₀ hval hsub) + · obtain ⟨w, hw, hrep⟩ := exists_var_rep h₀ (max φ.maxVar ψ'.maxVar) a + have hw_φ : φ.maxVar ≤ w := le_trans (Nat.le_max_left ..) hw + have hw_ψ' : ψ'.maxVar ≤ w := le_trans (Nat.le_max_right ..) hw + have helim := henkinTheory_ax h₀ (.all_elim y (.var w) ψ' (freeFor_var_of_maxVar_le y hw_ψ')) + have hinst : ψ'.subst y (.var w) ∈ henkinTheory φ₀ := henkinTheory_mp h₀ hall helim + rw [vsubst_subst_var hno_cap] at hinst + have hhold := (ih (safeFor_update_fresh hsafe_base hw_φ)).mpr hinst + have hfun : (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x))) = + Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y a := by + funext x + by_cases hxy : x = y + · subst hxy; simp [hrep] + · simp [hxy] + rwa [hfun] at hhold + | ex y φ ih => + intro ρ hsafe + let ψ' := φ.vsubst (Function.update ρ y y) + have hno_cap : ∀ x, φ.hasFree x = true → x ≠ y → ρ x ≠ y := by + intro x hx hxy + have hex_free : (PAFormula.ex y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hex_free with heq | hge + · rw [heq]; exact hxy + · simp only [PAFormula.maxVar, Nat.max_le] at hge + omega + have hsafe_base : ∀ x, φ.hasFree x = true → x ≠ y → ρ x = x ∨ φ.maxVar ≤ ρ x := by + intro x hx hxy + have hex_free : (PAFormula.ex y φ).hasFree x = true := by + simp [PAFormula.hasFree, Ne.symm hxy, hx] + rcases hsafe x hex_free with heq | hge + · exact Or.inl heq + · simp only [PAFormula.maxVar, Nat.max_le] at hge + exact Or.inr hge.2 + have hmax_le : φ.maxVar ≤ ψ'.maxVar := by + refine maxVar_le_vsubst_maxVar fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + rcases hsafe_base x hx hxy with heq | hge + · omega + · exact le_trans (Nat.le_of_lt (lt_maxVar_of_hasFree hx)) hge + simp only [PAFormula.HoldsIn, PAFormula.vsubst] + refine ⟨?_, fun hex ↦ ?_⟩ + · rintro ⟨a, ha⟩ + obtain ⟨w, hw, hrep⟩ := exists_var_rep h₀ (max φ.maxVar ψ'.maxVar) a + have hw_φ : φ.maxVar ≤ w := le_trans (Nat.le_max_left ..) hw + have hw_ψ' : ψ'.maxVar ≤ w := le_trans (Nat.le_max_right ..) hw + have hfun : Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y a = + fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x)) := by + funext x + by_cases hxy : x = y + · subst hxy; simp [hrep] + · simp [hxy] + rw [hfun, ih (safeFor_update_fresh hsafe_base hw_φ)] at ha + rw [← vsubst_subst_var hno_cap] at ha + have hintro := henkinTheory_ax h₀ (.ex_intro y (.var w) ψ' (freeFor_var_of_maxVar_le y hw_ψ')) + exact henkinTheory_mp h₀ ha hintro + · obtain ⟨w, hw, hsub⟩ := henkinTheory_witness h₀ hex + simp only [PAFormula.maxVar, Nat.max_le] at hw + have hw_φ : φ.maxVar ≤ w := le_trans hmax_le hw.2 + rw [vsubst_subst_var hno_cap] at hsub + have hhold := (ih (safeFor_update_fresh hsafe_base hw_φ)).mpr hsub + refine ⟨Quotient.mk (HenkinSetoid h₀) (.var w), ?_⟩ + have hfun : (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ y w x))) = + Function.update (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var (ρ x))) y + (Quotient.mk (HenkinSetoid h₀) (.var w)) := by + funext x + by_cases hxy : x = y + · subst hxy; simp + · simp [hxy] + rwa [hfun] at hhold + +private theorem henkin_truth_id (h₀ : ¬ CtxProvable [φ₀] .bot) (φ : PAFormula) : + PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var x)) φ ↔ + φ ∈ henkinTheory φ₀ := by + have h := henkin_truth_vsubst h₀ φ (safeFor_id φ) + rwa [vsubst_id] at h + +private theorem henkin_holds_of_provable (h₀ : ¬ CtxProvable [φ₀] .bot) {φ : PAFormula} + (hp : PAProvable φ) : + PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid h₀) (.var x)) φ := + (henkin_truth_id h₀ φ).mpr (henkinTheory_ax h₀ hp) + +private instance instPAModelHenkin (h₀ : ¬ CtxProvable [φ₀] .bot) : + PAModel (HenkinCarrier h₀) where + zero_ne_succ a := by + have h := henkin_holds_of_provable h₀ (.gen 0 .pa_zero_ne_succ) + exact h a + succ_inj {a b} hab := by + have h := henkin_holds_of_provable h₀ (.gen 0 (.gen 1 .pa_succ_inj)) + have h1 := h a b + have h01 : (0 : ℕ) ≠ 1 := by decide + simp only [PAFormula.HoldsIn, PATerm.evalIn, Function.update_self, + Function.update_of_ne h01] at h1 + exact h1 hab + add_zero a := by + have h := henkin_holds_of_provable h₀ (.gen 0 .pa_add_zero) + exact h a + add_succ a b := by + have h := henkin_holds_of_provable h₀ (.gen 0 (.gen 1 .pa_add_succ)) + have h1 := h a b + have h01 : (0 : ℕ) ≠ 1 := by decide + simp only [PAFormula.HoldsIn, PATerm.evalIn, Function.update_self, + Function.update_of_ne h01] at h1 + exact h1 + mul_zero a := by + have h := henkin_holds_of_provable h₀ (.gen 0 .pa_mul_zero) + exact h a + mul_succ a b := by + have h := henkin_holds_of_provable h₀ (.gen 0 (.gen 1 .pa_mul_succ)) + have h1 := h a b + have h01 : (0 : ℕ) ≠ 1 := by decide + simp only [PAFormula.HoldsIn, PATerm.evalIn, Function.update_self, + Function.update_of_ne h01] at h1 + exact h1 + ind x φ v hbase hstep a := by + have hex_ρ : ∀ z : ℕ, ∃ w : ℕ, max φ.maxVar (x + 1) ≤ w ∧ + Quotient.mk (HenkinSetoid h₀) (.var w) = v z := + fun z ↦ exists_var_rep h₀ (max φ.maxVar (x + 1)) (v z) + choose ρ hρ_ge hρ_eq using hex_ρ + let ψ := φ.vsubst (Function.update ρ x x) + let v₀ : ℕ → HenkinCarrier h₀ := fun z ↦ Quotient.mk (HenkinSetoid h₀) (.var z) + have hiff : ∀ b : HenkinCarrier h₀, + PAFormula.HoldsIn (Function.update v x b) φ ↔ + PAFormula.HoldsIn (Function.update v₀ x b) ψ := by + intro b + obtain ⟨w, hw, hrep⟩ := exists_var_rep h₀ (max φ.maxVar ψ.maxVar) b + have hw_φ : φ.maxVar ≤ w := le_trans (Nat.le_max_left ..) hw + have hw_ψ : ψ.maxVar ≤ w := le_trans (Nat.le_max_right ..) hw + have hv_eq : Function.update v x b = + fun z ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update ρ x w z)) := by + funext z + by_cases hzx : z = x + · subst hzx; simp [hrep] + · simp [hzx, hρ_eq z] + have hv₀_eq : Function.update v₀ x b = + fun z ↦ Quotient.mk (HenkinSetoid h₀) (.var (Function.update id x w z)) := by + funext z + by_cases hzx : z = x + · subst hzx; simp [hrep] + · simp [hzx, v₀] + have hsafe_φ : SafeFor (Function.update ρ x w) φ := + safeFor_update_fresh (fun z _ _ ↦ Or.inr (le_trans (Nat.le_max_left ..) (hρ_ge z))) hw_φ + have hsafe_ψ : SafeFor (Function.update id x w) ψ := + safeFor_update_fresh (fun _ _ _ ↦ Or.inl rfl) hw_ψ + have hno_cap : ∀ z, φ.hasFree z = true → z ≠ x → ρ z ≠ x := by + intro z _ _ + have hge := hρ_ge z + simp only [Nat.max_le] at hge + omega + have heq_form : ψ.vsubst (Function.update id x w) = φ.vsubst (Function.update ρ x w) := by + rw [vsubst_update_id_eq_subst, vsubst_subst_var hno_cap] + rw [hv_eq, hv₀_eq, henkin_truth_vsubst h₀ φ hsafe_φ, henkin_truth_vsubst h₀ ψ hsafe_ψ, + heq_form] + have hind := henkin_holds_of_provable h₀ (.pa_ind x ψ) + simp only [PAFormula.HoldsIn] at hind + have hbase_ψ : PAFormula.HoldsIn v₀ (ψ.subst x .zero) := by + rw [holdsIn_subst v₀ (freeFor_zero x ψ)] + exact (hiff PAStructure.zero).mp hbase + have hstep_ψ : ∀ b : HenkinCarrier h₀, + PAFormula.HoldsIn (Function.update v₀ x b) ψ → + PAFormula.HoldsIn (Function.update v₀ x b) (ψ.subst x (.succ (.var x))) := by + intro b hb + rw [holdsIn_subst (Function.update v₀ x b) (freeFor_succ_self x ψ)] + simp only [PATerm.evalIn, Function.update_self, Function.update_idem] + exact (hiff (PAStructure.succ b)).mp (hstep b ((hiff b).mpr hb)) + exact (hiff a).mpr (hind hbase_ψ hstep_ψ a) + +end HenkinModel + +/-- Gödel–Henkin soundness and completeness for first-order Peano Arithmetic (`PAProvable`): +a `PAFormula` is provable in `PAProvable` if and only if it holds in every first-order `PAModel` +`M` (`Type`) under every variable assignment. -/ +theorem paProvable_iff_holdsIn_all_models (φ : PAFormula) : + PAProvable φ ↔ + ∀ (M : Type) [PAStructure M] [PAModel M] (v : ℕ → M), PAFormula.HoldsIn v φ := by + refine ⟨fun h M _ _ v ↦ paProvable_sound h v, fun hall ↦ ?_⟩ + by_contra hnp + have hcons : ¬ CtxProvable [φ.not] .bot := by + intro hbot + exact hnp (ctx_nil_iff.mp (ctx_by_contra hbot)) + have hn_mem : φ.not ∈ henkinTheory φ.not := henkinTheory_mem_zero φ.not + have hn_sem : PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid hcons) (.var x)) φ.not := + (henkin_truth_id hcons φ.not).mpr hn_mem + have hp_sem : PAFormula.HoldsIn (fun x ↦ Quotient.mk (HenkinSetoid hcons) (.var x)) φ := + hall (HenkinCarrier hcons) (fun x ↦ Quotient.mk (HenkinSetoid hcons) (.var x)) + exact hn_sem hp_sem + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/PA/Syntax.lean b/Cryptids/Semantics/PA/Syntax.lean new file mode 100644 index 00000000..41090600 --- /dev/null +++ b/Cryptids/Semantics/PA/Syntax.lean @@ -0,0 +1,620 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Propositions + +/-! +# Syntax, Substitution, Model Semantics, and Consistency of `PAProvable` + +This module develops the foundational metatheory of the deeply embedded Peano Arithmetic system +`PAProvable` (`Cryptids.Propositions`): + +1. **General $\mathcal{L}_{\mathrm{PA}}$-structures and models (`PAStructure`, `PAModel`)**: + Evaluates `PATerm` and `PAFormula` in an arbitrary $\mathcal{L}_{\mathrm{PA}}$-structure `M` + (`evalIn`, `HoldsIn`), proves variable-agreement and capture-avoiding substitution lemmas + (`evalIn_subst`, `holdsIn_subst`), and establishes classical soundness of `PAProvable` across + all models `M` of $\mathrm{PA}$ (`paProvable_sound`, `paProvable_sound_nat`). +2. **Constructive consistency (`NHolds`, `not_paProvable_false`)**: + Interprets `PAFormula` in `ℕ` via the Gödel–Gentzen negative translation `NHolds`, proving + `¬ PAProvable .bot` constructively without `Classical.choice`. +-/ + +@[expose] public section + +namespace ConjectureMachines.Semantics.PA + +/-! ## Section 1: $\mathcal{L}_{\mathrm{PA}}$-Structures and Models -/ + +/-- Interpretation of the signature $\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$ on a carrier +type `M`. -/ +class PAStructure (M : Type*) where + /-- Interpretation of `0`. -/ + zero : M + /-- Interpretation of successor $S$. -/ + succ : M → M + /-- Interpretation of addition $+$. -/ + add : M → M → M + /-- Interpretation of multiplication $\times$. -/ + mul : M → M → M + +/-- Standard $\mathcal{L}_{\mathrm{PA}}$-structure on `ℕ`. -/ +instance instPAStructureNat : PAStructure ℕ where + zero := 0 + succ n := n + 1 + add := (· + ·) + mul := (· * ·) + +/-- Evaluate a `PATerm` in an $\mathcal{L}_{\mathrm{PA}}$-structure `M` under assignment `v`. -/ +def PATerm.evalIn {M : Type*} [PAStructure M] (v : ℕ → M) : PATerm → M + | .var x => v x + | .zero => PAStructure.zero + | .succ t => PAStructure.succ (PATerm.evalIn v t) + | .add t₁ t₂ => PAStructure.add (PATerm.evalIn v t₁) (PATerm.evalIn v t₂) + | .mul t₁ t₂ => PAStructure.mul (PATerm.evalIn v t₁) (PATerm.evalIn v t₂) + +/-- Tarski satisfaction of a `PAFormula` in an $\mathcal{L}_{\mathrm{PA}}$-structure `M` under +assignment `v`. -/ +def PAFormula.HoldsIn {M : Type*} [PAStructure M] (v : ℕ → M) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => PATerm.evalIn v t₁ = PATerm.evalIn v t₂ + | .and φ ψ => PAFormula.HoldsIn v φ ∧ PAFormula.HoldsIn v ψ + | .or φ ψ => PAFormula.HoldsIn v φ ∨ PAFormula.HoldsIn v ψ + | .imp φ ψ => PAFormula.HoldsIn v φ → PAFormula.HoldsIn v ψ + | .all x φ => ∀ a : M, PAFormula.HoldsIn (Function.update v x a) φ + | .ex x φ => ∃ a : M, PAFormula.HoldsIn (Function.update v x a) φ + +/-- A first-order model of Peano Arithmetic (`PA`): an $\mathcal{L}_{\mathrm{PA}}$-structure +satisfying the six Robinson `Q` axioms together with the first-order induction schema for every +`PAFormula`. -/ +class PAModel (M : Type*) [PAStructure M] : Prop where + zero_ne_succ : ∀ a : M, PAStructure.succ a ≠ PAStructure.zero + succ_inj : ∀ {a b : M}, PAStructure.succ a = PAStructure.succ b → a = b + add_zero : ∀ a : M, PAStructure.add a PAStructure.zero = a + add_succ : ∀ a b : M, PAStructure.add a (PAStructure.succ b) = + PAStructure.succ (PAStructure.add a b) + mul_zero : ∀ a : M, PAStructure.mul a PAStructure.zero = PAStructure.zero + mul_succ : ∀ a b : M, PAStructure.mul a (PAStructure.succ b) = + PAStructure.add (PAStructure.mul a b) a + ind : ∀ (x : ℕ) (φ : PAFormula) (v : ℕ → M), + PAFormula.HoldsIn (Function.update v x PAStructure.zero) φ → + (∀ a : M, PAFormula.HoldsIn (Function.update v x a) φ → + PAFormula.HoldsIn (Function.update v x (PAStructure.succ a)) φ) → + ∀ a : M, PAFormula.HoldsIn (Function.update v x a) φ + +/-- The standard natural numbers `ℕ` form a `PAModel`. -/ +instance instPAModelNat : PAModel ℕ where + zero_ne_succ n := Nat.succ_ne_zero n + succ_inj h := Nat.succ.inj h + add_zero := Nat.add_zero + add_succ := Nat.add_succ + mul_zero := Nat.mul_zero + mul_succ := Nat.mul_succ + ind x φ v h0 hs a := by + induction a with + | zero => exact h0 + | succ a ih => exact hs a ih + +theorem evalIn_nat_eq (v : ℕ → ℕ) (t : PATerm) : PATerm.evalIn v t = t.eval v := by + induction t with + | var _ | zero => rfl + | succ _ ih => exact congrArg (· + 1) ih + | add _ _ ih₁ ih₂ => exact congrArg₂ (· + ·) ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ (· * ·) ih₁ ih₂ + +theorem holdsIn_nat_iff (v : ℕ → ℕ) (φ : PAFormula) : PAFormula.HoldsIn v φ ↔ φ.Holds v := by + induction φ generalizing v with + | bot => exact Iff.rfl + | eq t₁ t₂ => simp only [PAFormula.HoldsIn, PAFormula.Holds, evalIn_nat_eq] + | and _ _ ih₁ ih₂ => exact and_congr (ih₁ v) (ih₂ v) + | or _ _ ih₁ ih₂ => exact or_congr (ih₁ v) (ih₂ v) + | imp _ _ ih₁ ih₂ => exact imp_congr (ih₁ v) (ih₂ v) + | all x _ ih => exact forall_congr' fun a ↦ ih (Function.update v x a) + | ex x _ ih => exact exists_congr fun a ↦ ih (Function.update v x a) + +/-! ## Section 2: Freshness, Variable Agreement, and Substitution Lemmas -/ + +theorem hasVar_false_of_freshVar_le {t : PATerm} {x : ℕ} (h : t.freshVar ≤ x) : + t.hasVar x = false := by + induction t with + | var y => + simp only [PATerm.freshVar] at h + simp only [PATerm.hasVar, beq_eq_false_iff_ne] + omega + | zero => rfl + | succ t ih => exact ih h + | add t₁ t₂ ih₁ ih₂ | mul t₁ t₂ ih₁ ih₂ => + simp only [PATerm.freshVar, Nat.max_le] at h + simp only [PATerm.hasVar, Bool.or_eq_false_iff] + exact ⟨ih₁ h.1, ih₂ h.2⟩ + +theorem evalIn_congr {M : Type*} [PAStructure M] {v₁ v₂ : ℕ → M} {t : PATerm} + (h : ∀ x, t.hasVar x = true → v₁ x = v₂ x) : + PATerm.evalIn v₁ t = PATerm.evalIn v₂ t := by + induction t with + | var x => exact h x (by simp [PATerm.hasVar]) + | zero => rfl + | succ t ih => exact congrArg PAStructure.succ (ih h) + | add t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PAStructure.add (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + | mul t₁ t₂ ih₁ ih₂ => + refine congrArg₂ PAStructure.mul (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PATerm.hasVar, hx] + +theorem evalIn_update_of_hasVar_false {M : Type*} [PAStructure M] (v : ℕ → M) + {x : ℕ} (a : M) {t : PATerm} (hx : t.hasVar x = false) : + PATerm.evalIn (Function.update v x a) t = PATerm.evalIn v t := by + refine evalIn_congr fun y hy ↦ ?_ + have hne : y ≠ x := fun h ↦ by subst h; rw [hx] at hy; cases hy + exact Function.update_of_ne hne a v + +theorem holdsIn_congr {M : Type*} [PAStructure M] {v₁ v₂ : ℕ → M} {φ : PAFormula} + (h : ∀ x, φ.hasFree x = true → v₁ x = v₂ x) : + PAFormula.HoldsIn v₁ φ ↔ PAFormula.HoldsIn v₂ φ := by + induction φ generalizing v₁ v₂ with + | bot => exact Iff.rfl + | eq t₁ t₂ => + have e₁ : PATerm.evalIn v₁ t₁ = PATerm.evalIn v₂ t₁ := + evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + have e₂ : PATerm.evalIn v₁ t₂ = PATerm.evalIn v₂ t₂ := + evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.HoldsIn, e₁, e₂] + | and φ ψ ih₁ ih₂ => + refine and_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | or φ ψ ih₁ ih₂ => + refine or_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | imp φ ψ ih₁ ih₂ => + refine imp_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all y φ ih => + refine forall_congr' fun a ↦ ih fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + | ex y φ ih => + refine exists_congr fun a ↦ ih fun x hx ↦ ?_ + by_cases hxy : x = y + · subst hxy; simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + +theorem holdsIn_update_of_hasFree_false {M : Type*} [PAStructure M] (v : ℕ → M) + {x : ℕ} (a : M) {φ : PAFormula} (hx : φ.hasFree x = false) : + PAFormula.HoldsIn (Function.update v x a) φ ↔ PAFormula.HoldsIn v φ := by + refine holdsIn_congr fun y hy ↦ ?_ + have hne : y ≠ x := fun h ↦ by subst h; rw [hx] at hy; cases hy + exact Function.update_of_ne hne a v + +theorem evalIn_subst {M : Type*} [PAStructure M] (v : ℕ → M) (x : ℕ) (s t : PATerm) : + PATerm.evalIn v (t.subst x s) = PATerm.evalIn (Function.update v x (PATerm.evalIn v s)) t := by + induction t with + | var y => + simp only [PATerm.subst] + by_cases hxy : y = x + · subst hxy; simp [PATerm.evalIn] + · simp [hxy, PATerm.evalIn] + | zero => rfl + | succ t ih => exact congrArg PAStructure.succ ih + | add t₁ t₂ ih₁ ih₂ => exact congrArg₂ PAStructure.add ih₁ ih₂ + | mul t₁ t₂ ih₁ ih₂ => exact congrArg₂ PAStructure.mul ih₁ ih₂ + +theorem subst_eq_self_of_hasFree_false {φ : PAFormula} {x : ℕ} (s : PATerm) + (hx : φ.hasFree x = false) : φ.subst x s = φ := by + have term_eq : ∀ {t : PATerm}, t.hasVar x = false → t.subst x s = t := by + intro t ht + induction t with + | var y => + simp only [PATerm.hasVar, beq_eq_false_iff_ne] at ht + simp [PATerm.subst, ht] + | zero => rfl + | succ t ih => exact congrArg PATerm.succ (ih ht) + | add t₁ t₂ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at ht + exact congrArg₂ PATerm.add (ih₁ ht.1) (ih₂ ht.2) + | mul t₁ t₂ ih₁ ih₂ => + simp only [PATerm.hasVar, Bool.or_eq_false_iff] at ht + exact congrArg₂ PATerm.mul (ih₁ ht.1) (ih₂ ht.2) + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.eq (term_eq hx.1) (term_eq hx.2) + | and φ ψ ih₁ ih₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.and (ih₁ hx.1) (ih₂ hx.2) + | or φ ψ ih₁ ih₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.or (ih₁ hx.1) (ih₂ hx.2) + | imp φ ψ ih₁ ih₂ => + simp only [PAFormula.hasFree, Bool.or_eq_false_iff] at hx + exact congrArg₂ PAFormula.imp (ih₁ hx.1) (ih₂ hx.2) + | all y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [PAFormula.hasFree, hb, Bool.not_false, Bool.true_and] at hx + simp [hb, ih hx] + | ex y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · simp [hxy] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [PAFormula.hasFree, hb, Bool.not_false, Bool.true_and] at hx + simp [hb, ih hx] + +theorem holdsIn_subst {M : Type*} [PAStructure M] (v : ℕ → M) {x : ℕ} {s : PATerm} {φ : PAFormula} + (hf : φ.freeFor x s = true) : + PAFormula.HoldsIn v (φ.subst x s) ↔ + PAFormula.HoldsIn (Function.update v x (PATerm.evalIn v s)) φ := by + induction φ generalizing v with + | bot => exact Iff.rfl + | eq t₁ t₂ => simp only [PAFormula.subst, PAFormula.HoldsIn, evalIn_subst] + | and φ ψ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact and_congr (ih₁ v hf.1) (ih₂ v hf.2) + | or φ ψ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact or_congr (ih₁ v hf.1) (ih₂ v hf.2) + | imp φ ψ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact imp_congr (ih₁ v hf.1) (ih₂ v hf.2) + | all y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy + simp only [beq_self_eq_true, ↓reduceIte, PAFormula.HoldsIn] + refine forall_congr' fun a ↦ ?_ + rw [Function.update_idem] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.HoldsIn] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine forall_congr' fun a ↦ ?_ + rw [subst_eq_self_of_hasFree_false s hno, Function.update_comm (Ne.symm hxy), + holdsIn_update_of_hasFree_false _ _ hno] + · refine forall_congr' fun a ↦ ?_ + rw [ih (Function.update v y a) hf', evalIn_update_of_hasVar_false v a hsy, + Function.update_comm hxy] + | ex y φ ih => + simp only [PAFormula.subst] + by_cases hxy : y = x + · subst hxy + simp only [beq_self_eq_true, ↓reduceIte, PAFormula.HoldsIn] + refine exists_congr fun a ↦ ?_ + rw [Function.update_idem] + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.HoldsIn] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine exists_congr fun a ↦ ?_ + rw [subst_eq_self_of_hasFree_false s hno, Function.update_comm (Ne.symm hxy), + holdsIn_update_of_hasFree_false _ _ hno] + · refine exists_congr fun a ↦ ?_ + rw [ih (Function.update v y a) hf', evalIn_update_of_hasVar_false v a hsy, + Function.update_comm hxy] + +theorem freeFor_of_no_vars {x : ℕ} {s : PATerm} (hs : ∀ y, s.hasVar y = false) (φ : PAFormula) : + φ.freeFor x s = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.freeFor, ih₁, ih₂] + | all y _ ih | ex y _ ih => + simp [PAFormula.freeFor, hs y, ih] + +theorem freeFor_zero (x : ℕ) (φ : PAFormula) : φ.freeFor x .zero = true := + freeFor_of_no_vars (fun _ ↦ rfl) φ + +theorem freeFor_ofNat (x n : ℕ) (φ : PAFormula) : φ.freeFor x (.ofNat n) = true := by + refine freeFor_of_no_vars (fun y ↦ ?_) φ + induction n with + | zero => rfl + | succ _ ih => exact ih + +theorem freeFor_succ_self (x : ℕ) (φ : PAFormula) : + φ.freeFor x (.succ (.var x)) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp [PAFormula.freeFor, ih₁, ih₂] + | all y φ ih | ex y φ ih => + simp only [PAFormula.freeFor, PATerm.hasVar] + by_cases hxy : y = x + · simp [hxy] + · simp [hxy, Ne.symm hxy, ih] + +/-! ## Section 3: Classical Soundness of `PAProvable` Across All `PAModel`s -/ + +/-- Soundness of `PAProvable` in every first-order `PAModel`. -/ +theorem paProvable_sound {M : Type*} [PAStructure M] [PAModel M] {φ : PAFormula} + (h : PAProvable φ) (v : ℕ → M) : PAFormula.HoldsIn v φ := by + induction h generalizing v with + | mp _ _ ihφ ihimp => exact ihimp v (ihφ v) + | gen x _ ih => intro a; exact ih (Function.update v x a) + | imp_k _ _ => intro h₁ _; exact h₁ + | imp_s _ _ _ => intro h₁ h₂ h₃; exact h₁ h₃ (h₂ h₃) + | dne _ => exact Classical.not_not.mp + | and_intro _ _ => exact And.intro + | and_left _ _ => exact And.left + | and_right _ _ => exact And.right + | or_left _ _ => exact Or.inl + | or_right _ _ => exact Or.inr + | or_elim _ _ _ => + intro h₁ h₂ h₃ + exact h₃.elim h₁ h₂ + | all_imp x _ _ => + intro h₁ h₂ a + exact h₁ a (h₂ a) + | all_vacuous x φ hx => + intro hφ a + exact (holdsIn_update_of_hasFree_false v a hx).mpr hφ + | all_elim x t φ hf => + intro hall + exact (holdsIn_subst v hf).mpr (hall (PATerm.evalIn v t)) + | ex_intro x t φ hf => + intro hsub + exact ⟨PATerm.evalIn v t, (holdsIn_subst v hf).mp hsub⟩ + | ex_elim x φ ψ hx => + rintro hall ⟨a, ha⟩ + exact (holdsIn_update_of_hasFree_false v a hx).mp (hall a ha) + | eq_refl _ => rfl + | eq_subst x s t φ hs ht => + intro heq hφs + have h1 := (holdsIn_subst v hs).mp hφs + rw [heq] at h1 + exact (holdsIn_subst v ht).mpr h1 + | pa_zero_ne_succ => exact PAModel.zero_ne_succ (v 0) + | pa_succ_inj => exact PAModel.succ_inj + | pa_add_zero => exact PAModel.add_zero (v 0) + | pa_add_succ => exact PAModel.add_succ (v 0) (v 1) + | pa_mul_zero => exact PAModel.mul_zero (v 0) + | pa_mul_succ => exact PAModel.mul_succ (v 0) (v 1) + | pa_ind x φ => + intro h0 hs a + have h0' : PAFormula.HoldsIn (Function.update v x PAStructure.zero) φ := + (holdsIn_subst v (freeFor_zero x φ)).mp h0 + have hs' : ∀ b : M, PAFormula.HoldsIn (Function.update v x b) φ → + PAFormula.HoldsIn (Function.update v x (PAStructure.succ b)) φ := by + intro b hb + have hstep := hs b hb + have hsub := (holdsIn_subst (Function.update v x b) (freeFor_succ_self x φ)).mp hstep + simpa [PATerm.evalIn] using hsub + exact PAModel.ind x φ v h0' hs' a + +/-- Soundness of `PAProvable` in the standard model `ℕ`. -/ +theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → ℕ) : φ.Holds v := + (holdsIn_nat_iff v φ).mp (paProvable_sound h v) + +/-! ## Section 4: Constructive Consistency via Negative Translation (`not_paProvable_false`) -/ + +/-- Gödel–Gentzen negative satisfaction of a `PAFormula` in `ℕ`, replacing positive disjunction +and existential quantification by their double-negated counterparts so every formula is +constructively `¬¬`-stable without `Classical.choice`. -/ +def PAFormula.NHolds (v : ℕ → ℕ) : PAFormula → Prop + | .bot => False + | .eq t₁ t₂ => t₁.eval v = t₂.eval v + | .and φ ψ => PAFormula.NHolds v φ ∧ PAFormula.NHolds v ψ + | .or φ ψ => ¬¬ (PAFormula.NHolds v φ ∨ PAFormula.NHolds v ψ) + | .imp φ ψ => PAFormula.NHolds v φ → PAFormula.NHolds v ψ + | .all x φ => ∀ a : ℕ, PAFormula.NHolds (Function.update v x a) φ + | .ex x φ => ¬¬ ∃ a : ℕ, PAFormula.NHolds (Function.update v x a) φ + +theorem nHolds_stable (φ : PAFormula) (v : ℕ → ℕ) : + ¬¬ PAFormula.NHolds v φ → PAFormula.NHolds v φ := by + induction φ generalizing v with + | bot => intro h; exact h id + | eq t₁ t₂ => + intro h + by_cases he : t₁.eval v = t₂.eval v + · exact he + · exact False.elim (h he) + | and φ ψ ih₁ ih₂ => + intro h + exact ⟨ih₁ v fun h₁ ↦ h fun hp ↦ h₁ hp.1, ih₂ v fun h₂ ↦ h fun hp ↦ h₂ hp.2⟩ + | or _ _ _ _ => + intro h hn + exact h fun hnn ↦ hnn hn + | imp _ ψ _ ih₂ => + intro h hφ + exact ih₂ v fun hψ ↦ h fun himp ↦ hψ (himp hφ) + | all x φ ih => + intro h a + exact ih (Function.update v x a) fun ha ↦ h fun hall ↦ ha (hall a) + | ex _ _ _ => + intro h hn + exact h fun hnn ↦ hnn hn + +private theorem nHolds_congr {v₁ v₂ : ℕ → ℕ} {φ : PAFormula} + (h : ∀ x, φ.hasFree x = true → v₁ x = v₂ x) : + PAFormula.NHolds v₁ φ ↔ PAFormula.NHolds v₂ φ := by + induction φ generalizing v₁ v₂ with + | bot => exact Iff.rfl + | eq t₁ t₂ => + have e₁ : t₁.eval v₁ = t₁.eval v₂ := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + have e₂ : t₂.eval v₁ = t₂.eval v₂ := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_congr fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + simp only [PAFormula.NHolds, e₁, e₂] + | and _ _ ih₁ ih₂ => + refine and_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | or _ _ ih₁ ih₂ => + have c₁ := ih₁ (v₁ := v₁) (v₂ := v₂) fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + have c₂ := ih₂ (v₁ := v₁) (v₂ := v₂) fun x hx ↦ h x (by simp [PAFormula.hasFree, hx]) + exact not_congr (not_congr (or_congr c₁ c₂)) + | imp _ _ ih₁ ih₂ => + refine imp_congr (ih₁ fun x hx ↦ h x ?_) (ih₂ fun x hx ↦ h x ?_) <;> + simp [PAFormula.hasFree, hx] + | all y _ ih => + refine forall_congr' fun a ↦ ih fun x hx ↦ ?_ + rcases Decidable.eq_or_ne x y with rfl | hxy + · simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + | ex y _ ih => + refine not_congr (not_congr (exists_congr fun a ↦ ih fun x hx ↦ ?_)) + rcases Decidable.eq_or_ne x y with rfl | hxy + · simp + · simp only [Function.update_of_ne hxy] + exact h x (by simp [PAFormula.hasFree, Ne.symm hxy, hx]) + +private theorem nHolds_update_of_hasFree_false (v : ℕ → ℕ) {x : ℕ} (a : ℕ) {φ : PAFormula} + (hx : φ.hasFree x = false) : + PAFormula.NHolds (Function.update v x a) φ ↔ PAFormula.NHolds v φ := by + refine nHolds_congr fun y hy ↦ ?_ + have hne : y ≠ x := fun h ↦ by subst h; rw [hx] at hy; cases hy + exact Function.update_of_ne hne a v + +private theorem nHolds_update_idem (v : ℕ → ℕ) (x a b : ℕ) (φ : PAFormula) : + PAFormula.NHolds (Function.update (Function.update v x a) x b) φ ↔ + PAFormula.NHolds (Function.update v x b) φ := by + refine nHolds_congr fun z _ ↦ ?_ + rcases Decidable.eq_or_ne z x with rfl | hzx + · simp only [Function.update_self] + · simp only [Function.update_of_ne hzx] + +private theorem nHolds_update_comm (v : ℕ → ℕ) {x y : ℕ} (hxy : x ≠ y) (a b : ℕ) (φ : PAFormula) : + PAFormula.NHolds (Function.update (Function.update v x a) y b) φ ↔ + PAFormula.NHolds (Function.update (Function.update v y b) x a) φ := by + refine nHolds_congr fun z _ ↦ ?_ + rcases Decidable.eq_or_ne z y with rfl | hzy + · rw [Function.update_self, Function.update_of_ne hxy.symm, Function.update_self] + · rw [Function.update_of_ne hzy] + rcases Decidable.eq_or_ne z x with rfl | hzx + · rw [Function.update_self, Function.update_self] + · rw [Function.update_of_ne hzx, Function.update_of_ne hzx, Function.update_of_ne hzy] + +private theorem nHolds_subst (v : ℕ → ℕ) {x : ℕ} {s : PATerm} {φ : PAFormula} + (hf : φ.freeFor x s = true) : + PAFormula.NHolds v (φ.subst x s) ↔ + PAFormula.NHolds (Function.update v x (s.eval v)) φ := by + induction φ generalizing v with + | bot => exact Iff.rfl + | eq t₁ t₂ => + simp only [PAFormula.subst, PAFormula.NHolds, ← evalIn_nat_eq, evalIn_subst] + | and _ _ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact and_congr (ih₁ v hf.1) (ih₂ v hf.2) + | or _ _ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact not_congr (not_congr (or_congr (ih₁ v hf.1) (ih₂ v hf.2))) + | imp _ _ ih₁ ih₂ => + simp only [PAFormula.freeFor, Bool.and_eq_true] at hf + exact imp_congr (ih₁ v hf.1) (ih₂ v hf.2) + | all y φ ih => + simp only [PAFormula.subst] + rcases Decidable.eq_or_ne y x with rfl | hxy + · simp only [beq_self_eq_true, ↓reduceIte, PAFormula.NHolds] + refine forall_congr' fun a ↦ ?_ + exact (nHolds_update_idem v y (s.eval v) a φ).symm + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.NHolds] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine forall_congr' fun a ↦ ?_ + rw [subst_eq_self_of_hasFree_false s hno, + nHolds_update_comm v (Ne.symm hxy), + nHolds_update_of_hasFree_false _ _ hno] + · refine forall_congr' fun a ↦ ?_ + have hev : s.eval (Function.update v y a) = s.eval v := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_update_of_hasVar_false v a hsy + rw [ih (Function.update v y a) hf', hev, nHolds_update_comm v hxy] + | ex y φ ih => + simp only [PAFormula.subst] + rcases Decidable.eq_or_ne y x with rfl | hxy + · simp only [beq_self_eq_true, ↓reduceIte, PAFormula.NHolds] + refine not_congr (not_congr (exists_congr fun a ↦ ?_)) + exact (nHolds_update_idem v y (s.eval v) a φ).symm + · have hb : (y == x) = false := beq_eq_false_iff_ne.mpr hxy + simp only [hb, Bool.false_eq_true, ↓reduceIte, PAFormula.NHolds] + simp only [PAFormula.freeFor, hb, Bool.false_or, Bool.and_eq_true, + Bool.or_eq_true, Bool.not_eq_true'] at hf + rcases hf with ⟨hno | hsy, hf'⟩ + · refine not_congr (not_congr (exists_congr fun a ↦ ?_)) + rw [subst_eq_self_of_hasFree_false s hno, + nHolds_update_comm v (Ne.symm hxy), + nHolds_update_of_hasFree_false _ _ hno] + · refine not_congr (not_congr (exists_congr fun a ↦ ?_)) + have hev : s.eval (Function.update v y a) = s.eval v := by + rw [← evalIn_nat_eq, ← evalIn_nat_eq] + exact evalIn_update_of_hasVar_false v a hsy + rw [ih (Function.update v y a) hf', hev, nHolds_update_comm v hxy] + +/-- Constructive soundness of `PAProvable` under `NHolds` (zero `Classical.choice`). -/ +theorem paProvable_nSound {φ : PAFormula} (h : PAProvable φ) (v : ℕ → ℕ) : + PAFormula.NHolds v φ := by + induction h generalizing v with + | mp _ _ ihφ ihimp => exact ihimp v (ihφ v) + | gen x _ ih => intro a; exact ih (Function.update v x a) + | imp_k _ _ => intro h₁ _; exact h₁ + | imp_s _ _ _ => intro h₁ h₂ h₃; exact h₁ h₃ (h₂ h₃) + | dne φ => exact nHolds_stable φ v + | and_intro _ _ => exact And.intro + | and_left _ _ => exact And.left + | and_right _ _ => exact And.right + | or_left _ _ => intro hφ hn; exact hn (Or.inl hφ) + | or_right _ _ => intro hψ hn; exact hn (Or.inr hψ) + | or_elim _ _ χ => + intro h₁ h₂ hor + refine nHolds_stable χ v fun hnχ ↦ hor fun hdisj ↦ ?_ + exact hdisj.elim (fun hφ ↦ hnχ (h₁ hφ)) (fun hψ ↦ hnχ (h₂ hψ)) + | all_imp x _ _ => intro h₁ h₂ a; exact h₁ a (h₂ a) + | all_vacuous x φ hx => + intro hφ a + exact (nHolds_update_of_hasFree_false v a hx).mpr hφ + | all_elim x t φ hf => + intro hall + exact (nHolds_subst v hf).mpr (hall (t.eval v)) + | ex_intro x t φ hf => + intro hsub hn + exact hn ⟨t.eval v, (nHolds_subst v hf).mp hsub⟩ + | ex_elim x φ ψ hx => + intro hall hex + refine nHolds_stable ψ v fun hnψ ↦ hex fun ⟨a, ha⟩ ↦ ?_ + exact hnψ ((nHolds_update_of_hasFree_false v a hx).mp (hall a ha)) + | eq_refl _ => rfl + | eq_subst x s t φ hs ht => + intro heq hφs + have h1 := (nHolds_subst v hs).mp hφs + rw [heq] at h1 + exact (nHolds_subst v ht).mpr h1 + | pa_zero_ne_succ => exact Nat.succ_ne_zero (v 0) + | pa_succ_inj => exact Nat.succ.inj + | pa_add_zero => exact Nat.add_zero (v 0) + | pa_add_succ => exact Nat.add_succ (v 0) (v 1) + | pa_mul_zero => exact Nat.mul_zero (v 0) + | pa_mul_succ => exact Nat.mul_succ (v 0) (v 1) + | pa_ind x φ => + intro h0 hs a + have h0' : PAFormula.NHolds (Function.update v x 0) φ := + (nHolds_subst v (freeFor_zero x φ)).mp h0 + have hs' : ∀ b : ℕ, PAFormula.NHolds (Function.update v x b) φ → + PAFormula.NHolds (Function.update v x (b + 1)) φ := by + intro b hb + have hstep := hs b hb + have hsub := (nHolds_subst (Function.update v x b) (freeFor_succ_self x φ)).mp hstep + simp only [PATerm.eval, Function.update_self] at hsub + exact (nHolds_update_idem v x b (b + 1) φ).mp hsub + induction a with + | zero => exact h0' + | succ a ih => exact hs' a ih + +/-- Consistency of first-order Peano Arithmetic (`¬ PAProvable .bot`), proved constructively +without `Classical.choice`. -/ +theorem not_paProvable_false : ¬ PAProvable .bot := + fun h ↦ paProvable_nSound h (fun _ ↦ 0) + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/README.md b/Cryptids/Semantics/README.md index 2c2478fb..66e9b0a0 100644 --- a/Cryptids/Semantics/README.md +++ b/Cryptids/Semantics/README.md @@ -367,7 +367,7 @@ Care is required when interpreting a Lean theorem of type `Halts M ↔ ZFInconsi 3. **Metamathematical scope — Lean's type theory, `PA`/`ZF` internalization, and `ZF`-independence:** Care must also be taken not to conflate a constructive Lean theorem `Halts M ↔ ZFInconsistent` with a formal proof of $\mathrm{ZF}$-independence: - **Strength of constructive Lean (`CIC` vs. `PA`/`ZF`):** Even without `Classical.choice` or Excluded Middle, Lean's Calculus of Inductive Constructions provides constructions absent from first-order $\mathrm{PA}$ and $\mathrm{ZF}$—an impredicative `Prop`, inductive families (`ZFProvable`, `Acc`, `PSet`), and a predicative universe hierarchy `Type u` (already strong enough to validate Zermelo set theory, and whether axiom-free `CIC` itself proves $\operatorname{Con}(\mathrm{ZF})$ remains an open question; see [`digama0/ConZF`](https://github.com/digama0/ConZF)). An axiom check in Lean therefore blocks classical `Con(ZF)` shortcuts, rather than restricting reasoning to $\mathrm{PA}$ or $\mathrm{ZF}$. - - **Internalizing the reduction inside `PA`/`ZF` is separate:** Although our concrete proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` proceed by explicit finitary structural and step-indexed induction rather than ambient set-theoretic models, they establish a **meta-level correspondence in Lean**. Internalizing that compiler and trace decoder as an object-level formal theorem inside $\mathrm{PA}$ or $\mathrm{ZF}$ (i.e., proving $\mathrm{ZF} \vdash \ulcorner \operatorname{Halts}(M) \leftrightarrow \neg\operatorname{Con}(\mathrm{ZF}) \urcorner$) is a separate step not formalized in this repository. + - **Internalizing the reduction inside first-order `PA` (`PAProvable`):** Our constructive Lean proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` establish a meta-level correspondence in Lean. To formulate and verify object-level provability inside weak first-order arithmetic—whose consistency strength is strictly below $\mathrm{ZF}$, so it cannot trivialize $\operatorname{Con}(\mathrm{ZF})$—Section 6 ([`Cryptids/Semantics/PA/`](./PA/)) deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`), proves constructive consistency (`not_paProvable_false : ¬ PAProvable .bot`), proves constructive standard-model adequacy of the $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), and proves Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`) so that object-level `PAProvable` theorems reduce to semantic reasoning in an arbitrary `[PAModel M]`. - **Assumptions required for both directions of `ZF`-independence:** Even once $\mathrm{ZF} \vdash \ulcorner \operatorname{Halts}(M) \leftrightarrow \neg\operatorname{Con}(\mathrm{ZF}) \urcorner$ is established, $\operatorname{Con}(\mathrm{ZF})$ alone yields only **one** direction of independence: $\mathrm{ZF} \nvdash \neg\ulcorner\operatorname{Halts}(M)\urcorner$ (by Gödel's Second Incompleteness Theorem). Ruling out the **other** direction, $\mathrm{ZF} \vdash \ulcorner\operatorname{Halts}(M)\urcorner$ (since $\mathrm{ZF} + \neg\operatorname{Con}(\mathrm{ZF})$ can still be consistent when $\mathrm{ZF}$ is consistent), requires $\operatorname{Con}(\mathrm{ZF} + \operatorname{Con}(\mathrm{ZF}))$—for example $\Sigma_1$-soundness ($1$-consistency) of $\mathrm{ZF}$, as assumed in Yedidia & Aaronson (2016). ### Formal Discovery of the `B6a` Register-Restoration Bug in `zf_432_wade.tm` @@ -505,3 +505,52 @@ theorem not_halts_zf393 : (`69..392`), the 125-step outer `main()` spine (`99..223`), and soundness & completeness against O'Rear's `ZFProvable` (`Layer2.Zf393RegHalts ↔ ZFInconsistent`), yielding unconditional non-halting (`not_halts_zf393`) via `Cryptids.Semantics.Zf.not_zfInconsistent`. + +--- + +## 6. First-Order Peano Arithmetic Metatheory ([`PA.lean`](./PA.lean) & [`PA/`](./PA/), `0 sorry`s) + +To state and verify object-level first-order Peano Arithmetic ($\mathrm{PA}$) provability statements +inside Lean without relying on Lean's ambient type-theoretic strength, [`Cryptids/Propositions.lean`](../Propositions.lean) +and [`Challenge.lean`](../../Challenge.lean) deeply embed first-order $\mathcal{L}_{\mathrm{PA}} = \{0, S, +, \times\}$ +terms (`PATerm`), positive formulas (`PAFormula`), the 25-clause Hilbert system `PAProvable`, and +closed $\Sigma_1^0$ sentences `paHalts M` and `paZFInconsistent`. + +In [`Cryptids/Semantics/PA.lean`](./PA.lean) and its three submodules ([`PA/Syntax.lean`](./PA/Syntax.lean), +[`PA/Adequacy.lean`](./PA/Adequacy.lean), [`PA/Completeness.lean`](./PA/Completeness.lean)), we prove: + +```lean +theorem not_paProvable_false : + ¬ PAProvable .bot + +theorem paHalts_holds_iff_halts {states : ℕ} [NeZero states] (M : Machine states 2) + (v : ℕ → ℕ) : (paHalts M).Holds v ↔ ConjectureMachines.Halts M + +theorem paZFInconsistent_holds_iff_zfInconsistent (v : ℕ → ℕ) : + paZFInconsistent.Holds v ↔ ZFInconsistent + +theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → ℕ) : + φ.Holds v + +theorem paProvable_iff_holdsIn_all_models (φ : PAFormula) : + PAProvable φ ↔ ∀ (M : Type) [PAModel M] (v : ℕ → M), PAFormula.HoldsIn v φ +``` + +1. **Models, Classical Soundness, & Constructive Consistency ([`PA/Syntax.lean`](./PA/Syntax.lean))**: + Defines first-order $\mathcal{L}_{\mathrm{PA}}$-structures (`PAStructure M`) and Peano models + (`PAModel M`), proves soundness of `PAProvable` in any `[PAModel M]` (`paProvable_sound`, + specializing to `paProvable_sound_nat` on `ℕ`), and proves `not_paProvable_false` constructively + (zero `Classical.choice`, audited in [`comparator/constructive.json`](../../comparator/constructive.json)) + via the Gödel–Gentzen negative translation (`PAFormula.NHolds`, translating `.or` and `.ex` via + double negation so `PAProvable.dne` is constructively valid on `ℕ`). +2. **Constructive $\Sigma_1^0$ Standard-Model Adequacy ([`PA/Adequacy.lean`](./PA/Adequacy.lean))**: + Uses Gödel's $\beta$-function (`paBetaEq`), symbolic Cantor-pairing DAGs (`PAZFTerm`, avoiding + giant numeral expansions for `axInf`), and binary half-tape codes to prove + `paHalts_holds_iff_halts` and `paZFInconsistent_holds_iff_zfInconsistent` constructively without + `Classical.choice` or Markov's Principle (constructing $\beta$-witnesses via + `Nat.chineseRemainderOfList`). +3. **Gödel–Henkin Completeness ([`PA/Completeness.lean`](./PA/Completeness.lean))**: + Proves `paProvable_iff_holdsIn_all_models` via a single-pass enumerable Henkin–Lindenbaum chain + (`henkinChain`), quotient term model `Quotient (HenkinSetoid h₀)`, and simultaneous variable + renaming (`vsubst`), enabling `PAProvable` theorems to be proved semantically in an arbitrary + `[PAModel M]`. diff --git a/README.md b/README.md index 217e0d5a..a13b6d8d 100644 --- a/README.md +++ b/README.md @@ -13,8 +13,8 @@ This repository contains two Lean 4 (`v4.35.0-rc4`) formalization libraries for | [`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 machines) and [`BusyBeaver/BB33/`](BusyBeaver/BB33/README.md) (6 machines) | [`BusyBeaver/README.md`](BusyBeaver/README.md), [`BusyBeaver/BB6/README.md`](BusyBeaver/BB6/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`), 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 and ensures the Lean proof-search correspondence is constructive (while internalizing the reduction inside `PA`/`ZF` and establishing both directions of `ZF`-independence are separate metamathematical steps; see [Foundational Note on `Con(ZF)` and Constructive Equivalence](Cryptids/Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). -- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** Set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json) and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). +- **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)). +- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** First-order `PA` soundness and Gödel–Henkin completeness (`paProvable_sound_nat`, `paProvable_iff_holdsIn_all_models`), set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json) and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). The [95-state Riemann machine](artifacts/riemann_95/README.md) has a kernel-checked blank-tape halting equivalence to the 104-state machine and to `¬ RiemannHypothesis`. diff --git a/comparator/README.md b/comparator/README.md index 52e6af56..30cbd1f8 100644 --- a/comparator/README.md +++ b/comparator/README.md @@ -10,8 +10,9 @@ using [`leanprover/comparator`](https://github.com/leanprover/comparator). - [`Challenge.lean`](../Challenge.lean) imports **only** Mathlib and Lean core (`Lean.Elab.Term`), defines all conjecture-checking baseline and candidate machines (`reference` and `candidate`), states the target mathematical propositions (`GoldbachConjecture`, - `MatiyasevichRiemannCounterexample`, `ZFProvable`, `WadeZFProvable`, etc.), and states all 22 - target state-reduction, equivalence, and semantics theorems with `sorry`. + `MatiyasevichRiemannCounterexample`, `ZFProvable`, `WadeZFProvable`, `PAProvable`, `paHalts`, + `paZFInconsistent`, etc.), and states all 26 target state-reduction, equivalence, `PA` + metatheory, and semantics theorems with `sorry`. - [`BusyBeaverChallenge.lean`](../BusyBeaverChallenge.lean) imports **only** Mathlib and Lean core (`Lean.Elab.Term`), defines the shared `BusyBeaver` Post-Turing execution model, accelerated `TapePatternSet`, `StackPatternSet`, and Collatz-like acceleration semantics (`IsClosedPatternSet`, @@ -34,25 +35,27 @@ that: [`zf_380.json`](./zf_380.json), and [`riemann_104.json`](./riemann_104.json), covering all three ZF machine-to-proof-search equivalences (`halts_zf393_iff_zfInconsistent`, `Zf380.Semantics.halts_candidate_iff_zfInconsistent`, - `halts_zf432_iff_wadeZFInconsistent`), the direct simulation reductions (`Goldbach21`, `Zf380`, - `Riemann104`), and all four `candidate_fewer_states` theorems (10 theorems total). Disallowing - `Classical.choice` blocks classical `Con(ZF)` shortcuts (`not_zfInconsistent` in `ZFSet.{0}` or - `Classical.em` + `digama0/ConZF`) for `Halts M ↔ ZFInconsistent`, though Lean's constructive - type theory remains stronger than `PA`/`ZF` and does not by itself internalize the reduction - inside `PA`/`ZF` (see + `halts_zf432_iff_wadeZFInconsistent`), first-order `PA` consistency and $\Sigma_1^0$ + adequacy (`not_paProvable_false`, `paHalts_holds_iff_halts`, + `paZFInconsistent_holds_iff_zfInconsistent`), the direct simulation reductions (`Goldbach21`, + `Zf380`, `Riemann104`), and all four `candidate_fewer_states` theorems (13 theorems total). + Disallowing `Classical.choice` blocks classical `Con(ZF)` shortcuts (`not_zfInconsistent` in + `ZFSet.{0}` or `Classical.em` + `digama0/ConZF`) for `Halts M ↔ ZFInconsistent`, while deeply + embedded `PAProvable` provides a weak first-order metatheory strictly below `ZF` (see [`Cryptids/Semantics/README.md`](../Cryptids/Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). - **`["propext", "Quot.sound", "Classical.choice"]`:** allowed in [`all.json`](./all.json), [`busy_beaver.json`](./busy_beaver.json), and the classical model-theoretic / arithmetic-stage / - analytic configs (`zf_393.json`, `zf_semantics.json`, `goldbach_semantics.json`, - `riemann_95.json`, `riemann_120.json`, `riemann_semantics.json`). + analytic configs (`pa_semantics.json`, `zf_393.json`, `zf_semantics.json`, + `goldbach_semantics.json`, `riemann_95.json`, `riemann_120.json`, `riemann_semantics.json`). 3. The exported proof terms are accepted by the Lean default kernel. ## Configurations | Config File | Challenge Module | Solution Module | Permitted Axioms | Verified Theorems | | :--- | :--- | :--- | :--- | :--- | -| [`constructive.json`](./constructive.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound` | All 10 constructive theorems: all 3 ZF proof-search equivalences (`zf_393`, `zf_380`, `zf_432`), direct state reductions (`Goldbach21`, `Zf380`, `Riemann104`), and `Riemann95.candidate_fewer_states` | -| [`all.json`](./all.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound`, `Classical.choice` | All 22 conjecture-checking state-reduction, equivalence, and semantics theorems | +| [`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 299 `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`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`) | | [`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` | diff --git a/comparator/all.json b/comparator/all.json index 187b2d57..bc3c5600 100644 --- a/comparator/all.json +++ b/comparator/all.json @@ -15,6 +15,10 @@ "ConjectureMachines.Semantics.Zf.zfProvable_sound_zfSet", "ConjectureMachines.Semantics.Zf.not_zfInconsistent", "ConjectureMachines.Semantics.Zf.halts_zf432_iff_wadeZFInconsistent", + "ConjectureMachines.Semantics.PA.not_paProvable_false", + "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", + "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", + "ConjectureMachines.Semantics.PA.paProvable_sound_nat", "ConjectureMachines.Semantics.Riemann.halts_riemann744_iff_exists_counterexample", "ConjectureMachines.Semantics.Riemann.halts_riemann744_iff_not_riemannHypothesis", "ConjectureMachines.Riemann120.halts_riemann120_iff_not_riemannHypothesis", diff --git a/comparator/constructive.json b/comparator/constructive.json index 1261336b..5229c744 100644 --- a/comparator/constructive.json +++ b/comparator/constructive.json @@ -9,6 +9,9 @@ "ConjectureMachines.Zf380.candidate_equivalent", "ConjectureMachines.Zf380.Semantics.halts_candidate_iff_zfInconsistent", "ConjectureMachines.Semantics.Zf.halts_zf432_iff_wadeZFInconsistent", + "ConjectureMachines.Semantics.PA.not_paProvable_false", + "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", + "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", "ConjectureMachines.Riemann104.candidate_fewer_states", "ConjectureMachines.Riemann104.candidate_equivalent", "ConjectureMachines.Riemann95.candidate_fewer_states" diff --git a/comparator/pa_semantics.json b/comparator/pa_semantics.json new file mode 100644 index 00000000..e473b0a9 --- /dev/null +++ b/comparator/pa_semantics.json @@ -0,0 +1,15 @@ +{ + "challenge_module": "Challenge", + "solution_module": "Cryptids.Semantics.PA", + "theorem_names": [ + "ConjectureMachines.Semantics.PA.not_paProvable_false", + "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", + "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", + "ConjectureMachines.Semantics.PA.paProvable_sound_nat" + ], + "permitted_axioms": [ + "propext", + "Quot.sound", + "Classical.choice" + ] +} From f990ff613f6d3982da677881bfb9f9ee5eccdc1b Mon Sep 17 00:00:00 2001 From: Moritz Firsching Date: Sun, 25 Oct 2026 17:59:31 +0000 Subject: [PATCH 2/3] Prove PA-internalized ZF inconsistency equivalences for zf_393 and zf_380 --- Challenge.lean | 6 + Cryptids.lean | 12 +- Cryptids/README.md | 2 +- Cryptids/Semantics/PA.lean | 22 +- Cryptids/Semantics/PA/Arithmetic.lean | 3472 ++++++++++++++ Cryptids/Semantics/PA/Zf380Internal.lean | 632 +++ .../Semantics/PA/Zf393BackendInternal.lean | 2453 ++++++++++ .../Semantics/PA/Zf393ProgramInternal.lean | 4010 +++++++++++++++++ .../Semantics/PA/Zf393SoundnessInternal.lean | 1105 +++++ Cryptids/Semantics/README.md | 35 +- README.md | 2 +- comparator/README.md | 8 +- comparator/all.json | 3 + comparator/pa_semantics.json | 5 +- 14 files changed, 11749 insertions(+), 18 deletions(-) create mode 100644 Cryptids/Semantics/PA/Arithmetic.lean create mode 100644 Cryptids/Semantics/PA/Zf380Internal.lean create mode 100644 Cryptids/Semantics/PA/Zf393BackendInternal.lean create mode 100644 Cryptids/Semantics/PA/Zf393ProgramInternal.lean create mode 100644 Cryptids/Semantics/PA/Zf393SoundnessInternal.lean diff --git a/Challenge.lean b/Challenge.lean index 96c8ae13..1ecb9b8e 100644 --- a/Challenge.lean +++ b/Challenge.lean @@ -775,6 +775,12 @@ theorem paZFInconsistent_holds_iff_zfInconsistent (v : ℕ → ℕ) : paZFInconsistent.Holds v ↔ ZFInconsistent := by sorry theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → ℕ) : φ.Holds v := by sorry +theorem paProvable_halts_zf380_iff_zf393 : + PAProvable ((paHalts Machines.zf380).iff (paHalts Machines.zf393)) := by sorry +theorem paProvable_halts_zf393_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf393).iff paZFInconsistent) := by sorry +theorem paProvable_halts_zf380_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf380).iff paZFInconsistent) := by sorry end Semantics.PA namespace Semantics.Riemann diff --git a/Cryptids.lean b/Cryptids.lean index 52c3a8d3..85f33bd5 100644 --- a/Cryptids.lean +++ b/Cryptids.lean @@ -50,11 +50,13 @@ linking every machine's blank-tape halting problem to Mathlib's statements: - `Cryptids.Riemann95`, `Cryptids.Semantics.Riemann95` — A 95-state machine with an exact 3,634-step blank initializer, unconditional equivalence to the 104-state machine, and `Halts candidate ↔ ¬ RiemannHypothesis`. -- `Cryptids.Semantics.PA` — First-order Peano Arithmetic metatheory: arbitrary `[PAModel M]` - soundness (`paProvable_sound`, `paProvable_sound_nat`), constructive consistency - (`not_paProvable_false`), constructive $\Sigma_1^0$ standard-model adequacy - (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), and Gödel–Henkin - completeness (`paProvable_iff_holdsIn_all_models`). +- `Cryptids.Semantics.PA` — First-order Peano Arithmetic metatheory and internalized `ZF` + reductions: arbitrary `[PAModel M]` soundness (`paProvable_sound`, `paProvable_sound_nat`), + constructive consistency (`not_paProvable_false`), constructive $\Sigma_1^0$ standard-model + adequacy (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), Gödel–Henkin + completeness (`paProvable_iff_holdsIn_all_models`), and object-level `PAProvable` proofs that + `zf_380` and `zf_393` halt iff `ZF` is inconsistent (`paProvable_halts_zf380_iff_zf393`, + `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent`). - `Cryptids.Semantics.Goldbach`, `Cryptids.Semantics.Zf`, `Cryptids.Semantics.Riemann` — End-to-end proofs linking halting from the blank tape to the corresponding mathematical conjectures across all baseline machines (`goldbach25`, `zf432`, `riemann744`). diff --git a/Cryptids/README.md b/Cryptids/README.md index 0cceaef9..e2c2c69e 100644 --- a/Cryptids/README.md +++ b/Cryptids/README.md @@ -24,7 +24,7 @@ All proofs in [`Cryptids/`](./) are checked by the Lean 4 kernel (`v4.35.0-rc4`) 1. **State reductions:** Each reduced machine (`goldbach_21`, `zf_380`, `riemann_104`, `riemann_95`) has fewer states than its reference machine (`goldbach_25`, `zf_393`, `riemann_120`, `riemann_104`) and halts from the blank tape if and only if the reference machine halts ([`Goldbach21.lean`](./Goldbach21.lean), [`Zf380.lean`](./Zf380.lean), [`Riemann104.lean`](./Riemann104.lean), [`Riemann95.lean`](./Riemann95.lean)). The direct simulation reductions (`goldbach_21`, `zf_380`, `riemann_104`) and all four `candidate_fewer_states` theorems are completely constructive (`["propext", "Quot.sound"]`, zero `Classical.choice`), audited via [`comparator/constructive.json`](../comparator/constructive.json), [`comparator/goldbach_21.json`](../comparator/goldbach_21.json), [`comparator/zf_380.json`](../comparator/zf_380.json), and [`comparator/riemann_104.json`](../comparator/riemann_104.json), while [`riemann_95`](./Riemann95.lean) routes through the arithmetic stage predicate `ShuniaCounterexample` (`Nat.Prime`, audited via [`comparator/riemann_95.json`](../comparator/riemann_95.json)). 2. **End-to-end mathematical semantics ([`Cryptids/Semantics/`](./Semantics/README.md)):** - **ZF Consistency (`zf_380`, `zf_393`, and `zf_432`):** Both `zf_380` and Wade's 393-state machine `zf_393` (incorporating upstream fix `10fcf152b3`) halt if and only if O'Rear's `zf2.nql` Hilbert system proves $v_0 \in v_0$ (`Halts candidate ↔ ZFInconsistent`, `Halts zf393 ↔ ZFInconsistent`), while `zf_432` halts if and only if the 20-clause deductive system enumerated by `zf_432_wade.tm` derives $v_0 \in v_0$ (`WadeZFInconsistent`). **All three proof-search equivalences are proved constructively in Lean using only `["propext", "Quot.sound"]` (no `Classical.choice`, no Excluded Middle, and no Markov's Principle)** and audited via [`comparator/constructive.json`](../comparator/constructive.json), blocking classical `Con(ZF)` shortcuts via [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) or `Classical.em` (while internalizing the reduction inside `PA`/`ZF` and establishing full `ZF`-independence remain separate from this Lean meta-level correspondence; see [`Semantics/README.md`](./Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). Separately, [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) uses classical `ZFSet.{0}` (`Classical.choice`) to establish `not_zfInconsistent` and deduce unconditional non-halting (`not_halts_zf393`, `not_halts_candidate`) inside Lean's stronger meta-theory. - - **First-Order Peano Arithmetic (`PAProvable`, [`Semantics/PA.lean`](./Semantics/PA.lean)):** Deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) and $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` in [`Propositions.lean`](./Propositions.lean) and [`Challenge.lean`](../Challenge.lean), proving constructive consistency (`not_paProvable_false`), constructive standard-model adequacy (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`; all three audited without `Classical.choice` in [`comparator/constructive.json`](../comparator/constructive.json)), standard-model soundness (`paProvable_sound_nat`), and Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`) across arbitrary `[PAModel M]`. + - **First-Order Peano Arithmetic (`PAProvable`, [`Semantics/PA.lean`](./Semantics/PA.lean)):** Deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) and $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` in [`Propositions.lean`](./Propositions.lean) and [`Challenge.lean`](../Challenge.lean), proving constructive consistency (`not_paProvable_false`), constructive standard-model adequacy (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`; all three audited without `Classical.choice` in [`comparator/constructive.json`](../comparator/constructive.json)), standard-model soundness (`paProvable_sound_nat`), Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`), and full object-level `PA` proofs that `zf_380` and `zf_393` halt iff `ZF` is inconsistent (`paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent`, audited in [`comparator/pa_semantics.json`](../comparator/pa_semantics.json) and [`comparator/all.json`](../comparator/all.json)). - **Goldbach (`goldbach_21` and `goldbach_25`):** Both `goldbach_21` and `goldbach_25` constructively satisfy `Halts M ↔ ∃ w, ¬ HasGoldbachPair (2 * w + 4)` without `Classical.choice` ([`Goldbach21.lean`](./Goldbach21.lean)), and with `Classical.choice` (for Markov's Principle on `¬ ∀ n, ...`) satisfy `Halts candidate ↔ ¬ GoldbachConjecture` ([`Semantics/Goldbach.lean`](./Semantics/Goldbach.lean)). - **Riemann Hypothesis (`riemann_95`, `riemann_104`, `riemann_120`, and `riemann_744`):** All four machines (`riemann_95`, `riemann_104`, Shunia's 120-state machine `riemann_120`, and the 744-state machine `riemann_744`) halt if and only if Mathlib's `RiemannHypothesis` is false (`Halts candidate ↔ ¬ RiemannHypothesis`, `Halts riemann120 ↔ ¬ RiemannHypothesis`, and `Halts riemann744 ↔ ¬ RiemannHypothesis`). diff --git a/Cryptids/Semantics/PA.lean b/Cryptids/Semantics/PA.lean index fd085774..d46d4684 100644 --- a/Cryptids/Semantics/PA.lean +++ b/Cryptids/Semantics/PA.lean @@ -7,12 +7,18 @@ module public import Cryptids.Semantics.PA.Syntax public import Cryptids.Semantics.PA.Adequacy public import Cryptids.Semantics.PA.Completeness +public import Cryptids.Semantics.PA.Arithmetic +public import Cryptids.Semantics.PA.Zf380Internal +public import Cryptids.Semantics.PA.Zf393BackendInternal +public import Cryptids.Semantics.PA.Zf393ProgramInternal +public import Cryptids.Semantics.PA.Zf393SoundnessInternal /-! -# First-Order Peano Arithmetic Semantics, Adequacy, and Completeness (`Cryptids.Semantics.PA`) +# First-Order Peano Arithmetic Semantics & Internalized `ZF` Reductions (`Cryptids.Semantics.PA`) Re-exports the foundational metatheory of the deeply embedded Peano Arithmetic system `PAProvable` -(`Cryptids.Propositions`): +(`Cryptids.Propositions`) together with the full first-order `PA` internalization of `zf_393` and +`zf_380`: 1. [`Cryptids.Semantics.PA.Syntax`](./PA/Syntax.lean): General $\mathcal{L}_{\mathrm{PA}}$-structures (`PAStructure`), models (`PAModel`), classical @@ -25,4 +31,16 @@ Re-exports the foundational metatheory of the deeply embedded Peano Arithmetic s 3. [`Cryptids.Semantics.PA.Completeness`](./PA/Completeness.lean): Gödel–Henkin soundness and completeness across all first-order `PAModel`s (`paProvable_iff_holdsIn_all_models`). +4. [`Cryptids.Semantics.PA.Arithmetic`](./PA/Arithmetic.lean): + Internal arithmetic in arbitrary `PAModel`s (`PAM M`), Euclidean division, `2^k`, Gödel's + $\beta$-function sequence coding via `PAM.ind1`, Cantor pairing (`mPair`/`mUnpair`), and model + bridges for `paHalts` and `paZFInconsistent`. +5. [`Cryptids.Semantics.PA.Zf380Internal`](./PA/Zf380Internal.lean): + First-order `PA` proof of `PAProvable ((paHalts Machines.zf380).iff (paHalts Machines.zf393))` + (`paProvable_halts_zf380_iff_zf393`). +6. [`Cryptids.Semantics.PA.Zf393BackendInternal`](./PA/Zf393BackendInternal.lean), + [`Cryptids.Semantics.PA.Zf393ProgramInternal`](./PA/Zf393ProgramInternal.lean), & + [`Cryptids.Semantics.PA.Zf393SoundnessInternal`](./PA/Zf393SoundnessInternal.lean): + Full Layer 1–3 internalization of `zf_393` and `zf_380` inside `PAProvable`: + `paProvable_halts_zf393_iff_zfInconsistent` and `paProvable_halts_zf380_iff_zfInconsistent`. -/ diff --git a/Cryptids/Semantics/PA/Arithmetic.lean b/Cryptids/Semantics/PA/Arithmetic.lean new file mode 100644 index 00000000..795932af --- /dev/null +++ b/Cryptids/Semantics/PA/Arithmetic.lean @@ -0,0 +1,3472 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Syntax +public import Cryptids.Semantics.PA.Adequacy +public import Cryptids.Semantics.PA.Completeness +public import Cryptids.Semantics.Riemann.Gadgets +public import Mathlib.Tactic.Ring + +/-! +# Internal Arithmetic, Sequences, Exponentiation, and Execution in `PAModel`s + +This module develops the internal arithmetic and computability toolkit inside an arbitrary +first-order model `[PAStructure M] [PAModel M]` of Peano Arithmetic, bridged to `PAProvable` via +Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`): + +1. **Nominal model carrier `PAM M`**: + Equips `M` with `CommSemiring`, `LinearOrder`, truncated subtraction (`-`), Euclidean division + (`/`, `%`), and `ℕ` initial-segment embedding without colliding with `ℕ`'s standard instances. +2. **Definable induction (`pam_ind_pred`, `pam_strong_ind_pred`)**: + Ordinary and strong induction principles on `PAM M` for any predicate first-order definable by a + `PAFormula` with parameters in `PAM M`. +3. **Bijective Cantor pairing (`mPair`, `mUnpair`)**: + Injectivity, diagonal surjectivity, and `PAZFTerm.eqFormula` evaluation in `PAM M`. +4. **Gödel's $\beta$-sequences (`mBeta`, `mBeta_snoc`, `mBeta_concat`)**: + Single-element extension and sequence concatenation inside `PAM M` via explicit polynomial + Bézout identities and unsigned Chinese Remainder Theorem steps. +5. **Internal base-2 exponentiation (`mPow2`, `paPow2Eq`) and unary blocks (`mRep0`, `mRep1`)**: + First-order definable $2^r$ and binary half-tape run-length helpers $0^r :: R$, $1^r :: R$. +6. **Internal Turing machine execution (`MCfg`, `mStep`, `mTracesTo`) and `ZF` step evaluation**: + Semantic characterizations of `(paHalts tm).HoldsIn` and `paZFInconsistent.HoldsIn` in `PAM M`, + plus standard-trace lifting (`embedCfg`, `mTracesTo_of_nSteps`). +-/ + +@[expose] public section + +namespace ConjectureMachines.Semantics.PA + +open Turing (Dir) +open ConjectureMachines.Semantics.Riemann.Layer1 (nSteps) + +/-! ## Section 1: Nominal Carrier `PAM M` and Isomorphism with `M` -/ + +/-- Nominal wrapper around the carrier of a first-order `PAModel M`, allowing `CommSemiring`, +`LinearOrder`, `-`, `/`, and `%` instances without creating instance diamonds on `ℕ`. -/ +@[ext] +structure PAM (M : Type*) where + /-- Underlying element of `M`. -/ + raw : M + +namespace PAM + +section Structure +variable {M : Type*} [PAStructure M] + +instance : Zero (PAM M) := ⟨⟨PAStructure.zero⟩⟩ +instance : One (PAM M) := ⟨⟨PAStructure.succ PAStructure.zero⟩⟩ +instance : Add (PAM M) := ⟨fun a b ↦ ⟨PAStructure.add a.raw b.raw⟩⟩ +instance : Mul (PAM M) := ⟨fun a b ↦ ⟨PAStructure.mul a.raw b.raw⟩⟩ + +/-- Successor operation on `PAM M`. -/ +def succ (a : PAM M) : PAM M := ⟨PAStructure.succ a.raw⟩ + +instance : PAStructure (PAM M) where + zero := 0 + succ := succ + add := (· + ·) + mul := (· * ·) + +@[simp] theorem raw_zero : (0 : PAM M).raw = PAStructure.zero := rfl +@[simp] theorem raw_one : (1 : PAM M).raw = PAStructure.succ PAStructure.zero := rfl +@[simp] theorem raw_add (a b : PAM M) : (a + b).raw = PAStructure.add a.raw b.raw := rfl +@[simp] theorem raw_mul (a b : PAM M) : (a * b).raw = PAStructure.mul a.raw b.raw := rfl +@[simp] theorem raw_succ (a : PAM M) : (succ a).raw = PAStructure.succ a.raw := rfl + +theorem evalIn_raw (v : ℕ → PAM M) (t : PATerm) : + (PATerm.evalIn v t).raw = PATerm.evalIn (fun x ↦ (v x).raw) t := by + induction t with + | var _ | zero => rfl + | succ _ ih => exact congrArg PAStructure.succ ih + | add _ _ ih₁ ih₂ => exact congrArg₂ PAStructure.add ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ PAStructure.mul ih₁ ih₂ + +theorem holdsIn_iff_raw (v : ℕ → PAM M) (φ : PAFormula) : + PAFormula.HoldsIn v φ ↔ PAFormula.HoldsIn (fun x ↦ (v x).raw) φ := by + induction φ generalizing v with + | bot => exact Iff.rfl + | eq t₁ t₂ => + simp only [PAFormula.HoldsIn, PAM.ext_iff, evalIn_raw] + | and _ _ ih₁ ih₂ => exact and_congr (ih₁ v) (ih₂ v) + | or _ _ ih₁ ih₂ => exact or_congr (ih₁ v) (ih₂ v) + | imp _ _ ih₁ ih₂ => exact imp_congr (ih₁ v) (ih₂ v) + | all x _ ih => + constructor + · intro h a + have h' := (ih (Function.update v x ⟨a⟩)).mp (h ⟨a⟩) + refine (holdsIn_congr (fun y _ ↦ ?_)).mp h' + by_cases hyx : y = x + · subst hyx; simp + · simp [hyx] + · intro h a + refine (ih (Function.update v x a)).mpr ?_ + have h' := h a.raw + refine (holdsIn_congr (fun y _ ↦ ?_)).mp h' + by_cases hyx : y = x + · subst hyx; simp + · simp [hyx] + | ex x _ ih => + constructor + · rintro ⟨a, ha⟩ + refine ⟨a.raw, ?_⟩ + have h' := (ih (Function.update v x a)).mp ha + refine (holdsIn_congr (fun y _ ↦ ?_)).mp h' + by_cases hyx : y = x + · subst hyx; simp + · simp [hyx] + · rintro ⟨a, ha⟩ + refine ⟨⟨a⟩, (ih (Function.update v x ⟨a⟩)).mpr ?_⟩ + refine (holdsIn_congr (fun y _ ↦ ?_)).mp ha + by_cases hyx : y = x + · subst hyx; simp + · simp [hyx] + +end Structure + +section Model +variable {M : Type*} [PAStructure M] [PAModel M] + +instance : PAModel (PAM M) where + zero_ne_succ a h := PAModel.zero_ne_succ a.raw (congrArg PAM.raw h) + succ_inj h := PAM.ext (PAModel.succ_inj (congrArg PAM.raw h)) + add_zero a := PAM.ext (PAModel.add_zero a.raw) + add_succ a b := PAM.ext (PAModel.add_succ a.raw b.raw) + mul_zero a := PAM.ext (PAModel.mul_zero a.raw) + mul_succ a b := PAM.ext (PAModel.mul_succ a.raw b.raw) + ind x φ v h0 hs a := by + let vr : ℕ → M := fun y ↦ (v y).raw + have upd_eq : ∀ b : M, + (fun y ↦ (Function.update v x ⟨b⟩ y).raw) = Function.update vr x b := by + intro b + funext y + by_cases hyx : y = x + · subst hyx; simp [vr] + · simp [hyx, vr] + have h0' : PAFormula.HoldsIn (Function.update vr x PAStructure.zero) φ := by + have h0r := (holdsIn_iff_raw (Function.update v x 0) φ).mp h0 + change PAFormula.HoldsIn (fun y ↦ (Function.update v x ⟨PAStructure.zero⟩ y).raw) φ at h0r + rwa [upd_eq PAStructure.zero] at h0r + have hs' : ∀ b : M, PAFormula.HoldsIn (Function.update vr x b) φ → + PAFormula.HoldsIn (Function.update vr x (PAStructure.succ b)) φ := by + intro b hb + have hb_pam : PAFormula.HoldsIn (Function.update v x ⟨b⟩) φ := by + rw [holdsIn_iff_raw, upd_eq b] + exact hb + have hstep := (holdsIn_iff_raw (Function.update v x (succ ⟨b⟩)) φ).mp (hs ⟨b⟩ hb_pam) + change PAFormula.HoldsIn (fun y ↦ (Function.update v x ⟨PAStructure.succ b⟩ y).raw) φ at hstep + rwa [upd_eq (PAStructure.succ b)] at hstep + have hres := PAModel.ind x φ vr h0' hs' a.raw + rw [holdsIn_iff_raw] + change PAFormula.HoldsIn (fun y ↦ (Function.update v x ⟨a.raw⟩ y).raw) φ + rwa [upd_eq a.raw] + +theorem succ_eq_add_one (a : PAM M) : succ a = a + 1 := by + change PAStructure.succ a = PAStructure.add a (PAStructure.succ PAStructure.zero) + rw [PAModel.add_succ, PAModel.add_zero] + +theorem pam_add_zero (a : PAM M) : a + 0 = a := PAModel.add_zero a +theorem pam_add_succ (a b : PAM M) : a + succ b = succ (a + b) := PAModel.add_succ a b +theorem pam_mul_zero (a : PAM M) : a * 0 = 0 := PAModel.mul_zero a +theorem pam_mul_succ (a b : PAM M) : a * succ b = a * b + a := PAModel.mul_succ a b + +/-- First-order induction on `PAM M` for any predicate equivalent to a `PAFormula`. -/ +theorem ind_pred {P : PAM M → Prop} + (hdef : ∃ (x : ℕ) (φ : PAFormula) (v : ℕ → PAM M), + ∀ a : PAM M, PAFormula.HoldsIn (Function.update v x a) φ ↔ P a) + (h0 : P 0) (hs : ∀ a : PAM M, P a → P (a + 1)) : + ∀ a : PAM M, P a := by + rcases hdef with ⟨x, φ, v, hiff⟩ + intro a + refine (hiff a).mp (PAModel.ind x φ v ((hiff 0).mpr h0) (fun b hb ↦ ?_) a) + rw [show PAStructure.succ b = b + 1 from succ_eq_add_one b] + exact (hiff (b + 1)).mpr (hs b ((hiff b).mp hb)) + +theorem pam_zero_add (a : PAM M) : 0 + a = a := by + refine ind_pred (P := fun b : PAM M ↦ 0 + b = b) + ⟨0, .eq (.add .zero (.var 0)) (.var 0), fun _ ↦ 0, fun b ↦ ?_⟩ + (pam_add_zero 0) (fun b ih ↦ ?_) a + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [← succ_eq_add_one, pam_add_succ, ih] + +theorem pam_succ_add (a b : PAM M) : succ a + b = succ (a + b) := by + refine ind_pred (P := fun c : PAM M ↦ succ a + c = succ (a + c)) + ⟨0, .eq (.add (.succ (.var 1)) (.var 0)) (.succ (.add (.var 1) (.var 0))), + fun | 1 => a | _ => 0, fun c ↦ ?_⟩ ?_ (fun c ih ↦ ?_) b + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [pam_add_zero, pam_add_zero] + · rw [← succ_eq_add_one, pam_add_succ, pam_add_succ, ih] + +theorem pam_add_comm (a b : PAM M) : a + b = b + a := by + refine ind_pred (P := fun c : PAM M ↦ a + c = c + a) + ⟨0, .eq (.add (.var 1) (.var 0)) (.add (.var 0) (.var 1)), + fun | 1 => a | _ => 0, fun c ↦ ?_⟩ ?_ (fun c ih ↦ ?_) b + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [pam_add_zero, pam_zero_add] + · rw [← succ_eq_add_one, pam_add_succ, pam_succ_add, ih] + +theorem pam_add_assoc (a b c : PAM M) : a + b + c = a + (b + c) := by + refine ind_pred (P := fun d : PAM M ↦ a + b + d = a + (b + d)) + ⟨0, .eq (.add (.add (.var 1) (.var 2)) (.var 0)) (.add (.var 1) (.add (.var 2) (.var 0))), + fun | 1 => a | 2 => b | _ => 0, fun d ↦ ?_⟩ ?_ (fun d ih ↦ ?_) c + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [pam_add_zero, pam_add_zero] + · rw [← succ_eq_add_one, pam_add_succ, pam_add_succ, pam_add_succ, ih] + +theorem pam_zero_mul (a : PAM M) : 0 * a = 0 := by + refine ind_pred (P := fun b : PAM M ↦ 0 * b = 0) + ⟨0, .eq (.mul .zero (.var 0)) .zero, fun _ ↦ 0, fun b ↦ ?_⟩ + (pam_mul_zero 0) (fun b ih ↦ ?_) a + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [← succ_eq_add_one, pam_mul_succ, ih, pam_add_zero] + +theorem pam_succ_mul (a b : PAM M) : succ a * b = a * b + b := by + refine ind_pred (P := fun c : PAM M ↦ succ a * c = a * c + c) + ⟨0, .eq (.mul (.succ (.var 1)) (.var 0)) (.add (.mul (.var 1) (.var 0)) (.var 0)), + fun | 1 => a | _ => 0, fun c ↦ ?_⟩ ?_ (fun c ih ↦ ?_) b + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [pam_mul_zero, pam_mul_zero, pam_add_zero] + · rw [← succ_eq_add_one, pam_mul_succ, pam_mul_succ, ih, succ_eq_add_one a, succ_eq_add_one c] + calc a * c + c + (a + 1) + _ = a * c + (c + (a + 1)) := pam_add_assoc _ _ _ + _ = a * c + (a + (c + 1)) := by + rw [← pam_add_assoc c a 1, pam_add_comm c a, pam_add_assoc a c 1] + _ = a * c + a + (c + 1) := (pam_add_assoc _ _ _).symm + +theorem pam_mul_comm (a b : PAM M) : a * b = b * a := by + refine ind_pred (P := fun c : PAM M ↦ a * c = c * a) + ⟨0, .eq (.mul (.var 1) (.var 0)) (.mul (.var 0) (.var 1)), + fun | 1 => a | _ => 0, fun c ↦ ?_⟩ ?_ (fun c ih ↦ ?_) b + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [pam_mul_zero, pam_zero_mul] + · rw [← succ_eq_add_one, pam_mul_succ, pam_succ_mul, ih] + +theorem pam_left_distrib (a b c : PAM M) : a * (b + c) = a * b + a * c := by + refine ind_pred (P := fun d : PAM M ↦ a * (b + d) = a * b + a * d) + ⟨0, .eq (.mul (.var 1) (.add (.var 2) (.var 0))) + (.add (.mul (.var 1) (.var 2)) (.mul (.var 1) (.var 0))), + fun | 1 => a | 2 => b | _ => 0, fun d ↦ ?_⟩ ?_ (fun d ih ↦ ?_) c + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [pam_add_zero, pam_mul_zero, pam_add_zero] + · rw [← succ_eq_add_one, pam_add_succ, pam_mul_succ, pam_mul_succ, ih, pam_add_assoc] + +theorem pam_right_distrib (a b c : PAM M) : (a + b) * c = a * c + b * c := by + rw [pam_mul_comm, pam_left_distrib, pam_mul_comm c a, pam_mul_comm c b] + +theorem pam_mul_assoc (a b c : PAM M) : a * b * c = a * (b * c) := by + refine ind_pred (P := fun d : PAM M ↦ a * b * d = a * (b * d)) + ⟨0, .eq (.mul (.mul (.var 1) (.var 2)) (.var 0)) (.mul (.var 1) (.mul (.var 2) (.var 0))), + fun | 1 => a | 2 => b | _ => 0, fun d ↦ ?_⟩ ?_ (fun d ih ↦ ?_) c + · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl + · rw [pam_mul_zero, pam_mul_zero, pam_mul_zero] + · rw [← succ_eq_add_one, pam_mul_succ, pam_mul_succ, pam_left_distrib, ih] + +theorem pam_mul_one (a : PAM M) : a * 1 = a := by + change a * succ 0 = a + rw [pam_mul_succ, pam_mul_zero, pam_zero_add] + +theorem pam_one_mul (a : PAM M) : 1 * a = a := by + rw [pam_mul_comm, pam_mul_one] + +/-- Standard natural cast into `PAM M`. -/ +def ofNat (n : ℕ) : PAM M := + match n with + | 0 => 0 + | n + 1 => ofNat n + 1 + +instance : CommSemiring (PAM M) where + add := (· + ·) + add_assoc := pam_add_assoc + zero := 0 + zero_add := pam_zero_add + add_zero := pam_add_zero + nsmul := nsmulRec + add_comm := pam_add_comm + mul := (· * ·) + left_distrib := pam_left_distrib + right_distrib := pam_right_distrib + zero_mul := pam_zero_mul + mul_zero := pam_mul_zero + mul_assoc := pam_mul_assoc + one := 1 + one_mul := pam_one_mul + mul_one := pam_mul_one + natCast := ofNat + natCast_zero := rfl + natCast_succ _ := rfl + npow := npowRec + mul_comm := pam_mul_comm + +omit [PAModel M] in +@[simp] +theorem evalIn_zero (v : ℕ → PAM M) : PATerm.evalIn v .zero = 0 := rfl + +omit [PAModel M] in +@[simp] +theorem evalIn_var (v : ℕ → PAM M) (x : ℕ) : PATerm.evalIn v (.var x) = v x := rfl + +@[simp] +theorem evalIn_succ (v : ℕ → PAM M) (t : PATerm) : + PATerm.evalIn v (.succ t) = PATerm.evalIn v t + 1 := + succ_eq_add_one (PATerm.evalIn v t) + +omit [PAModel M] in +@[simp] +theorem evalIn_add (v : ℕ → PAM M) (t₁ t₂ : PATerm) : + PATerm.evalIn v (.add t₁ t₂) = PATerm.evalIn v t₁ + PATerm.evalIn v t₂ := rfl + +omit [PAModel M] in +@[simp] +theorem evalIn_mul (v : ℕ → PAM M) (t₁ t₂ : PATerm) : + PATerm.evalIn v (.mul t₁ t₂) = PATerm.evalIn v t₁ * PATerm.evalIn v t₂ := rfl + +@[simp] +theorem evalIn_ofNat (v : ℕ → PAM M) (n : ℕ) : + PATerm.evalIn v (.ofNat n) = (n : PAM M) := by + induction n with + | zero => rfl + | succ n ih => simp [PATerm.ofNat, ih] + +/-- Every element of `PAM M` is either `0` or a successor `b + 1`. -/ +theorem eq_zero_or_exists_succ (a : PAM M) : a = 0 ∨ ∃ b : PAM M, a = b + 1 := by + refine ind_pred (P := fun c : PAM M ↦ c = 0 ∨ ∃ b : PAM M, c = b + 1) + ⟨0, .or (.eq (.var 0) .zero) (.ex 1 (.eq (.var 0) (.succ (.var 1)))), + fun _ ↦ 0, fun c ↦ ?_⟩ (Or.inl rfl) (fun c _ ↦ Or.inr ⟨c, rfl⟩) a + simp [PAFormula.HoldsIn] + +theorem add_one_ne_zero (a : PAM M) : a + 1 ≠ 0 := by + rw [← succ_eq_add_one] + exact PAModel.zero_ne_succ a + +theorem add_right_inj_pam {a b : PAM M} (c : PAM M) : a + c = b + c ↔ a = b := by + refine ⟨?_, fun h ↦ h ▸ rfl⟩ + refine ind_pred (P := fun d ↦ a + d = b + d → a = b) + ⟨0, .imp (.eq (.add (.var 1) (.var 0)) (.add (.var 2) (.var 0))) + (.eq (.var 1) (.var 2)), fun | 1 => a | 2 => b | _ => 0, fun d ↦ ?_⟩ + (fun h ↦ by simpa using h) (fun d ih h ↦ ?_) c + · simp [PAFormula.HoldsIn] + · have h' : succ (a + d) = succ (b + d) := by + rw [succ_eq_add_one, succ_eq_add_one, add_assoc, add_assoc] + exact h + exact ih (PAModel.succ_inj h') + +theorem add_left_inj_pam {a b : PAM M} (c : PAM M) : c + a = c + b ↔ a = b := by + rw [add_comm c a, add_comm c b] + exact add_right_inj_pam c + +theorem add_eq_zero_iff_pam {a b : PAM M} : a + b = 0 ↔ a = 0 ∧ b = 0 := by + refine ⟨fun h ↦ ?_, fun ⟨ha, hb⟩ ↦ by rw [ha, hb, add_zero]⟩ + rcases eq_zero_or_exists_succ b with rfl | ⟨b', rfl⟩ + · rw [add_zero] at h + exact ⟨h, rfl⟩ + · rw [← add_assoc] at h + exact absurd h (add_one_ne_zero (a + b')) + +theorem mul_eq_zero_iff_pam {a b : PAM M} : a * b = 0 ↔ a = 0 ∨ b = 0 := by + refine ⟨fun h ↦ ?_, fun h ↦ h.elim (fun ha ↦ by rw [ha, zero_mul]) + (fun hb ↦ by rw [hb, mul_zero])⟩ + rcases eq_zero_or_exists_succ a with rfl | ⟨a', rfl⟩ + · exact Or.inl rfl + · rcases eq_zero_or_exists_succ b with rfl | ⟨b', rfl⟩ + · exact Or.inr rfl + · have hexp : (a' + 1) * (b' + 1) = (a' * b' + a' + b') + 1 := by ring + rw [hexp] at h + exact absurd h (add_one_ne_zero _) + +/-! ## Section 2: Total Linear Order, Truncated Subtraction, and `ℕ` Embedding -/ + +instance : LE (PAM M) := ⟨fun a b ↦ ∃ k : PAM M, a + k = b⟩ +instance : LT (PAM M) := ⟨fun a b ↦ a + 1 ≤ b⟩ + +omit [PAModel M] in +theorem le_def {a b : PAM M} : a ≤ b ↔ ∃ k : PAM M, a + k = b := Iff.rfl + +omit [PAModel M] in +theorem lt_def {a b : PAM M} : a < b ↔ a + 1 ≤ b := Iff.rfl + +omit [PAModel M] in +theorem evalIn_update_of_freshVar_le (v : ℕ → PAM M) {t : PATerm} {x : ℕ} (a : PAM M) + (h : t.freshVar ≤ x) : PATerm.evalIn (Function.update v x a) t = PATerm.evalIn v t := + evalIn_update_of_hasVar_false v a (hasVar_false_of_freshVar_le h) + +omit [PAModel M] in +theorem paLe_holdsIn_iff (v : ℕ → PAM M) (a b : PATerm) : + PAFormula.HoldsIn v (paLe a b) ↔ PATerm.evalIn v a ≤ PATerm.evalIn v b := by + unfold paLe + set k := max a.freshVar b.freshVar + have ha : a.freshVar ≤ k := Nat.le_max_left _ _ + have hb : b.freshVar ≤ k := Nat.le_max_right _ _ + simp only [PAFormula.HoldsIn, evalIn_add, evalIn_var, + evalIn_update_of_freshVar_le v _ ha, evalIn_update_of_freshVar_le v _ hb, + Function.update_self] + rfl + +theorem paLt_holdsIn_iff (v : ℕ → PAM M) (a b : PATerm) : + PAFormula.HoldsIn v (paLt a b) ↔ PATerm.evalIn v a < PATerm.evalIn v b := by + unfold paLt + rw [paLe_holdsIn_iff, evalIn_succ] + rfl + +theorem pam_le_refl (a : PAM M) : a ≤ a := ⟨0, add_zero a⟩ + +theorem pam_le_trans {a b c : PAM M} : a ≤ b → b ≤ c → a ≤ c := by + rintro ⟨k₁, rfl⟩ ⟨k₂, rfl⟩ + exact ⟨k₁ + k₂, (add_assoc a k₁ k₂).symm⟩ + +theorem pam_le_antisymm {a b : PAM M} : a ≤ b → b ≤ a → a = b := by + rintro ⟨k₁, rfl⟩ ⟨k₂, h⟩ + have hk : a + (k₁ + k₂) = a + 0 := by rw [← add_assoc, h, add_zero] + have h0 : k₁ + k₂ = 0 := (add_left_inj_pam a).mp hk + rw [(add_eq_zero_iff_pam.mp h0).1, add_zero] + +theorem zero_le_pam (a : PAM M) : 0 ≤ a := ⟨a, zero_add a⟩ + +theorem pam_le_total (a b : PAM M) : a ≤ b ∨ b ≤ a := by + refine ind_pred (P := fun c : PAM M ↦ a ≤ c ∨ c ≤ a) + ⟨0, .or (paLe (.var 1) (.var 0)) (paLe (.var 0) (.var 1)), + fun | 1 => a | _ => 0, fun c ↦ ?_⟩ (Or.inr (zero_le_pam a)) (fun c ih ↦ ?_) b + · simp [PAFormula.HoldsIn, paLe_holdsIn_iff] + · rcases ih with ⟨k, rfl⟩ | ⟨k, hk⟩ + · exact Or.inl ⟨k + 1, by ring⟩ + · rcases eq_zero_or_exists_succ k with rfl | ⟨k', rfl⟩ + · rw [add_zero] at hk + subst hk + exact Or.inl ⟨1, rfl⟩ + · exact Or.inr ⟨k', by rw [← hk]; ring⟩ + +theorem pam_lt_iff_le_not_ge (a b : PAM M) : a < b ↔ a ≤ b ∧ ¬ b ≤ a := by + constructor + · rintro ⟨k, rfl⟩ + refine ⟨⟨1 + k, by ring⟩, ?_⟩ + rintro ⟨m, hm⟩ + have h0 : a + ((k + m) + 1) = a + 0 := by + calc a + ((k + m) + 1) + _ = a + 1 + k + m := by ring + _ = a := hm + _ = a + 0 := (add_zero a).symm + exact add_one_ne_zero (k + m) ((add_left_inj_pam a).mp h0) + · rintro ⟨⟨k, rfl⟩, hnot⟩ + rcases eq_zero_or_exists_succ k with rfl | ⟨k', rfl⟩ + · rw [add_zero] at hnot + exact absurd (pam_le_refl a) hnot + · exact ⟨k', by ring⟩ + +noncomputable instance : LinearOrder (PAM M) where + le := (· ≤ ·) + lt := (· < ·) + le_refl := pam_le_refl + le_trans := @pam_le_trans M _ _ + lt_iff_le_not_ge := pam_lt_iff_le_not_ge + le_antisymm := @pam_le_antisymm M _ _ + le_total := pam_le_total + toDecidableLE := Classical.decRel _ + toDecidableEq := Classical.decEq _ + toDecidableLT := Classical.decRel _ + +@[simp] +theorem not_lt_zero_pam (a : PAM M) : ¬ a < 0 := + not_lt_of_ge (zero_le_pam a) + +theorem le_zero_iff_pam {a : PAM M} : a ≤ 0 ↔ a = 0 := + ⟨fun h ↦ le_antisymm h (zero_le_pam a), fun h ↦ h ▸ le_rfl⟩ + +theorem pos_iff_ne_zero_pam {a : PAM M} : 0 < a ↔ a ≠ 0 := by + constructor + · rintro h rfl + exact lt_irrefl 0 h + · intro h + rcases eq_zero_or_exists_succ a with rfl | ⟨b, rfl⟩ + · exact absurd rfl h + · exact ⟨b, by ring⟩ + +@[simp] +theorem lt_succ_self_pam (a : PAM M) : a < a + 1 := + ⟨0, add_zero (a + 1)⟩ + +theorem lt_add_one_iff_le {a b : PAM M} : a < b + 1 ↔ a ≤ b := by + constructor + · rintro ⟨k, hk⟩ + exact ⟨k, (add_right_inj_pam 1).mp (by rw [← hk]; ring)⟩ + · rintro ⟨k, rfl⟩ + exact ⟨k, by ring⟩ + +theorem le_add_one_iff {a b : PAM M} : a ≤ b + 1 ↔ a ≤ b ∨ a = b + 1 := by + constructor + · rintro ⟨k, hk⟩ + rcases eq_zero_or_exists_succ k with rfl | ⟨k', rfl⟩ + · rw [add_zero] at hk + exact Or.inr hk + · exact Or.inl ⟨k', (add_right_inj_pam 1).mp (by rw [← hk]; ring)⟩ + · rintro (⟨k, rfl⟩ | rfl) + · exact ⟨k + 1, by ring⟩ + · exact le_rfl + +theorem add_le_add_pam {a b c d : PAM M} (h₁ : a ≤ b) (h₂ : c ≤ d) : a + c ≤ b + d := by + rcases h₁ with ⟨k₁, rfl⟩ + rcases h₂ with ⟨k₂, rfl⟩ + exact ⟨k₁ + k₂, by ring⟩ + +theorem add_lt_add_left_pam {a b : PAM M} (h : a < b) (c : PAM M) : c + a < c + b := by + rcases h with ⟨k, rfl⟩ + exact ⟨k, by ring⟩ + +theorem add_lt_add_right_pam {a b : PAM M} (h : a < b) (c : PAM M) : a + c < b + c := by + rw [add_comm a c, add_comm b c] + exact add_lt_add_left_pam h c + +omit [PAModel M] in +theorem le_add_right_pam (a b : PAM M) : a ≤ a + b := ⟨b, rfl⟩ +theorem le_add_left_pam (a b : PAM M) : a ≤ b + a := ⟨b, add_comm a b⟩ + +theorem mul_le_mul_pam {a b c d : PAM M} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d := by + rcases h₁ with ⟨k₁, rfl⟩ + rcases h₂ with ⟨k₂, rfl⟩ + exact ⟨a * k₂ + k₁ * c + k₁ * k₂, by ring⟩ + +theorem mul_lt_mul_of_pos_left_pam {a b c : PAM M} (h : a < b) (hc : 0 < c) : + c * a < c * b := by + rcases h with ⟨k, rfl⟩ + rcases eq_zero_or_exists_succ c with rfl | ⟨c', rfl⟩ + · exact absurd rfl (ne_of_gt hc) + · exact ⟨c' + (c' + 1) * k, by ring⟩ + +theorem mul_left_cancel_pam {a b c : PAM M} (hc : c ≠ 0) (h : c * a = c * b) : a = b := by + have hc_pos : 0 < c := pos_iff_ne_zero_pam.mpr hc + rcases lt_trichotomy a b with hlt | rfl | hgt + · exact absurd h (ne_of_lt (mul_lt_mul_of_pos_left_pam hlt hc_pos)) + · rfl + · exact absurd h (ne_of_gt (mul_lt_mul_of_pos_left_pam hgt hc_pos)) + +/-- Truncated subtraction on `PAM M`: returns the unique `k` with `b + k = a` when `b ≤ a`, +and `0` otherwise. -/ +noncomputable instance : Sub (PAM M) := + ⟨fun a b ↦ if h : b ≤ a then Classical.choose h else 0⟩ + +theorem add_sub_of_le_pam {a b : PAM M} (h : b ≤ a) : b + (a - b) = a := by + change b + (if h' : b ≤ a then Classical.choose h' else 0) = a + rw [dite_eq_left_of_eq_true (eq_true h)] + exact Classical.choose_spec h + +theorem sub_add_cancel_pam {a b : PAM M} (h : b ≤ a) : a - b + b = a := by + rw [add_comm] + exact add_sub_of_le_pam h + +theorem sub_eq_iff_eq_add_pam {a b c : PAM M} (h : b ≤ a) : a - b = c ↔ a = b + c := by + constructor + · rintro rfl + exact (add_sub_of_le_pam h).symm + · intro heq + exact (add_left_inj_pam b).mp (by rw [add_sub_of_le_pam h, heq]) + +@[simp] +theorem add_sub_cancel_right_pam (a b : PAM M) : a + b - b = a := by + rw [sub_eq_iff_eq_add_pam (le_add_left_pam b a), add_comm] + +@[simp] +theorem add_sub_cancel_left_pam (a b : PAM M) : a + b - a = b := + (sub_eq_iff_eq_add_pam (le_add_right_pam a b)).mpr rfl + +theorem sub_eq_zero_of_le_pam {a b : PAM M} (h : a ≤ b) : a - b = 0 := by + by_cases hba : b ≤ a + · have hab : a = b := le_antisymm h hba + subst hab + exact (sub_eq_iff_eq_add_pam le_rfl).mpr (add_zero a).symm + · change (if h' : b ≤ a then Classical.choose h' else 0) = 0 + exact dite_eq_right_of_eq_false (eq_false hba) + +@[simp] +theorem sub_self_pam (a : PAM M) : a - a = 0 := + sub_eq_zero_of_le_pam le_rfl + +/-- Initial-segment property: any element of `PAM M` strictly below a standard numeral `(n : PAM M)` +is itself a standard numeral `(k : PAM M)` with `k < n`. -/ +theorem lt_natCast_iff {a : PAM M} {n : ℕ} : + a < (n : PAM M) ↔ ∃ k : ℕ, k < n ∧ a = (k : PAM M) := by + induction n with + | zero => + simp only [Nat.cast_zero, not_lt_zero_pam, Nat.not_lt_zero, false_and, exists_false] + | succ n ih => + rw [Nat.cast_succ, lt_add_one_iff_le, le_iff_lt_or_eq, ih] + constructor + · rintro (⟨k, hk, rfl⟩ | rfl) + · exact ⟨k, Nat.lt_succ_of_lt hk, rfl⟩ + · exact ⟨n, Nat.lt_succ_self n, rfl⟩ + · rintro ⟨k, hk, rfl⟩ + rcases Nat.lt_succ_iff_lt_or_eq.mp hk with hlt | rfl + · exact Or.inl ⟨k, hlt, rfl⟩ + · exact Or.inr rfl + +theorem le_natCast_iff {a : PAM M} {n : ℕ} : + a ≤ (n : PAM M) ↔ ∃ k : ℕ, k ≤ n ∧ a = (k : PAM M) := by + rw [← lt_add_one_iff_le, ← Nat.cast_succ, lt_natCast_iff] + exact exists_congr fun k ↦ and_congr Nat.lt_succ_iff Iff.rfl + +@[simp] +theorem natCast_lt_iff {m n : ℕ} : (m : PAM M) < (n : PAM M) ↔ m < n := by + constructor + · intro h + obtain ⟨k, hk, heq⟩ := lt_natCast_iff.mp h + by_contra hge + have hle : (n : PAM M) ≤ (m : PAM M) := by + obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le (Nat.le_of_not_lt hge) + rw [Nat.cast_add] + exact le_add_right_pam _ _ + exact not_lt_of_ge hle h + · intro h + obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_lt h + rw [Nat.cast_add, Nat.cast_add, Nat.cast_one] + exact ⟨(d : PAM M), by ring⟩ + +@[simp] +theorem natCast_le_iff {m n : ℕ} : (m : PAM M) ≤ (n : PAM M) ↔ m ≤ n := by + rw [← not_lt, ← Nat.not_lt, natCast_lt_iff] + +@[simp] +theorem natCast_inj_pam {m n : ℕ} : (m : PAM M) = (n : PAM M) ↔ m = n := by + constructor + · intro h + exact Nat.le_antisymm (natCast_le_iff.mp (le_of_eq h)) (natCast_le_iff.mp (le_of_eq h.symm)) + · rintro rfl; rfl + +theorem zero_lt_one_pam : (0 : PAM M) < 1 := by + simpa using (natCast_lt_iff (M := M) (m := 0) (n := 1)).mpr (by decide) + +theorem zero_lt_two_pam : (0 : PAM M) < 2 := by + simpa using (natCast_lt_iff (M := M) (m := 0) (n := 2)).mpr (by decide) + +theorem one_ne_zero_pam : (1 : PAM M) ≠ 0 := + ne_of_gt zero_lt_one_pam + +theorem two_ne_zero_pam : (2 : PAM M) ≠ 0 := + ne_of_gt zero_lt_two_pam + +omit [PAStructure M] [PAModel M] in +theorem hasFree_false_of_maxVar_le_pam {φ : PAFormula} {w : ℕ} (h : φ.maxVar ≤ w) : + φ.hasFree w = false := by + induction φ with + | bot => rfl + | eq t₁ t₂ => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp [PAFormula.hasFree, hasVar_false_of_freshVar_le h.1, hasVar_false_of_freshVar_le h.2] + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp [PAFormula.hasFree, ih₁ h.1, ih₂ h.2] + | all _ _ ih | ex _ _ ih => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp [PAFormula.hasFree, ih h.2] + +omit [PAStructure M] [PAModel M] in +theorem freeFor_var_of_maxVar_le_pam {φ : PAFormula} {x w : ℕ} (h : φ.maxVar ≤ w) : + φ.freeFor x (.var w) = true := by + induction φ with + | bot | eq _ _ => rfl + | and _ _ ih₁ ih₂ | or _ _ ih₁ ih₂ | imp _ _ ih₁ ih₂ => + simp only [PAFormula.maxVar, Nat.max_le] at h + simp [PAFormula.freeFor, ih₁ h.1, ih₂ h.2] + | all z _ ih | ex z _ ih => + simp only [PAFormula.maxVar, Nat.max_le] at h + have hwz : w ≠ z := by omega + simp [PAFormula.freeFor, PATerm.hasVar, hwz, ih h.2] + +/-- Strong first-order induction on `PAM M` for any predicate equivalent to a `PAFormula`. -/ +theorem strong_ind_pred {P : PAM M → Prop} + (hdef : ∃ (x : ℕ) (φ : PAFormula) (v : ℕ → PAM M), + ∀ a : PAM M, PAFormula.HoldsIn (Function.update v x a) φ ↔ P a) + (hstep : ∀ a : PAM M, (∀ b < a, P b) → P a) : + ∀ a : PAM M, P a := by + rcases hdef with ⟨x, φ, v, hiff⟩ + let y := max (x + 1) φ.maxVar + have hyx : y ≠ x := by omega + have hmax : φ.maxVar ≤ y := Nat.le_max_right _ _ + have hf_xy : φ.freeFor x (.var y) = true := freeFor_var_of_maxVar_le_pam hmax + have hno_y : φ.hasFree y = false := hasFree_false_of_maxVar_le_pam hmax + let ψ : PAFormula := .all y (.imp (paLe (.var y) (.var x)) (φ.subst x (.var y))) + have hψ : ∀ n : PAM M, + PAFormula.HoldsIn (Function.update v x n) ψ ↔ ∀ b ≤ n, P b := by + intro n + simp only [ψ, PAFormula.HoldsIn] + refine forall_congr' fun b ↦ ?_ + set u := Function.update (Function.update v x n) y b + have hu_y : u y = b := by simp [u] + have hu_x : u x = n := by simp [u, hyx.symm] + have hsub := holdsIn_subst u hf_xy + have heq_u : Function.update u x (PATerm.evalIn u (.var y)) = + Function.update (Function.update v y b) x b := by + funext z + by_cases hzx : z = x + · subst hzx; simp [u] + · by_cases hzy : z = y + · subst hzy; simp [u, hzx] + · simp [u, hzx, hzy] + have hy_drop : PAFormula.HoldsIn (Function.update (Function.update v y b) x b) φ ↔ + PAFormula.HoldsIn (Function.update v x b) φ := by + rw [Function.update_comm hyx] + exact holdsIn_update_of_hasFree_false _ b hno_y + rw [paLe_holdsIn_iff, evalIn_var, evalIn_var, hu_y, hu_x, hsub, heq_u, hy_drop, hiff b] + have hall : ∀ n : PAM M, ∀ b ≤ n, P b := by + refine ind_pred (P := fun n ↦ ∀ b ≤ n, P b) ⟨x, ψ, v, hψ⟩ ?_ ?_ + · intro b hb + rw [le_zero_iff_pam.mp hb] + exact hstep 0 fun c hc ↦ absurd hc (not_lt_zero_pam c) + · intro n ih b hb + rcases le_iff_lt_or_eq.mp hb with hlt | rfl + · exact ih b (lt_add_one_iff_le.mp hlt) + · exact hstep (n + 1) fun c hc ↦ ih c (lt_add_one_iff_le.mp hc) + exact fun a ↦ hall a a le_rfl + +/-! ## Section 3: Euclidean Division, Parity, and Binary Half-Tapes -/ + +theorem div_mod_exists {b : PAM M} (hb : 0 < b) (a : PAM M) : + ∃ q r : PAM M, a = b * q + r ∧ r < b := by + refine ind_pred (P := fun c ↦ ∃ q r : PAM M, c = b * q + r ∧ r < b) + ⟨0, .ex 2 (.ex 3 (.and (.eq (.var 0) (.add (.mul (.var 1) (.var 2)) (.var 3))) + (paLt (.var 3) (.var 1)))), + fun | 1 => b | _ => 0, fun c ↦ ?_⟩ ⟨0, 0, by simp, hb⟩ (fun c ih ↦ ?_) a + · simp [PAFormula.HoldsIn, paLt_holdsIn_iff] + · rcases ih with ⟨q, r, rfl, hr⟩ + by_cases hrb : r + 1 = b + · exact ⟨q + 1, 0, by rw [← hrb]; ring, hb⟩ + · refine ⟨q, r + 1, by ring, ?_⟩ + exact lt_of_le_of_ne hr hrb + +theorem div_mod_unique {b q₁ r₁ q₂ r₂ : PAM M} (hr₁ : r₁ < b) (hr₂ : r₂ < b) + (h : b * q₁ + r₁ = b * q₂ + r₂) : q₁ = q₂ ∧ r₁ = r₂ := by + have hq : q₁ = q₂ := by + rcases lt_trichotomy q₁ q₂ with hlt | rfl | hgt + · rcases hlt with ⟨k, rfl⟩ + rcases hr₁ with ⟨m, hm⟩ + have hbad : b * q₁ + r₁ + (m + 1 + b * k + r₂) = b * q₁ + r₁ + 0 := by + calc b * q₁ + r₁ + (m + 1 + b * k + r₂) + _ = b * q₁ + (r₁ + 1 + m) + b * k + r₂ := by ring + _ = b * q₁ + b + b * k + r₂ := by rw [hm] + _ = b * (q₁ + 1 + k) + r₂ := by ring + _ = b * q₁ + r₁ := h.symm + _ = b * q₁ + r₁ + 0 := (add_zero _).symm + have h0 : m + b * k + r₂ + 1 = 0 := by + have := (add_left_inj_pam (b * q₁ + r₁)).mp hbad + rw [show m + b * k + r₂ + 1 = m + 1 + b * k + r₂ by ring] + exact this + exact absurd h0 (add_one_ne_zero _) + · rfl + · rcases hgt with ⟨k, rfl⟩ + rcases hr₂ with ⟨m, hm⟩ + have hbad : b * q₂ + r₂ + (m + 1 + b * k + r₁) = b * q₂ + r₂ + 0 := by + calc b * q₂ + r₂ + (m + 1 + b * k + r₁) + _ = b * q₂ + (r₂ + 1 + m) + b * k + r₁ := by ring + _ = b * q₂ + b + b * k + r₁ := by rw [hm] + _ = b * (q₂ + 1 + k) + r₁ := by ring + _ = b * q₂ + r₂ := h + _ = b * q₂ + r₂ + 0 := (add_zero _).symm + have h0 : m + b * k + r₁ + 1 = 0 := by + have := (add_left_inj_pam (b * q₂ + r₂)).mp hbad + rw [show m + b * k + r₁ + 1 = m + 1 + b * k + r₁ by ring] + exact this + exact absurd h0 (add_one_ne_zero _) + subst hq + exact ⟨rfl, (add_left_inj_pam (b * q₁)).mp h⟩ + +noncomputable instance : Div (PAM M) := + ⟨fun a b ↦ if hb : 0 < b then Classical.choose (div_mod_exists hb a) else 0⟩ + +noncomputable instance : Mod (PAM M) := + ⟨fun a b ↦ if hb : 0 < b then + Classical.choose (Classical.choose_spec (div_mod_exists hb a)) else a⟩ + +theorem div_add_mod_pam (a b : PAM M) : b * (a / b) + a % b = a := by + by_cases hb : 0 < b + · have hq : a / b = Classical.choose (div_mod_exists hb a) := + dite_eq_left_of_eq_true (eq_true hb) + have hr : a % b = Classical.choose (Classical.choose_spec (div_mod_exists hb a)) := + dite_eq_left_of_eq_true (eq_true hb) + rw [hq, hr] + exact (Classical.choose_spec (Classical.choose_spec (div_mod_exists hb a))).1.symm + · have h0 : b = 0 := le_zero_iff_pam.mp (le_of_not_gt hb) + subst h0 + have hr : a % (0 : PAM M) = a := dite_eq_right_of_eq_false (eq_false (lt_irrefl 0)) + rw [hr, zero_mul, zero_add] + +theorem mod_lt_pam (a : PAM M) {b : PAM M} (hb : 0 < b) : a % b < b := by + have hr : a % b = Classical.choose (Classical.choose_spec (div_mod_exists hb a)) := + dite_eq_left_of_eq_true (eq_true hb) + rw [hr] + exact (Classical.choose_spec (Classical.choose_spec (div_mod_exists hb a))).2 + +theorem div_mod_eq_iff {a b q r : PAM M} (hr : r < b) : + a / b = q ∧ a % b = r ↔ a = b * q + r := by + have hb : 0 < b := lt_of_le_of_lt (zero_le_pam r) hr + constructor + · rintro ⟨rfl, rfl⟩ + exact (div_add_mod_pam a b).symm + · intro ha + exact div_mod_unique (mod_lt_pam a hb) hr (by rw [div_add_mod_pam, ha]) + +theorem mod_eq_of_lt_pam {a b : PAM M} (h : a < b) : a % b = a := + ((div_mod_eq_iff (q := 0) h).mpr (by ring)).2 + +theorem add_mul_mod_self_left_pam (r m q : PAM M) : (r + m * q) % m = r % m := by + by_cases hm : 0 < m + · have h1 := div_add_mod_pam r m + refine ((div_mod_eq_iff (q := r / m + q) (mod_lt_pam r hm)).mpr ?_).2 + calc r + m * q + _ = (m * (r / m) + r % m) + m * q := congrArg (· + m * q) h1.symm + _ = m * (r / m + q) + r % m := by ring + · have hm0 : m = 0 := le_zero_iff_pam.mp (le_of_not_gt hm) + subst hm0 + simp + +@[simp] +theorem natCast_div_mod (a b : ℕ) (hb : 0 < b) : + ((a : PAM M) / (b : PAM M)) = ((a / b : ℕ) : PAM M) ∧ + ((a : PAM M) % (b : PAM M)) = ((a % b : ℕ) : PAM M) := by + refine (div_mod_eq_iff (natCast_lt_iff.mpr (Nat.mod_lt a hb))).mpr ?_ + rw [← Nat.cast_mul, ← Nat.cast_add, Nat.div_add_mod] + +/-- Low bit (`Fin 2`) of an element of `PAM M`. -/ +noncomputable def mBit (a : PAM M) : Fin 2 := + if a % 2 = 0 then 0 else 1 + +/-- Halving `a / 2` on `PAM M`. -/ +noncomputable def mHalf (a : PAM M) : PAM M := + a / 2 + +/-- Binary half-tape cons `2 * x + b.val` on `PAM M`. -/ +def mCons (b : Fin 2) (x : PAM M) : PAM M := + 2 * x + (b.val : PAM M) + +theorem mod_two_eq_zero_or_one (a : PAM M) : a % 2 = 0 ∨ a % 2 = 1 := by + have hlt : a % 2 < ((2 : ℕ) : PAM M) := by simpa using mod_lt_pam a zero_lt_two_pam + obtain ⟨k, hk, heq⟩ := lt_natCast_iff.mp hlt + rcases k with _ | _ | k + · exact Or.inl (by simpa using heq) + · exact Or.inr (by simpa using heq) + · omega + +theorem mBit_val_eq_mod (a : PAM M) : ((mBit a).val : PAM M) = a % 2 := by + unfold mBit + rcases mod_two_eq_zero_or_one a with h0 | h1 + · simp [h0] + · simp [h1, one_ne_zero_pam] + +@[simp] +theorem mCons_mBit_mHalf (a : PAM M) : mCons (mBit a) (mHalf a) = a := by + unfold mCons mHalf + rw [mBit_val_eq_mod] + exact div_add_mod_pam a 2 + +@[simp] +theorem mBit_mCons (b : Fin 2) (x : PAM M) : mBit (mCons b x) = b := by + rcases b with ⟨_ | _ | k, hk⟩ + · change mBit (mCons 0 x) = 0 + have hdm := (div_mod_eq_iff (a := mCons 0 x) (b := 2) (q := x) zero_lt_two_pam).mpr + (by simp [mCons]) + simp [mBit, hdm.2] + · change mBit (mCons 1 x) = 1 + have hlt : (1 : PAM M) < 2 := ⟨0, by ring⟩ + have hdm := (div_mod_eq_iff (a := mCons 1 x) (b := 2) (q := x) hlt).mpr + (by simp [mCons]) + simp [mBit, hdm.2, one_ne_zero_pam] + · omega + +@[simp] +theorem mHalf_mCons (b : Fin 2) (x : PAM M) : mHalf (mCons b x) = x := by + have hlt : (b.val : PAM M) < 2 := by + simpa using (natCast_lt_iff (M := M) (m := b.val) (n := 2)).mpr b.isLt + exact ((div_mod_eq_iff (a := mCons b x) (b := 2) (q := x) hlt).mpr rfl).1 + +@[simp] +theorem mBit_zero : mBit (0 : PAM M) = 0 := by + have := mBit_mCons (M := M) 0 0 + simpa [mCons] using this + +@[simp] +theorem mHalf_zero : mHalf (0 : PAM M) = 0 := by + have := mHalf_mCons (M := M) 0 0 + simpa [mCons] using this + +/-! ## Section 4: Bijective Cantor Pairing `mPair` / `mUnpair` -/ + +theorem two_dvd_mul_succ_pam (s : PAM M) : ∃ k : PAM M, s * (s + 1) = 2 * k := by + have hs := div_add_mod_pam s 2 + rcases mod_two_eq_zero_or_one s with h0 | h1 + · refine ⟨(s / 2) * (2 * (s / 2) + 1), ?_⟩ + rw [h0, add_zero] at hs + conv_lhs => rw [← hs] + ring + · refine ⟨(2 * (s / 2) + 1) * (s / 2 + 1), ?_⟩ + rw [h1] at hs + conv_lhs => rw [← hs] + ring + +/-- Cantor pairing $x + \frac{(x + y)(x + y + 1)}{2}$ on `PAM M`. -/ +noncomputable def mPair (x y : PAM M) : PAM M := + x + ((x + y) * (x + y + 1)) / 2 + +theorem two_mul_mPair (x y : PAM M) : + 2 * mPair x y = 2 * x + (x + y) * (x + y + 1) := by + obtain ⟨k, hk⟩ := two_dvd_mul_succ_pam (x + y) + have hdiv : ((x + y) * (x + y + 1)) / 2 = k := + ((div_mod_eq_iff (r := 0) zero_lt_two_pam).mpr (by rw [hk, add_zero])).1 + unfold mPair + rw [hdiv, hk] + ring + +@[simp] +theorem mPair_zero_zero : mPair (0 : PAM M) 0 = 0 := by + apply mul_left_cancel_pam two_ne_zero_pam + rw [two_mul_mPair] + ring + +@[simp] +theorem mPair_natCast (x y : ℕ) : mPair (x : PAM M) (y : PAM M) = (cantorPair x y : PAM M) := by + apply mul_left_cancel_pam two_ne_zero_pam + rw [two_mul_mPair] + have hnat : 2 * cantorPair x y = 2 * x + (x + y) * (x + y + 1) := by + unfold cantorPair + set s := x + y + have hs := (Nat.div_add_mod s 2).symm + rcases Nat.mod_two_eq_zero_or_one s with h0 | h1 + · have hev : s * (s + 1) = 2 * ((s / 2) * (2 * (s / 2) + 1)) := by + conv_lhs => rw [hs, h0] + ring + rw [hev, Nat.mul_div_right _ (by decide : 0 < 2)] + ring + · have hev : s * (s + 1) = 2 * ((2 * (s / 2) + 1) * (s / 2 + 1)) := by + conv_lhs => rw [hs, h1] + ring + rw [hev, Nat.mul_div_right _ (by decide : 0 < 2)] + ring + have hcast := congrArg (Nat.cast (R := PAM M)) hnat.symm + simpa [Nat.cast_add, Nat.cast_mul] using hcast + +theorem paCantorPairEq_holdsIn_iff (v : ℕ → PAM M) (x y z : PATerm) : + PAFormula.HoldsIn v (paCantorPairEq x y z) ↔ + PATerm.evalIn v z = mPair (PATerm.evalIn v x) (PATerm.evalIn v y) := by + unfold paCantorPairEq + simp only [PAFormula.HoldsIn, evalIn_mul, evalIn_add, evalIn_succ, evalIn_ofNat, Nat.cast_ofNat] + rw [← two_mul_mPair] + exact ⟨mul_left_cancel_pam two_ne_zero_pam, fun h ↦ h ▸ rfl⟩ + +theorem mPair_injective {x₁ y₁ x₂ y₂ : PAM M} (h : mPair x₁ y₁ = mPair x₂ y₂) : + x₁ = x₂ ∧ y₁ = y₂ := by + have h2 : 2 * x₁ + (x₁ + y₁) * (x₁ + y₁ + 1) = 2 * x₂ + (x₂ + y₂) * (x₂ + y₂ + 1) := by + rw [← two_mul_mPair, ← two_mul_mPair, h] + have hnotlt : ∀ {a₁ b₁ a₂ b₂ : PAM M}, + 2 * a₁ + (a₁ + b₁) * (a₁ + b₁ + 1) = 2 * a₂ + (a₂ + b₂) * (a₂ + b₂ + 1) → + ¬ (a₁ + b₁ < a₂ + b₂) := by + intro a₁ b₁ a₂ b₂ heq hlt + rcases hlt with ⟨d, hd⟩ + have hexp : 2 * a₂ + (a₂ + b₂) * (a₂ + b₂ + 1) = + (2 * a₁ + (a₁ + b₁) * (a₁ + b₁ + 1)) + + ((2 * a₂ + 2 * b₁ + (2 * (a₁ + b₁) + 3 + d) * d + 1) + 1) := by + rw [← hd] + ring + rw [heq] at hexp + have h0 : (2 * a₂ + 2 * b₁ + (2 * (a₁ + b₁) + 3 + d) * d + 1) + 1 = 0 := + (add_left_inj_pam (2 * a₂ + (a₂ + b₂) * (a₂ + b₂ + 1))).mp + (by rw [← hexp, add_zero]) + exact add_one_ne_zero _ h0 + have hs : x₁ + y₁ = x₂ + y₂ := + le_antisymm (le_of_not_gt (hnotlt h2.symm)) (le_of_not_gt (hnotlt h2)) + rw [hs] at h2 + have hx2 : 2 * x₁ = 2 * x₂ := (add_right_inj_pam _).mp h2 + have hx : x₁ = x₂ := mul_left_cancel_pam two_ne_zero_pam hx2 + subst hx + exact ⟨rfl, (add_left_inj_pam x₁).mp hs⟩ + +theorem mPair_surjective (z : PAM M) : ∃ x y : PAM M, mPair x y = z := by + refine ind_pred (P := fun w ↦ ∃ x y : PAM M, mPair x y = w) + ⟨0, .ex 1 (.ex 2 (paCantorPairEq (.var 1) (.var 2) (.var 0))), + fun _ ↦ 0, fun w ↦ ?_⟩ ⟨0, 0, mPair_zero_zero⟩ (fun w ih ↦ ?_) z + · simp only [PAFormula.HoldsIn, paCantorPairEq_holdsIn_iff, evalIn_var] + refine exists_congr fun x ↦ exists_congr fun y ↦ ?_ + simp [eq_comm] + · rcases ih with ⟨x, y, rfl⟩ + rcases eq_zero_or_exists_succ y with rfl | ⟨y₀, rfl⟩ + · refine ⟨0, x + 1, ?_⟩ + apply mul_left_cancel_pam two_ne_zero_pam + rw [mul_add, two_mul_mPair, two_mul_mPair] + ring + · refine ⟨x + 1, y₀, ?_⟩ + apply mul_left_cancel_pam two_ne_zero_pam + rw [mul_add, two_mul_mPair, two_mul_mPair] + ring + +/-- Inverse Cantor unpairing on `PAM M`. -/ +noncomputable def mUnpair (z : PAM M) : PAM M × PAM M := + (Classical.choose (mPair_surjective z), + Classical.choose (Classical.choose_spec (mPair_surjective z))) + +@[simp] +theorem mPair_mUnpair (z : PAM M) : mPair (mUnpair z).1 (mUnpair z).2 = z := + Classical.choose_spec (Classical.choose_spec (mPair_surjective z)) + +@[simp] +theorem mUnpair_mPair (x y : PAM M) : mUnpair (mPair x y) = (x, y) := by + obtain ⟨hx, hy⟩ := mPair_injective (mPair_mUnpair (mPair x y)) + exact Prod.ext hx hy + +theorem le_mPair_left (x y : PAM M) : x ≤ mPair x y := + ⟨((x + y) * (x + y + 1)) / 2, rfl⟩ + +theorem mul_le_mul_iff_of_pos_left_pam {a b c : PAM M} (hc : 0 < c) : + c * a ≤ c * b ↔ a ≤ b := by + refine ⟨fun h ↦ ?_, fun h ↦ mul_le_mul_pam le_rfl h⟩ + by_contra hnot + exact not_lt_of_ge h (mul_lt_mul_of_pos_left_pam (lt_of_not_ge hnot) hc) + +theorem le_mPair_right (x y : PAM M) : y ≤ mPair x y := by + rcases eq_zero_or_exists_succ y with rfl | ⟨y', rfl⟩ + · exact zero_le_pam _ + · refine (mul_le_mul_iff_of_pos_left_pam zero_lt_two_pam).mp ?_ + rw [two_mul_mPair] + exact ⟨5 * x + (x + y') * (x + y') + y', by ring⟩ + +omit [PAModel M] in +theorem paDisjList_holdsIn_iff (v : ℕ → PAM M) (L : List PAFormula) : + PAFormula.HoldsIn v (paDisjList L) ↔ ∃ φ ∈ L, PAFormula.HoldsIn v φ := by + match L with + | [] => simp [paDisjList, PAFormula.HoldsIn] + | [φ] => simp [paDisjList] + | φ :: ψ :: rest => + simp only [paDisjList, PAFormula.HoldsIn, paDisjList_holdsIn_iff v (ψ :: rest), + List.mem_cons, exists_eq_or_imp] + +/-- Evaluate a symbolic `PAZFTerm` in `PAM M`. -/ +noncomputable def evalPAZFTerm (v : ℕ → PAM M) : PAZFTerm → PAM M + | .var x => v x + | .const n => (n : PAM M) + | .pair a b => mPair (evalPAZFTerm v a) (evalPAZFTerm v b) + +theorem evalPAZFTerm_congr {v₁ v₂ : ℕ → PAM M} {e : PAZFTerm} + (h : ∀ x < e.freshVar, v₁ x = v₂ x) : + evalPAZFTerm v₁ e = evalPAZFTerm v₂ e := by + induction e with + | var x => exact h x (Nat.lt_succ_self x) + | const _ => rfl + | pair a b iha ihb => + refine congrArg₂ mPair (iha fun x hx ↦ h x ?_) (ihb fun x hx ↦ h x ?_) + · exact lt_of_lt_of_le hx (Nat.le_max_left _ _) + · exact lt_of_lt_of_le hx (Nat.le_max_right _ _) + +theorem evalPAZFTerm_update_fresh (v : ℕ → PAM M) {e : PAZFTerm} {x : ℕ} (a : PAM M) + (h : e.freshVar ≤ x) : evalPAZFTerm (Function.update v x a) e = evalPAZFTerm v e := + evalPAZFTerm_congr fun (y : ℕ) _ ↦ Function.update_of_ne (by omega : y ≠ x) a v + +theorem eqFormula_holdsIn_iff (e : PAZFTerm) (out : PATerm) (base : ℕ) (v : ℕ → PAM M) + (he : e.freshVar ≤ base) (hout : out.freshVar ≤ base) : + PAFormula.HoldsIn v (e.eqFormula out base) ↔ PATerm.evalIn v out = evalPAZFTerm v e := by + induction e generalizing out base v with + | var x => + simp [PAZFTerm.eqFormula, PAFormula.HoldsIn, evalPAZFTerm] + | const n => + simp [PAZFTerm.eqFormula, PAFormula.HoldsIn, evalPAZFTerm] + | pair a b iha ihb => + simp only [PAZFTerm.freshVar, Nat.max_le] at he + rcases he with ⟨ha, hb⟩ + simp only [PAZFTerm.eqFormula, PAFormula.HoldsIn] + constructor + · rintro ⟨va, vb, hpair, haeq, hbeq⟩ + set v' := Function.update (Function.update v base va) (base + 1) vb + have hv_base : v' base = va := by simp [v'] + have hv_base1 : v' (base + 1) = vb := by simp [v'] + have hout_eq : PATerm.evalIn v' out = PATerm.evalIn v out := by + dsimp only [v'] + rw [evalIn_update_of_freshVar_le _ _ (by omega), + evalIn_update_of_freshVar_le _ _ hout] + have hpair' : PATerm.evalIn v out = mPair va vb := by + have hp := (paCantorPairEq_holdsIn_iff v' (.var base) (.var (base + 1)) out).mp hpair + simpa [hv_base, hv_base1, hout_eq] using hp + have ha' : va = evalPAZFTerm v a := by + have h1 := (iha (.var base) (base + 2) v' (by omega) + (by simp [PATerm.freshVar])).mp haeq + dsimp only [v'] at h1 + rw [evalIn_var, evalPAZFTerm_update_fresh _ _ (by omega), + evalPAZFTerm_update_fresh _ _ ha] at h1 + simpa [Function.update_of_ne (by omega : base ≠ base + 1)] using h1 + have hb' : vb = evalPAZFTerm v b := by + have h2 := (ihb (.var (base + 1)) (base + 2 + a.numVars) v' (by omega) + (by simp [PATerm.freshVar]; omega)).mp hbeq + dsimp only [v'] at h2 + rw [evalIn_var, evalPAZFTerm_update_fresh _ _ (by omega), + evalPAZFTerm_update_fresh _ _ hb] at h2 + simpa using h2 + rw [hpair', ha', hb', evalPAZFTerm] + · intro heq + refine ⟨evalPAZFTerm v a, evalPAZFTerm v b, ?_⟩ + set v' := Function.update (Function.update v base (evalPAZFTerm v a)) + (base + 1) (evalPAZFTerm v b) + have hv_base : v' base = evalPAZFTerm v a := by simp [v'] + have hv_base1 : v' (base + 1) = evalPAZFTerm v b := by simp [v'] + have hout_eq : PATerm.evalIn v' out = PATerm.evalIn v out := by + dsimp only [v'] + rw [evalIn_update_of_freshVar_le _ _ (by omega), + evalIn_update_of_freshVar_le _ _ hout] + refine ⟨?_, ?_, ?_⟩ + · rw [paCantorPairEq_holdsIn_iff] + simp only [evalIn_var, hv_base, hv_base1, hout_eq] + exact heq + · rw [iha (.var base) (base + 2) v' (by omega) (by simp [PATerm.freshVar]), + evalIn_var, hv_base] + dsimp only [v'] + rw [evalPAZFTerm_update_fresh _ _ (by omega), evalPAZFTerm_update_fresh _ _ ha] + · rw [ihb (.var (base + 1)) (base + 2 + a.numVars) v' (by omega) + (by simp [PATerm.freshVar]; omega), evalIn_var, hv_base1] + dsimp only [v'] + rw [evalPAZFTerm_update_fresh _ _ (by omega), evalPAZFTerm_update_fresh _ _ hb] + +/-! ## Section 4b: Compositional First-Order Definability (`PADefN`, `PAFunN`) -/ + +def renameAllTerm (σ : ℕ → ℕ) : PATerm → PATerm + | .var x => .var (σ x) + | .zero => .zero + | .succ t => .succ (renameAllTerm σ t) + | .add t₁ t₂ => .add (renameAllTerm σ t₁) (renameAllTerm σ t₂) + | .mul t₁ t₂ => .mul (renameAllTerm σ t₁) (renameAllTerm σ t₂) + +def renameAllFormula (σ : ℕ → ℕ) : PAFormula → PAFormula + | .bot => .bot + | .eq t₁ t₂ => .eq (renameAllTerm σ t₁) (renameAllTerm σ t₂) + | .and φ ψ => .and (renameAllFormula σ φ) (renameAllFormula σ ψ) + | .or φ ψ => .or (renameAllFormula σ φ) (renameAllFormula σ ψ) + | .imp φ ψ => .imp (renameAllFormula σ φ) (renameAllFormula σ ψ) + | .all x φ => .all (σ x) (renameAllFormula σ φ) + | .ex x φ => .ex (σ x) (renameAllFormula σ φ) + +omit [PAModel M] in +theorem evalIn_renameAllTerm (σ : ℕ → ℕ) (u : ℕ → PAM M) (t : PATerm) : + PATerm.evalIn u (renameAllTerm σ t) = PATerm.evalIn (u ∘ σ) t := by + induction t with + | var _ | zero => rfl + | succ _ ih => exact congrArg PAStructure.succ ih + | add _ _ ih₁ ih₂ => exact congrArg₂ PAStructure.add ih₁ ih₂ + | mul _ _ ih₁ ih₂ => exact congrArg₂ PAStructure.mul ih₁ ih₂ + +omit [PAModel M] in +theorem holdsIn_renameAllFormula {σ : ℕ → ℕ} (hσ : Function.Injective σ) + (u : ℕ → PAM M) (φ : PAFormula) : + PAFormula.HoldsIn u (renameAllFormula σ φ) ↔ PAFormula.HoldsIn (u ∘ σ) φ := by + induction φ generalizing u with + | bot => exact Iff.rfl + | eq t₁ t₂ => + simp only [renameAllFormula, PAFormula.HoldsIn, evalIn_renameAllTerm] + | and _ _ ih₁ ih₂ => exact and_congr (ih₁ u) (ih₂ u) + | or _ _ ih₁ ih₂ => exact or_congr (ih₁ u) (ih₂ u) + | imp _ _ ih₁ ih₂ => exact imp_congr (ih₁ u) (ih₂ u) + | all x φ ih => + simp only [renameAllFormula, PAFormula.HoldsIn] + refine forall_congr' fun a ↦ (ih (Function.update u (σ x) a)).trans ?_ + have heq : Function.update u (σ x) a ∘ σ = Function.update (u ∘ σ) x a := by + funext z + by_cases hzx : z = x + · subst hzx; simp + · simp [hzx, hσ.ne hzx] + rw [heq] + | ex x φ ih => + simp only [renameAllFormula, PAFormula.HoldsIn] + refine exists_congr fun a ↦ (ih (Function.update u (σ x) a)).trans ?_ + have heq : Function.update u (σ x) a ∘ σ = Function.update (u ∘ σ) x a := by + funext z + by_cases hzx : z = x + · subst hzx; simp + · simp [hzx, hσ.ne hzx] + rw [heq] + +/-- Environment mapping `0..k-1` to `args` and `≥ k` to parameter assignment `v`. -/ +def paEnv {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) (x : ℕ) : PAM M := + if h : x < k then args ⟨x, h⟩ else v x + +omit [PAStructure M] [PAModel M] in +theorem paEnv_lt {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) {x : ℕ} (h : x < k) : + paEnv v args x = args ⟨x, h⟩ := + dite_eq_left_of_eq_true (eq_true h) + +omit [PAStructure M] [PAModel M] in +theorem paEnv_ge {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) {x : ℕ} (h : ¬ x < k) : + paEnv v args x = v x := + dite_eq_right_of_eq_false (eq_false h) + +omit [PAStructure M] [PAModel M] in +theorem fin_snoc_lt {k : ℕ} {α : Type*} (args : Fin k → α) (a : α) {x : ℕ} + (hx : x < k + 1) (hlt : x < k) : + (Fin.snoc args a : Fin (k + 1) → α) ⟨x, hx⟩ = args ⟨x, hlt⟩ := + Fin.snoc_castSucc (α := fun _ ↦ α) a args ⟨x, hlt⟩ + +omit [PAStructure M] [PAModel M] in +theorem fin_snoc_eq {k : ℕ} {α : Type*} (args : Fin k → α) (a : α) + (hx : k < k + 1 := Nat.lt_succ_self k) : + (Fin.snoc args a : Fin (k + 1) → α) ⟨k, hx⟩ = a := + Fin.snoc_last (α := fun _ ↦ α) a args + +/-- `k`-ary first-order definability with parameters in `PAM M`. -/ +def PADefN (k : ℕ) (P : (Fin k → PAM M) → Prop) : Prop := + ∃ (φ : PAFormula) (v : ℕ → PAM M), ∀ args : Fin k → PAM M, + PAFormula.HoldsIn (paEnv v args) φ ↔ P args + +/-- `k`-ary first-order definable function on `PAM M` (via its `(k + 1)`-ary graph). -/ +def PAFunN (k : ℕ) (f : (Fin k → PAM M) → PAM M) : Prop := + PADefN (k + 1) fun args ↦ args (Fin.last k) = f (Fin.init args) + +/-- Unary first-order definability on `PAM M`. -/ +abbrev PADef1 (P : PAM M → Prop) : Prop := + PADefN 1 fun args ↦ P (args 0) + +omit [PAModel M] in +theorem paDefN_congr {k : ℕ} {P Q : (Fin k → PAM M) → Prop} + (h : ∀ args, P args ↔ Q args) (hP : PADefN k P) : PADefN k Q := by + rcases hP with ⟨φ, v, hφ⟩ + exact ⟨φ, v, fun args ↦ (hφ args).trans (h args)⟩ + +omit [PAModel M] in +theorem paFunN_congr {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (h : ∀ args, f args = g args) (hf : PAFunN k f) : PAFunN k g := + paDefN_congr (fun args ↦ by rw [h (Fin.init args)]) hf + +theorem ind1 {P : PAM M → Prop} (hP : PADef1 P) (h0 : P 0) (hs : ∀ a : PAM M, P a → P (a + 1)) : + ∀ a : PAM M, P a := by + rcases hP with ⟨φ, v, hφ⟩ + refine ind_pred (P := P) ⟨0, φ, v, fun a ↦ ?_⟩ h0 hs + have heq : Function.update v 0 a = paEnv v (fun _ : Fin 1 ↦ a) := by + funext x + rcases x with _ | x + · rw [Function.update_self, paEnv_lt _ _ (Nat.zero_lt_one)] + · rw [Function.update_of_ne (Nat.succ_ne_zero x), paEnv_ge _ _ (by omega)] + rw [heq] + exact hφ _ + +theorem strong_ind1 {P : PAM M → Prop} (hP : PADef1 P) + (hstep : ∀ a : PAM M, (∀ b < a, P b) → P a) : ∀ a : PAM M, P a := by + rcases hP with ⟨φ, v, hφ⟩ + refine strong_ind_pred (P := P) ⟨0, φ, v, fun a ↦ ?_⟩ hstep + have heq : Function.update v 0 a = paEnv v (fun _ : Fin 1 ↦ a) := by + funext x + rcases x with _ | x + · rw [Function.update_self, paEnv_lt _ _ (Nat.zero_lt_one)] + · rw [Function.update_of_ne (Nat.succ_ne_zero x), paEnv_ge _ _ (by omega)] + rw [heq] + exact hφ _ + +omit [PAModel M] in +theorem paDef_false (k : ℕ) : PADefN k (fun _ : Fin k → PAM M ↦ False) := + ⟨.bot, fun _ ↦ 0, fun _ ↦ Iff.rfl⟩ + +omit [PAModel M] in +theorem paDef_true (k : ℕ) : PADefN k (fun _ : Fin k → PAM M ↦ True) := + ⟨.eq .zero .zero, fun _ ↦ 0, fun _ ↦ by simp [PAFormula.HoldsIn]⟩ + +omit [PAModel M] in +theorem paDef_not {k : ℕ} {P : (Fin k → PAM M) → Prop} (hP : PADefN k P) : + PADefN k (fun args ↦ ¬ P args) := by + rcases hP with ⟨φ, v, hφ⟩ + exact ⟨φ.not, v, fun args ↦ not_congr (hφ args)⟩ + +omit [PAModel M] in +theorem paDef_merge {k : ℕ} {P Q : (Fin k → PAM M) → Prop} + (hP : PADefN k P) (hQ : PADefN k Q) : + ∃ (φ₁ φ₂ : PAFormula) (v : ℕ → PAM M), ∀ args : Fin k → PAM M, + (PAFormula.HoldsIn (paEnv v args) φ₁ ↔ P args) ∧ + (PAFormula.HoldsIn (paEnv v args) φ₂ ↔ Q args) := by + rcases hP with ⟨φ₁, v₁, h₁⟩ + rcases hQ with ⟨φ₂, v₂, h₂⟩ + let m := max k φ₁.maxVar + let σ : ℕ → ℕ := fun x ↦ if x < k then x else x + m + have hσ_inj : Function.Injective σ := by + intro x y hxy + dsimp only [σ] at hxy + split_ifs at hxy with hx hy hy <;> omega + let v : ℕ → PAM M := fun z ↦ if z < m then v₁ z else v₂ (z - m) + refine ⟨φ₁, renameAllFormula σ φ₂, v, fun args ↦ ⟨?_, ?_⟩⟩ + · refine (holdsIn_congr (fun z hz ↦ ?_)).trans (h₁ args) + have hlt : z < m := by + have : z < φ₁.maxVar := by + by_contra hge + rw [hasFree_false_of_maxVar_le_pam (Nat.le_of_not_lt hge)] at hz + cases hz + exact lt_of_lt_of_le this (Nat.le_max_right _ _) + by_cases hzk : z < k + · rw [paEnv_lt _ _ hzk, paEnv_lt _ _ hzk] + · rw [paEnv_ge _ _ hzk, paEnv_ge _ _ hzk] + simp [v, hlt] + · rw [holdsIn_renameAllFormula hσ_inj] + refine (holdsIn_congr (fun z _ ↦ ?_)).trans (h₂ args) + by_cases hzk : z < k + · change paEnv v args (if z < k then z else z + m) = paEnv v₂ args z + simp only [hzk, ↓reduceIte] + rw [paEnv_lt _ _ hzk, paEnv_lt _ _ hzk] + · change paEnv v args (if z < k then z else z + m) = paEnv v₂ args z + have hge : ¬ (z + m < k) := by omega + have hge_m : ¬ (z + m < m) := by omega + simp only [hzk, ↓reduceIte] + rw [paEnv_ge _ _ hge, paEnv_ge _ _ hzk] + simp [v, hge_m] + +omit [PAModel M] in +theorem paDef_and {k : ℕ} {P Q : (Fin k → PAM M) → Prop} + (hP : PADefN k P) (hQ : PADefN k Q) : PADefN k (fun args ↦ P args ∧ Q args) := by + obtain ⟨φ₁, φ₂, v, h⟩ := paDef_merge hP hQ + exact ⟨.and φ₁ φ₂, v, fun args ↦ and_congr (h args).1 (h args).2⟩ + +omit [PAModel M] in +theorem paDef_or {k : ℕ} {P Q : (Fin k → PAM M) → Prop} + (hP : PADefN k P) (hQ : PADefN k Q) : PADefN k (fun args ↦ P args ∨ Q args) := by + obtain ⟨φ₁, φ₂, v, h⟩ := paDef_merge hP hQ + exact ⟨.or φ₁ φ₂, v, fun args ↦ or_congr (h args).1 (h args).2⟩ + +omit [PAModel M] in +theorem paDef_imp {k : ℕ} {P Q : (Fin k → PAM M) → Prop} + (hP : PADefN k P) (hQ : PADefN k Q) : PADefN k (fun args ↦ P args → Q args) := by + obtain ⟨φ₁, φ₂, v, h⟩ := paDef_merge hP hQ + exact ⟨.imp φ₁ φ₂, v, fun args ↦ imp_congr (h args).1 (h args).2⟩ + +omit [PAModel M] in +theorem paDef_iff {k : ℕ} {P Q : (Fin k → PAM M) → Prop} + (hP : PADefN k P) (hQ : PADefN k Q) : PADefN k (fun args ↦ P args ↔ Q args) := + paDefN_congr (fun _ ↦ iff_iff_implies_and_implies.symm) + (paDef_and (paDef_imp hP hQ) (paDef_imp hQ hP)) + +omit [PAStructure M] [PAModel M] in +theorem update_paEnv_eq_snoc {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) (a : PAM M) : + Function.update (paEnv v args) k a = paEnv v (Fin.snoc args a) := by + funext x + by_cases hxk : x = k + · subst hxk + rw [Function.update_self, paEnv_lt _ _ (Nat.lt_succ_self x), fin_snoc_eq] + · rw [Function.update_of_ne hxk] + by_cases hlt : x < k + · have hlt' : x < k + 1 := Nat.lt_succ_of_lt hlt + rw [paEnv_lt _ _ hlt, paEnv_lt _ _ hlt', fin_snoc_lt _ _ hlt' hlt] + · have hlt' : ¬ (x < k + 1) := by omega + rw [paEnv_ge _ _ hlt, paEnv_ge _ _ hlt'] + +omit [PAModel M] in +theorem paDef_ex {k : ℕ} {P : (Fin (k + 1) → PAM M) → Prop} (hP : PADefN (k + 1) P) : + PADefN k (fun args ↦ ∃ a : PAM M, P (Fin.snoc args a)) := by + rcases hP with ⟨φ, v, hφ⟩ + refine ⟨.ex k φ, v, fun args ↦ ?_⟩ + simp only [PAFormula.HoldsIn] + exact exists_congr fun a ↦ by rw [update_paEnv_eq_snoc]; exact hφ (Fin.snoc args a) + +omit [PAModel M] in +theorem paDef_all {k : ℕ} {P : (Fin (k + 1) → PAM M) → Prop} (hP : PADefN (k + 1) P) : + PADefN k (fun args ↦ ∀ a : PAM M, P (Fin.snoc args a)) := by + rcases hP with ⟨φ, v, hφ⟩ + refine ⟨.all k φ, v, fun args ↦ ?_⟩ + simp only [PAFormula.HoldsIn] + exact forall_congr' fun a ↦ by rw [update_paEnv_eq_snoc]; exact hφ (Fin.snoc args a) + +omit [PAModel M] in +theorem paDef_weaken {k : ℕ} {P : (Fin k → PAM M) → Prop} (hP : PADefN k P) : + PADefN (k + 1) (fun args ↦ P (Fin.init args)) := by + rcases hP with ⟨φ, v, hφ⟩ + let σ : ℕ → ℕ := fun x ↦ if x < k then x else x + 1 + have hσ_inj : Function.Injective σ := by + intro x y hxy + dsimp only [σ] at hxy + split_ifs at hxy with hx hy hy <;> omega + let v' : ℕ → PAM M := fun z ↦ v (z - 1) + refine ⟨renameAllFormula σ φ, v', fun args ↦ ?_⟩ + rw [holdsIn_renameAllFormula hσ_inj] + refine (holdsIn_congr (fun z _ ↦ ?_)).trans (hφ (Fin.init args)) + by_cases hzk : z < k + · have hzk1 : z < k + 1 := Nat.lt_succ_of_lt hzk + change paEnv v' args (if z < k then z else z + 1) = paEnv v (Fin.init args) z + simp only [hzk, ↓reduceIte] + rw [paEnv_lt _ _ hzk1, paEnv_lt _ _ hzk] + rfl + · have hge : ¬ (z + 1 < k + 1) := by omega + change paEnv v' args (if z < k then z else z + 1) = paEnv v (Fin.init args) z + simp only [hzk, ↓reduceIte] + rw [paEnv_ge _ _ hge, paEnv_ge _ _ hzk] + rfl + +omit [PAModel M] in +theorem paDef_subst_last {k : ℕ} {f : (Fin k → PAM M) → PAM M} + {R : (Fin (k + 1) → PAM M) → Prop} (hf : PAFunN k f) (hR : PADefN (k + 1) R) : + PADefN k (fun args ↦ R (Fin.snoc args (f args))) := by + refine paDefN_congr (fun args ↦ ?_) (paDef_ex (paDef_and hf hR)) + constructor + · rintro ⟨a, ha, hr⟩ + rw [Fin.snoc_last, Fin.init_snoc] at ha + rwa [← ha] + · intro hr + exact ⟨f args, by rw [Fin.snoc_last, Fin.init_snoc], hr⟩ + +omit [PAModel M] in +theorem paFun_weaken {k : ℕ} {f : (Fin k → PAM M) → PAM M} (hf : PAFunN k f) : + PAFunN (k + 1) (fun args ↦ f (Fin.init args)) := by + rcases hf with ⟨φ, v, hφ⟩ + let σ : ℕ → ℕ := fun x ↦ if x < k then x else x + 1 + have hσ_inj : Function.Injective σ := by + intro x y hxy + dsimp only [σ] at hxy + split_ifs at hxy with hx hy hy <;> omega + let v' : ℕ → PAM M := fun z ↦ v (z - 1) + refine ⟨renameAllFormula σ φ, v', fun args ↦ ?_⟩ + rw [holdsIn_renameAllFormula hσ_inj] + let args₀ : Fin (k + 1) → PAM M := + Fin.snoc (Fin.init (Fin.init args)) (args (Fin.last (k + 1))) + have htran : PAFormula.HoldsIn (paEnv v' args ∘ σ) φ ↔ PAFormula.HoldsIn (paEnv v args₀) φ := by + refine holdsIn_congr fun z _ ↦ ?_ + by_cases hzk : z < k + · have hzk1 : z < k + 1 := Nat.lt_succ_of_lt hzk + have hzk2 : z < k + 2 := Nat.lt_succ_of_lt hzk1 + change paEnv v' args (if z < k then z else z + 1) = paEnv v args₀ z + simp only [hzk, ↓reduceIte] + rw [paEnv_lt _ _ hzk2, paEnv_lt _ _ hzk1] + dsimp only [args₀] + rw [fin_snoc_lt _ _ hzk1 hzk] + rfl + · by_cases heq : z = k + · subst heq + change paEnv v' args (if z < z then z else z + 1) = paEnv v args₀ z + simp only [Nat.lt_irrefl, ↓reduceIte] + rw [paEnv_lt _ _ (Nat.lt_succ_self (z + 1)), paEnv_lt _ _ (Nat.lt_succ_self z)] + dsimp only [args₀] + rw [fin_snoc_eq] + rfl + · have hge2 : ¬ (z + 1 < k + 2) := by omega + have hge1 : ¬ (z < k + 1) := by omega + change paEnv v' args (if z < k then z else z + 1) = paEnv v args₀ z + simp only [hzk, ↓reduceIte] + rw [paEnv_ge _ _ hge2, paEnv_ge _ _ hge1] + rfl + rw [htran, hφ args₀] + dsimp only [args₀] + rw [Fin.snoc_last, Fin.init_snoc] + +omit [PAModel M] in +theorem paFun_proj {k : ℕ} (i : Fin k) : PAFunN k (fun args : Fin k → PAM M ↦ args i) := by + refine ⟨.eq (.var k) (.var i.val), fun _ ↦ 0, fun args ↦ ?_⟩ + simp only [PAFormula.HoldsIn, evalIn_var] + rw [paEnv_lt _ _ (Nat.lt_succ_self k), paEnv_lt _ _ (Nat.lt_succ_of_lt i.isLt)] + rfl + +omit [PAModel M] in +theorem paFun_const {k : ℕ} (c : PAM M) : PAFunN k (fun _ : Fin k → PAM M ↦ c) := by + refine ⟨.eq (.var k) (.var (k + 1)), fun _ ↦ c, fun args ↦ ?_⟩ + simp only [PAFormula.HoldsIn, evalIn_var] + rw [paEnv_lt _ _ (Nat.lt_succ_self k), paEnv_ge _ _ (Nat.lt_irrefl (k + 1))] + rfl + +omit [PAModel M] in +theorem paDef_eq {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PADefN k (fun args ↦ f args = g args) := by + refine paDefN_congr (fun args ↦ ?_) (paDef_ex (paDef_and hf hg)) + exact ⟨fun ⟨a, ha, hb⟩ ↦ by + rw [Fin.snoc_last, Fin.init_snoc] at ha hb + exact ha.symm.trans hb, + fun h ↦ ⟨f args, by rw [Fin.snoc_last, Fin.init_snoc], + by rw [Fin.snoc_last, Fin.init_snoc, h]⟩⟩ + +omit [PAModel M] in +theorem paDef_le {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PADefN k (fun args ↦ f args ≤ g args) := by + have hbase : PADefN (k + 2) (fun args : Fin (k + 2) → PAM M ↦ + args ⟨k, by omega⟩ ≤ args (Fin.last (k + 1))) := by + refine ⟨paLe (.var k) (.var (k + 1)), fun _ ↦ 0, fun args ↦ ?_⟩ + rw [paLe_holdsIn_iff, evalIn_var, evalIn_var, + paEnv_lt _ _ (by omega : k < k + 2), paEnv_lt _ _ (Nat.lt_succ_self (k + 1))] + rfl + have h1 := paDef_subst_last (paFun_weaken hg) hbase + have h2 := paDef_subst_last hf h1 + refine paDefN_congr (fun args ↦ ?_) h2 + rw [Fin.snoc_last, Fin.init_snoc, fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] + +theorem paDef_lt {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PADefN k (fun args ↦ f args < g args) := + paDefN_congr (fun _ ↦ lt_iff_le_and_ne.symm) + (paDef_and (paDef_le hf hg) (paDef_not (paDef_eq hf hg))) + +omit [PAModel M] in +theorem paFun_add {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PAFunN k (fun args ↦ f args + g args) := by + have hbase : PADefN (k + 3) (fun args : Fin (k + 3) → PAM M ↦ + args ⟨k, by omega⟩ = args ⟨k + 1, by omega⟩ + args (Fin.last (k + 2))) := by + refine ⟨.eq (.var k) (.add (.var (k + 1)) (.var (k + 2))), fun _ ↦ 0, fun args ↦ ?_⟩ + simp only [PAFormula.HoldsIn, evalIn_add, evalIn_var] + rw [paEnv_lt _ _ (by omega : k < k + 3), paEnv_lt _ _ (by omega : k + 1 < k + 3), + paEnv_lt _ _ (Nat.lt_succ_self (k + 2))] + rfl + have h1 := paDef_subst_last (paFun_weaken (paFun_weaken hg)) hbase + have h2 := paDef_subst_last (paFun_weaken hf) h1 + refine paDefN_congr (fun args ↦ ?_) h2 + simp only [Fin.snoc_last, Fin.init_snoc] + rw [fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), + fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_eq] + rfl + +omit [PAModel M] in +theorem paFun_mul {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PAFunN k (fun args ↦ f args * g args) := by + have hbase : PADefN (k + 3) (fun args : Fin (k + 3) → PAM M ↦ + args ⟨k, by omega⟩ = args ⟨k + 1, by omega⟩ * args (Fin.last (k + 2))) := by + refine ⟨.eq (.var k) (.mul (.var (k + 1)) (.var (k + 2))), fun _ ↦ 0, fun args ↦ ?_⟩ + simp only [PAFormula.HoldsIn, evalIn_mul, evalIn_var] + rw [paEnv_lt _ _ (by omega : k < k + 3), paEnv_lt _ _ (by omega : k + 1 < k + 3), + paEnv_lt _ _ (Nat.lt_succ_self (k + 2))] + rfl + have h1 := paDef_subst_last (paFun_weaken (paFun_weaken hg)) hbase + have h2 := paDef_subst_last (paFun_weaken hf) h1 + refine paDefN_congr (fun args ↦ ?_) h2 + simp only [Fin.snoc_last, Fin.init_snoc] + rw [fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), + fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_eq] + rfl + +theorem paFun_sub {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PAFunN k (fun args ↦ f args - g args) := by + let z : (Fin (k + 1) → PAM M) → PAM M := fun a ↦ a (Fin.last k) + let f' : (Fin (k + 1) → PAM M) → PAM M := fun a ↦ f (Fin.init a) + let g' : (Fin (k + 1) → PAM M) → PAM M := fun a ↦ g (Fin.init a) + have hz : PAFunN (k + 1) z := paFun_proj (Fin.last k) + have hf' : PAFunN (k + 1) f' := paFun_weaken hf + have hg' : PAFunN (k + 1) g' := paFun_weaken hg + refine paDefN_congr (fun a ↦ ?_) + (paDef_or + (paDef_and (paDef_le hg' hf') (paDef_eq (paFun_add hg' hz) hf')) + (paDef_and (paDef_lt hf' hg') (paDef_eq hz (paFun_const 0)))) + dsimp only [z, f', g'] + by_cases hle : g (Fin.init a) ≤ f (Fin.init a) + · have hnotlt : ¬ f (Fin.init a) < g (Fin.init a) := not_lt_of_ge hle + simp only [hle, true_and, hnotlt, false_and, or_false] + rw [eq_comm (a := a (Fin.last k)), sub_eq_iff_eq_add_pam hle, eq_comm] + · have hlt : f (Fin.init a) < g (Fin.init a) := lt_of_not_ge hle + have hsub0 : f (Fin.init a) - g (Fin.init a) = 0 := sub_eq_zero_of_le_pam (le_of_lt hlt) + simp [hle, hlt, hsub0] + +theorem paFun_div {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PAFunN k (fun args ↦ f args / g args) := by + let q : (Fin (k + 1) → PAM M) → PAM M := fun a ↦ a (Fin.last k) + let f' : (Fin (k + 1) → PAM M) → PAM M := fun a ↦ f (Fin.init a) + let g' : (Fin (k + 1) → PAM M) → PAM M := fun a ↦ g (Fin.init a) + have hq : PAFunN (k + 1) q := paFun_proj (Fin.last k) + have hf' : PAFunN (k + 1) f' := paFun_weaken hf + have hg' : PAFunN (k + 1) g' := paFun_weaken hg + have hrem : PADefN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ + f' (Fin.init b) = g' (Fin.init b) * q (Fin.init b) + b (Fin.last (k + 1)) ∧ + b (Fin.last (k + 1)) < g' (Fin.init b)) := by + have hr : PAFunN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ b (Fin.last (k + 1))) := + paFun_proj (Fin.last (k + 1)) + exact paDef_and + (paDef_eq (paFun_weaken hf') (paFun_add (paFun_mul (paFun_weaken hg') (paFun_weaken hq)) hr)) + (paDef_lt hr (paFun_weaken hg')) + refine paDefN_congr (fun a ↦ ?_) + (paDef_or + (paDef_and (paDef_eq hg' (paFun_const 0)) (paDef_eq hq (paFun_const 0))) + (paDef_and (paDef_lt (paFun_const 0) hg') (paDef_ex hrem))) + dsimp only [q, f', g'] + by_cases hg0 : g (Fin.init a) = 0 + · have hdiv0 : f (Fin.init a) / 0 = 0 := dite_eq_right_of_eq_false (eq_false (lt_irrefl 0)) + simp [hg0, hdiv0] + · have hpos : 0 < g (Fin.init a) := pos_iff_ne_zero_pam.mpr hg0 + simp only [hg0, false_and, hpos, true_and, false_or] + constructor + · rintro ⟨r, heq, hrlt⟩ + simp only [Fin.init_snoc, Fin.snoc_last] at heq hrlt + exact ((div_mod_eq_iff hrlt).mpr heq).1.symm + · intro hqeq + refine ⟨f (Fin.init a) % g (Fin.init a), ?_⟩ + simp only [Fin.init_snoc, Fin.snoc_last, hqeq] + exact ⟨(div_add_mod_pam _ _).symm, mod_lt_pam _ hpos⟩ + +theorem paFun_mod {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PAFunN k (fun args ↦ f args % g args) := by + refine paFunN_congr (fun args ↦ ?_) (paFun_sub hf (paFun_mul hg (paFun_div hf hg))) + exact (sub_eq_iff_eq_add_pam ⟨f args % g args, div_add_mod_pam _ _⟩).mpr + (div_add_mod_pam _ _).symm + +theorem paFun_mPair {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PAFunN k (fun args ↦ mPair (f args) (g args)) := by + unfold mPair + exact paFun_add hf + (paFun_div (paFun_mul (paFun_add hf hg) (paFun_add (paFun_add hf hg) (paFun_const 1))) + (paFun_const 2)) + +theorem paFun_mUnpair_fst {k : ℕ} {f : (Fin k → PAM M) → PAM M} (hf : PAFunN k f) : + PAFunN k (fun args ↦ (mUnpair (f args)).1) := by + have hpair : PADefN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ + mPair (b ⟨k, by omega⟩) (b (Fin.last (k + 1))) = f (Fin.init (Fin.init b))) := + paDef_eq (paFun_mPair (paFun_proj ⟨k, by omega⟩) (paFun_proj (Fin.last (k + 1)))) + (paFun_weaken (paFun_weaken hf)) + refine paDefN_congr (fun a ↦ ?_) (paDef_ex hpair) + constructor + · rintro ⟨y, hy⟩ + rw [Fin.snoc_last, Fin.init_snoc, fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k)] at hy + change mPair (a (Fin.last k)) y = f (Fin.init a) at hy + dsimp only + rw [← hy, mUnpair_mPair] + · intro hx + refine ⟨(mUnpair (f (Fin.init a))).2, ?_⟩ + rw [Fin.snoc_last, Fin.init_snoc, fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k)] + change mPair (a (Fin.last k)) (mUnpair (f (Fin.init a))).2 = f (Fin.init a) + rw [hx, mPair_mUnpair] + +theorem paFun_mUnpair_snd {k : ℕ} {f : (Fin k → PAM M) → PAM M} (hf : PAFunN k f) : + PAFunN k (fun args ↦ (mUnpair (f args)).2) := by + have hpair : PADefN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ + mPair (b (Fin.last (k + 1))) (b ⟨k, by omega⟩) = f (Fin.init (Fin.init b))) := + paDef_eq (paFun_mPair (paFun_proj (Fin.last (k + 1))) (paFun_proj ⟨k, by omega⟩)) + (paFun_weaken (paFun_weaken hf)) + refine paDefN_congr (fun a ↦ ?_) (paDef_ex hpair) + constructor + · rintro ⟨x, hx⟩ + rw [Fin.snoc_last, Fin.init_snoc, fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k)] at hx + change mPair x (a (Fin.last k)) = f (Fin.init a) at hx + dsimp only + rw [← hx, mUnpair_mPair] + · intro hy + refine ⟨(mUnpair (f (Fin.init a))).1, ?_⟩ + rw [Fin.snoc_last, Fin.init_snoc, fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k)] + change mPair (mUnpair (f (Fin.init a))).1 (a (Fin.last k)) = f (Fin.init a) + rw [hy, mPair_mUnpair] + +omit [PAModel M] in +theorem paDef_fin_exists {k m : ℕ} {P : Fin m → (Fin k → PAM M) → Prop} + (hP : ∀ i : Fin m, PADefN k (P i)) : + PADefN k (fun args ↦ ∃ i : Fin m, P i args) := by + induction m with + | zero => + exact paDefN_congr (fun _ ↦ ⟨fun h ↦ h.elim, fun ⟨i, _⟩ ↦ Fin.elim0 i⟩) (paDef_false k) + | succ m ih => + have hlast : PADefN k (P (Fin.last m)) := hP (Fin.last m) + have hinit : PADefN k (fun args ↦ ∃ j : Fin m, P j.castSucc args) := + ih (fun j ↦ hP j.castSucc) + refine paDefN_congr (fun args ↦ ?_) (paDef_or hinit hlast) + constructor + · rintro (⟨j, hj⟩ | hl) + · exact ⟨j.castSucc, hj⟩ + · exact ⟨Fin.last m, hl⟩ + · rintro ⟨i, hi⟩ + revert hi + exact Fin.lastCases (fun hl ↦ Or.inr hl) (fun j hj ↦ Or.inl ⟨j, hj⟩) i + +omit [PAModel M] in +theorem paDef_fin_forall {k m : ℕ} {P : Fin m → (Fin k → PAM M) → Prop} + (hP : ∀ i : Fin m, PADefN k (P i)) : + PADefN k (fun args ↦ ∀ i : Fin m, P i args) := by + induction m with + | zero => + exact paDefN_congr (fun _ ↦ ⟨fun _ i ↦ Fin.elim0 i, fun _ ↦ trivial⟩) (paDef_true k) + | succ m ih => + have hlast : PADefN k (P (Fin.last m)) := hP (Fin.last m) + have hinit : PADefN k (fun args ↦ ∀ j : Fin m, P j.castSucc args) := + ih (fun j ↦ hP j.castSucc) + refine paDefN_congr (fun args ↦ ?_) (paDef_and hinit hlast) + constructor + · rintro ⟨hi, hl⟩ i + exact Fin.lastCases hl hi i + · intro hall + exact ⟨fun j ↦ hall j.castSucc, hall (Fin.last m)⟩ + +/-! ## Section 5: Gödel's $\beta$-Function, `mBeta_snoc`, and `mBeta_concat` -/ + +/-- Gödel's $\beta$-function $c \bmod (1 + (i + 1) d)$ on `PAM M`. -/ +noncomputable def mBeta (c d i : PAM M) : PAM M := + c % (1 + (i + 1) * d) + +theorem paFun_mBeta {k : ℕ} {fc fd fi : (Fin k → PAM M) → PAM M} + (hc : PAFunN k fc) (hd : PAFunN k fd) (hi : PAFunN k fi) : + PAFunN k (fun args ↦ mBeta (fc args) (fd args) (fi args)) := + paFun_mod hc (paFun_add (paFun_const 1) (paFun_mul (paFun_add hi (paFun_const 1)) hd)) + +theorem paBetaEq_holdsIn_iff (v : ℕ → PAM M) (c d i r : PATerm) : + PAFormula.HoldsIn v (paBetaEq c d i r) ↔ + mBeta (PATerm.evalIn v c) (PATerm.evalIn v d) (PATerm.evalIn v i) = + PATerm.evalIn v r := by + let m := PATerm.succ (.mul (.succ i) d) + let q := max (max c.freshVar m.freshVar) r.freshVar + have hc : c.freshVar ≤ q := le_trans (Nat.le_max_left _ _) (Nat.le_max_left _ _) + have hm : m.freshVar ≤ q := le_trans (Nat.le_max_right _ _) (Nat.le_max_left _ _) + have hr : r.freshVar ≤ q := Nat.le_max_right _ _ + have hmev : PATerm.evalIn v m = 1 + (PATerm.evalIn v i + 1) * PATerm.evalIn v d := by + simp only [m, evalIn_succ, evalIn_mul] + ring + change PAFormula.HoldsIn v (.ex q (.and (.eq c (.add (.mul (.var q) m) r)) (paLt r m))) ↔ _ + simp only [PAFormula.HoldsIn, paLt_holdsIn_iff, evalIn_add, evalIn_mul, evalIn_var, mBeta] + set mod := 1 + (PATerm.evalIn v i + 1) * PATerm.evalIn v d + have hpos : 0 < mod := ⟨(PATerm.evalIn v i + 1) * PATerm.evalIn v d, by ring⟩ + constructor + · rintro ⟨w, hcw, hrlt⟩ + rw [evalIn_update_of_freshVar_le v w hc, evalIn_update_of_freshVar_le v w hm, + evalIn_update_of_freshVar_le v w hr, Function.update_self, hmev] at hcw + rw [evalIn_update_of_freshVar_le v w hr, evalIn_update_of_freshVar_le v w hm, hmev] at hrlt + exact ((div_mod_eq_iff (q := w) hrlt).mpr (by rw [hcw]; ring)).2 + · intro hrem + refine ⟨PATerm.evalIn v c / mod, ?_, ?_⟩ + · rw [evalIn_update_of_freshVar_le v _ hc, evalIn_update_of_freshVar_le v _ hm, + evalIn_update_of_freshVar_le v _ hr, Function.update_self, hmev, ← hrem] + calc PATerm.evalIn v c + _ = mod * (PATerm.evalIn v c / mod) + PATerm.evalIn v c % mod := + (div_add_mod_pam _ mod).symm + _ = PATerm.evalIn v c / mod * mod + PATerm.evalIn v c % mod := by ring + · rw [evalIn_update_of_freshVar_le v _ hr, evalIn_update_of_freshVar_le v _ hm, + hmev, ← hrem] + exact mod_lt_pam _ hpos + +/-- Singleton $\beta$-code representing `[val]` at index `0`. -/ +theorem mBeta_singleton (val : PAM M) : mBeta val (val + 1) 0 = val := by + unfold mBeta + exact mod_eq_of_lt_pam ⟨1, by ring⟩ + +def DvdPAM (a b : PAM M) : Prop := ∃ q : PAM M, b = a * q + +def BezoutPAM (a b : PAM M) : Prop := ∃ u v : PAM M, u * a = v * b + 1 + +omit [PAModel M] in +theorem paDef_dvd {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PADefN k (fun args ↦ DvdPAM (f args) (g args)) := by + refine paDefN_congr (fun args ↦ ?_) + (paDef_ex (paDef_eq (paFun_weaken hg) + (paFun_mul (paFun_weaken hf) (paFun_proj (Fin.last k))))) + simp only [DvdPAM, Fin.snoc_last, Fin.init_snoc] + +omit [PAModel M] in +theorem paDef_bezout {k : ℕ} {f g : (Fin k → PAM M) → PAM M} + (hf : PAFunN k f) (hg : PAFunN k g) : PADefN k (fun args ↦ BezoutPAM (f args) (g args)) := by + have hu : PAFunN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ b ⟨k, by omega⟩) := + paFun_proj ⟨k, by omega⟩ + have hv : PAFunN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ b (Fin.last (k + 1))) := + paFun_proj (Fin.last (k + 1)) + have hf2 : PAFunN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ f (Fin.init (Fin.init b))) := + paFun_weaken (paFun_weaken hf) + have hg2 : PAFunN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ g (Fin.init (Fin.init b))) := + paFun_weaken (paFun_weaken hg) + refine paDefN_congr (fun args ↦ ?_) + (paDef_ex (paDef_ex + (paDef_eq (paFun_mul hu hf2) (paFun_add (paFun_mul hv hg2) (paFun_const 1))))) + refine exists_congr fun u ↦ exists_congr fun v ↦ ?_ + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] + +private theorem bezout_one_left (b : PAM M) : BezoutPAM 1 b := + ⟨1, 0, by ring⟩ + +private theorem bezout_mul_left {a₁ a₂ b : PAM M} (h₁ : BezoutPAM a₁ b) + (h₂ : BezoutPAM a₂ b) : BezoutPAM (a₁ * a₂) b := by + rcases h₁ with ⟨u₁, v₁, e₁⟩ + rcases h₂ with ⟨u₂, v₂, e₂⟩ + refine ⟨u₁ * u₂, v₁ * v₂ * b + v₁ + v₂, ?_⟩ + calc (u₁ * u₂) * (a₁ * a₂) + _ = (u₁ * a₁) * (u₂ * a₂) := by ring + _ = (v₁ * b + 1) * (v₂ * b + 1) := by rw [e₁, e₂] + _ = (v₁ * v₂ * b + v₁ + v₂) * b + 1 := by ring + +private theorem bezout_beta_moduli {d i k : PAM M} (hd : 0 < d) (hik : i < k) + (hdvd : DvdPAM (k - i) d) : + BezoutPAM (1 + (i + 1) * d) (1 + (k + 1) * d) := by + rcases hdvd with ⟨q, hq⟩ + have hki_le : i ≤ k := le_of_lt hik + have hq_pos : 0 < q := by + rcases eq_zero_or_exists_succ q with rfl | ⟨q', rfl⟩ + · rw [mul_zero] at hq + exact absurd hq (ne_of_gt hd) + · exact ⟨q', by ring⟩ + set a := i + 1 + set b := k + 1 + set δ := k - i + set si := 1 + a * d + set sk := 1 + b * d + have hb_eq : b = a + δ := by + dsimp only [a, b, δ] + calc k + 1 + _ = (i + (k - i)) + 1 := congrArg (· + 1) (add_sub_of_le_pam hki_le).symm + _ = (i + 1) + (k - i) := by ring + have habq_pos : 1 ≤ a * b * q := by + rcases eq_zero_or_exists_succ q with rfl | ⟨q', rfl⟩ + · exact absurd rfl (ne_of_gt hq_pos) + · exact ⟨i * (k + 1) * (q' + 1) + k * (q' + 1) + q', by dsimp only [a, b]; ring⟩ + set U := a * a * q + set V := a * b * q - 1 + have hV : V + 1 = a * b * q := sub_add_cancel_pam habq_pos + have hUV : V * si + 1 = U * sk := by + apply (add_right_inj_pam si).mp + calc (V * si + 1) + si + _ = (V + 1) * si + 1 := by ring + _ = a * (a + δ) * q * (1 + a * (δ * q)) + 1 := by rw [hV, hb_eq, ← hq] + _ = a * a * q * (1 + (a + δ) * (δ * q)) + (1 + a * (δ * q)) := by ring + _ = U * sk + si := by dsimp only [U, si, sk]; rw [hb_eq, ← hq] + have hu_le : V ≤ (V + 1) * sk := + ⟨(V + 1) * b * d + 1, by dsimp only [sk]; ring⟩ + set u := (V + 1) * sk - V + have hu : u + V = (V + 1) * sk := sub_add_cancel_pam hu_le + have hv_le : U ≤ (V + 1) * si := by + have hU_le : U ≤ U * sk := ⟨U * (b * d), by dsimp only [sk]; ring⟩ + refine le_trans hU_le ?_ + rw [← hUV] + exact ⟨a * d, by dsimp only [si]; ring⟩ + set v := (V + 1) * si - U + have hv : v + U = (V + 1) * si := sub_add_cancel_pam hv_le + refine ⟨u, v, ?_⟩ + apply (add_right_inj_pam (U * sk)).mp + calc u * si + U * sk + _ = u * si + (V * si + 1) := by rw [← hUV] + _ = (u + V) * si + 1 := by ring + _ = (V + 1) * si * sk + 1 := by rw [hu]; ring + _ = (v + U) * sk + 1 := by rw [← hv] + _ = (v * sk + 1) + U * sk := by ring + +private theorem exists_common_multiple (B : PAM M) : + ∃ D : PAM M, 0 < D ∧ ∀ k : PAM M, 0 < k → k ≤ B → DvdPAM k D := by + have hdef : PADef1 (fun b : PAM M ↦ + ∃ D : PAM M, 0 < D ∧ ∀ k : PAM M, 0 < k → k ≤ b → DvdPAM k D) := by + have hb2 : PAFunN 3 (fun a : Fin 3 → PAM M ↦ a 0) := paFun_proj 0 + have hD2 : PAFunN 3 (fun a : Fin 3 → PAM M ↦ a 1) := paFun_proj 1 + have hk2 : PAFunN 3 (fun a : Fin 3 → PAM M ↦ a 2) := paFun_proj 2 + have hbody : PADefN 2 (fun a : Fin 2 → PAM M ↦ 0 < a 1 ∧ + ∀ k : PAM M, 0 < k → k ≤ a 0 → DvdPAM k (a 1)) := by + refine paDefN_congr (fun a ↦ ?_) + (paDef_and (paDef_lt (paFun_const 0) (paFun_proj 1)) + (paDef_all (paDef_imp (paDef_lt (paFun_const 0) hk2) + (paDef_imp (paDef_le hk2 hb2) (paDef_dvd hk2 hD2))))) + simp [Fin.snoc] + refine paDefN_congr (fun a ↦ ?_) (paDef_ex hbody) + simp [Fin.snoc] + refine ind1 hdef ?_ ?_ B + · refine ⟨1, zero_lt_one_pam, fun k hk hle ↦ ?_⟩ + rw [le_zero_iff_pam.mp hle] at hk + exact absurd hk (lt_irrefl 0) + · rintro b ⟨D, hD_pos, hD⟩ + refine ⟨D * (b + 1), ?_, fun k hk hle ↦ ?_⟩ + · rcases hD_pos with ⟨d', hd'⟩ + exact ⟨d' * (b + 1) + b, by rw [← hd']; ring⟩ + · rcases le_add_one_iff.mp hle with hkb | rfl + · rcases hD k hk hkb with ⟨q, hq⟩ + exact ⟨q * (b + 1), by rw [hq]; ring⟩ + · exact ⟨D, mul_comm D (b + 1)⟩ + +/-- Extend a $\beta$-coded sequence `(c, d)` of length `n` in `PAM M` by appending `val` at index +`n`. -/ +theorem mBeta_snoc (n c d val : PAM M) : + ∃ c' d' : PAM M, (∀ i < n, mBeta c' d' i = mBeta c d i) ∧ mBeta c' d' n = val := by + obtain ⟨D₀, hD₀_pos, hD₀_dvd⟩ := exists_common_multiple (n + 1) + let d' := D₀ * (c + val + 1) + have hd'_pos : 0 < d' := by + rcases hD₀_pos with ⟨m, hm⟩ + exact ⟨m * (c + val + 1) + c + val, by dsimp only [d']; rw [← hm]; ring⟩ + have hd'_dvd : ∀ k : PAM M, 0 < k → k ≤ n + 1 → DvdPAM k d' := by + intro k hk hle + rcases hD₀_dvd k hk hle with ⟨q, hq⟩ + exact ⟨q * (c + val + 1), by dsimp only [d']; rw [hq]; ring⟩ + have hd'_gt_c : c < d' := by + rcases eq_zero_or_exists_succ D₀ with rfl | ⟨m, rfl⟩ + · exact absurd rfl (ne_of_gt hD₀_pos) + · exact ⟨val + m * (c + val + 1), by dsimp only [d']; ring⟩ + have hd'_gt_val : val < d' := by + rcases eq_zero_or_exists_succ D₀ with rfl | ⟨m, rfl⟩ + · exact absurd rfl (ne_of_gt hD₀_pos) + · exact ⟨c + m * (c + val + 1), by dsimp only [d']; ring⟩ + let s : PAM M → PAM M := fun i ↦ 1 + (i + 1) * d' + have hs_pos : ∀ i : PAM M, 0 < s i := fun i ↦ ⟨(i + 1) * d', by dsimp only [s]; ring⟩ + have hbez_step : ∀ k : PAM M, k ≤ n → + ∃ Mk : PAM M, 0 < Mk ∧ (∀ i < k, DvdPAM (s i) Mk) ∧ BezoutPAM Mk (s k) := by + intro k hkn + have hdef_bez : PADef1 (fun j : PAM M ↦ j ≤ k → + ∃ Mj : PAM M, 0 < Mj ∧ (∀ i < j, DvdPAM (s i) Mj) ∧ BezoutPAM Mj (s k)) := by + have hs_fun : PAFunN 3 (fun a : Fin 3 → PAM M ↦ s (a 2)) := + paFun_add (paFun_const 1) + (paFun_mul (paFun_add (paFun_proj 2) (paFun_const 1)) (paFun_const d')) + have hinner : PADefN 2 (fun a : Fin 2 → PAM M ↦ 0 < a 1 ∧ + (∀ i < a 0, DvdPAM (s i) (a 1)) ∧ BezoutPAM (a 1) (s k)) := by + have hforall : PADefN 2 (fun a : Fin 2 → PAM M ↦ + ∀ i : PAM M, i < a 0 → DvdPAM (s i) (a 1)) := by + refine paDefN_congr (fun a ↦ ?_) + (paDef_all (paDef_imp (paDef_lt (paFun_proj 2) (paFun_proj 0)) + (paDef_dvd hs_fun (paFun_proj 1)))) + simp [Fin.snoc] + exact paDef_and (paDef_lt (paFun_const 0) (paFun_proj 1)) + (paDef_and hforall (paDef_bezout (paFun_proj 1) (paFun_const (s k)))) + refine paDefN_congr (fun a ↦ ?_) + (paDef_imp (paDef_le (paFun_proj 0) (paFun_const k)) (paDef_ex hinner)) + simp [Fin.snoc] + refine ind1 hdef_bez ?_ ?_ k le_rfl + · intro _ + exact ⟨1, zero_lt_one_pam, fun _ hi ↦ absurd hi (not_lt_zero_pam _), bezout_one_left (s k)⟩ + · intro j ih hjk + have hj_lt_k : j < k := hjk + obtain ⟨Mj, hMj_pos, hMj_dvd, hMj_bez⟩ := ih (le_of_lt hj_lt_k) + have hkj_pos : 0 < k - j := by + have ⟨m, hm⟩ := hj_lt_k + have hsub : k - j = 1 + m := + (sub_eq_iff_eq_add_pam (le_of_lt hj_lt_k)).mpr (by rw [← hm]; ring) + rw [hsub] + exact ⟨m, by ring⟩ + have hkj_le : k - j ≤ n + 1 := by + refine le_trans (b := k) ?_ (le_trans hkn ⟨1, rfl⟩) + exact ⟨j, sub_add_cancel_pam (le_of_lt hj_lt_k)⟩ + have hbez_jk : BezoutPAM (s j) (s k) := + bezout_beta_moduli hd'_pos hj_lt_k (hd'_dvd (k - j) hkj_pos hkj_le) + refine ⟨Mj * s j, ?_, ?_, bezout_mul_left hMj_bez hbez_jk⟩ + · rcases hMj_pos with ⟨m₁, hm₁⟩ + rcases hs_pos j with ⟨m₂, hm₂⟩ + exact ⟨m₁ * (1 + m₂) + m₂, by rw [← hm₁, ← hm₂]; ring⟩ + · intro i hi + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hi) with hilt | rfl + · rcases hMj_dvd i hilt with ⟨q, hq⟩ + exact ⟨q * s j, by rw [hq]; ring⟩ + · exact ⟨Mj, mul_comm Mj (s i)⟩ + let target : PAM M → PAM M := fun i ↦ if i < n then mBeta c d i else val + have htarget_lt : ∀ i : PAM M, target i < s i := by + intro i + dsimp only [target, s] + split_ifs with hin + · have hle_c : mBeta c d i ≤ c := by + unfold mBeta + have hdiv := div_add_mod_pam c (1 + (i + 1) * d) + exact ⟨(1 + (i + 1) * d) * (c / (1 + (i + 1) * d)), by rw [add_comm]; exact hdiv⟩ + exact lt_of_le_of_lt hle_c (lt_of_lt_of_le hd'_gt_c ⟨1 + i * d', by ring⟩) + · exact lt_of_lt_of_le hd'_gt_val ⟨1 + i * d', by ring⟩ + have hdef_crt : PADef1 (fun k : PAM M ↦ k ≤ n + 1 → + ∃ x : PAM M, ∀ i < k, x % s i = target i) := by + have hsi : PAFunN 3 (fun a : Fin 3 → PAM M ↦ s (a 2)) := + paFun_add (paFun_const 1) + (paFun_mul (paFun_add (paFun_proj 2) (paFun_const 1)) (paFun_const d')) + have htar : PADefN 3 (fun a : Fin 3 → PAM M ↦ a 1 % s (a 2) = target (a 2)) := by + have hmod_x : PAFunN 3 (fun a : Fin 3 → PAM M ↦ a 1 % s (a 2)) := + paFun_mod (paFun_proj 1) hsi + have hbeta_cd : PAFunN 3 (fun a : Fin 3 → PAM M ↦ mBeta c d (a 2)) := + paFun_mBeta (paFun_const c) (paFun_const d) (paFun_proj 2) + refine paDefN_congr (fun a ↦ ?_) + (paDef_and + (paDef_imp (paDef_lt (paFun_proj 2) (paFun_const n)) (paDef_eq hmod_x hbeta_cd)) + (paDef_imp (paDef_not (paDef_lt (paFun_proj 2) (paFun_const n))) + (paDef_eq hmod_x (paFun_const val)))) + dsimp only [target] + split_ifs with hlt <;> simp [hlt] + have hex_x : PADefN 1 (fun a : Fin 1 → PAM M ↦ + ∃ x : PAM M, ∀ i < a 0, x % s i = target i) := by + have hfor_i : PADefN 2 (fun a : Fin 2 → PAM M ↦ + ∀ i : PAM M, i < a 0 → a 1 % s i = target i) := by + refine paDefN_congr (fun a ↦ ?_) + (paDef_all (paDef_imp (paDef_lt (paFun_proj 2) (paFun_proj 0)) htar)) + simp [Fin.snoc] + refine paDefN_congr (fun a ↦ ?_) (paDef_ex hfor_i) + simp [Fin.snoc] + exact paDef_imp (paDef_le (paFun_proj 0) (paFun_const (n + 1))) hex_x + have hcrt := ind1 hdef_crt + (fun _ ↦ ⟨0, fun _ hi ↦ absurd hi (not_lt_zero_pam _)⟩) + (fun k ih hk1 ↦ ?_) (n + 1) le_rfl + · obtain ⟨c', hc'⟩ := hcrt + refine ⟨c', d', fun i hi ↦ ?_, ?_⟩ + · have h := hc' i (lt_trans hi (lt_succ_self_pam n)) + simpa [mBeta, s, target, hi] using h + · have h := hc' n (lt_succ_self_pam n) + simpa [mBeta, s, target, lt_irrefl n] using h + · have hkn : k ≤ n := by + rcases hk1 with ⟨m, hm⟩ + exact ⟨m, (add_right_inj_pam 1).mp (by rw [← hm]; ring)⟩ + obtain ⟨xk, hxk⟩ := ih (le_trans ⟨1, rfl⟩ hk1) + obtain ⟨Mk, _, hMk_dvd, ⟨u, v, huv⟩⟩ := hbez_step k hkn + let rem := xk % s k + have hrem_le : rem ≤ s k := le_of_lt (mod_lt_pam xk (hs_pos k)) + let δmod := (s k - rem) + target k + have hxδ : xk + δmod = s k * (xk / s k + 1) + target k := by + calc xk + δmod + _ = (s k * (xk / s k) + rem) + ((s k - rem) + target k) := by + conv_lhs => rw [← div_add_mod_pam xk (s k)] + _ = s k * (xk / s k) + (rem + (s k - rem)) + target k := by ring + _ = s k * (xk / s k) + s k + target k := by rw [add_sub_of_le_pam hrem_le] + _ = s k * (xk / s k + 1) + target k := by ring + let x' := xk + Mk * (u * δmod) + refine ⟨x', fun i hi ↦ ?_⟩ + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hi) with hilt | rfl + · obtain ⟨wi, hwi⟩ := hMk_dvd i hilt + have hxi : xk = s i * (xk / s i) + target i := by + rw [← hxk i hilt] + exact (div_add_mod_pam xk (s i)).symm + refine ((div_mod_eq_iff (q := xk / s i + wi * (u * δmod)) (htarget_lt i)).mpr ?_).2 + calc x' + _ = (s i * (xk / s i) + target i) + (s i * wi) * (u * δmod) := by + dsimp only [x'] + rw [← hxi, hwi] + _ = s i * (xk / s i + wi * (u * δmod)) + target i := by ring + · refine ((div_mod_eq_iff (q := xk / s i + 1 + v * δmod) (htarget_lt i)).mpr ?_).2 + calc x' + _ = xk + (u * Mk) * δmod := by dsimp only [x']; ring + _ = xk + (v * s i + 1) * δmod := by rw [huv] + _ = (xk + δmod) + s i * (v * δmod) := by ring + _ = (s i * (xk / s i + 1) + target i) + s i * (v * δmod) := by rw [hxδ] + _ = s i * (xk / s i + 1 + v * δmod) + target i := by ring + +/-- Concatenate two $\beta$-coded sequences of lengths `n₁` and `n₂` in `PAM M`. -/ +theorem mBeta_concat (n₁ c₁ d₁ n₂ c₂ d₂ : PAM M) : + ∃ c' d' : PAM M, + (∀ i < n₁, mBeta c' d' i = mBeta c₁ d₁ i) ∧ + (∀ j < n₂, mBeta c' d' (n₁ + j) = mBeta c₂ d₂ j) := by + have hdef : PADef1 (fun k : PAM M ↦ + ∃ c' d' : PAM M, + (∀ i < n₁, mBeta c' d' i = mBeta c₁ d₁ i) ∧ + (∀ j < k, mBeta c' d' (n₁ + j) = mBeta c₂ d₂ j)) := by + have hp1 : PADefN 3 (fun a : Fin 3 → PAM M ↦ ∀ i : PAM M, i < n₁ → + mBeta (a 1) (a 2) i = mBeta c₁ d₁ i) := by + refine paDefN_congr (fun a ↦ ?_) + (paDef_all (paDef_imp (paDef_lt (paFun_proj 3) (paFun_const n₁)) + (paDef_eq + (paFun_mBeta (paFun_proj 1) (paFun_proj 2) (paFun_proj 3)) + (paFun_mBeta (paFun_const c₁) (paFun_const d₁) (paFun_proj 3))))) + simp [Fin.snoc]; rfl + have hp2 : PADefN 3 (fun a : Fin 3 → PAM M ↦ ∀ j : PAM M, j < a 0 → + mBeta (a 1) (a 2) (n₁ + j) = mBeta c₂ d₂ j) := by + refine paDefN_congr (fun a ↦ ?_) + (paDef_all (paDef_imp (paDef_lt (paFun_proj 3) (paFun_proj 0)) + (paDef_eq + (paFun_mBeta (paFun_proj 1) (paFun_proj 2) + (paFun_add (paFun_const n₁) (paFun_proj 3))) + (paFun_mBeta (paFun_const c₂) (paFun_const d₂) (paFun_proj 3))))) + simp [Fin.snoc]; rfl + refine paDefN_congr (fun a ↦ ?_) (paDef_ex (paDef_ex (paDef_and hp1 hp2))) + simp [Fin.snoc] + refine ind1 hdef ⟨c₁, d₁, fun _ _ ↦ rfl, fun _ hj ↦ absurd hj (not_lt_zero_pam _)⟩ + (fun k ⟨c', d', h1, h2⟩ ↦ ?_) n₂ + obtain ⟨c'', d'', hprev, hlast⟩ := mBeta_snoc (n₁ + k) c' d' (mBeta c₂ d₂ k) + refine ⟨c'', d'', fun i hi ↦ ?_, fun j hj ↦ ?_⟩ + · rw [hprev i (lt_of_lt_of_le hi (le_add_right_pam n₁ k)), h1 i hi] + · rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hj) with hjlt | rfl + · rw [hprev (n₁ + j) (add_lt_add_left_pam hjlt n₁), h2 j hjlt] + · exact hlast + +/-! ## Section 6: Internal Base-2 Exponentiation (`mPow2`) and Unary Blocks (`mRep0`, `mRep1`) -/ + +/-- $\beta$-coded base-2 power table witness up to `r` with output `y = 2^r`. -/ +def IsPow2Seq (c d r y : PAM M) : Prop := + mBeta c d 0 = 1 ∧ (∀ j < r, mBeta c d (j + 1) = 2 * mBeta c d j) ∧ mBeta c d r = y + +theorem paDef_isPow2Seq {k : ℕ} {fc fd fr fy : (Fin k → PAM M) → PAM M} + (hc : PAFunN k fc) (hd : PAFunN k fd) (hr : PAFunN k fr) (hy : PAFunN k fy) : + PADefN k (fun a ↦ IsPow2Seq (fc a) (fd a) (fr a) (fy a)) := by + have h0 : PADefN k (fun a ↦ mBeta (fc a) (fd a) 0 = 1) := + paDef_eq (paFun_mBeta hc hd (paFun_const 0)) (paFun_const 1) + have hlast : PADefN k (fun a ↦ mBeta (fc a) (fd a) (fr a) = fy a) := + paDef_eq (paFun_mBeta hc hd hr) hy + have hstep : PADefN k (fun a ↦ ∀ j : PAM M, j < fr a → + mBeta (fc a) (fd a) (j + 1) = 2 * mBeta (fc a) (fd a) j) := by + let jProj : (Fin (k + 1) → PAM M) → PAM M := fun b ↦ b (Fin.last k) + have hj : PAFunN (k + 1) jProj := paFun_proj (Fin.last k) + have hc' : PAFunN (k + 1) (fun b ↦ fc (Fin.init b)) := paFun_weaken hc + have hd' : PAFunN (k + 1) (fun b ↦ fd (Fin.init b)) := paFun_weaken hd + have hr' : PAFunN (k + 1) (fun b ↦ fr (Fin.init b)) := paFun_weaken hr + refine paDefN_congr (fun a ↦ ?_) + (paDef_all (paDef_imp (paDef_lt hj hr') + (paDef_eq + (paFun_mBeta hc' hd' (paFun_add hj (paFun_const 1))) + (paFun_mul (paFun_const 2) (paFun_mBeta hc' hd' hj))))) + simp [jProj, Fin.snoc_last, Fin.init_snoc] + exact paDef_and h0 (paDef_and hstep hlast) + +theorem exists_pow2Seq (r : PAM M) : ∃ y c d : PAM M, IsPow2Seq c d r y := by + have hdef : PADef1 (fun r₀ : PAM M ↦ ∃ y c d : PAM M, IsPow2Seq c d r₀ y) := by + have h4 : PADefN 4 (fun a : Fin 4 → PAM M ↦ IsPow2Seq (a 2) (a 3) (a 0) (a 1)) := + paDef_isPow2Seq (paFun_proj 2) (paFun_proj 3) (paFun_proj 0) (paFun_proj 1) + refine paDefN_congr (fun a ↦ ?_) (paDef_ex (paDef_ex (paDef_ex h4))) + simp [Fin.snoc] + refine ind1 hdef ?_ ?_ r + · exact ⟨1, 1, 1 + 1, mBeta_singleton 1, fun _ hj ↦ absurd hj (not_lt_zero_pam _), + mBeta_singleton 1⟩ + · rintro r₀ ⟨y, c, d, h0, hstep, hr⟩ + obtain ⟨c', d', hprev, hlast⟩ := mBeta_snoc (r₀ + 1) c d (2 * y) + refine ⟨2 * y, c', d', ?_, ?_, hlast⟩ + · rw [hprev 0 ⟨r₀, by ring⟩, h0] + · intro j hj + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hj) with hjlt | rfl + · rw [hprev (j + 1) (add_lt_add_right_pam hjlt 1), + hprev j (lt_trans hjlt (lt_succ_self_pam r₀)), hstep j hjlt] + · rw [hlast, hprev j (lt_succ_self_pam j), hr] + +theorem isPow2Seq_unique {c₁ d₁ r y₁ c₂ d₂ y₂ : PAM M} + (h₁ : IsPow2Seq c₁ d₁ r y₁) (h₂ : IsPow2Seq c₂ d₂ r y₂) : y₁ = y₂ := by + have hdef : PADef1 (fun j : PAM M ↦ j ≤ r → mBeta c₁ d₁ j = mBeta c₂ d₂ j) := + paDef_imp (paDef_le (paFun_proj 0) (paFun_const r)) + (paDef_eq + (paFun_mBeta (paFun_const c₁) (paFun_const d₁) (paFun_proj 0)) + (paFun_mBeta (paFun_const c₂) (paFun_const d₂) (paFun_proj 0))) + have hall := ind1 hdef (fun _ ↦ by rw [h₁.1, h₂.1]) (fun j ih hj1 ↦ ?_) r le_rfl + · rw [← h₁.2.2, ← h₂.2.2, hall] + · have hjlt : j < r := hj1 + rw [h₁.2.1 j hjlt, h₂.2.1 j hjlt, ih (le_of_lt hjlt)] + +/-- Internal base-2 exponentiation $2^r$ on `PAM M`. -/ +noncomputable def mPow2 (r : PAM M) : PAM M := + Classical.choose (exists_pow2Seq r) + +theorem exists_isPow2Seq_mPow2 (r : PAM M) : ∃ c d : PAM M, IsPow2Seq c d r (mPow2 r) := + Classical.choose_spec (exists_pow2Seq r) + +theorem paFun_mPow2 {k : ℕ} {fr : (Fin k → PAM M) → PAM M} (hr : PAFunN k fr) : + PAFunN k (fun a ↦ mPow2 (fr a)) := by + have hseq : PADefN (k + 3) (fun b : Fin (k + 3) → PAM M ↦ + IsPow2Seq (b ⟨k + 1, by omega⟩) (b (Fin.last (k + 2))) + (fr (Fin.init (Fin.init (Fin.init b)))) (b ⟨k, by omega⟩)) := + paDef_isPow2Seq + (paFun_proj ⟨k + 1, by omega⟩) + (paFun_proj (Fin.last (k + 2))) + (paFun_weaken (paFun_weaken (paFun_weaken hr))) + (paFun_proj ⟨k, by omega⟩) + refine paDefN_congr (fun a ↦ ?_) (paDef_ex (paDef_ex hseq)) + constructor + · rintro ⟨c, d, h⟩ + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (by omega), fin_snoc_eq, + fin_snoc_lt _ _ (by omega) (by omega), fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k)] at h + obtain ⟨c₀, d₀, h₀⟩ := exists_isPow2Seq_mPow2 (fr (Fin.init a)) + exact isPow2Seq_unique h h₀ + · intro hy + obtain ⟨c₀, d₀, h₀⟩ := exists_isPow2Seq_mPow2 (fr (Fin.init a)) + refine ⟨c₀, d₀, ?_⟩ + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (by omega), fin_snoc_eq, + fin_snoc_lt _ _ (by omega) (by omega), fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k)] + change IsPow2Seq c₀ d₀ (fr (Fin.init a)) (a (Fin.last k)) + rwa [hy] + +@[simp] +theorem mPow2_zero : mPow2 (0 : PAM M) = 1 := by + obtain ⟨c, d, h⟩ := exists_isPow2Seq_mPow2 (0 : PAM M) + exact h.2.2.symm.trans h.1 + +@[simp] +theorem mPow2_succ (r : PAM M) : mPow2 (r + 1) = 2 * mPow2 r := by + obtain ⟨c, d, h0, hstep, hr⟩ := exists_isPow2Seq_mPow2 r + obtain ⟨c', d', hprev, hlast⟩ := mBeta_snoc (r + 1) c d (2 * mPow2 r) + have hseq : IsPow2Seq c' d' (r + 1) (2 * mPow2 r) := by + refine ⟨?_, ?_, hlast⟩ + · rw [hprev 0 ⟨r, by ring⟩, h0] + · intro j hj + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hj) with hjlt | rfl + · rw [hprev (j + 1) (add_lt_add_right_pam hjlt 1), + hprev j (lt_trans hjlt (lt_succ_self_pam r)), hstep j hjlt] + · rw [hlast, hprev j (lt_succ_self_pam j), hr] + obtain ⟨c₂, d₂, h₂⟩ := exists_isPow2Seq_mPow2 (r + 1) + exact isPow2Seq_unique h₂ hseq + +theorem mPow2_add (a b : PAM M) : mPow2 (a + b) = mPow2 a * mPow2 b := by + have hdef : PADef1 (fun x : PAM M ↦ mPow2 (a + x) = mPow2 a * mPow2 x) := + paDef_eq + (paFun_mPow2 (paFun_add (paFun_const a) (paFun_proj 0))) + (paFun_mul (paFun_const (mPow2 a)) (paFun_mPow2 (paFun_proj 0))) + refine ind1 hdef (by simp) (fun x ih ↦ ?_) b + rw [← add_assoc, mPow2_succ, mPow2_succ, ih] + ring + +theorem one_le_mPow2 (r : PAM M) : 1 ≤ mPow2 r := by + have hdef : PADef1 (fun x : PAM M ↦ 1 ≤ mPow2 x) := + paDef_le (paFun_const 1) (paFun_mPow2 (paFun_proj 0)) + refine ind1 hdef (by simp) (fun x ih ↦ ?_) r + rw [mPow2_succ] + rcases ih with ⟨k, hk⟩ + exact ⟨1 + 2 * k, by rw [← hk]; ring⟩ + +theorem mPow2_pos (r : PAM M) : 0 < mPow2 r := + lt_of_lt_of_le zero_lt_one_pam (one_le_mPow2 r) + +@[simp] +theorem mPow2_natCast (n : ℕ) : mPow2 (n : PAM M) = ((2 ^ n : ℕ) : PAM M) := by + induction n with + | zero => simp + | succ n ih => + rw [Nat.cast_succ, mPow2_succ, ih, Nat.pow_succ] + push_cast + ring + +/-- Unary `0`-block $0^r :: R = 2^r R$ on binary half-tape codes in `PAM M`. -/ +noncomputable def mRep0 (r R : PAM M) : PAM M := + mPow2 r * R + +/-- Unary `1`-block $1^r :: R = 2^r (R + 1) - 1$ on binary half-tape codes in `PAM M`. -/ +noncomputable def mRep1 (r R : PAM M) : PAM M := + mPow2 r * R + (mPow2 r - 1) + +theorem paFun_mRep0 {k : ℕ} {fr fR : (Fin k → PAM M) → PAM M} + (hr : PAFunN k fr) (hR : PAFunN k fR) : + PAFunN k (fun a ↦ mRep0 (fr a) (fR a)) := + paFun_mul (paFun_mPow2 hr) hR + +theorem paFun_mRep1 {k : ℕ} {fr fR : (Fin k → PAM M) → PAM M} + (hr : PAFunN k fr) (hR : PAFunN k fR) : + PAFunN k (fun a ↦ mRep1 (fr a) (fR a)) := + paFun_add (paFun_mul (paFun_mPow2 hr) hR) + (paFun_sub (paFun_mPow2 hr) (paFun_const 1)) + +@[simp] +theorem mRep0_zero (R : PAM M) : mRep0 0 R = R := by + simp [mRep0] + +theorem mRep0_succ (r R : PAM M) : mRep0 (r + 1) R = mCons 0 (mRep0 r R) := by + simp only [mRep0, mPow2_succ, mCons, Fin.val_zero, Nat.cast_zero, add_zero] + ring + +theorem mRep0_mCons_zero (r R : PAM M) : mRep0 r (mCons 0 R) = mRep0 (r + 1) R := by + simp only [mRep0, mPow2_succ, mCons, Fin.val_zero, Nat.cast_zero, add_zero] + ring + +theorem mRep0_add (a b R : PAM M) : mRep0 (a + b) R = mRep0 a (mRep0 b R) := by + simp only [mRep0, mPow2_add] + ring + +@[simp] +theorem mRep1_zero (R : PAM M) : mRep1 0 R = R := by + simp [mRep1] + +theorem mRep1_add_one (r R : PAM M) : mRep1 r R + 1 = mPow2 r * (R + 1) := by + unfold mRep1 + have h1 := sub_add_cancel_pam (one_le_mPow2 r) + calc mPow2 r * R + (mPow2 r - 1) + 1 + _ = mPow2 r * R + ((mPow2 r - 1) + 1) := by ring + _ = mPow2 r * R + mPow2 r := by rw [h1] + _ = mPow2 r * (R + 1) := by ring + +theorem mRep1_succ (r R : PAM M) : mRep1 (r + 1) R = mCons 1 (mRep1 r R) := by + apply (add_right_inj_pam 1).mp + rw [mRep1_add_one, mPow2_succ] + have h1 := mRep1_add_one r R + calc 2 * mPow2 r * (R + 1) + _ = 2 * (mPow2 r * (R + 1)) := by ring + _ = 2 * (mRep1 r R + 1) := by rw [← h1] + _ = (2 * mRep1 r R + 1) + 1 := by ring + _ = mCons 1 (mRep1 r R) + 1 := by simp [mCons] + +theorem mRep1_mCons_one (r R : PAM M) : mRep1 r (mCons 1 R) = mRep1 (r + 1) R := by + apply (add_right_inj_pam 1).mp + rw [mRep1_add_one, mRep1_add_one, mPow2_succ] + simp only [mCons, Fin.val_one, Nat.cast_one] + ring + +theorem mRep1_add (a b R : PAM M) : mRep1 (a + b) R = mRep1 a (mRep1 b R) := by + apply (add_right_inj_pam 1).mp + rw [mRep1_add_one, mRep1_add_one, mRep1_add_one, mPow2_add] + ring + +end Model +end PAM + + + + + +/-! ## Section 7: Internal Turing Machine Execution in `PAM M` -/ + +/-- Binary Turing machine configuration over `PAM M` half-tapes. -/ +@[ext] +structure MCfg (states : ℕ) (M : Type*) where + /-- Standard control state `Fin states`. -/ + state : Fin states + /-- Standard head symbol `Fin 2`. -/ + head : Fin 2 + /-- Binary-encoded left half-tape in `PAM M`. -/ + left : PAM M + /-- Binary-encoded non-head right half-tape in `PAM M`. -/ + right : PAM M + +section Execution +variable {M : Type*} [PAStructure M] [PAModel M] +open PAM + +/-- Nested Cantor configuration code `(q, (h, (L, R)))` of an `MCfg states M`. -/ +noncomputable def mEncodeCfg {states : ℕ} (c : MCfg states M) : PAM M := + mPair (c.state.val : PAM M) (mPair (c.head.val : PAM M) (mPair c.left c.right)) + +theorem mEncodeCfg_injective {states : ℕ} {c₁ c₂ : MCfg states M} + (h : mEncodeCfg c₁ = mEncodeCfg c₂) : c₁ = c₂ := by + obtain ⟨hq, h1⟩ := mPair_injective h + obtain ⟨hh, h2⟩ := mPair_injective h1 + obtain ⟨hl, hr⟩ := mPair_injective h2 + cases c₁ + cases c₂ + simp only [MCfg.mk.injEq] + exact ⟨Fin.ext (natCast_inj_pam.mp hq), Fin.ext (natCast_inj_pam.mp hh), hl, hr⟩ + +/-- Blank initial configuration in `MCfg states M`. -/ +def mInit {states : ℕ} [NeZero states] : MCfg states M := + ⟨0, 0, 0, 0⟩ + +@[simp] +theorem mEncodeCfg_mInit {states : ℕ} [NeZero states] : + mEncodeCfg (mInit : MCfg states M) = 0 := by + simp [mEncodeCfg, mInit] + +/-- Single Turing machine step on `MCfg states M`. -/ +noncomputable def mStep {states : ℕ} (tm : Machine states 2) + (c : MCfg states M) : Option (MCfg states M) := + match tm.transition c.state c.head with + | none => none + | some (w, .right, q') => + some ⟨q', mBit c.right, mCons w c.left, mHalf c.right⟩ + | some (w, .left, q') => + some ⟨q', mBit c.left, mHalf c.left, mCons w c.right⟩ + +/-- Deterministically iterate `mStep tm` for `k : ℕ` standard steps. -/ +noncomputable def mNSteps {states : ℕ} (tm : Machine states 2) : + ℕ → MCfg states M → Option (MCfg states M) + | 0, c => some c + | k + 1, c => (mStep tm c).bind (mNSteps tm k) + +theorem mNSteps_add {states : ℕ} (tm : Machine states 2) (j k : ℕ) (c : MCfg states M) : + mNSteps tm (j + k) c = (mNSteps tm j c).bind (mNSteps tm k) := by + induction j generalizing c with + | zero => simp [mNSteps] + | succ j ih => + simp only [Nat.succ_add, mNSteps] + cases mStep tm c with + | none => rfl + | some c' => exact ih c' + +private theorem pzPackCfg_evalPAM (v : ℕ → PAM M) (q h : ℕ) (L R : PAZFTerm) : + evalPAZFTerm v (pzPackCfg q h L R) = + mPair (q : PAM M) (mPair (h : PAM M) (mPair (evalPAZFTerm v L) (evalPAZFTerm v R))) := + rfl + +omit [PAStructure M] [PAModel M] in +private theorem pzPackCfg_fresh_le (q h x y : ℕ) (hx : x < 10) (hy : y < 10) : + (pzPackCfg q h (.var x) (.var y)).freshVar ≤ 10 := by + simp only [pzPackCfg, PAZFTerm.freshVar] + omega + +theorem paStep_holdsIn_iff {states : ℕ} (tm : Machine states 2) (v : ℕ → PAM M) : + PAFormula.HoldsIn v (paStep tm) ↔ + ∃ c c' : MCfg states M, + v 4 = mEncodeCfg c ∧ v 5 = mEncodeCfg c' ∧ mStep tm c = some c' := by + unfold paStep + rw [paDisjList_holdsIn_iff] + simp only [List.mem_flatMap] + constructor + · rintro ⟨φ, ⟨q, _, h, _, hmem⟩, hholds⟩ + cases htr : tm.transition q h with + | none => rw [htr] at hmem; cases hmem + | some val => + rcases val with ⟨w, d, q'⟩ + cases d with + | left => + rw [htr, List.mem_map] at hmem + rcases hmem with ⟨h', hh'mem, rfl⟩ + have hh'lt : h' < 2 := by simp at hh'mem; omega + let hFin : Fin 2 := ⟨h', hh'lt⟩ + simp only [PAFormula.HoldsIn] at hholds + rcases hholds with ⟨n6, n7, n8, n9, hc_eq, hc'_eq, hn6, hn9⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 n6) 7 n7) 8 n8) 9 n9 + have hv4 : v' 4 = v 4 := by simp [v'] + have hv5 : v' 5 = v 5 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + have hv8 : v' 8 = n8 := by simp [v'] + have hv9 : v' 9 = n9 := by simp [v'] + have e1 := (eqFormula_holdsIn_iff _ (.var 4) 10 v' + (pzPackCfg_fresh_le q.val h.val 6 7 (by decide) (by decide)) (by decide)).mp hc_eq + have e2 := (eqFormula_holdsIn_iff _ (.var 5) 10 v' + (pzPackCfg_fresh_le q'.val h' 8 9 (by decide) (by decide)) (by decide)).mp hc'_eq + simp only [evalIn_var, evalIn_add, evalIn_mul, evalIn_ofNat, pzPackCfg_evalPAM, + evalPAZFTerm, Nat.cast_ofNat, hv4, hv5, hv6, hv7, hv8, hv9] at e1 e2 hn6 hn9 + have hn6' : n6 = mCons hFin n8 := hn6 + have hn9' : n9 = mCons w n7 := hn9 + refine ⟨⟨q, h, n6, n7⟩, ⟨q', hFin, n8, n9⟩, e1, e2, ?_⟩ + simp [mStep, htr, hn6', hn9'] + | right => + rw [htr, List.mem_map] at hmem + rcases hmem with ⟨h', hh'mem, rfl⟩ + have hh'lt : h' < 2 := by simp at hh'mem; omega + let hFin : Fin 2 := ⟨h', hh'lt⟩ + simp only [PAFormula.HoldsIn] at hholds + rcases hholds with ⟨n6, n7, n8, n9, hc_eq, hc'_eq, hn8, hn7⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 n6) 7 n7) 8 n8) 9 n9 + have hv4 : v' 4 = v 4 := by simp [v'] + have hv5 : v' 5 = v 5 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + have hv8 : v' 8 = n8 := by simp [v'] + have hv9 : v' 9 = n9 := by simp [v'] + have e1 := (eqFormula_holdsIn_iff _ (.var 4) 10 v' + (pzPackCfg_fresh_le q.val h.val 6 7 (by decide) (by decide)) (by decide)).mp hc_eq + have e2 := (eqFormula_holdsIn_iff _ (.var 5) 10 v' + (pzPackCfg_fresh_le q'.val h' 8 9 (by decide) (by decide)) (by decide)).mp hc'_eq + simp only [evalIn_var, evalIn_add, evalIn_mul, evalIn_ofNat, pzPackCfg_evalPAM, + evalPAZFTerm, Nat.cast_ofNat, hv4, hv5, hv6, hv7, hv8, hv9] at e1 e2 hn8 hn7 + have hn8' : n8 = mCons w n6 := hn8 + have hn7' : n7 = mCons hFin n9 := hn7 + refine ⟨⟨q, h, n6, n7⟩, ⟨q', hFin, n8, n9⟩, e1, e2, ?_⟩ + simp [mStep, htr, hn8', hn7'] + · rintro ⟨⟨q, h, L, R⟩, c', hv4, hv5, hstep⟩ + dsimp only [mStep] at hstep + cases htr : tm.transition q h with + | none => simp [htr] at hstep + | some val => + rcases val with ⟨w, d, q'⟩ + cases d with + | left => + simp only [htr, Option.some.injEq] at hstep + subst hstep + let h' := (mBit L).val + have hh'mem : h' ∈ ([0, 1] : List ℕ) := by + have := (mBit L).isLt + simp only [List.mem_cons, List.not_mem_nil, or_false] + omega + let φ := PAFormula.ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 6) (.add (.mul (.ofNat 2) (.var 8)) (.ofNat h'))) + (.eq (.var 9) (.add (.mul (.ofNat 2) (.var 7)) (.ofNat w.val))))))))) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · rw [htr, List.mem_map] + exact ⟨h', hh'mem, rfl⟩ + · simp only [φ, PAFormula.HoldsIn] + refine ⟨L, R, mHalf L, mCons w R, ?_⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 L) 7 R) 8 (mHalf L)) 9 (mCons w R) + have hv4' : v' 4 = v 4 := by simp [v'] + have hv5' : v' 5 = v 5 := by simp [v'] + have hv6' : v' 6 = L := by simp [v'] + have hv7' : v' 7 = R := by simp [v'] + have hv8' : v' 8 = mHalf L := by simp [v'] + have hv9' : v' 9 = mCons w R := by simp [v'] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [eqFormula_holdsIn_iff _ (.var 4) 10 v' + (pzPackCfg_fresh_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + simp [pzPackCfg_evalPAM, evalPAZFTerm, hv4', hv6', hv7', hv4, mEncodeCfg] + · rw [eqFormula_holdsIn_iff _ (.var 5) 10 v' + (pzPackCfg_fresh_le q'.val h' 8 9 (by decide) (by decide)) (by decide)] + simp [pzPackCfg_evalPAM, evalPAZFTerm, hv5', hv8', hv9', hv5, mEncodeCfg, h'] + · simp only [evalIn_var, evalIn_add, evalIn_mul, evalIn_ofNat, Nat.cast_ofNat, + hv6', hv8', h'] + exact (mCons_mBit_mHalf L).symm + · simp [hv7', hv9', mCons] + | right => + simp only [htr, Option.some.injEq] at hstep + subst hstep + let h' := (mBit R).val + have hh'mem : h' ∈ ([0, 1] : List ℕ) := by + have := (mBit R).isLt + simp only [List.mem_cons, List.not_mem_nil, or_false] + omega + let φ := PAFormula.ex 6 (.ex 7 (.ex 8 (.ex 9 + (.and ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10) + (.and ((pzPackCfg q'.val h' (.var 8) (.var 9)).eqFormula (.var 5) 10) + (.and (.eq (.var 8) (.add (.mul (.ofNat 2) (.var 6)) (.ofNat w.val))) + (.eq (.var 7) (.add (.mul (.ofNat 2) (.var 9)) (.ofNat h'))))))))) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · rw [htr, List.mem_map] + exact ⟨h', hh'mem, rfl⟩ + · simp only [φ, PAFormula.HoldsIn] + refine ⟨L, R, mCons w L, mHalf R, ?_⟩ + set v' := Function.update (Function.update + (Function.update (Function.update v 6 L) 7 R) 8 (mCons w L)) 9 (mHalf R) + have hv4' : v' 4 = v 4 := by simp [v'] + have hv5' : v' 5 = v 5 := by simp [v'] + have hv6' : v' 6 = L := by simp [v'] + have hv7' : v' 7 = R := by simp [v'] + have hv8' : v' 8 = mCons w L := by simp [v'] + have hv9' : v' 9 = mHalf R := by simp [v'] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [eqFormula_holdsIn_iff _ (.var 4) 10 v' + (pzPackCfg_fresh_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + simp [pzPackCfg_evalPAM, evalPAZFTerm, hv4', hv6', hv7', hv4, mEncodeCfg] + · rw [eqFormula_holdsIn_iff _ (.var 5) 10 v' + (pzPackCfg_fresh_le q'.val h' 8 9 (by decide) (by decide)) (by decide)] + simp [pzPackCfg_evalPAM, evalPAZFTerm, hv5', hv8', hv9', hv5, mEncodeCfg, h'] + · simp [hv6', hv8', mCons] + · simp only [evalIn_var, evalIn_add, evalIn_mul, evalIn_ofNat, Nat.cast_ofNat, + hv7', hv9', h'] + exact (mCons_mBit_mHalf R).symm + +theorem paHalted_holdsIn_iff {states : ℕ} (tm : Machine states 2) (v : ℕ → PAM M) : + PAFormula.HoldsIn v (paHalted tm) ↔ + ∃ c : MCfg states M, v 4 = mEncodeCfg c ∧ mStep tm c = none := by + unfold paHalted + rw [paDisjList_holdsIn_iff] + simp only [List.mem_flatMap] + constructor + · rintro ⟨φ, ⟨q, _, h, _, hmem⟩, hholds⟩ + cases htr : tm.transition q h with + | some _ => rw [htr] at hmem; cases hmem + | none => + rw [htr, List.mem_singleton] at hmem + subst hmem + simp only [PAFormula.HoldsIn] at hholds + rcases hholds with ⟨n6, n7, heq⟩ + set v' := Function.update (Function.update v 6 n6) 7 n7 + have e1 := (eqFormula_holdsIn_iff _ (.var 4) 10 v' + (pzPackCfg_fresh_le q.val h.val 6 7 (by decide) (by decide)) (by decide)).mp heq + have hv4 : v' 4 = v 4 := by simp [v'] + have hv6 : v' 6 = n6 := by simp [v'] + have hv7 : v' 7 = n7 := by simp [v'] + simp only [evalIn_var, pzPackCfg_evalPAM, evalPAZFTerm, hv4, hv6, hv7] at e1 + exact ⟨⟨q, h, n6, n7⟩, e1, by simp [mStep, htr]⟩ + · rintro ⟨⟨q, h, L, R⟩, hv4, hstep⟩ + dsimp only [mStep] at hstep + cases htr : tm.transition q h with + | some val => + rcases val with ⟨w, d, q'⟩ + cases d <;> simp [htr] at hstep + | none => + let φ := PAFormula.ex 6 + (.ex 7 ((pzPackCfg q.val h.val (.var 6) (.var 7)).eqFormula (.var 4) 10)) + refine ⟨φ, ⟨q, List.mem_finRange q, h, List.mem_finRange h, ?_⟩, ?_⟩ + · simp [htr, φ] + · simp only [φ, PAFormula.HoldsIn] + refine ⟨L, R, ?_⟩ + set v' := Function.update (Function.update v 6 L) 7 R + rw [eqFormula_holdsIn_iff _ (.var 4) 10 v' + (pzPackCfg_fresh_le q.val h.val 6 7 (by decide) (by decide)) (by decide)] + have hv4' : v' 4 = v 4 := by simp [v'] + have hv6' : v' 6 = L := by simp [v'] + have hv7' : v' 7 = R := by simp [v'] + simp [pzPackCfg_evalPAM, evalPAZFTerm, hv4', hv6', hv7', hv4, mEncodeCfg] + +/-- A $\beta$-coded `n`-step `mStep` execution trace from `a` to `b` in `PAM M`. -/ +def MValidTrace {states : ℕ} (tm : Machine states 2) + (n c d : PAM M) (a b : MCfg states M) : Prop := + mBeta c d 0 = mEncodeCfg a ∧ + (∀ i < n, ∃ x y : MCfg states M, + mBeta c d i = mEncodeCfg x ∧ mBeta c d (i + 1) = mEncodeCfg y ∧ mStep tm x = some y) ∧ + mBeta c d n = mEncodeCfg b + +/-- Configuration `a` reaches `b` in `n : PAM M` steps of `tm` via a $\beta$-coded trace. -/ +def mTracesTo {states : ℕ} (tm : Machine states 2) + (n : PAM M) (a b : MCfg states M) : Prop := + ∃ c d : PAM M, MValidTrace tm n c d a b + +/-- Machine `tm` halts from configuration `a` inside `PAM M`. -/ +def mHaltsFrom {states : ℕ} (tm : Machine states 2) (a : MCfg states M) : Prop := + ∃ (n : PAM M) (f : MCfg states M), mTracesTo tm n a f ∧ mStep tm f = none + +/-- Machine `tm` halts from the blank initial configuration `mInit` inside `PAM M`. -/ +def mHalts (M : Type*) [PAStructure M] [PAModel M] {states : ℕ} [NeZero states] + (tm : Machine states 2) : Prop := + mHaltsFrom tm (mInit : MCfg states M) + +theorem paDef_mStepCode {states : ℕ} (tm : Machine states 2) {k : ℕ} + {fx fy : (Fin k → PAM M) → PAM M} (hx : PAFunN k fx) (hy : PAFunN k fy) : + PADefN k (fun a ↦ ∃ x y : MCfg states M, + fx a = mEncodeCfg x ∧ fy a = mEncodeCfg y ∧ mStep tm x = some y) := by + have hbase : PADefN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ ∃ x y : MCfg states M, + b ⟨k, by omega⟩ = mEncodeCfg x ∧ b (Fin.last (k + 1)) = mEncodeCfg y ∧ + mStep tm x = some y) := by + let σ : ℕ → ℕ := fun z ↦ + if z = 4 then k else if z = 5 then k + 1 else z + k + 2 + have hσ_inj : Function.Injective σ := by + intro x y hxy + dsimp only [σ] at hxy + split_ifs at hxy <;> omega + refine ⟨renameAllFormula σ (paStep tm), fun _ ↦ 0, fun b ↦ ?_⟩ + rw [holdsIn_renameAllFormula hσ_inj, paStep_holdsIn_iff] + have h4 : (paEnv (fun _ ↦ (0 : PAM M)) b ∘ σ) 4 = b ⟨k, by omega⟩ := + paEnv_lt _ _ (by omega : k < k + 2) + have h5 : (paEnv (fun _ ↦ (0 : PAM M)) b ∘ σ) 5 = b (Fin.last (k + 1)) := + paEnv_lt _ _ (Nat.lt_succ_self (k + 1)) + rw [h4, h5] + have h1 := paDef_subst_last (paFun_weaken hy) hbase + have h2 := paDef_subst_last hx h1 + refine paDefN_congr (fun a ↦ ?_) h2 + refine exists_congr fun x ↦ exists_congr fun y ↦ ?_ + rw [Fin.snoc_last, Fin.init_snoc, fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] + +theorem paDef_mHaltedCode {states : ℕ} (tm : Machine states 2) {k : ℕ} + {fx : (Fin k → PAM M) → PAM M} (hx : PAFunN k fx) : + PADefN k (fun a ↦ ∃ x : MCfg states M, fx a = mEncodeCfg x ∧ mStep tm x = none) := by + have hbase : PADefN (k + 1) (fun b : Fin (k + 1) → PAM M ↦ ∃ x : MCfg states M, + b (Fin.last k) = mEncodeCfg x ∧ mStep tm x = none) := by + let σ : ℕ → ℕ := fun z ↦ if z = 4 then k else z + k + 1 + have hσ_inj : Function.Injective σ := by + intro x y hxy + dsimp only [σ] at hxy + split_ifs at hxy <;> omega + refine ⟨renameAllFormula σ (paHalted tm), fun _ ↦ 0, fun b ↦ ?_⟩ + rw [holdsIn_renameAllFormula hσ_inj, paHalted_holdsIn_iff] + have h4 : (paEnv (fun _ ↦ (0 : PAM M)) b ∘ σ) 4 = b (Fin.last k) := + paEnv_lt _ _ (Nat.lt_succ_self k) + rw [h4] + refine paDefN_congr (fun a ↦ ?_) (paDef_subst_last hx hbase) + simp only [Fin.snoc_last] + +theorem paDef_mTracesToCode {states : ℕ} (tm : Machine states 2) {k : ℕ} + {fn fa fb : (Fin k → PAM M) → PAM M} + (hn : PAFunN k fn) (ha : PAFunN k fa) (hb : PAFunN k fb) : + PADefN k (fun args ↦ ∃ a b : MCfg states M, + fa args = mEncodeCfg a ∧ fb args = mEncodeCfg b ∧ mTracesTo tm (fn args) a b) := by + have validCode : ∀ {m : ℕ} {f : (Fin m → PAM M) → PAM M}, PAFunN m f → + PADefN m (fun u ↦ ∃ x : MCfg states M, f u = mEncodeCfg x) := by + intro m f hf + have hqh : ∀ (q : Fin states) (h : Fin 2), + PADefN m (fun u ↦ ∃ L R : PAM M, + f u = mPair (q.val : PAM M) (mPair (h.val : PAM M) (mPair L R))) := by + intro q h + have heq : PADefN (m + 2) (fun w : Fin (m + 2) → PAM M ↦ + f (Fin.init (Fin.init w)) = + mPair (q.val : PAM M) + (mPair (h.val : PAM M) (mPair (w ⟨m, by omega⟩) (w (Fin.last (m + 1)))))) := + paDef_eq (paFun_weaken (paFun_weaken hf)) + (paFun_mPair (paFun_const _) + (paFun_mPair (paFun_const _) + (paFun_mPair (paFun_proj ⟨m, by omega⟩) (paFun_proj (Fin.last (m + 1)))))) + refine paDefN_congr (fun u ↦ ?_) (paDef_ex (paDef_ex heq)) + refine exists_congr fun L ↦ exists_congr fun R ↦ ?_ + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self m), fin_snoc_eq] + refine paDefN_congr (fun u ↦ ?_) + (paDef_fin_exists fun q ↦ paDef_fin_exists fun h ↦ hqh q h) + constructor + · rintro ⟨q, h, L, R, heq⟩ + exact ⟨⟨q, h, L, R⟩, heq⟩ + · rintro ⟨⟨q, h, L, R⟩, heq⟩ + exact ⟨q, h, L, R, heq⟩ + have hbody : PADefN (k + 2) (fun w : Fin (k + 2) → PAM M ↦ + mBeta (w ⟨k, by omega⟩) (w (Fin.last (k + 1))) 0 = fa (Fin.init (Fin.init w)) ∧ + (∀ i < fn (Fin.init (Fin.init w)), ∃ x y : MCfg states M, + mBeta (w ⟨k, by omega⟩) (w (Fin.last (k + 1))) i = mEncodeCfg x ∧ + mBeta (w ⟨k, by omega⟩) (w (Fin.last (k + 1))) (i + 1) = mEncodeCfg y ∧ + mStep tm x = some y) ∧ + mBeta (w ⟨k, by omega⟩) (w (Fin.last (k + 1))) (fn (Fin.init (Fin.init w))) = + fb (Fin.init (Fin.init w))) := by + let fc : (Fin (k + 2) → PAM M) → PAM M := fun w ↦ w ⟨k, by omega⟩ + let fd : (Fin (k + 2) → PAM M) → PAM M := fun w ↦ w (Fin.last (k + 1)) + have hc : PAFunN (k + 2) fc := paFun_proj ⟨k, by omega⟩ + have hd : PAFunN (k + 2) fd := paFun_proj (Fin.last (k + 1)) + have hn2 : PAFunN (k + 2) (fun w ↦ fn (Fin.init (Fin.init w))) := + paFun_weaken (paFun_weaken hn) + have ha2 : PAFunN (k + 2) (fun w ↦ fa (Fin.init (Fin.init w))) := + paFun_weaken (paFun_weaken ha) + have hb2 : PAFunN (k + 2) (fun w ↦ fb (Fin.init (Fin.init w))) := + paFun_weaken (paFun_weaken hb) + have h0 := paDef_eq (paFun_mBeta hc hd (paFun_const 0)) ha2 + have hlast := paDef_eq (paFun_mBeta hc hd hn2) hb2 + have hfor : PADefN (k + 2) (fun w ↦ ∀ i < fn (Fin.init (Fin.init w)), + ∃ x y : MCfg states M, + mBeta (fc w) (fd w) i = mEncodeCfg x ∧ + mBeta (fc w) (fd w) (i + 1) = mEncodeCfg y ∧ mStep tm x = some y) := by + let fi : (Fin (k + 3) → PAM M) → PAM M := fun z ↦ z (Fin.last (k + 2)) + have hi : PAFunN (k + 3) fi := paFun_proj (Fin.last (k + 2)) + have hc3 := paFun_weaken hc + have hd3 := paFun_weaken hd + have hn3 := paFun_weaken hn2 + refine paDefN_congr (fun w ↦ ?_) + (paDef_all (paDef_imp (paDef_lt hi hn3) + (paDef_mStepCode tm + (paFun_mBeta hc3 hd3 hi) + (paFun_mBeta hc3 hd3 (paFun_add hi (paFun_const 1)))))) + simp only [fi, Fin.snoc_last, Fin.init_snoc] + exact paDef_and h0 (paDef_and hfor hlast) + refine paDefN_congr (fun args ↦ ?_) + (paDef_and (validCode ha) (paDef_and (validCode hb) (paDef_ex (paDef_ex hbody)))) + constructor + · rintro ⟨⟨a, ha_eq⟩, ⟨b, hb_eq⟩, c, d, h0, hfor, hlast⟩ + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] at h0 hfor hlast + rw [ha_eq] at h0 + rw [hb_eq] at hlast + exact ⟨a, b, ha_eq, hb_eq, c, d, h0, hfor, hlast⟩ + · rintro ⟨a, b, ha_eq, hb_eq, c, d, h0, hfor, hlast⟩ + refine ⟨⟨a, ha_eq⟩, ⟨b, hb_eq⟩, c, d, ?_⟩ + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] + exact ⟨h0.trans ha_eq.symm, hfor, hlast.trans hb_eq.symm⟩ + +theorem paHalts_holdsIn_iff {states : ℕ} [NeZero states] (tm : Machine states 2) + (v : ℕ → PAM M) : + PAFormula.HoldsIn v (paHalts tm) ↔ mHalts M tm := by + unfold paHalts mHalts mHaltsFrom mTracesTo MValidTrace + simp only [PAFormula.HoldsIn] + constructor + · rintro ⟨n, c, d, h0, hsteps, hhalt⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + have hb0 : mBeta c d 0 = 0 := by + have := (paBetaEq_holdsIn_iff v2 (.var 1) (.var 2) .zero .zero).mp h0 + simpa [v2] using this + rcases hhalt with ⟨x4, hb_n, hhalted⟩ + set v4 := Function.update v2 4 x4 + have hx4 : mBeta c d n = x4 := by + have := (paBetaEq_holdsIn_iff v4 (.var 1) (.var 2) (.var 0) (.var 4)).mp hb_n + simpa [v4, v2] using this + obtain ⟨f, hxf, hnone⟩ := (paHalted_holdsIn_iff tm v4).mp hhalted + simp only [v4, Function.update_self] at hxf + refine ⟨n, f, ⟨c, d, ?_, ?_, hx4.trans hxf⟩, hnone⟩ + · simpa [mEncodeCfg_mInit] using hb0 + · intro i hilt + have hilt' : PAFormula.HoldsIn (Function.update v2 3 i) (paLt (.var 3) (.var 0)) := by + rw [paLt_holdsIn_iff] + simpa [v2] using hilt + obtain ⟨y4, y5, hbi, hbi1, hst⟩ := hsteps i hilt' + set v5 := Function.update (Function.update (Function.update v2 3 i) 4 y4) 5 y5 + have hy4 : mBeta c d i = y4 := by + have := (paBetaEq_holdsIn_iff v5 (.var 1) (.var 2) (.var 3) (.var 4)).mp hbi + simpa [v5, v2] using this + have hy5 : mBeta c d (i + 1) = y5 := by + have := (paBetaEq_holdsIn_iff v5 (.var 1) (.var 2) (.succ (.var 3)) (.var 5)).mp hbi1 + simpa [v5, v2] using this + obtain ⟨x, y, hx, hy, hstep⟩ := (paStep_holdsIn_iff tm v5).mp hst + simp only [v5, Function.update_self, + Function.update_of_ne (by decide : (4 : ℕ) ≠ 5)] at hx hy + exact ⟨x, y, hy4.trans hx, hy5.trans hy, hstep⟩ + · rintro ⟨n, f, ⟨c, d, h0, hsteps, hn⟩, hnone⟩ + refine ⟨n, c, d, ?_⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + refine ⟨?_, ?_, ?_⟩ + · rw [paBetaEq_holdsIn_iff] + simpa [v2, mEncodeCfg_mInit] using h0 + · intro i hilt + rw [paLt_holdsIn_iff] at hilt + have hi_lt : i < n := by simpa [v2] using hilt + obtain ⟨x, y, hx, hy, hstep⟩ := hsteps i hi_lt + refine ⟨mEncodeCfg x, mEncodeCfg y, ?_⟩ + set v5 := Function.update (Function.update + (Function.update v2 3 i) 4 (mEncodeCfg x)) 5 (mEncodeCfg y) + refine ⟨?_, ?_, ?_⟩ + · rw [paBetaEq_holdsIn_iff] + simpa [v5, v2] using hx + · rw [paBetaEq_holdsIn_iff] + simpa [v5, v2] using hy + · rw [paStep_holdsIn_iff] + exact ⟨x, y, by simp [v5], by simp [v5], hstep⟩ + · refine ⟨mEncodeCfg f, ?_⟩ + set v4 := Function.update v2 4 (mEncodeCfg f) + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holdsIn_iff] + simpa [v4, v2] using hn + · rw [paHalted_holdsIn_iff] + exact ⟨f, by simp [v4], hnone⟩ + +theorem mTracesTo_zero {states : ℕ} (tm : Machine states 2) (a : MCfg states M) : + mTracesTo tm 0 a a := + ⟨mEncodeCfg a, mEncodeCfg a + 1, mBeta_singleton _, + fun _ hi ↦ absurd hi (not_lt_zero_pam _), mBeta_singleton _⟩ + +theorem mTracesTo_snoc {states : ℕ} {tm : Machine states 2} {n : PAM M} {a b c : MCfg states M} + (htr : mTracesTo tm n a b) (hst : mStep tm b = some c) : + mTracesTo tm (n + 1) a c := by + rcases htr with ⟨c₀, d₀, h0, hsteps, hn⟩ + obtain ⟨c', d', hprev, hlast⟩ := mBeta_snoc (n + 1) c₀ d₀ (mEncodeCfg c) + refine ⟨c', d', ?_, ?_, hlast⟩ + · rw [hprev 0 ⟨n, by ring⟩, h0] + · intro i hi + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hi) with hilt | rfl + · rw [hprev i (lt_trans hilt (lt_succ_self_pam n)), + hprev (i + 1) (add_lt_add_right_pam hilt 1)] + exact hsteps i hilt + · rw [hprev i (lt_succ_self_pam i), hlast] + exact ⟨b, c, hn, rfl, hst⟩ + +theorem mTracesTo_one {states : ℕ} {tm : Machine states 2} {a b : MCfg states M} + (hst : mStep tm a = some b) : mTracesTo tm 1 a b := by + simpa using mTracesTo_snoc (mTracesTo_zero tm a) hst + +theorem mTracesTo_trans {states : ℕ} {tm : Machine states 2} {n₁ n₂ : PAM M} + {a b c : MCfg states M} (h₁ : mTracesTo tm n₁ a b) (h₂ : mTracesTo tm n₂ b c) : + mTracesTo tm (n₁ + n₂) a c := by + rcases eq_zero_or_exists_succ n₂ with rfl | ⟨m₂, rfl⟩ + · rw [add_zero] + rcases h₁ with ⟨c₁, d₁, ha₁, hst₁, hb₁⟩ + rcases h₂ with ⟨c₂, d₂, hb₂, _, hc₂⟩ + have hbc : b = c := mEncodeCfg_injective (hb₂.symm.trans hc₂) + subst hbc + exact ⟨c₁, d₁, ha₁, hst₁, hb₁⟩ + · rcases h₁ with ⟨c₁, d₁, ha₁, hst₁, hb₁⟩ + rcases h₂ with ⟨c₂, d₂, hb₂, hst₂, hc₂⟩ + obtain ⟨c', d', hleft, hright⟩ := mBeta_concat n₁ c₁ d₁ (m₂ + 1 + 1) c₂ d₂ + refine ⟨c', d', ?_, ?_, ?_⟩ + · rcases eq_zero_or_exists_succ n₁ with rfl | ⟨m₁, rfl⟩ + · have h0 := hright 0 ⟨m₂ + 1, by ring⟩ + rw [zero_add] at h0 + have hab : a = b := mEncodeCfg_injective (ha₁.symm.trans hb₁) + subst hab + exact h0.trans hb₂ + · exact (hleft 0 ⟨m₁, by ring⟩).trans ha₁ + · intro i hi + rcases lt_or_ge i n₁ with hilt | hige + · obtain ⟨x, y, hx, hy, hxy⟩ := hst₁ i hilt + refine ⟨x, y, (hleft i hilt).trans hx, ?_, hxy⟩ + rcases lt_or_eq_of_le (show i + 1 ≤ n₁ from hilt) with hilt1 | hi1_eq + · exact (hleft (i + 1) hilt1).trans hy + · rw [hi1_eq] at hy ⊢ + have h0 := hright 0 ⟨m₂ + 1, by ring⟩ + rw [add_zero] at h0 + exact h0.trans (hb₂.trans (hb₁.symm.trans hy)) + · let j := i - n₁ + have hij : n₁ + j = i := add_sub_of_le_pam hige + have hjlt : j < m₂ + 1 := by + rcases hi with ⟨w, hw⟩ + exact ⟨w, (add_left_inj_pam n₁).mp (by + calc n₁ + (j + 1 + w) + _ = (n₁ + j) + 1 + w := by ring + _ = i + 1 + w := by rw [hij] + _ = n₁ + (m₂ + 1) := hw)⟩ + obtain ⟨x, y, hx, hy, hxy⟩ := hst₂ j hjlt + refine ⟨x, y, ?_, ?_, hxy⟩ + · rw [← hij] + exact (hright j (lt_trans hjlt (lt_succ_self_pam (m₂ + 1)))).trans hx + · have hij1 : i + 1 = n₁ + (j + 1) := by rw [← hij]; ring + rw [hij1] + exact (hright (j + 1) (add_lt_add_right_pam hjlt 1)).trans hy + · exact (hright (m₂ + 1) (lt_succ_self_pam (m₂ + 1))).trans hc₂ + +/-- Determinism of $\beta$-coded traces: any two valid traces from `a` agree at every common step +index. -/ +theorem mValidTrace_agree {states : ℕ} {tm : Machine states 2} + {n₁ c₁ d₁ n₂ c₂ d₂ : PAM M} {a b₁ b₂ : MCfg states M} + (h₁ : MValidTrace tm n₁ c₁ d₁ a b₁) (h₂ : MValidTrace tm n₂ c₂ d₂ a b₂) : + ∀ i : PAM M, i ≤ n₁ → i ≤ n₂ → mBeta c₁ d₁ i = mBeta c₂ d₂ i := by + have hdef : PADef1 (fun i : PAM M ↦ i ≤ n₁ → i ≤ n₂ → mBeta c₁ d₁ i = mBeta c₂ d₂ i) := + paDef_imp (paDef_le (paFun_proj 0) (paFun_const n₁)) + (paDef_imp (paDef_le (paFun_proj 0) (paFun_const n₂)) + (paDef_eq + (paFun_mBeta (paFun_const c₁) (paFun_const d₁) (paFun_proj 0)) + (paFun_mBeta (paFun_const c₂) (paFun_const d₂) (paFun_proj 0)))) + refine ind1 hdef (fun _ _ ↦ h₁.1.trans h₂.1.symm) (fun i ih hi1 hi2 ↦ ?_) + have hilt1 : i < n₁ := hi1 + have hilt2 : i < n₂ := hi2 + have heq_i := ih (le_of_lt hilt1) (le_of_lt hilt2) + obtain ⟨x₁, y₁, hx₁, hy₁, hst₁⟩ := h₁.2.1 i hilt1 + obtain ⟨x₂, y₂, hx₂, hy₂, hst₂⟩ := h₂.2.1 i hilt2 + have hx : x₁ = x₂ := mEncodeCfg_injective (hx₁.symm.trans (heq_i.trans hx₂)) + subst hx + have hy : y₁ = y₂ := Option.some.inj (hst₁.symm.trans hst₂) + subst hy + exact hy₁.trans hy₂.symm + +theorem mTracesTo_unique {states : ℕ} {tm : Machine states 2} {n : PAM M} + {a b₁ b₂ : MCfg states M} (h₁ : mTracesTo tm n a b₁) (h₂ : mTracesTo tm n a b₂) : + b₁ = b₂ := by + rcases h₁ with ⟨c₁, d₁, hv₁⟩ + rcases h₂ with ⟨c₂, d₂, hv₂⟩ + have hag := mValidTrace_agree hv₁ hv₂ n le_rfl le_rfl + exact mEncodeCfg_injective (hv₁.2.2.symm.trans (hag.trans hv₂.2.2)) + +/-- If `a` reaches `mid` in `k` steps, then `a` halts iff `mid` halts. -/ +theorem mHaltsFrom_iff_of_mTracesTo {states : ℕ} {tm : Machine states 2} + {k : PAM M} {a mid : MCfg states M} (hpre : mTracesTo tm k a mid) : + mHaltsFrom tm a ↔ mHaltsFrom tm mid := by + constructor + · rintro ⟨N, f, htot, hnone⟩ + rcases hpre with ⟨c₁, d₁, hv₁⟩ + rcases htot with ⟨c₂, d₂, hv₂⟩ + have hk_le_N : k ≤ N := by + by_contra hgt + have hN_lt_k : N < k := lt_of_not_ge hgt + have hag := mValidTrace_agree hv₁ hv₂ N (le_of_lt hN_lt_k) le_rfl + obtain ⟨x, y, hx, _, hst⟩ := hv₁.2.1 N hN_lt_k + have hxf : x = f := mEncodeCfg_injective (hx.symm.trans (hag.trans hv₂.2.2)) + subst hxf + rw [hnone] at hst + cases hst + -- Extract suffix trace of length `N - k` from `mid` to `f` + have hdef : PADef1 (fun m : PAM M ↦ m ≤ N - k → + ∃ b : MCfg states M, mBeta c₂ d₂ (k + m) = mEncodeCfg b ∧ mTracesTo tm m mid b) := by + have hm_le : PADefN 1 (fun u ↦ u 0 ≤ N - k) := + paDef_le (paFun_proj 0) (paFun_const (N - k)) + have htr : PADefN 1 (fun u ↦ ∃ a₀ b : MCfg states M, + mEncodeCfg mid = mEncodeCfg a₀ ∧ + mBeta c₂ d₂ (k + u 0) = mEncodeCfg b ∧ + mTracesTo tm (u 0) a₀ b) := + paDef_mTracesToCode tm (paFun_proj 0) (paFun_const (mEncodeCfg mid)) + (paFun_mBeta (paFun_const c₂) (paFun_const d₂) + (paFun_add (paFun_const k) (paFun_proj 0))) + refine paDefN_congr (fun u ↦ ?_) (paDef_imp hm_le htr) + refine imp_congr Iff.rfl ⟨?_, ?_⟩ + · rintro ⟨a₀, b, ha₀, hb, htr₀⟩ + rw [← mEncodeCfg_injective ha₀] at htr₀ + exact ⟨b, hb, htr₀⟩ + · rintro ⟨b, hb, htr₀⟩ + exact ⟨mid, b, rfl, hb, htr₀⟩ + have hsuf := ind1 hdef ?_ ?_ (N - k) le_rfl + · obtain ⟨b, hb, htr_b⟩ := hsuf + rw [add_sub_of_le_pam hk_le_N] at hb + have hbf : b = f := mEncodeCfg_injective (hb.symm.trans hv₂.2.2) + subst hbf + exact ⟨N - k, b, htr_b, hnone⟩ + · intro _ + have hag := mValidTrace_agree hv₁ hv₂ k le_rfl hk_le_N + exact ⟨mid, by rw [add_zero]; exact hag.symm.trans hv₁.2.2, mTracesTo_zero tm mid⟩ + · intro m ih hm1 + have hmlt : m < N - k := hm1 + obtain ⟨b, hb, htr_b⟩ := ih (le_of_lt hmlt) + have hkm_lt : k + m < N := by + have := add_lt_add_left_pam hmlt k + rwa [add_sub_of_le_pam hk_le_N] at this + obtain ⟨x, y, hx, hy, hst⟩ := hv₂.2.1 (k + m) hkm_lt + have hxb : x = b := mEncodeCfg_injective (hx.symm.trans hb) + subst hxb + exact ⟨y, by rw [← add_assoc]; exact hy, mTracesTo_snoc htr_b hst⟩ + · rintro ⟨n', f, hsuf, hnone⟩ + exact ⟨k + n', f, mTracesTo_trans hpre hsuf, hnone⟩ + +theorem mTracesTo_of_mNSteps {states : ℕ} {tm : Machine states 2} : + ∀ {k : ℕ} {a b : MCfg states M}, + mNSteps tm k a = some b → mTracesTo tm (k : PAM M) a b + | 0, a, b, h => by + simp only [mNSteps, Option.some.injEq] at h + subst h + simpa using mTracesTo_zero tm a + | k + 1, a, b, h => by + simp only [mNSteps, Option.bind_eq_some_iff] at h + rcases h with ⟨mid, hst, hrest⟩ + have h1 := mTracesTo_one hst + have h2 := mTracesTo_of_mNSteps hrest + have htr := mTracesTo_trans h1 h2 + rw [show (1 : PAM M) + (k : PAM M) = ((k + 1 : ℕ) : PAM M) by push_cast; ring] at htr + exact htr + +/-- Embed a standard `ListBlank (Fin 2)` half-tape into `PAM M`. -/ +def embedHalf (L : ListBlank (Fin 2)) : PAM M := + (encodeHalf L : PAM M) + +/-- Embed a standard `Cfg states 2` configuration into `MCfg states M`. -/ +def embedCfg {states : ℕ} (c : Cfg states 2) : MCfg states M := + ⟨c.state, c.tape.head, embedHalf c.tape.left, embedHalf c.tape.right⟩ + +@[simp] +theorem embedCfg_init {states : ℕ} [NeZero states] : + embedCfg (init : Cfg states 2) = (mInit : MCfg states M) := by + have henc0 : encodeListBin [] = 0 := rfl + simp [embedCfg, embedHalf, mInit, init, Tape.mk₁, Tape.mk₂, Tape.mk', henc0] + +theorem embedHalf_cons (L : ListBlank (Fin 2)) (a : Fin 2) : + embedHalf (M := M) (L.cons a) = mCons a (embedHalf (M := M) L) := by + unfold embedHalf mCons + rw [encodeHalf_cons] + push_cast + rfl + +theorem mBit_embedHalf (L : ListBlank (Fin 2)) : mBit (embedHalf (M := M) L) = L.head := by + have h : embedHalf (M := M) L = mCons L.head (embedHalf (M := M) L.tail) := by + unfold embedHalf mCons + rw [encodeHalf_eq_tail_head] + push_cast + rfl + rw [h, mBit_mCons] + +theorem mHalf_embedHalf (L : ListBlank (Fin 2)) : + mHalf (embedHalf (M := M) L) = embedHalf (M := M) L.tail := by + have h : embedHalf (M := M) L = mCons L.head (embedHalf (M := M) L.tail) := by + unfold embedHalf mCons + rw [encodeHalf_eq_tail_head] + push_cast + rfl + rw [h, mHalf_mCons] + +theorem mStep_embedCfg_some {states : ℕ} {tm : Machine states 2} {c c' : Cfg states 2} + (h : step tm c = some c') : + mStep tm (embedCfg (M := M) c) = some (embedCfg (M := M) c') := by + rcases c with ⟨q, hd, L, R⟩ + simp only [step] at h + cases htr : tm.transition q hd with + | none => simp [htr] at h + | some val => + rcases val with ⟨w, d, q'⟩ + rw [htr, Option.map_some, Option.some.injEq] at h + subst h + cases d <;> + simp [embedCfg, mStep, htr, Tape.write, Tape.move, + mBit_embedHalf, mHalf_embedHalf, embedHalf_cons] + +theorem mTracesTo_of_nSteps {states : ℕ} [NeZero states] {tm : Machine states 2} : + ∀ {k : ℕ} {c c' : Cfg states 2}, + nSteps tm k c = some c' → + mTracesTo tm (k : PAM M) (embedCfg (M := M) c) (embedCfg (M := M) c') + | 0, c, c', h => by + simp only [ConjectureMachines.Semantics.Riemann.Layer1.nSteps_zero, Option.some.injEq] at h + subst h + simpa using mTracesTo_zero tm (embedCfg c) + | k + 1, c, c', h => by + simp only [ConjectureMachines.Semantics.Riemann.Layer1.nSteps_succ, + Option.bind_eq_some_iff] at h + rcases h with ⟨mid, hst, hrest⟩ + have h1 := mTracesTo_one (mStep_embedCfg_some (M := M) hst) + have h2 := mTracesTo_of_nSteps hrest + have htr := mTracesTo_trans h1 h2 + rw [show (1 : PAM M) + (k : PAM M) = ((k + 1 : ℕ) : PAM M) by push_cast; ring] at htr + exact htr + +end Execution + +/-! ## Section 8: Internal `ZF` Formula Constructors and `paZFInconsistent` in `PAM M` -/ + +section ZFInternal +variable {M : Type*} [PAStructure M] [PAModel M] +open PAM + +noncomputable def mZfEq (x y : PAM M) : PAM M := mPair (mPair x y) 0 +noncomputable def mZfMem (x y : PAM M) : PAM M := mPair (mPair x y) 1 +noncomputable def mZfImp (φ ψ : PAM M) : PAM M := mPair (mPair φ ψ) 2 +noncomputable def mZfNot (φ : PAM M) : PAM M := mPair φ 3 +noncomputable def mZfAll (x φ : PAM M) : PAM M := mPair (mPair x φ) 4 +noncomputable def mZfEx (x φ : PAM M) : PAM M := mZfNot (mZfAll x (mZfNot φ)) +noncomputable def mZfAnd (φ ψ : PAM M) : PAM M := mZfNot (mZfImp φ (mZfNot ψ)) + +noncomputable def mAxB1 (φ ψ χ : PAM M) : PAM M := + mZfImp (mZfImp φ ψ) (mZfImp (mZfImp ψ χ) (mZfImp φ χ)) +noncomputable def mAxB2 (φ : PAM M) : PAM M := mZfImp (mZfImp (mZfNot φ) φ) φ +noncomputable def mAxB3 (φ ψ : PAM M) : PAM M := mZfImp φ (mZfImp (mZfNot φ) ψ) +noncomputable def mAxB4 (x φ ψ : PAM M) : PAM M := + mZfImp (mZfAll x (mZfImp φ ψ)) (mZfImp (mZfAll x φ) (mZfAll x ψ)) +noncomputable def mAxB6a (x y z : PAM M) : PAM M := + mZfAnd (mZfImp (mZfEq x y) (mZfAll z (mZfEq x y))) + (mZfImp (mZfMem x y) (mZfAll z (mZfMem x y))) +noncomputable def mAxB6b (x y φ : PAM M) : PAM M := + mZfImp (mZfAll x (mZfAll y φ)) (mZfAll y (mZfAll x φ)) +noncomputable def mAxB6c (x φ : PAM M) : PAM M := mZfImp (mZfEx x (mZfAll x φ)) φ +noncomputable def mAxB7 (x y : PAM M) : PAM M := mZfEx x (mZfEq x y) +noncomputable def mAxB8a (x y z : PAM M) : PAM M := + mZfImp (mZfEq x y) (mZfImp (mZfEq x z) (mZfEq y z)) +noncomputable def mAxB8b (x y z : PAM M) : PAM M := + mZfImp (mZfEq x y) (mZfImp (mZfMem x z) (mZfMem y z)) +noncomputable def mAxB8c (x y z : PAM M) : PAM M := + mZfImp (mZfEq x y) (mZfImp (mZfMem z x) (mZfMem z y)) + +noncomputable def mAxExt : PAM M := + mZfImp + (mZfAll 2 (mZfAnd (mZfImp (mZfMem 2 0) (mZfMem 2 1)) (mZfImp (mZfMem 2 1) (mZfMem 2 0)))) + (mZfEq 0 1) + +noncomputable def mAxRepRhs (φ : PAM M) : PAM M := + mZfEx 3 (mZfAnd (mZfMem 3 0) (mZfAll 1 φ)) + +noncomputable def mAxRep (φ : PAM M) : PAM M := + mZfImp + (mZfAll 3 (mZfEx 1 (mZfAll 2 (mZfImp (mZfAll 1 φ) (mZfEq 2 1))))) + (mZfEx 1 (mZfAll 2 + (mZfAnd (mZfImp (mZfMem 2 1) (mAxRepRhs φ)) (mZfImp (mAxRepRhs φ) (mZfMem 2 1))))) + +noncomputable def mAxPow : PAM M := + mZfEx 1 (mZfAll 2 (mZfImp (mZfAll 3 (mZfImp (mZfMem 3 2) (mZfMem 3 0))) (mZfMem 2 1))) + +noncomputable def mAxUni : PAM M := + mZfEx 1 (mZfAll 2 (mZfImp (mZfEx 3 (mZfAnd (mZfMem 2 3) (mZfMem 3 0))) (mZfMem 2 1))) + +noncomputable def mAxInfSingleton : PAM M := + mZfAll 1 (mZfAnd (mZfImp (mZfMem 1 2) (mZfEq 1 0)) (mZfImp (mZfEq 1 0) (mZfMem 1 2))) + +noncomputable def mAxInf : PAM M := + mZfEx 1 + (mZfAnd (mZfMem 0 1) + (mZfAll 0 (mZfImp (mZfMem 0 1) (mZfEx 2 (mZfAnd (mZfMem 2 1) mAxInfSingleton))))) + +@[simp] +theorem mZfMem_zero_zero : mZfMem (0 : PAM M) 0 = 1 := by + have h : mZfMem (0 : PAM M) 0 = mZfMem ((0 : ℕ) : PAM M) ((0 : ℕ) : PAM M) := rfl + simp only [mZfMem, mPair_zero_zero] + have h1 : mPair ((0 : ℕ) : PAM M) ((1 : ℕ) : PAM M) = (cantorPair 0 1 : PAM M) := + mPair_natCast 0 1 + have hc : cantorPair 0 1 = 1 := rfl + rw [hc] at h1 + simpa using h1 + +private theorem pzEq_evalPAM (v : ℕ → PAM M) (x y : PAZFTerm) : + evalPAZFTerm v (pzEq x y) = mZfEq (evalPAZFTerm v x) (evalPAZFTerm v y) := by + simp [pzEq, mZfEq, evalPAZFTerm] +private theorem pzMem_evalPAM (v : ℕ → PAM M) (x y : PAZFTerm) : + evalPAZFTerm v (pzMem x y) = mZfMem (evalPAZFTerm v x) (evalPAZFTerm v y) := by + simp [pzMem, mZfMem, evalPAZFTerm] +private theorem pzImp_evalPAM (v : ℕ → PAM M) (φ ψ : PAZFTerm) : + evalPAZFTerm v (pzImp φ ψ) = mZfImp (evalPAZFTerm v φ) (evalPAZFTerm v ψ) := by + simp [pzImp, mZfImp, evalPAZFTerm] +private theorem pzNot_evalPAM (v : ℕ → PAM M) (φ : PAZFTerm) : + evalPAZFTerm v (pzNot φ) = mZfNot (evalPAZFTerm v φ) := by + simp [pzNot, mZfNot, evalPAZFTerm] +private theorem pzAll_evalPAM (v : ℕ → PAM M) (x φ : PAZFTerm) : + evalPAZFTerm v (pzAll x φ) = mZfAll (evalPAZFTerm v x) (evalPAZFTerm v φ) := by + simp [pzAll, mZfAll, evalPAZFTerm] +private theorem pzEx_evalPAM (v : ℕ → PAM M) (x φ : PAZFTerm) : + evalPAZFTerm v (pzEx x φ) = mZfEx (evalPAZFTerm v x) (evalPAZFTerm v φ) := by + simp [pzEx, mZfEx, pzNot_evalPAM, pzAll_evalPAM] +private theorem pzAnd_evalPAM (v : ℕ → PAM M) (φ ψ : PAZFTerm) : + evalPAZFTerm v (pzAnd φ ψ) = mZfAnd (evalPAZFTerm v φ) (evalPAZFTerm v ψ) := by + simp [pzAnd, mZfAnd, pzNot_evalPAM, pzImp_evalPAM] + +private theorem pzB1_evalPAM (v : ℕ → PAM M) (φ ψ χ : PAZFTerm) : + evalPAZFTerm v (pzB1 φ ψ χ) = + mAxB1 (evalPAZFTerm v φ) (evalPAZFTerm v ψ) (evalPAZFTerm v χ) := by + simp only [pzB1, mAxB1, pzImp_evalPAM] +private theorem pzB2_evalPAM (v : ℕ → PAM M) (φ : PAZFTerm) : + evalPAZFTerm v (pzB2 φ) = mAxB2 (evalPAZFTerm v φ) := by + simp only [pzB2, mAxB2, pzImp_evalPAM, pzNot_evalPAM] +private theorem pzB3_evalPAM (v : ℕ → PAM M) (φ ψ : PAZFTerm) : + evalPAZFTerm v (pzB3 φ ψ) = mAxB3 (evalPAZFTerm v φ) (evalPAZFTerm v ψ) := by + simp only [pzB3, mAxB3, pzImp_evalPAM, pzNot_evalPAM] +private theorem pzB4_evalPAM (v : ℕ → PAM M) (x φ ψ : PAZFTerm) : + evalPAZFTerm v (pzB4 x φ ψ) = + mAxB4 (evalPAZFTerm v x) (evalPAZFTerm v φ) (evalPAZFTerm v ψ) := by + simp only [pzB4, mAxB4, pzImp_evalPAM, pzAll_evalPAM] +private theorem pzB6a_evalPAM (v : ℕ → PAM M) (x y z : PAZFTerm) : + evalPAZFTerm v (pzB6a x y z) = + mAxB6a (evalPAZFTerm v x) (evalPAZFTerm v y) (evalPAZFTerm v z) := by + simp only [pzB6a, mAxB6a, pzAnd_evalPAM, pzImp_evalPAM, pzAll_evalPAM, pzEq_evalPAM, + pzMem_evalPAM] +private theorem pzB6b_evalPAM (v : ℕ → PAM M) (x y φ : PAZFTerm) : + evalPAZFTerm v (pzB6b x y φ) = + mAxB6b (evalPAZFTerm v x) (evalPAZFTerm v y) (evalPAZFTerm v φ) := by + simp only [pzB6b, mAxB6b, pzImp_evalPAM, pzAll_evalPAM] +private theorem pzB6c_evalPAM (v : ℕ → PAM M) (x φ : PAZFTerm) : + evalPAZFTerm v (pzB6c x φ) = mAxB6c (evalPAZFTerm v x) (evalPAZFTerm v φ) := by + simp only [pzB6c, mAxB6c, pzImp_evalPAM, pzEx_evalPAM, pzAll_evalPAM] +private theorem pzB7_evalPAM (v : ℕ → PAM M) (x y : PAZFTerm) : + evalPAZFTerm v (pzB7 x y) = mAxB7 (evalPAZFTerm v x) (evalPAZFTerm v y) := by + simp only [pzB7, mAxB7, pzEx_evalPAM, pzEq_evalPAM] +private theorem pzB8a_evalPAM (v : ℕ → PAM M) (x y z : PAZFTerm) : + evalPAZFTerm v (pzB8a x y z) = + mAxB8a (evalPAZFTerm v x) (evalPAZFTerm v y) (evalPAZFTerm v z) := by + simp only [pzB8a, mAxB8a, pzImp_evalPAM, pzEq_evalPAM] +private theorem pzB8b_evalPAM (v : ℕ → PAM M) (x y z : PAZFTerm) : + evalPAZFTerm v (pzB8b x y z) = + mAxB8b (evalPAZFTerm v x) (evalPAZFTerm v y) (evalPAZFTerm v z) := by + simp only [pzB8b, mAxB8b, pzImp_evalPAM, pzEq_evalPAM, pzMem_evalPAM] +private theorem pzB8c_evalPAM (v : ℕ → PAM M) (x y z : PAZFTerm) : + evalPAZFTerm v (pzB8c x y z) = + mAxB8c (evalPAZFTerm v x) (evalPAZFTerm v y) (evalPAZFTerm v z) := by + simp only [pzB8c, mAxB8c, pzImp_evalPAM, pzEq_evalPAM, pzMem_evalPAM] +private theorem pzExt_evalPAM (v : ℕ → PAM M) : evalPAZFTerm v pzExt = mAxExt := by + simp only [pzExt, mAxExt, pzImp_evalPAM, pzAll_evalPAM, pzAnd_evalPAM, pzMem_evalPAM, + pzEq_evalPAM, evalPAZFTerm, Nat.cast_zero, Nat.cast_one, Nat.cast_ofNat] +private theorem pzRep_evalPAM (v : ℕ → PAM M) (φ : PAZFTerm) : + evalPAZFTerm v (pzRep φ) = mAxRep (evalPAZFTerm v φ) := by + simp only [pzRep, pzRepRhs, mAxRep, mAxRepRhs, pzImp_evalPAM, pzAll_evalPAM, pzEx_evalPAM, + pzAnd_evalPAM, pzMem_evalPAM, pzEq_evalPAM, evalPAZFTerm, Nat.cast_zero, Nat.cast_one, + Nat.cast_ofNat] +private theorem pzPow_evalPAM (v : ℕ → PAM M) : evalPAZFTerm v pzPow = mAxPow := by + simp only [pzPow, mAxPow, pzEx_evalPAM, pzAll_evalPAM, pzImp_evalPAM, pzMem_evalPAM, + evalPAZFTerm, Nat.cast_zero, Nat.cast_one, Nat.cast_ofNat] +private theorem pzUni_evalPAM (v : ℕ → PAM M) : evalPAZFTerm v pzUni = mAxUni := by + simp only [pzUni, mAxUni, pzEx_evalPAM, pzAll_evalPAM, pzImp_evalPAM, pzAnd_evalPAM, + pzMem_evalPAM, evalPAZFTerm, Nat.cast_zero, Nat.cast_one, Nat.cast_ofNat] +private theorem pzInf_evalPAM (v : ℕ → PAM M) : evalPAZFTerm v pzInf = mAxInf := by + simp only [pzInf, pzInfSingleton, mAxInf, mAxInfSingleton, pzEx_evalPAM, pzAnd_evalPAM, + pzAll_evalPAM, pzImp_evalPAM, pzMem_evalPAM, pzEq_evalPAM, evalPAZFTerm, Nat.cast_zero, + Nat.cast_one, Nat.cast_ofNat] + +/-- Whether `w : PAM M` is an axiom instance of `ZFProvable` inside `PAM M`. -/ +def MIsZFAxiom (w : PAM M) : Prop := + w = mZfEq 0 0 ∨ + (∃ φ ψ χ : PAM M, w = mAxB1 φ ψ χ) ∨ + (∃ φ : PAM M, w = mAxB2 φ) ∨ + (∃ φ ψ : PAM M, w = mAxB3 φ ψ) ∨ + (∃ x φ ψ : PAM M, w = mAxB4 x φ ψ) ∨ + (∃ x y z : PAM M, x ≠ z ∧ z ≠ y ∧ w = mAxB6a x y z) ∨ + (∃ x y φ : PAM M, w = mAxB6b x y φ) ∨ + (∃ x φ : PAM M, w = mAxB6c x φ) ∨ + (∃ x y : PAM M, w = mAxB7 x y) ∨ + (∃ x y z : PAM M, w = mAxB8a x y z) ∨ + (∃ x y z : PAM M, w = mAxB8b x y z) ∨ + (∃ x y z : PAM M, w = mAxB8c x y z) ∨ + w = mAxExt ∨ + (∃ φ : PAM M, w = mAxRep φ) ∨ + w = mAxPow ∨ + w = mAxUni ∨ + w = mAxInf + +/-- Validity of step `i` (formula `w`) in a $\beta$-coded `ZF` derivation `(c, d)` in `PAM M`. -/ +def MIsZFStep (c d i w : PAM M) : Prop := + MIsZFAxiom w ∨ + (∃ φ χ j₁ j₂ : PAM M, j₁ < i ∧ j₂ < i ∧ + mBeta c d j₁ = φ ∧ mBeta c d j₂ = χ ∧ χ = mZfImp φ w) ∨ + (∃ x φ j : PAM M, j < i ∧ mBeta c d j = φ ∧ w = mZfAll x φ) + +/-- Semantic `paZFInconsistent` witness in `PAM M`. -/ +def MZFInconsistent (M : Type*) [PAStructure M] [PAModel M] : Prop := + ∃ n c d : PAM M, + (∀ i ≤ n, MIsZFStep c d i (mBeta c d i)) ∧ + mBeta c d n = mZfMem 0 0 + +theorem paIsZFStep_holdsIn_iff (v : ℕ → PAM M) : + PAFormula.HoldsIn v paIsZFStep ↔ MIsZFStep (v 1) (v 2) (v 3) (v 4) := by + unfold paIsZFStep MIsZFStep MIsZFAxiom + rw [paDisjList_holdsIn_iff] + simp only [List.mem_cons, List.not_mem_nil, or_false, exists_eq_or_imp, exists_eq_left] + have eq_iff : ∀ (e : PAZFTerm) (out : PATerm) (u : ℕ → PAM M), + e.freshVar ≤ 10 → out.freshVar ≤ 10 → + (PAFormula.HoldsIn u (e.eqFormula out 10) ↔ PATerm.evalIn u out = evalPAZFTerm u e) := + fun e out u he ho ↦ eqFormula_holdsIn_iff e out 10 u he ho + constructor + · rintro (h0 | hmp | hgen | hb1 | hb2 | hb3 | hb4 | hb6a | hb6b | hb6c | hb7 | + hb8a | hb8b | hb8c | hext | hrep | hpow | huni | hinf) + · rw [eq_iff _ _ _ (by decide) (by decide)] at h0 + exact Or.inl (Or.inl (by simpa [pzEq_evalPAM, evalPAZFTerm] using h0)) + · simp only [PAFormula.HoldsIn] at hmp + rcases hmp with ⟨n5, n6, n8, n9, h8, h9, hb8, hb9, himp⟩ + set u := Function.update (Function.update + (Function.update (Function.update v 5 n5) 6 n6) 8 n8) 9 n9 + rw [paLt_holdsIn_iff] at h8 h9 + rw [paBetaEq_holdsIn_iff] at hb8 hb9 + rw [eq_iff _ _ _ (by decide) (by decide)] at himp + refine Or.inr (Or.inl ⟨n5, n6, n8, n9, ?_, ?_, ?_, ?_, ?_⟩) + · simpa [u] using h8 + · simpa [u] using h9 + · simpa [u] using hb8 + · simpa [u] using hb9 + · simpa [u, pzImp_evalPAM, evalPAZFTerm] using himp + · simp only [PAFormula.HoldsIn] at hgen + rcases hgen with ⟨n5, n6, n8, h8, hb8, hall⟩ + set u := Function.update (Function.update (Function.update v 5 n5) 6 n6) 8 n8 + rw [paLt_holdsIn_iff] at h8 + rw [paBetaEq_holdsIn_iff] at hb8 + rw [eq_iff _ _ _ (by decide) (by decide)] at hall + refine Or.inr (Or.inr ⟨n5, n6, n8, ?_, ?_, ?_⟩) + · simpa [u] using h8 + · simpa [u] using hb8 + · simpa [u, pzAll_evalPAM, evalPAZFTerm] using hall + · simp only [PAFormula.HoldsIn] at hb1 + rcases hb1 with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [pzB1_evalPAM, evalPAZFTerm] using h⟩)) + · simp only [PAFormula.HoldsIn] at hb2 + rcases hb2 with ⟨n5, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inl ⟨n5, + by simpa [pzB2_evalPAM, evalPAZFTerm] using h⟩))) + · simp only [PAFormula.HoldsIn] at hb3 + rcases hb3 with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, + by simpa [pzB3_evalPAM, evalPAZFTerm] using h⟩)))) + · simp only [PAFormula.HoldsIn] at hb4 + rcases hb4 with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [pzB4_evalPAM, evalPAZFTerm] using h⟩))))) + · simp only [PAFormula.HoldsIn] at hb6a + rcases hb6a with ⟨n5, n6, n7, hne1, hne2, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨n5, n6, n7, by simpa using hne1, by simpa using hne2, + by simpa [pzB6a_evalPAM, evalPAZFTerm] using h⟩)))))) + · simp only [PAFormula.HoldsIn] at hb6b + rcases hb6b with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [pzB6b_evalPAM, evalPAZFTerm] using h⟩))))))) + · simp only [PAFormula.HoldsIn] at hb6c + rcases hb6c with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, n6, + by simpa [pzB6c_evalPAM, evalPAZFTerm] using h⟩)))))))) + · simp only [PAFormula.HoldsIn] at hb7 + rcases hb7 with ⟨n5, n6, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨n5, n6, by simpa [pzB7_evalPAM, evalPAZFTerm] using h⟩))))))))) + · simp only [PAFormula.HoldsIn] at hb8a + rcases hb8a with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨n5, n6, n7, by simpa [pzB8a_evalPAM, evalPAZFTerm] using h⟩)))))))))) + · simp only [PAFormula.HoldsIn] at hb8b + rcases hb8b with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [pzB8b_evalPAM, evalPAZFTerm] using h⟩))))))))))) + · simp only [PAFormula.HoldsIn] at hb8c + rcases hb8c with ⟨n5, n6, n7, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨n5, n6, n7, + by simpa [pzB8c_evalPAM, evalPAZFTerm] using h⟩)))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hext + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [pzExt_evalPAM] using hext)))))))))))))) + · simp only [PAFormula.HoldsIn] at hrep + rcases hrep with ⟨n5, h⟩ + rw [eq_iff _ _ _ (by decide) (by decide)] at h + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨n5, + by simpa [pzRep_evalPAM, evalPAZFTerm] using h⟩)))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hpow + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [pzPow_evalPAM] using hpow)))))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at huni + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + (by simpa [pzUni_evalPAM] using huni))))))))))))))))) + · rw [eq_iff _ _ _ (by decide) (by decide)] at hinf + exact Or.inl (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (by simpa [pzInf_evalPAM] using hinf))))))))))))))))) + · rintro (hax | ⟨φ, χ, j₁, j₂, hj₁, hj₂, hb₁, hb₂, hχ⟩ | ⟨x, φ, j, hj, hbj, hall⟩) + · rcases hax with h0 | ⟨a, b, c, h⟩ | ⟨a, h⟩ | ⟨a, b, h⟩ | ⟨a, b, c, h⟩ | + ⟨a, b, c, hac, hcb, h⟩ | ⟨a, b, c, h⟩ | ⟨a, b, h⟩ | ⟨a, b, h⟩ | + ⟨a, b, c, h⟩ | ⟨a, b, c, h⟩ | ⟨a, b, c, h⟩ | hext | ⟨a, h⟩ | hpow | huni | hinf + · refine Or.inl ?_ + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzEq_evalPAM, evalPAZFTerm] using h0 + · refine Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB1_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, ?_⟩)))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB2_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, ?_⟩))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB3_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩)))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB4_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl + ⟨a, b, c, ?_, ?_, ?_⟩))))))) + · simpa [PAFormula.HoldsIn] using hac + · simpa [PAFormula.HoldsIn] using hcb + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB6a_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨a, b, c, ?_⟩)))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB6b_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨a, b, ?_⟩))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB6c_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨a, b, ?_⟩)))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB7_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB8a_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩)))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB8b_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, b, c, ?_⟩))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzB8c_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ?_)))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzExt_evalPAM] using hext + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨a, ?_⟩))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzRep_evalPAM, evalPAZFTerm] using h + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ?_)))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzPow_evalPAM] using hpow + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ?_))))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzUni_evalPAM] using huni + · refine Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr ?_))))))))))))))))) + rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzInf_evalPAM] using hinf + · refine Or.inr (Or.inl ⟨φ, χ, j₁, j₂, ?_, ?_, ?_, ?_, ?_⟩) + · rw [paLt_holdsIn_iff]; simpa using hj₁ + · rw [paLt_holdsIn_iff]; simpa using hj₂ + · rw [paBetaEq_holdsIn_iff]; simpa using hb₁ + · rw [paBetaEq_holdsIn_iff]; simpa using hb₂ + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzImp_evalPAM, evalPAZFTerm] using hχ + · refine Or.inr (Or.inr (Or.inl ⟨x, φ, j, ?_, ?_, ?_⟩)) + · rw [paLt_holdsIn_iff]; simpa using hj + · rw [paBetaEq_holdsIn_iff]; simpa using hbj + · rw [eq_iff _ _ _ (by decide) (by decide)] + simpa [pzAll_evalPAM, evalPAZFTerm] using hall + +theorem paDef_mIsZFStep {k : ℕ} {fc fd fi fw : (Fin k → PAM M) → PAM M} + (hc : PAFunN k fc) (hd : PAFunN k fd) (hi : PAFunN k fi) (hw : PAFunN k fw) : + PADefN k (fun a ↦ MIsZFStep (fc a) (fd a) (fi a) (fw a)) := by + have hbase : PADefN (k + 4) (fun b : Fin (k + 4) → PAM M ↦ + MIsZFStep (b ⟨k, by omega⟩) (b ⟨k + 1, by omega⟩) + (b ⟨k + 2, by omega⟩) (b (Fin.last (k + 3)))) := by + let σ : ℕ → ℕ := fun z ↦ + if z = 1 then k + else if z = 2 then k + 1 + else if z = 3 then k + 2 + else if z = 4 then k + 3 + else z + k + 4 + have hσ_inj : Function.Injective σ := by + intro x y hxy + dsimp only [σ] at hxy + split_ifs at hxy <;> omega + refine ⟨renameAllFormula σ paIsZFStep, fun _ ↦ 0, fun b ↦ ?_⟩ + rw [holdsIn_renameAllFormula hσ_inj, paIsZFStep_holdsIn_iff] + have h1 : (paEnv (fun _ ↦ (0 : PAM M)) b ∘ σ) 1 = b ⟨k, by omega⟩ := + paEnv_lt _ _ (by omega : k < k + 4) + have h2 : (paEnv (fun _ ↦ (0 : PAM M)) b ∘ σ) 2 = b ⟨k + 1, by omega⟩ := + paEnv_lt _ _ (by omega : k + 1 < k + 4) + have h3 : (paEnv (fun _ ↦ (0 : PAM M)) b ∘ σ) 3 = b ⟨k + 2, by omega⟩ := + paEnv_lt _ _ (by omega : k + 2 < k + 4) + have h4 : (paEnv (fun _ ↦ (0 : PAM M)) b ∘ σ) 4 = b (Fin.last (k + 3)) := + paEnv_lt _ _ (Nat.lt_succ_self (k + 3)) + rw [h1, h2, h3, h4] + have s1 := paDef_subst_last (paFun_weaken (paFun_weaken (paFun_weaken hw))) hbase + have s2 := paDef_subst_last (paFun_weaken (paFun_weaken hi)) s1 + have s3 := paDef_subst_last (paFun_weaken hd) s2 + have s4 := paDef_subst_last hc s3 + refine paDefN_congr (fun a ↦ ?_) s4 + simp only [Fin.snoc_last, Fin.init_snoc] + rw [fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_eq, + fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_eq, + fin_snoc_lt _ _ (by omega) (by omega), + fin_snoc_eq] + +theorem paZFInconsistent_holdsIn_iff (v : ℕ → PAM M) : + PAFormula.HoldsIn v paZFInconsistent ↔ MZFInconsistent M := by + unfold paZFInconsistent MZFInconsistent + simp only [PAFormula.HoldsIn] + constructor + · rintro ⟨n, c, d, hsteps, hfinal⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + rcases hfinal with ⟨w, hbw, hmem⟩ + set v4 := Function.update v2 4 w + have hw_eq : mBeta c d n = w := by + have := (paBetaEq_holdsIn_iff v4 (.var 1) (.var 2) (.var 0) (.var 4)).mp hbw + simpa [v4, v2] using this + have hw_mem : w = mZfMem 0 0 := by + have := (eqFormula_holdsIn_iff (pzMem (.const 0) (.const 0)) (.var 4) 10 v4 + (by decide) (by decide)).mp hmem + simpa [v4, pzMem_evalPAM, evalPAZFTerm] using this + refine ⟨n, c, d, ?_, hw_eq.trans hw_mem⟩ + intro i hle + have hle' : PAFormula.HoldsIn (Function.update v2 3 i) (paLe (.var 3) (.var 0)) := by + rw [paLe_holdsIn_iff] + simpa [v2] using hle + obtain ⟨wi, hbwi, hst⟩ := hsteps i hle' + set u4 := Function.update (Function.update v2 3 i) 4 wi + have hwi_eq : mBeta c d i = wi := by + have := (paBetaEq_holdsIn_iff u4 (.var 1) (.var 2) (.var 3) (.var 4)).mp hbwi + simpa [u4, v2] using this + have hst' := (paIsZFStep_holdsIn_iff u4).mp hst + simp only [u4, v2, Function.update_self, + Function.update_of_ne (by decide : (3 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 3), + Function.update_of_ne (by decide : (1 : ℕ) ≠ 2), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 4), + Function.update_of_ne (by decide : (2 : ℕ) ≠ 3)] at hst' + rwa [hwi_eq] + · rintro ⟨n, c, d, hsteps, hfinal⟩ + refine ⟨n, c, d, ?_⟩ + set v2 := Function.update (Function.update (Function.update v 0 n) 1 c) 2 d + refine ⟨?_, ?_⟩ + · intro i hle + rw [paLe_holdsIn_iff] at hle + have hi_le : i ≤ n := by simpa [v2] using hle + refine ⟨mBeta c d i, ?_⟩ + set u4 := Function.update (Function.update v2 3 i) 4 (mBeta c d i) + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holdsIn_iff] + simp [u4, v2] + · rw [paIsZFStep_holdsIn_iff] + simpa [u4, v2] using hsteps i hi_le + · refine ⟨mZfMem 0 0, ?_⟩ + set v4 := Function.update v2 4 (mZfMem 0 0) + refine ⟨?_, ?_⟩ + · rw [paBetaEq_holdsIn_iff] + simpa [v4, v2] using hfinal + · rw [eqFormula_holdsIn_iff _ (.var 4) 10 v4 (by decide) (by decide)] + simp [v4, pzMem_evalPAM, evalPAZFTerm] + +end ZFInternal + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/PA/Zf380Internal.lean b/Cryptids/Semantics/PA/Zf380Internal.lean new file mode 100644 index 00000000..f3f14ce2 --- /dev/null +++ b/Cryptids/Semantics/PA/Zf380Internal.lean @@ -0,0 +1,632 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Arithmetic +public import Cryptids.Zf380 + +/-! +# Internal `PA` Equivalence Between `zf_380` and `zf_393` + +This module internalizes the macro-step state-renumbering bisimulation between `Machines.zf380` and +`Machines.zf393` from `Cryptids.Zf380` inside an arbitrary first-order `PAModel M` via `PAM M`, +yielding: + +- `mHalts_zf380_iff_zf393`: in every `PAModel M`, + `mHalts M Machines.zf380 ↔ mHalts M Machines.zf393`. +- `paProvable_halts_zf380_iff_zf393`: + `PAProvable ((paHalts Machines.zf380).iff (paHalts Machines.zf393))`. +-/ + +@[expose] public section + +namespace ConjectureMachines.Semantics.PA + +open Turing (Dir) +open StateTransition +open ConjectureMachines.Zf380 + (candM refM zf380Trans candM_transition_eq_nat + renum mapState validState validState1 validState1_of_validState validState_next checkNext + expectedTransition isThreeStep isFiveStepLRLR isFiveStepLLRR isSevenStepLLLRRR + isNineStepLRLLLRRR isMultiStep + midP midS lrlrP1 lrlrS1 lrlrP2 lrlrS2 llrrP1 llrrP2 llrrS1 llrrS2 + lllrrrP1 lllrrrP2 lllrrrP3 lllrrrS1 lllrrrS2 lllrrrS3 + transition_oneStep + transition_threeStep_1 transition_threeStep_2 transition_threeStep_3 threeStep_not_none + transition_fiveStepLRLR_1 transition_fiveStepLRLR_2 transition_fiveStepLRLR_3 + transition_fiveStepLRLR_4 transition_fiveStepLRLR_5 fiveStepLRLR_not_none + transition_fiveStepLLRR_1 transition_fiveStepLLRR_2 transition_fiveStepLLRR_3 + transition_fiveStepLLRR_4 transition_fiveStepLLRR_5 fiveStepLLRR_not_none + transition_sevenStepLLLRRR_1 transition_sevenStepLLLRRR_2 transition_sevenStepLLLRRR_3 + transition_sevenStepLLLRRR_4 transition_sevenStepLLLRRR_5 transition_sevenStepLLLRRR_6 + transition_sevenStepLLLRRR_7 sevenStepLLLRRR_not_none + transition_nineStep_0a transition_nineStep_0b transition_nineStep_1 transition_nineStep_2 + transition_nineStep_3 transition_nineStep_4 transition_nineStep_5 transition_nineStep_6 + transition_nineStep_7 nineStepLRLLLRRR_not_none + cfgOfFast bootR_39753 boot_cand boot_ref rel_boot) + +section Model +variable {M : Type*} [PAStructure M] [PAModel M] +open PAM + +/-! ## Section 1: Standard `nSteps` Equivalence and Boot Lifting -/ + +private theorem zf380_nSteps_eq_layer1_nSteps {N : ℕ} [NeZero N] (tm : Machine N 2) : + ∀ (k : ℕ) (c : Cfg N 2), + ConjectureMachines.Zf380.nSteps tm k c = + ConjectureMachines.Semantics.Riemann.Layer1.nSteps tm k c + | 0, _ => rfl + | k + 1, c => by + simp only [ConjectureMachines.Zf380.nSteps_succ, + ConjectureMachines.Semantics.Riemann.Layer1.nSteps_succ] + cases step tm c with + | none => rfl + | some c' => exact zf380_nSteps_eq_layer1_nSteps tm k c' + +/-- Standard `k : ℕ` step counts in `mTracesTo` coincide with `mNSteps`. -/ +theorem mTracesTo_natCast_iff_mNSteps {states : ℕ} {tm : Machine states 2} + (k : ℕ) (a b : MCfg states M) : + mTracesTo tm (k : PAM M) a b ↔ mNSteps tm k a = some b := by + refine ⟨fun htr ↦ ?_, mTracesTo_of_mNSteps⟩ + rcases htr with ⟨c, d, h0, hsteps, hlast⟩ + have hwalk : ∀ j : ℕ, j ≤ k → + ∃ bj : MCfg states M, mNSteps tm j a = some bj ∧ mBeta c d (j : PAM M) = mEncodeCfg bj := by + intro j hj + induction j with + | zero => exact ⟨a, rfl, by simpa using h0⟩ + | succ j ih => + obtain ⟨bj, hns, hbj⟩ := ih (Nat.le_of_succ_le hj) + have hjlt : (j : PAM M) < (k : PAM M) := (natCast_lt_iff (M := M)).mpr hj + obtain ⟨x, y, hx, hy, hst⟩ := hsteps (j : PAM M) hjlt + have hxb : x = bj := mEncodeCfg_injective (hx.symm.trans hbj) + subst hxb + refine ⟨y, ?_, by simpa [Nat.cast_succ] using hy⟩ + rw [mNSteps_add tm j 1 a, hns] + simpa [mNSteps] using hst + obtain ⟨bk, hnsk, hbk⟩ := hwalk k le_rfl + have hbkeq : bk = b := mEncodeCfg_injective (hbk.symm.trans hlast) + subst hbkeq + exact hnsk + +private theorem mBoot_cand : + mTracesTo Machines.zf380 ((39753 : ℕ) : PAM M) mInit + (embedCfg (M := M) (cfgOfFast 64 [] 0 bootR_39753)) := by + have hb := boot_cand + rw [zf380_nSteps_eq_layer1_nSteps] at hb + have htr := mTracesTo_of_nSteps (M := M) hb + simpa only [embedCfg_init] using htr + +private theorem mBoot_ref : + mTracesTo Machines.zf393 ((39753 : ℕ) : PAM M) mInit + (embedCfg (M := M) (cfgOfFast 64 [] 0 bootR_39753)) := by + have hb := boot_ref + rw [zf380_nSteps_eq_layer1_nSteps] at hb + have htr := mTracesTo_of_nSteps (M := M) hb + simpa only [embedCfg_init] using htr + +/-! ## Section 2: `MCfg` Macro-Steps and Simulation Relation `MRel` -/ + +/-- Simulation relation between `Machines.zf393` and `Machines.zf380` on `MCfg` over `PAM M`. -/ +def MRel (c₁ : MCfg 393 M) (c₂ : MCfg 380 M) : Prop := + validState c₁.state.val + (mBit (mHalf (mHalf c₁.left))) (mBit (mHalf c₁.left)) (mBit c₁.left) + c₁.head (mBit c₁.right) = true ∧ + c₂ = ⟨mapState c₁.state.val (mBit c₁.left) c₁.head, c₁.head, c₁.left, c₁.right⟩ + +private theorem mBit_eq_iff_mod_eq (x : PAM M) (b : Fin 2) : + mBit x = b ↔ x % 2 = (b.val : PAM M) := by + rw [← mBit_val_eq_mod] + exact ⟨fun h ↦ congrArg (fun u : Fin 2 ↦ (u.val : PAM M)) h, + fun h ↦ Fin.ext (natCast_inj_pam.mp h)⟩ + +/-- First-order definability of `MRel` on configuration codes in `PAM M`. -/ +theorem paDef_mRelCode {k : ℕ} {fx₁ fx₂ : (Fin k → PAM M) → PAM M} + (hx₁ : PAFunN k fx₁) (hx₂ : PAFunN k fx₂) : + PADefN k (fun a ↦ ∃ (c₁ : MCfg 393 M) (c₂ : MCfg 380 M), + fx₁ a = mEncodeCfg c₁ ∧ fx₂ a = mEncodeCfg c₂ ∧ MRel c₁ c₂) := by + have htuple : ∀ (q : Fin 393) (h l0 l1 l2 r0 : Fin 2), + PADefN k (fun a ↦ + validState q.val l2 l1 l0 h r0 = true ∧ + ∃ L R : PAM M, + L % 2 = (l0.val : PAM M) ∧ + (L / 2) % 2 = (l1.val : PAM M) ∧ + ((L / 2) / 2) % 2 = (l2.val : PAM M) ∧ + R % 2 = (r0.val : PAM M) ∧ + fx₁ a = mPair (q.val : PAM M) (mPair (h.val : PAM M) (mPair L R)) ∧ + fx₂ a = mPair ((mapState q.val l0 h).val : PAM M) + (mPair (h.val : PAM M) (mPair L R))) := by + intro q h l0 l1 l2 r0 + let fL : (Fin (k + 2) → PAM M) → PAM M := fun w ↦ w ⟨k, by omega⟩ + let fR : (Fin (k + 2) → PAM M) → PAM M := fun w ↦ w (Fin.last (k + 1)) + have hL : PAFunN (k + 2) fL := paFun_proj ⟨k, by omega⟩ + have hR : PAFunN (k + 2) fR := paFun_proj (Fin.last (k + 1)) + have hx₁' : PAFunN (k + 2) (fun w ↦ fx₁ (Fin.init (Fin.init w))) := + paFun_weaken (paFun_weaken hx₁) + have hx₂' : PAFunN (k + 2) (fun w ↦ fx₂ (Fin.init (Fin.init w))) := + paFun_weaken (paFun_weaken hx₂) + have hLdiv1 := paFun_div hL (paFun_const 2) + have hLdiv2 := paFun_div hLdiv1 (paFun_const 2) + have hbody : PADefN (k + 2) (fun w : Fin (k + 2) → PAM M ↦ + fL w % 2 = (l0.val : PAM M) ∧ + (fL w / 2) % 2 = (l1.val : PAM M) ∧ + ((fL w / 2) / 2) % 2 = (l2.val : PAM M) ∧ + fR w % 2 = (r0.val : PAM M) ∧ + fx₁ (Fin.init (Fin.init w)) = + mPair (q.val : PAM M) (mPair (h.val : PAM M) (mPair (fL w) (fR w))) ∧ + fx₂ (Fin.init (Fin.init w)) = + mPair ((mapState q.val l0 h).val : PAM M) + (mPair (h.val : PAM M) (mPair (fL w) (fR w)))) := + paDef_and (paDef_eq (paFun_mod hL (paFun_const 2)) (paFun_const _)) + (paDef_and (paDef_eq (paFun_mod hLdiv1 (paFun_const 2)) (paFun_const _)) + (paDef_and (paDef_eq (paFun_mod hLdiv2 (paFun_const 2)) (paFun_const _)) + (paDef_and (paDef_eq (paFun_mod hR (paFun_const 2)) (paFun_const _)) + (paDef_and + (paDef_eq hx₁' + (paFun_mPair (paFun_const _) (paFun_mPair (paFun_const _) (paFun_mPair hL hR)))) + (paDef_eq hx₂' + (paFun_mPair (paFun_const _) + (paFun_mPair (paFun_const _) (paFun_mPair hL hR)))))))) + have hp : PADefN k (fun _ : Fin k → PAM M ↦ validState q.val l2 l1 l0 h r0 = true) := by + cases validState q.val l2 l1 l0 h r0 + · exact paDefN_congr (fun _ ↦ by simp) (paDef_false k) + · exact paDefN_congr (fun _ ↦ by simp) (paDef_true k) + refine paDef_and hp (paDefN_congr (fun a ↦ ?_) (paDef_ex (paDef_ex hbody))) + refine exists_congr fun L ↦ exists_congr fun R ↦ ?_ + dsimp only [fL, fR] + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] + refine paDefN_congr (fun a ↦ ?_) + (paDef_fin_exists fun q ↦ paDef_fin_exists fun h ↦ paDef_fin_exists fun l0 ↦ + paDef_fin_exists fun l1 ↦ paDef_fin_exists fun l2 ↦ paDef_fin_exists fun r0 ↦ + htuple q h l0 l1 l2 r0) + constructor + · rintro ⟨q, h, l0, l1, l2, r0, hv, L, R, hl0, hl1, hl2, hr0, hx1, hx2⟩ + have hb0 : mBit L = l0 := (mBit_eq_iff_mod_eq L l0).mpr hl0 + have hb1 : mBit (mHalf L) = l1 := (mBit_eq_iff_mod_eq (L / 2) l1).mpr hl1 + have hb2 : mBit (mHalf (mHalf L)) = l2 := (mBit_eq_iff_mod_eq ((L / 2) / 2) l2).mpr hl2 + have hbr : mBit R = r0 := (mBit_eq_iff_mod_eq R r0).mpr hr0 + refine ⟨⟨q, h, L, R⟩, ⟨mapState q.val l0 h, h, L, R⟩, hx1, hx2, ?_⟩ + simp only [MRel, hb0, hb1, hb2, hbr, hv, true_and] + · rintro ⟨⟨q, h, L, R⟩, c₂, hx1, hx2, hv, rfl⟩ + refine ⟨q, h, mBit L, mBit (mHalf L), mBit (mHalf (mHalf L)), mBit R, hv, L, R, + (mBit_eq_iff_mod_eq L _).mp rfl, + (mBit_eq_iff_mod_eq (L / 2) _).mp rfl, + (mBit_eq_iff_mod_eq ((L / 2) / 2) _).mp rfl, + (mBit_eq_iff_mod_eq R _).mp rfl, hx1, hx2⟩ + +private theorem mRel_boot : + MRel (embedCfg (M := M) (cfgOfFast 64 [] 0 bootR_39753)) + (embedCfg (M := M) (cfgOfFast 64 [] 0 bootR_39753)) := by + obtain ⟨hv, hmap⟩ := rel_boot + have hst := congrArg Cfg.state hmap + dsimp only [cfgOfFast] at hv hst ⊢ + simp only [MRel, embedCfg, mHalf_embedHalf, mBit_embedHalf] + exact ⟨hv, by rw [← hst]⟩ + +private theorem mStep_of_transition_eq {q : Fin 393} {S : Fin 380} (h : Fin 2) (L R : PAM M) + (htr : zf380Trans S.val h = + expectedTransition q.val (mBit (mHalf L)) (mBit L) h (mBit R)) : + mStep candM ⟨S, h, L, R⟩ = + (mStep refM ⟨q, h, L, R⟩).map fun c ↦ + ⟨mapState c.state.val (mBit c.left) c.head, c.head, c.left, c.right⟩ := by + dsimp only [mStep] + rw [candM_transition_eq_nat S h, htr, ConjectureMachines.Zf393.zf393Trans_eq q h] + rcases e : ConjectureMachines.Zf393.zf393Trans q h with _ | ⟨w, d, q'⟩ + · simp [expectedTransition, Nat.mod_eq_of_lt q.isLt, e] + · cases d <;> simp [expectedTransition, Nat.mod_eq_of_lt q.isLt, e] + +private theorem mStep_lr_pair {q₁ P S : Fin 380} (h : Fin 2) (L R : PAM M) + (h1 : zf380Trans q₁.val h = some (h, Dir.left, P)) + (h2 : zf380Trans P.val (mBit L) = some (mBit L, Dir.right, S)) : + mNSteps candM 2 ⟨q₁, h, L, R⟩ = some ⟨S, h, L, R⟩ := by + have hs1 : mStep candM ⟨q₁, h, L, R⟩ = some ⟨P, mBit L, mHalf L, mCons h R⟩ := by + simp [mStep, candM_transition_eq_nat, h1] + have hs2 : mStep candM ⟨P, mBit L, mHalf L, mCons h R⟩ = some ⟨S, h, L, R⟩ := by + simp [mStep, candM_transition_eq_nat, h2] + simp [mNSteps, hs1, hs2] + +private theorem mStep_three_left_right {q₁ P S : Fin 380} {h : Fin 2} {L R : PAM M} + (h1 : zf380Trans q₁.val h = some (h, Dir.left, P)) + (h2 : zf380Trans P.val (mBit L) = some (mBit L, Dir.right, S)) + {c' : MCfg 380 M} (h3 : mStep candM ⟨S, h, L, R⟩ = some c') : + mNSteps candM 3 ⟨q₁, h, L, R⟩ = some c' := by + rw [show (3 : ℕ) = 2 + 1 from rfl, mNSteps_add, mStep_lr_pair h L R h1 h2] + simpa [mNSteps] using h3 + +private theorem mStep_five_left_right {q₁ P₁ S₁ P₂ S₂ : Fin 380} {h : Fin 2} {L R : PAM M} + (h1 : zf380Trans q₁.val h = some (h, Dir.left, P₁)) + (h2 : zf380Trans P₁.val (mBit L) = some (mBit L, Dir.right, S₁)) + (h3 : zf380Trans S₁.val h = some (h, Dir.left, P₂)) + (h4 : zf380Trans P₂.val (mBit L) = some (mBit L, Dir.right, S₂)) + {c' : MCfg 380 M} (h5 : mStep candM ⟨S₂, h, L, R⟩ = some c') : + mNSteps candM 5 ⟨q₁, h, L, R⟩ = some c' := by + rw [show (5 : ℕ) = 2 + 3 from rfl, mNSteps_add, mStep_lr_pair h L R h1 h2] + exact mStep_three_left_right h3 h4 h5 + +private theorem mStep_five_left_left_right_right {q₁ P₁ P₂ S₁ S₂ : Fin 380} + {h : Fin 2} {L R : PAM M} + (h1 : zf380Trans q₁.val h = some (h, Dir.left, P₁)) + (h2 : zf380Trans P₁.val (mBit L) = some (mBit L, Dir.left, P₂)) + (h3 : zf380Trans P₂.val (mBit (mHalf L)) = some (mBit (mHalf L), Dir.right, S₁)) + (h4 : zf380Trans S₁.val (mBit L) = some (mBit L, Dir.right, S₂)) + {c' : MCfg 380 M} (h5 : mStep candM ⟨S₂, h, L, R⟩ = some c') : + mNSteps candM 5 ⟨q₁, h, L, R⟩ = some c' := by + have hs1 : mStep candM ⟨q₁, h, L, R⟩ = some ⟨P₁, mBit L, mHalf L, mCons h R⟩ := by + simp [mStep, candM_transition_eq_nat, h1] + have hs23 := mStep_lr_pair (mBit L) (mHalf L) (mCons h R) h2 h3 + have hs4 : mStep candM ⟨S₁, mBit L, mHalf L, mCons h R⟩ = some ⟨S₂, h, L, R⟩ := by + simp [mStep, candM_transition_eq_nat, h4] + rw [show (5 : ℕ) = 1 + (2 + (1 + 1)) from rfl, mNSteps_add, + show mNSteps candM 1 ⟨q₁, h, L, R⟩ = some ⟨P₁, mBit L, mHalf L, mCons h R⟩ by + simpa [mNSteps] using hs1] + dsimp only [Option.bind] + rw [mNSteps_add, hs23] + dsimp only [Option.bind] + simp [mNSteps, hs4, h5] + +private theorem mStep_seven_left_left_left_right_right_right + {q₁ P₁ P₂ P₃ S₁ S₂ S₃ : Fin 380} {h : Fin 2} {L R : PAM M} + (h1 : zf380Trans q₁.val h = some (h, Dir.left, P₁)) + (h2 : zf380Trans P₁.val (mBit L) = some (mBit L, Dir.left, P₂)) + (h3 : zf380Trans P₂.val (mBit (mHalf L)) = some (mBit (mHalf L), Dir.left, P₃)) + (h4 : zf380Trans P₃.val (mBit (mHalf (mHalf L))) = + some (mBit (mHalf (mHalf L)), Dir.right, S₁)) + (h5 : zf380Trans S₁.val (mBit (mHalf L)) = some (mBit (mHalf L), Dir.right, S₂)) + (h6 : zf380Trans S₂.val (mBit L) = some (mBit L, Dir.right, S₃)) + {c' : MCfg 380 M} (h7 : mStep candM ⟨S₃, h, L, R⟩ = some c') : + mNSteps candM 7 ⟨q₁, h, L, R⟩ = some c' := by + have hs1 : mStep candM ⟨q₁, h, L, R⟩ = some ⟨P₁, mBit L, mHalf L, mCons h R⟩ := by + simp [mStep, candM_transition_eq_nat, h1] + have hs6 : mStep candM ⟨S₂, mBit L, mHalf L, mCons h R⟩ = some ⟨S₃, h, L, R⟩ := by + simp [mStep, candM_transition_eq_nat, h6] + have hmid := mStep_five_left_left_right_right + (L := mHalf L) (R := mCons h R) h2 h3 h4 h5 hs6 + rw [show (7 : ℕ) = 1 + (5 + 1) from rfl, mNSteps_add, + show mNSteps candM 1 ⟨q₁, h, L, R⟩ = some ⟨P₁, mBit L, mHalf L, mCons h R⟩ by + simpa [mNSteps] using hs1] + dsimp only [Option.bind] + rw [mNSteps_add, hmid] + simpa [mNSteps] using h7 + +private theorem mStep_nine_left_right_left_left_left_right_right_right + {q₁ P₀ q₂ P₁ P₂ P₃ S₁ S₂ S₃ : Fin 380} {h : Fin 2} {L R : PAM M} + (h0a : zf380Trans q₁.val h = some (h, Dir.left, P₀)) + (h0b : zf380Trans P₀.val (mBit L) = some (mBit L, Dir.right, q₂)) + (h1 : zf380Trans q₂.val h = some (h, Dir.left, P₁)) + (h2 : zf380Trans P₁.val (mBit L) = some (mBit L, Dir.left, P₂)) + (h3 : zf380Trans P₂.val (mBit (mHalf L)) = some (mBit (mHalf L), Dir.left, P₃)) + (h4 : zf380Trans P₃.val (mBit (mHalf (mHalf L))) = + some (mBit (mHalf (mHalf L)), Dir.right, S₁)) + (h5 : zf380Trans S₁.val (mBit (mHalf L)) = some (mBit (mHalf L), Dir.right, S₂)) + (h6 : zf380Trans S₂.val (mBit L) = some (mBit L, Dir.right, S₃)) + {c' : MCfg 380 M} (h7 : mStep candM ⟨S₃, h, L, R⟩ = some c') : + mNSteps candM 9 ⟨q₁, h, L, R⟩ = some c' := by + rw [show (9 : ℕ) = 2 + 7 from rfl, mNSteps_add, mStep_lr_pair h L R h0a h0b] + exact mStep_seven_left_left_left_right_right_right h1 h2 h3 h4 h5 h6 h7 + +private theorem mStep_preserves_valid (q : Fin 393) (h : Fin 2) (L R : PAM M) + (hv : validState q.val (mBit (mHalf (mHalf L))) (mBit (mHalf L)) (mBit L) h (mBit R) = true) : + match mStep refM ⟨q, h, L, R⟩ with + | none => True + | some c => + validState c.state.val (mBit (mHalf (mHalf c.left))) (mBit (mHalf c.left)) (mBit c.left) + c.head (mBit c.right) = true := by + have hnext := validState_next q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) (mBit L) h (mBit R) + dsimp only [mStep] + rw [ConjectureMachines.Zf393.zf393Trans_eq q h] + rcases e : ConjectureMachines.Zf393.zf393Trans q h with _ | ⟨w, d, q'⟩ + · trivial + · cases d + · simpa [checkNext, Nat.mod_eq_of_lt q.isLt, e] using + hnext (mBit (mHalf (mHalf (mHalf L)))) hv + · simpa [checkNext, Nat.mod_eq_of_lt q.isLt, e] using + hnext (mBit (mHalf R)) hv + +private theorem zf393Trans_eq_none_of_mStep_none {q : Fin 393} {hd : Fin 2} {L R : PAM M} + (e : mStep refM ⟨q, hd, L, R⟩ = none) : + ConjectureMachines.Zf393.zf393Trans q hd = none := by + dsimp only [mStep] at e + rw [ConjectureMachines.Zf393.zf393Trans_eq] at e + rcases htr : ConjectureMachines.Zf393.zf393Trans q hd with _ | ⟨w, d, q'⟩ + · rfl + · cases d <;> simp [htr] at e + +/-- Single-step lockstep/macro-step simulation of `refM` (`zf_393`) by `candM` (`zf_380`) in +`PAM M`. -/ +theorem mRespects {c₁ : MCfg 393 M} {c₂ : MCfg 380 M} (hrel : MRel c₁ c₂) : + match mStep refM c₁ with + | none => mStep candM c₂ = none + | some c₁' => + ∃ (k : Fin 9) (c₂' : MCfg 380 M), + MRel c₁' c₂' ∧ mNSteps candM (k.val + 1) c₂ = some c₂' := by + obtain ⟨hv, h⟩ := hrel + subst h + rcases c₁ with ⟨q, hd, L, R⟩ + have hpres := mStep_preserves_valid q hd L R hv + have hv1 := validState1_of_validState q.val + (mBit (mHalf (mHalf L))) (mBit (mHalf L)) (mBit L) hd (mBit R) hv + cases h3 : isThreeStep q.val (mBit L) hd + · cases h5a : isFiveStepLRLR q.val hd + · cases h5b : isFiveStepLLRR q.val (mBit L) hd + · cases h7 : isSevenStepLLLRRR q.val hd + · cases h9 : isNineStepLRLLLRRR q.val hd + · have hm : isMultiStep q.val (mBit L) hd = false := by + simp [isMultiStep, h3, h5a, h5b, h7, h9] + have hstep := mStep_of_transition_eq hd L R + (transition_oneStep q (mBit (mHalf L)) (mBit L) hd (mBit R) hm hv1) + rcases e : mStep refM ⟨q, hd, L, R⟩ with _ | c + · simpa [hstep] using e + · rw [e] at hpres + exact ⟨⟨0, by decide⟩, ⟨mapState c.state.val (mBit c.left) c.head, + c.head, c.left, c.right⟩, ⟨hpres, rfl⟩, + by simp [mNSteps, hstep, e]⟩ + · have h0a := transition_nineStep_0a q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have h0b := transition_nineStep_0b q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have h1 := transition_nineStep_1 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have h2 := transition_nineStep_2 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have h3' := transition_nineStep_3 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have h4 := transition_nineStep_4 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have h5 := transition_nineStep_5 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have h6 := transition_nineStep_6 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv + have hstep9 := mStep_of_transition_eq hd L R + (transition_nineStep_7 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h9 hv) + rcases e : mStep refM ⟨q, hd, L, R⟩ with _ | c + · exact absurd (zf393Trans_eq_none_of_mStep_none e) + (nineStepLRLLLRRR_not_none q hd h9) + · rw [e] at hpres hstep9 + exact ⟨⟨8, by decide⟩, ⟨mapState c.state.val (mBit c.left) c.head, + c.head, c.left, c.right⟩, ⟨hpres, rfl⟩, + mStep_nine_left_right_left_left_left_right_right_right + h0a h0b h1 h2 h3' h4 h5 h6 hstep9⟩ + · have h1 := transition_sevenStepLLLRRR_1 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h7 hv + have h2 := transition_sevenStepLLLRRR_2 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h7 hv + have h3' := transition_sevenStepLLLRRR_3 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h7 hv + have h4 := transition_sevenStepLLLRRR_4 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h7 hv + have h5 := transition_sevenStepLLLRRR_5 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h7 hv + have h6 := transition_sevenStepLLLRRR_6 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h7 hv + have hstep7 := mStep_of_transition_eq hd L R + (transition_sevenStepLLLRRR_7 q (mBit (mHalf (mHalf L))) (mBit (mHalf L)) + (mBit L) hd (mBit R) h7 hv) + rcases e : mStep refM ⟨q, hd, L, R⟩ with _ | c + · exact absurd (zf393Trans_eq_none_of_mStep_none e) + (sevenStepLLLRRR_not_none q hd h7) + · rw [e] at hpres hstep7 + exact ⟨⟨6, by decide⟩, ⟨mapState c.state.val (mBit c.left) c.head, + c.head, c.left, c.right⟩, ⟨hpres, rfl⟩, + mStep_seven_left_left_left_right_right_right h1 h2 h3' h4 h5 h6 hstep7⟩ + · have h1 := transition_fiveStepLLRR_1 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5b hv1 + have h2 := transition_fiveStepLLRR_2 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5b hv1 + have h3' := transition_fiveStepLLRR_3 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5b hv1 + have h4 := transition_fiveStepLLRR_4 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5b hv1 + have hstep5 := mStep_of_transition_eq hd L R + (transition_fiveStepLLRR_5 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5b hv1) + rcases e : mStep refM ⟨q, hd, L, R⟩ with _ | c + · exact absurd (zf393Trans_eq_none_of_mStep_none e) + (fiveStepLLRR_not_none q (mBit L) hd h5b) + · rw [e] at hpres hstep5 + exact ⟨⟨4, by decide⟩, ⟨mapState c.state.val (mBit c.left) c.head, + c.head, c.left, c.right⟩, ⟨hpres, rfl⟩, + mStep_five_left_left_right_right h1 h2 h3' h4 hstep5⟩ + · have h1 := transition_fiveStepLRLR_1 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5a hv1 + have h2 := transition_fiveStepLRLR_2 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5a hv1 + have h3' := transition_fiveStepLRLR_3 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5a hv1 + have h4 := transition_fiveStepLRLR_4 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5a hv1 + have hstep5 := mStep_of_transition_eq hd L R + (transition_fiveStepLRLR_5 q (mBit (mHalf L)) (mBit L) hd (mBit R) h5a hv1) + rcases e : mStep refM ⟨q, hd, L, R⟩ with _ | c + · exact absurd (zf393Trans_eq_none_of_mStep_none e) + (fiveStepLRLR_not_none q hd h5a) + · rw [e] at hpres hstep5 + exact ⟨⟨4, by decide⟩, ⟨mapState c.state.val (mBit c.left) c.head, + c.head, c.left, c.right⟩, ⟨hpres, rfl⟩, + mStep_five_left_right h1 h2 h3' h4 hstep5⟩ + · have h1 := transition_threeStep_1 q (mBit (mHalf L)) (mBit L) hd (mBit R) h3 hv1 + have h2 := transition_threeStep_2 q (mBit (mHalf L)) (mBit L) hd (mBit R) h3 hv1 + have hstep3 := mStep_of_transition_eq hd L R + (transition_threeStep_3 q (mBit (mHalf L)) (mBit L) hd (mBit R) h3 hv1) + rcases e : mStep refM ⟨q, hd, L, R⟩ with _ | c + · exact absurd (zf393Trans_eq_none_of_mStep_none e) + (threeStep_not_none q (mBit L) hd h3) + · rw [e] at hpres hstep3 + exact ⟨⟨2, by decide⟩, ⟨mapState c.state.val (mBit c.left) c.head, + c.head, c.left, c.right⟩, ⟨hpres, rfl⟩, + mStep_three_left_right h1 h2 hstep3⟩ + +/-! ## Section 3: Bidirectional Trace Simulation in `PAM M` -/ + +/-- Forward trace simulation: if `MRel a₁ a₂` and `refM` (`zf_393`) halts from `a₁`, then `candM` +(`zf_380`) halts from `a₂`. -/ +theorem mHaltsFrom_cand_of_ref {a₁ : MCfg 393 M} {a₂ : MCfg 380 M} + (hrel₀ : MRel a₁ a₂) (hhalts : mHaltsFrom refM a₁) : + mHaltsFrom candM a₂ := by + rcases hhalts with ⟨N, f₁, ⟨c₀, d₀, h0, hsteps, hN⟩, hnone⟩ + have hdef : PADef1 (fun i : PAM M ↦ i ≤ N → + ∃ n₂ x₂ : PAM M, + (∃ (b₁ : MCfg 393 M) (b₂ : MCfg 380 M), + mBeta c₀ d₀ i = mEncodeCfg b₁ ∧ x₂ = mEncodeCfg b₂ ∧ MRel b₁ b₂) ∧ + (∃ (u₂ b₂ : MCfg 380 M), + mEncodeCfg a₂ = mEncodeCfg u₂ ∧ x₂ = mEncodeCfg b₂ ∧ mTracesTo candM n₂ u₂ b₂)) := by + have hi_le : PADefN 1 (fun u ↦ u 0 ≤ N) := paDef_le (paFun_proj 0) (paFun_const N) + let fn₂ : (Fin 3 → PAM M) → PAM M := fun w ↦ w 1 + let fx₂ : (Fin 3 → PAM M) → PAM M := fun w ↦ w 2 + let fbi : (Fin 3 → PAM M) → PAM M := fun w ↦ mBeta c₀ d₀ (w 0) + have hn₂ : PAFunN 3 fn₂ := paFun_proj 1 + have hx₂ : PAFunN 3 fx₂ := paFun_proj 2 + have hbi : PAFunN 3 fbi := paFun_mBeta (paFun_const c₀) (paFun_const d₀) (paFun_proj 0) + have hbody := paDef_and (paDef_mRelCode hbi hx₂) + (paDef_mTracesToCode candM hn₂ (paFun_const (mEncodeCfg a₂)) hx₂) + refine paDefN_congr (fun u ↦ ?_) (paDef_imp hi_le (paDef_ex (paDef_ex hbody))) + refine imp_congr Iff.rfl (exists_congr fun n₂ ↦ exists_congr fun x₂ ↦ ?_) + dsimp only [fn₂, fx₂, fbi] + simp [Fin.snoc] + have hsim := ind1 hdef ?_ ?_ N le_rfl + · rcases hsim with ⟨n₂, x₂, ⟨b₁, b₂, hb₁, hx₂, hrel⟩, ⟨u₂, b₂', hu₂, hx₂', htr₂⟩⟩ + have hb₁f : b₁ = f₁ := mEncodeCfg_injective (hb₁.symm.trans hN) + have hu₂a : u₂ = a₂ := mEncodeCfg_injective hu₂.symm + have hb₂eq : b₂' = b₂ := mEncodeCfg_injective (hx₂'.symm.trans hx₂) + subst b₁ u₂ b₂' + have hres := mRespects hrel + rw [hnone] at hres + exact ⟨n₂, b₂, htr₂, hres⟩ + · intro _ + exact ⟨0, mEncodeCfg a₂, ⟨a₁, a₂, h0, rfl, hrel₀⟩, + ⟨a₂, a₂, rfl, rfl, mTracesTo_zero candM a₂⟩⟩ + · intro i ih hi1 + have hilt : i < N := hi1 + rcases ih (le_of_lt hilt) with ⟨n₂, x₂, ⟨b₁, b₂, hb₁, hx₂, hrel⟩, ⟨u₂, b₂', hu₂, hx₂', htr₂⟩⟩ + have hu₂a : u₂ = a₂ := mEncodeCfg_injective hu₂.symm + have hb₂eq : b₂' = b₂ := mEncodeCfg_injective (hx₂'.symm.trans hx₂) + subst u₂ b₂' + obtain ⟨p₁, q₁, hp₁, hq₁, hst₁⟩ := hsteps i hilt + have hp₁b : p₁ = b₁ := mEncodeCfg_injective (hp₁.symm.trans hb₁) + subst p₁ + have hres := mRespects hrel + rw [hst₁] at hres + rcases hres with ⟨k, c₂', hrel', hns⟩ + have htr_step := mTracesTo_of_mNSteps (M := M) hns + exact ⟨n₂ + ((k.val + 1 : ℕ) : PAM M), mEncodeCfg c₂', + ⟨q₁, c₂', hq₁, rfl, hrel'⟩, + ⟨a₂, c₂', rfl, rfl, mTracesTo_trans htr₂ htr_step⟩⟩ + +/-- Backward trace simulation: if `MRel a₁ a₂` and `candM` (`zf_380`) halts from `a₂`, then `refM` +(`zf_393`) halts from `a₁`. -/ +theorem mHaltsFrom_ref_of_cand {a₁ : MCfg 393 M} {a₂ : MCfg 380 M} + (hrel₀ : MRel a₁ a₂) (hhalts : mHaltsFrom candM a₂) : + mHaltsFrom refM a₁ := by + rcases hhalts with ⟨N, f₂, ⟨c₀, d₀, h0, hsteps, hN⟩, hnone⟩ + have hdef : PADef1 (fun i : PAM M ↦ i ≤ N → + ∃ (r : Fin 9) (n₁ x₁ x₂ : PAM M), + (∃ (c₁ : MCfg 393 M) (c₂ : MCfg 380 M), + x₁ = mEncodeCfg c₁ ∧ x₂ = mEncodeCfg c₂ ∧ MRel c₁ c₂) ∧ + (∃ (u₁ c₁ : MCfg 393 M), + mEncodeCfg a₁ = mEncodeCfg u₁ ∧ x₁ = mEncodeCfg c₁ ∧ mTracesTo refM n₁ u₁ c₁) ∧ + (∃ (b₂ c₂ : MCfg 380 M), + mBeta c₀ d₀ i = mEncodeCfg b₂ ∧ x₂ = mEncodeCfg c₂ ∧ + mTracesTo candM (r.val : PAM M) b₂ c₂)) := by + have hi_le : PADefN 1 (fun u ↦ u 0 ≤ N) := paDef_le (paFun_proj 0) (paFun_const N) + have hr_case : ∀ r : Fin 9, PADefN 1 (fun u ↦ + ∃ n₁ x₁ x₂ : PAM M, + (∃ (c₁ : MCfg 393 M) (c₂ : MCfg 380 M), + x₁ = mEncodeCfg c₁ ∧ x₂ = mEncodeCfg c₂ ∧ MRel c₁ c₂) ∧ + (∃ (u₁ c₁ : MCfg 393 M), + mEncodeCfg a₁ = mEncodeCfg u₁ ∧ x₁ = mEncodeCfg c₁ ∧ mTracesTo refM n₁ u₁ c₁) ∧ + (∃ (b₂ c₂ : MCfg 380 M), + mBeta c₀ d₀ (u 0) = mEncodeCfg b₂ ∧ x₂ = mEncodeCfg c₂ ∧ + mTracesTo candM (r.val : PAM M) b₂ c₂)) := by + intro r + let fn₁ : (Fin 4 → PAM M) → PAM M := fun w ↦ w 1 + let fx₁ : (Fin 4 → PAM M) → PAM M := fun w ↦ w 2 + let fx₂ : (Fin 4 → PAM M) → PAM M := fun w ↦ w 3 + let fbi : (Fin 4 → PAM M) → PAM M := fun w ↦ mBeta c₀ d₀ (w 0) + have hn₁ : PAFunN 4 fn₁ := paFun_proj 1 + have hx₁ : PAFunN 4 fx₁ := paFun_proj 2 + have hx₂ : PAFunN 4 fx₂ := paFun_proj 3 + have hbi : PAFunN 4 fbi := paFun_mBeta (paFun_const c₀) (paFun_const d₀) (paFun_proj 0) + have hbody := paDef_and (paDef_mRelCode hx₁ hx₂) + (paDef_and + (paDef_mTracesToCode refM hn₁ (paFun_const (mEncodeCfg a₁)) hx₁) + (paDef_mTracesToCode candM (paFun_const (r.val : PAM M)) hbi hx₂)) + refine paDefN_congr (fun u ↦ ?_) (paDef_ex (paDef_ex (paDef_ex hbody))) + refine exists_congr fun n₁ ↦ exists_congr fun x₁ ↦ exists_congr fun x₂ ↦ ?_ + dsimp only [fn₁, fx₁, fx₂, fbi] + simp [Fin.snoc] + exact paDef_imp hi_le (paDef_fin_exists hr_case) + have hsim := ind1 hdef ?_ ?_ N le_rfl + · rcases hsim with ⟨r, n₁, x₁, x₂, ⟨c₁, c₂, hx₁, hx₂, hrel⟩, + ⟨u₁, c₁', hu₁, hx₁', htr₁⟩, ⟨b₂, c₂', hb₂, hx₂', htr_r⟩⟩ + have hu₁a : u₁ = a₁ := mEncodeCfg_injective hu₁.symm + have hc₁eq : c₁' = c₁ := mEncodeCfg_injective (hx₁'.symm.trans hx₁) + have hc₂eq : c₂' = c₂ := mEncodeCfg_injective (hx₂'.symm.trans hx₂) + have hb₂f : b₂ = f₂ := mEncodeCfg_injective (hb₂.symm.trans hN) + subst u₁ c₁' c₂' b₂ + have hns_r := (mTracesTo_natCast_iff_mNSteps r.val f₂ c₂).mp htr_r + rcases hr : r.val with _ | r' + · rw [hr] at hns_r + simp only [mNSteps, Option.some.injEq] at hns_r + subst c₂ + have hres := mRespects hrel + rcases e : mStep refM c₁ with _ | d₁ + · exact ⟨n₁, c₁, htr₁, e⟩ + · rw [e] at hres + rcases hres with ⟨k, d₂, _, hnsk⟩ + simp [mNSteps, hnone] at hnsk + · rw [hr] at hns_r + simp [mNSteps, hnone] at hns_r + · intro _ + exact ⟨⟨0, by decide⟩, 0, mEncodeCfg a₁, mEncodeCfg a₂, + ⟨a₁, a₂, rfl, rfl, hrel₀⟩, + ⟨a₁, a₁, rfl, rfl, mTracesTo_zero refM a₁⟩, + ⟨a₂, a₂, h0, rfl, by simpa using mTracesTo_zero candM a₂⟩⟩ + · intro i ih hi1 + have hilt : i < N := hi1 + rcases ih (le_of_lt hilt) with ⟨r, n₁, x₁, x₂, ⟨c₁, c₂, hx₁, hx₂, hrel⟩, + ⟨u₁, c₁', hu₁, hx₁', htr₁⟩, ⟨b₂, c₂', hb₂, hx₂', htr_r⟩⟩ + have hu₁a : u₁ = a₁ := mEncodeCfg_injective hu₁.symm + have hc₁eq : c₁' = c₁ := mEncodeCfg_injective (hx₁'.symm.trans hx₁) + have hc₂eq : c₂' = c₂ := mEncodeCfg_injective (hx₂'.symm.trans hx₂) + subst u₁ c₁' c₂' + obtain ⟨p₂, q₂, hp₂, hq₂, hst₂⟩ := hsteps i hilt + have hp₂b : p₂ = b₂ := mEncodeCfg_injective (hp₂.symm.trans hb₂) + subst b₂ + have hns_r := (mTracesTo_natCast_iff_mNSteps r.val p₂ c₂).mp htr_r + rcases hr : r.val with _ | r' + · rw [hr] at hns_r + simp only [mNSteps, Option.some.injEq] at hns_r + subst c₂ + have hres := mRespects hrel + rcases e : mStep refM c₁ with _ | d₁ + · rw [e] at hres + rw [hres] at hst₂ + cases hst₂ + · rw [e] at hres + rcases hres with ⟨k, d₂, hrel', hnsk⟩ + simp only [mNSteps, hst₂, Option.bind_some] at hnsk + exact ⟨k, n₁ + 1, mEncodeCfg d₁, mEncodeCfg d₂, + ⟨d₁, d₂, rfl, rfl, hrel'⟩, + ⟨a₁, d₁, rfl, rfl, mTracesTo_snoc htr₁ e⟩, + ⟨q₂, d₂, hq₂, rfl, mTracesTo_of_mNSteps hnsk⟩⟩ + · rw [hr] at hns_r + simp only [mNSteps, hst₂, Option.bind_some] at hns_r + have hr'_lt : r' < 9 := by have := r.isLt; omega + exact ⟨⟨r', hr'_lt⟩, n₁, mEncodeCfg c₁, mEncodeCfg c₂, + ⟨c₁, c₂, rfl, rfl, hrel⟩, + ⟨a₁, c₁, rfl, rfl, htr₁⟩, + ⟨q₂, c₂, hq₂, rfl, mTracesTo_of_mNSteps hns_r⟩⟩ + +/-- In every first-order `PAModel M`, `Machines.zf380` halts iff `Machines.zf393` halts. -/ +theorem mHalts_zf380_iff_zf393 : + mHalts M Machines.zf380 ↔ mHalts M Machines.zf393 := by + unfold mHalts + rw [mHaltsFrom_iff_of_mTracesTo (mBoot_cand (M := M)), + mHaltsFrom_iff_of_mTracesTo (mBoot_ref (M := M))] + exact ⟨mHaltsFrom_ref_of_cand mRel_boot, mHaltsFrom_cand_of_ref mRel_boot⟩ + +end Model + +/-- Peano Arithmetic proves that `zf_380` halts if and only if `zf_393` halts. -/ +theorem paProvable_halts_zf380_iff_zf393 : + PAProvable ((paHalts Machines.zf380).iff (paHalts Machines.zf393)) := by + rw [paProvable_iff_holdsIn_all_models] + intro M _ _ v + rw [← PAM.holdsIn_iff_raw (fun x ↦ ⟨v x⟩)] + simp only [PAFormula.HoldsIn, paHalts_holdsIn_iff] + exact ⟨(mHalts_zf380_iff_zf393 (M := M)).mp, (mHalts_zf380_iff_zf393 (M := M)).mpr⟩ + +end ConjectureMachines.Semantics.PA diff --git a/Cryptids/Semantics/PA/Zf393BackendInternal.lean b/Cryptids/Semantics/PA/Zf393BackendInternal.lean new file mode 100644 index 00000000..07596350 --- /dev/null +++ b/Cryptids/Semantics/PA/Zf393BackendInternal.lean @@ -0,0 +1,2453 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Arithmetic +public import Cryptids.Semantics.Zf393.Backend +public import Cryptids.Semantics.Zf393.Program + +/-! +# Internal `PA` Layer 1 Backend Verification for `zf_393` + +This module internalizes the Layer 1 execution backend of Andrew Wade's 393-state `ZF` consistency +Turing machine `Machines.zf393` inside an arbitrary first-order `PAModel M` via `PAM M`: + +1. Binary half-tape and unary-register encodings (`mLB01`, `mAppend`, `mMk'`, `mMkL`, `mRepBit`, + `mEncodeReg`, `mAppendRegs`, `mRegsTape`, `mRootCfg`, `mZf393RootCfg`, `mZfLogCfg`) and their + first-order `PAFunN` / `PADefN` definability lemmas. +2. Exact bootstrap lifting (`mBoot_reaches_main0`, `39,773` steps) yielding + `mHalts M Machines.zf393 ↔ mHaltsFrom Machines.zf393 (mZfLogCfg 19 [] (List.replicate 11 0))`. +3. `PAM.ind1` unary scan lemmas (`mRightScan`, `mLeftScan`), return scans (`mZfScan_rev`, + `mZfScan_bounce_default`, `mScan_reaches_main0`, `mContinue_k_reaches_main0`, + `mBreak_k_reaches_main0`), moving `00` selector (`mSel_step_reaches_main0`), register increment + and decrement gadgets (`mInc_leaf_reaches_main0`, `mDecnz_leaf_reaches_main0`), and the + 1-step logical stack-instruction simulator `mTm_simulates_evalStack`. +-/ + +@[expose] public section + +namespace ConjectureMachines.Semantics.PA + +open Turing (Dir) +open StateTransition ConjectureMachines +open ConjectureMachines.Zf393 +open ConjectureMachines.Zf393.Layer1 + (prefix190 prefix190_ne_nil boot_reaches_main0 + zfScanState scanZerosOk scanZerosOk_tail + breakState continueState rawContinueRev + popBreakRev_length_le scanZerosOk_popBreakRev + popBreakRev_head_one popBreakRev_overflow + popBreakRev_replicate_one_append popBreakRev_dropLast_prefix + popContinueRev_length_le rawContinueRev_length_le + popContinueRev_eq_zero_rawContinueRev popContinueRev_zero_pad + continueState_step0 continueState_step1 scanZerosOk_rawContinueRev + popContinueRev_prefix + breakSlot breakSlot_ge + regIncStage3 regDecnzStage3 + regIncStage3_step1 regDecnzStage3_step1 regIncStage3_step0 regDecnzStage3_step0 + leafReg_inc_spec leafReg_decnz_spec + walkTape_dag_props staysInDag staysInDag_of_walkTape walkTape_extend_zeros + walkTape_self_on_regLeaf walkTape_slot_tail staysInDag_prefix + fastWalk_eq_walkTape lookupSmall minSlot zf393Inv_init + checkSmallStackEntry checkSmallStackEntry_of_lookup minSlot_le_150) +open ConjectureMachines.Zf393.Layer2 + (logLeafReg ten_sub_leafReg_eq_logLeafReg StackInstr evalStack) +open ConjectureMachines.Semantics.Riemann.Layer1 + (fin2_cases default_cons_zero encodeReg encodeRegs regsTape) + +section Model +variable {M : Type*} [PAStructure M] [PAModel M] +open PAM + +/-! ## Section 1: Arithmetic Helpers, Half-Tape Encodings, and `MCfg` Constructors -/ + +theorem sub_zero_pam (a : PAM M) : a - 0 = a := by + rw [sub_eq_iff_eq_add_pam (zero_le_pam a), zero_add] + +theorem add_le_add_right_pam {a b : PAM M} (h : a ≤ b) (c : PAM M) : a + c ≤ b + c := by + rcases h with ⟨d, rfl⟩ + exact ⟨d, by ring⟩ + +theorem sub_sub_pam (a b c : PAM M) : a - b - c = a - (b + c) := by + by_cases hbc : b + c ≤ a + · have hb : b ≤ a := le_trans (le_add_right_pam b c) hbc + have hab : a - b = c + (a - (b + c)) := by + rw [sub_eq_iff_eq_add_pam hb] + calc a + _ = (b + c) + (a - (b + c)) := (add_sub_of_le_pam hbc).symm + _ = b + (c + (a - (b + c))) := by ring + have hc : c ≤ a - b := ⟨a - (b + c), hab.symm⟩ + rw [sub_eq_iff_eq_add_pam hc] + exact hab + · have hlt : a < b + c := lt_of_not_ge hbc + rw [sub_eq_zero_of_le_pam (le_of_lt hlt)] + have hab_le : a - b ≤ c := by + by_cases hb : b ≤ a + · by_contra hgt + have hlt_ab : c < a - b := lt_of_not_ge hgt + have := add_lt_add_left_pam hlt_ab b + rw [add_sub_of_le_pam hb] at this + exact not_lt_of_ge (le_of_lt hlt) this + · rw [sub_eq_zero_of_le_pam (le_of_lt (lt_of_not_ge hb))] + exact zero_le_pam c + exact sub_eq_zero_of_le_pam hab_le + +theorem sub_split_add {s a b : PAM M} (ha : a ≤ b) (hb : b ≤ s) : + (b - a) + (s - b) = s - a := by + symm + rw [sub_eq_iff_eq_add_pam (le_trans ha hb)] + calc s + _ = b + (s - b) := (add_sub_of_le_pam hb).symm + _ = (a + (b - a)) + (s - b) := by rw [add_sub_of_le_pam ha] + _ = a + ((b - a) + (s - b)) := by ring + +theorem sub_add_one_of_lt_pam {a b : PAM M} (h : b < a) : + a - b = (a - (b + 1)) + 1 := by + have hb1 : b + 1 ≤ a := h + rw [sub_eq_iff_eq_add_pam (le_of_lt h)] + calc a + _ = (b + 1) + (a - (b + 1)) := (add_sub_of_le_pam hb1).symm + _ = b + ((a - (b + 1)) + 1) := by ring + +theorem add_one_sub_of_le_pam {a b : PAM M} (h : b ≤ a) : + (a + 1) - b = (a - b) + 1 := by + rw [sub_eq_iff_eq_add_pam (le_trans h (le_add_right_pam a 1))] + calc a + 1 + _ = (b + (a - b)) + 1 := by rw [add_sub_of_le_pam h] + _ = b + ((a - b) + 1) := by ring + +/-- Left sentinel half-tape `LB01 = 1 :: 0^ω` encoded in `PAM M`. -/ +def mLB01 : PAM M := + mCons 1 0 + +/-- Prepend a finite bit list `xs : List (Fin 2)` onto a half-tape code `R : PAM M`. -/ +def mAppend (xs : List (Fin 2)) (R : PAM M) : PAM M := + xs.foldr mCons R + +@[simp] +theorem mAppend_nil (R : PAM M) : mAppend [] R = R := rfl + +@[simp] +theorem mAppend_cons (b : Fin 2) (xs : List (Fin 2)) (R : PAM M) : + mAppend (b :: xs) R = mCons b (mAppend xs R) := rfl + +theorem mAppend_append (xs ys : List (Fin 2)) (R : PAM M) : + mAppend (xs ++ ys) R = mAppend xs (mAppend ys R) := by + induction xs with + | nil => rfl + | cons b xs ih => simp [ih] + +theorem mAppend_snoc (xs : List (Fin 2)) (b : Fin 2) (R : PAM M) : + mAppend (xs ++ [b]) R = mAppend xs (mCons b R) := by + rw [mAppend_append, mAppend_cons, mAppend_nil] + +theorem mAppend_reverse_cons (xs : List (Fin 2)) (b : Fin 2) (L : PAM M) : + mCons b (mAppend xs.reverse L) = mAppend (xs ++ [b]).reverse L := by + simp [List.reverse_append] + +theorem mCons_zero_zero : mCons 0 (0 : PAM M) = 0 := by + simp [mCons] + +theorem mAppend_replicate_zero (n : ℕ) (R : PAM M) : + mAppend (List.replicate n 0) R = mRep0 (n : PAM M) R := by + induction n with + | zero => simp + | succ n ih => + rw [List.replicate_succ, mAppend_cons, ih, Nat.cast_succ, mRep0_succ] + +theorem mAppend_replicate_one (n : ℕ) (R : PAM M) : + mAppend (List.replicate n 1) R = mRep1 (n : PAM M) R := by + induction n with + | zero => simp + | succ n ih => + rw [List.replicate_succ, mAppend_cons, ih, Nat.cast_succ, mRep1_succ] + +theorem mRep1_inner_cons (r L : PAM M) : + mRep1 r (mCons 1 L) = mCons 1 (mRep1 r L) := by + rw [mRep1_mCons_one, mRep1_succ] + +theorem mRep0_inner_cons (r L : PAM M) : + mRep0 r (mCons 0 L) = mCons 0 (mRep0 r L) := by + rw [mRep0_mCons_zero, mRep0_succ] + +/-- Unary `a`-block `a^r :: R` on binary half-tape codes in `PAM M`. -/ +noncomputable def mRepBit (a : Fin 2) (r R : PAM M) : PAM M := + if a = 0 then mRep0 r R else mRep1 r R + +@[simp] +theorem mRepBit_zero_bit (r R : PAM M) : mRepBit 0 r R = mRep0 r R := rfl + +@[simp] +theorem mRepBit_one_bit (r R : PAM M) : mRepBit 1 r R = mRep1 r R := rfl + +@[simp] +theorem mRepBit_zero_len (a : Fin 2) (R : PAM M) : mRepBit a 0 R = R := by + rcases fin2_cases a with rfl | rfl <;> simp [mRepBit] + +theorem mRepBit_succ (a : Fin 2) (r R : PAM M) : + mRepBit a (r + 1) R = mCons a (mRepBit a r R) := by + rcases fin2_cases a with rfl | rfl + · exact mRep0_succ r R + · exact mRep1_succ r R + +theorem mRepBit_mCons (a : Fin 2) (r R : PAM M) : + mRepBit a r (mCons a R) = mRepBit a (r + 1) R := by + rcases fin2_cases a with rfl | rfl + · exact mRep0_mCons_zero r R + · exact mRep1_mCons_one r R + +theorem mRepBit_add (a : Fin 2) (r₁ r₂ R : PAM M) : + mRepBit a (r₁ + r₂) R = mRepBit a r₁ (mRepBit a r₂ R) := by + rcases fin2_cases a with rfl | rfl + · exact mRep0_add r₁ r₂ R + · exact mRep1_add r₁ r₂ R + +/-- Right-facing `MCfg 393 M`: head stands on `mBit R`, with left `L` and right tail `mHalf R`. -/ +noncomputable def mMk' (q : Fin 393) (L R : PAM M) : MCfg 393 M := + ⟨q, mBit R, L, mHalf R⟩ + +/-- Left-facing `MCfg 393 M`: head stands on `mBit L`, with left tail `mHalf L` and right `R`. -/ +noncomputable def mMkL (q : Fin 393) (L R : PAM M) : MCfg 393 M := + ⟨q, mBit L, mHalf L, R⟩ + +theorem mMkL_mCons_eq_mMk'_mCons (q : Fin 393) (b : Fin 2) (L R : PAM M) : + mMkL q (mCons b L) R = mMk' q L (mCons b R) := by + simp [mMkL, mMk'] + +theorem mStep_mMk'_none {q : Fin 393} {a : Fin 2} (htr : zf393Trans q a = none) + (L R : PAM M) : + mStep zf393 (mMk' q L (mCons a R)) = none := by + simp [mMk', mStep, htr] + +theorem mStep_mMk'_right {q q' : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .right, q')) (L R : PAM M) : + mStep zf393 (mMk' q L (mCons a R)) = some (mMk' q' (mCons b L) R) := by + simp [mMk', mStep, htr] + +theorem mStep_mMk'_left {q q' : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .left, q')) (L R : PAM M) : + mStep zf393 (mMk' q L (mCons a R)) = some (mMkL q' L (mCons b R)) := by + simp [mMk', mMkL, mStep, htr] + +theorem mStep_mMkL_left {q q' : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .left, q')) (L R : PAM M) : + mStep zf393 (mMkL q (mCons a L) R) = some (mMkL q' L (mCons b R)) := by + simp [mMkL, mStep, htr] + +theorem mStep_mMkL_right {q q' : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .right, q')) (L R : PAM M) : + mStep zf393 (mMkL q (mCons a L) R) = some (mMk' q' (mCons b L) R) := by + simp [mMk', mMkL, mStep, htr] + +/-- Reachability in `≥ 0` internal `zf393` steps. -/ +def mReach (a b : MCfg 393 M) : Prop := + ∃ s : PAM M, mTracesTo zf393 s a b + +/-- Reachability in `≥ 1` internal `zf393` steps. -/ +def mReachPos (a b : MCfg 393 M) : Prop := + ∃ s : PAM M, 1 ≤ s ∧ mTracesTo zf393 s a b + +theorem mReach_refl (a : MCfg 393 M) : mReach a a := + ⟨0, mTracesTo_zero zf393 a⟩ + +theorem mReachPos_to_mReach {a b : MCfg 393 M} (h : mReachPos a b) : mReach a b := + let ⟨s, _, hs⟩ := h + ⟨s, hs⟩ + +theorem mReachPos_step {a b : MCfg 393 M} (hst : mStep zf393 a = some b) : + mReachPos a b := + ⟨1, le_rfl, mTracesTo_one hst⟩ + +theorem mReach_trans {a b c : MCfg 393 M} (h₁ : mReach a b) (h₂ : mReach b c) : + mReach a c := by + rcases h₁ with ⟨s₁, hs₁⟩ + rcases h₂ with ⟨s₂, hs₂⟩ + exact ⟨s₁ + s₂, mTracesTo_trans hs₁ hs₂⟩ + +theorem mReach_mReachPos {a b c : MCfg 393 M} (h₁ : mReach a b) (h₂ : mReachPos b c) : + mReachPos a c := by + rcases h₁ with ⟨s₁, hs₁⟩ + rcases h₂ with ⟨s₂, ⟨d, rfl⟩, hs₂⟩ + exact ⟨s₁ + (1 + d), ⟨s₁ + d, by ring⟩, mTracesTo_trans hs₁ hs₂⟩ + +theorem mReachPos_mReach {a b c : MCfg 393 M} (h₁ : mReachPos a b) (h₂ : mReach b c) : + mReachPos a c := by + rcases h₁ with ⟨s₁, ⟨d, rfl⟩, hs₁⟩ + rcases h₂ with ⟨s₂, hs₂⟩ + exact ⟨(1 + d) + s₂, ⟨d + s₂, by ring⟩, mTracesTo_trans hs₁ hs₂⟩ + +theorem mReachPos_trans {a b c : MCfg 393 M} (h₁ : mReachPos a b) (h₂ : mReachPos b c) : + mReachPos a c := + mReachPos_mReach h₁ (mReachPos_to_mReach h₂) + +theorem mStep_mReach {a b c : MCfg 393 M} (hst : mStep zf393 a = some b) (h : mReach b c) : + mReach a c := + mReach_trans (mReachPos_to_mReach (mReachPos_step hst)) h + +theorem mStep_mReachPos {a b c : MCfg 393 M} (hst : mStep zf393 a = some b) (h : mReach b c) : + mReachPos a c := + mReachPos_mReach (mReachPos_step hst) h + +/-! ## Section 2: First-Order Definability & `PAM.ind1` Unary Scan Lemmas -/ + +omit [PAModel M] in +theorem paDef_prop {k : ℕ} (P : Prop) : PADefN k (fun _ : Fin k → PAM M ↦ P) := by + rcases Classical.em P with h | h + · exact paDefN_congr (fun _ ↦ ⟨fun _ ↦ h, fun _ ↦ trivial⟩) (paDef_true k) + · exact paDefN_congr (fun _ ↦ ⟨False.elim, fun hp ↦ absurd hp h⟩) (paDef_false k) + +theorem paFun_mCons (b : Fin 2) {k : ℕ} {fx : (Fin k → PAM M) → PAM M} + (hx : PAFunN k fx) : PAFunN k (fun u ↦ mCons b (fx u)) := + paFun_add (paFun_mul (paFun_const 2) hx) (paFun_const (b.val : PAM M)) + +theorem paFun_mAppend (xs : List (Fin 2)) {k : ℕ} {fR : (Fin k → PAM M) → PAM M} + (hR : PAFunN k fR) : PAFunN k (fun u ↦ mAppend xs (fR u)) := by + induction xs with + | nil => exact hR + | cons b xs ih => exact paFun_mCons b ih + +theorem paFun_mRepBit (a : Fin 2) {k : ℕ} {fr fR : (Fin k → PAM M) → PAM M} + (hr : PAFunN k fr) (hR : PAFunN k fR) : + PAFunN k (fun u ↦ mRepBit a (fr u) (fR u)) := by + rcases fin2_cases a with rfl | rfl + · exact paFun_mRep0 hr hR + · exact paFun_mRep1 hr hR + +theorem paFun_mEncode_mMk' (q : Fin 393) {k : ℕ} {fL fR : (Fin k → PAM M) → PAM M} + (hL : PAFunN k fL) (hR : PAFunN k fR) : + PAFunN k (fun u ↦ mEncodeCfg (mMk' q (fL u) (fR u))) := by + refine paFunN_congr (fun u ↦ ?_) + (paFun_mPair (paFun_const (q.val : PAM M)) + (paFun_mPair (paFun_mod hR (paFun_const 2)) + (paFun_mPair hL (paFun_div hR (paFun_const 2))))) + simp [mEncodeCfg, mMk', mBit_val_eq_mod, mHalf] + +theorem paFun_mEncode_mMkL (q : Fin 393) {k : ℕ} {fL fR : (Fin k → PAM M) → PAM M} + (hL : PAFunN k fL) (hR : PAFunN k fR) : + PAFunN k (fun u ↦ mEncodeCfg (mMkL q (fL u) (fR u))) := by + refine paFunN_congr (fun u ↦ ?_) + (paFun_mPair (paFun_const (q.val : PAM M)) + (paFun_mPair (paFun_mod hL (paFun_const 2)) + (paFun_mPair (paFun_div hL (paFun_const 2)) hR))) + simp [mEncodeCfg, mMkL, mBit_val_eq_mod, mHalf] + +theorem paDef_mTracesTo {states : ℕ} (tm : Machine states 2) {k : ℕ} + {fn : (Fin k → PAM M) → PAM M} {ca cb : (Fin k → PAM M) → MCfg states M} + (hn : PAFunN k fn) + (ha : PAFunN k (fun u ↦ mEncodeCfg (ca u))) + (hb : PAFunN k (fun u ↦ mEncodeCfg (cb u))) : + PADefN k (fun u ↦ mTracesTo tm (fn u) (ca u) (cb u)) := by + refine paDefN_congr (fun u ↦ ?_) (paDef_mTracesToCode tm hn ha hb) + constructor + · rintro ⟨a₀, b₀, ha₀, hb₀, htr⟩ + rwa [mEncodeCfg_injective ha₀, mEncodeCfg_injective hb₀] + · intro htr + exact ⟨ca u, cb u, rfl, rfl, htr⟩ + +/-- Right-scanning `N : PAM M` copies of `a` into `b` in state `q`. -/ +theorem mRightScan {q : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .right, q)) (N L₀ R₀ : PAM M) : + mTracesTo zf393 N (mMk' q L₀ (mRepBit a N R₀)) (mMk' q (mRepBit b N L₀) R₀) := by + have hdef : PADef1 (fun k : PAM M ↦ k ≤ N → + mTracesTo zf393 k + (mMk' q L₀ (mRepBit a N R₀)) + (mMk' q (mRepBit b k L₀) (mRepBit a (N - k) R₀))) := + paDef_imp (paDef_le (paFun_proj 0) (paFun_const N)) + (paDef_mTracesTo zf393 (paFun_proj 0) + (paFun_const _) + (paFun_mEncode_mMk' q + (paFun_mRepBit b (paFun_proj 0) (paFun_const L₀)) + (paFun_mRepBit a (paFun_sub (paFun_const N) (paFun_proj 0)) (paFun_const R₀)))) + have hall := ind1 hdef ?_ ?_ N le_rfl + · simpa using hall + · intro _ + simpa [sub_zero_pam] using mTracesTo_zero zf393 (mMk' q L₀ (mRepBit a N R₀)) + · intro k ih hk1 + have hklt : k < N := hk1 + have htr_k := ih (le_of_lt hklt) + have hsub := sub_add_one_of_lt_pam hklt + rw [hsub, mRepBit_succ] at htr_k + have hst := mStep_mMk'_right htr (mRepBit b k L₀) (mRepBit a (N - (k + 1)) R₀) + have hb_succ : mCons b (mRepBit b k L₀) = mRepBit b (k + 1) L₀ := + (mRepBit_succ b k L₀).symm + rw [hb_succ] at hst + exact mTracesTo_snoc htr_k hst + +/-- Left-scanning `N : PAM M` copies of `a` into `b` in state `q`. -/ +theorem mLeftScan {q : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .left, q)) (N L₀ R₀ : PAM M) : + mTracesTo zf393 N (mMkL q (mRepBit a N L₀) R₀) (mMkL q L₀ (mRepBit b N R₀)) := by + have hdef : PADef1 (fun k : PAM M ↦ k ≤ N → + mTracesTo zf393 k + (mMkL q (mRepBit a N L₀) R₀) + (mMkL q (mRepBit a (N - k) L₀) (mRepBit b k R₀))) := + paDef_imp (paDef_le (paFun_proj 0) (paFun_const N)) + (paDef_mTracesTo zf393 (paFun_proj 0) + (paFun_const _) + (paFun_mEncode_mMkL q + (paFun_mRepBit a (paFun_sub (paFun_const N) (paFun_proj 0)) (paFun_const L₀)) + (paFun_mRepBit b (paFun_proj 0) (paFun_const R₀)))) + have hall := ind1 hdef ?_ ?_ N le_rfl + · simpa using hall + · intro _ + simpa [sub_zero_pam] using mTracesTo_zero zf393 (mMkL q (mRepBit a N L₀) R₀) + · intro k ih hk1 + have hklt : k < N := hk1 + have htr_k := ih (le_of_lt hklt) + have hsub := sub_add_one_of_lt_pam hklt + rw [hsub, mRepBit_succ] at htr_k + have hst := mStep_mMkL_left htr (mRepBit a (N - (k + 1)) L₀) (mRepBit b k R₀) + have hb_succ : mCons b (mRepBit b k R₀) = mRepBit b (k + 1) R₀ := + (mRepBit_succ b k R₀).symm + rw [hb_succ] at hst + exact mTracesTo_snoc htr_k hst + +theorem mRightScan_reach {q : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .right, q)) (N L₀ R₀ : PAM M) : + mReach (mMk' q L₀ (mRepBit a N R₀)) (mMk' q (mRepBit b N L₀) R₀) := + ⟨N, mRightScan htr N L₀ R₀⟩ + +theorem mLeftScan_reach {q : Fin 393} {a b : Fin 2} + (htr : zf393Trans q a = some (b, .left, q)) (N L₀ R₀ : PAM M) : + mReach (mMkL q (mRepBit a N L₀) R₀) (mMkL q L₀ (mRepBit b N R₀)) := + ⟨N, mLeftScan htr N L₀ R₀⟩ + +/-! ## Section 3: Unary Register Encodings, Root Normal Form, and Bootstrap Lifting -/ + +/-- Unary register `1^(u + 1) :: 0 :: R` on right half-tapes in `PAM M`. -/ +noncomputable def mEncodeReg (u R : PAM M) : PAM M := + mRep1 (u + 1) (mCons 0 R) + +/-- Reversed unary register `0 :: 1^(u + 1) :: L` on left half-tapes in `PAM M`. -/ +noncomputable def mEncodeRegRev (u L : PAM M) : PAM M := + mCons 0 (mRep1 (u + 1) L) + +/-- Prepend a list of registers `rs : List (PAM M)` onto a right half-tape `R : PAM M`. -/ +noncomputable def mAppendRegs (rs : List (PAM M)) (R : PAM M) : PAM M := + rs.foldr mEncodeReg R + +/-- Prepend the reversed bit-encoding of `rs : List (PAM M)` onto a left half-tape `L : PAM M`. -/ +noncomputable def mAppendRegsRev (rs : List (PAM M)) (L : PAM M) : PAM M := + rs.reverse.foldr mEncodeRegRev L + +/-- Right half-tape encoding of a register list `rs : List (PAM M)` followed by `0^ω`. -/ +noncomputable def mRegsTape (rs : List (PAM M)) : PAM M := + mAppendRegs rs 0 + +@[simp] +theorem mAppendRegs_nil (R : PAM M) : mAppendRegs [] R = R := rfl + +@[simp] +theorem mAppendRegs_cons (u : PAM M) (rs : List (PAM M)) (R : PAM M) : + mAppendRegs (u :: rs) R = mEncodeReg u (mAppendRegs rs R) := rfl + +theorem mAppendRegs_append (xs ys : List (PAM M)) (R : PAM M) : + mAppendRegs (xs ++ ys) R = mAppendRegs xs (mAppendRegs ys R) := by + induction xs with + | nil => rfl + | cons u xs ih => simp [ih] + +@[simp] +theorem mAppendRegsRev_nil (L : PAM M) : mAppendRegsRev [] L = L := rfl + +theorem mAppendRegsRev_snoc (rs : List (PAM M)) (u L : PAM M) : + mAppendRegsRev (rs ++ [u]) L = mEncodeRegRev u (mAppendRegsRev rs L) := by + simp [mAppendRegsRev] + +theorem mAppendRegsRev_append (xs ys : List (PAM M)) (L : PAM M) : + mAppendRegsRev (xs ++ ys) L = mAppendRegsRev ys (mAppendRegsRev xs L) := by + simp [mAppendRegsRev, List.reverse_append, List.foldr_append] + +theorem mAppendRegsRev_cons (u : PAM M) (rs : List (PAM M)) (L : PAM M) : + mAppendRegsRev (u :: rs) L = mAppendRegsRev rs (mEncodeRegRev u L) := by + simp [mAppendRegsRev] + +@[simp] +theorem mRegsTape_nil : mRegsTape ([] : List (PAM M)) = 0 := rfl + +@[simp] +theorem mRegsTape_cons (u : PAM M) (rs : List (PAM M)) : + mRegsTape (u :: rs) = mEncodeReg u (mRegsTape rs) := rfl + +theorem mRegsTape_append (xs ys : List (PAM M)) : + mRegsTape (xs ++ ys) = mAppendRegs xs (mRegsTape ys) := + mAppendRegs_append xs ys 0 + +/-- Embed a standard `List ℕ` register list into `List (PAM M)`. -/ +def mCastRegs (ns : List ℕ) : List (PAM M) := + ns.map (fun n : ℕ ↦ (n : PAM M)) + +/-- The 190 fixed unary blocks preceding the 11 active registers in `PAM M`. -/ +def mPrefix190 : List (PAM M) := + mCastRegs prefix190 + +theorem mPrefix190_ne_nil : mPrefix190 (M := M) ≠ [] := by + simp [mPrefix190, mCastRegs, prefix190_ne_nil] + +instance mPrefix190_ne_nil_fact : Fact (mPrefix190 (M := M) ≠ []) := + ⟨mPrefix190_ne_nil⟩ + +/-- Canonical configuration at `main().0` (`State 99`) in `MCfg 393 M` (tape register order). -/ +noncomputable def mRootCfg (pre : List (PAM M)) (slot : PAM M) (ip : List (Fin 2)) + (regs_tape : List (PAM M)) : MCfg 393 M := + mMk' 99 mLB01 + (mAppend ip (mRep0 (slot - (ip.length : PAM M)) (mAppendRegs pre (mRegsTape regs_tape)))) + +/-- Canonical `zf393` root configuration in tape register order (`0=scratch3 .. 10=prooflist`). -/ +noncomputable abbrev mZf393RootCfg (slot : PAM M) (ip : List (Fin 2)) + (regs_tape : List (PAM M)) : MCfg 393 M := + mRootCfg mPrefix190 slot ip regs_tape + +/-- Canonical `zf393` root configuration in logical register order (`0=prooflist..10=scratch3`). -/ +noncomputable def mZfLogCfg (slot : PAM M) (ip : List (Fin 2)) + (regs : List (PAM M)) : MCfg 393 M := + mZf393RootCfg slot ip regs.reverse + +theorem paFun_mEncodeReg {k : ℕ} {fu fR : (Fin k → PAM M) → PAM M} + (hu : PAFunN k fu) (hR : PAFunN k fR) : + PAFunN k (fun a ↦ mEncodeReg (fu a) (fR a)) := + paFun_mRep1 (paFun_add hu (paFun_const 1)) (paFun_mCons 0 hR) + +theorem paFun_mAppendRegs_const (pre : List (PAM M)) {k : ℕ} + {fR : (Fin k → PAM M) → PAM M} (hR : PAFunN k fR) : + PAFunN k (fun a ↦ mAppendRegs pre (fR a)) := by + induction pre with + | nil => exact hR + | cons u pre ih => exact paFun_mEncodeReg (paFun_const u) ih + +theorem paFun_mZfLogCfg (ip : List (Fin 2)) {k : ℕ} + {fslot : (Fin k → PAM M) → PAM M} + {fregs : Fin 11 → (Fin k → PAM M) → PAM M} + (hslot : PAFunN k fslot) (hregs : ∀ i : Fin 11, PAFunN k (fregs i)) : + PAFunN k (fun a ↦ + mEncodeCfg (mZfLogCfg (fslot a) ip (List.ofFn (fun i : Fin 11 ↦ fregs i a)))) := by + have hregsTape : PAFunN k (fun a ↦ + mRegsTape (List.ofFn (fun i : Fin 11 ↦ fregs i a)).reverse) := by + have haux : ∀ (idxs : List (Fin 11)), + PAFunN k (fun a ↦ mRegsTape (idxs.map (fun i ↦ fregs i a))) := by + intro idxs + induction idxs with + | nil => exact paFun_const 0 + | cons i rest ih => exact paFun_mEncodeReg (hregs i) ih + refine paFunN_congr (fun a ↦ ?_) (haux (List.finRange 11).reverse) + have hfn : List.ofFn (fun i : Fin 11 ↦ fregs i a) = + (List.finRange 11).map (fun i ↦ fregs i a) := List.ofFn_eq_map + rw [hfn, List.map_reverse] + exact paFun_mEncode_mMk' 99 (paFun_const mLB01) + (paFun_mAppend ip + (paFun_mRep0 (paFun_sub hslot (paFun_const (ip.length : PAM M))) + (paFun_mAppendRegs_const mPrefix190 hregsTape))) + +private theorem embedHalf_default : embedHalf (M := M) default = 0 := by + have h0 : encodeHalf (default : ListBlank (Fin 2)) = 0 := rfl + simp [embedHalf, h0] + +private theorem embedHalf_LB01 : embedHalf (M := M) LB01 = mLB01 := by + rw [LB01, embedHalf_cons, embedHalf_default] + rfl + +private theorem embedHalf_append (xs : List (Fin 2)) (L : ListBlank (Fin 2)) : + embedHalf (M := M) (ListBlank.append xs L) = mAppend xs (embedHalf (M := M) L) := by + induction xs with + | nil => rfl + | cons b xs ih => + change embedHalf (M := M) ((ListBlank.append xs L).cons b) = _ + rw [embedHalf_cons, ih, mAppend_cons] + +private theorem mAppend_encodeReg (n : ℕ) (R : PAM M) : + mAppend (encodeReg n) R = mEncodeReg (n : PAM M) R := by + unfold encodeReg mEncodeReg + rw [mAppend_snoc, mAppend_replicate_one, Nat.cast_succ] + +private theorem mAppend_encodeRegs (ns : List ℕ) (R : PAM M) : + mAppend (encodeRegs ns) R = mAppendRegs (mCastRegs ns) R := by + induction ns with + | nil => rfl + | cons n ns ih => + rw [ConjectureMachines.Semantics.Riemann.Layer1.encodeRegs_cons, + mAppend_append, ih, mAppend_encodeReg] + rfl + +private theorem embedCfg_mk' (q : Fin 393) (L R : ListBlank (Fin 2)) : + embedCfg (M := M) ⟨q, Tape.mk' L R⟩ = + mMk' q (embedHalf (M := M) L) (embedHalf (M := M) R) := by + simp [embedCfg, Tape.mk', mMk', mBit_embedHalf, mHalf_embedHalf] + +theorem embedCfg_zf393RootCfg_init : + embedCfg (M := M) (ConjectureMachines.Zf393.Layer1.zf393RootCfg 19 [] (List.replicate 11 0)) = + mZfLogCfg 19 [] (List.replicate 11 (0 : PAM M)) := by + unfold ConjectureMachines.Zf393.Layer1.zf393RootCfg ConjectureMachines.Zf393.Layer1.rootCfg + mZfLogCfg mZf393RootCfg mRootCfg + rw [embedCfg_mk', embedHalf_LB01, List.nil_append, List.length_nil, Nat.sub_zero, + ListBlank.append_assoc, embedHalf_append, embedHalf_append, mAppend_replicate_zero, + mAppend_encodeRegs] + unfold regsTape + rw [embedHalf_append, embedHalf_default, mAppend_encodeRegs] + have hrep : mCastRegs (M := M) (List.replicate 11 0) = + (List.replicate 11 (0 : PAM M)).reverse := by + simp [mCastRegs] + rw [hrep] + simp [mPrefix190, mRegsTape, Nat.cast_zero, sub_zero_pam] + +/-- In `39,773` internal steps from `mInit`, `Machines.zf393` reaches `mZfLogCfg 19 [] 0^11`. -/ +theorem mBoot_reaches_main0 : + mTracesTo zf393 ((39773 : ℕ) : PAM M) mInit + (mZfLogCfg 19 [] (List.replicate 11 (0 : PAM M))) := by + have htr := mTracesTo_of_nSteps (M := M) boot_reaches_main0 + simpa only [embedCfg_init, embedCfg_zf393RootCfg_init] using htr + +/-- `Machines.zf393` halts from blank tape in `PAM M` iff it halts from `mZfLogCfg 19 [] 0^11`. -/ +theorem mHalts_zf393_iff_rootInit : + mHalts M zf393 ↔ mHaltsFrom zf393 (mZfLogCfg 19 [] (List.replicate 11 (0 : PAM M))) := + mHaltsFrom_iff_of_mTracesTo mBoot_reaches_main0 + +/-! ## Section 4: Return Scans & Call-Stack Operations (`continue`, `break`) -/ + +section GenericPrefix +variable {pre : List (PAM M)} [hpre : Fact (pre ≠ [])] + +theorem mZfScan_rev (rev : List (Fin 2)) (z : ℕ) (hz : z ≤ 9) + (hok : scanZerosOk z rev = true) (R : PAM M) : + ∃ z', z' ≤ 9 ∧ + mReach (mMkL (zfScanState z) (mAppend rev 0) R) + (mMkL (zfScanState z') 0 (mAppend rev.reverse R)) := by + induction rev generalizing z R with + | nil => exact ⟨z, hz, mReach_refl _⟩ + | cons a xs ih => + rcases fin2_cases a with rfl | rfl + · simp only [scanZerosOk] at hok + by_cases hz9 : 9 ≤ z + · simp [hz9] at hok + · simp only [Fin.isValue, BEq.rfl, ↓reduceIte, Bool.ite_false_left, Bool.and_eq_true, + Bool.not_eq_eq_eq_not, Bool.not_true, decide_eq_false_iff_not, not_le] at hok + have hz8 : z ≤ 8 := by omega + have htr0 : zf393Trans (zfScanState z) 0 = some (0, .left, zfScanState (z + 1)) := by + match z with | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 => rfl | _ + 9 => omega + have hstep := mStep_mMkL_left htr0 (mAppend xs 0) R + obtain ⟨z', hz', hrest⟩ := ih (z + 1) (by omega) hok.2 (mCons 0 R) + rw [← mAppend_snoc, ← List.reverse_cons] at hrest + exact ⟨z', hz', mStep_mReach hstep hrest⟩ + · have htr1 : zf393Trans (zfScanState z) 1 = some (1, .left, zfScanState 0) := by + match z with | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 => rfl | _ + 10 => omega + have hstep := mStep_mMkL_left htr1 (mAppend xs 0) R + obtain ⟨z', hz', hrest⟩ := ih 0 (by decide) hok (mCons 1 R) + rw [← mAppend_snoc, ← List.reverse_cons] at hrest + exact ⟨z', hz', mStep_mReach hstep hrest⟩ + +theorem mZfScan_bounce_default (z : ℕ) (hz : z ≤ 9) (R : PAM M) : + mReachPos (mMkL (zfScanState z) 0 R) (mMk' 60 0 R) := by + generalize hd : 9 - z = d + induction d generalizing z R with + | zero => + have hz9 : z = 9 := by omega + subst hz9 + have hstep := mStep_mMkL_right (q := zfScanState 9) (q' := 60) (a := 0) (b := 0) (by rfl) 0 R + simpa only [mCons_zero_zero] using mReachPos_step hstep + | succ d ih => + have hz8 : z ≤ 8 := by omega + have htr0 : zf393Trans (zfScanState z) 0 = some (0, .left, zfScanState (z + 1)) := by + match z with | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 => rfl | _ + 9 => omega + have h1 : mStep zf393 (mMkL (zfScanState z) 0 R) = + some (mMkL (zfScanState (z + 1)) 0 (mCons 0 R)) := by + simpa only [mCons_zero_zero] using mStep_mMkL_left htr0 0 R + have h2 := ih (z + 1) (by omega) (mCons 0 R) (by omega) + have h3 : mStep zf393 (mMk' 60 0 (mCons 0 R)) = some (mMk' 60 0 R) := by + simpa only [mCons_zero_zero] using + mStep_mMk'_right (q := 60) (q' := 60) (a := 0) (b := 0) (by rfl) 0 R + exact mStep_mReachPos h1 (mReachPos_to_mReach (mReachPos_trans h2 (mReachPos_step h3))) + +theorem mRoot_scan_to_main0 (R : PAM M) : + mStep zf393 (mMk' 60 0 (mCons 1 R)) = some (mMk' 99 mLB01 R) := + mStep_mMk'_right (by rfl) 0 R + +theorem mScan_reaches_main0 (z : ℕ) (hz : z ≤ 9) (ip : List (Fin 2)) + (hok : scanZerosOk z (ip.reverse ++ [1]) = true) (R : PAM M) : + mReachPos (mMkL (zfScanState z) (mAppend ip.reverse mLB01) R) + (mMk' 99 mLB01 (mAppend ip R)) := by + have hL : mAppend ip.reverse (mLB01 : PAM M) = mAppend (ip.reverse ++ [1]) (0 : PAM M) := by + rw [mAppend_snoc]; rfl + rw [hL] + obtain ⟨z', hz', hscan⟩ := mZfScan_rev (ip.reverse ++ [1]) z hz hok R + have hrev : (ip.reverse ++ [1]).reverse = 1 :: ip := by + simp [List.reverse_append] + rw [hrev, mAppend_cons] at hscan + have hbounce := mZfScan_bounce_default z' hz' (mCons 1 (mAppend ip R)) + have hroot := mReachPos_step (mRoot_scan_to_main0 (mAppend ip R)) + exact mReach_mReachPos hscan (mReachPos_trans hbounce hroot) + +theorem mContinue_scan_to_64 (k : ℕ) (hk4 : k ≤ 4) (rev : List (Fin 2)) + (h1 : k ≤ rev.count 1) (L R : PAM M) : + let w' := (rawContinueRev k rev).reverse + mReach (mMkL (continueState k) (mAppend rev L) R) + (mMkL 64 (mAppend w'.reverse L) (mRep0 ((rev.length - w'.length : ℕ) : PAM M) R)) := by + induction rev generalizing k R with + | nil => + intro w' + have hk0 : k = 0 := by simp at h1; omega + subst hk0 + simpa [w', rawContinueRev, continueState] using mReach_refl _ + | cons b xs ih => + intro w' + cases k with + | zero => + have hsub : (b :: xs).length - w'.length = 0 := by simp [w', rawContinueRev] + rw [hsub, Nat.cast_zero, mRep0_zero] + simpa [w', rawContinueRev, continueState] using mReach_refl _ + | succ k' => + have hk'3 : k' < 4 := by omega + rcases fin2_cases b with rfl | rfl + · have htr0 := continueState_step0 ⟨k', hk'3⟩ + have hstep := mStep_mMkL_left htr0 (mAppend xs L) R + have hrec := ih (k' + 1) hk4 (by simpa using h1) (mCons 0 R) + dsimp only at hrec + have hw'_eq : (rawContinueRev (k' + 1) xs).reverse = w' := rfl + have hlen_le : w'.length ≤ xs.length := by + rw [← hw'_eq, List.length_reverse]; exact rawContinueRev_length_le (k' + 1) xs + have hsub : (0 :: xs).length - w'.length = (xs.length - w'.length) + 1 := by simp; omega + rw [hw'_eq, mRep0_mCons_zero, ← Nat.cast_add_one, ← hsub] at hrec + exact mStep_mReach hstep hrec + · have htr1 := continueState_step1 ⟨k', hk'3⟩ + have hstep := mStep_mMkL_left htr1 (mAppend xs L) R + have hrec := ih k' (by omega) (by rw [List.count_cons_self] at h1; omega) (mCons 0 R) + dsimp only at hrec + have hw'_eq : (rawContinueRev k' xs).reverse = w' := rfl + have hlen_le : w'.length ≤ xs.length := by + rw [← hw'_eq, List.length_reverse]; exact rawContinueRev_length_le k' xs + have hsub : (1 :: xs).length - w'.length = (xs.length - w'.length) + 1 := by simp; omega + rw [hw'_eq, mRep0_mCons_zero, ← Nat.cast_add_one, ← hsub] at hrec + exact mStep_mReach hstep hrec + +omit hpre in +theorem mContinue_k_reaches_main0 (k : ℕ) (hk4 : k ≤ 4) (slot : PAM M) (P : List (Fin 2)) + (h1 : k ≤ P.count 1) (hsl : (P.length : PAM M) ≤ slot) + (hok : scanZerosOk 0 (P.reverse ++ [1]) = true) (regs_tape : List (PAM M)) : + let ip' := (popContinueRev k P.reverse).reverse + mReachPos + (mMkL (continueState k) (mAppend P.reverse mLB01) + (mRep0 (slot - (P.length : PAM M)) (mAppendRegs pre (mRegsTape regs_tape)))) + (mRootCfg pre slot ip' regs_tape) := by + intro ip' + have h1_rev : k ≤ P.reverse.count 1 := by rwa [List.count_reverse] + set R_end := mAppendRegs pre (mRegsTape regs_tape) + have hs₁ := mContinue_scan_to_64 k hk4 P.reverse h1_rev mLB01 + (mRep0 (slot - (P.length : PAM M)) R_end) + let raw := rawContinueRev k P.reverse + have hlen_raw : raw.length ≤ P.length := by + rw [← P.length_reverse]; exact rawContinueRev_length_le k P.reverse + have hlen_ip' : ip'.length ≤ raw.length := by + dsimp only [ip', raw] + rw [popContinueRev_eq_zero_rawContinueRev, List.length_reverse] + exact popContinueRev_length_le 0 _ + have hok_raw : scanZerosOk 0 (raw.reverse.reverse ++ [1]) = true := by + rw [List.reverse_reverse] + exact scanZerosOk_rawContinueRev k P.reverse hok + have hs₂ := mScan_reaches_main0 0 (by decide) raw.reverse hok_raw + (mRep0 ((P.reverse.length - raw.reverse.length : ℕ) : PAM M) + (mRep0 (slot - (P.length : PAM M)) R_end)) + have hraw_pad : raw.reverse = ip' ++ List.replicate (raw.length - ip'.length) 0 := by + dsimp only [ip', raw] + rw [popContinueRev_eq_zero_rawContinueRev, List.length_reverse] + exact popContinueRev_zero_pad _ + have hnat_sum : ((raw.length - ip'.length : ℕ) : PAM M) + + ((P.reverse.length - raw.reverse.length : ℕ) : PAM M) = + (P.length : PAM M) - (ip'.length : PAM M) := by + have hnat : (raw.length - ip'.length) + (P.reverse.length - raw.reverse.length) = + P.length - ip'.length := by simp only [List.length_reverse]; omega + rw [← Nat.cast_add, hnat] + exact ((sub_eq_iff_eq_add_pam (natCast_le_iff.mpr (le_trans hlen_ip' hlen_raw))).mpr (by + rw [← Nat.cast_add, Nat.add_sub_of_le (le_trans hlen_ip' hlen_raw)])).symm + have htot : ((raw.length - ip'.length : ℕ) : PAM M) + + (((P.reverse.length - raw.reverse.length : ℕ) : PAM M) + (slot - (P.length : PAM M))) = + slot - (ip'.length : PAM M) := by + rw [← add_assoc, hnat_sum] + exact sub_split_add (natCast_le_iff.mpr (le_trans hlen_ip' hlen_raw)) hsl + have hR : mAppend raw.reverse + (mRep0 ((P.reverse.length - raw.reverse.length : ℕ) : PAM M) + (mRep0 (slot - (P.length : PAM M)) R_end)) = + mAppend ip' (mRep0 (slot - (ip'.length : PAM M)) R_end) := by + conv_lhs => arg 1; rw [hraw_pad] + rw [mAppend_append, mAppend_replicate_zero, ← mRep0_add, ← mRep0_add, add_assoc, htot] + rw [hR] at hs₂ + exact mReach_mReachPos hs₁ hs₂ + +theorem mBreak_scan_to_64 (k : ℕ) (hk2 : k ≤ 2) (rev : List (Fin 2)) + (h0 : k + 1 ≤ rev.count 0) (L R : PAM M) : + let w' := (popBreakRev k rev).reverse + mReachPos (mMkL (breakState k) (mAppend rev L) R) + (mMkL 64 (mAppend w'.reverse.tail L) + (mCons 1 (mRep0 ((rev.length - w'.length : ℕ) : PAM M) R))) := by + induction rev generalizing k R with + | nil => simp at h0 + | cons b xs ih => + intro w' + rcases fin2_cases b with rfl | rfl + · cases k with + | zero => + have hstep := mStep_mMkL_left (q := 61) (q' := 64) (a := 0) (b := 1) (by rfl) + (mAppend xs L) R + have hw'_rev : w'.reverse = 1 :: xs := by simp [w', popBreakRev] + have hsub : (0 :: xs).length - w'.length = 0 := by + have : w'.length = (0 :: xs).length := by rw [← List.length_reverse, hw'_rev]; rfl + omega + rw [hw'_rev, List.tail_cons, hsub, Nat.cast_zero, mRep0_zero] + exact mReachPos_step hstep + | succ k' => + have htr0 : zf393Trans (breakState (k' + 1)) 0 = some (0, .left, breakState k') := by + match k' with | 0 | 1 => rfl | _ + 2 => omega + have hstep := mStep_mMkL_left htr0 (mAppend xs L) R + have hrec := ih k' (by omega) (by rw [List.count_cons_self] at h0; omega) (mCons 0 R) + dsimp only at hrec + have hw'_eq : (popBreakRev k' xs).reverse = w' := rfl + have hlen_le : w'.length ≤ xs.length := by + rw [← hw'_eq, List.length_reverse]; exact popBreakRev_length_le k' xs + have hsub : (0 :: xs).length - w'.length = (xs.length - w'.length) + 1 := by simp; omega + rw [hw'_eq, mRep0_mCons_zero, ← Nat.cast_add_one, ← hsub] at hrec + exact mStep_mReachPos hstep (mReachPos_to_mReach hrec) + · have htr1 : zf393Trans (breakState k) 1 = some (0, .left, breakState k) := by + match k with | 0 | 1 | 2 => rfl | _ + 3 => omega + have hstep := mStep_mMkL_left htr1 (mAppend xs L) R + have hrec := ih k hk2 (by simpa using h0) (mCons 0 R) + dsimp only at hrec + have hw'_eq : (popBreakRev k xs).reverse = w' := rfl + have hlen_le : w'.length ≤ xs.length := by + rw [← hw'_eq, List.length_reverse]; exact popBreakRev_length_le k xs + have hsub : (1 :: xs).length - w'.length = (xs.length - w'.length) + 1 := by simp; omega + rw [hw'_eq, mRep0_mCons_zero, ← Nat.cast_add_one, ← hsub] at hrec + exact mStep_mReachPos hstep (mReachPos_to_mReach hrec) + +/-- Slot size in `PAM M` after `6.break.k` (`k ∈ {0..2}`) on `P`. -/ +def mBreakSlot (k : ℕ) (slot : PAM M) (P : List (Fin 2)) : PAM M := + if k + 1 ≤ P.count 0 then slot else slot + ((k - P.count 0 : ℕ) : PAM M) + 1 + +theorem mBreakSlot_natCast (k sl : ℕ) (P : List (Fin 2)) : + mBreakSlot k (sl : PAM M) P = (breakSlot k sl P : PAM M) := by + unfold mBreakSlot breakSlot + split_ifs <;> push_cast <;> rfl + +theorem mBreakSlot_mono (k : ℕ) {s₁ s₂ : PAM M} (hs : s₁ ≤ s₂) (P : List (Fin 2)) : + mBreakSlot k s₁ P ≤ mBreakSlot k s₂ P := by + unfold mBreakSlot + split_ifs + · exact hs + · rcases hs with ⟨d, rfl⟩ + exact ⟨d, by ring⟩ + +theorem le_mBreakSlot (k : ℕ) (slot : PAM M) (P : List (Fin 2)) : + slot ≤ mBreakSlot k slot P := by + unfold mBreakSlot + split_ifs + · exact le_rfl + · exact ⟨((k - P.count 0 : ℕ) : PAM M) + 1, by ring⟩ + +theorem mBreakSlot_append_ones (k : ℕ) (s : PAM M) (m : ℕ) (walked : List (Fin 2)) : + mBreakSlot k s (walked ++ List.replicate m 1) = mBreakSlot k s walked := by + unfold mBreakSlot + rw [List.count_append, List.count_replicate] + simp + +omit hpre in +theorem mBreak_k_reaches_main0 (k : ℕ) (hk2 : k ≤ 2) (slot : PAM M) (P : List (Fin 2)) + (hsl : (P.length : PAM M) ≤ slot) (hok : scanZerosOk 0 (P.reverse ++ [1]) = true) + (regs_tape : List (PAM M)) : + let ip' := (popBreakRev k P.reverse).reverse + mReachPos + (mMkL (breakState k) (mAppend P.reverse mLB01) + (mRep0 (slot - (P.length : PAM M)) (mAppendRegs pre (mRegsTape regs_tape)))) + (mRootCfg pre (mBreakSlot k slot P) ip' regs_tape) := by + intro ip' + set R_end := mAppendRegs pre (mRegsTape regs_tape) + by_cases hlt : k + 1 ≤ P.count 0 + · have hlt_rev : k + 1 ≤ P.reverse.count 0 := by rwa [List.count_reverse] + have hs₁ := mBreak_scan_to_64 k hk2 P.reverse hlt_rev mLB01 + (mRep0 (slot - (P.length : PAM M)) R_end) + have hhead := popBreakRev_head_one k P.reverse hlt_rev + have hip'_rev : ip'.reverse = 1 :: ip'.reverse.tail := by simpa [ip'] using hhead + have hok' : scanZerosOk 0 (ip'.reverse.tail ++ [1]) = true := by + have hfull : scanZerosOk 0 (ip'.reverse ++ [1]) = true := by + simpa [ip'] using scanZerosOk_popBreakRev k P.reverse hok + rw [hip'_rev] at hfull + exact scanZerosOk_tail hfull + have hs₂ := mScan_reaches_main0 0 (by decide) ip'.reverse.tail.reverse + (by simpa [List.reverse_reverse] using hok') + (mCons 1 (mRep0 ((P.reverse.length - ip'.length : ℕ) : PAM M) + (mRep0 (slot - (P.length : PAM M)) R_end))) + rw [List.reverse_reverse] at hs₂ + have hlen_le : ip'.length ≤ P.length := by + have := popBreakRev_length_le k P.reverse; simpa [ip'] using this + have hsub_cast : ((P.reverse.length - ip'.length : ℕ) : PAM M) = + (P.length : PAM M) - (ip'.length : PAM M) := by + rw [List.length_reverse] + exact ((sub_eq_iff_eq_add_pam (natCast_le_iff.mpr hlen_le)).mpr (by + rw [← Nat.cast_add, Nat.add_sub_of_le hlen_le])).symm + have hpad : ((P.reverse.length - ip'.length : ℕ) : PAM M) + (slot - (P.length : PAM M)) = + slot - (ip'.length : PAM M) := by + rw [hsub_cast] + exact sub_split_add (natCast_le_iff.mpr hlen_le) hsl + have hip'_snoc : ip'.reverse.tail.reverse ++ [1] = ip' := by + conv_rhs => rw [← List.reverse_reverse ip', hip'_rev] + simp + have hR : mAppend ip'.reverse.tail.reverse + (mCons 1 (mRep0 ((P.reverse.length - ip'.length : ℕ) : PAM M) + (mRep0 (slot - (P.length : PAM M)) R_end))) = + mAppend ip' (mRep0 (slot - (ip'.length : PAM M)) R_end) := by + rw [← mAppend_snoc, hip'_snoc, ← mRep0_add, hpad] + rw [hR] at hs₂ + have hbs : mBreakSlot k slot P = slot := by simp only [mBreakSlot, hlt, ↓reduceIte] + rw [hbs] + exact mReachPos_trans hs₁ hs₂ + · have hle : P.reverse.count 0 ≤ k := by rw [List.count_reverse]; omega + obtain ⟨hpop_nil, hpop_full⟩ := popBreakRev_overflow k P.reverse hle + have hip'_nil : ip' = [] := by simp [ip', hpop_nil] + set full_rev := P.reverse ++ [1] ++ List.replicate (k + 1) 0 + have hrep0_zero : ∀ m : ℕ, mAppend (List.replicate m 0) (0 : PAM M) = 0 := by + intro m; rw [mAppend_replicate_zero]; simp [mRep0] + have hL_eq : mAppend P.reverse (mLB01 : PAM M) = mAppend full_rev 0 := by + unfold full_rev + rw [mAppend_append, mAppend_append, hrep0_zero] + rfl + have hfull0 : k + 1 ≤ full_rev.count 0 := by unfold full_rev; simp; omega + rw [hL_eq] + have hs₁ := mBreak_scan_to_64 k hk2 full_rev hfull0 0 + (mRep0 (slot - (P.length : PAM M)) R_end) + dsimp only at hs₁ + have hw_rev : (popBreakRev k full_rev).reverse.reverse.tail = + List.replicate (P.reverse.count 0) 0 := by + rw [List.reverse_reverse, hpop_full, List.tail_cons] + have hw_len : (popBreakRev k full_rev).reverse.length = P.count 0 + 1 := by + rw [List.length_reverse, hpop_full, List.length_cons, List.length_replicate, + List.count_reverse] + have hfull_len : full_rev.length - (popBreakRev k full_rev).reverse.length = + P.length + (k - P.count 0) + 1 := by + rw [hw_len]; unfold full_rev; simp; omega + rw [hw_rev, hfull_len, hrep0_zero] at hs₁ + set extra : ℕ := P.length + (k - P.count 0) + 1 + have hbounce := mZfScan_bounce_default 0 (by decide) + (mCons 1 (mRep0 (extra : PAM M) (mRep0 (slot - (P.length : PAM M)) R_end))) + have hroot := mReachPos_step (mRoot_scan_to_main0 + (mRep0 (extra : PAM M) (mRep0 (slot - (P.length : PAM M)) R_end))) + have hbs : mBreakSlot k slot P = slot + ((k - P.count 0 : ℕ) : PAM M) + 1 := by + simp only [mBreakSlot, hlt, ↓reduceIte] + have hpad : (extra : PAM M) + (slot - (P.length : PAM M)) = + slot + ((k - P.count 0 : ℕ) : PAM M) + 1 := by + dsimp only [extra] + push_cast + calc (P.length : PAM M) + ((k - P.count 0 : ℕ) : PAM M) + 1 + (slot - (P.length : PAM M)) + _ = ((P.length : PAM M) + (slot - (P.length : PAM M))) + + ((k - P.count 0 : ℕ) : PAM M) + 1 := by ring + _ = slot + ((k - P.count 0 : ℕ) : PAM M) + 1 := by rw [add_sub_of_le_pam hsl] + rw [hip'_nil, hbs] + have htot := mReachPos_trans hs₁ (mReachPos_trans hbounce hroot) + simpa only [mRootCfg, mAppend_nil, List.length_nil, Nat.cast_zero, sub_zero_pam, + ← mRep0_add, hpad] using htot + +/-! ## Section 5: Moving `00` Selector, `1.inc`, `1.decnz`, & Leaf Gadgets in `PAM M` -/ + +/-- Selector tape suffix in `PAM M` with `m` registers shifted to the right of `00`. -/ +noncomputable def mZf393SelRight (pre : List (PAM M)) (m : ℕ) + (regs_tape : List (PAM M)) : PAM M := + mAppendRegs (pre ++ regs_tape.take (11 - m)) (mCons 0 (mRegsTape (regs_tape.drop (11 - m)))) + +omit hpre in +theorem mZf393SelRight_zero (pre regs_tape : List (PAM M)) (h : regs_tape.length = 11) : + mZf393SelRight pre 0 regs_tape = mAppendRegs pre (mRegsTape regs_tape) := by + unfold mZf393SelRight + rw [Nat.sub_zero, List.take_of_length_le (by omega), List.drop_of_length_le (by omega), + mRegsTape_nil, mCons_zero_zero, mAppendRegs_append] + rfl + +theorem mRet1_scan_reg (u L R : PAM M) : + mReach (mMkL 23 (mEncodeRegRev u L) R) (mMkL 23 L (mEncodeReg u R)) := by + unfold mEncodeRegRev mEncodeReg + rw [mRep1_succ] + have h1 := mStep_mMkL_left (q := 23) (q' := 24) (a := 0) (b := 0) (by rfl) + (mCons 1 (mRep1 u L)) R + have h2 := mStep_mMkL_left (q := 24) (q' := 23) (a := 1) (b := 1) (by rfl) + (mRep1 u L) (mCons 0 R) + have hscan := mLeftScan_reach (q := 23) (a := 1) (b := 1) (by rfl) u L (mCons 1 (mCons 0 R)) + rw [mRepBit_one_bit, mRepBit_one_bit, mRep1_mCons_one] at hscan + exact mStep_mReach h1 (mStep_mReach h2 hscan) + +theorem mRet1_scan_regs (rs : List (PAM M)) (L R : PAM M) : + mReach (mMkL 23 (mAppendRegsRev rs L) R) (mMkL 23 L (mAppendRegs rs R)) := by + induction rs using List.reverseRecOn generalizing R with + | nil => exact mReach_refl _ + | append_singleton rs u ih => + rw [mAppendRegsRev_snoc, mAppendRegs_append, mAppendRegs_cons, mAppendRegs_nil] + exact mReach_trans (mRet1_scan_reg u (mAppendRegsRev rs L) R) (ih (mEncodeReg u R)) + +theorem mRet1_finish (rs : List (PAM M)) (z L R : PAM M) : + mReachPos + (mMkL 23 (mAppendRegsRev rs (mRep0 (z + 2) (mCons 1 L))) R) + (mMkL 61 L (mRep0 (z + 3) (mAppendRegs rs R))) := by + have h1 := mRet1_scan_regs rs (mRep0 (z + 2) (mCons 1 L)) R + set R₁ := mAppendRegs rs R + have hz_split : mRep0 (z + 2) (mCons 1 L) = mCons 0 (mCons 0 (mRep0 z (mCons 1 L))) := by + rw [show z + 2 = (z + 1) + 1 by ring, mRep0_succ, mRep0_succ] + conv at h1 => arg 2; rw [hz_split] + have hz1 := mStep_mMkL_left (q := 23) (q' := 24) (a := 0) (b := 0) (by rfl) + (mCons 0 (mRep0 z (mCons 1 L))) R₁ + have hz2 := mStep_mMkL_left (q := 24) (q' := 25) (a := 0) (b := 0) (by rfl) + (mRep0 z (mCons 1 L)) (mCons 0 R₁) + have hscan := mLeftScan_reach (q := 25) (a := 0) (b := 0) (by rfl) z (mCons 1 L) + (mCons 0 (mCons 0 R₁)) + rw [mRepBit_zero_bit, mRepBit_zero_bit] at hscan + have hm1 := mStep_mMkL_left (q := 25) (q' := 61) (a := 1) (b := 0) (by rfl) L + (mRep0 z (mCons 0 (mCons 0 R₁))) + have hrep : mCons 0 (mRep0 z (mCons 0 (mCons 0 R₁))) = mRep0 (z + 3) R₁ := by + rw [mRep0_mCons_zero, mRep0_mCons_zero, ← mRep0_succ] + exact congrArg (fun x ↦ mRep0 x R₁) (by ring) + rw [hrep] at hm1 + exact mReach_mReachPos h1 (mStep_mReachPos hz1 (mStep_mReach hz2 + (mReach_trans hscan (mReachPos_to_mReach (mReachPos_step hm1))))) + +theorem mRet2_scan_reg (u L R : PAM M) : + mReach (mMkL 26 (mEncodeRegRev u L) R) (mMkL 26 L (mEncodeReg u R)) := by + unfold mEncodeRegRev mEncodeReg + rw [mRep1_succ] + have h1 := mStep_mMkL_left (q := 26) (q' := 27) (a := 0) (b := 0) (by rfl) + (mCons 1 (mRep1 u L)) R + have h2 := mStep_mMkL_left (q := 27) (q' := 26) (a := 1) (b := 1) (by rfl) + (mRep1 u L) (mCons 0 R) + have hscan := mLeftScan_reach (q := 26) (a := 1) (b := 1) (by rfl) u L (mCons 1 (mCons 0 R)) + rw [mRepBit_one_bit, mRepBit_one_bit, mRep1_mCons_one] at hscan + exact mStep_mReach h1 (mStep_mReach h2 hscan) + +theorem mRet2_scan_regs (rs : List (PAM M)) (L R : PAM M) : + mReach (mMkL 26 (mAppendRegsRev rs L) R) (mMkL 26 L (mAppendRegs rs R)) := by + induction rs using List.reverseRecOn generalizing R with + | nil => exact mReach_refl _ + | append_singleton rs u ih => + rw [mAppendRegsRev_snoc, mAppendRegs_append, mAppendRegs_cons, mAppendRegs_nil] + exact mReach_trans (mRet2_scan_reg u (mAppendRegsRev rs L) R) (ih (mEncodeReg u R)) + +theorem mRet2_finish (rs : List (PAM M)) (z L R : PAM M) : + mReachPos + (mMkL 26 (mAppendRegsRev rs (mRep0 (z + 2) (mCons 1 L))) R) + (mMkL 62 L (mRep0 (z + 3) (mAppendRegs rs R))) := by + have h1 := mRet2_scan_regs rs (mRep0 (z + 2) (mCons 1 L)) R + set R₁ := mAppendRegs rs R + have hz_split : mRep0 (z + 2) (mCons 1 L) = mCons 0 (mCons 0 (mRep0 z (mCons 1 L))) := by + rw [show z + 2 = (z + 1) + 1 by ring, mRep0_succ, mRep0_succ] + conv at h1 => arg 2; rw [hz_split] + have hz1 := mStep_mMkL_left (q := 26) (q' := 27) (a := 0) (b := 0) (by rfl) + (mCons 0 (mRep0 z (mCons 1 L))) R₁ + have hz2 := mStep_mMkL_left (q := 27) (q' := 28) (a := 0) (b := 0) (by rfl) + (mRep0 z (mCons 1 L)) (mCons 0 R₁) + have hscan := mLeftScan_reach (q := 28) (a := 0) (b := 0) (by rfl) z (mCons 1 L) + (mCons 0 (mCons 0 R₁)) + rw [mRepBit_zero_bit, mRepBit_zero_bit] at hscan + have hm1 := mStep_mMkL_left (q := 28) (q' := 62) (a := 1) (b := 0) (by rfl) L + (mRep0 z (mCons 0 (mCons 0 R₁))) + have hrep : mCons 0 (mRep0 z (mCons 0 (mCons 0 R₁))) = mRep0 (z + 3) R₁ := by + rw [mRep0_mCons_zero, mRep0_mCons_zero, ← mRep0_succ] + exact congrArg (fun x ↦ mRep0 x R₁) (by ring) + rw [hrep] at hm1 + exact mReach_mReachPos h1 (mStep_mReachPos hz1 (mStep_mReach hz2 + (mReach_trans hscan (mReachPos_to_mReach (mReachPos_step hm1))))) + +theorem mSel_scan_reg (u L R : PAM M) : + mReach (mMk' 20 L (mEncodeReg u R)) (mMk' 20 (mEncodeRegRev u L) R) := by + unfold mEncodeReg mEncodeRegRev + rw [mRep1_succ] + have h1 := mStep_mMk'_right (q := 20) (q' := 19) (a := 1) (b := 1) (by rfl) L + (mRep1 u (mCons 0 R)) + have hscan := mRightScan_reach (q := 19) (a := 1) (b := 1) (by rfl) u (mCons 1 L) (mCons 0 R) + rw [mRepBit_one_bit, mRepBit_one_bit] at hscan + have h2 := mStep_mMk'_right (q := 19) (q' := 20) (a := 0) (b := 0) (by rfl) + (mRep1 u (mCons 1 L)) R + conv at h2 => rhs; rw [mRep1_mCons_one] + exact mStep_mReach h1 (mReach_trans hscan (mReachPos_to_mReach (mReachPos_step h2))) + +theorem mSel_scan_regs (rs : List (PAM M)) (L R : PAM M) : + mReach (mMk' 20 L (mAppendRegs rs R)) (mMk' 20 (mAppendRegsRev rs L) R) := by + induction rs generalizing L with + | nil => exact mReach_refl _ + | cons u rs ih => + rw [mAppendRegs_cons, mAppendRegsRev_cons] + exact mReach_trans (mSel_scan_reg u L (mAppendRegs rs R)) (ih (mEncodeRegRev u L)) + +theorem mSel_pass_to_61 (m : ℕ) (hm : m < 11) (z : PAM M) (regs_tape : List (PAM M)) + (hregs : regs_tape.length = 11) (L : PAM M) : + mReachPos + (mMk' 17 L (mRep0 (z + 3) (mZf393SelRight pre m regs_tape))) + (mMkL 61 L (mRep0 (z + 3) (mZf393SelRight pre (m + 1) regs_tape))) := by + have htake : regs_tape.take (11 - m) = regs_tape.take (10 - m) ++ [regs_tape[10 - m]] := by + have h11 : 11 - m = (10 - m) + 1 := by omega + rw [h11, List.take_add_one, getElem?_pos regs_tape (10 - m) (by omega), Option.toList_some] + set v := regs_tape[10 - m] + set rs_pre := pre ++ regs_tape.take (10 - m) + have hrs_ne : rs_pre ≠ [] := by simp [rs_pre, hpre.out] + have hrs_split : pre ++ regs_tape.take (11 - m) = rs_pre ++ [v] := by + rw [htake, List.append_assoc] + unfold mZf393SelRight + rw [hrs_split, mAppendRegs_append, mAppendRegs_cons, mAppendRegs_nil] + set R_tail := mRegsTape (regs_tape.drop (11 - m)) + have hz3 : mRep0 (z + 3) (mAppendRegs rs_pre (mEncodeReg v (mCons 0 R_tail))) = + mCons 0 (mRep0 (z + 2) (mAppendRegs rs_pre (mEncodeReg v (mCons 0 R_tail)))) := by + rw [show z + 3 = (z + 2) + 1 by ring, mRep0_succ] + rw [hz3] + have hs1 := mStep_mMk'_right (q := 17) (q' := 18) (a := 0) (b := 1) (by rfl) L + (mRep0 (z + 2) (mAppendRegs rs_pre (mEncodeReg v (mCons 0 R_tail)))) + have hscan0 := mRightScan_reach (q := 18) (a := 0) (b := 0) (by rfl) (z + 2) (mCons 1 L) + (mAppendRegs rs_pre (mEncodeReg v (mCons 0 R_tail))) + rw [mRepBit_zero_bit, mRepBit_zero_bit] at hscan0 + set L_z := mRep0 (z + 2) (mCons 1 L) + obtain ⟨u₀, rs_rest, hpre_cons⟩ : ∃ u₀ rs_rest, rs_pre = u₀ :: rs_rest := by + rcases h : rs_pre with _ | ⟨u₀, rs_rest⟩ + · exact absurd h hrs_ne + · exact ⟨u₀, rs_rest, rfl⟩ + have h18_to_20 : mReach + (mMk' 18 L_z (mAppendRegs rs_pre (mEncodeReg v (mCons 0 R_tail)))) + (mMk' 20 (mAppendRegsRev rs_pre L_z) (mEncodeReg v (mCons 0 R_tail))) := by + rw [hpre_cons, mAppendRegs_cons, mAppendRegsRev_cons] + set R_u0 := mAppendRegs rs_rest (mEncodeReg v (mCons 0 R_tail)) + have hfirst : mReach (mMk' 18 L_z (mEncodeReg u₀ R_u0)) + (mMk' 20 (mEncodeRegRev u₀ L_z) R_u0) := by + unfold mEncodeReg mEncodeRegRev + rw [mRep1_succ] + have ha1 := mStep_mMk'_right (q := 18) (q' := 19) (a := 1) (b := 1) (by rfl) L_z + (mRep1 u₀ (mCons 0 R_u0)) + have hasc := mRightScan_reach (q := 19) (a := 1) (b := 1) (by rfl) u₀ (mCons 1 L_z) + (mCons 0 R_u0) + rw [mRepBit_one_bit, mRepBit_one_bit] at hasc + have ha2 := mStep_mMk'_right (q := 19) (q' := 20) (a := 0) (b := 0) (by rfl) + (mRep1 u₀ (mCons 1 L_z)) R_u0 + conv at ha2 => rhs; rw [mRep1_mCons_one] + exact mStep_mReach ha1 (mReach_trans hasc (mReachPos_to_mReach (mReachPos_step ha2))) + exact mReach_trans hfirst (mSel_scan_regs rs_rest (mEncodeRegRev u₀ L_z) + (mEncodeReg v (mCons 0 R_tail))) + set L_pre := mAppendRegsRev rs_pre L_z + have hv_scan := mSel_scan_reg v L_pre (mCons 0 R_tail) + unfold mEncodeRegRev at hv_scan + set L_ones := mRep1 (v + 1) L_pre + have hd0 := mStep_mMk'_left (q := 20) (q' := 21) (a := 0) (b := 0) (by rfl) + (mCons 0 L_ones) R_tail + have he0 := mStep_mMkL_left (q := 21) (q' := 22) (a := 0) (b := 1) (by rfl) + L_ones (mCons 0 R_tail) + have hf_ones := mLeftScan_reach (q := 22) (a := 1) (b := 1) (by rfl) (v + 1) L_pre + (mCons 1 (mCons 0 R_tail)) + rw [mRepBit_one_bit, mRepBit_one_bit, mRep1_inner_cons] at hf_ones + have henc_v : mCons 1 (mRep1 (v + 1) (mCons 0 R_tail)) = mCons 1 (mEncodeReg v R_tail) := rfl + rw [henc_v] at hf_ones + obtain ⟨rs_init, u_last, hpre_snoc⟩ : ∃ rs_init u_last, rs_pre = rs_init ++ [u_last] := by + rcases rs_pre.eq_nil_or_concat with hnil | ⟨rs_init, u_last, hcat⟩ + · exact absurd hnil hrs_ne + · exact ⟨rs_init, u_last, by rw [hcat, List.concat_eq_append]⟩ + have hL_pre_0 : L_pre = mCons 0 (mRep1 (u_last + 1) (mAppendRegsRev rs_init L_z)) := by + dsimp only [L_pre] + rw [hpre_snoc, mAppendRegsRev_snoc] + rfl + have hf0 : mStep zf393 (mMkL 22 L_pre (mCons 1 (mEncodeReg v R_tail))) = + some (mMk' 21 L_pre (mCons 1 (mEncodeReg v R_tail))) := by + rw [hL_pre_0] + exact mStep_mMkL_right (by rfl) _ _ + have he1 := mStep_mMk'_left (q := 21) (q' := 23) (a := 1) (b := 0) (by rfl) L_pre + (mEncodeReg v R_tail) + have hret := mRet1_finish rs_pre z L (mCons 0 (mEncodeReg v R_tail)) + have hdrop : regs_tape.drop (11 - (m + 1)) = v :: regs_tape.drop (11 - m) := by + have hsub1 : 11 - (m + 1) = 10 - m := by omega + have hsub2 : 11 - m = (10 - m) + 1 := by omega + rw [hsub1, hsub2] + exact (List.getElem_cons_drop (by omega)).symm + have hsub_take : 11 - (m + 1) = 10 - m := by omega + rw [hdrop, hsub_take, mRegsTape_cons] + exact mStep_mReachPos hs1 (mReach_trans hscan0 (mReach_trans h18_to_20 + (mReach_trans hv_scan (mStep_mReach hd0 (mStep_mReach he0 (mReach_trans hf_ones + (mStep_mReach hf0 (mStep_mReach he1 (mReachPos_to_mReach hret))))))))) + +theorem mSel_step_reaches_main0 (m : ℕ) (hm : m < 11) (slot : PAM M) (walked : List (Fin 2)) + (hsl : ((walked.length + m + 4 : ℕ) : PAM M) ≤ slot) + (hok : scanZerosOk 0 (walked.reverse ++ [1]) = true) + (regs_tape : List (PAM M)) (hregs : regs_tape.length = 11) : + mReachPos + (mMk' 17 (mAppend (walked ++ List.replicate m 1 ++ [0]).reverse mLB01) + (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) + (mZf393SelRight pre m regs_tape))) + (mMk' 99 mLB01 + (mAppend (walked ++ List.replicate (m + 1) 1) + (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) + (mZf393SelRight pre (m + 1) regs_tape)))) := by + set P := walked ++ List.replicate m 1 ++ [0] + set base : PAM M := ((walked.length + m + 1 : ℕ) : PAM M) + have hbase3 : base + 3 ≤ slot := by + have hnat : walked.length + m + 4 = (walked.length + m + 1) + 3 := by omega + simpa only [base, hnat, Nat.cast_add, Nat.cast_ofNat] using hsl + set z := slot - (base + 3) + have hz_eq : slot - base = z + 3 := by + dsimp only [z] + have hle : base ≤ slot := le_trans (le_add_right_pam base 3) hbase3 + rw [sub_eq_iff_eq_add_pam hle] + calc slot + _ = (base + 3) + (slot - (base + 3)) := (add_sub_of_le_pam hbase3).symm + _ = base + (slot - (base + 3) + 3) := by ring + rw [hz_eq] + have hs₁ := @mSel_pass_to_61 M _ _ pre hpre m hm z regs_tape hregs (mAppend P.reverse mLB01) + set R_sel := mRep0 (z + 3) (mZf393SelRight pre (m + 1) regs_tape) + have hP_rev : mAppend P.reverse (mLB01 : PAM M) = + mCons 0 (mAppend (walked ++ List.replicate m 1).reverse mLB01) := by + simp [P, List.reverse_append] + have hb0 : mStep zf393 (mMkL 61 (mAppend P.reverse mLB01) R_sel) = + some (mMkL 64 (mAppend (walked ++ List.replicate m 1).reverse mLB01) (mCons 1 R_sel)) := by + rw [hP_rev] + exact mStep_mMkL_left (by rfl) _ _ + have hscan_ones : ∀ n xs, scanZerosOk 0 (List.replicate n (1 : Fin 2) ++ xs) = + scanZerosOk 0 xs := by + intro n xs; induction n with + | zero => rfl + | succ n ih => exact ih + have hok_ones : scanZerosOk 0 ((walked ++ List.replicate m 1).reverse ++ [1]) = true := by + rw [List.reverse_append, List.reverse_replicate, List.append_assoc, hscan_ones m] + exact hok + have hs₂ := mScan_reaches_main0 0 (by decide) (walked ++ List.replicate m 1) hok_ones + (mCons 1 R_sel) + have hR : mAppend (walked ++ List.replicate m 1) (mCons 1 R_sel) = + mAppend (walked ++ List.replicate (m + 1) 1) R_sel := by + rw [← mAppend_snoc, List.append_assoc walked, ← List.replicate_succ'] + rw [hR] at hs₂ + exact mReachPos_trans hs₁ (mStep_mReachPos hb0 (mReachPos_to_mReach hs₂)) + +theorem mInc_scan_reg (u L R : PAM M) : + mReach (mMk' 16 L (mEncodeReg u R)) (mMk' 16 (mEncodeRegRev u L) R) := by + unfold mEncodeReg mEncodeRegRev + rw [mRep1_succ] + have h1 := mStep_mMk'_right (q := 16) (q' := 15) (a := 1) (b := 1) (by rfl) L + (mRep1 u (mCons 0 R)) + have hscan := mRightScan_reach (q := 15) (a := 1) (b := 1) (by rfl) u (mCons 1 L) (mCons 0 R) + rw [mRepBit_one_bit, mRepBit_one_bit] at hscan + have h2 := mStep_mMk'_right (q := 15) (q' := 16) (a := 0) (b := 0) (by rfl) + (mRep1 u (mCons 1 L)) R + conv at h2 => rhs; rw [mRep1_mCons_one] + exact mStep_mReach h1 (mReach_trans hscan (mReachPos_to_mReach (mReachPos_step h2))) + +theorem mInc_scan_regs (rs : List (PAM M)) (L R : PAM M) : + mReach (mMk' 16 L (mAppendRegs rs R)) (mMk' 16 (mAppendRegsRev rs L) R) := by + induction rs generalizing L with + | nil => exact mReach_refl _ + | cons u rs ih => + rw [mAppendRegs_cons, mAppendRegsRev_cons] + exact mReach_trans (mInc_scan_reg u L (mAppendRegs rs R)) (ih (mEncodeRegRev u L)) + +theorem mInc_pass_to_61 (r : Fin 11) (z : PAM M) (regs_tape : List (PAM M)) + (hregs : regs_tape.length = 11) (L : PAM M) : + mReachPos + (mMk' 13 L (mRep0 (z + 3) (mZf393SelRight pre (11 - r.val) regs_tape))) + (mMkL 61 L (mRep0 (z + 3) + (mAppendRegs pre (mRegsTape (regs_tape.set r.val (regs_tape[r.val] + 1)))))) := by + have hsub : 11 - (11 - r.val) = r.val := by omega + unfold mZf393SelRight + rw [hsub] + set rs_pre := pre ++ regs_tape.take r.val + set R_after := mRegsTape (regs_tape.drop r.val) + have hz3 : mRep0 (z + 3) (mAppendRegs rs_pre (mCons 0 R_after)) = + mCons 0 (mRep0 (z + 2) (mAppendRegs rs_pre (mCons 0 R_after))) := by + rw [show z + 3 = (z + 2) + 1 by ring, mRep0_succ] + rw [hz3] + have hs1 := mStep_mMk'_right (q := 13) (q' := 14) (a := 0) (b := 1) (by rfl) L + (mRep0 (z + 2) (mAppendRegs rs_pre (mCons 0 R_after))) + have hscan0 := mRightScan_reach (q := 14) (a := 0) (b := 0) (by rfl) (z + 2) (mCons 1 L) + (mAppendRegs rs_pre (mCons 0 R_after)) + rw [mRepBit_zero_bit, mRepBit_zero_bit] at hscan0 + set L_z := mRep0 (z + 2) (mCons 1 L) + have hpre_ne : rs_pre ≠ [] := by simp [rs_pre, hpre.out] + obtain ⟨u₀, rs_rest, hpre_cons⟩ : ∃ u₀ rs_rest, rs_pre = u₀ :: rs_rest := by + rcases h : rs_pre with _ | ⟨u₀, rs_rest⟩ + · exact absurd h hpre_ne + · exact ⟨u₀, rs_rest, rfl⟩ + have h14_to_16 : mReach + (mMk' 14 L_z (mAppendRegs rs_pre (mCons 0 R_after))) + (mMk' 16 (mAppendRegsRev rs_pre L_z) (mCons 0 R_after)) := by + rw [hpre_cons, mAppendRegs_cons, mAppendRegsRev_cons] + set R_u0 := mAppendRegs rs_rest (mCons 0 R_after) + have hfirst : mReach (mMk' 14 L_z (mEncodeReg u₀ R_u0)) + (mMk' 16 (mEncodeRegRev u₀ L_z) R_u0) := by + unfold mEncodeReg mEncodeRegRev + rw [mRep1_succ] + have ha1 := mStep_mMk'_right (q := 14) (q' := 15) (a := 1) (b := 1) (by rfl) L_z + (mRep1 u₀ (mCons 0 R_u0)) + have hasc := mRightScan_reach (q := 15) (a := 1) (b := 1) (by rfl) u₀ (mCons 1 L_z) + (mCons 0 R_u0) + rw [mRepBit_one_bit, mRepBit_one_bit] at hasc + have ha2 := mStep_mMk'_right (q := 15) (q' := 16) (a := 0) (b := 0) (by rfl) + (mRep1 u₀ (mCons 1 L_z)) R_u0 + conv at ha2 => rhs; rw [mRep1_mCons_one] + exact mStep_mReach ha1 (mReach_trans hasc (mReachPos_to_mReach (mReachPos_step ha2))) + exact mReach_trans hfirst (mInc_scan_regs rs_rest (mEncodeRegRev u₀ L_z) (mCons 0 R_after)) + have hd0 := mStep_mMk'_left (q := 16) (q' := 23) (a := 0) (b := 1) (by rfl) + (mAppendRegsRev rs_pre L_z) R_after + have hret := mRet1_finish rs_pre z L (mCons 1 R_after) + have htake_set_drop : ∀ (xs : List (PAM M)) (i : ℕ) (w : PAM M), + i < xs.length → xs.take i ++ (w :: xs.drop (i + 1)) = xs.set i w := by + intro xs i w hi + induction xs generalizing i with + | nil => simp at hi + | cons x xs ih => + cases i with + | zero => rfl + | succ i => simp [ih i (by simpa using hi)] + have hset : mAppendRegs rs_pre (mCons 1 R_after) = + mAppendRegs pre (mRegsTape (regs_tape.set r.val (regs_tape[r.val] + 1))) := by + have hdrop : regs_tape.drop r.val = regs_tape[r.val] :: regs_tape.drop (r.val + 1) := + (List.getElem_cons_drop (by omega)).symm + have henc1 : mCons 1 (mRegsTape (regs_tape[r.val] :: regs_tape.drop (r.val + 1))) = + mRegsTape ((regs_tape[r.val] + 1) :: regs_tape.drop (r.val + 1)) := by + conv_lhs => rw [mRegsTape, mAppendRegs_cons, mEncodeReg] + conv_rhs => rw [mRegsTape, mAppendRegs_cons, mEncodeReg, mRep1_succ] + dsimp only [R_after, rs_pre] + rw [hdrop, henc1, mAppendRegs_append, ← mRegsTape_append, + htake_set_drop regs_tape r.val (regs_tape[r.val] + 1) (by omega)] + rw [hset] at hret + exact mStep_mReachPos hs1 (mReach_trans hscan0 + (mReach_trans h14_to_16 (mStep_mReach hd0 (mReachPos_to_mReach hret)))) + +theorem mInc_step_reaches_main0 (r : Fin 11) (slot : PAM M) (walked : List (Fin 2)) + (hsl : ((walked.length + (11 - r.val) + 3 : ℕ) : PAM M) ≤ slot) + (hok : scanZerosOk 0 (walked.reverse ++ [1]) = true) + (regs_tape : List (PAM M)) (hregs : regs_tape.length = 11) : + mReachPos + (mMk' 13 (mAppend (walked ++ List.replicate (11 - r.val) 1).reverse mLB01) + (mRep0 (slot - ((walked.length + (11 - r.val) : ℕ) : PAM M)) + (mZf393SelRight pre (11 - r.val) regs_tape))) + (mRootCfg pre (mBreakSlot 0 slot walked) (retStack walked) + (regs_tape.set r.val (regs_tape[r.val] + 1))) := by + set m := 11 - r.val + set base : PAM M := ((walked.length + m : ℕ) : PAM M) + have hbase3 : base + 3 ≤ slot := by + dsimp only [base, m] + simpa [Nat.cast_add] using hsl + set z := slot - (base + 3) + have hz_eq : slot - base = z + 3 := by + dsimp only [z] + have hle : base ≤ slot := le_trans (le_add_right_pam base 3) hbase3 + rw [sub_eq_iff_eq_add_pam hle] + calc slot + _ = (base + 3) + (slot - (base + 3)) := (add_sub_of_le_pam hbase3).symm + _ = base + (slot - (base + 3) + 3) := by ring + rw [hz_eq] + have hs₁ := @mInc_pass_to_61 M _ _ pre hpre r z regs_tape hregs + (mAppend (walked ++ List.replicate m 1).reverse mLB01) + have hscan_ones : ∀ n xs, scanZerosOk 0 (List.replicate n (1 : Fin 2) ++ xs) = + scanZerosOk 0 xs := by + intro n xs; induction n with + | zero => rfl + | succ n ih => exact ih + have hok_m : scanZerosOk 0 ((walked ++ List.replicate m 1).reverse ++ [1]) = true := by + rw [List.reverse_append, List.reverse_replicate, List.append_assoc, hscan_ones m] + exact hok + have hlen_m : ((walked ++ List.replicate m 1).length : PAM M) ≤ slot := by + rw [List.length_append, List.length_replicate] + exact le_trans (le_add_right_pam base 3) hbase3 + have hs₂ := @mBreak_k_reaches_main0 M _ _ pre 0 (by decide) slot + (walked ++ List.replicate m 1) hlen_m hok_m + (regs_tape.set r.val (regs_tape[r.val] + 1)) + have hsub_m : slot - ((walked ++ List.replicate m 1).length : PAM M) = z + 3 := by + rw [List.length_append, List.length_replicate]; exact hz_eq + have hpop : (popBreakRev 0 (walked ++ List.replicate m 1).reverse).reverse = retStack walked := by + rw [List.reverse_append, List.reverse_replicate, popBreakRev_replicate_one_append] + rfl + rw [hsub_m, hpop, mBreakSlot_append_ones] at hs₂ + exact mReachPos_trans hs₁ hs₂ + +theorem mDecnz_shift_right (rs : List (PAM M)) (L R : PAM M) : + mReachPos (mMk' 8 L (mAppendRegs rs (mCons 0 R))) + (mMk' 9 (mAppendRegsRev rs (mCons 0 L)) R) := by + induction rs generalizing L with + | nil => + exact mReachPos_step (mStep_mMk'_right (by rfl) L R) + | cons u rs ih => + rw [mAppendRegs_cons, mAppendRegsRev_cons] + set R_rs := mAppendRegs rs (mCons 0 R) + have h1 : mReach (mMk' 8 L (mEncodeReg u R_rs)) + (mMk' 8 (mRep1 (u + 1) (mCons 0 L)) R_rs) := by + unfold mEncodeReg + rw [mRep1_succ] + have ha1 := mStep_mMk'_right (q := 8) (q' := 7) (a := 1) (b := 0) (by rfl) L + (mRep1 u (mCons 0 R_rs)) + have hasc := mRightScan_reach (q := 7) (a := 1) (b := 1) (by rfl) u (mCons 0 L) + (mCons 0 R_rs) + rw [mRepBit_one_bit, mRepBit_one_bit] at hasc + have ha2 := mStep_mMk'_right (q := 7) (q' := 8) (a := 0) (b := 1) (by rfl) + (mRep1 u (mCons 0 L)) R_rs + rw [← mRep1_succ] at ha2 + exact mStep_mReach ha1 (mReach_trans hasc (mReachPos_to_mReach (mReachPos_step ha2))) + have hs₂ := ih (mRep1 (u + 1) (mCons 0 L)) + exact mReach_mReachPos h1 hs₂ + +theorem mDecnz_shift_left (rs : List (PAM M)) (L : PAM M) : + mReachPos (mMk' 11 L (mCons 0 (mRegsTape rs))) + (mMkL 23 (mAppendRegsRev rs L) 0) := by + induction rs generalizing L with + | nil => + have h1 := mStep_mMk'_right (q := 11) (q' := 12) (a := 0) (b := 1) (by rfl) L 0 + have h2 : mStep zf393 (mMk' 12 (mCons 1 L) 0) = some (mMkL 17 (mCons 1 L) 0) := by + simpa only [mCons_zero_zero] using + mStep_mMk'_left (q := 12) (q' := 17) (a := 0) (b := 0) (by rfl) (mCons 1 L) 0 + have h3 : mStep zf393 (mMkL 17 (mCons 1 L) 0) = some (mMkL 23 L 0) := by + simpa only [mCons_zero_zero] using + mStep_mMkL_left (q := 17) (q' := 23) (a := 1) (b := 0) (by rfl) L 0 + exact mStep_mReachPos h1 (mStep_mReach h2 (mReachPos_to_mReach (mReachPos_step h3))) + | cons u rs ih => + rw [mRegsTape_cons, mAppendRegsRev_cons] + unfold mEncodeReg mEncodeRegRev + rw [mRep1_succ] + set R_u := mCons 0 (mRegsTape rs) + have h1 := mStep_mMk'_right (q := 11) (q' := 12) (a := 0) (b := 1) (by rfl) L + (mCons 1 (mRep1 u R_u)) + have h2 := mStep_mMk'_right (q := 12) (q' := 9) (a := 1) (b := 1) (by rfl) (mCons 1 L) + (mRep1 u R_u) + have hscan := mRightScan_reach (q := 9) (a := 1) (b := 1) (by rfl) u + (mCons 1 (mCons 1 L)) R_u + rw [mRepBit_one_bit, mRepBit_one_bit, mRep1_inner_cons, mRep1_inner_cons] at hscan + have h3 : mStep zf393 (mMk' 9 (mCons 1 (mCons 1 (mRep1 u L))) R_u) = + some (mMkL 5 (mCons 1 (mCons 1 (mRep1 u L))) R_u) := by + dsimp only [R_u] + exact mStep_mMk'_left (by rfl) _ _ + have h4 := mStep_mMkL_left (q := 5) (q' := 10) (a := 1) (b := 1) (by rfl) + (mCons 1 (mRep1 u L)) R_u + have h5 := mStep_mMkL_right (q := 10) (q' := 11) (a := 1) (b := 1) (by rfl) + (mRep1 u L) (mCons 1 R_u) + have h6 := mStep_mMk'_right (q := 11) (q' := 11) (a := 1) (b := 0) (by rfl) + (mCons 1 (mRep1 u L)) R_u + conv at h6 => rhs; rw [← mRep1_succ] + have hrest := ih (mCons 0 (mRep1 (u + 1) L)) + exact mStep_mReachPos h1 (mStep_mReach h2 (mReach_trans hscan + (mStep_mReach h3 (mStep_mReach h4 (mStep_mReach h5 + (mStep_mReach h6 (mReachPos_to_mReach hrest))))))) + +theorem mDecnz_pass_to_break (r : Fin 11) (z : PAM M) (regs_tape : List (PAM M)) + (hregs : regs_tape.length = 11) (L : PAM M) : + (regs_tape[r.val] = 0 → + mReachPos + (mMk' 5 L (mRep0 (z + 3) (mZf393SelRight pre (11 - r.val) regs_tape))) + (mMkL 62 L (mRep0 (z + 4) (mAppendRegs pre (mRegsTape regs_tape))))) ∧ + (regs_tape[r.val] ≠ 0 → + mReachPos + (mMk' 5 L (mRep0 (z + 3) (mZf393SelRight pre (11 - r.val) regs_tape))) + (mMkL 61 L (mRep0 (z + 4) + (mAppendRegs pre (mRegsTape (regs_tape.set r.val (regs_tape[r.val] - 1))))))) := by + have hsub : 11 - (11 - r.val) = r.val := by omega + set rs_pre := pre ++ regs_tape.take r.val + set R_after := mRegsTape (regs_tape.drop r.val) + have hsel_eq : mZf393SelRight pre (11 - r.val) regs_tape = + mAppendRegs rs_pre (mCons 0 R_after) := by + unfold mZf393SelRight; rw [hsub] + have hz3 : mRep0 (z + 3) (mZf393SelRight pre (11 - r.val) regs_tape) = + mCons 0 (mRep0 (z + 2) (mAppendRegs rs_pre (mCons 0 R_after))) := by + rw [hsel_eq, show z + 3 = (z + 2) + 1 by ring, mRep0_succ] + have hs1 : mStep zf393 (mMk' 5 L (mRep0 (z + 3) (mZf393SelRight pre (11 - r.val) regs_tape))) = + some (mMk' 6 (mCons 1 L) (mRep0 (z + 2) (mAppendRegs rs_pre (mCons 0 R_after)))) := by + rw [hz3] + exact mStep_mMk'_right (by rfl) L _ + have hscan0 := mRightScan_reach (q := 6) (a := 0) (b := 0) (by rfl) (z + 2) (mCons 1 L) + (mAppendRegs rs_pre (mCons 0 R_after)) + rw [mRepBit_zero_bit, mRepBit_zero_bit] at hscan0 + set L_z := mRep0 (z + 2) (mCons 1 L) + have hrs_ne : rs_pre ≠ [] := by simp [rs_pre, hpre.out] + obtain ⟨u₀, rs_rest, hpre_cons⟩ : ∃ u₀ rs_rest, rs_pre = u₀ :: rs_rest := by + rcases h : rs_pre with _ | ⟨u₀, rs_rest⟩ + · exact absurd h hrs_ne + · exact ⟨u₀, rs_rest, rfl⟩ + have h6_shift : mReachPos + (mMk' 6 L_z (mAppendRegs rs_pre (mCons 0 R_after))) + (mMk' 9 (mAppendRegsRev rs_pre (mCons 0 L_z)) R_after) := by + rw [hpre_cons, mAppendRegs_cons, mAppendRegsRev_cons] + set R_u0 := mAppendRegs rs_rest (mCons 0 R_after) + have hfirst : mReach (mMk' 6 L_z (mEncodeReg u₀ R_u0)) + (mMk' 8 (mRep1 (u₀ + 1) (mCons 0 L_z)) R_u0) := by + unfold mEncodeReg + rw [mRep1_succ] + have ha1 := mStep_mMk'_right (q := 6) (q' := 7) (a := 1) (b := 0) (by rfl) L_z + (mRep1 u₀ (mCons 0 R_u0)) + have hasc := mRightScan_reach (q := 7) (a := 1) (b := 1) (by rfl) u₀ (mCons 0 L_z) + (mCons 0 R_u0) + rw [mRepBit_one_bit, mRepBit_one_bit] at hasc + have ha2 := mStep_mMk'_right (q := 7) (q' := 8) (a := 0) (b := 1) (by rfl) + (mRep1 u₀ (mCons 0 L_z)) R_u0 + rw [← mRep1_succ] at ha2 + exact mStep_mReach ha1 (mReach_trans hasc (mReachPos_to_mReach (mReachPos_step ha2))) + exact mReach_mReachPos hfirst + (mDecnz_shift_right rs_rest (mRep1 (u₀ + 1) (mCons 0 L_z)) R_after) + set L_pre := mAppendRegsRev rs_pre (mCons 0 L_z) + have hdrop : regs_tape.drop r.val = regs_tape[r.val] :: regs_tape.drop (r.val + 1) := + (List.getElem_cons_drop (by omega)).symm + set v := regs_tape[r.val] + set rs_tail := regs_tape.drop (r.val + 1) + have hR_after : R_after = mRep1 (v + 1) (mCons 0 (mRegsTape rs_tail)) := by + dsimp only [R_after, v, rs_tail] + rw [hdrop, mRegsTape_cons] + rfl + set R_t0 := mCons 0 (mRegsTape rs_tail) + have hscan_v := mRightScan_reach (q := 9) (a := 1) (b := 1) (by rfl) (v + 1) L_pre R_t0 + rw [mRepBit_one_bit, mRepBit_one_bit, ← hR_after] at hscan_v + have he0 : mStep zf393 (mMk' 9 (mRep1 (v + 1) L_pre) R_t0) = + some (mMkL 5 (mRep1 (v + 1) L_pre) R_t0) := by + dsimp only [R_t0] + exact mStep_mMk'_left (by rfl) _ _ + have hd1 : mStep zf393 (mMkL 5 (mRep1 (v + 1) L_pre) R_t0) = + some (mMkL 10 (mRep1 v L_pre) (mCons 1 R_t0)) := by + rw [mRep1_succ] + exact mStep_mMkL_left (by rfl) _ _ + have hL_z_cons : mCons 0 L_z = mRep0 ((z + 1) + 2) (mCons 1 L) := by + dsimp only [L_z] + rw [← mRep0_succ] + exact congrArg (fun x ↦ mRep0 x (mCons 1 L)) (by ring) + have hz4 : (z + 1) + 3 = z + 4 := by ring + rcases eq_zero_or_exists_succ v with hv | ⟨v', hv⟩ + · refine ⟨fun _ ↦ ?_, fun hne ↦ absurd hv hne⟩ + rw [hv] at hscan_v he0 hd1 + rw [mRep1_zero] at hd1 + obtain ⟨rs_init, u_last, hpre_snoc⟩ : ∃ rs_init u_last, rs_pre = rs_init ++ [u_last] := by + rcases rs_pre.eq_nil_or_concat with hnil | ⟨rs_init, u_last, hcat⟩ + · exact absurd hnil hrs_ne + · exact ⟨rs_init, u_last, by rw [hcat, List.concat_eq_append]⟩ + have hL_pre_0 : + L_pre = mCons 0 (mRep1 (u_last + 1) (mAppendRegsRev rs_init (mCons 0 L_z))) := by + dsimp only [L_pre] + rw [hpre_snoc, mAppendRegsRev_snoc] + rfl + have hg0 : mStep zf393 (mMkL 10 L_pre (mCons 1 R_t0)) = + some (mMkL 26 (mRep1 (u_last + 1) (mAppendRegsRev rs_init (mCons 0 L_z))) + (mCons 0 (mCons 1 R_t0))) := by + rw [hL_pre_0] + exact mStep_mMkL_left (by rfl) _ _ + have hscan_last := mLeftScan_reach (q := 26) (a := 1) (b := 1) (by rfl) (u_last + 1) + (mAppendRegsRev rs_init (mCons 0 L_z)) (mCons 0 (mCons 1 R_t0)) + rw [mRepBit_one_bit, mRepBit_one_bit] at hscan_last + conv at hscan_last => arg 2; rw [hL_z_cons] + have hret := mRet2_finish rs_init (z + 1) L (mRep1 (u_last + 1) (mCons 0 (mCons 1 R_t0))) + have hR_eq : mAppendRegs rs_init (mRep1 (u_last + 1) (mCons 0 (mCons 1 R_t0))) = + mAppendRegs pre (mRegsTape regs_tape) := by + have henc0 : mCons 1 R_t0 = mRegsTape (0 :: rs_tail) := by + unfold R_t0 mRegsTape + rw [mAppendRegs_cons, mEncodeReg, mRep1_succ, mRep1_zero] + have henc_u : mRep1 (u_last + 1) (mCons 0 (mRegsTape (0 :: rs_tail))) = + mAppendRegs [u_last] (mRegsTape (0 :: rs_tail)) := by + simp [mEncodeReg] + have hr_list : rs_init ++ [u_last] ++ (0 :: rs_tail) = pre ++ regs_tape := by + rw [← hpre_snoc, ← hv, ← hdrop] + dsimp only [rs_pre, v, rs_tail] + rw [List.append_assoc, List.take_append_drop] + rw [henc0, henc_u, ← mAppendRegs_append, ← mRegsTape_append, hr_list, mRegsTape_append] + rw [hz4, hR_eq] at hret + exact mStep_mReachPos hs1 (mReach_trans hscan0 + (mReach_trans (mReachPos_to_mReach h6_shift) + (mReach_trans hscan_v (mStep_mReach he0 (mStep_mReach hd1 + (mStep_mReach hg0 (mReach_trans hscan_last (mReachPos_to_mReach hret)))))))) + · refine ⟨fun h0 ↦ absurd (hv.symm.trans h0) (add_one_ne_zero v'), fun _ ↦ ?_⟩ + rw [hv] at hscan_v he0 hd1 + conv at hd1 => rhs; rw [mRep1_succ] + have hg1 : mStep zf393 (mMkL 10 (mCons 1 (mRep1 v' L_pre)) (mCons 1 R_t0)) = + some (mMk' 11 (mCons 1 (mRep1 v' L_pre)) (mCons 1 R_t0)) := + mStep_mMkL_right (by rfl) _ _ + have hh1 : mStep zf393 (mMk' 11 (mCons 1 (mRep1 v' L_pre)) (mCons 1 R_t0)) = + some (mMk' 11 (mEncodeRegRev v' L_pre) R_t0) := by + have h := mStep_mMk'_right (q := 11) (q' := 11) (a := 1) (b := 0) (by rfl) + (mCons 1 (mRep1 v' L_pre)) R_t0 + have henc : mCons 0 (mCons 1 (mRep1 v' L_pre)) = mEncodeRegRev v' L_pre := by + simp [mEncodeRegRev, mRep1_succ] + rwa [henc] at h + have hleft := mDecnz_shift_left rs_tail (mEncodeRegRev v' L_pre) + have hL_all : mAppendRegsRev rs_tail (mEncodeRegRev v' L_pre) = + mAppendRegsRev (rs_pre ++ [v'] ++ rs_tail) (mRep0 ((z + 1) + 2) (mCons 1 L)) := by + change mAppendRegsRev rs_tail + (mEncodeRegRev v' (mAppendRegsRev rs_pre (mCons 0 L_z))) = _ + rw [← mAppendRegsRev_snoc, ← mAppendRegsRev_append, hL_z_cons] + rw [hL_all] at hleft + have hret := mRet1_finish (rs_pre ++ [v'] ++ rs_tail) (z + 1) L 0 + have hv_sub : regs_tape[r.val] - 1 = v' := by + change v - 1 = v' + rw [hv, add_sub_cancel_right_pam] + have htake_set_drop : ∀ (xs : List (PAM M)) (i : ℕ) (w : PAM M), + i < xs.length → xs.take i ++ (w :: xs.drop (i + 1)) = xs.set i w := by + intro xs i w hi + induction xs generalizing i with + | nil => simp at hi + | cons x xs ih => + cases i with + | zero => rfl + | succ i => simp [ih i (by simpa using hi)] + have hR_eq : mAppendRegs (rs_pre ++ [v'] ++ rs_tail) 0 = + mAppendRegs pre (mRegsTape (regs_tape.set r.val (regs_tape[r.val] - 1))) := by + rw [hv_sub] + change mRegsTape (rs_pre ++ [v'] ++ rs_tail) = _ + have hr_eq : rs_pre ++ [v'] ++ rs_tail = pre ++ regs_tape.set r.val v' := by + simp only [rs_pre, rs_tail, List.append_assoc, List.singleton_append] + rw [htake_set_drop regs_tape r.val v' (by omega)] + rw [hr_eq, mRegsTape_append] + rw [hz4, hR_eq] at hret + exact mStep_mReachPos hs1 (mReach_trans hscan0 + (mReach_trans (mReachPos_to_mReach h6_shift) + (mReach_trans hscan_v (mStep_mReach he0 (mStep_mReach hd1 + (mStep_mReach hg1 (mStep_mReach hh1 + (mReachPos_to_mReach (mReachPos_trans hleft hret))))))))) + +theorem mDecnz_step_reaches_main0 (r : Fin 11) (slot : PAM M) (walked : List (Fin 2)) + (hsl : ((walked.length + (11 - r.val) + 3 : ℕ) : PAM M) ≤ slot) + (hok : scanZerosOk 0 (walked.reverse ++ [1]) = true) + (regs_tape : List (PAM M)) (hregs : regs_tape.length = 11) : + (regs_tape[r.val] = 0 → + mReachPos + (mMk' 5 (mAppend (walked ++ List.replicate (11 - r.val) 1).reverse mLB01) + (mRep0 (slot - ((walked.length + (11 - r.val) : ℕ) : PAM M)) + (mZf393SelRight pre (11 - r.val) regs_tape))) + (mRootCfg pre (mBreakSlot 1 (slot + 1) walked) + ((popBreakRev 1 walked.reverse).reverse) regs_tape)) ∧ + (regs_tape[r.val] ≠ 0 → + mReachPos + (mMk' 5 (mAppend (walked ++ List.replicate (11 - r.val) 1).reverse mLB01) + (mRep0 (slot - ((walked.length + (11 - r.val) : ℕ) : PAM M)) + (mZf393SelRight pre (11 - r.val) regs_tape))) + (mRootCfg pre (mBreakSlot 0 (slot + 1) walked) (retStack walked) + (regs_tape.set r.val (regs_tape[r.val] - 1)))) := by + set m := 11 - r.val + set base : PAM M := ((walked.length + m : ℕ) : PAM M) + have hbase3 : base + 3 ≤ slot := by + dsimp only [base, m] + simpa [Nat.cast_add] using hsl + have hle : base ≤ slot := le_trans (le_add_right_pam base 3) hbase3 + set z := slot - (base + 3) + have hz_eq : slot - base = z + 3 := by + dsimp only [z] + rw [sub_eq_iff_eq_add_pam hle] + calc slot + _ = (base + 3) + (slot - (base + 3)) := (add_sub_of_le_pam hbase3).symm + _ = base + (slot - (base + 3) + 3) := by ring + rw [hz_eq] + have hs₁ := @mDecnz_pass_to_break M _ _ pre hpre r z regs_tape hregs + (mAppend (walked ++ List.replicate m 1).reverse mLB01) + have hscan_ones : ∀ n xs, scanZerosOk 0 (List.replicate n (1 : Fin 2) ++ xs) = + scanZerosOk 0 xs := by + intro n xs; induction n with + | zero => rfl + | succ n ih => exact ih + have hok_m : scanZerosOk 0 ((walked ++ List.replicate m 1).reverse ++ [1]) = true := by + rw [List.reverse_append, List.reverse_replicate, List.append_assoc, hscan_ones m] + exact hok + have hlen_m : ((walked ++ List.replicate m 1).length : PAM M) ≤ slot + 1 := by + rw [List.length_append, List.length_replicate] + exact le_trans hle (le_add_right_pam slot 1) + have hsub_m : (slot + 1) - ((walked ++ List.replicate m 1).length : PAM M) = z + 4 := by + rw [List.length_append, List.length_replicate] + change (slot + 1) - base = z + 4 + rw [add_one_sub_of_le_pam hle, hz_eq] + ring + refine ⟨fun hv0 ↦ ?_, fun hvne ↦ ?_⟩ + · have hs₂ := @mBreak_k_reaches_main0 M _ _ pre 1 (by decide) (slot + 1) + (walked ++ List.replicate m 1) hlen_m hok_m regs_tape + have hpop : (popBreakRev 1 (walked ++ List.replicate m 1).reverse).reverse = + (popBreakRev 1 walked.reverse).reverse := by + rw [List.reverse_append, List.reverse_replicate, popBreakRev_replicate_one_append] + rw [hsub_m, hpop, mBreakSlot_append_ones] at hs₂ + exact mReachPos_trans (hs₁.1 hv0) hs₂ + · have hs₂ := @mBreak_k_reaches_main0 M _ _ pre 0 (by decide) (slot + 1) + (walked ++ List.replicate m 1) hlen_m hok_m + (regs_tape.set r.val (regs_tape[r.val] - 1)) + have hpop : (popBreakRev 0 (walked ++ List.replicate m 1).reverse).reverse = + retStack walked := by + rw [List.reverse_append, List.reverse_replicate, popBreakRev_replicate_one_append] + rfl + rw [hsub_m, hpop, mBreakSlot_append_ones] at hs₂ + exact mReachPos_trans (hs₁.2 hvne) hs₂ + +omit hpre in +theorem mStage3_walk_ones_inc (r : Fin 11) (j : ℕ) (hj : r.val + j ≤ 10) (L R : PAM M) : + mReach (mMk' (regIncStage3 r) L (mAppend (List.replicate j 1) R)) + (mMk' (regIncStage3 ⟨r.val + j, by omega⟩) (mAppend (List.replicate j 1) L) R) := by + induction j generalizing r L with + | zero => + simp only [Nat.add_zero, Fin.eta, List.replicate_zero, mAppend_nil] + exact mReach_refl _ + | succ j ih => + have htr1 : zf393Trans (regIncStage3 r) 1 = + some (1, .right, regIncStage3 ⟨r.val + 1, by omega⟩) := + regIncStage3_step1 ⟨r.val, by omega⟩ + rw [List.replicate_succ, mAppend_cons] + have hs1 := mStep_mMk'_right htr1 L (mAppend (List.replicate j 1) R) + have hj' : (⟨r.val + 1, by omega⟩ : Fin 11).val + j ≤ 10 := by dsimp; omega + have hrest := ih ⟨r.val + 1, by omega⟩ hj' (mCons 1 L) + have hidx : (⟨(⟨r.val + 1, by omega⟩ : Fin 11).val + j, by omega⟩ : Fin 11) = + ⟨r.val + (j + 1), by omega⟩ := by + ext; dsimp; omega + have hL : mAppend (List.replicate j 1) (mCons 1 L) = + mCons 1 (mAppend (List.replicate j 1) L) := by + rw [mAppend_replicate_one, mAppend_replicate_one, mRep1_inner_cons] + rw [hL, hidx] at hrest + exact mStep_mReach hs1 hrest + +omit hpre in +theorem mStage3_walk_ones_decnz (r : Fin 11) (j : ℕ) (hj : r.val + j ≤ 10) (L R : PAM M) : + mReach (mMk' (regDecnzStage3 r) L (mAppend (List.replicate j 1) R)) + (mMk' (regDecnzStage3 ⟨r.val + j, by omega⟩) (mAppend (List.replicate j 1) L) R) := by + induction j generalizing r L with + | zero => + simp only [Nat.add_zero, Fin.eta, List.replicate_zero, mAppend_nil] + exact mReach_refl _ + | succ j ih => + have htr1 : zf393Trans (regDecnzStage3 r) 1 = + some (1, .right, regDecnzStage3 ⟨r.val + 1, by omega⟩) := + regDecnzStage3_step1 ⟨r.val, by omega⟩ + rw [List.replicate_succ, mAppend_cons] + have hs1 := mStep_mMk'_right htr1 L (mAppend (List.replicate j 1) R) + have hj' : (⟨r.val + 1, by omega⟩ : Fin 11).val + j ≤ 10 := by dsimp; omega + have hrest := ih ⟨r.val + 1, by omega⟩ hj' (mCons 1 L) + have hidx : (⟨(⟨r.val + 1, by omega⟩ : Fin 11).val + j, by omega⟩ : Fin 11) = + ⟨r.val + (j + 1), by omega⟩ := by + ext; dsimp; omega + have hL : mAppend (List.replicate j 1) (mCons 1 L) = + mCons 1 (mAppend (List.replicate j 1) L) := by + rw [mAppend_replicate_one, mAppend_replicate_one, mRep1_inner_cons] + rw [hL, hidx] at hrest + exact mStep_mReach hs1 hrest + +/-! ## Section 6: Decision-Tree Dispatcher & `mTm_simulates_evalStack` -/ + +/-- Tree-walk configuration in `MCfg 393 M`. -/ +noncomputable def mTreeWalkCfg (q : Fin 393) (walked rem : List (Fin 2)) + (L₀ R_tail : PAM M) : MCfg 393 M := + mMk' q (mAppend walked.reverse L₀) (mAppend rem R_tail) + +omit hpre in +theorem mWalkTape_sound (q : Fin 393) (walked rem : List (Fin 2)) (L₀ R_tail : PAM M) : + match walkTape q walked rem with + | .halt q_h walked_h rem_h => + mReach (mTreeWalkCfg q walked rem L₀ R_tail) (mTreeWalkCfg q_h walked_h rem_h L₀ R_tail) ∧ + mStep zf393 (mTreeWalkCfg q_h walked_h rem_h L₀ R_tail) = none + | .jumpLeft q' walked_j rem' => + (∃ b, walked_j ++ (b :: rem') = walked ++ rem) ∧ + mReachPos (mTreeWalkCfg q walked rem L₀ R_tail) + (mMkL q' (mAppend walked_j.reverse L₀) (mAppend (0 :: rem') R_tail)) + | .regLeaf q' walked_l rem' => + walked_l ++ rem' = walked ++ rem ∧ + mReachPos (mTreeWalkCfg q walked rem L₀ R_tail) (mTreeWalkCfg q' walked_l rem' L₀ R_tail) + | .outOfFuel => True := by + induction rem generalizing q walked with + | nil => trivial + | cons b rem' ih => + simp only [walkTape] + rcases htr : zf393Trans q b with _ | ⟨w, d, q'⟩ + · refine ⟨mReach_refl _, ?_⟩ + exact mStep_mMk'_none htr (mAppend walked.reverse L₀) (mAppend rem' R_tail) + · cases d with + | left => + by_cases hw : (w == 0) = true + · simp only [hw, ↓reduceIte] + have hw0 : w = 0 := beq_iff_eq.mp hw + subst hw0 + refine ⟨⟨b, rfl⟩, ?_⟩ + exact mReachPos_step + (mStep_mMk'_left htr (mAppend walked.reverse L₀) (mAppend rem' R_tail)) + · simp only [hw, Bool.false_eq_true, ↓reduceIte] + | right => + by_cases hw : (w == b) = true + · simp only [hw, ↓reduceIte] + have hwb : w = b := beq_iff_eq.mp hw + subst hwb + have hstep1 : mStep zf393 (mTreeWalkCfg q walked (w :: rem') L₀ R_tail) = + some (mTreeWalkCfg q' (walked ++ [w]) rem' L₀ R_tail) := by + unfold mTreeWalkCfg + rw [mAppend_cons, mStep_mMk'_right htr, mAppend_reverse_cons] + by_cases hleaf : isLeafState q' = true + · simp only [hleaf, ↓reduceIte] + exact ⟨by simp, mReachPos_step hstep1⟩ + · simp only [hleaf, Bool.false_eq_true, ↓reduceIte] + have hrec := ih q' (walked ++ [w]) + rcases hout : walkTape q' (walked ++ [w]) rem' with + ⟨q_h, w_h, r_h⟩ | ⟨q_j, w_j, r_j⟩ | ⟨q_l, w_l, r_l⟩ | _ + · rw [hout] at hrec + exact ⟨mStep_mReach hstep1 hrec.1, hrec.2⟩ + · rw [hout] at hrec + obtain ⟨⟨b', heq⟩, hs⟩ := hrec + exact ⟨⟨b', by simpa using heq⟩, mStep_mReachPos hstep1 (mReachPos_to_mReach hs)⟩ + · rw [hout] at hrec + obtain ⟨heq, hs⟩ := hrec + exact ⟨by simpa using heq, mStep_mReachPos hstep1 (mReachPos_to_mReach hs)⟩ + · trivial + · simp only [hw, Bool.false_eq_true, ↓reduceIte] + +theorem mInc_leaf_reaches_main0 (r : Fin 11) (slot : PAM M) (walked : List (Fin 2)) + (hwalk : walkTape 99 [] walked = .regLeaf (regIncStage3 r) walked []) + (hsl : ((walked.length + (11 - r.val) + 3 : ℕ) : PAM M) ≤ slot) + (hok : scanZerosOk 0 (walked.reverse ++ [1]) = true) + (regs_tape : List (PAM M)) (hregs : regs_tape.length = 11) : + mReachPos + (mMk' 99 mLB01 + (mAppend walked (mRep0 (slot - (walked.length : PAM M)) + (mAppendRegs pre (mRegsTape regs_tape))))) + (mRootCfg pre (mBreakSlot 0 slot walked) (retStack walked) + (regs_tape.set r.val (regs_tape[r.val] + 1))) := by + have walk_exact : ∀ (R_rem : PAM M), + mReachPos + (mMk' 99 mLB01 (mAppend walked R_rem)) + (mMk' (regIncStage3 r) (mAppend walked.reverse mLB01) R_rem) := by + intro R_rem + have hws := mWalkTape_sound 99 [] walked mLB01 R_rem + rw [hwalk] at hws + simpa [mTreeWalkCfg] using hws.2 + have loop : ∀ m k : ℕ, m + k = 11 - r.val → + mReachPos + (mMk' 99 mLB01 + (mAppend walked + (mAppend (List.replicate m 1) + (mRep0 (slot - ((walked.length + m : ℕ) : PAM M)) + (mZf393SelRight pre m regs_tape))))) + (mRootCfg pre (mBreakSlot 0 slot walked) (retStack walked) + (regs_tape.set r.val (regs_tape[r.val] + 1))) := by + intro m k hmk + induction k generalizing m with + | zero => + have hm_eq : m = 11 - r.val := by omega + subst hm_eq + have hrep_split : List.replicate (11 - r.val) (1 : Fin 2) = + List.replicate (10 - r.val) 1 ++ [1] := by + have h11 : 11 - r.val = (10 - r.val) + 1 := by omega + rw [h11, List.replicate_succ'] + rw [hrep_split, mAppend_append] + set R_sel := mRep0 (slot - ((walked.length + (11 - r.val) : ℕ) : PAM M)) + (mZf393SelRight pre (11 - r.val) regs_tape) + have hsw := walk_exact (mAppend (List.replicate (10 - r.val) 1) (mAppend [1] R_sel)) + have hones := mStage3_walk_ones_inc r (10 - r.val) (by omega) + (mAppend walked.reverse mLB01) (mAppend [1] R_sel) + have hr10 : (⟨r.val + (10 - r.val), by omega⟩ : Fin 11) = 10 := by ext; dsimp; omega + rw [hr10] at hones + have hs10 : mStep zf393 + (mMk' (regIncStage3 10) + (mAppend (List.replicate (10 - r.val) 1) (mAppend walked.reverse mLB01)) + (mAppend [1] R_sel)) = + some (mMk' 13 + (mAppend (walked ++ List.replicate (11 - r.val) 1).reverse mLB01) R_sel) := by + have h := mStep_mMk'_right (q := regIncStage3 10) (q' := 13) (a := 1) (b := 1) (by rfl) + (mAppend (List.replicate (10 - r.val) 1) (mAppend walked.reverse mLB01)) R_sel + have hL_eq : mCons 1 (mAppend (List.replicate (10 - r.val) 1) + (mAppend walked.reverse (mLB01 : PAM M))) = + mAppend (walked ++ List.replicate (11 - r.val) 1).reverse (mLB01 : PAM M) := by + rw [hrep_split, List.reverse_append, List.reverse_append, List.reverse_replicate, + mAppend_append, mAppend_append] + rfl + rwa [hL_eq] at h + have hinc := @mInc_step_reaches_main0 M _ _ pre hpre r slot walked hsl hok regs_tape hregs + exact mReachPos_trans (mReachPos_mReach hsw hones) + (mStep_mReachPos hs10 (mReachPos_to_mReach hinc)) + | succ k' ih => + have hrm : r.val + m < 11 := by omega + have hsl_m : ((walked.length + m + 4 : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (by omega)) hsl + have hlt_slot : ((walked.length + m : ℕ) : PAM M) < slot := + lt_of_lt_of_le (by + have : walked.length + m < walked.length + m + 4 := by omega + exact natCast_lt_iff.mpr this) hsl_m + set R_m := mZf393SelRight pre m regs_tape + have hsw := walk_exact + (mAppend (List.replicate m 1) + (mRep0 (slot - ((walked.length + m : ℕ) : PAM M)) R_m)) + have hones := mStage3_walk_ones_inc r m (by omega) + (mAppend walked.reverse mLB01) + (mRep0 (slot - ((walked.length + m : ℕ) : PAM M)) R_m) + have hsub_z : slot - ((walked.length + m : ℕ) : PAM M) = + (slot - ((walked.length + m + 1 : ℕ) : PAM M)) + 1 := by + simpa [Nat.cast_add] using sub_add_one_of_lt_pam hlt_slot + rw [hsub_z, mRep0_succ] at hsw hones ⊢ + have htr0 : zf393Trans (regIncStage3 ⟨r.val + m, hrm⟩) 0 = some (0, .right, 17) := + regIncStage3_step0 ⟨r.val + m, hrm⟩ + have hs0 : mStep zf393 + (mMk' (regIncStage3 ⟨r.val + m, hrm⟩) + (mAppend (List.replicate m 1) (mAppend walked.reverse mLB01)) + (mCons 0 (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) R_m))) = + some (mMk' 17 (mAppend (walked ++ List.replicate m 1 ++ [0]).reverse mLB01) + (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) R_m)) := by + have h := mStep_mMk'_right htr0 + (mAppend (List.replicate m 1) (mAppend walked.reverse mLB01)) + (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) R_m) + have hL_eq : mCons 0 (mAppend (List.replicate m 1) + (mAppend walked.reverse (mLB01 : PAM M))) = + mAppend (walked ++ List.replicate m 1 ++ [0]).reverse (mLB01 : PAM M) := by + simp [List.reverse_append, mAppend_append] + rwa [hL_eq] at h + have hsel := @mSel_step_reaches_main0 M _ _ pre hpre m (by omega) slot walked + hsl_m hok regs_tape hregs + have hrest := ih (m + 1) (by omega) + rw [mAppend_append] at hsel + have hadd_assoc : walked.length + (m + 1) = walked.length + m + 1 := by omega + rw [hadd_assoc] at hrest + exact mReachPos_trans (mReachPos_mReach hsw hones) + (mStep_mReachPos hs0 (mReachPos_to_mReach (mReachPos_trans hsel hrest))) + have hs := loop 0 (11 - r.val) (Nat.zero_add _) + simpa only [List.replicate_zero, Nat.add_zero, mZf393SelRight_zero pre regs_tape hregs, + mAppend_nil] using hs + +theorem mDecnz_leaf_reaches_main0 (r : Fin 11) (slot : PAM M) (walked : List (Fin 2)) + (hwalk : walkTape 99 [] walked = .regLeaf (regDecnzStage3 r) walked []) + (hsl : ((walked.length + (11 - r.val) + 3 : ℕ) : PAM M) ≤ slot) + (hok : scanZerosOk 0 (walked.reverse ++ [1]) = true) + (regs_tape : List (PAM M)) (hregs : regs_tape.length = 11) : + (regs_tape[r.val] = 0 → + mReachPos + (mMk' 99 mLB01 + (mAppend walked (mRep0 (slot - (walked.length : PAM M)) + (mAppendRegs pre (mRegsTape regs_tape))))) + (mRootCfg pre (mBreakSlot 1 (slot + 1) walked) + ((popBreakRev 1 walked.reverse).reverse) regs_tape)) ∧ + (regs_tape[r.val] ≠ 0 → + mReachPos + (mMk' 99 mLB01 + (mAppend walked (mRep0 (slot - (walked.length : PAM M)) + (mAppendRegs pre (mRegsTape regs_tape))))) + (mRootCfg pre (mBreakSlot 0 (slot + 1) walked) (retStack walked) + (regs_tape.set r.val (regs_tape[r.val] - 1)))) := by + have walk_exact : ∀ (R_rem : PAM M), + mReachPos + (mMk' 99 mLB01 (mAppend walked R_rem)) + (mMk' (regDecnzStage3 r) (mAppend walked.reverse mLB01) R_rem) := by + intro R_rem + have hws := mWalkTape_sound 99 [] walked mLB01 R_rem + rw [hwalk] at hws + simpa [mTreeWalkCfg] using hws.2 + have sel_passes : ∀ m k : ℕ, m + k = 11 - r.val → + mReach + (mMk' 99 mLB01 + (mAppend walked + (mAppend (List.replicate m 1) + (mRep0 (slot - ((walked.length + m : ℕ) : PAM M)) + (mZf393SelRight pre m regs_tape))))) + (mMk' 99 mLB01 + (mAppend walked + (mAppend (List.replicate (11 - r.val) 1) + (mRep0 (slot - ((walked.length + (11 - r.val) : ℕ) : PAM M)) + (mZf393SelRight pre (11 - r.val) regs_tape))))) := by + intro m k hmk + induction k generalizing m with + | zero => + have hm_eq : m = 11 - r.val := by omega + subst hm_eq + exact mReach_refl _ + | succ k' ih => + have hrm : r.val + m < 11 := by omega + have hsl_m : ((walked.length + m + 4 : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (by omega)) hsl + have hlt_slot : ((walked.length + m : ℕ) : PAM M) < slot := + lt_of_lt_of_le (by + have : walked.length + m < walked.length + m + 4 := by omega + exact natCast_lt_iff.mpr this) hsl_m + set R_m := mZf393SelRight pre m regs_tape + have hsw := walk_exact + (mAppend (List.replicate m 1) + (mRep0 (slot - ((walked.length + m : ℕ) : PAM M)) R_m)) + have hones := mStage3_walk_ones_decnz r m (by omega) + (mAppend walked.reverse mLB01) + (mRep0 (slot - ((walked.length + m : ℕ) : PAM M)) R_m) + have hsub_z : slot - ((walked.length + m : ℕ) : PAM M) = + (slot - ((walked.length + m + 1 : ℕ) : PAM M)) + 1 := by + simpa [Nat.cast_add] using sub_add_one_of_lt_pam hlt_slot + rw [hsub_z, mRep0_succ] at hsw hones + have htr0 : zf393Trans (regDecnzStage3 ⟨r.val + m, hrm⟩) 0 = some (0, .right, 17) := + regDecnzStage3_step0 ⟨r.val + m, hrm⟩ + have hs0 : mStep zf393 + (mMk' (regDecnzStage3 ⟨r.val + m, hrm⟩) + (mAppend (List.replicate m 1) (mAppend walked.reverse mLB01)) + (mCons 0 (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) R_m))) = + some (mMk' 17 (mAppend (walked ++ List.replicate m 1 ++ [0]).reverse mLB01) + (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) R_m)) := by + have h := mStep_mMk'_right htr0 + (mAppend (List.replicate m 1) (mAppend walked.reverse mLB01)) + (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) R_m) + have hL_eq : mCons 0 (mAppend (List.replicate m 1) + (mAppend walked.reverse (mLB01 : PAM M))) = + mAppend (walked ++ List.replicate m 1 ++ [0]).reverse (mLB01 : PAM M) := by + simp [List.reverse_append, mAppend_append] + rwa [hL_eq] at h + have hsel := @mSel_step_reaches_main0 M _ _ pre hpre m (by omega) slot walked + hsl_m hok regs_tape hregs + have hrest := ih (m + 1) (by omega) + rw [mAppend_append] at hsel + have hadd_assoc : walked.length + (m + 1) = walked.length + m + 1 := by omega + rw [hadd_assoc] at hrest + have hfirst : mReach + (mMk' 99 mLB01 + (mAppend walked + (mAppend (List.replicate m 1) + (mRep0 (slot - ((walked.length + m : ℕ) : PAM M)) R_m)))) + (mMk' 99 mLB01 + (mAppend walked + (mAppend (List.replicate (m + 1) 1) + (mRep0 (slot - ((walked.length + m + 1 : ℕ) : PAM M)) + (mZf393SelRight pre (m + 1) regs_tape))))) := by + rw [hsub_z, mRep0_succ] + exact mReachPos_to_mReach (mReachPos_trans (mReachPos_mReach hsw hones) + (mStep_mReachPos hs0 (mReachPos_to_mReach hsel))) + exact mReach_trans hfirst hrest + have hpasses0 := sel_passes 0 (11 - r.val) (Nat.zero_add _) + simp only [List.replicate_zero, Nat.add_zero, mZf393SelRight_zero pre regs_tape hregs, + mAppend_nil] at hpasses0 + have hrep_split : List.replicate (11 - r.val) (1 : Fin 2) = + List.replicate (10 - r.val) 1 ++ [1] := by + have h11 : 11 - r.val = (10 - r.val) + 1 := by omega + rw [h11, List.replicate_succ'] + set R_sel := mRep0 (slot - ((walked.length + (11 - r.val) : ℕ) : PAM M)) + (mZf393SelRight pre (11 - r.val) regs_tape) + have hsw := walk_exact (mAppend (List.replicate (10 - r.val) 1) (mAppend [1] R_sel)) + have hones := mStage3_walk_ones_decnz r (10 - r.val) (by omega) + (mAppend walked.reverse mLB01) (mAppend [1] R_sel) + have hr10 : (⟨r.val + (10 - r.val), by omega⟩ : Fin 11) = 10 := by ext; dsimp; omega + rw [hr10] at hones + have hs10 : mStep zf393 + (mMk' (regDecnzStage3 10) + (mAppend (List.replicate (10 - r.val) 1) (mAppend walked.reverse mLB01)) + (mAppend [1] R_sel)) = + some (mMk' 5 + (mAppend (walked ++ List.replicate (11 - r.val) 1).reverse mLB01) R_sel) := by + have h := mStep_mMk'_right (q := regDecnzStage3 10) (q' := 5) (a := 1) (b := 1) (by rfl) + (mAppend (List.replicate (10 - r.val) 1) (mAppend walked.reverse mLB01)) R_sel + have hL_eq : mCons 1 (mAppend (List.replicate (10 - r.val) 1) + (mAppend walked.reverse (mLB01 : PAM M))) = + mAppend (walked ++ List.replicate (11 - r.val) 1).reverse (mLB01 : PAM M) := by + rw [hrep_split, List.reverse_append, List.reverse_append, List.reverse_replicate, + mAppend_append, mAppend_append] + rfl + rwa [hL_eq] at h + have hto5 : mReachPos + (mMk' 99 mLB01 + (mAppend walked (mRep0 (slot - (walked.length : PAM M)) + (mAppendRegs pre (mRegsTape regs_tape))))) + (mMk' 5 (mAppend (walked ++ List.replicate (11 - r.val) 1).reverse mLB01) R_sel) := by + rw [hrep_split, mAppend_append] at hpasses0 + exact mReach_mReachPos hpasses0 + (mReachPos_trans (mReachPos_mReach hsw hones) (mReachPos_step hs10)) + have hdec := @mDecnz_step_reaches_main0 M _ _ pre hpre r slot walked hsl hok regs_tape hregs + exact ⟨fun hv0 ↦ mReachPos_trans hto5 (hdec.1 hv0), + fun hvne ↦ mReachPos_trans hto5 (hdec.2 hvne)⟩ + +end GenericPrefix + +/-- Logical Layer 1/2 invariant in `PAM M`: `regs` has length `11`, `ip.length ≤ 136`, +`staysInDag 99 ip.dropLast = true`, and `(minSlot ip : PAM M) ≤ slot`. -/ +def MZfLogInv (slot : PAM M) (ip : List (Fin 2)) (regs : List (PAM M)) : Prop := + regs.length = 11 ∧ ip.length ≤ 136 ∧ + staysInDag 99 ip.dropLast = true ∧ (minSlot ip : PAM M) ≤ slot + +theorem mZfLogInv_init : MZfLogInv (19 : PAM M) [] (List.replicate 11 (0 : PAM M)) := + ⟨by simp, by decide, by decide, natCast_le_iff.mpr zf393Inv_init.2.2.2⟩ + +omit [PAModel M] in +theorem mRev11_getD_set {regs : List (PAM M)} (hlen : regs.length = 11) (k : Fin 11) : + (regs.reverse)[k.val]'(by rw [List.length_reverse, hlen]; exact k.isLt) = + regs.getD (10 - k.val) 0 ∧ + ∀ v, regs.reverse.set k.val v = (regs.set (10 - k.val) v).reverse := by + rcases regs with _ | ⟨r0, _ | ⟨r1, _ | ⟨r2, _ | ⟨r3, _ | ⟨r4, _ | ⟨r5, _ | + ⟨r6, _ | ⟨r7, _ | ⟨r8, _ | ⟨r9, _ | ⟨r10, _ | _⟩⟩⟩⟩⟩⟩⟩⟩⟩⟩⟩ <;> + try (simp at hlen; done) + rcases k with ⟨_ | _ | _ | _ | _ | _ | _ | _ | _ | _ | _ | n, hn⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exact ⟨rfl, fun _ ↦ rfl⟩ + · exfalso; omega + +/-- Forward 1-step logical stack-instruction simulation in `PAM M`: from `mZfLogCfg slot ip regs` +satisfying `MZfLogInv slot ip regs`, `Machines.zf393` executes `evalStack ip` in `≥ 1` steps (or +halts if `evalStack ip = .halt`) while preserving `MZfLogInv`. -/ +theorem mTm_simulates_evalStack {slot : PAM M} {ip : List (Fin 2)} {regs : List (PAM M)} + (hinv : MZfLogInv slot ip regs) : + match evalStack ip with + | .halt => + mHaltsFrom zf393 (mZfLogCfg slot ip regs) + | .jump ip' => + ∃ slot' : PAM M, MZfLogInv slot' ip' regs ∧ + mReachPos (mZfLogCfg slot ip regs) (mZfLogCfg slot' ip' regs) + | .inc r ip' => + ∃ slot' : PAM M, MZfLogInv slot' ip' (regs.set r (regs.getD r 0 + 1)) ∧ + mReachPos (mZfLogCfg slot ip regs) + (mZfLogCfg slot' ip' (regs.set r (regs.getD r 0 + 1))) + | .decnz r ip_succ ip_fail => + (regs.getD r 0 = 0 → + ∃ slot' : PAM M, MZfLogInv slot' ip_fail regs ∧ + mReachPos (mZfLogCfg slot ip regs) (mZfLogCfg slot' ip_fail regs)) ∧ + (regs.getD r 0 ≠ 0 → + ∃ slot' : PAM M, MZfLogInv slot' ip_succ (regs.set r (regs.getD r 0 - 1)) ∧ + mReachPos (mZfLogCfg slot ip regs) + (mZfLogCfg slot' ip_succ (regs.set r (regs.getD r 0 - 1)))) := by + obtain ⟨hregs, hip136, hdag_in, hmin⟩ := hinv + have hregs_rev : regs.reverse.length = 11 := by rw [List.length_reverse, hregs] + have hdag_walk := walkTape_dag_props 99 [] ip (by decide) (by decide) + (by decide) (by decide) (by decide) + have hstays_walk := staysInDag_of_walkTape 99 [] (ip ++ List.replicate 10 0) + have hpad_data : ∃ pad : ℕ, + let slot₀ := ip.length + pad + (slot₀ : PAM M) ≤ slot ∧ + match walkTape 99 [] (ip ++ List.replicate 10 0) with + | .outOfFuel => False + | .halt q_h w_h _ => + ∃ r_s, walkTape 99 [] (ip ++ List.replicate pad 0) = .halt q_h w_h r_s + | .jumpLeft q' w_j _ => + (∃ r_s, walkTape 99 [] (ip ++ List.replicate pad 0) = .jumpLeft q' w_j r_s) ∧ + ((w_j.length + 1 : ℕ) : PAM M) ≤ slot ∧ + match q'.val with + | 61 => (minSlot ((popBreakRev 0 w_j.reverse).reverse) : PAM M) ≤ mBreakSlot 0 slot w_j + | 62 => (minSlot ((popBreakRev 1 w_j.reverse).reverse) : PAM M) ≤ mBreakSlot 1 slot w_j + | 63 => (minSlot ((popBreakRev 2 w_j.reverse).reverse) : PAM M) ≤ mBreakSlot 2 slot w_j + | 64 => (minSlot ((popContinueRev 0 w_j.reverse).reverse) : PAM M) ≤ slot + | 65 => (minSlot ((popContinueRev 1 w_j.reverse).reverse) : PAM M) ≤ slot + | 66 => (minSlot ((popContinueRev 2 w_j.reverse).reverse) : PAM M) ≤ slot + | 67 => (minSlot ((popContinueRev 3 w_j.reverse).reverse) : PAM M) ≤ slot + | 68 => (minSlot ((popContinueRev 4 w_j.reverse).reverse) : PAM M) ≤ slot + | _ => False + | .regLeaf q' w_l _ => + let r := leafReg q' + (∃ r_s, walkTape 99 [] (ip ++ List.replicate pad 0) = .regLeaf q' w_l r_s) ∧ + ((w_l.length + (11 - r.val) + 3 : ℕ) : PAM M) ≤ slot ∧ + (if isLeafInc q' then + (minSlot (retStack w_l) : PAM M) ≤ mBreakSlot 0 slot w_l + else + (minSlot ((popBreakRev 1 w_l.reverse).reverse) : PAM M) ≤ mBreakSlot 1 (slot + 1) w_l ∧ + (minSlot (retStack w_l) : PAM M) ≤ mBreakSlot 0 (slot + 1) w_l) := by + unfold minSlot at hmin + cases hlk : lookupSmall ip with + | none => + simp only [hlk, Option.getD_none] at hmin + have hsl150 : ((ip.length + 10 : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (by omega)) hmin + refine ⟨10, hsl150, ?_⟩ + rcases h10 : walkTape 99 [] (ip ++ List.replicate 10 0) with + ⟨q_h, w_h, r_h⟩ | ⟨q', w_j, r_j⟩ | ⟨q', w_l, r_l⟩ | _ + · exact ⟨r_h, rfl⟩ + · rw [h10] at hdag_walk + obtain ⟨hwj135, _, hqv⟩ := hdag_walk + have hwj_sl : ((w_j.length + 1 : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (by omega)) hmin + refine ⟨⟨r_j, rfl⟩, hwj_sl, ?_⟩ + have h150_le : ∀ ip', (minSlot ip' : PAM M) ≤ slot := fun ip' ↦ + le_trans (natCast_le_iff.mpr (minSlot_le_150 ip')) hmin + rcases hqv with (hq61 | hq62 | hq63) | ⟨hq64, _⟩ | ⟨hq65, _⟩ | + ⟨hq66, _⟩ | ⟨hq67, _⟩ | ⟨hq68, _⟩ + · rw [hq61]; exact le_trans (h150_le _) (le_mBreakSlot 0 slot w_j) + · rw [hq62]; exact le_trans (h150_le _) (le_mBreakSlot 1 slot w_j) + · rw [hq63]; exact le_trans (h150_le _) (le_mBreakSlot 2 slot w_j) + · rw [hq64]; exact h150_le _ + · rw [hq65]; exact h150_le _ + · rw [hq66]; exact h150_le _ + · rw [hq67]; exact h150_le _ + · rw [hq68]; exact h150_le _ + · rw [h10] at hdag_walk + obtain ⟨_, hwl136, _⟩ := hdag_walk + have hwl_sl : ((w_l.length + (11 - (leafReg q').val) + 3 : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (by omega)) hmin + refine ⟨⟨r_l, rfl⟩, hwl_sl, ?_⟩ + have h150_le : ∀ ip', (minSlot ip' : PAM M) ≤ slot := fun ip' ↦ + le_trans (natCast_le_iff.mpr (minSlot_le_150 ip')) hmin + split + · exact le_trans (h150_le _) (le_mBreakSlot 0 slot w_l) + · exact ⟨le_trans (h150_le _) + (le_trans (le_add_right_pam slot 1) (le_mBreakSlot 1 (slot + 1) w_l)), + le_trans (h150_le _) + (le_trans (le_add_right_pam slot 1) (le_mBreakSlot 0 (slot + 1) w_l))⟩ + · rw [h10] at hdag_walk; exact hdag_walk + | some sl => + simp only [hlk, Option.getD_some] at hmin + have hall := checkSmallStackEntry_of_lookup hlk + simp only [checkSmallStackEntry, Bool.and_eq_true] at hall + let m := Nat.min 10 (sl - ip.length) + have hm10 : m ≤ 10 := Nat.min_le_left _ _ + have hmsl : m ≤ sl - ip.length := Nat.min_le_right _ _ + have hip_sl : ip.length ≤ sl := of_decide_eq_true hall.1.2 + have hsl0 : ((ip.length + m : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (by omega)) hmin + refine ⟨m, hsl0, ?_⟩ + have hext10 := walkTape_extend_zeros 99 [] (ip ++ List.replicate m 0) (10 - m) + have hrep10 : (ip ++ List.replicate m 0) ++ List.replicate (10 - m) 0 = + ip ++ List.replicate 10 0 := by + rw [List.append_assoc, ← List.replicate_add] + congr 2; omega + rw [hrep10] at hext10 + have hall2 := hall.2 + rw [fastWalk_eq_walkTape, List.reverse_nil] at hall2 + rcases hm : walkTape 99 [] (ip ++ List.replicate m 0) with + ⟨q_h, w_h, r_h⟩ | ⟨q', w_j, r_j⟩ | ⟨q', w_l, r_l⟩ | _ + · rw [hm] at hext10; rw [hext10]; exact ⟨r_h, rfl⟩ + · rw [hm] at hall2 hext10 + rw [hext10] at hdag_walk ⊢ + simp only [Bool.and_eq_true] at hall2 + have hwj_sl : ((w_j.length + 1 : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (of_decide_eq_true hall2.1)) hmin + refine ⟨⟨r_j, rfl⟩, hwj_sl, ?_⟩ + have hms := hall2.2 + rcases hdag_walk.2.2 with (hq61 | hq62 | hq63) | ⟨hq64, _⟩ | ⟨hq65, _⟩ | + ⟨hq66, _⟩ | ⟨hq67, _⟩ | ⟨hq68, _⟩ + · rw [hq61] at hms ⊢ + exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) + (by rw [← mBreakSlot_natCast]; exact mBreakSlot_mono 0 hmin w_j) + · rw [hq62] at hms ⊢ + exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) + (by rw [← mBreakSlot_natCast]; exact mBreakSlot_mono 1 hmin w_j) + · rw [hq63] at hms ⊢ + exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) + (by rw [← mBreakSlot_natCast]; exact mBreakSlot_mono 2 hmin w_j) + · rw [hq64] at hms ⊢; exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) hmin + · rw [hq65] at hms ⊢; exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) hmin + · rw [hq66] at hms ⊢; exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) hmin + · rw [hq67] at hms ⊢; exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) hmin + · rw [hq68] at hms ⊢; exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) hmin + · rw [hm] at hall2 hext10 + rw [hext10] + simp only [Bool.and_eq_true] at hall2 + have hwl_sl : ((w_l.length + (11 - (leafReg q').val) + 3 : ℕ) : PAM M) ≤ slot := + le_trans (natCast_le_iff.mpr (of_decide_eq_true hall2.1)) hmin + refine ⟨⟨r_l, rfl⟩, hwl_sl, ?_⟩ + have hms := hall2.2 + have hsl1 : ((sl + 1 : ℕ) : PAM M) ≤ slot + 1 := by + rw [Nat.cast_add, Nat.cast_one] + exact add_le_add_right_pam hmin 1 + by_cases hinc_q : isLeafInc q' = true <;> + simp only [hinc_q, ↓reduceIte, Bool.false_eq_true] at hms ⊢ + · exact le_trans (natCast_le_iff.mpr (of_decide_eq_true hms)) + (by rw [← mBreakSlot_natCast]; exact mBreakSlot_mono 0 hmin w_l) + · simp only [Bool.and_eq_true] at hms + exact ⟨le_trans (natCast_le_iff.mpr (of_decide_eq_true hms.1)) + (by rw [← mBreakSlot_natCast]; exact mBreakSlot_mono 1 hsl1 w_l), + le_trans (natCast_le_iff.mpr (of_decide_eq_true hms.2)) + (by rw [← mBreakSlot_natCast]; exact mBreakSlot_mono 0 hsl1 w_l)⟩ + · rw [hm] at hall2; cases hall2 + rcases hpad_data with ⟨pad, hsl0, hslot_match⟩ + let slot₀ : ℕ := ip.length + pad + have htail := walkTape_slot_tail (slot := slot₀) (ip := ip) (by dsimp [slot₀]; omega) hdag_in + have hsub0 : slot₀ - ip.length = pad := by dsimp [slot₀]; omega + rw [hsub0] at htail + set R_end := mAppendRegs mPrefix190 (mRegsTape regs.reverse) + set R_rem := mRep0 (slot - (slot₀ : PAM M)) R_end + have hroot_eq : mZfLogCfg slot ip regs = + mTreeWalkCfg 99 [] (ip ++ List.replicate pad 0) mLB01 R_rem := by + unfold mZfLogCfg mZf393RootCfg mRootCfg mTreeWalkCfg + have hpad_split : (pad : PAM M) + (slot - (slot₀ : PAM M)) = slot - (ip.length : PAM M) := by + have hcast : (pad : PAM M) = (slot₀ : PAM M) - (ip.length : PAM M) := by + symm + apply (sub_eq_iff_eq_add_pam (natCast_le_iff.mpr (by dsimp [slot₀]; omega))).mpr + dsimp [slot₀]; push_cast; rfl + rw [hcast] + exact sub_split_add (natCast_le_iff.mpr (by dsimp [slot₀]; omega)) hsl0 + simp only [List.reverse_nil, mAppend_nil, mAppend_append, mAppend_replicate_zero, + R_rem, ← mRep0_add, hpad_split, R_end] + have hreach := mWalkTape_sound 99 [] (ip ++ List.replicate pad 0) mLB01 R_rem + unfold evalStack + rcases h10 : walkTape 99 [] (ip ++ List.replicate 10 0) with + ⟨q_h, w_h, r_h⟩ | ⟨q', w_j, r_j⟩ | ⟨q', w_l, r_l⟩ | _ + · dsimp only + rw [h10] at hslot_match + obtain ⟨r_s, hr_s⟩ := hslot_match + rw [hr_s] at hreach + obtain ⟨⟨s, hs⟩, hnone⟩ := hreach + exact ⟨s, _, by rwa [hroot_eq], hnone⟩ + · rw [h10] at hdag_walk hstays_walk hslot_match + obtain ⟨hwj135, hok_j, hqv⟩ := hdag_walk + obtain ⟨_, hw_eq, hstays_wj⟩ := hstays_walk + rw [List.nil_append] at hw_eq + rw [← hw_eq] at hstays_wj + obtain ⟨⟨r_s, hr_s⟩, hwj_sl, hms⟩ := hslot_match + rw [hr_s] at hreach htail + obtain ⟨⟨b₀, hb₀⟩, hs₁⟩ := hreach + have hwj_lt0 : w_j.length + 1 ≤ slot₀ := by + have hlen_eq := congrArg List.length hb₀ + simp only [List.length_append, List.length_cons, List.length_nil, + List.length_replicate] at hlen_eq + dsimp [slot₀]; omega + subst htail + have hR_eq : mAppend (0 :: List.replicate (slot₀ - (w_j.length + 1)) 0) R_rem = + mRep0 (slot - (w_j.length : PAM M)) R_end := by + have hrep_succ : (0 : Fin 2) :: List.replicate (slot₀ - (w_j.length + 1)) 0 = + List.replicate (slot₀ - w_j.length) 0 := by + have hsub : slot₀ - w_j.length = (slot₀ - (w_j.length + 1)) + 1 := by omega + rw [hsub, List.replicate_succ] + have hcast_sub : ((slot₀ - w_j.length : ℕ) : PAM M) = + (slot₀ : PAM M) - (w_j.length : PAM M) := by + symm + apply (sub_eq_iff_eq_add_pam (natCast_le_iff.mpr (by omega))).mpr + rw [← Nat.cast_add, Nat.add_sub_of_le (by omega)] + rw [hrep_succ, mAppend_replicate_zero, ← mRep0_add, hcast_sub, + sub_split_add (natCast_le_iff.mpr (by omega)) hsl0] + rw [hR_eq, ← hroot_eq] at hs₁ + have hwj_le_sl : (w_j.length : PAM M) ≤ slot := + le_trans (by + have : w_j.length ≤ w_j.length + 1 := by omega + exact natCast_le_iff.mpr this) hwj_sl + rcases hqv with (hq61 | hq62 | hq63) | ⟨hq64, hc0⟩ | ⟨hq65, hc1⟩ | + ⟨hq66, hc2⟩ | ⟨hq67, hc3⟩ | ⟨hq68, hc4⟩ + · have hq'_eq : q' = breakState 0 := by ext; exact hq61 + simp only [hq61] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mBreak_k_reaches_main0 (pre := mPrefix190) 0 (by decide) slot w_j + hwj_le_sl hok_j regs.reverse + have hip_len : (popBreakRev 0 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popBreakRev_length_le 0 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popBreakRev 0 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 ((popBreakRev_dropLast_prefix 0 w_j).trans w_j.dropLast_prefix) + hstays_wj + exact ⟨_, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · have hq'_eq : q' = breakState 1 := by ext; exact hq62 + simp only [hq62] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mBreak_k_reaches_main0 (pre := mPrefix190) 1 (by decide) slot w_j + hwj_le_sl hok_j regs.reverse + have hip_len : (popBreakRev 1 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popBreakRev_length_le 1 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popBreakRev 1 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 ((popBreakRev_dropLast_prefix 1 w_j).trans w_j.dropLast_prefix) + hstays_wj + exact ⟨_, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · have hq'_eq : q' = breakState 2 := by ext; exact hq63 + simp only [hq63] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mBreak_k_reaches_main0 (pre := mPrefix190) 2 (by decide) slot w_j + hwj_le_sl hok_j regs.reverse + have hip_len : (popBreakRev 2 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popBreakRev_length_le 2 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popBreakRev 2 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 ((popBreakRev_dropLast_prefix 2 w_j).trans w_j.dropLast_prefix) + hstays_wj + exact ⟨_, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · have hq'_eq : q' = continueState 0 := by ext; exact hq64 + simp only [hq64] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mContinue_k_reaches_main0 (pre := mPrefix190) 0 (by decide) slot w_j + hc0 hwj_le_sl hok_j regs.reverse + have hip_len : (popContinueRev 0 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popContinueRev_length_le 0 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popContinueRev 0 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 + ((popContinueRev 0 w_j.reverse).reverse.dropLast_prefix.trans + (popContinueRev_prefix 0 w_j)) + hstays_wj + exact ⟨slot, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · have hq'_eq : q' = continueState 1 := by ext; exact hq65 + simp only [hq65] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mContinue_k_reaches_main0 (pre := mPrefix190) 1 (by decide) slot w_j + hc1 hwj_le_sl hok_j regs.reverse + have hip_len : (popContinueRev 1 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popContinueRev_length_le 1 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popContinueRev 1 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 + ((popContinueRev 1 w_j.reverse).reverse.dropLast_prefix.trans + (popContinueRev_prefix 1 w_j)) + hstays_wj + exact ⟨slot, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · have hq'_eq : q' = continueState 2 := by ext; exact hq66 + simp only [hq66] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mContinue_k_reaches_main0 (pre := mPrefix190) 2 (by decide) slot w_j + hc2 hwj_le_sl hok_j regs.reverse + have hip_len : (popContinueRev 2 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popContinueRev_length_le 2 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popContinueRev 2 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 + ((popContinueRev 2 w_j.reverse).reverse.dropLast_prefix.trans + (popContinueRev_prefix 2 w_j)) + hstays_wj + exact ⟨slot, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · have hq'_eq : q' = continueState 3 := by ext; exact hq67 + simp only [hq67] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mContinue_k_reaches_main0 (pre := mPrefix190) 3 (by decide) slot w_j + hc3 hwj_le_sl hok_j regs.reverse + have hip_len : (popContinueRev 3 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popContinueRev_length_le 3 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popContinueRev 3 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 + ((popContinueRev 3 w_j.reverse).reverse.dropLast_prefix.trans + (popContinueRev_prefix 3 w_j)) + hstays_wj + exact ⟨slot, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · have hq'_eq : q' = continueState 4 := by ext; exact hq68 + simp only [hq68] at hms ⊢ + rw [hq'_eq] at hs₁ + have hs₂ := mContinue_k_reaches_main0 (pre := mPrefix190) 4 (by decide) slot w_j + hc4 hwj_le_sl hok_j regs.reverse + have hip_len : (popContinueRev 4 w_j.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popContinueRev_length_le 4 w_j.reverse).trans (by rw [List.length_reverse]; omega) + have hdag' : staysInDag 99 (popContinueRev 4 w_j.reverse).reverse.dropLast = true := + staysInDag_prefix 99 + ((popContinueRev 4 w_j.reverse).reverse.dropLast_prefix.trans + (popContinueRev_prefix 4 w_j)) + hstays_wj + exact ⟨slot, ⟨hregs, hip_len, hdag', hms⟩, mReachPos_trans hs₁ hs₂⟩ + · dsimp only + rw [h10] at hdag_walk hstays_walk hslot_match + obtain ⟨hleaf_q, hwl136, hok_l⟩ := hdag_walk + obtain ⟨_, hw_eq, hstays_wl⟩ := hstays_walk + rw [List.nil_append] at hw_eq + rw [← hw_eq] at hstays_wl + obtain ⟨⟨r_s, hr_s⟩, hwl_sl, hms⟩ := hslot_match + rw [hr_s] at hreach htail + obtain ⟨hu_eq, _⟩ := hreach + rw [List.nil_append] at hu_eq + have hwl_le0 : w_l.length ≤ slot₀ := by + have hlen_eq := congrArg List.length hu_eq + simp only [List.length_append, List.length_replicate] at hlen_eq + dsimp [slot₀]; omega + subst htail + have hroot_wl : mZfLogCfg slot ip regs = + mMk' 99 mLB01 + (mAppend w_l (mRep0 (slot - (w_l.length : PAM M)) R_end)) := by + rw [hroot_eq] + unfold mTreeWalkCfg + rw [← hu_eq, List.reverse_nil, mAppend_nil, mAppend_append, mAppend_replicate_zero, + ← mRep0_add] + have hcast_sub : ((slot₀ - w_l.length : ℕ) : PAM M) = + (slot₀ : PAM M) - (w_l.length : PAM M) := by + symm + apply (sub_eq_iff_eq_add_pam (natCast_le_iff.mpr hwl_le0)).mpr + rw [← Nat.cast_add, Nat.add_sub_of_le hwl_le0] + rw [hcast_sub, sub_split_add (natCast_le_iff.mpr hwl_le0) hsl0] + have hself := walkTape_self_on_regLeaf 99 [] (ip ++ List.replicate 10 0) q' w_l r_l + (by simpa using h10) + rw [List.nil_append] at hself + obtain ⟨hget, hset⟩ := mRev11_getD_set hregs (leafReg q') + rw [ten_sub_leafReg_eq_logLeafReg q'] at hget hset + have hip0_len : (retStack w_l).length ≤ 136 := by + unfold retStack; rw [List.length_reverse] + exact (popBreakRev_length_le 0 w_l.reverse).trans (by rw [List.length_reverse]; omega) + have hdag0 : staysInDag 99 (retStack w_l).dropLast = true := by + unfold retStack + exact staysInDag_prefix 99 (popBreakRev_dropLast_prefix 0 w_l) hstays_wl + by_cases hinc : isLeafInc q' = true + · simp only [hinc, ↓reduceIte] at hms ⊢ + have hq_inc := leafReg_inc_spec q' hleaf_q hinc + rw [hq_inc] at hself + have hs₂ := mInc_leaf_reaches_main0 (pre := mPrefix190) (leafReg q') slot w_l hself + hwl_sl hok_l regs.reverse hregs_rev + rw [← hroot_wl, hget, hset] at hs₂ + have hset_len : (regs.set (logLeafReg q') (regs.getD (logLeafReg q') 0 + 1)).length = 11 := by + rw [List.length_set, hregs] + exact ⟨_, ⟨hset_len, hip0_len, hdag0, hms⟩, hs₂⟩ + · simp only [Bool.not_eq_true] at hinc + simp only [hinc, Bool.false_eq_true, ↓reduceIte] at hms ⊢ + have hq_dec := leafReg_decnz_spec q' hleaf_q hinc + rw [hq_dec] at hself + have hs₂ := mDecnz_leaf_reaches_main0 (pre := mPrefix190) (leafReg q') slot w_l + hself hwl_sl hok_l regs.reverse hregs_rev + rw [← hroot_wl, hget, hset] at hs₂ + have hip1_len : (popBreakRev 1 w_l.reverse).reverse.length ≤ 136 := by + rw [List.length_reverse] + exact (popBreakRev_length_le 1 w_l.reverse).trans (by rw [List.length_reverse]; omega) + have hdag1 : staysInDag 99 (popBreakRev 1 w_l.reverse).reverse.dropLast = true := + staysInDag_prefix 99 (popBreakRev_dropLast_prefix 1 w_l) hstays_wl + refine ⟨fun hv0 ↦ ⟨_, ⟨hregs, hip1_len, hdag1, hms.1⟩, hs₂.1 hv0⟩, + fun hvne ↦ ⟨_, ⟨by rw [List.length_set, hregs], hip0_len, hdag0, hms.2⟩, hs₂.2 hvne⟩⟩ + · rw [h10] at hslot_match; exact False.elim hslot_match + +end Model + +end ConjectureMachines.Semantics.PA + +end diff --git a/Cryptids/Semantics/PA/Zf393ProgramInternal.lean b/Cryptids/Semantics/PA/Zf393ProgramInternal.lean new file mode 100644 index 00000000..c0daea70 --- /dev/null +++ b/Cryptids/Semantics/PA/Zf393ProgramInternal.lean @@ -0,0 +1,4010 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Zf393BackendInternal + +/-! +# Internal `PA` Layer 2 Program & Spine Verification for `zf_393` + +This module internalizes the Layer 2 decision-tree program (`69..392`), the 13-step `unpair` +header (`k = 0..13`), the 20 reordered `ZF` axiom/rule clauses (`k = 13..123`, including the +bugfixed `B6a` check at states `255..256`), the halt check (`k = 123, 124`), and the forward and +backward step-for-step equivalence between `Machines.zf393` halting and `MZf393MainHalts M` inside +an arbitrary first-order `PAModel M` (`mHalts_zf393_iff_mZf393MainHalts`). +-/ + +@[expose] public section + +namespace ConjectureMachines.Semantics.PA + +open Turing (Dir) +open StateTransition ConjectureMachines +open ConjectureMachines.Zf393 +open ConjectureMachines.Zf393.Layer2 +open PAM + +set_option maxRecDepth 200000 + +section ProgramInternal + +variable {M : Type*} [PAStructure M] [PAModel M] + +/-! ## Section 1: Arithmetic Helpers, `PAFunRegs`, and Generic `PAM.ind1` Loop Combinators -/ + +@[simp] +theorem add_one_sub_one_pam (v : PAM M) : v + 1 - 1 = v := + (sub_eq_iff_eq_add_pam ⟨v, add_comm 1 v⟩).mpr (add_comm v 1) + +@[simp] +theorem zero_sub_pam (a : PAM M) : (0 : PAM M) - a = 0 := + sub_eq_zero_of_le_pam (zero_le_pam a) + +@[simp] +theorem zero_lt_add_one_pam (x : PAM M) : (0 : PAM M) < x + 1 := by + rw [PAM.lt_def, zero_add] + exact ⟨x, add_comm 1 x⟩ + +@[simp] +theorem add_one_add_one_ne_one_pam (x : PAM M) : x + 1 + 1 ≠ 1 := by + intro h + have h1 : x + 1 + 1 = (0 : PAM M) + 1 := by simpa using h + have h0 : x + 1 = 0 := (add_right_inj_pam 1).mp h1 + exact add_one_ne_zero x h0 + +theorem add_eq_zero_iff_pam {a b : PAM M} : a + b = 0 ↔ a = 0 ∧ b = 0 := by + refine ⟨fun h ↦ ?_, fun ⟨ha, hb⟩ ↦ by rw [ha, hb, add_zero]⟩ + have ha : a ≤ a + b := ⟨b, rfl⟩ + have hb : b ≤ a + b := ⟨a, add_comm b a⟩ + rw [h] at ha hb + exact ⟨le_zero_iff_pam.mp ha, le_zero_iff_pam.mp hb⟩ + +theorem mPair_zero_succ (x : PAM M) : mPair 0 (x + 1) = mPair x 0 + 1 := by + apply mul_left_cancel_pam two_ne_zero_pam + rw [mul_add, two_mul_mPair, two_mul_mPair] + ring + +theorem mPair_succ_left (x y : PAM M) : mPair (x + 1) y = mPair x (y + 1) + 1 := by + apply mul_left_cancel_pam two_ne_zero_pam + rw [mul_add, two_mul_mPair, two_mul_mPair] + ring + +theorem mPair_step_inv {out₀ x y m : PAM M} (hxy : x + y = m + 1) : + (out₀ + x + 1) + mPair m 0 = out₀ + mPair x y := by + apply mul_left_cancel_pam two_ne_zero_pam + rw [mul_add 2 (out₀ + x + 1), mul_add 2 out₀, two_mul_mPair, two_mul_mPair, add_zero, hxy] + ring + +@[simp] +theorem mUnpair_zero : mUnpair (0 : PAM M) = (0, 0) := by + have h := mUnpair_mPair (0 : PAM M) 0 + rwa [mPair_zero_zero] at h + +attribute [local irreducible] mPair mUnpair + +omit [PAModel M] in +theorem paFun_ite {k : ℕ} {P : (Fin k → PAM M) → Prop} [DecidablePred P] + {f g : (Fin k → PAM M) → PAM M} + (hP : PADefN k P) (hf : PAFunN k f) (hg : PAFunN k g) : + PAFunN k (fun a ↦ if P a then f a else g a) := by + refine paDefN_congr (fun a ↦ ?_) + (paDef_or + (paDef_and (paDef_weaken hP) hf) + (paDef_and (paDef_not (paDef_weaken hP)) hg)) + by_cases hp : P (Fin.init a) <;> simp [hp] + +/-- Concatenate a `k`-tuple and an `m`-tuple into a `(k + m)`-tuple. -/ +def finCat {k : ℕ} (a : Fin k → PAM M) : + ∀ {m : ℕ}, (Fin m → PAM M) → (Fin (k + m) → PAM M) + | 0, _ => a + | m + 1, b => Fin.snoc (finCat a (Fin.init b)) (b (Fin.last m)) + +omit [PAStructure M] [PAModel M] in +theorem finCat_left {k : ℕ} (a : Fin k → PAM M) : + ∀ {m : ℕ} (b : Fin m → PAM M) (i : Fin k), + finCat a b ⟨i.val, Nat.lt_of_lt_of_le i.isLt (Nat.le_add_right k m)⟩ = a i + | 0, _, _ => rfl + | m + 1, b, i => by + dsimp only [finCat] + rw [fin_snoc_lt _ _ _ (Nat.lt_of_lt_of_le i.isLt (Nat.le_add_right k m))] + exact finCat_left a (Fin.init b) i + +omit [PAStructure M] [PAModel M] in +theorem finCat_right {k : ℕ} (a : Fin k → PAM M) : + ∀ {m : ℕ} (b : Fin m → PAM M) (j : Fin m), + finCat a b ⟨k + j.val, Nat.add_lt_add_left j.isLt k⟩ = b j + | 0, _, j => Fin.elim0 j + | m + 1, b, j => by + dsimp only [finCat] + refine Fin.lastCases ?_ ?_ j + · change Fin.snoc (α := fun _ ↦ PAM M) (finCat a (Fin.init b)) (b (Fin.last m)) + (Fin.last (k + m)) = b (Fin.last m) + exact Fin.snoc_last _ _ + · intro j₀ + dsimp only [Fin.val_castSucc] + rw [fin_snoc_lt _ _ _ (Nat.add_lt_add_left j₀.isLt k)] + exact finCat_right a (Fin.init b) j₀ + +omit [PAModel M] in +theorem paDef_forall_vec {k : ℕ} : + ∀ {m : ℕ} {P : (Fin (k + m) → PAM M) → Prop}, + PADefN (k + m) P → + PADefN k (fun a ↦ ∀ b : Fin m → PAM M, P (finCat a b)) + | 0, P, hP => + paDefN_congr (fun a ↦ ⟨fun hp _ ↦ hp, fun hall ↦ hall Fin.elim0⟩) hP + | m + 1, P, hP => by + refine paDefN_congr (fun a ↦ ?_) (paDef_forall_vec (m := m) (paDef_all hP)) + constructor + · intro h b + exact h (Fin.init b) (b (Fin.last m)) + · intro h b₀ x + have hb := h (Fin.snoc b₀ x) + simpa [finCat, Fin.init_snoc, Fin.snoc_last] using hb + +omit [PAModel M] in +theorem paDef_exists_vec {k : ℕ} : + ∀ {m : ℕ} {P : (Fin (k + m) → PAM M) → Prop}, + PADefN (k + m) P → + PADefN k (fun a ↦ ∃ b : Fin m → PAM M, P (finCat a b)) + | 0, P, hP => + paDefN_congr (fun a ↦ ⟨fun hp ↦ ⟨Fin.elim0, hp⟩, fun ⟨_, hp⟩ ↦ hp⟩) hP + | m + 1, P, hP => by + refine paDefN_congr (fun a ↦ ?_) (paDef_exists_vec (m := m) (paDef_ex hP)) + constructor + · rintro ⟨b₀, x, hx⟩ + refine ⟨Fin.snoc b₀ x, ?_⟩ + simpa [finCat, Fin.init_snoc, Fin.snoc_last] using hx + · rintro ⟨b, hb⟩ + exact ⟨Fin.init b, b (Fin.last m), hb⟩ + +omit [PAModel M] in +theorem ofFn_getD_eq_self {regs : List (PAM M)} (hlen : regs.length = 11) : + List.ofFn (fun i : Fin 11 ↦ regs.getD i.val 0) = regs := by + apply List.ext_getElem + · simp [hlen] + · intro i hi1 hi2 + rw [List.getElem_ofFn, List.getD_eq_getElem?_getD, List.getElem?_eq_getElem hi2, + Option.getD_some] + +omit [PAModel M] in +theorem mGetD_set_self (regs : List (PAM M)) (r : ℕ) (v : PAM M) (hr : r < regs.length) : + (regs.set r v).getD r 0 = v := by + simp [List.getD_eq_getElem?_getD, hr] + +omit [PAModel M] in +theorem mGetD_set_ne (regs : List (PAM M)) {r₁ r₂ : ℕ} (v : PAM M) (hne : r₁ ≠ r₂) : + (regs.set r₁ v).getD r₂ 0 = regs.getD r₂ 0 := by + simp [List.getD_eq_getElem?_getD, hne] + +omit [PAModel M] in +theorem mSet_getD_self (regs : List (PAM M)) (r : ℕ) : + regs.set r (regs.getD r 0) = regs := by + apply List.ext_getElem + · simp + · intro i hi1 hi2 + rw [List.getElem_set] + split_ifs with heq + · subst heq + rw [List.getD_eq_getElem?_getD, List.getElem?_eq_getElem hi2, Option.getD_some] + · rfl + +omit [PAModel M] in +theorem mSet_eq_self_of_getD_eq {regs : List (PAM M)} {r : ℕ} {v : PAM M} + (h : regs.getD r 0 = v) : regs.set r v = regs := by + rw [← h, mSet_getD_self] + +omit [PAStructure M] [PAModel M] in +theorem mSet_comm_of_ne (regs : List (PAM M)) {r₁ r₂ : ℕ} (v₁ v₂ : PAM M) (hne : r₁ ≠ r₂) : + (regs.set r₁ v₁).set r₂ v₂ = (regs.set r₂ v₂).set r₁ v₁ := + List.set_comm v₁ v₂ hne + +/-- First-order definable 11-register bank family on `PAM M`. -/ +def PAFunRegs (n : ℕ) (R : (Fin n → PAM M) → List (PAM M)) : Prop := + (∀ u, (R u).length = 11) ∧ ∀ i : Fin 11, PAFunN n (fun u ↦ (R u).getD i.val 0) + +omit [PAModel M] in +theorem paFunRegs_ofFn {n : ℕ} {f : Fin 11 → (Fin n → PAM M) → PAM M} + (hf : ∀ i : Fin 11, PAFunN n (f i)) : + PAFunRegs n (fun u ↦ List.ofFn (fun i : Fin 11 ↦ f i u)) := by + refine ⟨fun _ ↦ by simp, fun i ↦ paFunN_congr (fun u ↦ ?_) (hf i)⟩ + simp only [List.getD_eq_getElem?_getD, List.getElem?_ofFn, i.isLt, ↓reduceDIte, Option.getD_some] + +omit [PAModel M] in +theorem paFunRegs_weaken {n : ℕ} {R : (Fin n → PAM M) → List (PAM M)} + (hR : PAFunRegs n R) : PAFunRegs (n + 1) (fun u ↦ R (Fin.init u)) := + ⟨fun u ↦ hR.1 (Fin.init u), fun i ↦ paFun_weaken (hR.2 i)⟩ + +omit [PAModel M] in +theorem paFunRegs_getD {n : ℕ} {R : (Fin n → PAM M) → List (PAM M)} + (hR : PAFunRegs n R) (r : ℕ) : + PAFunN n (fun u ↦ (R u).getD r 0) := by + by_cases hr : r < 11 + · exact hR.2 ⟨r, hr⟩ + · refine paFunN_congr (fun u ↦ ?_) (paFun_const 0) + have hge : (R u).length ≤ r := by rw [hR.1 u]; omega + simp [List.getD_eq_getElem?_getD, List.getElem?_eq_none hge] + +omit [PAModel M] in +theorem paFunRegs_set {n : ℕ} {R : (Fin n → PAM M) → List (PAM M)} + (hR : PAFunRegs n R) (r : ℕ) {fv : (Fin n → PAM M) → PAM M} (hv : PAFunN n fv) : + PAFunRegs n (fun u ↦ (R u).set r (fv u)) := by + refine ⟨fun u ↦ by rw [List.length_set, hR.1 u], fun i ↦ ?_⟩ + by_cases hri : r = i.val + · subst hri + refine paFunN_congr (fun u ↦ ?_) hv + exact (mGetD_set_self (R u) i.val (fv u) (by rw [hR.1 u]; exact i.isLt)).symm + · refine paFunN_congr (fun u ↦ ?_) (hR.2 i) + exact (mGetD_set_ne (R u) (fv u) hri).symm + +theorem paFun_mZfLogCfg_of_regs (ip : List (Fin 2)) {n : ℕ} + {fslot : (Fin n → PAM M) → PAM M} {R : (Fin n → PAM M) → List (PAM M)} + (hslot : PAFunN n fslot) (hR : PAFunRegs n R) : + PAFunN n (fun u ↦ mEncodeCfg (mZfLogCfg (fslot u) ip (R u))) := by + refine paFunN_congr (fun u ↦ ?_) (paFun_mZfLogCfg ip hslot hR.2) + rw [ofFn_getD_eq_self (hR.1 u)] + +theorem paDef_mZfLogInv (ip : List (Fin 2)) {n : ℕ} + {fslot : (Fin n → PAM M) → PAM M} {R : (Fin n → PAM M) → List (PAM M)} + (hslot : PAFunN n fslot) (hR : PAFunRegs n R) : + PADefN n (fun u ↦ MZfLogInv (fslot u) ip (R u)) := by + refine paDefN_congr (fun u ↦ ?_) + (paDef_and (paDef_prop (ip.length ≤ 136 ∧ Layer1.staysInDag 99 ip.dropLast = true)) + (paDef_le (paFun_const (Layer1.minSlot ip : PAM M)) hslot)) + simp [MZfLogInv, hR.1 u, and_assoc] + +theorem paDef_mReach {n : ℕ} {ca cb : (Fin n → PAM M) → MCfg 393 M} + (ha : PAFunN n (fun u ↦ mEncodeCfg (ca u))) + (hb : PAFunN n (fun u ↦ mEncodeCfg (cb u))) : + PADefN n (fun u ↦ mReach (ca u) (cb u)) := by + refine paDefN_congr (fun u ↦ ?_) + (paDef_ex (paDef_mTracesTo zf393 (paFun_proj (Fin.last n)) + (paFun_weaken ha) (paFun_weaken hb))) + simp [mReach] + +theorem paDef_mReachPos {n : ℕ} {ca cb : (Fin n → PAM M) → MCfg 393 M} + (ha : PAFunN n (fun u ↦ mEncodeCfg (ca u))) + (hb : PAFunN n (fun u ↦ mEncodeCfg (cb u))) : + PADefN n (fun u ↦ mReachPos (ca u) (cb u)) := by + refine paDefN_congr (fun u ↦ ?_) + (paDef_ex (paDef_and + (paDef_le (paFun_const 1) (paFun_proj (Fin.last n))) + (paDef_mTracesTo zf393 (paFun_proj (Fin.last n)) + (paFun_weaken ha) (paFun_weaken hb)))) + simp [mReachPos] + +theorem paDef_exists_slot_reachPos (ip₁ ip₂ : List (Fin 2)) {n : ℕ} + {fslot : (Fin n → PAM M) → PAM M} + {R₁ R₂ : (Fin n → PAM M) → List (PAM M)} + (hslot : PAFunN n fslot) (hR₁ : PAFunRegs n R₁) (hR₂ : PAFunRegs n R₂) : + PADefN n (fun u ↦ + ∃ slot' : PAM M, MZfLogInv slot' ip₂ (R₂ u) ∧ + mReachPos (mZfLogCfg (fslot u) ip₁ (R₁ u)) (mZfLogCfg slot' ip₂ (R₂ u))) := by + have hsl' : PAFunN (n + 1) (fun b : Fin (n + 1) → PAM M ↦ b (Fin.last n)) := + paFun_proj (Fin.last n) + have hR₂' : PAFunRegs (n + 1) (fun b ↦ R₂ (Fin.init b)) := paFunRegs_weaken hR₂ + refine paDefN_congr (fun u ↦ ?_) + (paDef_ex (paDef_and + (paDef_mZfLogInv ip₂ hsl' hR₂') + (paDef_mReachPos + (paFun_weaken (paFun_mZfLogCfg_of_regs ip₁ hslot hR₁)) + (paFun_mZfLogCfg_of_regs ip₂ hsl' hR₂')))) + simp + +/-- Extract the 11 registers `w 2 .. w 12` from `w : Fin 13 → PAM M`. -/ +def regsOfVec13 (w : Fin 13 → PAM M) : List (PAM M) := + List.ofFn (fun i : Fin 11 ↦ w ⟨i.val + 2, by omega⟩) + +omit [PAModel M] in +theorem paFunRegs_regsOfVec13 : PAFunRegs 13 (regsOfVec13 (M := M)) := + paFunRegs_ofFn (fun i ↦ paFun_proj ⟨i.val + 2, by omega⟩) + +omit [PAStructure M] [PAModel M] in +private theorem regsOfVec13_finCat (a : Fin 1 → PAM M) (b : Fin 12 → PAM M) : + regsOfVec13 (finCat a b) = List.ofFn (fun i : Fin 11 ↦ b i.succ) := by + unfold regsOfVec13 + congr 1 + funext i + have hidx : (⟨i.val + 2, by omega⟩ : Fin 13) = + ⟨1 + i.succ.val, Nat.add_lt_add_left i.succ.isLt 1⟩ := by + ext; dsimp; omega + rw [hidx, finCat_right a b i.succ] + +/-- Generic `PAM.ind1` principle for subroutines transitioning from `ip₁` to `ip₂` over all +`(slot, regs)` satisfying `MZfLogInv slot ip₁ regs`. -/ +theorem ind1_subEval_loop (ip₁ ip₂ : List (Fin 2)) + (Cond : PAM M → List (PAM M) → Prop) + (F : PAM M → List (PAM M) → List (PAM M)) + (hCond : PADefN 13 (fun w : Fin 13 → PAM M ↦ Cond (w 0) (regsOfVec13 w))) + (hF : PAFunRegs 13 (fun w : Fin 13 → PAM M ↦ F (w 0) (regsOfVec13 w))) + (h0 : ∀ (slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot ip₁ regs → Cond 0 regs → + ∃ slot' : PAM M, MZfLogInv slot' ip₂ (F 0 regs) ∧ + mReachPos (mZfLogCfg slot ip₁ regs) (mZfLogCfg slot' ip₂ (F 0 regs))) + (hs : ∀ (v : PAM M), + (∀ (slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot ip₁ regs → Cond v regs → + ∃ slot' : PAM M, MZfLogInv slot' ip₂ (F v regs) ∧ + mReachPos (mZfLogCfg slot ip₁ regs) (mZfLogCfg slot' ip₂ (F v regs))) → + ∀ (slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot ip₁ regs → Cond (v + 1) regs → + ∃ slot' : PAM M, MZfLogInv slot' ip₂ (F (v + 1) regs) ∧ + mReachPos (mZfLogCfg slot ip₁ regs) (mZfLogCfg slot' ip₂ (F (v + 1) regs))) : + ∀ (v slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot ip₁ regs → Cond v regs → + ∃ slot' : PAM M, MZfLogInv slot' ip₂ (F v regs) ∧ + mReachPos (mZfLogCfg slot ip₁ regs) (mZfLogCfg slot' ip₂ (F v regs)) := by + have hbody13 : PADefN 13 (fun w : Fin 13 → PAM M ↦ + MZfLogInv (w 1) ip₁ (regsOfVec13 w) → + Cond (w 0) (regsOfVec13 w) → + ∃ slot' : PAM M, MZfLogInv slot' ip₂ (F (w 0) (regsOfVec13 w)) ∧ + mReachPos (mZfLogCfg (w 1) ip₁ (regsOfVec13 w)) + (mZfLogCfg slot' ip₂ (F (w 0) (regsOfVec13 w)))) := + paDef_imp (paDef_mZfLogInv ip₁ (paFun_proj 1) paFunRegs_regsOfVec13) + (paDef_imp hCond + (paDef_exists_slot_reachPos ip₁ ip₂ (paFun_proj 1) paFunRegs_regsOfVec13 hF)) + have hall1 : PADef1 (fun v : PAM M ↦ + ∀ (slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot ip₁ regs → Cond v regs → + ∃ slot' : PAM M, MZfLogInv slot' ip₂ (F v regs) ∧ + mReachPos (mZfLogCfg slot ip₁ regs) (mZfLogCfg slot' ip₂ (F v regs))) := by + refine paDefN_congr (fun a ↦ ?_) (paDef_forall_vec (k := 1) (m := 12) hbody13) + have ha0 : ∀ b : Fin 12 → PAM M, finCat a b 0 = a 0 := fun b ↦ finCat_left a b 0 + have hb0 : ∀ b : Fin 12 → PAM M, finCat a b 1 = b 0 := fun b ↦ finCat_right a b 0 + constructor + · intro hvec slot regs hinv hc + let b : Fin 12 → PAM M := Fin.cons slot (fun i : Fin 11 ↦ regs.getD i.val 0) + have hb_slot : b 0 = slot := rfl + have hb_regs : List.ofFn (fun i : Fin 11 ↦ b i.succ) = regs := ofFn_getD_eq_self hinv.1 + have hinst := hvec b + rw [ha0 b, hb0 b, regsOfVec13_finCat a b, hb_slot, hb_regs] at hinst + exact hinst hinv hc + · intro hall b + rw [ha0 b, hb0 b, regsOfVec13_finCat a b] + exact hall (b 0) (List.ofFn (fun i : Fin 11 ↦ b i.succ)) + exact ind1 hall1 h0 hs + +/-! ## Section 2: Logical Step Lemmas & Subroutine Combinators (`MSubEval`) -/ + +theorem mLogStep_of_jump {slot : PAM M} {ip ip' : List (Fin 2)} {regs : List (PAM M)} + (hinv : MZfLogInv slot ip regs) (hev : evalStack ip = .jump ip') : + ∃ slot' : PAM M, MZfLogInv slot' ip' regs ∧ + mReachPos (mZfLogCfg slot ip regs) (mZfLogCfg slot' ip' regs) := by + have h := mTm_simulates_evalStack hinv + rwa [hev] at h + +theorem mLogStep_of_inc {slot : PAM M} {ip ip' : List (Fin 2)} {r : ℕ} {regs : List (PAM M)} + (hinv : MZfLogInv slot ip regs) (hev : evalStack ip = .inc r ip') : + ∃ slot' : PAM M, MZfLogInv slot' ip' (regs.set r (regs.getD r 0 + 1)) ∧ + mReachPos (mZfLogCfg slot ip regs) + (mZfLogCfg slot' ip' (regs.set r (regs.getD r 0 + 1))) := by + have h := mTm_simulates_evalStack hinv + rwa [hev] at h + +theorem mLogStep_of_decnz_zero {slot : PAM M} {ip ip_succ ip_fail : List (Fin 2)} {r : ℕ} + {regs : List (PAM M)} (hinv : MZfLogInv slot ip regs) + (hev : evalStack ip = .decnz r ip_succ ip_fail) (hz : regs.getD r 0 = 0) : + ∃ slot' : PAM M, MZfLogInv slot' ip_fail regs ∧ + mReachPos (mZfLogCfg slot ip regs) (mZfLogCfg slot' ip_fail regs) := by + have h := mTm_simulates_evalStack hinv + rw [hev] at h + exact h.1 hz + +theorem mLogStep_of_decnz_succ {slot : PAM M} {ip ip_succ ip_fail : List (Fin 2)} {r : ℕ} + {v : PAM M} {regs : List (PAM M)} (hinv : MZfLogInv slot ip regs) + (hev : evalStack ip = .decnz r ip_succ ip_fail) (hv : regs.getD r 0 = v + 1) : + ∃ slot' : PAM M, MZfLogInv slot' ip_succ (regs.set r v) ∧ + mReachPos (mZfLogCfg slot ip regs) (mZfLogCfg slot' ip_succ (regs.set r v)) := by + have h := mTm_simulates_evalStack hinv + rw [hev] at h + have hne : regs.getD r 0 ≠ 0 := by rw [hv]; exact add_one_ne_zero v + have hres := h.2 hne + rwa [hv, add_one_sub_one_pam] at hres + +theorem mLogStep_of_halt {slot : PAM M} {ip : List (Fin 2)} {regs : List (PAM M)} + (hinv : MZfLogInv slot ip regs) (hev : evalStack ip = .halt) : + mHaltsFrom zf393 (mZfLogCfg slot ip regs) := by + have h := mTm_simulates_evalStack hinv + rwa [hev] at h + +/-- Subroutine specification at decision-tree node `q` over `PAM M`. -/ +def MSubEval (q : Fin 393) (f : List (PAM M) → List (PAM M)) : Prop := + ∀ (P : List (Fin 2)), + walkInternal 99 P = some q → + ∀ (slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot (trimZeros P) regs → + (f regs).length = 11 ∧ + ∃ slot' : PAM M, MZfLogInv slot' (retStack P) (f regs) ∧ + mReachPos (mZfLogCfg slot (trimZeros P) regs) (mZfLogCfg slot' (retStack P) (f regs)) + +theorem MSubEval.congr {q : Fin 393} {f g : List (PAM M) → List (PAM M)} + (h : MSubEval q f) (heq : ∀ regs : List (PAM M), regs.length = 11 → f regs = g regs) : + MSubEval q g := by + intro P hP slot regs hinv + obtain ⟨hlen_f, slot', hinv', hreach⟩ := h P hP slot regs hinv + rw [heq regs hinv.1] at hlen_f hinv' hreach + exact ⟨hlen_f, slot', hinv', hreach⟩ + +theorem mSubEval_seq {q q₀ q₁ : Fin 393} {f₀ f₁ f : List (PAM M) → List (PAM M)} + (htr0 : zf393Trans q 0 = some (0, .right, q₀)) (hq₀ : 69 ≤ q₀.val) + (htr1 : zf393Trans q 1 = some (1, .right, q₁)) (hq₁ : 69 ≤ q₁.val) + (h0 : MSubEval q₀ f₀) (h1 : MSubEval q₁ f₁) + (heq : (fun regs ↦ f₁ (f₀ regs)) = f := by rfl) : + MSubEval q f := by + subst heq + intro P hP slot regs hinv + have hP0 : walkInternal 99 (P ++ [0]) = some q₀ := walkInternal_snoc hP htr0 hq₀ + have hP1 : walkInternal 99 (P ++ [1]) = some q₁ := walkInternal_snoc hP htr1 hq₁ + have hinv0 : MZfLogInv slot (trimZeros (P ++ [0])) regs := by rwa [trimZeros_append_zero] + obtain ⟨_, slot₀, hinv₀, hreach₀⟩ := h0 (P ++ [0]) hP0 slot regs hinv0 + rw [trimZeros_append_zero, retStack_append_zero] at hreach₀ + rw [retStack_append_zero] at hinv₀ + have hinv1 : MZfLogInv slot₀ (trimZeros (P ++ [1])) (f₀ regs) := by + rwa [trimZeros_append_one] + obtain ⟨hlen₁, slot₁, hinv₁, hreach₁⟩ := h1 (P ++ [1]) hP1 slot₀ (f₀ regs) hinv1 + rw [trimZeros_append_one, retStack_append_one] at hreach₁ + rw [retStack_append_one] at hinv₁ + exact ⟨hlen₁, slot₁, hinv₁, mReachPos_trans hreach₀ hreach₁⟩ + +theorem mSubEval_seq_inc {q q₀ q₁ : Fin 393} {f₀ : List (PAM M) → List (PAM M)} + (htr0 : zf393Trans q 0 = some (0, .right, q₀)) (hq₀ : 69 ≤ q₀.val) + (htr1 : zf393Trans q 1 = some (1, .right, q₁)) + (h29 : 29 ≤ q₁.val) (h50 : q₁.val ≤ 50) (hinc : isLeafInc q₁ = true) + (h0 : MSubEval q₀ f₀) : + MSubEval q (fun regs ↦ + let r := f₀ regs + r.set (logLeafReg q₁) (r.getD (logLeafReg q₁) 0 + 1)) := by + intro P hP slot regs hinv + have hP0 : walkInternal 99 (P ++ [0]) = some q₀ := walkInternal_snoc hP htr0 hq₀ + have hinv0 : MZfLogInv slot (trimZeros (P ++ [0])) regs := by rwa [trimZeros_append_zero] + obtain ⟨hlen₀, slot₀, hinv₀, hreach₀⟩ := h0 (P ++ [0]) hP0 slot regs hinv0 + rw [trimZeros_append_zero, retStack_append_zero] at hreach₀ + rw [retStack_append_zero] at hinv₀ + have hev1 := evalStack_leaf1_inc_of_walkInternal hP htr1 h29 h50 hinc + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_inc hinv₀ hev1 + exact ⟨by simp [hlen₀], slot₁, hinv₁, mReachPos_trans hreach₀ hreach₁⟩ + +theorem mSubEval_inc_inc {q q₀ q₁ : Fin 393} + (htr0 : zf393Trans q 0 = some (0, .right, q₀)) + (h0_29 : 29 ≤ q₀.val) (h0_50 : q₀.val ≤ 50) (hinc0 : isLeafInc q₀ = true) + (htr1 : zf393Trans q 1 = some (1, .right, q₁)) + (h1_29 : 29 ≤ q₁.val) (h1_50 : q₁.val ≤ 50) (hinc1 : isLeafInc q₁ = true) : + MSubEval (M := M) q (fun regs : List (PAM M) ↦ + let r₁ := regs.set (logLeafReg q₀) (regs.getD (logLeafReg q₀) 0 + 1) + r₁.set (logLeafReg q₁) (r₁.getD (logLeafReg q₁) 0 + 1)) := by + intro P hP slot regs hinv + have hev0 : evalStack (trimZeros P) = .inc (logLeafReg q₀) (P ++ [1]) := by + rw [evalStack_trimZeros_of_walkInternal hP, + evalStack_leaf0_of_walkInternal hP htr0 h0_29 h0_50] + simp [hinc0] + obtain ⟨slot₀, hinv₀, hreach₀⟩ := mLogStep_of_inc hinv hev0 + have hev1 := evalStack_leaf1_inc_of_walkInternal hP htr1 h1_29 h1_50 hinc1 + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_inc hinv₀ hev1 + exact ⟨by simp [hinv.1], slot₁, hinv₁, mReachPos_trans hreach₀ hreach₁⟩ + +theorem mSubEval_inc_seq {q q₀ q₁ : Fin 393} {f₁ : List (PAM M) → List (PAM M)} + (htr0 : zf393Trans q 0 = some (0, .right, q₀)) + (h29 : 29 ≤ q₀.val) (h50 : q₀.val ≤ 50) (hinc : isLeafInc q₀ = true) + (htr1 : zf393Trans q 1 = some (1, .right, q₁)) (hq₁ : 69 ≤ q₁.val) + (h1 : MSubEval q₁ f₁) : + MSubEval q (fun regs ↦ + f₁ (regs.set (logLeafReg q₀) (regs.getD (logLeafReg q₀) 0 + 1))) := by + intro P hP slot regs hinv + have hev0 : evalStack (trimZeros P) = .inc (logLeafReg q₀) (P ++ [1]) := by + rw [evalStack_trimZeros_of_walkInternal hP, + evalStack_leaf0_of_walkInternal hP htr0 h29 h50] + simp [hinc] + obtain ⟨slot₀, hinv₀, hreach₀⟩ := mLogStep_of_inc hinv hev0 + have hP1 : walkInternal 99 (P ++ [1]) = some q₁ := walkInternal_snoc hP htr1 hq₁ + have hinv1 : MZfLogInv slot₀ (trimZeros (P ++ [1])) + (regs.set (logLeafReg q₀) (regs.getD (logLeafReg q₀) 0 + 1)) := by + rwa [trimZeros_append_one] + obtain ⟨hlen₁, slot₁, hinv₁, hreach₁⟩ := h1 (P ++ [1]) hP1 slot₀ _ hinv1 + rw [trimZeros_append_one, retStack_append_one] at hreach₁ + rw [retStack_append_one] at hinv₁ + exact ⟨hlen₁, slot₁, hinv₁, mReachPos_trans hreach₀ hreach₁⟩ + +theorem mSubEval_cond {q q₀ q₁ : Fin 393} {cond : List (PAM M) → Prop} [DecidablePred cond] + {f₀ f₁ f : List (PAM M) → List (PAM M)} + (htr0 : zf393Trans q 0 = some (0, .right, q₀)) (hq₀ : 69 ≤ q₀.val) + (htr1 : zf393Trans q 1 = some (1, .right, q₁)) (hq₁ : 69 ≤ q₁.val) + (h0 : ∀ (Q : List (Fin 2)), walkInternal 99 Q = some q₀ → + ∀ (slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot (trimZeros Q) regs → + (f₀ regs).length = 11 ∧ + ∃ slot' : PAM M, + MZfLogInv slot' + (if cond regs then retStack Q else (popBreakRev 1 Q.reverse).reverse) (f₀ regs) ∧ + mReachPos (mZfLogCfg slot (trimZeros Q) regs) + (mZfLogCfg slot' + (if cond regs then retStack Q else (popBreakRev 1 Q.reverse).reverse) (f₀ regs))) + (h1 : MSubEval q₁ f₁) + (heq : (fun regs ↦ if cond regs then f₁ (f₀ regs) else f₀ regs) = f := by rfl) : + MSubEval q f := by + subst heq + intro P hP slot regs hinv + have hP0 : walkInternal 99 (P ++ [0]) = some q₀ := walkInternal_snoc hP htr0 hq₀ + have hP1 : walkInternal 99 (P ++ [1]) = some q₁ := walkInternal_snoc hP htr1 hq₁ + have hinv0 : MZfLogInv slot (trimZeros (P ++ [0])) regs := by rwa [trimZeros_append_zero] + obtain ⟨hlen₀, slot₀, hinv₀, hreach₀⟩ := h0 (P ++ [0]) hP0 slot regs hinv0 + have hbrk : (popBreakRev 1 (P ++ [0]).reverse).reverse = retStack P := by simp [retStack] + rw [trimZeros_append_zero, retStack_append_zero, hbrk] at hreach₀ + rw [retStack_append_zero, hbrk] at hinv₀ + by_cases hc : cond regs + · simp only [hc, ↓reduceIte] at hinv₀ hreach₀ ⊢ + have hinv1 : MZfLogInv slot₀ (trimZeros (P ++ [1])) (f₀ regs) := by + rwa [trimZeros_append_one] + obtain ⟨hlen₁, slot₁, hinv₁, hreach₁⟩ := h1 (P ++ [1]) hP1 slot₀ (f₀ regs) hinv1 + rw [trimZeros_append_one, retStack_append_one] at hreach₁ + rw [retStack_append_one] at hinv₁ + exact ⟨hlen₁, slot₁, hinv₁, mReachPos_trans hreach₀ hreach₁⟩ + · simp only [hc, ↓reduceIte] at hinv₀ hreach₀ ⊢ + exact ⟨hlen₀, slot₀, hinv₀, hreach₀⟩ + +/-! ## Section 3: Parametric `PAM.ind1` Loop Theorems & Concrete Subroutine Instantiations -/ + +theorem mSubEval_while_clear {q q_dec : Fin 393} (r : ℕ) (hr : r < 11) + (htr0 : zf393Trans q 0 = some (0, .right, q_dec)) + (h29 : 29 ≤ q_dec.val) (h50 : q_dec.val ≤ 50) (hdec : isLeafInc q_dec = false) + (hlr : logLeafReg q_dec = r) + (htr1 : zf393Trans q 1 = some (0, .left, 64)) : + MSubEval (M := M) q (fun regs ↦ regs.set r 0) := by + intro P hP + have hev0 : evalStack (trimZeros P) = .decnz r (P ++ [1]) (retStack P) := by + rw [evalStack_trimZeros_of_walkInternal hP, + evalStack_leaf0_of_walkInternal hP htr0 h29 h50] + simp [hdec, hlr] + have hev1 : evalStack (P ++ [1]) = .jump (trimZeros P) := by + have h := evalStack_continue1_of_walkInternal (k := 0) (by omega) hP htr1 + simpa [popContinueRev_zero_eq_dropLeadingZeros, trimZeros] using h + have hloop := ind1_subEval_loop (M := M) (trimZeros P) (retStack P) + (fun v regs ↦ regs.getD r 0 = v) + (fun _ regs ↦ regs.set r 0) + (paDef_eq (paFunRegs_getD paFunRegs_regsOfVec13 r) (paFun_proj 0)) + (paFunRegs_set paFunRegs_regsOfVec13 r (paFun_const 0)) + (fun slot regs hinv hv ↦ by + obtain ⟨slot', hinv', hreach⟩ := mLogStep_of_decnz_zero hinv hev0 hv + rw [mSet_eq_self_of_getD_eq hv] + exact ⟨slot', hinv', hreach⟩) + (fun v ih slot regs hinv hv ↦ by + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev0 hv + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_jump hinv₁ hev1 + have hv' : (regs.set r v).getD r 0 = v := mGetD_set_self regs r v (by rw [hinv.1]; exact hr) + obtain ⟨slot₃, hinv₃, hreach₃⟩ := ih slot₂ (regs.set r v) hinv₂ hv' + rw [List.set_set] at hinv₃ hreach₃ + exact ⟨slot₃, hinv₃, mReachPos_trans hreach₁ (mReachPos_trans hreach₂ hreach₃)⟩) + intro slot regs hinv + exact ⟨by rw [List.length_set, hinv.1], hloop (regs.getD r 0) slot regs hinv rfl⟩ + +theorem mSubEval_while_move1 {q q_dec q₁ q_inc : Fin 393} (r₁ r₂ : ℕ) + (hr₁ : r₁ < 11) (_hr₂ : r₂ < 11) (hne : r₁ ≠ r₂) + (htr0 : zf393Trans q 0 = some (0, .right, q_dec)) + (hdec29 : 29 ≤ q_dec.val) (hdec50 : q_dec.val ≤ 50) (hdec : isLeafInc q_dec = false) + (hlr1 : logLeafReg q_dec = r₁) + (htr1 : zf393Trans q 1 = some (1, .right, q₁)) (hq₁ : 69 ≤ q₁.val) + (htr10 : zf393Trans q₁ 0 = some (0, .right, q_inc)) + (hinc29 : 29 ≤ q_inc.val) (hinc50 : q_inc.val ≤ 50) (hinc : isLeafInc q_inc = true) + (hlr2 : logLeafReg q_inc = r₂) + (htr11 : zf393Trans q₁ 1 = some (0, .left, 65)) : + MSubEval (M := M) q (fun regs ↦ (regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + regs.getD r₁ 0)) := by + intro P hP + have hP1 : walkInternal 99 (P ++ [1]) = some q₁ := walkInternal_snoc hP htr1 hq₁ + have hev0 : evalStack (trimZeros P) = .decnz r₁ (P ++ [1]) (retStack P) := by + rw [evalStack_trimZeros_of_walkInternal hP, + evalStack_leaf0_of_walkInternal hP htr0 hdec29 hdec50] + simp [hdec, hlr1] + have hev10 : evalStack (P ++ [1]) = .inc r₂ (P ++ [1] ++ [1]) := by + have h := evalStack_leaf0_of_walkInternal hP1 htr10 hinc29 hinc50 + simpa [hinc, hlr2] using h + have hev11 : evalStack (P ++ [1] ++ [1]) = .jump (trimZeros P) := by + have h := evalStack_continue1_of_walkInternal (P := P ++ [1]) (k := 1) (by omega) hP1 htr11 + simpa [popContinueRev_zero_eq_dropLeadingZeros, trimZeros] using h + have hloop := ind1_subEval_loop (M := M) (trimZeros P) (retStack P) + (fun v regs ↦ regs.getD r₁ 0 = v) + (fun v regs ↦ (regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + v)) + (paDef_eq (paFunRegs_getD paFunRegs_regsOfVec13 r₁) (paFun_proj 0)) + (paFunRegs_set (paFunRegs_set paFunRegs_regsOfVec13 r₁ (paFun_const 0)) r₂ + (paFun_add (paFunRegs_getD paFunRegs_regsOfVec13 r₂) (paFun_proj 0))) + (fun slot regs hinv hv ↦ by + obtain ⟨slot', hinv', hreach⟩ := mLogStep_of_decnz_zero hinv hev0 hv + have hset : (regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + 0) = regs := by + rw [add_zero, mSet_eq_self_of_getD_eq hv, mSet_getD_self] + rw [hset] + exact ⟨slot', hinv', hreach⟩) + (fun v ih slot regs hinv hv ↦ by + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev0 hv + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_inc hinv₁ hev10 + rw [mGetD_set_ne _ _ hne] at hinv₂ hreach₂ + let regs₁ := (regs.set r₁ v).set r₂ (regs.getD r₂ 0 + 1) + obtain ⟨slot₃, hinv₃, hreach₃⟩ := mLogStep_of_jump (regs := regs₁) hinv₂ hev11 + have hv₁ : regs₁.getD r₁ 0 = v := by + dsimp [regs₁] + rw [mGetD_set_ne _ _ hne.symm, mGetD_set_self regs r₁ v (by rw [hinv.1]; exact hr₁)] + obtain ⟨slot₄, hinv₄, hreach₄⟩ := ih slot₃ regs₁ hinv₃ hv₁ + have hregs_eq : (regs₁.set r₁ 0).set r₂ (regs₁.getD r₂ 0 + v) = + (regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + (v + 1)) := by + have hr₂_get : regs₁.getD r₂ 0 = regs.getD r₂ 0 + 1 := + mGetD_set_self (regs.set r₁ v) r₂ (regs.getD r₂ 0 + 1) + (by rw [List.length_set, hinv.1]; exact _hr₂) + rw [hr₂_get] + dsimp only [regs₁] + rw [mSet_comm_of_ne (regs.set r₁ v) (regs.getD r₂ 0 + 1) 0 hne.symm, + List.set_set, List.set_set, add_assoc, add_comm 1 v] + rw [hregs_eq] at hinv₄ hreach₄ + exact ⟨slot₄, hinv₄, mReachPos_trans hreach₁ + (mReachPos_trans hreach₂ (mReachPos_trans hreach₃ hreach₄))⟩) + intro slot regs hinv + exact ⟨by simp [hinv.1], hloop (regs.getD r₁ 0) slot regs hinv rfl⟩ + +theorem mSubEval_while_move2 {q q_dec q₁ q₂ q_inc1 q_inc2 : Fin 393} (r₁ r₂ r₃ : ℕ) + (hr₁ : r₁ < 11) (hr₂ : r₂ < 11) (hr₃ : r₃ < 11) + (hne12 : r₁ ≠ r₂) (hne13 : r₁ ≠ r₃) (hne23 : r₂ ≠ r₃) + (htr0 : zf393Trans q 0 = some (0, .right, q_dec)) + (hdec29 : 29 ≤ q_dec.val) (hdec50 : q_dec.val ≤ 50) (hdec : isLeafInc q_dec = false) + (hlr1 : logLeafReg q_dec = r₁) + (htr1 : zf393Trans q 1 = some (1, .right, q₁)) (hq₁ : 69 ≤ q₁.val) + (htr10 : zf393Trans q₁ 0 = some (0, .right, q₂)) (hq₂ : 69 ≤ q₂.val) + (htr11 : zf393Trans q₁ 1 = some (0, .left, 65)) + (htr20 : zf393Trans q₂ 0 = some (0, .right, q_inc1)) + (hinc1_29 : 29 ≤ q_inc1.val) (hinc1_50 : q_inc1.val ≤ 50) (hinc1 : isLeafInc q_inc1 = true) + (hlr2 : logLeafReg q_inc1 = r₂) + (htr21 : zf393Trans q₂ 1 = some (1, .right, q_inc2)) + (hinc2_29 : 29 ≤ q_inc2.val) (hinc2_50 : q_inc2.val ≤ 50) (hinc2 : isLeafInc q_inc2 = true) + (hlr3 : logLeafReg q_inc2 = r₃) : + MSubEval (M := M) q (fun regs ↦ + ((regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + regs.getD r₁ 0)).set + r₃ (regs.getD r₃ 0 + regs.getD r₁ 0)) := by + intro P hP + have hP1 : walkInternal 99 (P ++ [1]) = some q₁ := walkInternal_snoc hP htr1 hq₁ + have hP10 : walkInternal 99 (P ++ [1] ++ [0]) = some q₂ := walkInternal_snoc hP1 htr10 hq₂ + have hbody := mSubEval_inc_inc (M := M) htr20 hinc1_29 hinc1_50 hinc1 + htr21 hinc2_29 hinc2_50 hinc2 + have hev0 : evalStack (trimZeros P) = .decnz r₁ (P ++ [1]) (retStack P) := by + rw [evalStack_trimZeros_of_walkInternal hP, + evalStack_leaf0_of_walkInternal hP htr0 hdec29 hdec50] + simp [hdec, hlr1] + have hev11 : evalStack (P ++ [1] ++ [1]) = .jump (trimZeros P) := by + have h := evalStack_continue1_of_walkInternal (P := P ++ [1]) (k := 1) (by omega) hP1 htr11 + simpa [popContinueRev_zero_eq_dropLeadingZeros, trimZeros] using h + have hloop := ind1_subEval_loop (M := M) (trimZeros P) (retStack P) + (fun v regs ↦ regs.getD r₁ 0 = v) + (fun v regs ↦ ((regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + v)).set r₃ (regs.getD r₃ 0 + v)) + (paDef_eq (paFunRegs_getD paFunRegs_regsOfVec13 r₁) (paFun_proj 0)) + (paFunRegs_set + (paFunRegs_set (paFunRegs_set paFunRegs_regsOfVec13 r₁ (paFun_const 0)) r₂ + (paFun_add (paFunRegs_getD paFunRegs_regsOfVec13 r₂) (paFun_proj 0))) + r₃ (paFun_add (paFunRegs_getD paFunRegs_regsOfVec13 r₃) (paFun_proj 0))) + (fun slot regs hinv hv ↦ by + obtain ⟨slot', hinv', hreach⟩ := mLogStep_of_decnz_zero hinv hev0 hv + have hset : + ((regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + 0)).set r₃ (regs.getD r₃ 0 + 0) = regs := by + rw [add_zero, add_zero, mSet_eq_self_of_getD_eq hv, mSet_getD_self, mSet_getD_self] + rw [hset] + exact ⟨slot', hinv', hreach⟩) + (fun v ih slot regs hinv hv ↦ by + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev0 hv + have hinv10 : MZfLogInv slot₁ (trimZeros (P ++ [1] ++ [0])) (regs.set r₁ v) := by + rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨_, slot₂, hinv₂, hreach_b⟩ := + hbody (P ++ [1] ++ [0]) hP10 slot₁ (regs.set r₁ v) hinv10 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero, hlr2, hlr3] at hreach_b + rw [retStack_append_zero, hlr2, hlr3] at hinv₂ + let regs₁ := ((regs.set r₁ v).set r₂ (regs.getD r₂ 0 + 1)).set r₃ (regs.getD r₃ 0 + 1) + have hb_eq : ((regs.set r₁ v).set r₂ ((regs.set r₁ v).getD r₂ 0 + 1)).set + r₃ (((regs.set r₁ v).set r₂ ((regs.set r₁ v).getD r₂ 0 + 1)).getD r₃ 0 + 1) = regs₁ := by + dsimp only [regs₁] + rw [mGetD_set_ne _ _ hne12, mGetD_set_ne _ _ hne23, mGetD_set_ne _ _ hne13] + dsimp only at hinv₂ hreach_b + rw [hb_eq] at hinv₂ hreach_b + obtain ⟨slot₃, hinv₃, hreach₃⟩ := mLogStep_of_jump (regs := regs₁) hinv₂ hev11 + have hv₁ : regs₁.getD r₁ 0 = v := by + dsimp [regs₁] + rw [mGetD_set_ne _ _ hne13.symm, mGetD_set_ne _ _ hne12.symm, + mGetD_set_self regs r₁ v (by rw [hinv.1]; exact hr₁)] + obtain ⟨slot₄, hinv₄, hreach₄⟩ := ih slot₃ regs₁ hinv₃ hv₁ + have hregs_eq : + ((regs₁.set r₁ 0).set r₂ (regs₁.getD r₂ 0 + v)).set r₃ (regs₁.getD r₃ 0 + v) = + ((regs.set r₁ 0).set r₂ (regs.getD r₂ 0 + (v + 1))).set + r₃ (regs.getD r₃ 0 + (v + 1)) := by + have hr₂_get : regs₁.getD r₂ 0 = regs.getD r₂ 0 + 1 := by + dsimp [regs₁] + rw [mGetD_set_ne _ _ hne23.symm, + mGetD_set_self (regs.set r₁ v) r₂ (regs.getD r₂ 0 + 1) + (by rw [List.length_set, hinv.1]; exact hr₂)] + have hr₃_get : regs₁.getD r₃ 0 = regs.getD r₃ 0 + 1 := by + dsimp [regs₁] + exact mGetD_set_self _ r₃ (regs.getD r₃ 0 + 1) + (by rw [List.length_set, List.length_set, hinv.1]; exact hr₃) + rw [hr₂_get, hr₃_get] + dsimp only [regs₁] + rw [mSet_comm_of_ne _ (regs.getD r₃ 0 + 1) 0 hne13.symm, + mSet_comm_of_ne (regs.set r₁ v) (regs.getD r₂ 0 + 1) 0 hne12.symm, + List.set_set, + mSet_comm_of_ne _ (regs.getD r₃ 0 + 1) (regs.getD r₂ 0 + 1 + v) hne23.symm, + List.set_set, List.set_set, + add_assoc (regs.getD r₂ 0) 1 v, add_comm (1 : PAM M) v, + add_assoc (regs.getD r₃ 0) 1 v, add_comm (1 : PAM M) v] + rw [hregs_eq] at hinv₄ hreach₄ + exact ⟨slot₄, hinv₄, mReachPos_trans hreach₁ + (mReachPos_trans hreach_b (mReachPos_trans hreach₃ hreach₄))⟩) + intro slot regs hinv + exact ⟨by simp [hinv.1], hloop (regs.getD r₁ 0) slot regs hinv rfl⟩ + +/-- Closed-form Cantor pairing register operation `pair(out, r1, r2)` on `PAM M`. -/ +noncomputable def mRegPairOp (out r1 r2 : ℕ) (regs : List (PAM M)) : List (PAM M) := + ((regs.set r1 0).set r2 0).set out + (regs.getD out 0 + mPair (regs.getD r1 0) (regs.getD r2 0)) + +theorem paFunRegs_mRegPairOp (out r1 r2 : ℕ) {n : ℕ} {R : (Fin n → PAM M) → List (PAM M)} + (hR : PAFunRegs n R) : PAFunRegs n (fun u ↦ mRegPairOp out r1 r2 (R u)) := + paFunRegs_set (paFunRegs_set (paFunRegs_set hR r1 (paFun_const 0)) r2 (paFun_const 0)) out + (paFun_add (paFunRegs_getD hR out) + (paFun_mPair (paFunRegs_getD hR r1) (paFunRegs_getD hR r2))) + +theorem mSubEval_pair {q q_move2 q1 q_dec q2 q3 : Fin 393} (out r1 r2 : ℕ) + (hout : out < 11) (hr1 : r1 < 11) (hr2 : r2 < 11) + (hne12 : r1 ≠ r2) (hne1o : r1 ≠ out) (hne2o : r2 ≠ out) + (htr0 : zf393Trans q 0 = some (0, .right, q_move2)) (hq_move2 : 69 ≤ q_move2.val) + (htr1 : zf393Trans q 1 = some (1, .right, q1)) (hq1 : 69 ≤ q1.val) + (htr10 : zf393Trans q1 0 = some (0, .right, q_dec)) + (hdec29 : 29 ≤ q_dec.val) (hdec50 : q_dec.val ≤ 50) (hdec : isLeafInc q_dec = false) + (hlr_dec : logLeafReg q_dec = r2) + (htr11 : zf393Trans q1 1 = some (1, .right, q2)) (hq2 : 69 ≤ q2.val) + (htr20 : zf393Trans q2 0 = some (0, .right, q3)) (hq3 : 69 ≤ q3.val) + (htr21 : zf393Trans q2 1 = some (0, .left, 66)) + (hmove2 : MSubEval (M := M) q_move2 (fun regs ↦ + ((regs.set r1 0).set r2 (regs.getD r2 0 + regs.getD r1 0)).set + out (regs.getD out 0 + regs.getD r1 0))) + (hbody : MSubEval (M := M) q3 (fun regs ↦ + let r₀ := regs.set out (regs.getD out 0 + 1) + (r₀.set r2 0).set r1 (r₀.getD r1 0 + r₀.getD r2 0))) : + MSubEval (M := M) q (mRegPairOp out r1 r2) := by + intro P hP + have hP0 : walkInternal 99 (P ++ [0]) = some q_move2 := walkInternal_snoc hP htr0 hq_move2 + have hP1 : walkInternal 99 (P ++ [1]) = some q1 := walkInternal_snoc hP htr1 hq1 + have hP11 : walkInternal 99 (P ++ [1] ++ [1]) = some q2 := walkInternal_snoc hP1 htr11 hq2 + have hP110 : walkInternal 99 (P ++ [1] ++ [1] ++ [0]) = some q3 := + walkInternal_snoc hP11 htr20 hq3 + have hev10 : evalStack (P ++ [1]) = .decnz r2 (P ++ [1] ++ [1]) (retStack P) := by + have h := evalStack_leaf0_of_walkInternal hP1 htr10 hdec29 hdec50 + simpa [hdec, hlr_dec] using h + have hev21 : evalStack (P ++ [1] ++ [1] ++ [1]) = .jump (trimZeros P) := by + have h := + evalStack_continue1_of_walkInternal (P := P ++ [1] ++ [1]) (k := 2) (by omega) hP11 htr21 + simpa [popContinueRev_zero_eq_dropLeadingZeros, trimZeros] using h + have hloop := ind1_subEval_loop (M := M) (trimZeros P) (retStack P) + (fun n regs ↦ regs.getD r1 0 + regs.getD r2 0 = n) + (fun _ regs ↦ mRegPairOp out r1 r2 regs) + (paDef_eq + (paFun_add (paFunRegs_getD paFunRegs_regsOfVec13 r1) + (paFunRegs_getD paFunRegs_regsOfVec13 r2)) + (paFun_proj 0)) + (paFunRegs_mRegPairOp out r1 r2 paFunRegs_regsOfVec13) + (fun slot regs hinv hn ↦ by + obtain ⟨hr1_z, hr2_z⟩ := add_eq_zero_iff_pam.mp hn + have hinv0 : MZfLogInv slot (trimZeros (P ++ [0])) regs := by rwa [trimZeros_append_zero] + obtain ⟨_, slot₁, hinv₁, hreach₀⟩ := hmove2 (P ++ [0]) hP0 slot regs hinv0 + rw [trimZeros_append_zero, retStack_append_zero] at hreach₀ + rw [retStack_append_zero] at hinv₁ + dsimp only at hinv₁ hreach₀ + let regs₁ := ((regs.set r1 0).set r2 (regs.getD r2 0 + regs.getD r1 0)).set + out (regs.getD out 0 + regs.getD r1 0) + have hr2_zero : regs₁.getD r2 0 = 0 := by + dsimp [regs₁] + rw [mGetD_set_ne _ _ hne2o.symm, + mGetD_set_self _ r2 _ (by rw [List.length_set, hinv.1]; exact hr2), + hr1_z, hr2_z, add_zero] + obtain ⟨slot₂, hinv₂, hreach₁⟩ := mLogStep_of_decnz_zero (regs := regs₁) hinv₁ hev10 hr2_zero + have hreach₀₁ := mReachPos_trans hreach₀ hreach₁ + have hregs_eq : regs₁ = mRegPairOp out r1 r2 regs := by + dsimp [regs₁, mRegPairOp] + rw [hr1_z, hr2_z, add_zero, mPair_zero_zero] + rw [hregs_eq] at hinv₂ hreach₀₁ + exact ⟨slot₂, hinv₂, hreach₀₁⟩) + (fun m ih slot regs hinv hn ↦ by + have hinv0 : MZfLogInv slot (trimZeros (P ++ [0])) regs := by rwa [trimZeros_append_zero] + obtain ⟨_, slot₁, hinv₁, hreach₀⟩ := hmove2 (P ++ [0]) hP0 slot regs hinv0 + rw [trimZeros_append_zero, retStack_append_zero] at hreach₀ + rw [retStack_append_zero] at hinv₁ + dsimp only at hinv₁ hreach₀ + let regs₁ := ((regs.set r1 0).set r2 (regs.getD r2 0 + regs.getD r1 0)).set + out (regs.getD out 0 + regs.getD r1 0) + have hr2_succ : regs₁.getD r2 0 = m + 1 := by + dsimp [regs₁] + rw [mGetD_set_ne _ _ hne2o.symm, + mGetD_set_self _ r2 _ (by rw [List.length_set, hinv.1]; exact hr2), + add_comm, hn] + obtain ⟨slot₂, hinv₂, hreach₁⟩ := mLogStep_of_decnz_succ (regs := regs₁) hinv₁ hev10 hr2_succ + have hinv110 : MZfLogInv slot₂ (trimZeros (P ++ [1] ++ [1] ++ [0])) (regs₁.set r2 m) := by + rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨_, slot₃, hinv₃, hreach₃⟩ := + hbody (P ++ [1] ++ [1] ++ [0]) hP110 slot₂ (regs₁.set r2 m) hinv110 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero] at hreach₃ + rw [retStack_append_zero] at hinv₃ + dsimp only at hinv₃ hreach₃ + let regs₂ := ((regs.set r1 m).set r2 0).set out (regs.getD out 0 + regs.getD r1 0 + 1) + have hbody_eq : + (let r₀ := (regs₁.set r2 m).set out ((regs₁.set r2 m).getD out 0 + 1) + (r₀.set r2 0).set r1 (r₀.getD r1 0 + r₀.getD r2 0)) = regs₂ := by + dsimp only [regs₁, regs₂] + have hout_get : + ((((regs.set r1 0).set r2 (regs.getD r2 0 + regs.getD r1 0)).set + out (regs.getD out 0 + regs.getD r1 0)).set r2 m).getD out 0 = + regs.getD out 0 + regs.getD r1 0 := by + rw [mGetD_set_ne _ _ hne2o, + mGetD_set_self _ out _ (by simp [hinv.1, hout])] + rw [hout_get] + have hr0_eq : + ((((regs.set r1 0).set r2 (regs.getD r2 0 + regs.getD r1 0)).set + out (regs.getD out 0 + regs.getD r1 0)).set r2 m).set + out (regs.getD out 0 + regs.getD r1 0 + 1) = + ((regs.set r1 0).set r2 m).set out (regs.getD out 0 + regs.getD r1 0 + 1) := by + rw [mSet_comm_of_ne _ (regs.getD out 0 + regs.getD r1 0) m hne2o.symm, + List.set_set, List.set_set] + rw [hr0_eq] + have hr1_get : + (((regs.set r1 0).set r2 m).set + out (regs.getD out 0 + regs.getD r1 0 + 1)).getD r1 0 = 0 := by + rw [mGetD_set_ne _ _ hne1o.symm, mGetD_set_ne _ _ hne12.symm, + mGetD_set_self regs r1 0 (by rw [hinv.1]; exact hr1)] + have hr2_get : + (((regs.set r1 0).set r2 m).set + out (regs.getD out 0 + regs.getD r1 0 + 1)).getD r2 0 = m := by + rw [mGetD_set_ne _ _ hne2o.symm, mGetD_set_self _ r2 m (by simp [hinv.1, hr2])] + rw [hr1_get, hr2_get, zero_add, + mSet_comm_of_ne _ (regs.getD out 0 + regs.getD r1 0 + 1) 0 hne2o.symm, + List.set_set, + mSet_comm_of_ne _ (regs.getD out 0 + regs.getD r1 0 + 1) m hne1o.symm, + mSet_comm_of_ne (regs.set r1 0) 0 m hne12.symm, + List.set_set] + rw [hbody_eq] at hinv₃ hreach₃ + obtain ⟨slot₄, hinv₄, hreach_jmp⟩ := mLogStep_of_jump (regs := regs₂) hinv₃ hev21 + have hr1_₂ : regs₂.getD r1 0 = m := by + dsimp [regs₂] + rw [mGetD_set_ne _ _ hne1o.symm, mGetD_set_ne _ _ hne12.symm, + mGetD_set_self regs r1 m (by rw [hinv.1]; exact hr1)] + have hr2_₂ : regs₂.getD r2 0 = 0 := by + dsimp [regs₂] + rw [mGetD_set_ne _ _ hne2o.symm, mGetD_set_self _ r2 0 (by simp [hinv.1, hr2])] + have hout_₂ : regs₂.getD out 0 = regs.getD out 0 + regs.getD r1 0 + 1 := by + dsimp [regs₂] + exact mGetD_set_self _ out _ (by simp [hinv.1, hout]) + obtain ⟨slot₅, hinv₅, hreach_ih⟩ := + ih slot₄ regs₂ hinv₄ (by rw [hr1_₂, hr2_₂, add_zero]) + have hfinal_eq : mRegPairOp out r1 r2 regs₂ = mRegPairOp out r1 r2 regs := by + unfold mRegPairOp + rw [hout_₂, hr1_₂, hr2_₂, mPair_step_inv hn] + dsimp only [regs₂] + rw [mSet_comm_of_ne _ (regs.getD out 0 + regs.getD r1 0 + 1) 0 hne1o.symm, + mSet_comm_of_ne (regs.set r1 m) 0 0 hne12.symm, + List.set_set, + mSet_comm_of_ne _ (regs.getD out 0 + regs.getD r1 0 + 1) 0 hne2o.symm, + List.set_set, List.set_set] + rw [hfinal_eq] at hinv₅ hreach_ih + exact ⟨slot₅, hinv₅, mReachPos_trans hreach₀ + (mReachPos_trans hreach₁ + (mReachPos_trans hreach₃ (mReachPos_trans hreach_jmp hreach_ih)))⟩) + intro slot regs hinv + exact ⟨by simp [mRegPairOp, hinv.1], + hloop (regs.getD r1 0 + regs.getD r2 0) slot regs hinv rfl⟩ + +/-- Closed-form Cantor unpairing register operation `unpair(out1, out2, rin)` on `PAM M`. -/ +noncomputable def mRegUnpairGen (out1 out2 rin : ℕ) (regs : List (PAM M)) : List (PAM M) := + let p := mUnpair (regs.getD rin 0 + mPair (regs.getD out1 0) (regs.getD out2 0)) + ((regs.set rin 0).set out1 p.1).set out2 p.2 + +theorem paFunRegs_mRegUnpairGen (out1 out2 rin : ℕ) {n : ℕ} {R : (Fin n → PAM M) → List (PAM M)} + (hR : PAFunRegs n R) : PAFunRegs n (fun u ↦ mRegUnpairGen out1 out2 rin (R u)) := by + have harg : PAFunN n (fun u ↦ + (R u).getD rin 0 + mPair ((R u).getD out1 0) ((R u).getD out2 0)) := + paFun_add (paFunRegs_getD hR rin) + (paFun_mPair (paFunRegs_getD hR out1) (paFunRegs_getD hR out2)) + exact paFunRegs_set + (paFunRegs_set (paFunRegs_set hR rin (paFun_const 0)) out1 (paFun_mUnpair_fst harg)) + out2 (paFun_mUnpair_snd harg) + +theorem mSubEval_unpair {q q_dec q1 q_inc1 q2 q3 q_move : Fin 393} (out1 rin : ℕ) + (hout1 : out1 < 11) (hrin : rin < 11) + (hne_in_1 : rin ≠ out1) (hne_in_9 : rin ≠ 9) (hne_1_9 : out1 ≠ 9) + (htr0 : zf393Trans q 0 = some (0, .right, q_dec)) + (hdec29 : 29 ≤ q_dec.val) (hdec50 : q_dec.val ≤ 50) (hdec : isLeafInc q_dec = false) + (hlr_dec : logLeafReg q_dec = rin) + (htr1 : zf393Trans q 1 = some (1, .right, q1)) (hq1 : 69 ≤ q1.val) + (htr10 : zf393Trans q1 0 = some (0, .right, q_inc1)) + (hinc29 : 29 ≤ q_inc1.val) (hinc50 : q_inc1.val ≤ 50) (hinc : isLeafInc q_inc1 = true) + (hlr_inc : logLeafReg q_inc1 = out1) + (htr11 : zf393Trans q1 1 = some (1, .right, q2)) (hq2 : 69 ≤ q2.val) + (htr20 : zf393Trans q2 0 = some (0, .right, 309)) + (htr21 : zf393Trans q2 1 = some (1, .right, q3)) (hq3 : 69 ≤ q3.val) + (htr30 : zf393Trans q3 0 = some (0, .right, q_move)) (hq_move : 69 ≤ q_move.val) + (htr31 : zf393Trans q3 1 = some (0, .left, 67)) + (hmove : MSubEval (M := M) q_move (fun regs ↦ + (regs.set out1 0).set 9 (regs.getD 9 0 + regs.getD out1 0))) : + MSubEval (M := M) q (mRegUnpairGen out1 9 rin) := by + intro P hP + have hP1 : walkInternal 99 (P ++ [1]) = some q1 := walkInternal_snoc hP htr1 hq1 + have hP11 : walkInternal 99 (P ++ [1] ++ [1]) = some q2 := walkInternal_snoc hP1 htr11 hq2 + have hP110 : walkInternal 99 (P ++ [1] ++ [1] ++ [0]) = some 309 := + walkInternal_snoc hP11 htr20 (by decide) + have hP111 : walkInternal 99 (P ++ [1] ++ [1] ++ [1]) = some q3 := + walkInternal_snoc hP11 htr21 hq3 + have hP1110 : walkInternal 99 (P ++ [1] ++ [1] ++ [1] ++ [0]) = some q_move := + walkInternal_snoc hP111 htr30 hq_move + have hev0 : evalStack (trimZeros P) = .decnz rin (P ++ [1]) (retStack P) := by + rw [evalStack_trimZeros_of_walkInternal hP, + evalStack_leaf0_of_walkInternal hP htr0 hdec29 hdec50] + simp [hdec, hlr_dec] + have hev10 : evalStack (P ++ [1]) = .inc out1 (P ++ [1] ++ [1]) := by + have h := evalStack_leaf0_of_walkInternal hP1 htr10 hinc29 hinc50 + simpa [hinc, hlr_inc] using h + have hev11 : evalStack (P ++ [1] ++ [1]) = + .decnz 9 (P ++ [1] ++ [1] ++ [0] ++ [1]) (P ++ [1] ++ [1] ++ [1]) := by + have htrim := evalStack_trimZeros_of_walkInternal hP110 + rw [trimZeros_append_zero, trimZeros_append_one] at htrim + have hleaf := evalStack_leaf0_of_walkInternal (q' := 43) hP110 rfl (by decide) (by decide) + rw [htrim, hleaf, retStack_append_zero] + rfl + have hev1101 : evalStack (P ++ [1] ++ [1] ++ [0] ++ [1]) = .jump (trimZeros P) := by + have h := evalStack_continue1_of_walkInternal + (P := P ++ [1] ++ [1] ++ [0]) (k := 2) (by omega) hP110 rfl + simpa [popContinueRev_zero_eq_dropLeadingZeros, trimZeros] using h + have hev1111 : evalStack (P ++ [1] ++ [1] ++ [1] ++ [1]) = .jump (trimZeros P) := by + have h := evalStack_continue1_of_walkInternal + (P := P ++ [1] ++ [1] ++ [1]) (k := 3) (by omega) hP111 htr31 + simpa [popContinueRev_zero_eq_dropLeadingZeros, trimZeros] using h + have hloop := ind1_subEval_loop (M := M) (trimZeros P) (retStack P) + (fun z regs ↦ regs.getD rin 0 = z) + (fun _ regs ↦ mRegUnpairGen out1 9 rin regs) + (paDef_eq (paFunRegs_getD paFunRegs_regsOfVec13 rin) (paFun_proj 0)) + (paFunRegs_mRegUnpairGen out1 9 rin paFunRegs_regsOfVec13) + (fun slot regs hinv hz ↦ by + obtain ⟨slot', hinv', hreach⟩ := mLogStep_of_decnz_zero hinv hev0 hz + have hset : mRegUnpairGen out1 9 rin regs = regs := by + unfold mRegUnpairGen + rw [hz, zero_add, mUnpair_mPair] + dsimp only + rw [mSet_eq_self_of_getD_eq hz, mSet_getD_self, mSet_getD_self] + rw [hset] + exact ⟨slot', hinv', hreach⟩) + (fun z ih slot regs hinv hz ↦ by + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev0 hz + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_inc hinv₁ hev10 + rw [mGetD_set_ne _ _ hne_in_1] at hinv₂ hreach₂ + let regs₁ := (regs.set rin z).set out1 (regs.getD out1 0 + 1) + have hr9_₁ : regs₁.getD 9 0 = regs.getD 9 0 := by + dsimp [regs₁] + rw [mGetD_set_ne _ _ hne_1_9, mGetD_set_ne _ _ hne_in_9] + rcases eq_zero_or_exists_succ (regs.getD 9 0) with hy | ⟨y, hy⟩ + · obtain ⟨slot₃, hinv₃, hreach₃⟩ := + mLogStep_of_decnz_zero (regs := regs₁) hinv₂ hev11 (by rw [hr9_₁, hy]) + have hinv1110 : MZfLogInv slot₃ (trimZeros (P ++ [1] ++ [1] ++ [1] ++ [0])) regs₁ := by + rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨_, slot₄, hinv₄, hreach_m⟩ := + hmove (P ++ [1] ++ [1] ++ [1] ++ [0]) hP1110 slot₃ regs₁ hinv1110 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero] at hreach_m + rw [retStack_append_zero] at hinv₄ + dsimp only at hinv₄ hreach_m + let regs₂ := ((regs.set rin z).set out1 0).set 9 (regs.getD out1 0 + 1) + have hm_eq : + (regs₁.set out1 0).set 9 (regs₁.getD 9 0 + regs₁.getD out1 0) = regs₂ := by + rw [hr9_₁, hy, zero_add] + dsimp [regs₁, regs₂] + rw [mGetD_set_self _ out1 _ (by simp [hinv.1, hout1]), List.set_set] + rw [hm_eq] at hinv₄ hreach_m + obtain ⟨slot₅, hinv₅, hreach_jmp⟩ := mLogStep_of_jump (regs := regs₂) hinv₄ hev1111 + have hrin_₂ : regs₂.getD rin 0 = z := by + dsimp [regs₂] + rw [mGetD_set_ne _ _ hne_in_9.symm, mGetD_set_ne _ _ hne_in_1.symm, + mGetD_set_self regs rin z (by rw [hinv.1]; exact hrin)] + obtain ⟨slot₆, hinv₆, hreach_ih⟩ := ih slot₅ regs₂ hinv₅ hrin_₂ + have hgen_eq : mRegUnpairGen out1 9 rin regs₂ = mRegUnpairGen out1 9 rin regs := by + unfold mRegUnpairGen + have hout1_₂ : regs₂.getD out1 0 = 0 := by + dsimp [regs₂] + rw [mGetD_set_ne _ _ hne_1_9.symm, mGetD_set_self _ out1 0 (by simp [hinv.1, hout1])] + have hr9_₂ : regs₂.getD 9 0 = regs.getD out1 0 + 1 := by + dsimp [regs₂] + exact mGetD_set_self _ 9 _ (by simp [hinv.1]) + have hpair_eq : z + mPair 0 (regs.getD out1 0 + 1) = + (z + 1) + mPair (regs.getD out1 0) 0 := by + rw [mPair_zero_succ] + ring + rw [hrin_₂, hout1_₂, hr9_₂, hz, hy, hpair_eq] + dsimp only [regs₂] + rw [mSet_comm_of_ne _ (regs.getD out1 0 + 1) 0 hne_in_9.symm, + mSet_comm_of_ne (regs.set rin z) 0 0 hne_in_1.symm, + List.set_set, + mSet_comm_of_ne _ (regs.getD out1 0 + 1) _ hne_1_9.symm, + List.set_set, List.set_set] + rw [hgen_eq] at hinv₆ hreach_ih + exact ⟨slot₆, hinv₆, mReachPos_trans hreach₁ + (mReachPos_trans hreach₂ + (mReachPos_trans hreach₃ + (mReachPos_trans hreach_m (mReachPos_trans hreach_jmp hreach_ih))))⟩ + · obtain ⟨slot₃, hinv₃, hreach₃⟩ := + mLogStep_of_decnz_succ (regs := regs₁) hinv₂ hev11 (by rw [hr9_₁, hy]) + let regs₂ := regs₁.set 9 y + obtain ⟨slot₄, hinv₄, hreach_jmp⟩ := mLogStep_of_jump (regs := regs₂) hinv₃ hev1101 + have hrin_₂ : regs₂.getD rin 0 = z := by + dsimp [regs₂, regs₁] + rw [mGetD_set_ne _ _ hne_in_9.symm, mGetD_set_ne _ _ hne_in_1.symm, + mGetD_set_self regs rin z (by rw [hinv.1]; exact hrin)] + obtain ⟨slot₅, hinv₅, hreach_ih⟩ := ih slot₄ regs₂ hinv₄ hrin_₂ + have hgen_eq : mRegUnpairGen out1 9 rin regs₂ = mRegUnpairGen out1 9 rin regs := by + unfold mRegUnpairGen + have hout1_₂ : regs₂.getD out1 0 = regs.getD out1 0 + 1 := by + dsimp [regs₂, regs₁] + rw [mGetD_set_ne _ _ hne_1_9.symm, + mGetD_set_self _ out1 _ (by simp [hinv.1, hout1])] + have hr9_₂ : regs₂.getD 9 0 = y := by + dsimp [regs₂, regs₁] + exact mGetD_set_self _ 9 y (by simp [hinv.1]) + have hpair_eq : z + mPair (regs.getD out1 0 + 1) y = + (z + 1) + mPair (regs.getD out1 0) (y + 1) := by + rw [mPair_succ_left] + ring + rw [hrin_₂, hout1_₂, hr9_₂, hz, hy, hpair_eq] + dsimp only [regs₂, regs₁] + rw [mSet_comm_of_ne _ y 0 hne_in_9.symm, + mSet_comm_of_ne (regs.set rin z) (regs.getD out1 0 + 1) 0 hne_in_1.symm, + List.set_set, + mSet_comm_of_ne _ y _ hne_1_9.symm, + List.set_set, List.set_set] + rw [hgen_eq] at hinv₅ hreach_ih + exact ⟨slot₅, hinv₅, mReachPos_trans hreach₁ + (mReachPos_trans hreach₂ + (mReachPos_trans hreach₃ (mReachPos_trans hreach_jmp hreach_ih)))⟩) + intro slot regs hinv + exact ⟨by simp [mRegUnpairGen, hinv.1], hloop (regs.getD rin 0) slot regs hinv rfl⟩ + +/-! ## Section 4: Concrete Subroutine Instantiations (`69..392`) -/ + +theorem mSubEval_342 : MSubEval (M := M) 342 (fun regs ↦ regs.set 4 0) := + mSubEval_while_clear 4 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_346 : MSubEval (M := M) 346 (fun regs ↦ regs.set 5 0) := + mSubEval_while_clear 5 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_352 : MSubEval (M := M) 352 (fun regs ↦ regs.set 6 0) := + mSubEval_while_clear 6 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_356 : MSubEval (M := M) 356 (fun regs ↦ regs.set 7 0) := + mSubEval_while_clear 7 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_359 : MSubEval (M := M) 359 (fun regs ↦ regs.set 8 0) := + mSubEval_while_clear 8 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_376 : MSubEval (M := M) 376 (fun regs ↦ regs.set 9 0) := + mSubEval_while_clear 9 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_381 : MSubEval (M := M) 381 (fun regs ↦ regs.set 10 0) := + mSubEval_while_clear 10 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_382 : MSubEval (M := M) 382 (fun regs ↦ regs.set 2 0) := + mSubEval_while_clear 2 (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_360 : + MSubEval (M := M) 360 (fun regs ↦ (regs.set 8 0).set 4 (regs.getD 4 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 4 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_362 : + MSubEval (M := M) 362 (fun regs ↦ (regs.set 8 0).set 1 (regs.getD 1 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 1 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_364 : + MSubEval (M := M) 364 (fun regs ↦ (regs.set 8 0).set 5 (regs.getD 5 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 5 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_366 : + MSubEval (M := M) 366 (fun regs ↦ (regs.set 8 0).set 6 (regs.getD 6 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 6 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_368 : + MSubEval (M := M) 368 (fun regs ↦ (regs.set 8 0).set 7 (regs.getD 7 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 7 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_370 : + MSubEval (M := M) 370 (fun regs ↦ (regs.set 8 0).set 9 (regs.getD 9 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 9 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_371 : + MSubEval (M := M) 371 (fun regs ↦ (regs.set 8 0).set 2 (regs.getD 2 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 2 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_372 : + MSubEval (M := M) 372 (fun regs ↦ (regs.set 8 0).set 3 (regs.getD 3 0 + regs.getD 8 0)) := + mSubEval_while_move1 8 3 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_377 : + MSubEval (M := M) 377 (fun regs ↦ (regs.set 9 0).set 0 (regs.getD 0 0 + regs.getD 9 0)) := + mSubEval_while_move1 9 0 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_379 : + MSubEval (M := M) 379 (fun regs ↦ (regs.set 9 0).set 2 (regs.getD 2 0 + regs.getD 9 0)) := + mSubEval_while_move1 9 2 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_380 : + MSubEval (M := M) 380 (fun regs ↦ (regs.set 9 0).set 3 (regs.getD 3 0 + regs.getD 9 0)) := + mSubEval_while_move1 9 3 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_386 : + MSubEval (M := M) 386 (fun regs ↦ (regs.set 2 0).set 8 (regs.getD 8 0 + regs.getD 2 0)) := + mSubEval_while_move1 2 8 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_388 : + MSubEval (M := M) 388 (fun regs ↦ (regs.set 2 0).set 9 (regs.getD 9 0 + regs.getD 2 0)) := + mSubEval_while_move1 2 9 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_389 : + MSubEval (M := M) 389 (fun regs ↦ (regs.set 3 0).set 2 (regs.getD 2 0 + regs.getD 3 0)) := + mSubEval_while_move1 3 2 (by decide) (by decide) (by decide) rfl (by decide) (by decide) + rfl rfl rfl (by decide) rfl (by decide) (by decide) rfl rfl rfl + +theorem mSubEval_343 : + MSubEval (M := M) 343 (fun regs ↦ + ((regs.set 1 0).set 8 (regs.getD 8 0 + regs.getD 1 0)).set + 0 (regs.getD 0 0 + regs.getD 1 0)) := + mSubEval_while_move2 1 8 0 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_351 : + MSubEval (M := M) 351 (fun regs ↦ + ((regs.set 5 0).set 8 (regs.getD 8 0 + regs.getD 5 0)).set + 9 (regs.getD 9 0 + regs.getD 5 0)) := + mSubEval_while_move2 5 8 9 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_347 : + MSubEval (M := M) 347 (fun regs ↦ + ((regs.set 5 0).set 2 (regs.getD 2 0 + regs.getD 5 0)).set + 8 (regs.getD 8 0 + regs.getD 5 0)) := + mSubEval_while_move2 5 2 8 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_348 : + MSubEval (M := M) 348 (fun regs ↦ + ((regs.set 5 0).set 8 (regs.getD 8 0 + regs.getD 5 0)).set + 2 (regs.getD 2 0 + regs.getD 5 0)) := + mSubEval_while_move2 5 8 2 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_355 : + MSubEval (M := M) 355 (fun regs ↦ + ((regs.set 6 0).set 8 (regs.getD 8 0 + regs.getD 6 0)).set + 9 (regs.getD 9 0 + regs.getD 6 0)) := + mSubEval_while_move2 6 8 9 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_353 : + MSubEval (M := M) 353 (fun regs ↦ + ((regs.set 6 0).set 2 (regs.getD 2 0 + regs.getD 6 0)).set + 8 (regs.getD 8 0 + regs.getD 6 0)) := + mSubEval_while_move2 6 2 8 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_354 : + MSubEval (M := M) 354 (fun regs ↦ + ((regs.set 6 0).set 8 (regs.getD 8 0 + regs.getD 6 0)).set + 10 (regs.getD 10 0 + regs.getD 6 0)) := + mSubEval_while_move2 6 8 10 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_357 : + MSubEval (M := M) 357 (fun regs ↦ + ((regs.set 7 0).set 2 (regs.getD 2 0 + regs.getD 7 0)).set + 8 (regs.getD 8 0 + regs.getD 7 0)) := + mSubEval_while_move2 7 2 8 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_358 : + MSubEval (M := M) 358 (fun regs ↦ + ((regs.set 7 0).set 8 (regs.getD 8 0 + regs.getD 7 0)).set + 10 (regs.getD 10 0 + regs.getD 7 0)) := + mSubEval_while_move2 7 8 10 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_373 : + MSubEval (M := M) 373 (fun regs ↦ + ((regs.set 8 0).set 2 (regs.getD 2 0 + regs.getD 8 0)).set + 9 (regs.getD 9 0 + regs.getD 8 0)) := + mSubEval_while_move2 8 2 9 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_383 : + MSubEval (M := M) 383 (fun regs ↦ + ((regs.set 2 0).set 3 (regs.getD 3 0 + regs.getD 2 0)).set + 8 (regs.getD 8 0 + regs.getD 2 0)) := + mSubEval_while_move2 2 3 8 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl rfl (by decide) (by decide) rfl rfl + rfl (by decide) (by decide) rfl rfl + +theorem mSubEval_293 : + MSubEval (M := M) 293 (fun regs ↦ + let r₀ := regs.set 8 (regs.getD 8 0 + 1) + (r₀.set 3 0).set 2 (r₀.getD 2 0 + r₀.getD 3 0)) := + mSubEval_inc_seq (q₀ := 42) rfl (by decide) (by decide) rfl rfl (by decide) mSubEval_389 + +theorem mSubEval_297 : + MSubEval (M := M) 297 (fun regs ↦ + let r₀ := regs.set 9 (regs.getD 9 0 + 1) + (r₀.set 2 0).set 8 (r₀.getD 8 0 + r₀.getD 2 0)) := + mSubEval_inc_seq (q₀ := 44) rfl (by decide) (by decide) rfl rfl (by decide) mSubEval_386 + +theorem mSubEval_290 : MSubEval (M := M) 290 (mRegPairOp 8 2 3) := + mSubEval_pair 8 2 3 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) + rfl (by decide) rfl (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl mSubEval_383 mSubEval_293 + +theorem mSubEval_294 : MSubEval (M := M) 294 (mRegPairOp 9 8 2) := + mSubEval_pair 9 8 2 (by decide) (by decide) (by decide) + (by decide) (by decide) (by decide) + rfl (by decide) rfl (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) rfl mSubEval_373 mSubEval_297 + +theorem mSubEval_313 : MSubEval (M := M) 313 (mRegUnpairGen 8 9 0) := + mSubEval_unpair 8 0 (by decide) (by decide) + (by decide) (by decide) (by decide) + rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl rfl (by decide) rfl (by decide) rfl mSubEval_370 + +theorem mSubEval_314 : MSubEval (M := M) 314 (mRegUnpairGen 8 9 3) := + mSubEval_unpair 8 3 (by decide) (by decide) + (by decide) (by decide) (by decide) + rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl rfl (by decide) rfl (by decide) rfl mSubEval_370 + +theorem mSubEval_315 : MSubEval (M := M) 315 (mRegUnpairGen 2 9 3) := + mSubEval_unpair 2 3 (by decide) (by decide) + (by decide) (by decide) (by decide) + rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl (by decide) (by decide) rfl rfl + rfl (by decide) rfl rfl (by decide) rfl (by decide) rfl mSubEval_388 + +noncomputable def mReg269Op (regs : List (PAM M)) : List (PAM M) := + let r := mRegUnpairGen 8 9 0 regs + (r.set 9 0).set 0 (r.getD 0 0 + r.getD 9 0) + +theorem mSubEval_269 : MSubEval (M := M) 269 mReg269Op := by + unfold mReg269Op + exact mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_313 mSubEval_377 + +noncomputable def mReg289Op (regs : List (PAM M)) : List (PAM M) := + let r := mRegUnpairGen 8 9 3 regs + (r.set 9 0).set 3 (r.getD 3 0 + r.getD 9 0) + +theorem mSubEval_289 : MSubEval (M := M) 289 mReg289Op := by + unfold mReg289Op + exact mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_314 mSubEval_380 + +noncomputable def mReg70Op (regs : List (PAM M)) : List (PAM M) := + let r := mRegPairOp 9 8 2 regs + (r.set 9 0).set 2 (r.getD 2 0 + r.getD 9 0) + +theorem mSubEval_70 : MSubEval (M := M) 70 mReg70Op := by + unfold mReg70Op + exact mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_294 mSubEval_379 + +noncomputable def mRegConsOp (regs : List (PAM M)) : List (PAM M) := + mReg70Op (mReg289Op regs) + +theorem mSubEval_69 : MSubEval (M := M) 69 mRegConsOp := by + unfold mRegConsOp + exact mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_289 mSubEval_70 + +noncomputable def mRegPushwffOp (regs : List (PAM M)) : List (PAM M) := + let r := mRegPairOp 8 2 3 regs + (r.set 8 0).set 3 (r.getD 3 0 + r.getD 8 0) + +theorem mSubEval_304 : MSubEval (M := M) 304 mRegPushwffOp := by + unfold mRegPushwffOp + exact mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_290 mSubEval_372 + +noncomputable def mRegV1Op (regs : List (PAM M)) : List (PAM M) := + let r := mRegPushwffOp regs + r.set 2 (r.getD 2 0 + 1) + +theorem mSubEval_319 : MSubEval (M := M) 319 mRegV1Op := by + unfold mRegV1Op + exact mSubEval_seq_inc (q₁ := 48) rfl (by decide) rfl (by decide) (by decide) rfl mSubEval_304 + +theorem mSubEval_288 : + MSubEval (M := M) 288 (fun regs ↦ regs.set 2 (regs.getD 2 0 + 2)) := by + refine (mSubEval_inc_inc (M := M) rfl (by decide) (by decide) rfl + rfl (by decide) (by decide) rfl).congr ?_ + intro regs hlen + change (regs.set 2 (regs.getD 2 0 + 1)).set 2 + ((regs.set 2 (regs.getD 2 0 + 1)).getD 2 0 + 1) = regs.set 2 (regs.getD 2 0 + 2) + rw [mGetD_set_self regs 2 (regs.getD 2 0 + 1) (by omega), List.set_set] + congr 1 + ring + +noncomputable def mRegV2Op (regs : List (PAM M)) : List (PAM M) := + let r := mRegV1Op regs + r.set 2 (r.getD 2 0 + 1) + +theorem mSubEval_320 : MSubEval (M := M) 320 mRegV2Op := by + refine (mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_304 mSubEval_288).congr ?_ + intro regs hlen + dsimp only [mRegV2Op, mRegV1Op] + have hlen0 : 2 < (mRegPushwffOp regs).length := by simp [mRegPushwffOp, mRegPairOp, hlen] + rw [mGetD_set_self (mRegPushwffOp regs) 2 _ hlen0, List.set_set] + congr 1 + ring + +noncomputable def mRegV3Op (regs : List (PAM M)) : List (PAM M) := + let r := mRegV2Op regs + r.set 2 (r.getD 2 0 + 1) + +theorem mSubEval_321 : MSubEval (M := M) 321 mRegV3Op := by + refine (mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_319 mSubEval_288).congr ?_ + intro regs hlen + dsimp only [mRegV3Op, mRegV2Op] + have hlen1 : 2 < (mRegV1Op regs).length := by simp [mRegV1Op, mRegPushwffOp, mRegPairOp, hlen] + rw [mGetD_set_self (mRegV1Op regs) 2 _ hlen1, List.set_set] + congr 1 + ring + +noncomputable def mRegV4Op (regs : List (PAM M)) : List (PAM M) := + let r := mRegV3Op regs + r.set 2 (r.getD 2 0 + 1) + +theorem mSubEval_322 : MSubEval (M := M) 322 mRegV4Op := by + refine (mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_320 mSubEval_288).congr ?_ + intro regs hlen + dsimp only [mRegV4Op, mRegV3Op] + have hlen2 : 2 < (mRegV2Op regs).length := by + simp [mRegV2Op, mRegV1Op, mRegPushwffOp, mRegPairOp, hlen] + rw [mGetD_set_self (mRegV2Op regs) 2 _ hlen2, List.set_set] + congr 1 + ring + +noncomputable def mReg330Op (regs : List (PAM M)) : List (PAM M) := + mRegConsOp (mRegPushwffOp regs) + +theorem mSubEval_330 : MSubEval (M := M) 330 mReg330Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_304 mSubEval_69 + +noncomputable def mRegWeqOp (regs : List (PAM M)) : List (PAM M) := + mReg330Op (mRegConsOp regs) + +theorem mSubEval_329 : MSubEval (M := M) 329 mRegWeqOp := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_69 mSubEval_330 + +noncomputable def mReg328Op (regs : List (PAM M)) : List (PAM M) := + mRegConsOp (mRegV1Op regs) + +theorem mSubEval_328 : MSubEval (M := M) 328 mReg328Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_319 mSubEval_69 + +noncomputable def mRegWelOp (regs : List (PAM M)) : List (PAM M) := + mReg328Op (mRegConsOp regs) + +theorem mSubEval_327 : MSubEval (M := M) 327 mRegWelOp := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_69 mSubEval_328 + +noncomputable def mReg391Op (regs : List (PAM M)) : List (PAM M) := + mRegConsOp (mRegV2Op regs) + +theorem mSubEval_391 : MSubEval (M := M) 391 mReg391Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_320 mSubEval_69 + +noncomputable def mRegWimOp (regs : List (PAM M)) : List (PAM M) := + mReg391Op (mRegConsOp regs) + +theorem mSubEval_390 : MSubEval (M := M) 390 mRegWimOp := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_69 mSubEval_391 + +noncomputable def mRegWnOp (regs : List (PAM M)) : List (PAM M) := + mRegConsOp (mRegV3Op regs) + +theorem mSubEval_392 : MSubEval (M := M) 392 mRegWnOp := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_321 mSubEval_69 + +noncomputable def mReg326Op (regs : List (PAM M)) : List (PAM M) := + mRegConsOp (mRegV4Op regs) + +theorem mSubEval_326 : MSubEval (M := M) 326 mReg326Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_322 mSubEval_69 + +noncomputable def mRegWalOp (regs : List (PAM M)) : List (PAM M) := + mReg326Op (mRegConsOp regs) + +theorem mSubEval_325 : MSubEval (M := M) 325 mRegWalOp := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_69 mSubEval_326 + +noncomputable def mReg332Op (regs : List (PAM M)) : List (PAM M) := + mRegWnOp (mRegWalOp regs) + +theorem mSubEval_332 : MSubEval (M := M) 332 mReg332Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_325 mSubEval_392 + +noncomputable def mRegWexOp (regs : List (PAM M)) : List (PAM M) := + mReg332Op (mRegWnOp regs) + +theorem mSubEval_331 : MSubEval (M := M) 331 mRegWexOp := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_392 mSubEval_332 + +noncomputable def mReg324Op (regs : List (PAM M)) : List (PAM M) := + mRegWnOp (mRegWimOp regs) + +theorem mSubEval_324 : MSubEval (M := M) 324 mReg324Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_390 mSubEval_392 + +noncomputable def mRegWaOp (regs : List (PAM M)) : List (PAM M) := + mReg324Op (mRegWnOp regs) + +theorem mSubEval_323 : MSubEval (M := M) 323 mRegWaOp := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_392 mSubEval_324 + +def mReg299Op (regs : List (PAM M)) : List (PAM M) := + let r := ((regs.set 5 0).set 2 (regs.getD 2 0 + regs.getD 5 0)).set + 8 (regs.getD 8 0 + regs.getD 5 0) + (r.set 8 0).set 5 (r.getD 5 0 + r.getD 8 0) + +theorem mSubEval_299 : MSubEval (M := M) 299 mReg299Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_347 mSubEval_364 + +noncomputable def mRegPar1Op (regs : List (PAM M)) : List (PAM M) := + mReg299Op (mRegPushwffOp regs) + +theorem mSubEval_298 : MSubEval (M := M) 298 mRegPar1Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_304 mSubEval_299 + +def mReg301Op (regs : List (PAM M)) : List (PAM M) := + let r := ((regs.set 6 0).set 2 (regs.getD 2 0 + regs.getD 6 0)).set + 8 (regs.getD 8 0 + regs.getD 6 0) + (r.set 8 0).set 6 (r.getD 6 0 + r.getD 8 0) + +theorem mSubEval_301 : MSubEval (M := M) 301 mReg301Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_353 mSubEval_366 + +noncomputable def mRegPar2Op (regs : List (PAM M)) : List (PAM M) := + mReg301Op (mRegPushwffOp regs) + +theorem mSubEval_300 : MSubEval (M := M) 300 mRegPar2Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_304 mSubEval_301 + +def mReg303Op (regs : List (PAM M)) : List (PAM M) := + let r := ((regs.set 7 0).set 2 (regs.getD 2 0 + regs.getD 7 0)).set + 8 (regs.getD 8 0 + regs.getD 7 0) + (r.set 8 0).set 7 (r.getD 7 0 + r.getD 8 0) + +theorem mSubEval_303 : MSubEval (M := M) 303 mReg303Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_357 mSubEval_368 + +noncomputable def mRegPar3Op (regs : List (PAM M)) : List (PAM M) := + mReg303Op (mRegPushwffOp regs) + +theorem mSubEval_302 : MSubEval (M := M) 302 mRegPar3Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_304 mSubEval_303 + +theorem mSubEval_98 : + MSubEval (M := M) 98 (fun regs ↦ + (regs.set 8 0).set 1 (regs.getD 1 0 + regs.getD 8 0 + 1)) := by + refine (mSubEval_seq_inc rfl (by decide) rfl (by decide) (by decide) rfl mSubEval_362).congr ?_ + intro regs hlen + change ((regs.set 8 0).set 1 (regs.getD 1 0 + regs.getD 8 0)).set 1 + (((regs.set 8 0).set 1 (regs.getD 1 0 + regs.getD 8 0)).getD 1 0 + 1) = + (regs.set 8 0).set 1 (regs.getD 1 0 + regs.getD 8 0 + 1) + rw [mGetD_set_self _ 1 _ (by simp [hlen]), List.set_set] + +def mReg97Op (regs : List (PAM M)) : List (PAM M) := + let r := ((regs.set 1 0).set 8 (regs.getD 8 0 + regs.getD 1 0)).set 0 + (regs.getD 0 0 + regs.getD 1 0) + (r.set 8 0).set 1 (r.getD 1 0 + r.getD 8 0 + 1) + +theorem mSubEval_97 : MSubEval (M := M) 97 mReg97Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_343 mSubEval_98 + +noncomputable def mReg95Op (regs : List (PAM M)) : List (PAM M) := + if regs.getD 0 0 = 0 then + mReg97Op regs + else + regs.set 0 (regs.getD 0 0 - 1) + +theorem mSubEval_95 : MSubEval (M := M) 95 mReg95Op := by + intro P hP slot regs hinv + unfold mReg95Op + have hP0 : walkInternal 99 (P ++ [0]) = some 96 := walkInternal_snoc hP rfl (by decide) + have hP1 : walkInternal 99 (P ++ [1]) = some 97 := walkInternal_snoc hP rfl (by decide) + have hev0 : evalStack (trimZeros P) = .decnz 0 (P ++ [0] ++ [1]) (P ++ [1]) := by + rw [← trimZeros_append_zero P, evalStack_trimZeros_of_walkInternal hP0, + evalStack_leaf0_of_walkInternal hP0 rfl (by decide) (by decide)] + simp [isLeafInc, logLeafReg] + rcases eq_zero_or_exists_succ (regs.getD 0 0) with hv | ⟨v, hv⟩ + · simp only [hv, ↓reduceIte] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_zero hinv hev0 hv + have hinv1' : MZfLogInv slot₁ (trimZeros (P ++ [1])) regs := by rwa [trimZeros_append_one] + obtain ⟨hlen', slot₂, hinv₂, hreach₂⟩ := mSubEval_97 (P ++ [1]) hP1 slot₁ regs hinv1' + rw [trimZeros_append_one, retStack_append_one] at hreach₂ + rw [retStack_append_one] at hinv₂ + exact ⟨hlen', slot₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + · have hne : regs.getD 0 0 ≠ 0 := by rw [hv]; exact add_one_ne_zero v + simp only [hne, ↓reduceIte] + rw [hv, add_one_sub_one_pam] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev0 hv + have hev_brk : evalStack (P ++ [0] ++ [1]) = .jump (retStack P) := by + have h := evalStack_break1_of_walkInternal (P := P ++ [0]) (k := 1) (by decide) hP0 rfl + simpa [retStack] using h + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_jump hinv₁ hev_brk + exact ⟨by simp [hinv.1], slot₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + +theorem mSubEval_84 : + MSubEval (M := M) 84 (fun regs ↦ (regs.set 8 0).set 2 (regs.getD 8 0)) := by + refine (mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_382 mSubEval_371).congr ?_ + intro regs hlen + have hget2 : (regs.set 2 0).getD 2 0 = 0 := mGetD_set_self regs 2 0 (by omega) + have hget8 : (regs.set 2 0).getD 8 0 = regs.getD 8 0 := mGetD_set_ne regs 0 (by decide) + rw [hget2, hget8, zero_add, mSet_comm_of_ne regs 0 0 (by decide), List.set_set] + +noncomputable def mReg83Op (regs : List (PAM M)) : List (PAM M) := + if regs.getD 4 0 = 0 then + regs + else + ((regs.set 4 (regs.getD 4 0 - 1)).set 8 0).set 2 (regs.getD 8 0) + +theorem mSubEval_83 : MSubEval (M := M) 83 mReg83Op := by + intro P hP slot regs hinv + unfold mReg83Op + have hP1 : walkInternal 99 (P ++ [1]) = some 84 := walkInternal_snoc hP rfl (by decide) + have hev0 : evalStack (trimZeros P) = .decnz 4 (P ++ [1]) (retStack P) := by + rw [evalStack_trimZeros_of_walkInternal hP, + evalStack_leaf0_of_walkInternal hP rfl (by decide) (by decide)] + simp [isLeafInc, logLeafReg] + rcases eq_zero_or_exists_succ (regs.getD 4 0) with hv | ⟨v, hv⟩ + · simp only [hv, ↓reduceIte] + exact ⟨hinv.1, mLogStep_of_decnz_zero hinv hev0 hv⟩ + · have hne : regs.getD 4 0 ≠ 0 := by rw [hv]; exact add_one_ne_zero v + simp only [hne, ↓reduceIte] + rw [hv, add_one_sub_one_pam] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev0 hv + have hinv1' : MZfLogInv slot₁ (trimZeros (P ++ [1])) (regs.set 4 v) := by + rwa [trimZeros_append_one] + obtain ⟨hlen', slot₂, hinv₂, hreach₂⟩ := mSubEval_84 (P ++ [1]) hP1 slot₁ (regs.set 4 v) hinv1' + rw [trimZeros_append_one, retStack_append_one] at hreach₂ + rw [retStack_append_one] at hinv₂ + dsimp only at hlen' hinv₂ hreach₂ + rw [mGetD_set_ne regs v (by decide)] at hlen' hinv₂ hreach₂ + exact ⟨hlen', slot₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + +noncomputable def mReg308Op (regs : List (PAM M)) : List (PAM M) := + (mReg83Op regs).set 8 0 + +theorem mSubEval_308 : MSubEval (M := M) 308 mReg308Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_83 mSubEval_359 + +noncomputable def mReg307Op (regs : List (PAM M)) : List (PAM M) := + mReg308Op ((regs.set 9 0).set 3 (regs.getD 3 0 + regs.getD 9 0)) + +theorem mSubEval_307 : MSubEval (M := M) 307 mReg307Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_380 mSubEval_308 + +noncomputable def mReg306Op (f315 : List (PAM M) → List (PAM M)) (regs : List (PAM M)) : + List (PAM M) := + mReg307Op (f315 regs) + +theorem mSubEval_306 {f315 : List (PAM M) → List (PAM M)} (h315 : MSubEval (M := M) 315 f315) : + MSubEval (M := M) 306 (mReg306Op f315) := + mSubEval_seq rfl (by decide) rfl (by decide) h315 mSubEval_307 + +noncomputable def mRegSelectGenOp (f315 : List (PAM M) → List (PAM M)) (regs : List (PAM M)) : + List (PAM M) := + mReg306Op f315 ((regs.set 2 0).set 8 (regs.getD 8 0 + regs.getD 2 0)) + +theorem mSubEval_305 {f315 : List (PAM M) → List (PAM M)} (h315 : MSubEval (M := M) 315 f315) : + MSubEval (M := M) 305 (mRegSelectGenOp f315) := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_386 (mSubEval_306 h315) + +theorem mSubEval_76 : + MSubEval (M := M) 76 (fun regs ↦ regs.set 4 (regs.getD 4 0 + 2)) := by + refine (mSubEval_inc_inc (M := M) (q₀ := 30) (q₁ := 30) + rfl (by decide) (by decide) rfl rfl (by decide) (by decide) rfl).congr ?_ + intro regs hlen + change (regs.set 4 (regs.getD 4 0 + 1)).set 4 + ((regs.set 4 (regs.getD 4 0 + 1)).getD 4 0 + 1) = regs.set 4 (regs.getD 4 0 + 2) + rw [mGetD_set_self regs 4 _ (by omega), List.set_set] + congr 1 + ring + +theorem mSubEval_78 {f289 : List (PAM M) → List (PAM M)} (h289 : MSubEval (M := M) 289 f289) : + MSubEval (M := M) 78 (fun regs ↦ f289 (regs.set 4 (regs.getD 4 0 + 1))) := + mSubEval_inc_seq (q₀ := 30) (q₁ := 289) rfl (by decide) (by decide) rfl rfl (by decide) h289 + +theorem mSubEval_71 {f289 : List (PAM M) → List (PAM M)} (h289 : MSubEval (M := M) 289 f289) + (Q : List (Fin 2)) (hQ : walkInternal 99 Q = some 71) + (slot : PAM M) (regs : List (PAM M)) (hinv : MZfLogInv slot (trimZeros Q) regs) : + (if regs.getD 4 0 = 1 then f289 regs else regs).length = 11 ∧ + ∃ slot' : PAM M, + MZfLogInv slot' + (if regs.getD 4 0 = 1 then retStack Q else (popBreakRev 1 Q.reverse).reverse) + (if regs.getD 4 0 = 1 then f289 regs else regs) ∧ + mReachPos (mZfLogCfg slot (trimZeros Q) regs) + (mZfLogCfg slot' + (if regs.getD 4 0 = 1 then retStack Q else (popBreakRev 1 Q.reverse).reverse) + (if regs.getD 4 0 = 1 then f289 regs else regs)) := by + have hQ0 : walkInternal 99 (Q ++ [0]) = some 72 := walkInternal_snoc hQ rfl (by decide) + have hQ01 : walkInternal 99 (Q ++ [0] ++ [1]) = some 73 := + walkInternal_snoc hQ0 rfl (by decide) + have hQ010 : walkInternal 99 (Q ++ [0] ++ [1] ++ [0]) = some 74 := + walkInternal_snoc hQ01 rfl (by decide) + have hQ0101 : walkInternal 99 (Q ++ [0] ++ [1] ++ [0] ++ [1]) = some 75 := + walkInternal_snoc hQ010 rfl (by decide) + have hQ01010 : walkInternal 99 (Q ++ [0] ++ [1] ++ [0] ++ [1] ++ [0]) = some 76 := + walkInternal_snoc hQ0101 rfl (by decide) + have hQ011 : walkInternal 99 (Q ++ [0] ++ [1] ++ [1]) = some 77 := + walkInternal_snoc hQ01 rfl (by decide) + have hQ0110 : walkInternal 99 (Q ++ [0] ++ [1] ++ [1] ++ [0]) = some 78 := + walkInternal_snoc hQ011 rfl (by decide) + have hev99 : evalStack (trimZeros Q) = .decnz 4 (Q ++ [0] ++ [1]) (Q ++ [1]) := by + rw [← trimZeros_append_zero Q, evalStack_trimZeros_of_walkInternal hQ0, + evalStack_leaf0_of_walkInternal hQ0 rfl (by decide) (by decide)] + simp [isLeafInc, logLeafReg] + have hev98_brk : evalStack (Q ++ [1]) = .jump (popBreakRev 1 Q.reverse).reverse := + evalStack_break1_of_walkInternal (k := 1) (by decide) hQ rfl + have hev101 : evalStack (Q ++ [0] ++ [1]) = + .decnz 4 (Q ++ [0] ++ [1] ++ [0] ++ [1]) (Q ++ [0] ++ [1] ++ [1]) := by + have h := evalStack_leaf0_of_walkInternal hQ010 rfl (by decide) (by decide) + rw [← evalStack_trimZeros_of_walkInternal hQ010, trimZeros_append_zero, + trimZeros_append_one, retStack_append_zero] at h + exact h + rcases eq_zero_or_exists_succ (regs.getD 4 0) with hv | ⟨u, hu⟩ + · have hne1 : (regs.getD 4 0) ≠ 1 := by rw [hv]; exact one_ne_zero_pam.symm + simp only [hne1, ↓reduceIte] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_zero hinv hev99 hv + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_jump hinv₁ hev98_brk + exact ⟨hinv.1, slot₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + · rcases eq_zero_or_exists_succ u with rfl | ⟨v, rfl⟩ + · have hv1 : regs.getD 4 0 = 1 := by simpa using hu + simp only [hv1, ↓reduceIte] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev99 hu + have hv0 : (regs.set 4 0).getD 4 0 = 0 := mGetD_set_self regs 4 0 (by rw [hinv.1]; decide) + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_zero hinv₁ hev101 hv0 + have hinv105 : MZfLogInv slot₂ (trimZeros (Q ++ [0] ++ [1] ++ [1] ++ [0])) (regs.set 4 0) := + by rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨hlen_105, slot₃, hinv₃, hreach_105⟩ := + mSubEval_78 h289 (Q ++ [0] ++ [1] ++ [1] ++ [0]) hQ0110 slot₂ (regs.set 4 0) hinv105 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero] at hreach_105 + rw [retStack_append_zero] at hinv₃ + dsimp only [logLeafReg] at hlen_105 hinv₃ hreach_105 + have hrestore : (regs.set 4 0).set 4 ((regs.set 4 0).getD 4 0 + 1) = regs := by + rw [hv0, zero_add, List.set_set, mSet_eq_self_of_getD_eq hv1] + rw [hrestore] at hlen_105 hinv₃ hreach_105 + have hev104_brk : evalStack (Q ++ [0] ++ [1] ++ [1] ++ [1]) = .jump (retStack Q) := by + have h := evalStack_break1_of_walkInternal (P := Q ++ [0] ++ [1] ++ [1]) + (k := 1) (by decide) hQ011 rfl + simpa [retStack] using h + obtain ⟨slot₄, hinv₄, hreach₄⟩ := mLogStep_of_jump (regs := f289 regs) hinv₃ hev104_brk + exact ⟨hlen_105, slot₄, hinv₄, + mReachPos_trans hreach₁ (mReachPos_trans hreach₂ (mReachPos_trans hreach_105 hreach₄))⟩ + · have hne1 : regs.getD 4 0 ≠ 1 := by rw [hu]; exact add_one_add_one_ne_one_pam v + simp only [hne1, ↓reduceIte] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv hev99 hu + have hv1 : (regs.set 4 (v + 1)).getD 4 0 = v + 1 := + mGetD_set_self regs 4 (v + 1) (by rw [hinv.1]; decide) + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_succ hinv₁ hev101 hv1 + rw [List.set_set] at hinv₂ hreach₂ + have hinv103 : + MZfLogInv slot₂ (trimZeros (Q ++ [0] ++ [1] ++ [0] ++ [1] ++ [0])) (regs.set 4 v) := by + rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨_, slot₃, hinv₃, hreach_103⟩ := + mSubEval_76 (Q ++ [0] ++ [1] ++ [0] ++ [1] ++ [0]) hQ01010 slot₂ (regs.set 4 v) hinv103 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero] at hreach_103 + rw [retStack_append_zero] at hinv₃ + dsimp only at hinv₃ hreach_103 + have hrestore : (regs.set 4 v).set 4 ((regs.set 4 v).getD 4 0 + 2) = regs := by + rw [mGetD_set_self regs 4 v (by rw [hinv.1]; decide), List.set_set] + have hv2 : v + 2 = v + 1 + 1 := by ring + rw [hv2, mSet_eq_self_of_getD_eq hu] + rw [hrestore] at hinv₃ hreach_103 + have hev102_brk : evalStack (Q ++ [0] ++ [1] ++ [0] ++ [1] ++ [1]) = .jump (Q ++ [1]) := by + have h := evalStack_break1_of_walkInternal (P := Q ++ [0] ++ [1] ++ [0] ++ [1]) + (k := 1) (by decide) hQ0101 rfl + simpa using h + obtain ⟨slot₄, hinv₄, hreach₄⟩ := mLogStep_of_jump hinv₃ hev102_brk + obtain ⟨slot₅, hinv₅, hreach₅⟩ := mLogStep_of_jump hinv₄ hev98_brk + exact ⟨hinv.1, slot₅, hinv₅, mReachPos_trans hreach₁ + (mReachPos_trans hreach₂ + (mReachPos_trans hreach_103 (mReachPos_trans hreach₄ hreach₅)))⟩ + +theorem mSubEval_80 : + MSubEval (M := M) 80 (fun regs ↦ (regs.set 8 0).set 6 (regs.getD 8 0)) := by + refine (mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_352 mSubEval_366).congr ?_ + intro regs hlen + have hget6 : (regs.set 6 0).getD 6 0 = 0 := mGetD_set_self regs 6 0 (by omega) + have hget8 : (regs.set 6 0).getD 8 0 = regs.getD 8 0 := mGetD_set_ne regs 0 (by decide) + rw [hget6, hget8, zero_add, mSet_comm_of_ne regs 0 0 (by decide), List.set_set] + +theorem mSubEval_79 {f289 : List (PAM M) → List (PAM M)} (h289 : MSubEval (M := M) 289 f289) : + MSubEval (M := M) 79 (fun regs ↦ + if regs.getD 4 0 = 1 then + let r := f289 regs + (r.set 8 0).set 6 (r.getD 8 0) + else + regs) := by + refine (mSubEval_cond (cond := fun regs ↦ regs.getD 4 0 = 1) + rfl (by decide) rfl (by decide) (mSubEval_71 h289) mSubEval_80).congr ?_ + intro regs _hlen + split_ifs <;> rfl + +theorem mSubEval_82 : + MSubEval (M := M) 82 (fun regs ↦ (regs.set 8 0).set 7 (regs.getD 8 0)) := by + refine (mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_356 mSubEval_368).congr ?_ + intro regs hlen + have hget7 : (regs.set 7 0).getD 7 0 = 0 := mGetD_set_self regs 7 0 (by omega) + have hget8 : (regs.set 7 0).getD 8 0 = regs.getD 8 0 := mGetD_set_ne regs 0 (by decide) + rw [hget7, hget8, zero_add, mSet_comm_of_ne regs 0 0 (by decide), List.set_set] + +theorem mSubEval_81 {f289 : List (PAM M) → List (PAM M)} (h289 : MSubEval (M := M) 289 f289) : + MSubEval (M := M) 81 (fun regs ↦ + if regs.getD 4 0 = 1 then + let r := f289 regs + (r.set 8 0).set 7 (r.getD 8 0) + else + regs) := by + refine (mSubEval_cond (cond := fun regs ↦ regs.getD 4 0 = 1) + rfl (by decide) rfl (by decide) (mSubEval_71 h289) mSubEval_82).congr ?_ + intro regs _hlen + split_ifs <;> rfl + +theorem mSubEval_85 (Q : List (Fin 2)) (hQ : walkInternal 99 Q = some 85) + (slot : PAM M) (regs : List (PAM M)) (hinv : MZfLogInv slot (trimZeros Q) regs) : + ((regs.set 9 0).set 10 0).length = 11 ∧ + ∃ slot' : PAM M, + MZfLogInv slot' + (if regs.getD 9 0 = regs.getD 10 0 then retStack Q + else (popBreakRev 1 Q.reverse).reverse) + ((regs.set 9 0).set 10 0) ∧ + mReachPos (mZfLogCfg slot (trimZeros Q) regs) + (mZfLogCfg slot' + (if regs.getD 9 0 = regs.getD 10 0 then retStack Q + else (popBreakRev 1 Q.reverse).reverse) + ((regs.set 9 0).set 10 0)) := by + have hQ0 : walkInternal 99 (Q ++ [0]) = some 86 := walkInternal_snoc hQ rfl (by decide) + have hQ01 : walkInternal 99 (Q ++ [0] ++ [1]) = some 87 := + walkInternal_snoc hQ0 rfl (by decide) + have hQ010 : walkInternal 99 (Q ++ [0] ++ [1] ++ [0]) = some 88 := + walkInternal_snoc hQ01 rfl (by decide) + have hQ011 : walkInternal 99 (Q ++ [0] ++ [1] ++ [1]) = some 89 := + walkInternal_snoc hQ01 rfl (by decide) + have hQ0110 : walkInternal 99 (Q ++ [0] ++ [1] ++ [1] ++ [0]) = some 376 := + walkInternal_snoc hQ011 rfl (by decide) + have hQ1 : walkInternal 99 (Q ++ [1]) = some 90 := walkInternal_snoc hQ rfl (by decide) + have hQ11 : walkInternal 99 (Q ++ [1] ++ [1]) = some 91 := walkInternal_snoc hQ1 rfl (by decide) + have hQ110 : walkInternal 99 (Q ++ [1] ++ [1] ++ [0]) = some 381 := + walkInternal_snoc hQ11 rfl (by decide) + have hev113 : evalStack (trimZeros Q) = .decnz 9 (Q ++ [0] ++ [1]) (Q ++ [1]) := by + rw [← trimZeros_append_zero Q, evalStack_trimZeros_of_walkInternal hQ0, + evalStack_leaf0_of_walkInternal hQ0 rfl (by decide) (by decide)] + simp [isLeafInc, logLeafReg] + have hev115 : evalStack (Q ++ [0] ++ [1]) = + .decnz 10 (Q ++ [0] ++ [1] ++ [0] ++ [1]) (Q ++ [0] ++ [1] ++ [1]) := by + have h := evalStack_leaf0_of_walkInternal hQ010 rfl (by decide) (by decide) + rw [← evalStack_trimZeros_of_walkInternal hQ010, trimZeros_append_zero, + trimZeros_append_one, retStack_append_zero] at h + exact h + have hev115_cont : evalStack (Q ++ [0] ++ [1] ++ [0] ++ [1]) = .jump (trimZeros Q) := by + have h := evalStack_continue1_of_walkInternal (P := Q ++ [0] ++ [1] ++ [0]) + (k := 1) (by decide) hQ010 rfl + simpa [popContinueRev_zero_eq_dropLeadingZeros, trimZeros] using h + have hev116_brk : evalStack (Q ++ [0] ++ [1] ++ [1] ++ [1]) = + .jump (popBreakRev 1 Q.reverse).reverse := by + have h := evalStack_break1_of_walkInternal (P := Q ++ [0] ++ [1] ++ [1]) + (k := 2) (by decide) hQ011 rfl + simpa using h + have hev117 : evalStack (Q ++ [1]) = .decnz 10 (Q ++ [1] ++ [1]) (retStack Q) := by + have h := evalStack_leaf0_of_walkInternal hQ1 rfl (by decide) (by decide) + simpa [isLeafInc, logLeafReg] using h + have hev118_brk : evalStack (Q ++ [1] ++ [1] ++ [1]) = + .jump (popBreakRev 1 Q.reverse).reverse := by + have h := evalStack_break1_of_walkInternal (P := Q ++ [1] ++ [1]) + (k := 1) (by decide) hQ11 rfl + simpa using h + let ip_eq := retStack Q + let ip_ne := (popBreakRev 1 Q.reverse).reverse + have hdef : PADef1 (fun v : PAM M ↦ + ∀ (sl : PAM M) (rs : List (PAM M)), + MZfLogInv sl (trimZeros Q) rs → rs.getD 9 0 = v → + ∃ sl' : PAM M, + MZfLogInv sl' (if v = rs.getD 10 0 then ip_eq else ip_ne) ((rs.set 9 0).set 10 0) ∧ + mReachPos (mZfLogCfg sl (trimZeros Q) rs) + (mZfLogCfg sl' (if v = rs.getD 10 0 then ip_eq else ip_ne) + ((rs.set 9 0).set 10 0))) := by + let R_clr : (Fin 13 → PAM M) → List (PAM M) := + fun w ↦ ((regsOfVec13 w).set 9 0).set 10 0 + have hR_clr : PAFunRegs 13 R_clr := + paFunRegs_set (paFunRegs_set paFunRegs_regsOfVec13 9 (paFun_const 0)) 10 (paFun_const 0) + have hce : PADefN 13 (fun w : Fin 13 → PAM M ↦ w 0 = (regsOfVec13 w).getD 10 0) := + paDef_eq (paFun_proj 0) (paFunRegs_getD paFunRegs_regsOfVec13 10) + have hres13 : PADefN 13 (fun w : Fin 13 → PAM M ↦ + ∃ sl' : PAM M, + MZfLogInv sl' (if w 0 = (regsOfVec13 w).getD 10 0 then ip_eq else ip_ne) (R_clr w) ∧ + mReachPos (mZfLogCfg (w 1) (trimZeros Q) (regsOfVec13 w)) + (mZfLogCfg sl' (if w 0 = (regsOfVec13 w).getD 10 0 then ip_eq else ip_ne) + (R_clr w))) := by + refine paDefN_congr (fun w ↦ ?_) + (paDef_or + (paDef_and hce + (paDef_exists_slot_reachPos (trimZeros Q) ip_eq + (paFun_proj 1) paFunRegs_regsOfVec13 hR_clr)) + (paDef_and (paDef_not hce) + (paDef_exists_slot_reachPos (trimZeros Q) ip_ne + (paFun_proj 1) paFunRegs_regsOfVec13 hR_clr))) + by_cases hc : w 0 = (regsOfVec13 w).getD 10 0 + · simp only [hc, ↓reduceIte, not_true_eq_false, true_and, false_and, or_false] + · simp only [hc, ↓reduceIte, not_false_eq_true, true_and, false_and, false_or] + have hbody13 := paDef_imp + (paDef_mZfLogInv (trimZeros Q) (paFun_proj 1) paFunRegs_regsOfVec13) + (paDef_imp (paDef_eq (paFunRegs_getD paFunRegs_regsOfVec13 9) (paFun_proj 0)) hres13) + refine paDefN_congr (fun a ↦ ?_) (paDef_forall_vec (k := 1) (m := 12) hbody13) + have ha0 : ∀ b : Fin 12 → PAM M, finCat a b 0 = a 0 := fun b ↦ finCat_left a b 0 + have hb0 : ∀ b : Fin 12 → PAM M, finCat a b 1 = b 0 := fun b ↦ finCat_right a b 0 + constructor + · intro hvec sl rs hinv_rs hv + let b : Fin 12 → PAM M := Fin.cons sl (fun i : Fin 11 ↦ rs.getD i.val 0) + have hb_sl : b 0 = sl := rfl + have hb_rs : List.ofFn (fun i : Fin 11 ↦ b i.succ) = rs := ofFn_getD_eq_self hinv_rs.1 + have hinst := hvec b + dsimp only [R_clr] at hinst + rw [ha0 b, hb0 b, regsOfVec13_finCat a b, hb_sl, hb_rs] at hinst + exact hinst hinv_rs hv + · intro hall b + dsimp only [R_clr] + rw [ha0 b, hb0 b, regsOfVec13_finCat a b] + exact hall (b 0) (List.ofFn (fun i : Fin 11 ↦ b i.succ)) + have hloop := ind1 hdef + (fun sl rs hinv_rs hv ↦ by + obtain ⟨sl₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_zero hinv_rs hev113 hv + rcases eq_zero_or_exists_succ (rs.getD 10 0) with hw | ⟨w, hw⟩ + · simp only [hw, ↓reduceIte] + obtain ⟨sl₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_zero hinv₁ hev117 hw + have hset : (rs.set 9 0).set 10 0 = rs := by + rw [mSet_eq_self_of_getD_eq hv, mSet_eq_self_of_getD_eq hw] + rw [hset] + exact ⟨sl₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + · have hne : (0 : PAM M) ≠ w + 1 := (add_one_ne_zero w).symm + simp only [hw, hne, ↓reduceIte] + obtain ⟨sl₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_succ hinv₁ hev117 hw + have hinv420 : MZfLogInv sl₂ (trimZeros (Q ++ [1] ++ [1] ++ [0])) (rs.set 10 w) := by + rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨_, sl₃, hinv₃, hreach_420⟩ := + mSubEval_381 (Q ++ [1] ++ [1] ++ [0]) hQ110 sl₂ (rs.set 10 w) hinv420 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero] at hreach_420 + rw [retStack_append_zero] at hinv₃ + dsimp only at hinv₃ hreach_420 + rw [List.set_set] at hinv₃ hreach_420 + obtain ⟨sl₄, hinv₄, hreach₄⟩ := mLogStep_of_jump (regs := rs.set 10 0) hinv₃ hev118_brk + rw [mSet_eq_self_of_getD_eq hv] + exact ⟨sl₄, hinv₄, + mReachPos_trans hreach₁ (mReachPos_trans hreach₂ (mReachPos_trans hreach_420 hreach₄))⟩) + (fun v ih sl rs hinv_rs hv ↦ by + obtain ⟨sl₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv_rs hev113 hv + rcases eq_zero_or_exists_succ (rs.getD 10 0) with hw | ⟨w, hw⟩ + · have hne : v + 1 ≠ (0 : PAM M) := add_one_ne_zero v + simp only [hw, hne, ↓reduceIte] + have hw' : (rs.set 9 v).getD 10 0 = 0 := by rw [mGetD_set_ne _ _ (by decide), hw] + obtain ⟨sl₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_zero hinv₁ hev115 hw' + have hinv415 : + MZfLogInv sl₂ (trimZeros (Q ++ [0] ++ [1] ++ [1] ++ [0])) (rs.set 9 v) := by + rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨_, sl₃, hinv₃, hreach_415⟩ := + mSubEval_376 (Q ++ [0] ++ [1] ++ [1] ++ [0]) hQ0110 sl₂ (rs.set 9 v) hinv415 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero] at hreach_415 + rw [retStack_append_zero] at hinv₃ + dsimp only at hinv₃ hreach_415 + rw [List.set_set] at hinv₃ hreach_415 + obtain ⟨sl₄, hinv₄, hreach₄⟩ := mLogStep_of_jump (regs := rs.set 9 0) hinv₃ hev116_brk + have hset10 : (rs.set 9 0).set 10 0 = rs.set 9 0 := + mSet_eq_self_of_getD_eq (by rw [mGetD_set_ne _ _ (by decide), hw]) + rw [hset10] + exact ⟨sl₄, hinv₄, + mReachPos_trans hreach₁ (mReachPos_trans hreach₂ (mReachPos_trans hreach_415 hreach₄))⟩ + · have hw' : (rs.set 9 v).getD 10 0 = w + 1 := by rw [mGetD_set_ne _ _ (by decide), hw] + obtain ⟨sl₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_succ hinv₁ hev115 hw' + let rs₁ := (rs.set 9 v).set 10 w + obtain ⟨sl₃, hinv₃, hreach₃⟩ := mLogStep_of_jump (regs := rs₁) hinv₂ hev115_cont + have hv₁ : rs₁.getD 9 0 = v := by + dsimp only [rs₁] + rw [mGetD_set_ne _ _ (by decide), mGetD_set_self rs 9 v (by rw [hinv_rs.1]; decide)] + have hw₁ : rs₁.getD 10 0 = w := by + dsimp only [rs₁] + exact mGetD_set_self (rs.set 9 v) 10 w (by simp [hinv_rs.1]) + obtain ⟨sl₄, hinv₄, hreach_ih⟩ := ih sl₃ rs₁ hinv₃ hv₁ + have hset_eq : (rs₁.set 9 0).set 10 0 = (rs.set 9 0).set 10 0 := by + dsimp only [rs₁] + rw [mSet_comm_of_ne (rs.set 9 v) w 0 (by decide), List.set_set, List.set_set] + have heq_iff : (v = w) ↔ (v + 1 = w + 1) := + ⟨congrArg (· + 1), (add_right_inj_pam 1).mp⟩ + rw [hw₁, hset_eq] at hinv₄ hreach_ih + have hcond_eq : (if v = w then ip_eq else ip_ne) = + (if v + 1 = rs.getD 10 0 then ip_eq else ip_ne) := by + rw [hw] + simp only [heq_iff] + rw [hcond_eq] at hinv₄ hreach_ih + exact ⟨sl₄, hinv₄, + mReachPos_trans hreach₁ (mReachPos_trans hreach₂ (mReachPos_trans hreach₃ hreach_ih))⟩) + exact ⟨by simp [hinv.1], hloop (regs.getD 9 0) slot regs hinv rfl⟩ + +def mReg94Op (regs : List (PAM M)) : List (PAM M) := + let r := ((regs.set 5 0).set 8 (regs.getD 8 0 + regs.getD 5 0)).set 2 + (regs.getD 2 0 + regs.getD 5 0) + (r.set 8 0).set 5 (r.getD 5 0 + r.getD 8 0) + +theorem mSubEval_94 : MSubEval (M := M) 94 mReg94Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_348 mSubEval_364 + +noncomputable def mReg93Op (regs : List (PAM M)) : List (PAM M) := + if regs.getD 9 0 = regs.getD 10 0 then + mReg94Op ((regs.set 9 0).set 10 0) + else + (regs.set 9 0).set 10 0 + +theorem mSubEval_93 : MSubEval (M := M) 93 mReg93Op := + mSubEval_cond (cond := fun regs ↦ regs.getD 9 0 = regs.getD 10 0) + rfl (by decide) rfl (by decide) mSubEval_85 mSubEval_94 + +noncomputable def mReg92Op (regs : List (PAM M)) : List (PAM M) := + if regs.getD 9 0 = regs.getD 10 0 then + ((regs.set 9 0).set 10 0).set 2 0 + else + (regs.set 9 0).set 10 0 + +theorem mSubEval_92 : MSubEval (M := M) 92 mReg92Op := + mSubEval_cond (cond := fun regs ↦ regs.getD 9 0 = regs.getD 10 0) + rfl (by decide) rfl (by decide) mSubEval_85 mSubEval_382 + +noncomputable def mReg256Op (regs : List (PAM M)) : List (PAM M) := + mReg92Op ((regs.set 8 0).set 7 (regs.getD 7 0 + regs.getD 8 0)) + +theorem mSubEval_256 : MSubEval (M := M) 256 mReg256Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_368 mSubEval_92 + +noncomputable def mReg255Op (regs : List (PAM M)) : List (PAM M) := + mReg256Op (((regs.set 7 0).set 8 (regs.getD 8 0 + regs.getD 7 0)).set 10 + (regs.getD 10 0 + regs.getD 7 0)) + +theorem mSubEval_255 : MSubEval (M := M) 255 mReg255Op := + mSubEval_seq rfl (by decide) rfl (by decide) mSubEval_358 mSubEval_256 + +noncomputable def mRegSelectOp (regs : List (PAM M)) : List (PAM M) := + mRegSelectGenOp (mRegUnpairGen 2 9 3) regs + +theorem mSubEval_305_inst : MSubEval (M := M) 305 mRegSelectOp := + mSubEval_305 mSubEval_315 + +noncomputable def mRegCparam2Op (regs : List (PAM M)) : List (PAM M) := + if regs.getD 4 0 = 1 then + let r := mReg289Op regs + (r.set 8 0).set 6 (r.getD 8 0) + else + regs + +theorem mSubEval_79_inst : MSubEval (M := M) 79 mRegCparam2Op := + mSubEval_79 mSubEval_289 + +noncomputable def mRegCparam3Op (regs : List (PAM M)) : List (PAM M) := + if regs.getD 4 0 = 1 then + let r := mReg289Op regs + (r.set 8 0).set 7 (r.getD 8 0) + else + regs + +theorem mSubEval_81_inst : MSubEval (M := M) 81 mRegCparam3Op := + mSubEval_81 mSubEval_289 + + +/-! ## Section 5: `MWffState`, RPN Clauses, and Spine Segment `k = 13..123` -/ + +@[simp] +theorem one_ne_zero_pam_simp : (1 : PAM M) ≠ 0 := one_ne_zero_pam + +@[simp] +theorem zero_ne_one_pam_simp : (0 : PAM M) ≠ 1 := one_ne_zero_pam.symm + +@[simp] +theorem add_one_ne_zero_pam (x : PAM M) : x + 1 ≠ 0 := add_one_ne_zero x + +@[simp] +theorem one_sub_one_pam : (1 : PAM M) - 1 = 0 := by + simp + +@[simp] +theorem one_add_one_ne_one_pam : (1 : PAM M) + 1 ≠ 1 := by + simpa using add_one_add_one_ne_one_pam (0 : PAM M) + +/-- The 6 active RPN formula-stack and parameter registers on `PAM M`. -/ +structure MWffState (M : Type*) [PAStructure M] where + topwff : PAM M + wffstack : PAM M + axiomcode : PAM M + param1 : PAM M + param2 : PAM M + param3 : PAM M + +/-- Canonical 11-register bank for a given `MWffState M` (with scratch registers `8..10 = 0`). -/ +def mWffStateToRegs (pl np : PAM M) (s : MWffState M) : List (PAM M) := + [pl, np, s.topwff, s.wffstack, s.axiomcode, s.param1, s.param2, s.param3, 0, 0, 0] + +noncomputable def mRpnVk (k : PAM M) (s : MWffState M) : MWffState M := + { s with topwff := k, wffstack := mPair s.topwff s.wffstack } + +noncomputable def mRpnCons (s : MWffState M) : MWffState M := + let p := mUnpair s.wffstack + { s with topwff := mPair p.1 s.topwff, wffstack := p.2 } + +noncomputable def mRpnWeq (s : MWffState M) : MWffState M := mRpnCons (mRpnVk 0 (mRpnCons s)) +noncomputable def mRpnWel (s : MWffState M) : MWffState M := mRpnCons (mRpnVk 1 (mRpnCons s)) +noncomputable def mRpnWim (s : MWffState M) : MWffState M := mRpnCons (mRpnVk 2 (mRpnCons s)) +noncomputable def mRpnWn (s : MWffState M) : MWffState M := mRpnCons (mRpnVk 3 s) +noncomputable def mRpnWal (s : MWffState M) : MWffState M := mRpnCons (mRpnVk 4 (mRpnCons s)) +noncomputable def mRpnWex (s : MWffState M) : MWffState M := mRpnWn (mRpnWal (mRpnWn s)) +noncomputable def mRpnWa (s : MWffState M) : MWffState M := mRpnWn (mRpnWim (mRpnWn s)) + +noncomputable def mRpnPar1 (s : MWffState M) : MWffState M := + { s with topwff := s.param1, wffstack := mPair s.topwff s.wffstack } + +noncomputable def mRpnPar2 (s : MWffState M) : MWffState M := + { s with topwff := s.param2, wffstack := mPair s.topwff s.wffstack } + +noncomputable def mRpnPar3 (s : MWffState M) : MWffState M := + { s with topwff := s.param3, wffstack := mPair s.topwff s.wffstack } + +noncomputable def mRpnSelect (s : MWffState M) : MWffState M := + let p := mUnpair s.wffstack + if s.axiomcode = 0 then + { s with topwff := p.1, wffstack := p.2 } + else + { s with topwff := s.topwff, wffstack := p.2, axiomcode := s.axiomcode - 1 } + +noncomputable def mRpnCparam2 (s : MWffState M) : MWffState M := + if s.axiomcode = 1 then + let p := mUnpair s.wffstack + { s with wffstack := p.2, param2 := p.1 } + else s + +noncomputable def mRpnCparam3 (s : MWffState M) : MWffState M := + if s.axiomcode = 1 then + let p := mUnpair s.wffstack + { s with wffstack := p.2, param3 := p.1 } + else s + +noncomputable def mRpnDetCheck (s : MWffState M) : MWffState M := + { s with topwff := if s.topwff = s.param2 then s.param1 else 0 } + +noncomputable def mRpnZf393B6aCheck1 (s : MWffState M) : MWffState M := + { s with topwff := if s.param1 = s.param3 then 0 else s.topwff } + +noncomputable def mRpnZf393B6aCheck2 (s : MWffState M) : MWffState M := + { s with topwff := if s.param2 = s.param3 then 0 else s.topwff } + +theorem mRegPushwffOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegPushwffOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnVk 0 s) := by + simp [mWffStateToRegs, mRegPushwffOp, mRegPairOp, mRpnVk, List.getD] + +theorem mRegV1Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegV1Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnVk 1 s) := by + rw [mRegV1Op, mRegPushwffOp_wffStateToRegs] + simp [mWffStateToRegs, mRpnVk, List.getD] + +theorem mRegV2Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegV2Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnVk 2 s) := by + rw [mRegV2Op, mRegV1Op_wffStateToRegs] + simp only [mWffStateToRegs, mRpnVk, List.getD, List.getElem?_cons_zero, + List.getElem?_cons_succ, Option.getD_some, List.set_cons_zero, List.set_cons_succ] + congr 3 + ring + +theorem mRegV3Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegV3Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnVk 3 s) := by + rw [mRegV3Op, mRegV2Op_wffStateToRegs] + simp only [mWffStateToRegs, mRpnVk, List.getD, List.getElem?_cons_zero, + List.getElem?_cons_succ, Option.getD_some, List.set_cons_zero, List.set_cons_succ] + congr 3 + +theorem mRegV4Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegV4Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnVk 4 s) := by + rw [mRegV4Op, mRegV3Op_wffStateToRegs] + simp only [mWffStateToRegs, mRpnVk, List.getD, List.getElem?_cons_zero, + List.getElem?_cons_succ, Option.getD_some, List.set_cons_zero, List.set_cons_succ] + congr 3 + +theorem mRegConsOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegConsOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnCons s) := by + simp [mWffStateToRegs, mRegConsOp, mReg70Op, mReg289Op, mRegUnpairGen, mRegPairOp, + mRpnCons, List.getD] + +theorem mRegWeqOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegWeqOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnWeq s) := by + rw [mRegWeqOp, mReg330Op, mRegConsOp_wffStateToRegs, mRegPushwffOp_wffStateToRegs, + mRegConsOp_wffStateToRegs] + rfl + +theorem mRegWelOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegWelOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnWel s) := by + rw [mRegWelOp, mReg328Op, mRegConsOp_wffStateToRegs, mRegV1Op_wffStateToRegs, + mRegConsOp_wffStateToRegs] + rfl + +theorem mRegWimOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegWimOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnWim s) := by + rw [mRegWimOp, mReg391Op, mRegConsOp_wffStateToRegs, mRegV2Op_wffStateToRegs, + mRegConsOp_wffStateToRegs] + rfl + +theorem mRegWnOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegWnOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnWn s) := by + rw [mRegWnOp, mRegV3Op_wffStateToRegs, mRegConsOp_wffStateToRegs] + rfl + +theorem mRegWalOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegWalOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnWal s) := by + rw [mRegWalOp, mReg326Op, mRegConsOp_wffStateToRegs, mRegV4Op_wffStateToRegs, + mRegConsOp_wffStateToRegs] + rfl + +theorem mRegWexOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegWexOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnWex s) := by + rw [mRegWexOp, mReg332Op, mRegWnOp_wffStateToRegs, mRegWalOp_wffStateToRegs, + mRegWnOp_wffStateToRegs] + rfl + +theorem mRegWaOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegWaOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnWa s) := by + rw [mRegWaOp, mReg324Op, mRegWnOp_wffStateToRegs, mRegWimOp_wffStateToRegs, + mRegWnOp_wffStateToRegs] + rfl + +theorem mRegPar1Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegPar1Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnPar1 s) := by + rw [mRegPar1Op, mRegPushwffOp_wffStateToRegs] + simp [mWffStateToRegs, mReg299Op, mRpnVk, mRpnPar1, List.getD] + +theorem mRegPar2Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegPar2Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnPar2 s) := by + rw [mRegPar2Op, mRegPushwffOp_wffStateToRegs] + simp [mWffStateToRegs, mReg301Op, mRpnVk, mRpnPar2, List.getD] + +theorem mRegPar3Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegPar3Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnPar3 s) := by + rw [mRegPar3Op, mRegPushwffOp_wffStateToRegs] + simp [mWffStateToRegs, mReg303Op, mRpnVk, mRpnPar3, List.getD] + +theorem mRegSelectOp_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegSelectOp (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnSelect s) := by + by_cases hac : s.axiomcode = 0 <;> + simp [mWffStateToRegs, mRegSelectOp, mRegSelectGenOp, mReg306Op, mReg307Op, mReg308Op, + mReg83Op, mRegUnpairGen, mRpnSelect, hac, List.getD] + +theorem mRegCparam2Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegCparam2Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnCparam2 s) := by + by_cases hac : s.axiomcode = 1 <;> + simp [mWffStateToRegs, mRegCparam2Op, mReg289Op, mRegUnpairGen, mRpnCparam2, hac, List.getD] + +theorem mRegCparam3Op_wffStateToRegs (pl np : PAM M) (s : MWffState M) : + mRegCparam3Op (mWffStateToRegs pl np s) = mWffStateToRegs pl np (mRpnCparam3 s) := by + by_cases hac : s.axiomcode = 1 <;> + simp [mWffStateToRegs, mRegCparam3Op, mReg289Op, mRegUnpairGen, mRpnCparam3, hac, List.getD] + +/-- Register-level spine segment evaluation on `PAM M`. -/ +def MRegSpineEval (k₁ k₂ : ℕ) (f : List (PAM M) → List (PAM M)) : Prop := + ∀ (slot : PAM M) (regs : List (PAM M)), + MZfLogInv slot (List.replicate k₁ 1) regs → + (f regs).length = 11 ∧ + ∃ slot' : PAM M, + MZfLogInv slot' (List.replicate k₂ 1) (f regs) ∧ + mReachPos (mZfLogCfg slot (List.replicate k₁ 1) regs) + (mZfLogCfg slot' (List.replicate k₂ 1) (f regs)) + +theorem mRegSpineEval_step {k k' : ℕ} {q_k q_sub : Fin 393} + {f : List (PAM M) → List (PAM M)} + (hwalk : walkInternal 99 (List.replicate k 1) = some q_k) + (htr0 : zf393Trans q_k 0 = some (0, .right, q_sub)) + (hq_sub : 69 ≤ q_sub.val) + (hsub : MSubEval (M := M) q_sub f) + (hk : k + 1 = k' := by rfl) : + MRegSpineEval (M := M) k k' f := by + subst hk + intro slot regs hinv + have hwalk0 : walkInternal 99 (List.replicate k 1 ++ [0]) = some q_sub := + walkInternal_snoc hwalk htr0 hq_sub + have hinv0 : MZfLogInv slot (trimZeros (List.replicate k 1 ++ [0])) regs := by + rwa [trimZeros_append_zero, trimZeros_replicate_one] + obtain ⟨hlen, slot', hinv', hreach⟩ := hsub (List.replicate k 1 ++ [0]) hwalk0 slot regs hinv0 + rw [trimZeros_append_zero, trimZeros_replicate_one, retStack_append_zero, + ← List.replicate_succ'] at hreach + rw [retStack_append_zero, ← List.replicate_succ'] at hinv' + exact ⟨hlen, slot', hinv', hreach⟩ + +theorem mRegSpineEval_trans {k₁ k₂ k₃ : ℕ} {f₁ f₂ f : List (PAM M) → List (PAM M)} + (h1 : MRegSpineEval (M := M) k₁ k₂ f₁) (h2 : MRegSpineEval (M := M) k₂ k₃ f₂) + (heq : (fun regs ↦ f₂ (f₁ regs)) = f := by rfl) : + MRegSpineEval (M := M) k₁ k₃ f := by + subst heq + intro slot regs hinv + obtain ⟨_, slot₁, hinv₁, hreach₁⟩ := h1 slot regs hinv + obtain ⟨hlen₂, slot₂, hinv₂, hreach₂⟩ := h2 slot₁ (f₁ regs) hinv₁ + exact ⟨hlen₂, slot₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + +/-- `MWffState`-level subroutine evaluation at node `q` on `PAM M`. -/ +def MWffSubEval (q : Fin 393) (op : MWffState M → MWffState M) : Prop := + ∀ (P : List (Fin 2)), + walkInternal 99 P = some q → + ∀ (slot pl np : PAM M) (s : MWffState M), + MZfLogInv slot (trimZeros P) (mWffStateToRegs pl np s) → + ∃ slot' : PAM M, + MZfLogInv slot' (retStack P) (mWffStateToRegs pl np (op s)) ∧ + mReachPos (mZfLogCfg slot (trimZeros P) (mWffStateToRegs pl np s)) + (mZfLogCfg slot' (retStack P) (mWffStateToRegs pl np (op s))) + +theorem mWffSubEval_of_mSubEval {q : Fin 393} {f : List (PAM M) → List (PAM M)} + {op : MWffState M → MWffState M} (hsub : MSubEval (M := M) q f) + (heq : ∀ pl np s, f (mWffStateToRegs pl np s) = mWffStateToRegs pl np (op s)) : + MWffSubEval (M := M) q op := by + intro P hP slot pl np s hinv + obtain ⟨_, slot', hinv', hreach⟩ := hsub P hP slot (mWffStateToRegs pl np s) hinv + rw [heq pl np s] at hinv' hreach + exact ⟨slot', hinv', hreach⟩ + +theorem mWffSubEval_seq {q q0 q1 : Fin 393} {op0 op1 op : MWffState M → MWffState M} + (htr0 : zf393Trans q 0 = some (0, .right, q0)) (hq0 : 69 ≤ q0.val) + (htr1 : zf393Trans q 1 = some (1, .right, q1)) (hq1 : 69 ≤ q1.val) + (h0 : MWffSubEval (M := M) q0 op0) (h1 : MWffSubEval (M := M) q1 op1) + (heq : (fun s ↦ op1 (op0 s)) = op := by rfl) : + MWffSubEval (M := M) q op := by + subst heq + intro P hP slot pl np s hinv + have hP0 : walkInternal 99 (P ++ [0]) = some q0 := walkInternal_snoc hP htr0 hq0 + have hP1 : walkInternal 99 (P ++ [1]) = some q1 := walkInternal_snoc hP htr1 hq1 + have hinv0 : MZfLogInv slot (trimZeros (P ++ [0])) (mWffStateToRegs pl np s) := by + rwa [trimZeros_append_zero] + obtain ⟨slot₀, hinv₀, hreach₀⟩ := h0 (P ++ [0]) hP0 slot pl np s hinv0 + rw [trimZeros_append_zero, retStack_append_zero] at hreach₀ + rw [retStack_append_zero] at hinv₀ + have hinv1 : MZfLogInv slot₀ (trimZeros (P ++ [1])) (mWffStateToRegs pl np (op0 s)) := by + rwa [trimZeros_append_one] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := h1 (P ++ [1]) hP1 slot₀ pl np (op0 s) hinv1 + rw [trimZeros_append_one, retStack_append_one] at hreach₁ + rw [retStack_append_one] at hinv₁ + exact ⟨slot₁, hinv₁, mReachPos_trans hreach₀ hreach₁⟩ + +theorem mWffSubEval_79 : MWffSubEval (M := M) 79 mRpnCparam2 := + mWffSubEval_of_mSubEval mSubEval_79_inst mRegCparam2Op_wffStateToRegs +theorem mWffSubEval_81 : MWffSubEval (M := M) 81 mRpnCparam3 := + mWffSubEval_of_mSubEval mSubEval_81_inst mRegCparam3Op_wffStateToRegs +theorem mWffSubEval_298 : MWffSubEval (M := M) 298 mRpnPar1 := + mWffSubEval_of_mSubEval mSubEval_298 mRegPar1Op_wffStateToRegs +theorem mWffSubEval_300 : MWffSubEval (M := M) 300 mRpnPar2 := + mWffSubEval_of_mSubEval mSubEval_300 mRegPar2Op_wffStateToRegs +theorem mWffSubEval_302 : MWffSubEval (M := M) 302 mRpnPar3 := + mWffSubEval_of_mSubEval mSubEval_302 mRegPar3Op_wffStateToRegs +theorem mWffSubEval_304 : MWffSubEval (M := M) 304 (mRpnVk 0) := + mWffSubEval_of_mSubEval mSubEval_304 mRegPushwffOp_wffStateToRegs +theorem mWffSubEval_305 : MWffSubEval (M := M) 305 mRpnSelect := + mWffSubEval_of_mSubEval mSubEval_305_inst mRegSelectOp_wffStateToRegs +theorem mWffSubEval_319 : MWffSubEval (M := M) 319 (mRpnVk 1) := + mWffSubEval_of_mSubEval mSubEval_319 mRegV1Op_wffStateToRegs +theorem mWffSubEval_320 : MWffSubEval (M := M) 320 (mRpnVk 2) := + mWffSubEval_of_mSubEval mSubEval_320 mRegV2Op_wffStateToRegs +theorem mWffSubEval_321 : MWffSubEval (M := M) 321 (mRpnVk 3) := + mWffSubEval_of_mSubEval mSubEval_321 mRegV3Op_wffStateToRegs +theorem mWffSubEval_323 : MWffSubEval (M := M) 323 mRpnWa := + mWffSubEval_of_mSubEval mSubEval_323 mRegWaOp_wffStateToRegs +theorem mWffSubEval_325 : MWffSubEval (M := M) 325 mRpnWal := + mWffSubEval_of_mSubEval mSubEval_325 mRegWalOp_wffStateToRegs +theorem mWffSubEval_327 : MWffSubEval (M := M) 327 mRpnWel := + mWffSubEval_of_mSubEval mSubEval_327 mRegWelOp_wffStateToRegs +theorem mWffSubEval_329 : MWffSubEval (M := M) 329 mRpnWeq := + mWffSubEval_of_mSubEval mSubEval_329 mRegWeqOp_wffStateToRegs +theorem mWffSubEval_331 : MWffSubEval (M := M) 331 mRpnWex := + mWffSubEval_of_mSubEval mSubEval_331 mRegWexOp_wffStateToRegs +theorem mWffSubEval_390 : MWffSubEval (M := M) 390 mRpnWim := + mWffSubEval_of_mSubEval mSubEval_390 mRegWimOp_wffStateToRegs +theorem mWffSubEval_392 : MWffSubEval (M := M) 392 mRpnWn := + mWffSubEval_of_mSubEval mSubEval_392 mRegWnOp_wffStateToRegs + +noncomputable abbrev mWffOp_277 (s : MWffState M) : MWffState M := (mRpnVk 2) ((mRpnVk 1) s) +theorem mWffSubEval_277 : MWffSubEval (M := M) 277 mWffOp_277 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_319 mWffSubEval_320 +noncomputable abbrev mWffOp_266 (s : MWffState M) : MWffState M := mRpnWal (mRpnPar1 s) +theorem mWffSubEval_266 : MWffSubEval (M := M) 266 mWffOp_266 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_298 mWffSubEval_325 +noncomputable abbrev mWffOp_265 (s : MWffState M) : MWffState M := mWffOp_266 ((mRpnVk 1) s) +theorem mWffSubEval_265 : MWffSubEval (M := M) 265 mWffOp_265 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_319 mWffSubEval_266 +noncomputable abbrev mWffOp_258 (s : MWffState M) : MWffState M := mRpnWim (mRpnWeq s) +theorem mWffSubEval_258 : MWffSubEval (M := M) 258 mWffOp_258 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_329 mWffSubEval_390 +noncomputable abbrev mWffOp_257 (s : MWffState M) : MWffState M := mWffOp_258 ((mRpnVk 1) s) +theorem mWffSubEval_257 : MWffSubEval (M := M) 257 mWffOp_257 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_319 mWffSubEval_258 +noncomputable abbrev mWffOp_270 (s : MWffState M) : MWffState M := mRpnWex (mRpnWal s) +theorem mWffSubEval_270 : MWffSubEval (M := M) 270 mWffOp_270 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_325 mWffSubEval_331 +noncomputable abbrev mWffOp_280 (s : MWffState M) : MWffState M := mRpnWel ((mRpnVk 1) s) +theorem mWffSubEval_280 : MWffSubEval (M := M) 280 mWffOp_280 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_319 mWffSubEval_327 +noncomputable abbrev mWffOp_263 (s : MWffState M) : MWffState M := mWffOp_280 ((mRpnVk 2) s) +theorem mWffSubEval_263 : MWffSubEval (M := M) 263 mWffOp_263 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_320 mWffSubEval_280 +noncomputable abbrev mWffOp_249 (s : MWffState M) : MWffState M := mWffOp_263 ((mRpnVk 2) s) +theorem mWffSubEval_249 : MWffSubEval (M := M) 249 mWffOp_249 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_320 mWffSubEval_263 +noncomputable abbrev mWffOp_287 (s : MWffState M) : MWffState M := mRpnWel ((mRpnVk 0) s) +theorem mWffSubEval_287 : MWffSubEval (M := M) 287 mWffOp_287 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_304 mWffSubEval_327 +noncomputable abbrev mWffOp_264 (s : MWffState M) : MWffState M := mWffOp_287 ((mRpnVk 3) s) +theorem mWffSubEval_264 : MWffSubEval (M := M) 264 mWffOp_264 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_321 mWffSubEval_287 +noncomputable abbrev mWffOp_278 (s : MWffState M) : MWffState M := mRpnWex (mRpnWa s) +theorem mWffSubEval_278 : MWffSubEval (M := M) 278 mWffOp_278 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_323 mWffSubEval_331 +noncomputable abbrev mWffOp_240 (s : MWffState M) : MWffState M := mWffOp_278 (mWffOp_265 s) +theorem mWffSubEval_240 : MWffSubEval (M := M) 240 mWffOp_240 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_265 mWffSubEval_278 +noncomputable abbrev mWffOp_239 (s : MWffState M) : MWffState M := mWffOp_240 (mWffOp_264 s) +theorem mWffSubEval_239 : MWffSubEval (M := M) 239 mWffOp_239 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_264 mWffSubEval_240 +noncomputable abbrev mWffOp_238 (s : MWffState M) : MWffState M := mWffOp_239 ((mRpnVk 3) s) +theorem mWffSubEval_238 : MWffSubEval (M := M) 238 mWffOp_238 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_321 mWffSubEval_239 +noncomputable abbrev mWffOp_248 (s : MWffState M) : MWffState M := mRpnWim (mWffOp_263 s) +theorem mWffSubEval_248 : MWffSubEval (M := M) 248 mWffOp_248 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_263 mWffSubEval_390 +noncomputable abbrev mWffOp_281 (s : MWffState M) : MWffState M := mRpnSelect (mRpnWim s) +theorem mWffSubEval_281 : MWffSubEval (M := M) 281 mWffOp_281 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_390 mWffSubEval_305 +noncomputable abbrev mWffOp_267 (s : MWffState M) : MWffState M := (mRpnVk 1) (mWffOp_281 s) +theorem mWffSubEval_267 : MWffSubEval (M := M) 267 mWffOp_267 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_281 mWffSubEval_319 +noncomputable abbrev mWffOp_285 (s : MWffState M) : MWffState M := (mRpnVk 3) ((mRpnVk 2) s) +theorem mWffSubEval_285 : MWffSubEval (M := M) 285 mWffOp_285 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_320 mWffSubEval_321 +noncomputable abbrev mWffOp_245 (s : MWffState M) : MWffState M := mWffOp_285 (mWffOp_267 s) +theorem mWffSubEval_245 : MWffSubEval (M := M) 245 mWffOp_245 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_267 mWffSubEval_285 +noncomputable abbrev mWffOp_247 (s : MWffState M) : MWffState M := mWffOp_264 (mRpnWel s) +theorem mWffSubEval_247 : MWffSubEval (M := M) 247 mWffOp_247 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_327 mWffSubEval_264 +noncomputable abbrev mWffOp_272 (s : MWffState M) : MWffState M := mRpnWal (mRpnWim s) +theorem mWffSubEval_272 : MWffSubEval (M := M) 272 mWffOp_272 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_390 mWffSubEval_325 +noncomputable abbrev mWffOp_283 (s : MWffState M) : MWffState M := mRpnPar1 (mRpnSelect s) +theorem mWffSubEval_283 : MWffSubEval (M := M) 283 mWffOp_283 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_305 mWffSubEval_298 +noncomputable abbrev mWffOp_242 (s : MWffState M) : MWffState M := mWffOp_283 (mWffOp_270 s) +theorem mWffSubEval_242 : MWffSubEval (M := M) 242 mWffOp_242 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_270 mWffSubEval_283 +noncomputable abbrev mWffOp_241 (s : MWffState M) : MWffState M := mWffOp_242 (mWffOp_248 s) +theorem mWffSubEval_241 : MWffSubEval (M := M) 241 mWffOp_241 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_248 mWffSubEval_242 +noncomputable abbrev mWffOp_274 (s : MWffState M) : MWffState M := mRpnPar1 (mRpnWim s) +theorem mWffSubEval_274 : MWffSubEval (M := M) 274 mWffOp_274 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_390 mWffSubEval_298 +noncomputable abbrev mWffOp_268 (s : MWffState M) : MWffState M := mWffOp_281 (mRpnWim s) +theorem mWffSubEval_268 : MWffSubEval (M := M) 268 mWffOp_268 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_390 mWffSubEval_281 +noncomputable abbrev mWffOp_279 (s : MWffState M) : MWffState M := mRpnPar2 (mRpnPar1 s) +theorem mWffSubEval_279 : MWffSubEval (M := M) 279 mWffOp_279 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_298 mWffSubEval_300 +noncomputable abbrev mWffOp_246 (s : MWffState M) : MWffState M := mWffOp_279 (mWffOp_268 s) +theorem mWffSubEval_246 : MWffSubEval (M := M) 246 mWffOp_246 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_268 mWffSubEval_279 +noncomputable abbrev mWffOp_284 (s : MWffState M) : MWffState M := mRpnPar3 (mRpnPar1 s) +theorem mWffSubEval_284 : MWffSubEval (M := M) 284 mWffOp_284 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_298 mWffSubEval_302 +noncomputable abbrev mWffOp_286 (s : MWffState M) : MWffState M := mWffOp_284 (mRpnWeq s) +theorem mWffSubEval_286 : MWffSubEval (M := M) 286 mWffOp_286 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_329 mWffSubEval_284 +noncomputable abbrev mWffOp_243 (s : MWffState M) : MWffState M := mWffOp_286 (mWffOp_246 s) +theorem mWffSubEval_243 : MWffSubEval (M := M) 243 mWffOp_243 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_246 mWffSubEval_286 +noncomputable abbrev mWffOp_273 (s : MWffState M) : MWffState M := mRpnPar3 (mRpnPar2 s) +theorem mWffSubEval_273 : MWffSubEval (M := M) 273 mWffOp_273 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_300 mWffSubEval_302 +noncomputable abbrev mWffOp_244 (s : MWffState M) : MWffState M := mWffOp_246 (mRpnWel s) +theorem mWffSubEval_244 : MWffSubEval (M := M) 244 mWffOp_244 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_327 mWffSubEval_246 +noncomputable abbrev mWffOp_282 (s : MWffState M) : MWffState M := mRpnPar1 (mRpnPar3 s) +theorem mWffSubEval_282 : MWffSubEval (M := M) 282 mWffOp_282 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_302 mWffSubEval_298 +noncomputable abbrev mWffOp_230 (s : MWffState M) : MWffState M := mWffOp_282 (mRpnWeq s) +theorem mWffSubEval_230 : MWffSubEval (M := M) 230 mWffOp_230 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_329 mWffSubEval_282 +noncomputable abbrev mWffOp_229 (s : MWffState M) : MWffState M := mWffOp_230 (mWffOp_244 s) +theorem mWffSubEval_229 : MWffSubEval (M := M) 229 mWffOp_229 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_244 mWffSubEval_230 +noncomputable abbrev mWffOp_228 (s : MWffState M) : MWffState M := mWffOp_229 (mWffOp_273 s) +theorem mWffSubEval_228 : MWffSubEval (M := M) 228 mWffOp_228 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_273 mWffSubEval_229 +noncomputable abbrev mWffOp_227 (s : MWffState M) : MWffState M := mWffOp_228 (mRpnWel s) +theorem mWffSubEval_227 : MWffSubEval (M := M) 227 mWffOp_227 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_327 mWffSubEval_228 +noncomputable abbrev mWffOp_226 (s : MWffState M) : MWffState M := mWffOp_227 (mWffOp_243 s) +theorem mWffSubEval_226 : MWffSubEval (M := M) 226 mWffOp_226 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_243 mWffSubEval_227 +noncomputable abbrev mWffOp_271 (s : MWffState M) : MWffState M := mRpnWim (mRpnWal s) +theorem mWffSubEval_271 : MWffSubEval (M := M) 271 mWffOp_271 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_325 mWffSubEval_390 +noncomputable abbrev mWffOp_254 (s : MWffState M) : MWffState M := mRpnWel (mWffOp_279 s) +theorem mWffSubEval_254 : MWffSubEval (M := M) 254 mWffOp_254 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_279 mWffSubEval_327 +noncomputable abbrev mWffOp_253 (s : MWffState M) : MWffState M := mWffOp_273 (mWffOp_283 s) +theorem mWffSubEval_253 : MWffSubEval (M := M) 253 mWffOp_253 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_283 mWffSubEval_273 +noncomputable abbrev mWffOp_259 (s : MWffState M) : MWffState M := mRpnWal (mWffOp_284 s) +theorem mWffSubEval_259 : MWffSubEval (M := M) 259 mWffOp_259 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_284 mWffSubEval_325 +noncomputable abbrev mWffOp_237 (s : MWffState M) : MWffState M := mWffOp_279 (mWffOp_283 s) +theorem mWffSubEval_237 : MWffSubEval (M := M) 237 mWffOp_237 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_283 mWffSubEval_279 +noncomputable abbrev mWffOp_236 (s : MWffState M) : MWffState M := mWffOp_237 (mWffOp_271 s) +theorem mWffSubEval_236 : MWffSubEval (M := M) 236 mWffOp_236 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_271 mWffSubEval_237 +noncomputable abbrev mWffOp_235 (s : MWffState M) : MWffState M := mWffOp_236 (mWffOp_259 s) +theorem mWffSubEval_235 : MWffSubEval (M := M) 235 mWffOp_235 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_259 mWffSubEval_236 +noncomputable abbrev mWffOp_234 (s : MWffState M) : MWffState M := mWffOp_235 (mRpnPar2 s) +theorem mWffSubEval_234 : MWffSubEval (M := M) 234 mWffOp_234 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_300 mWffSubEval_235 +noncomputable abbrev mWffOp_233 (s : MWffState M) : MWffState M := mWffOp_234 (mRpnWal s) +theorem mWffSubEval_233 : MWffSubEval (M := M) 233 mWffOp_233 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_325 mWffSubEval_234 +noncomputable abbrev mWffOp_232 (s : MWffState M) : MWffState M := mWffOp_233 (mRpnWal s) +theorem mWffSubEval_232 : MWffSubEval (M := M) 232 mWffOp_232 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_325 mWffSubEval_233 +noncomputable abbrev mWffOp_231 (s : MWffState M) : MWffState M := mWffOp_232 (mWffOp_253 s) +theorem mWffSubEval_231 : MWffSubEval (M := M) 231 mWffOp_231 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_253 mWffSubEval_232 +noncomputable abbrev mWffOp_275 (s : MWffState M) : MWffState M := (mRpnVk 0) ((mRpnVk 2) s) +theorem mWffSubEval_275 : MWffSubEval (M := M) 275 mWffOp_275 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_320 mWffSubEval_304 +noncomputable abbrev mWffOp_252 (s : MWffState M) : MWffState M := mRpnWal (mRpnWa s) +theorem mWffSubEval_252 : MWffSubEval (M := M) 252 mWffOp_252 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_323 mWffSubEval_325 +noncomputable abbrev mWffOp_251 (s : MWffState M) : MWffState M := mWffOp_252 (mRpnWim s) +theorem mWffSubEval_251 : MWffSubEval (M := M) 251 mWffOp_251 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_390 mWffSubEval_252 +noncomputable abbrev mWffOp_250 (s : MWffState M) : MWffState M := mWffOp_251 (mRpnWel s) +theorem mWffSubEval_250 : MWffSubEval (M := M) 250 mWffOp_250 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_327 mWffSubEval_251 +noncomputable abbrev mWffOp_276 (s : MWffState M) : MWffState M := mRpnCparam3 (mRpnSelect s) +theorem mWffSubEval_276 : MWffSubEval (M := M) 276 mWffOp_276 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_305 mWffSubEval_81 +noncomputable abbrev mWffOp_260 (s : MWffState M) : MWffState M := mWffOp_280 ((mRpnVk 0) s) +theorem mWffSubEval_260 : MWffSubEval (M := M) 260 mWffOp_260 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_304 mWffSubEval_280 +noncomputable abbrev mWffOp_262 (s : MWffState M) : MWffState M := mRpnWeq ((mRpnVk 0) s) +theorem mWffSubEval_262 : MWffSubEval (M := M) 262 mWffOp_262 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_304 mWffSubEval_329 +noncomputable abbrev mWffOp_261 (s : MWffState M) : MWffState M := mWffOp_262 ((mRpnVk 1) s) +theorem mWffSubEval_261 : MWffSubEval (M := M) 261 mWffOp_261 := + mWffSubEval_seq rfl (by decide) rfl (by decide) mWffSubEval_319 mWffSubEval_262 + +/-- `MWffState`-level spine segment evaluation on `PAM M`. -/ +def MWffSpineEval (k₁ k₂ : ℕ) (op : MWffState M → MWffState M) : Prop := + ∀ (slot pl np : PAM M) (s : MWffState M), + MZfLogInv slot (List.replicate k₁ 1) (mWffStateToRegs pl np s) → + ∃ slot' : PAM M, + MZfLogInv slot' (List.replicate k₂ 1) (mWffStateToRegs pl np (op s)) ∧ + mReachPos (mZfLogCfg slot (List.replicate k₁ 1) (mWffStateToRegs pl np s)) + (mZfLogCfg slot' (List.replicate k₂ 1) (mWffStateToRegs pl np (op s))) + +theorem mWffSpineEval_step {k k' : ℕ} {q_k q_sub : Fin 393} + {op : MWffState M → MWffState M} + (hwalk : walkInternal 99 (List.replicate k 1) = some q_k) + (htr0 : zf393Trans q_k 0 = some (0, .right, q_sub)) + (hq_sub : 69 ≤ q_sub.val) + (hsub : MWffSubEval (M := M) q_sub op) + (hk : k + 1 = k' := by rfl) : + MWffSpineEval (M := M) k k' op := by + subst hk + intro slot pl np s hinv + have hwalk0 : walkInternal 99 (List.replicate k 1 ++ [0]) = some q_sub := + walkInternal_snoc hwalk htr0 hq_sub + have hinv0 : + MZfLogInv slot (trimZeros (List.replicate k 1 ++ [0])) (mWffStateToRegs pl np s) := by + rwa [trimZeros_append_zero, trimZeros_replicate_one] + obtain ⟨slot', hinv', hreach⟩ := hsub (List.replicate k 1 ++ [0]) hwalk0 slot pl np s hinv0 + rw [trimZeros_append_zero, trimZeros_replicate_one, retStack_append_zero, + ← List.replicate_succ'] at hreach + rw [retStack_append_zero, ← List.replicate_succ'] at hinv' + exact ⟨slot', hinv', hreach⟩ + +theorem mWffSpineEval_trans {k₁ k₂ k₃ : ℕ} {op₁ op₂ op : MWffState M → MWffState M} + (h1 : MWffSpineEval (M := M) k₁ k₂ op₁) (h2 : MWffSpineEval (M := M) k₂ k₃ op₂) + (heq : (fun s ↦ op₂ (op₁ s)) = op := by rfl) : + MWffSpineEval (M := M) k₁ k₃ op := by + subst heq + intro slot pl np s hinv + obtain ⟨slot₁, hinv₁, hreach₁⟩ := h1 slot pl np s hinv + obtain ⟨slot₂, hinv₂, hreach₂⟩ := h2 slot₁ pl np (op₁ s) hinv₁ + exact ⟨slot₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + +theorem mWffSpineEval_of_mRegSpineEval {k₁ k₂ : ℕ} {f : List (PAM M) → List (PAM M)} + {op : MWffState M → MWffState M} (h : MRegSpineEval (M := M) k₁ k₂ f) + (heq : ∀ pl np s, f (mWffStateToRegs pl np s) = mWffStateToRegs pl np (op s)) : + MWffSpineEval (M := M) k₁ k₂ op := by + intro slot pl np s hinv + obtain ⟨_, slot', hinv', hreach⟩ := h slot (mWffStateToRegs pl np s) hinv + rw [heq pl np s] at hinv' hreach + exact ⟨slot', hinv', hreach⟩ + +theorem mWffSpineEval_55_58 : MWffSpineEval (M := M) 55 58 mRpnZf393B6aCheck1 := by + refine mWffSpineEval_of_mRegSpineEval + (mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_55 rfl (by decide) mSubEval_351) <| + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_56 rfl (by decide) mSubEval_364) <| + mRegSpineEval_step walkInternal_spine_57 rfl (by decide) mSubEval_255) ?_ + intro pl np s + simp only [mWffStateToRegs, mReg255Op, mReg256Op, mReg92Op, mRpnZf393B6aCheck1, List.getD, + List.getElem?_cons_zero, List.getElem?_cons_succ, Option.getD_some, + List.set_cons_zero, List.set_cons_succ, zero_add] + split_ifs <;> rfl + +theorem mWffSpineEval_58_61 : MWffSpineEval (M := M) 58 61 mRpnZf393B6aCheck2 := by + refine mWffSpineEval_of_mRegSpineEval + (mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_58 rfl (by decide) mSubEval_355) <| + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_59 rfl (by decide) mSubEval_366) <| + mRegSpineEval_step walkInternal_spine_60 rfl (by decide) mSubEval_255) ?_ + intro pl np s + simp only [mWffStateToRegs, mReg255Op, mReg256Op, mReg92Op, mRpnZf393B6aCheck2, List.getD, + List.getElem?_cons_zero, List.getElem?_cons_succ, Option.getD_some, + List.set_cons_zero, List.set_cons_succ, zero_add] + split_ifs <;> rfl + +theorem mWffSpineEval_97_101 : MWffSpineEval (M := M) 97 101 mRpnDetCheck := by + refine mWffSpineEval_of_mRegSpineEval + (mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_97 rfl (by decide) mSubEval_388) <| + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_98 rfl (by decide) mSubEval_354) <| + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_99 rfl (by decide) mSubEval_366) <| + mRegSpineEval_step walkInternal_spine_100 rfl (by decide) mSubEval_93) ?_ + intro pl np s + simp only [mWffStateToRegs, mReg93Op, mReg94Op, mRpnDetCheck, List.getD, + List.getElem?_cons_zero, List.getElem?_cons_succ, Option.getD_some, + List.set_cons_zero, List.set_cons_succ, zero_add] + split_ifs <;> rfl + +noncomputable abbrev mWffSpineOp_13_21 (s : MWffState M) : MWffState M := + mRpnWal (mWffOp_270 (mWffOp_257 ((mRpnVk 2) (mWffOp_265 (mWffOp_277 ((mRpnVk 3) + ((mRpnVk 0) s))))))) +theorem mWffSpineEval_13_21 : MWffSpineEval (M := M) 13 21 mWffSpineOp_13_21 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_13 rfl (by decide) mWffSubEval_304) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_14 rfl (by decide) mWffSubEval_321) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_15 rfl (by decide) mWffSubEval_277) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_16 rfl (by decide) mWffSubEval_265) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_17 rfl (by decide) mWffSubEval_320) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_18 rfl (by decide) mWffSubEval_257) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_19 rfl (by decide) mWffSubEval_270) <| + mWffSpineEval_step walkInternal_spine_20 rfl (by decide) mWffSubEval_325 + +noncomputable abbrev mWffSpineOp_21_29 (s : MWffState M) : MWffState M := + mWffOp_270 (mRpnWa (mWffOp_248 (mWffOp_238 (mRpnWim (mWffOp_238 (mWffOp_249 ((mRpnVk 1) s))))))) +theorem mWffSpineEval_21_29 : MWffSpineEval (M := M) 21 29 mWffSpineOp_21_29 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_21 rfl (by decide) mWffSubEval_319) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_22 rfl (by decide) mWffSubEval_249) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_23 rfl (by decide) mWffSubEval_238) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_24 rfl (by decide) mWffSubEval_390) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_25 rfl (by decide) mWffSubEval_238) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_26 rfl (by decide) mWffSubEval_248) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_27 rfl (by decide) mWffSubEval_323) <| + mWffSpineEval_step walkInternal_spine_28 rfl (by decide) mWffSubEval_270 + +noncomputable abbrev mWffSpineOp_29_37 (s : MWffState M) : MWffState M := + mRpnPar1 (mRpnWn (mWffOp_241 (mWffOp_272 (mWffOp_247 ((mRpnVk 2) ((mRpnVk 3) (mWffOp_245 s))))))) +theorem mWffSpineEval_29_37 : MWffSpineEval (M := M) 29 37 mWffSpineOp_29_37 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_29 rfl (by decide) mWffSubEval_245) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_30 rfl (by decide) mWffSubEval_321) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_31 rfl (by decide) mWffSubEval_320) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_32 rfl (by decide) mWffSubEval_247) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_33 rfl (by decide) mWffSubEval_272) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_34 rfl (by decide) mWffSubEval_241) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_35 rfl (by decide) mWffSubEval_392) <| + mWffSpineEval_step walkInternal_spine_36 rfl (by decide) mWffSubEval_298 + +noncomputable abbrev mWffSpineOp_37_45 (s : MWffState M) : MWffState M := + mRpnWn (mRpnPar1 (mWffOp_241 (mWffOp_278 (mWffOp_247 (mWffOp_285 (mWffOp_245 (mWffOp_274 s))))))) +theorem mWffSpineEval_37_45 : MWffSpineEval (M := M) 37 45 mWffSpineOp_37_45 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_37 rfl (by decide) mWffSubEval_274) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_38 rfl (by decide) mWffSubEval_245) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_39 rfl (by decide) mWffSubEval_285) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_40 rfl (by decide) mWffSubEval_247) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_41 rfl (by decide) mWffSubEval_278) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_42 rfl (by decide) mWffSubEval_241) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_43 rfl (by decide) mWffSubEval_298) <| + mWffSpineEval_step walkInternal_spine_44 rfl (by decide) mWffSubEval_392 + +noncomputable abbrev mWffSpineOp_45_55 (s : MWffState M) : MWffState M := + mRpnWa (mWffOp_271 (mWffOp_254 (mRpnPar3 (mWffOp_254 (mWffOp_271 + (mRpnWeq (mRpnPar2 (mWffOp_226 (mRpnPar2 s))))))))) +theorem mWffSpineEval_45_55 : MWffSpineEval (M := M) 45 55 mWffSpineOp_45_55 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_45 rfl (by decide) mWffSubEval_300) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_46 rfl (by decide) mWffSubEval_226) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_47 rfl (by decide) mWffSubEval_300) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_48 rfl (by decide) mWffSubEval_329) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_49 rfl (by decide) mWffSubEval_271) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_50 rfl (by decide) mWffSubEval_254) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_51 rfl (by decide) mWffSubEval_302) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_52 rfl (by decide) mWffSubEval_254) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_53 rfl (by decide) mWffSubEval_271) <| + mWffSpineEval_step walkInternal_spine_54 rfl (by decide) mWffSubEval_323 + +noncomputable abbrev mWffSpineOp_55_65 (s : MWffState M) : MWffState M := + mWffOp_253 (mRpnWex (mRpnWeq (mWffOp_231 (mRpnZf393B6aCheck2 (mRpnZf393B6aCheck1 s))))) +theorem mWffSpineEval_55_65 : MWffSpineEval (M := M) 55 65 mWffSpineOp_55_65 := + mWffSpineEval_trans mWffSpineEval_55_58 <| + mWffSpineEval_trans mWffSpineEval_58_61 <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_61 rfl (by decide) mWffSubEval_231) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_62 rfl (by decide) mWffSubEval_329) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_63 rfl (by decide) mWffSubEval_331) <| + mWffSpineEval_step walkInternal_spine_64 rfl (by decide) mWffSubEval_253 + +noncomputable abbrev mWffSpineOp_65_73 (s : MWffState M) : MWffState M := + mRpnWeq (mWffOp_273 (mRpnWeq (mWffOp_243 (mWffOp_259 (mRpnWal (mWffOp_279 (mWffOp_272 s))))))) +theorem mWffSpineEval_65_73 : MWffSpineEval (M := M) 65 73 mWffSpineOp_65_73 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_65 rfl (by decide) mWffSubEval_272) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_66 rfl (by decide) mWffSubEval_279) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_67 rfl (by decide) mWffSubEval_325) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_68 rfl (by decide) mWffSubEval_259) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_69 rfl (by decide) mWffSubEval_243) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_70 rfl (by decide) mWffSubEval_329) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_71 rfl (by decide) mWffSubEval_273) <| + mWffSpineEval_step walkInternal_spine_72 rfl (by decide) mWffSubEval_329 + +noncomputable abbrev mWffSpineOp_73_81 (s : MWffState M) : MWffState M := + mWffOp_274 (mWffOp_273 (mRpnWim (mWffOp_244 (mRpnPar2 (mRpnPar3 (mRpnWel (mWffOp_226 s))))))) +theorem mWffSpineEval_73_81 : MWffSpineEval (M := M) 73 81 mWffSpineOp_73_81 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_73 rfl (by decide) mWffSubEval_226) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_74 rfl (by decide) mWffSubEval_327) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_75 rfl (by decide) mWffSubEval_302) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_76 rfl (by decide) mWffSubEval_300) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_77 rfl (by decide) mWffSubEval_244) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_78 rfl (by decide) mWffSubEval_390) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_79 rfl (by decide) mWffSubEval_273) <| + mWffSpineEval_step walkInternal_spine_80 rfl (by decide) mWffSubEval_274 + +noncomputable abbrev mWffSpineOp_81_89 (s : MWffState M) : MWffState M := + mWffOp_263 (mWffOp_248 (mRpnWel (mWffOp_275 ((mRpnVk 2) (mWffOp_268 (mRpnWim (mRpnPar3 s))))))) +theorem mWffSpineEval_81_89 : MWffSpineEval (M := M) 81 89 mWffSpineOp_81_89 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_81 rfl (by decide) mWffSubEval_302) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_82 rfl (by decide) mWffSubEval_390) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_83 rfl (by decide) mWffSubEval_268) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_84 rfl (by decide) mWffSubEval_320) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_85 rfl (by decide) mWffSubEval_275) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_86 rfl (by decide) mWffSubEval_327) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_87 rfl (by decide) mWffSubEval_248) <| + mWffSpineEval_step walkInternal_spine_88 rfl (by decide) mWffSubEval_263 + +noncomputable abbrev mWffSpineOp_89_97 (s : MWffState M) : MWffState M := + mRpnWim (mWffOp_282 (mRpnCparam2 (mWffOp_276 (mWffOp_257 ((mRpnVk 0) + (mWffOp_250 (mWffOp_275 s))))))) +theorem mWffSpineEval_89_97 : MWffSpineEval (M := M) 89 97 mWffSpineOp_89_97 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_89 rfl (by decide) mWffSubEval_275) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_90 rfl (by decide) mWffSubEval_250) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_91 rfl (by decide) mWffSubEval_304) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_92 rfl (by decide) mWffSubEval_257) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_93 rfl (by decide) mWffSubEval_276) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_94 rfl (by decide) mWffSubEval_79) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_95 rfl (by decide) mWffSubEval_282) <| + mWffSpineEval_step walkInternal_spine_96 rfl (by decide) mWffSubEval_390 + +noncomputable abbrev mWffSpineOp_97_106 (s : MWffState M) : MWffState M := + mRpnPar2 (mWffOp_270 (mWffOp_231 (mWffOp_259 (mWffOp_276 (mRpnDetCheck s))))) +theorem mWffSpineEval_97_106 : MWffSpineEval (M := M) 97 106 mWffSpineOp_97_106 := + mWffSpineEval_trans mWffSpineEval_97_101 <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_101 rfl (by decide) mWffSubEval_276) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_102 rfl (by decide) mWffSubEval_259) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_103 rfl (by decide) mWffSubEval_231) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_104 rfl (by decide) mWffSubEval_270) <| + mWffSpineEval_step walkInternal_spine_105 rfl (by decide) mWffSubEval_300 + +noncomputable abbrev mWffSpineOp_106_114 (s : MWffState M) : MWffState M := + mRpnWel (mWffOp_277 ((mRpnVk 1) (mWffOp_249 (mWffOp_260 ((mRpnVk 0) + (mWffOp_260 (mWffOp_267 s))))))) +theorem mWffSpineEval_106_114 : MWffSpineEval (M := M) 106 114 mWffSpineOp_106_114 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_106 rfl (by decide) mWffSubEval_267) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_107 rfl (by decide) mWffSubEval_260) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_108 rfl (by decide) mWffSubEval_304) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_109 rfl (by decide) mWffSubEval_260) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_110 rfl (by decide) mWffSubEval_249) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_111 rfl (by decide) mWffSubEval_319) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_112 rfl (by decide) mWffSubEval_277) <| + mWffSpineEval_step walkInternal_spine_113 rfl (by decide) mWffSubEval_327 + +noncomputable abbrev mWffSpineOp_114_123 (s : MWffState M) : MWffState M := + mRpnSelect (mWffOp_278 (mWffOp_272 (mWffOp_278 (mWffOp_250 (mWffOp_277 (mWffOp_261 + (mRpnWim (mWffOp_261 s)))))))) +theorem mWffSpineEval_114_123 : MWffSpineEval (M := M) 114 123 mWffSpineOp_114_123 := + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_114 rfl (by decide) mWffSubEval_261) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_115 rfl (by decide) mWffSubEval_390) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_116 rfl (by decide) mWffSubEval_261) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_117 rfl (by decide) mWffSubEval_277) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_118 rfl (by decide) mWffSubEval_250) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_119 rfl (by decide) mWffSubEval_278) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_120 rfl (by decide) mWffSubEval_272) <| + mWffSpineEval_trans (mWffSpineEval_step walkInternal_spine_121 rfl (by decide) mWffSubEval_278) <| + mWffSpineEval_step walkInternal_spine_122 rfl (by decide) mWffSubEval_305 + +/-! ### RPN Clause Definitions and Closed-Form `mZf393ClauseDispatch` Equivalence -/ + +noncomputable def mRpnClauseDET (s : MWffState M) : MWffState M := + mRpnSelect (mRpnDetCheck (mRpnWim (mRpnPar1 (mRpnPar3 (mRpnCparam2 (mRpnCparam3 s)))))) + +noncomputable def mRpnClauseGEN (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWal (mRpnPar3 (mRpnPar1 (mRpnCparam3 s)))) + +noncomputable def mRpnClauseB1 (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnWim (mRpnWim (mRpnPar3 (mRpnPar1 (mRpnWim + (mRpnPar3 (mRpnPar2 (mRpnWim (mRpnPar2 (mRpnPar1 s))))))))))) + +noncomputable def mRpnClauseB2 (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnPar1 (mRpnWim (mRpnPar1 (mRpnWn (mRpnPar1 s)))))) + +noncomputable def mRpnClauseB3 (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnWim (mRpnPar2 (mRpnWn (mRpnPar1 (mRpnPar1 s)))))) + +noncomputable def mRpnClauseB4 (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnWim (mRpnWal (mRpnPar3 (mRpnPar1 (mRpnWal + (mRpnPar2 (mRpnPar1 (mRpnWal (mRpnWim (mRpnPar3 (mRpnPar2 (mRpnPar1 s))))))))))))) + +noncomputable def mRpnZf393ClauseB6a (s : MWffState M) : MWffState M := + let s1 := + mRpnWim (mRpnWal (mRpnWeq (mRpnPar2 (mRpnPar1 (mRpnPar3 (mRpnWeq (mRpnPar2 (mRpnPar1 s)))))))) + let s2 := + mRpnWa (mRpnWim (mRpnWal (mRpnWel (mRpnPar2 (mRpnPar1 (mRpnPar3 + (mRpnWel (mRpnPar2 (mRpnPar1 s1))))))))) + mRpnSelect (mRpnZf393B6aCheck2 (mRpnZf393B6aCheck1 s2)) + +noncomputable def mRpnClauseB6b (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnWal (mRpnWal (mRpnPar3 (mRpnPar1 (mRpnPar2 + (mRpnWal (mRpnWal (mRpnPar3 (mRpnPar2 (mRpnPar1 s))))))))))) + +noncomputable def mRpnClauseB6c (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnPar2 (mRpnWex (mRpnWal (mRpnPar2 (mRpnPar1 (mRpnPar1 s))))))) + +noncomputable def mRpnClauseB7 (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWex (mRpnWeq (mRpnPar2 (mRpnPar1 (mRpnPar1 s))))) + +noncomputable def mRpnClauseB8a (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnWim (mRpnWeq (mRpnPar3 (mRpnPar2 (mRpnWeq + (mRpnPar3 (mRpnPar1 (mRpnWeq (mRpnPar2 (mRpnPar1 s))))))))))) + +noncomputable def mRpnClauseB8b (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnWim (mRpnWel (mRpnPar3 (mRpnPar2 (mRpnWel + (mRpnPar3 (mRpnPar1 (mRpnWeq (mRpnPar2 (mRpnPar1 s))))))))))) + +noncomputable def mRpnClauseB8c (s : MWffState M) : MWffState M := + mRpnSelect (mRpnWim (mRpnWim (mRpnWel (mRpnPar2 (mRpnPar3 (mRpnWel + (mRpnPar1 (mRpnPar3 (mRpnWeq (mRpnPar2 (mRpnPar1 s))))))))))) + +noncomputable def mRpnClauseEXT (s : MWffState M) : MWffState M := + let s1 := mRpnWim (mRpnWel (mRpnVk 1 (mRpnVk 2 (mRpnWel (mRpnVk 0 (mRpnVk 2 (mRpnVk 2 s))))))) + let s2 := mRpnWa (mRpnWim (mRpnWel (mRpnVk 0 (mRpnVk 2 (mRpnWel (mRpnVk 1 (mRpnVk 2 s1))))))) + mRpnSelect (mRpnWim (mRpnWeq (mRpnVk 1 (mRpnVk 0 (mRpnWal s2))))) + +noncomputable def mRpnClauseREP (s : MWffState M) : MWffState M := + let s1 := mRpnWal (mRpnWex (mRpnWal (mRpnWim (mRpnWeq (mRpnVk 1 (mRpnVk 2 + (mRpnWal (mRpnPar1 (mRpnVk 1 (mRpnVk 2 (mRpnVk 1 (mRpnVk 3 s)))))))))))) + let s2 := mRpnWel (mRpnVk 1 (mRpnVk 2 (mRpnVk 2 (mRpnVk 1 s1)))) + let s3 := mRpnWim (mRpnWex (mRpnWa (mRpnWal (mRpnPar1 (mRpnVk 1 + (mRpnWel (mRpnVk 0 (mRpnVk 3 (mRpnVk 3 s2))))))))) + let s4 := mRpnWex (mRpnWa (mRpnWal (mRpnPar1 (mRpnVk 1 + (mRpnWel (mRpnVk 0 (mRpnVk 3 (mRpnVk 3 s3)))))))) + let s5 := mRpnWa (mRpnWim (mRpnWel (mRpnVk 1 (mRpnVk 2 s4)))) + mRpnSelect (mRpnWim (mRpnWex (mRpnWal s5))) + +noncomputable def mRpnClausePOW (s : MWffState M) : MWffState M := + let s1 := mRpnWal (mRpnWim (mRpnWel (mRpnVk 0 (mRpnVk 3 (mRpnWel + (mRpnVk 2 (mRpnVk 3 (mRpnVk 3 (mRpnVk 2 (mRpnVk 1 s)))))))))) + mRpnSelect (mRpnWex (mRpnWal (mRpnWim (mRpnWel (mRpnVk 1 (mRpnVk 2 s1)))))) + +noncomputable def mRpnClauseUNI (s : MWffState M) : MWffState M := + let s1 := mRpnWex (mRpnWa (mRpnWel (mRpnVk 0 (mRpnVk 3 (mRpnWel + (mRpnVk 3 (mRpnVk 2 (mRpnVk 3 (mRpnVk 2 (mRpnVk 1 s)))))))))) + mRpnSelect (mRpnWex (mRpnWal (mRpnWim (mRpnWel (mRpnVk 1 (mRpnVk 2 s1)))))) + +noncomputable def mRpnClauseINF (s : MWffState M) : MWffState M := + let s1 := mRpnWel (mRpnVk 1 (mRpnVk 2 (mRpnVk 2 (mRpnWel (mRpnVk 1 + (mRpnVk 0 (mRpnVk 0 (mRpnWel (mRpnVk 1 (mRpnVk 0 (mRpnVk 1 s))))))))))) + let s2 := mRpnWim (mRpnWeq (mRpnVk 0 (mRpnVk 1 (mRpnWel (mRpnVk 2 (mRpnVk 1 (mRpnVk 1 s1))))))) + let s3 := mRpnWal (mRpnWa (mRpnWim (mRpnWel (mRpnVk 2 (mRpnVk 1 + (mRpnWeq (mRpnVk 0 (mRpnVk 1 s2)))))))) + mRpnSelect (mRpnWex (mRpnWa (mRpnWal (mRpnWim (mRpnWex (mRpnWa s3)))))) + +noncomputable def mRpnZf393AllClausesOp (s : MWffState M) : MWffState M := + let s0 := mRpnVk 0 s + mRpnClauseINF (mRpnClauseB6c (mRpnClauseB6b (mRpnClauseGEN (mRpnClauseDET + (mRpnClauseEXT (mRpnClauseB1 (mRpnClauseB8c (mRpnClauseB8b (mRpnClauseB8a + (mRpnClauseB4 (mRpnClauseB7 (mRpnClauseB6b (mRpnZf393ClauseB6a (mRpnClauseB8b + (mRpnClauseB3 (mRpnClauseUNI (mRpnClauseB2 + (mRpnClausePOW (mRpnClauseREP s0))))))))))))))))))) + +noncomputable def mRpnZf393AllClauses (top stk ac p1 p2 p3 : PAM M) : MWffState M := + mRpnZf393AllClausesOp ⟨top, stk, ac, p1, p2, p3⟩ + +theorem mWffSpineEval_13_123 : MWffSpineEval (M := M) 13 123 mRpnZf393AllClausesOp := + mWffSpineEval_trans mWffSpineEval_13_21 <| + mWffSpineEval_trans mWffSpineEval_21_29 <| + mWffSpineEval_trans mWffSpineEval_29_37 <| + mWffSpineEval_trans mWffSpineEval_37_45 <| + mWffSpineEval_trans mWffSpineEval_45_55 <| + mWffSpineEval_trans mWffSpineEval_55_65 <| + mWffSpineEval_trans mWffSpineEval_65_73 <| + mWffSpineEval_trans mWffSpineEval_73_81 <| + mWffSpineEval_trans mWffSpineEval_81_89 <| + mWffSpineEval_trans mWffSpineEval_89_97 <| + mWffSpineEval_trans mWffSpineEval_97_106 <| + mWffSpineEval_trans mWffSpineEval_106_114 <| + mWffSpineEval_114_123 + +@[simp] +theorem mRpnCons_mPair (x y stk ac p1 p2 p3 : PAM M) : + mRpnCons ⟨y, mPair x stk, ac, p1, p2, p3⟩ = ⟨mPair x y, stk, ac, p1, p2, p3⟩ := by + simp [mRpnCons] + +@[simp] +theorem mRpnWeq_eval (x y stk ac p1 p2 p3 : PAM M) : + mRpnWeq ⟨y, mPair x stk, ac, p1, p2, p3⟩ = ⟨mZfEq x y, stk, ac, p1, p2, p3⟩ := by + simp [mRpnWeq, mRpnVk, mZfEq] + +@[simp] +theorem mRpnWel_eval (x y stk ac p1 p2 p3 : PAM M) : + mRpnWel ⟨y, mPair x stk, ac, p1, p2, p3⟩ = ⟨mZfMem x y, stk, ac, p1, p2, p3⟩ := by + simp [mRpnWel, mRpnVk, mZfMem] + +@[simp] +theorem mRpnWim_eval (φ ψ stk ac p1 p2 p3 : PAM M) : + mRpnWim ⟨ψ, mPair φ stk, ac, p1, p2, p3⟩ = ⟨mZfImp φ ψ, stk, ac, p1, p2, p3⟩ := by + simp [mRpnWim, mRpnVk, mZfImp] + +@[simp] +theorem mRpnWn_eval (φ stk ac p1 p2 p3 : PAM M) : + mRpnWn ⟨φ, stk, ac, p1, p2, p3⟩ = ⟨mZfNot φ, stk, ac, p1, p2, p3⟩ := by + simp [mRpnWn, mRpnVk, mZfNot] + +@[simp] +theorem mRpnWal_eval (x φ stk ac p1 p2 p3 : PAM M) : + mRpnWal ⟨φ, mPair x stk, ac, p1, p2, p3⟩ = ⟨mZfAll x φ, stk, ac, p1, p2, p3⟩ := by + simp [mRpnWal, mRpnVk, mZfAll] + +@[simp] +theorem mRpnWex_eval (x φ stk ac p1 p2 p3 : PAM M) : + mRpnWex ⟨φ, mPair x stk, ac, p1, p2, p3⟩ = ⟨mZfEx x φ, stk, ac, p1, p2, p3⟩ := by + simp [mRpnWex, mZfEx] + +@[simp] +theorem mRpnWa_eval (φ ψ stk ac p1 p2 p3 : PAM M) : + mRpnWa ⟨ψ, mPair φ stk, ac, p1, p2, p3⟩ = ⟨mZfAnd φ ψ, stk, ac, p1, p2, p3⟩ := by + simp [mRpnWa, mZfAnd] + +@[simp] +theorem mRpnSelect_eval (candidate prev stk ac p1 p2 p3 : PAM M) : + mRpnSelect ⟨candidate, mPair prev stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then prev else candidate, stk, ac - 1, p1, p2, p3⟩ := by + by_cases hac : ac = 0 <;> simp [mRpnSelect, hac] + +@[simp] +theorem mRpnClauseB1_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB1 ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB1 p1 p2 p3, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB1, mRpnPar1, mRpnPar2, mRpnPar3, mAxB1] + +@[simp] +theorem mRpnClauseB2_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB2 ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB2 p1, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB2, mRpnPar1, mAxB2] + +@[simp] +theorem mRpnClauseB3_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB3 ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB3 p1 p2, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB3, mRpnPar1, mRpnPar2, mAxB3] + +@[simp] +theorem mRpnClauseB4_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB4 ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB4 p1 p2 p3, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB4, mRpnPar1, mRpnPar2, mRpnPar3, mAxB4] + +@[simp] +theorem mRpnZf393ClauseB6a_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnZf393ClauseB6a ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else (if p1 = p3 ∨ p2 = p3 then 0 else mAxB6a p1 p2 p3), + stk, ac - 1, p1, p2, p3⟩ := by + by_cases hp1 : p1 = p3 <;> by_cases hp2 : p2 = p3 <;> + simp [mRpnZf393ClauseB6a, mRpnZf393B6aCheck1, mRpnZf393B6aCheck2, + mRpnPar1, mRpnPar2, mRpnPar3, mAxB6a, hp1, hp2] + +@[simp] +theorem mRpnClauseB6b_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB6b ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB6b p1 p2 p3, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB6b, mRpnPar1, mRpnPar2, mRpnPar3, mAxB6b] + +@[simp] +theorem mRpnClauseB6c_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB6c ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB6c p1 p2, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB6c, mRpnPar1, mRpnPar2, mAxB6c] + +@[simp] +theorem mRpnClauseB7_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB7 ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB7 p1 p2, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB7, mRpnPar1, mRpnPar2, mAxB7] + +@[simp] +theorem mRpnClauseB8a_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB8a ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB8a p1 p2 p3, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB8a, mRpnPar1, mRpnPar2, mRpnPar3, mAxB8a] + +@[simp] +theorem mRpnClauseB8b_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB8b ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB8b p1 p2 p3, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB8b, mRpnPar1, mRpnPar2, mRpnPar3, mAxB8b] + +@[simp] +theorem mRpnClauseB8c_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseB8c ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxB8c p1 p2 p3, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseB8c, mRpnPar1, mRpnPar2, mRpnPar3, mAxB8c] + +@[simp] +theorem mRpnClauseEXT_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseEXT ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxExt, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseEXT, mRpnVk, mAxExt] + +@[simp] +theorem mRpnClauseREP_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseREP ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxRep p1, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseREP, mRpnVk, mRpnPar1, mAxRep, mAxRepRhs] + +@[simp] +theorem mRpnClausePOW_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClausePOW ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxPow, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClausePOW, mRpnVk, mAxPow] + +@[simp] +theorem mRpnClauseUNI_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseUNI ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxUni, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseUNI, mRpnVk, mAxUni] + +@[simp] +theorem mRpnClauseINF_eval (top stk ac p1 p2 p3 : PAM M) : + mRpnClauseINF ⟨top, stk, ac, p1, p2, p3⟩ = + ⟨if ac = 0 then top else mAxInf, stk, ac - 1, p1, p2, p3⟩ := by + simp [mRpnClauseINF, mRpnVk, mAxInf, mAxInfSingleton] + +/-- Closed-form 20-clause dispatch of `zf393` inside `PAM M`. -/ +noncomputable def mZf393ClauseDispatch (topwff wffstack ac p1 p2 p3 : PAM M) : PAM M × PAM M := + let stk0 := mPair topwff wffstack + if ac = ((0 : ℕ) : PAM M) then (0, stk0) + else if ac = ((1 : ℕ) : PAM M) then (mAxRep p1, stk0) + else if ac = ((2 : ℕ) : PAM M) then (mAxPow, stk0) + else if ac = ((3 : ℕ) : PAM M) then (mAxB2 p1, stk0) + else if ac = ((4 : ℕ) : PAM M) then (mAxUni, stk0) + else if ac = ((5 : ℕ) : PAM M) then (mAxB3 p1 p2, stk0) + else if ac = ((6 : ℕ) : PAM M) then (mAxB8b p1 p2 p3, stk0) + else if ac = ((7 : ℕ) : PAM M) then + if p1 = p3 ∨ p2 = p3 then (0, stk0) else (mAxB6a p1 p2 p3, stk0) + else if ac = ((8 : ℕ) : PAM M) then (mAxB6b p1 p2 p3, stk0) + else if ac = ((9 : ℕ) : PAM M) then (mAxB7 p1 p2, stk0) + else if ac = ((10 : ℕ) : PAM M) then (mAxB4 p1 p2 p3, stk0) + else if ac = ((11 : ℕ) : PAM M) then (mAxB8a p1 p2 p3, stk0) + else if ac = ((12 : ℕ) : PAM M) then (mAxB8b p1 p2 p3, stk0) + else if ac = ((13 : ℕ) : PAM M) then (mAxB8c p1 p2 p3, stk0) + else if ac = ((14 : ℕ) : PAM M) then (mAxB1 p1 p2 p3, stk0) + else if ac = ((15 : ℕ) : PAM M) then (mAxExt, stk0) + else if ac = ((16 : ℕ) : PAM M) then + let pop1 := mUnpair stk0 + let φ := pop1.1 + let pop2 := mUnpair pop1.2 + let maj := pop2.1 + let stk2 := pop2.2 + if mZfImp φ p1 = maj then (p1, stk2) else (0, stk2) + else if ac = ((17 : ℕ) : PAM M) then + let pop1 := mUnpair stk0 + (mZfAll p1 pop1.1, pop1.2) + else if ac = ((18 : ℕ) : PAM M) then (mAxB6b p1 p2 p3, stk0) + else if ac = ((19 : ℕ) : PAM M) then (mAxB6c p1 p2, stk0) + else (mAxInf, stk0) + +private def pamSuccChain : ℕ → PAM M → PAM M + | 0, d => d + | n + 1, d => pamSuccChain n d + 1 + +private theorem add_natCast_eq_pamSuccChain (d : PAM M) : + ∀ k : ℕ, d + (k : PAM M) = pamSuccChain k d + | 0 => by simp [pamSuccChain] + | k + 1 => by + rw [Nat.cast_succ, ← add_assoc, add_natCast_eq_pamSuccChain d k] + rfl + +private theorem natCast_eq_pamSuccChain (k : ℕ) : (k : PAM M) = pamSuccChain k 0 := by + simpa using add_natCast_eq_pamSuccChain (0 : PAM M) k + +set_option linter.flexible false in +theorem mRpnZf393AllClauses_eq_mZf393ClauseDispatch (topwff wffstack ac p1 p2 p3 : PAM M) : + let out := mRpnZf393AllClauses topwff wffstack ac p1 p2 p3 + (out.topwff, out.wffstack) = mZf393ClauseDispatch topwff wffstack ac p1 p2 p3 := by + dsimp only + rcases lt_or_ge ac ((20 : ℕ) : PAM M) with hlt20 | hge20 + · obtain ⟨k, hk20, rfl⟩ := lt_natCast_iff.mp hlt20 + have hk_cases : + k = 0 ∨ k = 1 ∨ k = 2 ∨ k = 3 ∨ k = 4 ∨ k = 5 ∨ k = 6 ∨ k = 7 ∨ k = 8 ∨ k = 9 ∨ + k = 10 ∨ k = 11 ∨ k = 12 ∨ k = 13 ∨ k = 14 ∨ k = 15 ∨ k = 16 ∨ k = 17 ∨ k = 18 ∨ k = 19 := + by omega + rcases hk_cases with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | + rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + all_goals + simp only [mZf393ClauseDispatch, natCast_inj_pam, OfNat.ofNat_ne_zero, + one_ne_zero, Nat.reduceEqDiff, ↓reduceIte] + rw [natCast_eq_pamSuccChain] + dsimp only [pamSuccChain] + unfold mRpnZf393AllClauses mRpnZf393AllClausesOp + simp [mRpnVk, mRpnClauseDET, mRpnDetCheck, mRpnClauseGEN, mRpnCparam2, mRpnCparam3, + mRpnPar1, mRpnPar3] + all_goals + try (split_ifs <;> rfl) + · have hne : ∀ (n : ℕ), n < 20 → ac ≠ (n : PAM M) := + fun n hn heq ↦ not_lt_of_ge hge20 (heq ▸ natCast_lt_iff.mpr hn) + unfold mZf393ClauseDispatch + simp only [hne 0 (by decide), hne 1 (by decide), hne 2 (by decide), hne 3 (by decide), + hne 4 (by decide), hne 5 (by decide), hne 6 (by decide), hne 7 (by decide), + hne 8 (by decide), hne 9 (by decide), hne 10 (by decide), hne 11 (by decide), + hne 12 (by decide), hne 13 (by decide), hne 14 (by decide), hne 15 (by decide), + hne 16 (by decide), hne 17 (by decide), hne 18 (by decide), hne 19 (by decide), + ↓reduceIte] + rcases hge20 with ⟨d, hd⟩ + have hac_eq : ac = pamSuccChain 20 d := by + rw [← hd, add_comm, add_natCast_eq_pamSuccChain] + rw [hac_eq] + dsimp only [pamSuccChain] + unfold mRpnZf393AllClauses mRpnZf393AllClausesOp + simp [mRpnVk, mRpnClauseDET, mRpnDetCheck, mRpnClauseGEN, mRpnCparam2, mRpnCparam3, + mRpnPar1, mRpnPar3] + +/-! ## Section 6: Header Unpairing (`k = 0..13`), Halt Check (`k = 123, 124`), and One-Iteration +Simulation -/ + +/-- The 4 persistent registers of `main()` in `zf393` inside `PAM M`. -/ +structure MZfMainCfg (M : Type*) [PAStructure M] where + prooflist : PAM M + nextproof : PAM M + topwff : PAM M + wffstack : PAM M + +def mZfMainInit : MZfMainCfg M := ⟨0, 0, 0, 0⟩ + +def mRegsToMainCfg (regs : List (PAM M)) : MZfMainCfg M := + ⟨regs.getD 0 0, regs.getD 1 0, regs.getD 2 0, regs.getD 3 0⟩ + +/-- One body-iteration transition of `main()` in `zf393` inside `PAM M`. -/ +noncomputable def mZf393MainNext (c : MZfMainCfg M) : MZfMainCfg M := + let prooflist₁ := if c.prooflist = 0 then c.nextproof else c.prooflist - 1 + let nextproof' := if c.prooflist = 0 then c.nextproof + 1 else c.nextproof + let u1 := mUnpair prooflist₁ + let ac := u1.1 + let u2 := mUnpair u1.2 + let p1 := u2.1 + let u3 := mUnpair u2.2 + let p2 := u3.1 + let u4 := mUnpair u3.2 + let p3 := u4.1 + let prooflist' := u4.2 + let res := mZf393ClauseDispatch c.topwff c.wffstack ac p1 p2 p3 + ⟨prooflist', nextproof', res.1, res.2⟩ + +/-- Partial step of `main()` in `zf393`: halts (`none`) iff the newly produced `topwff` is `1`. -/ +noncomputable def mZf393MainStep (c : MZfMainCfg M) : Option (MZfMainCfg M) := + if (mZf393MainNext c).topwff = 1 then none else some (mZf393MainNext c) + +/-- Invariant at `ip = []`: 11 registers with scratch registers `8, 9, 10` cleared to `0`. -/ +def MRegsInv (regs : List (PAM M)) : Prop := + regs.length = 11 ∧ regs.getD 8 0 = 0 ∧ regs.getD 9 0 = 0 ∧ regs.getD 10 0 = 0 + +omit [PAModel M] in +theorem mRegsInv_init : MRegsInv (List.replicate 11 (0 : PAM M)) := + ⟨by simp, rfl, rfl, rfl⟩ + +omit [PAModel M] in +theorem paDef_mRegsInv {n : ℕ} {R : (Fin n → PAM M) → List (PAM M)} (hR : PAFunRegs n R) : + PADefN n (fun u ↦ MRegsInv (R u)) := by + refine paDefN_congr (fun u ↦ ?_) + (paDef_and (paDef_eq (paFunRegs_getD hR 8) (paFun_const 0)) + (paDef_and (paDef_eq (paFunRegs_getD hR 9) (paFun_const 0)) + (paDef_eq (paFunRegs_getD hR 10) (paFun_const 0)))) + simp [MRegsInv, hR.1 u] + +omit [PAModel M] in +theorem mRegs_eq_of_mRegsInv {regs : List (PAM M)} (hInv : MRegsInv regs) : + regs = [regs.getD 0 0, regs.getD 1 0, regs.getD 2 0, regs.getD 3 0, + regs.getD 4 0, regs.getD 5 0, regs.getD 6 0, regs.getD 7 0, 0, 0, 0] := by + rcases hInv with ⟨hlen, h8, h9, h10⟩ + rcases regs with _ | ⟨r0, _ | ⟨r1, _ | ⟨r2, _ | ⟨r3, _ | ⟨r4, _ | ⟨r5, _ | + ⟨r6, _ | ⟨r7, _ | ⟨r8, _ | ⟨r9, _ | ⟨r10, _ | _⟩⟩⟩⟩⟩⟩⟩⟩⟩⟩⟩ <;> + try (simp at hlen; done) + dsimp [List.getD] at h8 h9 h10 + subst h8 h9 h10 + rfl + +noncomputable def mRegHeader05Op (regs : List (PAM M)) : List (PAM M) := + ((((mReg95Op regs).set 4 0).set 5 0).set 6 0).set 7 0 + +theorem mRegSpineEval_0_5 : MRegSpineEval (M := M) 0 5 mRegHeader05Op := + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_0 rfl (by decide) mSubEval_95) <| + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_1 rfl (by decide) mSubEval_342) <| + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_2 rfl (by decide) mSubEval_346) <| + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_3 rfl (by decide) mSubEval_352) <| + mRegSpineEval_step walkInternal_spine_4 rfl (by decide) mSubEval_356 + +theorem mRegHeader05Op_eval (pl np top stk ac0 p1_0 p2_0 p3_0 : PAM M) : + mRegHeader05Op [pl, np, top, stk, ac0, p1_0, p2_0, p3_0, 0, 0, 0] = + [if pl = 0 then np else pl - 1, if pl = 0 then np + 1 else np, + top, stk, 0, 0, 0, 0, 0, 0, 0] := by + by_cases hpl : pl = 0 <;> + simp [mRegHeader05Op, mReg95Op, mReg97Op, hpl, List.getD] + +theorem mReg269Op_eval (pl np top stk ac p1 p2 p3 : PAM M) : + mReg269Op [pl, np, top, stk, ac, p1, p2, p3, 0, 0, 0] = + [(mUnpair pl).2, np, top, stk, ac, p1, p2, p3, (mUnpair pl).1, 0, 0] := by + simp [mReg269Op, mRegUnpairGen, List.getD] + +noncomputable def mRegUnpairMoveOp (r : ℕ) (regs : List (PAM M)) : List (PAM M) := + let u := mReg269Op regs + (u.set 8 0).set r (u.getD r 0 + u.getD 8 0) + +theorem mRegSpineEval_5_7 : MRegSpineEval (M := M) 5 7 (mRegUnpairMoveOp 4) := + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_5 rfl (by decide) mSubEval_269) <| + mRegSpineEval_step walkInternal_spine_6 rfl (by decide) mSubEval_360 + +theorem mRegSpineEval_7_9 : MRegSpineEval (M := M) 7 9 (mRegUnpairMoveOp 5) := + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_7 rfl (by decide) mSubEval_269) <| + mRegSpineEval_step walkInternal_spine_8 rfl (by decide) mSubEval_364 + +theorem mRegSpineEval_9_11 : MRegSpineEval (M := M) 9 11 (mRegUnpairMoveOp 6) := + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_9 rfl (by decide) mSubEval_269) <| + mRegSpineEval_step walkInternal_spine_10 rfl (by decide) mSubEval_366 + +theorem mRegSpineEval_11_13 : MRegSpineEval (M := M) 11 13 (mRegUnpairMoveOp 7) := + mRegSpineEval_trans (mRegSpineEval_step walkInternal_spine_11 rfl (by decide) mSubEval_269) <| + mRegSpineEval_step walkInternal_spine_12 rfl (by decide) mSubEval_368 + +theorem mRegSpineEval_0_13 : + MRegSpineEval (M := M) 0 13 (fun regs ↦ + mRegUnpairMoveOp 7 (mRegUnpairMoveOp 6 (mRegUnpairMoveOp 5 + (mRegUnpairMoveOp 4 (mRegHeader05Op regs))))) := + mRegSpineEval_trans mRegSpineEval_0_5 <| + mRegSpineEval_trans mRegSpineEval_5_7 <| + mRegSpineEval_trans mRegSpineEval_7_9 <| + mRegSpineEval_trans mRegSpineEval_9_11 <| + mRegSpineEval_11_13 + +theorem mUnpair_header_eval {slot : PAM M} {regs : List (PAM M)} + (hLog : MZfLogInv slot [] regs) (hInv : MRegsInv regs) : + let prooflist₁ := if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1 + let nextproof' := if regs.getD 0 0 = 0 then regs.getD 1 0 + 1 else regs.getD 1 0 + let u1 := mUnpair prooflist₁ + let ac := u1.1 + let u2 := mUnpair u1.2 + let p1 := u2.1 + let u3 := mUnpair u2.2 + let p2 := u3.1 + let u4 := mUnpair u3.2 + let p3 := u4.1 + let prooflist' := u4.2 + let regs₁₃ := mWffStateToRegs prooflist' nextproof' + ⟨regs.getD 2 0, regs.getD 3 0, ac, p1, p2, p3⟩ + ∃ slot' : PAM M, + MZfLogInv slot' (List.replicate 13 1) regs₁₃ ∧ + mReachPos (mZfLogCfg slot [] regs) (mZfLogCfg slot' (List.replicate 13 1) regs₁₃) := by + dsimp only + obtain ⟨_, slot', hinv', hreach⟩ := mRegSpineEval_0_13 slot regs hLog + dsimp only [List.replicate] at hinv' hreach + have h05 : mRegHeader05Op regs = + [if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1, + if regs.getD 0 0 = 0 then regs.getD 1 0 + 1 else regs.getD 1 0, + regs.getD 2 0, regs.getD 3 0, 0, 0, 0, 0, 0, 0, 0] := by + conv_lhs => rw [mRegs_eq_of_mRegsInv hInv] + exact mRegHeader05Op_eval _ _ _ _ _ _ _ _ + have h13 : mRegUnpairMoveOp 7 (mRegUnpairMoveOp 6 (mRegUnpairMoveOp 5 + (mRegUnpairMoveOp 4 (mRegHeader05Op regs)))) = + mWffStateToRegs + (mUnpair (mUnpair (mUnpair (mUnpair + (if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1)).2).2).2).2 + (if regs.getD 0 0 = 0 then regs.getD 1 0 + 1 else regs.getD 1 0) + ⟨regs.getD 2 0, regs.getD 3 0, + (mUnpair (if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1)).1, + (mUnpair (mUnpair (if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1)).2).1, + (mUnpair (mUnpair (mUnpair + (if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1)).2).2).1, + (mUnpair (mUnpair (mUnpair (mUnpair + (if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1)).2).2).2).1⟩ := by + rw [h05] + simp [mRegUnpairMoveOp, mReg269Op_eval, mWffStateToRegs, List.getD] + rw [h13] at hinv' hreach + exact ⟨slot', hinv', hreach⟩ + +theorem mSpine_0_123_eval {slot : PAM M} {regs : List (PAM M)} + (hLog : MZfLogInv slot [] regs) (hInv : MRegsInv regs) : + let prooflist₁ := if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1 + let nextproof' := if regs.getD 0 0 = 0 then regs.getD 1 0 + 1 else regs.getD 1 0 + let u1 := mUnpair prooflist₁ + let ac := u1.1 + let u2 := mUnpair u1.2 + let p1 := u2.1 + let u3 := mUnpair u2.2 + let p2 := u3.1 + let u4 := mUnpair u3.2 + let p3 := u4.1 + let prooflist' := u4.2 + let out := mRpnZf393AllClauses (regs.getD 2 0) (regs.getD 3 0) ac p1 p2 p3 + let regs' := mWffStateToRegs prooflist' nextproof' out + ∃ slot' : PAM M, + MZfLogInv slot' (List.replicate 123 1) regs' ∧ + mReachPos (mZfLogCfg slot [] regs) (mZfLogCfg slot' (List.replicate 123 1) regs') := by + dsimp only + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mUnpair_header_eval hLog hInv + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mWffSpineEval_13_123 slot₁ _ _ _ hinv₁ + exact ⟨slot₂, hinv₂, mReachPos_trans hreach₁ hreach₂⟩ + +theorem mHalt_check_eval {slot : PAM M} {regs : List (PAM M)} + (hinv : MZfLogInv slot (List.replicate 123 1) regs) : + (regs.getD 2 0 = 1 → + mHaltsFrom zf393 (mZfLogCfg slot (List.replicate 123 1) regs)) ∧ + (regs.getD 2 0 ≠ 1 → + ∃ slot' : PAM M, + MZfLogInv slot' [] regs ∧ + mReachPos (mZfLogCfg slot (List.replicate 123 1) regs) (mZfLogCfg slot' [] regs)) := by + constructor + · intro h1 + have h01 : regs.getD 2 0 = (0 : PAM M) + 1 := by rw [h1, zero_add] + obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv evalStack_spine_123 h01 + have hz : (regs.set 2 0).getD 2 0 = 0 := mGetD_set_self regs 2 0 (by rw [hinv.1]; decide) + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_zero hinv₁ evalStack_spine_124 hz + have hhalt := mLogStep_of_halt hinv₂ evalStack_spine_125 + obtain ⟨s, _, htr⟩ := mReachPos_trans hreach₁ hreach₂ + exact (mHaltsFrom_iff_of_mTracesTo htr).mpr hhalt + · intro hne1 + rcases eq_zero_or_exists_succ (regs.getD 2 0) with hv0 | ⟨u, hu⟩ + · exact mLogStep_of_decnz_zero hinv evalStack_spine_123 hv0 + · rcases eq_zero_or_exists_succ u with rfl | ⟨v, rfl⟩ + · rw [zero_add] at hu + exact absurd hu hne1 + · obtain ⟨slot₁, hinv₁, hreach₁⟩ := mLogStep_of_decnz_succ hinv evalStack_spine_123 hu + have hv1 : (regs.set 2 (v + 1)).getD 2 0 = v + 1 := + mGetD_set_self regs 2 (v + 1) (by rw [hinv.1]; decide) + obtain ⟨slot₂, hinv₂, hreach₂⟩ := mLogStep_of_decnz_succ hinv₁ evalStack_spine_124 hv1 + rw [List.set_set] at hinv₂ hreach₂ + have h224 : walkInternal 99 (List.replicate 124 1 ++ [0]) = some 224 := + walkInternal_snoc walkInternal_spine_124 rfl (by decide) + have h225 : walkInternal 99 (List.replicate 124 1 ++ [0] ++ [1]) = some 225 := + walkInternal_snoc h224 rfl (by decide) + have h288 : walkInternal 99 (List.replicate 124 1 ++ [0] ++ [1] ++ [0]) = some 288 := + walkInternal_snoc h225 rfl (by decide) + have hinv288 : MZfLogInv slot₂ + (trimZeros (List.replicate 124 1 ++ [0] ++ [1] ++ [0])) (regs.set 2 v) := by + rwa [trimZeros_append_zero, trimZeros_append_one] + obtain ⟨_, slot₃, hinv₃, hreach₃⟩ := mSubEval_288 + (List.replicate 124 1 ++ [0] ++ [1] ++ [0]) h288 slot₂ (regs.set 2 v) hinv288 + rw [trimZeros_append_zero, trimZeros_append_one, retStack_append_zero] at hreach₃ + rw [retStack_append_zero] at hinv₃ + dsimp only at hinv₃ hreach₃ + have hv2 : v + 2 = v + 1 + 1 := by ring + rw [mGetD_set_self regs 2 v (by rw [hinv.1]; decide), List.set_set, hv2, + mSet_eq_self_of_getD_eq hu] at hinv₃ hreach₃ + obtain ⟨slot₄, hinv₄, hreach₄⟩ := mLogStep_of_jump hinv₃ evalStack_225_break + exact ⟨slot₄, hinv₄, mReachPos_trans hreach₁ + (mReachPos_trans hreach₂ (mReachPos_trans hreach₃ hreach₄))⟩ + +theorem mSpine_body_eval {slot : PAM M} {regs : List (PAM M)} + (hLog : MZfLogInv slot [] regs) (hInv : MRegsInv regs) : + ∃ (slot' : PAM M) (regs' : List (PAM M)), + MZfLogInv slot' (List.replicate 123 1) regs' ∧ + MRegsInv regs' ∧ + mRegsToMainCfg regs' = mZf393MainNext (mRegsToMainCfg regs) ∧ + mReachPos (mZfLogCfg slot [] regs) (mZfLogCfg slot' (List.replicate 123 1) regs') := by + obtain ⟨slot', hinv', hreach⟩ := mSpine_0_123_eval hLog hInv + refine ⟨slot', _, hinv', ⟨rfl, rfl, rfl, rfl⟩, ?_, hreach⟩ + let pl1 := if regs.getD 0 0 = 0 then regs.getD 1 0 else regs.getD 0 0 - 1 + let ac := (mUnpair pl1).1 + let u2 := mUnpair (mUnpair pl1).2 + let p1 := u2.1 + let u3 := mUnpair u2.2 + let p2 := u3.1 + let p3 := (mUnpair u3.2).1 + have h := mRpnZf393AllClauses_eq_mZf393ClauseDispatch + (regs.getD 2 0) (regs.getD 3 0) ac p1 p2 p3 + dsimp only at h + rw [Prod.mk.injEq] at h + have hcfg : ∀ (pl np : PAM M) (st : MWffState M), + mRegsToMainCfg (mWffStateToRegs pl np st) = ⟨pl, np, st.topwff, st.wffstack⟩ := + fun _ _ _ ↦ rfl + rw [hcfg, h.1, h.2] + rfl + +theorem mMain_iter_sim {slot : PAM M} {regs : List (PAM M)} + (hLog : MZfLogInv slot [] regs) (hInv : MRegsInv regs) : + match mZf393MainStep (mRegsToMainCfg regs) with + | none => + mHaltsFrom zf393 (mZfLogCfg slot [] regs) + | some c' => + ∃ (slot' : PAM M) (regs' : List (PAM M)), + MZfLogInv slot' [] regs' ∧ + MRegsInv regs' ∧ + mRegsToMainCfg regs' = c' ∧ + mReachPos (mZfLogCfg slot [] regs) (mZfLogCfg slot' [] regs') := by + obtain ⟨slot₁, regs', hLog₁, hInv', hnext, hreach₁⟩ := mSpine_body_eval hLog hInv + have htop_eq : (mZf393MainNext (mRegsToMainCfg regs)).topwff = regs'.getD 2 0 := by + rw [← hnext]; rfl + have hhalt := mHalt_check_eval hLog₁ + unfold mZf393MainStep + by_cases h1 : (mZf393MainNext (mRegsToMainCfg regs)).topwff = 1 + · simp only [h1, ↓reduceIte] + rw [htop_eq] at h1 + obtain ⟨s₁, _, htr₁⟩ := hreach₁ + exact (mHaltsFrom_iff_of_mTracesTo htr₁).mpr (hhalt.1 h1) + · simp only [h1, ↓reduceIte] + rw [htop_eq] at h1 + obtain ⟨slot₂, hLog₂, hreach₂⟩ := hhalt.2 h1 + exact ⟨slot₂, regs', hLog₂, hInv', hnext, mReachPos_trans hreach₁ hreach₂⟩ + +/-! ## Section 7: $\beta$-Coded `main()` Traces and Bidirectional Halting Equivalence in `PAM M` -/ + +noncomputable def mPackMainCfg (c : MZfMainCfg M) : PAM M := + mPair c.prooflist (mPair c.nextproof (mPair c.topwff c.wffstack)) + +noncomputable def mUnpackMainCfg (z : PAM M) : MZfMainCfg M := + let u1 := mUnpair z + let u2 := mUnpair u1.2 + let u3 := mUnpair u2.2 + ⟨u1.1, u2.1, u3.1, u3.2⟩ + +@[simp] +theorem mUnpackMainCfg_mPackMainCfg (c : MZfMainCfg M) : + mUnpackMainCfg (mPackMainCfg c) = c := by + cases c + simp [mPackMainCfg, mUnpackMainCfg] + +@[simp] +theorem mPackMainCfg_mUnpackMainCfg (z : PAM M) : + mPackMainCfg (mUnpackMainCfg z) = z := by + simp [mPackMainCfg, mUnpackMainCfg] + +theorem mPackMainCfg_injective {c₁ c₂ : MZfMainCfg M} + (h : mPackMainCfg c₁ = mPackMainCfg c₂) : c₁ = c₂ := by + have h' := congrArg mUnpackMainCfg h + simpa using h' + +theorem mZf393MainStep_eq_some_iff {c c' : MZfMainCfg M} : + mZf393MainStep c = some c' ↔ + (mZf393MainNext c).topwff ≠ 1 ∧ c' = mZf393MainNext c := by + unfold mZf393MainStep + split_ifs with h1 <;> simp [h1, eq_comm] + +theorem paFun_mZfEq {k : ℕ} {fx fy : (Fin k → PAM M) → PAM M} + (hx : PAFunN k fx) (hy : PAFunN k fy) : + PAFunN k (fun u ↦ mZfEq (fx u) (fy u)) := + paFun_mPair (paFun_mPair hx hy) (paFun_const 0) + +theorem paFun_mZfMem {k : ℕ} {fx fy : (Fin k → PAM M) → PAM M} + (hx : PAFunN k fx) (hy : PAFunN k fy) : + PAFunN k (fun u ↦ mZfMem (fx u) (fy u)) := + paFun_mPair (paFun_mPair hx hy) (paFun_const 1) + +theorem paFun_mZfImp {k : ℕ} {fφ fψ : (Fin k → PAM M) → PAM M} + (hφ : PAFunN k fφ) (hψ : PAFunN k fψ) : + PAFunN k (fun u ↦ mZfImp (fφ u) (fψ u)) := + paFun_mPair (paFun_mPair hφ hψ) (paFun_const 2) + +theorem paFun_mZfNot {k : ℕ} {fφ : (Fin k → PAM M) → PAM M} (hφ : PAFunN k fφ) : + PAFunN k (fun u ↦ mZfNot (fφ u)) := + paFun_mPair hφ (paFun_const 3) + +theorem paFun_mZfAll {k : ℕ} {fx fφ : (Fin k → PAM M) → PAM M} + (hx : PAFunN k fx) (hφ : PAFunN k fφ) : + PAFunN k (fun u ↦ mZfAll (fx u) (fφ u)) := + paFun_mPair (paFun_mPair hx hφ) (paFun_const 4) + +theorem paFun_mZfEx {k : ℕ} {fx fφ : (Fin k → PAM M) → PAM M} + (hx : PAFunN k fx) (hφ : PAFunN k fφ) : + PAFunN k (fun u ↦ mZfEx (fx u) (fφ u)) := + paFun_mZfNot (paFun_mZfAll hx (paFun_mZfNot hφ)) + +theorem paFun_mZfAnd {k : ℕ} {fφ fψ : (Fin k → PAM M) → PAM M} + (hφ : PAFunN k fφ) (hψ : PAFunN k fψ) : + PAFunN k (fun u ↦ mZfAnd (fφ u) (fψ u)) := + paFun_mZfNot (paFun_mZfImp hφ (paFun_mZfNot hψ)) + +theorem paFun_mZf393ClauseDispatch {k : ℕ} + {ftop fstk fac fp1 fp2 fp3 : (Fin k → PAM M) → PAM M} + (htop : PAFunN k ftop) (hstk : PAFunN k fstk) (hac : PAFunN k fac) + (hp1 : PAFunN k fp1) (hp2 : PAFunN k fp2) (hp3 : PAFunN k fp3) : + PAFunN k (fun u ↦ + (mZf393ClauseDispatch (ftop u) (fstk u) (fac u) (fp1 u) (fp2 u) (fp3 u)).1) ∧ + PAFunN k (fun u ↦ + (mZf393ClauseDispatch (ftop u) (fstk u) (fac u) (fp1 u) (fp2 u) (fp3 u)).2) := by + have hstk0 : PAFunN k (fun u ↦ mPair (ftop u) (fstk u)) := paFun_mPair htop hstk + have hpop1_1 := paFun_mUnpair_fst hstk0 + have hpop1_2 := paFun_mUnpair_snd hstk0 + have hpop2_1 := paFun_mUnpair_fst hpop1_2 + have hpop2_2 := paFun_mUnpair_snd hpop1_2 + have hrep : PAFunN k (fun u ↦ mAxRep (fp1 u)) := by + have hrhs : PAFunN k (fun u ↦ mAxRepRhs (fp1 u)) := + paFun_mZfEx (paFun_const 3) + (paFun_mZfAnd (paFun_mZfMem (paFun_const 3) (paFun_const 0)) + (paFun_mZfAll (paFun_const 1) hp1)) + exact paFun_mZfImp + (paFun_mZfAll (paFun_const 3) + (paFun_mZfEx (paFun_const 1) + (paFun_mZfAll (paFun_const 2) + (paFun_mZfImp (paFun_mZfAll (paFun_const 1) hp1) + (paFun_mZfEq (paFun_const 2) (paFun_const 1)))))) + (paFun_mZfEx (paFun_const 1) + (paFun_mZfAll (paFun_const 2) + (paFun_mZfAnd + (paFun_mZfImp (paFun_mZfMem (paFun_const 2) (paFun_const 1)) hrhs) + (paFun_mZfImp hrhs (paFun_mZfMem (paFun_const 2) (paFun_const 1)))))) + have hb1 : PAFunN k (fun u ↦ mAxB1 (fp1 u) (fp2 u) (fp3 u)) := + paFun_mZfImp (paFun_mZfImp hp1 hp2) (paFun_mZfImp (paFun_mZfImp hp2 hp3) (paFun_mZfImp hp1 hp3)) + have hb2 : PAFunN k (fun u ↦ mAxB2 (fp1 u)) := + paFun_mZfImp (paFun_mZfImp (paFun_mZfNot hp1) hp1) hp1 + have hb3 : PAFunN k (fun u ↦ mAxB3 (fp1 u) (fp2 u)) := + paFun_mZfImp hp1 (paFun_mZfImp (paFun_mZfNot hp1) hp2) + have hb4 : PAFunN k (fun u ↦ mAxB4 (fp1 u) (fp2 u) (fp3 u)) := + paFun_mZfImp (paFun_mZfAll hp1 (paFun_mZfImp hp2 hp3)) + (paFun_mZfImp (paFun_mZfAll hp1 hp2) (paFun_mZfAll hp1 hp3)) + have hb6a : PAFunN k (fun u ↦ mAxB6a (fp1 u) (fp2 u) (fp3 u)) := + paFun_mZfAnd + (paFun_mZfImp (paFun_mZfEq hp1 hp2) (paFun_mZfAll hp3 (paFun_mZfEq hp1 hp2))) + (paFun_mZfImp (paFun_mZfMem hp1 hp2) (paFun_mZfAll hp3 (paFun_mZfMem hp1 hp2))) + have hb6b : PAFunN k (fun u ↦ mAxB6b (fp1 u) (fp2 u) (fp3 u)) := + paFun_mZfImp (paFun_mZfAll hp1 (paFun_mZfAll hp2 hp3)) + (paFun_mZfAll hp2 (paFun_mZfAll hp1 hp3)) + have hb6c : PAFunN k (fun u ↦ mAxB6c (fp1 u) (fp2 u)) := + paFun_mZfImp (paFun_mZfEx hp1 (paFun_mZfAll hp1 hp2)) hp2 + have hb7 : PAFunN k (fun u ↦ mAxB7 (fp1 u) (fp2 u)) := paFun_mZfEx hp1 (paFun_mZfEq hp1 hp2) + have hb8a : PAFunN k (fun u ↦ mAxB8a (fp1 u) (fp2 u) (fp3 u)) := + paFun_mZfImp (paFun_mZfEq hp1 hp2) (paFun_mZfImp (paFun_mZfEq hp1 hp3) (paFun_mZfEq hp2 hp3)) + have hb8b : PAFunN k (fun u ↦ mAxB8b (fp1 u) (fp2 u) (fp3 u)) := + paFun_mZfImp (paFun_mZfEq hp1 hp2) + (paFun_mZfImp (paFun_mZfMem hp1 hp3) (paFun_mZfMem hp2 hp3)) + have hb8c : PAFunN k (fun u ↦ mAxB8c (fp1 u) (fp2 u) (fp3 u)) := + paFun_mZfImp (paFun_mZfEq hp1 hp2) + (paFun_mZfImp (paFun_mZfMem hp3 hp1) (paFun_mZfMem hp3 hp2)) + have h7_1 := paFun_ite (paDef_or (paDef_eq hp1 hp3) (paDef_eq hp2 hp3)) (paFun_const 0) hb6a + have h16_1 := paFun_ite (paDef_eq (paFun_mZfImp hpop1_1 hp1) hpop2_1) hp1 (paFun_const 0) + have h17_1 := paFun_mZfAll hp1 hpop1_1 + have eqc : ∀ n : ℕ, PADefN k (fun u ↦ fac u = ((n : ℕ) : PAM M)) := + fun n ↦ paDef_eq hac (paFun_const ((n : ℕ) : PAM M)) + constructor + · refine paFunN_congr (fun u ↦ ?_) + (paFun_ite (eqc 0) (paFun_const 0) <| + paFun_ite (eqc 1) hrep <| + paFun_ite (eqc 2) (paFun_const mAxPow) <| + paFun_ite (eqc 3) hb2 <| + paFun_ite (eqc 4) (paFun_const mAxUni) <| + paFun_ite (eqc 5) hb3 <| + paFun_ite (eqc 6) hb8b <| + paFun_ite (eqc 7) h7_1 <| + paFun_ite (eqc 8) hb6b <| + paFun_ite (eqc 9) hb7 <| + paFun_ite (eqc 10) hb4 <| + paFun_ite (eqc 11) hb8a <| + paFun_ite (eqc 12) hb8b <| + paFun_ite (eqc 13) hb8c <| + paFun_ite (eqc 14) hb1 <| + paFun_ite (eqc 15) (paFun_const mAxExt) <| + paFun_ite (eqc 16) h16_1 <| + paFun_ite (eqc 17) h17_1 <| + paFun_ite (eqc 18) hb6b <| + paFun_ite (eqc 19) hb6c <| + paFun_const mAxInf) + unfold mZf393ClauseDispatch + dsimp only [eqc] + by_cases c0 : fac u = ((0 : ℕ) : PAM M); · simp only [c0, ↓reduceIte] + simp only [c0, ↓reduceIte] + by_cases c1 : fac u = ((1 : ℕ) : PAM M); · simp only [c1, ↓reduceIte] + simp only [c1, ↓reduceIte] + by_cases c2 : fac u = ((2 : ℕ) : PAM M); · simp only [c2, ↓reduceIte] + simp only [c2, ↓reduceIte] + by_cases c3 : fac u = ((3 : ℕ) : PAM M); · simp only [c3, ↓reduceIte] + simp only [c3, ↓reduceIte] + by_cases c4 : fac u = ((4 : ℕ) : PAM M); · simp only [c4, ↓reduceIte] + simp only [c4, ↓reduceIte] + by_cases c5 : fac u = ((5 : ℕ) : PAM M); · simp only [c5, ↓reduceIte] + simp only [c5, ↓reduceIte] + by_cases c6 : fac u = ((6 : ℕ) : PAM M); · simp only [c6, ↓reduceIte] + simp only [c6, ↓reduceIte] + by_cases c7 : fac u = ((7 : ℕ) : PAM M) + · simp only [c7, ↓reduceIte] + by_cases c7i : fp1 u = fp3 u ∨ fp2 u = fp3 u <;> simp only [c7i, ↓reduceIte] + simp only [c7, ↓reduceIte] + by_cases c8 : fac u = ((8 : ℕ) : PAM M); · simp only [c8, ↓reduceIte] + simp only [c8, ↓reduceIte] + by_cases c9 : fac u = ((9 : ℕ) : PAM M); · simp only [c9, ↓reduceIte] + simp only [c9, ↓reduceIte] + by_cases c10 : fac u = ((10 : ℕ) : PAM M); · simp only [c10, ↓reduceIte] + simp only [c10, ↓reduceIte] + by_cases c11 : fac u = ((11 : ℕ) : PAM M); · simp only [c11, ↓reduceIte] + simp only [c11, ↓reduceIte] + by_cases c12 : fac u = ((12 : ℕ) : PAM M); · simp only [c12, ↓reduceIte] + simp only [c12, ↓reduceIte] + by_cases c13 : fac u = ((13 : ℕ) : PAM M); · simp only [c13, ↓reduceIte] + simp only [c13, ↓reduceIte] + by_cases c14 : fac u = ((14 : ℕ) : PAM M); · simp only [c14, ↓reduceIte] + simp only [c14, ↓reduceIte] + by_cases c15 : fac u = ((15 : ℕ) : PAM M); · simp only [c15, ↓reduceIte] + simp only [c15, ↓reduceIte] + by_cases c16 : fac u = ((16 : ℕ) : PAM M) + · simp only [c16, ↓reduceIte] + by_cases c16i : mZfImp (mUnpair (mPair (ftop u) (fstk u))).1 (fp1 u) = + (mUnpair (mUnpair (mPair (ftop u) (fstk u))).2).1 <;> + simp only [c16i, ↓reduceIte] + simp only [c16, ↓reduceIte] + by_cases c17 : fac u = ((17 : ℕ) : PAM M); · simp only [c17, ↓reduceIte] + simp only [c17, ↓reduceIte] + by_cases c18 : fac u = ((18 : ℕ) : PAM M); · simp only [c18, ↓reduceIte] + simp only [c18, ↓reduceIte] + by_cases c19 : fac u = ((19 : ℕ) : PAM M) <;> simp only [c19, ↓reduceIte] + · refine paFunN_congr (fun u ↦ ?_) + (paFun_ite (eqc 0) hstk0 <| + paFun_ite (eqc 1) hstk0 <| + paFun_ite (eqc 2) hstk0 <| + paFun_ite (eqc 3) hstk0 <| + paFun_ite (eqc 4) hstk0 <| + paFun_ite (eqc 5) hstk0 <| + paFun_ite (eqc 6) hstk0 <| + paFun_ite (eqc 7) hstk0 <| + paFun_ite (eqc 8) hstk0 <| + paFun_ite (eqc 9) hstk0 <| + paFun_ite (eqc 10) hstk0 <| + paFun_ite (eqc 11) hstk0 <| + paFun_ite (eqc 12) hstk0 <| + paFun_ite (eqc 13) hstk0 <| + paFun_ite (eqc 14) hstk0 <| + paFun_ite (eqc 15) hstk0 <| + paFun_ite (eqc 16) hpop2_2 <| + paFun_ite (eqc 17) hpop1_2 <| + paFun_ite (eqc 18) hstk0 <| + paFun_ite (eqc 19) hstk0 <| + hstk0) + unfold mZf393ClauseDispatch + dsimp only [eqc] + by_cases c0 : fac u = ((0 : ℕ) : PAM M); · simp only [c0, ↓reduceIte] + simp only [c0, ↓reduceIte] + by_cases c1 : fac u = ((1 : ℕ) : PAM M); · simp only [c1, ↓reduceIte] + simp only [c1, ↓reduceIte] + by_cases c2 : fac u = ((2 : ℕ) : PAM M); · simp only [c2, ↓reduceIte] + simp only [c2, ↓reduceIte] + by_cases c3 : fac u = ((3 : ℕ) : PAM M); · simp only [c3, ↓reduceIte] + simp only [c3, ↓reduceIte] + by_cases c4 : fac u = ((4 : ℕ) : PAM M); · simp only [c4, ↓reduceIte] + simp only [c4, ↓reduceIte] + by_cases c5 : fac u = ((5 : ℕ) : PAM M); · simp only [c5, ↓reduceIte] + simp only [c5, ↓reduceIte] + by_cases c6 : fac u = ((6 : ℕ) : PAM M); · simp only [c6, ↓reduceIte] + simp only [c6, ↓reduceIte] + by_cases c7 : fac u = ((7 : ℕ) : PAM M) + · simp only [c7, ↓reduceIte] + by_cases c7i : fp1 u = fp3 u ∨ fp2 u = fp3 u <;> simp only [c7i, ↓reduceIte] + simp only [c7, ↓reduceIte] + by_cases c8 : fac u = ((8 : ℕ) : PAM M); · simp only [c8, ↓reduceIte] + simp only [c8, ↓reduceIte] + by_cases c9 : fac u = ((9 : ℕ) : PAM M); · simp only [c9, ↓reduceIte] + simp only [c9, ↓reduceIte] + by_cases c10 : fac u = ((10 : ℕ) : PAM M); · simp only [c10, ↓reduceIte] + simp only [c10, ↓reduceIte] + by_cases c11 : fac u = ((11 : ℕ) : PAM M); · simp only [c11, ↓reduceIte] + simp only [c11, ↓reduceIte] + by_cases c12 : fac u = ((12 : ℕ) : PAM M); · simp only [c12, ↓reduceIte] + simp only [c12, ↓reduceIte] + by_cases c13 : fac u = ((13 : ℕ) : PAM M); · simp only [c13, ↓reduceIte] + simp only [c13, ↓reduceIte] + by_cases c14 : fac u = ((14 : ℕ) : PAM M); · simp only [c14, ↓reduceIte] + simp only [c14, ↓reduceIte] + by_cases c15 : fac u = ((15 : ℕ) : PAM M); · simp only [c15, ↓reduceIte] + simp only [c15, ↓reduceIte] + by_cases c16 : fac u = ((16 : ℕ) : PAM M) + · simp only [c16, ↓reduceIte] + by_cases c16i : mZfImp (mUnpair (mPair (ftop u) (fstk u))).1 (fp1 u) = + (mUnpair (mUnpair (mPair (ftop u) (fstk u))).2).1 <;> + simp only [c16i, ↓reduceIte] + simp only [c16, ↓reduceIte] + by_cases c17 : fac u = ((17 : ℕ) : PAM M); · simp only [c17, ↓reduceIte] + simp only [c17, ↓reduceIte] + by_cases c18 : fac u = ((18 : ℕ) : PAM M); · simp only [c18, ↓reduceIte] + simp only [c18, ↓reduceIte] + by_cases c19 : fac u = ((19 : ℕ) : PAM M) <;> simp only [c19, ↓reduceIte] + +theorem paFun_mZf393MainNextParts {k : ℕ} {fz : (Fin k → PAM M) → PAM M} + (hz : PAFunN k fz) : + PAFunN k (fun u ↦ mPackMainCfg (mZf393MainNext (mUnpackMainCfg (fz u)))) ∧ + PAFunN k (fun u ↦ (mZf393MainNext (mUnpackMainCfg (fz u))).topwff) := by + have hpl := paFun_mUnpair_fst hz + have hu1_2 := paFun_mUnpair_snd hz + have hnp := paFun_mUnpair_fst hu1_2 + have hu2_2 := paFun_mUnpair_snd hu1_2 + have htop := paFun_mUnpair_fst hu2_2 + have hstk := paFun_mUnpair_snd hu2_2 + have hpl0 : PADefN k (fun u ↦ (mUnpair (fz u)).1 = 0) := paDef_eq hpl (paFun_const 0) + have hpl1 := paFun_ite hpl0 hnp (paFun_sub hpl (paFun_const 1)) + have hnp' := paFun_ite hpl0 (paFun_add hnp (paFun_const 1)) hnp + have hac := paFun_mUnpair_fst hpl1 + have hv1 := paFun_mUnpair_snd hpl1 + have hp1 := paFun_mUnpair_fst hv1 + have hv2 := paFun_mUnpair_snd hv1 + have hp2 := paFun_mUnpair_fst hv2 + have hv3 := paFun_mUnpair_snd hv2 + have hp3 := paFun_mUnpair_fst hv3 + have hpl' := paFun_mUnpair_snd hv3 + obtain ⟨hres1, hres2⟩ := paFun_mZf393ClauseDispatch htop hstk hac hp1 hp2 hp3 + exact ⟨paFun_mPair hpl' (paFun_mPair hnp' (paFun_mPair hres1 hres2)), hres1⟩ + +/-- $\beta$-coded execution trace of `mZf393MainStep` of length `n` from `a` to `b`. -/ +def MValidMainTrace (n tc td : PAM M) (a b : MZfMainCfg M) : Prop := + mBeta tc td 0 = mPackMainCfg a ∧ + (∀ i < n, mZf393MainStep (mUnpackMainCfg (mBeta tc td i)) = + some (mUnpackMainCfg (mBeta tc td (i + 1)))) ∧ + mBeta tc td n = mPackMainCfg b + +def mMainTracesTo (n : PAM M) (a b : MZfMainCfg M) : Prop := + ∃ tc td : PAM M, MValidMainTrace n tc td a b + +theorem mMainTracesTo_zero (a : MZfMainCfg M) : mMainTracesTo 0 a a := + ⟨mPackMainCfg a, mPackMainCfg a + 1, mBeta_singleton _, + fun _ hi ↦ absurd hi (not_lt_zero_pam _), mBeta_singleton _⟩ + +theorem mMainTracesTo_snoc {n : PAM M} {a b c : MZfMainCfg M} + (htr : mMainTracesTo n a b) (hst : mZf393MainStep b = some c) : + mMainTracesTo (n + 1) a c := by + rcases htr with ⟨tc, td, h0, hstep, hn⟩ + obtain ⟨tc', td', hprev, hlast⟩ := mBeta_snoc (n + 1) tc td (mPackMainCfg c) + refine ⟨tc', td', ?_, ?_, hlast⟩ + · rw [hprev 0 ⟨n, by ring⟩, h0] + · intro i hi + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hi) with hilt | rfl + · rw [hprev i (lt_trans hilt (lt_succ_self_pam n)), + hprev (i + 1) (add_lt_add_right_pam hilt 1)] + exact hstep i hilt + · rw [hprev i (lt_succ_self_pam i), hn, mUnpackMainCfg_mPackMainCfg, hlast, + mUnpackMainCfg_mPackMainCfg] + exact hst + +theorem mMainTracesTo_one {a b : MZfMainCfg M} (hst : mZf393MainStep a = some b) : + mMainTracesTo 1 a b := by + simpa using mMainTracesTo_snoc (mMainTracesTo_zero a) hst + +theorem mMainTracesTo_trans {n₁ n₂ : PAM M} {a b c : MZfMainCfg M} + (h₁ : mMainTracesTo n₁ a b) (h₂ : mMainTracesTo n₂ b c) : + mMainTracesTo (n₁ + n₂) a c := by + rcases eq_zero_or_exists_succ n₂ with rfl | ⟨m₂, rfl⟩ + · rcases h₂ with ⟨tc₂, td₂, hb₂, _, hc₂⟩ + have hbc : b = c := mPackMainCfg_injective (hb₂.symm.trans hc₂) + subst hbc + simpa using h₁ + · rcases h₁ with ⟨c₁, d₁, ha₁, hst₁, hb₁⟩ + rcases h₂ with ⟨c₂, d₂, hb₂, hst₂, hc₂⟩ + obtain ⟨c', d', hleft, hright⟩ := mBeta_concat n₁ c₁ d₁ (m₂ + 1 + 1) c₂ d₂ + refine ⟨c', d', ?_, ?_, ?_⟩ + · rcases eq_zero_or_exists_succ n₁ with rfl | ⟨m₁, rfl⟩ + · have h0 := hright 0 ⟨m₂ + 1, by ring⟩ + rw [zero_add] at h0 + have hab : a = b := mPackMainCfg_injective (ha₁.symm.trans hb₁) + subst hab + exact h0.trans hb₂ + · exact (hleft 0 ⟨m₁, by ring⟩).trans ha₁ + · intro i hi + rcases lt_or_ge i n₁ with hilt | hige + · rw [hleft i hilt] + rcases lt_or_eq_of_le (show i + 1 ≤ n₁ from hilt) with hilt1 | hi1_eq + · rw [hleft (i + 1) hilt1] + exact hst₁ i hilt + · have hstep_i := hst₁ i hilt + rw [hi1_eq] at hstep_i ⊢ + have h0 := hright 0 ⟨m₂ + 1, by ring⟩ + rw [add_zero] at h0 + rw [h0, hb₂, ← hb₁] + exact hstep_i + · let j := i - n₁ + have hij : n₁ + j = i := add_sub_of_le_pam hige + have hjlt : j < m₂ + 1 := by + rcases hi with ⟨w, hw⟩ + exact ⟨w, (add_left_inj_pam n₁).mp (by + calc n₁ + (j + 1 + w) + _ = (n₁ + j) + 1 + w := by ring + _ = i + 1 + w := by rw [hij] + _ = n₁ + (m₂ + 1) := hw)⟩ + have hij1 : i + 1 = n₁ + (j + 1) := by rw [← hij]; ring + rw [← hij, hright j (lt_trans hjlt (lt_succ_self_pam (m₂ + 1))), hij, + hij1, hright (j + 1) (add_lt_add_right_pam hjlt 1)] + exact hst₂ j hjlt + · exact (hright (m₂ + 1) (lt_succ_self_pam (m₂ + 1))).trans hc₂ + +theorem paDef_mMainTracesTo {k : ℕ} {fn : (Fin k → PAM M) → PAM M} + {ca cb : (Fin k → PAM M) → MZfMainCfg M} + (hn : PAFunN k fn) + (ha : PAFunN k (fun u ↦ mPackMainCfg (ca u))) + (hb : PAFunN k (fun u ↦ mPackMainCfg (cb u))) : + PADefN k (fun u ↦ mMainTracesTo (fn u) (ca u) (cb u)) := by + let tcProj : (Fin (k + 2) → PAM M) → PAM M := fun v ↦ v ⟨k, by omega⟩ + let tdProj : (Fin (k + 2) → PAM M) → PAM M := fun v ↦ v (Fin.last (k + 1)) + have htc : PAFunN (k + 2) tcProj := paFun_proj ⟨k, by omega⟩ + have htd : PAFunN (k + 2) tdProj := paFun_proj (Fin.last (k + 1)) + have hn2 : PAFunN (k + 2) (fun v ↦ fn (Fin.init (Fin.init v))) := paFun_weaken (paFun_weaken hn) + have ha2 : PAFunN (k + 2) (fun v ↦ mPackMainCfg (ca (Fin.init (Fin.init v)))) := + paFun_weaken (paFun_weaken ha) + have hb2 : PAFunN (k + 2) (fun v ↦ mPackMainCfg (cb (Fin.init (Fin.init v)))) := + paFun_weaken (paFun_weaken hb) + have h0 : PADefN (k + 2) (fun v ↦ + mBeta (tcProj v) (tdProj v) 0 = mPackMainCfg (ca (Fin.init (Fin.init v)))) := + paDef_eq (paFun_mBeta htc htd (paFun_const 0)) ha2 + have hlast : PADefN (k + 2) (fun v ↦ + mBeta (tcProj v) (tdProj v) (fn (Fin.init (Fin.init v))) = + mPackMainCfg (cb (Fin.init (Fin.init v)))) := + paDef_eq (paFun_mBeta htc htd hn2) hb2 + have hstep : PADefN (k + 2) (fun v ↦ ∀ i < fn (Fin.init (Fin.init v)), + mZf393MainStep (mUnpackMainCfg (mBeta (tcProj v) (tdProj v) i)) = + some (mUnpackMainCfg (mBeta (tcProj v) (tdProj v) (i + 1)))) := by + let iProj : (Fin (k + 3) → PAM M) → PAM M := fun w ↦ w (Fin.last (k + 2)) + have hi : PAFunN (k + 3) iProj := paFun_proj (Fin.last (k + 2)) + have htc3 := paFun_weaken htc + have htd3 := paFun_weaken htd + have hn3 := paFun_weaken hn2 + have hbi := paFun_mBeta htc3 htd3 hi + have hbi1 := paFun_mBeta htc3 htd3 (paFun_add hi (paFun_const 1)) + obtain ⟨hnextCode, hnextTop⟩ := paFun_mZf393MainNextParts hbi + refine paDefN_congr (fun v ↦ ?_) + (paDef_all (paDef_imp (paDef_lt hi hn3) + (paDef_and (paDef_not (paDef_eq hnextTop (paFun_const 1))) + (paDef_eq hbi1 hnextCode)))) + simp only [iProj, Fin.snoc_last, Fin.init_snoc] + refine forall_congr' fun i ↦ imp_congr Iff.rfl ?_ + rw [mZf393MainStep_eq_some_iff] + exact and_congr Iff.rfl + ⟨fun h ↦ by simpa using congrArg (mUnpackMainCfg (M := M)) h, + fun h ↦ by simpa using congrArg (mPackMainCfg (M := M)) h⟩ + refine paDefN_congr (fun u ↦ ?_) (paDef_ex (paDef_ex (paDef_and h0 (paDef_and hstep hlast)))) + constructor + · rintro ⟨tc, td, hv⟩ + dsimp only [tcProj, tdProj] at hv + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] at hv + exact ⟨tc, td, hv⟩ + · rintro ⟨tc, td, hv⟩ + refine ⟨tc, td, ?_⟩ + dsimp only [tcProj, tdProj] + rw [Fin.snoc_last, Fin.init_snoc, Fin.init_snoc, + fin_snoc_lt _ _ (by omega) (Nat.lt_succ_self k), fin_snoc_eq] + exact hv + +/-- Internal halting predicate for `zf393`'s `main()` loop inside `PAM M`. -/ +def MZf393MainHalts (M : Type*) [PAStructure M] [PAModel M] : Prop := + ∃ (n : PAM M) (c : MZfMainCfg M), mMainTracesTo n mZfMainInit c ∧ mZf393MainStep c = none + +def regsOfAfterN (n : ℕ) (w : Fin (n + 12) → PAM M) : List (PAM M) := + List.ofFn (fun i : Fin 11 ↦ w ⟨n + i.val + 1, by omega⟩) + +omit [PAModel M] in +theorem paFunRegs_regsOfAfterN (n : ℕ) : PAFunRegs (n + 12) (regsOfAfterN (M := M) n) := + paFunRegs_ofFn (fun i ↦ paFun_proj ⟨n + i.val + 1, by omega⟩) + +omit [PAStructure M] [PAModel M] in +private theorem regsOfAfterN_finCat {n : ℕ} (a : Fin n → PAM M) (b : Fin 12 → PAM M) : + regsOfAfterN n (finCat a b) = List.ofFn (fun i : Fin 11 ↦ b i.succ) := by + unfold regsOfAfterN + congr 1 + funext i + have hidx : (⟨n + i.val + 1, by omega⟩ : Fin (n + 12)) = + ⟨n + i.succ.val, Nat.add_lt_add_left i.succ.isLt n⟩ := by + ext; dsimp; omega + rw [hidx, finCat_right] + +omit [PAModel M] in +theorem paDef_exists_slot_regs {n : ℕ} + {P : (Fin n → PAM M) → PAM M → List (PAM M) → Prop} + (hP : PADefN (n + 12) (fun w ↦ + P (fun i : Fin n ↦ w ⟨i.val, by omega⟩) (w ⟨n, by omega⟩) (regsOfAfterN n w))) : + PADefN n (fun a ↦ ∃ (slot : PAM M) (regs : List (PAM M)), + regs.length = 11 ∧ P a slot regs) := by + refine paDefN_congr (fun a ↦ ?_) (paDef_exists_vec (k := n) (m := 12) hP) + have ha : ∀ b : Fin 12 → PAM M, + (fun i : Fin n ↦ finCat a b ⟨i.val, by omega⟩) = a := by + intro b; funext i; exact finCat_left a b i + have hb0 : ∀ b : Fin 12 → PAM M, finCat a b ⟨n, by omega⟩ = b 0 := by + intro b + have h0 : (⟨n, by omega⟩ : Fin (n + 12)) = ⟨n + (0 : Fin 12).val, by omega⟩ := by ext; simp + rw [h0, finCat_right] + constructor + · rintro ⟨b, hb⟩ + rw [ha b, hb0 b, regsOfAfterN_finCat a b] at hb + exact ⟨b 0, List.ofFn (fun i : Fin 11 ↦ b i.succ), by simp, hb⟩ + · rintro ⟨slot, regs, hlen, hp⟩ + let b : Fin 12 → PAM M := Fin.cons slot (fun i : Fin 11 ↦ regs.getD i.val 0) + refine ⟨b, ?_⟩ + rw [ha b, hb0 b, regsOfAfterN_finCat a b] + have hb_sl : b 0 = slot := rfl + have hb_rs : List.ofFn (fun i : Fin 11 ↦ b i.succ) = regs := ofFn_getD_eq_self hlen + rwa [hb_sl, hb_rs] + +theorem paFun_mPack_mRegsToMainCfg {n : ℕ} {R : (Fin n → PAM M) → List (PAM M)} + (hR : PAFunRegs n R) : + PAFunN n (fun u ↦ mPackMainCfg (mRegsToMainCfg (R u))) := + paFun_mPair (paFunRegs_getD hR 0) + (paFun_mPair (paFunRegs_getD hR 1) + (paFun_mPair (paFunRegs_getD hR 2) (paFunRegs_getD hR 3))) + +/-- Backward simulation in `PAM M`: if `MZf393MainHalts M`, then `Machines.zf393` halts. -/ +theorem mHalts_zf393_of_mZf393MainHalts (hMain : MZf393MainHalts M) : mHalts M zf393 := by + rcases hMain with ⟨N, c_end, ⟨tc, td, htr⟩, hnone⟩ + let root₀ : MCfg 393 M := mZfLogCfg 19 [] (List.replicate 11 (0 : PAM M)) + have hdef : PADef1 (fun k : PAM M ↦ k ≤ N → + ∃ (slot : PAM M) (regs : List (PAM M)), + regs.length = 11 ∧ + MZfLogInv slot [] regs ∧ + MRegsInv regs ∧ + mPackMainCfg (mRegsToMainCfg regs) = mBeta tc td k ∧ + mReach root₀ (mZfLogCfg slot [] regs)) := by + have hR := paFunRegs_regsOfAfterN (M := M) 1 + have hsl : PAFunN 13 (fun w : Fin 13 → PAM M ↦ w ⟨1, by omega⟩) := paFun_proj ⟨1, by omega⟩ + have hk13 : PAFunN 13 (fun w : Fin 13 → PAM M ↦ w ⟨0, by omega⟩) := paFun_proj ⟨0, by omega⟩ + have hex : PADefN 1 (fun a ↦ ∃ (slot : PAM M) (regs : List (PAM M)), + regs.length = 11 ∧ + MZfLogInv slot [] regs ∧ + MRegsInv regs ∧ + mPackMainCfg (mRegsToMainCfg regs) = mBeta tc td (a 0) ∧ + mReach root₀ (mZfLogCfg slot [] regs)) := + paDef_exists_slot_regs (n := 1) + (paDef_and (paDef_mZfLogInv [] hsl hR) + (paDef_and (paDef_mRegsInv hR) + (paDef_and + (paDef_eq (paFun_mPack_mRegsToMainCfg hR) + (paFun_mBeta (paFun_const tc) (paFun_const td) hk13)) + (paDef_mReach (paFun_const (mEncodeCfg root₀)) + (paFun_mZfLogCfg_of_regs [] hsl hR))))) + exact paDef_imp (paDef_le (paFun_proj 0) (paFun_const N)) hex + have hsim := ind1 hdef + (fun _ ↦ by + refine ⟨19, List.replicate 11 0, by simp, mZfLogInv_init, mRegsInv_init, ?_, + mReach_refl root₀⟩ + have hcfg0 : mRegsToMainCfg (List.replicate 11 (0 : PAM M)) = mZfMainInit := rfl + rw [hcfg0, htr.1]) + (fun k ih hk1 ↦ by + have hklt : k < N := hk1 + obtain ⟨slot, regs, _, hLog, hInv, hpack, hreach⟩ := ih (le_of_lt hklt) + have hcfg_eq : mRegsToMainCfg regs = mUnpackMainCfg (mBeta tc td k) := by + simpa using congrArg mUnpackMainCfg hpack + have hstep_k := htr.2.1 k hklt + rw [← hcfg_eq] at hstep_k + have hiter := mMain_iter_sim hLog hInv + rw [hstep_k] at hiter + obtain ⟨slot', regs', hLog', hInv', hcfg', hreachPos⟩ := hiter + have hpack' : mPackMainCfg (mRegsToMainCfg regs') = mBeta tc td (k + 1) := by + rw [hcfg', mPackMainCfg_mUnpackMainCfg] + exact ⟨slot', regs', hLog'.1, hLog', hInv', hpack', + mReach_trans hreach (mReachPos_to_mReach hreachPos)⟩) + N le_rfl + obtain ⟨slot_end, regs_end, _, hLog_end, hInv_end, hpack_end, ⟨S, htr_end⟩⟩ := hsim + have hcfg_end : mRegsToMainCfg regs_end = c_end := + mPackMainCfg_injective (hpack_end.trans htr.2.2) + have hiter_end := mMain_iter_sim hLog_end hInv_end + rw [hcfg_end, hnone] at hiter_end + exact mHalts_zf393_iff_rootInit.mpr ((mHaltsFrom_iff_of_mTracesTo htr_end).mpr hiter_end) + +/-- Forward simulation in `PAM M`: if `Machines.zf393` halts, then `MZf393MainHalts M`. -/ +theorem mZf393MainHalts_of_mHalts_zf393 (hTM : mHalts M zf393) : MZf393MainHalts M := by + let root₀ : MCfg 393 M := mZfLogCfg 19 [] (List.replicate 11 (0 : PAM M)) + obtain ⟨T, c_halt, ⟨tc_tm, td_tm, hv_tm⟩, hnone_tm⟩ := mHalts_zf393_iff_rootInit.mp hTM + by_contra hno + have hdef : PADef1 (fun k : PAM M ↦ + ∃ (S slot : PAM M) (regs : List (PAM M)), + regs.length = 11 ∧ + k ≤ S ∧ + MZfLogInv slot [] regs ∧ + MRegsInv regs ∧ + mMainTracesTo k mZfMainInit (mRegsToMainCfg regs) ∧ + mTracesTo zf393 S root₀ (mZfLogCfg slot [] regs)) := by + have hR := paFunRegs_regsOfAfterN (M := M) 2 + have hk14 : PAFunN 14 (fun w : Fin 14 → PAM M ↦ w ⟨0, by omega⟩) := paFun_proj ⟨0, by omega⟩ + have hS14 : PAFunN 14 (fun w : Fin 14 → PAM M ↦ w ⟨1, by omega⟩) := paFun_proj ⟨1, by omega⟩ + have hsl14 : PAFunN 14 (fun w : Fin 14 → PAM M ↦ w ⟨2, by omega⟩) := paFun_proj ⟨2, by omega⟩ + have hex2 : PADefN 2 (fun a ↦ ∃ (slot : PAM M) (regs : List (PAM M)), + regs.length = 11 ∧ + a 0 ≤ a 1 ∧ + MZfLogInv slot [] regs ∧ + MRegsInv regs ∧ + mMainTracesTo (a 0) mZfMainInit (mRegsToMainCfg regs) ∧ + mTracesTo zf393 (a 1) root₀ (mZfLogCfg slot [] regs)) := + paDef_exists_slot_regs (n := 2) + (paDef_and (paDef_le hk14 hS14) + (paDef_and (paDef_mZfLogInv [] hsl14 hR) + (paDef_and (paDef_mRegsInv hR) + (paDef_and + (paDef_mMainTracesTo hk14 (paFun_const (mPackMainCfg mZfMainInit)) + (paFun_mPack_mRegsToMainCfg hR)) + (paDef_mTracesTo zf393 hS14 (paFun_const (mEncodeCfg root₀)) + (paFun_mZfLogCfg_of_regs [] hsl14 hR)))))) + refine paDefN_congr (fun a ↦ ?_) (paDef_ex hex2) + simp [Fin.snoc] + have hrun := ind1 hdef + (by + refine ⟨0, 19, List.replicate 11 0, by simp, le_rfl, mZfLogInv_init, mRegsInv_init, ?_, + mTracesTo_zero zf393 root₀⟩ + have hcfg0 : mRegsToMainCfg (List.replicate 11 (0 : PAM M)) = mZfMainInit := rfl + rw [hcfg0] + exact mMainTracesTo_zero mZfMainInit) + (fun k ⟨S, slot, regs, _, hkS, hLog, hInv, hmain_k, htm_k⟩ ↦ by + have hiter := mMain_iter_sim hLog hInv + rcases hs : mZf393MainStep (mRegsToMainCfg regs) with _ | c' + · exact False.elim (hno ⟨k, mRegsToMainCfg regs, hmain_k, hs⟩) + · rw [hs] at hiter + obtain ⟨slot', regs', hLog', hInv', hcfg', s, hs1, htr_s⟩ := hiter + rw [← hcfg'] at hs + have hk1S : k + 1 ≤ S + s := by + rcases hkS with ⟨d₁, rfl⟩ + rcases hs1 with ⟨d₂, rfl⟩ + exact ⟨d₁ + d₂, by ring⟩ + exact ⟨S + s, slot', regs', hLog'.1, hk1S, hLog', hInv', + mMainTracesTo_snoc hmain_k hs, mTracesTo_trans htm_k htr_s⟩) + (T + 1) + obtain ⟨S, slot, regs, _, hT1_S, _, _, _, c_s, d_s, hv_s⟩ := hrun + have hT_lt_S : T < S := hT1_S + have hag := mValidTrace_agree hv_tm hv_s T le_rfl (le_of_lt hT_lt_S) + obtain ⟨x, y, hx, _, hst⟩ := hv_s.2.1 T hT_lt_S + have hxh : x = c_halt := mEncodeCfg_injective (hx.symm.trans (hag.symm.trans hv_tm.2.2)) + subst hxh + rw [hnone_tm] at hst + cases hst + +/-- Full Layer 1 + Layer 2 equivalence inside an arbitrary `PAModel M`: `Machines.zf393` halts iff +the abstract proof-enumerating register machine `MZf393MainHalts M` halts. -/ +theorem mHalts_zf393_iff_mZf393MainHalts : mHalts M zf393 ↔ MZf393MainHalts M := + ⟨mZf393MainHalts_of_mHalts_zf393, mHalts_zf393_of_mZf393MainHalts⟩ + +end ProgramInternal + +end ConjectureMachines.Semantics.PA + +end diff --git a/Cryptids/Semantics/PA/Zf393SoundnessInternal.lean b/Cryptids/Semantics/PA/Zf393SoundnessInternal.lean new file mode 100644 index 00000000..ab1b78c1 --- /dev/null +++ b/Cryptids/Semantics/PA/Zf393SoundnessInternal.lean @@ -0,0 +1,1105 @@ +/- +Copyright (c) 2026 Google LLC. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +-/ +module + +public import Cryptids.Semantics.PA.Zf393ProgramInternal +public import Cryptids.Semantics.PA.Zf380Internal + +/-! +# Internalized `ZF` Soundness & Completeness of `zf_393` and `zf_380` in `PA` + +Completes Layer 3 of the `zf_393` proof inside arbitrary first-order models `PAM M` of Peano +Arithmetic (`[PAStructure M] [PAModel M]`): + +1. **Internalized Soundness (`mZfInconsistent_of_mZf393MainHalts`)**: + Maintains a first-order definable invariant `MStackProofInv` along $\beta$-coded `main()` + traces witnessing a $\beta$-coded `MIsZFStep` derivation `(L, pc, pd)` and a $\beta$-coded + formula-stack spine `(depth, sc, sd)` whose entries all appear in `(pc, pd)`. When `main()` + halts (`topwff = 1 = mZfMem 0 0`), `(pc, pd)` witnesses `MZFInconsistent M`. +2. **Internalized Completeness (`mZf393MainHalts_of_mZfInconsistent`)**: + Compiles any $\beta$-coded `ZF` derivation `(n, pc, pd)` of `mZfMem 0 0` into a $\beta$-coded + sequence of 4-tuple `zf393` instructions via `PAM.strong_ind1`, folds it into a Cantor-paired + `prooflist` code via `PAM.ind1`, advances `nextproof` to that code, and executes `main()` to + halting (`topwff = 1`). +3. **`PAProvable` Main Theorems**: + By Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`), establishes: + - `paProvable_halts_zf393_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf393).iff paZFInconsistent)` + - `paProvable_halts_zf380_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf380).iff paZFInconsistent)` +-/ + +@[expose] public section + +namespace ConjectureMachines.Semantics.PA + +open Machines +open ConjectureMachines.Zf393 +open ConjectureMachines.Zf393.Layer2 +open PAM + +section Model + +variable {M : Type*} [PAStructure M] [PAModel M] + +/-! ## Section 1: Pairing Bounds, Zero Axiom, and Prefix Congruence -/ + +@[simp] +theorem mZfEq_zero_zero : mZfEq (0 : PAM M) 0 = 0 := by + simp [mZfEq, mPair_zero_zero] + +theorem mIsZFAxiom_zero : MIsZFAxiom (0 : PAM M) := + Or.inl mZfEq_zero_zero.symm + +theorem mIsZFStep_zero (c d i : PAM M) : MIsZFStep c d i 0 := + Or.inl mIsZFAxiom_zero + +theorem mUnpair_snd_le (z : PAM M) : (mUnpair z).2 ≤ z := by + conv_rhs => rw [← mPair_mUnpair z] + exact le_mPair_right _ _ + +attribute [local irreducible] mPair mUnpair + +theorem mIsZFStep_congr_prefix {c d c' d' i w : PAM M} + (hprev : ∀ j < i, mBeta c' d' j = mBeta c d j) + (hst : MIsZFStep c d i w) : MIsZFStep c' d' i w := by + rcases hst with hax | ⟨φ, χ, j₁, j₂, hj₁, hj₂, hb₁, hb₂, hχ⟩ | ⟨x, φ, j, hj, hbj, hw⟩ + · exact Or.inl hax + · exact Or.inr (Or.inl ⟨φ, χ, j₁, j₂, hj₁, hj₂, + (hprev j₁ hj₁).trans hb₁, (hprev j₂ hj₂).trans hb₂, hχ⟩) + · exact Or.inr (Or.inr ⟨x, φ, j, hj, (hprev j hj).trans hbj, hw⟩) + +/-! ## Section 2: Soundness (`mZfInconsistent_of_mZf393MainHalts`) -/ + +/-- $\beta$-coded derivation prefix `(L, pc, pd)` with `mBeta pc pd 0 = 0` and valid `ZF` steps. -/ +def MDerivInv (L pc pd : PAM M) : Prop := + 1 ≤ L ∧ mBeta pc pd 0 = 0 ∧ ∀ i < L, MIsZFStep pc pd i (mBeta pc pd i) + +/-- $\beta$-coded stack spine `(depth, sc, sd)` for `stk` whose formulas lie in `(L, pc, pd)`. -/ +def MStackSpine (L pc pd depth sc sd stk : PAM M) : Prop := + mBeta sc sd 0 = 0 ∧ + (∀ k < depth, ∃ j < L, mBeta sc sd (k + 1) = mPair (mBeta pc pd j) (mBeta sc sd k)) ∧ + stk = mBeta sc sd depth + +/-- Combined derivation + formula-stack invariant on `(top, stk)`. -/ +def MStackProofInv (top stk : PAM M) : Prop := + ∃ L pc pd depth sc sd : PAM M, + MDerivInv L pc pd ∧ + MStackSpine L pc pd depth sc sd stk ∧ + ∃ j < L, top = mBeta pc pd j + +theorem paDef_mStackProofInv {n : ℕ} {ftop fstk : (Fin n → PAM M) → PAM M} + (htop : PAFunN n ftop) (hstk : PAFunN n fstk) : + PADefN n (fun u ↦ MStackProofInv (ftop u) (fstk u)) := by + let fL : (Fin (n + 6) → PAM M) → PAM M := + fun v ↦ (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init v))))) (Fin.last n) + let fpc : (Fin (n + 6) → PAM M) → PAM M := + fun v ↦ (Fin.init (Fin.init (Fin.init (Fin.init v)))) (Fin.last (n + 1)) + let fpd : (Fin (n + 6) → PAM M) → PAM M := + fun v ↦ (Fin.init (Fin.init (Fin.init v))) (Fin.last (n + 2)) + let fdep : (Fin (n + 6) → PAM M) → PAM M := + fun v ↦ (Fin.init (Fin.init v)) (Fin.last (n + 3)) + let fsc : (Fin (n + 6) → PAM M) → PAM M := + fun v ↦ (Fin.init v) (Fin.last (n + 4)) + let fsd : (Fin (n + 6) → PAM M) → PAM M := + fun v ↦ v (Fin.last (n + 5)) + have hL : PAFunN (n + 6) fL := + paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken + (paFun_proj (Fin.last n)))))) + have hpc : PAFunN (n + 6) fpc := + paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken (paFun_proj (Fin.last (n + 1)))))) + have hpd : PAFunN (n + 6) fpd := + paFun_weaken (paFun_weaken (paFun_weaken (paFun_proj (Fin.last (n + 2))))) + have hdep : PAFunN (n + 6) fdep := + paFun_weaken (paFun_weaken (paFun_proj (Fin.last (n + 3)))) + have hsc : PAFunN (n + 6) fsc := + paFun_weaken (paFun_proj (Fin.last (n + 4))) + have hsd : PAFunN (n + 6) fsd := + paFun_proj (Fin.last (n + 5)) + have htop6 : PAFunN (n + 6) (fun v ↦ + ftop (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init v))))))) := + paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken htop))))) + have hstk6 : PAFunN (n + 6) (fun v ↦ + fstk (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init v))))))) := + paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken (paFun_weaken hstk))))) + have h1leL : PADefN (n + 6) (fun v ↦ 1 ≤ fL v) := + paDef_le (paFun_const 1) hL + have hpc0 : PADefN (n + 6) (fun v ↦ mBeta (fpc v) (fpd v) 0 = 0) := + paDef_eq (paFun_mBeta hpc hpd (paFun_const 0)) (paFun_const 0) + have hsteps : PADefN (n + 6) (fun v ↦ + ∀ i < fL v, MIsZFStep (fpc v) (fpd v) i (mBeta (fpc v) (fpd v) i)) := by + have hi : PAFunN (n + 7) (fun w ↦ w (Fin.last (n + 6))) := + paFun_proj (M := M) (Fin.last (n + 6)) + have hL7 := paFun_weaken hL + have hpc7 := paFun_weaken hpc + have hpd7 := paFun_weaken hpd + refine paDefN_congr (fun v ↦ ?_) + (paDef_all (paDef_imp (paDef_lt hi hL7) + (paDef_mIsZFStep hpc7 hpd7 hi (paFun_mBeta hpc7 hpd7 hi)))) + simp only [Fin.init_snoc, Fin.snoc_last] + have hsc0 : PADefN (n + 6) (fun v ↦ mBeta (fsc v) (fsd v) 0 = 0) := + paDef_eq (paFun_mBeta hsc hsd (paFun_const 0)) (paFun_const 0) + have hspine : PADefN (n + 6) (fun v ↦ + ∀ k < fdep v, ∃ j < fL v, + mBeta (fsc v) (fsd v) (k + 1) = + mPair (mBeta (fpc v) (fpd v) j) (mBeta (fsc v) (fsd v) k)) := by + have hk8 : PAFunN (n + 8) (fun w ↦ (Fin.init w) (Fin.last (n + 6))) := + paFun_weaken (paFun_proj (M := M) (Fin.last (n + 6))) + have hj8 : PAFunN (n + 8) (fun w ↦ w (Fin.last (n + 7))) := + paFun_proj (M := M) (Fin.last (n + 7)) + have hL8 := paFun_weaken (paFun_weaken hL) + have hpc8 := paFun_weaken (paFun_weaken hpc) + have hpd8 := paFun_weaken (paFun_weaken hpd) + have hsc8 := paFun_weaken (paFun_weaken hsc) + have hsd8 := paFun_weaken (paFun_weaken hsd) + have hex_j : PADefN (n + 7) (fun u7 ↦ + ∃ j < fL (Fin.init u7), + mBeta (fsc (Fin.init u7)) (fsd (Fin.init u7)) (u7 (Fin.last (n + 6)) + 1) = + mPair (mBeta (fpc (Fin.init u7)) (fpd (Fin.init u7)) j) + (mBeta (fsc (Fin.init u7)) (fsd (Fin.init u7)) (u7 (Fin.last (n + 6))))) := by + refine paDefN_congr (fun u7 ↦ ?_) + (paDef_ex (paDef_and (paDef_lt hj8 hL8) + (paDef_eq + (paFun_mBeta hsc8 hsd8 (paFun_add hk8 (paFun_const 1))) + (paFun_mPair (paFun_mBeta hpc8 hpd8 hj8) (paFun_mBeta hsc8 hsd8 hk8))))) + simp only [Fin.init_snoc, Fin.snoc_last] + have hk7 : PAFunN (n + 7) (fun u7 ↦ u7 (Fin.last (n + 6))) := + paFun_proj (M := M) (Fin.last (n + 6)) + refine paDefN_congr (fun v ↦ ?_) + (paDef_all (paDef_imp (paDef_lt hk7 (paFun_weaken hdep)) hex_j)) + simp only [Fin.init_snoc, Fin.snoc_last] + have hstk_eq : PADefN (n + 6) (fun v ↦ + fstk (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init v)))))) = + mBeta (fsc v) (fsd v) (fdep v)) := + paDef_eq hstk6 (paFun_mBeta hsc hsd hdep) + have htop_mem : PADefN (n + 6) (fun v ↦ + ∃ j < fL v, + ftop (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init v)))))) = + mBeta (fpc v) (fpd v) j) := by + have hj7 : PAFunN (n + 7) (fun w ↦ w (Fin.last (n + 6))) := + paFun_proj (M := M) (Fin.last (n + 6)) + refine paDefN_congr (fun v ↦ ?_) + (paDef_ex (paDef_and (paDef_lt hj7 (paFun_weaken hL)) + (paDef_eq (paFun_weaken htop6) + (paFun_mBeta (paFun_weaken hpc) (paFun_weaken hpd) hj7)))) + simp only [Fin.init_snoc, Fin.snoc_last] + have hbody := + paDef_and (paDef_and h1leL (paDef_and hpc0 hsteps)) + (paDef_and (paDef_and hsc0 (paDef_and hspine hstk_eq)) htop_mem) + refine paDefN_congr (fun u ↦ ?_) + (paDef_ex (paDef_ex (paDef_ex (paDef_ex (paDef_ex (paDef_ex hbody)))))) + simp only [MStackProofInv, MDerivInv, MStackSpine, + fL, fpc, fpd, fdep, fsc, fsd, Fin.init_snoc, Fin.snoc_last] + +theorem mDerivInv_append {L pc pd w : PAM M} + (hD : MDerivInv L pc pd) (hw : MIsZFStep pc pd L w) : + ∃ pc' pd' : PAM M, + MDerivInv (L + 1) pc' pd' ∧ + (∀ i < L, mBeta pc' pd' i = mBeta pc pd i) ∧ + mBeta pc' pd' L = w := by + obtain ⟨pc', pd', hprev, hlast⟩ := mBeta_snoc L pc pd w + rcases hD with ⟨h1L, h0, hst⟩ + have h0ltL : (0 : PAM M) < L := lt_of_lt_of_le zero_lt_one_pam h1L + refine ⟨pc', pd', ⟨le_trans h1L ⟨1, rfl⟩, (hprev 0 h0ltL).trans h0, ?_⟩, hprev, hlast⟩ + intro i hi + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hi) with hilt | rfl + · rw [hprev i hilt] + exact mIsZFStep_congr_prefix (fun j hj ↦ hprev j (lt_trans hj hilt)) (hst i hilt) + · rw [hlast] + exact mIsZFStep_congr_prefix hprev hw + +theorem mStackSpine_upgrade {L L' pc pd pc' pd' depth sc sd stk : PAM M} + (hS : MStackSpine L pc pd depth sc sd stk) + (hL : L ≤ L') + (hprev : ∀ i < L, mBeta pc' pd' i = mBeta pc pd i) : + MStackSpine L' pc' pd' depth sc sd stk := by + rcases hS with ⟨h0, hstep, hstk⟩ + refine ⟨h0, fun k hk ↦ ?_, hstk⟩ + obtain ⟨j, hj, heq⟩ := hstep k hk + exact ⟨j, lt_of_lt_of_le hj hL, by rw [hprev j hj, heq]⟩ + +theorem mStackSpine_push {L pc pd depth sc sd stk top j₀ : PAM M} + (hS : MStackSpine L pc pd depth sc sd stk) + (hj₀ : j₀ < L) (htop : top = mBeta pc pd j₀) : + ∃ sc' sd' : PAM M, MStackSpine L pc pd (depth + 1) sc' sd' (mPair top stk) := by + rcases hS with ⟨h0, hstep, hstk⟩ + obtain ⟨sc', sd', hprev, hlast⟩ := mBeta_snoc (depth + 1) sc sd (mPair top stk) + refine ⟨sc', sd', ?_, ?_, hlast.symm⟩ + · rw [hprev 0 ⟨depth, by ring⟩, h0] + · intro k hk + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hk) with hklt | rfl + · obtain ⟨j, hj, heq⟩ := hstep k hklt + refine ⟨j, hj, ?_⟩ + rw [hprev (k + 1) (add_lt_add_right_pam hklt 1), + hprev k (lt_trans hklt (lt_succ_self_pam depth)), heq] + · refine ⟨j₀, hj₀, ?_⟩ + rw [hlast, hprev k (lt_succ_self_pam k), ← hstk, htop] + +theorem mStackSpine_pop {L pc pd depth sc sd stk : PAM M} + (hD : MDerivInv L pc pd) + (hS : MStackSpine L pc pd depth sc sd stk) : + (∃ j < L, (mUnpair stk).1 = mBeta pc pd j) ∧ + MStackSpine L pc pd (depth - 1) sc sd (mUnpair stk).2 := by + rcases hS with ⟨h0, hstep, hstk⟩ + rcases eq_zero_or_exists_succ depth with rfl | ⟨d', rfl⟩ + · have hstk0 : stk = 0 := hstk.trans h0 + have h0sub : (0 : PAM M) - 1 = 0 := sub_eq_zero_of_le_pam (zero_le_pam 1) + rw [hstk0, mUnpair_zero, h0sub] + refine ⟨⟨0, lt_of_lt_of_le zero_lt_one_pam hD.1, hD.2.1.symm⟩, h0, ?_, h0.symm⟩ + intro k hk + exact absurd hk (not_lt_zero_pam k) + · rw [add_one_sub_one_pam] + obtain ⟨j, hj, heq⟩ := hstep d' (lt_succ_self_pam d') + have hunp : mUnpair stk = (mBeta pc pd j, mBeta sc sd d') := by + rw [hstk, heq, mUnpair_mPair] + rw [hunp] + exact ⟨⟨j, hj, rfl⟩, h0, fun k hk ↦ hstep k (lt_trans hk (lt_succ_self_pam d')), rfl⟩ + +theorem mStackProofInv_push_step {top stk w : PAM M} + (hInv : MStackProofInv top stk) + (hw : ∀ L pc pd : PAM M, MIsZFStep pc pd L w) : + MStackProofInv w (mPair top stk) := by + rcases hInv with ⟨L, pc, pd, depth, sc, sd, hD, hS, j₀, hj₀, htop⟩ + obtain ⟨sc', sd', hS'⟩ := mStackSpine_push hS hj₀ htop + obtain ⟨pc', pd', hD', hprev, hlast⟩ := mDerivInv_append hD (hw L pc pd) + exact ⟨L + 1, pc', pd', depth + 1, sc', sd', hD', + mStackSpine_upgrade hS' ⟨1, rfl⟩ hprev, + L, lt_succ_self_pam L, hlast.symm⟩ + +theorem mStackProofInv_init : MStackProofInv (0 : PAM M) 0 := by + refine ⟨1, 0, 0 + 1, 0, 0, 0 + 1, ?_, ?_, 0, zero_lt_one_pam, (mBeta_singleton 0).symm⟩ + · refine ⟨le_rfl, mBeta_singleton 0, fun i hi ↦ ?_⟩ + have hi0 : i = 0 := le_zero_iff_pam.mp (lt_add_one_iff_le.mp (by simpa using hi)) + subst hi0 + rw [mBeta_singleton 0] + exact mIsZFStep_zero 0 (0 + 1) 0 + · exact ⟨mBeta_singleton 0, fun k hk ↦ absurd hk (not_lt_zero_pam k), (mBeta_singleton 0).symm⟩ + +theorem mZf393ClauseDispatch_preserves_inv {top stk : PAM M} + (hInv : MStackProofInv top stk) (ac p1 p2 p3 : PAM M) : + let res := mZf393ClauseDispatch top stk ac p1 p2 p3 + MStackProofInv res.1 res.2 := by + dsimp only + have hax_step : ∀ {w : PAM M}, MIsZFAxiom w → MStackProofInv w (mPair top stk) := + fun hw ↦ mStackProofInv_push_step hInv (fun _ _ _ ↦ Or.inl hw) + rcases lt_or_ge ac ((20 : ℕ) : PAM M) with hlt20 | hge20 + · obtain ⟨k, hk20, rfl⟩ := lt_natCast_iff.mp hlt20 + have hk_cases : + k = 0 ∨ k = 1 ∨ k = 2 ∨ k = 3 ∨ k = 4 ∨ k = 5 ∨ k = 6 ∨ k = 7 ∨ k = 8 ∨ k = 9 ∨ + k = 10 ∨ k = 11 ∨ k = 12 ∨ k = 13 ∨ k = 14 ∨ k = 15 ∨ k = 16 ∨ k = 17 ∨ k = 18 ∨ k = 19 := + by omega + rcases hk_cases with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | + rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + · simp only [mZf393ClauseDispatch, ↓reduceIte] + exact hax_step mIsZFAxiom_zero + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨p1, rfl⟩)))))))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl))))))))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inl ⟨p1, rfl⟩))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)))))))))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inl ⟨p1, p2, rfl⟩)))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨p1, p2, p3, rfl⟩))))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + split_ifs with hcond + · exact hax_step mIsZFAxiom_zero + · rcases not_or.mp hcond with ⟨hne1, hne2⟩ + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨p1, p2, p3, hne1, Ne.symm hne2, rfl⟩)))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨p1, p2, p3, rfl⟩))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨p1, p2, rfl⟩))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨p1, p2, p3, rfl⟩))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inl ⟨p1, p2, p3, rfl⟩)))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inl ⟨p1, p2, p3, rfl⟩))))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inl ⟨p1, p2, p3, rfl⟩)))))))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inl ⟨p1, p2, p3, rfl⟩)) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl))))))))))))) + · -- Clause 16: `DET` (Modus Ponens) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + rcases hInv with ⟨L, pc, pd, depth, sc, sd, hD, hS, j₀, hj₀, htop⟩ + obtain ⟨sc₀, sd₀, hS₀⟩ := mStackSpine_push hS hj₀ htop + obtain ⟨⟨j₁, hj₁, hφ_eq⟩, hS₁⟩ := mStackSpine_pop hD hS₀ + obtain ⟨⟨j₂, hj₂, hmaj_eq⟩, hS₂⟩ := mStackSpine_pop hD hS₁ + split_ifs with hmp + · have hmp_step : MIsZFStep pc pd L p1 := + Or.inr (Or.inl ⟨(mUnpair (mPair top stk)).1, + (mUnpair (mUnpair (mPair top stk)).2).1, + j₁, j₂, hj₁, hj₂, hφ_eq.symm, hmaj_eq.symm, hmp.symm⟩) + obtain ⟨pc', pd', hD', hprev, hlast⟩ := mDerivInv_append hD hmp_step + exact ⟨L + 1, pc', pd', depth + 1 - 1 - 1, sc₀, sd₀, hD', + mStackSpine_upgrade hS₂ ⟨1, rfl⟩ hprev, + L, lt_succ_self_pam L, hlast.symm⟩ + · exact ⟨L, pc, pd, depth + 1 - 1 - 1, sc₀, sd₀, hD, hS₂, + 0, lt_of_lt_of_le zero_lt_one_pam hD.1, hD.2.1.symm⟩ + · -- Clause 17: `GEN` (Generalization) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + rcases hInv with ⟨L, pc, pd, depth, sc, sd, hD, hS, j₀, hj₀, htop⟩ + obtain ⟨sc₀, sd₀, hS₀⟩ := mStackSpine_push hS hj₀ htop + obtain ⟨⟨j₁, hj₁, hφ_eq⟩, hS₁⟩ := mStackSpine_pop hD hS₀ + have hgen_step : MIsZFStep pc pd L (mZfAll p1 (mUnpair (mPair top stk)).1) := + Or.inr (Or.inr ⟨p1, (mUnpair (mPair top stk)).1, j₁, hj₁, hφ_eq.symm, rfl⟩) + obtain ⟨pc', pd', hD', hprev, hlast⟩ := mDerivInv_append hD hgen_step + exact ⟨L + 1, pc', pd', depth + 1 - 1, sc₀, sd₀, hD', + mStackSpine_upgrade hS₁ ⟨1, rfl⟩ hprev, + L, lt_succ_self_pam L, hlast.symm⟩ + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨p1, p2, p3, rfl⟩))))))) + · simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inl ⟨p1, p2, rfl⟩)))))))) + · have hne : ∀ (n : ℕ), n < 20 → ac ≠ (n : PAM M) := + fun n hn heq ↦ not_lt_of_ge hge20 (heq ▸ natCast_lt_iff.mpr hn) + unfold mZf393ClauseDispatch + simp only [hne 0 (by decide), hne 1 (by decide), hne 2 (by decide), hne 3 (by decide), + hne 4 (by decide), hne 5 (by decide), hne 6 (by decide), hne 7 (by decide), + hne 8 (by decide), hne 9 (by decide), hne 10 (by decide), hne 11 (by decide), + hne 12 (by decide), hne 13 (by decide), hne 14 (by decide), hne 15 (by decide), + hne 16 (by decide), hne 17 (by decide), hne 18 (by decide), hne 19 (by decide), + ↓reduceIte] + exact hax_step (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr + (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr rfl)))))))))))))))) + +theorem mZf393MainNext_preserves_inv {c : MZfMainCfg M} + (hInv : MStackProofInv c.topwff c.wffstack) : + MStackProofInv (mZf393MainNext c).topwff (mZf393MainNext c).wffstack := by + unfold mZf393MainNext + exact mZf393ClauseDispatch_preserves_inv hInv _ _ _ _ + +/-- **Internalized Soundness**: if `zf393`'s `main()` loop halts in `PAM M`, then +`MZFInconsistent M` holds. -/ +theorem mZfInconsistent_of_mZf393MainHalts (hHalts : MZf393MainHalts M) : + MZFInconsistent M := by + rcases hHalts with ⟨N, c_end, ⟨tc, td, h0, hstep, hN⟩, hnone⟩ + have hdef : PADef1 (fun k : PAM M ↦ k ≤ N → + MStackProofInv (mUnpackMainCfg (mBeta tc td k)).topwff + (mUnpackMainCfg (mBeta tc td k)).wffstack) := by + have hz : PAFunN 1 (fun a : Fin 1 → PAM M ↦ mBeta tc td (a 0)) := + paFun_mBeta (paFun_const tc) (paFun_const td) (paFun_proj 0) + have htop : PAFunN 1 (fun a : Fin 1 → PAM M ↦ (mUnpackMainCfg (mBeta tc td (a 0))).topwff) := + paFun_mUnpair_fst (paFun_mUnpair_snd (paFun_mUnpair_snd hz)) + have hstk : PAFunN 1 (fun a : Fin 1 → PAM M ↦ (mUnpackMainCfg (mBeta tc td (a 0))).wffstack) := + paFun_mUnpair_snd (paFun_mUnpair_snd (paFun_mUnpair_snd hz)) + exact paDef_imp (paDef_le (paFun_proj 0) (paFun_const N)) (paDef_mStackProofInv htop hstk) + have hinv_end := ind1 hdef + (fun _ ↦ by + rw [h0, mUnpackMainCfg_mPackMainCfg] + exact mStackProofInv_init) + (fun k ih hk1 ↦ by + have hklt : k < N := hk1 + have hst := hstep k hklt + obtain ⟨_, heq⟩ := mZf393MainStep_eq_some_iff.mp hst + rw [heq] + exact mZf393MainNext_preserves_inv (ih (le_of_lt hklt))) + N le_rfl + rw [hN, mUnpackMainCfg_mPackMainCfg] at hinv_end + have hinv_next := mZf393MainNext_preserves_inv hinv_end + unfold mZf393MainStep at hnone + split_ifs at hnone with htop1 + rcases hinv_next with ⟨L, pc, pd, _, _, _, ⟨_, _, hsteps⟩, _, j, hj, htop_j⟩ + refine ⟨j, pc, pd, fun i hi ↦ hsteps i (lt_of_le_of_lt hi hj), ?_⟩ + rw [← htop_j, htop1, mZfMem_zero_zero] + +/-! ## Section 3: Completeness (`mZf393MainHalts_of_mZfInconsistent`) -/ + +/-- Pack a 4-tuple `(ac, p1, p2, p3)` into a single element of `PAM M`. -/ +noncomputable def mPackInstr (ac p1 p2 p3 : PAM M) : PAM M := + mPair ac (mPair p1 (mPair p2 p3)) + +/-- Execute one packed 4-tuple instruction `s` on `(top, stk)`. -/ +noncomputable def mExecInstr (s top stk : PAM M) : PAM M × PAM M := + let u1 := mUnpair s + let u2 := mUnpair u1.2 + let u3 := mUnpair u2.2 + mZf393ClauseDispatch top stk u1.1 u2.1 u3.1 u3.2 + +@[simp] +theorem mExecInstr_mPackInstr (ac p1 p2 p3 top stk : PAM M) : + mExecInstr (mPackInstr ac p1 p2 p3) top stk = + mZf393ClauseDispatch top stk ac p1 p2 p3 := by + simp [mExecInstr, mPackInstr] + +theorem paFun_mExecInstr {k : ℕ} {fs ftop fstk : (Fin k → PAM M) → PAM M} + (hs : PAFunN k fs) (htop : PAFunN k ftop) (hstk : PAFunN k fstk) : + PAFunN k (fun u ↦ (mExecInstr (fs u) (ftop u) (fstk u)).1) ∧ + PAFunN k (fun u ↦ (mExecInstr (fs u) (ftop u) (fstk u)).2) := by + have hac := paFun_mUnpair_fst hs + have hu1 := paFun_mUnpair_snd hs + have hp1 := paFun_mUnpair_fst hu1 + have hu2 := paFun_mUnpair_snd hu1 + have hp2 := paFun_mUnpair_fst hu2 + have hp3 := paFun_mUnpair_snd hu2 + exact paFun_mZf393ClauseDispatch htop hstk hac hp1 hp2 hp3 + +/-- $\beta$-coded execution of instruction sequence `(len, lc, ld)` from `(top₀, stk₀)` to +`(top₁, stk₁)`. -/ +def MInstrSeqExec (len lc ld top₀ stk₀ top₁ stk₁ : PAM M) : Prop := + ∃ ec ed : PAM M, + mBeta ec ed 0 = mPair top₀ stk₀ ∧ + (∀ k < len, + let p := mUnpair (mBeta ec ed k) + let p' := mExecInstr (mBeta lc ld k) p.1 p.2 + mBeta ec ed (k + 1) = mPair p'.1 p'.2) ∧ + mBeta ec ed len = mPair top₁ stk₁ + +theorem paDef_mInstrSeqExec {n : ℕ} + {flen flc fld ftop₀ fstk₀ ftop₁ fstk₁ : (Fin n → PAM M) → PAM M} + (hlen : PAFunN n flen) (hlc : PAFunN n flc) (hld : PAFunN n fld) + (htop₀ : PAFunN n ftop₀) (hstk₀ : PAFunN n fstk₀) + (htop₁ : PAFunN n ftop₁) (hstk₁ : PAFunN n fstk₁) : + PADefN n (fun u ↦ + MInstrSeqExec (flen u) (flc u) (fld u) (ftop₀ u) (fstk₀ u) (ftop₁ u) (fstk₁ u)) := by + let fec : (Fin (n + 2) → PAM M) → PAM M := fun v ↦ (Fin.init v) (Fin.last n) + let fed : (Fin (n + 2) → PAM M) → PAM M := fun v ↦ v (Fin.last (n + 1)) + have hec : PAFunN (n + 2) fec := paFun_weaken (paFun_proj (Fin.last n)) + have hed : PAFunN (n + 2) fed := paFun_proj (Fin.last (n + 1)) + have hlen2 := paFun_weaken (paFun_weaken hlen) + have hlc2 := paFun_weaken (paFun_weaken hlc) + have hld2 := paFun_weaken (paFun_weaken hld) + have htop₀2 := paFun_weaken (paFun_weaken htop₀) + have hstk₀2 := paFun_weaken (paFun_weaken hstk₀) + have htop₁2 := paFun_weaken (paFun_weaken htop₁) + have hstk₁2 := paFun_weaken (paFun_weaken hstk₁) + have h0 : PADefN (n + 2) (fun v ↦ + mBeta (fec v) (fed v) 0 = + mPair (ftop₀ (Fin.init (Fin.init v))) (fstk₀ (Fin.init (Fin.init v)))) := + paDef_eq (paFun_mBeta hec hed (paFun_const 0)) (paFun_mPair htop₀2 hstk₀2) + have hlast : PADefN (n + 2) (fun v ↦ + mBeta (fec v) (fed v) (flen (Fin.init (Fin.init v))) = + mPair (ftop₁ (Fin.init (Fin.init v))) (fstk₁ (Fin.init (Fin.init v)))) := + paDef_eq (paFun_mBeta hec hed hlen2) (paFun_mPair htop₁2 hstk₁2) + have hstep : PADefN (n + 2) (fun v ↦ + ∀ k < flen (Fin.init (Fin.init v)), + let p := mUnpair (mBeta (fec v) (fed v) k) + let p' := mExecInstr (mBeta (flc (Fin.init (Fin.init v))) (fld (Fin.init (Fin.init v))) k) + p.1 p.2 + mBeta (fec v) (fed v) (k + 1) = mPair p'.1 p'.2) := by + have hk3 : PAFunN (n + 3) (fun w ↦ w (Fin.last (n + 2))) := + paFun_proj (M := M) (Fin.last (n + 2)) + have hec3 := paFun_weaken hec + have hed3 := paFun_weaken hed + have hlc3 := paFun_weaken hlc2 + have hld3 := paFun_weaken hld2 + have hlen3 := paFun_weaken hlen2 + have hbk := paFun_mBeta hec3 hed3 hk3 + have hbk1 := paFun_mBeta hec3 hed3 (paFun_add hk3 (paFun_const 1)) + have hlck := paFun_mBeta hlc3 hld3 hk3 + obtain ⟨hex1, hex2⟩ := + paFun_mExecInstr hlck (paFun_mUnpair_fst hbk) (paFun_mUnpair_snd hbk) + refine paDefN_congr (fun v ↦ ?_) + (paDef_all (paDef_imp (paDef_lt hk3 hlen3) (paDef_eq hbk1 (paFun_mPair hex1 hex2)))) + simp only [Fin.init_snoc, Fin.snoc_last] + refine paDefN_congr (fun u ↦ ?_) (paDef_ex (paDef_ex (paDef_and h0 (paDef_and hstep hlast)))) + simp only [MInstrSeqExec, fec, fed, Fin.init_snoc, Fin.snoc_last] + +theorem mInstrSeqExec_singleton (s top₀ stk₀ : PAM M) : + MInstrSeqExec 1 s (s + 1) top₀ stk₀ + (mExecInstr s top₀ stk₀).1 (mExecInstr s top₀ stk₀).2 := by + let p₀ := mPair top₀ stk₀ + let p₁ := mPair (mExecInstr s top₀ stk₀).1 (mExecInstr s top₀ stk₀).2 + obtain ⟨ec, ed, hprev, hlast⟩ := mBeta_snoc 1 p₀ (p₀ + 1) p₁ + refine ⟨ec, ed, (hprev 0 zero_lt_one_pam).trans (mBeta_singleton p₀), ?_, hlast⟩ + intro k hk + have hk0 : k = 0 := le_zero_iff_pam.mp (lt_add_one_iff_le.mp (by simpa using hk)) + subst hk0 + dsimp only + rw [zero_add, hlast, hprev 0 zero_lt_one_pam, mBeta_singleton p₀, mBeta_singleton s, + mUnpair_mPair] + +theorem mInstrSeqExec_concat {len₁ lc₁ ld₁ len₂ lc₂ ld₂ : PAM M} + (hlen₂ : 1 ≤ len₂) : + ∃ lc ld : PAM M, + ∀ {top₀ stk₀ top₁ stk₁ top₂ stk₂ : PAM M}, + MInstrSeqExec len₁ lc₁ ld₁ top₀ stk₀ top₁ stk₁ → + MInstrSeqExec len₂ lc₂ ld₂ top₁ stk₁ top₂ stk₂ → + MInstrSeqExec (len₁ + len₂) lc ld top₀ stk₀ top₂ stk₂ := by + obtain ⟨lc, ld, hlc_l, hlc_r⟩ := mBeta_concat len₁ lc₁ ld₁ len₂ lc₂ ld₂ + refine ⟨lc, ld, ?_⟩ + rintro top₀ stk₀ top₁ stk₁ top₂ stk₂ ⟨ec₁, ed₁, he0₁, hest₁, hel₁⟩ ⟨ec₂, ed₂, he0₂, hest₂, hel₂⟩ + obtain ⟨m₂, rfl⟩ : ∃ m₂ : PAM M, len₂ = m₂ + 1 := by + rcases eq_zero_or_exists_succ len₂ with rfl | ⟨m₂, rfl⟩ + · exact absurd hlen₂ (not_le_of_gt zero_lt_one_pam) + · exact ⟨m₂, rfl⟩ + obtain ⟨ec, ed, he_l, he_r⟩ := mBeta_concat len₁ ec₁ ed₁ (m₂ + 1 + 1) ec₂ ed₂ + refine ⟨ec, ed, ?_, ?_, ?_⟩ + · rcases eq_zero_or_exists_succ len₁ with rfl | ⟨m₁, rfl⟩ + · have h0 := he_r 0 ⟨m₂ + 1, by ring⟩ + rw [zero_add] at h0 + exact h0.trans (he0₂.trans (hel₁.symm.trans he0₁)) + · exact (he_l 0 ⟨m₁, by ring⟩).trans he0₁ + · intro i hi + dsimp only + rcases lt_or_ge i len₁ with hilt | hige + · rw [hlc_l i hilt, he_l i hilt] + rcases lt_or_eq_of_le (show i + 1 ≤ len₁ from hilt) with hilt1 | hi1_eq + · rw [he_l (i + 1) hilt1] + exact hest₁ i hilt + · have hst_i := hest₁ i hilt + dsimp only at hst_i + rw [hi1_eq] at hst_i ⊢ + have h0 := he_r 0 ⟨m₂ + 1, by ring⟩ + rw [add_zero] at h0 + rw [h0, he0₂, ← hel₁] + exact hst_i + · let j := i - len₁ + have hij : len₁ + j = i := add_sub_of_le_pam hige + have hjlt : j < m₂ + 1 := by + rcases hi with ⟨w, hw⟩ + exact ⟨w, (add_left_inj_pam len₁).mp (by + calc len₁ + (j + 1 + w) + _ = (len₁ + j) + 1 + w := by ring + _ = i + 1 + w := by rw [hij] + _ = len₁ + (m₂ + 1) := hw)⟩ + have hij1 : i + 1 = len₁ + (j + 1) := by rw [← hij]; ring + rw [← hij, hlc_r j hjlt, he_r j (lt_trans hjlt (lt_succ_self_pam (m₂ + 1))), hij, + hij1, he_r (j + 1) (add_lt_add_right_pam hjlt 1)] + exact hest₂ j hjlt + · exact (he_r (m₂ + 1) (lt_succ_self_pam (m₂ + 1))).trans hel₂ + +private theorem mInstrSeq_of_axiom {w : PAM M} (hax : MIsZFAxiom w) : + ∃ len lc ld : PAM M, + 1 ≤ len ∧ ∀ top stk : PAM M, MInstrSeqExec len lc ld top stk w (mPair top stk) := by + have single : ∀ ac p1 p2 p3 : PAM M, + (∀ top stk : PAM M, mZf393ClauseDispatch top stk ac p1 p2 p3 = (w, mPair top stk)) → + ∃ len lc ld : PAM M, + 1 ≤ len ∧ ∀ top stk : PAM M, MInstrSeqExec len lc ld top stk w (mPair top stk) := by + intro ac p1 p2 p3 hev + let s := mPackInstr ac p1 p2 p3 + refine ⟨1, s, s + 1, le_rfl, fun top stk ↦ ?_⟩ + have h := mInstrSeqExec_singleton s top stk + dsimp only [s] at h + rw [mExecInstr_mPackInstr, hev top stk] at h + exact h + rcases hax with rfl | ⟨φ, ψ, χ, rfl⟩ | ⟨φ, rfl⟩ | ⟨φ, ψ, rfl⟩ | ⟨x, φ, ψ, rfl⟩ | + ⟨x, y, z, hxz, hzy, rfl⟩ | ⟨x, y, φ, rfl⟩ | ⟨x, φ, rfl⟩ | ⟨x, y, rfl⟩ | + ⟨x, y, z, rfl⟩ | ⟨x, y, z, rfl⟩ | ⟨x, y, z, rfl⟩ | rfl | ⟨φ, rfl⟩ | rfl | rfl | rfl + · refine single ((0 : ℕ) : PAM M) 0 0 0 (fun top stk ↦ ?_) + simp [mZf393ClauseDispatch] + · refine single ((14 : ℕ) : PAM M) φ ψ χ (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((3 : ℕ) : PAM M) φ 0 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((5 : ℕ) : PAM M) φ ψ 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((10 : ℕ) : PAM M) x φ ψ (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((7 : ℕ) : PAM M) x y z (fun top stk ↦ ?_) + have hcond : ¬ (x = z ∨ y = z) := not_or.mpr ⟨hxz, Ne.symm hzy⟩ + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, hcond, ↓reduceIte] + · refine single ((8 : ℕ) : PAM M) x y φ (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((19 : ℕ) : PAM M) x φ 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((9 : ℕ) : PAM M) x y 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((11 : ℕ) : PAM M) x y z (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((6 : ℕ) : PAM M) x y z (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((13 : ℕ) : PAM M) x y z (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((15 : ℕ) : PAM M) 0 0 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((1 : ℕ) : PAM M) φ 0 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((2 : ℕ) : PAM M) 0 0 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((4 : ℕ) : PAM M) 0 0 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + · refine single ((20 : ℕ) : PAM M) 0 0 0 (fun top stk ↦ ?_) + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, ↓reduceIte] + +theorem exists_mInstrSeq_of_mZfInconsistent (hInc : MZFInconsistent M) : + ∃ m lc ld : PAM M, + ∀ top stk : PAM M, MInstrSeqExec (m + 1) lc ld top stk 1 (mPair top stk) := by + rcases hInc with ⟨n_prf, pc, pd, hsteps, hgoal⟩ + have hdef : PADef1 (fun i : PAM M ↦ i ≤ n_prf → + ∃ len lc ld : PAM M, + 1 ≤ len ∧ + ∀ top stk : PAM M, MInstrSeqExec len lc ld top stk (mBeta pc pd i) (mPair top stk)) := by + let flen : (Fin 4 → PAM M) → PAM M := + fun v ↦ (Fin.init (Fin.init v)) (Fin.last 1) + let flc : (Fin 4 → PAM M) → PAM M := + fun v ↦ (Fin.init v) (Fin.last 2) + let fld : (Fin 4 → PAM M) → PAM M := + fun v ↦ v (Fin.last 3) + have hlen4 : PAFunN 4 flen := paFun_weaken (paFun_weaken (paFun_proj (M := M) (Fin.last 1))) + have hlc4 : PAFunN 4 flc := paFun_weaken (paFun_proj (M := M) (Fin.last 2)) + have fld4 : PAFunN 4 fld := paFun_proj (M := M) (Fin.last 3) + have hi6 : PAFunN 6 (fun w ↦ + (Fin.init (Fin.init (Fin.init (Fin.init (Fin.init w))))) 0) := + paFun_weaken (paFun_weaken (paFun_weaken + (paFun_weaken (paFun_weaken (paFun_proj (M := M) 0))))) + have htop6 : PAFunN 6 (fun w ↦ (Fin.init w) (Fin.last 4)) := + paFun_weaken (paFun_proj (M := M) (Fin.last 4)) + have hstk6 : PAFunN 6 (fun w ↦ w (Fin.last 5)) := + paFun_proj (M := M) (Fin.last 5) + have hexec6 := paDef_mInstrSeqExec + (paFun_weaken (paFun_weaken hlen4)) + (paFun_weaken (paFun_weaken hlc4)) + (paFun_weaken (paFun_weaken fld4)) + htop6 hstk6 + (paFun_mBeta (paFun_const pc) (paFun_const pd) hi6) + (paFun_mPair htop6 hstk6) + have hall4 : PADefN 4 (fun v ↦ ∀ top stk : PAM M, + MInstrSeqExec (flen v) (flc v) (fld v) top stk + (mBeta pc pd ((Fin.init (Fin.init (Fin.init v))) 0)) (mPair top stk)) := by + refine paDefN_congr (fun v ↦ ?_) (paDef_all (paDef_all hexec6)) + simp only [Fin.init_snoc, Fin.snoc_last] + have hex1 : PADefN 1 (fun a ↦ ∃ len lc ld : PAM M, + 1 ≤ len ∧ + ∀ top stk : PAM M, + MInstrSeqExec len lc ld top stk (mBeta pc pd (a 0)) (mPair top stk)) := by + refine paDefN_congr (fun a ↦ ?_) + (paDef_ex (paDef_ex (paDef_ex + (paDef_and (paDef_le (paFun_const 1) hlen4) hall4)))) + simp only [flen, flc, fld, Fin.init_snoc, Fin.snoc_last] + exact paDef_imp (paDef_le (paFun_proj 0) (paFun_const n_prf)) hex1 + have hall := strong_ind1 hdef (fun i ih hi ↦ ?_) + · obtain ⟨len, lc, ld, h1len, hexec⟩ := hall n_prf le_rfl + rw [hgoal, mZfMem_zero_zero] at hexec + rcases eq_zero_or_exists_succ len with rfl | ⟨m, rfl⟩ + · exact absurd h1len (not_le_of_gt zero_lt_one_pam) + · exact ⟨m, lc, ld, hexec⟩ + · rcases hsteps i hi with hax | ⟨φ, χ, j₁, j₂, hj₁, hj₂, hb₁, hb₂, hχ⟩ | ⟨x, φ, j, hj, hbj, hw⟩ + · exact mInstrSeq_of_axiom hax + · obtain ⟨len₂, lc₂, ld₂, h1₂, hex₂⟩ := ih j₂ hj₂ (le_trans (le_of_lt hj₂) hi) + obtain ⟨len₁, lc₁, ld₁, h1₁, hex₁⟩ := ih j₁ hj₁ (le_trans (le_of_lt hj₁) hi) + rw [hb₂, hχ] at hex₂ + rw [hb₁] at hex₁ + obtain ⟨lc₁₂, ld₁₂, hcat₁₂⟩ := mInstrSeqExec_concat (lc₁ := lc₂) (ld₁ := ld₂) h1₁ + let s_mp := mPackInstr ((16 : ℕ) : PAM M) (mBeta pc pd i) 0 0 + obtain ⟨lc', ld', hcat'⟩ := + mInstrSeqExec_concat (len₁ := len₂ + len₁) (lc₁ := lc₁₂) (ld₁ := ld₁₂) + (len₂ := 1) (lc₂ := s_mp) (ld₂ := s_mp + 1) le_rfl + refine ⟨len₂ + len₁ + 1, lc', ld', le_trans h1₂ ⟨len₁ + 1, by ring⟩, fun top stk ↦ ?_⟩ + have hstep_mp : MInstrSeqExec 1 s_mp (s_mp + 1) + φ (mPair (mZfImp φ (mBeta pc pd i)) (mPair top stk)) + (mBeta pc pd i) (mPair top stk) := by + have h := mInstrSeqExec_singleton s_mp φ + (mPair (mZfImp φ (mBeta pc pd i)) (mPair top stk)) + dsimp only [s_mp] at h + rw [mExecInstr_mPackInstr] at h + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, + mUnpair_mPair, ↓reduceIte] at h + exact h + exact hcat' (hcat₁₂ (hex₂ top stk) (hex₁ _ _)) hstep_mp + · obtain ⟨len₁, lc₁, ld₁, h1₁, hex₁⟩ := ih j hj (le_trans (le_of_lt hj) hi) + rw [hbj] at hex₁ + let s_gen := mPackInstr ((17 : ℕ) : PAM M) x 0 0 + obtain ⟨lc', ld', hcat'⟩ := + mInstrSeqExec_concat (len₁ := len₁) (lc₁ := lc₁) (ld₁ := ld₁) + (len₂ := 1) (lc₂ := s_gen) (ld₂ := s_gen + 1) le_rfl + refine ⟨len₁ + 1, lc', ld', le_trans h1₁ ⟨1, rfl⟩, fun top stk ↦ ?_⟩ + have hstep_gen : MInstrSeqExec 1 s_gen (s_gen + 1) + φ (mPair top stk) (mBeta pc pd i) (mPair top stk) := by + have h := mInstrSeqExec_singleton s_gen φ (mPair top stk) + dsimp only [s_gen] at h + rw [mExecInstr_mPackInstr] at h + simp only [mZf393ClauseDispatch, natCast_inj_pam, Nat.reduceEqDiff, + mUnpair_mPair, ↓reduceIte, ← hw] at h + exact h + exact hcat' (hex₁ top stk) hstep_gen + +/-- Prepend a packed 4-tuple instruction `s` onto a Cantor-paired `prooflist` code `rest`. -/ +noncomputable def mPackProofStep (s rest : PAM M) : PAM M := + let u1 := mUnpair s + let u2 := mUnpair u1.2 + let u3 := mUnpair u2.2 + mPair u1.1 (mPair u2.1 (mPair u3.1 (mPair u3.2 rest))) + 1 + +theorem paFun_mPackProofStep {k : ℕ} {fs frest : (Fin k → PAM M) → PAM M} + (hs : PAFunN k fs) (hrest : PAFunN k frest) : + PAFunN k (fun u ↦ mPackProofStep (fs u) (frest u)) := by + have hu1 := paFun_mUnpair_snd hs + have hu2 := paFun_mUnpair_snd hu1 + exact paFun_add + (paFun_mPair (paFun_mUnpair_fst hs) + (paFun_mPair (paFun_mUnpair_fst hu1) + (paFun_mPair (paFun_mUnpair_fst hu2) + (paFun_mPair (paFun_mUnpair_snd hu2) hrest)))) + (paFun_const 1) + +theorem mZf393MainNext_mPackProofStep (s rest np top stk : PAM M) : + mZf393MainNext ⟨mPackProofStep s rest, np, top, stk⟩ = + ⟨rest, np, (mExecInstr s top stk).1, (mExecInstr s top stk).2⟩ := by + have hne : mPackProofStep s rest ≠ 0 := add_one_ne_zero_pam _ + simp only [mZf393MainNext, hne, ↓reduceIte] + unfold mPackProofStep mExecInstr + rw [add_one_sub_one_pam] + simp only [mUnpair_mPair] + +theorem mZf393MainNext_zero_prooflist (P top stk : PAM M) : + mZf393MainNext ⟨0, P, top, stk⟩ = mZf393MainNext ⟨P + 1, P + 1, top, stk⟩ := by + simp [mZf393MainNext] + +theorem mZf393MainNext_prooflist_lt {c : MZfMainCfg M} {pl' : PAM M} + (hpl : c.prooflist = pl' + 1) : + (mZf393MainNext c).prooflist < c.prooflist ∧ + (mZf393MainNext c).nextproof = c.nextproof := by + rw [mZf393MainNext] + simp only [hpl, add_one_ne_zero_pam, ↓reduceIte, add_one_sub_one_pam] + have hle : (mUnpair (mUnpair (mUnpair (mUnpair pl').2).2).2).2 ≤ pl' := + le_trans (mUnpair_snd_le _) + (le_trans (mUnpair_snd_le _) (le_trans (mUnpair_snd_le _) (mUnpair_snd_le _))) + exact ⟨lt_of_le_of_lt hle (lt_succ_self_pam pl'), trivial⟩ + +/-- Fold instructions `mBeta lc ld 0 .. mBeta lc ld m` from right to left into a $\beta$-coded +`prooflist` suffix table `(fc, fd)` with `plSuffix k = mBeta fc fd (m + 1 - k)`. -/ +theorem exists_mProofListSuffix (m lc ld : PAM M) : + ∃ fc fd : PAM M, + mBeta fc fd 0 = 0 ∧ + ∀ k ≤ m, mBeta fc fd (m + 1 - k) = + mPackProofStep (mBeta lc ld k) (mBeta fc fd (m - k)) := by + have hdef : PADef1 (fun r : PAM M ↦ r ≤ m + 1 → + ∃ fc fd : PAM M, + mBeta fc fd 0 = 0 ∧ + ∀ j < r, mBeta fc fd (j + 1) = + mPackProofStep (mBeta lc ld (m - j)) (mBeta fc fd j)) := by + let ffc : (Fin 3 → PAM M) → PAM M := fun v ↦ (Fin.init v) (Fin.last 1) + let ffd : (Fin 3 → PAM M) → PAM M := fun v ↦ v (Fin.last 2) + have hfc : PAFunN 3 ffc := paFun_weaken (paFun_proj (Fin.last 1)) + have hfd : PAFunN 3 ffd := paFun_proj (Fin.last 2) + have h0 : PADefN 3 (fun v ↦ mBeta (ffc v) (ffd v) 0 = 0) := + paDef_eq (paFun_mBeta hfc hfd (paFun_const 0)) (paFun_const 0) + have hstep : PADefN 3 (fun v ↦ + ∀ j < (Fin.init (Fin.init v)) 0, + mBeta (ffc v) (ffd v) (j + 1) = + mPackProofStep (mBeta lc ld (m - j)) (mBeta (ffc v) (ffd v) j)) := by + have hj4 : PAFunN 4 (fun w ↦ w (Fin.last 3)) := paFun_proj (M := M) (Fin.last 3) + have hr4 : PAFunN 4 (fun w ↦ (Fin.init (Fin.init (Fin.init w))) 0) := + paFun_weaken (paFun_weaken (paFun_weaken (paFun_proj (M := M) 0))) + have hfc4 := paFun_weaken hfc + have hfd4 := paFun_weaken hfd + refine paDefN_congr (fun v ↦ ?_) + (paDef_all (paDef_imp (paDef_lt hj4 hr4) + (paDef_eq + (paFun_mBeta hfc4 hfd4 (paFun_add hj4 (paFun_const 1))) + (paFun_mPackProofStep + (paFun_mBeta (paFun_const lc) (paFun_const ld) (paFun_sub (paFun_const m) hj4)) + (paFun_mBeta hfc4 hfd4 hj4))))) + simp only [Fin.init_snoc, Fin.snoc_last] + have hex1 : PADefN 1 (fun a ↦ ∃ fc fd : PAM M, + mBeta fc fd 0 = 0 ∧ + ∀ j < a 0, mBeta fc fd (j + 1) = + mPackProofStep (mBeta lc ld (m - j)) (mBeta fc fd j)) := by + refine paDefN_congr (fun a ↦ ?_) (paDef_ex (paDef_ex (paDef_and h0 hstep))) + simp only [ffc, ffd, Fin.init_snoc, Fin.snoc_last] + exact paDef_imp (paDef_le (paFun_proj 0) (paFun_const (m + 1))) hex1 + obtain ⟨fc, fd, h0, hstep⟩ := ind1 hdef + (fun _ ↦ ⟨0, 0 + 1, mBeta_singleton 0, fun _ hj ↦ absurd hj (not_lt_zero_pam _)⟩) + (fun r ih hr1 ↦ by + have hrlt : r < m + 1 := hr1 + obtain ⟨fc₀, fd₀, h0₀, hst₀⟩ := ih (le_of_lt hrlt) + obtain ⟨fc', fd', hprev, hlast⟩ := + mBeta_snoc (r + 1) fc₀ fd₀ (mPackProofStep (mBeta lc ld (m - r)) (mBeta fc₀ fd₀ r)) + refine ⟨fc', fd', (hprev 0 ⟨r, by ring⟩).trans h0₀, fun j hj ↦ ?_⟩ + rcases le_iff_lt_or_eq.mp (lt_add_one_iff_le.mp hj) with hjlt | rfl + · rw [hprev (j + 1) (add_lt_add_right_pam hjlt 1), + hprev j (lt_trans hjlt (lt_succ_self_pam r)), hst₀ j hjlt] + · rw [hlast, hprev j (lt_succ_self_pam j)]) + (m + 1) le_rfl + refine ⟨fc, fd, h0, fun k hk ↦ ?_⟩ + let r := m - k + have hkr : k + r = m := add_sub_of_le_pam hk + have hrlt : r < m + 1 := ⟨k, by rw [← hkr]; ring⟩ + have hm1k : m + 1 - k = r + 1 := + (sub_eq_iff_eq_add_pam (le_trans hk ⟨1, rfl⟩)).mpr (by rw [← hkr]; ring) + have hmr : m - r = k := + (sub_eq_iff_eq_add_pam ⟨k, by rw [← hkr]; ring⟩).mpr (by rw [← hkr]; ring) + rw [hm1k] + have h := hstep r hrlt + rwa [hmr] at h + +private theorem mStep_of_not_halts {n : PAM M} {c : MZfMainCfg M} + (hno : ¬ MZf393MainHalts M) (htr : mMainTracesTo n mZfMainInit c) : + mZf393MainStep c = some (mZf393MainNext c) := by + rcases hs : mZf393MainStep c with _ | c' + · exact False.elim (hno ⟨n, c, htr, hs⟩) + · obtain ⟨_, heq⟩ := mZf393MainStep_eq_some_iff.mp hs + exact congrArg some heq + +private theorem mDrain_prooflist (hno : ¬ MZf393MainHalts M) (pl : PAM M) : + ∀ {n : PAM M} {c : MZfMainCfg M}, + mMainTracesTo n mZfMainInit c → + c.prooflist = pl → + ∃ (m : PAM M) (c' : MZfMainCfg M), + mMainTracesTo m mZfMainInit c' ∧ c'.prooflist = 0 ∧ c'.nextproof = c.nextproof := by + have hdef : PADef1 (fun p : PAM M ↦ + ∀ n z : PAM M, + mMainTracesTo n mZfMainInit (mUnpackMainCfg z) → + (mUnpackMainCfg z).prooflist = p → + ∃ m z' : PAM M, + mMainTracesTo m mZfMainInit (mUnpackMainCfg z') ∧ + (mUnpackMainCfg z').prooflist = 0 ∧ + (mUnpackMainCfg z').nextproof = (mUnpackMainCfg z).nextproof) := by + let fp : (Fin 3 → PAM M) → PAM M := fun v ↦ (Fin.init (Fin.init v)) 0 + let fn : (Fin 3 → PAM M) → PAM M := fun v ↦ (Fin.init v) (Fin.last 1) + let fz : (Fin 3 → PAM M) → PAM M := fun v ↦ v (Fin.last 2) + have hp3 : PAFunN 3 fp := paFun_weaken (paFun_weaken (paFun_proj (M := M) 0)) + have hn3 : PAFunN 3 fn := paFun_weaken (paFun_proj (Fin.last 1)) + have hz3 : PAFunN 3 fz := paFun_proj (Fin.last 2) + have htr_in : PADefN 3 (fun v ↦ + mMainTracesTo (fn v) mZfMainInit (mUnpackMainCfg (fz v))) := + paDef_mMainTracesTo hn3 (paFun_const (mPackMainCfg mZfMainInit)) + (paFunN_congr (fun v ↦ (mPackMainCfg_mUnpackMainCfg (fz v)).symm) hz3) + have hpl_in : PADefN 3 (fun v ↦ (mUnpackMainCfg (fz v)).prooflist = fp v) := + paDef_eq (paFun_mUnpair_fst hz3) hp3 + let fm5 : (Fin 5 → PAM M) → PAM M := fun w ↦ (Fin.init w) (Fin.last 3) + let fz'5 : (Fin 5 → PAM M) → PAM M := fun w ↦ w (Fin.last 4) + have hm5 : PAFunN 5 fm5 := paFun_weaken (paFun_proj (Fin.last 3)) + have hz'5 : PAFunN 5 fz'5 := paFun_proj (Fin.last 4) + have hz5 := paFun_weaken (paFun_weaken hz3) + have htr_out : PADefN 5 (fun w ↦ + mMainTracesTo (fm5 w) mZfMainInit (mUnpackMainCfg (fz'5 w))) := + paDef_mMainTracesTo hm5 (paFun_const (mPackMainCfg mZfMainInit)) + (paFunN_congr (fun w ↦ (mPackMainCfg_mUnpackMainCfg (fz'5 w)).symm) hz'5) + have hex3 : PADefN 3 (fun v ↦ ∃ m z' : PAM M, + mMainTracesTo m mZfMainInit (mUnpackMainCfg z') ∧ + (mUnpackMainCfg z').prooflist = 0 ∧ + (mUnpackMainCfg z').nextproof = (mUnpackMainCfg (fz v)).nextproof) := by + refine paDefN_congr (fun v ↦ ?_) + (paDef_ex (paDef_ex + (paDef_and htr_out + (paDef_and + (paDef_eq (paFun_mUnpair_fst hz'5) (paFun_const 0)) + (paDef_eq + (paFun_mUnpair_fst (paFun_mUnpair_snd hz'5)) + (paFun_mUnpair_fst (paFun_mUnpair_snd hz5))))))) + simp only [fm5, fz'5, mUnpackMainCfg, Fin.init_snoc, Fin.snoc_last] + refine paDefN_congr (fun a ↦ ?_) + (paDef_all (paDef_all (paDef_imp htr_in (paDef_imp hpl_in hex3)))) + simp only [fp, fn, fz, Fin.init_snoc, Fin.snoc_last] + have hall := strong_ind1 hdef (fun p ih n z htr hpl ↦ ?_) + · intro n c htr hpl + obtain ⟨m, z', htr', hpl', hnp'⟩ := + hall pl n (mPackMainCfg c) (by rwa [mUnpackMainCfg_mPackMainCfg]) + (by rwa [mUnpackMainCfg_mPackMainCfg]) + rw [mUnpackMainCfg_mPackMainCfg] at hnp' + exact ⟨m, mUnpackMainCfg z', htr', hpl', hnp'⟩ + · rcases eq_zero_or_exists_succ p with rfl | ⟨p', rfl⟩ + · exact ⟨n, z, htr, hpl, rfl⟩ + · have hst := mStep_of_not_halts hno htr + have htr1 := mMainTracesTo_snoc htr hst + obtain ⟨hlt, hnp⟩ := mZf393MainNext_prooflist_lt hpl + obtain ⟨m, z', htr', hpl', hnp'⟩ := + ih (mZf393MainNext (mUnpackMainCfg z)).prooflist (hlt.trans_eq hpl) + (n + 1) (mPackMainCfg (mZf393MainNext (mUnpackMainCfg z))) + (by rwa [mUnpackMainCfg_mPackMainCfg]) + (by rw [mUnpackMainCfg_mPackMainCfg]) + rw [mUnpackMainCfg_mPackMainCfg] at hnp' + exact ⟨m, z', htr', hpl', hnp'.trans hnp⟩ + +private theorem mReaches_nextproof (hno : ¬ MZf393MainHalts M) (N : PAM M) : + ∃ (n : PAM M) (c : MZfMainCfg M), + mMainTracesTo n mZfMainInit c ∧ c.prooflist = 0 ∧ c.nextproof = N := by + have hdef : PADef1 (fun P : PAM M ↦ + ∃ n z : PAM M, + mMainTracesTo n mZfMainInit (mUnpackMainCfg z) ∧ + (mUnpackMainCfg z).prooflist = 0 ∧ + (mUnpackMainCfg z).nextproof = P) := by + let fn : (Fin 3 → PAM M) → PAM M := fun v ↦ (Fin.init v) (Fin.last 1) + let fz : (Fin 3 → PAM M) → PAM M := fun v ↦ v (Fin.last 2) + have hn3 : PAFunN 3 fn := paFun_weaken (paFun_proj (Fin.last 1)) + have hz3 : PAFunN 3 fz := paFun_proj (Fin.last 2) + have hp3 : PAFunN 3 (fun v ↦ (Fin.init (Fin.init v)) 0) := + paFun_weaken (paFun_weaken (paFun_proj (M := M) 0)) + refine paDefN_congr (fun a ↦ ?_) + (paDef_ex (paDef_ex + (paDef_and + (paDef_mMainTracesTo hn3 (paFun_const (mPackMainCfg mZfMainInit)) + (paFunN_congr (fun v ↦ (mPackMainCfg_mUnpackMainCfg (fz v)).symm) hz3)) + (paDef_and + (paDef_eq (paFun_mUnpair_fst hz3) (paFun_const 0)) + (paDef_eq (paFun_mUnpair_fst (paFun_mUnpair_snd hz3)) hp3))))) + simp only [fn, fz, mUnpackMainCfg, Fin.init_snoc, Fin.snoc_last] + obtain ⟨n, z, htr, hpl, hnp⟩ := ind1 hdef + ⟨0, mPackMainCfg mZfMainInit, + by rw [mUnpackMainCfg_mPackMainCfg]; exact mMainTracesTo_zero mZfMainInit, + by rw [mUnpackMainCfg_mPackMainCfg]; rfl, + by rw [mUnpackMainCfg_mPackMainCfg]; rfl⟩ + (fun P ⟨n, z, htr, hpl0, hnp⟩ ↦ by + have hst := mStep_of_not_halts hno htr + have htr1 := mMainTracesTo_snoc htr hst + have hnp_next : (mZf393MainNext (mUnpackMainCfg z)).nextproof = P + 1 := by + simp [mZf393MainNext, hpl0, hnp] + obtain ⟨m, c', htr', hpl', hnp'⟩ := mDrain_prooflist hno _ htr1 rfl + exact ⟨m, mPackMainCfg c', by rwa [mUnpackMainCfg_mPackMainCfg], + by rwa [mUnpackMainCfg_mPackMainCfg], + by rw [mUnpackMainCfg_mPackMainCfg]; exact hnp'.trans hnp_next⟩) + N + exact ⟨n, mUnpackMainCfg z, htr, hpl, hnp⟩ + +/-- **Internalized Completeness**: if `MZFInconsistent M` holds, then `zf393`'s `main()` loop +halts in `PAM M`. -/ +theorem mZf393MainHalts_of_mZfInconsistent (hInc : MZFInconsistent M) : + MZf393MainHalts M := by + by_contra hno + obtain ⟨m, lc, ld, hexec⟩ := exists_mInstrSeq_of_mZfInconsistent hInc + obtain ⟨fc, fd, hfc0, hfc_step⟩ := exists_mProofListSuffix m lc ld + let pl₀ := mBeta fc fd (m + 1) + have hpl₀_eq : pl₀ = mPackProofStep (mBeta lc ld 0) (mBeta fc fd m) := by + simpa [pl₀, sub_zero_pam] using hfc_step 0 (zero_le_pam m) + let P := pl₀ - 1 + have hP1 : P + 1 = pl₀ := by + dsimp only [P] + rw [hpl₀_eq, mPackProofStep, add_one_sub_one_pam] + obtain ⟨n₀, c₀, htr₀, hpl_c₀, hnp_c₀⟩ := mReaches_nextproof hno P + have hc₀_eq : c₀ = ⟨0, P, c₀.topwff, c₀.wffstack⟩ := by + cases c₀; dsimp at hpl_c₀ hnp_c₀; subst hpl_c₀ hnp_c₀; rfl + rw [hc₀_eq] at htr₀ + obtain ⟨ec, ed, he0, hest, hel⟩ := hexec c₀.topwff c₀.wffstack + rcases eq_zero_or_exists_succ m with rfl | ⟨m', rfl⟩ + · -- Single-instruction proof (`m = 0`): step 0 already produces `topwff = 1`. + have hnext : (mZf393MainNext ⟨0, P, c₀.topwff, c₀.wffstack⟩).topwff = 1 := by + rw [mZf393MainNext_zero_prooflist, hP1, hpl₀_eq, mZf393MainNext_mPackProofStep] + have h0 := hest 0 (lt_succ_self_pam 0) + dsimp only at h0 + rw [hel, he0, mUnpair_mPair] at h0 + dsimp only at h0 + exact (mPair_injective h0).1.symm + have hnone : mZf393MainStep ⟨0, P, c₀.topwff, c₀.wffstack⟩ = none := by + simp [mZf393MainStep, hnext] + exact hno ⟨n₀, ⟨0, P, c₀.topwff, c₀.wffstack⟩, htr₀, hnone⟩ + · -- Multi-instruction proof (`m = m' + 1`): step 0 enters `P + 1`, then run up to `k = m' + 1`. + let cfgAt : PAM M → MZfMainCfg M := fun k ↦ + ⟨mBeta fc fd (m' + 1 + 1 - k), P + 1, + (mUnpair (mBeta ec ed k)).1, (mUnpair (mBeta ec ed k)).2⟩ + have hstep0 := mStep_of_not_halts hno htr₀ + have hnext0 : mZf393MainNext ⟨0, P, c₀.topwff, c₀.wffstack⟩ = cfgAt 1 := by + rw [mZf393MainNext_zero_prooflist, hP1, hpl₀_eq, mZf393MainNext_mPackProofStep] + have hsub1 : m' + 1 + 1 - 1 = m' + 1 := add_one_sub_one_pam (m' + 1) + have he1 := hest 0 ⟨m' + 1, by ring⟩ + dsimp only at he1 + rw [zero_add, he0, mUnpair_mPair] at he1 + dsimp only at he1 + dsimp only [cfgAt] + rw [hsub1, he1, mUnpair_mPair, ← hpl₀_eq, hP1] + rw [hnext0] at hstep0 + have htr1 : mMainTracesTo (n₀ + 1) mZfMainInit (cfgAt 1) := mMainTracesTo_snoc htr₀ hstep0 + have hdef : PADef1 (fun k : PAM M ↦ 1 ≤ k → k ≤ m' + 1 → + mMainTracesTo (n₀ + k) mZfMainInit (cfgAt k)) := by + have hk : PAFunN 1 (fun a : Fin 1 → PAM M ↦ a 0) := paFun_proj 0 + have hpl_k := paFun_mBeta (paFun_const fc) (paFun_const fd) + (paFun_sub (paFun_const (m' + 1 + 1)) hk) + have hek := paFun_mBeta (paFun_const ec) (paFun_const ed) hk + have hpack_k : PAFunN 1 (fun a : Fin 1 → PAM M ↦ mPackMainCfg (cfgAt (a 0))) := + paFun_mPair hpl_k + (paFun_mPair (paFun_const (P + 1)) + (paFun_mPair (paFun_mUnpair_fst hek) (paFun_mUnpair_snd hek))) + exact paDef_imp (paDef_le (paFun_const 1) hk) + (paDef_imp (paDef_le hk (paFun_const (m' + 1))) + (paDef_mMainTracesTo (paFun_add (paFun_const n₀) hk) + (paFun_const (mPackMainCfg mZfMainInit)) hpack_k)) + have htr_m := ind1 hdef + (fun h10 _ ↦ absurd h10 (not_le_of_gt zero_lt_one_pam)) + (fun k ih _ hk1_le ↦ by + rcases eq_zero_or_exists_succ k with rfl | ⟨k', rfl⟩ + · simpa using htr1 + · have h1k : 1 ≤ k' + 1 := ⟨k', by ring⟩ + have hkle : k' + 1 ≤ m' + 1 := le_trans ⟨1, rfl⟩ hk1_le + have hk_lt_m : k' + 1 < m' + 1 := hk1_le + have htr_k := ih h1k hkle + have hst_k := mStep_of_not_halts hno htr_k + have hpl_step := hfc_step (k' + 1) hkle + have he_step := hest (k' + 1) (lt_trans hk_lt_m (lt_succ_self_pam (m' + 1))) + dsimp only at he_step + have hsub_eq : m' + 1 - (k' + 1) = m' + 1 + 1 - (k' + 1 + 1) := by + have ⟨d, hd⟩ := hkle + have h1 : m' + 1 - (k' + 1) = d := + (sub_eq_iff_eq_add_pam hkle).mpr (by rw [← hd]) + have h2 : m' + 1 + 1 - (k' + 1 + 1) = d := + (sub_eq_iff_eq_add_pam ⟨d, by rw [← hd]; ring⟩).mpr (by rw [← hd]; ring) + exact h1.trans h2.symm + have hnext_k : mZf393MainNext (cfgAt (k' + 1)) = cfgAt (k' + 1 + 1) := by + dsimp only [cfgAt] + rw [hpl_step, mZf393MainNext_mPackProofStep, hsub_eq, he_step, mUnpair_mPair] + rw [hnext_k] at hst_k + have htr_succ := mMainTracesTo_snoc htr_k hst_k + rwa [add_assoc] at htr_succ) + (m' + 1) ⟨m', by ring⟩ le_rfl + -- Now `cfgAt (m' + 1)` executes the final instruction `m' + 1`, producing `topwff = 1`. + have hpl_last := hfc_step (m' + 1) le_rfl + have he_last := hest (m' + 1) (lt_succ_self_pam (m' + 1)) + dsimp only at he_last + rw [hel] at he_last + have htop_last : (mZf393MainNext (cfgAt (m' + 1))).topwff = 1 := by + dsimp only [cfgAt] + rw [hpl_last, mZf393MainNext_mPackProofStep] + exact (mPair_injective he_last).1.symm + have hnone_last : mZf393MainStep (cfgAt (m' + 1)) = none := by + simp [mZf393MainStep, htop_last] + exact hno ⟨n₀ + (m' + 1), cfgAt (m' + 1), htr_m, hnone_last⟩ + +/-! ## Section 4: Bidirectional Equivalence in `PAM M` and `PAProvable` Main Theorems -/ + +/-- Layer 3 equivalence in `PAM M`: `MZf393MainHalts M ↔ MZFInconsistent M`. -/ +theorem mZf393MainHalts_iff_mZfInconsistent : + MZf393MainHalts M ↔ MZFInconsistent M := + ⟨mZfInconsistent_of_mZf393MainHalts, mZf393MainHalts_of_mZfInconsistent⟩ + +/-- End-to-end equivalence in every first-order `PAModel M`: +`Machines.zf393` halts iff `MZFInconsistent M` holds. -/ +theorem mHalts_zf393_iff_mZfInconsistent : + mHalts M Machines.zf393 ↔ MZFInconsistent M := + ⟨fun h ↦ mZfInconsistent_of_mZf393MainHalts (mZf393MainHalts_of_mHalts_zf393 h), + fun h ↦ mHalts_zf393_of_mZf393MainHalts (mZf393MainHalts_of_mZfInconsistent h)⟩ + +/-- End-to-end equivalence in every first-order `PAModel M`: +`Machines.zf380` halts iff `MZFInconsistent M` holds. -/ +theorem mHalts_zf380_iff_mZfInconsistent : + mHalts M Machines.zf380 ↔ MZFInconsistent M := + mHalts_zf380_iff_zf393.trans mHalts_zf393_iff_mZfInconsistent + +end Model + +/-- **Peano Arithmetic proves `zf_393` halts iff `ZF` is inconsistent** +($\mathrm{PA} \vdash \mathrm{Halts}(\mathtt{zf\_393}) \leftrightarrow + \neg\mathrm{Con}(\mathrm{ZF})$). -/ +theorem paProvable_halts_zf393_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf393).iff paZFInconsistent) := by + rw [paProvable_iff_holdsIn_all_models] + intro M _ _ v + rw [← PAM.holdsIn_iff_raw (fun x ↦ ⟨v x⟩)] + simp only [PAFormula.HoldsIn, paHalts_holdsIn_iff, paZFInconsistent_holdsIn_iff] + exact ⟨(mHalts_zf393_iff_mZfInconsistent (M := M)).mp, + (mHalts_zf393_iff_mZfInconsistent (M := M)).mpr⟩ + +/-- **Peano Arithmetic proves `zf_380` halts iff `ZF` is inconsistent** +($\mathrm{PA} \vdash \mathrm{Halts}(\mathtt{zf\_380}) \leftrightarrow + \neg\mathrm{Con}(\mathrm{ZF})$). -/ +theorem paProvable_halts_zf380_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf380).iff paZFInconsistent) := by + rw [paProvable_iff_holdsIn_all_models] + intro M _ _ v + rw [← PAM.holdsIn_iff_raw (fun x ↦ ⟨v x⟩)] + simp only [PAFormula.HoldsIn, paHalts_holdsIn_iff, paZFInconsistent_holdsIn_iff] + exact ⟨(mHalts_zf380_iff_mZfInconsistent (M := M)).mp, + (mHalts_zf380_iff_mZfInconsistent (M := M)).mpr⟩ + +end ConjectureMachines.Semantics.PA +end diff --git a/Cryptids/Semantics/README.md b/Cryptids/Semantics/README.md index 66e9b0a0..951d4aa8 100644 --- a/Cryptids/Semantics/README.md +++ b/Cryptids/Semantics/README.md @@ -367,7 +367,7 @@ Care is required when interpreting a Lean theorem of type `Halts M ↔ ZFInconsi 3. **Metamathematical scope — Lean's type theory, `PA`/`ZF` internalization, and `ZF`-independence:** Care must also be taken not to conflate a constructive Lean theorem `Halts M ↔ ZFInconsistent` with a formal proof of $\mathrm{ZF}$-independence: - **Strength of constructive Lean (`CIC` vs. `PA`/`ZF`):** Even without `Classical.choice` or Excluded Middle, Lean's Calculus of Inductive Constructions provides constructions absent from first-order $\mathrm{PA}$ and $\mathrm{ZF}$—an impredicative `Prop`, inductive families (`ZFProvable`, `Acc`, `PSet`), and a predicative universe hierarchy `Type u` (already strong enough to validate Zermelo set theory, and whether axiom-free `CIC` itself proves $\operatorname{Con}(\mathrm{ZF})$ remains an open question; see [`digama0/ConZF`](https://github.com/digama0/ConZF)). An axiom check in Lean therefore blocks classical `Con(ZF)` shortcuts, rather than restricting reasoning to $\mathrm{PA}$ or $\mathrm{ZF}$. - - **Internalizing the reduction inside first-order `PA` (`PAProvable`):** Our constructive Lean proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` establish a meta-level correspondence in Lean. To formulate and verify object-level provability inside weak first-order arithmetic—whose consistency strength is strictly below $\mathrm{ZF}$, so it cannot trivialize $\operatorname{Con}(\mathrm{ZF})$—Section 6 ([`Cryptids/Semantics/PA/`](./PA/)) deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`), proves constructive consistency (`not_paProvable_false : ¬ PAProvable .bot`), proves constructive standard-model adequacy of the $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), and proves Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`) so that object-level `PAProvable` theorems reduce to semantic reasoning in an arbitrary `[PAModel M]`. + - **Internalizing the reduction inside first-order `PA` (`PAProvable`):** Our constructive Lean proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` establish a meta-level correspondence in Lean. To formulate and verify object-level provability inside weak first-order arithmetic—whose consistency strength is strictly below $\mathrm{ZF}$, so it cannot trivialize $\operatorname{Con}(\mathrm{ZF})$—Section 6 ([`Cryptids/Semantics/PA/`](./PA/)) deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`), proves constructive consistency (`not_paProvable_false : ¬ PAProvable .bot`), proves constructive standard-model adequacy of the $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), proves Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`), and internalizes the entire Layer 1–3 verification of `zf_393` and `zf_380` inside `PAProvable` (`paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, and `paProvable_halts_zf380_iff_zfInconsistent`). - **Assumptions required for both directions of `ZF`-independence:** Even once $\mathrm{ZF} \vdash \ulcorner \operatorname{Halts}(M) \leftrightarrow \neg\operatorname{Con}(\mathrm{ZF}) \urcorner$ is established, $\operatorname{Con}(\mathrm{ZF})$ alone yields only **one** direction of independence: $\mathrm{ZF} \nvdash \neg\ulcorner\operatorname{Halts}(M)\urcorner$ (by Gödel's Second Incompleteness Theorem). Ruling out the **other** direction, $\mathrm{ZF} \vdash \ulcorner\operatorname{Halts}(M)\urcorner$ (since $\mathrm{ZF} + \neg\operatorname{Con}(\mathrm{ZF})$ can still be consistent when $\mathrm{ZF}$ is consistent), requires $\operatorname{Con}(\mathrm{ZF} + \operatorname{Con}(\mathrm{ZF}))$—for example $\Sigma_1$-soundness ($1$-consistency) of $\mathrm{ZF}$, as assumed in Yedidia & Aaronson (2016). ### Formal Discovery of the `B6a` Register-Restoration Bug in `zf_432_wade.tm` @@ -508,7 +508,7 @@ theorem not_halts_zf393 : --- -## 6. First-Order Peano Arithmetic Metatheory ([`PA.lean`](./PA.lean) & [`PA/`](./PA/), `0 sorry`s) +## 6. First-Order Peano Arithmetic Metatheory & Internalized `ZF` Reductions ([`PA.lean`](./PA.lean) & [`PA/`](./PA/), `0 sorry`s) To state and verify object-level first-order Peano Arithmetic ($\mathrm{PA}$) provability statements inside Lean without relying on Lean's ambient type-theoretic strength, [`Cryptids/Propositions.lean`](../Propositions.lean) @@ -516,8 +516,12 @@ and [`Challenge.lean`](../../Challenge.lean) deeply embed first-order $\mathcal{ terms (`PATerm`), positive formulas (`PAFormula`), the 25-clause Hilbert system `PAProvable`, and closed $\Sigma_1^0$ sentences `paHalts M` and `paZFInconsistent`. -In [`Cryptids/Semantics/PA.lean`](./PA.lean) and its three submodules ([`PA/Syntax.lean`](./PA/Syntax.lean), -[`PA/Adequacy.lean`](./PA/Adequacy.lean), [`PA/Completeness.lean`](./PA/Completeness.lean)), we prove: +In [`Cryptids/Semantics/PA.lean`](./PA.lean) and its eight submodules ([`PA/Syntax.lean`](./PA/Syntax.lean), +[`PA/Adequacy.lean`](./PA/Adequacy.lean), [`PA/Completeness.lean`](./PA/Completeness.lean), +[`PA/Arithmetic.lean`](./PA/Arithmetic.lean), [`PA/Zf380Internal.lean`](./PA/Zf380Internal.lean), +[`PA/Zf393BackendInternal.lean`](./PA/Zf393BackendInternal.lean), +[`PA/Zf393ProgramInternal.lean`](./PA/Zf393ProgramInternal.lean), and +[`PA/Zf393SoundnessInternal.lean`](./PA/Zf393SoundnessInternal.lean)), we prove: ```lean theorem not_paProvable_false : @@ -534,6 +538,15 @@ theorem paProvable_sound_nat (φ : PAFormula) (h : PAProvable φ) (v : ℕ → theorem paProvable_iff_holdsIn_all_models (φ : PAFormula) : PAProvable φ ↔ ∀ (M : Type) [PAModel M] (v : ℕ → M), PAFormula.HoldsIn v φ + +theorem paProvable_halts_zf380_iff_zf393 : + PAProvable ((paHalts Machines.zf380).iff (paHalts Machines.zf393)) + +theorem paProvable_halts_zf393_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf393).iff paZFInconsistent) + +theorem paProvable_halts_zf380_iff_zfInconsistent : + PAProvable ((paHalts Machines.zf380).iff paZFInconsistent) ``` 1. **Models, Classical Soundness, & Constructive Consistency ([`PA/Syntax.lean`](./PA/Syntax.lean))**: @@ -554,3 +567,17 @@ theorem paProvable_iff_holdsIn_all_models (φ : PAFormula) : (`henkinChain`), quotient term model `Quotient (HenkinSetoid h₀)`, and simultaneous variable renaming (`vsubst`), enabling `PAProvable` theorems to be proved semantically in an arbitrary `[PAModel M]`. +4. **Internal Arithmetic & Sequence Coding in `PAM M` ([`PA/Arithmetic.lean`](./PA/Arithmetic.lean))**: + Develops discrete ordered-semiring arithmetic, Euclidean division, `mPow2`, Gödel's + $\beta$-function sequence append/concatenation (`mBeta_snoc`, `mBeta_concat`), Cantor pairing + (`mPair`/`mUnpair`), and semantic model bridges (`paHalts_holdsIn_iff`, + `paZFInconsistent_holdsIn_iff`) inside arbitrary first-order `PAModel`s via first-order induction + (`PAM.ind1`, `PAM.strong_ind1`). +5. **Internalized `zf_380 ↔ zf_393` State Reduction ([`PA/Zf380Internal.lean`](./PA/Zf380Internal.lean))**: + Lifts the 39,753-step bootstrap equality (`Σ₁`-absoluteness) and 5-cell sliding-window + lockstep simulation to arbitrary `PAM M`, proving `paProvable_halts_zf380_iff_zf393`. +6. **Internalized Layer 1–3 `zf_393` & `zf_380` Verification ([`PA/Zf393BackendInternal.lean`](./PA/Zf393BackendInternal.lean), [`PA/Zf393ProgramInternal.lean`](./PA/Zf393ProgramInternal.lean), & [`PA/Zf393SoundnessInternal.lean`](./PA/Zf393SoundnessInternal.lean))**: + Internalizes the moving-`00` unary register backend (`mZfRootCfg`), all 324 control-DAG states + and 20 reordered `ZF` axiom/rule clauses along the 125-step `main()` spine, and bidirectional + soundness and completeness against `MZFInconsistent M`, yielding + `paProvable_halts_zf393_iff_zfInconsistent` and `paProvable_halts_zf380_iff_zfInconsistent`. diff --git a/README.md b/README.md index a13b6d8d..6784b5e3 100644 --- a/README.md +++ b/README.md @@ -14,7 +14,7 @@ This repository contains two Lean 4 (`v4.35.0-rc4`) formalization libraries for 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)). -- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** First-order `PA` soundness and Gödel–Henkin completeness (`paProvable_sound_nat`, `paProvable_iff_holdsIn_all_models`), set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json) and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). +- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** First-order `PA` soundness, Gödel–Henkin completeness, and object-level `PAProvable` proofs that `zf_380` and `zf_393` halt iff `ZF` is inconsistent (`paProvable_sound_nat`, `paProvable_iff_holdsIn_all_models`, `paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent`), set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json), [`comparator/pa_semantics.json`](comparator/pa_semantics.json), and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). The [95-state Riemann machine](artifacts/riemann_95/README.md) has a kernel-checked blank-tape halting equivalence to the 104-state machine and to `¬ RiemannHypothesis`. diff --git a/comparator/README.md b/comparator/README.md index 30cbd1f8..e904dd70 100644 --- a/comparator/README.md +++ b/comparator/README.md @@ -11,8 +11,8 @@ using [`leanprover/comparator`](https://github.com/leanprover/comparator). defines all conjecture-checking baseline and candidate machines (`reference` and `candidate`), states the target mathematical propositions (`GoldbachConjecture`, `MatiyasevichRiemannCounterexample`, `ZFProvable`, `WadeZFProvable`, `PAProvable`, `paHalts`, - `paZFInconsistent`, etc.), and states all 26 target state-reduction, equivalence, `PA` - metatheory, and semantics theorems with `sorry`. + `paZFInconsistent`, etc.), and states all 29 target state-reduction, equivalence, `PA` + metatheory & internalized `ZF` provability, and semantics theorems with `sorry`. - [`BusyBeaverChallenge.lean`](../BusyBeaverChallenge.lean) imports **only** Mathlib and Lean core (`Lean.Elab.Term`), defines the shared `BusyBeaver` Post-Turing execution model, accelerated `TapePatternSet`, `StackPatternSet`, and Collatz-like acceleration semantics (`IsClosedPatternSet`, @@ -54,8 +54,8 @@ that: | Config File | Challenge Module | Solution Module | Permitted Axioms | Verified Theorems | | :--- | :--- | :--- | :--- | :--- | | [`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` | +| [`all.json`](./all.json) | `Challenge` | `Cryptids` | `propext`, `Quot.sound`, `Classical.choice` | All 29 conjecture-checking state-reduction, equivalence, `PA` metatheory & internalized `ZF` provability, 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`, `paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent` | | [`busy_beaver.json`](./busy_beaver.json) | `BusyBeaverChallenge` | `BusyBeaver` | `propext`, `Quot.sound`, `Classical.choice` | All 299 `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`, `is_valid_acceleration`, `isHalt_iff_acceleration`, `is_valid_highLevel_acceleration`, `isHalt_iff_highLevel_acceleration`, `acceleration_iff_highLevel_acceleration`) | | [`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` | diff --git a/comparator/all.json b/comparator/all.json index bc3c5600..dc44d821 100644 --- a/comparator/all.json +++ b/comparator/all.json @@ -19,6 +19,9 @@ "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", "ConjectureMachines.Semantics.PA.paProvable_sound_nat", + "ConjectureMachines.Semantics.PA.paProvable_halts_zf380_iff_zf393", + "ConjectureMachines.Semantics.PA.paProvable_halts_zf393_iff_zfInconsistent", + "ConjectureMachines.Semantics.PA.paProvable_halts_zf380_iff_zfInconsistent", "ConjectureMachines.Semantics.Riemann.halts_riemann744_iff_exists_counterexample", "ConjectureMachines.Semantics.Riemann.halts_riemann744_iff_not_riemannHypothesis", "ConjectureMachines.Riemann120.halts_riemann120_iff_not_riemannHypothesis", diff --git a/comparator/pa_semantics.json b/comparator/pa_semantics.json index e473b0a9..4418c2b7 100644 --- a/comparator/pa_semantics.json +++ b/comparator/pa_semantics.json @@ -5,7 +5,10 @@ "ConjectureMachines.Semantics.PA.not_paProvable_false", "ConjectureMachines.Semantics.PA.paHalts_holds_iff_halts", "ConjectureMachines.Semantics.PA.paZFInconsistent_holds_iff_zfInconsistent", - "ConjectureMachines.Semantics.PA.paProvable_sound_nat" + "ConjectureMachines.Semantics.PA.paProvable_sound_nat", + "ConjectureMachines.Semantics.PA.paProvable_halts_zf380_iff_zf393", + "ConjectureMachines.Semantics.PA.paProvable_halts_zf393_iff_zfInconsistent", + "ConjectureMachines.Semantics.PA.paProvable_halts_zf380_iff_zfInconsistent" ], "permitted_axioms": [ "propext", From f3e1cdb1539fc66d7a890fdda2c99f5d47873b08 Mon Sep 17 00:00:00 2001 From: Moritz Firsching Date: Sat, 31 Oct 2026 22:00:54 +0000 Subject: [PATCH 3/3] Address PR #20 review: reorganize PA/Zf393 modules, tighten options & visibility, clarify docs --- Cryptids/README.md | 4 +- Cryptids/Semantics/PA.lean | 16 +-- Cryptids/Semantics/PA/Arithmetic.lean | 106 +++++++++--------- .../PA/{Zf380Internal.lean => Zf380.lean} | 0 .../Backend.lean} | 0 .../Program.lean} | 13 ++- .../Soundness.lean} | 4 +- Cryptids/Semantics/README.md | 20 ++-- README.md | 2 +- 9 files changed, 86 insertions(+), 79 deletions(-) rename Cryptids/Semantics/PA/{Zf380Internal.lean => Zf380.lean} (100%) rename Cryptids/Semantics/PA/{Zf393BackendInternal.lean => Zf393/Backend.lean} (100%) rename Cryptids/Semantics/PA/{Zf393ProgramInternal.lean => Zf393/Program.lean} (99%) rename Cryptids/Semantics/PA/{Zf393SoundnessInternal.lean => Zf393/Soundness.lean} (99%) diff --git a/Cryptids/README.md b/Cryptids/README.md index e2c2c69e..4d1fec4a 100644 --- a/Cryptids/README.md +++ b/Cryptids/README.md @@ -23,8 +23,8 @@ All proofs in [`Cryptids/`](./) are checked by the Lean 4 kernel (`v4.35.0-rc4`) 1. **State reductions:** Each reduced machine (`goldbach_21`, `zf_380`, `riemann_104`, `riemann_95`) has fewer states than its reference machine (`goldbach_25`, `zf_393`, `riemann_120`, `riemann_104`) and halts from the blank tape if and only if the reference machine halts ([`Goldbach21.lean`](./Goldbach21.lean), [`Zf380.lean`](./Zf380.lean), [`Riemann104.lean`](./Riemann104.lean), [`Riemann95.lean`](./Riemann95.lean)). The direct simulation reductions (`goldbach_21`, `zf_380`, `riemann_104`) and all four `candidate_fewer_states` theorems are completely constructive (`["propext", "Quot.sound"]`, zero `Classical.choice`), audited via [`comparator/constructive.json`](../comparator/constructive.json), [`comparator/goldbach_21.json`](../comparator/goldbach_21.json), [`comparator/zf_380.json`](../comparator/zf_380.json), and [`comparator/riemann_104.json`](../comparator/riemann_104.json), while [`riemann_95`](./Riemann95.lean) routes through the arithmetic stage predicate `ShuniaCounterexample` (`Nat.Prime`, audited via [`comparator/riemann_95.json`](../comparator/riemann_95.json)). 2. **End-to-end mathematical semantics ([`Cryptids/Semantics/`](./Semantics/README.md)):** - - **ZF Consistency (`zf_380`, `zf_393`, and `zf_432`):** Both `zf_380` and Wade's 393-state machine `zf_393` (incorporating upstream fix `10fcf152b3`) halt if and only if O'Rear's `zf2.nql` Hilbert system proves $v_0 \in v_0$ (`Halts candidate ↔ ZFInconsistent`, `Halts zf393 ↔ ZFInconsistent`), while `zf_432` halts if and only if the 20-clause deductive system enumerated by `zf_432_wade.tm` derives $v_0 \in v_0$ (`WadeZFInconsistent`). **All three proof-search equivalences are proved constructively in Lean using only `["propext", "Quot.sound"]` (no `Classical.choice`, no Excluded Middle, and no Markov's Principle)** and audited via [`comparator/constructive.json`](../comparator/constructive.json), blocking classical `Con(ZF)` shortcuts via [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) or `Classical.em` (while internalizing the reduction inside `PA`/`ZF` and establishing full `ZF`-independence remain separate from this Lean meta-level correspondence; see [`Semantics/README.md`](./Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). Separately, [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) uses classical `ZFSet.{0}` (`Classical.choice`) to establish `not_zfInconsistent` and deduce unconditional non-halting (`not_halts_zf393`, `not_halts_candidate`) inside Lean's stronger meta-theory. - - **First-Order Peano Arithmetic (`PAProvable`, [`Semantics/PA.lean`](./Semantics/PA.lean)):** Deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) and $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` in [`Propositions.lean`](./Propositions.lean) and [`Challenge.lean`](../Challenge.lean), proving constructive consistency (`not_paProvable_false`), constructive standard-model adequacy (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`; all three audited without `Classical.choice` in [`comparator/constructive.json`](../comparator/constructive.json)), standard-model soundness (`paProvable_sound_nat`), Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`), and full object-level `PA` proofs that `zf_380` and `zf_393` halt iff `ZF` is inconsistent (`paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent`, audited in [`comparator/pa_semantics.json`](../comparator/pa_semantics.json) and [`comparator/all.json`](../comparator/all.json)). + - **ZF Consistency (`zf_380`, `zf_393`, and `zf_432`):** Both `zf_380` and Wade's 393-state machine `zf_393` (incorporating upstream fix `10fcf152b3`) halt if and only if O'Rear's `zf2.nql` Hilbert system proves $v_0 \in v_0$ (`Halts candidate ↔ ZFInconsistent`, `Halts zf393 ↔ ZFInconsistent`), while `zf_432` halts if and only if the 20-clause deductive system enumerated by `zf_432_wade.tm` derives $v_0 \in v_0$ (`WadeZFInconsistent`). **All three proof-search equivalences are proved constructively in Lean using only `["propext", "Quot.sound"]` (no `Classical.choice`, no Excluded Middle, and no Markov's Principle)** and audited via [`comparator/constructive.json`](../comparator/constructive.json), blocking classical `Con(ZF)` shortcuts via [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) or `Classical.em` (object-level `PA` internalization for `zf_393` and `zf_380` is proved separately below via `PAProvable`, while `zf_432` internalization and establishing full two-way `ZF`-independence remain separate; see [`Semantics/README.md`](./Semantics/README.md#foundational-note-conzf-in-lean-and-constructive-equivalence)). Separately, [`Zf/Soundness.lean`](./Semantics/Zf/Soundness.lean) uses classical `ZFSet.{0}` (`Classical.choice`) to establish `not_zfInconsistent` and deduce unconditional non-halting (`not_halts_zf393`, `not_halts_candidate`) inside Lean's stronger meta-theory. + - **First-Order Peano Arithmetic (`PAProvable`, [`Semantics/PA.lean`](./Semantics/PA.lean)):** Deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`) and $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` in [`Propositions.lean`](./Propositions.lean) and [`Challenge.lean`](../Challenge.lean), proving constructive consistency (`not_paProvable_false`) and constructive standard-model adequacy (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`; all three audited without `Classical.choice` in [`comparator/constructive.json`](../comparator/constructive.json)), along with classical standard-model soundness (`paProvable_sound_nat`) and full object-level `PA` proofs that `zf_380` and `zf_393` halt iff `ZF` is inconsistent (`paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent`, audited in [`comparator/pa_semantics.json`](../comparator/pa_semantics.json) and [`comparator/all.json`](../comparator/all.json); these three `PAProvable` theorems use `Classical.choice` because they reason in arbitrary `PAModel`s and reflect back to `PAProvable` via internal Gödel–Henkin completeness `paProvable_iff_holdsIn_all_models`). - **Goldbach (`goldbach_21` and `goldbach_25`):** Both `goldbach_21` and `goldbach_25` constructively satisfy `Halts M ↔ ∃ w, ¬ HasGoldbachPair (2 * w + 4)` without `Classical.choice` ([`Goldbach21.lean`](./Goldbach21.lean)), and with `Classical.choice` (for Markov's Principle on `¬ ∀ n, ...`) satisfy `Halts candidate ↔ ¬ GoldbachConjecture` ([`Semantics/Goldbach.lean`](./Semantics/Goldbach.lean)). - **Riemann Hypothesis (`riemann_95`, `riemann_104`, `riemann_120`, and `riemann_744`):** All four machines (`riemann_95`, `riemann_104`, Shunia's 120-state machine `riemann_120`, and the 744-state machine `riemann_744`) halt if and only if Mathlib's `RiemannHypothesis` is false (`Halts candidate ↔ ¬ RiemannHypothesis`, `Halts riemann120 ↔ ¬ RiemannHypothesis`, and `Halts riemann744 ↔ ¬ RiemannHypothesis`). diff --git a/Cryptids/Semantics/PA.lean b/Cryptids/Semantics/PA.lean index d46d4684..8e1e6ec4 100644 --- a/Cryptids/Semantics/PA.lean +++ b/Cryptids/Semantics/PA.lean @@ -8,10 +8,10 @@ public import Cryptids.Semantics.PA.Syntax public import Cryptids.Semantics.PA.Adequacy public import Cryptids.Semantics.PA.Completeness public import Cryptids.Semantics.PA.Arithmetic -public import Cryptids.Semantics.PA.Zf380Internal -public import Cryptids.Semantics.PA.Zf393BackendInternal -public import Cryptids.Semantics.PA.Zf393ProgramInternal -public import Cryptids.Semantics.PA.Zf393SoundnessInternal +public import Cryptids.Semantics.PA.Zf380 +public import Cryptids.Semantics.PA.Zf393.Backend +public import Cryptids.Semantics.PA.Zf393.Program +public import Cryptids.Semantics.PA.Zf393.Soundness /-! # First-Order Peano Arithmetic Semantics & Internalized `ZF` Reductions (`Cryptids.Semantics.PA`) @@ -35,12 +35,12 @@ Re-exports the foundational metatheory of the deeply embedded Peano Arithmetic s Internal arithmetic in arbitrary `PAModel`s (`PAM M`), Euclidean division, `2^k`, Gödel's $\beta$-function sequence coding via `PAM.ind1`, Cantor pairing (`mPair`/`mUnpair`), and model bridges for `paHalts` and `paZFInconsistent`. -5. [`Cryptids.Semantics.PA.Zf380Internal`](./PA/Zf380Internal.lean): +5. [`Cryptids.Semantics.PA.Zf380`](./PA/Zf380.lean): First-order `PA` proof of `PAProvable ((paHalts Machines.zf380).iff (paHalts Machines.zf393))` (`paProvable_halts_zf380_iff_zf393`). -6. [`Cryptids.Semantics.PA.Zf393BackendInternal`](./PA/Zf393BackendInternal.lean), - [`Cryptids.Semantics.PA.Zf393ProgramInternal`](./PA/Zf393ProgramInternal.lean), & - [`Cryptids.Semantics.PA.Zf393SoundnessInternal`](./PA/Zf393SoundnessInternal.lean): +6. [`Cryptids.Semantics.PA.Zf393.Backend`](./PA/Zf393/Backend.lean), + [`Cryptids.Semantics.PA.Zf393.Program`](./PA/Zf393/Program.lean), & + [`Cryptids.Semantics.PA.Zf393.Soundness`](./PA/Zf393/Soundness.lean): Full Layer 1–3 internalization of `zf_393` and `zf_380` inside `PAProvable`: `paProvable_halts_zf393_iff_zfInconsistent` and `paProvable_halts_zf380_iff_zfInconsistent`. -/ diff --git a/Cryptids/Semantics/PA/Arithmetic.lean b/Cryptids/Semantics/PA/Arithmetic.lean index 795932af..c5b5d4be 100644 --- a/Cryptids/Semantics/PA/Arithmetic.lean +++ b/Cryptids/Semantics/PA/Arithmetic.lean @@ -76,7 +76,7 @@ instance : PAStructure (PAM M) where @[simp] theorem raw_mul (a b : PAM M) : (a * b).raw = PAStructure.mul a.raw b.raw := rfl @[simp] theorem raw_succ (a : PAM M) : (succ a).raw = PAStructure.succ a.raw := rfl -theorem evalIn_raw (v : ℕ → PAM M) (t : PATerm) : +private theorem evalIn_raw (v : ℕ → PAM M) (t : PATerm) : (PATerm.evalIn v t).raw = PATerm.evalIn (fun x ↦ (v x).raw) t := by induction t with | var _ | zero => rfl @@ -168,12 +168,12 @@ theorem succ_eq_add_one (a : PAM M) : succ a = a + 1 := by rw [PAModel.add_succ, PAModel.add_zero] theorem pam_add_zero (a : PAM M) : a + 0 = a := PAModel.add_zero a -theorem pam_add_succ (a b : PAM M) : a + succ b = succ (a + b) := PAModel.add_succ a b +private theorem pam_add_succ (a b : PAM M) : a + succ b = succ (a + b) := PAModel.add_succ a b theorem pam_mul_zero (a : PAM M) : a * 0 = 0 := PAModel.mul_zero a -theorem pam_mul_succ (a b : PAM M) : a * succ b = a * b + a := PAModel.mul_succ a b +private theorem pam_mul_succ (a b : PAM M) : a * succ b = a * b + a := PAModel.mul_succ a b /-- First-order induction on `PAM M` for any predicate equivalent to a `PAFormula`. -/ -theorem ind_pred {P : PAM M → Prop} +private theorem ind_pred {P : PAM M → Prop} (hdef : ∃ (x : ℕ) (φ : PAFormula) (v : ℕ → PAM M), ∀ a : PAM M, PAFormula.HoldsIn (Function.update v x a) φ ↔ P a) (h0 : P 0) (hs : ∀ a : PAM M, P a → P (a + 1)) : @@ -191,7 +191,7 @@ theorem pam_zero_add (a : PAM M) : 0 + a = a := by · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl · rw [← succ_eq_add_one, pam_add_succ, ih] -theorem pam_succ_add (a b : PAM M) : succ a + b = succ (a + b) := by +private theorem pam_succ_add (a b : PAM M) : succ a + b = succ (a + b) := by refine ind_pred (P := fun c : PAM M ↦ succ a + c = succ (a + c)) ⟨0, .eq (.add (.succ (.var 1)) (.var 0)) (.succ (.add (.var 1) (.var 0))), fun | 1 => a | _ => 0, fun c ↦ ?_⟩ ?_ (fun c ih ↦ ?_) b @@ -222,7 +222,7 @@ theorem pam_zero_mul (a : PAM M) : 0 * a = 0 := by · simp [PAFormula.HoldsIn, PATerm.evalIn]; rfl · rw [← succ_eq_add_one, pam_mul_succ, ih, pam_add_zero] -theorem pam_succ_mul (a b : PAM M) : succ a * b = a * b + b := by +private theorem pam_succ_mul (a b : PAM M) : succ a * b = a * b + b := by refine ind_pred (P := fun c : PAM M ↦ succ a * c = a * c + c) ⟨0, .eq (.mul (.succ (.var 1)) (.var 0)) (.add (.mul (.var 1) (.var 0)) (.var 0)), fun | 1 => a | _ => 0, fun c ↦ ?_⟩ ?_ (fun c ih ↦ ?_) b @@ -387,12 +387,12 @@ omit [PAModel M] in theorem lt_def {a b : PAM M} : a < b ↔ a + 1 ≤ b := Iff.rfl omit [PAModel M] in -theorem evalIn_update_of_freshVar_le (v : ℕ → PAM M) {t : PATerm} {x : ℕ} (a : PAM M) +private theorem evalIn_update_of_freshVar_le (v : ℕ → PAM M) {t : PATerm} {x : ℕ} (a : PAM M) (h : t.freshVar ≤ x) : PATerm.evalIn (Function.update v x a) t = PATerm.evalIn v t := evalIn_update_of_hasVar_false v a (hasVar_false_of_freshVar_le h) omit [PAModel M] in -theorem paLe_holdsIn_iff (v : ℕ → PAM M) (a b : PATerm) : +private theorem paLe_holdsIn_iff (v : ℕ → PAM M) (a b : PATerm) : PAFormula.HoldsIn v (paLe a b) ↔ PATerm.evalIn v a ≤ PATerm.evalIn v b := by unfold paLe set k := max a.freshVar b.freshVar @@ -403,7 +403,7 @@ theorem paLe_holdsIn_iff (v : ℕ → PAM M) (a b : PATerm) : Function.update_self] rfl -theorem paLt_holdsIn_iff (v : ℕ → PAM M) (a b : PATerm) : +private theorem paLt_holdsIn_iff (v : ℕ → PAM M) (a b : PATerm) : PAFormula.HoldsIn v (paLt a b) ↔ PATerm.evalIn v a < PATerm.evalIn v b := by unfold paLt rw [paLe_holdsIn_iff, evalIn_succ] @@ -472,7 +472,7 @@ theorem not_lt_zero_pam (a : PAM M) : ¬ a < 0 := theorem le_zero_iff_pam {a : PAM M} : a ≤ 0 ↔ a = 0 := ⟨fun h ↦ le_antisymm h (zero_le_pam a), fun h ↦ h ▸ le_rfl⟩ -theorem pos_iff_ne_zero_pam {a : PAM M} : 0 < a ↔ a ≠ 0 := by +private theorem pos_iff_ne_zero_pam {a : PAM M} : 0 < a ↔ a ≠ 0 := by constructor · rintro h rfl exact lt_irrefl 0 h @@ -492,7 +492,7 @@ theorem lt_add_one_iff_le {a b : PAM M} : a < b + 1 ↔ a ≤ b := by · rintro ⟨k, rfl⟩ exact ⟨k, by ring⟩ -theorem le_add_one_iff {a b : PAM M} : a ≤ b + 1 ↔ a ≤ b ∨ a = b + 1 := by +private theorem le_add_one_iff {a b : PAM M} : a ≤ b + 1 ↔ a ≤ b ∨ a = b + 1 := by constructor · rintro ⟨k, hk⟩ rcases eq_zero_or_exists_succ k with rfl | ⟨k', rfl⟩ @@ -518,14 +518,14 @@ theorem add_lt_add_right_pam {a b : PAM M} (h : a < b) (c : PAM M) : a + c < b + omit [PAModel M] in theorem le_add_right_pam (a b : PAM M) : a ≤ a + b := ⟨b, rfl⟩ -theorem le_add_left_pam (a b : PAM M) : a ≤ b + a := ⟨b, add_comm a b⟩ +private theorem le_add_left_pam (a b : PAM M) : a ≤ b + a := ⟨b, add_comm a b⟩ -theorem mul_le_mul_pam {a b c d : PAM M} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d := by +private theorem mul_le_mul_pam {a b c d : PAM M} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d := by rcases h₁ with ⟨k₁, rfl⟩ rcases h₂ with ⟨k₂, rfl⟩ exact ⟨a * k₂ + k₁ * c + k₁ * k₂, by ring⟩ -theorem mul_lt_mul_of_pos_left_pam {a b c : PAM M} (h : a < b) (hc : 0 < c) : +private theorem mul_lt_mul_of_pos_left_pam {a b c : PAM M} (h : a < b) (hc : 0 < c) : c * a < c * b := by rcases h with ⟨k, rfl⟩ rcases eq_zero_or_exists_succ c with rfl | ⟨c', rfl⟩ @@ -549,7 +549,7 @@ theorem add_sub_of_le_pam {a b : PAM M} (h : b ≤ a) : b + (a - b) = a := by rw [dite_eq_left_of_eq_true (eq_true h)] exact Classical.choose_spec h -theorem sub_add_cancel_pam {a b : PAM M} (h : b ≤ a) : a - b + b = a := by +private theorem sub_add_cancel_pam {a b : PAM M} (h : b ≤ a) : a - b + b = a := by rw [add_comm] exact add_sub_of_le_pam h @@ -633,7 +633,7 @@ theorem natCast_inj_pam {m n : ℕ} : (m : PAM M) = (n : PAM M) ↔ m = n := by theorem zero_lt_one_pam : (0 : PAM M) < 1 := by simpa using (natCast_lt_iff (M := M) (m := 0) (n := 1)).mpr (by decide) -theorem zero_lt_two_pam : (0 : PAM M) < 2 := by +private theorem zero_lt_two_pam : (0 : PAM M) < 2 := by simpa using (natCast_lt_iff (M := M) (m := 0) (n := 2)).mpr (by decide) theorem one_ne_zero_pam : (1 : PAM M) ≠ 0 := @@ -643,7 +643,7 @@ theorem two_ne_zero_pam : (2 : PAM M) ≠ 0 := ne_of_gt zero_lt_two_pam omit [PAStructure M] [PAModel M] in -theorem hasFree_false_of_maxVar_le_pam {φ : PAFormula} {w : ℕ} (h : φ.maxVar ≤ w) : +private theorem hasFree_false_of_maxVar_le_pam {φ : PAFormula} {w : ℕ} (h : φ.maxVar ≤ w) : φ.hasFree w = false := by induction φ with | bot => rfl @@ -658,7 +658,7 @@ theorem hasFree_false_of_maxVar_le_pam {φ : PAFormula} {w : ℕ} (h : φ.maxVar simp [PAFormula.hasFree, ih h.2] omit [PAStructure M] [PAModel M] in -theorem freeFor_var_of_maxVar_le_pam {φ : PAFormula} {x w : ℕ} (h : φ.maxVar ≤ w) : +private theorem freeFor_var_of_maxVar_le_pam {φ : PAFormula} {x w : ℕ} (h : φ.maxVar ≤ w) : φ.freeFor x (.var w) = true := by induction φ with | bot | eq _ _ => rfl @@ -671,7 +671,7 @@ theorem freeFor_var_of_maxVar_le_pam {φ : PAFormula} {x w : ℕ} (h : φ.maxVar simp [PAFormula.freeFor, PATerm.hasVar, hwz, ih h.2] /-- Strong first-order induction on `PAM M` for any predicate equivalent to a `PAFormula`. -/ -theorem strong_ind_pred {P : PAM M → Prop} +private theorem strong_ind_pred {P : PAM M → Prop} (hdef : ∃ (x : ℕ) (φ : PAFormula) (v : ℕ → PAM M), ∀ a : PAM M, PAFormula.HoldsIn (Function.update v x a) φ ↔ P a) (hstep : ∀ a : PAM M, (∀ b < a, P b) → P a) : @@ -731,7 +731,7 @@ theorem div_mod_exists {b : PAM M} (hb : 0 < b) (a : PAM M) : · refine ⟨q, r + 1, by ring, ?_⟩ exact lt_of_le_of_ne hr hrb -theorem div_mod_unique {b q₁ r₁ q₂ r₂ : PAM M} (hr₁ : r₁ < b) (hr₂ : r₂ < b) +private theorem div_mod_unique {b q₁ r₁ q₂ r₂ : PAM M} (hr₁ : r₁ < b) (hr₂ : r₂ < b) (h : b * q₁ + r₁ = b * q₂ + r₂) : q₁ = q₂ ∧ r₁ = r₂ := by have hq : q₁ = q₂ := by rcases lt_trichotomy q₁ q₂ with hlt | rfl | hgt @@ -802,7 +802,7 @@ theorem div_mod_eq_iff {a b q r : PAM M} (hr : r < b) : · intro ha exact div_mod_unique (mod_lt_pam a hb) hr (by rw [div_add_mod_pam, ha]) -theorem mod_eq_of_lt_pam {a b : PAM M} (h : a < b) : a % b = a := +private theorem mod_eq_of_lt_pam {a b : PAM M} (h : a < b) : a % b = a := ((div_mod_eq_iff (q := 0) h).mpr (by ring)).2 theorem add_mul_mod_self_left_pam (r m q : PAM M) : (r + m * q) % m = r % m := by @@ -835,7 +835,7 @@ noncomputable def mHalf (a : PAM M) : PAM M := def mCons (b : Fin 2) (x : PAM M) : PAM M := 2 * x + (b.val : PAM M) -theorem mod_two_eq_zero_or_one (a : PAM M) : a % 2 = 0 ∨ a % 2 = 1 := by +private theorem mod_two_eq_zero_or_one (a : PAM M) : a % 2 = 0 ∨ a % 2 = 1 := by have hlt : a % 2 < ((2 : ℕ) : PAM M) := by simpa using mod_lt_pam a zero_lt_two_pam obtain ⟨k, hk, heq⟩ := lt_natCast_iff.mp hlt rcases k with _ | _ | k @@ -887,7 +887,7 @@ theorem mHalf_zero : mHalf (0 : PAM M) = 0 := by /-! ## Section 4: Bijective Cantor Pairing `mPair` / `mUnpair` -/ -theorem two_dvd_mul_succ_pam (s : PAM M) : ∃ k : PAM M, s * (s + 1) = 2 * k := by +private theorem two_dvd_mul_succ_pam (s : PAM M) : ∃ k : PAM M, s * (s + 1) = 2 * k := by have hs := div_add_mod_pam s 2 rcases mod_two_eq_zero_or_one s with h0 | h1 · refine ⟨(s / 2) * (2 * (s / 2) + 1), ?_⟩ @@ -940,7 +940,7 @@ theorem mPair_natCast (x y : ℕ) : mPair (x : PAM M) (y : PAM M) = (cantorPair have hcast := congrArg (Nat.cast (R := PAM M)) hnat.symm simpa [Nat.cast_add, Nat.cast_mul] using hcast -theorem paCantorPairEq_holdsIn_iff (v : ℕ → PAM M) (x y z : PATerm) : +private theorem paCantorPairEq_holdsIn_iff (v : ℕ → PAM M) (x y z : PATerm) : PAFormula.HoldsIn v (paCantorPairEq x y z) ↔ PATerm.evalIn v z = mPair (PATerm.evalIn v x) (PATerm.evalIn v y) := by unfold paCantorPairEq @@ -1010,7 +1010,7 @@ theorem mUnpair_mPair (x y : PAM M) : mUnpair (mPair x y) = (x, y) := by theorem le_mPair_left (x y : PAM M) : x ≤ mPair x y := ⟨((x + y) * (x + y + 1)) / 2, rfl⟩ -theorem mul_le_mul_iff_of_pos_left_pam {a b c : PAM M} (hc : 0 < c) : +private theorem mul_le_mul_iff_of_pos_left_pam {a b c : PAM M} (hc : 0 < c) : c * a ≤ c * b ↔ a ≤ b := by refine ⟨fun h ↦ ?_, fun h ↦ mul_le_mul_pam le_rfl h⟩ by_contra hnot @@ -1024,7 +1024,7 @@ theorem le_mPair_right (x y : PAM M) : y ≤ mPair x y := by exact ⟨5 * x + (x + y') * (x + y') + y', by ring⟩ omit [PAModel M] in -theorem paDisjList_holdsIn_iff (v : ℕ → PAM M) (L : List PAFormula) : +private theorem paDisjList_holdsIn_iff (v : ℕ → PAM M) (L : List PAFormula) : PAFormula.HoldsIn v (paDisjList L) ↔ ∃ φ ∈ L, PAFormula.HoldsIn v φ := by match L with | [] => simp [paDisjList, PAFormula.HoldsIn] @@ -1034,12 +1034,12 @@ theorem paDisjList_holdsIn_iff (v : ℕ → PAM M) (L : List PAFormula) : List.mem_cons, exists_eq_or_imp] /-- Evaluate a symbolic `PAZFTerm` in `PAM M`. -/ -noncomputable def evalPAZFTerm (v : ℕ → PAM M) : PAZFTerm → PAM M +private noncomputable def evalPAZFTerm (v : ℕ → PAM M) : PAZFTerm → PAM M | .var x => v x | .const n => (n : PAM M) | .pair a b => mPair (evalPAZFTerm v a) (evalPAZFTerm v b) -theorem evalPAZFTerm_congr {v₁ v₂ : ℕ → PAM M} {e : PAZFTerm} +private theorem evalPAZFTerm_congr {v₁ v₂ : ℕ → PAM M} {e : PAZFTerm} (h : ∀ x < e.freshVar, v₁ x = v₂ x) : evalPAZFTerm v₁ e = evalPAZFTerm v₂ e := by induction e with @@ -1050,11 +1050,11 @@ theorem evalPAZFTerm_congr {v₁ v₂ : ℕ → PAM M} {e : PAZFTerm} · exact lt_of_lt_of_le hx (Nat.le_max_left _ _) · exact lt_of_lt_of_le hx (Nat.le_max_right _ _) -theorem evalPAZFTerm_update_fresh (v : ℕ → PAM M) {e : PAZFTerm} {x : ℕ} (a : PAM M) +private theorem evalPAZFTerm_update_fresh (v : ℕ → PAM M) {e : PAZFTerm} {x : ℕ} (a : PAM M) (h : e.freshVar ≤ x) : evalPAZFTerm (Function.update v x a) e = evalPAZFTerm v e := evalPAZFTerm_congr fun (y : ℕ) _ ↦ Function.update_of_ne (by omega : y ≠ x) a v -theorem eqFormula_holdsIn_iff (e : PAZFTerm) (out : PATerm) (base : ℕ) (v : ℕ → PAM M) +private theorem eqFormula_holdsIn_iff (e : PAZFTerm) (out : PATerm) (base : ℕ) (v : ℕ → PAM M) (he : e.freshVar ≤ base) (hout : out.freshVar ≤ base) : PAFormula.HoldsIn v (e.eqFormula out base) ↔ PATerm.evalIn v out = evalPAZFTerm v e := by induction e generalizing out base v with @@ -1118,14 +1118,14 @@ theorem eqFormula_holdsIn_iff (e : PAZFTerm) (out : PATerm) (base : ℕ) (v : /-! ## Section 4b: Compositional First-Order Definability (`PADefN`, `PAFunN`) -/ -def renameAllTerm (σ : ℕ → ℕ) : PATerm → PATerm +private def renameAllTerm (σ : ℕ → ℕ) : PATerm → PATerm | .var x => .var (σ x) | .zero => .zero | .succ t => .succ (renameAllTerm σ t) | .add t₁ t₂ => .add (renameAllTerm σ t₁) (renameAllTerm σ t₂) | .mul t₁ t₂ => .mul (renameAllTerm σ t₁) (renameAllTerm σ t₂) -def renameAllFormula (σ : ℕ → ℕ) : PAFormula → PAFormula +private def renameAllFormula (σ : ℕ → ℕ) : PAFormula → PAFormula | .bot => .bot | .eq t₁ t₂ => .eq (renameAllTerm σ t₁) (renameAllTerm σ t₂) | .and φ ψ => .and (renameAllFormula σ φ) (renameAllFormula σ ψ) @@ -1135,7 +1135,7 @@ def renameAllFormula (σ : ℕ → ℕ) : PAFormula → PAFormula | .ex x φ => .ex (σ x) (renameAllFormula σ φ) omit [PAModel M] in -theorem evalIn_renameAllTerm (σ : ℕ → ℕ) (u : ℕ → PAM M) (t : PATerm) : +private theorem evalIn_renameAllTerm (σ : ℕ → ℕ) (u : ℕ → PAM M) (t : PATerm) : PATerm.evalIn u (renameAllTerm σ t) = PATerm.evalIn (u ∘ σ) t := by induction t with | var _ | zero => rfl @@ -1144,7 +1144,7 @@ theorem evalIn_renameAllTerm (σ : ℕ → ℕ) (u : ℕ → PAM M) (t : PATerm) | mul _ _ ih₁ ih₂ => exact congrArg₂ PAStructure.mul ih₁ ih₂ omit [PAModel M] in -theorem holdsIn_renameAllFormula {σ : ℕ → ℕ} (hσ : Function.Injective σ) +private theorem holdsIn_renameAllFormula {σ : ℕ → ℕ} (hσ : Function.Injective σ) (u : ℕ → PAM M) (φ : PAFormula) : PAFormula.HoldsIn u (renameAllFormula σ φ) ↔ PAFormula.HoldsIn (u ∘ σ) φ := by induction φ generalizing u with @@ -1178,12 +1178,12 @@ def paEnv {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) (x : ℕ) : PAM if h : x < k then args ⟨x, h⟩ else v x omit [PAStructure M] [PAModel M] in -theorem paEnv_lt {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) {x : ℕ} (h : x < k) : +private theorem paEnv_lt {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) {x : ℕ} (h : x < k) : paEnv v args x = args ⟨x, h⟩ := dite_eq_left_of_eq_true (eq_true h) omit [PAStructure M] [PAModel M] in -theorem paEnv_ge {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) {x : ℕ} (h : ¬ x < k) : +private theorem paEnv_ge {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) {x : ℕ} (h : ¬ x < k) : paEnv v args x = v x := dite_eq_right_of_eq_false (eq_false h) @@ -1262,7 +1262,7 @@ theorem paDef_not {k : ℕ} {P : (Fin k → PAM M) → Prop} (hP : PADefN k P) : exact ⟨φ.not, v, fun args ↦ not_congr (hφ args)⟩ omit [PAModel M] in -theorem paDef_merge {k : ℕ} {P Q : (Fin k → PAM M) → Prop} +private theorem paDef_merge {k : ℕ} {P Q : (Fin k → PAM M) → Prop} (hP : PADefN k P) (hQ : PADefN k Q) : ∃ (φ₁ φ₂ : PAFormula) (v : ℕ → PAM M), ∀ args : Fin k → PAM M, (PAFormula.HoldsIn (paEnv v args) φ₁ ↔ P args) ∧ @@ -1326,7 +1326,7 @@ theorem paDef_iff {k : ℕ} {P Q : (Fin k → PAM M) → Prop} (paDef_and (paDef_imp hP hQ) (paDef_imp hQ hP)) omit [PAStructure M] [PAModel M] in -theorem update_paEnv_eq_snoc {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) (a : PAM M) : +private theorem update_paEnv_eq_snoc {k : ℕ} (v : ℕ → PAM M) (args : Fin k → PAM M) (a : PAM M) : Function.update (paEnv v args) k a = paEnv v (Fin.snoc args a) := by funext x by_cases hxk : x = k @@ -1381,7 +1381,7 @@ theorem paDef_weaken {k : ℕ} {P : (Fin k → PAM M) → Prop} (hP : PADefN k P rfl omit [PAModel M] in -theorem paDef_subst_last {k : ℕ} {f : (Fin k → PAM M) → PAM M} +private theorem paDef_subst_last {k : ℕ} {f : (Fin k → PAM M) → PAM M} {R : (Fin (k + 1) → PAM M) → Prop} (hf : PAFunN k f) (hR : PADefN (k + 1) R) : PADefN k (fun args ↦ R (Fin.snoc args (f args))) := by refine paDefN_congr (fun args ↦ ?_) (paDef_ex (paDef_and hf hR)) @@ -1674,7 +1674,7 @@ theorem paFun_mBeta {k : ℕ} {fc fd fi : (Fin k → PAM M) → PAM M} PAFunN k (fun args ↦ mBeta (fc args) (fd args) (fi args)) := paFun_mod hc (paFun_add (paFun_const 1) (paFun_mul (paFun_add hi (paFun_const 1)) hd)) -theorem paBetaEq_holdsIn_iff (v : ℕ → PAM M) (c d i r : PATerm) : +private theorem paBetaEq_holdsIn_iff (v : ℕ → PAM M) (c d i r : PATerm) : PAFormula.HoldsIn v (paBetaEq c d i r) ↔ mBeta (PATerm.evalIn v c) (PATerm.evalIn v d) (PATerm.evalIn v i) = PATerm.evalIn v r := by @@ -1713,12 +1713,12 @@ theorem mBeta_singleton (val : PAM M) : mBeta val (val + 1) 0 = val := by unfold mBeta exact mod_eq_of_lt_pam ⟨1, by ring⟩ -def DvdPAM (a b : PAM M) : Prop := ∃ q : PAM M, b = a * q +private def DvdPAM (a b : PAM M) : Prop := ∃ q : PAM M, b = a * q -def BezoutPAM (a b : PAM M) : Prop := ∃ u v : PAM M, u * a = v * b + 1 +private def BezoutPAM (a b : PAM M) : Prop := ∃ u v : PAM M, u * a = v * b + 1 omit [PAModel M] in -theorem paDef_dvd {k : ℕ} {f g : (Fin k → PAM M) → PAM M} +private theorem paDef_dvd {k : ℕ} {f g : (Fin k → PAM M) → PAM M} (hf : PAFunN k f) (hg : PAFunN k g) : PADefN k (fun args ↦ DvdPAM (f args) (g args)) := by refine paDefN_congr (fun args ↦ ?_) (paDef_ex (paDef_eq (paFun_weaken hg) @@ -1726,7 +1726,7 @@ theorem paDef_dvd {k : ℕ} {f g : (Fin k → PAM M) → PAM M} simp only [DvdPAM, Fin.snoc_last, Fin.init_snoc] omit [PAModel M] in -theorem paDef_bezout {k : ℕ} {f g : (Fin k → PAM M) → PAM M} +private theorem paDef_bezout {k : ℕ} {f g : (Fin k → PAM M) → PAM M} (hf : PAFunN k f) (hg : PAFunN k g) : PADefN k (fun args ↦ BezoutPAM (f args) (g args)) := by have hu : PAFunN (k + 2) (fun b : Fin (k + 2) → PAM M ↦ b ⟨k, by omega⟩) := paFun_proj ⟨k, by omega⟩ @@ -2035,7 +2035,7 @@ theorem mBeta_concat (n₁ c₁ d₁ n₂ c₂ d₂ : PAM M) : def IsPow2Seq (c d r y : PAM M) : Prop := mBeta c d 0 = 1 ∧ (∀ j < r, mBeta c d (j + 1) = 2 * mBeta c d j) ∧ mBeta c d r = y -theorem paDef_isPow2Seq {k : ℕ} {fc fd fr fy : (Fin k → PAM M) → PAM M} +private theorem paDef_isPow2Seq {k : ℕ} {fc fd fr fy : (Fin k → PAM M) → PAM M} (hc : PAFunN k fc) (hd : PAFunN k fd) (hr : PAFunN k fr) (hy : PAFunN k fy) : PADefN k (fun a ↦ IsPow2Seq (fc a) (fd a) (fr a) (fy a)) := by have h0 : PADefN k (fun a ↦ mBeta (fc a) (fd a) 0 = 1) := @@ -2076,7 +2076,7 @@ theorem exists_pow2Seq (r : PAM M) : ∃ y c d : PAM M, IsPow2Seq c d r y := by hprev j (lt_trans hjlt (lt_succ_self_pam r₀)), hstep j hjlt] · rw [hlast, hprev j (lt_succ_self_pam j), hr] -theorem isPow2Seq_unique {c₁ d₁ r y₁ c₂ d₂ y₂ : PAM M} +private theorem isPow2Seq_unique {c₁ d₁ r y₁ c₂ d₂ y₂ : PAM M} (h₁ : IsPow2Seq c₁ d₁ r y₁) (h₂ : IsPow2Seq c₂ d₂ r y₂) : y₁ = y₂ := by have hdef : PADef1 (fun j : PAM M ↦ j ≤ r → mBeta c₁ d₁ j = mBeta c₂ d₂ j) := paDef_imp (paDef_le (paFun_proj 0) (paFun_const r)) @@ -2092,7 +2092,7 @@ theorem isPow2Seq_unique {c₁ d₁ r y₁ c₂ d₂ y₂ : PAM M} noncomputable def mPow2 (r : PAM M) : PAM M := Classical.choose (exists_pow2Seq r) -theorem exists_isPow2Seq_mPow2 (r : PAM M) : ∃ c d : PAM M, IsPow2Seq c d r (mPow2 r) := +private theorem exists_isPow2Seq_mPow2 (r : PAM M) : ∃ c d : PAM M, IsPow2Seq c d r (mPow2 r) := Classical.choose_spec (exists_pow2Seq r) theorem paFun_mPow2 {k : ℕ} {fr : (Fin k → PAM M) → PAM M} (hr : PAFunN k fr) : @@ -2210,7 +2210,7 @@ theorem mRep0_add (a b R : PAM M) : mRep0 (a + b) R = mRep0 a (mRep0 b R) := by theorem mRep1_zero (R : PAM M) : mRep1 0 R = R := by simp [mRep1] -theorem mRep1_add_one (r R : PAM M) : mRep1 r R + 1 = mPow2 r * (R + 1) := by +private theorem mRep1_add_one (r R : PAM M) : mRep1 r R + 1 = mPow2 r * (R + 1) := by unfold mRep1 have h1 := sub_add_cancel_pam (one_le_mPow2 r) calc mPow2 r * R + (mPow2 r - 1) + 1 @@ -2324,7 +2324,7 @@ private theorem pzPackCfg_fresh_le (q h x y : ℕ) (hx : x < 10) (hy : y < 10) : simp only [pzPackCfg, PAZFTerm.freshVar] omega -theorem paStep_holdsIn_iff {states : ℕ} (tm : Machine states 2) (v : ℕ → PAM M) : +private theorem paStep_holdsIn_iff {states : ℕ} (tm : Machine states 2) (v : ℕ → PAM M) : PAFormula.HoldsIn v (paStep tm) ↔ ∃ c c' : MCfg states M, v 4 = mEncodeCfg c ∧ v 5 = mEncodeCfg c' ∧ mStep tm c = some c' := by @@ -2470,7 +2470,7 @@ theorem paStep_holdsIn_iff {states : ℕ} (tm : Machine states 2) (v : ℕ → P hv7', hv9', h'] exact (mCons_mBit_mHalf R).symm -theorem paHalted_holdsIn_iff {states : ℕ} (tm : Machine states 2) (v : ℕ → PAM M) : +private theorem paHalted_holdsIn_iff {states : ℕ} (tm : Machine states 2) (v : ℕ → PAM M) : PAFormula.HoldsIn v (paHalted tm) ↔ ∃ c : MCfg states M, v 4 = mEncodeCfg c ∧ mStep tm c = none := by unfold paHalted @@ -2536,7 +2536,7 @@ def mHalts (M : Type*) [PAStructure M] [PAModel M] {states : ℕ} [NeZero states (tm : Machine states 2) : Prop := mHaltsFrom tm (mInit : MCfg states M) -theorem paDef_mStepCode {states : ℕ} (tm : Machine states 2) {k : ℕ} +private theorem paDef_mStepCode {states : ℕ} (tm : Machine states 2) {k : ℕ} {fx fy : (Fin k → PAM M) → PAM M} (hx : PAFunN k fx) (hy : PAFunN k fy) : PADefN k (fun a ↦ ∃ x y : MCfg states M, fx a = mEncodeCfg x ∧ fy a = mEncodeCfg y ∧ mStep tm x = some y) := by @@ -2943,7 +2943,7 @@ theorem mHalf_embedHalf (L : ListBlank (Fin 2)) : rfl rw [h, mHalf_mCons] -theorem mStep_embedCfg_some {states : ℕ} {tm : Machine states 2} {c c' : Cfg states 2} +private theorem mStep_embedCfg_some {states : ℕ} {tm : Machine states 2} {c c' : Cfg states 2} (h : step tm c = some c') : mStep tm (embedCfg (M := M) c) = some (embedCfg (M := M) c') := by rcases c with ⟨q, hd, L, R⟩ @@ -3165,7 +3165,7 @@ def MZFInconsistent (M : Type*) [PAStructure M] [PAModel M] : Prop := (∀ i ≤ n, MIsZFStep c d i (mBeta c d i)) ∧ mBeta c d n = mZfMem 0 0 -theorem paIsZFStep_holdsIn_iff (v : ℕ → PAM M) : +private theorem paIsZFStep_holdsIn_iff (v : ℕ → PAM M) : PAFormula.HoldsIn v paIsZFStep ↔ MIsZFStep (v 1) (v 2) (v 3) (v 4) := by unfold paIsZFStep MIsZFStep MIsZFAxiom rw [paDisjList_holdsIn_iff] diff --git a/Cryptids/Semantics/PA/Zf380Internal.lean b/Cryptids/Semantics/PA/Zf380.lean similarity index 100% rename from Cryptids/Semantics/PA/Zf380Internal.lean rename to Cryptids/Semantics/PA/Zf380.lean diff --git a/Cryptids/Semantics/PA/Zf393BackendInternal.lean b/Cryptids/Semantics/PA/Zf393/Backend.lean similarity index 100% rename from Cryptids/Semantics/PA/Zf393BackendInternal.lean rename to Cryptids/Semantics/PA/Zf393/Backend.lean diff --git a/Cryptids/Semantics/PA/Zf393ProgramInternal.lean b/Cryptids/Semantics/PA/Zf393/Program.lean similarity index 99% rename from Cryptids/Semantics/PA/Zf393ProgramInternal.lean rename to Cryptids/Semantics/PA/Zf393/Program.lean index c0daea70..6c385de4 100644 --- a/Cryptids/Semantics/PA/Zf393ProgramInternal.lean +++ b/Cryptids/Semantics/PA/Zf393/Program.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. -/ module -public import Cryptids.Semantics.PA.Zf393BackendInternal +public import Cryptids.Semantics.PA.Zf393.Backend /-! # Internal `PA` Layer 2 Program & Spine Verification for `zf_393` @@ -26,8 +26,6 @@ open ConjectureMachines.Zf393 open ConjectureMachines.Zf393.Layer2 open PAM -set_option maxRecDepth 200000 - section ProgramInternal variable {M : Type*} [PAStructure M] [PAModel M] @@ -2857,6 +2855,7 @@ noncomputable def mRpnZf393AllClausesOp (s : MWffState M) : MWffState M := noncomputable def mRpnZf393AllClauses (top stk ac p1 p2 p3 : PAM M) : MWffState M := mRpnZf393AllClausesOp ⟨top, stk, ac, p1, p2, p3⟩ +set_option maxRecDepth 50000 in theorem mWffSpineEval_13_123 : MWffSpineEval (M := M) 13 123 mRpnZf393AllClausesOp := mWffSpineEval_trans mWffSpineEval_13_21 <| mWffSpineEval_trans mWffSpineEval_21_29 <| @@ -3065,7 +3064,11 @@ private theorem add_natCast_eq_pamSuccChain (d : PAM M) : private theorem natCast_eq_pamSuccChain (k : ℕ) : (k : PAM M) = pamSuccChain k 0 := by simpa using add_natCast_eq_pamSuccChain (0 : PAM M) k -set_option linter.flexible false in +@[simp] +private theorem prod_mk_ite {α β : Type*} (c : Prop) [Decidable c] (a b : α) (y : β) : + (if c then a else b, y) = if c then (a, y) else (b, y) := by + split_ifs <;> rfl + theorem mRpnZf393AllClauses_eq_mZf393ClauseDispatch (topwff wffstack ac p1 p2 p3 : PAM M) : let out := mRpnZf393AllClauses topwff wffstack ac p1 p2 p3 (out.topwff, out.wffstack) = mZf393ClauseDispatch topwff wffstack ac p1 p2 p3 := by @@ -3086,8 +3089,6 @@ theorem mRpnZf393AllClauses_eq_mZf393ClauseDispatch (topwff wffstack ac p1 p2 p3 unfold mRpnZf393AllClauses mRpnZf393AllClausesOp simp [mRpnVk, mRpnClauseDET, mRpnDetCheck, mRpnClauseGEN, mRpnCparam2, mRpnCparam3, mRpnPar1, mRpnPar3] - all_goals - try (split_ifs <;> rfl) · have hne : ∀ (n : ℕ), n < 20 → ac ≠ (n : PAM M) := fun n hn heq ↦ not_lt_of_ge hge20 (heq ▸ natCast_lt_iff.mpr hn) unfold mZf393ClauseDispatch diff --git a/Cryptids/Semantics/PA/Zf393SoundnessInternal.lean b/Cryptids/Semantics/PA/Zf393/Soundness.lean similarity index 99% rename from Cryptids/Semantics/PA/Zf393SoundnessInternal.lean rename to Cryptids/Semantics/PA/Zf393/Soundness.lean index ab1b78c1..69b5e050 100644 --- a/Cryptids/Semantics/PA/Zf393SoundnessInternal.lean +++ b/Cryptids/Semantics/PA/Zf393/Soundness.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. -/ module -public import Cryptids.Semantics.PA.Zf393ProgramInternal -public import Cryptids.Semantics.PA.Zf380Internal +public import Cryptids.Semantics.PA.Zf393.Program +public import Cryptids.Semantics.PA.Zf380 /-! # Internalized `ZF` Soundness & Completeness of `zf_393` and `zf_380` in `PA` diff --git a/Cryptids/Semantics/README.md b/Cryptids/Semantics/README.md index 951d4aa8..29150438 100644 --- a/Cryptids/Semantics/README.md +++ b/Cryptids/Semantics/README.md @@ -367,7 +367,7 @@ Care is required when interpreting a Lean theorem of type `Halts M ↔ ZFInconsi 3. **Metamathematical scope — Lean's type theory, `PA`/`ZF` internalization, and `ZF`-independence:** Care must also be taken not to conflate a constructive Lean theorem `Halts M ↔ ZFInconsistent` with a formal proof of $\mathrm{ZF}$-independence: - **Strength of constructive Lean (`CIC` vs. `PA`/`ZF`):** Even without `Classical.choice` or Excluded Middle, Lean's Calculus of Inductive Constructions provides constructions absent from first-order $\mathrm{PA}$ and $\mathrm{ZF}$—an impredicative `Prop`, inductive families (`ZFProvable`, `Acc`, `PSet`), and a predicative universe hierarchy `Type u` (already strong enough to validate Zermelo set theory, and whether axiom-free `CIC` itself proves $\operatorname{Con}(\mathrm{ZF})$ remains an open question; see [`digama0/ConZF`](https://github.com/digama0/ConZF)). An axiom check in Lean therefore blocks classical `Con(ZF)` shortcuts, rather than restricting reasoning to $\mathrm{PA}$ or $\mathrm{ZF}$. - - **Internalizing the reduction inside first-order `PA` (`PAProvable`):** Our constructive Lean proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` establish a meta-level correspondence in Lean. To formulate and verify object-level provability inside weak first-order arithmetic—whose consistency strength is strictly below $\mathrm{ZF}$, so it cannot trivialize $\operatorname{Con}(\mathrm{ZF})$—Section 6 ([`Cryptids/Semantics/PA/`](./PA/)) deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`), proves constructive consistency (`not_paProvable_false : ¬ PAProvable .bot`), proves constructive standard-model adequacy of the $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), proves Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`), and internalizes the entire Layer 1–3 verification of `zf_393` and `zf_380` inside `PAProvable` (`paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, and `paProvable_halts_zf380_iff_zfInconsistent`). + - **Internalizing the reduction inside first-order `PA` (`PAProvable`):** Our constructive Lean proofs of `ZFInconsistent → Halts M` and `Halts M → ZFInconsistent` establish a meta-level correspondence in Lean. To formulate and verify object-level provability inside weak first-order arithmetic—whose consistency strength is strictly below $\mathrm{ZF}$, so it cannot trivialize $\operatorname{Con}(\mathrm{ZF})$—Section 6 ([`Cryptids/Semantics/PA/`](./PA/)) deeply embeds first-order Peano Arithmetic (`PATerm`, `PAFormula`, `PAProvable`), proves constructive consistency (`not_paProvable_false : ¬ PAProvable .bot`), proves constructive standard-model adequacy of the $\Sigma_1^0$ encodings `paHalts M` and `paZFInconsistent` (`paHalts_holds_iff_halts`, `paZFInconsistent_holds_iff_zfInconsistent`), and internalizes the entire Layer 1–3 verification of `zf_393` and `zf_380` inside `PAProvable` (`paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, and `paProvable_halts_zf380_iff_zfInconsistent`; `zf_432` is not yet internalized in `PA`). Note why these three `PAProvable` theorems live in the classical `comparator` gates (`pa_semantics.json`, `all.json`) rather than `constructive.json`: instead of constructing raw Hilbert proof trees directly, we carry out the argument in an arbitrary first-order model `[PAModel M]` via `PAM.ind1` and reflect to syntactic `PAProvable` via Gödel–Henkin completeness (`paProvable_iff_holdsIn_all_models`), whose Henkin–Lindenbaum maximal consistent extension uses `Classical.choice`. Using `Classical.choice` in the meta-proof does not create a `Con(ZF)` shortcut here because the conclusion `PAProvable ((paHalts M).iff paZFInconsistent)` asserts syntactic derivability inside weak first-order `PA` (which cannot prove `¬ paZFInconsistent` if `ZF` is consistent). - **Assumptions required for both directions of `ZF`-independence:** Even once $\mathrm{ZF} \vdash \ulcorner \operatorname{Halts}(M) \leftrightarrow \neg\operatorname{Con}(\mathrm{ZF}) \urcorner$ is established, $\operatorname{Con}(\mathrm{ZF})$ alone yields only **one** direction of independence: $\mathrm{ZF} \nvdash \neg\ulcorner\operatorname{Halts}(M)\urcorner$ (by Gödel's Second Incompleteness Theorem). Ruling out the **other** direction, $\mathrm{ZF} \vdash \ulcorner\operatorname{Halts}(M)\urcorner$ (since $\mathrm{ZF} + \neg\operatorname{Con}(\mathrm{ZF})$ can still be consistent when $\mathrm{ZF}$ is consistent), requires $\operatorname{Con}(\mathrm{ZF} + \operatorname{Con}(\mathrm{ZF}))$—for example $\Sigma_1$-soundness ($1$-consistency) of $\mathrm{ZF}$, as assumed in Yedidia & Aaronson (2016). ### Formal Discovery of the `B6a` Register-Restoration Bug in `zf_432_wade.tm` @@ -518,10 +518,16 @@ closed $\Sigma_1^0$ sentences `paHalts M` and `paZFInconsistent`. In [`Cryptids/Semantics/PA.lean`](./PA.lean) and its eight submodules ([`PA/Syntax.lean`](./PA/Syntax.lean), [`PA/Adequacy.lean`](./PA/Adequacy.lean), [`PA/Completeness.lean`](./PA/Completeness.lean), -[`PA/Arithmetic.lean`](./PA/Arithmetic.lean), [`PA/Zf380Internal.lean`](./PA/Zf380Internal.lean), -[`PA/Zf393BackendInternal.lean`](./PA/Zf393BackendInternal.lean), -[`PA/Zf393ProgramInternal.lean`](./PA/Zf393ProgramInternal.lean), and -[`PA/Zf393SoundnessInternal.lean`](./PA/Zf393SoundnessInternal.lean)), we prove: +[`PA/Arithmetic.lean`](./PA/Arithmetic.lean), [`PA/Zf380.lean`](./PA/Zf380.lean), +[`PA/Zf393/Backend.lean`](./PA/Zf393/Backend.lean), +[`PA/Zf393/Program.lean`](./PA/Zf393/Program.lean), and +[`PA/Zf393/Soundness.lean`](./PA/Zf393/Soundness.lean)), we prove the seven [`Challenge.lean`](../../Challenge.lean) +target theorems audited via [`comparator/pa_semantics.json`](../../comparator/pa_semantics.json) +(the first three also constructive in [`comparator/constructive.json`](../../comparator/constructive.json)), +together with the internal Gödel–Henkin completeness theorem `paProvable_iff_holdsIn_all_models` +(`PAModel` is kept outside `Challenge.lean` so the trusted specification stays purely syntactic, while +`comparator` transitively kernel-checks `paProvable_iff_holdsIn_all_models` via the three +`paProvable_halts_*` targets): ```lean theorem not_paProvable_false : @@ -573,10 +579,10 @@ theorem paProvable_halts_zf380_iff_zfInconsistent : (`mPair`/`mUnpair`), and semantic model bridges (`paHalts_holdsIn_iff`, `paZFInconsistent_holdsIn_iff`) inside arbitrary first-order `PAModel`s via first-order induction (`PAM.ind1`, `PAM.strong_ind1`). -5. **Internalized `zf_380 ↔ zf_393` State Reduction ([`PA/Zf380Internal.lean`](./PA/Zf380Internal.lean))**: +5. **Internalized `zf_380 ↔ zf_393` State Reduction ([`PA/Zf380.lean`](./PA/Zf380.lean))**: Lifts the 39,753-step bootstrap equality (`Σ₁`-absoluteness) and 5-cell sliding-window lockstep simulation to arbitrary `PAM M`, proving `paProvable_halts_zf380_iff_zf393`. -6. **Internalized Layer 1–3 `zf_393` & `zf_380` Verification ([`PA/Zf393BackendInternal.lean`](./PA/Zf393BackendInternal.lean), [`PA/Zf393ProgramInternal.lean`](./PA/Zf393ProgramInternal.lean), & [`PA/Zf393SoundnessInternal.lean`](./PA/Zf393SoundnessInternal.lean))**: +6. **Internalized Layer 1–3 `zf_393` & `zf_380` Verification ([`PA/Zf393/Backend.lean`](./PA/Zf393/Backend.lean), [`PA/Zf393/Program.lean`](./PA/Zf393/Program.lean), & [`PA/Zf393/Soundness.lean`](./PA/Zf393/Soundness.lean))**: Internalizes the moving-`00` unary register backend (`mZfRootCfg`), all 324 control-DAG states and 20 reordered `ZF` axiom/rule clauses along the 125-step `main()` spine, and bidirectional soundness and completeness against `MZFInconsistent M`, yielding diff --git a/README.md b/README.md index 6784b5e3..2b036fa7 100644 --- a/README.md +++ b/README.md @@ -14,7 +14,7 @@ This repository contains two Lean 4 (`v4.35.0-rc4`) formalization libraries for 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)). -- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** First-order `PA` soundness, Gödel–Henkin completeness, and object-level `PAProvable` proofs that `zf_380` and `zf_393` halt iff `ZF` is inconsistent (`paProvable_sound_nat`, `paProvable_iff_holdsIn_all_models`, `paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent`), set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json), [`comparator/pa_semantics.json`](comparator/pa_semantics.json), and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). +- **Classical (`["propext", "Classical.choice", "Quot.sound"]`):** First-order `PA` standard-model soundness and object-level `PAProvable` proofs that `zf_380` and `zf_393` halt iff `ZF` is inconsistent (`paProvable_sound_nat`, `paProvable_halts_zf380_iff_zf393`, `paProvable_halts_zf393_iff_zfInconsistent`, `paProvable_halts_zf380_iff_zfInconsistent`; proved semantically in arbitrary `PAModel`s via first-order induction and reflected to `PAProvable` via internal Gödel–Henkin completeness `paProvable_iff_holdsIn_all_models`, which uses `Classical.choice`), set-theoretic soundness and non-halting in `ZFSet.{0}` (`zfProvable_sound_zfSet`, `not_zfInconsistent`, `not_halts_zf393`, `not_halts_candidate`), negated-$\Pi_1^0$ Goldbach equivalence (`¬ GoldbachConjecture`, which uses Markov's Principle), the arithmetic-stage `riemann_95` reduction (`Nat.Prime`), complex-analytic `RiemannHypothesis` equivalences, and the `BB(6)` and `BB(3, 3)` holdout reductions, audited via [`comparator/all.json`](comparator/all.json), [`comparator/pa_semantics.json`](comparator/pa_semantics.json), and [`comparator/busy_beaver.json`](comparator/busy_beaver.json). The [95-state Riemann machine](artifacts/riemann_95/README.md) has a kernel-checked blank-tape halting equivalence to the 104-state machine and to `¬ RiemannHypothesis`.