gdp-wired 0.16.0 → 0.18.0

package/dist/lean-kernel/library.js

@@ -2,6 +2,7 @@
 export const leanLibrary = {
     "Cert.lean": "/-\nCert: the trusted core of gdp-wired, with its proofs. Lean 4.34.0, core only.\n\nA row `Σ cᵢ·xᵢ + c ≤ 0` over the integers. A certificate is a list of steps that replays into rows: an input row, a\npositive combination of two earlier rows, or a cut (an earlier row whose coefficients are all g times q, replaced by q\nwith a constant c such that g·c ≤ constant + g − 1). `check` accepts when the last row has only zero coefficients and a\npositive constant. `sound`: if `check` accepts, no integer point satisfies every input row.\n\nA row holds its nonzero coefficients alone (column, coefficient), in column order, so a step costs a row's nonzeros\nrather than the table's width. Any list reads as a sum (`dot`); sorted lists stay sorted and cancel to [] under `addL`.\n\n`run_preserves` is the induction rule a step machine's laws rest on: a property true at the start and preserved by\nevery step holds after every sequence of steps.\n-/\n\nnamespace Cert\n\nstructure Row where\n  coefs : List (Nat × Int)\n  const : Int\nderiving Repr\n\ndef dot : List (Nat × Int) → List Int → Int\n  | [], _ => 0\n  | p :: rest, x => p.2 * x.getD p.1 0 + dot rest x\n\ndef eval (r : Row) (x : List Int) : Int := dot r.coefs x + r.const\n\n-- Two sorted lists merged, coefficients of one column added (a column that cancels dropped). The fuel only bounds the\n-- recursion: out of it, the lists are put side by side, which reads the same.\ndef addF : Nat → List (Nat × Int) → List (Nat × Int) → List (Nat × Int)\n  | 0, a, b => a ++ b\n  | _ + 1, [], b => b\n  | _ + 1, a, [] => a\n  | n + 1, p :: as, q :: bs =>\n    if p.1 < q.1 then p :: addF n as (q :: bs)\n    else if q.1 < p.1 then q :: addF n (p :: as) bs\n    else if p.2 + q.2 = 0 then addF n as bs else (p.1, p.2 + q.2) :: addF n as bs\n\ndef addL (a b : List (Nat × Int)) : List (Nat × Int) := addF (a.length + b.length) a b\n\ndef scaleL (m : Int) (a : List (Nat × Int)) : List (Nat × Int) := if m = 0 then [] else a.map (fun p => (p.1, m * p.2))\n\ndef allZero : List (Nat × Int) → Bool\n  | [] => true\n  | p :: a => p.2 == 0 && allZero a\n\ntheorem dot_app (x : List Int) : ∀ (a b : List (Nat × Int)), dot (a ++ b) x = dot a x + dot b x\n  | [], b => by simp [dot]\n  | p :: a, b => by simp only [List.cons_append, dot, dot_app x a b]; omega\n\ntheorem dot_addF (x : List Int) : ∀ (n : Nat) (a b : List (Nat × Int)), dot (addF n a b) x = dot a x + dot b x\n  | 0, a, b => by simp only [addF, dot_app]\n  | _ + 1, [], b => by simp [addF, dot]\n  | _ + 1, _ :: _, [] => by simp [addF, dot]\n  | n + 1, p :: as, q :: bs => by\n    simp only [addF]\n    split\n    · simp only [dot, dot_addF x n as (q :: bs)]; omega\n    · split\n      · simp only [dot, dot_addF x n (p :: as) bs]; omega\n      · have hpq : p.1 = q.1 := by omega\n        split\n        · rename_i hz\n          simp only [dot, dot_addF x n as bs, hpq]\n          have : p.2 * x.getD q.1 0 + q.2 * x.getD q.1 0 = 0 := by rw [← Int.add_mul, hz, Int.zero_mul]\n          omega\n        · simp only [dot, dot_addF x n as bs, hpq, Int.add_mul]; omega\n\ntheorem dot_addL (a b : List (Nat × Int)) (x : List Int) : dot (addL a b) x = dot a x + dot b x := dot_addF x _ a b\n\ntheorem dot_map (m : Int) (x : List Int) : ∀ (a : List (Nat × Int)), dot (a.map (fun p => (p.1, m * p.2))) x = m * dot a x\n  | [] => by simp [dot]\n  | p :: a => by simp only [List.map_cons, dot, dot_map m x a, Int.mul_add, Int.mul_assoc]\n\ntheorem dot_scaleL (m : Int) (a : List (Nat × Int)) (x : List Int) : dot (scaleL m a) x = m * dot a x := by\n  unfold scaleL\n  split\n  · rename_i h; subst h; simp [dot]\n  · exact dot_map m x a\n\ntheorem dot_allZero : ∀ (a : List (Nat × Int)) (x : List Int), allZero a = true → dot a x = 0\n  | [], _, _ => rfl\n  | p :: a, x, h => by\n    simp only [allZero, Bool.and_eq_true, beq_iff_eq] at h\n    simp [dot, h.1, dot_allZero a x h.2]\n\ninductive Step where\n  | input (i : Nat)\n  | combine (a b : Nat) (ma mb : Int)\n  | cut (of : Nat) (g : Int) (q : List (Nat × Int)) (c : Int)\nderiving Repr\n\ndef combineRow (ma mb : Int) (A B : Row) : Row :=\n  ⟨addL (scaleL ma A.coefs) (scaleL mb B.coefs), ma * A.const + mb * B.const⟩\n\ndef cutOk (A : Row) (g : Int) (q : List (Nat × Int)) (c : Int) : Bool :=\n  decide (1 ≤ g) && decide (A.coefs = scaleL g q) && decide (g * c ≤ A.const + g - 1)\n\n-- The rows so far kept newest first, with their number (step i's row is at n − 1 − i): a row is put on the front and\n-- read where it is, never past a chain of appends.\ndef replay (inputs : List Row) : List Step → Nat → List Row → Option (List Row)\n  | [], _, rows => some rows\n  | .input i :: ss, n, rows =>\n    match inputs[i]? with\n    | some r => replay inputs ss (n + 1) (r :: rows)\n    | none => none\n  | .combine a b ma mb :: ss, n, rows =>\n    match rows[n - 1 - a]?, rows[n - 1 - b]? with\n    | some A, some B => if a < n ∧ b < n ∧ 0 < ma ∧ 0 < mb then replay inputs ss (n + 1) (combineRow ma mb A B :: rows) else none\n    | _, _ => none\n  | .cut o g q c :: ss, n, rows =>\n    match rows[n - 1 - o]? with\n    | some A => if o < n ∧ cutOk A g q c then replay inputs ss (n + 1) (⟨q, c⟩ :: rows) else none\n    | none => none\n\ndef check (inputs : List Row) (steps : List Step) : Bool :=\n  match replay inputs steps 0 [] with\n  | some rows =>\n    match rows.head? with\n    | some r => allZero r.coefs && decide (0 < r.const)\n    | none => false\n  | none => false\n\ntheorem cut_sound (g d c c' : Int) (hg : 1 ≤ g) (h : g * d + c ≤ 0) (hc : g * c' ≤ c + g - 1) : d + c' ≤ 0 := by\n  have hd : g * (d + c') = g * d + g * c' := Int.mul_add g d c'\n  refine Int.not_lt.mp (fun h1 => ?_)\n  have h2 : g * 1 ≤ g * (d + c') := Int.mul_le_mul_of_nonneg_left (by omega) (by omega)\n  omega\n\n-- Every row a replay produces holds wherever the inputs and the rows so far hold.\ntheorem replay_holds (inputs : List Row) (x : List Int) (hx : ∀ r ∈ inputs, eval r x ≤ 0) :\n    ∀ (ss : List Step) (n : Nat) (rows out : List Row), (∀ r ∈ rows, eval r x ≤ 0) →\n      replay inputs ss n rows = some out → ∀ r ∈ out, eval r x ≤ 0 := by\n  intro ss\n  induction ss with\n  | nil =>\n    intro n rows out hrows h\n    simp only [replay, Option.some.injEq] at h\n    exact h ▸ hrows\n  | cons s ss ih =>\n    intro n rows out hrows h\n    cases s with\n    | input i =>\n      simp only [replay] at h\n      split at h\n      · rename_i r hr\n        refine ih _ _ out ?_ h\n        intro r' hr'\n        rcases List.mem_cons.mp hr' with hr' | hr'\n        · exact hr' ▸ hx r (List.mem_of_getElem? hr)\n        · exact hrows r' hr'\n      · exact absurd h (by simp)\n    | combine a b ma mb =>\n      simp only [replay] at h\n      split at h\n      · rename_i A B hA hB\n        split at h\n        · rename_i hm\n          refine ih _ _ out ?_ h\n          intro r' hr'\n          rcases List.mem_cons.mp hr' with hr' | hr'\n          · subst hr'\n            have eA := hrows A (List.mem_of_getElem? hA)\n            have eB := hrows B (List.mem_of_getElem? hB)\n            simp only [eval, combineRow, dot_addL, dot_scaleL] at eA eB ⊢\n            have h1 : ma * (dot A.coefs x + A.const) ≤ ma * 0 := Int.mul_le_mul_of_nonneg_left eA (by omega)\n            have h2 : mb * (dot B.coefs x + B.const) ≤ mb * 0 := Int.mul_le_mul_of_nonneg_left eB (by omega)\n            simp only [Int.mul_add, Int.mul_zero] at h1 h2\n            omega\n          · exact hrows r' hr'\n        · exact absurd h (by simp)\n      · exact absurd h (by simp)\n    | cut o g q c =>\n      simp only [replay] at h\n      split at h\n      · rename_i A hA\n        split at h\n        · rename_i hok\n          refine ih _ _ out ?_ h\n          intro r' hr'\n          rcases List.mem_cons.mp hr' with hr' | hr'\n          · subst hr'\n            simp only [cutOk, Bool.and_eq_true, decide_eq_true_eq] at hok\n            obtain ⟨_, ⟨hg, hq⟩, hc⟩ := hok\n            have eA := hrows A (List.mem_of_getElem? hA)\n            have hdot : dot A.coefs x = g * dot q x := by rw [hq, dot_scaleL]\n            simp only [eval, hdot] at eA\n            exact cut_sound g (dot q x) A.const c hg eA hc\n          · exact hrows r' hr'\n        · exact absurd h (by simp)\n      · exact absurd h (by simp)\n\n/-- A certificate the checker accepts refutes its inputs: no integer point satisfies them all. -/\ntheorem sound (inputs : List Row) (steps : List Step) (h : check inputs steps = true) (x : List Int)\n    (hx : ∀ r ∈ inputs, eval r x ≤ 0) : False := by\n  simp only [check] at h\n  split at h\n  · rename_i rows hrows\n    split at h\n    · rename_i r hr\n      simp only [Bool.and_eq_true, decide_eq_true_eq] at h\n      have hall := replay_holds inputs x hx steps 0 [] rows (by simp) hrows\n      have hm : r ∈ rows := by\n        cases rows with\n        | nil => simp at hr\n        | cons a as => simp only [List.head?, Option.some.injEq] at hr; subst hr; exact List.mem_cons_self\n      have := hall r hm\n      simp only [eval, dot_allZero r.coefs x h.1] at this\n      omega\n    · exact absurd h (by simp)\n  · exact absurd h (by simp)\n\n/-- The induction rule: what holds at the start and survives every step holds after any sequence of steps. -/\ntheorem run_preserves {S I : Type} (step : S → I → S) (P : S → Prop) (start : S)\n    (h0 : P start) (hs : ∀ s i, P s → P (step s i)) : ∀ (is : List I), P (is.foldl step start) := by\n  intro is\n  induction is generalizing start with\n  | nil => exact h0\n  | cons i is ih => exact ih (step start i) (hs start i h0)\n\nend Cert\n",
     "Kernel.lean": "import Cert\n/-!\nKernel: the Lean twin of gdp-wired's kernel/kernel.ts tree check, with its soundness proof. Lean 4.34.0, core only.\n\nA goal is a variable table and hypotheses over naturals (+, ∸, × by a constant, min, max, if, map reads; ≤, <, =,\nand, or, not). A proof is a tree of splits on linear atoms, with a leaf certificate: the rows it claims, a Cert\nderivation over them, and the pairs of cells it claims equal. At a leaf the twin computes the rows the path, the\nhypotheses' facts, the naturals and the verified cell equalities give, checks every claimed row is one of them, and\nreplays the derivation with `Cert.check`. `sound`: if `checkGoal` accepts, no naturals and no maps satisfy every\nhypothesis.\n\nThe table names what each column of a row is: a variable of the environment, or a map's cell at a key (a row over\nearlier columns). Rows compare by coefficients (`same`), so the exporter's ordering doesn't matter.\n-/\n\nnamespace Kern\nopen Cert\nset_option linter.unusedSimpArgs false\nset_option linter.unusedSectionVars false\n\nmutual\ninductive E where\n  | var (i : Nat)\n  | const (n : Nat)\n  | add (a b : E)\n  | sub (a b : E)\n  | mul (k : Nat) (a : E)\n  | min (a b : E)\n  | max (a b : E)\n  | prod (a b : E)\n  | ite (c : C) (t f : E)\n  | get (m : Nat) (key : E)\ninductive C where\n  | le (a b : E)\n  | lt (a b : E)\n  | eq (a b : E)\n  | and (a b : C)\n  | or (a b : C)\n  | not (a : C)\nend\n\nderiving instance DecidableEq for E, C\n\n/-! Boolean equality of terms and conditions, by structure: what a check compares terms with (the derived DecidableEq\nbuilds a proof at each comparison, which the kernel then reduces). -/\n\nmutual\ndef beqE : E → E → Bool\n  | .var x0, .var y0 => x0 == y0\n  | .const x0, .const y0 => x0 == y0\n  | .add x0 x1, .add y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .sub x0 x1, .sub y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .mul x0 x1, .mul y0 y1 => x0 == y0 && beqE x1 y1\n  | .min x0 x1, .min y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .max x0 x1, .max y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .prod x0 x1, .prod y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .ite x0 x1 x2, .ite y0 y1 y2 => beqC x0 y0 && beqE x1 y1 && beqE x2 y2\n  | .get x0 x1, .get y0 y1 => x0 == y0 && beqE x1 y1\n  | _, _ => false\ndef beqC : C → C → Bool\n  | .le x0 x1, .le y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .lt x0 x1, .lt y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .eq x0 x1, .eq y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .and x0 x1, .and y0 y1 => beqC x0 y0 && beqC x1 y1\n  | .or x0 x1, .or y0 y1 => beqC x0 y0 && beqC x1 y1\n  | .not x0, .not y0 => beqC x0 y0\n  | _, _ => false\nend\n\nmutual\ntheorem beqE_eq : ∀ {a b : E}, beqE a b = true → a = b\n  | .var x0, .var y0, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h]\n  | .const x0, .const y0, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h]\n  | .add x0 x1, .add y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .sub x0 x1, .sub y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .mul x0 x1, .mul y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h.1, beqE_eq h.2]\n  | .min x0 x1, .min y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .max x0 x1, .max y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .prod x0 x1, .prod y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .ite x0 x1 x2, .ite y0 y1 y2, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1.1, beqE_eq h.1.2, beqE_eq h.2]\n  | .get x0 x1, .get y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h.1, beqE_eq h.2]\n  | .var _, .const _, h => by simp [beqE] at h\n  | .var _, .add _ _, h => by simp [beqE] at h\n  | .var _, .sub _ _, h => by simp [beqE] at h\n  | .var _, .mul _ _, h => by simp [beqE] at h\n  | .var _, .min _ _, h => by simp [beqE] at h\n  | .var _, .max _ _, h => by simp [beqE] at h\n  | .var _, .prod _ _, h => by simp [beqE] at h\n  | .var _, .ite _ _ _, h => by simp [beqE] at h\n  | .var _, .get _ _, h => by simp [beqE] at h\n  | .const _, .var _, h => by simp [beqE] at h\n  | .const _, .add _ _, h => by simp [beqE] at h\n  | .const _, .sub _ _, h => by simp [beqE] at h\n  | .const _, .mul _ _, h => by simp [beqE] at h\n  | .const _, .min _ _, h => by simp [beqE] at h\n  | .const _, .max _ _, h => by simp [beqE] at h\n  | .const _, .prod _ _, h => by simp [beqE] at h\n  | .const _, .ite _ _ _, h => by simp [beqE] at h\n  | .const _, .get _ _, h => by simp [beqE] at h\n  | .add _ _, .var _, h => by simp [beqE] at h\n  | .add _ _, .const _, h => by simp [beqE] at h\n  | .add _ _, .sub _ _, h => by simp [beqE] at h\n  | .add _ _, .mul _ _, h => by simp [beqE] at h\n  | .add _ _, .min _ _, h => by simp [beqE] at h\n  | .add _ _, .max _ _, h => by simp [beqE] at h\n  | .add _ _, .prod _ _, h => by simp [beqE] at h\n  | .add _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .add _ _, .get _ _, h => by simp [beqE] at h\n  | .sub _ _, .var _, h => by simp [beqE] at h\n  | .sub _ _, .const _, h => by simp [beqE] at h\n  | .sub _ _, .add _ _, h => by simp [beqE] at h\n  | .sub _ _, .mul _ _, h => by simp [beqE] at h\n  | .sub _ _, .min _ _, h => by simp [beqE] at h\n  | .sub _ _, .max _ _, h => by simp [beqE] at h\n  | .sub _ _, .prod _ _, h => by simp [beqE] at h\n  | .sub _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .sub _ _, .get _ _, h => by simp [beqE] at h\n  | .mul _ _, .var _, h => by simp [beqE] at h\n  | .mul _ _, .const _, h => by simp [beqE] at h\n  | .mul _ _, .add _ _, h => by simp [beqE] at h\n  | .mul _ _, .sub _ _, h => by simp [beqE] at h\n  | .mul _ _, .min _ _, h => by simp [beqE] at h\n  | .mul _ _, .max _ _, h => by simp [beqE] at h\n  | .mul _ _, .prod _ _, h => by simp [beqE] at h\n  | .mul _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .mul _ _, .get _ _, h => by simp [beqE] at h\n  | .min _ _, .var _, h => by simp [beqE] at h\n  | .min _ _, .const _, h => by simp [beqE] at h\n  | .min _ _, .add _ _, h => by simp [beqE] at h\n  | .min _ _, .sub _ _, h => by simp [beqE] at h\n  | .min _ _, .mul _ _, h => by simp [beqE] at h\n  | .min _ _, .max _ _, h => by simp [beqE] at h\n  | .min _ _, .prod _ _, h => by simp [beqE] at h\n  | .min _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .min _ _, .get _ _, h => by simp [beqE] at h\n  | .max _ _, .var _, h => by simp [beqE] at h\n  | .max _ _, .const _, h => by simp [beqE] at h\n  | .max _ _, .add _ _, h => by simp [beqE] at h\n  | .max _ _, .sub _ _, h => by simp [beqE] at h\n  | .max _ _, .mul _ _, h => by simp [beqE] at h\n  | .max _ _, .min _ _, h => by simp [beqE] at h\n  | .max _ _, .prod _ _, h => by simp [beqE] at h\n  | .max _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .max _ _, .get _ _, h => by simp [beqE] at h\n  | .prod _ _, .var _, h => by simp [beqE] at h\n  | .prod _ _, .const _, h => by simp [beqE] at h\n  | .prod _ _, .add _ _, h => by simp [beqE] at h\n  | .prod _ _, .sub _ _, h => by simp [beqE] at h\n  | .prod _ _, .mul _ _, h => by simp [beqE] at h\n  | .prod _ _, .min _ _, h => by simp [beqE] at h\n  | .prod _ _, .max _ _, h => by simp [beqE] at h\n  | .prod _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .prod _ _, .get _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .var _, h => by simp [beqE] at h\n  | .ite _ _ _, .const _, h => by simp [beqE] at h\n  | .ite _ _ _, .add _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .sub _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .mul _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .min _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .max _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .prod _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .get _ _, h => by simp [beqE] at h\n  | .get _ _, .var _, h => by simp [beqE] at h\n  | .get _ _, .const _, h => by simp [beqE] at h\n  | .get _ _, .add _ _, h => by simp [beqE] at h\n  | .get _ _, .sub _ _, h => by simp [beqE] at h\n  | .get _ _, .mul _ _, h => by simp [beqE] at h\n  | .get _ _, .min _ _, h => by simp [beqE] at h\n  | .get _ _, .max _ _, h => by simp [beqE] at h\n  | .get _ _, .prod _ _, h => by simp [beqE] at h\n  | .get _ _, .ite _ _ _, h => by simp [beqE] at h\ntheorem beqC_eq : ∀ {a b : C}, beqC a b = true → a = b\n  | .le x0 x1, .le y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .lt x0 x1, .lt y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .eq x0 x1, .eq y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .and x0 x1, .and y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1, beqC_eq h.2]\n  | .or x0 x1, .or y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1, beqC_eq h.2]\n  | .not x0, .not y0, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h]\n  | .le _ _, .lt _ _, h => by simp [beqC] at h\n  | .le _ _, .eq _ _, h => by simp [beqC] at h\n  | .le _ _, .and _ _, h => by simp [beqC] at h\n  | .le _ _, .or _ _, h => by simp [beqC] at h\n  | .le _ _, .not _, h => by simp [beqC] at h\n  | .lt _ _, .le _ _, h => by simp [beqC] at h\n  | .lt _ _, .eq _ _, h => by simp [beqC] at h\n  | .lt _ _, .and _ _, h => by simp [beqC] at h\n  | .lt _ _, .or _ _, h => by simp [beqC] at h\n  | .lt _ _, .not _, h => by simp [beqC] at h\n  | .eq _ _, .le _ _, h => by simp [beqC] at h\n  | .eq _ _, .lt _ _, h => by simp [beqC] at h\n  | .eq _ _, .and _ _, h => by simp [beqC] at h\n  | .eq _ _, .or _ _, h => by simp [beqC] at h\n  | .eq _ _, .not _, h => by simp [beqC] at h\n  | .and _ _, .le _ _, h => by simp [beqC] at h\n  | .and _ _, .lt _ _, h => by simp [beqC] at h\n  | .and _ _, .eq _ _, h => by simp [beqC] at h\n  | .and _ _, .or _ _, h => by simp [beqC] at h\n  | .and _ _, .not _, h => by simp [beqC] at h\n  | .or _ _, .le _ _, h => by simp [beqC] at h\n  | .or _ _, .lt _ _, h => by simp [beqC] at h\n  | .or _ _, .eq _ _, h => by simp [beqC] at h\n  | .or _ _, .and _ _, h => by simp [beqC] at h\n  | .or _ _, .not _, h => by simp [beqC] at h\n  | .not _, .le _ _, h => by simp [beqC] at h\n  | .not _, .lt _ _, h => by simp [beqC] at h\n  | .not _, .eq _ _, h => by simp [beqC] at h\n  | .not _, .and _ _, h => by simp [beqC] at h\n  | .not _, .or _ _, h => by simp [beqC] at h\nend\n\nmutual\ndef evalE (env : Nat → Nat) (maps : Nat → Nat → Nat) : E → Nat\n  | .var i => env i\n  | .const n => n\n  | .add a b => evalE env maps a + evalE env maps b\n  | .sub a b => evalE env maps a - evalE env maps b\n  | .mul k a => k * evalE env maps a\n  | .min a b => min (evalE env maps a) (evalE env maps b)\n  | .max a b => max (evalE env maps a) (evalE env maps b)\n  | .prod a b => evalE env maps a * evalE env maps b\n  | .ite c t f => if evalC env maps c then evalE env maps t else evalE env maps f\n  | .get m key => maps m (evalE env maps key)\ndef evalC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Bool\n  | .le a b => decide (evalE env maps a ≤ evalE env maps b)\n  | .lt a b => decide (evalE env maps a < evalE env maps b)\n  | .eq a b => decide (evalE env maps a = evalE env maps b)\n  | .and a b => evalC env maps a && evalC env maps b\n  | .or a b => evalC env maps a || evalC env maps b\n  | .not a => !evalC env maps a\nend\n\n-- A condition's meaning as a proposition: what a law says in plain Lean (`evalC_iff`). Exported laws are stated with it,\n-- so a statement like `ρ x ≤ ρ cap` is the law itself, up to unfolding.\ndef holdsC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Prop\n  | .le a b => evalE env maps a ≤ evalE env maps b\n  | .lt a b => evalE env maps a < evalE env maps b\n  | .eq a b => evalE env maps a = evalE env maps b\n  | .and a b => holdsC env maps a ∧ holdsC env maps b\n  | .or a b => holdsC env maps a ∨ holdsC env maps b\n  | .not a => ¬ holdsC env maps a\n\ntheorem evalC_iff (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ c, evalC env maps c = true ↔ holdsC env maps c\n  | .le a b => by simp [evalC, holdsC]\n  | .lt a b => by simp [evalC, holdsC]\n  | .eq a b => by simp [evalC, holdsC]\n  | .and a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .or a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .not a => by\n    have h := evalC_iff env maps a\n    simp only [evalC, holdsC]\n    cases hb : evalC env maps a <;> simp_all\n\n/-! Linear forms are Cert rows: `eval r x = dot r.coefs x + r.const`. -/\n\ndef lconst (n : Int) : Row := ⟨[], n⟩\ndef ladd (a b : Row) : Row := ⟨addL a.coefs b.coefs, a.const + b.const⟩\ndef lscale (m : Int) (a : Row) : Row := ⟨scaleL m a.coefs, m * a.const⟩\ndef lsub (a b : Row) : Row := ladd a (lscale (-1) b)\ndef lunit (j : Nat) : Row := ⟨[(j, 1)], 0⟩\n-- A row as the exporters write it: its nonzero coefficients (column, coefficient), in column order, and its constant.\ndef sp (cs : List (Nat × Int)) (c : Int) : Row := ⟨cs, c⟩\ndef same (a b : Row) : Bool := allZero (lsub a b).coefs && (lsub a b).const == 0\n-- 1 − a: over the integers, a ≤ 0 fails exactly when 1 − a ≤ 0 holds.\ndef flip (a : Row) : Row := lsub (lconst 1) a\n\ntheorem eval_lconst (n : Int) (x : List Int) : eval (lconst n) x = n := by\n  cases x <;> simp [eval, lconst, dot]\ntheorem eval_ladd (a b : Row) (x : List Int) : eval (ladd a b) x = eval a x + eval b x := by\n  simp only [eval, ladd, dot_addL]; omega\ntheorem eval_lscale (m : Int) (a : Row) (x : List Int) : eval (lscale m a) x = m * eval a x := by\n  simp only [eval, lscale, dot_scaleL, Int.mul_add]\ntheorem eval_lsub (a b : Row) (x : List Int) : eval (lsub a b) x = eval a x - eval b x := by\n  simp only [lsub, eval_ladd, eval_lscale]; omega\ntheorem eval_flip (a : Row) (x : List Int) : eval (flip a) x = 1 - eval a x := by\n  simp only [flip, eval_lsub, eval_lconst]\ntheorem eval_lunit (j : Nat) (x : List Int) : eval (lunit j) x = x.getD j 0 := by\n  simp [eval, lunit, dot]\ntheorem same_eval {a b : Row} (h : same a b = true) (x : List Int) : eval a x = eval b x := by\n  simp only [same, Bool.and_eq_true, beq_iff_eq] at h\n  have h1 : eval (lsub a b) x = 0 := by simp only [eval, dot_allZero _ x h.1, h.2]; rfl\n  rw [eval_lsub] at h1; omega\n\n/-! The path: atoms decided so far. `(l, true)` says l ≤ 0, `(l, false)` says l ≥ 1. -/\n\nabbrev Path := List (Row × Bool)\ndef PathHolds (path : Path) (x : List Int) : Prop := ∀ a ∈ path, decide (eval a.1 x ≤ 0) = a.2\n\ndef lookup {α : Type} (p : α → Bool) : List α → Option α\n  | [] => none\n  | a :: as => if p a then some a else lookup p as\ntheorem lookup_some {α : Type} {p : α → Bool} : ∀ {l : List α} {a : α}, lookup p l = some a → a ∈ l ∧ p a = true\n  | [], _, h => by simp [lookup] at h\n  | b :: bs, a, h => by\n    simp only [lookup] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨List.mem_cons_self, by assumption⟩\n    · have := lookup_some h; exact ⟨List.mem_cons_of_mem _ this.1, this.2⟩\n\ndef dec (path : Path) (l : Row) : Option Bool :=\n  if allZero l.coefs then some (decide (l.const ≤ 0))\n  else match lookup (fun a => same a.1 l) path with\n    | some a => some a.2\n    | none => match lookup (fun a => same a.1 (flip l)) path with\n      | some a => some (!a.2)\n      | none => none\n\ntheorem dec_sound {path : Path} {x : List Int} (hP : PathHolds path x) {l : Row} {b : Bool}\n    (h : dec path l = some b) : decide (eval l x ≤ 0) = b := by\n  simp only [dec] at h\n  split at h\n  · rename_i hz\n    simp only [Option.some.injEq] at h\n    subst h\n    simp [eval, dot_allZero _ x hz]\n  · split at h\n    · rename_i a ha\n      simp only [Option.some.injEq] at h; subst h\n      have ⟨hm, hs⟩ := lookup_some ha\n      rw [← hP a hm, same_eval hs]\n    · split at h\n      · rename_i a ha\n        simp only [Option.some.injEq] at h; subst h\n        have ⟨hm, hs⟩ := lookup_some ha\n        have := hP a hm\n        rw [same_eval hs, eval_flip] at this\n        rw [← this]\n        by_cases hl : eval l x ≤ 0 <;> simp [hl] <;> omega\n      · simp at h\n\n/-! The table: column j is a variable of the environment, or map m's cell at a key (a row over earlier columns). -/\n\ninductive VDef where\n  | var (i : Nat)\n  | cell (m : Nat) (key : Row)\n  | mono (fs : List Nat)        -- the product of earlier columns (a monomial)\n  | term (e : E)                -- a choice the path leaves open (∸, min, max, if), standing for its value\n\ndef prodV (x : List Int) : List Nat → Int\n  | [] => 1\n  | j :: js => x.getD j 0 * prodV x js\n\ndef valD (env : Nat → Nat) (maps : Nat → Nat → Nat) : VDef → List Int → Int\n  | .var i, _ => (env i : Int)\n  | .cell m k, x => (maps m (eval k x).toNat : Int)\n  | .mono fs, x => ((prodV x fs).toNat : Int)\n  | .term e, _ => (evalE env maps e : Int)\n\n-- x is a valuation of the table: each column holds what its definition says, and every value is a natural.\ndef Model (tab : List VDef) (env : Nat → Nat) (maps : Nat → Nat → Nat) (x : List Int) : Prop :=\n  (∀ j d, tab[j]? = some d → x.getD j 0 = valD env maps d x) ∧ ∀ j, 0 ≤ x.getD j 0\n\ndef findIdx {α : Type} (p : α → Bool) : List α → Option Nat\n  | [] => none\n  | a :: as => if p a then some 0 else (findIdx p as).map (· + 1)\ntheorem findIdx_some {α : Type} {p : α → Bool} : ∀ {l : List α} {j : Nat}, findIdx p l = some j → ∃ a, l[j]? = some a ∧ p a = true\n  | [], _, h => by simp [findIdx] at h\n  | b :: bs, j, h => by\n    simp only [findIdx] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨b, rfl, by assumption⟩\n    · cases hj : findIdx p bs with\n      | none => simp [hj] at h\n      | some i =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        obtain ⟨a, ha, hp⟩ := findIdx_some (l := bs) hj\n        exact ⟨a, by simpa using ha, hp⟩\n\ndef isVar (i : Nat) : VDef → Bool\n  | .var i' => i' == i\n  | _ => false\ndef isCell (m : Nat) (k : Row) : VDef → Bool\n  | .cell m' k' => m' == m && same k' k\n  | _ => false\ndef isTerm (e : E) : VDef → Bool\n  | .term e' => beqE e' e\n  | _ => false\n-- An open choice's column: the table's column for the whole term, if it has one.\ndef termCol (tab : List VDef) (e : E) : Option Row := (findIdx (isTerm e) tab).map lunit\ndef isMono (fs : List Nat) : VDef → Bool\n  | .mono fs' => fs' == fs\n  | _ => false\n\n/-! Products: monomials are columns, each the product of the columns its factors name (sorted, so one monomial is one\ncolumn). Multiplying two rows looks up the column of each product of two columns. -/\n\ndef ins (a : Nat) : List Nat → List Nat\n  | [] => [a]\n  | b :: bs => if a ≤ b then a :: b :: bs else b :: ins a bs\ndef srt : List Nat → List Nat\n  | [] => []\n  | a :: as => ins a (srt as)\n\ntheorem prodV_ins (x : List Int) (a : Nat) : ∀ l, prodV x (ins a l) = x.getD a 0 * prodV x l\n  | [] => by simp [ins, prodV]\n  | b :: bs => by\n    simp only [ins]; split\n    · rfl\n    · simp only [prodV, prodV_ins x a bs]; rw [Int.mul_left_comm]\ntheorem prodV_srt (x : List Int) : ∀ l, prodV x (srt l) = prodV x l\n  | [] => rfl\n  | a :: as => by simp only [srt, prodV_ins, prodV_srt x as, prodV]\ntheorem prodV_append (x : List Int) : ∀ l1 l2, prodV x (l1 ++ l2) = prodV x l1 * prodV x l2\n  | [], l2 => by simp [prodV]\n  | a :: as, l2 => by simp only [List.cons_append, prodV, prodV_append x as l2, Int.mul_assoc]\ntheorem prodV_nonneg {x : List Int} (h : ∀ j, 0 ≤ x.getD j 0) : ∀ l, 0 ≤ prodV x l\n  | [] => by simp [prodV]\n  | a :: as => Int.mul_nonneg (h a) (prodV_nonneg h as)\n\n-- A column's factors: a monomial's own, or the column itself (a variable, a map's cell, an open choice).\ndef fac (tab : List VDef) (i : Nat) : Option (List Nat) :=\n  match tab[i]? with\n  | some (.mono fs) => some fs\n  | some _ => some [i]\n  | none => none\ndef pcol (tab : List VDef) (i j : Nat) : Option Nat :=\n  match fac tab i, fac tab j with\n  | some a, some b => findIdx (isMono (srt (a ++ b))) tab\n  | _, _ => none\n\n-- x_i · Σ b x_j, over b's coefficients (column j, coefficient b)\ndef mulRow (tab : List VDef) (i : Nat) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | q :: bs => match mulRow tab i bs with\n    | none => none\n    | some r => if q.2 == 0 then some r else match pcol tab i q.1 with\n      | some k => some (ladd (lscale q.2 (lunit k)) r)\n      | none => none\n-- (Σ a x_i) · Σ b x_j\ndef mulRows (tab : List VDef) (bs : List (Nat × Int)) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | p :: as => match mulRows tab bs as with\n    | none => none\n    | some r => if p.2 == 0 then some r else match mulRow tab p.1 bs with\n      | some q => some (ladd (lscale p.2 q) r)\n      | none => none\ndef rowMul (tab : List VDef) (a b : Row) : Option Row :=\n  match mulRows tab b.coefs a.coefs with\n  | some p => some (ladd p (ladd (lscale a.const ⟨b.coefs, 0⟩) (ladd (lscale b.const ⟨a.coefs, 0⟩) (lconst (a.const * b.const)))))\n  | none => none\n\n\nmutual\ndef linear (tab : List VDef) (path : Path) : E → Option Row\n  | .var i => (findIdx (isVar i) tab).map lunit\n  | .const n => some (lconst n)\n  | .add a b => match linear tab path a, linear tab path b with\n    | some la, some lb => some (ladd la lb)\n    | _, _ => none\n  | .mul k a => match linear tab path a with\n    | some la => some (lscale k la)\n    | none => none\n  | .sub a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub lb la) with\n      | some true => some (lsub la lb)\n      | some false => some (lconst 0)\n      | none => termCol tab (.sub a b)\n    | _, _ => none\n  | .min a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some la\n      | some false => some lb\n      | none => termCol tab (.min a b)\n    | _, _ => none\n  | .max a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some lb\n      | some false => some la\n      | none => termCol tab (.max a b)\n    | _, _ => none\n  | .prod a b => match linear tab path a, linear tab path b with\n    | some la, some lb => rowMul tab la lb\n    | _, _ => none\n  | .ite c t f => match truth tab path c with\n    | some true => linear tab path t\n    | some false => linear tab path f\n    | none => termCol tab (.ite c t f)\n  | .get m key => match linear tab path key with\n    | some lk => (findIdx (isCell m lk) tab).map lunit\n    | none => none\ndef truth (tab : List VDef) (path : Path) : C → Option Bool\n  | .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (lsub la lb)\n    | _, _ => none\n  | .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (ladd (lsub la lb) (lconst 1))\n    | _, _ => none\n  | .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb), dec path (lsub lb la) with\n      | some false, _ => some false\n      | _, some false => some false\n      | some true, some true => some true\n      | _, _ => none\n    | _, _ => none\n  | .and a b => match truth tab path a, truth tab path b with\n    | some false, _ => some false\n    | _, some false => some false\n    | some true, some true => some true\n    | _, _ => none\n  | .or a b => match truth tab path a, truth tab path b with\n    | some true, _ => some true\n    | _, some true => some true\n    | some false, some false => some false\n    | _, _ => none\n  | .not a => match truth tab path a with\n    | some b => some (!b)\n    | none => none\nend\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem var_col (hM : Model tab env maps x) {i j : Nat} (h : findIdx (isVar i) tab = some j) : x.getD j 0 = env i := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | var i' => simp only [isVar, beq_iff_eq] at hv; subst hv; rfl\n  | _ => simp [isVar] at hv\n\ntheorem term_col (hM : Model tab env maps x) {e : E} {j : Nat} (h : findIdx (isTerm e) tab = some j) :\n    x.getD j 0 = (evalE env maps e : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | term e' => simp only [isTerm] at hv; have he := beqE_eq hv; subst he; rfl\n  | _ => simp [isTerm] at hv\n\ntheorem termCol_sound (hM : Model tab env maps x) {e : E} {l : Row} (h : termCol tab e = some l) :\n    eval l x = (evalE env maps e : Int) := by\n  simp only [termCol] at h\n  cases hj : findIdx (isTerm e) tab with\n  | none => simp [hj] at h\n  | some j => simp only [hj, Option.map_some, Option.some.injEq] at h; subst h; rw [eval_lunit, term_col hM hj]\n\ntheorem cell_col (hM : Model tab env maps x) {m j : Nat} {k : Row} (h : findIdx (isCell m k) tab = some j) :\n    x.getD j 0 = (maps m (eval k x).toNat : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | cell m' k' =>\n    simp only [isCell, Bool.and_eq_true, beq_iff_eq] at hv\n    obtain ⟨rfl, hs⟩ := hv\n    simp only [valD, same_eval hs x]\n  | _ => simp [isCell] at hv\n\ntheorem fac_val (hM : Model tab env maps x) {i : Nat} {fs : List Nat} (h : fac tab i = some fs) : x.getD i 0 = prodV x fs := by\n  simp only [fac] at h\n  split at h\n  · rename_i fs' hd\n    simp only [Option.some.injEq] at h; subst h\n    rw [hM.1 i _ hd]; simp only [valD]; exact Int.toNat_of_nonneg (prodV_nonneg hM.2 _)\n  · simp only [Option.some.injEq] at h; subst h; simp [prodV]\n  · simp at h\n\ntheorem pcol_val (hM : Model tab env maps x) {i j k : Nat} (h : pcol tab i j = some k) :\n    x.getD k 0 = x.getD i 0 * x.getD j 0 := by\n  simp only [pcol] at h\n  split at h\n  · rename_i a b ha hb\n    obtain ⟨d, hd, hv⟩ := findIdx_some h\n    cases d with\n    | mono fs =>\n      simp only [isMono, beq_iff_eq] at hv; subst hv\n      rw [hM.1 k _ hd]; simp only [valD]\n      rw [Int.toNat_of_nonneg (prodV_nonneg hM.2 _), prodV_srt, prodV_append, ← fac_val hM ha, ← fac_val hM hb]\n    | _ => simp [isMono] at hv\n  · simp at h\n\ntheorem mulRow_sound (hM : Model tab env maps x) (i : Nat) :\n    ∀ bs r, mulRow tab i bs = some r → eval r x = x.getD i 0 * dot bs x\n  | [], r, h => by simp only [mulRow, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | q :: bs, r, h => by\n    simp only [mulRow] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRow_sound hM i bs r' hr'\n      split at h\n      · rename_i hb\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at hb; simp [dot, hb, ih]\n      · split at h\n        · rename_i k hk\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, eval_lunit, pcol_val hM hk, ih]\n          simp only [dot]; rw [Int.mul_add, Int.mul_left_comm (x.getD i 0) q.2]\n        · simp at h\n\ntheorem mulRows_sound (hM : Model tab env maps x) (bs : List (Nat × Int)) :\n    ∀ as r, mulRows tab bs as = some r → eval r x = dot as x * dot bs x\n  | [], r, h => by simp only [mulRows, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | p :: as, r, h => by\n    simp only [mulRows] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRows_sound hM bs as r' hr'\n      split at h\n      · rename_i ha\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at ha; simp [dot, ha, ih]\n      · split at h\n        · rename_i q hq\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, mulRow_sound hM p.1 bs q hq, ih]\n          simp only [dot]; rw [Int.add_mul, Int.mul_assoc]\n        · simp at h\n\ntheorem rowMul_sound (hM : Model tab env maps x) {a b r : Row} (h : rowMul tab a b = some r) : eval r x = eval a x * eval b x := by\n  simp only [rowMul] at h\n  split at h\n  · rename_i p hp\n    simp only [Option.some.injEq] at h; subst h\n    have e := mulRows_sound hM b.coefs a.coefs p hp\n    simp only [eval_ladd, eval_lscale, eval_lconst, e]\n    simp only [eval, Int.add_zero]\n    rw [Int.add_mul, Int.mul_add, Int.mul_add, Int.mul_comm b.const]; omega\n  · simp at h\n\nmutual\ntheorem linear_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (e : E) → (l : Row) → linear tab path e = some l → eval l x = (evalE env maps e : Int)\n  | .var i, l, h => by\n    simp only [linear] at h\n    cases hj : findIdx (isVar i) tab with\n    | none => simp [hj] at h\n    | some j =>\n      simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n      rw [eval_lunit, var_col hM hj, evalE]\n  | .const n, l, h => by\n    simp only [linear, Option.some.injEq] at h; subst h\n    simp [eval_lconst, evalE]\n  | .add a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_ladd, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; omega\n    · simp at h\n  | .mul k a, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la ha\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_lscale, linear_sound hM hP a la ha, evalE]; simp\n    · simp at h\n  | .sub a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [eval_lsub, evalE]; omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [eval_lconst, evalE]; omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .min a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .max a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .prod a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      rw [rowMul_sound hM h, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; simp\n    · simp at h\n  | .ite c t f, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i hc\n      have := truth_sound hM hP c true hc\n      rw [linear_sound hM hP t l h, evalE, this]; rfl\n    · rename_i hc\n      have := truth_sound hM hP c false hc\n      rw [linear_sound hM hP f l h, evalE, this]; rfl\n    · exact termCol_sound hM h\n  | .get m key, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i lk hk\n      cases hj : findIdx (isCell m lk) tab with\n      | none => simp [hj] at h\n      | some j =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        rw [eval_lunit, cell_col hM hj, linear_sound hM hP key lk hk, evalE]; simp\n    · simp at h\ntheorem truth_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (b : Bool) → truth tab path c = some b → evalC env maps c = b\n  | .le a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_lsub] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .lt a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_ladd, eval_lsub, eval_lconst] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .eq a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      simp only [evalC]\n      revert h\n      rcases h1 : dec path (lsub la lb) with _ | _ | _ <;> rcases h2 : dec path (lsub lb la) with _ | _ | _ <;>\n        intro h <;> simp only [Option.some.injEq, reduceCtorEq] at h <;> subst h <;>\n        first\n          | (have t1 := dec_sound hP h1; have t2 := dec_sound hP h2; rw [eval_lsub] at t1 t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 t2 ⊢; omega)\n          | (have t1 := dec_sound hP h1; rw [eval_lsub] at t1\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 ⊢; omega)\n          | (have t2 := dec_sound hP h2; rw [eval_lsub] at t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t2 ⊢; omega)\n    · simp at h\n  | .and a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' false h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1, truth_sound hM hP b' true h2]\n    · simp at h\n  | .or a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' true h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1, truth_sound hM hP b' false h2]\n    · simp at h\n  | .not a, r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i r' h1; simp only [Option.some.injEq] at h; subst h; simp [evalC, truth_sound hM hP a r' h1]\n    · simp at h\nend\nend\n\n/-! Facts: the rows a hypothesis gives under the path, when it has the truth value `pos`. -/\n\ndef facts (tab : List VDef) (path : Path) : Bool → C → List Row\n  | pos, .not a => facts tab path (!pos) a\n  | pos, .and a b =>\n    if pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .or a b =>\n    if !pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb]\n      else let u := ladd (lsub lb la) (lconst 1); if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [ladd (lsub la lb) (lconst 1)]\n      else let u := lsub lb la; if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb, lsub lb la]\n      else\n        let u1 := ladd (lsub la lb) (lconst 1)\n        let u2 := ladd (lsub lb la) (lconst 1)\n        let o1 := dec path u1 != some false\n        let o2 := dec path u2 != some false\n        if o1 && o2 then [] else if o1 then [u1] else if o2 then [u2] else [lconst 1]\n    | _, _ => []\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem facts_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (pos : Bool) → evalC env maps c = pos → ∀ r ∈ facts tab path pos c, eval r x ≤ 0\n  | .not a, pos, h, r, hr => by\n    simp only [facts] at hr\n    exact facts_sound hM hP a (!pos) (by simp [evalC] at h; simp [← h]) r hr\n  | .and a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | true =>\n      simp only [evalC, Bool.and_eq_true] at h\n      simp only [ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a true h.1 r hr\n      · exact facts_sound hM hP b true h.2 r hr\n    | false =>\n      simp only [Bool.false_eq_true, ite_false, Bool.not_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.and_eq_false_iff] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · rename_i _ hoa\n          have hb : truth tab path b = some true := by simp_all\n          have := tb true hb\n          exact facts_sound hM hP a false (by simp_all) r hr\n        · split at hr\n          · rename_i _ _ hob\n            have ha : truth tab path a = some true := by simp_all\n            have := ta true ha\n            exact facts_sound hM hP b false (by simp_all) r hr\n          · have ha : truth tab path a = some true := by simp_all\n            have hb : truth tab path b = some true := by simp_all\n            have := ta true ha; have := tb true hb\n            simp_all\n  | .or a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | false =>\n      simp only [evalC, Bool.or_eq_false_iff] at h\n      simp only [Bool.not_false, ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a false h.1 r hr\n      · exact facts_sound hM hP b false h.2 r hr\n    | true =>\n      simp only [Bool.not_true, Bool.false_eq_true, ite_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.or_eq_true] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · have hb : truth tab path b = some false := by simp_all\n          have := tb false hb\n          exact facts_sound hM hP a true (by simp_all) r hr\n        · split at hr\n          · have ha : truth tab path a = some false := by simp_all\n            have := ta false ha\n            exact facts_sound hM hP b true (by simp_all) r hr\n          · have ha : truth tab path a = some false := by simp_all\n            have hb : truth tab path b = some false := by simp_all\n            have := ta false ha; have := tb false hb\n            simp_all\n  | .le a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_lsub]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_ladd, eval_lsub, eval_lconst]; omega\n    · simp at hr\n  | .lt a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_ladd, eval_lsub, eval_lconst]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_lsub, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_lsub]; omega\n    · simp at hr\n  | .eq a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with hr | hr <;> subst hr <;> rw [eval_lsub] <;> omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        have d1 := fun (hv : dec path (ladd (lsub la lb) (lconst 1)) = some false) => dec_sound hP hv\n        have d2 := fun (hv : dec path (ladd (lsub lb la) (lconst 1)) = some false) => dec_sound hP hv\n        simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at d1 d2\n        split at hr\n        · simp at hr\n        · split at hr\n          · have := d2 (by simp_all)\n            simp only [List.mem_singleton] at hr; subst hr\n            rw [eval_ladd, eval_lsub, eval_lconst]; omega\n          · split at hr\n            · have := d1 (by simp_all)\n              simp only [List.mem_singleton] at hr; subst hr\n              rw [eval_ladd, eval_lsub, eval_lconst]; omega\n            · have := d1 (by simp_all); have := d2 (by simp_all); omega\n    · simp at hr\nend\n\n/-! Leaves and trees. -/\n\ndef atomRow (a : Row × Bool) : Row := if a.2 then a.1 else flip a.1\ndef natRows : Nat → List Row\n  | 0 => []\n  | n + 1 => lscale (-1) (lunit n) :: natRows n\n-- Two cells of one map whose keys the path proves equal are equal (the pair is the leaf's claim; it is checked here).\ndef cellEq (tab : List VDef) (path : Path) (p : Nat × Nat) : List Row :=\n  match tab[p.1]?, tab[p.2]? with\n  | some (.cell m k), some (.cell m' k') =>\n    if m == m' && dec path (lsub k k') == some true && dec path (lsub k' k) == some true\n    then [lsub (lunit p.1) (lunit p.2), lsub (lunit p.2) (lunit p.1)] else []\n  | _, _ => []\n-- A term column's rows: its bounds, whichever way its choice goes (min ≤ each side, max ≥ each side, a ∸ b ≥ a − b and\n-- ≤ a, an if ≤ the sum of its branches when both are constants), and its equality to the term's form under the path\n-- (the branch taken, once the path decides it).\ndef constIn (r : Row) : Bool := r.coefs.all (fun p => p.2 == 0)\ndef termBounds (j : Nat) (la lb : Row) : E → List Row\n  | .min _ _ => [lsub (lunit j) la, lsub (lunit j) lb]\n  | .max _ _ => [lsub la (lunit j), lsub lb (lunit j)]\n  | .sub _ _ => [lsub (lsub la lb) (lunit j), lsub (lunit j) la]\n  | .ite _ _ _ => [lsub (lunit j) (ladd la lb)]\n  | _ => []\ndef termRowsAt (tab : List VDef) (path : Path) (j : Nat) : List Row :=\n  match tab[j]? with\n  | some (.term e) =>\n    (match e with\n     | .min a b | .max a b | .sub a b => match linear tab path a, linear tab path b with\n       | some la, some lb => termBounds j la lb e\n       | _, _ => []\n     | .ite _ a b => match linear tab path a, linear tab path b with\n       | some la, some lb => if constIn la && constIn lb then termBounds j la lb e else []\n       | _, _ => []\n     | _ => [])\n    ++ (match linear tab path e with\n        | some r => [lsub (lunit j) r, lsub r (lunit j)]\n        | none => [])\n  | _ => []\ndef termRows (tab : List VDef) (path : Path) : List Row := (List.range tab.length).flatMap (termRowsAt tab path)\n\ndef leafRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : List Row :=\n  path.map atomRow ++ hyps.flatMap (facts tab path true) ++ natRows tab.length ++ eqs.flatMap (cellEq tab path) ++ termRows tab path\n\n-- Where a leaf's row is looked for first: the path's i-th atom (the latest decision first), a hypothesis's facts, column i's naturality, the i-th\n-- pair of equal cells, or term column j's rows. A hint only saves work: a row not found there is looked for among all\n-- of the leaf's rows, as one without a hint is.\ninductive Src where\n  | atom (i : Nat)\n  | fact (h : Nat)\n  | nat (i : Nat)\n  | eq (i : Nat)\n  | term (j : Nat)\n  | any\n\ndef srcRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : Src → List Row\n  | .atom i => match path[i]? with | some a => [atomRow a] | none => []\n  | .fact h => match hyps[h]? with | some c => facts tab path true c | none => []\n  | .nat i => if i < tab.length then [lscale (-1) (lunit i)] else []\n  | .eq i => match eqs[i]? with | some p => cellEq tab path p | none => []\n  | .term j => if j < tab.length then termRowsAt tab path j else []\n  | .any => []\n\n-- A leaf may add products of two of its rows (p ≤ 0 and q ≤ 0 give −p·q ≤ 0); a pair may name an earlier product.\n-- `leafAt` is a leaf whose rows come with hints; `leafSq` one that also adds the square of each of its forms t\n-- (−t·t ≤ 0, whatever t's sign) after its rows, before the products, which may name them.\ninductive Tree where\n  | split (l : Row) (yes no : Tree)\n  | leaf (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n  | leafAt (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n  | leafSq (rows : List (Row × Src)) (sqs : List Row) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n\ndef squares (tab : List VDef) : List Row → Option (List Row)\n  | [] => some []\n  | t :: ts => match rowMul tab t t, squares tab ts with\n    | some r, some rs => some (lscale (-1) r :: rs)\n    | _, _ => none\n\ndef extend (tab : List VDef) : List Row → List (Nat × Nat) → Option (List Row)\n  | acc, [] => some acc\n  | acc, (i, j) :: ps => match acc[i]?, acc[j]? with\n    | some p, some q => match rowMul tab p q with\n      | some r => extend tab (acc ++ [lscale (-1) r]) ps\n      | none => none\n    | _, _ => none\n\ndef leafOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  let comp := leafRows tab path hyps eqs\n  rows.all (fun r => comp.any (same r)) && match extend tab rows prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\n-- Each row where its hint says, or else among the leaf's rows.\ndef leafAtOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  rows.all (fun r => (srcRows tab path hyps eqs r.2).any (same r.1) || (leafRows tab path hyps eqs).any (same r.1))\n    && match extend tab (rows.map (·.1)) prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\n-- Each row where its hint says, or else among the leaf's rows; then the squares, then the products.\ndef leafSqOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List (Row × Src)) (sqs : List Row) (steps : List Step)\n    (eqs : List (Nat × Nat)) (prods : List (Nat × Nat)) : Bool :=\n  rows.all (fun r => (srcRows tab path hyps eqs r.2).any (same r.1) || (leafRows tab path hyps eqs).any (same r.1))\n    && match squares tab sqs with\n    | some sr => match extend tab (rows.map (·.1) ++ sr) prods with\n      | some rows' => Cert.check rows' steps\n      | none => false\n    | none => false\n\ndef checkT (tab : List VDef) (hyps : List C) : Path → Tree → Bool\n  | path, .split l y n => checkT tab hyps ((l, true) :: path) y && checkT tab hyps ((l, false) :: path) n\n  | path, .leaf rows steps eqs prods => leafOk tab path hyps rows steps eqs prods\n  | path, .leafAt rows steps eqs prods => leafAtOk tab path hyps rows steps eqs prods\n  | path, .leafSq rows sqs steps eqs prods => leafSqOk tab path hyps rows sqs steps eqs prods\n\nstructure Goal where\n  tab : List VDef\n  hyps : List C\n\n-- Each cell's key reads only earlier columns, so the table has a valuation.\ndef wfTab : Nat → List VDef → Bool\n  | _, [] => true\n  | n, .var _ :: ds => wfTab (n + 1) ds\n  | n, .cell _ k :: ds => k.coefs.all (·.1 < n) && wfTab (n + 1) ds\n  | n, .mono fs :: ds => fs.all (· < n) && wfTab (n + 1) ds\n  | n, .term _ :: ds => wfTab (n + 1) ds\n\ndef checkGoal (g : Goal) (t : Tree) : Bool := wfTab 0 g.tab && checkT g.tab g.hyps [] t\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int}\n\ntheorem natRows_sound (hM : Model tab env maps x) : ∀ n, ∀ r ∈ natRows n, eval r x ≤ 0\n  | 0, r, hr => by simp [natRows] at hr\n  | n + 1, r, hr => by\n    simp only [natRows, List.mem_cons] at hr\n    rcases hr with hr | hr\n    · subst hr; rw [eval_lscale, eval_lunit]; have := hM.2 n; omega\n    · exact natRows_sound hM n r hr\n\ntheorem termRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) :\n    ∀ r ∈ termRows tab path, eval r x ≤ 0 := by\n  intro r hr\n  simp only [termRows, List.mem_flatMap] at hr\n  obtain ⟨j, _, hr⟩ := hr\n  simp only [termRowsAt] at hr\n  split at hr\n  · rename_i e hj\n    have hx : x.getD j 0 = (evalE env maps e : Int) := by rw [hM.1 j _ hj]; rfl\n    simp only [List.mem_append] at hr\n    rcases hr with hr | hr\n    · cases e with\n      | min a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.min_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | max a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.max_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | sub a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE] at hx\n          rcases hr with rfl | rfl\n          · rw [eval_lsub, eval_lsub, eval_lunit]; omega\n          · rw [eval_lsub, eval_lunit]; omega\n        · simp at hr\n      | ite c a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          split at hr\n          · have ea := linear_sound hM hP a la ha\n            have eb := linear_sound hM hP b lb hb\n            simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n            simp only [evalE] at hx\n            subst hr\n            rw [eval_lsub, eval_ladd, eval_lunit]\n            split at hx <;> omega\n          · simp at hr\n        · simp at hr\n      | _ => simp at hr\n    · split at hr\n      · rename_i r' hr'\n        have := linear_sound hM hP e r' hr'\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n      · simp at hr\n  · simp at hr\n\ntheorem leafRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) {hyps : List C}\n    (hH : ∀ c ∈ hyps, evalC env maps c = true) (eqs : List (Nat × Nat)) : ∀ r ∈ leafRows tab path hyps eqs, eval r x ≤ 0 := by\n  intro r hr\n  simp only [leafRows, List.mem_append, List.mem_map, List.mem_flatMap] at hr\n  rcases hr with (((⟨a, ha, rfl⟩ | ⟨c, hc, hr⟩) | hr) | ⟨p, _, hr⟩) | hr\n  · have := hP a ha\n    simp only [atomRow]\n    cases h2 : a.2 with\n    | true => rw [h2] at this; simpa using this\n    | false => rw [h2] at this; simp only [decide_eq_false_iff_not] at this; simp only [ite_false, Bool.false_eq_true, eval_flip]; omega\n  · exact facts_sound hM hP c true (hH c hc) r hr\n  · exact natRows_sound hM _ r hr\n  · simp only [cellEq] at hr\n    split at hr\n    · rename_i m k m' k' h1 h2\n      split at hr\n      · rename_i hc\n        simp only [Bool.and_eq_true, beq_iff_eq] at hc\n        obtain ⟨⟨rfl, hk1⟩, hk2⟩ := hc\n        have t1 := dec_sound hP hk1; have t2 := dec_sound hP hk2\n        simp only [eval_lsub, decide_eq_true_eq] at t1 t2\n        have e1 := hM.1 p.1 _ h1; have e2 := hM.1 p.2 _ h2\n        simp only [valD] at e1 e2\n        have hkk : eval k x = eval k' x := by omega\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit, eval_lunit, e1, e2, hkk] <;> omega\n      · simp at hr\n    · simp at hr\n  · exact termRows_sound hM hP r hr\n\n-- A hint names some of the leaf's rows.\ntheorem natRows_mem : ∀ {n i : Nat}, i < n → lscale (-1) (lunit i) ∈ natRows n\n  | 0, _, h => absurd h (Nat.not_lt_zero _)\n  | n + 1, i, h => by\n    simp only [natRows, List.mem_cons]\n    rcases Nat.lt_succ_iff_lt_or_eq.mp h with h | rfl\n    · exact Or.inr (natRows_mem h)\n    · exact Or.inl rfl\n\ntheorem srcRows_sub {path : Path} {hyps : List C} {eqs : List (Nat × Nat)} {r : Row} :\n    ∀ s, r ∈ srcRows tab path hyps eqs s → r ∈ leafRows tab path hyps eqs\n  | .atom i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i a ha\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append, List.mem_map]\n      exact Or.inl (Or.inl (Or.inl (Or.inl ⟨a, List.mem_of_getElem? ha, rfl⟩)))\n    · simp at hr\n  | .fact h, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i c hc\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inl (Or.inl (Or.inr ⟨c, List.mem_of_getElem? hc, hr⟩)))\n    · simp at hr\n  | .nat i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hi\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append]\n      exact Or.inl (Or.inl (Or.inr (natRows_mem hi)))\n    · simp at hr\n  | .eq i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i p hp\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inr ⟨p, List.mem_of_getElem? hp, hr⟩)\n    · simp at hr\n  | .term j, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hj\n      simp only [leafRows, termRows, List.mem_append, List.mem_flatMap, List.mem_range]\n      exact Or.inr ⟨j, hj, hr⟩\n    · simp at hr\n  | .any, hr => by simp [srcRows] at hr\n\ntheorem extend_sound (hM : Model tab env maps x) :\n    ∀ ps acc rows', extend tab acc ps = some rows' → (∀ r ∈ acc, eval r x ≤ 0) → ∀ r ∈ rows', eval r x ≤ 0\n  | [], acc, rows', h, ha => by simp only [extend, Option.some.injEq] at h; subst h; exact ha\n  | (i, j) :: ps, acc, rows', h, ha => by\n    simp only [extend] at h\n    split at h\n    · rename_i p q hp hq\n      split at h\n      · rename_i r hr\n        refine extend_sound hM ps _ rows' h (fun r' hr' => ?_)\n        rcases List.mem_append.mp hr' with hr' | hr'\n        · exact ha r' hr'\n        · simp only [List.mem_singleton] at hr'; subst hr'\n          have e1 := ha p (List.mem_of_getElem? hp)\n          have e2 := ha q (List.mem_of_getElem? hq)\n          rw [eval_lscale, rowMul_sound hM hr]\n          have : 0 ≤ (-eval p x) * (-eval q x) := Int.mul_nonneg (by omega) (by omega)\n          rw [Int.neg_mul_neg] at this; omega\n      · simp at h\n    · simp at h\n\ntheorem squares_sound (hM : Model tab env maps x) : ∀ ts rs, squares tab ts = some rs → ∀ r ∈ rs, eval r x ≤ 0\n  | [], rs, h => by simp only [squares, Option.some.injEq] at h; subst h; simp\n  | t :: ts, rs, h => by\n    simp only [squares] at h\n    split at h\n    · rename_i r rs' hr hrs\n      simp only [Option.some.injEq] at h; subst h\n      intro r' hr'\n      rcases List.mem_cons.mp hr' with hr' | hr'\n      · subst hr'\n        rw [eval_lscale, rowMul_sound hM hr]\n        have : 0 ≤ eval t x * eval t x := by\n          rcases Int.le_total 0 (eval t x) with h0 | h0\n          · exact Int.mul_nonneg h0 h0\n          · have := Int.mul_nonneg (show 0 ≤ -eval t x by omega) (show 0 ≤ -eval t x by omega)\n            rwa [Int.neg_mul_neg] at this\n        omega\n      · exact squares_sound hM ts rs' hrs r' hr'\n    · simp at h\n\ntheorem checkT_sound (hM : Model tab env maps x) {hyps : List C} (hH : ∀ c ∈ hyps, evalC env maps c = true) :\n    ∀ (t : Tree) (path : Path), PathHolds path x → checkT tab hyps path t = true → False\n  | .split l y n, path, hP, h => by\n    simp only [checkT, Bool.and_eq_true] at h\n    by_cases hl : eval l x ≤ 0\n    · refine checkT_sound hM hH y _ ?_ h.1\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n    · refine checkT_sound hM hH n _ ?_ h.2\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n  | .leaf rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafOk, Bool.and_eq_true, List.all_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods rows rows' he ?_)\n      intro r hr\n      obtain ⟨c, hc, hs⟩ := h1 r hr\n      rw [same_eval hs]\n      exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\n  | .leafAt rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafAtOk, Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods _ rows' he ?_)\n      intro r hr\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hr\n      rcases h1 p hp with ⟨c, hc, hs⟩ | ⟨c, hc, hs⟩\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c (srcRows_sub p.2 hc)\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\n  | .leafSq rows sqs steps eqs prods, path, hP, h => by\n    simp only [checkT, leafSqOk, Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i sr hsr\n      split at h2\n      · rename_i rows' he\n        refine Cert.sound rows' steps h2 x (extend_sound hM prods _ rows' he ?_)\n        intro r hr\n        rcases List.mem_append.mp hr with hr | hr\n        · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hr\n          rcases h1 p hp with ⟨c, hc, hs⟩ | ⟨c, hc, hs⟩\n          · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c (srcRows_sub p.2 hc)\n          · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c hc\n        · exact squares_sound hM sqs sr hsr r hr\n      · simp at h2\n    · simp at h2\nend\n\n/-! The table's valuation. -/\n\ndef build (env : Nat → Nat) (maps : Nat → Nat → Nat) : List VDef → List Int → List Int\n  | [], acc => acc\n  | d :: ds, acc => build env maps ds (acc ++ [valD env maps d acc])\n\ntheorem dot_append : ∀ (a : List (Nat × Int)) (l1 l2 : List Int), (∀ p ∈ a, p.1 < l1.length) → dot a (l1 ++ l2) = dot a l1\n  | [], _, _, _ => by simp [dot]\n  | p :: a, l1, l2, h => by\n    simp only [dot]\n    rw [dot_append a l1 l2 (fun q hq => h q (List.mem_cons_of_mem _ hq))]\n    have hp := h p List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hp]\n\n-- What a column may refer to: only earlier columns.\ndef Refs (n : Nat) : VDef → Prop\n  | .var _ => True\n  | .cell _ k => ∀ p ∈ k.coefs, p.1 < n\n  | .mono fs => ∀ f ∈ fs, f < n\n  | .term _ => True\n\ntheorem Refs.mono_le {n m : Nat} (h : n ≤ m) : ∀ {d : VDef}, Refs n d → Refs m d\n  | .var _, _ => trivial\n  | .cell _ _, hd => fun p hp => by have := hd p hp; omega\n  | .mono _, hd => fun f hf => by have := hd f hf; omega\n  | .term _, _ => trivial\n\ntheorem prodV_append_left (acc more : List Int) : ∀ fs : List Nat, (∀ f ∈ fs, f < acc.length) → prodV (acc ++ more) fs = prodV acc fs\n  | [], _ => rfl\n  | f :: fs, h => by\n    simp only [prodV]\n    rw [prodV_append_left acc more fs (fun g hg => h g (List.mem_cons_of_mem _ hg))]\n    have hf := h f List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hf]\n\ntheorem valD_append (env : Nat → Nat) (maps : Nat → Nat → Nat) (d : VDef) (acc more : List Int)\n    (h : Refs acc.length d) : valD env maps d (acc ++ more) = valD env maps d acc := by\n  cases d with\n  | var i => rfl\n  | cell m k => simp only [Refs] at h; simp only [valD, eval, dot_append k.coefs acc more h]\n  | mono fs => simp only [valD, prodV_append_left acc more fs h]\n  | term e => rfl\n\ndef Valid (env : Nat → Nat) (maps : Nat → Nat → Nat) (acc : List Int) (pre : List VDef) : Prop :=\n  acc.length = pre.length ∧ (∀ (j : Nat) (d : VDef), pre[j]? = some d → Refs j d) ∧\n    ∀ (j : Nat) (d : VDef), pre[j]? = some d → acc[j]? = some (valD env maps d acc)\n\ntheorem valid_snoc {env : Nat → Nat} {maps : Nat → Nat → Nat} {acc : List Int} {pre : List VDef} (d : VDef)\n    (hv : Valid env maps acc pre) (hd : Refs pre.length d) :\n    Valid env maps (acc ++ [valD env maps d acc]) (pre ++ [d]) := by\n  obtain ⟨hl, hw, hx⟩ := hv\n  refine ⟨by simp [hl], ?_, ?_⟩\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj; exact hw j d' hj\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      exact Refs.mono_le (by omega) hd\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj\n      rw [List.getElem?_append_left (by omega), hx j d' hj]\n      rw [valD_append env maps d' acc _ (Refs.mono_le (by omega) (hw j d' hj))]\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      rw [List.getElem?_append_right (by omega), show j - acc.length = 0 by omega]\n      simp only [List.getElem?_cons_zero, Option.some.injEq]\n      rw [valD_append env maps d acc _ (by rw [hl]; exact hd)]\n\ntheorem build_valid (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ (ds : List VDef) (acc : List Int) (pre : List VDef),\n    Valid env maps acc pre → wfTab pre.length ds = true → Valid env maps (build env maps ds acc) (pre ++ ds)\n  | [], acc, pre, hv, _ => by simpa [build] using hv\n  | d :: ds, acc, pre, hv, hw => by\n    have hd : Refs pre.length d ∧ wfTab (pre.length + 1) ds = true := by\n      cases d with\n      | var i => exact ⟨trivial, by simpa [wfTab] using hw⟩\n      | cell m k =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | mono fs =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | term e => exact ⟨trivial, by simpa [wfTab] using hw⟩\n    have := build_valid env maps ds _ (pre ++ [d]) (valid_snoc d hv hd.1) (by simpa using hd.2)\n    simpa [build] using this\n\ntheorem model_of_valid {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {tab : List VDef}\n    (hv : Valid env maps x tab) : Model tab env maps x := by\n  obtain ⟨hl, _, hx⟩ := hv\n  refine ⟨fun j d hj => by rw [List.getD_eq_getElem?_getD, hx j d hj]; rfl, fun j => ?_⟩\n  rw [List.getD_eq_getElem?_getD]\n  cases h : x[j]? with\n  | none => simp\n  | some v =>\n    have hj : j < tab.length := by\n      have := (List.getElem?_eq_some_iff.mp h).1; omega\n    obtain ⟨d, hd⟩ : ∃ d, tab[j]? = some d := ⟨tab[j], List.getElem?_eq_getElem hj⟩\n    rw [hx j d hd] at h\n    simp only [Option.some.injEq] at h; subst h\n    cases d <;> simp [valD]\n    exact Int.le_max_right _ _\n\n/-- The kernel's tree check is sound: an accepted goal's hypotheses hold for no naturals and no maps. -/\ntheorem sound (g : Goal) (t : Tree) (h : checkGoal g t = true) (env : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ¬ ∀ c ∈ g.hyps, evalC env maps c = true := by\n  intro hH\n  simp only [checkGoal, Bool.and_eq_true] at h\n  have hv := build_valid env maps g.tab [] [] ⟨rfl, by simp, by simp⟩ (by simpa using h.1)\n  simp only [List.nil_append] at hv\n  exact checkT_sound (model_of_valid hv) hH t [] (by simp [PathHolds]) h.2\n\n/-! Step machines with scalar state: the induction rule over kernel goals. The goals are built here, in Lean, from\nthe machine, so the TypeScript `obligations` is not trusted for these: a law holds at the start (`startGoal` is\nrefuted) and one step keeps every law (`stepGoal` is refuted, assuming them all and the request's assumption), so every\nlaw holds in every reachable state. Laws may not read the request's inputs. -/\n\ndef assoc (σ : List (Nat × E)) (i : Nat) : Option E := (lookup (fun p => p.1 == i) σ).map (·.2)\n\nmutual\ndef substE (σ : List (Nat × E)) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substE σ a) (substE σ b)\n  | .sub a b => .sub (substE σ a) (substE σ b)\n  | .mul k a => .mul k (substE σ a)\n  | .min a b => .min (substE σ a) (substE σ b)\n  | .max a b => .max (substE σ a) (substE σ b)\n  | .prod a b => .prod (substE σ a) (substE σ b)\n  | .ite c t f => .ite (substC σ c) (substE σ t) (substE σ f)\n  | .get m key => .get m (substE σ key)\ndef substC (σ : List (Nat × E)) : C → C\n  | .le a b => .le (substE σ a) (substE σ b)\n  | .lt a b => .lt (substE σ a) (substE σ b)\n  | .eq a b => .eq (substE σ a) (substE σ b)\n  | .and a b => .and (substC σ a) (substC σ b)\n  | .or a b => .or (substC σ a) (substC σ b)\n  | .not a => .not (substC σ a)\nend\n\n-- The environment after σ: each assigned variable takes its term's value, the rest keep theirs.\ndef applyS (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat :=\n  fun i => match assoc σ i with\n    | some e => evalE ρ maps e\n    | none => ρ i\n\nmutual\ntheorem subst_evalE (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → evalE ρ maps (substE σ e) = evalE (applyS σ ρ maps) maps e\n  | .var i => by\n    simp only [substE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substE, evalE]\n  | .add a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .sub a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .mul k a => by simp [substE, evalE, subst_evalE σ ρ maps a]\n  | .min a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .max a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .prod a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .ite c t f => by simp [substE, evalE, subst_evalC σ ρ maps c, subst_evalE σ ρ maps t, subst_evalE σ ρ maps f]\n  | .get m key => by simp [substE, evalE, subst_evalE σ ρ maps key]\ntheorem subst_evalC (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → evalC ρ maps (substC σ c) = evalC (applyS σ ρ maps) maps c\n  | .le a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .lt a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .eq a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .and a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .or a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .not a => by simp [substC, evalC, subst_evalC σ ρ maps a]\nend\n\nmutual\ndef occE (i : Nat) : E → Bool\n  | .var j => j == i\n  | .const _ => false\n  | .add a b => occE i a || occE i b\n  | .sub a b => occE i a || occE i b\n  | .mul _ a => occE i a\n  | .min a b => occE i a || occE i b\n  | .max a b => occE i a || occE i b\n  | .prod a b => occE i a || occE i b\n  | .ite c t f => occC i c || occE i t || occE i f\n  | .get _ key => occE i key\ndef occC (i : Nat) : C → Bool\n  | .le a b => occE i a || occE i b\n  | .lt a b => occE i a || occE i b\n  | .eq a b => occE i a || occE i b\n  | .and a b => occC i a || occC i b\n  | .or a b => occC i a || occC i b\n  | .not a => occC i a\nend\n\nmutual\ntheorem congrE (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → (∀ i, occE i e = true → ρ i = ρ' i) → evalE ρ maps e = evalE ρ' maps e\n  | .var j, h => by simp only [evalE]; exact h j (by simp [occE])\n  | .const n, _ => rfl\n  | .add a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .sub a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .mul k a, h => by simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi]))]\n  | .min a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .max a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .prod a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .ite c t f, h => by\n    simp only [evalE, congrC ρ ρ' maps c (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps t (fun i hi => h i (by simp [occE, hi])),\n      congrE ρ ρ' maps f (fun i hi => h i (by simp [occE, hi]))]\n  | .get m key, h => by simp only [evalE, congrE ρ ρ' maps key (fun i hi => h i (by simp [occE, hi]))]\ntheorem congrC (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → (∀ i, occC i c = true → ρ i = ρ' i) → evalC ρ maps c = evalC ρ' maps c\n  | .le a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .lt a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .eq a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .and a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .or a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .not a, h => by simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi]))]\nend\n\nstructure Machine where\n  inputs : List Nat\n  init : List (Nat × E)   -- each state variable's start, over the params\n  step : List (Nat × E)   -- each state variable after a request, over params, inputs and state\n  pre : C                 -- about the params alone: a precondition, so it holds at the start and at every step\n  assume : C              -- about each request (and the params); holds at a step, not at the start\n\n-- A request: its inputs replace those variables; nothing else changes until the step.\ndef withInputs (inputs : List Nat) (ρ ι : Nat → Nat) : Nat → Nat := fun i => if inputs.contains i then ι i else ρ i\n\ninductive Reach (m : Machine) (maps : Nat → Nat → Nat) : (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) : evalC ρ maps m.pre = true → Reach m maps (applyS m.init ρ maps)\n  | step (ρ ι : Nat → Nat) : Reach m maps ρ → evalC (withInputs m.inputs ρ ι) maps m.assume = true →\n      Reach m maps (applyS m.step (withInputs m.inputs ρ ι) maps)\n\ndef startGoal (m : Machine) (law : C) : List C := [m.pre, .not (substC m.init law)]\ndef stepGoal (m : Machine) (laws : List C) (law : C) : List C := [m.pre, m.assume] ++ laws ++ [.not (substC m.step law)]\n\n-- Per law: the law, then (table, tree) for its start goal and for its step goal.\nabbrev MachineProof := List (C × (List VDef × Tree) × (List VDef × Tree))\n\n-- None of `vs` occurs in c.\ndef avoids (vs : List Nat) (c : C) : Bool := vs.all fun i => !occC i c\n\n-- The precondition reads only params: no input, no variable the start or a step assigns.\ndef preOk (m : Machine) : Bool := avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre\n\ndef checkMachine (m : Machine) (ps : MachineProof) : Bool :=\n  preOk m && ps.all fun p => avoids m.inputs p.1\n    && checkGoal ⟨p.2.1.1, startGoal m p.1⟩ p.2.1.2\n    && checkGoal ⟨p.2.2.1, stepGoal m (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem avoids_occ {vs : List Nat} {c : C} (h : avoids vs c = true) {i : Nat} (hi : occC i c = true) : i ∉ vs := by\n  intro hm\n  simp only [avoids, List.all_eq_true] at h\n  have := h i hm; simp [hi] at this\n\ntheorem assoc_mem {σ : List (Nat × E)} {i : Nat} {e : E} (h : assoc σ i = some e) : i ∈ σ.map (·.1) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, _⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  simp only [beq_iff_eq] at hp\n  exact List.mem_map.mpr ⟨a, hm, hp⟩\n\n-- σ leaves every variable it doesn't assign alone.\ntheorem applyS_other {σ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    applyS σ ρ maps i = ρ i := by\n  simp only [applyS]\n  cases ha : assoc σ i with\n  | none => rfl\n  | some e => exact absurd (assoc_mem ha) h\n\ntheorem withInputs_other {inputs : List Nat} {i : Nat} (h : i ∉ inputs) (ρ ι : Nat → Nat) : withInputs inputs ρ ι i = ρ i := by\n  simp only [withInputs]; split\n  · rename_i hc; exact absurd (List.contains_iff_mem.mp hc) h\n  · rfl\n\n-- Conditions that avoid some variables read the same before and after anything that only changes those.\ntheorem evalC_avoids {vs : List Nat} {c : C} (h : avoids vs c = true) {ρ ρ' : Nat → Nat} (maps : Nat → Nat → Nat)\n    (hρ : ∀ i, i ∉ vs → ρ i = ρ' i) : evalC ρ maps c = evalC ρ' maps c :=\n  congrC ρ ρ' maps c (fun i hi => hρ i (avoids_occ h hi))\n\ntheorem pre_reach {m : Machine} (hp : preOk m = true) {maps : Nat → Nat → Nat} :\n    ∀ {ρ}, Reach m maps ρ → evalC ρ maps m.pre = true := by\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ maps)]; exact h0\n  | step ρ ι _ _ ih =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n/-- The induction rule: for params that meet the precondition, every law of an accepted machine proof holds in every\nreachable state, for any maps. -/\ntheorem machine_sound (m : Machine) (ps : MachineProof) (h : checkMachine m ps = true) (maps : Nat → Nat → Nat) :\n    ∀ ρ, Reach m maps ρ → ∀ l ∈ ps.map (·.1), evalC ρ maps l = true := by\n  simp only [checkMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨hpre, h⟩ := h\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).1.2 ρ maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [startGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · exact h0\n    · simp only [evalC, subst_evalC]; simpa using hf\n  | step ρ ι hr ha ih =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).2 (withInputs m.inputs ρ ι) maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [stepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with ((rfl | rfl) | hc) | rfl\n    · rw [evalC_avoids hpre maps (ρ' := ρ) (fun i hi => withInputs_other (fun h => hi (by simp [h])) ρ ι)]\n      exact pre_reach hpre hr\n    · exact ha\n    · obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hc\n      rw [evalC_avoids (h q hq).1.1 maps (ρ' := ρ) (fun i hi => withInputs_other hi ρ ι)]\n      exact ih q.1 (List.mem_map.mpr ⟨q, hq, rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa using hf\n\n/-! Loops: termination. A loop runs `body` while `guard` holds, each turn reading fresh inputs that meet `assume`. That it\nhalts is a liveness of its machine (Live.lean's Loop.machine and loop_halts_of): from anywhere, the guard fails later. -/\n\nstructure Loop where\n  inputs : List Nat\n  init : List (Nat × E)\n  body : List (Nat × E)\n  guard : C               -- while\n  pre : C                 -- about the params alone\n  assume : C              -- about each turn's inputs\n\n-- One turn: some inputs meeting the assumption, the guard holds, the body runs.\ndef Turn (l : Loop) (maps : Nat → Nat → Nat) (ρ ρ' : Nat → Nat) : Prop :=\n  ∃ ι, evalC (withInputs l.inputs ρ ι) maps l.guard = true ∧ evalC (withInputs l.inputs ρ ι) maps l.assume = true ∧\n    ρ' = applyS l.body (withInputs l.inputs ρ ι) maps\n\n/-! Folds over binary trees: structural induction. Each leaf and node carries its own inputs; a leaf's state comes from\nits inputs, a node's from its children's (read through copies of the state variables, one per side) and its inputs.\nThe goals are built here: each law holds at every leaf, and at a node whenever every law holds at both children. -/\n\nstructure Fold where\n  inputs : List Nat\n  state : List (Nat × Nat × Nat)   -- a state variable, its copy for the left child, its copy for the right child\n  leaf : List (Nat × E)\n  node : List (Nat × E)\n  pre : C\n  assume : C\n\ninductive BTree where\n  | leaf (ι : Nat → Nat)\n  | node (ι : Nat → Nat) (l r : BTree)\n\n-- A node's environment: each copy reads the child's state variable.\ndef withChildren (f : Fold) (env a b : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun e => e.2.1 == i) f.state with\n  | some e => a e.1\n  | none => match lookup (fun e => e.2.2 == i) f.state with\n    | some e => b e.1\n    | none => env i\n\ndef foldT (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Nat → Nat\n  | .leaf ι => applyS f.leaf (withInputs f.inputs ρ ι) maps\n  | .node ι l r => applyS f.node (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps\n\n-- Every leaf's and node's inputs meet the assumption.\ndef Allowed (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Prop\n  | .leaf ι => evalC (withInputs f.inputs ρ ι) maps f.assume = true\n  | .node ι l r => evalC (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps f.assume = true\n      ∧ Allowed f ρ maps l ∧ Allowed f ρ maps r\n\ndef leftSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.1)\ndef rightSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.2)\n\ndef leafGoal (f : Fold) (law : C) : List C := [f.pre, f.assume, .not (substC f.leaf law)]\ndef nodeGoal (f : Fold) (laws : List C) (law : C) : List C :=\n  [f.pre, f.assume] ++ laws.flatMap (fun h => [substC (leftSub f) h, substC (rightSub f) h]) ++ [.not (substC f.node law)]\n\n-- Variables a fold changes or reads per tree: inputs, the copies, and whatever a leaf or node assigns.\ndef touched (f : Fold) : List Nat :=\n  f.inputs ++ f.state.map (·.2.1) ++ f.state.map (·.2.2) ++ f.leaf.map (·.1) ++ f.node.map (·.1)\n-- Copies name one state variable each, and no right copy is a left copy.\ndef copiesOk (f : Fold) : Bool :=\n  f.state.all fun e => f.state.all fun e' => (e.2.1 != e'.2.1 || e.1 == e'.1) && (e.2.2 != e'.2.2 || e.1 == e'.1) && e.2.2 != e'.2.1\n\n-- Per law: the law, then (table, tree) for its leaf goal and its node goal.\nabbrev FoldProof := MachineProof\n\ndef checkFold (f : Fold) (ps : FoldProof) : Bool :=\n  copiesOk f && avoids (touched f) f.pre\n    && ps.all fun p => avoids ((touched f).filter fun i => !(f.state.map (·.1)).contains i) p.1\n      && checkGoal ⟨p.2.1.1, leafGoal f p.1⟩ p.2.1.2\n      && checkGoal ⟨p.2.2.1, nodeGoal f (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem lookup_none {α : Type} {p : α → Bool} {l : List α} (h : ∀ a ∈ l, p a = false) : lookup p l = none := by\n  cases hl : lookup p l with\n  | none => rfl\n  | some a => have := lookup_some hl; simp [h a this.1] at this\n\ntheorem lookup_none_all {α : Type} {p : α → Bool} : ∀ {l : List α}, lookup p l = none → ∀ a ∈ l, p a = false\n  | [], _, a, ha => by simp at ha\n  | b :: bs, h, a, ha => by\n    simp only [lookup] at h\n    split at h\n    · simp at h\n    · rcases List.mem_cons.mp ha with rfl | ha\n      · simpa using (by assumption : ¬ p a = true)\n      · exact lookup_none_all h a ha\n\ntheorem withChildren_plain (f : Fold) (env a b : Nat → Nat) {i : Nat} (hl : i ∉ f.state.map (·.2.1))\n    (hr : i ∉ f.state.map (·.2.2)) : withChildren f env a b i = env i := by\n  simp only [withChildren]\n  rw [lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hl (List.mem_map.mpr ⟨e, he, h⟩)),\n    lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hr (List.mem_map.mpr ⟨e, he, h⟩))]\n\ntheorem withChildren_left {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.1 = a e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  cases h : lookup (fun e' => e'.2.1 == e.2.1) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.1\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem withChildren_right {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.2 = b e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  rw [lookup_none (fun e' he' => by simp only [beq_eq_false_iff_ne]; intro h; exact (hc e he e' he').2 h.symm)]\n  cases h : lookup (fun e' => e'.2.2 == e.2.2) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.2\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem foldT_other (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) {i : Nat} (hi : i ∉ touched f) :\n    ∀ t, foldT f ρ maps t i = ρ i\n  | .leaf ι => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n  | .node ι l r => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h]))\n      (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n\ntheorem assoc_map {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} {x : E}\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = some x) : ∃ e ∈ s, e.1 = i ∧ x = .var (g e) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, rfl⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hm\n  simp only [beq_iff_eq] at hp\n  exact ⟨e, he, hp, rfl⟩\n\ntheorem assoc_map_none {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∉ s.map (·.1)) :\n    assoc (s.map fun e => (e.1, E.var (g e))) i = none := by\n  cases h : assoc (s.map fun e => (e.1, E.var (g e))) i with\n  | none => rfl\n  | some x => obtain ⟨e, he, rfl, -⟩ := assoc_map h; exact absurd (List.mem_map.mpr ⟨e, he, rfl⟩) hi\n\ntheorem assoc_map_some {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∈ s.map (·.1))\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = none) : False := by\n  simp only [assoc, Option.map_eq_none_iff] at h\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hi\n  have := lookup_none_all h (e.1, E.var (g e)) (List.mem_map.mpr ⟨e, he, rfl⟩)\n  simp at this\n\n-- With no assumption (the trivially true one), every tree is allowed.\ntheorem allowed_trivial (f : Fold) (h : f.assume = .le (.const 0) (.const 0)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ∀ t, Allowed f ρ maps t\n  | .leaf ι => by simp [Allowed, h, evalC, evalE]\n  | .node ι l r => ⟨by simp [h, evalC, evalE], allowed_trivial f h ρ maps l, allowed_trivial f h ρ maps r⟩\n\n/-- Structural induction: for params that meet the precondition, every law of an accepted fold proof holds of every\ntree whose inputs meet the assumption, for any maps. -/\ntheorem fold_sound (f : Fold) (ps : FoldProof) (h : checkFold f ps = true) (maps : Nat → Nat → Nat) (ρ : Nat → Nat)\n    (h0 : evalC ρ maps f.pre = true) : ∀ t, Allowed f ρ maps t → ∀ l ∈ ps.map (·.1), evalC (foldT f ρ maps t) maps l = true := by\n  simp only [checkFold, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hc, hpre⟩, h⟩ := h\n  have preAt : ∀ env : Nat → Nat, (∀ i, i ∉ touched f → env i = ρ i) → evalC env maps f.pre = true := fun env he => by\n    rw [evalC_avoids hpre maps (ρ' := ρ) he]; exact h0\n  -- What a law reads: the state variables, or variables no tree changes.\n  have reads : ∀ q ∈ ps, ∀ i, occC i q.1 = true → i ∈ f.state.map (·.1) ∨ i ∉ touched f := by\n    intro q hq i hi\n    by_cases hs : i ∈ f.state.map (·.1)\n    · exact Or.inl hs\n    · refine Or.inr fun ht => avoids_occ (h q hq).1.1 hi ?_\n      simp only [List.mem_filter, ht, true_and, Bool.not_eq_true', List.contains_iff_mem]\n      simpa using hs\n  intro t\n  induction t with\n  | leaf ι =>\n    intro ha l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).1.2 (withInputs f.inputs ρ ι) maps\n    intro c hc\n    simp only [leafGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl | rfl\n    · exact preAt _ (fun i hi => withInputs_other (fun h => hi (by simp [touched, h])) ρ ι)\n    · exact ha\n    · simp only [evalC, subst_evalC]; simpa [foldT] using hn\n  | node ι lt rt ihl ihr =>\n    intro ha l hl\n    obtain ⟨hA, hal, har⟩ := ha\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    let Env := withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps lt) (foldT f ρ maps rt)\n    -- A law at a child, read through that side's copies.\n    have side : ∀ (g : Nat × Nat × Nat → Nat) (child : BTree),\n        (∀ e ∈ f.state, Env (g e) = foldT f ρ maps child e.1) → ∀ q ∈ ps,\n        evalC Env maps (substC (f.state.map fun e => (e.1, E.var (g e))) q.1) = evalC (foldT f ρ maps child) maps q.1 := by\n      intro g child hg q hq\n      rw [subst_evalC]\n      refine congrC _ _ maps q.1 (fun i hi => ?_)\n      cases hx : assoc (f.state.map fun e => (e.1, E.var (g e))) i with\n      | some x =>\n        obtain ⟨e, he, rfl, rfl⟩ := assoc_map hx\n        simp only [applyS, hx, evalE]; exact hg e he\n      | none =>\n        have hs : i ∉ f.state.map (·.1) := fun hm => assoc_map_some (g := g) hm hx\n        have ht : i ∉ touched f := (reads q hq i hi).resolve_left hs\n        simp only [applyS, hx, Env]\n        rw [withChildren_plain _ _ _ _ (fun h => ht (by simp [touched, h])) (fun h => ht (by simp [touched, h])),\n          withInputs_other (fun h => ht (by simp [touched, h])), foldT_other f ρ maps ht]\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).2 Env maps\n    intro c hc'\n    simp only [nodeGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false,\n      List.mem_flatMap] at hc'\n    rcases hc' with ((rfl | rfl) | ⟨q, hq, hcq⟩) | rfl\n    · exact preAt Env (fun i hi => by\n        simp only [Env]\n        rw [withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h])) (fun h => hi (by simp [touched, h])),\n          withInputs_other (fun h => hi (by simp [touched, h]))])\n    · exact hA\n    · obtain ⟨q', hq', rfl⟩ := List.mem_map.mp hq\n      rcases hcq with rfl | rfl\n      · simp only [leftSub]\n        rw [side (·.2.1) lt (fun e he => withChildren_left hc _ _ _ he) q' hq']\n        exact ihl hal _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n      · simp only [rightSub]\n        rw [side (·.2.2) rt (fun e he => withChildren_right hc _ _ _ he) q' hq']\n        exact ihr har _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa [foldT, Env] using hn\n\n/-! Step machines with maps. A step may write each map at one key (read-over-write: a read after the step is the\nwritten value at the written key, the old cell elsewhere). A law may hold at every key: it is proven at a fresh skolem\nvariable and assumed, before the step, at whatever keys the proof names (instantiating ∀ is sound at any term). The\ngoals are built here, as for scalar machines. -/\n\nmutual\ndef readsE : E → Bool\n  | .var _ => false\n  | .const _ => false\n  | .add a b => readsE a || readsE b\n  | .sub a b => readsE a || readsE b\n  | .mul _ a => readsE a\n  | .min a b => readsE a || readsE b\n  | .max a b => readsE a || readsE b\n  | .prod a b => readsE a || readsE b\n  | .ite c t f => readsC c || readsE t || readsE f\n  | .get _ _ => true\ndef readsC : C → Bool\n  | .le a b => readsE a || readsE b\n  | .lt a b => readsE a || readsE b\n  | .eq a b => readsE a || readsE b\n  | .and a b => readsC a || readsC b\n  | .or a b => readsC a || readsC b\n  | .not a => readsC a\nend\n\nmutual\ntheorem noReadsE (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (e : E) → readsE e = false → evalE ρ M e = evalE ρ M' e\n  | .var _, _ => rfl\n  | .const _, _ => rfl\n  | .add a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .sub a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .mul _ a, h => by simp only [readsE] at h; simp only [evalE, noReadsE ρ M M' a h]\n  | .min a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .max a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .prod a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .ite c t f, h => by\n    simp only [readsE, Bool.or_eq_false_iff] at h\n    simp only [evalE, noReadsC ρ M M' c h.1.1, noReadsE ρ M M' t h.1.2, noReadsE ρ M M' f h.2]\n  | .get _ _, h => by simp [readsE] at h\ntheorem noReadsC (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (c : C) → readsC c = false → evalC ρ M c = evalC ρ M' c\n  | .le a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .lt a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .eq a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .and a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .or a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .not a, h => by simp only [readsC] at h; simp only [evalC, noReadsC ρ M M' a h]\nend\n\n-- Substitution of variables by σ and of each read by `rd` (applied to the substituted key).\nmutual\ndef substRE (σ : List (Nat × E)) (rd : Nat → E → E) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substRE σ rd a) (substRE σ rd b)\n  | .sub a b => .sub (substRE σ rd a) (substRE σ rd b)\n  | .mul k a => .mul k (substRE σ rd a)\n  | .min a b => .min (substRE σ rd a) (substRE σ rd b)\n  | .max a b => .max (substRE σ rd a) (substRE σ rd b)\n  | .prod a b => .prod (substRE σ rd a) (substRE σ rd b)\n  | .ite c t f => .ite (substRC σ rd c) (substRE σ rd t) (substRE σ rd f)\n  | .get m key => rd m (substRE σ rd key)\ndef substRC (σ : List (Nat × E)) (rd : Nat → E → E) : C → C\n  | .le a b => .le (substRE σ rd a) (substRE σ rd b)\n  | .lt a b => .lt (substRE σ rd a) (substRE σ rd b)\n  | .eq a b => .eq (substRE σ rd a) (substRE σ rd b)\n  | .and a b => .and (substRC σ rd a) (substRC σ rd b)\n  | .or a b => .or (substRC σ rd a) (substRC σ rd b)\n  | .not a => .not (substRC σ rd a)\nend\n\nsection\nvariable (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M M' : Nat → Nat → Nat)\n  (hrd : ∀ m k, evalE W M (rd m k) = M' m (evalE W M k))\ninclude hrd\nmutual\ntheorem substR_evalE : (e : E) → evalE W M (substRE σ rd e) = evalE (applyS σ W M) M' e\n  | .var i => by\n    simp only [substRE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substRE, evalE]\n  | .add a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .sub a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .mul k a => by simp [substRE, evalE, substR_evalE a]\n  | .min a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .max a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .prod a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .ite c t f => by simp [substRE, evalE, substR_evalC c, substR_evalE t, substR_evalE f]\n  | .get m key => by simp only [substRE, evalE, hrd, substR_evalE key]\ntheorem substR_evalC : (c : C) → evalC W M (substRC σ rd c) = evalC (applyS σ W M) M' c\n  | .le a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .lt a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .eq a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .and a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .or a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .not a => by simp [substRC, evalC, substR_evalC a]\nend\nend\n\nstructure MMachine where\n  inputs : List Nat\n  init : List (Nat × E)\n  maps0 : List (Nat × Nat)       -- each map's value at every key at the start\n  step : List (Nat × E)\n  writes : List (Nat × E × E)    -- a map, the key it's written at and the value, over the state before the step\n  pre : C                        -- about the params alone, reading no map\n  assume : C                     -- about each request\n\ndef writeMaps (ws : List (Nat × E × E)) (W : Nat → Nat) (M : Nat → Nat → Nat) : Nat → Nat → Nat := fun m key =>\n  match lookup (fun w => w.1 == m) ws with\n  | some w => if key = evalE W M w.2.1 then evalE W M w.2.2 else M m key\n  | none => M m key\n\ndef StartMaps (m : MMachine) (M : Nat → Nat → Nat) : Prop := ∀ p ∈ m.maps0, ∀ key, M p.1 key = p.2\n\ninductive MReach (m : MMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps m M → evalC ρ M m.pre = true → MReach m (applyS m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : MReach m ρ M →\n      evalC (withInputs m.inputs ρ ι) M m.assume = true →\n      MReach m (applyS m.step (withInputs m.inputs ρ ι) M) (writeMaps m.writes (withInputs m.inputs ρ ι) M)\n\ndef upd (ρ : Nat → Nat) (i v : Nat) : Nat → Nat := fun j => if j = i then v else ρ j\n\n-- A law, and for a law about every key, the variable it holds at.\nstructure MLaw where\n  holds : C\n  key : Option Nat\n\ndef MLaw.Holds (l : MLaw) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop :=\n  match l.key with\n  | none => evalC ρ M l.holds = true\n  | some kv => ∀ v, evalC (upd ρ kv v) M l.holds = true\n\ndef rdStart (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun p => p.1 == mp) m.maps0 with\n  | some p => .const p.2\n  | none => .get mp k\ndef rdStep (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) m.writes with\n  | some w => .ite (.eq k w.2.1) w.2.2 (.get mp k)\n  | none => .get mp k\n\n-- What a goal proves: the law, at the skolem variable if it holds at every key.\ndef goalOf (l : MLaw) (sk : Nat) : C :=\n  match l.key with\n  | none => l.holds\n  | some kv => substC [(kv, .var sk)] l.holds\n\nstructure MEntry where\n  law : MLaw\n  sk : Nat                    -- the skolem variable\n  insts : List (Nat × E)      -- (law index, key): where the step goal assumes the laws about every key\n  start : List VDef × Tree\n  step : List VDef × Tree\n\ndef scalarHyps (laws : List MLaw) : List C := laws.filterMap fun l =>\n  match l.key with\n  | none => some l.holds\n  | some _ => none\ndef instHyps (laws : List MLaw) (insts : List (Nat × E)) : List C := insts.filterMap fun p =>\n  match laws[p.1]? with\n  | some l => match l.key with\n    | some kv => some (substC [(kv, p.2)] l.holds)\n    | none => none\n  | none => none\n\ndef mStartGoal (m : MMachine) (e : MEntry) : List C := [m.pre, .not (substRC m.init (rdStart m) (goalOf e.law e.sk))]\ndef mStepGoal (m : MMachine) (laws : List MLaw) (e : MEntry) : List C :=\n  [m.pre, m.assume] ++ scalarHyps laws ++ instHyps laws e.insts ++ [.not (substRC m.step (rdStep m) (goalOf e.law e.sk))]\n\n-- The skolem is fresh: no input or state variable, and nothing the machine or a law reads.\ndef skOk (m : MMachine) (laws : List MLaw) (sk : Nat) : Bool :=\n  !(m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)).contains sk && !occC sk m.pre && !occC sk m.assume\n    && laws.all (fun l => !occC sk l.holds) && m.init.all (fun p => !occE sk p.2) && m.step.all (fun p => !occE sk p.2)\n    && m.writes.all (fun w => !occE sk w.2.1 && !occE sk w.2.2)\n\ndef checkMMachine (m : MMachine) (ps : List MEntry) : Bool :=\n  avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre && !readsC m.pre\n    && ps.all fun e => avoids m.inputs e.law.holds && skOk m (ps.map (·.law)) e.sk\n      && checkGoal ⟨e.start.1, mStartGoal m e⟩ e.start.2\n      && checkGoal ⟨e.step.1, mStepGoal m (ps.map (·.law)) e⟩ e.step.2\n\ntheorem occ_false {i : Nat} {c : C} (h : (!occC i c) = true) : occC i c = false := by simpa using h\n\n-- A law reads the same at the skolem as it holds at every key.\ntheorem goalOf_holds (l : MLaw) {sk : Nat} (hs : occC sk l.holds = false) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    (∀ v, evalC (upd ρ sk v) M (goalOf l sk) = true) → l.Holds ρ M := by\n  intro h\n  unfold MLaw.Holds\n  unfold goalOf at h\n  split\n  · rename_i hk\n    simp only [hk] at h\n    have := h 0\n    rwa [congrC _ ρ M l.holds (fun i hi => by simp only [upd]; split <;> simp_all)] at this\n  · rename_i kv hk\n    simp only [hk] at h\n    intro v\n    have := h v\n    rw [subst_evalC] at this\n    rwa [congrC _ (upd ρ kv v) M l.holds (fun i hi => by\n      simp only [applyS, assoc, lookup, upd]\n      by_cases hik : i = kv\n      · subst hik; simp [evalE, upd]\n      · have hb : (kv == i) = false := by simp; omega\n        simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik]\n        split <;> simp_all)] at this\n\ntheorem pre_mreach {m : MMachine} (hp : avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre = true)\n    (hr : readsC m.pre = false) : ∀ {ρ M}, MReach m ρ M → evalC ρ M m.pre = true := by\n  intro ρ M h\n  induction h with\n  | start ρ M _ h0 =>\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M)]; exact h0\n  | step ρ M ι _ _ ih =>\n    rw [noReadsC _ _ M m.pre hr]\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n-- With a fresh skolem, σ commutes with setting it.\ntheorem applyS_upd {σ : List (Nat × E)} {sk : Nat} (hk : sk ∉ σ.map (·.1)) (he : σ.all (fun p => !occE sk p.2) = true)\n    (W : Nat → Nat) (M : Nat → Nat → Nat) (v : Nat) : applyS σ (upd W sk v) M = upd (applyS σ W M) sk v := by\n  funext i\n  simp only [upd]\n  by_cases hi : i = sk\n  · subst hi; rw [applyS_other hk]; simp [upd]\n  · simp only [hi, ite_false, applyS]\n    cases h : assoc σ i with\n    | none => simp [upd, hi]\n    | some e =>\n      simp only [assoc, Option.map_eq_some_iff] at h\n      obtain ⟨p, hp, rfl⟩ := h\n      have hm := (lookup_some hp).1\n      simp only [List.all_eq_true] at he\n      have := he p hm\n      exact congrE _ _ M p.2 (fun j hj => by simp only [upd]; split <;> simp_all)\n\n/-- The induction rule with maps: for params that meet the precondition and maps that start as declared, every law of\nan accepted proof holds in every reachable state (a law about every key, at every key). -/\ntheorem mmachine_sound (m : MMachine) (ps : List MEntry) (h : checkMMachine m ps = true) :\n    ∀ ρ M, MReach m ρ M → ∀ e ∈ ps, e.law.Holds ρ M := by\n  simp only [checkMMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hpre, hrp⟩, h⟩ := h\n  simp only [Bool.not_eq_true'] at hrp\n  have hsk : ∀ e ∈ ps, _ := fun e he => (h e he).1.1.2\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 =>\n    intro e he\n    obtain ⟨⟨⟨_, hs⟩, hst⟩, _⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, _⟩, hslaw⟩, hsinit⟩, _⟩, _⟩ := hs\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ M (fun v => ?_)\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd ρ e.sk v) M\n    intro c hc\n    simp only [mStartGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by simp only [upd]; split <;> simp_all)]; exact h0\n    · have hrd : ∀ mp k, evalE (upd ρ e.sk v) M (rdStart m mp k) = M mp (evalE (upd ρ e.sk v) M k) := by\n        intro mp k\n        simp only [rdStart]\n        split\n        · rename_i p hp\n          have ⟨hm, hq⟩ := lookup_some hp\n          simp only [beq_iff_eq] at hq\n          simp only [evalE]; rw [← hq, hM p hm]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M M hrd]\n      rw [applyS_upd (fun h => by simp [h] at hfresh) (by simpa [List.all_eq_true] using hsinit)]\n      simpa using hn\n  | step ρ M ι hr ha ih =>\n    intro e he\n    obtain ⟨⟨⟨hin, hs⟩, _⟩, hst⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, hsas⟩, hslaw⟩, _⟩, hsstep⟩, hsw⟩ := hs\n    have hfresh' : e.sk ∉ m.inputs ∧ e.sk ∉ m.step.map (·.1) := by\n      constructor <;> intro hm <;> simp [hm] at hfresh\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ _ (fun v => ?_)\n    let W0 := withInputs m.inputs ρ ι\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd W0 e.sk v) M\n    -- Reading a law about the state before the step, at the goal's environment.\n    have before : ∀ (l : MLaw), l ∈ ps.map (·.law) → ∀ (g : Nat → Nat), (∀ i, i ∉ m.inputs → i ≠ e.sk → g i = ρ i) →\n        avoids m.inputs l.holds = true → occC e.sk l.holds = false → ∀ c, c = l.holds → evalC g M c = evalC ρ M l.holds := by\n      intro l _ g hg hl hsl c hc; subst hc\n      exact congrC _ _ M l.holds (fun i hi => hg i (avoids_occ hl hi) (by intro h'; subst h'; simp [hsl] at hi))\n    intro c hc\n    simp only [mStepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with (((rfl | rfl) | hc) | hc) | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by\n        simp only [upd, W0]\n        split\n        · rename_i h'; subst h'; simp [hspre] at hi\n        · exact withInputs_other (fun hm => avoids_occ hpre hi (by simp [hm])) ρ ι)]\n      exact pre_mreach hpre hrp hr\n    · rw [congrC _ W0 M m.assume (fun i hi => by simp only [upd]; split <;> simp_all)]; exact ha\n    · simp only [scalarHyps, List.mem_filterMap] at hc\n      obtain ⟨l, hl, hk⟩ := hc\n      split at hk\n      · rename_i hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl\n        have := ih e' he'\n        simp only [MLaw.Holds, hkey] at this\n        rw [before e'.law hl _ (fun i hi hs' => by simp only [upd, hs', ite_false, W0]; exact withInputs_other hi ρ ι)\n          (h e' he').1.1.1 (by simpa using hslaw e'.law hl) _ rfl]\n        exact this\n      · simp at hk\n    · simp only [instHyps, List.mem_filterMap] at hc\n      obtain ⟨p, _, hk⟩ := hc\n      split at hk\n      · rename_i l hl\n        split at hk\n        · rename_i kv hkey\n          simp only [Option.some.injEq] at hk; subst hk\n          have hlm : l ∈ ps.map (·.law) := List.mem_of_getElem? hl\n          obtain ⟨e', he', rfl⟩ := List.mem_map.mp hlm\n          have := ih e' he'\n          simp only [MLaw.Holds, hkey] at this\n          rw [subst_evalC]\n          have hsl : occC e.sk e'.law.holds = false := by simpa using hslaw e'.law hlm\n          rw [congrC _ (upd ρ kv (evalE (upd W0 e.sk v) M p.2)) M e'.law.holds (fun i hi => by\n            simp only [applyS, assoc, lookup, upd]\n            by_cases hik : i = kv\n            · subst hik; simp\n            · have hb : (kv == i) = false := by simp; omega\n              have hs' : i ≠ e.sk := by intro h'; subst h'; simp [hsl] at hi\n              simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik, hs', W0]\n              exact withInputs_other (avoids_occ (h e' he').1.1.1 hi) ρ ι)]\n          exact this _\n        · simp at hk\n      · simp at hk\n    · have hrd : ∀ mp k, evalE (upd W0 e.sk v) M (rdStep m mp k) = writeMaps m.writes W0 M mp (evalE (upd W0 e.sk v) M k) := by\n        intro mp k\n        simp only [rdStep, writeMaps]\n        split\n        · rename_i w hw\n          have hm := (lookup_some hw).1\n          have h1 := hsw w hm\n          try simp only [Bool.and_eq_true, Bool.not_eq_true'] at h1\n          have e1 : evalE (upd W0 e.sk v) M w.2.1 = evalE W0 M w.2.1 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          have e2 : evalE (upd W0 e.sk v) M w.2.2 = evalE W0 M w.2.2 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          simp only [evalE, evalC, e1, e2]\n          by_cases hk : evalE (upd W0 e.sk v) M k = evalE W0 M w.2.1 <;> simp [hk]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M _ hrd]\n      rw [applyS_upd hfresh'.2 (by simpa [List.all_eq_true] using hsstep)]\n      simpa using hn\n\nend Kern\n\n#print axioms Kern.sound\n#print axioms Kern.machine_sound\n#print axioms Kern.fold_sound\n#print axioms Kern.mmachine_sound\n",
+    "Cyclic.lean": "import Kernel\n\n/-!\nCyclic: one rule for every induction, proven sound. Lean 4.34.0, core only, on top of `Kernel.lean`.\n\nA cyclic proof is a list of nodes, each a sequent over the environment: its hypotheses imply its conclusion, for every\nenvironment and every maps that meet the facts. The facts are conditions that hold at every value of their keys (a\nfunction's equations: f(k + 1) = next(k, f(k)) at every k). A node's proof is one kernel goal, refuted by a tree: its\nhypotheses, facts at the terms it names, and what other nodes give where it uses them, against its conclusion. A use\nof node m reads m at a substitution σ of m's variables by terms over this node's frame, where a guard holds: it gives\nm's conclusion at σ, once m's hypotheses at σ follow (one goal each) and m's rank at σ is below this node's rank (one\ngoal, ranks compared in order). Uses may go to any node, the node itself included: the proof is a graph, its cycles\nthe inductions. Every back-edge lowers a rank of naturals compared in order, so every chain of uses is finite, and\n`cyclic_sound` is well-founded induction on the rank.\n\nNothing about machines, recurrences or trees is built in: those are instances, a node's variables standing for a step\ncounter, a recurrence's argument, a node of a table. The goals are built here, from the nodes, so nothing in\nkernel/cyclic.ts but its tree check is trusted beyond this file.\n-/\n\nnamespace Kern\n\n/-- A condition that holds at every value of its keys (the rest of the environment fixed). -/\nstructure Fact where\n  keys : List Nat\n  holds : C\n\n/-- A use of node `node` at `σ` where `guard` holds: a tree per hypothesis of that node (each at σ), and one for the\ndescent of its rank. -/\nstructure Use where\n  node : Nat\n  σ : List (Nat × E)\n  guard : C\n  premises : List (List VDef × Tree)\n  descent : List VDef × Tree\n\n/-- A node: hypotheses ⇒ conclusion, its rank (naturals compared in order), the facts it reads at terms\n(fact index, a term per key), the nodes it uses, and the tree of its own goal. -/\nstructure CNode where\n  hyps : List C\n  concl : C\n  rank : List E\n  insts : List (Nat × List E)\n  uses : List Use\n  main : List VDef × Tree\n\ndef falseC : C := .lt (.const 0) (.const 0)\n\n/-- `as` below `bs` in order: the first that differs is smaller. -/\ndef lexLtC : List E → List E → C\n  | a :: as, b :: bs => .or (.lt a b) (.and (.eq a b) (lexLtC as bs))\n  | _, _ => falseC\n\n/-- The same over values, for lists of one length. -/\ndef lexLt : List Nat → List Nat → Prop\n  | a :: as, b :: bs => as.length = bs.length ∧ (a < b ∨ (a = b ∧ lexLt as bs))\n  | _, _ => False\n\ndef override (keys : List Nat) (vals env : Nat → Nat) : Nat → Nat := fun i => if keys.contains i then vals i else env i\n\n/-- The facts hold: each at every value of its keys. -/\ndef FactsHold (facts : List Fact) (env : Nat → Nat) (maps : Nat → Nat → Nat) : Prop :=\n  ∀ f ∈ facts, ∀ vals : Nat → Nat, evalC (override f.keys vals env) maps f.holds = true\n\ndef cycInsts (facts : List Fact) (insts : List (Nat × List E)) : List C :=\n  insts.filterMap fun p => facts[p.1]?.map fun f => substC (f.keys.zip p.2) f.holds\n\n/-- A substitution leaves every fact's other variables alone. -/\ndef factsAvoid (facts : List Fact) (σ : List (Nat × E)) : Bool :=\n  σ.all fun p => facts.all fun f => f.keys.contains p.1 || !occC p.1 f.holds\n\ndef baseHyps (facts : List Fact) (n : CNode) : List C := n.hyps ++ cycInsts facts n.insts\ndef useHyps (nodes : List CNode) (us : List Use) : List C :=\n  us.filterMap fun u => nodes[u.node]?.map fun m => .or (.not u.guard) (substC u.σ m.concl)\ndef mainGoal (facts : List Fact) (nodes : List CNode) (n : CNode) : List C :=\n  baseHyps facts n ++ useHyps nodes n.uses ++ [.not n.concl]\ndef premiseGoal (facts : List Fact) (n : CNode) (u : Use) (c : C) : List C :=\n  baseHyps facts n ++ [u.guard, .not (substC u.σ c)]\ndef descentGoal (facts : List Fact) (n : CNode) (u : Use) (m : CNode) : List C :=\n  baseHyps facts n ++ [u.guard, .not (lexLtC (m.rank.map (substE u.σ)) n.rank)]\n\ndef checkUse (facts : List Fact) (nodes : List CNode) (n : CNode) (u : Use) : Bool :=\n  match nodes[u.node]? with\n  | none => false\n  | some m => m.rank.length == n.rank.length && factsAvoid facts u.σ && m.hyps.length == u.premises.length\n      && (m.hyps.zip u.premises).all (fun p => checkGoal ⟨p.2.1, premiseGoal facts n u p.1⟩ p.2.2)\n      && checkGoal ⟨u.descent.1, descentGoal facts n u m⟩ u.descent.2\n\ndef checkCyclic (facts : List Fact) (nodes : List CNode) : Bool :=\n  nodes.all fun n => checkGoal ⟨n.main.1, mainGoal facts nodes n⟩ n.main.2 && n.uses.all (checkUse facts nodes n)\n\nsection\nvariable {env : Nat → Nat} {maps : Nat → Nat → Nat}\n\ntheorem lexLtC_sound : ∀ (as bs : List E), as.length = bs.length → evalC env maps (lexLtC as bs) = true →\n    lexLt (as.map (evalE env maps)) (bs.map (evalE env maps))\n  | [], [], _, h => by simp [lexLtC, falseC, evalC, evalE] at h\n  | [], _ :: _, hl, _ => by simp at hl\n  | _ :: _, [], hl, _ => by simp at hl\n  | a :: as, b :: bs, hl, h => by\n    simp only [lexLtC, evalC, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq] at h\n    simp only [List.map_cons, lexLt, List.length_map]\n    refine ⟨by simpa using hl, ?_⟩\n    rcases h with h | ⟨h1, h2⟩\n    · exact Or.inl h\n    · exact Or.inr ⟨h1, lexLtC_sound as bs (by simpa using hl) h2⟩\n\ntheorem lex_acc_cons (n : Nat) (ihn : ∀ l : List Nat, l.length = n → Acc lexLt l) :\n    ∀ a (as : List Nat), as.length = n → Acc lexLt (a :: as) := by\n  intro a\n  refine (Nat.lt_wfRel.wf).induction (C := fun a => ∀ (as : List Nat), as.length = n → Acc lexLt (a :: as)) a ?_\n  intro a iha\n  · intro as has\n    have hacc := ihn as has\n    revert has\n    induction hacc with\n    | intro as _ ihas =>\n      intro has\n      constructor\n      intro w hw\n      cases w with\n      | nil => simp [lexLt] at hw\n      | cons c cs =>\n        simp only [lexLt] at hw\n        obtain ⟨hlen, hc⟩ := hw\n        rcases hc with hlt | ⟨rfl, hl⟩\n        · exact iha c hlt cs (by omega)\n        · exact ihas cs hl (by omega)\n\ntheorem lex_acc : ∀ n (l : List Nat), l.length = n → Acc lexLt l\n  | 0, l, h => by\n    cases l with\n    | nil => exact ⟨_, fun w hw => by cases w <;> simp [lexLt] at hw⟩\n    | cons _ _ => simp at h\n  | n + 1, l, h => by\n    cases l with\n    | nil => simp at h\n    | cons a as => exact lex_acc_cons n (lex_acc n) a as (by simpa using h)\n\ntheorem lexLt_wf : WellFounded lexLt := ⟨fun l => lex_acc l.length l rfl⟩\n\ntheorem cyc_zip_cover {α β : Type} : ∀ (as : List α) (bs : List β), as.length = bs.length → ∀ a ∈ as, ∃ b, (a, b) ∈ as.zip bs\n  | [], _, _, a, ha => by simp at ha\n  | _ :: _, [], h, _, _ => by simp at h\n  | a :: as, b :: bs, h, x, hx => by\n    simp only [List.mem_cons] at hx\n    simp only [List.zip_cons_cons, List.mem_cons]\n    rcases hx with rfl | hx\n    · exact ⟨b, Or.inl rfl⟩\n    · obtain ⟨b', hb'⟩ := cyc_zip_cover as bs (by simpa using h) x hx\n      exact ⟨b', Or.inr hb'⟩\n\ntheorem zip_keys {keys : List Nat} {ts : List E} {i : Nat} (h : i ∈ (keys.zip ts).map (·.1)) : i ∈ keys := by\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n  exact (List.of_mem_zip hp).1\n\ntheorem inst_holds {facts : List Fact} (hF : FactsHold facts env maps) (insts : List (Nat × List E)) :\n    ∀ c ∈ cycInsts facts insts, evalC env maps c = true := by\n  intro c hc\n  simp only [cycInsts, List.mem_filterMap, Option.map_eq_some_iff] at hc\n  obtain ⟨p, _, f, hf, rfl⟩ := hc\n  rw [subst_evalC]\n  have he : applyS (f.keys.zip p.2) env maps = override f.keys (applyS (f.keys.zip p.2) env maps) env := by\n    funext i\n    simp only [override]\n    split\n    · rfl\n    · rename_i hi\n      exact applyS_other (fun h => hi (List.contains_iff_mem.mpr (zip_keys h))) env maps\n  rw [he]\n  exact hF f (List.mem_of_getElem? hf) _\n\ntheorem facts_after {facts : List Fact} {σ : List (Nat × E)} (hA : factsAvoid facts σ = true)\n    (hF : FactsHold facts env maps) : FactsHold facts (applyS σ env maps) maps := by\n  intro f hf vals\n  rw [congrC (override f.keys vals (applyS σ env maps)) (override f.keys vals env) maps f.holds ?_]\n  · exact hF f hf vals\n  · intro i hi\n    simp only [override]\n    split\n    · rfl\n    · rename_i hk\n      cases ha : assoc σ i with\n      | none => simp only [applyS, ha]\n      | some e =>\n        exfalso\n        obtain ⟨p, hp, rfl⟩ := List.mem_map.mp (assoc_mem ha)\n        simp only [factsAvoid, List.all_eq_true, Bool.or_eq_true, Bool.not_eq_true'] at hA\n        rcases hA p hp f hf with h | h\n        · exact hk h\n        · simp [h] at hi\n\ntheorem cyc_base {facts : List Fact} {n : CNode} (hF : FactsHold facts env maps)\n    (hH : ∀ c ∈ n.hyps, evalC env maps c = true) : ∀ c ∈ baseHyps facts n, evalC env maps c = true := by\n  intro c hc\n  simp only [baseHyps, List.mem_append] at hc\n  rcases hc with hc | hc\n  · exact hH c hc\n  · exact inst_holds hF n.insts c hc\nend\n\n/-- Every node of an accepted cyclic proof holds: for any maps, at every environment that meets the facts and the\nnode's hypotheses, its conclusion holds. -/\ntheorem cyclic_sound (facts : List Fact) (nodes : List CNode) (h : checkCyclic facts nodes = true) (maps : Nat → Nat → Nat) :\n    ∀ env, FactsHold facts env maps → ∀ n ∈ nodes, (∀ c ∈ n.hyps, evalC env maps c = true) → evalC env maps n.concl = true := by\n  have key : ∀ v : List Nat, ∀ n ∈ nodes, ∀ env, n.rank.map (evalE env maps) = v → FactsHold facts env maps →\n      (∀ c ∈ n.hyps, evalC env maps c = true) → evalC env maps n.concl = true := by\n    intro v\n    refine lexLt_wf.induction (C := fun v => ∀ n ∈ nodes, ∀ env, n.rank.map (evalE env maps) = v → FactsHold facts env maps →\n      (∀ c ∈ n.hyps, evalC env maps c = true) → evalC env maps n.concl = true) v ?_\n    intro v ih n hn env hv hF hH\n    have hc := (List.all_eq_true.mp h) n hn\n    simp only [Bool.and_eq_true] at hc\n    obtain ⟨hmain, huses⟩ := hc\n    have hbase := cyc_base hF hH\n    have huse : ∀ c ∈ useHyps nodes n.uses, evalC env maps c = true := by\n      intro c hc\n      simp only [useHyps, List.mem_filterMap, Option.map_eq_some_iff] at hc\n      obtain ⟨u, hu, m, hm, rfl⟩ := hc\n      have hcu := (List.all_eq_true.mp huses) u hu\n      simp only [checkUse, hm, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hcu\n      obtain ⟨⟨⟨⟨hlen, hav⟩, hpl⟩, hprem⟩, hdesc⟩ := hcu\n      simp only [evalC, Bool.or_eq_true, Bool.not_eq_true']\n      by_cases hg : evalC env maps u.guard = true\n      · right\n        rw [subst_evalC]\n        have hprem' : ∀ c ∈ m.hyps, evalC (applyS u.σ env maps) maps c = true := by\n          intro c hc\n          obtain ⟨p, hp⟩ := cyc_zip_cover m.hyps u.premises hpl c hc\n          have hs := sound ⟨p.1, premiseGoal facts n u c⟩ p.2 (hprem (c, p) hp) env maps\n          rw [← subst_evalC]\n          apply Decidable.byContradiction\n          intro hf\n          apply hs\n          intro c' hc'\n          simp only [premiseGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc'\n          rcases hc' with hc' | rfl | rfl\n          · exact hbase c' hc'\n          · exact hg\n          · simp only [evalC, Bool.not_eq_true']; simpa using hf\n        have hdl : evalC env maps (lexLtC (m.rank.map (substE u.σ)) n.rank) = true := by\n          have hs := sound ⟨u.descent.1, descentGoal facts n u m⟩ u.descent.2 hdesc env maps\n          apply Decidable.byContradiction\n          intro hf\n          apply hs\n          intro c' hc'\n          simp only [descentGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc'\n          rcases hc' with hc' | rfl | rfl\n          · exact hbase c' hc'\n          · exact hg\n          · simp only [evalC, Bool.not_eq_true']; simpa using hf\n        have hlx := lexLtC_sound (env := env) (maps := maps) _ _ (by simpa using hlen) hdl\n        have hrank : (m.rank.map (substE u.σ)).map (evalE env maps) = m.rank.map (evalE (applyS u.σ env maps) maps) := by\n          simp only [List.map_map]\n          exact List.map_congr_left (fun e _ => by simp [Function.comp, subst_evalE])\n        rw [hrank, hv] at hlx\n        exact ih _ hlx m (List.mem_of_getElem? hm) (applyS u.σ env maps) rfl (facts_after hav hF) hprem'\n      · left\n        simpa using hg\n    have hs := sound ⟨n.main.1, mainGoal facts nodes n⟩ n.main.2 hmain env maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [mainGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n    rcases hc with (hc | hc) | rfl\n    · exact hbase c hc\n    · exact huse c hc\n    · simp only [evalC, Bool.not_eq_true']; simpa using hf\n  intro env hF n hn hH\n  exact key _ n hn env rfl hF hH\n\nend Kern\n",
     "Progress.lean": "import Kernel\n/-!\nProgress: flags and \"some request makes this happen\", the two parts of kernel.ts that Kernel.lean left to TypeScript.\n\nFlags. A step may name conditions (kernel.ts's `step.flags`), decided once per step from the request and the state\nbefore it. Step terms read flag f as `.eq (.var f) (.const 1)`; the flag's variable holds 1 when its condition holds\nand 0 when it doesn't (`decideFlags`). The exporter passes flags through untouched: Lean inlines them itself (`inlineC`\nturns each `.eq (.var f) (.const 1)` into the condition, `inlineE` any other read of f into `ite cond 1 0`, exactly what\nkernel.ts's goal builder does) and proves inlining keeps the meaning (`inline_evalE`, `inline_evalC`). A machine with\nflags reaches, outside its flag variables, exactly the states its inlined machine reaches (`freach_plain`,\n`fmreach_plain`), so the induction rules of Kernel.lean carry over (`fmachine_sound`, `fmmachine_sound`).\n\nProgress. \"In every reachable state where `when` holds, some request makes `then` true of its step\": the request is\nnamed (a term per input over the state and params), and Lean builds kernel.ts's two goals itself: the request is allowed\n(the machine's assumption holds of it), and the step it causes makes `then` hold. `then` reads the state before the step\nby plain names and after it by primed names (`prime`, `primeMaps`). `progress_sound`: for every reachable state where\n`when` holds, the named request is a step the machine allows, and `then` holds of it.\n-/\nnamespace Kern\nopen Cert\n\n/-! Flags -/\n\ndef flagOf (fl : List (Nat × C)) (i : Nat) : Option C := (lookup (fun p => p.1 == i) fl).map (·.2)\ndef flagSub (fl : List (Nat × C)) : List (Nat × E) := fl.map fun p => (p.1, .ite p.2 (.const 1) (.const 0))\ndef flagVars (fl : List (Nat × C)) : List Nat := fl.map (·.1)\n-- The state with every flag decided: flag f holds 1 when its condition holds before the step, else 0.\ndef decideFlags (fl : List (Nat × C)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat := applyS (flagSub fl) ρ maps\n\n-- A read of flag f as a condition becomes the condition itself.\ndef eqOrFlag (fl : List (Nat × C)) (a b a' b' : E) : C :=\n  match a, b with\n  | .var i, .const 1 => match flagOf fl i with\n    | some c => c\n    | none => .eq a' b'\n  | _, _ => .eq a' b'\n\nmutual\ndef inlineE (fl : List (Nat × C)) : E → E\n  | .var i => match flagOf fl i with\n    | some c => .ite c (.const 1) (.const 0)\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (inlineE fl a) (inlineE fl b)\n  | .sub a b => .sub (inlineE fl a) (inlineE fl b)\n  | .mul k a => .mul k (inlineE fl a)\n  | .min a b => .min (inlineE fl a) (inlineE fl b)\n  | .max a b => .max (inlineE fl a) (inlineE fl b)\n  | .prod a b => .prod (inlineE fl a) (inlineE fl b)\n  | .ite c t f => .ite (inlineC fl c) (inlineE fl t) (inlineE fl f)\n  | .get m key => .get m (inlineE fl key)\ndef inlineC (fl : List (Nat × C)) : C → C\n  | .le a b => .le (inlineE fl a) (inlineE fl b)\n  | .lt a b => .lt (inlineE fl a) (inlineE fl b)\n  | .eq a b => eqOrFlag fl a b (inlineE fl a) (inlineE fl b)\n  | .and a b => .and (inlineC fl a) (inlineC fl b)\n  | .or a b => .or (inlineC fl a) (inlineC fl b)\n  | .not a => .not (inlineC fl a)\nend\n\ntheorem lookup_map_same {α : Type} (p : α → Bool) (g : α → α) (hg : ∀ a, p (g a) = p a) :\n    ∀ l : List α, lookup p (l.map g) = (lookup p l).map g\n  | [] => rfl\n  | a :: as => by\n    simp only [List.map_cons, lookup, hg]\n    split <;> simp [lookup_map_same p g hg as]\n\ntheorem lookup_map_pred {α β : Type} (p : β → Bool) (g : α → β) :\n    ∀ l : List α, lookup p (l.map g) = (lookup (fun a => p (g a)) l).map g\n  | [] => rfl\n  | a :: as => by\n    simp only [List.map_cons, lookup]\n    split <;> simp [lookup_map_pred p g as]\n\ntheorem lookup_map_fst {β γ : Type} (i : Nat) (g : β → γ) :\n    ∀ l : List (Nat × β), lookup (fun q => q.1 == i) (l.map fun q => (q.1, g q.2)) = (lookup (fun q => q.1 == i) l).map fun q => (q.1, g q.2)\n  | [] => rfl\n  | a :: as => by\n    simp only [List.map_cons, lookup]\n    split <;> simp [lookup_map_fst i g as]\n\ntheorem assoc_flagSub (fl : List (Nat × C)) (i : Nat) :\n    assoc (flagSub fl) i = (flagOf fl i).map (fun c => .ite c (.const 1) (.const 0)) := by\n  simp only [assoc, flagSub, flagOf, lookup_map_pred, Option.map_map]; rfl\n\ntheorem assoc_map_snd (σ : List (Nat × E)) (g : E → E) (i : Nat) :\n    assoc (σ.map fun p => (p.1, g p.2)) i = (assoc σ i).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\nmutual\ntheorem inline_evalE (fl : List (Nat × C)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → evalE ρ maps (inlineE fl e) = evalE (decideFlags fl ρ maps) maps e\n  | .var i => by\n    cases h : flagOf fl i <;> simp [inlineE, h, evalE, decideFlags, applyS, assoc_flagSub]\n  | .const n => by simp [inlineE, evalE]\n  | .add a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .sub a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .mul k a => by simp [inlineE, evalE, inline_evalE fl ρ maps a]\n  | .min a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .max a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .prod a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .ite c t f => by simp [inlineE, evalE, inline_evalC fl ρ maps c, inline_evalE fl ρ maps t, inline_evalE fl ρ maps f]\n  | .get m key => by simp [inlineE, evalE, inline_evalE fl ρ maps key]\ntheorem inline_evalC (fl : List (Nat × C)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → evalC ρ maps (inlineC fl c) = evalC (decideFlags fl ρ maps) maps c\n  | .le a b => by simp [inlineC, evalC, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .lt a b => by simp [inlineC, evalC, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .eq a b => by\n    have ha := inline_evalE fl ρ maps a\n    have hb := inline_evalE fl ρ maps b\n    simp only [inlineC, eqOrFlag]\n    split\n    · rename_i i\n      cases h : flagOf fl i with\n      | none => simp only [evalC, ha, hb]\n      | some c =>\n        simp only [evalC, evalE, decideFlags, applyS, assoc_flagSub, h, Option.map_some]\n        cases evalC ρ maps c <;> simp\n    · simp only [evalC, ha, hb]\n  | .and a b => by simp [inlineC, evalC, inline_evalC fl ρ maps a, inline_evalC fl ρ maps b]\n  | .or a b => by simp [inlineC, evalC, inline_evalC fl ρ maps a, inline_evalC fl ρ maps b]\n  | .not a => by simp [inlineC, evalC, inline_evalC fl ρ maps a]\nend\n\n-- Flag conditions read the request and the state, never a flag.\ndef flagsOk (fl : List (Nat × C)) : Bool := fl.all fun p => avoids (flagVars fl) p.2\n\n-- A term that reads none of these variables.\ndef avoidsE (vs : List Nat) (e : E) : Bool := vs.all fun i => !occE i e\n\ntheorem avoidsE_occ {vs : List Nat} {e : E} (h : avoidsE vs e = true) {i : Nat} (hi : occE i e = true) : i ∉ vs := by\n  intro hm\n  simp only [avoidsE, List.all_eq_true] at h\n  have := h i hm; simp [hi] at this\n\n-- Two states that agree outside some variables.\ndef Agree (vs : List Nat) (ρ ρ' : Nat → Nat) : Prop := ∀ i, i ∉ vs → ρ i = ρ' i\n\ntheorem flagOf_none {fl : List (Nat × C)} {i : Nat} (h : flagOf fl i = none) : i ∉ flagVars fl := by\n  intro hm\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hm\n  simp only [flagOf, Option.map_eq_none_iff] at h\n  have := lookup_none_all h p hp\n  simp at this\n\ntheorem flagOf_some {fl : List (Nat × C)} {i : Nat} {c : C} (h : flagOf fl i = some c) : ∃ p ∈ fl, p.2 = c := by\n  simp only [flagOf, Option.map_eq_some_iff] at h\n  obtain ⟨p, hp, rfl⟩ := h\n  exact ⟨p, (lookup_some hp).1, rfl⟩\n\ntheorem decide_other {fl : List (Nat × C)} {i : Nat} (hi : i ∉ flagVars fl) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    decideFlags fl ρ maps i = ρ i :=\n  applyS_other (by simpa [flagSub, flagVars] using hi) ρ maps\n\n-- States that agree outside the flags decide the flags alike, so they agree everywhere once the flags are decided.\ntheorem decide_agree {fl : List (Nat × C)} (hf : flagsOk fl = true) {X X' : Nat → Nat} (maps : Nat → Nat → Nat)\n    (h : Agree (flagVars fl) X X') : decideFlags fl X maps = decideFlags fl X' maps := by\n  funext i\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases hc : flagOf fl i with\n  | none => exact h i (flagOf_none hc)\n  | some c =>\n    obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n    simp only [flagsOk, List.all_eq_true] at hf\n    have hav := hf p hp\n    simp only [Option.map_some, evalE]\n    rw [congrC X X' maps p.2 (fun j hj => h j (avoids_occ hav hj))]\n\ntheorem withInputs_agree {vs ins : List Nat} {ρ ρ' : Nat → Nat} (h : Agree vs ρ ρ') (ι : Nat → Nat) :\n    Agree vs (withInputs ins ρ ι) (withInputs ins ρ' ι) := by\n  intro i hi; simp only [withInputs]; split\n  · rfl\n  · exact h i hi\n\n/-! Scalar machines with flags -/\n\nstructure FMachine where\n  m : Machine                 -- step terms and the assumption may read flags\n  flags : List (Nat × C)      -- each flag's variable and its condition\n\ndef FMachine.plain (f : FMachine) : Machine :=\n  { f.m with step := f.m.step.map (fun p => (p.1, inlineE f.flags p.2)), assume := inlineC f.flags f.m.assume }\n\ninductive FReach (f : FMachine) (maps : Nat → Nat → Nat) : (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) : evalC ρ maps f.m.pre = true → FReach f maps (applyS f.m.init ρ maps)\n  | step (ρ ι : Nat → Nat) : FReach f maps ρ →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) maps) maps f.m.assume = true →\n      FReach f maps (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) maps) maps)\n\ndef checkFMachine (f : FMachine) (ps : MachineProof) : Bool :=\n  flagsOk f.flags && ps.all (fun p => avoids (flagVars f.flags) p.1) && checkMachine f.plain ps\n\ntheorem freach_plain (f : FMachine) (hf : flagsOk f.flags = true) (maps : Nat → Nat → Nat) :\n    ∀ {ρ}, FReach f maps ρ → ∃ ρ₀, Reach f.plain maps ρ₀ ∧ Agree (flagVars f.flags) ρ ρ₀ := by\n  intro ρ hr\n  induction hr with\n  | start ρ h0 => exact ⟨_, Reach.start (m := f.plain) ρ h0, fun _ _ => rfl⟩\n  | step ρ ι _ ha ih =>\n    obtain ⟨ρ₀, hr₀, hag⟩ := ih\n    have hdec := decide_agree hf maps (withInputs_agree (ins := f.m.inputs) hag ι)\n    refine ⟨_, Reach.step (m := f.plain) ρ₀ ι hr₀ ?_, ?_⟩\n    · show evalC (withInputs f.m.inputs ρ₀ ι) maps (inlineC f.flags f.m.assume) = true\n      rw [inline_evalC, ← hdec]; exact ha\n    · intro i hi\n      show _ = applyS (f.m.step.map (fun p => (p.1, inlineE f.flags p.2))) (withInputs f.m.inputs ρ₀ ι) maps i\n      simp only [applyS, assoc_map_snd]\n      cases h : assoc f.m.step i with\n      | none =>\n        simp only [Option.map_none]\n        rw [decide_other hi]; exact withInputs_agree (ins := f.m.inputs) hag ι i hi\n      | some e => simp only [Option.map_some, inline_evalE, hdec]\n\n/-- Flags inlined by Lean: every law of an accepted proof of the inlined machine, none reading a flag, holds in every\nstate the machine with flags reaches. -/\ntheorem fmachine_sound (f : FMachine) (ps : MachineProof) (h : checkFMachine f ps = true) (maps : Nat → Nat → Nat) :\n    ∀ ρ, FReach f maps ρ → ∀ l ∈ ps.map (·.1), evalC ρ maps l = true := by\n  simp only [checkFMachine, Bool.and_eq_true, List.all_eq_true] at h\n  obtain ⟨⟨hf, hl⟩, hc⟩ := h\n  intro ρ hr l hlm\n  obtain ⟨ρ₀, hr₀, hag⟩ := freach_plain f hf maps hr\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hlm\n  rw [congrC ρ ρ₀ maps p.1 (fun j hj => hag j (avoids_occ (hl p hp) hj))]\n  exact machine_sound f.plain ps hc maps ρ₀ hr₀ p.1 hlm\n\n/-! Machines with maps and flags -/\n\nstructure FMMachine where\n  m : MMachine\n  flags : List (Nat × C)\n\ndef inlineW (fl : List (Nat × C)) (ws : List (Nat × E × E)) : List (Nat × E × E) :=\n  ws.map fun w => (w.1, inlineE fl w.2.1, inlineE fl w.2.2)\n\ndef FMMachine.plain (f : FMMachine) : MMachine :=\n  { f.m with\n    step := f.m.step.map (fun p => (p.1, inlineE f.flags p.2))\n    writes := inlineW f.flags f.m.writes\n    assume := inlineC f.flags f.m.assume }\n\ninductive FMReach (f : FMMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps f.m M → evalC ρ M f.m.pre = true → FMReach f (applyS f.m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : FMReach f ρ M →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true →\n      FMReach f (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M)\n        (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M)\n\ndef checkFMMachine (f : FMMachine) (ps : List MEntry) : Bool :=\n  flagsOk f.flags && avoids (flagVars f.flags) f.m.pre && ps.all (fun e => avoids (flagVars f.flags) e.law.holds)\n    && checkMMachine f.plain ps\n\ntheorem writeMaps_inline (fl : List (Nat × C)) (ws : List (Nat × E × E)) (X : Nat → Nat) (M : Nat → Nat → Nat) :\n    writeMaps (inlineW fl ws) X M = writeMaps ws (decideFlags fl X M) M := by\n  funext mp key\n  simp only [writeMaps, inlineW, lookup_map_pred]\n  cases lookup (fun w : Nat × E × E => w.1 == mp) ws with\n  | none => rfl\n  | some w => simp only [Option.map_some, inline_evalE]\n\ntheorem fmreach_plain (f : FMMachine) (hf : flagsOk f.flags = true) :\n    ∀ {ρ M}, FMReach f ρ M → ∃ ρ₀, MReach f.plain ρ₀ M ∧ Agree (flagVars f.flags) ρ ρ₀ := by\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 => exact ⟨_, MReach.start (m := f.plain) ρ M hM h0, fun _ _ => rfl⟩\n  | step ρ M ι _ ha ih =>\n    obtain ⟨ρ₀, hr₀, hag⟩ := ih\n    have hdec := decide_agree hf M (withInputs_agree (ins := f.m.inputs) hag ι)\n    have hstep := MReach.step (m := f.plain) ρ₀ M ι hr₀ (by\n      show evalC (withInputs f.m.inputs ρ₀ ι) M (inlineC f.flags f.m.assume) = true\n      rw [inline_evalC, ← hdec]; exact ha)\n    have hw : writeMaps f.plain.writes (withInputs f.plain.inputs ρ₀ ι) M\n        = writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M := by\n      show writeMaps (inlineW f.flags f.m.writes) (withInputs f.m.inputs ρ₀ ι) M = _\n      rw [writeMaps_inline, ← hdec]\n    rw [hw] at hstep\n    refine ⟨_, hstep, ?_⟩\n    intro i hi\n    show _ = applyS (f.m.step.map (fun p => (p.1, inlineE f.flags p.2))) (withInputs f.m.inputs ρ₀ ι) M i\n    simp only [applyS, assoc_map_snd]\n    cases h : assoc f.m.step i with\n    | none =>\n      simp only [Option.map_none]\n      rw [decide_other hi]; exact withInputs_agree (ins := f.m.inputs) hag ι i hi\n    | some e => simp only [Option.map_some, inline_evalE, hdec]\n\n-- A law that reads no flag holds alike in states that agree outside the flags.\ntheorem holds_agree {vs : List Nat} (l : MLaw) (hav : avoids vs l.holds = true) {ρ ρ₀ : Nat → Nat} (hag : Agree vs ρ ρ₀)\n    (M : Nat → Nat → Nat) : l.Holds ρ₀ M → l.Holds ρ M := by\n  unfold MLaw.Holds\n  split\n  · intro h; rwa [congrC ρ ρ₀ M l.holds (fun j hj => hag j (avoids_occ hav hj))]\n  · rename_i kv _\n    intro h v\n    rw [congrC (upd ρ kv v) (upd ρ₀ kv v) M l.holds (fun j hj => by\n      simp only [upd]; split\n      · rfl\n      · exact hag j (avoids_occ hav hj))]\n    exact h v\n\n/-- Flags inlined by Lean, with maps: every law of an accepted proof of the inlined machine holds in every state the\nmachine with flags reaches. -/\ntheorem fmmachine_sound (f : FMMachine) (ps : List MEntry) (h : checkFMMachine f ps = true) :\n    ∀ ρ M, FMReach f ρ M → ∀ e ∈ ps, e.law.Holds ρ M := by\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at h\n  obtain ⟨⟨⟨hf, _⟩, hl⟩, hc⟩ := h\n  intro ρ M hr e he\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  exact holds_agree e.law (hl e he) hag M (mmachine_sound f.plain ps hc ρ₀ M hr₀ e he)\n\n/-! Progress -/\n\nstructure Progress where\n  when : C\n  then_ : C\n  req : List (Nat × E)          -- the request: an input and its term over the state and params\n  prime : List (Nat × Nat)      -- a state variable, and the name `then` reads its value after the step by\n  primeMaps : List (Nat × Nat)  -- a map, and the name `then` reads it after the step by\n  insts : List (Nat × E)        -- (law index, key): where the goals assume the laws about every key\n  allowed : List VDef × Tree\n  causes : List VDef × Tree\n\n-- A term of the step, at the named request: flags inlined, then the request's terms for the inputs.\ndef nowE (f : FMMachine) (pp : Progress) (e : E) : E := substE pp.req (inlineE f.flags e)\n-- What a state variable is after the step: its step term, or itself.\ndef stepTerm (f : FMMachine) (v : Nat) : E :=\n  match assoc f.m.step v with\n  | some e => e\n  | none => .var v\ndef primeSub (f : FMMachine) (pp : Progress) : List (Nat × E) := pp.prime.map fun q => (q.2, nowE f pp (stepTerm f q.1))\n-- A read of a primed map is the map after the step's write (read-over-write); any other read is the map before.\ndef rdAfter (f : FMMachine) (pp : Progress) : Nat → E → E := fun mp k =>\n  match lookup (fun q => q.2 == mp) pp.primeMaps with\n  | some q => match lookup (fun w => w.1 == q.1) f.m.writes with\n    | some w => .ite (.eq k (nowE f pp w.2.1)) (nowE f pp w.2.2) (.get q.1 k)\n    | none => .get q.1 k\n  | none => .get mp k\n\ndef progressBefore (f : FMMachine) (laws : List MLaw) (pp : Progress) : List C :=\n  [f.m.pre] ++ scalarHyps laws ++ instHyps laws pp.insts ++ [pp.when]\ndef allowedGoal (f : FMMachine) (laws : List MLaw) (pp : Progress) : List C :=\n  progressBefore f laws pp ++ [.not (substC pp.req (inlineC f.flags f.m.assume))]\ndef causesGoal (f : FMMachine) (laws : List MLaw) (pp : Progress) : List C :=\n  progressBefore f laws pp ++ [.not (substRC (pp.req ++ primeSub f pp) (rdAfter f pp) pp.then_)]\n\n-- The request names only inputs, no primed name is an input, and `then` reads no flag.\ndef checkProgress (f : FMMachine) (ps : List MEntry) (pp : Progress) : Bool :=\n  pp.req.all (fun p => f.m.inputs.contains p.1) && pp.prime.all (fun q => !f.m.inputs.contains q.2)\n    && avoids (flagVars f.flags) pp.then_\n    && checkGoal ⟨pp.allowed.1, allowedGoal f (ps.map (·.law)) pp⟩ pp.allowed.2\n    && checkGoal ⟨pp.causes.1, causesGoal f (ps.map (·.law)) pp⟩ pp.causes.2\n\n-- What `then` reads: primed names after the step, the rest before it (with the request's inputs).\ndef primed (prime : List (Nat × Nat)) (after before : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun q => q.2 == i) prime with\n  | some q => after q.1\n  | none => before i\ndef primedMaps (pm : List (Nat × Nat)) (after before : Nat → Nat → Nat) : Nat → Nat → Nat := fun mp =>\n  match lookup (fun q => q.2 == mp) pm with\n  | some q => after q.1\n  | none => before mp\n\ntheorem lookup_append {α : Type} (p : α → Bool) : ∀ (l1 l2 : List α),\n    lookup p (l1 ++ l2) = match lookup p l1 with | some a => some a | none => lookup p l2\n  | [], _ => rfl\n  | a :: as, l2 => by simp only [List.cons_append, lookup]; split <;> simp [lookup_append p as l2]\n\ntheorem assoc_none_of {σ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) : assoc σ i = none := by\n  cases ha : assoc σ i with\n  | none => rfl\n  | some e => exact absurd (assoc_mem ha) h\n\n-- Every hypothesis before the request holds at a reachable state where `when` holds.\ntheorem before_true (f : FMMachine) (ps : List MEntry) (pp : Progress) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (hpre : evalC ρ M f.m.pre = true) (hlaws : ∀ e ∈ ps, e.law.Holds ρ M) (hw : evalC ρ M pp.when = true) :\n    ∀ c ∈ progressBefore f (ps.map (·.law)) pp, evalC ρ M c = true := by\n  intro c hc\n  simp only [progressBefore, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with ((rfl | hc) | hc) | rfl\n  · exact hpre\n  · simp only [scalarHyps, List.mem_filterMap] at hc\n    obtain ⟨l, hl, hk⟩ := hc\n    split at hk\n    · rename_i hkey\n      simp only [Option.some.injEq] at hk; subst hk\n      obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl\n      have := hlaws e' he'\n      simpa [MLaw.Holds, hkey] using this\n    · simp at hk\n  · simp only [instHyps, List.mem_filterMap] at hc\n    obtain ⟨p, _, hk⟩ := hc\n    split at hk\n    · rename_i l hl\n      split at hk\n      · rename_i kv hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        have hlm : l ∈ ps.map (·.law) := List.mem_of_getElem? hl\n        obtain ⟨e', he', rfl⟩ := List.mem_map.mp hlm\n        have := hlaws e' he'\n        simp only [MLaw.Holds, hkey] at this\n        rw [subst_evalC]\n        rw [congrC _ (upd ρ kv (evalE ρ M p.2)) M e'.law.holds (fun i _ => by\n          simp only [applyS, assoc, lookup, upd]\n          by_cases hik : i = kv\n          · subst hik; simp\n          · have hb : (kv == i) = false := by simp; omega\n            simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik])]\n        exact this _\n      · simp at hk\n    · simp at hk\n  · exact hw\n\n/-- Progress: in every reachable state where `when` holds, the named request (its inputs ι, the rest of the state as it\nis) is a step the machine allows, and `then` holds of that step: primed names read the state and maps after it, plain\nnames the state before it with the request's inputs. -/\ndef ProgressHolds (f : FMMachine) (pp : Progress) : Prop :=\n    ∀ ρ M, FMReach f ρ M → evalC ρ M pp.when = true →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M f.m.assume = true ∧\n      evalC (primed pp.prime (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M)\n          (withInputs f.m.inputs ρ (applyS pp.req ρ M)))\n        (primedMaps pp.primeMaps (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M) M)\n        pp.then_ = true\n\ntheorem progress_sound (f : FMMachine) (ps : List MEntry) (pp : Progress)\n    (hl : checkFMMachine f ps = true) (hp : checkProgress f ps pp = true) : ProgressHolds f pp := by\n  unfold ProgressHolds\n  revert hl hp\n  intro hl hp\n  show ∀ ρ M, FMReach f ρ M → evalC ρ M pp.when = true →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M f.m.assume = true ∧\n      evalC (primed pp.prime (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M)\n          (withInputs f.m.inputs ρ (applyS pp.req ρ M)))\n        (primedMaps pp.primeMaps (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M) M)\n        pp.then_ = true\n  have hl0 := hl\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at hl\n  obtain ⟨⟨⟨hf, hpref⟩, hlf⟩, hc⟩ := hl\n  simp only [checkProgress, Bool.and_eq_true, List.all_eq_true] at hp\n  obtain ⟨⟨⟨⟨hreq, hprime⟩, _⟩, hal⟩, hca⟩ := hp\n  intro ρ M hr hw\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  -- The laws and the precondition hold here.\n  have hlaws : ∀ e ∈ ps, e.law.Holds ρ M := fmmachine_sound f ps hl0 ρ M hr\n  have hcm := hc\n  simp only [checkMMachine, Bool.and_eq_true] at hcm\n  obtain ⟨⟨hpa, hpr⟩, _⟩ := hcm\n  simp only [Bool.not_eq_true'] at hpr\n  have hpre : evalC ρ M f.m.pre = true := by\n    rw [congrC ρ ρ₀ M f.m.pre (fun j hj => hag j (avoids_occ hpref hj))]\n    exact pre_mreach (m := f.plain) hpa hpr hr₀\n  have hb := before_true f ps pp ρ M hpre hlaws hw\n  -- The request's state: its inputs, the rest as it is.\n  have hX : applyS pp.req ρ M = withInputs f.m.inputs ρ (applyS pp.req ρ M) := by\n    funext i\n    simp only [withInputs]\n    split\n    · rfl\n    · rename_i hi\n      exact applyS_other (fun hm => by\n        obtain ⟨p, hp', rfl⟩ := List.mem_map.mp hm\n        exact hi (by simpa using hreq p hp')) ρ M\n  refine ⟨?_, ?_⟩\n  · apply Decidable.byContradiction; intro hn\n    apply sound _ _ hal ρ M\n    intro c hc'\n    simp only [allowedGoal, List.mem_append, List.mem_singleton] at hc'\n    rcases hc' with hc' | rfl\n    · exact hb c hc'\n    · simp only [evalC, subst_evalC, inline_evalC]\n      rw [← hX] at hn; simpa using hn\n  · apply Decidable.byContradiction; intro hn\n    apply sound _ _ hca ρ M\n    intro c hc'\n    simp only [causesGoal, List.mem_append, List.mem_singleton] at hc'\n    rcases hc' with hc' | rfl\n    · exact hb c hc'\n    · let e := decideFlags f.flags (applyS pp.req ρ M) M\n      have hnow : ∀ t, evalE ρ M (nowE f pp t) = evalE e M t := by\n        intro t; simp only [nowE, subst_evalE, inline_evalE, e]\n      have hrd : ∀ mp k, evalE ρ M (rdAfter f pp mp k)\n          = primedMaps pp.primeMaps (writeMaps f.m.writes e M) M mp (evalE ρ M k) := by\n        intro mp k\n        simp only [rdAfter, primedMaps]\n        cases hq : lookup (fun q => q.2 == mp) pp.primeMaps with\n        | none => simp [evalE]\n        | some q =>\n          simp only [writeMaps]\n          cases hw : lookup (fun w => w.1 == q.1) f.m.writes with\n          | none => simp [evalE]\n          | some w =>\n            simp only [evalE, evalC, hnow]\n            by_cases hk : evalE ρ M k = evalE e M w.2.1 <;> simp [hk]\n      have henv : applyS (pp.req ++ primeSub f pp) ρ M = primed pp.prime (applyS f.m.step e M) (applyS pp.req ρ M) := by\n        funext i\n        have hps : lookup (fun p : Nat × E => p.1 == i) (primeSub f pp)\n            = (lookup (fun q => q.2 == i) pp.prime).map (fun q => (q.2, nowE f pp (stepTerm f q.1))) := by\n          simp only [primeSub, lookup_map_pred]\n        simp only [primed, applyS, assoc, lookup_append, hps]\n        cases hq : lookup (fun q => q.2 == i) pp.prime with\n        | none => cases lookup (fun p => p.1 == i) pp.req <;> rfl\n        | some q =>\n          have ⟨hqm, hqi⟩ := lookup_some hq\n          simp only [beq_iff_eq] at hqi\n          have h1 : lookup (fun p => p.1 == i) pp.req = none := by\n            cases h1 : lookup (fun p => p.1 == i) pp.req with\n            | none => rfl\n            | some p =>\n              exfalso\n              have ⟨hpm, hpi⟩ := lookup_some h1\n              simp only [beq_iff_eq] at hpi\n              have h3 := hprime q hqm\n              have h4 := hreq p hpm\n              rw [hpi, ← hqi] at h4\n              simp at h3 h4; exact h3 h4\n          simp only [h1, Option.map_some]\n          rw [hnow]\n          simp only [stepTerm]\n          cases hs : assoc f.m.step q.1 with\n          | none =>\n            rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = none from hs]\n            simp [evalE, e]\n          | some t =>\n            rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = some t from hs]\n      simp only [evalC, substR_evalC _ _ _ M _ hrd, henv]\n      rw [← hX] at hn; simpa [e] using hn\n\n-- The named request is a step the machine takes: the state after it is reachable too.\ntheorem progress_reach (f : FMMachine) (ps : List MEntry) (pp : Progress)\n    (hl : checkFMMachine f ps = true) (hp : checkProgress f ps pp = true) {ρ M} (hr : FMReach f ρ M)\n    (hw : evalC ρ M pp.when = true) :\n    FMReach f (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M)\n      (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M) :=\n  FMReach.step ρ M _ hr (progress_sound f ps pp hl hp ρ M hr hw).1\n\nend Kern\n\n#print axioms Kern.inline_evalC\n#print axioms Kern.fmachine_sound\n#print axioms Kern.fmmachine_sound\n#print axioms Kern.progress_sound\n#print axioms Kern.progress_reach\n",
     "StepLaw.lean": "import Progress\n\n/-!\nStepLaw: kernel.ts's step laws, \"every request the machine allows takes a step where `then` holds\", proven sound.\n\n`then` reads the state before the step (with the request's inputs) by plain names and the state and maps after it by\nprimed names (`prime`, `primeMaps`), as Progress does; `when` narrows the requests. Where Progress names one request\nand must prove it allowed, a step law is about every request: its inputs are any `ι`, and the machine's assumption\n(flags decided) is a hypothesis. Lean builds the goal itself from the machine (`stepLawGoal`, reusing Progress's\n`progressBefore`, `primeSub` and `rdAfter` with an empty request), and `steplaw_sound` shows that an accepted tree makes\n`StepLawHolds` true in every reachable state. The exporter inlines flags into `when` and `then` (as kernel.ts's goal\ndoes), so both must read no flag variable.\n-/\n\nnamespace Kern\n\nstructure StepLaw where\n  when : C\n  then_ : C\n  prime : List (Nat × Nat)      -- a state variable, and the name `then` reads its value after the step by\n  primeMaps : List (Nat × Nat)  -- a map, and the name `then` reads it after the step by\n  insts : List (Nat × E)        -- (law index, key): where the goal assumes the laws about every key\n  proof : List VDef × Tree\n\n-- The same goal shape as Progress's, with no request named: the request's inputs are the inputs as they are.\ndef asProgress (sl : StepLaw) : Progress := ⟨sl.when, sl.then_, [], sl.prime, sl.primeMaps, sl.insts, sl.proof, sl.proof⟩\n\ndef stepLawGoal (f : FMMachine) (laws : List MLaw) (sl : StepLaw) : List C :=\n  progressBefore f laws (asProgress sl)\n    ++ [inlineC f.flags f.m.assume, .not (substRC (primeSub f (asProgress sl)) (rdAfter f (asProgress sl)) sl.then_)]\n\ndef checkStepLaw (f : FMMachine) (ps : List MEntry) (sl : StepLaw) : Bool :=\n  avoids (flagVars f.flags) sl.then_ && avoids (flagVars f.flags) sl.when\n    && checkGoal ⟨sl.proof.1, stepLawGoal f (ps.map (·.law)) sl⟩ sl.proof.2\n\n/-- A step law: in every reachable state, every request (inputs ι) the machine allows with its flags decided, and that\n`when` admits, takes a step where `then` holds: primed names read the state and maps after it, plain names the state\nbefore it with the request's inputs. -/\ndef StepLawHolds (f : FMMachine) (sl : StepLaw) : Prop :=\n  ∀ ρ M, FMReach f ρ M → ∀ ι : Nat → Nat,\n    evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true →\n    evalC (withInputs f.m.inputs ρ ι) M sl.when = true →\n    evalC (primed sl.prime (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M) (withInputs f.m.inputs ρ ι))\n      (primedMaps sl.primeMaps (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M) M)\n      sl.then_ = true\n\ntheorem applyS_nil (ρ : Nat → Nat) (M : Nat → Nat → Nat) : applyS [] ρ M = ρ := by\n  funext i; simp [applyS, assoc, lookup]\n\ntheorem steplaw_sound (f : FMMachine) (ps : List MEntry) (sl : StepLaw)\n    (hl : checkFMMachine f ps = true) (hs : checkStepLaw f ps sl = true) : StepLawHolds f sl := by\n  intro ρ M hr ι hA hW\n  have hl0 := hl\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at hl\n  obtain ⟨⟨⟨hf, hpref⟩, _⟩, hc⟩ := hl\n  simp only [checkStepLaw, Bool.and_eq_true] at hs\n  obtain ⟨_, hgoal⟩ := hs\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  -- The laws and the precondition hold in the reachable state.\n  have hlaws : ∀ e ∈ ps, e.law.Holds ρ M := fmmachine_sound f ps hl0 ρ M hr\n  have hcm := hc\n  simp only [checkMMachine, Bool.and_eq_true, List.all_eq_true] at hcm\n  obtain ⟨⟨hpa, hpr⟩, hent⟩ := hcm\n  try simp only [Bool.not_eq_true'] at hpr\n  have hpre : evalC ρ M f.m.pre = true := by\n    rw [congrC ρ ρ₀ M f.m.pre (fun j hj => hag j (avoids_occ hpref hj))]\n    exact pre_mreach (m := f.plain) hpa hpr hr₀\n  -- They hold with the request's inputs too: neither reads an input.\n  have hagX : Agree f.m.inputs (withInputs f.m.inputs ρ ι) ρ := fun i hi => withInputs_other hi ρ ι\n  have hpreX : evalC (withInputs f.m.inputs ρ ι) M f.m.pre = true := by\n    rw [congrC (withInputs f.m.inputs ρ ι) ρ M f.m.pre (fun j hj => hagX j (fun h =>\n      avoids_occ hpa hj (List.mem_append_left _ (List.mem_append_left _ h))))]\n    exact hpre\n  have hlawsX : ∀ e ∈ ps, e.law.Holds (withInputs f.m.inputs ρ ι) M := by\n    intro e he\n    have hav := hent e he\n    exact holds_agree e.law hav.1.1.1 hagX M (hlaws e he)\n  have hb := before_true f ps (asProgress sl) (withInputs f.m.inputs ρ ι) M hpreX hlawsX hW\n  apply Decidable.byContradiction; intro hn\n  apply sound _ _ hgoal (withInputs f.m.inputs ρ ι) M\n  intro c hc'\n  simp only [stepLawGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc'\n  rcases hc' with hc' | rfl | rfl\n  · exact hb c hc'\n  · rw [inline_evalC]; exact hA\n  · let e := decideFlags f.flags (withInputs f.m.inputs ρ ι) M\n    have hnow : ∀ t, evalE (withInputs f.m.inputs ρ ι) M (nowE f (asProgress sl) t) = evalE e M t := by\n      intro t; simp only [nowE, asProgress, subst_evalE, applyS_nil, inline_evalE, e]\n    have hrd : ∀ mp k, evalE (withInputs f.m.inputs ρ ι) M (rdAfter f (asProgress sl) mp k)\n        = primedMaps sl.primeMaps (writeMaps f.m.writes e M) M mp (evalE (withInputs f.m.inputs ρ ι) M k) := by\n      intro mp k\n      simp only [rdAfter, primedMaps, asProgress]\n      cases hq : lookup (fun q => q.2 == mp) sl.primeMaps with\n      | none => simp [evalE]\n      | some q =>\n        simp only [writeMaps]\n        cases hw : lookup (fun w => w.1 == q.1) f.m.writes with\n        | none => simp [evalE]\n        | some w =>\n          have h1 := hnow w.2.1\n          have h2 := hnow w.2.2\n          simp only [asProgress] at h1 h2\n          simp only [evalE, evalC, h1, h2]\n          by_cases hk : evalE (withInputs f.m.inputs ρ ι) M k = evalE e M w.2.1 <;> simp [hk]\n    have henv : applyS (primeSub f (asProgress sl)) (withInputs f.m.inputs ρ ι) M = primed sl.prime (applyS f.m.step e M) (withInputs f.m.inputs ρ ι) := by\n      funext i\n      have hps : lookup (fun p : Nat × E => p.1 == i) (primeSub f (asProgress sl))\n          = (lookup (fun q => q.2 == i) sl.prime).map (fun q => (q.2, nowE f (asProgress sl) (stepTerm f q.1))) := by\n        simp only [primeSub, asProgress, lookup_map_pred]\n      simp only [primed, applyS, assoc, hps]\n      cases hq : lookup (fun q => q.2 == i) sl.prime with\n      | none => rfl\n      | some q =>\n        simp only [Option.map_some]\n        rw [hnow]\n        simp only [stepTerm]\n        cases hs : assoc f.m.step q.1 with\n        | none =>\n          rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = none from hs]\n          simp [evalE, e]\n        | some t =>\n          rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = some t from hs]\n    simp only [evalC, substR_evalC _ _ _ M _ hrd, henv]\n    simpa [e] using hn\n\nend Kern\n\n#print axioms Kern.steplaw_sound\n",
     "Steps.lean": "import StepLaw\n\n/-!\nSteps: kernel.ts's k-step laws, \"every k requests in a row that the machine allows, each meeting its `when`, take a\nreachable state to one where `then` holds\", proven sound.\n\nThe goal is a symbolic run, as kernel.ts builds it: a frame is a substitution (each state variable a term over the\nfirst state) and a read of each map (a term over the first state's maps); a step composes the machine's step terms\n(flags inlined) after the frame, and a map read after it is read-over-write. Before each step the laws, the assumption\nand that step's `when` are read at the frame; the first step reads its request's inputs by their own names, the j-th\n(j ≥ 2) by fresh variables (`ren`). `then` reads the first state by plain names and the last by primed ones.\n\nOne invariant carries the proof (`Denotes`, kept by `step_denotes`): the frame denotes the real state after j steps\n(outside the inputs, the fresh variables and the flags) and the real maps. So every hypothesis holds at the first state\nwith the fresh variables set to the later requests (`krun_sound`), and a refuted goal leaves `then` no way to fail\n(`kstep_sound`). Lean builds the goal itself; only the tree comes from TypeScript.\n-/\n\nnamespace Kern\n\nstructure KStep where\n  whens : List C                 -- one per step, flags inlined (0 ≤ 0 for a step with none); k is the length\n  then_ : C\n  ren : List (List (Nat × Nat))  -- per step: (input, the variable the goal reads it by there); [] for the first step\n  prime : List (Nat × Nat)       -- a state variable, and the name `then` reads its value after the last step by\n  primeMaps : List (Nat × Nat)   -- a map, and the name `then` reads it after the last step by\n  insts : List (Nat × E)         -- (law index, key): where each frame assumes the laws about every key\n  proof : List VDef × Tree\n\ndef frameSub (r : List (Nat × Nat)) (σ : List (Nat × E)) : List (Nat × E) := r.map (fun p => (p.1, .var p.2)) ++ σ\ndef stepSub (f : FMMachine) (τ : List (Nat × E)) (rd : Nat → E → E) : List (Nat × E) :=\n  f.m.step.map (fun p => (p.1, substRE τ rd (inlineE f.flags p.2))) ++ τ\ndef stepRd (f : FMMachine) (τ : List (Nat × E)) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) f.m.writes with\n  | some w => .ite (.eq k (substRE τ rd (inlineE f.flags w.2.1))) (substRE τ rd (inlineE f.flags w.2.2)) (rd mp k)\n  | none => rd mp k\ndef frameHyps (f : FMMachine) (laws : List MLaw) (insts : List (Nat × E)) (w : C) : List C :=\n  scalarHyps laws ++ instHyps laws insts ++ [inlineC f.flags f.m.assume, w]\n\n-- The hypotheses along the steps, and the frame after them.\ndef kRun (f : FMMachine) (laws : List MLaw) (insts : List (Nat × E)) :\n    List C → List (List (Nat × Nat)) → List (Nat × E) → (Nat → E → E) → List C × List (Nat × E) × (Nat → E → E)\n  | w :: ws, r :: rs, σ, rd =>\n    ((frameHyps f laws insts w).map (substRC (frameSub r σ) rd) ++ (kRun f laws insts ws rs (stepSub f (frameSub r σ) rd) (stepRd f (frameSub r σ) rd)).1,\n      (kRun f laws insts ws rs (stepSub f (frameSub r σ) rd) (stepRd f (frameSub r σ) rd)).2)\n  | _, _, σ, rd => ([], σ, rd)\n\ndef getRd : Nat → E → E := fun mp k => .get mp k\ndef kEndSub (sl : KStep) (σ : List (Nat × E)) (rd : Nat → E → E) : List (Nat × E) :=\n  sl.prime.map fun q => (q.2, substRE σ rd (.var q.1))\ndef kEndRd (sl : KStep) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun q => q.2 == mp) sl.primeMaps with\n  | some q => rd q.1 k\n  | none => .get mp k\n\ndef kOut (f : FMMachine) (laws : List MLaw) (sl : KStep) := kRun f laws sl.insts sl.whens sl.ren [] getRd\ndef kGoal (f : FMMachine) (laws : List MLaw) (sl : KStep) : List C :=\n  [f.m.pre] ++ (kOut f laws sl).1 ++ [.not (substRC (kEndSub sl (kOut f laws sl).2.1 (kOut f laws sl).2.2) (kEndRd sl (kOut f laws sl).2.2) sl.then_)]\n\ndef distinct : List Nat → Bool\n  | [] => true\n  | a :: as => !as.contains a && distinct as\n\ndef tgts : List (List (Nat × Nat)) → List Nat\n  | [] => []\n  | r :: rs => r.map (·.2) ++ tgts rs\ndef zone (f : FMMachine) (sl : KStep) : List Nat := tgts sl.ren ++ flagVars f.flags\n\ndef checkKStep (f : FMMachine) (ps : List MEntry) (sl : KStep) : Bool :=\n  sl.whens.length == sl.ren.length && sl.ren.head? == some [] && distinct (tgts sl.ren)\n    && sl.ren.all (fun r => r.all fun p => f.m.inputs.contains p.1)\n    && sl.ren.tail.all (fun r => f.m.inputs.all fun i => r.any (·.1 == i))\n    && (tgts sl.ren).all (fun v => !f.m.inputs.contains v)\n    && sl.prime.all (fun q => !f.m.inputs.contains q.1 && !(zone f sl).contains q.1)\n    && avoids (zone f sl) f.m.pre\n    && sl.whens.all (fun w => (frameHyps f (ps.map (·.law)) sl.insts w).all (avoids (zone f sl)))\n    && f.m.step.all (fun p => avoidsE (zone f sl) (inlineE f.flags p.2))\n    && f.m.writes.all (fun w => avoidsE (zone f sl) (inlineE f.flags w.2.1) && avoidsE (zone f sl) (inlineE f.flags w.2.2))\n    && avoids (flagVars f.flags) sl.then_\n    && checkGoal ⟨sl.proof.1, kGoal f (ps.map (·.law)) sl⟩ sl.proof.2\n\n/-! What a k-step law claims -/\n\n-- One step from ρ, M with request ι: flags decided, then the step's terms and writes.\ndef kNext (f : FMMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : (Nat → Nat) × (Nat → Nat → Nat) :=\n  (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M,\n   writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M)\n\ndef kEnd (f : FMMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List (Nat → Nat) → (Nat → Nat) × (Nat → Nat → Nat)\n  | ρ, M, [] => (ρ, M)\n  | ρ, M, ι :: ιs => kEnd f (kNext f ρ M ι).1 (kNext f ρ M ι).2 ιs\n\n-- Each request allowed (the assumption, flags decided) and meeting its step's `when`.\ndef KAllowed (f : FMMachine) : List C → (Nat → Nat) → (Nat → Nat → Nat) → List (Nat → Nat) → Prop\n  | w :: ws, ρ, M, ι :: ιs =>\n    evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true\n      ∧ evalC (withInputs f.m.inputs ρ ι) M w = true ∧ KAllowed f ws (kNext f ρ M ι).1 (kNext f ρ M ι).2 ιs\n  | _, _, _, _ => True\n\n-- What `then`'s plain names read: the first state with the first request, each later request at its fresh variables.\ndef renEnv : List (List (Nat × Nat)) → List (Nat → Nat) → (Nat → Nat) → Nat → Nat\n  | r :: rs, ι :: ιs, b => fun v => match lookup (fun p => p.2 == v) r with\n    | some p => ι p.1\n    | none => renEnv rs ιs b v\n  | _, _, b => b\n\n/-- A k-step law: from every reachable state, every k requests in a row the machine allows (each with its flags\ndecided, each meeting its `when`) end in a state where `then` holds: primed names read the last state and maps, plain\nnames the first state with the first request, and each later request's inputs are read by their fresh variables. -/\ndef KStepHolds (f : FMMachine) (sl : KStep) : Prop :=\n  ∀ ρ M, FMReach f ρ M → ∀ ι₁ ιs, ιs.length + 1 = sl.whens.length → KAllowed f sl.whens ρ M (ι₁ :: ιs) →\n    evalC (primed sl.prime (kEnd f ρ M (ι₁ :: ιs)).1 (renEnv sl.ren (ι₁ :: ιs) (withInputs f.m.inputs ρ ι₁)))\n      (primedMaps sl.primeMaps (kEnd f ρ M (ι₁ :: ιs)).2 M) sl.then_ = true\n\n/-! Lists -/\n\ntheorem distinct_cons {a : Nat} {as : List Nat} (h : distinct (a :: as) = true) : a ∉ as ∧ distinct as = true := by\n  simp only [distinct, Bool.and_eq_true, Bool.not_eq_true'] at h\n  refine ⟨fun hm => ?_, h.2⟩\n  have h1 := h.1\n  simp at h1\n  exact h1 hm\n\ntheorem distinct_append : ∀ {l1 l2 : List Nat}, distinct (l1 ++ l2) = true →\n    distinct l1 = true ∧ distinct l2 = true ∧ ∀ a ∈ l1, a ∉ l2\n  | [], l2, h => ⟨rfl, h, fun _ ha => by simp at ha⟩\n  | a :: as, l2, h => by\n    rw [List.cons_append] at h\n    obtain ⟨hn, hd⟩ := distinct_cons h\n    obtain ⟨h1, h2, h3⟩ := distinct_append hd\n    refine ⟨by simp only [distinct, h1, Bool.and_true, Bool.not_eq_true']; simpa using fun h' => hn (List.mem_append_left l2 h'), h2, fun x hx => ?_⟩\n    rcases List.mem_cons.mp hx with rfl | hx'\n    · exact fun h' => hn (List.mem_append_right _ h')\n    · exact h3 x hx'\n\ntheorem assoc_append_or (l1 l2 : List (Nat × E)) (i : Nat) : assoc (l1 ++ l2) i = (assoc l1 i).or (assoc l2 i) := by\n  simp only [assoc, lookup_append]\n  cases lookup (fun p : Nat × E => p.1 == i) l1 <;> rfl\n\ntheorem applyS_nil' (W : Nat → Nat) (M : Nat → Nat → Nat) : applyS [] W M = W := by\n  funext i; simp [applyS, assoc, lookup]\n\ntheorem assoc_stepSub (f : FMMachine) (τ : List (Nat × E)) (rd : Nat → E → E) (v : Nat) :\n    assoc (f.m.step.map (fun p => (p.1, substRE τ rd (inlineE f.flags p.2)))) v = (assoc f.m.step v).map (fun e => substRE τ rd (inlineE f.flags e)) :=\n  assoc_map_snd f.m.step (fun e => substRE τ rd (inlineE f.flags e)) v\n\n-- Reading `then`'s primed names: each the frame's term for its state variable, the rest as they are.\ntheorem applyS_primes (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    ∀ l : List (Nat × Nat), applyS (l.map fun q => (q.2, substRE σ rd (.var q.1))) W M i\n      = match lookup (fun q => q.2 == i) l with\n        | some q => evalE W M (substRE σ rd (.var q.1))\n        | none => W i\n  | [] => by simp [applyS, assoc, lookup]\n  | a :: as => by\n    have ih := applyS_primes σ rd W M i as\n    simp only [applyS, assoc, List.map_cons, lookup] at ih ⊢\n    by_cases h : a.2 = i\n    · simp [h]\n    · have hb : (a.2 == i) = false := by simpa using h\n      simp only [hb, Bool.false_eq_true, ite_false]; exact ih\n\n-- A fresh variable of one step reads its request.\ntheorem lookup_ren : ∀ {r : List (Nat × Nat)}, distinct (r.map (·.2)) = true → ∀ p ∈ r, lookup (fun q => q.2 == p.2) r = some p\n  | [], _, p, hp => by simp at hp\n  | a :: as, hd, p, hp => by\n    simp only [List.map_cons] at hd\n    obtain ⟨hna, hd'⟩ := distinct_cons hd\n    simp only [lookup]\n    rcases List.mem_cons.mp hp with rfl | hp'\n    · simp\n    · have hne : (a.2 == p.2) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hna (by rw [he]; exact List.mem_map_of_mem hp')\n      simp only [hne, Bool.false_eq_true, ite_false]; exact lookup_ren hd' p hp'\n\ntheorem renEnv_other : ∀ (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)) (b : Nat → Nat) (v : Nat),\n    v ∉ tgts rs → renEnv rs ιs b v = b v\n  | [], ιs, b, v, _ => by cases ιs <;> rfl\n  | r :: rs, [], b, v, _ => rfl\n  | r :: rs, ι :: ιs, b, v, hv => by\n    simp only [tgts, List.mem_append, not_or] at hv\n    have hn : lookup (fun p : Nat × Nat => p.2 == v) r = none := lookup_none (fun p hp => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hv.1 (by rw [← he]; exact List.mem_map_of_mem hp))\n    simp only [renEnv, hn]\n    exact renEnv_other rs ιs b v hv.2\n\n-- Each step's fresh variables hold its request's inputs.\ndef RenOK (W : Nat → Nat) : List (List (Nat × Nat)) → List (Nat → Nat) → Prop\n  | r :: rs, ι :: ιs => (∀ p ∈ r, W p.2 = ι p.1) ∧ RenOK W rs ιs\n  | _, _ => True\n\ntheorem renOK_congr {W W' : Nat → Nat} : ∀ (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)),\n    (∀ v ∈ tgts rs, W v = W' v) → RenOK W' rs ιs → RenOK W rs ιs\n  | [], _, _, _ => trivial\n  | _ :: _, [], _, _ => trivial\n  | r :: rs, ι :: ιs, hag, ⟨hh, ht⟩ => by\n    refine ⟨fun p hp => ?_, renOK_congr rs ιs (fun v hv => hag v (by simp [tgts, hv])) ht⟩\n    rw [hag p.2 (by simp only [tgts, List.mem_append]; exact Or.inl (List.mem_map_of_mem hp))]; exact hh p hp\n\ntheorem renEnv_ok : ∀ (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)) (b : Nat → Nat),\n    distinct (tgts rs) = true → RenOK (renEnv rs ιs b) rs ιs\n  | [], _, _, _ => trivial\n  | _ :: _, [], _, _ => trivial\n  | r :: rs, ι :: ιs, b, hd => by\n    simp only [tgts] at hd\n    obtain ⟨hr, hrs, hdis⟩ := distinct_append hd\n    refine ⟨fun p hp => ?_, renOK_congr rs ιs (fun v hv => ?_) (renEnv_ok rs ιs b hrs)⟩\n    · simp only [renEnv, lookup_ren hr p hp]\n    · have hn : lookup (fun p : Nat × Nat => p.2 == v) r = none := lookup_none (fun p hp => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hdis v (by rw [← he]; exact List.mem_map_of_mem hp) hv)\n      simp only [renEnv, hn]\n\n/-! Frames -/\n\n-- A step's input, read at a frame whose fresh variables hold the request.\ntheorem applyS_frame_in {r : List (Nat × Nat)} {σ : List (Nat × E)} {W : Nat → Nat} {M0 : Nat → Nat → Nat} {ι : Nat → Nat} {i : Nat}\n    (hcov : ∃ p ∈ r, p.1 = i) (hval : ∀ p ∈ r, W p.2 = ι p.1) : applyS (frameSub r σ) W M0 i = ι i := by\n  simp only [applyS, frameSub, assoc_append_or]\n  cases h : assoc (r.map fun p => (p.1, E.var p.2)) i with\n  | none =>\n    obtain ⟨p, hp, rfl⟩ := hcov\n    simp only [assoc, Option.map_eq_none_iff] at h\n    have := lookup_none_all h (p.1, .var p.2) (List.mem_map_of_mem hp)\n    simp at this\n  | some e =>\n    simp only [assoc, Option.map_eq_some_iff] at h\n    obtain ⟨q, hq, rfl⟩ := h\n    obtain ⟨hqm, hqi⟩ := lookup_some hq\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hqm\n    simp at hqi\n    simp only [Option.some_or, evalE, hval p hp, hqi]\n\n-- Any other variable reads through to the frame.\ntheorem applyS_frame_out {r : List (Nat × Nat)} {σ : List (Nat × E)} {W : Nat → Nat} {M0 : Nat → Nat → Nat} {i : Nat}\n    (hi : ∀ p ∈ r, p.1 ≠ i) : applyS (frameSub r σ) W M0 i = applyS σ W M0 i := by\n  have hn : assoc (r.map fun p => (p.1, E.var p.2)) i = none := by\n    simp only [assoc, Option.map_eq_none_iff]\n    exact lookup_none (fun a ha => by\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp ha\n      simp only [beq_eq_false_iff_ne]; exact hi p hp)\n  simp only [applyS, frameSub, assoc_append_or, hn, Option.none_or]\n\n-- The frame σ, rd denotes the state ρ, M (read from the first state W, M0): every variable outside the inputs and\n-- the zone, and every map read.\ndef Denotes (f : FMMachine) (Z : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (rd : Nat → E → E)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop :=\n  (∀ v, v ∉ f.m.inputs → v ∉ Z → applyS σ W M0 v = ρ v) ∧ (∀ mp k, evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n\n-- The frame a step reads (its inputs set) agrees with the state and request outside the zone.\ndef HeadAgree (f : FMMachine) (Z : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (ρ : Nat → Nat) :\n    List (List (Nat × Nat)) → List (Nat → Nat) → Prop\n  | r :: _, ι :: _ => Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι)\n  | _, _ => True\n\nsection\nvariable (f : FMMachine) (Z : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n\n-- A term of the step read at the frame is its value at the real state, flags decided.\ntheorem frame_term {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} {r : List (Nat × Nat)} {ι : Nat → Nat}\n    (hrd : ∀ mp k, evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n    (hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι)) (e : E) (he : avoidsE Z (inlineE f.flags e) = true) :\n    evalE W M0 (substRE (frameSub r σ) rd (inlineE f.flags e)) = evalE (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M e := by\n  rw [substR_evalE (frameSub r σ) rd W M0 M hrd,\n    congrE _ (withInputs f.m.inputs ρ ι) M _ (fun i hi => hX i (avoidsE_occ he hi)), inline_evalE]\n\ntheorem step_denotes {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} (r : List (Nat × Nat)) (ι : Nat → Nat)\n    (hD : Denotes f Z W M0 σ rd ρ M)\n    (hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι))\n    (hfz : ∀ v ∈ flagVars f.flags, v ∈ Z)\n    (hst : ∀ p ∈ f.m.step, avoidsE Z (inlineE f.flags p.2) = true)\n    (hwr : ∀ w ∈ f.m.writes, avoidsE Z (inlineE f.flags w.2.1) = true ∧ avoidsE Z (inlineE f.flags w.2.2) = true) :\n    Denotes f Z W M0 (stepSub f (frameSub r σ) rd) (stepRd f (frameSub r σ) rd) (kNext f ρ M ι).1 (kNext f ρ M ι).2 := by\n  obtain ⟨_, hrd⟩ := hD\n  refine ⟨fun v hvi hvz => ?_, fun mp k => ?_⟩\n  · simp only [kNext, applyS, stepSub, assoc_append_or, assoc_stepSub]\n    cases h : assoc f.m.step v with\n    | some e =>\n      have hm : (v, e) ∈ f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at h\n        obtain ⟨q, hq, rfl⟩ := h\n        obtain ⟨hqm, hqv⟩ := lookup_some hq\n        simp only [beq_iff_eq] at hqv\n        rw [← hqv]; exact hqm\n      simp only [Option.map_some, Option.some_or]\n      exact frame_term f Z W M0 hrd hX e (hst (v, e) hm)\n    | none =>\n      simp only [Option.map_none, Option.none_or]\n      have hvf : v ∉ flagVars f.flags := fun h' => hvz (hfz v h')\n      rw [decide_other hvf, withInputs_other hvi]\n      show applyS (frameSub r σ) W M0 v = ρ v\n      rw [hX v hvz, withInputs_other hvi]\n  · simp only [kNext, stepRd, writeMaps]\n    cases hw : lookup (fun w : Nat × E × E => w.1 == mp) f.m.writes with\n    | none => simp only [hrd]\n    | some w =>\n      have hm := (lookup_some hw).1\n      simp only [evalE, evalC, frame_term f Z W M0 hrd hX w.2.1 (hwr w hm).1, frame_term f Z W M0 hrd hX w.2.2 (hwr w hm).2, hrd]\n      by_cases hk : evalE W M0 k = evalE (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M w.2.1 <;> simp [hk]\nend\n\n-- The laws and the precondition hold at a reachable state with any request's inputs (neither reads an input).\ntheorem reach_facts (f : FMMachine) (ps : List MEntry) (hl : checkFMMachine f ps = true) {ρ : Nat → Nat} {M : Nat → Nat → Nat}\n    (hr : FMReach f ρ M) (ι : Nat → Nat) :\n    evalC (withInputs f.m.inputs ρ ι) M f.m.pre = true ∧ ∀ e ∈ ps, e.law.Holds (withInputs f.m.inputs ρ ι) M := by\n  have hl0 := hl\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at hl\n  obtain ⟨⟨⟨hf, hpref⟩, _⟩, hc⟩ := hl\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  have hlaws : ∀ e ∈ ps, e.law.Holds ρ M := fmmachine_sound f ps hl0 ρ M hr\n  have hcm := hc\n  simp only [checkMMachine, Bool.and_eq_true, List.all_eq_true] at hcm\n  obtain ⟨⟨hpa, hpr⟩, hent⟩ := hcm\n  try simp only [Bool.not_eq_true'] at hpr\n  have hpre : evalC ρ M f.m.pre = true := by\n    rw [congrC ρ ρ₀ M f.m.pre (fun j hj => hag j (avoids_occ hpref hj))]\n    exact pre_mreach (m := f.plain) hpa hpr hr₀\n  have hagX : Agree f.m.inputs (withInputs f.m.inputs ρ ι) ρ := fun i hi => withInputs_other hi ρ ι\n  refine ⟨?_, fun e he => holds_agree e.law (hent e he).1.1.1 hagX M (hlaws e he)⟩\n  rw [congrC (withInputs f.m.inputs ρ ι) ρ M f.m.pre (fun j hj => hagX j (fun h =>\n    avoids_occ hpa hj (List.mem_append_left _ (List.mem_append_left _ h))))]\n  exact hpre\n\n-- Every hypothesis of a frame holds where the frame is read.\ntheorem frame_hyps (f : FMMachine) (ps : List MEntry) (hl : checkFMMachine f ps = true) (Z : List Nat) (insts : List (Nat × E))\n    {W : Nat → Nat} {M0 : Nat → Nat → Nat} {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat}\n    {r : List (Nat × Nat)} {ι : Nat → Nat} {w : C}\n    (hr : FMReach f ρ M) (hrd : ∀ mp k, evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n    (hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι))\n    (hav : ∀ c ∈ frameHyps f (ps.map (·.law)) insts w, avoids Z c = true)\n    (hA : evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true)\n    (hW : evalC (withInputs f.m.inputs ρ ι) M w = true) :\n    ∀ c ∈ frameHyps f (ps.map (·.law)) insts w, evalC W M0 (substRC (frameSub r σ) rd c) = true := by\n  intro c hc\n  obtain ⟨hpre, hlaws⟩ := reach_facts f ps hl hr ι\n  have hb := before_true f ps ⟨w, w, [], [], [], insts, ([], .leaf [] [] [] []), ([], .leaf [] [] [] [])⟩ _ M hpre hlaws hW\n  have hY : evalC (withInputs f.m.inputs ρ ι) M c = true := by\n    simp only [frameHyps, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n    rcases hc with (hc | hc) | rfl | rfl\n    · exact hb c (by simp only [progressBefore, List.mem_append]; exact Or.inl (Or.inl (Or.inr hc)))\n    · exact hb c (by simp only [progressBefore, List.mem_append]; exact Or.inl (Or.inr hc))\n    · rw [inline_evalC]; exact hA\n    · exact hW\n  rw [substR_evalC (frameSub r σ) rd W M0 M hrd, congrC _ (withInputs f.m.inputs ρ ι) M c (fun i hi => hX i (avoids_occ (hav c hc) hi))]\n  exact hY\n\ntheorem krun_sound (f : FMMachine) (ps : List MEntry) (hl : checkFMMachine f ps = true) (Z : List Nat) (insts : List (Nat × E))\n    (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n    (hfz : ∀ v ∈ flagVars f.flags, v ∈ Z)\n    (hst : ∀ p ∈ f.m.step, avoidsE Z (inlineE f.flags p.2) = true)\n    (hwr : ∀ w ∈ f.m.writes, avoidsE Z (inlineE f.flags w.2.1) = true ∧ avoidsE Z (inlineE f.flags w.2.2) = true) :\n    ∀ (ws : List C) (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)) (σ : List (Nat × E)) (rd : Nat → E → E)\n      (ρ : Nat → Nat) (M : Nat → Nat → Nat),\n      ws.length = rs.length → ws.length = ιs.length →\n      (∀ w ∈ ws, ∀ c ∈ frameHyps f (ps.map (·.law)) insts w, avoids Z c = true) →\n      (∀ r ∈ rs, ∀ p ∈ r, p.1 ∈ f.m.inputs) →\n      (∀ r ∈ rs.tail, ∀ i ∈ f.m.inputs, ∃ p ∈ r, p.1 = i) →\n      RenOK W rs.tail ιs.tail →\n      FMReach f ρ M → Denotes f Z W M0 σ rd ρ M → HeadAgree f Z W M0 σ ρ rs ιs → KAllowed f ws ρ M ιs →\n      (∀ c ∈ (kRun f (ps.map (·.law)) insts ws rs σ rd).1, evalC W M0 c = true)\n        ∧ Denotes f Z W M0 (kRun f (ps.map (·.law)) insts ws rs σ rd).2.1 (kRun f (ps.map (·.law)) insts ws rs σ rd).2.2\n            (kEnd f ρ M ιs).1 (kEnd f ρ M ιs).2\n  | [], rs, ιs, σ, rd, ρ, M, hl1, hl2, _, _, _, _, _, hD, _, _ => by\n    cases rs with\n    | cons _ _ => simp at hl1\n    | nil =>\n      cases ιs with\n      | cons _ _ => simp at hl2\n      | nil => exact ⟨fun c hc => by simp [kRun] at hc, hD⟩\n  | w :: ws, rs, ιs, σ, rd, ρ, M, hl1, hl2, hav, hkeys, hcov, hren, hr, hD, hH, hK => by\n    rcases rs with _ | ⟨r, rs⟩\n    · simp at hl1\n    rcases ιs with _ | ⟨ι, ιs⟩\n    · simp at hl2\n    simp only [List.length_cons, Nat.add_right_cancel_iff] at hl1 hl2\n    simp only [List.tail_cons] at hcov hren\n    obtain ⟨hA, hW, hK'⟩ := hK\n    have hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι) := hH\n    have hD' := step_denotes f Z W M0 r ι hD hX hfz hst hwr\n    have hr' : FMReach f (kNext f ρ M ι).1 (kNext f ρ M ι).2 := FMReach.step ρ M ι hr hA\n    -- The next step's frame, its inputs set, agrees with the next state and request.\n    have hH' : HeadAgree f Z W M0 (stepSub f (frameSub r σ) rd) (kNext f ρ M ι).1 rs ιs := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases ιs with _ | ⟨ι', ιs'⟩\n      · exact trivial\n      intro v hvz\n      by_cases hvi : v ∈ f.m.inputs\n      · show applyS (frameSub r' (stepSub f (frameSub r σ) rd)) W M0 v = withInputs f.m.inputs (kNext f ρ M ι).1 ι' v\n        rw [applyS_frame_in (hcov r' List.mem_cons_self v hvi) hren.1]\n        simp only [withInputs, List.contains_iff_mem, hvi, ite_true]\n      · show applyS (frameSub r' (stepSub f (frameSub r σ) rd)) W M0 v = withInputs f.m.inputs (kNext f ρ M ι).1 ι' v\n        rw [applyS_frame_out (fun p hp he => hvi (by rw [← he]; exact hkeys r' (List.mem_cons_of_mem _ List.mem_cons_self) p hp)),\n          hD'.1 v hvi hvz, withInputs_other hvi]\n    have hren' : RenOK W rs.tail ιs.tail := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases ιs with _ | ⟨ι', ιs'⟩\n      · cases rs' <;> exact trivial\n      exact hren.2\n    obtain ⟨ih1, ih2⟩ := krun_sound f ps hl Z insts W M0 hfz hst hwr ws rs ιs _ _ _ _ hl1 hl2\n      (fun w' hw' => hav w' (List.mem_cons_of_mem _ hw'))\n      (fun r' hr'' => hkeys r' (List.mem_cons_of_mem _ hr''))\n      (fun r' hr'' => hcov r' (List.mem_of_mem_tail hr''))\n      hren' hr' hD' hH' hK'\n    refine ⟨fun c hc => ?_, ih2⟩\n    simp only [kRun, List.mem_append, List.mem_map] at hc\n    rcases hc with ⟨c', hc', rfl⟩ | hc\n    · exact frame_hyps f ps hl Z insts hr hD.2 hX (hav w List.mem_cons_self) hA hW c' hc'\n    · exact ih1 c hc\n\ntheorem kstep_sound (f : FMMachine) (ps : List MEntry) (sl : KStep)\n    (hl : checkFMMachine f ps = true) (hs : checkKStep f ps sl = true) : KStepHolds f sl := by\n  intro ρ M hr ι₁ ιs hlen hK\n  simp only [checkKStep, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hs\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hlw, hhead⟩, hdist⟩, hkeys⟩, hcov⟩, hrv⟩, hpr⟩, hpre⟩, hws⟩, hst⟩, hwr⟩, hthen⟩, hgoal⟩ := hs\n  have hflags : ∀ v ∈ flagVars f.flags, v ∈ zone f sl := fun v hv => List.mem_append_right _ hv\n  obtain ⟨rs, hrs⟩ : ∃ rs, sl.ren = [] :: rs := by\n    cases h : sl.ren with\n    | nil => rw [h] at hhead; simp at hhead\n    | cons r rs => rw [h] at hhead; simp only [List.head?_cons, Option.some.injEq] at hhead; exact ⟨rs, by rw [hhead]⟩\n  let W := renEnv sl.ren (ι₁ :: ιs) (withInputs f.m.inputs ρ ι₁)\n  have hWo : ∀ v, v ∉ zone f sl → W v = withInputs f.m.inputs ρ ι₁ v := fun v hv =>\n    renEnv_other _ _ _ v (fun h => hv (List.mem_append_left _ h))\n  have hD0 : Denotes f (zone f sl) W M [] getRd ρ M :=\n    ⟨fun v hvi hvz => by rw [applyS_nil', hWo v hvz, withInputs_other hvi], fun mp k => by simp [getRd, evalE]⟩\n  have hH0 : HeadAgree f (zone f sl) W M [] ρ sl.ren (ι₁ :: ιs) := by\n    rw [hrs]\n    show Agree _ (applyS (frameSub [] []) W M) (withInputs f.m.inputs ρ ι₁)\n    intro v hvz\n    simp only [frameSub, List.map_nil, List.append_nil, applyS_nil']; exact hWo v hvz\n  have hren0 : RenOK W sl.ren.tail (ι₁ :: ιs).tail := by\n    have h : RenOK W sl.ren (ι₁ :: ιs) := renEnv_ok sl.ren (ι₁ :: ιs) (withInputs f.m.inputs ρ ι₁) hdist\n    rw [hrs] at h ⊢; exact h.2\n  obtain ⟨hh, hfin⟩ := krun_sound f ps hl (zone f sl) sl.insts W M hflags\n    hst hwr\n    sl.whens sl.ren (ι₁ :: ιs) [] getRd ρ M hlw (by simp only [List.length_cons]; omega)\n    hws (fun r hr p hp => List.contains_iff_mem.mp (hkeys r hr p hp))\n    (fun r hr i hi => by have := hcov r hr i hi; simpa only [List.any_eq_true, beq_iff_eq] using this)\n    hren0 hr hD0 hH0 hK\n  apply Decidable.byContradiction; intro hn\n  apply sound _ _ hgoal W M\n  intro c hc\n  simp only [kGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with (rfl | hc) | rfl\n  · -- The precondition: at the first state (it reads no input and no fresh variable).\n    obtain ⟨hpX, _⟩ := reach_facts f ps hl hr ι₁\n    rw [congrC W (withInputs f.m.inputs ρ ι₁) M f.m.pre (fun j hj => hWo j (avoids_occ hpre hj))]; exact hpX\n  · exact hh c hc\n  · -- `then`, read across the run, is what KStepHolds reads.\n    have hrdE : ∀ mp k, evalE W M (kEndRd sl (kOut f (ps.map (·.law)) sl).2.2 mp k)\n        = primedMaps sl.primeMaps (kEnd f ρ M (ι₁ :: ιs)).2 M mp (evalE W M k) := by\n      intro mp k\n      simp only [kEndRd, primedMaps]\n      cases hq : lookup (fun q => q.2 == mp) sl.primeMaps with\n      | none => simp [evalE]\n      | some q => exact hfin.2 q.1 k\n    have henv : applyS (kEndSub sl (kOut f (ps.map (·.law)) sl).2.1 (kOut f (ps.map (·.law)) sl).2.2) W M\n        = primed sl.prime (kEnd f ρ M (ι₁ :: ιs)).1 W := by\n      funext i\n      rw [kEndSub, applyS_primes]\n      simp only [primed]\n      cases hq : lookup (fun q => q.2 == i) sl.prime with\n      | none => rfl\n      | some q =>\n        have hq1 := hpr q (lookup_some hq).1\n        simp only [Bool.not_eq_true'] at hq1\n        have hqi : q.1 ∉ f.m.inputs := by simpa using hq1.1\n        have hqz : q.1 ∉ zone f sl := by simpa using hq1.2\n        show evalE W M (substRE (kOut f (ps.map (·.law)) sl).2.1 (kOut f (ps.map (·.law)) sl).2.2 (.var q.1)) = (kEnd f ρ M (ι₁ :: ιs)).1 q.1\n        have hfin' : Denotes f (zone f sl) W M (kOut f (ps.map fun e : MEntry => e.law) sl).2.1 (kOut f (ps.map fun e : MEntry => e.law) sl).2.2\n            (kEnd f ρ M (ι₁ :: ιs)).1 (kEnd f ρ M (ι₁ :: ιs)).2 := hfin\n        exact (substR_evalE (kOut f (ps.map fun e : MEntry => e.law) sl).2.1 _ W M _ hfin'.2 (.var q.1)).trans (hfin'.1 q.1 hqi hqz)\n    simp only [evalC, substR_evalC _ _ W M _ hrdE, henv]\n    simpa using hn\n\nend Kern\n\n#print axioms Kern.kstep_sound\n",
@@ -10,4 +11,6 @@ export const leanLibrary = {
     "Live.lean": "import Sets\n\n/-!\nLiveness under fairness: \"from leads to to\", proven sound for machines with sets (`sleads_sound`, and under weak\nfairness `sleads_wf_sound`); a machine with maps and flags is one with no sets. kernel.ts proves it by a rank (naturals over the state and params, compared in\norder: the first that differs decides) and helpful requests, each with the region where it helps. While `from` holds and\n`to` doesn't: every request allowed keeps `from` or reaches `to`, and reaches `to`, lowers the rank, or keeps the rank\nwith every region it was in kept (a step law); some region holds (a step law that reads no step); and each helpful\nrequest, taken in its region, reaches `to` or lowers the rank (a step law whose `when` names the inputs the request\nsets; the others, and the maps it carries, stay free: a history's queries among them). Lean builds all of them from the\nliveness and checks them with the step-law rules (StepLaw.lean's, Sets.lean's). Then along every run that takes each\nhelpful request infinitely often, each state where `from` holds is followed by one where `to` holds: the rank can't drop\nforever, once it stops dropping the region it is in stays, and that region's request comes and lowers it.\n-/\n\nnamespace Kern\n\n/-! Ranks compared in order -/\n\ndef lexB : List Nat → List Nat → Bool\n  | a' :: as', a :: as => decide (a' < a) || (decide (a' = a) && lexB as' as)\n  | _, _ => false\n\ntheorem lexB_irrefl : ∀ x : List Nat, lexB x x = false\n  | [] => rfl\n  | a :: as => by simp [lexB, lexB_irrefl as]\n\ntheorem nat_down {g : Nat → Nat} {n0 : Nat} (h : ∀ n, n0 ≤ n → g (n + 1) ≤ g n) : ∀ d, g (n0 + d) ≤ g n0\n  | 0 => Nat.le_refl _\n  | d + 1 => Nat.le_trans (h (n0 + d) (Nat.le_add_right _ _)) (nat_down h d)\n\n-- A natural that never rises from n0 on stops changing.\ntheorem nat_stable (g : Nat → Nat) : ∀ v n0, g n0 ≤ v → (∀ n, n0 ≤ n → g (n + 1) ≤ g n) →\n    ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → g m = g T := by\n  intro v\n  induction v with\n  | zero =>\n    intro n0 hv h\n    refine ⟨n0, Nat.le_refl _, fun m hm => ?_⟩\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    have := nat_down h d; omega\n  | succ v ih =>\n    intro n0 hv h\n    by_cases hall : ∀ m, n0 ≤ m → g m = g n0\n    · exact ⟨n0, Nat.le_refl _, hall⟩\n    · have hex : ∃ m, n0 ≤ m ∧ g m ≠ g n0 := Classical.byContradiction fun hno =>\n        hall fun m hm => Classical.byContradiction fun hne => hno ⟨m, hm, hne⟩\n      obtain ⟨m, hm, hne⟩ := hex\n      obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n      have := nat_down h d\n      obtain ⟨T, hT, hTm⟩ := ih (n0 + d) (by omega) (fun n hn => h n (by omega))\n      exact ⟨T, by omega, hTm⟩\n\n-- A rank of k naturals that never rises (in order) from n0 on stops changing.\ntheorem lex_stable : ∀ (k : Nat) (r : Nat → List Nat) (n0 : Nat), (∀ n, (r n).length = k) →\n    (∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n) → ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → r m = r T\n  | 0, r, n0, hk, _ => ⟨n0, Nat.le_refl _, fun m _ => by\n      rw [List.eq_nil_of_length_eq_zero (hk m), List.eq_nil_of_length_eq_zero (hk n0)]⟩\n  | k + 1, r, n0, hk, hmono => by\n    have hcons : ∀ n, r n = (r n).headD 0 :: (r n).tail := by\n      intro n\n      have := hk n\n      cases h : r n with\n      | nil => rw [h] at this; simp at this\n      | cons a as => rfl\n    have hstep : ∀ n, n0 ≤ n → (r (n + 1)).headD 0 < (r n).headD 0 ∨\n        ((r (n + 1)).headD 0 = (r n).headD 0 ∧ (lexB (r (n + 1)).tail (r n).tail = true ∨ (r (n + 1)).tail = (r n).tail)) := by\n      intro n hn\n      have h := hmono n hn\n      rw [hcons (n + 1), hcons n] at h\n      simp only [lexB, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq, List.cons.injEq] at h\n      rcases h with (h | ⟨h1, h2⟩) | ⟨h1, h2⟩\n      · exact Or.inl h\n      · exact Or.inr ⟨h1, Or.inl h2⟩\n      · exact Or.inr ⟨h1, Or.inr h2⟩\n    obtain ⟨T1, hT1, hT1m⟩ := nat_stable (fun n => (r n).headD 0) _ n0 (Nat.le_refl _) (fun n hn => by\n      rcases hstep n hn with h | ⟨h, _⟩\n      · exact Nat.le_of_lt h\n      · exact Nat.le_of_eq h)\n    obtain ⟨T2, hT2, hT2m⟩ := lex_stable k (fun n => (r n).tail) T1 (fun n => by simp [hk n]) (fun n hn => by\n      rcases hstep n (by omega) with h | ⟨_, h⟩\n      · have e1 := hT1m (n + 1) (by omega); have e2 := hT1m n hn; omega\n      · exact h)\n    refine ⟨T2, by omega, fun m hm => ?_⟩\n    have e1 := hT1m m (by omega); have e2 := hT1m T2 hT2; have e3 := hT2m m hm\n    rw [hcons m, hcons T2, e3, e1, e2]\n\n/-- Along a run: if `P ∧ ¬Q` is kept (or Q reached) with the rank never rising, and kept only with every region kept;\nsome region holds while `P ∧ ¬Q` does; and each region's helpful step reaches Q or lowers the rank there; then Q\nfollows every P, provided each helpful step is taken from any point on where it stays enabled (E), and it is enabled in\nits region while `P ∧ ¬Q` holds. With E always true, that is: each helpful step taken infinitely often. -/\ntheorem leads_of_lex {α : Type} (P Q : Nat → Prop) (r : Nat → List Nat) (k : Nat) (hk : ∀ n, (r n).length = k)\n    (helps : List α) (W H E : α → Nat → Prop)\n    (hstay : ∀ n, P n → ¬ Q n → (P (n + 1) ∨ Q (n + 1)) ∧\n      (Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true ∨ (r (n + 1) = r n ∧ ∀ h ∈ helps, W h n → W h (n + 1))))\n    (hcover : ∀ n, P n → ¬ Q n → ∃ h ∈ helps, W h n)\n    (hhelp : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → H h n → Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true)\n    (henabled : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → E h n)\n    (fair : ∀ h ∈ helps, ∀ n, (∀ m, n ≤ m → E h m) → ∃ m, n ≤ m ∧ H h m) : ∀ n, P n → ∃ m, n ≤ m ∧ Q m := by\n  intro n0 hP\n  apply Classical.byContradiction\n  intro hno\n  have hnq : ∀ m, n0 ≤ m → ¬ Q m := fun m hm hq => hno ⟨m, hm, hq⟩\n  have hPd : ∀ d, P (n0 + d) := by\n    intro d\n    induction d with\n    | zero => exact hP\n    | succ d ih =>\n      rcases (hstay (n0 + d) ih (hnq _ (Nat.le_add_right _ _))).1 with h | h\n      · exact h\n      · exact absurd h (hnq _ (by omega))\n  have hPm : ∀ m, n0 ≤ m → P m := fun m hm => by obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm; exact hPd d\n  have hmono : ∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n := by\n    intro n hn\n    rcases (hstay n (hPm n hn) (hnq n hn)).2 with h | h | ⟨h, _⟩\n    · exact absurd h (hnq _ (by omega))\n    · exact Or.inl h\n    · exact Or.inr h\n  -- The rank stops changing at T; the region T is in stays, and its helpful step would lower the rank.\n  obtain ⟨T, hT, hTm⟩ := lex_stable k r n0 hk hmono\n  have hlow : ∀ m, T ≤ m → lexB (r (m + 1)) (r m) ≠ true := fun m hm hl => by\n    rw [hTm (m + 1) (by omega), hTm m hm, lexB_irrefl] at hl; exact absurd hl (by simp)\n  obtain ⟨h, hh, hW⟩ := hcover T (hPm T hT) (hnq T hT)\n  have hWd : ∀ d, W h (T + d) := by\n    intro d\n    induction d with\n    | zero => exact hW\n    | succ d ih =>\n      rcases (hstay (T + d) (hPm _ (by omega)) (hnq _ (by omega))).2 with hq | hl | ⟨_, hkeep⟩\n      · exact absurd hq (hnq _ (by omega))\n      · exact absurd hl (hlow _ (by omega))\n      · exact hkeep h hh ih\n  obtain ⟨m, hm, hH⟩ := fair h hh T (fun m hm => by\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    exact henabled h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d))\n  obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n  rcases hhelp h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d) hH with hq | hl\n  · exact hnq _ (by omega) hq\n  · exact hlow _ (by omega) hl\n\n/-! Primed names: a condition read after a step -/\n\n-- A term with its state variables renamed to their primed names (`pr`: variable, name) and its maps to theirs (`pm`).\nmutual\ndef primeE (pr pm : List (Nat × Nat)) : E → E\n  | .var i => match lookup (fun q => q.1 == i) pr with\n    | some q => .var q.2\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (primeE pr pm a) (primeE pr pm b)\n  | .sub a b => .sub (primeE pr pm a) (primeE pr pm b)\n  | .mul k a => .mul k (primeE pr pm a)\n  | .min a b => .min (primeE pr pm a) (primeE pr pm b)\n  | .max a b => .max (primeE pr pm a) (primeE pr pm b)\n  | .prod a b => .prod (primeE pr pm a) (primeE pr pm b)\n  | .ite c t f => .ite (primeC pr pm c) (primeE pr pm t) (primeE pr pm f)\n  | .get m k => .get (match lookup (fun q => q.1 == m) pm with\n      | some q => q.2\n      | none => m) (primeE pr pm k)\ndef primeC (pr pm : List (Nat × Nat)) : C → C\n  | .le a b => .le (primeE pr pm a) (primeE pr pm b)\n  | .lt a b => .lt (primeE pr pm a) (primeE pr pm b)\n  | .eq a b => .eq (primeE pr pm a) (primeE pr pm b)\n  | .and a b => .and (primeC pr pm a) (primeC pr pm b)\n  | .or a b => .or (primeC pr pm a) (primeC pr pm b)\n  | .not a => .not (primeC pr pm a)\nend\n\n-- Read where `then` reads (primed names after, the rest before), a renamed term is the term after, wherever a variable\n-- or map it reads is renamed or the same before and after, and reads no primed name.\nsection prime\nvariable (pr pm : List (Nat × Nat)) (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n  (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat)\ninclude hpr hpm\nmutual\ntheorem primeE_eval : (e : E) → (∀ i, occE i e = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occME mp e = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalE (primed pr ρ' ρ) (primedMaps pm M' M) (primeE pr pm e) = evalE ρ' M' e\n  | .var i, hv, _ => by\n    simp only [primeE]\n    cases hl : lookup (fun q => q.1 == i) pr with\n    | some q =>\n      have ⟨hq, hqi⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqi\n      simp only [evalE, primed, lookup_ren hpr q hq, hqi]\n    | none =>\n      have hi := hv i (by simp [occE])\n      have hnot : i ∉ pr.map (·.1) := fun hm => by\n        obtain ⟨q, hq, hqi⟩ := List.mem_map.mp hm\n        have := lookup_none_all hl q hq; simp [hqi] at this\n      have hn2 : lookup (fun q => q.2 == i) pr = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hi.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [evalE, primed, hn2]\n      rcases hi.2 with h | h\n      · exact absurd h hnot\n      · exact h.symm\n  | .const n, _, _ => rfl\n  | .add a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .sub a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .mul k a, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .min a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .max a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .prod a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .ite c t f, hv, hm => by\n    simp only [primeE, evalE, primeC_eval c (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval t (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval f (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .get m k, hv, hm => by\n    have hk := primeE_eval k (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))\n    simp only [primeE, evalE, hk]\n    cases hl : lookup (fun q => q.1 == m) pm with\n    | some q =>\n      have ⟨hq, hqm⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqm\n      simp only [primedMaps, lookup_ren hpm q hq, hqm]\n    | none =>\n      have hmm := hm m (by simp [occME])\n      have hnot : m ∉ pm.map (·.1) := fun hmem => by\n        obtain ⟨q, hq, hqm⟩ := List.mem_map.mp hmem\n        have := lookup_none_all hl q hq; simp [hqm] at this\n      have hn2 : lookup (fun q => q.2 == m) pm = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hmm.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [primedMaps, hn2]\n      rcases hmm.2 with h | h\n      · exact absurd h hnot\n      · rw [h]\ntheorem primeC_eval : (c : C) → (∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalC (primed pr ρ' ρ) (primedMaps pm M' M) (primeC pr pm c) = evalC ρ' M' c\n  | .le a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .lt a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .eq a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .and a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .or a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .not a, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\nend\nend prime\n\n-- Read where `then` reads, a condition that reads no primed name is the condition before the step.\ntheorem unprimedC_eval {pr pm : List (Nat × Nat)} {c : C} (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalC (primed pr ρ' ρ) (primedMaps pm M' M) c = evalC ρ M c := by\n  rw [congrC _ ρ _ c (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrMC ρ _ M c (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\ntheorem unprimed_eval {pr pm : List (Nat × Nat)} {e : E} (hv : ∀ i, occE i e = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occME mp e = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalE (primed pr ρ' ρ) (primedMaps pm M' M) e = evalE ρ M e := by\n  rw [congrE _ ρ _ e (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrME ρ _ M e (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\n-- A condition (a term) read across a step: primed, it is read after the step; plain, before it, whether in `then`'s\n-- reading or in `when`'s; given that what it reads is renamed or unchanged by the step, and unchanged by the request.\ntheorem view_C {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {c : C} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i c = true → X i = ρ i) (hn : ∀ mp, occMC mp c = true → N mp = M mp) :\n    evalC (primed pr ρ' X) (primedMaps pm M' N) (primeC pr pm c) = evalC ρ' M' c\n      ∧ evalC (primed pr ρ' X) (primedMaps pm M' N) c = evalC ρ M c ∧ evalC X N c = evalC ρ M c := by\n  have h3 : evalC X N c = evalC ρ M c := by rw [congrMC X N M c hn]; exact congrC X ρ M c hx\n  refine ⟨primeC_eval pr pm hpr hpm X ρ' N M' c hv hm, ?_, h3⟩\n  rw [unprimedC_eval (fun i hi => (hv i hi).1) (fun mp h => (hm mp h).1), h3]\n\ntheorem view_E {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {e : E} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i (.eq e e) = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp (.eq e e) = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i (.eq e e) = true → X i = ρ i) (hn : ∀ mp, occMC mp (.eq e e) = true → N mp = M mp) :\n    evalE (primed pr ρ' X) (primedMaps pm M' N) (primeE pr pm e) = evalE ρ' M' e\n      ∧ evalE (primed pr ρ' X) (primedMaps pm M' N) e = evalE ρ M e := by\n  have h3 : evalE X N e = evalE ρ M e := by\n    rw [congrME X N M e (fun mp h => hn mp (by simp [occMC, h]))]; exact congrE X ρ M e (fun i h => hx i (by simp [occC, h]))\n  refine ⟨primeE_eval pr pm hpr hpm X ρ' N M' e (fun i h => hv i (by simp [occC, h])) (fun mp h => hm mp (by simp [occMC, h])), ?_⟩\n  rw [unprimed_eval (fun i h => (hv i (by simp [occC, h])).1) (fun mp h => (hm mp (by simp [occMC, h])).1), h3]\n\n/-! The conditions Lean builds -/\n\ndef falseC : C := .lt (.const 0) (.const 0)\n-- The rank after (as') below the rank before (as), in order; the two equal; each region, if it held, held after; some\n-- region; the request's inputs as its terms.\ndef lexLtC : List E → List E → C\n  | a' :: as', a :: as => .or (.lt a' a) (.and (.eq a' a) (lexLtC as' as))\n  | _, _ => falseC\ndef eqsC : List E → List E → C\n  | a' :: as', a :: as => .and (.eq a' a) (eqsC as' as)\n  | _, _ => trueC\ndef keepC (pr pm : List (Nat × Nat)) : List C → C\n  | [] => trueC\n  | w :: ws => .and (.or (.not w) (primeC pr pm w)) (keepC pr pm ws)\ndef anyC : List C → C\n  | [] => falseC\n  | w :: ws => .or w (anyC ws)\ndef reqC : List (Nat × E) → C\n  | [] => trueC\n  | p :: ps => .and (.eq (.var p.1) p.2) (reqC ps)\n\ntheorem lexLtC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ as' as : List E,\n    evalC ρ M (lexLtC as' as) = lexB (as'.map (evalE ρ M)) (as.map (evalE ρ M))\n  | a' :: as', a :: as => by simp only [lexLtC, lexB, evalC, List.map_cons, lexLtC_eval ρ M as' as]\n  | [], _ => by simp [lexLtC, lexB, evalC, falseC]\n  | _ :: _, [] => by simp [lexLtC, lexB, evalC, falseC]\n\ntheorem eqsC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ as' as : List E, as'.length = as.length →\n    (evalC ρ M (eqsC as' as) = true ↔ as'.map (evalE ρ M) = as.map (evalE ρ M))\n  | a' :: as', a :: as, h => by\n    simp only [eqsC, evalC, Bool.and_eq_true, decide_eq_true_eq, List.map_cons, List.cons.injEq, eqsC_eval ρ M as' as (by simpa using h)]\n  | [], [], _ => by simp [eqsC, evalC, trueC]\n  | [], _ :: _, h => by simp at h\n  | _ :: _, [], h => by simp at h\n\ntheorem keepC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) (pr pm : List (Nat × Nat)) : ∀ ws : List C,\n    evalC ρ M (keepC pr pm ws) = true ↔ ∀ w ∈ ws, evalC ρ M w = true → evalC ρ M (primeC pr pm w) = true\n  | [] => by simp [keepC, evalC, trueC]\n  | w :: ws => by\n    rw [List.forall_mem_cons, ← keepC_eval ρ M pr pm ws]\n    simp only [keepC, evalC, Bool.and_eq_true, Bool.or_eq_true, Bool.not_eq_true']\n    cases evalC ρ M w <;> simp\n\ntheorem anyC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ ws : List C, evalC ρ M (anyC ws) = true ↔ ∃ w ∈ ws, evalC ρ M w = true\n  | [] => by simp [anyC, evalC, falseC]\n  | w :: ws => by simp only [anyC, evalC, Bool.or_eq_true, anyC_eval ρ M ws, List.mem_cons, exists_eq_or_imp]\n\ntheorem reqC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ ps : List (Nat × E), evalC ρ M (reqC ps) = true ↔ ∀ p ∈ ps, ρ p.1 = evalE ρ M p.2\n  | [] => by simp [reqC, evalC, trueC]\n  | p :: ps => by\n    rw [List.forall_mem_cons, ← reqC_eval ρ M ps]\n    simp only [reqC, evalC, evalE, Bool.and_eq_true]\n    exact ⟨fun h => ⟨of_decide_eq_true h.1, h.2⟩, fun h => ⟨decide_eq_true h.1, h.2⟩⟩\n\ntheorem zip_cover {α β : Type} : ∀ (as : List α) (bs : List β), as.length = bs.length → ∀ a ∈ as, ∃ b, (a, b) ∈ as.zip bs\n  | [], [], _, a, ha => by simp at ha\n  | a :: as, b :: bs, h, x, hx => by\n    rcases List.mem_cons.mp hx with rfl | hx\n    · exact ⟨b, by simp⟩\n    · obtain ⟨b', hb'⟩ := zip_cover as bs (by simpa using h) x hx\n      exact ⟨b', by simp [hb']⟩\n  | [], _ :: _, h, _, _ => by simp at h\n  | _ :: _, [], h, _, _ => by simp at h\n\n/-! Liveness -/\n\nstructure Live where\n  from_ : C\n  to : C\n  rank : List E                         -- compared in order\n  helps : List (C × List (Nat × E))     -- (the region where it helps, the request: an input and its term over the state and params)\n  prime : List (Nat × Nat)              -- a state variable, and its primed name\n  primeMaps : List (Nat × Nat)          -- a map, and its primed name\n\ndef Live.pend (l : Live) : C := .and l.from_ (.not l.to)\ndef liveStayC (l : Live) : C :=\n  .and (.or (primeC l.prime l.primeMaps l.from_) (primeC l.prime l.primeMaps l.to))\n    (.or (primeC l.prime l.primeMaps l.to) (.or (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n      (.and (eqsC (l.rank.map (primeE l.prime l.primeMaps)) l.rank) (keepC l.prime l.primeMaps (l.helps.map (·.1))))))\ndef liveCoverC (l : Live) : C := anyC (l.helps.map (·.1))\ndef liveHelpWhen (l : Live) (h : C × List (Nat × E)) : C := .and l.pend (.and h.1 (reqC h.2))\ndef liveHelpThen (l : Live) : C := .or (primeC l.prime l.primeMaps l.to) (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n-- What reads the state alone: `from`, `to`, each part of the rank and each region.\ndef liveConds (l : Live) : List C := [l.from_, l.to] ++ l.rank.map (fun e => .eq e e) ++ l.helps.map (·.1)\n\ntheorem mem_conds_rank {l : Live} {e : E} (he : e ∈ l.rank) : C.eq e e ∈ liveConds l := by\n  simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inl (Or.inr ⟨e, he, rfl⟩)\n\n/-- The argument, given how each step reads: `B`, `BM` the state and maps `when` reads (with the request), `A`, `AM`\nthose `then` reads (primed names after the step). -/\ntheorem leads_view (l : Live) (st : Nat → (Nat → Nat) × (Nat → Nat → Nat)) (B A : Nat → Nat → Nat) (BM AM : Nat → Nat → Nat → Nat)\n    (H En : C × List (Nat × E) → Nat → Prop)\n    (hC : ∀ n, ∀ c ∈ liveConds l, evalC (A n) (AM n) (primeC l.prime l.primeMaps c) = evalC (st (n + 1)).1 (st (n + 1)).2 c\n      ∧ evalC (A n) (AM n) c = evalC (st n).1 (st n).2 c ∧ evalC (B n) (BM n) c = evalC (st n).1 (st n).2 c)\n    (hE : ∀ n, ∀ e ∈ l.rank, evalE (A n) (AM n) (primeE l.prime l.primeMaps e) = evalE (st (n + 1)).1 (st (n + 1)).2 e\n      ∧ evalE (A n) (AM n) e = evalE (st n).1 (st n).2 e)\n    (hstay : ∀ n, evalC (B n) (BM n) l.pend = true → evalC (A n) (AM n) (liveStayC l) = true)\n    (hcover : ∀ n, evalC (B n) (BM n) l.pend = true → evalC (A n) (AM n) (liveCoverC l) = true)\n    (hhelp : ∀ h ∈ l.helps, ∀ n, evalC (B n) (BM n) (liveHelpWhen l h) = true → evalC (A n) (AM n) (liveHelpThen l) = true)\n    (hreq : ∀ h ∈ l.helps, ∀ n, H h n → evalC (B n) (BM n) (reqC h.2) = true)\n    (henabled : ∀ h ∈ l.helps, ∀ n, evalC (st n).1 (st n).2 l.from_ = true → evalC (st n).1 (st n).2 l.to = false →\n      evalC (st n).1 (st n).2 h.1 = true → En h n)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → En h m) → ∃ m, n ≤ m ∧ H h m) :\n    ∀ n, evalC (st n).1 (st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (st m).1 (st m).2 l.to = true := by\n  have memF : l.from_ ∈ liveConds l := by simp [liveConds]\n  have memT : l.to ∈ liveConds l := by simp [liveConds]\n  have memH : ∀ h ∈ l.helps, h.1 ∈ liveConds l := fun h hh => by\n    simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inr ⟨h, hh, rfl⟩\n  have h1 : ∀ n, (l.rank.map (primeE l.prime l.primeMaps)).map (evalE (A n) (AM n)) = l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2) := by\n    intro n; rw [List.map_map]; exact List.map_congr_left (fun e he => (hE n e he).1)\n  have h2 : ∀ n, l.rank.map (evalE (A n) (AM n)) = l.rank.map (evalE (st n).1 (st n).2) := fun n =>\n    List.map_congr_left (fun e he => (hE n e he).2)\n  have hlex : ∀ n, evalC (A n) (AM n) (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n      = lexB (l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2)) (l.rank.map (evalE (st n).1 (st n).2)) := by\n    intro n; rw [lexLtC_eval, h1, h2]\n  have heqs : ∀ n, evalC (A n) (AM n) (eqsC (l.rank.map (primeE l.prime l.primeMaps)) l.rank) = true\n      ↔ l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2) = l.rank.map (evalE (st n).1 (st n).2) := by\n    intro n; rw [eqsC_eval _ _ _ _ (by simp), h1, h2]\n  have hpend : ∀ n, evalC (st n).1 (st n).2 l.from_ = true → ¬ evalC (st n).1 (st n).2 l.to = true → evalC (B n) (BM n) l.pend = true := by\n    intro n hP hnQ\n    simp only [Live.pend, evalC, Bool.and_eq_true, Bool.not_eq_true']\n    rw [(hC n _ memF).2.2, (hC n _ memT).2.2]; exact ⟨hP, by simpa using hnQ⟩\n  refine leads_of_lex (fun n => evalC (st n).1 (st n).2 l.from_ = true) (fun n => evalC (st n).1 (st n).2 l.to = true)\n    (fun n => l.rank.map (evalE (st n).1 (st n).2)) l.rank.length (fun n => by simp) l.helps\n    (fun h n => evalC (st n).1 (st n).2 h.1 = true) H En ?_ ?_ ?_ (fun h hh n hP hnQ hW => henabled h hh n hP (by simpa using hnQ) hW) fair\n  · intro n hP hnQ\n    have h := hstay n (hpend n hP hnQ)\n    simp only [liveStayC, evalC, Bool.and_eq_true, Bool.or_eq_true] at h\n    rw [(hC n _ memF).1, (hC n _ memT).1, hlex n, heqs n, keepC_eval] at h\n    refine ⟨h.1, ?_⟩\n    rcases h.2 with h2 | h2 | ⟨h2, h3⟩\n    · exact Or.inl h2\n    · exact Or.inr (Or.inl h2)\n    · refine Or.inr (Or.inr ⟨h2, fun hp hhp hW => ?_⟩)\n      have := h3 hp.1 (List.mem_map_of_mem hhp) (by rw [(hC n _ (memH hp hhp)).2.1]; exact hW)\n      rwa [(hC n _ (memH hp hhp)).1] at this\n  · intro n hP hnQ\n    have h := hcover n (hpend n hP hnQ)\n    rw [liveCoverC, anyC_eval] at h\n    obtain ⟨w, hw, hW⟩ := h\n    obtain ⟨hp, hhp, rfl⟩ := List.mem_map.mp hw\n    exact ⟨hp, hhp, by rw [← (hC n _ (memH hp hhp)).2.1]; exact hW⟩\n  · intro hp hhp n hP hnQ hW hH\n    have hB : evalC (B n) (BM n) (liveHelpWhen l hp) = true := by\n      have := hpend n hP hnQ\n      simp only [liveHelpWhen, evalC, Bool.and_eq_true]\n      rw [(hC n _ (memH hp hhp)).2.2]\n      exact ⟨this, hW, hreq hp hhp n hH⟩\n    have h := hhelp hp hhp n hB\n    simp only [liveHelpThen, evalC, Bool.or_eq_true] at h\n    rwa [(hC n _ memT).1, hlex n] at h\n\ntheorem assoc_distinct : ∀ {σ : List (Nat × E)}, distinct (σ.map (·.1)) = true → ∀ {p}, p ∈ σ → assoc σ p.1 = some p.2\n  | [], _, _, hp => by simp at hp\n  | a :: as, hd, p, hp => by\n    simp only [List.map_cons, distinct, Bool.and_eq_true, Bool.not_eq_true'] at hd\n    simp only [assoc, lookup]\n    rcases List.mem_cons.mp hp with rfl | hp\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he\n        have h1 : (as.map (·.1)).contains a.1 = true := List.contains_iff_mem.mpr (by rw [he]; exact List.mem_map_of_mem hp)\n        rw [hd.1] at h1; cases h1\n      simp only [hne, Bool.false_eq_true, if_false]\n      have := assoc_distinct hd.2 hp\n      simpa [assoc] using this\n\n/-! Machines with sets -/\n\n-- As for maps and flags, with the request's extended variables (inputs, quantified flags, witnesses) and the maps it\n-- carries read by no part of the liveness, and maps written at every key unprimed counted as written.\ndef sliveVars (s : SMachine) (l : Live) : List Nat :=\n  l.prime.map (·.2) ++ s.extVars ++ (flagVars s.f.flags ++ s.f.m.step.map (·.1)).filter (fun i => !(l.prime.map (·.1)).contains i)\ndef sliveMaps (s : SMachine) (l : Live) : List Nat :=\n  l.primeMaps.map (·.2) ++ s.carried ++ (s.f.m.writes.map (·.1) ++ s.every.map (·.1)).filter (fun mp => !(l.primeMaps.map (·.1)).contains mp)\ndef sliveOk (s : SMachine) (l : Live) : Bool :=\n  distinct (l.prime.map (·.2)) && distinct (l.primeMaps.map (·.2))\n    && (liveConds l).all (fun c => avoids (sliveVars s l) c && avoidsMaps (sliveMaps s l) c)\n    && l.helps.all (fun h => h.2.all (fun p => s.f.m.inputs.contains p.1 && avoids s.extVars (.eq p.2 p.2) && avoidsMaps s.carried (.eq p.2 p.2)))\n\n-- A step law over sets's proof: (law instances, quantified flag instances, fact instances, several-key instances, tree).\n-- A proof's instances (laws, quantified flags, facts, laws about several keys, facts about several keys) and its certificate.\nabbrev SProof := List (Nat × E) × List (Nat × List E) × List (Nat × E) × List (Nat × E × List E) × List (Nat × E × List E) × Cert\ndef sliveStep (l : Live) (w t : C) (p : SProof) : SKStep :=\n  ⟨⟨[w], t, [[]], l.prime, l.primeMaps, p.1, (p.2.2.2.2.2.1, p.2.2.2.2.2.2.2)⟩, [[]], p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2.1, p.2.2.2.2.2.2.1, []⟩\ndef sliveHelpsOk (s : SMachine) (ps : List SEntry) (l : Live) (hp : List SProof) : Bool :=\n  l.helps.length == hp.length && (l.helps.zip hp).all (fun x => checkSKStep s ps (sliveStep l (liveHelpWhen l x.1) (liveHelpThen l) x.2))\n\n-- A run of a machine with sets: each step a request (inputs, the maps it carries) the machine allows.\nstructure SRun (s : SMachine) where\n  st : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  req : Nat → SRequest\n  start : SReach s (st 0).1 (st 0).2\n  allowed : ∀ n, evalC (sView s (st n).1 (st n).2 (req n).1 (req n).2).1 (sView s (st n).1 (st n).2 (req n).1 (req n).2).2 s.f.m.assume = true\n  next : ∀ n, st (n + 1) = sNext s (st n).1 (st n).2 (req n).1 (req n).2\n\ntheorem srun_reach {s : SMachine} (run : SRun s) : ∀ n, SReach s (run.st n).1 (run.st n).2\n  | 0 => run.start\n  | n + 1 => by rw [run.next n]; exact SReach.step _ _ _ _ (srun_reach run n) (run.allowed n)\n\n-- A step law over sets of one step: every request allowed that `when` admits takes a step where `then` holds.\ntheorem skstep_one {s : SMachine} {ps : List SEntry} {l : Live} {w t : C} {p : SProof} (hl : checkSMachine s ps = true)\n    (hc : checkSKStep s ps (sliveStep l w t p) = true) : ∀ ρ M, SReach s ρ M → ∀ ι κ,\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true →\n      evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true →\n      evalC (primed l.prime (sNext s ρ M ι κ).1 (withExt s ρ (sReq s ρ M ι κ)))\n        (primedMaps l.primeMaps (sNext s ρ M ι κ).2 (withCarried s M κ)) t = true := by\n  intro ρ M hr ι κ hA hW\n  have h := skstep_sound s ps _ hl hc ρ M hr (ι, κ) [] rfl ⟨hA, hW, trivial⟩\n  simpa [sliveStep, sEnd, sExts, renEnv, renMaps, lookup] using h\n\n-- A step law over sets of one step, read as one step: every request allowed that `when` admits takes a step where `then`\n-- holds, its fresh names read as the step reads them.\ntheorem skstep_holds_one {s : SMachine} {sl : SKStep} {w : C} (h : SKStepHolds s sl) (hw : sl.k.whens = [w]) (hren : sl.k.ren = [[]])\n    (hmren : sl.mren = [[]]) : ∀ ρ M, SReach s ρ M → ∀ ι κ,\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true →\n      evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true →\n      evalC (primed sl.k.prime (sNext s ρ M ι κ).1 (withExt s ρ (sReq s ρ M ι κ)))\n        (primedMaps sl.k.primeMaps (sNext s ρ M ι κ).2 (withCarried s M κ)) sl.k.then_ = true := by\n  intro ρ M hr ι κ hA hW\n  have := h ρ M hr (ι, κ) [] (by simp [hw]) (by rw [hw]; exact ⟨hA, hW, trivial⟩)\n  rw [hren, hmren] at this\n  simpa [sEnd, sExts, renEnv, renMaps, lookup] using this\n\ntheorem decideQ_other {s : SMachine} {i : Nat} (h : i ∉ s.qVars) (X : Nat → Nat) (N : Nat → Nat → Nat) : decideQ s X N i = X i := by\n  simp only [decideQ]\n  rw [lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hq))]\n\ntheorem slive_reads {s : SMachine} {l : Live} (hok : sliveOk s l = true) {c : C} (hc : c ∈ liveConds l)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (∀ i, occC i c = true → i ∉ l.prime.map (·.2) ∧ (i ∈ l.prime.map (·.1) ∨ (sNext s ρ M ι κ).1 i = withExt s ρ (sReq s ρ M ι κ) i))\n      ∧ (∀ mp, occMC mp c = true → mp ∉ l.primeMaps.map (·.2) ∧ (mp ∈ l.primeMaps.map (·.1) ∨ (sNext s ρ M ι κ).2 mp = withCarried s M κ mp))\n      ∧ (∀ i, occC i c = true → withExt s ρ (sReq s ρ M ι κ) i = ρ i)\n      ∧ (∀ mp, occMC mp c = true → withCarried s M κ mp = M mp) := by\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok\n  have hv := hok.1.2 c hc\n  have noExt : ∀ i, occC i c = true → i ∉ s.extVars := fun i hi hm => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hext : ∀ i, occC i c = true → withExt s ρ (sReq s ρ M ι κ) i = ρ i := fun i hi => by\n    simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using noExt i hi)]\n  have noCar : ∀ mp, occMC mp c = true → mp ∉ s.carried := fun mp hmp hm => avoidsMaps_occ hv.2 hmp (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hcar : ∀ mp, occMC mp c = true → withCarried s M κ mp = M mp := fun mp hmp => by\n    simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using noCar mp hmp)]\n  refine ⟨fun i hi => ⟨fun h => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_left _ h)), ?_⟩,\n    fun mp hmp => ⟨fun h => avoidsMaps_occ hv.2 hmp (List.mem_append_left _ (List.mem_append_left _ h)), ?_⟩, hext, hcar⟩\n  · by_cases hp : i ∈ l.prime.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hn : i ∉ flagVars s.f.flags ++ s.f.m.step.map (·.1) := fun hm =>\n        avoids_occ hv.1 hi (List.mem_append_right _ (List.mem_filter.mpr ⟨hm, by simpa [List.contains_iff_mem] using hp⟩))\n      have hx := noExt i hi\n      simp only [SMachine.extVars, SMachine.qVars, List.mem_append, not_or] at hx\n      rw [hext i hi]\n      simp only [sNext, sView]\n      rw [applyS_other (fun h => hn (List.mem_append_right _ h)), decide_other (fun h => hn (List.mem_append_left _ h)),\n        decideQ_other (by simpa [SMachine.qVars] using hx.1.2), withInputs_other hx.1.1]\n  · by_cases hp : mp ∈ l.primeMaps.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hw : mp ∉ s.f.m.writes.map (·.1) ++ s.every.map (·.1) := fun hm =>\n        avoidsMaps_occ hv.2 hmp (List.mem_append_right _ (List.mem_filter.mpr ⟨hm, by simpa [List.contains_iff_mem] using hp⟩))\n      funext k\n      simp only [sNext, everyMaps]\n      rw [lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro he; exact hw (List.mem_append_right _ (by rw [← he]; exact List.mem_map_of_mem hw')))]\n      simp only [writeMaps]\n      rw [lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro he; exact hw (List.mem_append_left _ (by rw [← he]; exact List.mem_map_of_mem hw')))]\n      rfl\n\n/-- Liveness under fairness: if the laws' proof checks, the liveness reads what it may (`sliveOk`), and the step laws Lean\nbuilds from it check, then along every run that takes each helpful request (its named inputs as its terms; the rest,\nand the maps it carries, free) infinitely often, each state where `from` holds is followed by one where `to` holds. -/\ntheorem sleads_sound (s : SMachine) (ps : List SEntry) (l : Live) (sp cp : SProof) (hp : List SProof)\n    (hl : checkSMachine s ps = true) (hok : sliveOk s l = true)\n    (hs : checkSKStep s ps (sliveStep l l.pend (liveStayC l) sp) = true) (hc : checkSKStep s ps (sliveStep l l.pend (liveCoverC l) cp) = true)\n    (hh : sliveHelpsOk s ps l hp = true) (run : SRun s)\n    (fair : ∀ h ∈ l.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :\n    ∀ n, evalC (run.st n).1 (run.st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 l.to = true := by\n  have hok0 := hok\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨⟨⟨hd1, hd2⟩, _⟩, hreqs⟩ := hok0\n  simp only [sliveHelpsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hh\n  obtain ⟨hlen, hall⟩ := hh\n  refine leads_view l run.st (fun n => withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2))\n    (fun n => primed l.prime (run.st (n + 1)).1 (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)))\n    (fun n => withCarried s (run.st n).2 (run.req n).2) (fun n => primedMaps l.primeMaps (run.st (n + 1)).2 (withCarried s (run.st n).2 (run.req n).2))\n    (fun h n => ∀ p ∈ h.2, (run.req n).1 p.1 = evalE (run.st n).1 (run.st n).2 p.2) (fun _ _ => True) ?_ ?_ ?_ ?_ ?_ ?_\n    (fun _ _ _ _ _ _ => trivial) (fun h hh n _ => fair h hh n)\n  · intro n c hc\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok hc (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_C hd1 hd2 hv hm hx hn\n  · intro n e he\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok (mem_conds_rank he) (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_E hd1 hd2 hv hm hx hn\n  · intro n hB\n    have := skstep_one hl hs _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_one hl hc _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    obtain ⟨pp, hpp⟩ := zip_cover l.helps hp hlen h hmem\n    have := skstep_one hl (hall _ hpp) _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hH\n    show evalC (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) (reqC h.2) = true\n    rw [reqC_eval]\n    intro p hp'\n    have hq := hreqs h hmem p hp'\n    obtain ⟨⟨hin, hav⟩, havm⟩ := hq\n    have hext : s.extVars.contains p.1 = true := by\n      simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inl (Or.inl (List.contains_iff_mem.mp hin))\n    have hl1 : withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2) p.1 = (run.req n).1 p.1 := by\n      simp only [withExt, hext, if_true, sReq, hin]\n    have hr1 : evalE (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) p.2\n        = evalE (run.st n).1 (run.st n).2 p.2 := by\n      rw [congrME _ _ (run.st n).2 p.2 (fun mp hmp => by\n        simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using avoidsMaps_occ havm (by simp [occMC, hmp]))])]\n      exact congrE _ _ _ p.2 (fun i hi => by\n        simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using avoids_occ hav (by simp [occC, hi]))])\n    rw [hl1, hr1]; exact hH p hp'\n\n/-! Weak fairness over sets -/\n\n-- A request whose inputs named in a list are the list's terms meets the list's condition, in the goal's view.\ntheorem sreq_list {s : SMachine} {ps' : List (Nat × E)}\n    (hc : ∀ p ∈ ps', (s.f.m.inputs.contains p.1 = true ∧ avoids s.extVars (.eq p.2 p.2) = true) ∧ avoidsMaps s.carried (.eq p.2 p.2) = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι : Nat → Nat} {κ : Nat → Nat → Nat} (hH : ∀ p ∈ ps', ι p.1 = evalE ρ M p.2) :\n    evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) (reqC ps') = true := by\n  rw [reqC_eval]\n  intro p hp'\n  obtain ⟨⟨hin, hav⟩, havm⟩ := hc p hp'\n  have hext : s.extVars.contains p.1 = true := by\n    simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inl (Or.inl (List.contains_iff_mem.mp hin))\n  have hl1 : withExt s ρ (sReq s ρ M ι κ) p.1 = ι p.1 := by simp only [withExt, hext, if_true, sReq, hin]\n  have hr1 : evalE (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) p.2 = evalE ρ M p.2 := by\n    rw [congrME _ _ M p.2 (fun mp hmp => by\n      simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using avoidsMaps_occ havm (by simp [occMC, hmp]))])]\n    exact congrE _ _ _ p.2 (fun i hi => by\n      simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using avoids_occ hav (by simp [occC, hi]))])\n  rw [hl1, hr1]; exact hH p hp'\n\ntheorem sreq_holds {s : SMachine} {l : Live} (hok : sliveOk s l = true) {h : C × List (Nat × E)} (hmem : h ∈ l.helps)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι : Nat → Nat} {κ : Nat → Nat → Nat} (hH : ∀ p ∈ h.2, ι p.1 = evalE ρ M p.2) :\n    evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) (reqC h.2) = true := by\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok\n  exact sreq_list (fun p hp' => hok.2 h hmem p hp') hH\n\n-- A helpful request allowed in its region, carrying empty sets: the precondition, the facts, the laws, `when`, each\n-- quantified flag closed, and the carried maps empty at the keys the proof names refute the assumption's failing. The\n-- facts read no request's variable or map.\ndef zeroHyps (s : SMachine) (zkeys : List E) : List C := s.carried.flatMap fun mp => zkeys.map fun t => .eq (.get mp t) (.const 0)\ndef sAllowGoal (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E) : List C :=\n  [s.f.m.pre] ++ factHyps s p.2.2.1 p.2.2.2.2.1 ++ (scalarHyps (sLaws ps p.2.2.2.1) ++ instHyps (sLaws ps p.2.2.2.1) (sInsts ps p.1 p.2.2.2.1))\n    ++ [w] ++ closingHyps s p.2.1 ++ zeroHyps s zkeys ++ [.not (inlineC s.f.flags s.f.m.assume)]\ndef checkSAllow (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E) : Bool :=\n  s.facts.all (fun l => avoids s.extVars l.holds && avoidsMaps s.carried l.holds)\n    && checkIn (sAllowGoal s ps w p zkeys) p.2.2.2.2.2\n\n-- The request carrying empty sets.\ndef noSets : Nat → Nat → Nat := fun _ _ => 0\n\ntheorem sallow_sound (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E)\n    (hl : checkSMachine s ps = true) (hc : checkSAllow s ps w p zkeys = true) :\n    ∀ ρ M, SReach s ρ M → ∀ ι, evalC (withExt s ρ (sReq s ρ M ι noSets)) (withCarried s M noSets) w = true →\n      evalC (sView s ρ M ι noSets).1 (sView s ρ M ι noSets).2 s.f.m.assume = true := by\n  intro ρ M hr ι hw\n  simp only [checkSAllow, Bool.and_eq_true, List.all_eq_true] at hc\n  obtain ⟨hfa, hgoal⟩ := hc\n  have hs := sOk_of hl\n  obtain ⟨hpreS, hrp⟩ := spre_parts hl\n  let W := withExt s ρ (sReq s ρ M ι noSets)\n  let M0 := withCarried s M noSets\n  have hWo : ∀ v, v ∉ s.extVars → W v = ρ v := fun v hv => by\n    simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hv)]\n  have hMo : ∀ mp, mp ∉ s.carried → M0 mp = M mp := fun mp hmp => by\n    simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]\n  -- Every entry, and each pair's, holds in the goal's view of the state.\n  have hall : ∀ e ∈ ps, e.Holds W M0 := fun e he =>\n    sentry_transfer (slaws_avoid hl e.law (List.mem_map_of_mem he)).1 (slaws_avoid hl e.law (List.mem_map_of_mem he)).2\n      (fun i hi => by simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hi)])\n      (fun mp hmp => by simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)])\n      (smachine_sound s ps hl ρ M hr e he)\n  have hlY : ∀ l ∈ sLaws ps p.2.2.2.1, l.Holds W M0 := fun l hl' => by\n    rcases List.mem_append.mp hl' with hl' | hl'\n    · obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl'; exact SEntry.holds_law (hall e' he')\n    · exact pairLaws_hold ps p.2.2.2.1 (skeys_apart hl) hall l hl'\n  have hfacts : ∀ l ∈ s.facts, l.Holds W M0 := fun l hl' => by\n    have h := hfa l hl'\n    exact holds_transfer l h.1 h.2 (fun i hi => hWo i hi) (fun mp hmp => hMo mp hmp) (facts_sreach s (sfacts_ok hl) hr l hl')\n  apply Decidable.byContradiction; intro hn\n  apply sound_in _ _ hgoal W M0\n  intro c hc\n  simp only [sAllowGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with (((((rfl | hc) | hc) | rfl) | hc) | hc) | rfl\n  · rw [noReadsC W M0 M s.f.m.pre hrp, congrC W ρ M s.f.m.pre (fun j hj => hWo j (fun h' =>\n      avoids_occ hpreS hj (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h')))))]\n    exact pre_sreach s hpreS hrp hr\n  · -- The facts about several keys, as the reachable state has them: they read no request and no carried map.\n    have hpf : s.PFacts W M0 := fun f hf' =>\n      holdsOver_transfer f.1 (pfactsOk_parts (sfacts_ok hl) f hf').1 (pfactsOk_parts (sfacts_ok hl) f hf').2.1 f.2\n        (fun i hi => hWo i (fun h' => hi (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h')))))\n        (fun mp hmp => hMo mp (fun h' => hmp (List.mem_append_left _ (List.mem_append_left _ h'))))\n        (pfacts_sreach s (sfacts_ok hl) hr f hf')\n    exact facthyps_true s p.2.2.1 p.2.2.2.2.1 W M0 (fun f hf' => (pfactsOk_parts (sfacts_ok hl) f hf').2.2) hfacts hpf c hc\n  · exact laws_hyps_true _ _ W M0 hlY c (List.mem_append.mpr hc)\n  · exact hw\n  · exact closing_true s ρ M ι noSets hs p.2.1 c hc\n  · simp only [zeroHyps, List.mem_flatMap, List.mem_map] at hc\n    obtain ⟨mp, hmp, t, _, rfl⟩ := hc\n    simp only [evalC, evalE, M0, withCarried, List.contains_iff_mem.mpr hmp, if_true, noSets, decide_eq_true_eq]\n  · -- The assumption, inlined: the view decides the plain flags as the step does, away from the witnesses.\n    simp only [evalC, Bool.not_eq_true']\n    rw [inline_evalC]\n    have hagD := decide_agree_on (sOk_parts s hs).2.2.2.2.2.2 (withCarried s M noSets) (view_agree s ρ M ι noSets hs)\n    rw [congrC _ (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M noSets)) (withCarried s M noSets)) _ s.f.m.assume\n      (fun i hi => (hagD i (fun h => by\n        have hpa : avoids s.wVars s.f.m.assume = true := by simp only [sOk, Bool.and_eq_true] at hs; exact hs.2\n        exact avoids_occ hpa hi h)).symm)]\n    have hf : evalC (sView s ρ M ι noSets).1 (sView s ρ M ι noSets).2 s.f.m.assume = false := by simpa using hn\n    exact hf\n\ndef sliveAllowsOk (s : SMachine) (ps : List SEntry) (l : Live) (ap : List (List (Nat × E) × SProof × List E)) : Bool :=\n  l.helps.length == ap.length\n    && (l.helps.zip ap).all (fun x => distinct ((x.1.2 ++ x.2.1).map (·.1))\n      && x.2.1.all (fun p => s.f.m.inputs.contains p.1 && avoids s.extVars (.eq p.2 p.2) && avoidsMaps s.carried (.eq p.2 p.2))\n      && checkSAllow s ps (.and (liveHelpWhen l x.1) (reqC x.2.1)) x.2.2.1 x.2.2.2)\n\n/-- Liveness under weak fairness, for machines with sets: as `sleads_sound`, with each helpful request also proven\nallowed in its region carrying empty sets (`sliveAllowsOk`); then along every run that takes each helpful request\nwhenever, from some point on, it stays allowed (some request with its named inputs as its terms, carrying some sets, is a\nstep the machine allows), each state where `from` holds is followed by one where `to` holds. -/\ntheorem sleads_wf_sound (s : SMachine) (ps : List SEntry) (l : Live) (sp cp : SProof) (hp : List SProof) (ap : List (List (Nat × E) × SProof × List E))\n    (hl : checkSMachine s ps = true) (hok : sliveOk s l = true)\n    (hs : checkSKStep s ps (sliveStep l l.pend (liveStayC l) sp) = true) (hc : checkSKStep s ps (sliveStep l l.pend (liveCoverC l) cp) = true)\n    (hh : sliveHelpsOk s ps l hp = true) (ha : sliveAllowsOk s ps l ap = true) (run : SRun s)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (sView s (run.st m).1 (run.st m).2 ι κ).1 (sView s (run.st m).1 (run.st m).2 ι κ).2 s.f.m.assume = true) →\n      ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :\n    ∀ n, evalC (run.st n).1 (run.st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 l.to = true := by\n  have hok0 := hok\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨⟨⟨hd1, hd2⟩, _⟩, hreqs⟩ := hok0\n  simp only [sliveHelpsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hh\n  obtain ⟨hlen, hall⟩ := hh\n  simp only [sliveAllowsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at ha\n  obtain ⟨halen, haall⟩ := ha\n  refine leads_view l run.st (fun n => withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2))\n    (fun n => primed l.prime (run.st (n + 1)).1 (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)))\n    (fun n => withCarried s (run.st n).2 (run.req n).2) (fun n => primedMaps l.primeMaps (run.st (n + 1)).2 (withCarried s (run.st n).2 (run.req n).2))\n    (fun h n => ∀ p ∈ h.2, (run.req n).1 p.1 = evalE (run.st n).1 (run.st n).2 p.2)\n    (fun h m => ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (sView s (run.st m).1 (run.st m).2 ι κ).1 (sView s (run.st m).1 (run.st m).2 ι κ).2 s.f.m.assume = true) ?_ ?_ ?_ ?_ ?_ ?_ ?_ fair\n  · intro n c hc\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok hc (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_C hd1 hd2 hv hm hx hn\n  · intro n e he\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok (mem_conds_rank he) (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_E hd1 hd2 hv hm hx hn\n  · intro n hB\n    have := skstep_one hl hs _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_one hl hc _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    obtain ⟨pp, hpp⟩ := zip_cover l.helps hp hlen h hmem\n    have := skstep_one hl (hall _ hpp) _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hH\n    show evalC (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) (reqC h.2) = true\n    exact sreq_holds hok hmem (fun p hp' => hH p hp')\n  · -- Enabled in its region: the request with its named inputs as its terms, the rest as the state has them, carrying\n    -- empty sets.\n    intro h hmem n hP hnQ hW\n    obtain ⟨x, hx⟩ := zip_cover l.helps ap halen h hmem\n    obtain ⟨⟨hdist, hwit⟩, hpc⟩ := haall _ hx\n    let ρ := (run.st n).1\n    let M := (run.st n).2\n    let ι := applyS (h.2 ++ x.1) ρ M\n    have hιp : ∀ p ∈ h.2, ι p.1 = evalE ρ M p.2 := fun p hp' => by\n      simp only [ι, applyS, assoc_distinct hdist (List.mem_append_left _ hp')]\n    have hιw : ∀ p ∈ x.1, ι p.1 = evalE ρ M p.2 := fun p hp' => by\n      simp only [ι, applyS, assoc_distinct hdist (List.mem_append_right _ hp')]\n    have hX : ∀ c ∈ liveConds l, evalC (withExt s ρ (sReq s ρ M ι noSets)) (withCarried s M noSets) c = evalC ρ M c := fun c hc' => by\n      obtain ⟨_, _, hx', hn'⟩ := slive_reads hok hc' ρ M ι noSets\n      rw [congrMC _ _ M c hn']; exact congrC _ _ M c hx'\n    have memF : l.from_ ∈ liveConds l := by simp [liveConds]\n    have memT : l.to ∈ liveConds l := by simp [liveConds]\n    have memH : h.1 ∈ liveConds l := by simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inr ⟨h, hmem, rfl⟩\n    refine ⟨ι, noSets, hιp, sallow_sound s ps _ x.2.1 x.2.2 hl hpc ρ M (srun_reach run n) ι ?_⟩\n    simp only [liveHelpWhen, Live.pend, evalC, Bool.and_eq_true, Bool.not_eq_true']\n    rw [hX _ memF, hX _ memT, hX _ memH]\n    exact ⟨⟨⟨hP, hnQ⟩, hW, sreq_holds hok hmem hιp⟩, sreq_list (fun p hp' => hwit p hp') hιw⟩\n\n/-! Loops, as machines -/\n\n-- A loop as a machine with sets (none of them): the loop's state, inputs, precondition and assumption, its body taken\n-- where the guard holds and the state kept where it doesn't. That it halts is a liveness claim: every request helps,\n-- `to` is the guard failing, and the loop's ranks drop.\ndef Loop.machine (l : Loop) : SMachine :=\n  ⟨⟨⟨l.inputs, l.init, [], l.body.map (fun p => (p.1, E.ite l.guard p.2 (.var p.1))), [], l.pre, l.assume⟩, []⟩, [], [], [], [], [], []⟩\n\ntheorem assoc_guarded (g : C) (i : Nat) : ∀ body : List (Nat × E),\n    assoc (body.map fun p => (p.1, E.ite g p.2 (.var p.1))) i = (assoc body i).map fun e => E.ite g e (.var i)\n  | [] => rfl\n  | p :: ps => by\n    simp only [List.map_cons, assoc, lookup] at ⊢\n    by_cases h : (p.1 == i) = true\n    · have hp : p.1 = i := beq_iff_eq.mp h\n      simp only [h, ite_true, Option.map_some]; rw [hp]\n    · simp only [h, Bool.false_eq_true, ite_false]\n      have := assoc_guarded g i ps\n      simp only [assoc] at this; exact this\n\n-- The loop's machine reads a request as the loop does: its inputs set, nothing decided, no map carried.\ntheorem sView_loop (l : Loop) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sView l.machine ρ M ι κ = (withInputs l.inputs ρ ι, M) := by\n  have hc : withCarried l.machine M κ = M := by funext mp; simp [withCarried, Loop.machine]\n  have hq : decideQ l.machine (withInputs l.inputs ρ ι) M = withInputs l.inputs ρ ι := by funext v; simp [decideQ, Loop.machine, lookup]\n  simp only [sView, hc]\n  show (decideFlags [] (decideQ l.machine (withInputs l.inputs ρ ι) M) M, M) = _\n  rw [hq]; simp [decideFlags, flagSub, applyS_nil']\n\n-- Where the guard holds, a step of the loop's machine is a turn of the loop, and leaves the maps.\ntheorem sNext_loop (l : Loop) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n    (hg : evalC (withInputs l.inputs ρ ι) M l.guard = true) :\n    sNext l.machine ρ M ι κ = (applyS l.body (withInputs l.inputs ρ ι) M, M) := by\n  simp only [sNext, sView_loop]\n  refine Prod.ext ?_ ?_\n  · funext i\n    show applyS (l.body.map fun p => (p.1, E.ite l.guard p.2 (.var p.1))) (withInputs l.inputs ρ ι) M i = _\n    simp only [applyS, assoc_guarded]\n    cases assoc l.body i with\n    | none => rfl\n    | some e => simp [evalE, hg]\n  · funext mp key; simp [everyMaps, Loop.machine, lookup, writeMaps]\n\n/-- A loop halts: if the loop's machine reaches the guard failing from anywhere, along every run whose helpful requests\n(here naming no input, so every run's) recur, then for params meeting the precondition no run of turns is infinite. -/\ntheorem loop_halts_of (l : Loop) (lv : Live) (hfrom : lv.from_ = trueC) (hto : lv.to = .not l.guard) (hhelps : ∀ h ∈ lv.helps, h.2 = [])\n    (hguard : avoids l.inputs l.guard = true)\n    (hlive : ∀ run : SRun l.machine, (∀ h ∈ lv.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) →\n      ∀ n, evalC (run.st n).1 (run.st n).2 lv.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 lv.to = true)\n    (maps : Nat → Nat → Nat) (ρ0 : Nat → Nat) (h0 : evalC ρ0 maps l.pre = true) :\n    ¬ ∃ f : Nat → Nat → Nat, f 0 = applyS l.init ρ0 maps ∧ ∀ n, Turn l maps (f n) (f (n + 1)) := by\n  rintro ⟨f, hf0, hf⟩\n  let ι := fun n => Classical.choose (hf n)\n  have hg : ∀ n, evalC (withInputs l.inputs (f n) (ι n)) maps l.guard = true := fun n => (Classical.choose_spec (hf n)).1\n  have ha : ∀ n, evalC (withInputs l.inputs (f n) (ι n)) maps l.assume = true := fun n => (Classical.choose_spec (hf n)).2.1\n  have hnext : ∀ n, f (n + 1) = applyS l.body (withInputs l.inputs (f n) (ι n)) maps := fun n => (Classical.choose_spec (hf n)).2.2\n  let run : SRun l.machine := {\n    st := fun n => (f n, maps)\n    req := fun n => (ι n, fun _ _ => 0)\n    start := by\n      show SReach l.machine (f 0) maps\n      rw [hf0]\n      exact SReach.start (s := l.machine) ρ0 maps (fun p hp => by simp [Loop.machine] at hp) h0 (fun l' hl' => by simp [Loop.machine] at hl') (fun p hp => by simp [Loop.machine] at hp)\n    allowed := fun n => by\n      show evalC (sView l.machine (f n) maps (ι n) _).1 (sView l.machine (f n) maps (ι n) _).2 l.assume = true\n      rw [sView_loop]; exact ha n\n    next := fun n => by\n      show (f (n + 1), maps) = sNext l.machine (f n) maps (ι n) _\n      rw [sNext_loop l _ _ _ _ (hg n), hnext n] }\n  obtain ⟨m, _, hm⟩ := hlive run (fun h hh n => ⟨n, Nat.le_refl n, by simp [hhelps h hh]⟩) 0 (by rw [hfrom]; simp [trueC, evalC, evalE])\n  rw [hto] at hm\n  have hgm := hg m\n  rw [congrC (withInputs l.inputs (f m) (ι m)) (f m) maps l.guard (fun i hi => withInputs_other (avoids_occ hguard hi) _ _)] at hgm\n  simp only [evalC, Bool.not_eq_true'] at hm\n  show False\n  have : evalC (run.st m).1 (run.st m).2 l.guard = true := hgm\n  rw [this] at hm; exact Bool.noConfusion hm\n\nend Kern\n\n#print axioms Kern.sleads_sound\n#print axioms Kern.sleads_wf_sound\n#print axioms Kern.loop_halts_of\n",
     "Ghost.lean": "import Live\n\n/-!\nWhat a ghost means, proven: compose.ts's `ghost(m, vars)` adds state that watches a machine without changing it. Lean\nchecks that a ghosted machine is the original's parts plus each ghost's start and step, read by no part of the original\n(`sghostOk`), and proves, for machines with maps, flags and sets:\n- `sghost_reach`: every reachable state of the original is, outside the ghosts, a reachable state of the ghosted\n  machine, so a law of the ghosted machine that reads no ghost is a law of the original (`sghost_laws`);\n- `sghost_run`: every run of the original is, outside the ghosts, a run of the ghosted machine taking the same requests;\n- `sever_meaning`: along a run, a ghost that starts at 0 and is set to 1 by a step where `c` holds (compose.ts's `ever`)\n  is 1 exactly when some step before took a request where `c` held.\n-/\n\nnamespace Kern\nopen Classical\n\ntheorem lookup_unique_fst {p : Nat × E} {l : List (Nat × E)} (hd : distinct (l.map (·.1)) = true) (hp : p ∈ l) :\n    lookup (fun q => q.1 == p.1) l = some p := by\n  induction l with\n  | nil => simp at hp\n  | cons a as ih =>\n    simp only [List.map_cons] at hd\n    obtain ⟨hna, hd'⟩ := distinct_cons hd\n    simp only [lookup]\n    rcases List.mem_cons.mp hp with rfl | hp'\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hna (by rw [he]; exact List.mem_map_of_mem hp')\n      simp only [hne, Bool.false_eq_true, ite_false]; exact ih hd' hp'\n\ntheorem assoc_append_none {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ τ.map (·.1)) : assoc (σ ++ τ) i = assoc σ i := by\n  have hτ : lookup (fun p => p.1 == i) τ = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [assoc, lookup_append]\n  cases hσ : lookup (fun p => p.1 == i) σ <;> simp [hτ]\n\ntheorem applyS_append_other {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ τ.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS (σ ++ τ) ρ M i = applyS σ ρ M i := by\n  simp only [applyS, assoc_append_none h]\n\n-- The keys a machine's every-key writes and quantified flags bind.\ndef bkeys (s : SMachine) : List Nat := s.every.map (·.2.1) ++ s.qflags.flatMap (·.2.1)\n\n-- A flag that holds at every value of its keys, decided over states that agree where its body reads (its keys aside), is\n-- decided alike.\ntheorem ite_all_congr {X X' : Nat → Nat} {N N' : Nat → Nat → Nat} {ks : List Nat} {c : C}\n    (hv : ∀ i, occC i c = true → i ∉ ks → X i = X' i) (hm : ∀ mp, occMC mp c = true → N mp = N' mp) :\n    (if ∀ k, holdsC (atKeys X ks k) N c then 1 else 0) = (if ∀ k, holdsC (atKeys X' ks k) N' c then 1 else 0) := by\n  have h : (∀ k, holdsC (atKeys X ks k) N c) ↔ (∀ k, holdsC (atKeys X' ks k) N' c) := by\n    apply forall_congr'; intro k\n    rw [← evalC_iff, ← evalC_iff, congrMC _ N N' c hm]\n    rw [congrC (atKeys X ks k) (atKeys X' ks k) N' c (fun i hi => by\n      by_cases hik : i ∈ ks\n      · rw [atKeys_in hik, atKeys_in hik]\n      · rw [atKeys_out hik, atKeys_out hik]; exact hv i hi hik)]\n  simp only [h]\n\ntheorem decideQ_of (s : SMachine) (X : Nat → Nat) (N : Nat → Nat → Nat) (v : Nat) :\n    decideQ s X N v = match lookup (fun q => q.1 == v) s.qflags with\n      | some q => if ∀ k, holdsC (atKeys X q.2.1 k) N q.2.2 then 1 else 0\n      | none => X v := rfl\n\ntheorem upd_agree {V : List Nat} {X X' : Nat → Nat} (h : Agree V X X') (k v : Nat) : Agree V (upd X k v) (upd X' k v) := fun i hi => by\n  simp only [upd]; split\n  · rfl\n  · exact h i hi\n\n/-! Ghosts -/\n\nstructure SGhosted where\n  orig : SMachine\n  ghosts : List (Nat × E × E)   -- (variable, start over the params, step over the state before, the request and flags)\n\ndef SGhosted.vars (g : SGhosted) : List Nat := g.ghosts.map (·.1)\n\n-- The ghosted machine: the original, each ghost's start and step added.\ndef SGhosted.full (g : SGhosted) : SMachine :=\n  ⟨⟨⟨g.orig.f.m.inputs, g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1)), g.orig.f.m.maps0,\n      g.orig.f.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2)), g.orig.f.m.writes, g.orig.f.m.pre, g.orig.f.m.assume⟩, g.orig.f.flags⟩,\n    g.orig.carried, g.orig.every, g.orig.qflags, g.orig.wits, g.orig.facts, g.orig.pfacts⟩\n\n-- The ghosts are new names, and nothing of the original reads them.\ndef sghostOk (g : SGhosted) : Bool :=\n  distinct g.vars\n    && g.vars.all (fun v => !(g.orig.extVars ++ g.orig.f.m.init.map (·.1) ++ g.orig.f.m.step.map (·.1) ++ flagVars g.orig.f.flags ++ bkeys g.orig).contains v)\n    && avoids g.vars g.orig.f.m.pre && avoids g.vars g.orig.f.m.assume && g.orig.f.flags.all (fun p => avoids g.vars p.2)\n    && g.orig.f.m.step.all (fun p => avoidsE g.vars p.2) && g.orig.f.m.init.all (fun p => avoidsE g.vars p.2)\n    && g.orig.f.m.writes.all (fun w => avoidsE g.vars w.2.1 && avoidsE g.vars w.2.2)\n    && g.orig.every.all (fun w => avoidsE g.vars w.2.2) && g.orig.qflags.all (fun q => avoids g.vars q.2.2)\n    && g.orig.facts.all (fun l => avoids g.vars l.holds)\n\n-- The ghosted machine reads requests and decides flags as the original does.\ntheorem sview_full (g : SGhosted) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sView g.full ρ M ι κ = sView g.orig ρ M ι κ := rfl\n\n-- A run of the original lifted to the ghosted machine from a ghosted state s0 that agrees with its first: the ghosts\n-- move with each request the run takes.\nnoncomputable def sghostFrom (g : SGhosted) (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  | 0 => s0\n  | n + 1 => sNext g.full (sghostFrom g run s0 n).1 (sghostFrom g run s0 n).2 (run.req n).1 (run.req n).2\n\nsection sghost\nvariable (g : SGhosted) (hg : sghostOk g = true)\ninclude hg\n\ntheorem sghostOk_parts :\n    distinct g.vars = true\n      ∧ (∀ v ∈ g.vars, v ∉ g.orig.extVars ++ g.orig.f.m.init.map (·.1) ++ g.orig.f.m.step.map (·.1) ++ flagVars g.orig.f.flags ++ bkeys g.orig)\n      ∧ avoids g.vars g.orig.f.m.pre = true ∧ avoids g.vars g.orig.f.m.assume = true ∧ (∀ p ∈ g.orig.f.flags, avoids g.vars p.2 = true)\n      ∧ (∀ p ∈ g.orig.f.m.step, avoidsE g.vars p.2 = true) ∧ (∀ p ∈ g.orig.f.m.init, avoidsE g.vars p.2 = true)\n      ∧ (∀ w ∈ g.orig.f.m.writes, avoidsE g.vars w.2.1 = true ∧ avoidsE g.vars w.2.2 = true)\n      ∧ (∀ w ∈ g.orig.every, avoidsE g.vars w.2.2 = true) ∧ (∀ q ∈ g.orig.qflags, avoids g.vars q.2.2 = true)\n      ∧ (∀ l ∈ g.orig.facts, avoids g.vars l.holds = true) := by\n  simp only [sghostOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at hg\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hd, hn⟩, hp⟩, ha⟩, hf⟩, hs⟩, hi⟩, hw⟩, he⟩, hq⟩, hfa⟩ := hg\n  exact ⟨hd, fun v hv h => (by have := hn v hv; rw [List.contains_iff_mem.mpr h] at this; cases this), hp, ha, hf, hs, hi, hw, he, hq, hfa⟩\n\n-- One step from states that agree outside the ghosts, with the same request: allowed alike, and to states that agree\n-- outside the ghosts, with the same maps.\ntheorem sghost_step {ρ ρg : Nat → Nat} (hag : Agree g.vars ρg ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    evalC (sView g.full ρg M ι κ).1 (sView g.full ρg M ι κ).2 g.full.f.m.assume = evalC (sView g.orig ρ M ι κ).1 (sView g.orig ρ M ι κ).2 g.orig.f.m.assume\n      ∧ Agree g.vars (sNext g.full ρg M ι κ).1 (sNext g.orig ρ M ι κ).1\n      ∧ (sNext g.full ρg M ι κ).2 = (sNext g.orig ρ M ι κ).2 := by\n  obtain ⟨_, _, _, ha, hf, hs, _, hw, he, hq, _⟩ := sghostOk_parts g hg\n  have hX : Agree g.vars (withInputs g.orig.f.m.inputs ρg ι) (withInputs g.orig.f.m.inputs ρ ι) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  have hQ : Agree g.vars (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ))\n      (decideQ g.orig (withInputs g.orig.f.m.inputs ρ ι) (withCarried g.orig M κ)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of]\n    cases hl : lookup (fun q => q.1 == v) g.orig.qflags with\n    | some q => exact ite_all_congr (fun i hi _ => hX i (avoids_occ (hq q (lookup_some hl).1) hi)) (fun _ _ => rfl)\n    | none => exact hX v hv\n  have hD := decide_agree_on hf (withCarried g.orig M κ) hQ\n  refine ⟨?_, fun i hi => ?_, ?_⟩\n  · show evalC (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) _ g.orig.f.m.assume = _\n    exact congrC _ _ _ _ (fun i hi => hD i (avoids_occ ha hi))\n  · show applyS (g.orig.f.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2))) (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) i = _\n    rw [applyS_append_other (by simpa [SGhosted.vars] using hi)]\n    simp only [sNext, sView, applyS]\n    cases hst : assoc g.orig.f.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ g.orig.f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq', rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq'\n        simp only [beq_iff_eq] at hqv\n        rw [← hqv]; exact hqm\n      exact congrE _ _ _ e (fun j hj => hD j (avoidsE_occ (hs (i, e) hm) hj))\n  · funext mp key\n    show everyMaps g.orig (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) mp key\n      = everyMaps g.orig (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρ ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) mp key\n    simp only [everyMaps]\n    cases hl : lookup (fun w => w.1 == mp) g.orig.every with\n    | some w => exact congrE _ _ _ w.2.2 (fun j hj => upd_agree hD w.2.1 key j (avoidsE_occ (he w (lookup_some hl).1) hj))\n    | none =>\n      simp only [writeMaps]\n      cases hl2 : lookup (fun w => w.1 == mp) g.orig.f.m.writes with\n      | none => rfl\n      | some w =>\n        obtain ⟨h1, h2⟩ := hw w (lookup_some hl2).1\n        simp only [congrE _ _ _ w.2.1 (fun j hj => hD j (avoidsE_occ h1 hj)), congrE _ _ _ w.2.2 (fun j hj => hD j (avoidsE_occ h2 hj))]\n\n/-- Every reachable state of the original is, outside the ghosts, a reachable state of the ghosted machine. -/\ntheorem sghost_reach : ∀ {ρ M}, SReach g.orig ρ M → ∃ ρg, SReach g.full ρg M ∧ Agree g.vars ρg ρ := by\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 hfa hpf =>\n    refine ⟨applyS g.full.f.m.init ρ M, SReach.start ρ M hM h0 hfa hpf, fun i hi => ?_⟩\n    show applyS (g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ M i = applyS g.orig.f.m.init ρ M i\n    exact applyS_append_other (by simpa [SGhosted.vars] using hi) ρ M\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨ρg, hrg, hag⟩ := ih\n    obtain ⟨hA, hS, hW⟩ := sghost_step g hg hag M ι κ\n    refine ⟨_, ?_, hS⟩\n    rw [← hW]\n    exact SReach.step ρg M ι κ hrg (by rw [hA]; exact ha)\n\n/-- A law of the ghosted machine that reads no ghost holds in every reachable state of the original. -/\ntheorem sghost_laws (ps : List SEntry) (hl : checkSMachine g.full ps = true) :\n    ∀ ρ M, SReach g.orig ρ M → ∀ e ∈ ps, avoids g.vars e.law.holds = true → e.Holds ρ M := by\n  intro ρ M hr e he hav\n  obtain ⟨ρg, hrg, hag⟩ := sghost_reach g hg hr\n  exact sentry_transfer (V := g.vars) (MS := []) hav (by simp [avoidsMaps]) (fun i hi => (hag i hi).symm) (fun _ _ => rfl)\n    (smachine_sound g.full ps hl ρg M hrg e he)\n\ntheorem sghostFrom_agree (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) (hM0 : s0.2 = (run.st 0).2) (hA0 : Agree g.vars s0.1 (run.st 0).1) :\n    ∀ n, (sghostFrom g run s0 n).2 = (run.st n).2 ∧ Agree g.vars (sghostFrom g run s0 n).1 (run.st n).1\n  | 0 => ⟨hM0, hA0⟩\n  | n + 1 => by\n    obtain ⟨hM, hag⟩ := sghostFrom_agree run s0 hM0 hA0 n\n    obtain ⟨_, hS, hW⟩ := sghost_step g hg hag (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    simp only [sghostFrom, hM]\n    exact ⟨hW, hS⟩\n\nomit hg in\nnoncomputable def sghostRun (hg : sghostOk g = true) (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) (hr : SReach g.full s0.1 s0.2)\n    (hM0 : s0.2 = (run.st 0).2) (hA0 : Agree g.vars s0.1 (run.st 0).1) : SRun g.full :=\n  ⟨sghostFrom g run s0, run.req, hr,\n    fun n => by\n      obtain ⟨hM, hag⟩ := sghostFrom_agree g hg run s0 hM0 hA0 n\n      obtain ⟨hA, _, _⟩ := sghost_step g hg hag (run.st n).2 (run.req n).1 (run.req n).2\n      rw [hM, hA]; exact run.allowed n,\n    fun n => rfl⟩\n\n/-- Every run of the original is, outside the ghosts, a run of the ghosted machine taking the same requests. -/\ntheorem sghost_run (run : SRun g.orig) : ∃ run' : SRun g.full, run'.req = run.req ∧ ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1 :=\n  ⟨sghostRun g hg run (Classical.choose (sghost_reach g hg run.start), (run.st 0).2) (Classical.choose_spec (sghost_reach g hg run.start)).1 rfl\n      (Classical.choose_spec (sghost_reach g hg run.start)).2, rfl,\n    sghostFrom_agree g hg run (Classical.choose (sghost_reach g hg run.start), (run.st 0).2) rfl (Classical.choose_spec (sghost_reach g hg run.start)).2⟩\n/-- A run of the original from its start lifts to one of the ghosted machine from its start: each ghost at its start term. -/\ntheorem sghost_run_start (run : SRun g.orig) {ρ0 : Nat → Nat} {M0 : Nat → Nat → Nat} (hM : StartMaps g.orig.f.m M0)\n    (hp : evalC ρ0 M0 g.orig.f.m.pre = true) (hfa : ∀ l ∈ g.orig.facts, l.Holds ρ0 M0) (hpf : g.orig.PFacts ρ0 M0) (hst : run.st 0 = (applyS g.orig.f.m.init ρ0 M0, M0)) :\n    ∃ run' : SRun g.full, run'.req = run.req ∧ run'.st 0 = (applyS g.full.f.m.init ρ0 M0, M0)\n      ∧ ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1 := by\n  have hA0 : Agree g.vars (applyS g.full.f.m.init ρ0 M0) (run.st 0).1 := fun i hi => by\n    rw [hst]\n    show applyS (g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ0 M0 i = applyS g.orig.f.m.init ρ0 M0 i\n    exact applyS_append_other (by simpa [SGhosted.vars] using hi) ρ0 M0\n  have hM0 : M0 = (run.st 0).2 := by rw [hst]\n  exact ⟨sghostRun g hg run (applyS g.full.f.m.init ρ0 M0, M0) (SReach.start ρ0 M0 hM hp hfa hpf) hM0 hA0, rfl, rfl,\n    sghostFrom_agree g hg run (applyS g.full.f.m.init ρ0 M0, M0) hM0 hA0⟩\n\n-- A condition that reads no ghost, read where a step reads (its request, its flags decided), reads alike in a run and\n-- its lift.\ntheorem sghost_view (run : SRun g.orig) (run' : SRun g.full) (hreq : run'.req = run.req)\n    (hag : ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1) {c : C} (hc : avoids g.vars c = true) (n : Nat) :\n    evalC (sView g.orig (run'.st n).1 (run'.st n).2 (run'.req n).1 (run'.req n).2).1 (sView g.orig (run'.st n).1 (run'.st n).2 (run'.req n).1 (run'.req n).2).2 c\n      = evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c := by\n  obtain ⟨_, _, _, _, hf, _, _, _, _, hq, _⟩ := sghostOk_parts g hg\n  obtain ⟨hM, hA⟩ := hag n\n  rw [hM, hreq]\n  have hX : Agree g.vars (withInputs g.orig.f.m.inputs (run'.st n).1 (run.req n).1) (withInputs g.orig.f.m.inputs (run.st n).1 (run.req n).1) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hA i hi\n  have hQ : Agree g.vars (decideQ g.orig (withInputs g.orig.f.m.inputs (run'.st n).1 (run.req n).1) (withCarried g.orig (run.st n).2 (run.req n).2))\n      (decideQ g.orig (withInputs g.orig.f.m.inputs (run.st n).1 (run.req n).1) (withCarried g.orig (run.st n).2 (run.req n).2)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of]\n    cases hl : lookup (fun q => q.1 == v) g.orig.qflags with\n    | some q => exact ite_all_congr (fun i hi _ => hX i (avoids_occ (hq q (lookup_some hl).1) hi)) (fun _ _ => rfl)\n    | none => exact hX v hv\n  exact congrC _ _ _ c (fun i hi => decide_agree_on hf _ hQ i (avoids_occ hc hi))\nend sghost\n\n/-- What `ever` means: along a run of the ghosted machine where the ghost x starts at 0, with x's step `if c then 1\nelse x`, x is 1 at step n exactly when some step before n took a request where c held (read where that step reads: its\nrequest, its flags decided). -/\ntheorem sever_meaning (g : SGhosted) (hg : sghostOk g = true) {x : Nat} {s0 : E} {c : C} (hx : (x, s0, .ite c (.const 1) (.var x)) ∈ g.ghosts)\n    (run : SRun g.full) (h0 : (run.st 0).1 x = 0) :\n    ∀ n, (run.st n).1 x = 1 ↔ ∃ i, i < n ∧ evalC (sView g.orig (run.st i).1 (run.st i).2 (run.req i).1 (run.req i).2).1\n      (sView g.orig (run.st i).1 (run.st i).2 (run.req i).1 (run.req i).2).2 c = true := by\n  obtain ⟨hd, hn, _⟩ := sghostOk_parts g hg\n  have hxv : x ∈ g.vars := List.mem_map_of_mem hx\n  have hxo := hn x hxv\n  have hassoc : assoc g.full.f.m.step x = some (.ite c (.const 1) (.var x)) := by\n    show assoc (g.orig.f.m.step ++ g.ghosts.map (fun y => (y.1, y.2.2))) x = _\n    simp only [assoc, lookup_append]\n    rw [lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact hxo (by\n      rw [← he]; exact List.mem_append_left _ (List.mem_append_left _ (List.mem_append_right _ (List.mem_map_of_mem hp)))))]\n    have hl : lookup (fun p => p.1 == x) (g.ghosts.map (fun y => (y.1, y.2.2))) = some (x, .ite c (.const 1) (.var x)) := by\n      have hd' : distinct ((g.ghosts.map (fun y => (y.1, y.2.2))).map (·.1)) = true := by rw [List.map_map]; exact hd\n      exact lookup_unique_fst hd' (List.mem_map.mpr ⟨_, hx, rfl⟩)\n    simp [hl]\n  have hxe : x ∉ g.orig.extVars := fun h => hxo (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h))))\n  have hxf : x ∉ flagVars g.orig.f.flags := fun h => hxo (List.mem_append_left _ (List.mem_append_right _ h))\n  simp only [SMachine.extVars, SMachine.qVars, List.mem_append, not_or] at hxe\n  intro n\n  induction n with\n  | zero => simp [h0]\n  | succ n ih =>\n    have hst : (run.st (n + 1)).1 x = if evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1\n        (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true then 1 else (run.st n).1 x := by\n      rw [run.next n]\n      simp only [sNext, applyS, hassoc, evalE]\n      rw [sview_full]\n      congr 1\n      simp only [sView]\n      rw [decide_other hxf, decideQ_other (by simpa [SMachine.qVars] using hxe.1.2), withInputs_other hxe.1.1]\n    rw [hst]\n    constructor\n    · intro h1\n      by_cases hc : evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true\n      · exact ⟨n, Nat.lt_succ_self n, hc⟩\n      · rw [if_neg hc] at h1\n        obtain ⟨i, hi, hci⟩ := ih.mp h1\n        exact ⟨i, Nat.lt_succ_of_lt hi, hci⟩\n    · rintro ⟨i, hi, hci⟩\n      by_cases hc : evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true\n      · rw [if_pos hc]\n      · rw [if_neg hc]\n        rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hi | rfl\n        · exact ih.mpr ⟨i, hi, hci⟩\n        · exact absurd hci hc\n\nend Kern\n\n#print axioms Kern.sghost_reach\n#print axioms Kern.sghost_laws\n#print axioms Kern.sghost_run\n#print axioms Kern.sever_meaning\n#print axioms Kern.sghost_run_start\n",
     "Refine.lean": "import Ghost\n\n/-!\nWhat a refinement means, proven: compose.ts's `refinement(impl, spec, {relation, witness, stutter})` builds one machine,\nthe implementation beside the spec, the spec sent at each of the implementation's requests the request the witness\nnames, and left as it was where `stutter` holds. Lean builds that machine from the two (`SRefined.full`), the spec\ngiven in the composite's names, and checks that neither reads the other's parts (`srOk`). The machines have maps,\nflags and sets (a machine with maps and flags is one with no sets): requests carry maps, the spec's among the\nimplementation's, shared by name. With the relation proven of the composite (smachine_sound) and its step law that the\nspec stutters or allows every request it is sent (skstep_sound):\n- `srefine_lift`: every reachable state of the implementation is, outside the spec's part, a reachable state of the\n  composite;\n- `srefine_project`: the spec's part of every reachable state of the composite is a reachable state of the spec;\n- `srefines`: so every reachable state of the implementation is related, by the relation, to a reachable state of the\n  spec.\n-/\n\nnamespace Kern\n\nstructure Refined where\n  impl : FMMachine            -- the implementation, in the composite's names\n  spec : FMMachine            -- the spec, in the composite's names (its inputs fresh)\n  wit : List (Nat × E)        -- each spec input and its term over the implementation's request and both states\n  stutter : C                 -- where the implementation's step is one the spec doesn't see\n\n-- The composite: the implementation, then the spec, its inputs read as the witness, each part kept where it stutters.\ndef Refined.full (r : Refined) : FMMachine :=\n  ⟨{ inputs := r.impl.m.inputs\n     init := r.impl.m.init ++ r.spec.m.init\n     maps0 := r.impl.m.maps0 ++ r.spec.m.maps0\n     step := r.impl.m.step ++ r.spec.m.step.map (fun p => (p.1, .ite r.stutter (.var p.1) (substE r.wit p.2)))\n     writes := r.impl.m.writes ++ r.spec.m.writes.map (fun w =>\n       (w.1, substE r.wit w.2.1, .ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2)))\n     pre := r.impl.m.pre\n     assume := r.impl.m.assume },\n   r.impl.flags ++ r.spec.flags.map (fun p => (p.1, substC r.wit p.2))⟩\n\ndef readsNone (V MS : List Nat) (c : C) : Bool := avoids V c && avoidsMaps MS c\ndef readsNoneE (V MS : List Nat) (e : E) : Bool := avoidsE V e && avoidsMapsE MS e\n\n/-! Lists and flags -/\n\ntheorem applyS_append_right {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS (σ ++ τ) ρ M i = applyS τ ρ M i := by\n  have hσ : lookup (fun p => p.1 == i) σ = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [applyS, assoc, lookup_append, hσ]\n\ntheorem flagOf_append_left {fl fl' : List (Nat × C)} {i : Nat} (h : i ∉ flagVars fl') : flagOf (fl ++ fl') i = flagOf fl i := by\n  have h' : lookup (fun p => p.1 == i) fl' = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [flagOf, lookup_append]\n  cases hl : lookup (fun p => p.1 == i) fl <;> simp [h']\n\ntheorem flagOf_append_right {fl fl' : List (Nat × C)} {i : Nat} (h : i ∉ flagVars fl) : flagOf (fl ++ fl') i = flagOf fl' i := by\n  have h' : lookup (fun p => p.1 == i) fl = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [flagOf, lookup_append, h']\n\ntheorem flagOf_map {fl : List (Nat × C)} {g : C → C} (i : Nat) : flagOf (fl.map (fun p => (p.1, g p.2))) i = (flagOf fl i).map g := by\n  simp only [flagOf]\n  induction fl with\n  | nil => rfl\n  | cons a as ih =>\n    simp only [List.map_cons, lookup]\n    split <;> simp_all\n\ntheorem decideFlags_of (fl : List (Nat × C)) (X : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    decideFlags fl X M i = match flagOf fl i with\n      | some c => if evalC X M c = true then 1 else 0\n      | none => X i := by\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases flagOf fl i <;> simp [evalE]\n\ntheorem rn_v {V MS : List Nat} {c : C} (h : readsNone V MS c = true) : avoids V c = true := by simp only [readsNone, Bool.and_eq_true] at h; exact h.1\ntheorem rn_m {V MS : List Nat} {c : C} (h : readsNone V MS c = true) : avoidsMaps MS c = true := by simp only [readsNone, Bool.and_eq_true] at h; exact h.2\ntheorem rnE_v {V MS : List Nat} {e : E} (h : readsNoneE V MS e = true) : avoidsE V e = true := by simp only [readsNoneE, Bool.and_eq_true] at h; exact h.1\ntheorem rnE_m {V MS : List Nat} {e : E} (h : readsNoneE V MS e = true) : avoidsMapsE MS e = true := by simp only [readsNoneE, Bool.and_eq_true] at h; exact h.2\n\ntheorem assoc_map_fst (l : List (Nat × E)) (g : Nat × E → E) (v : Nat) :\n    assoc (l.map (fun q => (q.1, g q))) v = (lookup (fun q => q.1 == v) l).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\ntheorem lookup_writes_map (l : List (Nat × E × E)) (g : Nat × E × E → E × E) (mp : Nat) :\n    lookup (fun w : Nat × E × E => w.1 == mp) (l.map (fun w => (w.1, g w))) = (lookup (fun w : Nat × E × E => w.1 == mp) l).map (fun w => (w.1, g w)) := by\n  rw [lookup_map_pred]\n\n-- Read where `then` reads, a condition that reads no primed name is the condition before the step.\ntheorem unprimed_evalC {pr pm : List (Nat × Nat)} {c : C} (hv : avoids (pr.map (·.2)) c = true) (hm : avoidsMaps (pm.map (·.2)) c = true)\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalC (primed pr ρ' ρ) (primedMaps pm M' M) c = evalC ρ M c := by\n  rw [congrC _ ρ _ c (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact avoids_occ hv hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrMC ρ _ M c (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact avoidsMaps_occ hm hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\n\n/-! Refinements -/\n\nopen Classical\n\nstructure SRefined where\n  impl : SMachine\n  spec : SMachine\n  wit : List (Nat × E)\n  stutter : C\n\n\ndef SRefined.base (r : SRefined) : Refined := ⟨r.impl.f, r.spec.f, r.wit, r.stutter⟩\ndef SRefined.full (r : SRefined) : SMachine :=\n  ⟨r.base.full, r.impl.carried,\n   r.impl.every ++ r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2))),\n   r.impl.qflags ++ r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2)),\n   r.impl.wits ++ r.spec.wits, [], []⟩\ndef SRefined.allowed (r : SRefined) : C := inlineC r.full.f.flags (.or r.stutter (substC r.wit r.spec.f.m.assume))\n\ntheorem sfull_inputs (r : SRefined) : r.full.f.m.inputs = r.impl.f.m.inputs := rfl\ntheorem sfull_carried (r : SRefined) : r.full.carried = r.impl.carried := rfl\ntheorem sfull_flags (r : SRefined) : r.full.f.flags = r.impl.f.flags ++ r.spec.f.flags.map (fun p => (p.1, substC r.wit p.2)) := rfl\ntheorem sfull_qflags (r : SRefined) : r.full.qflags = r.impl.qflags ++ r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2)) := rfl\ntheorem sfull_every (r : SRefined) : r.full.every = r.impl.every ++ r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2))) := rfl\ntheorem sfull_step (r : SRefined) : r.full.f.m.step = r.impl.f.m.step ++ r.spec.f.m.step.map (fun p => (p.1, .ite r.stutter (.var p.1) (substE r.wit p.2))) := rfl\ntheorem sfull_writes (r : SRefined) : r.full.f.m.writes = r.impl.f.m.writes ++ r.spec.f.m.writes.map (fun w =>\n    (w.1, substE r.wit w.2.1, .ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2))) := rfl\ntheorem sfull_init (r : SRefined) : r.full.f.m.init = r.impl.f.m.init ++ r.spec.f.m.init := rfl\ntheorem sfull_maps0 (r : SRefined) : r.full.f.m.maps0 = r.impl.f.m.maps0 ++ r.spec.f.m.maps0 := rfl\ntheorem sfull_assume (r : SRefined) : r.full.f.m.assume = r.impl.f.m.assume := rfl\ntheorem sfull_pre (r : SRefined) : r.full.f.m.pre = r.impl.f.m.pre := rfl\n\n-- The implementation's names and maps (its own, and those only it carries); the spec's; where the spec's state and the\n-- composite's may differ; what the witness and `stutter` may not read.\ndef SRefined.IV (r : SRefined) : List Nat := r.impl.f.m.inputs ++ r.impl.f.m.init.map (·.1) ++ r.impl.f.m.step.map (·.1) ++ flagVars r.impl.f.flags ++ r.impl.qVars ++ bkeys r.impl\ndef SRefined.IO (r : SRefined) : List Nat := r.impl.f.m.maps0.map (·.1) ++ r.impl.f.m.writes.map (·.1) ++ r.impl.every.map (·.1)\ndef SRefined.IM (r : SRefined) : List Nat := r.IO ++ r.impl.carried.filter (fun mp => !r.spec.carried.contains mp)\ndef SRefined.SV (r : SRefined) : List Nat := r.spec.f.m.init.map (·.1) ++ r.spec.f.m.step.map (·.1) ++ flagVars r.spec.f.flags ++ r.spec.qVars ++ bkeys r.spec\ndef SRefined.SM (r : SRefined) : List Nat := r.spec.f.m.maps0.map (·.1) ++ r.spec.f.m.writes.map (·.1) ++ r.spec.every.map (·.1)\ndef SRefined.X (r : SRefined) : List Nat := r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars ++ r.spec.f.m.inputs\ndef SRefined.W (r : SRefined) : List Nat := flagVars r.impl.f.flags ++ flagVars r.spec.f.flags ++ r.spec.f.m.inputs ++ r.impl.qVars ++ r.spec.qVars ++ bkeys r.spec\n\ndef srImplOk (r : SRefined) : Bool :=\n  readsNone r.SV r.SM r.impl.f.m.pre && readsNone r.SV r.SM r.impl.f.m.assume\n    && r.impl.f.flags.all (fun p => readsNone r.SV r.SM p.2) && r.impl.f.m.step.all (fun p => readsNoneE r.SV r.SM p.2)\n    && r.impl.f.m.init.all (fun p => readsNoneE r.SV r.SM p.2)\n    && r.impl.f.m.writes.all (fun w => readsNoneE r.SV r.SM w.2.1 && readsNoneE r.SV r.SM w.2.2)\n    && r.impl.every.all (fun w => readsNoneE r.SV r.SM w.2.2) && r.impl.qflags.all (fun q => readsNone r.SV r.SM q.2.2)\ndef srSpecOk (r : SRefined) : Bool :=\n  readsNone r.IV r.IM r.spec.f.m.assume && r.spec.f.flags.all (fun p => readsNone (r.IV ++ flagVars r.spec.f.flags) r.IM p.2)\n    && r.spec.f.m.step.all (fun p => readsNoneE r.IV r.IM p.2) && r.spec.f.m.init.all (fun p => readsNoneE (r.IV ++ r.spec.f.m.inputs) r.IM p.2)\n    && r.spec.f.m.writes.all (fun w => readsNoneE r.IV r.IM w.2.1 && readsNoneE r.IV r.IM w.2.2)\n    && r.spec.every.all (fun w => readsNoneE r.IV r.IM w.2.2)\n    && r.spec.qflags.all (fun q => readsNone (r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars) r.IM q.2.2)\n    && readsNone (r.X ++ r.SV) r.IM r.spec.f.m.pre && !readsC r.spec.f.m.pre\ndef srNamesOk (r : SRefined) : Bool :=\n  r.SV.all (fun v => !r.IV.contains v) && r.spec.f.m.inputs.all (fun v => !(r.IV ++ r.SV).contains v)\n    && r.SM.all (fun mp => !r.IM.contains mp) && r.spec.carried.all (fun mp => r.impl.carried.contains mp)\n    && r.impl.carried.all (fun mp => !(r.IO ++ r.SM).contains mp)\n    && r.wit.all (fun p => r.spec.f.m.inputs.contains p.1 && avoidsE r.W p.2) && avoids r.W r.stutter\n    && r.impl.facts.isEmpty && r.spec.facts.isEmpty\ndef srOk (r : SRefined) : Bool := srImplOk r && srSpecOk r && (srNamesOk r && r.spec.pfacts.isEmpty)\n\ntheorem srImpl_parts {r : SRefined} (h : srImplOk r = true) :\n    readsNone r.SV r.SM r.impl.f.m.pre = true ∧ readsNone r.SV r.SM r.impl.f.m.assume = true\n      ∧ (∀ p ∈ r.impl.f.flags, readsNone r.SV r.SM p.2 = true) ∧ (∀ p ∈ r.impl.f.m.step, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ p ∈ r.impl.f.m.init, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ w ∈ r.impl.f.m.writes, readsNoneE r.SV r.SM w.2.1 = true ∧ readsNoneE r.SV r.SM w.2.2 = true)\n      ∧ (∀ w ∈ r.impl.every, readsNoneE r.SV r.SM w.2.2 = true) ∧ (∀ q ∈ r.impl.qflags, readsNone r.SV r.SM q.2.2 = true) := by\n  simp only [srImplOk, Bool.and_eq_true, List.all_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7, h8⟩\n\ntheorem srSpec_parts {r : SRefined} (h : srSpecOk r = true) :\n    readsNone r.IV r.IM r.spec.f.m.assume = true ∧ (∀ p ∈ r.spec.f.flags, readsNone (r.IV ++ flagVars r.spec.f.flags) r.IM p.2 = true)\n      ∧ (∀ p ∈ r.spec.f.m.step, readsNoneE r.IV r.IM p.2 = true) ∧ (∀ p ∈ r.spec.f.m.init, readsNoneE (r.IV ++ r.spec.f.m.inputs) r.IM p.2 = true)\n      ∧ (∀ w ∈ r.spec.f.m.writes, readsNoneE r.IV r.IM w.2.1 = true ∧ readsNoneE r.IV r.IM w.2.2 = true)\n      ∧ (∀ w ∈ r.spec.every, readsNoneE r.IV r.IM w.2.2 = true)\n      ∧ (∀ q ∈ r.spec.qflags, readsNone (r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars) r.IM q.2.2 = true)\n      ∧ readsNone (r.X ++ r.SV) r.IM r.spec.f.m.pre = true ∧ readsC r.spec.f.m.pre = false := by\n  simp only [srSpecOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩, h9⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9⟩\n\ntheorem srNames_parts {r : SRefined} (h : srNamesOk r = true) :\n    (∀ v ∈ r.SV, v ∉ r.IV) ∧ (∀ v ∈ r.spec.f.m.inputs, v ∉ r.IV ++ r.SV) ∧ (∀ mp ∈ r.SM, mp ∉ r.IM)\n      ∧ (∀ mp ∈ r.spec.carried, mp ∈ r.impl.carried) ∧ (∀ mp ∈ r.impl.carried, mp ∉ r.IO ++ r.SM)\n      ∧ (∀ p ∈ r.wit, p.1 ∈ r.spec.f.m.inputs ∧ avoidsE r.W p.2 = true) ∧ avoids r.W r.stutter = true\n      ∧ r.impl.facts = [] ∧ r.spec.facts = [] := by\n  simp only [srNamesOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true', List.isEmpty_iff] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩, h9⟩ := h\n  refine ⟨fun v hv hm => ?_, fun v hv hm => ?_, fun mp hm hm' => ?_, fun mp hm => List.contains_iff_mem.mp (h4 mp hm), fun mp hm hm' => ?_,\n    fun p hp => ⟨List.contains_iff_mem.mp (h6 p hp).1, (h6 p hp).2⟩, h7, h8, h9⟩\n  · have := h1 v hv; rw [List.contains_iff_mem.mpr hm] at this; cases this\n  · have := h2 v hv; rw [List.contains_iff_mem.mpr hm] at this; cases this\n  · have := h3 mp hm; rw [List.contains_iff_mem.mpr hm'] at this; cases this\n  · have := h5 mp hm; rw [List.contains_iff_mem.mpr hm'] at this; cases this\n\n/-! The implementation's runs, inside the composite's -/\n\nsection slift\nvariable (r : SRefined) (hok : srOk r = true)\ninclude hok\n\ntheorem sr_impl : srImplOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.1.1\ntheorem sr_spec : srSpecOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.1.2\ntheorem sr_names : srNamesOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.2.1\ntheorem sr_pfacts : r.spec.pfacts = [] := by simp only [srOk, Bool.and_eq_true, List.isEmpty_iff] at hok; exact hok.2.2\n\n-- One step of the composite from a state that agrees with the implementation's outside the spec's part, with the same\n-- request: allowed alike, to states that still agree.\ntheorem srefine_step {ρ ρc : Nat → Nat} {M Mc : Nat → Nat → Nat} (hag : Agree r.SV ρc ρ) (hmag : ∀ mp, mp ∉ r.SM → Mc mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    evalC (sView r.full ρc Mc ι κ).1 (sView r.full ρc Mc ι κ).2 r.full.f.m.assume = evalC (sView r.impl ρ M ι κ).1 (sView r.impl ρ M ι κ).2 r.impl.f.m.assume\n      ∧ Agree r.SV (sNext r.full ρc Mc ι κ).1 (sNext r.impl ρ M ι κ).1\n      ∧ ∀ mp, mp ∉ r.SM → (sNext r.full ρc Mc ι κ).2 mp = (sNext r.impl ρ M ι κ).2 mp := by\n  obtain ⟨_, ha, hf, hs, _, hw, he, hq⟩ := srImpl_parts (sr_impl r hok)\n  have hN : ∀ mp, mp ∉ r.SM → withCarried r.full Mc κ mp = withCarried r.impl M κ mp := fun mp hmp => by\n    show (if r.impl.carried.contains mp = true then κ mp else Mc mp) = (if r.impl.carried.contains mp = true then κ mp else M mp)\n    by_cases hc : r.impl.carried.contains mp = true\n    · rw [if_pos hc, if_pos hc]\n    · rw [if_neg hc, if_neg hc]; exact hmag mp hmp\n  have hX : Agree r.SV (withInputs r.full.f.m.inputs ρc ι) (withInputs r.impl.f.m.inputs ρ ι) := fun i hi => by\n    rw [sfull_inputs]; simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  -- The quantified flags: the composite's decide the implementation's alike, outside the spec's names.\n  have hQ : Agree r.SV (decideQ r.full (withInputs r.full.f.m.inputs ρc ι) (withCarried r.full Mc κ))\n      (decideQ r.impl (withInputs r.impl.f.m.inputs ρ ι) (withCarried r.impl M κ)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of, sfull_qflags, lookup_append]\n    cases hl : lookup (fun q => q.1 == v) r.impl.qflags with\n    | some q =>\n      have hrd := hq q (lookup_some hl).1\n      exact ite_all_congr (fun i hi _ => hX i (avoids_occ (rn_v hrd) hi)) (fun mp hmp => hN mp (avoidsMaps_occ (rn_m hrd) hmp))\n    | none =>\n      have hn : lookup (fun q => q.1 == v) (r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2))) = none :=\n        lookup_none (fun q hq' => by\n          simp only [beq_eq_false_iff_ne]; intro hqv\n          obtain ⟨q0, hq0, rfl⟩ := List.mem_map.mp hq'\n          exact hv (by simp only [SRefined.SV, SMachine.qVars, List.mem_append]; left; right; rw [← hqv]; exact List.mem_map.mpr ⟨q0, hq0, rfl⟩))\n      simp only [hn]\n      exact hX v hv\n  -- The plain flags, likewise.\n  have hD : Agree r.SV (decideFlags r.full.f.flags (decideQ r.full (withInputs r.full.f.m.inputs ρc ι) (withCarried r.full Mc κ)) (withCarried r.full Mc κ))\n      (decideFlags r.impl.f.flags (decideQ r.impl (withInputs r.impl.f.m.inputs ρ ι) (withCarried r.impl M κ)) (withCarried r.impl M κ)) := by\n    intro i hi\n    have hif : i ∉ flagVars (r.spec.f.flags.map (fun p => (p.1, substC r.wit p.2))) := fun h' => hi (by\n      simp only [flagVars, List.map_map] at h'; simp only [SRefined.SV, List.mem_append]; left; left; right\n      simpa [flagVars, Function.comp_def] using h')\n    rw [sfull_flags, decideFlags_of, decideFlags_of, flagOf_append_left hif]\n    cases hfo : flagOf r.impl.f.flags i with\n    | none => exact hQ i hi\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hfo\n      simp only\n      rw [congrMC _ _ _ _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m (hf p hp)) hmp)),\n        congrC _ _ _ _ (fun j hj => hQ j (avoids_occ (rn_v (hf p hp)) hj))]\n  refine ⟨?_, fun i hi => ?_, fun mp hmp => ?_⟩\n  · simp only [sView]\n    rw [sfull_assume, congrMC _ _ _ _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m ha) hmp)), congrC _ _ _ _ (fun j hj => hD j (avoids_occ (rn_v ha) hj))]\n  · simp only [sNext, sView]\n    rw [sfull_step]\n    have hit : i ∉ (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))).map (·.1) := fun h' => hi (by\n      simp only [List.map_map] at h'; simp only [SRefined.SV, List.mem_append]; left; left; left; right; simpa [Function.comp_def] using h')\n    rw [applyS_append_other hit]\n    simp only [applyS]\n    cases hst : assoc r.impl.f.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ r.impl.f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq', rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq'\n        simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n      dsimp only\n      rw [congrME _ _ _ e (fun mp hmp => hN mp (avoidsMapsE_occ (rnE_m (hs (i, e) hm)) hmp)),\n        congrE _ _ _ e (fun j hj => hD j (avoidsE_occ (rnE_v (hs (i, e) hm)) hj))]\n  · funext key\n    simp only [sNext, sView, everyMaps]\n    rw [sfull_every, lookup_append]\n    cases hl : lookup (fun w => w.1 == mp) r.impl.every with\n    | some w =>\n      have hrd := he w (lookup_some hl).1\n      simp only\n      rw [congrME _ _ _ w.2.2 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m hrd) h)),\n        congrE _ _ _ w.2.2 (fun j hj => upd_agree hD w.2.1 key j (avoidsE_occ (rnE_v hrd) hj))]\n    | none =>\n      have hn : lookup (fun w => w.1 == mp) (r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2)))) = none :=\n        lookup_none (fun w hw' => by\n          simp only [beq_eq_false_iff_ne]; intro he'\n          obtain ⟨w0, hw0, rfl⟩ := List.mem_map.mp hw'\n          exact hmp (by simp only [SRefined.SM, List.mem_append]; right; rw [← he']; exact List.mem_map.mpr ⟨w0, hw0, rfl⟩))\n      simp only [hn]\n      have hwm : lookup (fun w : Nat × E × E => w.1 == mp) (r.spec.f.m.writes.map (fun w =>\n          (w.1, substE r.wit w.2.1, E.ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2)))) = none :=\n        lookup_none (fun w hw' => by\n          simp only [beq_eq_false_iff_ne]; intro he'\n          obtain ⟨w0, hw0, rfl⟩ := List.mem_map.mp hw'\n          exact hmp (by simp only [SRefined.SM, List.mem_append]; left; right; rw [← he']; exact List.mem_map.mpr ⟨w0, hw0, rfl⟩))\n      simp only [writeMaps]\n      rw [sfull_writes, lookup_append]\n      cases hl2 : lookup (fun w => w.1 == mp) r.impl.f.m.writes with\n      | none => simp only [hwm]; exact congrFun (hN mp hmp) key\n      | some w =>\n        obtain ⟨h1, h2⟩ := hw w (lookup_some hl2).1\n        simp only\n        rw [congrME _ _ _ w.2.1 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m h1) h)), congrE _ _ _ w.2.1 (fun j hj => hD j (avoidsE_occ (rnE_v h1) hj)),\n          congrME _ _ _ w.2.2 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m h2) h)), congrE _ _ _ w.2.2 (fun j hj => hD j (avoidsE_occ (rnE_v h2) hj)), hN mp hmp]\n\n/-- Every reachable state of the implementation is, outside the spec's part, a reachable state of the composite. -/\ntheorem srefine_lift (hmo : distinct (r.spec.f.m.maps0.map (·.1)) = true) :\n    ∀ {ρ M}, SReach r.impl ρ M → ∃ ρc Mc, SReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ ∀ mp, mp ∉ r.SM → Mc mp = M mp := by\n  obtain ⟨hp, _, _, _, hi, _⟩ := srImpl_parts (sr_impl r hok)\n  obtain ⟨_, _, hsm, _⟩ := srNames_parts (sr_names r hok)\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 _ _ =>\n    let Mc : Nat → Nat → Nat := fun mp => match lookup (fun p => p.1 == mp) r.spec.f.m.maps0 with\n      | some p => fun _ => p.2\n      | none => M mp\n    have hMc : ∀ mp, mp ∉ r.SM → Mc mp = M mp := fun mp hmp => by\n      simp only [Mc]\n      rw [lookup_none (fun p hp' => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hmp (by simp only [SRefined.SM, List.mem_append]; left; left; rw [← he]; exact List.mem_map_of_mem hp'))]\n    have hpre : evalC ρ Mc r.full.f.m.pre = true := by\n      rw [sfull_pre, congrMC _ Mc M _ (fun mp hmp => hMc mp (avoidsMaps_occ (rn_m hp) hmp))]; exact h0\n    have hstart : StartMaps r.full.f.m Mc := by\n      intro p hp' key\n      rw [sfull_maps0] at hp'\n      rcases List.mem_append.mp hp' with hp' | hp'\n      · have hn : p.1 ∉ r.SM := fun h' => hsm p.1 h' (by\n          simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; left; left; exact List.mem_map_of_mem hp')\n        rw [hMc p.1 hn]; exact hM p hp' key\n      · have hl : lookup (fun q => q.1 == p.1) r.spec.f.m.maps0 = some p := lookup_unique1 hmo hp'\n        simp only [Mc, hl]\n    have hfacts : ∀ l ∈ r.full.facts, l.Holds ρ Mc := fun l hl => by simp [SRefined.full] at hl\n    refine ⟨_, Mc, SReach.start ρ Mc hstart hpre hfacts (fun p hp => by simp [SRefined.full] at hp), fun i hi' => ?_, hMc⟩\n    show applyS (r.impl.f.m.init ++ r.spec.f.m.init) ρ Mc i = applyS r.impl.f.m.init ρ M i\n    rw [applyS_append_other (by\n      intro h'; apply hi'; simp only [SRefined.SV, List.mem_append]; left; left; left; left; exact h')]\n    simp only [applyS]\n    cases hst : assoc r.impl.f.m.init i with\n    | none => rfl\n    | some e =>\n      have hm : (i, e) ∈ r.impl.f.m.init := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq, rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq\n        simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n      exact congrME _ Mc M e (fun mp hmp => hMc mp (avoidsMapsE_occ (rnE_m (hi (i, e) hm)) hmp))\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨ρc, Mc, hrc, hag, hmag⟩ := ih\n    obtain ⟨hA, hS, hW⟩ := srefine_step r hok hag hmag ι κ\n    exact ⟨_, _, SReach.step ρc Mc ι κ hrc (by rw [hA]; exact ha), hS, hW⟩\nend slift\n\n/-! The spec's part of the composite's runs -/\n\ntheorem lookup_qmap (l : List (Nat × List Nat × C)) (g : Nat × List Nat × C → C) (v : Nat) :\n    lookup (fun q : Nat × List Nat × C => q.1 == v) (l.map (fun q => (q.1, q.2.1, g q))) = (lookup (fun q : Nat × List Nat × C => q.1 == v) l).map (fun q => (q.1, q.2.1, g q)) := by\n  rw [lookup_map_pred]\ntheorem lookup_emap (l : List (Nat × Nat × E)) (g : Nat × Nat × E → E) (v : Nat) :\n    lookup (fun w : Nat × Nat × E => w.1 == v) (l.map (fun w => (w.1, w.2.1, g w))) = (lookup (fun w : Nat × Nat × E => w.1 == v) l).map (fun w => (w.1, w.2.1, g w)) := by\n  rw [lookup_map_pred]\n\ntheorem sView_snd (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (sView s ρ M ι κ).2 = withCarried s M κ := rfl\n\nsection sproject\nvariable (r : SRefined) (hok : srOk r = true)\ninclude hok\n\n-- The maps the spec reads: alike in its view and the composite's.\ntheorem sr_maps {M Ms : Nat → Nat → Nat} (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp) (κ : Nat → Nat → Nat) :\n    ∀ mp, mp ∉ r.IM → withCarried r.spec Ms κ mp = withCarried r.full M κ mp := by\n  obtain ⟨_, _, _, hcar, _⟩ := srNames_parts (sr_names r hok)\n  intro mp hmp\n  show (if r.spec.carried.contains mp = true then κ mp else Ms mp) = (if r.impl.carried.contains mp = true then κ mp else M mp)\n  by_cases hs : r.spec.carried.contains mp = true\n  · rw [if_pos hs, if_pos (List.contains_iff_mem.mpr (hcar mp (List.contains_iff_mem.mp hs)))]\n  · have hi : ¬ r.impl.carried.contains mp = true := fun hc => hmp (by\n      simp only [SRefined.IM, List.mem_append, List.mem_filter]; right; exact ⟨List.contains_iff_mem.mp hc, by simpa using hs⟩)\n    rw [if_neg hs, if_neg hi]\n    exact hmag mp hmp (fun h' => hs (List.contains_iff_mem.mpr h'))\n\ntheorem sr_W {v : Nat} (hv : v ∈ flagVars r.full.f.flags ∨ v ∈ r.full.qVars) : v ∈ r.W := by\n  simp only [sfull_flags, flagVars, List.map_append, List.map_map, SMachine.qVars, sfull_qflags, List.mem_append] at hv\n  simp only [SRefined.W, SMachine.qVars, flagVars, List.mem_append]\n  rcases hv with (h | h) | (h | h)\n  · left; left; left; left; left; exact h\n  · left; left; left; left; right; simpa [Function.comp_def] using h\n  · left; left; right; exact h\n  · left; right; simpa [Function.comp_def] using h\n\n-- A term the witness has, read in the composite's view, before its flags or with a key set: alike.\ntheorem sr_witE {ρ : Nat → Nat} {M : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : avoidsE r.W e = true) :\n    evalE (decideFlags r.full.f.flags (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) (withCarried r.full M κ) e\n      = evalE (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ) e := by\n  apply congrE; intro j hj\n  have hjW := avoidsE_occ he hj\n  rw [decide_other (fun h' => hjW (sr_W r hok (Or.inl h'))), decideQ_other (fun h' => hjW (sr_W r hok (Or.inr h')))]\n\ntheorem sr_wit_upd {X : Nat → Nat} {N : Nat → Nat → Nat} {e : E} (he : avoidsE r.W e = true) {k : Nat} (hk : k ∈ bkeys r.spec) (key : Nat) :\n    evalE (upd X k key) N e = evalE X N e := by\n  apply congrE; intro j hj\n  simp only [upd]; split\n  · rename_i h; subst h; exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk) (avoidsE_occ he hj)\n  · rfl\n\ntheorem sr_wit_atKeys {X : Nat → Nat} {N : Nat → Nat → Nat} {e : E} (he : avoidsE r.W e = true) {ks : List Nat} (hk : ∀ k ∈ ks, k ∈ bkeys r.spec) (v : Nat → Nat) :\n    evalE (atKeys X ks v) N e = evalE X N e := by\n  apply congrE; intro j hj\n  by_cases hjk : j ∈ ks\n  · exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk j hjk) (avoidsE_occ he hj)\n  · exact atKeys_out hjk\n\n-- The witness's domain: spec inputs.\ntheorem sr_wdom {i : Nat} (hi : i ∉ r.spec.f.m.inputs) : i ∉ r.wit.map (·.1) := fun h' => by\n  obtain ⟨_, _, _, _, _, hwit, _⟩ := srNames_parts (sr_names r hok)\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h'; exact hi (hwit p hp).1\n\ntheorem sr_wit_some {i : Nat} {e : E} (h : assoc r.wit i = some e) : (i, e) ∈ r.wit := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨q, hq, rfl⟩ := h\n  obtain ⟨hqm, hqv⟩ := lookup_some hq\n  simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n\n-- The spec's quantified flags, decided over its view (its inputs as the witness reads them), agree with the composite's\n-- with the witness put in, outside the implementation's names and the spec's plain flags.\ntheorem sr_q {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    Agree (r.IV ++ flagVars r.spec.f.flags)\n      (decideQ r.spec (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) (withCarried r.spec Ms κ))\n      (applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) := by\n  obtain ⟨_, _, _, _, _, _, hsq, _, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨hsv, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hN := sr_maps r hok hmag κ\n  intro v hv\n  have hvI : v ∉ r.IV := fun h' => hv (List.mem_append_left _ h')\n  have hvF : v ∉ flagVars r.spec.f.flags := fun h' => hv (List.mem_append_right _ h')\n  -- Names of the spec's part are none of the spec's inputs.\n  have hSI : ∀ i, i ∈ r.SV → i ∉ r.spec.f.m.inputs := fun i hi h' => hsi i h' (List.mem_append_right _ hi)\n  have hIVq : ∀ i, i ∉ r.IV → i ∉ r.impl.qVars := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; right; exact h')\n  have hIVi : ∀ i, i ∉ r.IV → i ∉ r.impl.f.m.inputs := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; left; left; left; exact h')\n  have hIVf : ∀ i, i ∉ r.IV → i ∉ flagVars r.impl.f.flags := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; right; exact h')\n  have hfull_q : ∀ i, i ∉ r.impl.qVars → i ∉ r.spec.qVars → i ∉ r.full.qVars := fun i h1 h2 h' => by\n    simp only [SMachine.qVars, sfull_qflags, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact h1 h'\n    · exact h2 (by simpa [SMachine.qVars, Function.comp_def] using h')\n  have hfull_f : ∀ i, i ∉ flagVars r.impl.f.flags → i ∉ flagVars r.spec.f.flags → i ∉ flagVars r.full.f.flags := fun i h1 h2 h' => by\n    simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact h1 h'\n    · exact h2 (by simpa [flagVars, Function.comp_def] using h')\n  -- The spec inputs as the witness reads them: in the composite's view, or before its flags; the same.\n  have hιs : ∀ i, i ∈ r.spec.f.m.inputs → applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ) i\n      = applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ) i := fun i hi => by\n    have hiI : i ∉ r.IV := fun h' => hsi i hi (List.mem_append_left _ h')\n    have hiS : i ∉ r.SV := fun h' => hsi i hi (List.mem_append_right _ h')\n    have hiF : i ∉ flagVars r.full.f.flags := hfull_f i (hIVf i hiI) (fun h' => hiS (by simp only [SRefined.SV, List.mem_append]; left; left; right; exact h'))\n    simp only [applyS, sView]\n    cases ha : assoc r.wit i with\n    | none => exact decide_other hiF _ _\n    | some e =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      rw [sr_witE r hok ι κ (hwit _ hm).2]\n      exact (congrE _ _ _ e (fun j hj => decideQ_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inr h'))) _ _)).symm\n  by_cases hvq : v ∈ r.spec.qVars\n  · -- A spec's quantified flag: its body over the spec's view; in the composite, with the witness put in.\n    have hvi : v ∉ r.spec.f.m.inputs := hSI v (by simp only [SRefined.SV, List.mem_append]; left; right; exact hvq)\n    rw [decideQ_of, applyS_other (sr_wdom r hok hvi), decideQ_of, sfull_qflags, lookup_append]\n    have hn : lookup (fun q => q.1 == v) r.impl.qflags = none := lookup_none (fun q hq' => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hIVq v hvI (by rw [← he]; exact List.mem_map_of_mem hq'))\n    simp only [hn, lookup_qmap]\n    cases hl : lookup (fun q => q.1 == v) r.spec.qflags with\n    | none => exact absurd hvq (fun h' => by obtain ⟨q, hq, hqv⟩ := List.mem_map.mp h'; have := lookup_none_all hl q hq; simp [hqv] at this)\n    | some q =>\n      have hqm := (lookup_some hl).1\n      have hrd := hsq q hqm\n      have hk : ∀ k ∈ q.2.1, k ∈ bkeys r.spec := fun k hk' => by simp only [bkeys, List.mem_append]; right; exact List.mem_flatMap.mpr ⟨q, hqm, hk'⟩\n      simp only [Option.map_some]\n      have hc : (∀ k, holdsC (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ) (substC r.wit q.2.2))\n          ↔ (∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) := by\n        apply forall_congr'; intro k; rw [← evalC_iff, ← evalC_iff, subst_evalC]\n      rw [show (if ∀ k, holdsC (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ) (substC r.wit q.2.2) then 1 else 0)\n          = (if ∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 then 1 else 0) by\n        simp only [hc]]\n      have hkdom : ∀ k ∈ q.2.1, k ∉ r.wit.map (·.1) := fun k hk' => sr_wdom r hok (hSI _ (by simp only [SRefined.SV, List.mem_append]; right; exact hk k hk'))\n      -- Both sides as one condition over every value of the keys: compare the states they read the body at.\n      have hall : ∀ k, evalC (atKeys (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 k) (withCarried r.spec Ms κ) q.2.2\n          = evalC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 := by\n        intro k\n        rw [congrMC _ _ (withCarried r.full M κ) _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m hrd) hmp))]\n        apply congrC; intro i hi\n        have hiR := avoids_occ (rn_v hrd) hi\n        simp only [List.mem_append, not_or] at hiR\n        obtain ⟨⟨hiI, hiF⟩, hiQ⟩ := hiR\n        by_cases hik : i ∈ q.2.1\n        · rw [applyS_other (hkdom i hik), atKeys_in hik, atKeys_in hik]\n        · rw [atKeys_out hik]\n          by_cases hii : i ∈ r.spec.f.m.inputs\n          · simp only [withInputs, List.contains_iff_mem.mpr hii, if_true]\n            rw [hιs i hii]\n            simp only [applyS]\n            cases ha : assoc r.wit i with\n            | none => rw [atKeys_out hik]; exact decideQ_other (fun h' => hfull_q i (hIVq i hiI) hiQ h') _ _\n            | some e =>\n              have hm := sr_wit_some r hok ha\n              dsimp only\n              rw [sr_wit_atKeys r hok (hwit _ hm).2 hk]\n              exact congrE _ _ _ e (fun j hj => decideQ_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inr h'))) _ _)\n          · rw [withInputs_other hii, applyS_other (sr_wdom r hok hii), atKeys_out hik]\n            rw [sfull_inputs, withInputs_other (hIVi i hiI)]\n            exact hag i (by simp only [SRefined.X, List.mem_append, not_or]; exact ⟨⟨⟨hiI, hiF⟩, hiQ⟩, hii⟩)\n      simp only [show (∀ k, holdsC (atKeys (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 k) (withCarried r.spec Ms κ) q.2.2)\n          ↔ (∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) from\n        forall_congr' (fun k => by rw [← evalC_iff, ← evalC_iff, hall k])]\n  · rw [decideQ_other hvq]\n    by_cases hvi : v ∈ r.spec.f.m.inputs\n    · simp only [withInputs, List.contains_iff_mem.mpr hvi, if_true]\n      exact hιs v hvi\n    · rw [withInputs_other hvi, applyS_other (sr_wdom r hok hvi), decideQ_other (hfull_q v (hIVq v hvI) hvq), sfull_inputs, withInputs_other (hIVi v hvI)]\n      exact hag v (by simp only [SRefined.X, List.mem_append, not_or]; exact ⟨⟨⟨hvI, hvF⟩, hvq⟩, hvi⟩)\n\n-- The spec's view of a step agrees with the composite's with the witness put in, outside the implementation's names.\ntheorem sr_view {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    Agree r.IV (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1\n      (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) := by\n  obtain ⟨_, hsf, _, _, _, _, _, _, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨hsv, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hN := sr_maps r hok hmag κ\n  have hQ := sr_q r hok hag hmag ι κ\n  simp only [sView] at hQ\n  have hIVf : ∀ i, i ∉ r.IV → i ∉ flagVars r.impl.f.flags := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; right; exact h')\n  intro v hv\n  simp only [sView]\n  by_cases hvf : v ∈ flagVars r.spec.f.flags\n  · have hvi : v ∉ r.spec.f.m.inputs := fun h' => hsi v h' (List.mem_append_right _ (by simp only [SRefined.SV, List.mem_append]; left; left; right; exact hvf))\n    cases hfo : flagOf r.spec.f.flags v with\n    | none => exact absurd hvf (flagOf_none hfo)\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hfo\n      have hfull : flagOf r.full.f.flags v = some (substC r.wit p.2) := by\n        rw [sfull_flags, flagOf_append_right (hIVf v hv), flagOf_map, hfo]; rfl\n      rw [decideFlags_of, hfo, applyS_other (sr_wdom r hok hvi), decideFlags_of, hfull]\n      simp only\n      rw [subst_evalC, congrMC _ _ (withCarried r.full M κ) _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m (hsf p hp)) hmp))]\n      rw [congrC _ (applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) _ p.2\n        (fun j hj => hQ j (avoids_occ (rn_v (hsf p hp)) hj))]\n  · rw [decide_other hvf]\n    have hX : v ∉ r.IV ++ flagVars r.spec.f.flags := by simp only [List.mem_append, not_or]; exact ⟨hv, hvf⟩\n    rw [hQ v hX]\n    simp only [applyS]\n    cases ha : assoc r.wit v with\n    | none =>\n      dsimp only\n      rw [decide_other (fun h' => by\n        simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n        rcases h' with h' | h'\n        · exact hIVf v hv h'\n        · exact hvf (by simpa [flagVars, Function.comp_def] using h'))]\n    | some e =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      exact congrE _ _ _ e (fun j hj => (decide_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inl h'))) _ _).symm)\n\n-- A term of the spec, read in the spec's view, is the term with the witness put in, read in the composite's view; with a\n-- bound key of the spec set, alike.\ntheorem sr_term {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : readsNoneE r.IV r.IM e = true) :\n    evalE (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 (withCarried r.spec Ms κ) e\n      = evalE (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substE r.wit e) := by\n  rw [subst_evalE, congrME _ _ (withCarried r.full M κ) e (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMapsE_occ (rnE_m he) hmp))]\n  exact congrE _ _ _ e (fun j hj => sr_view r hok hag hmag ι κ j (avoidsE_occ (rnE_v he) hj))\n\ntheorem sr_cond {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {c : C} (hc : readsNone r.IV r.IM c = true) :\n    evalC (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 (withCarried r.spec Ms κ) c\n      = evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substC r.wit c) := by\n  rw [subst_evalC, congrMC _ _ (withCarried r.full M κ) c (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMaps_occ (rn_m hc) hmp))]\n  exact congrC _ _ _ c (fun j hj => sr_view r hok hag hmag ι κ j (avoids_occ (rn_v hc) hj))\n\ntheorem sr_term_upd {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : readsNoneE r.IV r.IM e = true) {k : Nat} (hk : k ∈ bkeys r.spec) (key : Nat) :\n    evalE (upd (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 k key) (withCarried r.spec Ms κ) e\n      = evalE (upd (sView r.full ρ M ι κ).1 k key) (withCarried r.full M κ) (substE r.wit e) := by\n  obtain ⟨_, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hkdom : k ∉ r.wit.map (·.1) := sr_wdom r hok (fun h' => hsi k h' (List.mem_append_right _ (by simp only [SRefined.SV, List.mem_append]; right; exact hk)))\n  rw [subst_evalE, congrME _ _ (withCarried r.full M κ) e (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMapsE_occ (rnE_m he) hmp))]\n  apply congrE; intro j hj\n  by_cases hjk : j = k\n  · subst hjk; rw [applyS_other hkdom]; simp [upd]\n  · have hv := sr_view r hok hag hmag ι κ j (avoidsE_occ (rnE_v he) hj)\n    simp only [upd, hjk, if_false]\n    rw [hv]\n    simp only [applyS]\n    cases ha : assoc r.wit j with\n    | none => simp [upd, hjk]\n    | some e' =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      exact (sr_wit_upd r hok (hwit _ hm).2 hk key).symm\n\n-- A variable none of the names the composite's view sets, nor the spec's: each view reads it as its state does.\ntheorem sr_plain_full {ρ : Nat → Nat} {M : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {v : Nat} (hv : v ∉ r.X) :\n    (sView r.full ρ M ι κ).1 v = ρ v := by\n  simp only [SRefined.X, SRefined.IV, List.mem_append, not_or] at hv\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨hi, _⟩, _⟩, hf⟩, hq⟩, _⟩, hsf⟩, hsq⟩, _⟩ := hv\n  simp only [sView]\n  rw [decide_other (fun h' => by\n    simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact hf h'\n    · exact hsf (by simpa [flagVars, Function.comp_def] using h'))]\n  rw [decideQ_other (fun h' => by\n    simp only [SMachine.qVars, sfull_qflags, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact hq h'\n    · exact hsq (by simpa [SMachine.qVars, Function.comp_def] using h')), sfull_inputs]\n  exact withInputs_other hi ρ ι\n\ntheorem sr_plain_spec {σ : Nat → Nat} {Ms : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {v : Nat} (hv : v ∉ r.X) :\n    (sView r.spec σ Ms ι κ).1 v = σ v := by\n  simp only [SRefined.X, List.mem_append, not_or] at hv\n  obtain ⟨⟨⟨_, hsf⟩, hsq⟩, hsi⟩ := hv\n  simp only [sView]\n  rw [decide_other hsf, decideQ_other hsq]\n  exact withInputs_other hsi σ ι\n\n/-- The spec's part of every reachable state of the composite is a reachable state of the spec, given that the spec's\nprecondition holds at every reachable state of the composite (one of its laws) and that, at every step the composite\ntakes, the spec stutters or allows the request it is sent (its step law). -/\ntheorem srefine_project (hpre : ∀ ρ M, SReach r.full ρ M → evalC ρ M r.spec.f.m.pre = true)\n    (hallow : ∀ ρ M, SReach r.full ρ M → ∀ ι κ, evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 r.full.f.m.assume = true →\n      evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 (.or r.stutter (substC r.wit r.spec.f.m.assume)) = true) :\n    ∀ {ρ M}, SReach r.full ρ M → ∃ σ Ms, SReach r.spec σ Ms ∧ Agree r.X σ ρ ∧ ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp := by\n  obtain ⟨hsa, _, hss, _, hsw, hse, _, hsp, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨_, _, _, _, hcarO, _, hst, _, hsfacts⟩ := srNames_parts (sr_names r hok)\n  have hIVst : ∀ v, v ∉ r.IV → v ∉ r.impl.f.m.step.map (·.1) := fun v hv h' => hv (by simp only [SRefined.IV, List.mem_append]; left; left; left; right; exact h')\n  -- A map of the spec's part, unwritten by the implementation, read where the request carries none: the state's.\n  have hNc : ∀ (M : Nat → Nat → Nat) (κ : Nat → Nat → Nat) mp, mp ∉ r.IM → mp ∉ r.spec.carried → withCarried r.full M κ mp = M mp := fun M κ mp h1 h2 => by\n    show (if r.impl.carried.contains mp = true then κ mp else M mp) = M mp\n    rw [if_neg (fun hc => h1 (by\n      simp only [SRefined.IM, List.mem_append, List.mem_filter]; right\n      exact ⟨List.contains_iff_mem.mp hc, by simpa [List.contains_iff_mem] using h2⟩))]\n  have hIMe : ∀ mp, mp ∉ r.IM → lookup (fun w => w.1 == mp) r.impl.every = none := fun mp h => lookup_none (fun w hw => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; right; rw [← he]; exact List.mem_map_of_mem hw))\n  have hIMw : ∀ mp, mp ∉ r.IM → lookup (fun w : Nat × E × E => w.1 == mp) r.impl.f.m.writes = none := fun mp h => lookup_none (fun w hw => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; left; right; rw [← he]; exact List.mem_map_of_mem hw))\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 _ _ =>\n    have hp0 : evalC ρ M r.spec.f.m.pre = true := by\n      have h := hpre _ M (SReach.start ρ M hM h0 (fun l hl => by simp [SRefined.full] at hl) (fun p hp => by simp [SRefined.full] at hp))\n      have hag0 : ∀ i, occC i r.spec.f.m.pre = true → applyS r.full.f.m.init ρ M i = ρ i := fun i hi => applyS_other (fun h' => by\n        apply avoids_occ (rn_v hsp) hi\n        rw [sfull_init] at h'\n        simp only [List.map_append, List.mem_append] at h'\n        rcases h' with h' | h' <;> simp [SRefined.X, SRefined.IV, SRefined.SV, h']) ρ M\n      rwa [congrC _ ρ M r.spec.f.m.pre hag0] at h\n    have hMs : StartMaps r.spec.f.m M := fun p hp' key => hM p (by rw [sfull_maps0]; exact List.mem_append_right _ hp') key\n    refine ⟨_, M, SReach.start ρ M hMs hp0 (fun l hl => by simp [hsfacts] at hl) (fun p hp => by simp [sr_pfacts r hok] at hp), fun i hi => ?_, fun _ _ _ => rfl⟩\n    show applyS r.spec.f.m.init ρ M i = applyS (r.impl.f.m.init ++ r.spec.f.m.init) ρ M i\n    rw [applyS_append_right (fun h' => hi (by simp [SRefined.X, SRefined.IV, h']))]\n  | step ρ M ι κ hr ha ih =>\n    obtain ⟨σ, Ms, hrs, hag, hmag⟩ := ih\n    have hA := hallow ρ M hr ι κ ha\n    simp only [evalC, Bool.or_eq_true, sView_snd] at hA\n    -- The composite's step at a variable of the spec's part: kept where it stutters, the spec's term otherwise.\n    have hstepS : ∀ v, v ∉ r.IV → (sNext r.full ρ M ι κ).1 v\n        = applyS (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))) (sView r.full ρ M ι κ).1 (withCarried r.full M κ) v :=\n      fun v hv => by simp only [sNext]; rw [sfull_step]; exact applyS_append_right (hIVst v hv) _ _\n    have hstutK : ∀ k ∈ bkeys r.spec, ∀ key, evalC (upd (sView r.full ρ M ι κ).1 k key) (withCarried r.full M κ) r.stutter\n        = evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter := fun k hk key => by\n      apply congrC; intro j hj; simp only [upd]; split\n      · rename_i h; subst h; exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk) (avoids_occ hst hj)\n      · rfl\n    by_cases hstut : evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = true\n    · -- The spec doesn't step: its state is the same, and so is the composite's spec part.\n      refine ⟨σ, Ms, hrs, fun v hv => ?_, fun mp hmp hmc => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h'))))]\n        simp only [applyS]\n        cases hl : assoc (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))) v with\n        | none => dsimp only; rw [sr_plain_full r hok ι κ hv]; exact hag v hv\n        | some e =>\n          obtain ⟨q, hq, hqv, rfl⟩ : ∃ q ∈ r.spec.f.m.step, q.1 = v ∧ e = E.ite r.stutter (.var q.1) (substE r.wit q.2) := by\n            simp only [assoc, Option.map_eq_some_iff] at hl\n            obtain ⟨x, hx, rfl⟩ := hl\n            obtain ⟨hxm, hxv⟩ := lookup_some hx\n            obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hxm\n            simp only [beq_iff_eq] at hxv\n            exact ⟨q, hq, hxv, rfl⟩\n          dsimp only\n          simp only [evalE, hstut, if_true]\n          rw [hqv, sr_plain_full r hok ι κ hv]; exact hag v hv\n      · funext key\n        rw [hmag mp hmp hmc]\n        simp only [sNext, everyMaps, sView_snd]\n        rw [sfull_every, lookup_append, hIMe mp hmp]\n        simp only [lookup_emap]\n        cases hw : lookup (fun w => w.1 == mp) r.spec.every with\n        | some w =>\n          have hwm := (lookup_some hw).2\n          simp only [beq_iff_eq] at hwm\n          have hk : w.2.1 ∈ bkeys r.spec := by simp only [bkeys, List.mem_append]; left; exact List.mem_map_of_mem (lookup_some hw).1\n          simp only [Option.map_some, evalE]\n          rw [hstutK _ hk key]\n          simp only [hstut, if_true, upd, hwm, hNc M κ mp hmp hmc]\n        | none =>\n          simp only [Option.map_none, writeMaps]\n          rw [sfull_writes, lookup_append, hIMw mp hmp]\n          try dsimp only\n          rw [lookup_writes_map]\n          cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.f.m.writes with\n          | none => simp only [Option.map_none]; exact (congrFun (hNc M κ mp hmp hmc) key).symm\n          | some w0 =>\n            have hw0m := (lookup_some hw0).2\n            simp only [beq_iff_eq] at hw0m\n            simp only [Option.map_some, evalE, hstut, if_true, hw0m]\n            by_cases hk : key = evalE (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substE r.wit w0.2.1)\n            · rw [if_pos hk, ← hk]; exact (congrFun (hNc M κ mp hmp hmc) _).symm\n            · rw [if_neg hk]; exact (congrFun (hNc M κ mp hmp hmc) key).symm\n    · -- The spec steps, sent the witness's request, which it allows.\n      have hX := hA.resolve_left hstut\n      rw [← sr_cond r hok hag hmag ι κ (c := r.spec.f.m.assume) hsa] at hX\n      refine ⟨_, _, SReach.step σ Ms _ κ hrs hX, fun v hv => ?_, fun mp hmp hmc => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h'))))]\n        simp only [sNext, applyS, sView_snd]\n        rw [assoc_map_fst]\n        cases hl : lookup (fun q => q.1 == v) r.spec.f.m.step with\n        | none =>\n          have hn : assoc r.spec.f.m.step v = none := by simp only [assoc, hl, Option.map_none]\n          rw [hn]; dsimp only\n          rw [sr_plain_full r hok ι κ hv, sr_plain_spec r hok _ κ hv]; exact hag v hv\n        | some q =>\n          have hq := lookup_some hl\n          simp only [beq_iff_eq] at hq\n          have hn : assoc r.spec.f.m.step v = some q.2 := by simp only [assoc, hl, Option.map_some]\n          rw [hn]; dsimp only\n          simp only [Option.map_some, evalE, show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n          have hm : (v, q.2) ∈ r.spec.f.m.step := by rw [← hq.2]; exact hq.1\n          exact sr_term r hok hag hmag ι κ (hss (v, q.2) hm)\n      · funext key\n        simp only [sNext, everyMaps, sView_snd]\n        rw [sfull_every, lookup_append, hIMe mp hmp]\n        simp only [lookup_emap]\n        cases hw : lookup (fun w => w.1 == mp) r.spec.every with\n        | some w =>\n          have hk : w.2.1 ∈ bkeys r.spec := by simp only [bkeys, List.mem_append]; left; exact List.mem_map_of_mem (lookup_some hw).1\n          simp only [Option.map_some, evalE]\n          rw [hstutK _ hk key]\n          simp only [show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n          exact sr_term_upd r hok hag hmag ι κ (hse w (lookup_some hw).1) hk key\n        | none =>\n          simp only [Option.map_none, writeMaps]\n          rw [sfull_writes, lookup_append, hIMw mp hmp]\n          try dsimp only\n          rw [lookup_writes_map]\n          cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.f.m.writes with\n          | none => simp only [Option.map_none]; exact congrFun (sr_maps r hok hmag κ mp hmp) key\n          | some w0 =>\n            obtain ⟨h1, h2⟩ := hsw w0 (lookup_some hw0).1\n            simp only [Option.map_some, evalE, show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n            rw [sr_term r hok hag hmag ι κ h1, sr_term r hok hag hmag ι κ h2, sr_maps r hok hmag κ mp hmp]\nend sproject\n\n-- The composite's step law: on every request it takes, the spec stutters or allows the request it is sent.\ndef srStep (r : SRefined) (prime primeMaps : List (Nat × Nat)) (p : SProof) : SKStep :=\n  ⟨⟨[trueC], r.allowed, [[]], prime, primeMaps, p.1, (p.2.2.2.2.2.1, p.2.2.2.2.2.2.2)⟩, [[]], p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2.1, p.2.2.2.2.2.2.1, []⟩\n\n/-- What a refinement over sets means: with the relation (and the spec's precondition, the j-th law) proven of the\ncomposite, and its step law that the spec stutters or allows every request it is sent, every reachable state of the\nimplementation is, outside the spec's part, a reachable state of the composite, whose spec part is a reachable state of\nthe spec, the two related by every law. -/\ntheorem srefines (r : SRefined) (hok : srOk r = true) (hmo : distinct (r.spec.f.m.maps0.map (·.1)) = true) (ps : List SEntry)\n    (hl : checkSMachine r.full ps = true)\n    (j : Nat) (hj : (ps[j]?).map (·.law.holds) = some r.spec.f.m.pre ∧ (ps[j]?).map (·.law.key) = some none)\n    (prime primeMaps : List (Nat × Nat)) (p : SProof) (hs : checkSKStep r.full ps (srStep r prime primeMaps p) = true)\n    (hfresh : avoids (prime.map (·.2)) r.allowed = true ∧ avoidsMaps (primeMaps.map (·.2)) r.allowed = true)\n    (hw : avoids r.full.wVars r.allowed = true) (hiq : r.full.f.m.inputs.all (fun i => !r.full.qVars.contains i) = true) :\n    ∀ ρ M, SReach r.impl ρ M → ∃ ρc Mc σ Ms, SReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ (∀ mp, mp ∉ r.SM → Mc mp = M mp)\n      ∧ SReach r.spec σ Ms ∧ Agree r.X σ ρc ∧ (∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = Mc mp) ∧ ∀ e ∈ ps, e.Holds ρc Mc := by\n  have hlaws := smachine_sound r.full ps hl\n  have hpre : ∀ ρ M, SReach r.full ρ M → evalC ρ M r.spec.f.m.pre = true := by\n    intro ρ M hr\n    cases he : ps[j]? with\n    | none => simp [he] at hj\n    | some e =>\n      simp only [he, Option.map_some, Option.some.injEq] at hj\n      have h := SEntry.holds_law (hlaws ρ M hr e (List.mem_of_getElem? he))\n      unfold MLaw.Holds at h\n      rw [hj.2] at h\n      simpa [hj.1] using h\n  have hiq' : ∀ i, i ∈ r.full.f.m.inputs → i ∉ r.full.qVars := fun i hi hq => by\n    simp only [List.all_eq_true, Bool.not_eq_true'] at hiq\n    have := hiq i hi; rw [List.contains_iff_mem.mpr hq] at this; cases this\n  have hallow : ∀ ρ M, SReach r.full ρ M → ∀ ι κ, evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 r.full.f.m.assume = true →\n      evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 (.or r.stutter (substC r.wit r.spec.f.m.assume)) = true := by\n    intro ρ M hr ι κ hA\n    have h := skstep_sound r.full ps _ hl hs ρ M hr (ι, κ) [] rfl ⟨hA, by simp [trueC, evalC, evalE], trivial⟩\n    have h' : evalC (primed prime (sNext r.full ρ M ι κ).1 (withExt r.full ρ (sReq r.full ρ M ι κ)))\n        (primedMaps primeMaps (sNext r.full ρ M ι κ).2 (withCarried r.full M κ)) r.allowed = true := by\n      simpa [srStep, sEnd, sExts, renEnv, renMaps, lookup] using h\n    rw [unprimed_evalC hfresh.1 hfresh.2] at h'\n    -- The request's extended variables, read as the step reads them: the inputs, and each quantified flag decided.\n    have hE : ∀ v, v ∉ r.full.wVars → withExt r.full ρ (sReq r.full ρ M ι κ) v\n        = decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ) v := by\n      intro v hv\n      simp only [withExt, sReq]\n      by_cases hi : v ∈ r.full.f.m.inputs\n      · have hext : r.full.extVars.contains v = true := List.contains_iff_mem.mpr (by simp [SMachine.extVars, hi])\n        rw [decideQ_other (hiq' v hi)]\n        simp only [hext, if_true, List.contains_iff_mem.mpr hi, withInputs]\n      · have hin : r.full.f.m.inputs.contains v = false := by simpa [List.contains_iff_mem] using hi\n        by_cases hq : v ∈ r.full.qVars\n        · have hext : r.full.extVars.contains v = true := List.contains_iff_mem.mpr (by simp [SMachine.extVars, hq])\n          obtain ⟨q, hq0, rfl⟩ := List.mem_map.mp hq\n          cases hl : lookup (fun q' => q'.1 == q.1) r.full.qflags with\n          | none => have := lookup_none_all hl q hq0; simp at this\n          | some q' => simp only [hext, if_true, hin, Bool.false_eq_true, if_false, hl]\n        · have hext : r.full.extVars.contains v = false := by\n            simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, not_or]\n            simpa [List.contains_iff_mem] using (⟨hi, hq, hv⟩ : v ∉ r.full.f.m.inputs ∧ v ∉ r.full.qVars ∧ v ∉ r.full.wVars)\n          rw [decideQ_other hq, withInputs_other hi]\n          simp only [hext, Bool.false_eq_true, if_false]\n    rw [congrC _ _ _ r.allowed (fun i hi => hE i (avoids_occ hw hi))] at h'\n    simp only [SRefined.allowed] at h'\n    rw [inline_evalC] at h'\n    exact h'\n  intro ρ M hr\n  obtain ⟨ρc, Mc, hrc, hag, hmag⟩ := srefine_lift r hok hmo hr\n  obtain ⟨σ, Ms, hrs, hags, hmags⟩ := srefine_project r hok hpre hallow hrc\n  exact ⟨ρc, Mc, σ, Ms, hrc, hag, hmag, hrs, hags, hmags, hlaws ρc Mc hrc⟩\n\nend Kern\n\n#print axioms Kern.srefine_lift\n#print axioms Kern.srefine_project\n#print axioms Kern.srefines\n",
+    "Bridge.lean": "import Sets\nimport Cyclic\n\n/-!\nBridge: a cyclic proof of one of today's rules is a proof about the rule. Lean 4.34.0, core only, on top of\n`Sets.lean` and `Cyclic.lean`.\n\n`cyclic_sound` says what a cyclic proof's nodes say about any maps that meet its facts. core/cyclic.ts's instances say a\nrule in those terms, and this file says them back: what an instance's facts and nodes are is a function of the rule's\nown syntax here, a check (`cycMOk`) compares the exported proof against it, and a theorem carries the node to the rule's\nown meaning.\n\nMachines (`machineNodes`). A run of an `SMachine` (Sets.lean's `SReach`, with no flag that holds at every key) is put\nas maps over time: each state variable and input x as a map x@ whose cell u is x's value at time u (an input, the\nrequest taken at u), each map M (and each map a request carries) as a map M@ whose cell u + k·Ω is M's cell k at time u,\nΩ above the run's length T, so that u < Ω and the pair decodes (u = (u + k·Ω) % Ω, k = (u + k·Ω) / Ω) at every key k.\nThe facts are the start and each step (flags inlined), each map's start and step (a write at one key read at the key\nthe fact names), the functions' facts, and conditions that hold of every natural (`natC`). `cyc_machine_sound`: if the\nexported facts are among those, the node's hypotheses among the precondition, t ≤ T and T < Ω, and its conclusion the\nlaw at time t, then the law holds in every reachable state, at every value of its keys.\n-/\n\nnamespace Kern\nset_option linter.unusedSimpArgs false\nset_option linter.unusedSectionVars false\n\n/-! Lists and terms -/\n\ntheorem not_mem_of_not_contains {l : List Nat} {a : Nat} (h : (!l.contains a) = true) : a ∉ l := fun hm => by\n  rw [List.contains_iff_mem.mpr hm] at h; exact absurd h (by decide)\n\n-- A condition true of every natural: 0 ≤ e, and conjunctions of those.\ndef natC : C → Bool\n  | .le a _ => beqE a (.const 0)\n  | .and a b => natC a && natC b\n  | _ => false\n\ntheorem natC_true {ρ : Nat → Nat} {M : Nat → Nat → Nat} : ∀ c, natC c = true → evalC ρ M c = true\n  | .le a b, h => by simp only [natC] at h; rw [beqE_eq h]; simp [evalC, evalE]\n  | .and a b, h => by\n    simp only [natC, Bool.and_eq_true] at h; simp only [evalC, natC_true a h.1, natC_true b h.2, Bool.and_self]\n  | .lt _ _, h => by simp [natC] at h\n  | .eq _ _, h => by simp [natC] at h\n  | .or _ _, h => by simp [natC] at h\n  | .not _, h => by simp [natC] at h\n\n-- A list of conditions as their conjunction, as TypeScript's `and` and the exporter write it.\ndef andL : List C → C\n  | [] => trueC\n  | [a] => a\n  | a :: b :: rest => .and a (andL (b :: rest))\n\ntheorem andL_true {ρ : Nat → Nat} {M : Nat → Nat → Nat} : ∀ l : List C, (∀ c ∈ l, evalC ρ M c = true) → evalC ρ M (andL l) = true\n  | [], _ => by simp [andL, trueC, evalC, evalE]\n  | [a], h => by simpa [andL] using h a (by simp)\n  | a :: b :: rest, h => by\n    simp only [andL, evalC, Bool.and_eq_true]\n    exact ⟨h a (by simp), andL_true (b :: rest) (fun c hc => h c (List.mem_cons_of_mem _ hc))⟩\n\ntheorem evalE_ite_eq (ρ : Nat → Nat) (M : Nat → Nat → Nat) (a b t f : E) :\n    evalE ρ M (.ite (.eq a b) t f) = if evalE ρ M a = evalE ρ M b then evalE ρ M t else evalE ρ M f := by\n  show (if evalC ρ M (.eq a b) = true then evalE ρ M t else evalE ρ M f) = _\n  by_cases h : evalE ρ M a = evalE ρ M b\n  · rw [if_pos ((evalC_iff ρ M (.eq a b)).mpr h), if_pos h]\n  · rw [if_neg (fun hc => h ((evalC_iff ρ M (.eq a b)).mp hc)), if_neg h]\n\ntheorem impl_true {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : C} (h : evalC ρ M a = true → evalC ρ M b = true) :\n    evalC ρ M (.or (.not a) b) = true := by\n  cases ha : evalC ρ M a with\n  | false => simp [evalC, ha]\n  | true => simp [evalC, ha, h ha]\n\ntheorem congr2E {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (e : E) (hv : ∀ i, occE i e = true → ρ i = ρ' i)\n    (hm : ∀ m, occME m e = true → M m = M' m) : evalE ρ M e = evalE ρ' M' e := by\n  rw [congrE ρ ρ' M e hv, congrME ρ' M M' e hm]\ntheorem congr2C {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (c : C) (hv : ∀ i, occC i c = true → ρ i = ρ' i)\n    (hm : ∀ m, occMC m c = true → M m = M' m) : evalC ρ M c = evalC ρ' M' c := by\n  rw [congrC ρ ρ' M c hv, congrMC ρ' M M' c hm]\n\n-- Every read at the term `fr` read at `to` instead (core/cyclic.ts's readsAt): the same wherever the two are equal.\nmutual\ndef readsAtE (fr to : E) : E → E\n  | .var i => .var i\n  | .const n => .const n\n  | .add a b => .add (readsAtE fr to a) (readsAtE fr to b)\n  | .sub a b => .sub (readsAtE fr to a) (readsAtE fr to b)\n  | .mul k a => .mul k (readsAtE fr to a)\n  | .min a b => .min (readsAtE fr to a) (readsAtE fr to b)\n  | .max a b => .max (readsAtE fr to a) (readsAtE fr to b)\n  | .prod a b => .prod (readsAtE fr to a) (readsAtE fr to b)\n  | .ite c t f => .ite (readsAtC fr to c) (readsAtE fr to t) (readsAtE fr to f)\n  | .get m key => if beqE key fr then .get m to else .get m (readsAtE fr to key)\ndef readsAtC (fr to : E) : C → C\n  | .le a b => .le (readsAtE fr to a) (readsAtE fr to b)\n  | .lt a b => .lt (readsAtE fr to a) (readsAtE fr to b)\n  | .eq a b => .eq (readsAtE fr to a) (readsAtE fr to b)\n  | .and a b => .and (readsAtC fr to a) (readsAtC fr to b)\n  | .or a b => .or (readsAtC fr to a) (readsAtC fr to b)\n  | .not a => .not (readsAtC fr to a)\nend\n\nsection\nvariable {ρ : Nat → Nat} {M : Nat → Nat → Nat} {fr to : E} (h : evalE ρ M to = evalE ρ M fr)\ninclude h\nmutual\ntheorem readsAt_evalE : (e : E) → evalE ρ M (readsAtE fr to e) = evalE ρ M e\n  | .var _ => rfl\n  | .const _ => rfl\n  | .add a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .sub a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .mul k a => by simp only [readsAtE, evalE, readsAt_evalE a]\n  | .min a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .max a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .prod a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .ite c t f => by simp only [readsAtE, evalE, readsAt_evalC c, readsAt_evalE t, readsAt_evalE f]\n  | .get m key => by\n    simp only [readsAtE]\n    split\n    · rename_i hb; simp only [evalE, h, beqE_eq hb]\n    · simp only [evalE, readsAt_evalE key]\ntheorem readsAt_evalC : (c : C) → evalC ρ M (readsAtC fr to c) = evalC ρ M c\n  | .le a b => by simp only [readsAtC, evalC, readsAt_evalE a, readsAt_evalE b]\n  | .lt a b => by simp only [readsAtC, evalC, readsAt_evalE a, readsAt_evalE b]\n  | .eq a b => by simp only [readsAtC, evalC, readsAt_evalE a, readsAt_evalE b]\n  | .and a b => by simp only [readsAtC, evalC, readsAt_evalC a, readsAt_evalC b]\n  | .or a b => by simp only [readsAtC, evalC, readsAt_evalC a, readsAt_evalC b]\n  | .not a => by simp only [readsAtC, evalC, readsAt_evalC a]\nend\nend\n\ntheorem applyS_getD (σ : List (Nat × E)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    applyS σ ρ M i = evalE ρ M ((assoc σ i).getD (.var i)) := by\n  simp only [applyS]; cases assoc σ i <;> rfl\n\ntheorem assoc_some_mem {σ : List (Nat × E)} {i : Nat} {e : E} (h : assoc σ i = some e) : (i, e) ∈ σ := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨p, hp, rfl⟩ := h\n  obtain ⟨hm, hq⟩ := lookup_some hp\n  have : p.1 = i := by simpa using hq\n  rw [← this]; exact hm\n\ntheorem pair_mod {u T : Nat} (h : u ≤ T) (kv : Nat) : (u + kv * (T + 1)) % (T + 1) = u := by\n  rw [Nat.add_mul_mod_self_right]; exact Nat.mod_eq_of_lt (by omega)\ntheorem pair_div {u T : Nat} (h : u ≤ T) (kv : Nat) : (u + kv * (T + 1)) / (T + 1) = kv := by\n  rw [Nat.add_mul_div_right _ _ (by omega), Nat.div_eq_of_lt (by omega), Nat.zero_add]\n\n/-! The encoding (core/cyclic.ts's machineNodes) as a function of the machine -/\n\n-- The variables a machine's facts and nodes add (a fact's time and key, the run's length, Ω, a node's time), and the\n-- maps over time: each state variable and input's, each map's.\nstructure CycEnc where\n  u : Nat\n  k : Nat\n  T : Nat\n  om : Nat\n  t : Nat\n  vtr : List (Nat × Nat)\n  mtr : List (Nat × Nat)\n\ndef CycEnc.special (ce : CycEnc) : List Nat := [ce.u, ce.k, ce.T, ce.om, ce.t]\ndef CycEnc.tm (ce : CycEnc) : List Nat := ce.vtr.map (·.2) ++ ce.mtr.map (·.2)\n\n-- A term at time w: each state variable and input read from its map at w, each map's cell k from its map at w + k·Ω.\ndef cycσ (ce : CycEnc) (w : E) : List (Nat × E) := ce.vtr.map fun p => (p.1, .get p.2 w)\ndef cycRd (ce : CycEnc) (w : E) : Nat → E → E := fun m key =>\n  match lookup (fun p => p.1 == m) ce.mtr with\n  | some p => .get p.2 (.add w (.prod key (.var ce.om)))\n  | none => .get m key\ndef trE (ce : CycEnc) (w : E) : E → E := substRE (cycσ ce w) (cycRd ce w)\ndef trC (ce : CycEnc) (w : E) : C → C := substRC (cycσ ce w) (cycRd ce w)\n\ndef cycStepped (ce : CycEnc) : C := .and (.le (.const 1) (.var ce.u)) (.le (.var ce.u) (.var ce.T))\ndef cycPrev (ce : CycEnc) : E := .sub (.var ce.u) (.const 1)\ndef cycCell (ce : CycEnc) (m : Nat) (w : E) : E := cycRd ce w m (.var ce.k)\ndef cycStepTerm (s : SMachine) (x : Nat) : E := (assoc s.f.m.step x).getD (.var x)\n\ndef cycStart (s : SMachine) (ce : CycEnc) : Fact :=\n  ⟨[ce.u], .or (.not (.le (.var ce.u) (.const 0))) (andL (trueC :: s.f.m.init.map fun p => .eq (trE ce (.var ce.u) (.var p.1)) p.2))⟩\ndef cycStep (s : SMachine) (ce : CycEnc) (withAssume : Bool) : Fact :=\n  ⟨[ce.u], .or (.not (cycStepped ce)) (andL (trueC :: ((if withAssume then [trC ce (cycPrev ce) (inlineC s.f.flags s.f.m.assume)] else [])\n    ++ s.f.m.init.map fun p => .eq (trE ce (.var ce.u) (.var p.1)) (trE ce (cycPrev ce) (inlineE s.f.flags (cycStepTerm s p.1))))))⟩\n-- A map's cell k after a step: a write at every key, its value at k; a write at one key, where k is the key, its value\n-- read at k; else the cell before.\ndef cycNext (s : SMachine) (ce : CycEnc) (m : Nat) : E :=\n  match lookup (fun w => w.1 == m) s.every with\n  | some w => trE ce (cycPrev ce) (inlineE s.f.flags (substE [(w.2.1, .var ce.k)] w.2.2))\n  | none => match lookup (fun w => w.1 == m) s.f.m.writes with\n    | some w => .ite (.eq (.var ce.k) (trE ce (cycPrev ce) (inlineE s.f.flags w.2.1)))\n        (trE ce (cycPrev ce) (readsAtE (inlineE s.f.flags w.2.1) (.var ce.k) (inlineE s.f.flags w.2.2))) (cycCell ce m (cycPrev ce))\n    | none => cycCell ce m (cycPrev ce)\ndef cycMapFacts (s : SMachine) (ce : CycEnc) : List Fact := s.f.m.maps0.flatMap fun p =>\n  [⟨[ce.u, ce.k], .or (.not (.le (.var ce.u) (.const 0))) (.eq (cycCell ce p.1 (.var ce.u)) (.const p.2))⟩,\n   ⟨[ce.u, ce.k], .or (.not (cycStepped ce)) (.eq (cycCell ce p.1 (.var ce.u)) (cycNext s ce p.1))⟩]\n-- The functions' facts, each with its further keys.\ndef cycGiven (s : SMachine) : List (MLaw × List Nat) := s.facts.map (fun l => (l, [])) ++ s.pfacts\ndef cycFnFacts (s : SMachine) : List Fact := (cycGiven s).map fun p => ⟨p.1.key.toList ++ p.2, p.1.holds⟩\n-- The step with the assumption and without it (core/cyclic.ts leaves it out when the machine has none).\ndef cycCanon (s : SMachine) (ce : CycEnc) : List Fact :=\n  cycStart s ce :: cycStep s ce true :: cycStep s ce false :: (cycMapFacts s ce ++ cycFnFacts s)\n\n/-! The check -/\n\ndef cycZ (ce : CycEnc) (keys : List Nat) : List Nat := ce.special ++ keys\ndef cycP (s : SMachine) (ce : CycEnc) (keys : List Nat) : List Nat := cycZ ce keys ++ ce.vtr.map (·.1) ++ flagVars s.f.flags\n\n-- The encoding fits the machine: every variable a step changes has its map over time, every map a step or a request\n-- changes has its own, those maps are fresh, and the added variables are apart from the machine's.\ndef cycShapeOk (s : SMachine) (ce : CycEnc) (keys : List Nat) : Bool :=\n  s.qflags.isEmpty && flagsOk s.f.flags && distinct ce.special && distinct ce.tm\n    && (cycZ ce keys).all (fun z => !(ce.vtr.map (·.1)).contains z && !(flagVars s.f.flags).contains z)\n    && keys.all (fun z => !ce.special.contains z)\n    && ce.tm.all (fun m => !(ce.mtr.map (·.1)).contains m)\n    && s.f.m.init.all (fun p => (ce.vtr.map (·.1)).contains p.1 && !s.f.m.inputs.contains p.1)\n    && s.f.m.step.all (fun p => (ce.vtr.map (·.1)).contains p.1)\n    && s.f.m.inputs.all (fun x => (ce.vtr.map (·.1)).contains x)\n    && distinct (s.f.m.init.map (·.1))\n    && s.f.m.maps0.all (fun p => (ce.mtr.map (·.1)).contains p.1 && !s.carried.contains p.1)\n    && s.carried.all (fun m => (ce.mtr.map (·.1)).contains m)\n    && s.f.m.writes.all (fun w => (ce.mtr.map (·.1)).contains w.1)\n    && s.every.all (fun w => (ce.mtr.map (·.1)).contains w.1)\n\n-- The machine's terms read none of the added variables nor the maps over time; what is read at the start (the start\n-- terms, the precondition, the functions' facts) reads no variable a step changes either.\ndef cycTermsOk (s : SMachine) (ce : CycEnc) (keys : List Nat) : Bool :=\n  s.f.flags.all (fun p => avoids (cycZ ce keys) p.2 && avoidsMaps ce.tm p.2)\n    && s.f.m.step.all (fun p => avoidsE (cycZ ce keys) p.2 && avoidsMapsE ce.tm p.2)\n    && s.f.m.writes.all (fun w => avoidsE (cycZ ce keys) w.2.1 && avoidsMapsE ce.tm w.2.1 && avoidsE (cycZ ce keys) w.2.2 && avoidsMapsE ce.tm w.2.2)\n    && s.every.all (fun w => (cycZ ce keys).all (fun z => z == w.2.1 || !occE z w.2.2) && avoidsMapsE ce.tm w.2.2)\n    && avoids (cycZ ce keys) s.f.m.assume && avoidsMaps ce.tm s.f.m.assume\n    && s.f.m.init.all (fun p => avoidsE (cycP s ce keys) p.2 && avoidsMapsE ce.tm p.2)\n    && avoids (cycP s ce keys) s.f.m.pre && avoidsMaps ce.tm s.f.m.pre\n    && (cycGiven s).all (fun g => (cycP s ce keys).all (fun z => g.1.key == some z || g.2.contains z || !occC z g.1.holds)\n      && avoidsMaps ce.tm g.1.holds)\n\n-- The law reads no added variable, no input, no map over time and no map a request carries.\ndef cycLawOk (s : SMachine) (ce : CycEnc) (law : C) : Bool :=\n  avoids (ce.special ++ s.f.m.inputs) law && avoidsMaps (ce.tm ++ s.carried) law\n\ndef factBeq (f g : Fact) : Bool := f.keys == g.keys && beqC f.holds g.holds\n\n-- Each exported fact is one of the encoding's, or true of every natural.\ndef cycFactsIn (s : SMachine) (ce : CycEnc) (facts : List Fact) : Bool :=\n  facts.all fun f => natC f.holds || (cycCanon s ce).any (factBeq f)\n\n-- The node: its conclusion the law at time t, its hypotheses among the precondition, t ≤ T and T < Ω.\ndef cycNodeOk (s : SMachine) (ce : CycEnc) (law : C) (n : CNode) : Bool :=\n  beqC n.concl (trC ce (.var ce.t) law)\n    && n.hyps.all (fun h => beqC h s.f.m.pre || beqC h (.le (.var ce.t) (.var ce.T)) || beqC h (.lt (.var ce.T) (.var ce.om)))\n\ndef cycMOk (s : SMachine) (ce : CycEnc) (facts : List Fact) (law : C) (keys : List Nat) (n : CNode) : Bool :=\n  cycShapeOk s ce keys && cycTermsOk s ce keys && cycLawOk s ce law && cycFactsIn s ce facts && cycNodeOk s ce law n\n\n/-! The checks, as propositions -/\n\ntheorem and_parts {a b : Bool} (h : (a && b) = true) : a = true ∧ b = true := by\n  cases a <;> cases b <;> simp_all\n\ntheorem mem_toList {o : Option Nat} {j : Nat} (h : j ∈ o.toList) : o = some j := by\n  cases o <;> simp_all [Option.toList]\n\ntheorem isEmpty_nil {α : Type} {l : List α} (h : l.isEmpty = true) : l = [] := by\n  cases l\n  · rfl\n  · simp [List.isEmpty] at h\n\nstructure CycShape (s : SMachine) (ce : CycEnc) (keys : List Nat) : Prop where\n  q : s.qflags = []\n  fl : flagsOk s.f.flags = true\n  dsp : distinct ce.special = true\n  dtm : distinct ce.tm = true\n  zv : ∀ z ∈ cycZ ce keys, z ∉ ce.vtr.map (·.1)\n  zf : ∀ z ∈ cycZ ce keys, z ∉ flagVars s.f.flags\n  ks : ∀ z ∈ keys, z ∉ ce.special\n  tmd : ∀ m ∈ ce.tm, m ∉ ce.mtr.map (·.1)\n  initv : ∀ p ∈ s.f.m.init, p.1 ∈ ce.vtr.map (·.1)\n  initin : ∀ p ∈ s.f.m.init, p.1 ∉ s.f.m.inputs\n  stepv : ∀ p ∈ s.f.m.step, p.1 ∈ ce.vtr.map (·.1)\n  inv : ∀ x ∈ s.f.m.inputs, x ∈ ce.vtr.map (·.1)\n  dinit : distinct (s.f.m.init.map (·.1)) = true\n  m0 : ∀ p ∈ s.f.m.maps0, p.1 ∈ ce.mtr.map (·.1)\n  m0c : ∀ p ∈ s.f.m.maps0, p.1 ∉ s.carried\n  carm : ∀ m ∈ s.carried, m ∈ ce.mtr.map (·.1)\n  wrm : ∀ w ∈ s.f.m.writes, w.1 ∈ ce.mtr.map (·.1)\n  evm : ∀ w ∈ s.every, w.1 ∈ ce.mtr.map (·.1)\n\ntheorem cycShape_of {s : SMachine} {ce : CycEnc} {keys : List Nat} (h : cycShapeOk s ce keys = true) : CycShape s ce keys := by\n  simp only [cycShapeOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hq, hfl⟩, hdsp⟩, hdtm⟩, hz⟩, hks⟩, htm⟩, hinit⟩, hstep⟩, hin⟩, hdi⟩, hm0⟩, hcar⟩, hwr⟩, hev⟩ := h\n  have hz' := List.all_eq_true.mp hz\n  have hinit' := List.all_eq_true.mp hinit\n  have hm0' := List.all_eq_true.mp hm0\n  refine ⟨isEmpty_nil hq, hfl, hdsp, hdtm, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, hdi, ?_, ?_, ?_, ?_, ?_⟩\n  · intro z hzm; exact not_mem_of_not_contains (and_parts (hz' z hzm)).1\n  · intro z hzm; exact not_mem_of_not_contains (and_parts (hz' z hzm)).2\n  · intro z hzm; exact not_mem_of_not_contains (List.all_eq_true.mp hks z hzm)\n  · intro m hm; exact not_mem_of_not_contains (List.all_eq_true.mp htm m hm)\n  · intro p hp; exact List.contains_iff_mem.mp (and_parts (hinit' p hp)).1\n  · intro p hp; exact not_mem_of_not_contains (and_parts (hinit' p hp)).2\n  · intro p hp; exact List.contains_iff_mem.mp (List.all_eq_true.mp hstep p hp)\n  · intro x hx; exact List.contains_iff_mem.mp (List.all_eq_true.mp hin x hx)\n  · intro p hp; exact List.contains_iff_mem.mp (and_parts (hm0' p hp)).1\n  · intro p hp; exact not_mem_of_not_contains (and_parts (hm0' p hp)).2\n  · intro m hm; exact List.contains_iff_mem.mp (List.all_eq_true.mp hcar m hm)\n  · intro w hw; exact List.contains_iff_mem.mp (List.all_eq_true.mp hwr w hw)\n  · intro w hw; exact List.contains_iff_mem.mp (List.all_eq_true.mp hev w hw)\n\nstructure CycTerms (s : SMachine) (ce : CycEnc) (keys : List Nat) : Prop where\n  flz : ∀ p ∈ s.f.flags, avoids (cycZ ce keys) p.2 = true\n  flm : ∀ p ∈ s.f.flags, avoidsMaps ce.tm p.2 = true\n  stz : ∀ p ∈ s.f.m.step, avoidsE (cycZ ce keys) p.2 = true\n  stm : ∀ p ∈ s.f.m.step, avoidsMapsE ce.tm p.2 = true\n  wkz : ∀ w ∈ s.f.m.writes, avoidsE (cycZ ce keys) w.2.1 = true\n  wkm : ∀ w ∈ s.f.m.writes, avoidsMapsE ce.tm w.2.1 = true\n  wvz : ∀ w ∈ s.f.m.writes, avoidsE (cycZ ce keys) w.2.2 = true\n  wvm : ∀ w ∈ s.f.m.writes, avoidsMapsE ce.tm w.2.2 = true\n  evz : ∀ w ∈ s.every, ∀ z ∈ cycZ ce keys, z ≠ w.2.1 → occE z w.2.2 = false\n  evm : ∀ w ∈ s.every, avoidsMapsE ce.tm w.2.2 = true\n  asz : avoids (cycZ ce keys) s.f.m.assume = true\n  asm : avoidsMaps ce.tm s.f.m.assume = true\n  inz : ∀ p ∈ s.f.m.init, avoidsE (cycP s ce keys) p.2 = true\n  inm : ∀ p ∈ s.f.m.init, avoidsMapsE ce.tm p.2 = true\n  prz : avoids (cycP s ce keys) s.f.m.pre = true\n  prm : avoidsMaps ce.tm s.f.m.pre = true\n  gz : ∀ g ∈ cycGiven s, ∀ z ∈ cycP s ce keys, g.1.key ≠ some z → z ∉ g.2 → occC z g.1.holds = false\n  gm : ∀ g ∈ cycGiven s, avoidsMaps ce.tm g.1.holds = true\n\ntheorem cycTerms_of {s : SMachine} {ce : CycEnc} {keys : List Nat} (h : cycTermsOk s ce keys = true) : CycTerms s ce keys := by\n  simp only [cycTermsOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨hfl, hst⟩, hw⟩, hev⟩, has⟩, ham⟩, hin⟩, hpz⟩, hpm⟩, hg⟩ := h\n  have hfl' := List.all_eq_true.mp hfl\n  have hst' := List.all_eq_true.mp hst\n  have hw' := List.all_eq_true.mp hw\n  have hev' := List.all_eq_true.mp hev\n  have hin' := List.all_eq_true.mp hin\n  have hg' := List.all_eq_true.mp hg\n  refine ⟨fun p hp => (and_parts (hfl' p hp)).1, fun p hp => (and_parts (hfl' p hp)).2,\n    fun p hp => (and_parts (hst' p hp)).1, fun p hp => (and_parts (hst' p hp)).2,\n    fun w hw => (and_parts (and_parts (and_parts (hw' w hw)).1).1).1, fun w hw => (and_parts (and_parts (and_parts (hw' w hw)).1).1).2,\n    fun w hw => (and_parts (and_parts (hw' w hw)).1).2, fun w hw => (and_parts (hw' w hw)).2,\n    fun w hw z hz hne => ?_, fun w hw => (and_parts (hev' w hw)).2,\n    has, ham, fun p hp => (and_parts (hin' p hp)).1, fun p hp => (and_parts (hin' p hp)).2, hpz, hpm,\n    fun g hg z hz hk hgs => ?_, fun g hg => (and_parts (hg' g hg)).2⟩\n  · have := List.all_eq_true.mp (and_parts (hev' w hw)).1 z hz\n    cases hb : (z == w.2.1)\n    · rw [hb] at this; simpa using this\n    · exact absurd (beq_iff_eq.mp hb) hne\n  · have := List.all_eq_true.mp (and_parts (hg' g hg)).1 z hz\n    have h1 : (g.1.key == some z) = false := by\n      cases hb : (g.1.key == some z)\n      · rfl\n      · exact absurd (beq_iff_eq.mp hb) hk\n    have h2 : g.2.contains z = false := by\n      cases hb : g.2.contains z\n      · rfl\n      · exact absurd (List.contains_iff_mem.mp hb) hgs\n    rw [h1, h2] at this; simpa using this\n\n/-! A run, step by step -/\n\nstructure CRun where\n  ρ0 : Nat → Nat                  -- before the start\n  st : Nat → Nat → Nat            -- the state at each time\n  mp : Nat → Nat → Nat → Nat      -- the maps at each time\n  ι : Nat → Nat → Nat             -- the request taken at each time\n  κ : Nat → Nat → Nat → Nat       -- the maps it carries\n\ndef CRun.N (s : SMachine) (r : CRun) (u : Nat) : Nat → Nat → Nat := withCarried s (r.mp u) (r.κ u)\ndef CRun.X (s : SMachine) (r : CRun) (u : Nat) : Nat → Nat := withInputs s.f.m.inputs (r.st u) (r.ι u)\ndef CRun.V (s : SMachine) (r : CRun) (u : Nat) : Nat → Nat := decideFlags s.f.flags (r.X s u) (r.N s u)\n\n-- A run of T steps from a start SReach allows.\nstructure CRun.Ok (s : SMachine) (r : CRun) (T : Nat) : Prop where\n  maps0 : StartMaps s.f.m (r.mp 0)\n  pre : evalC r.ρ0 (r.mp 0) s.f.m.pre = true\n  facts : ∀ l ∈ s.facts, l.Holds r.ρ0 (r.mp 0)\n  pfacts : s.PFacts r.ρ0 (r.mp 0)\n  init : r.st 0 = applyS s.f.m.init r.ρ0 (r.mp 0)\n  step : ∀ u, u < T → evalC (r.V s u) (r.N s u) s.f.m.assume = true ∧ r.st (u + 1) = applyS s.f.m.step (r.V s u) (r.N s u)\n    ∧ r.mp (u + 1) = everyMaps s (r.V s u) (r.N s u)\n\n-- The run with one more step.\ndef CRun.snoc (r : CRun) (T : Nat) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : CRun :=\n  ⟨r.ρ0, fun u => if u ≤ T then r.st u else ρ, fun u => if u ≤ T then r.mp u else M,\n    fun u => if u < T then r.ι u else ι, fun u => if u < T then r.κ u else κ⟩\n\ntheorem decideQ_nil {s : SMachine} (hq : s.qflags = []) (X : Nat → Nat) (N : Nat → Nat → Nat) : decideQ s X N = X := by\n  funext v; simp only [decideQ, hq, lookup]\n\ntheorem snoc_early {s : SMachine} {r : CRun} {T u : Nat} (hu : u < T) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat)\n    (κ : Nat → Nat → Nat) : (r.snoc T ρ M ι κ).N s u = r.N s u ∧ (r.snoc T ρ M ι κ).V s u = r.V s u\n      ∧ (r.snoc T ρ M ι κ).st (u + 1) = r.st (u + 1) ∧ (r.snoc T ρ M ι κ).mp (u + 1) = r.mp (u + 1) := by\n  have h1 : u ≤ T := Nat.le_of_lt hu\n  have h2 : u + 1 ≤ T := hu\n  refine ⟨?_, ?_, ?_, ?_⟩ <;> simp only [CRun.V, CRun.X, CRun.N, CRun.snoc, if_pos h1, if_pos hu, if_pos h2]\n\ntheorem snoc_zero {r : CRun} {T : Nat} (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (r.snoc T ρ M ι κ).ρ0 = r.ρ0 ∧ (r.snoc T ρ M ι κ).st 0 = r.st 0 ∧ (r.snoc T ρ M ι κ).mp 0 = r.mp 0 := by\n  refine ⟨rfl, ?_, ?_⟩ <;> simp only [CRun.snoc, if_pos (Nat.zero_le T)]\n\ntheorem snoc_last {r : CRun} {T : Nat} (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (r.snoc T ρ M ι κ).st (T + 1) = ρ ∧ (r.snoc T ρ M ι κ).mp (T + 1) = M ∧ (r.snoc T ρ M ι κ).st T = r.st T\n      ∧ (r.snoc T ρ M ι κ).mp T = r.mp T ∧ (r.snoc T ρ M ι κ).ι T = ι ∧ (r.snoc T ρ M ι κ).κ T = κ := by\n  have h1 : ¬ T + 1 ≤ T := by omega\n  have h2 : ¬ T < T := Nat.lt_irrefl T\n  refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ <;> simp only [CRun.snoc, if_neg h1, if_neg h2, if_pos (Nat.le_refl T)]\n\n-- A reachable state is the end of a run (no flag holds at every key).\ntheorem reach_run {s : SMachine} (hq : s.qflags = []) :\n    ∀ {ρ M}, SReach s ρ M → ∃ (r : CRun) (T : Nat), r.Ok s T ∧ r.st T = ρ ∧ r.mp T = M := by\n  intro ρ M h\n  induction h with\n  | start ρ M hM hp hf hpf =>\n    exact ⟨⟨ρ, fun _ => applyS s.f.m.init ρ M, fun _ => M, fun _ => ρ, fun _ => M⟩, 0,\n      ⟨hM, hp, hf, hpf, rfl, fun u hu => absurd hu (Nat.not_lt_zero u)⟩, rfl, rfl⟩\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨r, T, hr, hst, hmp⟩ := ih\n    have hv : sView s ρ M ι κ = (decideFlags s.f.flags (withInputs s.f.m.inputs ρ ι) (withCarried s M κ), withCarried s M κ) := by\n      simp only [sView, decideQ_nil hq]\n    obtain ⟨l1, l2, l3, l4, l5, l6⟩ := snoc_last (r := r) (T := T) (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ\n    obtain ⟨z1, z2, z3⟩ := snoc_zero (r := r) (T := T) (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ\n    have hN : (r.snoc T (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ).N s T = (sView s ρ M ι κ).2 := by\n      rw [hv, CRun.N, l4, l6, hmp]\n    have hV : (r.snoc T (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ).V s T = (sView s ρ M ι κ).1 := by\n      rw [CRun.V, hN, CRun.X, l3, l5, hst, hv]\n    refine ⟨r.snoc T (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ, T + 1, ⟨?_, ?_, ?_, ?_, ?_, ?_⟩, l1, l2⟩\n    · rw [z3]; exact hr.maps0\n    · rw [z1, z3]; exact hr.pre\n    · rw [z1, z3]; exact hr.facts\n    · rw [z1, z3]; exact hr.pfacts\n    · rw [z1, z2, z3]; exact hr.init\n    · intro u hu\n      rcases Nat.lt_or_ge u T with hlt | hge\n      · obtain ⟨e1, e2, e3, e4⟩ := snoc_early (s := s) (r := r) hlt (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ\n        rw [e1, e2, e3, e4]; exact hr.step u hlt\n      · have hu' : u = T := by omega\n        rw [hu', hV, hN, l1, l2]\n        exact ⟨ha, rfl, rfl⟩\n\nsection run\nvariable {s : SMachine} {r : CRun} {T : Nat} (hr : r.Ok s T)\ninclude hr\n\n-- What no step changes keeps its value from before the start.\ntheorem run_frame : ∀ u, u ≤ T → ∀ i, i ∉ s.f.m.init.map (·.1) → i ∉ s.f.m.step.map (·.1) → i ∉ s.f.m.inputs →\n    i ∉ flagVars s.f.flags → r.st u i = r.ρ0 i := by\n  intro u\n  induction u with\n  | zero => intro _ i hi _ _ _; rw [hr.init]; exact applyS_other hi _ _\n  | succ u ih =>\n    intro hu i hi hs hin hf\n    rw [(hr.step u (by omega)).2.1, applyS_other hs, CRun.V, decide_other hf, CRun.X, withInputs_other hin]\n    exact ih (by omega) i hi hs hin hf\n\n-- A map no step writes and no request carries keeps its cells.\ntheorem run_maps {D : List Nat} (hc : ∀ m ∈ s.carried, m ∈ D) (hw : ∀ w ∈ s.f.m.writes, w.1 ∈ D) (he : ∀ w ∈ s.every, w.1 ∈ D) :\n    ∀ u, u ≤ T → ∀ m, m ∉ D → r.mp u m = r.mp 0 m := by\n  intro u\n  induction u with\n  | zero => intros; rfl\n  | succ u ih =>\n    intro hu m hm\n    rw [(hr.step u (by omega)).2.2]\n    funext key\n    have hne : lookup (fun w => w.1 == m) s.every = none :=\n      lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro h; exact hm (h ▸ he w hw'))\n    have hnw : lookup (fun w => w.1 == m) s.f.m.writes = none :=\n      lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro h; exact hm (h ▸ hw w hw'))\n    have hnc : ¬ s.carried.contains m = true := fun h => hm (hc m (List.contains_iff_mem.mp h))\n    simp only [everyMaps, hne, writeMaps, hnw, CRun.N, withCarried]\n    rw [if_neg hnc]\n    exact congrFun (ih (by omega) m hm) key\nend run\n\ntheorem N_not_carried {s : SMachine} {r : CRun} {u m : Nat} (hm : m ∉ s.carried) : r.N s u m = r.mp u m := by\n  simp only [CRun.N, withCarried]\n  rw [if_neg (fun h => hm (List.contains_iff_mem.mp h))]\n\n/-! The run as maps over time -/\n\ndef cycMaps (s : SMachine) (ce : CycEnc) (r : CRun) (om : Nat) : Nat → Nat → Nat := fun i =>\n  match lookup (fun p => p.2 == i) ce.vtr with\n  | some p => fun u => r.X s u p.1\n  | none => match lookup (fun p => p.2 == i) ce.mtr with\n    | some p => fun y => r.N s (y % om) p.1 (y / om)\n    | none => r.mp 0 i\n\n-- The maps a step at time u reads, as the encoding gives them: the maps over time as they are, the rest as the run's.\ndef cycView (s : SMachine) (ce : CycEnc) (r : CRun) (om u : Nat) : Nat → Nat → Nat := fun m =>\n  if ce.tm.contains m then cycMaps s ce r om m else r.N s u m\n\n-- The node's environment: t and T the run's length, Ω one above it.\ndef cycEnv (ce : CycEnc) (T : Nat) (ρ' : Nat → Nat) : Nat → Nat := fun i =>\n  if i = ce.t then T else if i = ce.T then T else if i = ce.om then T + 1 else ρ' i\n\n-- An environment a fact is read at: T and Ω as the node's, and from before the start wherever no step reaches.\ndef EnvOk (s : SMachine) (ce : CycEnc) (keys : List Nat) (r : CRun) (T : Nat) (Q : Nat → Nat) : Prop :=\n  Q ce.T = T ∧ Q ce.om = T + 1 ∧ ∀ i, i ∉ cycP s ce keys → Q i = r.ρ0 i\n\nsection enc\nvariable {s : SMachine} {ce : CycEnc} {keys : List Nat} {r : CRun} {T : Nat}\n\ntheorem tm_parts (hd : distinct ce.tm = true) :\n    distinct (ce.vtr.map (·.2)) = true ∧ distinct (ce.mtr.map (·.2)) = true ∧ ∀ a ∈ ce.vtr.map (·.2), a ∉ ce.mtr.map (·.2) :=\n  distinct_append hd\n\ntheorem cm_v (hd : distinct ce.tm = true) {om : Nat} {p : Nat × Nat} (hp : p ∈ ce.vtr) :\n    cycMaps s ce r om p.2 = fun u => r.X s u p.1 := by\n  simp only [cycMaps, lookup_ren (tm_parts hd).1 p hp]\n\ntheorem cm_m (hd : distinct ce.tm = true) {om : Nat} {p : Nat × Nat} (hp : p ∈ ce.mtr) :\n    cycMaps s ce r om p.2 = fun y => r.N s (y % om) p.1 (y / om) := by\n  obtain ⟨_, h2, h3⟩ := tm_parts hd\n  have hn : lookup (fun q => q.2 == p.2) ce.vtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact h3 q.2 (List.mem_map.mpr ⟨q, hq, rfl⟩) (List.mem_map.mpr ⟨p, hp, he.symm⟩))\n  simp only [cycMaps, hn, lookup_ren h2 p hp]\n\ntheorem cm_o {om i : Nat} (hi : i ∉ ce.tm) : cycMaps s ce r om i = r.mp 0 i := by\n  have h1 : lookup (fun q => q.2 == i) ce.vtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact hi (List.mem_append_left _ (List.mem_map.mpr ⟨q, hq, he⟩)))\n  have h2 : lookup (fun q => q.2 == i) ce.mtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact hi (List.mem_append_right _ (List.mem_map.mpr ⟨q, hq, he⟩)))\n  simp only [cycMaps, h1, h2]\n\ntheorem cv_N {om u m : Nat} (hm : m ∉ ce.tm) : cycView s ce r om u m = r.N s u m := by\n  simp only [cycView]\n  rw [if_neg (fun h => hm (List.contains_iff_mem.mp h))]\n\ntheorem notP {i : Nat} (h : i ∉ cycP s ce keys) :\n    i ∉ ce.special ∧ i ∉ keys ∧ i ∉ ce.vtr.map (·.1) ∧ i ∉ flagVars s.f.flags := by\n  simp only [cycP, cycZ, List.mem_append, not_or] at h\n  exact ⟨h.1.1.1, h.1.1.2, h.1.2, h.2⟩\n\ntheorem special_parts (h : distinct ce.special = true) :\n    ce.u ≠ ce.T ∧ ce.u ≠ ce.om ∧ ce.k ≠ ce.T ∧ ce.k ≠ ce.om ∧ ce.T ≠ ce.om ∧ ce.t ≠ ce.T ∧ ce.t ≠ ce.om := by\n  have h0 : distinct [ce.u, ce.k, ce.T, ce.om, ce.t] = true := h\n  obtain ⟨n1, d1⟩ := distinct_cons h0\n  obtain ⟨n2, d2⟩ := distinct_cons d1\n  obtain ⟨n3, d3⟩ := distinct_cons d2\n  obtain ⟨n4, _⟩ := distinct_cons d3\n  refine ⟨fun e => n1 (by rw [e]; simp), fun e => n1 (by rw [e]; simp), fun e => n2 (by rw [e]; simp),\n    fun e => n2 (by rw [e]; simp), fun e => n3 (by rw [e]; simp), fun e => n3 (by rw [← e]; simp), fun e => n4 (by rw [← e]; simp)⟩\n\ntheorem in_special {i : Nat} (h : i = ce.u ∨ i = ce.k ∨ i = ce.T ∨ i = ce.om ∨ i = ce.t) : i ∈ ce.special := by\n  simp only [CycEnc.special, List.mem_cons, List.not_mem_nil, or_false]; exact h\n\n-- Flags decided at two frames that agree off Z (and off the flags), over maps that agree off TM.\ntheorem decide_view {fl : List (Nat × C)} (hfl : flagsOk fl = true) {Z TM : List Nat} (hz : ∀ p ∈ fl, avoids Z p.2 = true)\n    (hm : ∀ p ∈ fl, avoidsMaps TM p.2 = true) {Y X : Nat → Nat} {V N : Nat → Nat → Nat}\n    (hY : ∀ j, j ∉ Z → j ∉ flagVars fl → Y j = X j) (hV : ∀ m, m ∉ TM → V m = N m) {i : Nat} (hi : i ∉ Z) :\n    decideFlags fl Y V i = decideFlags fl X N i := by\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases hc : flagOf fl i with\n  | none => exact hY i hi (flagOf_none hc)\n  | some c =>\n    obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n    simp only [Option.map_some, evalE]\n    rw [congr2C (ρ' := X) (M' := N) p.2 (fun j hj => hY j (avoids_occ (hz p hp) hj) (avoids_occ (List.all_eq_true.mp hfl p hp) hj))\n      (fun m hm' => hV m (avoidsMaps_occ (hm p hp) hm'))]\n\nvariable (hS : CycShape s ce keys) (hT : CycTerms s ce keys) (hr : r.Ok s T)\ninclude hS hT hr\n\ntheorem enc_maps {u : Nat} (hu : u ≤ T) {m : Nat} (hm : m ∉ ce.mtr.map (·.1)) : r.N s u m = r.mp 0 m := by\n  rw [N_not_carried (fun h => hm (hS.carm m h))]\n  exact run_maps hr hS.carm hS.wrm hS.evm u hu m hm\n\ntheorem enc_frame {u : Nat} (hu : u ≤ T) {i : Nat} (hv : i ∉ ce.vtr.map (·.1)) (hf : i ∉ flagVars s.f.flags) :\n    r.X s u i = r.ρ0 i := by\n  have hin : i ∉ s.f.m.inputs := fun h => hv (hS.inv i h)\n  rw [CRun.X, withInputs_other hin]\n  exact run_frame hr u hu i (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hv (hS.initv p hp))\n    (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hv (hS.stepv p hp)) hin hf\n\nvariable {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) {w : E} {u : Nat}\n  (hw : evalE Q (cycMaps s ce r (T + 1)) w = u) (hu : u ≤ T)\ninclude hQ hw hu\n\n-- A read of a map at time w: the maps over time read back the run's.\ntheorem enc_rd : ∀ m key, evalE Q (cycMaps s ce r (T + 1)) (cycRd ce w m key)\n    = cycView s ce r (T + 1) u m (evalE Q (cycMaps s ce r (T + 1)) key) := by\n  intro m key\n  simp only [cycRd]\n  split\n  · rename_i p hp\n    obtain ⟨hpm, hpe⟩ := lookup_some hp\n    have hpm' : p.1 = m := by simpa using hpe\n    have hmd : m ∈ ce.mtr.map (·.1) := List.mem_map.mpr ⟨p, hpm, hpm'⟩\n    have hmt : m ∉ ce.tm := fun h => hS.tmd m h hmd\n    rw [cv_N hmt]\n    simp only [evalE, cm_m hS.dtm hpm, hw, hQ.2.1, pair_mod hu, pair_div hu, hpm']\n  · rename_i hn\n    have hmd : m ∉ ce.mtr.map (·.1) := fun h => by\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n      have := lookup_none_all hn p hp; simp at this\n    simp only [evalE, cycView]\n    by_cases ht : ce.tm.contains m = true\n    · rw [if_pos ht]\n    · rw [if_neg ht, cm_o (fun h => ht (List.contains_iff_mem.mpr h)), enc_maps hS hT hr hu hmd]\n\ntheorem enc_trE (e : E) : evalE Q (cycMaps s ce r (T + 1)) (trE ce w e)\n    = evalE (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) e :=\n  substR_evalE (cycσ ce w) (cycRd ce w) Q (cycMaps s ce r (T + 1)) (cycView s ce r (T + 1) u) (enc_rd hS hT hr hQ hw hu) e\ntheorem enc_trC (c : C) : evalC Q (cycMaps s ce r (T + 1)) (trC ce w c)\n    = evalC (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) c :=\n  substR_evalC (cycσ ce w) (cycRd ce w) Q (cycMaps s ce r (T + 1)) (cycView s ce r (T + 1) u) (enc_rd hS hT hr hQ hw hu) c\n\ntheorem enc_σ_in {i : Nat} (hi : i ∈ ce.vtr.map (·.1)) : applyS (cycσ ce w) Q (cycMaps s ce r (T + 1)) i = r.X s u i := by\n  cases h : lookup (fun p => p.1 == i) ce.vtr with\n  | none =>\n    exfalso; obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hi\n    have := lookup_none_all h p hp; simp at this\n  | some q =>\n    obtain ⟨hq, hqi⟩ := lookup_some h\n    have hqi' : q.1 = i := by simpa using hqi\n    have ha : assoc (cycσ ce w) i = some (.get q.2 w) := by\n      simp only [assoc, cycσ, lookup_map_pred, h, Option.map_some]\n    simp only [applyS, ha, evalE, cm_v hS.dtm hq, hw, hqi']\n\ntheorem enc_σ_out {i : Nat} (hi : i ∉ ce.vtr.map (·.1)) : applyS (cycσ ce w) Q (cycMaps s ce r (T + 1)) i = Q i := by\n  apply applyS_other\n  intro h; apply hi\n  obtain ⟨a, ha, rfl⟩ := List.mem_map.mp h\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp ha\n  exact List.mem_map.mpr ⟨p, hp, rfl⟩\n\n-- The frame a traced term reads: the run's state and request at time u, off the added variables and the flags.\ntheorem enc_Y {i : Nat} (hz : i ∉ cycZ ce keys) (hf : i ∉ flagVars s.f.flags) :\n    applyS (cycσ ce w) Q (cycMaps s ce r (T + 1)) i = r.X s u i := by\n  by_cases hv : i ∈ ce.vtr.map (·.1)\n  · exact enc_σ_in hS hT hr hQ hw hu hv\n  · rw [enc_σ_out hS hT hr hQ hw hu hv, hQ.2.2 i (by\n      simp only [cycP, List.mem_append, not_or]; exact ⟨⟨hz, hv⟩, hf⟩), enc_frame hS hT hr hu hv hf]\n\ntheorem enc_D {i : Nat} (hz : i ∉ cycZ ce keys) :\n    decideFlags s.f.flags (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) i = r.V s u i :=\n  decide_view hS.fl hT.flz hT.flm (fun _ hj hf => enc_Y hS hT hr hQ hw hu hj hf) (fun m hm => cv_N hm) hz\n\n-- A machine term, its flags inlined, read at the frame of time w: the term at the run's step from u.\ntheorem enc_inl (e : E) (hz : avoidsE (cycZ ce keys) e = true) (hm : avoidsMapsE ce.tm e = true) :\n    evalE (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) (inlineE s.f.flags e) = evalE (r.V s u) (r.N s u) e := by\n  rw [inline_evalE]\n  exact congr2E e (fun i hi => enc_D hS hT hr hQ hw hu (avoidsE_occ hz hi)) (fun m hm' => cv_N (avoidsMapsE_occ hm hm'))\n\ntheorem enc_now (e : E) (hz : avoidsE (cycZ ce keys) e = true) (hm : avoidsMapsE ce.tm e = true) :\n    evalE Q (cycMaps s ce r (T + 1)) (trE ce w (inlineE s.f.flags e)) = evalE (r.V s u) (r.N s u) e := by\n  rw [enc_trE hS hT hr hQ hw hu, enc_inl hS hT hr hQ hw hu e hz hm]\n\ntheorem enc_nowC (c : C) (hz : avoids (cycZ ce keys) c = true) (hm : avoidsMaps ce.tm c = true) :\n    evalC Q (cycMaps s ce r (T + 1)) (trC ce w (inlineC s.f.flags c)) = evalC (r.V s u) (r.N s u) c := by\n  rw [enc_trC hS hT hr hQ hw hu, inline_evalC]\n  exact congr2C c (fun i hi => enc_D hS hT hr hQ hw hu (avoids_occ hz hi)) (fun m hm' => cv_N (avoidsMaps_occ hm hm'))\nend enc\n\n/-! The facts hold of the run -/\n\ntheorem holds_any (l : MLaw) (M : Nat → Nat → Nat) : ∀ (gs : List Nat) (ρ : Nat → Nat), holdsOver l M gs ρ →\n    ∀ X : Nat → Nat, (∀ j, occC j l.holds = true → j ∉ gs → l.key ≠ some j → X j = ρ j) → evalC X M l.holds = true\n  | [], ρ, h, X, hX => by\n    simp only [holdsOver, MLaw.Holds] at h\n    split at h\n    · rename_i hk\n      rw [congrC X ρ M l.holds (fun j hj => hX j hj (by simp) (by rw [hk]; simp))]; exact h\n    · rename_i kv hk\n      rw [congrC X (upd ρ kv (X kv)) M l.holds (fun j hj => by\n        simp only [upd]\n        split\n        · rename_i e; rw [e]\n        · rename_i e; exact hX j hj (by simp) (by rw [hk]; intro h'; exact e (Option.some.inj h').symm))]\n      exact h (X kv)\n  | g :: gs, ρ, h, X, hX => by\n    simp only [holdsOver] at h\n    exact holds_any l M gs (upd ρ g (X g)) (h (X g)) X (fun j hj hgs hk => by\n      simp only [upd]\n      split\n      · rename_i e; rw [e]\n      · rename_i e\n        exact hX j hj (fun hm => by rcases List.mem_cons.mp hm with h' | h'; exact e h'; exact hgs h') hk)\n\ntheorem cycNext_every {s : SMachine} {ce : CycEnc} {m : Nat} {w : Nat × Nat × E} (h : lookup (fun w => w.1 == m) s.every = some w) :\n    cycNext s ce m = trE ce (cycPrev ce) (inlineE s.f.flags (substE [(w.2.1, .var ce.k)] w.2.2)) := by\n  simp only [cycNext, h]\ntheorem cycNext_write {s : SMachine} {ce : CycEnc} {m : Nat} {w : Nat × E × E} (he : lookup (fun w => w.1 == m) s.every = none)\n    (h : lookup (fun w => w.1 == m) s.f.m.writes = some w) :\n    cycNext s ce m = .ite (.eq (.var ce.k) (trE ce (cycPrev ce) (inlineE s.f.flags w.2.1)))\n        (trE ce (cycPrev ce) (readsAtE (inlineE s.f.flags w.2.1) (.var ce.k) (inlineE s.f.flags w.2.2))) (cycCell ce m (cycPrev ce)) := by\n  simp only [cycNext, he, h]\ntheorem cycNext_none {s : SMachine} {ce : CycEnc} {m : Nat} (he : lookup (fun w => w.1 == m) s.every = none)\n    (h : lookup (fun w => w.1 == m) s.f.m.writes = none) : cycNext s ce m = cycCell ce m (cycPrev ce) := by\n  simp only [cycNext, he, h]\ntheorem everyMaps_every {s : SMachine} {D : Nat → Nat} {N : Nat → Nat → Nat} {m key : Nat} {w : Nat × Nat × E}\n    (h : lookup (fun w => w.1 == m) s.every = some w) : everyMaps s D N m key = evalE (upd D w.2.1 key) N w.2.2 := by\n  simp only [everyMaps, h]\ntheorem everyMaps_write {s : SMachine} {D : Nat → Nat} {N : Nat → Nat → Nat} {m key : Nat} {w : Nat × E × E}\n    (he : lookup (fun w => w.1 == m) s.every = none) (h : lookup (fun w => w.1 == m) s.f.m.writes = some w) :\n    everyMaps s D N m key = if key = evalE D N w.2.1 then evalE D N w.2.2 else N m key := by\n  simp only [everyMaps, he, writeMaps, h]\ntheorem everyMaps_none {s : SMachine} {D : Nat → Nat} {N : Nat → Nat → Nat} {m key : Nat}\n    (he : lookup (fun w => w.1 == m) s.every = none) (h : lookup (fun w => w.1 == m) s.f.m.writes = none) :\n    everyMaps s D N m key = N m key := by\n  simp only [everyMaps, he, writeMaps, h]\n\nsection facts\nvariable {s : SMachine} {ce : CycEnc} {keys : List Nat} {r : CRun} {T : Nat}\n  (hS : CycShape s ce keys) (hT : CycTerms s ce keys) (hr : r.Ok s T)\ninclude hS hT hr\n\ntheorem stepTerm_avoids {x : Nat} (hx : x ∈ ce.vtr.map (·.1)) :\n    avoidsE (cycZ ce keys) (cycStepTerm s x) = true ∧ avoidsMapsE ce.tm (cycStepTerm s x) = true := by\n  simp only [cycStepTerm]\n  cases h : assoc s.f.m.step x with\n  | some e => exact ⟨hT.stz _ (assoc_some_mem h), hT.stm _ (assoc_some_mem h)⟩\n  | none =>\n    refine ⟨?_, ?_⟩\n    · simp only [Option.getD, avoidsE, List.all_eq_true, occE, Bool.not_eq_true', beq_eq_false_iff_ne]\n      intro z hz e; subst e; exact hS.zv _ hz hx\n    · simp [Option.getD, avoidsMapsE, occME]\n\ntheorem given_holds {g : MLaw × List Nat} (hg : g ∈ cycGiven s) : holdsOver g.1 (r.mp 0) g.2 r.ρ0 := by\n  simp only [cycGiven, List.mem_append, List.mem_map] at hg\n  rcases hg with ⟨l, hl, rfl⟩ | hg\n  · exact hr.facts l hl\n  · exact hr.pfacts g hg\n\ntheorem start_holds {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (cycStart s ce).holds = true := by\n  apply impl_true\n  intro h0\n  rw [evalC_iff] at h0; simp only [holdsC, evalE] at h0\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = 0 := by simp only [evalE]; omega\n  apply andL_true\n  intro c hc\n  rcases List.mem_cons.mp hc with rfl | hc\n  · simp [trueC, evalC, evalE]\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n  have ha : assoc s.f.m.init p.1 = some p.2 := by simp only [assoc, lookup_unique hS.dinit hp, Option.map_some]\n  rw [evalC_iff]; simp only [holdsC]\n  rw [enc_trE hS hT hr hQ hw (Nat.zero_le T)]\n  show applyS (cycσ ce (.var ce.u)) Q (cycMaps s ce r (T + 1)) p.1 = _\n  rw [enc_σ_in hS hT hr hQ hw (Nat.zero_le T) (hS.initv p hp), CRun.X, withInputs_other (hS.initin p hp), hr.init]\n  simp only [applyS, ha]\n  exact congr2E p.2 (fun j hj => (hQ.2.2 j (avoidsE_occ (hT.inz p hp) hj)).symm)\n    (fun m hm => (cm_o (avoidsMapsE_occ (hT.inm p hp) hm)).symm)\n\ntheorem step_holds (b : Bool) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (cycStep s ce b).holds = true := by\n  apply impl_true\n  intro h1\n  rw [evalC_iff] at h1; simp only [cycStepped, holdsC, evalE] at h1\n  obtain ⟨h1a, h1b⟩ := h1\n  have hQT := hQ.1\n  obtain ⟨u', hu'⟩ : ∃ u', Q ce.u = u' + 1 := ⟨Q ce.u - 1, by omega⟩\n  have hlt : u' < T := by omega\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (cycPrev ce) = u' := by simp only [cycPrev, evalE]; omega\n  have hw0 : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = u' + 1 := hu'\n  apply andL_true\n  intro c hc\n  rcases List.mem_cons.mp hc with rfl | hc\n  · simp [trueC, evalC, evalE]\n  rcases List.mem_append.mp hc with hc | hc\n  · cases b\n    · simp at hc\n    · simp at hc\n      subst hc\n      rw [enc_nowC hS hT hr hQ hw (Nat.le_of_lt hlt) _ hT.asz hT.asm]\n      exact (hr.step u' hlt).1\n  · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n    have hx := hS.initv p hp\n    rw [evalC_iff]; simp only [holdsC]\n    rw [enc_trE hS hT hr hQ hw0 hlt, enc_now hS hT hr hQ hw (Nat.le_of_lt hlt) _ (stepTerm_avoids hS hT hr hx).1 (stepTerm_avoids hS hT hr hx).2]\n    show applyS (cycσ ce (.var ce.u)) Q (cycMaps s ce r (T + 1)) p.1 = _\n    rw [enc_σ_in hS hT hr hQ hw0 hlt hx, CRun.X, withInputs_other (hS.initin p hp), (hr.step u' hlt).2.1, applyS_getD]\n    rfl\n\ntheorem mapStart_holds {p : Nat × Nat} (hp : p ∈ s.f.m.maps0) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (.or (.not (.le (.var ce.u) (.const 0))) (.eq (cycCell ce p.1 (.var ce.u)) (.const p.2))) = true := by\n  apply impl_true\n  intro h0\n  rw [evalC_iff] at h0; simp only [holdsC, evalE] at h0\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = 0 := by simp only [evalE]; omega\n  rw [evalC_iff]; simp only [holdsC, cycCell]\n  rw [enc_rd hS hT hr hQ hw (Nat.zero_le T), cv_N (fun h => hS.tmd _ h (hS.m0 p hp)), N_not_carried (hS.m0c p hp)]\n  exact hr.maps0 p hp _\n\ntheorem mapStep_holds {p : Nat × Nat} (hp : p ∈ s.f.m.maps0) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (.or (.not (cycStepped ce)) (.eq (cycCell ce p.1 (.var ce.u)) (cycNext s ce p.1))) = true := by\n  apply impl_true\n  intro h1\n  rw [evalC_iff] at h1; simp only [cycStepped, holdsC, evalE] at h1\n  obtain ⟨h1a, h1b⟩ := h1\n  have hQT := hQ.1\n  obtain ⟨u', hu'⟩ : ∃ u', Q ce.u = u' + 1 := ⟨Q ce.u - 1, by omega⟩\n  have hlt : u' < T := by omega\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (cycPrev ce) = u' := by simp only [cycPrev, evalE]; omega\n  have hw0 : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = u' + 1 := hu'\n  have hk : evalE Q (cycMaps s ce r (T + 1)) (.var ce.k) = Q ce.k := rfl\n  have hmt : p.1 ∉ ce.tm := fun h => hS.tmd _ h (hS.m0 p hp)\n  have hsp := special_parts hS.dsp\n  have hkZ : ce.k ∈ cycZ ce keys := List.mem_append_left _ (in_special (Or.inr (Or.inl rfl)))\n  -- the frame of time u' at k: the fact's own key\n  have hYk : applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1)) ce.k = Q ce.k :=\n    enc_σ_out hS hT hr hQ hw (Nat.le_of_lt hlt) (hS.zv _ hkZ)\n  rw [evalC_iff]; simp only [holdsC, cycCell]\n  rw [enc_rd hS hT hr hQ hw0 hlt, cv_N hmt, N_not_carried (hS.m0c p hp), (hr.step u' hlt).2.2, hk]\n  by_cases hev : ∃ w, lookup (fun w => w.1 == p.1) s.every = some w\n  · obtain ⟨w, he⟩ := hev\n    obtain ⟨hwm, _⟩ := lookup_some he\n    rw [cycNext_every he, everyMaps_every he, enc_trE hS hT hr hQ hw (Nat.le_of_lt hlt), inline_evalE, subst_evalE, applyS_single]\n    have hD : evalE (decideFlags s.f.flags (applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u'))\n        (cycView s ce r (T + 1) u') (.var ce.k) = Q ce.k := by\n      show decideFlags s.f.flags (applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u') ce.k = Q ce.k\n      rw [decide_other (hS.zf _ hkZ), hYk]\n    rw [hD]\n    refine congr2E w.2.2 (fun j hj => ?_) (fun m hm => (cv_N (avoidsMapsE_occ (hT.evm w hwm) hm)).symm)\n    simp only [upd]\n    split\n    · rfl\n    · rename_i hne\n      have hjz : j ∉ cycZ ce keys := fun hz => by\n        have := hT.evz w hwm j hz hne; rw [this] at hj; exact absurd hj (by decide)\n      exact (enc_D hS hT hr hQ hw (Nat.le_of_lt hlt) hjz).symm\n  · have he : lookup (fun w => w.1 == p.1) s.every = none := by\n      cases h : lookup (fun w => w.1 == p.1) s.every\n      · rfl\n      · exact absurd ⟨_, h⟩ hev\n    by_cases hwr' : ∃ w, lookup (fun w => w.1 == p.1) s.f.m.writes = some w\n    · obtain ⟨w, hwr⟩ := hwr'\n      obtain ⟨hwm, _⟩ := lookup_some hwr\n      rw [cycNext_write he hwr, everyMaps_write he hwr]\n      rw [evalE_ite_eq, hk, enc_now hS hT hr hQ hw (Nat.le_of_lt hlt) _ (hT.wkz w hwm) (hT.wkm w hwm)]\n      by_cases hkk : Q ce.k = evalE (r.V s u') (r.N s u') w.2.1\n      · rw [if_pos hkk, if_pos hkk, enc_trE hS hT hr hQ hw (Nat.le_of_lt hlt), readsAt_evalE]\n        · exact (enc_inl hS hT hr hQ hw (Nat.le_of_lt hlt) _ (hT.wvz w hwm) (hT.wvm w hwm)).symm\n        · show applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1)) ce.k = _\n          rw [hYk, enc_inl hS hT hr hQ hw (Nat.le_of_lt hlt) _ (hT.wkz w hwm) (hT.wkm w hwm)]\n          exact hkk\n      · rw [if_neg hkk, if_neg hkk, cycCell, enc_rd hS hT hr hQ hw (Nat.le_of_lt hlt), cv_N hmt, hk]\n    · have hwr : lookup (fun w => w.1 == p.1) s.f.m.writes = none := by\n        cases h : lookup (fun w => w.1 == p.1) s.f.m.writes\n        · rfl\n        · exact absurd ⟨_, h⟩ hwr'\n      rw [cycNext_none he hwr, everyMaps_none he hwr, cycCell, enc_rd hS hT hr hQ hw (Nat.le_of_lt hlt), cv_N hmt, hk]\n\ntheorem fn_holds {g : MLaw × List Nat} (hg : g ∈ cycGiven s) (X : Nat → Nat)\n    (hX : ∀ j, j ∉ cycP s ce keys → j ∉ g.1.key.toList ++ g.2 → X j = r.ρ0 j) :\n    evalC X (cycMaps s ce r (T + 1)) g.1.holds = true := by\n  rw [congrMC X (cycMaps s ce r (T + 1)) (r.mp 0) _ (fun m hm => cm_o (avoidsMaps_occ (hT.gm g hg) hm))]\n  apply holds_any g.1 (r.mp 0) g.2 r.ρ0 (given_holds hS hT hr hg) X\n  intro j hj hgs hk\n  apply hX j\n  · intro hP; have := hT.gz g hg j hP hk hgs; rw [this] at hj; exact absurd hj (by decide)\n  · intro hm\n    rcases List.mem_append.mp hm with h | h\n    · exact hk (mem_toList h)\n    · exact hgs h\n\ntheorem canon_holds {g : Fact} (hg : g ∈ cycCanon s ce) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) (vals : Nat → Nat) :\n    evalC (override g.keys vals Q) (cycMaps s ce r (T + 1)) g.holds = true := by\n  have hsp := special_parts hS.dsp\n  have hov : ∀ ks : List Nat, (∀ x ∈ ks, x = ce.u ∨ x = ce.k) → EnvOk s ce keys r T (override ks vals Q) := by\n    intro ks hks\n    refine ⟨?_, ?_, ?_⟩\n    · simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks _ (List.contains_iff_mem.mp h) with e | e\n        · exact hsp.1 e.symm\n        · exact hsp.2.2.1 e.symm)]\n      exact hQ.1\n    · simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks _ (List.contains_iff_mem.mp h) with e | e\n        · exact hsp.2.1 e.symm\n        · exact hsp.2.2.2.1 e.symm)]\n      exact hQ.2.1\n    · intro i hi\n      simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks _ (List.contains_iff_mem.mp h) with e | e\n        · exact (notP hi).1 (in_special (Or.inl e))\n        · exact (notP hi).1 (in_special (Or.inr (Or.inl e))))]\n      exact hQ.2.2 i hi\n  simp only [cycCanon, List.mem_cons, List.mem_append] at hg\n  rcases hg with rfl | rfl | rfl | hg | hg\n  · exact start_holds hS hT hr (hov [ce.u] (by simp))\n  · exact step_holds hS hT hr true (hov [ce.u] (by simp))\n  · exact step_holds hS hT hr false (hov [ce.u] (by simp))\n  · simp only [cycMapFacts, List.mem_flatMap, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hg\n    obtain ⟨p, hp, rfl | rfl⟩ := hg\n    · exact mapStart_holds hS hT hr hp (hov [ce.u, ce.k] (by simp))\n    · exact mapStep_holds hS hT hr hp (hov [ce.u, ce.k] (by simp))\n  · simp only [cycFnFacts, List.mem_map] at hg\n    obtain ⟨q, hq, rfl⟩ := hg\n    exact fn_holds hS hT hr hq _ (fun j hjP hjk => by\n      simp only [override]\n      rw [if_neg (fun h => hjk (List.contains_iff_mem.mp h))]\n      exact hQ.2.2 j hjP)\nend facts\n\n/-! The bridge for machines -/\n\n/-- A cyclic proof of a machine law, checked against the machine's encoding (`cycMOk`): the law holds in every state\nthe machine reaches, at every value of its keys. -/\ntheorem cyc_machine_sound (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (law : C) (keys : List Nat) (n : CNode) (hn : n ∈ nodes) (hok : cycMOk s ce facts law keys n = true) :\n    ∀ ρ M, SReach s ρ M → ∀ ρ' : Nat → Nat, (∀ i, i ∉ keys → ρ' i = ρ i) → evalC ρ' M law = true := by\n  simp only [cycMOk, Bool.and_eq_true] at hok\n  obtain ⟨⟨⟨⟨hsh, hte⟩, hlaw⟩, hfa⟩, hnd⟩ := hok\n  have hS := cycShape_of hsh\n  have hT := cycTerms_of hte\n  simp only [cycNodeOk, Bool.and_eq_true] at hnd\n  simp only [cycLawOk, Bool.and_eq_true] at hlaw\n  intro ρ M hreach ρ' hρ'\n  obtain ⟨r, T, hr, hst, hmp⟩ := reach_run hS.q hreach\n  have hsp := special_parts hS.dsp\n  have hnot : ∀ i, i ∉ ce.special → cycEnv ce T ρ' i = ρ' i := fun i hi => by\n    simp only [cycEnv]\n    rw [if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inr e)))))),\n      if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inl e))))), if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inl e))))))]\n  have hEnv : EnvOk s ce keys r T (cycEnv ce T ρ') := by\n    refine ⟨by simp [cycEnv], by simp [cycEnv, Ne.symm hsp.2.2.2.2.2.2, Ne.symm hsp.2.2.2.2.1], ?_⟩\n    intro i hi\n    obtain ⟨h1, h2, h3, h4⟩ := notP hi\n    rw [hnot i h1, hρ' i h2, ← hst]\n    exact run_frame hr T (Nat.le_refl T) i (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact h3 (hS.initv p hp))\n      (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact h3 (hS.stepv p hp)) (fun h => h3 (hS.inv i h)) h4\n  have hF : FactsHold facts (cycEnv ce T ρ') (cycMaps s ce r (T + 1)) := by\n    intro f hf vals\n    have hfi := List.all_eq_true.mp hfa f hf\n    simp only [Bool.or_eq_true] at hfi\n    rcases hfi with hnc | hcan\n    · exact natC_true _ hnc\n    · obtain ⟨g, hg, hb⟩ := List.any_eq_true.mp hcan\n      simp only [factBeq, Bool.and_eq_true, beq_iff_eq] at hb\n      rw [hb.1, beqC_eq hb.2]\n      exact canon_holds hS hT hr hg hEnv vals\n  have htT : cycEnv ce T ρ' ce.t = T := by simp [cycEnv]\n  have hH : ∀ c ∈ n.hyps, evalC (cycEnv ce T ρ') (cycMaps s ce r (T + 1)) c = true := by\n    intro c hc\n    have h := List.all_eq_true.mp hnd.2 c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with (h | h) | h\n    · rw [beqC_eq h, congr2C (ρ' := r.ρ0) (M' := r.mp 0) _ (fun j hj => hEnv.2.2 j (avoids_occ hT.prz hj))\n        (fun m hm => cm_o (avoidsMaps_occ hT.prm hm))]\n      exact hr.pre\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, htT, hEnv.1] <;> omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hEnv.1, hEnv.2.1] <;> omega\n  have hc0 := cyclic_sound facts nodes hc (cycMaps s ce r (T + 1)) (cycEnv ce T ρ') hF n hn hH\n  have htT' : evalE (cycEnv ce T ρ') (cycMaps s ce r (T + 1)) (.var ce.t) = T := htT\n  rw [beqC_eq hnd.1, enc_trC hS hT hr hEnv htT' (Nat.le_refl T)] at hc0\n  rw [congr2C (ρ' := applyS (cycσ ce (.var ce.t)) (cycEnv ce T ρ') (cycMaps s ce r (T + 1))) (M' := cycView s ce r (T + 1) T) law\n    (fun j hj => ?_) (fun m hm => ?_)]\n  · exact hc0\n  · have hj' := avoids_occ hlaw.1 hj\n    have hjs : j ∉ ce.special := fun h => hj' (List.mem_append_left _ h)\n    have hji : j ∉ s.f.m.inputs := fun h => hj' (List.mem_append_right _ h)\n    by_cases hv : j ∈ ce.vtr.map (·.1)\n    · rw [enc_σ_in hS hT hr hEnv htT' (Nat.le_refl T) hv, CRun.X, withInputs_other hji, hst]\n      exact hρ' j (fun hk => hS.zv j (List.mem_append_right _ hk) hv)\n    · rw [enc_σ_out hS hT hr hEnv htT' (Nat.le_refl T) hv, hnot j hjs]\n  · have hm' := avoidsMaps_occ hlaw.2 hm\n    rw [cv_N (fun h => hm' (List.mem_append_left _ h)), N_not_carried (fun h => hm' (List.mem_append_right _ h)), hmp]\n\n-- The same as a law of the machine about every value of its keys (Sets.lean's `holdsOver`).\ntheorem cyc_machine_holds {M : Nat → Nat → Nat} {ρ : Nat → Nat} {law : C} {key : Option Nat} {gs : List Nat}\n    (h : ∀ ρ' : Nat → Nat, (∀ i, i ∉ key.toList ++ gs → ρ' i = ρ i) → evalC ρ' M law = true) : holdsOver ⟨law, key⟩ M gs ρ := by\n  induction gs generalizing ρ with\n  | nil =>\n    cases key with\n    | none => simp only [holdsOver, MLaw.Holds]; exact h ρ (fun _ _ => rfl)\n    | some kv =>\n      simp only [holdsOver, MLaw.Holds]\n      intro v\n      exact h _ (fun i hi => by\n        simp only [upd]\n        rw [if_neg (fun e => hi (by simp [Option.toList, e]))])\n  | cons g gs ih =>\n    simp only [holdsOver]\n    intro v\n    apply ih\n    intro ρ' hρ'\n    apply h\n    intro i hi\n    rw [hρ' i (fun hm => hi (by\n      rcases List.mem_append.mp hm with h1 | h1\n      · exact List.mem_append_left _ h1\n      · exact List.mem_append_right _ (List.mem_cons_of_mem _ h1)))]\n    simp only [upd]\n    rw [if_neg (fun e => hi (List.mem_append_right _ (by rw [e]; exact List.mem_cons_self)))]\n\n/-! Recurrences (`recurNodes`) -/\n\n-- A recurrence's values: f(0) is `zero`, f(n + 1) is `next` with x read as n and prev as f(n), the rest of the\n-- environment (the further arguments) as given.\ndef recF (zero next : E) (x prev : Nat) (env : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat\n  | 0 => evalE env maps zero\n  | n + 1 => evalE (upd (upd env x n) prev (recF zero next x prev env maps n)) maps next\n\n-- The maps with one of them replaced.\ndef withMap (maps : Nat → Nat → Nat) (f : Nat) (g : Nat → Nat) : Nat → Nat → Nat := fun m => if m = f then g else maps m\n\n-- The function's map, the recurrence's x and prev, the step fact's key.\nstructure RecEnc where\n  f : Nat\n  x : Nat\n  prev : Nat\n  k : Nat\n\n-- The recurrence's two equations as recurNodes states them: f(0) = zero, and at every k, f(k + 1) = next(k, f(k)).\ndef recFacts (re : RecEnc) (zero next : E) : List Fact :=\n  [⟨[], .eq (.get re.f (.const 0)) zero⟩,\n   ⟨[re.k], .eq (.get re.f (.add (.var re.k) (.const 1))) (substE [(re.x, .var re.k), (re.prev, .get re.f (.var re.k))] next)⟩]\n\n-- The exported facts are the equations, facts given about other functions (`given`), or true of every natural; the\n-- recurrence reads its own values only through prev, and nothing given reads them.\ndef recOk (re : RecEnc) (zero next : E) (given facts : List Fact) : Bool :=\n  !occME re.f zero && !occME re.f next && !occE re.k next && re.x != re.prev && re.k != re.x && re.k != re.prev\n    && given.all (fun g => !occMC re.f g.holds)\n    && facts.all (fun g => natC g.holds || (recFacts re zero next ++ given).any (factBeq g))\n\ntheorem override_nil (vals env : Nat → Nat) : override [] vals env = env := by\n  funext i; simp [override]\n\ntheorem rec_facts {re : RecEnc} {zero next : E} {given facts : List Fact} (hok : recOk re zero next given facts = true)\n    (maps : Nat → Nat → Nat) (env : Nat → Nat) (hg : FactsHold given env maps) :\n    FactsHold facts env (withMap maps re.f (recF zero next re.x re.prev env maps)) := by\n  simp only [recOk, Bool.and_eq_true, Bool.not_eq_true', bne_iff_ne, ne_eq] at hok\n  obtain ⟨⟨⟨⟨⟨⟨⟨hz, hn⟩, hk⟩, hxp⟩, hkx⟩, hkp⟩, hgv⟩, hfa⟩ := hok\n  have hM : ∀ e : E, occME re.f e = false → ∀ ρ, evalE ρ (withMap maps re.f (recF zero next re.x re.prev env maps)) e = evalE ρ maps e :=\n    fun e he ρ => congrME ρ _ maps e (fun m hm => by\n      simp only [withMap]; rw [if_neg (fun h => by rw [h, he] at hm; exact absurd hm (by decide))])\n  intro f hf vals\n  have hfi := List.all_eq_true.mp hfa f hf\n  simp only [Bool.or_eq_true] at hfi\n  rcases hfi with hnc | hcan\n  · exact natC_true _ hnc\n  obtain ⟨g, hg', hb⟩ := List.any_eq_true.mp hcan\n  simp only [factBeq, Bool.and_eq_true, beq_iff_eq] at hb\n  rw [hb.1, beqC_eq hb.2]\n  simp only [recFacts, List.cons_append, List.nil_append, List.mem_cons] at hg'\n  rcases hg' with rfl | rfl | hg'\n  · show evalC (override [] vals env) _ (.eq (.get re.f (.const 0)) zero) = true\n    rw [override_nil, evalC_iff]\n    show withMap maps re.f (recF zero next re.x re.prev env maps) re.f 0 = evalE env _ zero\n    rw [hM zero hz env]\n    simp only [withMap, if_pos (rfl : re.f = re.f), ite_true, recF]\n  · show evalC (override [re.k] vals env) _ (.eq (.get re.f (.add (.var re.k) (.const 1)))\n      (substE [(re.x, .var re.k), (re.prev, .get re.f (.var re.k))] next)) = true\n    rw [evalC_iff]\n    show withMap maps re.f (recF zero next re.x re.prev env maps) re.f (override [re.k] vals env re.k + 1) = _\n    rw [subst_evalE, hM next hn]\n    simp only [withMap, if_pos (rfl : re.f = re.f), ite_true, recF]\n    refine congrE _ _ maps next (fun j hj => ?_)\n    have hjk : j ≠ re.k := fun h => by rw [h, hk] at hj; exact absurd hj (by decide)\n    simp only [upd, applyS, assoc, lookup]\n    by_cases hjp : j = re.prev\n    · subst hjp\n      simp [hxp, Ne.symm hxp, evalE, withMap]\n    · by_cases hjx : j = re.x\n      · subst hjx\n        simp [evalE, hxp]\n      · have h1 : (re.x == j) = false := by simpa using Ne.symm hjx\n        have h2 : (re.prev == j) = false := by simpa using Ne.symm hjp\n        simp only [hjp, hjx, if_false, h1, h2, Bool.false_eq_true, Option.map_none, override]\n        rw [if_neg (fun h => hjk (by simpa using h))]\n  · rw [congrMC _ _ maps g.holds (fun m hm => by\n      simp only [withMap]\n      rw [if_neg (fun h => by\n        have := List.all_eq_true.mp hgv g hg'; rw [h] at hm; rw [hm] at this; exact absurd this (by decide))])]\n    exact hg g hg' vals\n\n/-- A cyclic proof of a recurrence's lemmas and laws between two points (`recurNodes`), checked against its equations\n(`recOk`): every node holds of the recurrence's values (`recF`), at every environment where the facts given about the\nfunctions it reads hold. -/\ntheorem cyc_recur_sound (re : RecEnc) (zero next : E) (given facts : List Fact) (nodes : List CNode)\n    (hc : checkCyclic facts nodes = true) (hok : recOk re zero next given facts = true) (maps : Nat → Nat → Nat) (env : Nat → Nat)\n    (hg : FactsHold given env maps) : ∀ n ∈ nodes, (∀ c ∈ n.hyps, evalC env (withMap maps re.f (recF zero next re.x re.prev env maps)) c = true) →\n      evalC env (withMap maps re.f (recF zero next re.x re.prev env maps)) n.concl = true :=\n  cyclic_sound facts nodes hc _ env (rec_facts hok maps env hg)\n\ntheorem assoc_map_kv {α : Type} (l : List α) (k : α → Nat) (g : α → E) (y : Nat) :\n    assoc (l.map fun a => (k a, g a)) y = (lookup (fun a => k a == y) l).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\ntheorem holds_of_eq {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : E} (h : evalE ρ M a = evalE ρ M b) : evalC ρ M (.eq a b) = true :=\n  (evalC_iff ρ M (.eq a b)).mpr h\ntheorem holds_of_lt {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : E} (h : evalE ρ M a < evalE ρ M b) : evalC ρ M (.lt a b) = true :=\n  (evalC_iff ρ M (.lt a b)).mpr h\n\ntheorem holds_of_le {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : E} (h : evalE ρ M a ≤ evalE ρ M b) : evalC ρ M (.le a b) = true :=\n  (evalC_iff ρ M (.le a b)).mpr h\ntheorem and_true2 {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : C} (ha : evalC ρ M a = true) (hb : evalC ρ M b = true) :\n    evalC ρ M (.and a b) = true := by simp [evalC, ha, hb]\n\n/-! Folds over trees (`foldNodes`) -/\n\ndef BTree.size : BTree → Nat\n  | .leaf _ => 1\n  | .node _ l r => l.size + r.size + 1\n-- The inputs a leaf or node carries.\ndef BTree.req : BTree → Nat → Nat\n  | .leaf ι => ι\n  | .node ι _ _ => ι\n-- The subtrees in post-order: each node after its children, so its right child just before it and its left child just\n-- before its right subtree (foldNodes' table, children numbered below their parent).\ndef BTree.flat : BTree → List BTree\n  | .leaf ι => [.leaf ι]\n  | .node ι l r => l.flat ++ r.flat ++ [.node ι l r]\n\ntheorem flat_length : ∀ t : BTree, t.flat.length = t.size\n  | .leaf _ => rfl\n  | .node _ l r => by simp [BTree.flat, BTree.size, flat_length l, flat_length r]; omega\n\ntheorem size_pos : ∀ t : BTree, 1 ≤ t.size\n  | .leaf _ => by simp [BTree.size]\n  | .node _ l r => by simp [BTree.size]\n\ntheorem flat_last : ∀ t : BTree, t.flat[t.size - 1]? = some t\n  | .leaf _ => rfl\n  | .node ι l r => by\n    simp only [BTree.flat, BTree.size]\n    rw [List.getElem?_append_right (by simp [flat_length])]\n    simp [flat_length]\n\ntheorem flat_node : ∀ (t : BTree) (i : Nat) (ι : Nat → Nat) (l r : BTree), t.flat[i]? = some (.node ι l r) →\n    l.size + r.size ≤ i ∧ t.flat[i - 1]? = some r ∧ t.flat[i - 1 - r.size]? = some l\n  | .leaf _, i, ι, l, r, h => by\n    cases i with\n    | zero => simp [BTree.flat] at h\n    | succ i => simp [BTree.flat] at h\n  | .node ι' l' r', i, ι, l, r, h => by\n    have hl := flat_length l'\n    have hr := flat_length r'\n    have pl := size_pos l'\n    have pr := size_pos r'\n    have pl2 := size_pos l\n    simp only [BTree.flat] at h ⊢\n    rcases Nat.lt_or_ge i l'.size with h1 | h1\n    · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega)] at h\n      obtain ⟨b, e1, e2⟩ := flat_node l' i ι l r h\n      refine ⟨b, ?_, ?_⟩\n      · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega), e1]\n      · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega), e2]\n    · rcases Nat.lt_or_ge i (l'.size + r'.size) with h2 | h2\n      · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl] at h\n        obtain ⟨b, e1, e2⟩ := flat_node r' (i - l'.size) ι l r h\n        refine ⟨by omega, ?_, ?_⟩\n        · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl,\n            show i - 1 - l'.size = i - l'.size - 1 by omega]\n          exact e1\n        · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl,\n            show i - 1 - r.size - l'.size = i - l'.size - 1 - r.size by omega]\n          exact e2\n      · rw [List.getElem?_append_right (by simp; omega)] at h\n        simp only [List.length_append, hl, hr] at h\n        rcases Nat.lt_or_ge i (l'.size + r'.size + 1) with h3 | h3\n        · have hi : i - (l'.size + r'.size) = 0 := by omega\n          rw [hi] at h\n          simp only [List.getElem?_cons_zero, Option.some.injEq, BTree.node.injEq] at h\n          obtain ⟨_, hll, hrr⟩ := h\n          subst hll\n          subst hrr\n          refine ⟨by omega, ?_, ?_⟩\n          · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl,\n              show i - 1 - l'.size = r'.size - 1 by omega, ← hr]\n            rw [hr]; exact flat_last r'\n          · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega),\n              show i - 1 - r'.size = l'.size - 1 by omega]\n            exact flat_last l'\n        · rw [List.getElem?_eq_none (by simp; omega)] at h\n          exact absurd h (by simp)\n\ntheorem flat_allowed {f : Fold} {ρ : Nat → Nat} {maps : Nat → Nat → Nat} : ∀ t : BTree, Allowed f ρ maps t →\n    ∀ s ∈ t.flat, Allowed f ρ maps s\n  | .leaf ι, h, s, hs => by simp [BTree.flat] at hs; rw [hs]; exact h\n  | .node ι l r, h, s, hs => by\n    simp only [BTree.flat, List.mem_append, List.mem_singleton] at hs\n    rcases hs with (hs | hs) | hs\n    · exact flat_allowed l h.2.1 s hs\n    · exact flat_allowed r h.2.2 s hs\n    · rw [hs]; exact h\n\n-- The table's variables (a node's number n, the tree's size N) and maps (each node's kind and children, and each\n-- state variable and input's value at each node).\nstructure FoldEnc where\n  n : Nat\n  N : Nat\n  kind : Nat\n  left : Nat\n  right : Nat\n  vtr : List (Nat × Nat)\n\ndef foldσ (fe : FoldEnc) (w : E) : List (Nat × E) := fe.vtr.map fun p => (p.1, .get p.2 w)\n-- A node's frame: its inputs, and each copy read at the child's number.\ndef foldNodeσ (f : Fold) (fe : FoldEnc) : List (Nat × E) :=\n  f.inputs.map (fun i => (i, substE (foldσ fe (.var fe.n)) (.var i)))\n    ++ f.state.map (fun e => (e.2.1, substE (foldσ fe (.get fe.left (.var fe.n))) (.var e.1)))\n    ++ f.state.map (fun e => (e.2.2, substE (foldσ fe (.get fe.right (.var fe.n))) (.var e.1)))\n\n-- foldNodes' table fact: below the size, a leaf's values from its inputs, a node's from its children's, numbered below\n-- it (with the assumption at each, or without when the fold has none).\ndef foldTable (f : Fold) (fe : FoldEnc) (withAssume : Bool) : Fact :=\n  ⟨[fe.n], .or (.not (.lt (.var fe.n) (.var fe.N))) (.and (.le (.get fe.kind (.var fe.n)) (.const 1)) (.and\n    (.or (.not (.eq (.get fe.kind (.var fe.n)) (.const 0))) (andL (trueC :: ((if withAssume then [substC (foldσ fe (.var fe.n)) f.assume] else [])\n      ++ f.leaf.map fun p => .eq (substE (foldσ fe (.var fe.n)) (.var p.1)) (substE (foldσ fe (.var fe.n)) p.2)))))\n    (.or (.not (.eq (.get fe.kind (.var fe.n)) (.const 1))) (andL (.lt (.get fe.left (.var fe.n)) (.var fe.n) :: .lt (.get fe.right (.var fe.n)) (.var fe.n)\n      :: ((if withAssume then [substC (foldσ fe (.var fe.n)) f.assume] else [])\n      ++ f.leaf.map fun p => .eq (substE (foldσ fe (.var fe.n)) (.var p.1)) (substE (foldNodeσ f fe) ((assoc f.node p.1).getD (.var p.1)))))))))⟩\n\ndef foldCopies (f : Fold) : List Nat := f.state.map (·.2.1) ++ f.state.map (·.2.2)\ndef foldTM (fe : FoldEnc) : List Nat := [fe.kind, fe.left, fe.right] ++ fe.vtr.map (·.2)\ndef foldNot (f : Fold) (fe : FoldEnc) : List Nat := f.state.map (·.1) ++ foldCopies f ++ [fe.n, fe.N]\n\n-- The table fits the fold: names apart, every input and state variable with its map, leaf and node set the state\n-- variables, leaves and the assumption read no state variable or copy, nodes no state variable, the precondition\n-- params alone, the law no input or copy; none reads the added variables or maps.\ndef foldShapeOk (f : Fold) (fe : FoldEnc) : Bool :=\n  copiesOk f && distinct (f.inputs ++ f.state.map (·.1) ++ foldCopies f ++ [fe.n, fe.N]) && distinct (f.leaf.map (·.1))\n    && f.leaf.all (fun p => (f.state.map (·.1)).contains p.1 && (f.node.map (·.1)).contains p.1)\n    && f.node.all (fun p => (f.state.map (·.1)).contains p.1)\n    && distinct (foldTM fe) && (f.inputs ++ f.state.map (·.1)).all (fun x => (fe.vtr.map (·.1)).contains x)\n    && !(fe.vtr.map (·.1)).contains fe.n && !(fe.vtr.map (·.1)).contains fe.N\ndef foldTermsOk (f : Fold) (fe : FoldEnc) (law : C) : Bool :=\n  f.leaf.all (fun p => avoidsE (foldNot f fe) p.2 && avoidsMapsE (foldTM fe) p.2)\n    && f.node.all (fun p => avoidsE (f.state.map (·.1) ++ [fe.n, fe.N]) p.2 && avoidsMapsE (foldTM fe) p.2)\n    && avoids (foldNot f fe) f.assume && avoidsMaps (foldTM fe) f.assume\n    && avoids (f.inputs ++ foldNot f fe) f.pre && avoidsMaps (foldTM fe) f.pre\n    && avoids (f.inputs ++ foldCopies f ++ [fe.n, fe.N]) law && avoidsMaps (foldTM fe) law\ndef foldOk (f : Fold) (fe : FoldEnc) (facts : List Fact) (law : C) (nd : CNode) : Bool :=\n  foldShapeOk f fe && foldTermsOk f fe law\n    && facts.all (fun g => natC g.holds || [foldTable f fe true, foldTable f fe false].any (factBeq g))\n    && beqC nd.concl (substC (foldσ fe (.var fe.n)) law)\n    && nd.hyps.all (fun h => beqC h f.pre || beqC h (.lt (.var fe.n) (.var fe.N)))\n\n-- The tree as foldNodes' table.\ndef foldMaps (f : Fold) (fe : FoldEnc) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) (t : BTree) : Nat → Nat → Nat := fun i =>\n  if i = fe.kind then fun j => match t.flat[j]? with\n    | some (.node _ _ _) => 1\n    | _ => 0\n  else if i = fe.left then fun j => match t.flat[j]? with\n    | some (.node _ _ r) => j - 1 - r.size\n    | _ => 0\n  else if i = fe.right then fun j => j - 1\n  else match lookup (fun p => p.2 == i) fe.vtr with\n    | some p => fun j => match t.flat[j]? with\n      | some s => foldT f ρ maps s p.1\n      | none => 0\n    | none => maps i\n\nstructure FoldShape (f : Fold) (fe : FoldEnc) : Prop where\n  copies : copiesOk f = true\n  dvars : distinct (f.inputs ++ f.state.map (·.1) ++ foldCopies f ++ [fe.n, fe.N]) = true\n  dleaf : distinct (f.leaf.map (·.1)) = true\n  leafst : ∀ p ∈ f.leaf, p.1 ∈ f.state.map (·.1)\n  leafnode : ∀ p ∈ f.leaf, p.1 ∈ f.node.map (·.1)\n  nodest : ∀ p ∈ f.node, p.1 ∈ f.state.map (·.1)\n  dtm : distinct (foldTM fe) = true\n  vin : ∀ x ∈ f.inputs, x ∈ fe.vtr.map (·.1)\n  vst : ∀ x ∈ f.state.map (·.1), x ∈ fe.vtr.map (·.1)\n  vn : fe.n ∉ fe.vtr.map (·.1)\n  vN : fe.N ∉ fe.vtr.map (·.1)\n\ntheorem foldShape_of {f : Fold} {fe : FoldEnc} (h : foldShapeOk f fe = true) : FoldShape f fe := by\n  simp only [foldShapeOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨hc, hd⟩, hdl⟩, hl⟩, hn⟩, hdt⟩, hv⟩, hvn⟩, hvN⟩ := h\n  refine ⟨hc, hd, hdl, fun p hp => List.contains_iff_mem.mp (and_parts (List.all_eq_true.mp hl p hp)).1,\n    fun p hp => List.contains_iff_mem.mp (and_parts (List.all_eq_true.mp hl p hp)).2,\n    fun p hp => List.contains_iff_mem.mp (List.all_eq_true.mp hn p hp), hdt,\n    fun x hx => List.contains_iff_mem.mp (List.all_eq_true.mp hv x (List.mem_append_left _ hx)),\n    fun x hx => List.contains_iff_mem.mp (List.all_eq_true.mp hv x (List.mem_append_right _ hx)),\n    not_mem_of_not_contains hvn, not_mem_of_not_contains hvN⟩\n\nsection fold\nvariable {f : Fold} {fe : FoldEnc} {ρ : Nat → Nat} {maps : Nat → Nat → Nat} {t : BTree} (hS : FoldShape f fe)\ninclude hS\n\ntheorem fs_parts : fe.kind ≠ fe.left ∧ fe.kind ≠ fe.right ∧ fe.left ≠ fe.right ∧ (∀ a ∈ fe.vtr.map (·.2), a ≠ fe.kind ∧ a ≠ fe.left ∧ a ≠ fe.right)\n    ∧ distinct (fe.vtr.map (·.2)) = true := by\n  have h := hS.dtm\n  simp only [foldTM, List.cons_append, List.nil_append] at h\n  obtain ⟨n1, d1⟩ := distinct_cons h\n  obtain ⟨n2, d2⟩ := distinct_cons d1\n  obtain ⟨n3, d3⟩ := distinct_cons d2\n  refine ⟨fun e => n1 (by rw [e]; simp), fun e => n1 (by rw [e]; simp), fun e => n2 (by rw [e]; simp),\n    fun a ha => ⟨fun e => n1 (by rw [← e]; simp [ha]), fun e => n2 (by rw [← e]; simp [ha]), fun e => n3 (by rw [← e]; exact ha)⟩, d3⟩\n\ntheorem fm_kind (j : Nat) : foldMaps f fe ρ maps t fe.kind j = match t.flat[j]? with\n    | some (.node _ _ _) => 1\n    | _ => 0 := by\n  simp only [foldMaps, if_pos rfl, ite_true]\ntheorem fm_left (j : Nat) : foldMaps f fe ρ maps t fe.left j = match t.flat[j]? with\n    | some (.node _ _ r) => j - 1 - r.size\n    | _ => 0 := by\n  have := fs_parts hS\n  simp only [foldMaps, if_neg (Ne.symm this.1), if_pos rfl, ite_true]\ntheorem fm_right (j : Nat) : foldMaps f fe ρ maps t fe.right j = j - 1 := by\n  have := fs_parts hS\n  simp only [foldMaps, if_neg (Ne.symm this.2.1), if_neg (Ne.symm this.2.2.1), if_pos rfl, ite_true]\ntheorem fm_v {p : Nat × Nat} (hp : p ∈ fe.vtr) (j : Nat) : foldMaps f fe ρ maps t p.2 j = match t.flat[j]? with\n    | some s => foldT f ρ maps s p.1\n    | none => 0 := by\n  obtain ⟨_, _, _, ha, hd⟩ := fs_parts hS\n  have h3 := ha p.2 (List.mem_map.mpr ⟨p, hp, rfl⟩)\n  simp only [foldMaps, if_neg h3.1, if_neg h3.2.1, if_neg h3.2.2, lookup_ren hd p hp]\ntheorem fm_o {i : Nat} (hi : i ∉ foldTM fe) : foldMaps f fe ρ maps t i = maps i := by\n  have h1 : i ≠ fe.kind := fun e => hi (by simp [foldTM, e])\n  have h2 : i ≠ fe.left := fun e => hi (by simp [foldTM, e])\n  have h3 : i ≠ fe.right := fun e => hi (by simp [foldTM, e])\n  have hn : lookup (fun p => p.2 == i) fe.vtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact hi (List.mem_append_right _ (List.mem_map.mpr ⟨q, hq, he⟩)))\n  simp only [foldMaps, if_neg h1, if_neg h2, if_neg h3, hn]\n\n-- What no leaf or node sets, and no copy: the inputs a node carries, else as before the tree.\ntheorem foldT_frame {y : Nat} (hy : y ∉ f.state.map (·.1)) (hc : y ∉ foldCopies f) (s : BTree) :\n    foldT f ρ maps s y = withInputs f.inputs ρ s.req y := by\n  cases s with\n  | leaf ι =>\n    simp only [foldT, BTree.req]\n    exact applyS_other (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hy (hS.leafst p hp)) _ _\n  | node ι l r =>\n    simp only [foldT, BTree.req]\n    rw [applyS_other (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hy (hS.nodest p hp))]\n    exact withChildren_plain f _ _ _ (fun h => hc (List.mem_append_left _ h)) (fun h => hc (List.mem_append_right _ h))\n\ntheorem fold_σ_in {Q : Nat → Nat} {w : E} {j : Nat} {s : BTree} (hw : evalE Q (foldMaps f fe ρ maps t) w = j)\n    (hs : t.flat[j]? = some s) {x : Nat} (hx : x ∈ fe.vtr.map (·.1)) : applyS (foldσ fe w) Q (foldMaps f fe ρ maps t) x = foldT f ρ maps s x := by\n  cases h : lookup (fun p => p.1 == x) fe.vtr with\n  | none =>\n    exfalso; obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hx\n    have := lookup_none_all h p hp; simp at this\n  | some q =>\n    obtain ⟨hq, hqx⟩ := lookup_some h\n    have hqx' : q.1 = x := by simpa using hqx\n    have ha : assoc (foldσ fe w) x = some (.get q.2 w) := by\n      simp only [assoc, foldσ, lookup_map_pred, h, Option.map_some]\n    simp only [applyS, ha, evalE, fm_v hS hq, hw, hs, hqx']\n\ntheorem fold_σ_out {Q : Nat → Nat} {w : E} {x : Nat} (hx : x ∉ fe.vtr.map (·.1)) :\n    applyS (foldσ fe w) Q (foldMaps f fe ρ maps t) x = Q x := by\n  apply applyS_other\n  intro h; apply hx\n  obtain ⟨a, ha, rfl⟩ := List.mem_map.mp h\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp ha\n  exact List.mem_map.mpr ⟨p, hp, rfl⟩\n\n-- A term that reads no state variable, copy or added variable, at a node's frame: at its inputs.\ntheorem fold_at {Q : Nat → Nat} (hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → Q i = ρ i) {w : E} {j : Nat} {s : BTree}\n    (hw : evalE Q (foldMaps f fe ρ maps t) w = j) (hs : t.flat[j]? = some s) {y : Nat} (hy : y ∉ foldNot f fe) :\n    applyS (foldσ fe w) Q (foldMaps f fe ρ maps t) y = withInputs f.inputs ρ s.req y := by\n  have hy1 : y ∉ f.state.map (·.1) := fun h => hy (by simp only [foldNot, List.mem_append]; exact Or.inl (Or.inl h))\n  have hy2 : y ∉ foldCopies f := fun h => hy (by simp only [foldNot, List.mem_append]; exact Or.inl (Or.inr h))\n  have hy3 : y ≠ fe.n := fun e => hy (by simp [foldNot, e])\n  have hy4 : y ≠ fe.N := fun e => hy (by simp [foldNot, e])\n  by_cases hv : y ∈ fe.vtr.map (·.1)\n  · rw [fold_σ_in hS hw hs hv, foldT_frame hS hy1 hy2]\n  · rw [fold_σ_out hS hv, hQ y hy3 hy4, withInputs_other (fun h => hv (hS.vin y h))]\n\ntheorem dvars_parts : (∀ x ∈ f.inputs, x ∉ foldCopies f) ∧ fe.n ≠ fe.N ∧ (∀ x ∈ f.inputs ++ f.state.map (·.1) ++ foldCopies f, x ≠ fe.n ∧ x ≠ fe.N) := by\n  obtain ⟨d1, d2, d3⟩ := distinct_append hS.dvars\n  obtain ⟨d4, _, d6⟩ := distinct_append d1\n  obtain ⟨_, _, d9⟩ := distinct_append d4\n  obtain ⟨n1, _⟩ := distinct_cons d2\n  refine ⟨fun x hx hc => d6 x (List.mem_append_left _ hx) hc, fun e => n1 (by rw [e]; simp), fun x hx => ⟨fun e => d3 x hx (by rw [e]; simp), fun e => d3 x hx (by rw [e]; simp)⟩⟩\n\n-- A node's frame, as foldNodeσ reads it from the table: as withChildren reads it from the children.\ntheorem fold_node {Q : Nat → Nat} (hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → Q i = ρ i) {j : Nat} {ι : Nat → Nat} {l r : BTree}\n    (hs : t.flat[j]? = some (.node ι l r)) (hj : Q fe.n = j) {y : Nat} (hy1 : y ∉ f.state.map (·.1)) (hy2 : y ≠ fe.n) (hy3 : y ≠ fe.N) :\n    applyS (foldNodeσ f fe) Q (foldMaps f fe ρ maps t) y = withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r) y := by\n  obtain ⟨_, hr1, hl1⟩ := flat_node t j ι l r hs\n  have hwn : evalE Q (foldMaps f fe ρ maps t) (.var fe.n) = j := hj\n  have hwl : evalE Q (foldMaps f fe ρ maps t) (.get fe.left (.var fe.n)) = j - 1 - r.size := by\n    simp only [evalE, hj, fm_left hS, hs]\n  have hwr : evalE Q (foldMaps f fe ρ maps t) (.get fe.right (.var fe.n)) = j - 1 := by\n    simp only [evalE, hj, fm_right hS]\n  have hcp := (dvars_parts hS).1\n  simp only [applyS, foldNodeσ, assoc_append_or, assoc_map_kv, withChildren]\n  by_cases hin : y ∈ f.inputs\n  · have hl0 : lookup (fun e => e.2.1 == y) f.state = none := lookup_none (fun e he => by\n      simp only [beq_eq_false_iff_ne]; intro h; exact hcp y hin (List.mem_append_left _ (List.mem_map.mpr ⟨e, he, h⟩)))\n    have hr0 : lookup (fun e => e.2.2 == y) f.state = none := lookup_none (fun e he => by\n      simp only [beq_eq_false_iff_ne]; intro h; exact hcp y hin (List.mem_append_right _ (List.mem_map.mpr ⟨e, he, h⟩)))\n    have hi0 : (lookup (fun i => i == y) f.inputs).map (fun i => substE (foldσ fe (.var fe.n)) (.var i)) = some (substE (foldσ fe (.var fe.n)) (.var y)) := by\n      cases h : lookup (fun i => i == y) f.inputs with\n      | none => have := lookup_none_all h y hin; simp at this\n      | some i => obtain ⟨_, hi⟩ := lookup_some h; simp only [beq_iff_eq] at hi; simp [hi]\n    simp only [hl0, hr0, hi0, Option.some_or]\n    rw [subst_evalE]\n    show applyS (foldσ fe (.var fe.n)) Q (foldMaps f fe ρ maps t) y = _\n    rw [fold_σ_in hS hwn hs (hS.vin y hin), foldT_frame hS hy1 (hcp y hin)]\n    rfl\n  · have hi0 : lookup (fun i => i == y) f.inputs = none := lookup_none (fun i hi => by\n      simp only [beq_eq_false_iff_ne]; intro h; exact hin (h ▸ hi))\n    simp only [hi0, Option.map_none, Option.none_or]\n    cases hl : lookup (fun e => e.2.1 == y) f.state with\n    | some e =>\n      obtain ⟨he, _⟩ := lookup_some hl\n      simp only [Option.map_some, Option.some_or]\n      rw [subst_evalE]\n      show applyS (foldσ fe (.get fe.left (.var fe.n))) Q (foldMaps f fe ρ maps t) e.1 = _\n      exact fold_σ_in hS hwl hl1 (hS.vst e.1 (List.mem_map.mpr ⟨e, he, rfl⟩))\n    | none =>\n      simp only [Option.map_none, Option.none_or]\n      cases hr : lookup (fun e => e.2.2 == y) f.state with\n      | some e =>\n        obtain ⟨he, _⟩ := lookup_some hr\n        simp only [Option.map_some]\n        rw [subst_evalE]\n        show applyS (foldσ fe (.get fe.right (.var fe.n))) Q (foldMaps f fe ρ maps t) e.1 = _\n        exact fold_σ_in hS hwr hr1 (hS.vst e.1 (List.mem_map.mpr ⟨e, he, rfl⟩))\n      | none =>\n        simp only [Option.map_none]\n        rw [hQ y hy2 hy3, withInputs_other hin]\nend fold\n\nstructure FoldTerms (f : Fold) (fe : FoldEnc) (law : C) : Prop where\n  leafz : ∀ p ∈ f.leaf, avoidsE (foldNot f fe) p.2 = true\n  leafm : ∀ p ∈ f.leaf, avoidsMapsE (foldTM fe) p.2 = true\n  nodez : ∀ p ∈ f.node, avoidsE (f.state.map (·.1) ++ [fe.n, fe.N]) p.2 = true\n  nodem : ∀ p ∈ f.node, avoidsMapsE (foldTM fe) p.2 = true\n  asz : avoids (foldNot f fe) f.assume = true\n  asm : avoidsMaps (foldTM fe) f.assume = true\n  prz : avoids (f.inputs ++ foldNot f fe) f.pre = true\n  prm : avoidsMaps (foldTM fe) f.pre = true\n  lawz : avoids (f.inputs ++ foldCopies f ++ [fe.n, fe.N]) law = true\n  lawm : avoidsMaps (foldTM fe) law = true\n\ntheorem foldTerms_of {f : Fold} {fe : FoldEnc} {law : C} (h : foldTermsOk f fe law = true) : FoldTerms f fe law := by\n  simp only [foldTermsOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨hl, hn⟩, ha⟩, ham⟩, hp⟩, hpm⟩, hz⟩, hzm⟩ := h\n  exact ⟨fun p hp => (and_parts (List.all_eq_true.mp hl p hp)).1, fun p hp => (and_parts (List.all_eq_true.mp hl p hp)).2,\n    fun p hp => (and_parts (List.all_eq_true.mp hn p hp)).1, fun p hp => (and_parts (List.all_eq_true.mp hn p hp)).2, ha, ham, hp, hpm, hz, hzm⟩\n\n-- The table's fact holds of the tree's table, wherever T and Ω... the size N is the tree's.\ntheorem table_holds {f : Fold} {fe : FoldEnc} {law : C} {ρ : Nat → Nat} {maps : Nat → Nat → Nat} {t : BTree} (hS : FoldShape f fe)\n    (hT : FoldTerms f fe law) (hA : Allowed f ρ maps t) (b : Bool) {Q : Nat → Nat} (hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → Q i = ρ i)\n    (hN : Q fe.N = t.size) : evalC Q (foldMaps f fe ρ maps t) (foldTable f fe b).holds = true := by\n  apply impl_true\n  intro h0\n  rw [evalC_iff] at h0; simp only [holdsC, evalE] at h0\n  rw [hN, ← flat_length] at h0\n  have hs : t.flat[Q fe.n]? = some t.flat[Q fe.n] := List.getElem?_eq_getElem h0\n  have hal := flat_allowed t hA _ (List.getElem_mem h0)\n  have hw : evalE Q (foldMaps f fe ρ maps t) (.var fe.n) = Q fe.n := rfl\n  have hkind : evalE Q (foldMaps f fe ρ maps t) (.get fe.kind (.var fe.n)) = match t.flat[Q fe.n]? with\n      | some (.node _ _ _) => 1\n      | _ => 0 := by simp only [evalE, fm_kind hS]\n  -- the assumption, at the node's own inputs\n  have hasm : ∀ (s : BTree), t.flat[Q fe.n]? = some s → evalC (withInputs f.inputs ρ s.req) maps f.assume = true →\n      evalC Q (foldMaps f fe ρ maps t) (substC (foldσ fe (.var fe.n)) f.assume) = true := by\n    intro s hs' hx\n    rw [subst_evalC, congr2C (ρ' := withInputs f.inputs ρ s.req) (M' := maps) f.assume\n      (fun y hy => fold_at hS hQ hw hs' (avoids_occ hT.asz hy)) (fun m hm => fm_o hS (avoidsMaps_occ hT.asm hm))]\n    exact hx\n  generalize t.flat[Q fe.n] = s at hs hal\n  cases s with\n  | leaf ι =>\n    have hk : evalE Q (foldMaps f fe ρ maps t) (.get fe.kind (.var fe.n)) = 0 := by rw [hkind, hs]\n    refine and_true2 (holds_of_le (by rw [hk]; simp [evalE])) (and_true2 (impl_true fun _ => ?_) (impl_true fun h1 => ?_))\n    · apply andL_true\n      intro c hc\n      rcases List.mem_cons.mp hc with rfl | hc\n      · simp [trueC, evalC, evalE]\n      rcases List.mem_append.mp hc with hc | hc\n      · cases b\n        · simp at hc\n        · simp at hc; subst hc; exact hasm _ hs hal\n      · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n        apply holds_of_eq\n        rw [subst_evalE, subst_evalE]\n        show applyS (foldσ fe (.var fe.n)) Q (foldMaps f fe ρ maps t) p.1 = _\n        rw [fold_σ_in hS hw hs (hS.vst p.1 (hS.leafst p hp)), congr2E (ρ' := withInputs f.inputs ρ ι) (M' := maps) p.2\n          (fun y hy => fold_at hS hQ hw hs (avoidsE_occ (hT.leafz p hp) hy)) (fun m hm => fm_o hS (avoidsMapsE_occ (hT.leafm p hp) hm))]\n        simp only [foldT, applyS, assoc, lookup_unique hS.dleaf hp, Option.map_some]\n    · rw [evalC_iff] at h1; simp only [holdsC, hk] at h1; simp [evalE] at h1\n  | node ι l r =>\n    obtain ⟨hb, _, _⟩ := flat_node t (Q fe.n) ι l r hs\n    have pl := size_pos l\n    have hk : evalE Q (foldMaps f fe ρ maps t) (.get fe.kind (.var fe.n)) = 1 := by rw [hkind, hs]\n    refine and_true2 (holds_of_le (by rw [hk]; simp [evalE])) (and_true2 (impl_true fun h1 => ?_) (impl_true fun _ => ?_))\n    · rw [evalC_iff] at h1; simp only [holdsC, hk] at h1; simp [evalE] at h1\n    · apply andL_true\n      intro c hc\n      rcases List.mem_cons.mp hc with rfl | hc\n      · apply holds_of_lt\n        have hl' : evalE Q (foldMaps f fe ρ maps t) (.get fe.left (.var fe.n)) = Q fe.n - 1 - r.size := by\n          simp only [evalE, fm_left hS, hs]\n        rw [hl']; show Q fe.n - 1 - r.size < Q fe.n; omega\n      rcases List.mem_cons.mp hc with rfl | hc\n      · apply holds_of_lt\n        have hr' : evalE Q (foldMaps f fe ρ maps t) (.get fe.right (.var fe.n)) = Q fe.n - 1 := by\n          simp only [evalE, fm_right hS]\n        rw [hr']; show Q fe.n - 1 < Q fe.n; omega\n      rcases List.mem_append.mp hc with hc | hc\n      · cases b\n        · simp at hc\n        · simp at hc; subst hc\n          apply hasm _ hs\n          show evalC (withInputs f.inputs ρ ι) maps f.assume = true\n          rw [← congrC (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) _ maps f.assume\n            (fun y hy => withChildren_plain f _ _ _\n              (fun h => avoids_occ hT.asz hy (by simp only [foldNot, foldCopies, List.mem_append]; exact Or.inl (Or.inr (Or.inl h))))\n              (fun h => avoids_occ hT.asz hy (by simp only [foldNot, foldCopies, List.mem_append]; exact Or.inl (Or.inr (Or.inr h)))))]\n          exact hal.1\n      · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n        apply holds_of_eq\n        rw [subst_evalE, subst_evalE]\n        show applyS (foldσ fe (.var fe.n)) Q (foldMaps f fe ρ maps t) p.1 = _\n        rw [fold_σ_in hS hw hs (hS.vst p.1 (hS.leafst p hp))]\n        simp only [foldT]\n        rw [applyS_getD]\n        obtain ⟨e, he⟩ : ∃ e, assoc f.node p.1 = some e := by\n          cases h : assoc f.node p.1 with\n          | some e => exact ⟨e, rfl⟩\n          | none =>\n            exfalso; obtain ⟨q, hq, hq1⟩ := List.mem_map.mp (hS.leafnode p hp)\n            simp only [assoc, Option.map_eq_none_iff] at h\n            have := lookup_none_all h q hq; simp [hq1] at this\n        have hem := assoc_some_mem he\n        rw [he]\n        simp only [Option.getD]\n        exact congr2E e (fun y hy => (fold_node hS hQ hs rfl (fun h => avoidsE_occ (hT.nodez _ hem) hy (List.mem_append_left _ h))\n            (fun h => avoidsE_occ (hT.nodez _ hem) hy (by rw [h]; simp)) (fun h => avoidsE_occ (hT.nodez _ hem) hy (by rw [h]; simp))).symm)\n          (fun m hm => (fm_o hS (avoidsMapsE_occ (hT.nodem _ hem) hm)).symm)\n\ndef foldEnv (fe : FoldEnc) (t : BTree) (ρ : Nat → Nat) : Nat → Nat := fun i =>\n  if i = fe.n then t.size - 1 else if i = fe.N then t.size else ρ i\n\n/-- A cyclic proof of a fold's law over trees as tables (`foldNodes`), checked against the fold's table (`foldOk`): for\nparams that meet the precondition, the law holds of every tree whose inputs meet the assumption, as `fold_sound` says of\nthe structural induction. -/\ntheorem cyc_fold_sound (f : Fold) (fe : FoldEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (law : C) (nd : CNode) (hn : nd ∈ nodes) (hok : foldOk f fe facts law nd = true) (maps : Nat → Nat → Nat) (ρ : Nat → Nat)\n    (h0 : evalC ρ maps f.pre = true) : ∀ t, Allowed f ρ maps t → evalC (foldT f ρ maps t) maps law = true := by\n  intro t hA\n  simp only [foldOk, Bool.and_eq_true] at hok\n  obtain ⟨⟨⟨⟨hsh, hte⟩, hfa⟩, hcon⟩, hhy⟩ := hok\n  have hS := foldShape_of hsh\n  have hT := foldTerms_of hte\n  obtain ⟨_, hnN, hx⟩ := dvars_parts hS\n  have hE : ∀ i, i ≠ fe.n → i ≠ fe.N → foldEnv fe t ρ i = ρ i := fun i h1 h2 => by simp [foldEnv, h1, h2]\n  have hEn : foldEnv fe t ρ fe.n = t.size - 1 := by simp [foldEnv]\n  have hEN : foldEnv fe t ρ fe.N = t.size := by simp [foldEnv, Ne.symm hnN]\n  have pt := size_pos t\n  have hF : FactsHold facts (foldEnv fe t ρ) (foldMaps f fe ρ maps t) := by\n    intro g hg vals\n    have hgi := List.all_eq_true.mp hfa g hg\n    simp only [Bool.or_eq_true] at hgi\n    rcases hgi with hnc | hcan\n    · exact natC_true _ hnc\n    obtain ⟨g', hg', hb⟩ := List.any_eq_true.mp hcan\n    simp only [factBeq, Bool.and_eq_true, beq_iff_eq] at hb\n    rw [hb.1, beqC_eq hb.2]\n    have hk : g'.keys = [fe.n] := by\n      simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hg'\n      rcases hg' with rfl | rfl <;> rfl\n    have hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → override g'.keys vals (foldEnv fe t ρ) i = ρ i := fun i h1 h2 => by\n      rw [hk]; simp only [override]\n      rw [if_neg (fun h => h1 (by simpa using h))]\n      exact hE i h1 h2\n    have hQN : override g'.keys vals (foldEnv fe t ρ) fe.N = t.size := by\n      rw [hk]; simp only [override]\n      rw [if_neg (fun h => hnN (by have h' : fe.N = fe.n := by simpa using h\n                                   exact h'.symm))]\n      exact hEN\n    simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hg'\n    rcases hg' with rfl | rfl\n    · exact table_holds hS hT hA true hQ hQN\n    · exact table_holds hS hT hA false hQ hQN\n  have hH : ∀ c ∈ nd.hyps, evalC (foldEnv fe t ρ) (foldMaps f fe ρ maps t) c = true := by\n    intro c hc\n    have h := List.all_eq_true.mp hhy c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with h | h\n    · rw [beqC_eq h, congr2C (ρ' := ρ) (M' := maps) _ (fun y hy => hE y\n        (fun e => avoids_occ hT.prz hy (by rw [e]; simp [foldNot])) (fun e => avoids_occ hT.prz hy (by rw [e]; simp [foldNot])))\n        (fun m hm => fm_o hS (avoidsMaps_occ hT.prm hm))]\n      exact h0\n    · rw [beqC_eq h]; apply holds_of_lt; simp only [evalE, hEn, hEN]; omega\n  have hc0 := cyclic_sound facts nodes hc (foldMaps f fe ρ maps t) (foldEnv fe t ρ) hF nd hn hH\n  have hw : evalE (foldEnv fe t ρ) (foldMaps f fe ρ maps t) (.var fe.n) = t.size - 1 := hEn\n  rw [beqC_eq hcon, subst_evalC] at hc0\n  refine (congr2C (ρ' := applyS (foldσ fe (.var fe.n)) (foldEnv fe t ρ) (foldMaps f fe ρ maps t)) (M' := foldMaps f fe ρ maps t) law\n    (fun y hy => ?_) (fun m hm => (fm_o hS (avoidsMaps_occ hT.lawm hm)).symm)).trans hc0\n  have hy' := avoids_occ hT.lawz hy\n  have hyi : y ∉ f.inputs := fun h => hy' (List.mem_append_left _ (List.mem_append_left _ h))\n  have hyc : y ∉ foldCopies f := fun h => hy' (List.mem_append_left _ (List.mem_append_right _ h))\n  have hyn : y ≠ fe.n := fun e => hy' (by rw [e]; simp)\n  have hyN : y ≠ fe.N := fun e => hy' (by rw [e]; simp)\n  by_cases hv : y ∈ fe.vtr.map (·.1)\n  · rw [fold_σ_in hS hw (flat_last t) hv]\n  · rw [fold_σ_out hS hv, hE y hyn hyN, foldT_frame hS (fun h => hv (hS.vst y h)) hyc, withInputs_other hyi]\n\nend Kern\n",
+    "Data.lean": "import Cyclic\n\n/-!\nData: recursive datatypes as values, for cyclic proofs. Lean 4.34.0, core only, on top of `Cyclic.lean`.\n\ncore/data.ts proves laws about datatypes (lists, trees, any declared with constructors whose fields are naturals or\nvalues of the datatype) by cyclic proofs over an encoding: every natural is a value of each datatype, a value is read\nthrough maps (its constructor's tag, its fields, its size), a function of several arguments is a map read at their\npairing `pk a b = (a + b)² + b` (left-nested). Nothing here is trusted beyond `Cyclic.lean`: an export defines the\ndatatype as a Lean `inductive` and the functions by pattern matching, gives each map of the encoding its meaning (the\nmodel, through a bijection between the naturals and the datatype's values), proves every fact of the cyclic proof true\nof that model, and concludes the law about the Lean definitions from `cyclic_sound`. What this file gives the exports:\n\n- `pk`, the pairing, injective (`pk_inj`), and a left inverse `unpk` (`unpk_pk`, chosen classically, so no division or\n  square root is computed);\n- `cun`, the naturals onto the pairs, in order of their sum (`cun 0 = (0, 0)`, then each pair after the last), with\n  `cpair` its inverse (`cun_cpair`, `cpair_cun`): a bijection, the one a datatype's codes are built from, each part at\n  most the whole (`cun_fst_le`, `cun_snd_le`) so a value's fields have smaller codes;\n- `tup q k i`, the i-th of k naturals packed in q by `tupk` (`tup_tupk`), at most q (`tup_le`).\n-/\n\nnamespace Kern\n\n/-! ### The pairing the encoding reads several arguments at -/\n\n/-- `(a + b)² + b`: core/dsl.ts's argsKey of two arguments. -/\ndef pk (a b : Nat) : Nat := (a + b) * (a + b) + b\n\ntheorem sq_succ (s : Nat) : (s + 1) * (s + 1) = s * s + 2 * s + 1 := by\n  rw [Nat.add_mul, Nat.mul_add, Nat.mul_one, Nat.one_mul]; omega\n\ntheorem pk_lt {a b c d : Nat} (h : a + b < c + d) : pk a b < pk c d := by\n  unfold pk\n  have h1 : (a + b + 1) * (a + b + 1) ≤ (c + d) * (c + d) := Nat.mul_self_le_mul_self h\n  have h2 := sq_succ (a + b)\n  omega\n\ntheorem pk_inj {a b c d : Nat} (h : pk a b = pk c d) : a = c ∧ b = d := by\n  have hs : a + b = c + d := by\n    rcases Nat.lt_trichotomy (a + b) (c + d) with hl | he | hg\n    · exact absurd h (Nat.ne_of_lt (pk_lt hl))\n    · exact he\n    · exact absurd h (Nat.ne_of_gt (pk_lt hg))\n  unfold pk at h\n  rw [hs] at h\n  omega\n\nopen Classical in\n/-- A left inverse of `pk`: the pair a natural is the pairing of, where it is one. -/\nnoncomputable def unpk (n : Nat) : Nat × Nat :=\n  if h : ∃ p : Nat × Nat, pk p.1 p.2 = n then Classical.choose h else (0, 0)\n\ntheorem unpk_pk (a b : Nat) : unpk (pk a b) = (a, b) := by\n  have h : ∃ p : Nat × Nat, pk p.1 p.2 = pk a b := ⟨(a, b), rfl⟩\n  unfold unpk\n  split\n  · rename_i h'\n    have ⟨h1, h2⟩ := pk_inj (Classical.choose_spec h')\n    exact Prod.ext h1 h2\n  · exact absurd h ‹_›\n\n@[simp] theorem unpk_fst (a b : Nat) : (unpk ((a + b) * (a + b) + b)).1 = a := by\n  have := unpk_pk a b; unfold pk at this; rw [this]\n@[simp] theorem unpk_snd (a b : Nat) : (unpk ((a + b) * (a + b) + b)).2 = b := by\n  have := unpk_pk a b; unfold pk at this; rw [this]\n\n-- The pairing with a 0 argument, as simp leaves it: (a + 0)² + 0 is a·a, (0 + b)² + b is b·b + b, and (0 + 0)² + 0 is 0.\n@[simp] theorem unpk_sq_fst (a : Nat) : (unpk (a * a)).1 = a := by\n  have := unpk_pk a 0; simp only [pk, Nat.add_zero] at this; rw [this]\n@[simp] theorem unpk_sq_snd (a : Nat) : (unpk (a * a)).2 = 0 := by\n  have := unpk_pk a 0; simp only [pk, Nat.add_zero] at this; rw [this]\n@[simp] theorem unpk_sqb_fst (b : Nat) : (unpk (b * b + b)).1 = 0 := by\n  have := unpk_pk 0 b; simp only [pk, Nat.zero_add] at this; rw [this]\n@[simp] theorem unpk_sqb_snd (b : Nat) : (unpk (b * b + b)).2 = b := by\n  have := unpk_pk 0 b; simp only [pk, Nat.zero_add] at this; rw [this]\n@[simp] theorem unpk_zero : unpk 0 = (0, 0) := unpk_pk 0 0\n\n/-! ### A bijection between the naturals and the pairs -/\n\n/-- The naturals onto the pairs, in order of their sum: 0 is (0, 0), and each next natural the pair after. -/\ndef cun : Nat → Nat × Nat\n  | 0 => (0, 0)\n  | n + 1 => match cun n with\n    | (0, b) => (b + 1, 0)\n    | (a + 1, b) => (a, b + 1)\n\n/-- 0 + 1 + … + s. -/\ndef tri : Nat → Nat\n  | 0 => 0\n  | s + 1 => tri s + s + 1\n\n/-- `cun`'s inverse. -/\ndef cpair (a b : Nat) : Nat := tri (a + b) + b\n\ntheorem le_tri : ∀ s, s ≤ tri s\n  | 0 => Nat.le_refl 0\n  | s + 1 => by have := le_tri s; simp only [tri]; omega\n\ntheorem cpair_succ_left (b : Nat) : cpair (b + 1) 0 = cpair 0 b + 1 := by\n  simp only [cpair, Nat.add_zero, Nat.zero_add, tri]\n\ntheorem cpair_succ_right (a b : Nat) : cpair a (b + 1) = cpair (a + 1) b + 1 := by\n  simp only [cpair]\n  have e : a + (b + 1) = a + 1 + b := by omega\n  rw [e]; omega\n\ntheorem cpair_cun : ∀ n, cpair (cun n).1 (cun n).2 = n\n  | 0 => rfl\n  | n + 1 => by\n    have ih := cpair_cun n\n    rcases h : cun n with ⟨a, b⟩\n    rw [h] at ih\n    cases a with\n    | zero => simp only [cun, h]; rw [cpair_succ_left]; simp only at ih; omega\n    | succ a => simp only [cun, h]; rw [cpair_succ_right]; simp only at ih; omega\n\ntheorem cun_tri : ∀ s b, b ≤ s → cun (tri s + b) = (s - b, b)\n  | 0, 0, _ => rfl\n  | 0, _ + 1, h => absurd h (by omega)\n  | s + 1, 0, _ => by\n    have ih := cun_tri s s (Nat.le_refl s)\n    have e : tri (s + 1) + 0 = (tri s + s) + 1 := by simp only [tri]; try omega\n    rw [e]\n    simp only [cun, ih, Nat.sub_self, Nat.sub_zero]\n  | s + 1, b + 1, h => by\n    have ih := cun_tri (s + 1) b (by omega)\n    have e : tri (s + 1) + (b + 1) = (tri (s + 1) + b) + 1 := by omega\n    rw [e]\n    simp only [cun, ih]\n    have e2 : s + 1 - b = (s - b) + 1 := by omega\n    rw [e2]\n    simp only\n    have e3 : s + 1 - (b + 1) = s - b := by omega\n    rw [e3]\n\ntheorem cun_cpair (a b : Nat) : cun (cpair a b) = (a, b) := by\n  unfold cpair\n  rw [cun_tri (a + b) b (by omega)]\n  simp\n\n@[simp] theorem cun_cpair_fst (a b : Nat) : (cun (cpair a b)).1 = a := by rw [cun_cpair]\n@[simp] theorem cun_cpair_snd (a b : Nat) : (cun (cpair a b)).2 = b := by rw [cun_cpair]\n@[simp] theorem cpair_cun_eq (n : Nat) : cpair (cun n).1 (cun n).2 = n := cpair_cun n\n\ntheorem cpair_ge (a b : Nat) : a + b ≤ cpair a b := by\n  unfold cpair; have := le_tri (a + b); omega\n\ntheorem cun_fst_le (n : Nat) : (cun n).1 ≤ n := by\n  have h := cpair_ge (cun n).1 (cun n).2; rw [cpair_cun] at h; omega\ntheorem cun_snd_le (n : Nat) : (cun n).2 ≤ n := by\n  have h := cpair_ge (cun n).1 (cun n).2; rw [cpair_cun] at h; omega\n\n/-! ### Tuples of naturals -/\n\n/-- The i-th of k naturals packed in q (`tupk`): the first is `(cun q).1`, the rest packed in `(cun q).2`, the last q\nitself. -/\ndef tup (q : Nat) : Nat → Nat → Nat\n  | 0, _ => q\n  | 1, _ => q\n  | _ + 2, 0 => (cun q).1\n  | k + 2, i + 1 => tup (cun q).2 (k + 1) i\n\n/-- Naturals packed by `cpair`, right-nested; one is itself. -/\ndef tupk : List Nat → Nat\n  | [] => 0\n  | [x] => x\n  | x :: xs => cpair x (tupk xs)\n\ntheorem tup_le : ∀ (k i q : Nat), tup q k i ≤ q\n  | 0, _, _ => Nat.le_refl _\n  | 1, _, _ => Nat.le_refl _\n  | _ + 2, 0, q => cun_fst_le q\n  | k + 2, i + 1, q => Nat.le_trans (tup_le (k + 1) i (cun q).2) (cun_snd_le q)\n\n@[simp] theorem tup_two_zero (k a q : Nat) : tup (cpair a q) (k + 2) 0 = a := by simp [tup]\n@[simp] theorem tup_two_succ (k i a q : Nat) : tup (cpair a q) (k + 2) (i + 1) = tup q (k + 1) i := by simp [tup]\n@[simp] theorem tup_one (q i : Nat) : tup q 1 i = q := rfl\n@[simp] theorem tupk_one (x : Nat) : tupk [x] = x := rfl\n@[simp] theorem tupk_cons (x y : Nat) (ys : List Nat) : tupk (x :: y :: ys) = cpair x (tupk (y :: ys)) := rfl\n\n/-! ### Facts at their keys -/\n\n/-- A condition's value as a natural is at most 1 (a function to `Bool` as the encoding reads it). -/\n@[simp] theorem ite_one_zero_le (p : Prop) [Decidable p] : (if p then 1 else 0) ≤ 1 := by\n  split <;> omega\n\n/-- A fact read at its own keys reads the values given there. -/\ntheorem override_at (keys : List Nat) (i : Nat) (h : keys.contains i = true) (vals env : Nat → Nat) :\n    override keys vals env i = vals i := by\n  unfold override; rw [if_pos h]\n\nend Kern\n",
 };