gdp-wired 0.2.0 → 0.3.0

package/dist/lean-kernel/library.js

@@ -0,0 +1,13 @@
+// Generated by scripts/gen-lean-library.ts from lean-kernel/*.lean (the twin): do not edit.
+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\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 Int\n  const : Int\nderiving Repr\n\ndef dot : List Int → List Int → Int\n  | c :: cs, y :: ys => c * y + dot cs ys\n  | _, _ => 0\n\ndef eval (r : Row) (x : List Int) : Int := dot r.coefs x + r.const\n\ndef addL : List Int → List Int → List Int\n  | a :: as, b :: bs => (a + b) :: addL as bs\n  | [], bs => bs\n  | as, [] => as\n\ndef scaleL (m : Int) : List Int → List Int\n  | [] => []\n  | a :: as => (m * a) :: scaleL m as\n\ntheorem dot_nil_right : ∀ (a : List Int), dot a [] = 0\n  | [] => rfl\n  | _ :: _ => rfl\n\ntheorem dot_addL : ∀ (a b x : List Int), dot (addL a b) x = dot a x + dot b x\n  | [], b, x => by simp [addL, dot]\n  | _ :: _, [], x => by simp [addL, dot]\n  | a :: as, b :: bs, [] => by simp [addL, dot]\n  | a :: as, b :: bs, y :: ys => by\n    simp only [addL, dot, dot_addL as bs ys, Int.add_mul]\n    omega\n\ntheorem dot_scaleL (m : Int) : ∀ (a x : List Int), dot (scaleL m a) x = m * dot a x\n  | [], x => by simp [scaleL, dot]\n  | _ :: _, [] => by simp [scaleL, dot]\n  | a :: as, y :: ys => by\n    simp only [scaleL, dot, dot_scaleL m as ys, Int.mul_add, Int.mul_assoc]\n\ndef allZero : List Int → Bool\n  | [] => true\n  | c :: cs => c == 0 && allZero cs\n\ntheorem dot_allZero : ∀ (a x : List Int), allZero a = true → dot a x = 0\n  | [], _, _ => by simp [dot]\n  | _ :: _, [], _ => rfl\n  | c :: cs, y :: ys, h => by\n    simp only [allZero, Bool.and_eq_true, beq_iff_eq] at h\n    simp [dot, h.1, dot_allZero cs ys 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 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\n-- Coefficient lists compare up to trailing zeros: a combination keeps the longer list's length, while a certificate\n-- may write the cut's quotient without its trailing zeros. Trimming changes no dot product (dot_trimZ).\ndef trimZ : List Int → List Int\n  | [] => []\n  | a :: as => match trimZ as with\n    | [] => if a = 0 then [] else [a]\n    | t => a :: t\n\ntheorem dot_trimZ : ∀ (a x : List Int), dot (trimZ a) x = dot a x\n  | [], _ => rfl\n  | _ :: _, [] => by simp only [dot_nil_right]\n  | a :: as, y :: ys => by\n    have ih := dot_trimZ as ys\n    have key : trimZ (a :: as) = (match trimZ as with | [] => if a = 0 then [] else [a] | t => a :: t) := rfl\n    rw [key]\n    cases h : trimZ as with\n    | nil =>\n      rw [h] at ih\n      have h0 : dot as ys = 0 := by rw [← ih]; simp [dot]\n      by_cases ha : a = 0\n      · simp [ha, dot, h0]\n      · simp [ha, dot, h0]\n    | cons t0 ts =>\n      rw [h] at ih\n      simp only [dot]\n      rw [ih]\n\ndef cutOk (A : Row) (g : Int) (q : List Int) (c : Int) : Bool :=\n  decide (1 ≤ g) && decide (trimZ A.coefs = trimZ (scaleL g q)) && decide (g * c ≤ A.const + g - 1)\n\ndef replay (inputs : List Row) : List Step → List Row → Option (List Row)\n  | [], rows => some rows\n  | .input i :: ss, rows =>\n    match inputs[i]? with\n    | some r => replay inputs ss (rows ++ [r])\n    | none => none\n  | .combine a b ma mb :: ss, rows =>\n    match rows[a]?, rows[b]? with\n    | some A, some B => if 0 < ma ∧ 0 < mb then replay inputs ss (rows ++ [combineRow ma mb A B]) else none\n    | _, _ => none\n  | .cut o g q c :: ss, rows =>\n    match rows[o]? with\n    | some A => if cutOk A g q c then replay inputs ss (rows ++ [⟨q, c⟩]) else none\n    | none => none\n\ndef check (inputs : List Row) (steps : List Step) : Bool :=\n  match replay inputs steps [] with\n  | some rows =>\n    match rows.getLast? 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) (rows out : List Row), (∀ r ∈ rows, eval r x ≤ 0) →\n      replay inputs ss rows = some out → ∀ r ∈ out, eval r x ≤ 0 := by\n  intro ss\n  induction ss with\n  | nil =>\n    intro rows out hrows h\n    simp only [replay, Option.some.injEq] at h\n    exact h ▸ hrows\n  | cons s ss ih =>\n    intro 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_append.mp hr' with hr' | hr'\n        · exact hrows r' hr'\n        · simp only [List.mem_singleton] at hr'\n          exact hr' ▸ hx r (List.mem_of_getElem? 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_append.mp hr' with hr' | hr'\n          · exact hrows r' hr'\n          · simp only [List.mem_singleton] at 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 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_append.mp hr' with hr' | hr'\n          · exact hrows r' hr'\n          · simp only [List.mem_singleton] at 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\n              rw [← dot_trimZ A.coefs x, hq, dot_trimZ, 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 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 [] rows (by simp) hrows\n      have := hall r (List.mem_of_getLast? hr)\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\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 unitL : Nat → List Int\n  | 0 => [1]\n  | j + 1 => 0 :: unitL j\ndef lunit (j : Nat) : Row := ⟨unitL j, 0⟩\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 dot_unitL : ∀ (j : Nat) (x : List Int), dot (unitL j) x = x.getD j 0\n  | 0, [] => rfl\n  | 0, y :: ys => by simp [unitL, dot]\n  | _ + 1, [] => rfl\n  | j + 1, y :: ys => by simp [unitL, dot, dot_unitL j ys]\ntheorem eval_lunit (j : Nat) (x : List Int) : eval (lunit j) x = x.getD j 0 := by\n  simp [eval, lunit, dot_unitL]\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\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\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 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\ndef fac (tab : List VDef) (i : Nat) : Option (List Nat) :=\n  match tab[i]? with\n  | some (.var _) => some [i]\n  | some (.mono fs) => some fs\n  | _ => 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 · Σ_t b_t x_(j+t)\ndef mulRow (tab : List VDef) (i : Nat) : Nat → List Int → Option Row\n  | _, [] => some (lconst 0)\n  | j, b :: bs => match mulRow tab i (j + 1) bs with\n    | none => none\n    | some r => if b == 0 then some r else match pcol tab i j with\n      | some k => some (ladd (lscale b (lunit k)) r)\n      | none => none\n-- (Σ_s a_s x_(i+s)) · Σ_t b_t x_t\ndef mulRows (tab : List VDef) (bs : List Int) : Nat → List Int → Option Row\n  | _, [] => some (lconst 0)\n  | i, a :: as => match mulRows tab bs (i + 1) as with\n    | none => none\n    | some r => if a == 0 then some r else match mulRow tab i 0 bs with\n      | some q => some (ladd (lscale a q) r)\n      | none => none\ndef rowMul (tab : List VDef) (a b : Row) : Option Row :=\n  match mulRows tab b.coefs 0 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\ndef dotAt (x : List Int) : Nat → List Int → Int\n  | _, [] => 0\n  | j, b :: bs => b * x.getD j 0 + dotAt x (j + 1) bs\ntheorem dotAt_cons (y : Int) (ys : List Int) : ∀ j bs, dotAt (y :: ys) (j + 1) bs = dotAt ys j bs\n  | _, [] => rfl\n  | j, b :: bs => by simp only [dotAt, List.getD_cons_succ, dotAt_cons y ys (j + 1) bs]\ntheorem dotAt_nil : ∀ j bs, dotAt [] j bs = 0\n  | _, [] => rfl\n  | j, b :: bs => by simp [dotAt, dotAt_nil (j + 1) bs]\ntheorem dot_dotAt : ∀ (bs x : List Int), dot bs x = dotAt x 0 bs\n  | [], x => by cases x <;> rfl\n  | b :: bs, [] => by simp [dot, dotAt, dotAt_nil]\n  | b :: bs, y :: ys => by simp only [dot, dotAt, List.getD_cons_zero, dotAt_cons, dot_dotAt bs ys]\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 => none\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 => none\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 => none\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 => none\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 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  · simp only [Option.some.injEq] at h; subst h; simp [prodV]\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 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    ∀ j bs r, mulRow tab i j bs = some r → eval r x = x.getD i 0 * dotAt x j bs\n  | _, [], r, h => by simp only [mulRow, Option.some.injEq] at h; subst h; simp [eval_lconst, dotAt]\n  | j, b :: 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 (j + 1) 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; subst hb; simp [dotAt, 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 [dotAt]; rw [Int.mul_add, Int.mul_left_comm (x.getD i 0) b]\n        · simp at h\n\ntheorem mulRows_sound (hM : Model tab env maps x) (bs : List Int) :\n    ∀ i as r, mulRows tab bs i as = some r → eval r x = dotAt x i as * dotAt x 0 bs\n  | _, [], r, h => by simp only [mulRows, Option.some.injEq] at h; subst h; simp [eval_lconst, dotAt]\n  | i, a :: 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 (i + 1) 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; subst ha; simp [dotAt, 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 i 0 bs q hq, ih]\n          simp only [dotAt]; 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 0 a.coefs p hp\n    rw [← dot_dotAt, ← dot_dotAt] at e\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      · simp at 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      · simp at 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      · simp at 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    · simp at 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  | _, _ => []\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)\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.\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\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\ndef checkT (tab : List VDef) (hyps : List C) : Path → Tree → Bool\n  | path, .split l y n => checkT tab hyps (path ++ [(l, true)]) y && checkT tab hyps (path ++ [(l, false)]) n\n  | path, .leaf rows steps eqs prods => leafOk tab path hyps rows 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 => decide (k.coefs.length ≤ n) && wfTab (n + 1) ds\n  | n, .mono fs :: ds => fs.all (· < n) && 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 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⟩\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\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 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_append.mp ha with ha | ha\n      · exact hP a ha\n      · simp only [List.mem_singleton] at ha; subst ha; simpa using hl\n    · refine checkT_sound hM hH n _ ?_ h.2\n      intro a ha\n      rcases List.mem_append.mp ha with ha | ha\n      · exact hP a ha\n      · simp only [List.mem_singleton] at ha; subst ha; simpa using hl\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\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 l1 l2 : List Int), a.length ≤ l1.length → dot a (l1 ++ l2) = dot a l1\n  | [], _, _, _ => by simp [dot]\n  | _ :: _, [], _, h => by simp at h\n  | c :: cs, y :: ys, l2, h => by\n    simp only [List.length_cons, Nat.add_le_add_iff_right] at h\n    simp only [List.cons_append, dot, dot_append cs ys l2 h]\n\n-- What a column may refer to: only earlier columns.\ndef Refs (n : Nat) : VDef → Prop\n  | .var _ => True\n  | .cell _ k => k.coefs.length ≤ n\n  | .mono fs => ∀ f ∈ fs, f < n\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 => by simp only [Refs] at hd ⊢; omega\n  | .mono _, hd => fun f hf => by have := hd f hf; omega\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\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, 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    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`. The\ngoals are built here: invariants hold at the start and each turn keeps them, and a tuple of natural ranks drops in\norder (lexicographically) on every turn the invariants allow. Ranks may not read the turn's inputs: a rank over an\ninput compares two values at one turn's input, which says nothing about the next turn's. -/\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-- The ranks after the turn (each substituted by the body) are below the ranks before, compared in order.\ndef dropsC (σ : List (Nat × E)) : List E → C\n  | [] => .lt (.const 0) (.const 0)\n  | [r] => .lt (substE σ r) r\n  | r :: rest => .or (.lt (substE σ r) r) (.and (.eq (substE σ r) r) (dropsC σ rest))\n\ndef during (l : Loop) (laws : List C) : List C := [l.pre, l.assume, l.guard] ++ laws\ndef loopStart (l : Loop) (law : C) : List C := [l.pre, .not (substC l.init law)]\ndef loopTurn (l : Loop) (laws : List C) (law : C) : List C := during l laws ++ [.not (substC l.body law)]\ndef rankGoal (l : Loop) (laws : List C) (ranks : List E) : List C := during l laws ++ [.not (dropsC l.body ranks)]\n\n-- Per invariant: the law, then (table, tree) for its start goal and its turn goal; then the ranks and the rank tree.\nstructure LoopProof where\n  laws : MachineProof\n  ranks : List E\n  rank : List VDef × Tree\n\ndef checkLoop (l : Loop) (ps : LoopProof) : Bool :=\n  avoids (l.inputs ++ l.init.map (·.1) ++ l.body.map (·.1)) l.pre\n    && ps.ranks.all (fun r => l.inputs.all fun i => !occE i r)\n    && ps.laws.all (fun p => avoids l.inputs p.1\n      && checkGoal ⟨p.2.1.1, loopStart l p.1⟩ p.2.1.2\n      && checkGoal ⟨p.2.2.1, loopTurn l (ps.laws.map (·.1)) p.1⟩ p.2.2.2)\n    && checkGoal ⟨ps.rank.1, rankGoal l (ps.laws.map (·.1)) ps.ranks⟩ ps.rank.2\n\n-- Tuples compared in order.\ndef lexLt : List Nat → List Nat → Prop\n  | a :: as, b :: bs => a < b ∨ (a = b ∧ lexLt as bs)\n  | _, _ => False\n\ntheorem drops_lex (σ : List (Nat × E)) (W : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ∀ rs : List E, evalC W maps (dropsC σ rs) = true →\n      lexLt (rs.map (evalE (applyS σ W maps) maps)) (rs.map (evalE W maps))\n  | [], h => by simp [dropsC, evalC, evalE] at h\n  | [r], h => by\n    simp only [dropsC, evalC, decide_eq_true_eq, subst_evalE] at h\n    simp only [List.map, lexLt]; exact Or.inl h\n  | r :: r2 :: rest, h => by\n    simp only [dropsC, evalC, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq, subst_evalE] at h\n    simp only [List.map] at h ⊢\n    rw [lexLt]\n    rcases h with h | ⟨he, h⟩\n    · exact Or.inl h\n    · exact Or.inr ⟨he, by simpa only [List.map] using drops_lex σ W maps (r2 :: rest) h⟩\n\ntheorem antitone_le (h : Nat → Nat) (hd : ∀ n, h (n + 1) ≤ h n) : ∀ n m, h (n + m) ≤ h n\n  | _, 0 => Nat.le_refl _\n  | n, m + 1 => Nat.le_trans (hd (n + m)) (antitone_le h hd n m)\n\n-- A non-increasing sequence of naturals is constant from some point on.\ntheorem eventually_const (v : Nat) : ∀ (h : Nat → Nat), h 0 ≤ v → (∀ n, h (n + 1) ≤ h n) → ∃ N, ∀ n, h (N + n) = h N := by\n  induction v with\n  | zero => intro h h0 hd; exact ⟨0, fun n => by have := antitone_le h hd 0 n; simp at this ⊢; omega⟩\n  | succ v ih =>\n    intro h h0 hd\n    by_cases hc : ∀ n, h n = h 0\n    · exact ⟨0, fun n => by simp [hc]⟩\n    · obtain ⟨m, hm⟩ := Classical.not_forall.mp hc\n      have hle := antitone_le h hd 0 m\n      simp only [Nat.zero_add] at hle\n      obtain ⟨N, hN⟩ := ih (fun n => h (m + n)) (by simp only [Nat.add_zero]; omega) (fun n => hd (m + n))\n      exact ⟨m + N, fun n => by have := hN n; simp only [Nat.add_assoc] at this ⊢; exact this⟩\n\ntheorem lexLt_cons {x y : List Nat} {k : Nat} (hx : x.length = k + 1) (hy : y.length = k + 1) (h : lexLt x y) :\n    x.headD 0 ≤ y.headD 0 ∧ (x.headD 0 = y.headD 0 → lexLt x.tail y.tail) := by\n  cases x with\n  | nil => simp at hx\n  | cons a as =>\n    cases y with\n    | nil => simp at hy\n    | cons b bs =>\n      simp only [lexLt] at h\n      simp only [List.headD_cons, List.tail_cons]\n      rcases h with h | ⟨h1, h2⟩\n      · exact ⟨Nat.le_of_lt h, fun e => absurd e (Nat.ne_of_lt h)⟩\n      · exact ⟨Nat.le_of_eq h1, fun _ => h2⟩\n\n-- Tuples of naturals of one length can't drop forever.\ntheorem no_descent (k : Nat) : ∀ f : Nat → List Nat, (∀ n, (f n).length = k) → (∀ n, lexLt (f (n + 1)) (f n)) → False := by\n  induction k with\n  | zero =>\n    intro f hl hd\n    have h0 := hd 0\n    have a := hl 0; have b := hl 1\n    rw [List.length_eq_zero_iff] at a b\n    rw [a, b] at h0; simp [lexLt] at h0\n  | succ k ih =>\n    intro f hl hd\n    have hc := fun n => lexLt_cons (hl (n + 1)) (hl n) (hd n)\n    obtain ⟨N, hN⟩ := eventually_const _ (fun n => (f n).headD 0) (Nat.le_refl _) (fun n => (hc n).1)\n    refine ih (fun n => (f (N + n)).tail) (fun n => by simp [hl]) (fun n => ?_)\n    have := (hc (N + n)).2 (by have a := hN (n + 1); have b := hN n; simp only [← Nat.add_assoc] at a; omega)\n    simpa [Nat.add_assoc] using this\n\ntheorem avoidsE_eq {vs : List Nat} {r : E} (h : ∀ i ∈ vs, (!occE i r) = true) {ρ ρ' : Nat → Nat} (maps : Nat → Nat → Nat)\n    (hρ : ∀ i, i ∉ vs → ρ i = ρ' i) : evalE ρ maps r = evalE ρ' maps r :=\n  congrE ρ ρ' maps r (fun i hi => hρ i (fun hm => by have := h i hm; simp [hi] at this))\n\n/-- Termination: for params that meet the precondition, an accepted loop proof admits no infinite run. -/\ntheorem loop_sound (l : Loop) (ps : LoopProof) (h : checkLoop l ps = true) (maps : Nat → Nat → Nat) (ρ0 : Nat → Nat)\n    (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  simp only [checkLoop, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨hpre, hrk⟩, hlaws⟩, hrank⟩ := h\n  -- The precondition and every invariant hold all along the run.\n  have inv : ∀ n, evalC (f n) maps l.pre = true ∧ ∀ q ∈ ps.laws, evalC (f n) maps q.1 = true := by\n    intro n\n    induction n with\n    | zero =>\n      rw [hf0]\n      have hp : evalC (applyS l.init ρ0 maps) maps l.pre = true := by\n        rw [evalC_avoids hpre maps (ρ' := ρ0) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ0 maps)]; exact h0\n      refine ⟨hp, fun q hq => ?_⟩\n      apply Decidable.byContradiction; intro hn\n      apply sound _ _ (hlaws q hq).1.2 ρ0 maps\n      intro c hc\n      simp only [loopStart, 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 hn\n    | succ n ih =>\n      obtain ⟨ι, hg, ha, he⟩ := hf n\n      have hW : ∀ c, avoids l.inputs c = true → evalC (withInputs l.inputs (f n) ι) maps c = evalC (f n) maps c :=\n        fun c hc => evalC_avoids hc maps (fun i hi => withInputs_other hi (f n) ι)\n      have hpW : evalC (withInputs l.inputs (f n) ι) maps l.pre = true := by\n        rw [evalC_avoids hpre maps (ρ' := f n) (fun i hi => withInputs_other (fun h => hi (by simp [h])) (f n) ι)]; exact ih.1\n      refine ⟨?_, fun q hq => ?_⟩\n      · rw [he, evalC_avoids hpre maps (ρ' := f n) (fun i hi => by\n          rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih.1\n      · rw [he]\n        apply Decidable.byContradiction; intro hn\n        apply sound _ _ (hlaws q hq).2 (withInputs l.inputs (f n) ι) maps\n        intro c hc\n        simp only [loopTurn, during, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n        rcases hc with (((rfl | rfl | rfl) | hc) | rfl)\n        · exact hpW\n        · exact ha\n        · exact hg\n        · obtain ⟨q', hq', rfl⟩ := List.mem_map.mp hc\n          rw [hW _ (hlaws q' hq').1.1]; exact ih.2 q' hq'\n        · simp only [evalC, subst_evalC]; simpa using hn\n  -- The ranks drop on every turn.\n  apply no_descent ps.ranks.length (fun n => ps.ranks.map (evalE (f n) maps)) (fun n => by simp)\n  intro n\n  obtain ⟨ι, hg, ha, he⟩ := hf n\n  have hd : evalC (withInputs l.inputs (f n) ι) maps (dropsC l.body ps.ranks) = true := by\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hrank (withInputs l.inputs (f n) ι) maps\n    intro c hc\n    simp only [rankGoal, during, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with (((rfl | rfl | rfl) | hc) | rfl)\n    · rw [evalC_avoids hpre maps (ρ' := f n) (fun i hi => withInputs_other (fun h => hi (by simp [h])) (f n) ι)]; exact (inv n).1\n    · exact ha\n    · exact hg\n    · obtain ⟨q', hq', rfl⟩ := List.mem_map.mp hc\n      rw [evalC_avoids (hlaws q' hq').1.1 maps (fun i hi => withInputs_other hi (f n) ι)]; exact (inv n).2 q' hq'\n    · simp only [evalC]; simpa using hn\n  have := drops_lex l.body _ maps ps.ranks hd\n  rw [← he] at this\n  have hm : ps.ranks.map (evalE (withInputs l.inputs (f n) ι) maps) = ps.ranks.map (evalE (f n) maps) :=\n    List.map_congr_left (fun r hr => avoidsE_eq (hrk r hr) maps (fun i hi => withInputs_other hi (f n) ι))\n  rw [hm] at this\n  exact this\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.loop_sound\n#print axioms Kern.fold_sound\n#print axioms Kern.mmachine_sound\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",
+    "History.lean": "import Progress\n/-!\nHistory: kernel.ts's `historyMachine`, the rule for a machine that keeps a log of the requests it accepts.\n\nA machine with a history (`HMachine`) is a machine with maps and flags plus:\n- `keep`: whether a request is appended to the history (read with the flags decided);\n- `record`, `rvars`: the recorded inputs, and the variables (r.f) a sum or query reads them as;\n- `sums`: state variables defined as the sum, over the history, of a term of the record and the params;\n- `queries`: inputs whose value at each request is the sum, over the history before it, of a term of the record, the\n  params and the request's other (plain) inputs;\n- `rels`: relations (when, a, b): `when` (params and plain inputs) implies a ≤ b, with a and b homogeneous (+ and × by\n  a constant, no constant term) over sums and queries.\n\n`HReach` is the history semantics: the history is a list of request environments (sums and queries only read their\nrecorded inputs from them), every sum is recomputed from it, every query is computed from it at the request.\nLean builds what kernel.ts builds: the plain machine (`HMachine.plain`: each sum a state variable from 0, plus its term\nat the request when the request is kept; the relations conjoined to the assumption) and one goal per relation, a ≤ b\nfor a single record (`recordGoal`), and checks kernel.ts's side conditions (`histOk`). `hmachine_sound`: if those goals\ncheck and the plain machine's proof checks (`checkFMMachine`), every law holds in every state the history semantics\nreaches. The step from one record to the whole history (`homog_sum`, `sum_le_map`): a homogeneous term of sums over one\nlist is the sum of the term over its elements.\n-/\nnamespace Kern\nopen Cert\n\nstructure HMachine where\n  f : FMMachine                 -- the machine without its history; its inputs include the queries\n  keep : C                      -- whether the request is appended to the history (flags decided)\n  record : List Nat             -- the recorded inputs\n  rvars : List Nat              -- the record's fields as variables, one per recorded input\n  sums : List (Nat × E)         -- a sum's state variable and its term over the fields and the params\n  queries : List (Nat × E)      -- a query's input variable and its term over the fields, params and plain inputs\n  rels : List (C × E × E)       -- (when, a, b): a ≤ b whenever `when` holds\n\n-- A field reads its recorded input from the record; every other variable reads ρ.\ndef fieldEnv (h : HMachine) (rec ρ : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun p => p.1 == i) (h.rvars.zip h.record) with\n  | some p => rec p.2\n  | none => ρ i\n\ndef sumAt (h : HMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) (g : E) : Nat :=\n  (hist.map fun rec => evalE (fieldEnv h rec ρ) M g).sum\n\ndef withSums (h : HMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat := fun i =>\n  match assoc h.sums i with\n  | some g => sumAt h ρ M hist g\n  | none => ρ i\n\ndef withQueries (h : HMachine) (X : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat := fun i =>\n  match assoc h.queries i with\n  | some g => sumAt h X M hist g\n  | none => X i\n\ndef plainInputs (h : HMachine) : List Nat := h.f.m.inputs.filter fun i => !(h.queries.map (·.1)).contains i\n\n-- The request as the step reads it: plain inputs from ι, queries from the history, flags decided.\ndef reqEnv (h : HMachine) (ρ ι : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat :=\n  decideFlags h.f.flags (withQueries h (withInputs (plainInputs h) ρ ι) M hist) M\n\ndef kept (h : HMachine) (X : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : List (Nat → Nat) :=\n  if evalC X M h.keep then hist ++ [X] else hist\n\ninductive HReach (h : HMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps h.f.m M → evalC ρ M h.f.m.pre = true →\n      HReach h (withSums h (applyS h.f.m.init ρ M) M []) M []\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) (ι : Nat → Nat) : HReach h ρ M hist →\n      evalC (reqEnv h ρ ι M hist) M h.f.m.assume = true →\n      HReach h (withSums h (applyS h.f.m.step (reqEnv h ρ ι M hist) M) M (kept h (reqEnv h ρ ι M hist) M hist))\n        (writeMaps h.f.m.writes (reqEnv h ρ ι M hist) M) (kept h (reqEnv h ρ ι M hist) M hist)\n\n/-! What Lean builds -/\n\ndef fieldSub (h : HMachine) : List (Nat × E) := (h.rvars.zip h.record).map fun p => (p.1, .var p.2)\ndef TRUEC : C := .le (.const 0) (.const 0)\ndef relC (r : C × E × E) : C := .or (.not r.1) (.le r.2.1 r.2.2)\ndef relsC (rs : List (C × E × E)) : C := rs.foldr (fun r acc => .and (relC r) acc) TRUEC\ndef sumStep (h : HMachine) (s : Nat) (g : E) : E := .add (.var s) (.ite h.keep (substE (fieldSub h) g) (.const 0))\n\ndef HMachine.plain (h : HMachine) : FMMachine :=\n  { m := { h.f.m with\n      init := h.f.m.init ++ h.sums.map fun p => (p.1, .const 0)\n      step := h.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2)\n      assume := .and h.f.m.assume (relsC h.rels) }\n    flags := h.f.flags }\n\n-- One record: the relation's two sides with each sum and query read as its term at that record.\ndef recordGoal (h : HMachine) (r : C × E × E) : List C :=\n  [h.f.m.pre, r.1, .not (.le (substE (h.sums ++ h.queries) r.2.1) (substE (h.sums ++ h.queries) r.2.2))]\n\nmutual\ndef homog (vs : List Nat) : E → Bool\n  | .var i => vs.contains i\n  | .add a b => homog vs a && homog vs b\n  | .mul _ a => homog vs a\n  | _ => false\ndef homogC (_vs : List Nat) : C → Bool\n  | _ => false\nend\n\n\n-- kernel.ts's checks: sums read the fields and params, queries also the plain inputs, `when` the params and plain\n-- inputs; nothing reads a map; the names don't collide; the precondition reads no input, flag or field.\ndef histOk (h : HMachine) : Bool :=\n  let ins := h.f.m.inputs\n  let qs := h.queries.map (·.1)\n  let ss := h.sums.map (·.1)\n  let st := h.f.m.init.map (·.1) ++ h.f.m.step.map (·.1)\n  let fv := flagVars h.f.flags\n  h.rvars.length == h.record.length\n  && qs.all (fun q => ins.contains q)\n  && h.record.all (fun i => (plainInputs h).contains i)\n  && ss.all (fun s => !(ins ++ st ++ fv ++ h.rvars).contains s)\n  && h.rvars.all (fun v => !(ins ++ st ++ fv).contains v)\n  && fv.all (fun v => !ins.contains v)\n  && h.sums.all (fun p => avoidsE (ins ++ st ++ ss ++ fv) p.2 && !readsE p.2)\n  && h.queries.all (fun p => avoidsE (qs ++ st ++ ss ++ fv) p.2 && !readsE p.2)\n  && h.rels.all (fun r => avoids (qs ++ st ++ ss ++ fv ++ h.rvars) r.1 && !readsC r.1 && homog (ss ++ qs) r.2.1 && homog (ss ++ qs) r.2.2)\n  && avoids (ins ++ fv ++ h.rvars) h.f.m.pre && !readsC h.f.m.pre\n\n-- Per relation, (table, tree) for its record goal, in order; then the plain machine's proof.\ndef checkHMachine (h : HMachine) (ps : List MEntry) (rs : List (List VDef × Tree)) : Bool :=\n  histOk h && rs.length == h.rels.length && (h.rels.zip rs).all (fun p => checkGoal ⟨p.2.1, recordGoal h p.1⟩ p.2.2)\n    && checkFMMachine h.plain ps\n\n/-! Lists and sums -/\n\ntheorem sum_map_add {α : Type} (f g : α → Nat) : ∀ l : List α, (l.map fun x => f x + g x).sum = (l.map f).sum + (l.map g).sum\n  | [] => rfl\n  | a :: as => by simp only [List.map_cons, List.sum_cons, sum_map_add f g as]; omega\n\ntheorem sum_map_mul {α : Type} (k : Nat) (f : α → Nat) : ∀ l : List α, (l.map fun x => k * f x).sum = k * (l.map f).sum\n  | [] => by simp\n  | a :: as => by simp only [List.map_cons, List.sum_cons, sum_map_mul k f as, Nat.mul_add]\n\ntheorem sum_le_map {α : Type} (f g : α → Nat) : ∀ l : List α, (∀ x ∈ l, f x ≤ g x) → (l.map f).sum ≤ (l.map g).sum\n  | [], _ => by simp\n  | a :: as, h => by\n    simp only [List.map_cons, List.sum_cons]\n    exact Nat.add_le_add (h a List.mem_cons_self) (sum_le_map f g as (fun x hx => h x (List.mem_cons_of_mem _ hx)))\n\ntheorem zip_mem_left {α β : Type} : ∀ (l1 : List α) (l2 : List β), l1.length = l2.length → ∀ a ∈ l1, ∃ b, (a, b) ∈ l1.zip l2\n  | [], _, _, a, ha => by simp at ha\n  | _ :: _, [], hl, _, _ => by simp at hl\n  | x :: xs, y :: ys, hl, a, ha => by\n    rcases List.mem_cons.mp ha with rfl | ha\n    · exact ⟨y, by simp⟩\n    · obtain ⟨b, hb⟩ := zip_mem_left xs ys (by simpa using hl) a ha\n      exact ⟨b, by simp [hb]⟩\n\n-- A homogeneous term of variables that are each a sum over one list is the sum of the term over the list.\nmutual\ntheorem homog_sum {vs : List Nat} (M : Nat → Nat → Nat) (X : Nat → Nat) (F : List (Nat → Nat))\n    (hX : ∀ v ∈ vs, X v = (F.map fun Y => Y v).sum) : (a : E) → homog vs a = true →\n    evalE X M a = (F.map fun Y => evalE Y M a).sum\n  | .var i, h => by simp only [homog, List.contains_iff_mem] at h; simp only [evalE]; exact hX i h\n  | .add a b, h => by\n    simp only [homog, Bool.and_eq_true] at h\n    simp only [evalE, homog_sum M X F hX a h.1, homog_sum M X F hX b h.2]\n    exact (sum_map_add (fun Y => evalE Y M a) (fun Y => evalE Y M b) F).symm\n  | .mul k a, h => by\n    simp only [homog] at h\n    simp only [evalE, homog_sum M X F hX a h]\n    exact (sum_map_mul k (fun Y => evalE Y M a) F).symm\n  | .const _, h => by simp [homog] at h\n  | .sub _ _, h => by simp [homog] at h\n  | .min _ _, h => by simp [homog] at h\n  | .max _ _, h => by simp [homog] at h\n  | .prod _ _, h => by simp [homog] at h\n  | .ite _ _ _, h => by simp [homog] at h\n  | .get _ _, h => by simp [homog] at h\ntheorem homog_sumC {vs : List Nat} (_M : Nat → Nat → Nat) (X : Nat → Nat) (F : List (Nat → Nat))\n    (_hX : ∀ v ∈ vs, X v = (F.map fun Y => Y v).sum) : (c : C) → homogC vs c = true → True\n  | _, _ => trivial\nend\n\n/-! Lookups -/\n\ntheorem assoc_append (l1 l2 : List (Nat × E)) (i : Nat) :\n    assoc (l1 ++ l2) i = match assoc l1 i with | some e => some e | none => assoc l2 i := by\n  simp only [assoc, lookup_append]\n  cases lookup (fun p => p.1 == i) l1 <;> rfl\n\ntheorem assoc_map_key (σ : List (Nat × E)) (F : Nat → E → E) (i : Nat) :\n    assoc (σ.map fun p => (p.1, F p.1 p.2)) i = (assoc σ i).map (F i) := by\n  simp only [assoc, lookup_map_pred]\n  cases hl : lookup (fun p => p.1 == i) σ with\n  | none => rfl\n  | some p =>\n    have := (lookup_some hl).2\n    simp only [beq_iff_eq] at this\n    subst this; rfl\n\ntheorem assoc_some_of_mem {σ : List (Nat × E)} {i : Nat} (h : i ∈ σ.map (·.1)) : ∃ e, assoc σ i = some e := by\n  cases ha : assoc σ i with\n  | some e => exact ⟨e, rfl⟩\n  | none =>\n    simp only [assoc, Option.map_eq_none_iff] at ha\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n    have := lookup_none_all ha p hp\n    simp at this\n\ntheorem fieldEnv_other (h : HMachine) {i : Nat} (hi : i ∉ h.rvars) (rec ρ : Nat → Nat) : fieldEnv h rec ρ i = ρ i := by\n  simp only [fieldEnv]\n  cases hl : lookup (fun p => p.1 == i) (h.rvars.zip h.record) with\n  | none => rfl\n  | some p =>\n    have ⟨hm, hp⟩ := lookup_some hl\n    simp only [beq_iff_eq] at hp\n    exact absurd (hp ▸ (List.of_mem_zip hm).1) hi\n\ntheorem fieldSub_apply (h : HMachine) (X : Nat → Nat) (M : Nat → Nat → Nat) : applyS (fieldSub h) X M = fieldEnv h X X := by\n  funext i\n  simp only [applyS, fieldSub, assoc, lookup_map_pred, fieldEnv]\n  cases lookup (fun p => p.1 == i) (h.rvars.zip h.record) <;> rfl\n\ntheorem sumAt_congr (h : HMachine) {ρ ρ' : Nat → Nat} (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) (g : E)\n    (hag : ∀ i, occE i g = true → ρ i = ρ' i) : sumAt h ρ M hist g = sumAt h ρ' M hist g := by\n  unfold sumAt\n  congr 1\n  apply List.map_congr_left\n  intro rec _\n  exact congrE _ _ M g (fun i hi => by\n    simp only [fieldEnv]; split\n    · rfl\n    · exact hag i hi)\n\ntheorem sumAt_maps (h : HMachine) (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) (hist : List (Nat → Nat)) (g : E)\n    (hr : readsE g = false) : sumAt h ρ M hist g = sumAt h ρ M' hist g := by\n  unfold sumAt\n  congr 1\n  apply List.map_congr_left\n  intro rec _\n  exact noReadsE _ M M' g hr\n\n\n/-! The side conditions, unpacked -/\n\nstructure HOk (h : HMachine) : Prop where\n  len : h.rvars.length = h.record.length\n  qs_in : ∀ q ∈ h.queries.map (·.1), q ∈ h.f.m.inputs\n  rec_in : ∀ i ∈ h.record, i ∈ plainInputs h\n  ss_out : ∀ s ∈ h.sums.map (·.1), s ∉ h.f.m.inputs ∧ s ∉ h.f.m.init.map (·.1) ∧ s ∉ h.f.m.step.map (·.1) ∧\n    s ∉ flagVars h.f.flags ∧ s ∉ h.rvars\n  rv_out : ∀ v ∈ h.rvars, v ∉ h.f.m.inputs ∧ v ∉ h.f.m.init.map (·.1) ∧ v ∉ h.f.m.step.map (·.1) ∧ v ∉ flagVars h.f.flags\n  fv_out : ∀ v ∈ flagVars h.f.flags, v ∉ h.f.m.inputs\n  sums_ok : ∀ p ∈ h.sums, avoidsE (h.f.m.inputs ++ (h.f.m.init.map (·.1) ++ h.f.m.step.map (·.1)) ++ h.sums.map (·.1)\n    ++ flagVars h.f.flags) p.2 = true ∧ readsE p.2 = false\n  queries_ok : ∀ p ∈ h.queries, avoidsE (h.queries.map (·.1) ++ (h.f.m.init.map (·.1) ++ h.f.m.step.map (·.1))\n    ++ h.sums.map (·.1) ++ flagVars h.f.flags) p.2 = true ∧ readsE p.2 = false\n  rels_ok : ∀ r ∈ h.rels, avoids (h.queries.map (·.1) ++ (h.f.m.init.map (·.1) ++ h.f.m.step.map (·.1)) ++ h.sums.map (·.1)\n    ++ flagVars h.f.flags ++ h.rvars) r.1 = true ∧ homog (h.sums.map (·.1) ++ h.queries.map (·.1)) r.2.1 = true ∧\n    homog (h.sums.map (·.1) ++ h.queries.map (·.1)) r.2.2 = true\n  pre_ok : avoids (h.f.m.inputs ++ flagVars h.f.flags ++ h.rvars) h.f.m.pre = true ∧ readsC h.f.m.pre = false\n\ntheorem histOk_sound {h : HMachine} (hc : histOk h = true) : HOk h := by\n  simp only [histOk, Bool.and_eq_true] at hc\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hlen, hqs⟩, hrec⟩, hss⟩, hrv⟩, hfv⟩, hsums⟩, hq⟩, hrels⟩, hpre⟩, hpr⟩ := hc\n  simp only [List.all_eq_true] at hqs hrec hss hrv hfv hsums hq hrels\n  refine ⟨by simpa using hlen, fun q hq' => by simpa using hqs q hq', fun i hi => by simpa using hrec i hi, ?_, ?_, ?_, ?_, ?_, ?_,\n    ⟨hpre, by simpa using hpr⟩⟩\n  · intro s hs; have := hss s hs; simpa [not_or] using this\n  · intro v hv; have := hrv v hv; simpa [not_or] using this\n  · intro v hv; have := hfv v hv; simpa using this\n  · intro p hp; have := hsums p hp; simp only [Bool.and_eq_true] at this; exact ⟨this.1, by simpa using this.2⟩\n  · intro p hp; have := hq p hp; simp only [Bool.and_eq_true] at this; exact ⟨this.1, by simpa using this.2⟩\n  · intro r hr; have := hrels r hr; simp only [Bool.and_eq_true] at this; exact ⟨this.1.1.1, this.1.2, this.2⟩\n\n/-! The history semantics simulated by the plain machine -/\n\ntheorem withSums_other (h : HMachine) {i : Nat} (hi : i ∉ h.sums.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (hist : List (Nat → Nat)) : withSums h ρ M hist i = ρ i := by\n  simp only [withSums, assoc_none_of hi]\n\ntheorem plain_sub (h : HMachine) : plainInputs h ⊆ h.f.m.inputs := fun _ hi => (List.mem_filter.mp hi).1\n\ntheorem reqEnv_other {h : HMachine} (ok : HOk h) {i : Nat} (hin : i ∉ h.f.m.inputs) (hf : i ∉ flagVars h.f.flags)\n    (ρ ι : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : reqEnv h ρ ι M hist i = ρ i := by\n  simp only [reqEnv]\n  rw [decide_other hf]\n  simp only [withQueries, assoc_none_of (fun hq => hin (ok.qs_in i hq))]\n  exact withInputs_other (fun hp => hin (plain_sub h hp)) ρ ι\n\n-- In a reached state every sum is its sum over the history.\ntheorem hsum_of_hreach {h : HMachine} (ok : HOk h) : ∀ {ρ M hist}, HReach h ρ M hist →\n    ∀ s g, assoc h.sums s = some g → ρ s = sumAt h ρ M hist g := by\n  have key : ∀ ρ1 M0 M hist s g, assoc h.sums s = some g →\n      withSums h ρ1 M0 hist s = sumAt h (withSums h ρ1 M0 hist) M hist g := by\n    intro ρ1 M0 M hist s g hs\n    obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n      simp only [assoc, Option.map_eq_some_iff] at hs\n      obtain ⟨p, hl, rfl⟩ := hs\n      exact ⟨p, (lookup_some hl).1, rfl⟩\n    have hg := ok.sums_ok p hp\n    rw [hpg] at hg\n    simp only [withSums, hs]\n    rw [sumAt_maps h ρ1 M0 M hist g hg.2]\n    exact sumAt_congr h M hist g (fun i hi => by\n      have := avoidsE_occ hg.1 hi\n      simp only [List.mem_append, not_or] at this\n      exact (withSums_other h this.1.2 ρ1 M0 hist).symm)\n  intro ρ M hist hr\n  cases hr with\n  | start ρ0 M h0 hp => exact fun s g hs => key _ M M [] s g hs\n  | step ρ0 M0 hist0 ι _ _ => exact fun s g hs => key _ M0 _ _ s g hs\n\ntheorem pre_fmreach (f : FMMachine) (ps : List MEntry) (h : checkFMMachine f ps = true) :\n    ∀ {ρ M}, FMReach f ρ M → evalC ρ M f.m.pre = true := by\n  intro ρ M hr\n  simp only [checkFMMachine, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨hf, hpre⟩, _⟩, hc⟩ := h\n  simp only [checkMMachine, Bool.and_eq_true] at hc\n  obtain ⟨⟨hav, hrd⟩, _⟩ := hc\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  have := pre_mreach (m := f.plain) hav (by simpa using hrd) hr₀\n  rw [congrC ρ ρ₀ M f.m.pre (fun j hj => hag j (avoids_occ hpre hj))]\n  exact this\n\ntheorem relsC_true (X : Nat → Nat) (M : Nat → Nat → Nat) :\n    ∀ rs : List (C × E × E), (∀ r ∈ rs, evalC X M (relC r) = true) → evalC X M (relsC rs) = true\n  | [], _ => by simp [relsC, TRUEC, evalC, evalE]\n  | r :: rs, hr => by\n    simp only [relsC, List.foldr_cons, evalC, Bool.and_eq_true]\n    exact ⟨hr r List.mem_cons_self, relsC_true X M rs (fun r' h' => hr r' (List.mem_cons_of_mem _ h'))⟩\n\n-- At a reached state where the precondition holds, every relation holds of the request.\ntheorem rels_hold {h : HMachine} (ok : HOk h)\n    (hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {hist : List (Nat → Nat)}\n    (hsum : ∀ s g, assoc h.sums s = some g → ρ s = sumAt h ρ M hist g) (hpre : evalC ρ M h.f.m.pre = true)\n    (ι : Nat → Nat) : evalC (reqEnv h ρ ι M hist) M (relsC h.rels) = true := by\n  apply relsC_true\n  intro r hr\n  obtain ⟨tt, hck⟩ := hrs r hr\n  obtain ⟨hwav, ha, hb⟩ := ok.rels_ok r hr\n  let X := reqEnv h ρ ι M hist\n  let X0 := withInputs (plainInputs h) ρ ι\n  let gsub := h.sums ++ h.queries\n  let F := hist.map fun rec => applyS gsub (fieldEnv h rec X) M\n  -- Each sum and each query is its sum over the history, at X.\n  have hX : ∀ v ∈ h.sums.map (·.1) ++ h.queries.map (·.1), X v = (F.map fun Y => Y v).sum := by\n    intro v hv\n    have hF : ∀ g, assoc gsub v = some g → (F.map fun Y => Y v).sum = sumAt h X M hist g := by\n      intro g hg\n      simp only [F, List.map_map, sumAt]\n      congr 1\n      apply List.map_congr_left\n      intro rec _\n      simp only [Function.comp, applyS, hg]\n    by_cases hs : v ∈ h.sums.map (·.1)\n    · obtain ⟨g, hg⟩ := assoc_some_of_mem hs\n      have hgs : assoc gsub v = some g := by simp only [gsub, assoc_append, hg]\n      rw [hF g hgs]\n      obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n        simp only [assoc, Option.map_eq_some_iff] at hg\n        obtain ⟨p, hl, rfl⟩ := hg\n        exact ⟨p, (lookup_some hl).1, rfl⟩\n      have hok := ok.sums_ok p hp\n      rw [hpg] at hok\n      have ⟨hvin, _, _, hvf, _⟩ := ok.ss_out v hs\n      show reqEnv h ρ ι M hist v = _\n      rw [reqEnv_other ok hvin hvf, hsum v g hg]\n      exact sumAt_congr h M hist g (fun i hi => by\n        have := avoidsE_occ hok.1 hi\n        simp only [List.mem_append, not_or] at this\n        exact (reqEnv_other ok this.1.1.1 this.2 ρ ι M hist).symm)\n    · have hq : v ∈ h.queries.map (·.1) := by\n        rcases List.mem_append.mp hv with h1 | h1\n        · exact absurd h1 hs\n        · exact h1\n      obtain ⟨g, hg⟩ := assoc_some_of_mem hq\n      have hgs : assoc gsub v = some g := by simp only [gsub, assoc_append, assoc_none_of hs, hg]\n      rw [hF g hgs]\n      obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.queries, p.2 = g := by\n        simp only [assoc, Option.map_eq_some_iff] at hg\n        obtain ⟨p, hl, rfl⟩ := hg\n        exact ⟨p, (lookup_some hl).1, rfl⟩\n      have hok := ok.queries_ok p hp\n      rw [hpg] at hok\n      have hvf : v ∉ flagVars h.f.flags := fun hf => ok.fv_out v hf (ok.qs_in v hq)\n      show decideFlags h.f.flags (withQueries h X0 M hist) M v = _\n      rw [decide_other hvf]\n      simp only [withQueries, hg]\n      exact sumAt_congr h M hist g (fun i hi => by\n        have := avoidsE_occ hok.1 hi\n        simp only [List.mem_append, not_or] at this\n        show X0 i = decideFlags h.f.flags (withQueries h X0 M hist) M i\n        rw [decide_other this.2]\n        simp only [withQueries, assoc_none_of this.1.1.1])\n  simp only [relC, evalC, Bool.or_eq_true, Bool.not_eq_true']\n  by_cases hw : evalC X M r.1 = true\n  · right\n    simp only [decide_eq_true_eq]\n    rw [homog_sum M X F hX r.2.1 ha, homog_sum M X F hX r.2.2 hb]\n    apply sum_le_map\n    intro Y hY\n    obtain ⟨rec, _, rfl⟩ := List.mem_map.mp hY\n    have hs := sound ⟨tt.1, recordGoal h r⟩ tt.2 hck (fieldEnv h rec X) M\n    have hE : ∀ c, avoids h.rvars c = true → evalC (fieldEnv h rec X) M c = evalC X M c := fun c hc =>\n      congrC _ _ M c (fun i hi => fieldEnv_other h (avoids_occ hc hi) rec X)\n    have hpreX : evalC X M h.f.m.pre = true := by\n      have hp := ok.pre_ok.1\n      rw [congrC X ρ M h.f.m.pre (fun i hi => by\n        have := avoids_occ hp hi\n        simp only [List.mem_append, not_or] at this\n        exact reqEnv_other ok this.1.1 this.1.2 ρ ι M hist)]\n      exact hpre\n    apply Decidable.byContradiction\n    intro hlt\n    apply hs\n    intro c hc\n    simp only [recordGoal, List.mem_cons, List.mem_nil_iff, or_false] at hc\n    rcases hc with rfl | rfl | rfl\n    · rw [hE _ (by\n        have hp := ok.pre_ok.1\n        simp only [avoids, List.all_eq_true] at hp ⊢\n        intro i hi; exact hp i (by simp [hi]))]\n      exact hpreX\n    · rw [hE _ (by\n        simp only [avoids, List.all_eq_true] at hwav ⊢\n        intro i hi; exact hwav i (by simp [hi]))]\n      exact hw\n    · simp only [evalC, subst_evalE, Bool.not_eq_true', decide_eq_false_iff_not]\n      exact hlt\n  · left; simpa using hw\n\ntheorem start_eq {h : HMachine} (ok : HOk h) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS h.plain.m.init ρ M = withSums h (applyS h.f.m.init ρ M) M [] := by\n  funext i\n  show applyS (h.f.m.init ++ h.sums.map fun p => (p.1, .const 0)) ρ M i = _\n  simp only [applyS, assoc_append, withSums]\n  cases hs : assoc h.sums i with\n  | some g =>\n    have hi : i ∉ h.f.m.init.map (·.1) := (ok.ss_out i (assoc_mem hs)).2.1\n    simp only [assoc_none_of hi, assoc_map_snd (σ := h.sums) (g := fun _ => .const 0), hs, Option.map_some, evalE,\n      sumAt, List.map_nil, List.sum_nil]\n  | none =>\n    cases hi : assoc h.f.m.init i with\n    | some e => rfl\n    | none => simp only [assoc_map_snd (σ := h.sums) (g := fun _ => .const 0), hs, Option.map_none]\n\ntheorem inputs_eq {h : HMachine} (ok : HOk h) (ρ ι : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) :\n    withInputs h.f.m.inputs ρ (withQueries h (withInputs (plainInputs h) ρ ι) M hist)\n      = withQueries h (withInputs (plainInputs h) ρ ι) M hist := by\n  funext i\n  by_cases hin : i ∈ h.f.m.inputs\n  · simp only [withInputs, List.contains_iff_mem, hin, ite_true]\n  · rw [withInputs_other hin]\n    simp only [withQueries, assoc_none_of (fun hq => hin (ok.qs_in i hq))]\n    exact (withInputs_other (fun hp => hin (plain_sub h hp)) ρ ι).symm\n\ntheorem step_eq {h : HMachine} (ok : HOk h) (X : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat))\n    (hX : ∀ s g, assoc h.sums s = some g → X s = sumAt h X M hist g) :\n    applyS h.plain.m.step X M = withSums h (applyS h.f.m.step X M) M (kept h X M hist) := by\n  funext i\n  show applyS (h.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2)) X M i = _\n  cases hs : assoc h.sums i with\n  | some g =>\n    have hmem := assoc_mem hs\n    have hi : i ∉ h.f.m.step.map (·.1) := (ok.ss_out i hmem).2.2.1\n    obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n      simp only [assoc, Option.map_eq_some_iff] at hs\n      obtain ⟨p, hl, rfl⟩ := hs\n      exact ⟨p, (lookup_some hl).1, rfl⟩\n    have hok := ok.sums_ok p hp\n    rw [hpg] at hok\n    have hA : assoc (h.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2)) i = some (sumStep h i g) := by\n      rw [assoc_append, assoc_none_of hi]\n      show assoc (h.sums.map fun p => (p.1, sumStep h p.1 p.2)) i = _\n      rw [assoc_map_key h.sums (sumStep h), hs]; rfl\n    have hL : applyS (h.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2)) X M i = evalE X M (sumStep h i g) := by\n      simp only [applyS, hA]\n    have hR : withSums h (applyS h.f.m.step X M) M (kept h X M hist) i = sumAt h (applyS h.f.m.step X M) M (kept h X M hist) g := by\n      simp only [withSums, hs]\n    rw [hL, hR]\n    -- The old records read alike after the step: the term reads no state variable.\n    have hcg : ∀ hs', sumAt h (applyS h.f.m.step X M) M hs' g = sumAt h X M hs' g := fun hs' =>\n      sumAt_congr h M hs' g (fun j hj => by\n        have := avoidsE_occ hok.1 hj\n        simp only [List.mem_append, not_or] at this\n        exact applyS_other this.1.1.2.2 X M)\n    rw [hcg]\n    simp only [sumStep, evalE, subst_evalE, fieldSub_apply]\n    rw [hX i g hs]\n    unfold kept\n    by_cases hk : evalC X M h.keep = true\n    · simp [hk, sumAt, List.map_append, List.sum_append]\n    · simp [hk]\n  | none =>\n    have hR : withSums h (applyS h.f.m.step X M) M (kept h X M hist) i = applyS h.f.m.step X M i := by\n      simp only [withSums, hs]\n    rw [hR]\n    have hB : assoc (h.sums.map fun p => (p.1, sumStep h p.1 p.2)) i = none := by\n      rw [assoc_map_key h.sums (sumStep h), hs]; rfl\n    simp only [applyS, assoc_append]\n    cases hi : assoc h.f.m.step i with\n    | some e => rfl\n    | none => simp only [hB]\n\ntheorem hreach_fmreach {h : HMachine} (ps : List MEntry) (ok : HOk h)\n    (hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true)\n    (hfm : checkFMMachine h.plain ps = true) : ∀ {ρ M hist}, HReach h ρ M hist → FMReach h.plain ρ M := by\n  intro ρ M hist hr\n  induction hr with\n  | start ρ M hM h0 =>\n    rw [← start_eq ok]\n    exact FMReach.start (f := h.plain) ρ M hM h0\n  | step ρ M hist ι hr ha ih =>\n    have hsum := hsum_of_hreach ok hr\n    have hpre := pre_fmreach h.plain ps hfm ih\n    have hass : evalC (decideFlags h.plain.flags (withInputs h.plain.m.inputs ρ\n        (withQueries h (withInputs (plainInputs h) ρ ι) M hist)) M) M h.plain.m.assume = true := by\n      show evalC (decideFlags h.f.flags (withInputs h.f.m.inputs ρ (withQueries h (withInputs (plainInputs h) ρ ι) M hist)) M) M\n        (.and h.f.m.assume (relsC h.rels)) = true\n      rw [inputs_eq ok]\n      simp only [evalC, Bool.and_eq_true]\n      exact ⟨ha, rels_hold ok hrs hsum hpre ι⟩\n    have hstep := FMReach.step (f := h.plain) ρ M (withQueries h (withInputs (plainInputs h) ρ ι) M hist) ih hass\n    have hin : withInputs h.plain.m.inputs ρ (withQueries h (withInputs (plainInputs h) ρ ι) M hist)\n        = withQueries h (withInputs (plainInputs h) ρ ι) M hist := inputs_eq ok ρ ι M hist\n    rw [hin] at hstep\n    have hX : ∀ s g, assoc h.sums s = some g → reqEnv h ρ ι M hist s = sumAt h (reqEnv h ρ ι M hist) M hist g := by\n      intro s g hs\n      have hmem := assoc_mem hs\n      have ⟨hsin, _, _, hsf, _⟩ := ok.ss_out s hmem\n      obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n        simp only [assoc, Option.map_eq_some_iff] at hs\n        obtain ⟨p, hl, rfl⟩ := hs\n        exact ⟨p, (lookup_some hl).1, rfl⟩\n      have hok := ok.sums_ok p hp\n      rw [hpg] at hok\n      rw [reqEnv_other ok hsin hsf, hsum s g hs]\n      exact sumAt_congr h M hist g (fun i hi => by\n        have := avoidsE_occ hok.1 hi\n        simp only [List.mem_append, not_or] at this\n        exact (reqEnv_other ok this.1.1.1 this.2 ρ ι M hist).symm)\n    have hst := step_eq ok (reqEnv h ρ ι M hist) M hist hX\n    show FMReach h.plain (withSums h (applyS h.f.m.step (reqEnv h ρ ι M hist) M) M (kept h (reqEnv h ρ ι M hist) M hist))\n      (writeMaps h.f.m.writes (reqEnv h ρ ι M hist) M)\n    rw [← hst]\n    exact hstep\n\n/-- The history rule: if the record goals and the plain machine's proof check, every law of the proof holds in every\nstate the machine with its history reaches (sums read as their sums over the history, queries computed from it). -/\ntheorem hmachine_sound (h : HMachine) (ps : List MEntry) (rs : List (List VDef × Tree)) (hc : checkHMachine h ps rs = true) :\n    ∀ ρ M hist, HReach h ρ M hist → ∀ e ∈ ps, e.law.Holds ρ M := by\n  simp only [checkHMachine, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hc\n  obtain ⟨⟨⟨hok, hlen⟩, hgoals⟩, hfm⟩ := hc\n  have ok := histOk_sound hok\n  have hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true := by\n    intro r hr\n    obtain ⟨tt, htt⟩ := zip_mem_left h.rels rs hlen.symm r hr\n    exact ⟨tt, hgoals (r, tt) htt⟩\n  intro ρ M hist hr\n  exact fmmachine_sound h.plain ps hfm ρ M (hreach_fmreach ps ok hrs hfm hr)\n\nend Kern\n",
+    "Sets.lean": "import Steps\n\n/-!\nSets: kernel.ts's machines with sets, proven sound. A set is a map with cells 0 or 1; three things go beyond FMMachine:\na request carries whole maps (`carried`: any maps at each request), a step writes a map at every key at once (`every`:\nthe value at each key, read with the key bound), and a flag may hold at every key (`qflags`: ∀ key. body, its body\nreading no flag). Lean decides a quantified flag classically, which only the meaning needs; the checker never does.\n\nFunctions from outside the rule are maps no step writes (and no request carries); `facts` are laws about the params and\nthose maps alone, given rather than proven: a run starts where they hold, so they hold at every state, and every goal may\nassume them at the keys its proof names (`finsts`).\n\nkernel.ts closes each quantified flag ?f in a goal: ?f ≤ 1; ?f = 0 ∨ body(t) at keys t the proof names (`qinsts`); and\n?f = 1 ∨ ¬body(w) at a fresh witness w (`wits`). A real step satisfies these with w a failing key when ?f = 0, so a goal\nthat refutes them refutes the machine. Lean builds the same closed goals.\n-/\n\nnamespace Kern\nopen Classical\n\nstructure SMachine where\n  f : FMMachine\n  carried : List Nat               -- maps a request carries\n  every : List (Nat × Nat × E)     -- (map, bound key, value): the map at every key\n  qflags : List (Nat × Nat × C)    -- (flag variable, bound key, body): 1 when the body holds at every key, else 0\n  wits : List (Nat × Nat)          -- (flag variable, its witness variable)\n  facts : List MLaw                -- given about the params and the functions (maps no step writes)\n\ndef SMachine.qVars (s : SMachine) : List Nat := s.qflags.map (·.1)\ndef SMachine.wVars (s : SMachine) : List Nat := s.wits.map (·.2)\n\n/-! The meaning -/\n\n-- The maps a step reads: its own, with the maps the request carries.\ndef withCarried (s : SMachine) (M κ : Nat → Nat → Nat) : Nat → Nat → Nat := fun mp => if s.carried.contains mp then κ mp else M mp\n\n-- Each quantified flag decided: 1 where its body holds at every key, else 0.\nnoncomputable def decideQ (s : SMachine) (X : Nat → Nat) (N : Nat → Nat → Nat) : Nat → Nat := fun v =>\n  match lookup (fun q => q.1 == v) s.qflags with\n  | some q => if ∀ key, holdsC (upd X q.2.1 key) N q.2.2 then 1 else 0\n  | none => X v\n\n-- A step's state before its terms: inputs set, quantified flags decided, then the plain flags; and the maps it reads.\nnoncomputable def sView (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : (Nat → Nat) × (Nat → Nat → Nat) :=\n  (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ), withCarried s M κ)\n\n-- The maps after a step: a map written at every key, its value there; any other as kernel.ts's writes leave it.\ndef everyMaps (s : SMachine) (D : Nat → Nat) (N : Nat → Nat → Nat) : Nat → Nat → Nat := fun mp key =>\n  match lookup (fun w => w.1 == mp) s.every with\n  | some w => evalE (upd D w.2.1 key) N w.2.2\n  | none => writeMaps s.f.m.writes D N mp key\n\nnoncomputable def sNext (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : (Nat → Nat) × (Nat → Nat → Nat) :=\n  (applyS s.f.m.step (sView s ρ M ι κ).1 (sView s ρ M ι κ).2, everyMaps s (sView s ρ M ι κ).1 (sView s ρ M ι κ).2)\n\ninductive SReach (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps s.f.m M → evalC ρ M s.f.m.pre = true → (∀ l ∈ s.facts, l.Holds ρ M) →\n      SReach s (applyS s.f.m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : SReach s ρ M →\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true → SReach s (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2\n\n/-! The goals -/\n\n-- Each quantified flag closed, at the keys the proof names.\ndef closingHyps (s : SMachine) (qinsts : List (Nat × E)) : List C :=\n  s.qflags.flatMap fun q =>\n    [.le (.var q.1) (.const 1)]\n      ++ (qinsts.filter (fun p => p.1 == q.1)).map (fun p => .or (.eq (.var q.1) (.const 0)) (substC [(q.2.1, p.2)] q.2.2))\n      ++ (match lookup (fun w => w.1 == q.1) s.wits with\n          | some w => [.or (.eq (.var q.1) (.const 1)) (.not (substC [(q.2.1, .var w.2)] q.2.2))]\n          | none => [])\n\n-- The facts, at the keys the proof names.\ndef factHyps (s : SMachine) (finsts : List (Nat × E)) : List C := scalarHyps s.facts ++ instHyps s.facts finsts\n\n-- A map written at every key reads, after the step, its value at the key read; any other map as stepRd reads it.\ndef stepRdS (s : SMachine) (τ : List (Nat × E)) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) s.every with\n  | some w => substRE ((w.2.1, k) :: τ) rd (inlineE s.f.flags w.2.2)\n  | none => stepRd s.f τ rd mp k\n\n-- A later step reads the maps its request carries by fresh names.\ndef frameRd (mr : List (Nat × Nat)) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun p => p.1 == mp) mr with\n  | some p => .get p.2 k\n  | none => rd mp k\n\ndef sFrameHyps (s : SMachine) (laws : List MLaw) (insts qinsts : List (Nat × E)) (w : C) : List C :=\n  scalarHyps laws ++ instHyps laws insts ++ [inlineC s.f.flags s.f.m.assume, w] ++ closingHyps s qinsts\n\ndef sRun (s : SMachine) (laws : List MLaw) (insts qinsts : List (Nat × E)) :\n    List C → List (List (Nat × Nat)) → List (List (Nat × Nat)) → List (Nat × E) → (Nat → E → E) → List C × List (Nat × E) × (Nat → E → E)\n  | w :: ws, r :: rs, mr :: mrs, σ, rd =>\n    ((sFrameHyps s laws insts qinsts w).map (substRC (frameSub r σ) (frameRd mr rd))\n        ++ (sRun s laws insts qinsts ws rs mrs (stepSub s.f (frameSub r σ) (frameRd mr rd)) (stepRdS s (frameSub r σ) (frameRd mr rd))).1,\n      (sRun s laws insts qinsts ws rs mrs (stepSub s.f (frameSub r σ) (frameRd mr rd)) (stepRdS s (frameSub r σ) (frameRd mr rd))).2)\n  | _, _, _, σ, rd => ([], σ, rd)\n\n/-! What a step's goal reads it by -/\n\n-- A key where a quantified flag's body fails, when one does.\nnoncomputable def witnessKey (X : Nat → Nat) (N : Nat → Nat → Nat) (q : Nat × Nat × C) : Nat :=\n  if h : ∃ key, ¬ holdsC (upd X q.2.1 key) N q.2.2 then Classical.choose h else 0\n\ndef SMachine.extVars (s : SMachine) : List Nat := s.f.m.inputs ++ s.qVars ++ s.wVars\n\n-- A step's request as its goal reads it: the inputs, each quantified flag's value, each witness.\nnoncomputable def sReq (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : Nat → Nat := fun v =>\n  if s.f.m.inputs.contains v then ι v\n  else match lookup (fun q => q.1 == v) s.qflags with\n    | some _ => decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) v\n    | none => match lookup (fun w => w.2 == v) s.wits with\n      | some w => match lookup (fun q => q.1 == w.1) s.qflags with\n        | some q => witnessKey (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q\n        | none => 0\n      | none => 0\n\ndef withExt (s : SMachine) (ρ e : Nat → Nat) : Nat → Nat := fun v => if s.extVars.contains v then e v else ρ v\n\n-- The maps later requests carry, at their fresh names.\ndef renMaps : List (List (Nat × Nat)) → List (Nat → Nat → Nat) → (Nat → Nat → Nat) → Nat → Nat → Nat\n  | r :: rs, κ :: κs, b => fun mp => match lookup (fun p => p.2 == mp) r with\n    | some p => κ p.1\n    | none => renMaps rs κs b mp\n  | _, _, b => b\n\n/-! The checks -/\n\ndef distinctPairs (ws : List (Nat × Nat)) : Bool := distinct (ws.map (·.1)) && distinct (ws.map (·.2))\n\n-- The machine's own side conditions: inputs, flags, quantified flags and witnesses are distinct variables; a body reads no flag, quantified flag or witness, and its key is none of them; every\n-- quantified flag has a witness; the plain flags and the step read no witness.\ndef sOk (s : SMachine) : Bool :=\n  flagsOk s.f.flags && distinct s.qVars && distinctPairs s.wits\n    && s.qflags.all (fun q => s.wits.any (·.1 == q.1))\n    && distinct (s.extVars ++ flagVars s.f.flags)\n    && s.qflags.all (fun q => avoids (s.qVars ++ s.wVars ++ flagVars s.f.flags) q.2.2 && !(s.extVars ++ flagVars s.f.flags).contains q.2.1)\n    && s.f.flags.all (fun p => avoids s.wVars p.2)\n    && avoids (s.wVars ++ s.qVars) s.f.m.pre\n    && s.f.m.step.all (fun p => avoidsE s.wVars (inlineE s.f.flags p.2))\n    && s.f.m.writes.all (fun w => avoidsE s.wVars (inlineE s.f.flags w.2.1) && avoidsE s.wVars (inlineE s.f.flags w.2.2))\n    && s.every.all (fun w => avoidsE s.wVars (inlineE s.f.flags w.2.2) && !(s.extVars ++ flagVars s.f.flags).contains w.2.1\n        && !(s.f.m.writes.map (·.1)).contains w.1 && !s.carried.contains w.1)\n    && avoids s.wVars s.f.m.assume\n\n/-! One step's view -/\n\ntheorem lookup_unique {p : Nat × Nat × C} {l : List (Nat × Nat × C)} (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 lookup_unique2 {p : Nat × Nat} {l : List (Nat × Nat)} (hd : distinct (l.map (·.2)) = true) (hp : p ∈ l) :\n    lookup (fun q => q.2 == p.2) l = some p := lookup_ren hd p hp\n\ntheorem lookup_unique1 {p : Nat × Nat} {l : List (Nat × Nat)} (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 applyS_single (k : Nat) (t : E) (W : Nat → Nat) (M : Nat → Nat → Nat) : applyS [(k, t)] W M = upd W k (evalE W M t) := by\n  funext i; simp only [applyS, assoc, lookup, upd]\n  by_cases h : i = k\n  · subst h; simp\n  · have hb : (k == i) = false := by simp; omega\n    simp [hb, h]\n\n-- Agreeing states decide the plain flags alike, wherever the flag conditions don't read where they differ.\ntheorem decide_agree_on {fl : List (Nat × C)} {V : List Nat} (hav : ∀ p ∈ fl, avoids V p.2 = true) {X X' : Nat → Nat}\n    (N : Nat → Nat → Nat) (h : Agree V X X') : Agree V (decideFlags fl X N) (decideFlags fl X' N) := by\n  intro i hi\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases hc : flagOf fl i with\n  | none => exact h i hi\n  | some c =>\n    obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n    simp only [Option.map_some, evalE]\n    rw [congrC X X' N p.2 (fun j hj => h j (avoids_occ (hav p hp) hj))]\n\nsection view\nvariable (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n\ntheorem sOk_parts (hs : sOk s = true) :\n    flagsOk s.f.flags = true ∧ distinct s.qVars = true ∧ distinctPairs s.wits = true ∧ (∀ q ∈ s.qflags, ∃ w ∈ s.wits, w.1 = q.1)\n      ∧ distinct (s.extVars ++ flagVars s.f.flags) = true\n      ∧ (∀ q ∈ s.qflags, avoids (s.qVars ++ s.wVars ++ flagVars s.f.flags) q.2.2 = true ∧ q.2.1 ∉ s.extVars ++ flagVars s.f.flags)\n      ∧ (∀ p ∈ s.f.flags, avoids s.wVars p.2 = true) := by\n  simp only [sOk, Bool.and_eq_true, List.all_eq_true, List.any_eq_true, beq_iff_eq, Bool.not_eq_true'] at hs\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hf, hq⟩, hw⟩, hcov⟩, hd⟩, hb⟩, hfl⟩, _⟩, _⟩, _⟩, _⟩, _⟩ := hs\n  refine ⟨hf, hq, hw, fun q hq' => hcov q hq', hd, fun q hq' => ⟨(hb q hq').1, fun hm => ?_⟩, hfl⟩\n  have h2 := (hb q hq').2\n  exact absurd hm (by simpa using h2)\n\n-- The extended variables are apart: an input is no quantified flag or witness, and so on.\ntheorem ext_apart (hs : sOk s = true) :\n    (∀ v ∈ s.f.m.inputs, v ∉ s.qVars ∧ v ∉ s.wVars) ∧ (∀ v ∈ s.qVars, v ∉ s.wVars) := by\n  obtain ⟨_, _, _, _, hd, _, _⟩ := sOk_parts s hs\n  obtain ⟨hd1, _, _⟩ := distinct_append hd\n  simp only [SMachine.extVars, List.append_assoc] at hd1\n  obtain ⟨_, hd2, hi⟩ := distinct_append hd1\n  obtain ⟨_, _, hqw⟩ := distinct_append hd2\n  exact ⟨fun v hv => ⟨fun h => hi v hv (List.mem_append_left _ h), fun h => hi v hv (List.mem_append_right _ h)⟩, hqw⟩\n\n-- (F1) The goal's view and the decided quantified flags agree outside the witnesses.\ntheorem view_agree (hs : sOk s = true) :\n    Agree s.wVars (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withExt s ρ (sReq s ρ M ι κ)) := by\n  obtain ⟨hin, hqw⟩ := ext_apart s hs\n  intro v hvw\n  simp only [withExt, sReq]\n  by_cases hvi : v ∈ s.f.m.inputs\n  · have hvq : v ∉ s.qVars := (hin v hvi).1\n    have hl : lookup (fun q => q.1 == v) s.qflags = none := lookup_none (fun q hq => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hvq (by rw [← he]; exact List.mem_map_of_mem hq))\n    simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, hvi, true_or, ite_true, decideQ, hl, withInputs]\n  · by_cases hvq : v ∈ s.qVars\n    · simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, hvi, hvq, or_true, true_or, ite_true, false_or, ite_false]\n      obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hvq\n      have hl : lookup (fun q' => q'.1 == q.1) s.qflags = some q := lookup_unique (sOk_parts s hs).2.1 hq\n      simp only [hl]\n    · have hl : lookup (fun q => q.1 == v) s.qflags = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hvq (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, hvi, hvq, hvw, or_false, ite_false, decideQ, hl, withInputs, List.contains_iff_mem]\n\n-- (F2) Every closing hypothesis holds of the real step, read in the goal's view.\ntheorem closing_true (hs : sOk s = true) (qinsts : List (Nat × E)) :\n    ∀ c ∈ closingHyps s qinsts, evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) c = true := by\n  obtain ⟨_, hqd, hwd, hcov, _, hbody, _⟩ := sOk_parts s hs\n  obtain ⟨hin, hqw⟩ := ext_apart s hs\n  have hag := view_agree s ρ M ι κ hs\n  intro c hc\n  simp only [closingHyps, List.mem_flatMap, List.mem_append, List.mem_singleton, List.mem_map, List.mem_filter] at hc\n  obtain ⟨q, hq, hc⟩ := hc\n  have hqv : q.1 ∈ s.qVars := List.mem_map_of_mem hq\n  -- The flag's value: 1 exactly when the body holds at every key (read in either view: they agree on the body).\n  have hY : withExt s ρ (sReq s ρ M ι κ) q.1 = if ∀ key, holdsC (upd (withInputs s.f.m.inputs ρ ι) q.2.1 key) (withCarried s M κ) q.2.2 then 1 else 0 := by\n    rw [← hag q.1 (hqw _ hqv)]; simp only [decideQ, lookup_unique hqd hq]\n  have hbodyY : ∀ key, holdsC (upd (withExt s ρ (sReq s ρ M ι κ)) q.2.1 key) (withCarried s M κ) q.2.2\n      ↔ holdsC (upd (withInputs s.f.m.inputs ρ ι) q.2.1 key) (withCarried s M κ) q.2.2 := by\n    intro key\n    rw [← evalC_iff, ← evalC_iff, congrC _ (upd (withInputs s.f.m.inputs ρ ι) q.2.1 key) (withCarried s M κ) q.2.2 (fun j hj => by\n      simp only [upd]; split\n      · rfl\n      · have hjq : j ∉ s.qVars := fun h => avoids_occ (hbody q hq).1 hj (List.mem_append_left _ (List.mem_append_left _ h))\n        have hjw : j ∉ s.wVars := fun h => avoids_occ (hbody q hq).1 hj (List.mem_append_left _ (List.mem_append_right _ h))\n        rw [← hag j hjw]; simp only [decideQ]\n        rw [lookup_none (fun q' hq' => by simp only [beq_eq_false_iff_ne]; intro he; exact hjq (by rw [← he]; exact List.mem_map_of_mem hq'))])]\n  rcases hc with ((rfl | ⟨p, ⟨_, hpq⟩, rfl⟩) | hc)\n  · simp only [evalC, evalE, hY]; split <;> simp\n  · simp only [beq_iff_eq] at hpq\n    simp only [evalC, evalE, Bool.or_eq_true, decide_eq_true_eq]\n    by_cases h1 : ∀ key, holdsC (upd (withInputs s.f.m.inputs ρ ι) q.2.1 key) (withCarried s M κ) q.2.2\n    · right; rw [subst_evalC, applyS_single, evalC_iff]; exact (hbodyY _).mpr (h1 _)\n    · left; simp [hY, h1]\n  · obtain ⟨w, hw, hwq⟩ := hcov q hq\n    have hlw : lookup (fun w' => w'.1 == q.1) s.wits = some w := by\n      rw [← hwq]; exact lookup_unique1 (by simp only [distinctPairs, Bool.and_eq_true] at hwd; exact hwd.1) hw\n    simp only [hlw, List.mem_singleton] at hc; subst hc\n    simp only [evalC, evalE, Bool.or_eq_true, decide_eq_true_eq, Bool.not_eq_true']\n    by_cases h1 : ∀ key, holdsC (upd (withInputs s.f.m.inputs ρ ι) q.2.1 key) (withCarried s M κ) q.2.2\n    · left; simp [hY, h1]\n    · right\n      -- The witness reads a failing key.\n      have hwv : w.2 ∈ s.wVars := List.mem_map_of_mem hw\n      have hYw : withExt s ρ (sReq s ρ M ι κ) w.2 = witnessKey (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q := by\n        have hwi : w.2 ∉ s.f.m.inputs := fun h => (hin _ h).2 hwv\n        have hwq' : w.2 ∉ s.qVars := fun h => hqw _ h hwv\n        have hext : s.extVars.contains w.2 = true := by\n          simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inr hwv\n        have hni : s.f.m.inputs.contains w.2 = false := by simpa [List.contains_iff_mem] using hwi\n        simp only [withExt, hext, ite_true, sReq, hni, Bool.false_eq_true, ite_false]\n        rw [lookup_none (fun q' hq' => by\n          simp only [beq_eq_false_iff_ne]; intro he; exact hwq' (by rw [← he]; exact List.mem_map_of_mem hq')),\n          lookup_unique2 (by simp only [distinctPairs, Bool.and_eq_true] at hwd; exact hwd.2) hw]\n        simp only [hwq, lookup_unique hqd hq]\n      have hex : ∃ key, ¬ holdsC (upd (withInputs s.f.m.inputs ρ ι) q.2.1 key) (withCarried s M κ) q.2.2 := by simpa using h1\n      have hfail : ¬ holdsC (upd (withInputs s.f.m.inputs ρ ι) q.2.1 (witnessKey (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q)) (withCarried s M κ) q.2.2 := by\n        simp only [witnessKey, dif_pos hex]; exact Classical.choose_spec hex\n      rw [subst_evalC, applyS_single]\n      simp only [evalE, hYw]\n      cases hb : evalC (upd (withExt s ρ (sReq s ρ M ι κ)) q.2.1 (witnessKey (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q)) (withCarried s M κ) q.2.2\n      · rfl\n      · exact absurd ((hbodyY _).mp ((evalC_iff _ _ _).mp hb)) hfail\nend view\n\n/-! Which maps a term reads -/\n\nmutual\ndef occME (mp : Nat) : E → Bool\n  | .var _ => false\n  | .const _ => false\n  | .add a b => occME mp a || occME mp b\n  | .sub a b => occME mp a || occME mp b\n  | .mul _ a => occME mp a\n  | .min a b => occME mp a || occME mp b\n  | .max a b => occME mp a || occME mp b\n  | .prod a b => occME mp a || occME mp b\n  | .ite c t f => occMC mp c || occME mp t || occME mp f\n  | .get m key => m == mp || occME mp key\ndef occMC (mp : Nat) : C → Bool\n  | .le a b => occME mp a || occME mp b\n  | .lt a b => occME mp a || occME mp b\n  | .eq a b => occME mp a || occME mp b\n  | .and a b => occMC mp a || occMC mp b\n  | .or a b => occMC mp a || occMC mp b\n  | .not a => occMC mp a\nend\n\ndef avoidsMaps (ms : List Nat) (c : C) : Bool := ms.all fun mp => !occMC mp c\ndef avoidsMapsE (ms : List Nat) (e : E) : Bool := ms.all fun mp => !occME mp e\n\n-- Maps that agree on every map a term reads give it the same value.\nmutual\ntheorem congrME (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) :\n    (e : E) → (∀ mp, occME mp e = true → M mp = M' mp) → evalE ρ M e = evalE ρ M' e\n  | .var _, _ => rfl\n  | .const _, _ => rfl\n  | .add a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .sub a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .mul k a, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm]))]\n  | .min a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .max a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .prod a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .ite c t f, h => by\n    simp only [evalE, congrMC ρ M M' c (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' t (fun mp hm => h mp (by simp [occME, hm])),\n      congrME ρ M M' f (fun mp hm => h mp (by simp [occME, hm]))]\n  | .get m key, h => by\n    simp only [evalE, congrME ρ M M' key (fun mp hm => h mp (by simp [occME, hm])), h m (by simp [occME])]\ntheorem congrMC (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) :\n    (c : C) → (∀ mp, occMC mp c = true → M mp = M' mp) → evalC ρ M c = evalC ρ M' c\n  | .le a b, h => by simp only [evalC, congrME ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .lt a b, h => by simp only [evalC, congrME ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .eq a b, h => by simp only [evalC, congrME ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .and a b, h => by simp only [evalC, congrMC ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrMC ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .or a b, h => by simp only [evalC, congrMC ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrMC ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .not a, h => by simp only [evalC, congrMC ρ M M' a (fun mp hm => h mp (by simp [occMC, hm]))]\nend\n\ntheorem avoidsMapsE_occ {ms : List Nat} {e : E} (h : avoidsMapsE ms e = true) {mp : Nat} (hm : occME mp e = true) : mp ∉ ms := by\n  intro hmem; simp only [avoidsMapsE, List.all_eq_true] at h; have := h mp hmem; simp [hm] at this\n\n-- A term avoiding some maps: so does each of its parts.\ntheorem amE {ms : List Nat} {e a : E} (h : avoidsMapsE ms e = true) (hs : ∀ mp, occME mp a = true → occME mp e = true) : avoidsMapsE ms a = true := by\n  simp only [avoidsMapsE, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occME mp a\n  · rfl\n  · simp [hs mp hq] at h\ntheorem amEC {ms : List Nat} {e : E} {c : C} (h : avoidsMapsE ms e = true) (hs : ∀ mp, occMC mp c = true → occME mp e = true) : avoidsMaps ms c = true := by\n  simp only [avoidsMapsE, avoidsMaps, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occMC mp c\n  · rfl\n  · simp [hs mp hq] at h\ntheorem amCE {ms : List Nat} {c : C} {a : E} (h : avoidsMaps ms c = true) (hs : ∀ mp, occME mp a = true → occMC mp c = true) : avoidsMapsE ms a = true := by\n  simp only [avoidsMapsE, avoidsMaps, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occME mp a\n  · rfl\n  · simp [hs mp hq] at h\ntheorem amC {ms : List Nat} {c d : C} (h : avoidsMaps ms c = true) (hs : ∀ mp, occMC mp d = true → occMC mp c = true) : avoidsMaps ms d = true := by\n  simp only [avoidsMaps, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occMC mp d\n  · rfl\n  · simp [hs mp hq] at h\n\n-- substR_evalE for a term avoiding the maps rd doesn't read as M' does.\nsection\nvariable (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M M' : Nat → Nat → Nat) (X : List Nat)\n  (hrd : ∀ m k, m ∉ X → evalE W M (rd m k) = M' m (evalE W M k))\ninclude hrd\nmutual\ntheorem substR_evalE_on : (e : E) → avoidsMapsE X e = true → 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, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .sub a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .mul k a, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm]))]\n  | .min a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .max a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .prod a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .ite c t f, h => by\n    simp [substRE, evalE, substR_evalC_on c (amEC h (fun mp hm => by simp [occME, hm])), substR_evalE_on t (amE h (fun mp hm => by simp [occME, hm])),\n      substR_evalE_on f (amE h (fun mp hm => by simp [occME, hm]))]\n  | .get m key, h => by\n    have hmz : m ∉ X := avoidsMapsE_occ h (by simp [occME])\n    simp only [substRE, evalE]\n    rw [hrd m _ hmz, substR_evalE_on key (amE h (fun mp hm => by simp [occME, hm]))]\ntheorem substR_evalC_on : (c : C) → avoidsMaps X c = true → evalC W M (substRC σ rd c) = evalC (applyS σ W M) M' c\n  | .le a b, h => by simp [substRC, evalC, substR_evalE_on a (amCE h (fun mp hm => by simp [occMC, hm])), substR_evalE_on b (amCE h (fun mp hm => by simp [occMC, hm]))]\n  | .lt a b, h => by simp [substRC, evalC, substR_evalE_on a (amCE h (fun mp hm => by simp [occMC, hm])), substR_evalE_on b (amCE h (fun mp hm => by simp [occMC, hm]))]\n  | .eq a b, h => by simp [substRC, evalC, substR_evalE_on a (amCE h (fun mp hm => by simp [occMC, hm])), substR_evalE_on b (amCE h (fun mp hm => by simp [occMC, hm]))]\n  | .and a b, h => by simp [substRC, evalC, substR_evalC_on a (amC h (fun mp hm => by simp [occMC, hm])), substR_evalC_on b (amC h (fun mp hm => by simp [occMC, hm]))]\n  | .or a b, h => by simp [substRC, evalC, substR_evalC_on a (amC h (fun mp hm => by simp [occMC, hm])), substR_evalC_on b (amC h (fun mp hm => by simp [occMC, hm]))]\n  | .not a, h => by simp [substRC, evalC, substR_evalC_on a (amC h (fun mp hm => by simp [occMC, hm]))]\nend\nend\n\ntheorem substR_var (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    evalE W M (substRE σ rd (.var i)) = applyS σ W M i := by\n  simp only [substRE]; cases h : assoc σ i <;> simp [evalE, applyS, h]\n\ntheorem avoidsMaps_occ {ms : List Nat} {c : C} (h : avoidsMaps ms c = true) {mp : Nat} (hm : occMC mp c = true) : mp ∉ ms := by\n  intro hin; simp only [avoidsMaps, List.all_eq_true] at h; have := h mp hin; simp [hm] at this\n\ntheorem applyS_cons (k : Nat) (t : E) (τ : List (Nat × E)) (W : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS ((k, t) :: τ) W M = upd (applyS τ W M) k (evalE W M t) := by\n  funext i; simp only [applyS, assoc, lookup, upd]\n  by_cases h : i = k\n  · subst h; simp\n  · have hb : (k == i) = false := by simp; omega\n    simp [hb, h]\n\n-- Setting a variable no flag condition reads commutes with deciding the flags.\ntheorem decide_upd {fl : List (Nat × C)} {k : Nat} (hk : k ∉ flagVars fl) (hav : ∀ p ∈ fl, occC k p.2 = false)\n    (X : Nat → Nat) (N : Nat → Nat → Nat) (v : Nat) : decideFlags fl (upd X k v) N = upd (decideFlags fl X N) k v := by\n  funext i\n  simp only [decideFlags, applyS, assoc_flagSub, upd]\n  by_cases hi : i = k\n  · subst hi\n    have hn : flagOf fl i = none := by\n      simp only [flagOf, Option.map_eq_none_iff]\n      exact lookup_none (fun p hp => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hk (by simp only [flagVars]; rw [← he]; exact List.mem_map_of_mem hp))\n    simp [hn]\n  · simp only [hi, ite_false]\n    cases hc : flagOf fl i with\n    | none => simp\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n      simp only [Option.map_some, evalE]\n      rw [congrC (upd X k v) X N p.2 (fun j hj => by\n        simp only [upd]\n        split\n        · rename_i hjk; subst hjk; have h0 := hav p hp; rw [h0] at hj; exact absurd hj (by decide)\n        · rfl)]\n\n/-! Laws read where a frame is read -/\n\n-- The scalar laws and every-key laws at their instances hold wherever the laws do.\ntheorem laws_hyps_true (laws : List MLaw) (insts : List (Nat × E)) (Y : Nat → Nat) (N : Nat → Nat → Nat)\n    (hl : ∀ l ∈ laws, l.Holds Y N) : ∀ c ∈ scalarHyps laws ++ instHyps laws insts, evalC Y N c = true := by\n  intro c hc\n  rcases List.mem_append.mp hc with hc | hc\n  · simp only [scalarHyps, List.mem_filterMap] at hc\n    obtain ⟨l, hlm, hk⟩ := hc\n    split at hk\n    · rename_i hkey\n      simp only [Option.some.injEq] at hk; subst hk\n      have := hl l hlm\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 hlg\n      split at hk\n      · rename_i kv hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        have := hl l (List.mem_of_getElem? hlg)\n        simp only [MLaw.Holds, hkey] at this\n        rw [subst_evalC, applyS_single]\n        exact this _\n      · simp at hk\n    · simp at hk\n\n-- A law reading neither the variables nor the maps two states differ at holds in both alike.\ntheorem holds_transfer {V MS : List Nat} (l : MLaw) (hv : avoids V l.holds = true) (hm : avoidsMaps MS l.holds = true)\n    {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (hag : Agree V ρ ρ') (hmag : ∀ mp, mp ∉ MS → M mp = M' mp) :\n    l.Holds ρ' M' → l.Holds ρ M := by\n  have cong : ∀ X X' : Nat → Nat, Agree V X X' → evalC X' M' l.holds = true → evalC X M l.holds = true := by\n    intro X X' ha h\n    rw [congrMC X M M' l.holds (fun mp hmp => hmag mp (avoidsMaps_occ hm hmp)), congrC X X' M' l.holds (fun i hi => ha i (avoids_occ hv hi))]\n    exact h\n  unfold MLaw.Holds\n  split\n  · exact cong ρ ρ' hag\n  · rename_i kv _\n    intro h v\n    have ha : Agree V (upd ρ kv v) (upd ρ' kv v) := by\n      intro i hi; simp only [upd]; split\n      · rfl\n      · exact hag i hi\n    exact cong _ _ ha (h v)\n\n/-! Frames of a run of a machine with sets -/\n\n-- The frame σ, rd denotes the state ρ, M: every variable outside the extended request's and the zone Z, and every map\n-- read but those the requests carry and the zone MZ (the names later requests' maps are read by).\ndef SDenotes (s : SMachine) (Z MZ : 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 ∉ s.extVars → v ∉ Z → applyS σ W M0 v = ρ v) ∧ (∀ mp k, mp ∉ s.carried → mp ∉ MZ → evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n\n-- The frame a step reads (its request set) agrees with the state and request outside the zone, and reads the maps the\n-- step reads.\ndef SHead (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (rd : Nat → E → E)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (r mr : List (Nat × Nat)) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : Prop :=\n  Agree Z (applyS (frameSub r σ) W M0) (withExt s ρ (sReq s ρ M ι κ))\n    ∧ ∀ mp k, mp ∉ MZ → evalE W M0 (frameRd mr rd mp k) = withCarried s M κ mp (evalE W M0 k)\n\nsection frame\nvariable (s : SMachine) (Z MZ : 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 step (flags decided), away from the zone and witnesses.\ntheorem sframe_term (hs : sOk s = true) (hfz : ∀ v ∈ flagVars s.f.flags, v ∈ Z) (hfav : ∀ p ∈ s.f.flags, avoids Z p.2 = true)\n    {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} {r mr : List (Nat × Nat)} {ι : Nat → Nat} {κ : Nat → Nat → Nat}\n    (hH : SHead s Z MZ W M0 σ rd ρ M r mr ι κ) (e : E) (he : avoidsE (Z ++ s.wVars) (inlineE s.f.flags e) = true)\n    (hem : avoidsMapsE MZ (inlineE s.f.flags e) = true) :\n    evalE W M0 (substRE (frameSub r σ) (frameRd mr rd) (inlineE s.f.flags e)) = evalE (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 e := by\n  obtain ⟨hX, hrd⟩ := hH\n  have hwfl := (sOk_parts s hs).2.2.2.2.2.2\n  rw [substR_evalE_on (frameSub r σ) (frameRd mr rd) W M0 (withCarried s M κ) MZ hrd _ hem,\n    congrE _ (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) _ (fun i hi => hX i (fun h => avoidsE_occ he hi (List.mem_append_left _ h))),\n    inline_evalE]\n  show evalE (decideFlags s.f.flags (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ)) (withCarried s M κ) e\n    = evalE (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) (withCarried s M κ) e\n  rw [← inline_evalE, ← inline_evalE]\n  exact congrE _ _ _ _ (fun i hi => (view_agree s ρ M ι κ hs i (fun h => avoidsE_occ he hi (List.mem_append_right _ h))).symm)\nend frame\n\nsection frame2\nvariable (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n\n-- Every hypothesis of a frame holds where the frame is read, given the laws in the goal's view of its state.\ntheorem sframe_hyps (hs : sOk s = true) (laws : List MLaw) (insts qinsts : List (Nat × E))\n    {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} {r mr : List (Nat × Nat)} {ι : Nat → Nat} {κ : Nat → Nat → Nat} {w : C}\n    (hlY : ∀ l ∈ laws, l.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ))\n    (hH : SHead s Z MZ W M0 σ rd ρ M r mr ι κ)\n    (hav : ∀ c ∈ sFrameHyps s laws insts qinsts w, avoids Z c = true)\n    (havm : ∀ c ∈ sFrameHyps s laws insts qinsts w, avoidsMaps MZ c = true)\n    (hA : evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true)\n    (hW : evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true) :\n    ∀ c ∈ sFrameHyps s laws insts qinsts w, evalC W M0 (substRC (frameSub r σ) (frameRd mr rd) c) = true := by\n  obtain ⟨hX, hrd⟩ := hH\n  intro c hc\n  rw [substR_evalC_on (frameSub r σ) (frameRd mr rd) W M0 (withCarried s M κ) MZ hrd c (havm c hc),\n    congrC _ (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) c (fun i hi => hX i (avoids_occ (hav c hc) hi))]\n  simp only [sFrameHyps, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with ((hc | rfl | rfl) | hc)\n  · exact laws_hyps_true laws insts _ _ hlY c (List.mem_append.mpr hc)\n  · -- The assumption, inlined: the view decides the plain flags as the step does, away from the witnesses.\n    rw [inline_evalC]\n    have hagD := decide_agree_on (sOk_parts s hs).2.2.2.2.2.2 (withCarried s M κ) (view_agree s ρ M ι κ hs)\n    rw [congrC _ (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) _ 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    exact hA\n  · exact hW\n  · exact closing_true s ρ M ι κ hs qinsts c hc\n\n-- One step keeps the frame denoting the state: each variable its step term, each map its writes.\ntheorem sstep_denotes (hs : sOk s = true) (hfz : ∀ v ∈ flagVars s.f.flags, v ∈ Z) (hfav : ∀ p ∈ s.f.flags, avoids Z p.2 = true)\n    {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} (r mr : List (Nat × Nat)) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n    (hD : SDenotes s Z MZ W M0 σ rd ρ M) (hH : SHead s Z MZ W M0 σ rd ρ M r mr ι κ)\n    (hrk : ∀ p ∈ r, p.1 ∈ s.extVars)\n    (hst : ∀ p ∈ s.f.m.step, avoidsE (Z ++ s.wVars) (inlineE s.f.flags p.2) = true)\n    (hwr : ∀ w ∈ s.f.m.writes, avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.1) = true ∧ avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true)\n    (hev : ∀ w ∈ s.every, avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true ∧ w.2.1 ∉ Z ∧ w.2.1 ∉ flagVars s.f.flags\n      ∧ (∀ p ∈ s.f.flags, occC w.2.1 p.2 = false) ∧ w.1 ∉ s.carried ∧ w.1 ∉ s.f.m.writes.map (·.1))\n    (hstm : ∀ p ∈ s.f.m.step, avoidsMapsE MZ (inlineE s.f.flags p.2) = true)\n    (hwrm : ∀ w ∈ s.f.m.writes, avoidsMapsE MZ (inlineE s.f.flags w.2.1) = true ∧ avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true)\n    (hevm : ∀ w ∈ s.every, avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true) :\n    SDenotes s Z MZ W M0 (stepSub s.f (frameSub r σ) (frameRd mr rd)) (stepRdS s (frameSub r σ) (frameRd mr rd)) (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 := by\n  obtain ⟨hv, hrdM⟩ := hD\n  have hH' := hH\n  obtain ⟨hX, hrd⟩ := hH\n  refine ⟨fun v hve hvz => ?_, fun mp k hmp hmz => ?_⟩\n  · simp only [sNext, applyS, stepSub, assoc_append_or, assoc_stepSub]\n    cases h : assoc s.f.m.step v with\n    | some e =>\n      have hm : (v, e) ∈ s.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 sframe_term s Z MZ W M0 hs hfz hfav hH' e (hst (v, e) hm) (hstm (v, e) hm)\n    | none =>\n      simp only [Option.map_none, Option.none_or]\n      have hvf : v ∉ flagVars s.f.flags := fun h' => hvz (hfz v h')\n      have hvq : v ∉ s.qVars := fun h' => hve (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inr h'))\n      have hvi : v ∉ s.f.m.inputs := fun h' => hve (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl h'))\n      show applyS (frameSub r σ) W M0 v = decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ) v\n      rw [decide_other hvf, hX v hvz]\n      simp only [withExt, decideQ, sReq]\n      rw [if_neg (by simpa [List.contains_iff_mem] using hve)]\n      rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hvq (by rw [← he]; exact List.mem_map_of_mem hq))]\n      exact (withInputs_other hvi ρ ι).symm\n  · simp only [stepRdS, sNext, everyMaps]\n    cases he : lookup (fun w => w.1 == mp) s.every with\n    | some w =>\n      obtain ⟨hval, _, hkf, hkfl, _, _⟩ := hev w (lookup_some he).1\n      simp only\n      rw [substR_evalE_on ((w.2.1, k) :: frameSub r σ) (frameRd mr rd) W M0 (withCarried s M κ) MZ hrd _ (hevm w (lookup_some he).1), applyS_cons]\n      show evalE (upd (applyS (frameSub r σ) W M0) w.2.1 (evalE W M0 k)) (withCarried s M κ) (inlineE s.f.flags w.2.2)\n        = evalE (upd (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) w.2.1 (evalE W M0 k)) (withCarried s M κ) w.2.2\n      rw [← decide_upd hkf (fun p hp => hkfl p hp), ← inline_evalE]\n      -- The frame and the step read the inlined value alike: they agree away from the zone and the witnesses.\n      exact congrE _ _ _ _ (fun i hi => by\n        simp only [upd]; split\n        · rfl\n        · have hiz : i ∉ Z := fun h => avoidsE_occ hval hi (List.mem_append_left _ h)\n          have hiw : i ∉ s.wVars := fun h => avoidsE_occ hval hi (List.mem_append_right _ h)\n          rw [hX i hiz]; exact (view_agree s ρ M ι κ hs i hiw).symm)\n    | none =>\n      simp only [stepRd, writeMaps]\n      cases hw : lookup (fun w : Nat × E × E => w.1 == mp) s.f.m.writes with\n      | none => exact hrd mp k hmz\n      | some w =>\n        have hm := (lookup_some hw).1\n        simp only [evalE, evalC, sframe_term s Z MZ W M0 hs hfz hfav hH' w.2.1 (hwr w hm).1 (hwrm w hm).1,\n          sframe_term s Z MZ W M0 hs hfz hfav hH' w.2.2 (hwr w hm).2 (hwrm w hm).2, fun k => hrd mp k hmz]\n        simp only [sView]\n        by_cases hk : evalE W M0 k = evalE (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) (withCarried s M κ) w.2.1 <;> simp [hk]\nend frame2\n\n/-! Laws: the induction rule for machines with sets -/\n\nstructure SEntry where\n  law : MLaw\n  sk : Nat                    -- the skolem variable\n  keys2 : List Nat            -- a law about every two keys or more: its further keys, variables nothing but laws about them read\n  insts : List (Nat × E)      -- (law index, key): where the step goal assumes the laws about every key\n  qinsts : List (Nat × E)     -- (quantified flag, key): where the step goal closes it\n  finsts : List (Nat × E)     -- (fact index, key): where both goals assume the facts\n  pinsts : List (Nat × E × List E) -- (law index, key, further keys): where the step goal assumes the laws about several keys\n  start : List VDef × Tree\n  step : List VDef × Tree\n\n-- A law at every value of each of some keys.\ndef holdsOver (l : MLaw) (M : Nat → Nat → Nat) : List Nat → (Nat → Nat) → Prop\n  | [], ρ => l.Holds ρ M\n  | g :: gs, ρ => ∀ w, holdsOver l M gs (upd ρ g w)\n\n-- What an entry claims: its law, at every value of each further key.\ndef SEntry.Holds (e : SEntry) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop := holdsOver e.law M e.keys2 ρ\n\ndef trueC : C := .le (.const 0) (.const 0)\n\n-- A law about several keys at a tuple, as a law about every first key: each further key read as the tuple's term.\ndef pairLaws (ps : List SEntry) (pinsts : List (Nat × E × List E)) : List MLaw := pinsts.map fun p =>\n  match ps[p.1]? with\n  | some e => ⟨substC (e.keys2.zip p.2.2) e.law.holds, e.law.key⟩\n  | none => ⟨trueC, none⟩\ndef pairInsts : Nat → List (Nat × E × List E) → List (Nat × E)\n  | _, [] => []\n  | n, p :: ps => (n, p.2.1) :: pairInsts (n + 1) ps\n-- The laws a frame assumes (the entries' laws, then each pair's) and where (each pair's at its first term).\ndef sLaws (ps : List SEntry) (pinsts : List (Nat × E × List E)) : List MLaw := ps.map (·.law) ++ pairLaws ps pinsts\ndef sInsts (ps : List SEntry) (insts : List (Nat × E)) (pinsts : List (Nat × E × List E)) : List (Nat × E) := insts ++ pairInsts ps.length pinsts\ndef sStartGoal (s : SMachine) (e : SEntry) : List C := [s.f.m.pre] ++ factHyps s e.finsts ++ [.not (substRC s.f.m.init (rdStart s.f.m) (goalOf e.law e.sk))]\ndef sStepGoal (s : SMachine) (ps : List SEntry) (e : SEntry) : List C :=\n  [s.f.m.pre] ++ factHyps s e.finsts ++ (sFrameHyps s (sLaws ps e.pinsts) (sInsts ps e.insts e.pinsts) e.qinsts trueC).map (substRC (frameSub [] []) (frameRd [] getRd))\n    ++ [.not (substRC (stepSub s.f (frameSub [] []) (frameRd [] getRd)) (stepRdS s (frameSub [] []) (frameRd [] getRd)) (goalOf e.law e.sk))]\n\n-- The machine's terms and the zone a frame keeps apart (the flags, and here the skolem).\ndef sTermsOk (s : SMachine) (Z : List Nat) : Bool :=\n  s.f.flags.all (fun p => avoids Z p.2)\n    && s.f.m.step.all (fun p => avoidsE (Z ++ s.wVars) (inlineE s.f.flags p.2))\n    && s.f.m.writes.all (fun w => avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.1) && avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) && !s.carried.contains w.1)\n    && s.every.all (fun w => avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) && !Z.contains w.2.1 && !(flagVars s.f.flags).contains w.2.1\n        && s.f.flags.all (fun p => !occC w.2.1 p.2) && !s.carried.contains w.1 && !(s.f.m.writes.map (·.1)).contains w.1)\n    && s.facts.all (fun l => avoids Z l.holds)\n\n-- The facts read the params and the functions alone: no request, flag or state variable, and no map a step writes or\n-- a request carries.\ndef factsOk (s : SMachine) : Bool :=\n  s.facts.all fun l => avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) l.holds\n    && avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) l.holds\n\n-- The skolem is fresh for the machine: no flag, body, assumption, term or write reads it, nor binds it.\ndef skFresh (s : SMachine) (sk : Nat) : Bool :=\n  s.f.flags.all (fun p => !occC sk p.2) && s.qflags.all (fun q => !occC sk q.2.2) && !occC sk s.f.m.assume\n    && s.f.m.step.all (fun p => !occE sk p.2) && s.f.m.writes.all (fun w => !occE sk w.2.1 && !occE sk w.2.2)\n    && s.every.all (fun w => !occE sk w.2.2 && w.2.1 != sk) && s.facts.all (fun l => !occC sk l.holds)\n\n-- Further keys: each fresh as a skolem is, not the law's own key, read by no law but those about it, and no entry's skolem.\ndef key2Ok (s : SMachine) (ps : List SEntry) (e : SEntry) : Bool :=\n  e.keys2.all fun g => e.law.key != some g && skFresh s g && !(s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains g\n    && !occC g s.f.m.pre && s.f.m.init.all (fun p => !occE g p.2)\n    && ps.all (fun e' => (!occC g e'.law.holds || e'.keys2.contains g) && e'.sk != g)\n\ndef checkSMachine (s : SMachine) (ps : List SEntry) : Bool :=\n  sOk s && avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) s.f.m.pre && !readsC s.f.m.pre\n    && sTermsOk s (flagVars s.f.flags) && factsOk s\n    && ps.all fun e =>\n      avoids (s.extVars ++ flagVars s.f.flags) e.law.holds && avoidsMaps s.carried e.law.holds\n        && !(s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains e.sk\n        && ps.all (fun e' => !occC e.sk e'.law.holds) && !occC e.sk s.f.m.pre && s.f.m.init.all (fun p => !occE e.sk p.2)\n        && skFresh s e.sk && key2Ok s ps e\n        && checkGoal ⟨e.start.1, sStartGoal s e⟩ e.start.2\n        && checkGoal ⟨e.step.1, sStepGoal s ps e⟩ e.step.2\n\ntheorem skFresh_parts {s : SMachine} {sk : Nat} (h : skFresh s sk = true) :\n    (∀ p ∈ s.f.flags, occC sk p.2 = false) ∧ (∀ q ∈ s.qflags, occC sk q.2.2 = false) ∧ occC sk s.f.m.assume = false\n      ∧ (∀ p ∈ s.f.m.step, occE sk p.2 = false) ∧ (∀ w ∈ s.f.m.writes, occE sk w.2.1 = false ∧ occE sk w.2.2 = false)\n      ∧ (∀ w ∈ s.every, occE sk w.2.2 = false ∧ w.2.1 ≠ sk) ∧ (∀ l ∈ s.facts, occC sk l.holds = false) := by\n  simp only [skFresh, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true', bne_iff_ne, ne_eq] at h\n  obtain ⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7⟩\n\n/-! A variable no step reads or writes: setting it commutes with a step -/\n\ntheorem withInputs_upd {ins : List Nat} {x : Nat} (hx : x ∉ ins) (ρ ι : Nat → Nat) (v : Nat) :\n    withInputs ins (upd ρ x v) ι = upd (withInputs ins ρ ι) x v := by\n  funext i\n  simp only [withInputs, upd]\n  by_cases hi : i = x\n  · subst hi; simp [List.contains_iff_mem, hx]\n  · simp [hi]\n\ntheorem decideQ_upd {s : SMachine} {x : Nat} (hq : x ∉ s.qVars) (hb : ∀ q ∈ s.qflags, occC x q.2.2 = false)\n    (X : Nat → Nat) (N : Nat → Nat → Nat) (v : Nat) : decideQ s (upd X x v) N = upd (decideQ s X N) x v := by\n  funext u\n  by_cases hux : u = x\n  · subst hux\n    have hl : lookup (fun q => q.1 == u) s.qflags = none := lookup_none (fun q hq' => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hq (by rw [← he]; exact List.mem_map_of_mem hq'))\n    simp only [decideQ, hl, upd, ite_true]\n  · simp only [upd, hux, ite_false]\n    simp only [decideQ]\n    cases hl : lookup (fun q => q.1 == u) s.qflags with\n    | none => simp [upd, hux]\n    | some q =>\n      have hbq := hb q (lookup_some hl).1\n      have hiff : ∀ key, holdsC (upd (upd X x v) q.2.1 key) N q.2.2 ↔ holdsC (upd X q.2.1 key) N q.2.2 := fun key => by\n        rw [← evalC_iff, ← evalC_iff, congrC _ (upd X q.2.1 key) N q.2.2 (fun i hi => by\n          have hix : i ≠ x := fun h => by rw [h, hbq] at hi; cases hi\n          simp only [upd]\n          by_cases hik : i = q.2.1\n          · simp [hik]\n          · simp [hik, hix])]\n      simp only [hiff]\n\ntheorem sView_upd {s : SMachine} {x : Nat} (hxi : x ∉ s.f.m.inputs) (hxq : x ∉ s.qVars) (hxf : x ∉ flagVars s.f.flags)\n    (hb : ∀ q ∈ s.qflags, occC x q.2.2 = false) (hfl : ∀ p ∈ s.f.flags, occC x p.2 = false)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) (v : Nat) :\n    sView s (upd ρ x v) M ι κ = (upd (sView s ρ M ι κ).1 x v, (sView s ρ M ι κ).2) := by\n  simp only [sView, withInputs_upd hxi, decideQ_upd hxq hb, decide_upd hxf hfl]\n\ntheorem sNext_upd {s : SMachine} {x : Nat} (hxi : x ∉ s.f.m.inputs) (hxq : x ∉ s.qVars) (hxf : x ∉ flagVars s.f.flags)\n    (hb : ∀ q ∈ s.qflags, occC x q.2.2 = false) (hfl : ∀ p ∈ s.f.flags, occC x p.2 = false)\n    (hxs : x ∉ s.f.m.step.map (·.1)) (hst : ∀ p ∈ s.f.m.step, occE x p.2 = false)\n    (hwr : ∀ w ∈ s.f.m.writes, occE x w.2.1 = false ∧ occE x w.2.2 = false) (hev : ∀ w ∈ s.every, occE x w.2.2 = false ∧ w.2.1 ≠ x)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) (v : Nat) :\n    sNext s (upd ρ x v) M ι κ = (upd (sNext s ρ M ι κ).1 x v, (sNext s ρ M ι κ).2) := by\n  simp only [sNext, sView_upd hxi hxq hxf hb hfl]\n  rw [applyS_upd hxs (by simpa [List.all_eq_true] using hst)]\n  congr 1\n  funext mp key\n  simp only [everyMaps]\n  cases he : lookup (fun w => w.1 == mp) s.every with\n  | some w =>\n    obtain ⟨hv, hk⟩ := hev w (lookup_some he).1\n    exact congrE _ _ _ _ (fun i hi => by\n      have hix : i ≠ x := fun h => by rw [h, hv] at hi; cases hi\n      simp only [upd]\n      by_cases h1 : i = w.2.1\n      · simp [h1]\n      · simp [h1, hix])\n  | none =>\n    simp only [writeMaps]\n    cases hw : lookup (fun w : Nat × E × E => w.1 == mp) s.f.m.writes with\n    | none => rfl\n    | some w =>\n      obtain ⟨h1, h2⟩ := hwr w (lookup_some hw).1\n      have e1 : evalE (upd (sView s ρ M ι κ).1 x v) (sView s ρ M ι κ).2 w.2.1 = evalE (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 w.2.1 :=\n        congrE _ _ _ _ (fun i hi => by have hix : i ≠ x := (fun h => by rw [h, h1] at hi; cases hi); simp [upd, hix])\n      have e2 : evalE (upd (sView s ρ M ι κ).1 x v) (sView s ρ M ι κ).2 w.2.2 = evalE (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 w.2.2 :=\n        congrE _ _ _ _ (fun i hi => by have hix : i ≠ x := (fun h => by rw [h, h2] at hi; cases hi); simp [upd, hix])\n      simp only [e1, e2]\n\ntheorem sTermsOk_parts {s : SMachine} {Z : List Nat} (h : sTermsOk s Z = true) :\n    (∀ p ∈ s.f.flags, avoids Z p.2 = true)\n      ∧ (∀ p ∈ s.f.m.step, avoidsE (Z ++ s.wVars) (inlineE s.f.flags p.2) = true)\n      ∧ (∀ w ∈ s.f.m.writes, (avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.1) = true ∧ avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true) ∧ w.1 ∉ s.carried)\n      ∧ (∀ w ∈ s.every, avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true ∧ w.2.1 ∉ Z ∧ w.2.1 ∉ flagVars s.f.flags\n          ∧ (∀ p ∈ s.f.flags, occC w.2.1 p.2 = false) ∧ w.1 ∉ s.carried ∧ w.1 ∉ s.f.m.writes.map (·.1)) := by\n  simp only [sTermsOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨hf, hst⟩, hwr⟩, hev⟩, _⟩ := h\n  refine ⟨hf, hst, fun w hw => ⟨⟨(hwr w hw).1.1, (hwr w hw).1.2⟩, by simpa using (hwr w hw).2⟩, fun w hw => ?_⟩\n  obtain ⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩ := hev w hw\n  exact ⟨h1, by simpa using h2, by simpa using h3, fun p hp => by simpa using h4 p hp, by simpa using h5, by simpa using h6⟩\n\n-- The precondition holds in every reachable state: it reads the params alone.\ntheorem pre_sreach (s : SMachine) (hp : avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) s.f.m.pre = true)\n    (hr : readsC s.f.m.pre = false) : ∀ {ρ M}, SReach s ρ M → evalC ρ M s.f.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 s.f.m.pre hr]\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => by\n      simp only [sNext, sView]\n      rw [applyS_other (fun h => hi (by simp [h])), decide_other (fun h => hi (by simp [h]))]\n      simp only [decideQ]\n      rw [lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hi (by simp only [SMachine.extVars, SMachine.qVars, List.mem_append, List.mem_map]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inr ⟨q, hq, he⟩))))))]\n      exact withInputs_other (fun h => hi (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inl h)))))) ρ ι)]\n    exact ih\n\n-- The facts hold in every reachable state: a run starts where they hold, and no step moves what they read.\ntheorem facts_sreach (s : SMachine) (hf : factsOk s = true) : ∀ {ρ M}, SReach s ρ M → ∀ l ∈ s.facts, l.Holds ρ M := by\n  simp only [factsOk, List.all_eq_true, Bool.and_eq_true] at hf\n  intro ρ M h\n  induction h with\n  | start ρ M _ _ hfa =>\n    intro l hl\n    exact holds_transfer l (hf l hl).1 (MS := []) (by simp [avoidsMaps])\n      (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M) (fun _ _ => rfl) (hfa l hl)\n  | step ρ M ι κ _ _ ih =>\n    intro l hl\n    refine holds_transfer l (hf l hl).1 (hf l hl).2 (fun i hi => ?_) (fun mp hmp => ?_) (ih l hl)\n    · simp only [sNext, sView]\n      rw [applyS_other (fun h => hi (by simp [h])), decide_other (fun h => hi (by simp [h]))]\n      simp only [decideQ]\n      rw [lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hi (by simp only [SMachine.extVars, SMachine.qVars, List.mem_append, List.mem_map]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inr ⟨q, hq, he⟩))))))]\n      exact withInputs_other (fun h => hi (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inl h)))))) ρ ι\n    · simp only [List.mem_append, not_or] at hmp\n      obtain ⟨⟨hmc, hme⟩, hmw⟩ := hmp\n      funext key\n      simp only [sNext, sView, everyMaps]\n      rw [lookup_none (fun w hw => by simp only [beq_eq_false_iff_ne]; intro he; exact hme (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 hmw (by rw [← he]; exact List.mem_map_of_mem hw))]\n      simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]\n\ntheorem sTermsOk_facts {s : SMachine} {Z : List Nat} (h : sTermsOk s Z = true) : ∀ l ∈ s.facts, avoids Z l.holds = true := by\n  simp only [sTermsOk, Bool.and_eq_true, List.all_eq_true] at h; exact h.2\n\n-- The facts hold wherever the variables and maps they may read are the state's: away from the request, the flags, the\n-- state and the zone Vx, and from the maps a step writes, a request carries and the zone Mx.\ntheorem facts_frame (s : SMachine) (hfok : factsOk s = true) (Vx Mx : List Nat)\n    (hvx : ∀ l ∈ s.facts, avoids Vx l.holds = true) (hmx : ∀ l ∈ s.facts, avoidsMaps Mx l.holds = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {X : Nat → Nat} {N : Nat → Nat → Nat}\n    (hX : ∀ i, i ∉ s.extVars → i ∉ Vx → X i = ρ i) (hN : ∀ mp, mp ∉ s.carried → mp ∉ Mx → N mp = M mp)\n    (hl : ∀ l ∈ s.facts, l.Holds ρ M) : ∀ l ∈ s.facts, l.Holds X N := by\n  simp only [factsOk, List.all_eq_true, Bool.and_eq_true] at hfok\n  intro l hl'\n  refine holds_transfer (V := (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) ++ Vx)\n    (MS := (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) ++ Mx) l\n    (by simp only [avoids, List.all_append, Bool.and_eq_true] at hfok hvx ⊢; exact ⟨(hfok l hl').1, hvx l hl'⟩)\n    (by simp only [avoidsMaps, List.all_append, Bool.and_eq_true] at hfok hmx ⊢; exact ⟨(hfok l hl').2, hmx l hl'⟩)\n    (fun i hi => hX i (fun h => hi (by simp [h])) (fun h => hi (by simp [h])))\n    (fun mp hmp => hN mp (fun h => hmp (by simp [h])) (fun h => hmp (by simp [h]))) (hl l hl')\n\n-- Two environments that agree on what a law reads and at the skolem read its goal alike.\ntheorem goalOf_agree (l : MLaw) (sk : Nat) (N : Nat → Nat → Nat) {X X' : Nat → Nat} (hsk : X sk = X' sk)\n    (h : ∀ i, occC i l.holds = true → X i = X' i) : evalC X N (goalOf l sk) = evalC X' N (goalOf l sk) := by\n  unfold goalOf\n  split\n  · exact congrC _ _ N _ h\n  · rename_i kv _\n    rw [subst_evalC, subst_evalC, applyS_single, applyS_single]\n    exact congrC _ _ N _ (fun i hi => by\n      simp only [upd, evalE]; split\n      · exact hsk\n      · exact h i hi)\n\ntheorem sOk_of {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) : sOk s = true := by\n  simp only [checkSMachine, Bool.and_eq_true] at hl; exact hl.1.1.1.1.1\n\ntheorem spre_parts {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) :\n    avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) s.f.m.pre = true ∧ readsC s.f.m.pre = false := by\n  simp only [checkSMachine, Bool.and_eq_true] at hl; exact ⟨hl.1.1.1.1.2, by simpa using hl.1.1.1.2⟩\n\ntheorem sfacts_ok {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) : factsOk s = true := by\n  simp only [checkSMachine, Bool.and_eq_true] at hl; exact hl.1.2\n\ntheorem slaws_avoid {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) :\n    ∀ l ∈ ps.map (·.law), avoids s.extVars l.holds = true ∧ avoidsMaps s.carried l.holds = true := by\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true'] at hl\n  intro l hl'\n  obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl'\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩ := hl.2 e' he'\n  refine ⟨?_, h2⟩\n  simp only [avoids, List.all_append, Bool.and_eq_true] at h1 ⊢; exact h1.1\n\n/-! Entries, read at states -/\n\ntheorem upd_self (ρ : Nat → Nat) (x : Nat) : upd ρ x (ρ x) = ρ := funext fun i => by simp only [upd]; split <;> simp_all\ntheorem upd_upd_same (ρ : Nat → Nat) (x u w : Nat) : upd (upd ρ x u) x w = upd ρ x w := funext fun i => by simp only [upd]; split <;> rfl\ntheorem upd_comm (ρ : Nat → Nat) {x y : Nat} (h : x ≠ y) (u w : Nat) : upd (upd ρ x u) y w = upd (upd ρ y w) x u := funext fun i => by\n  simp only [upd]; by_cases hy : i = y <;> by_cases hx : i = x <;> simp_all\n\n-- An entry holds exactly where its law holds at every state that agrees with the state but at the further keys.\ntheorem holdsOver_any {l : MLaw} {M : Nat → Nat → Nat} : ∀ (gs : List Nat) {Y : Nat → Nat}, holdsOver l M gs Y → ∀ Z, Agree gs Z Y → l.Holds Z M\n  | [], Y, h, Z, hag => by\n    have hZ : Z = Y := funext fun i => hag i (by simp)\n    subst hZ; exact h\n  | g :: gs, Y, h, Z, hag => holdsOver_any gs (h (Z g)) Z (fun i hi => by\n      simp only [upd]; split\n      · rename_i hig; subst hig; rfl\n      · rename_i hig; exact hag i (by simp only [List.mem_cons, not_or]; exact ⟨hig, hi⟩))\n\ntheorem holdsOver_of_any {l : MLaw} {M : Nat → Nat → Nat} : ∀ (gs : List Nat) {Y : Nat → Nat}, (∀ Z, Agree gs Z Y → l.Holds Z M) → holdsOver l M gs Y\n  | [], Y, h => h Y (fun _ _ => rfl)\n  | g :: gs, Y, h => by\n    intro w\n    exact holdsOver_of_any gs (fun Z hag => h Z (fun i hi => by\n      simp only [List.mem_cons, not_or] at hi\n      rw [hag i hi.2]; simp only [upd, if_neg hi.1]))\n\ntheorem SEntry.holds_law {e : SEntry} {ρ : Nat → Nat} {M : Nat → Nat → Nat} (h : e.Holds ρ M) : e.law.Holds ρ M :=\n  holdsOver_any e.keys2 h ρ (fun _ _ => rfl)\n\n-- An entry read where its law reads alike holds alike (at every value of its further keys).\ntheorem sentry_transfer {V MS : List Nat} {e : SEntry} (hv : avoids V e.law.holds = true) (hm : avoidsMaps MS e.law.holds = true)\n    {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (hag : Agree V ρ ρ') (hmag : ∀ mp, mp ∉ MS → M mp = M' mp) : e.Holds ρ' M' → e.Holds ρ M := by\n  intro h\n  apply holdsOver_of_any\n  intro Z hZ\n  have h' := holdsOver_any e.keys2 h (fun i => if i ∈ e.keys2 then Z i else ρ' i) (fun i hi => by simp [hi])\n  exact holds_transfer e.law hv hm (fun i hiV => by\n    by_cases hk : i ∈ e.keys2\n    · simp [hk]\n    · simp only [hk, if_false]; rw [hZ i hk]; exact hag i hiV) hmag h'\n\n-- Setting a variable the law reads nowhere, or one of its further keys, keeps the entry.\ntheorem sentry_upd {e : SEntry} {x : Nat} (hx : occC x e.law.holds = false ∨ x ∈ e.keys2) {ρ : Nat → Nat} {M : Nat → Nat → Nat} (u : Nat) :\n    e.Holds ρ M → e.Holds (upd ρ x u) M := by\n  intro h\n  apply holdsOver_of_any\n  intro Z hZ\n  rcases hx with hx | hx\n  · have h' := holdsOver_any e.keys2 h (upd Z x (ρ x)) (fun i hi => by\n      simp only [upd]; split\n      · rename_i hix; subst hix; rfl\n      · rename_i hix; rw [hZ i hi]; simp only [upd, if_neg hix])\n    exact holds_transfer (V := [x]) (MS := []) e.law (by simp [avoids, hx]) (by simp [avoidsMaps])\n      (fun i hi => by simp only [upd]; rw [if_neg (by simpa using hi)]) (fun _ _ => rfl) h'\n  · exact holdsOver_any e.keys2 h Z (fun i hi => by\n      rw [hZ i hi]; simp only [upd]; rw [if_neg (fun h' => hi (by rw [h']; exact hx))])\n\n-- Each tuple's law holds wherever every entry does (the law's own key none of its further keys).\ntheorem pairLaws_hold (ps : List SEntry) (pinsts : List (Nat × E × List E)) (hkk : ∀ e ∈ ps, ∀ k, e.law.key = some k → k ∉ e.keys2)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (hall : ∀ e ∈ ps, e.Holds Y N) : ∀ l ∈ pairLaws ps pinsts, l.Holds Y N := by\n  have htrue : (⟨trueC, none⟩ : MLaw).Holds Y N := by simp [MLaw.Holds, trueC, evalC, evalE]\n  intro l hl\n  simp only [pairLaws, List.mem_map] at hl\n  obtain ⟨p, _, rfl⟩ := hl\n  split\n  · rename_i e he\n    have hem : e ∈ ps := List.mem_of_getElem? he\n    have hany := holdsOver_any e.keys2 (hall e hem)\n    have hdom : ∀ i, i ∉ e.keys2 → i ∉ (e.keys2.zip p.2.2).map (·.1) := fun i hi hm => by\n      obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hm; exact hi (List.of_mem_zip hq).1\n    cases hk : e.law.key with\n    | none =>\n      have h' := hany (applyS (e.keys2.zip p.2.2) Y N) (fun i hi => applyS_other (hdom i hi) Y N)\n      simp only [MLaw.Holds, hk] at h' ⊢\n      rw [subst_evalC]; exact h'\n    | some k =>\n      have hkg := hkk e hem k hk\n      simp only [MLaw.Holds, hk]\n      intro v\n      rw [subst_evalC]\n      have h' := hany (fun i => if i ∈ e.keys2 then applyS (e.keys2.zip p.2.2) (upd Y k v) N i else Y i) (fun i hi => by simp [hi])\n      simp only [MLaw.Holds, hk] at h'\n      have hZ : upd (fun i => if i ∈ e.keys2 then applyS (e.keys2.zip p.2.2) (upd Y k v) N i else Y i) k v = applyS (e.keys2.zip p.2.2) (upd Y k v) N := by\n        funext i\n        by_cases hik : i = k\n        · subst hik; simp only [upd, if_true]; rw [applyS_other (hdom i hkg)]; simp [upd]\n        · simp only [upd, if_neg hik]\n          by_cases hi : i ∈ e.keys2\n          · simp [hi]\n          · simp only [hi, if_false]; rw [applyS_other (hdom i hi)]; simp [upd, hik]\n      rw [← hZ]; exact h' v\n  · exact htrue\n\n-- A variable fresh as a skolem: setting it commutes with a step's view and with the step.\ntheorem fresh_parts {s : SMachine} {x : Nat} (hf : skFresh s x = true)\n    (hc : (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains x = false) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) (v : Nat) :\n    sNext s (upd ρ x v) M ι κ = (upd (sNext s ρ M ι κ).1 x v, (sNext s ρ M ι κ).2)\n      ∧ sView s (upd ρ x v) M ι κ = (upd (sView s ρ M ι κ).1 x v, (sView s ρ M ι κ).2)\n      ∧ x ∉ s.f.m.init.map (·.1) := by\n  obtain ⟨hf1, hf2, _, hf4, hf5, hf6, _⟩ := skFresh_parts hf\n  have hnot : x ∉ s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1) := fun hm => by\n    rw [List.contains_iff_mem.mpr hm] at hc; cases hc\n  have hE : x ∉ s.extVars := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ hm)))\n  have hF : x ∉ flagVars s.f.flags := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_right _ hm)))\n  have hS : x ∉ s.f.m.step.map (·.1) := fun hm => hnot (List.mem_append_right _ hm)\n  have hI : x ∉ s.f.m.init.map (·.1) := fun hm => hnot (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hi : x ∉ s.f.m.inputs := fun hm => hE (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl hm))\n  have hq : x ∉ s.qVars := fun hm => hE (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inr hm))\n  exact ⟨sNext_upd hi hq hF hf2 hf1 hS hf4 hf5 hf6 ρ M ι κ v, sView_upd hi hq hF hf2 hf1 ρ M ι κ v, hI⟩\n\ntheorem skey2_parts {s : SMachine} {ps : List SEntry} (h : checkSMachine s ps = true) {e : SEntry} (he : e ∈ ps) {g : Nat} (hg : g ∈ e.keys2) :\n    skFresh s g = true ∧ (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains g = false\n      ∧ occC g s.f.m.pre = false ∧ (∀ p ∈ s.f.m.init, occE g p.2 = false) ∧ (∀ e' ∈ ps, occC g e'.law.holds = false ∨ g ∈ e'.keys2)\n      ∧ e.law.key ≠ some g := by\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true] at h\n  have hk := (h.2 e he).1.1.2\n  simp only [key2Ok, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true', bne_iff_ne, ne_eq, Bool.or_eq_true, List.contains_iff_mem] at hk\n  obtain ⟨⟨⟨⟨⟨hkey, hf⟩, hc⟩, hp⟩, hi⟩, hall⟩ := hk g hg\n  exact ⟨hf, hc, hp, hi, fun e' he' => (by have := (hall e' he').1; simpa using this), hkey⟩\n\ntheorem skeys_apart {s : SMachine} {ps : List SEntry} (h : checkSMachine s ps = true) : ∀ e ∈ ps, ∀ k, e.law.key = some k → k ∉ e.keys2 :=\n  fun e he k hk hg => (skey2_parts h he hg).2.2.2.2.2 hk\n\n/-- The start: at params that meet the precondition and the facts, with maps as declared, every law holds. -/\ntheorem sstart_case (s : SMachine) (ps : List SEntry) (h : checkSMachine s ps = true) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (hM : StartMaps s.f.m M) (h0 : evalC ρ M s.f.m.pre = true) (hfa : ∀ l ∈ s.facts, l.Holds ρ M) :\n    ∀ e ∈ ps, e.law.Holds (applyS s.f.m.init ρ M) M := by\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨_, _⟩, _⟩, _⟩, hfok⟩, h⟩ := h\n  intro e he\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨_, _⟩, hfresh⟩, hslaw⟩, hspre⟩, hsinit⟩, hskf⟩, _⟩, hst⟩, _⟩ := h e he\n  refine goalOf_holds e.law (hslaw e he) _ 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 [sStartGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n  rcases hc with (rfl | hc) | rfl\n  · rw [congrC _ ρ M s.f.m.pre (fun i hi => by\n      simp only [upd]; split\n      · rename_i hik; subst hik; simp [hspre] at hi\n      · rfl)]\n    exact h0\n  · -- The facts hold at the start, and read not the skolem.\n    exact laws_hyps_true s.facts e.finsts _ M (facts_frame s hfok [e.sk] [] (fun l hl => by simp [avoids, (skFresh_parts hskf).2.2.2.2.2.2 l hl])\n      (fun _ _ => by simp [avoidsMaps]) (fun i _ hik => by simp only [upd]; rw [if_neg (by simpa using hik)]) (fun _ _ _ => rfl) hfa) c hc\n  · have hrd : ∀ mp k, evalE (upd ρ e.sk v) M (rdStart s.f.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\n/-- One step: from a state where the precondition, the facts and every entry hold, a request allowed keeps each law. -/\ntheorem sstep_case (s : SMachine) (ps : List SEntry) (h : checkSMachine s ps = true) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) (hp0 : evalC ρ M s.f.m.pre = true) (hfa : ∀ l ∈ s.facts, l.Holds ρ M)\n    (ih : ∀ e ∈ ps, e.Holds ρ M) (ha : evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true) :\n    ∀ e ∈ ps, e.law.Holds (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 := by\n  have hlav := slaws_avoid h\n  have hkk := skeys_apart h\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨hs, hpre⟩, hrp⟩, hterms⟩, hfok⟩, h⟩ := h\n  obtain ⟨hfav, hstp, hwr, hev⟩ := sTermsOk_parts hterms\n  intro e he\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨hlx, hlm⟩, hfresh⟩, hslaw⟩, hspre⟩, _⟩, hskf⟩, _⟩, _⟩, hst⟩ := h e he\n  obtain ⟨hf1, hf2, hf3, hf4, hf5, hf6, hf7⟩ := skFresh_parts hskf\n  have hnot : e.sk ∉ s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1) := fun hm => by\n    rw [List.contains_iff_mem.mpr hm] at hfresh; cases hfresh\n  have hskE : e.sk ∉ s.extVars := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ hm)))\n  have hskF : e.sk ∉ flagVars s.f.flags := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_right _ hm)))\n  -- The law at the next state with the carried maps in place reads as at the next state: it reads none of them.\n  refine holds_transfer (V := []) (MS := s.carried) (ρ' := (sNext s ρ M ι κ).1) (M' := withCarried s (sNext s ρ M ι κ).2 κ) e.law (by simp [avoids]) hlm (fun i _ => rfl)\n    (fun mp hmp => by simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]) ?_\n  refine goalOf_holds e.law (hslaw e he) _ _ (fun v => ?_)\n  apply Decidable.byContradiction; intro hn\n  -- The frame runs from the state with the skolem set to v: the machine reads it nowhere, so the step is the same.\n  obtain ⟨hNext, hView, _⟩ := fresh_parts hskf (by simpa [List.contains_iff_mem] using hnot) ρ M ι κ v\n  let W := withExt s (upd ρ e.sk v) (sReq s (upd ρ e.sk v) M ι κ)\n  let M0 := withCarried s M κ\n  have hH : ∀ Z, SHead s Z [] W M0 [] getRd (upd ρ e.sk v) M [] [] ι κ := fun Z => by\n    refine ⟨fun i _ => ?_, fun mp k _ => ?_⟩\n    · show applyS (frameSub [] []) W M0 i = W i\n      simp only [frameSub, List.map_nil, List.append_nil, applyS_nil']\n    · simp [frameRd, getRd, lookup, evalE, M0]\n  have hD : SDenotes s (flagVars s.f.flags) [] W M0 [] getRd (upd ρ e.sk v) M := by\n    refine ⟨fun i hie _ => ?_, fun mp k hmp _ => ?_⟩\n    · rw [applyS_nil']; simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)]\n    · simp only [getRd, evalE, M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]\n  have hD' := sstep_denotes s (flagVars s.f.flags) [] W M0 hs (fun v hv => hv) hfav [] [] ι κ hD (hH _) (fun p hp => by simp at hp)\n    hstp (fun w hw => (hwr w hw).1) hev (fun _ _ => by simp [avoidsMapsE]) (fun _ _ => by simp [avoidsMapsE]) (fun _ _ => by simp [avoidsMapsE])\n  apply sound _ _ hst W M0\n  intro c hc\n  simp only [sStepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false, List.mem_map] at hc\n  rcases hc with ((rfl | hc) | ⟨c', hc', rfl⟩) | rfl\n  · -- The precondition: it reads no map, no request and not the skolem.\n    rw [noReadsC W M0 M s.f.m.pre hrp, congrC W ρ M s.f.m.pre (fun i hi => ?_)]\n    · exact hp0\n    · have hi1 := avoids_occ hpre hi\n      have hik : i ≠ e.sk := fun h' => by rw [h'] at hi; simp [hspre] at hi\n      simp only [W, withExt]\n      rw [if_neg (fun h' => hi1 (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ (List.contains_iff_mem.mp h')))))]\n      simp only [upd, if_neg hik]\n  · -- The facts: they read no request, not the skolem, and no map a request carries.\n    exact laws_hyps_true s.facts e.finsts W M0 (facts_frame s hfok [e.sk] [] (fun l hl => by simp [avoids, hf7 l hl])\n      (fun _ _ => by simp [avoidsMaps])\n      (fun i hie hik => by simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)]; simp only [upd]; rw [if_neg (by simpa using hik)])\n      (fun mp hmc _ => by simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]) hfa) c hc\n  · -- The entries hold at the state with the skolem set (their laws don't read it), so in the goal's view of it, and so\n    -- does each pair's law; the assumption reads the skolem nowhere either.\n    have hA : evalC (sView s (upd ρ e.sk v) M ι κ).1 (sView s (upd ρ e.sk v) M ι κ).2 s.f.m.assume = true := by\n      rw [hView]; dsimp only\n      rw [congrC _ (sView s ρ M ι κ).1 _ _ (fun i hi => by\n        have hik : i ≠ e.sk := fun h' => by rw [h', hf3] at hi; cases hi\n        simp only [upd, if_neg hik])]\n      exact ha\n    have hallY : ∀ e' ∈ ps, e'.Holds W M0 := fun e' he' =>\n      sentry_transfer (hlav e'.law (List.mem_map_of_mem he')).1 (hlav 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        (sentry_upd (Or.inl (hslaw e' he')) v (ih e' he'))\n    exact sframe_hyps s [] [] W M0 hs (sLaws ps e.pinsts) (sInsts ps e.insts e.pinsts) e.qinsts\n      (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 (hallY e' he')\n        · exact pairLaws_hold ps e.pinsts hkk hallY l hl)\n      (hH []) (fun _ _ => by simp [avoids]) (fun _ _ => by simp [avoidsMaps]) hA (by simp [trueC, evalC, evalE]) c' hc'\n  · -- The goal, read across the step: the maps a request carries read as carried, the rest as the step leaves them.\n    have hrd' : ∀ mp k, evalE W M0 (stepRdS s (frameSub [] []) (frameRd [] getRd) mp k) = withCarried s (sNext s ρ M ι κ).2 κ mp (evalE W M0 k) := by\n      intro mp k\n      by_cases hmp : mp ∈ s.carried\n      · have hne : lookup (fun w => w.1 == mp) s.every = none := lookup_none (fun w hw => by\n          simp only [beq_eq_false_iff_ne]; intro h'; exact (hev w hw).2.2.2.2.1 (by rw [h']; exact hmp))\n        have hnw : lookup (fun w : Nat × E × E => w.1 == mp) s.f.m.writes = none := lookup_none (fun w hw => by\n          simp only [beq_eq_false_iff_ne]; intro h'; exact (hwr w hw).2 (by rw [h']; exact hmp))\n        simp only [stepRdS, hne, stepRd, hnw]\n        simp [frameRd, getRd, lookup, evalE, M0, withCarried, hmp]\n      · rw [hD'.2 mp k hmp (by simp), hNext]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]\n    simp only [evalC]\n    rw [substR_evalC _ _ W M0 _ hrd', goalOf_agree e.law e.sk _ (X' := upd (sNext s ρ M ι κ).1 e.sk v)\n      (by rw [hD'.1 e.sk hskE hskF, hNext]) (fun i hi => ?_)]\n    · simpa using hn\n    · have hi1 := avoids_occ hlx hi\n      rw [hD'.1 i (fun h' => hi1 (List.mem_append_left _ h')) (fun h' => hi1 (List.mem_append_right _ h')), hNext]\n\n/-- The induction rule with sets: for params that meet the precondition, maps that start as declared and functions that\nmeet the facts, every entry of an accepted proof holds in every reachable state (a law about several keys at every value\nof its further keys), whatever maps each request carries. -/\ntheorem smachine_sound (s : SMachine) (ps : List SEntry) (h : checkSMachine s ps = true) :\n    ∀ ρ M, SReach s ρ M → ∀ e ∈ ps, e.Holds ρ M := by\n  have hpre := spre_parts h\n  have hfok := sfacts_ok h\n  -- Facts at a state hold with a further key set: they read no further key.\n  have hfacts : ∀ {ρ : Nat → Nat} {M : Nat → Nat → Nat} {g : Nat}, skFresh s g = true → (∀ l ∈ s.facts, l.Holds ρ M) → ∀ w, ∀ l ∈ s.facts, l.Holds (upd ρ g w) M := by\n    intro ρ M g hf hfa w\n    exact facts_frame s hfok [g] [] (fun l hl => by simp [avoids, (skFresh_parts hf).2.2.2.2.2.2 l hl]) (fun _ _ => by simp [avoidsMaps])\n      (fun i _ hig' => by simp only [upd]; rw [if_neg (by simpa using hig')]) (fun _ _ _ => rfl) hfa\n  have hpreu : ∀ {ρ : Nat → Nat} {M : Nat → Nat → Nat} {g : Nat}, occC g s.f.m.pre = false → evalC ρ M s.f.m.pre = true → ∀ w, evalC (upd ρ g w) M s.f.m.pre = true := by\n    intro ρ M g hpg h0 w\n    rw [congrC _ ρ M s.f.m.pre (fun i hi => by have hig' : i ≠ g := (fun h' => by rw [h', hpg] at hi; cases hi); simp only [upd, if_neg hig'])]; exact h0\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 hfa =>\n    intro e he\n    -- Each further key set in turn, from a start state that meets the precondition and the facts.\n    suffices hs : ∀ gs : List Nat, (∀ g ∈ gs, g ∈ e.keys2) → ∀ ρ', evalC ρ' M s.f.m.pre = true → (∀ l ∈ s.facts, l.Holds ρ' M) →\n        holdsOver e.law M gs (applyS s.f.m.init ρ' M) from hs e.keys2 (fun g hg => hg) ρ h0 hfa\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf; exact sstart_case s ps h ρ' M hM hp hf e he\n    | cons g gs ih =>\n      intro hsub ρ' hp hf w\n      obtain ⟨hfr, hc, hpg, hig, _, _⟩ := skey2_parts h he (hsub g List.mem_cons_self)\n      have hI := (fresh_parts hfr hc ρ' M (fun _ => 0) (fun _ _ => 0) 0).2.2\n      rw [← applyS_upd hI (by simpa [List.all_eq_true] using hig)]\n      exact ih (fun g' hg' => hsub g' (List.mem_cons_of_mem _ hg')) (upd ρ' g w) (hpreu hpg hp w) (hfacts hfr hf w)\n  | step ρ M ι κ hr ha ih =>\n    intro e he\n    suffices hs : ∀ gs : List Nat, (∀ g ∈ gs, g ∈ e.keys2) → ∀ ρ', evalC ρ' M s.f.m.pre = true → (∀ l ∈ s.facts, l.Holds ρ' M) →\n        (∀ e' ∈ ps, e'.Holds ρ' M) → evalC (sView s ρ' M ι κ).1 (sView s ρ' M ι κ).2 s.f.m.assume = true →\n        holdsOver e.law (sNext s ρ' M ι κ).2 gs (sNext s ρ' M ι κ).1 from\n      hs e.keys2 (fun g hg => hg) ρ (pre_sreach s hpre.1 hpre.2 hr) (facts_sreach s hfok hr) ih ha\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf hi ha'; exact sstep_case s ps h ρ' M ι κ hp hf hi ha' e he\n    | cons g gs ihg =>\n      intro hsub ρ' hp hf hi ha' w\n      obtain ⟨hfr, hc, hpg, _, hall, _⟩ := skey2_parts h he (hsub g List.mem_cons_self)\n      obtain ⟨hNext, hView, _⟩ := fresh_parts hfr hc ρ' M ι κ w\n      have := ihg (fun g' hg' => hsub g' (List.mem_cons_of_mem _ hg')) (upd ρ' g w) (hpreu hpg hp w) (hfacts hfr hf w)\n        (fun e' he' => sentry_upd (hall e' he') w (hi e' he'))\n        (by\n          rw [hView]; dsimp only\n          rw [congrC _ (sView s ρ' M ι κ).1 _ _ (fun i hi => by\n            have hig' : i ≠ g := fun h' => by rw [h', (skFresh_parts hfr).2.2.1] at hi; cases hi\n            simp only [upd, if_neg hig'])]\n          exact ha')\n      rw [hNext] at this; exact this\n\n/-! k-step laws over sets -/\n\nstructure SKStep where\n  k : KStep                        -- whens (flags inlined), then, ren (each later step: every extended request variable), primes, insts, proof\n  mren : List (List (Nat × Nat))   -- per step: (carried map, the name the goal reads it by there); [] for the first step\n  qinsts : List (Nat × E)          -- (quantified flag, key): where each frame closes it\n  finsts : List (Nat × E)          -- (fact index, key): where the goal assumes the facts, read at the first frame\n  pinsts : List (Nat × E × List E) -- (law index, key, further keys): where each frame assumes the laws about several keys\n\ndef sKOut (s : SMachine) (ps : List SEntry) (sl : SKStep) := sRun s (sLaws ps sl.pinsts) (sInsts ps sl.k.insts sl.pinsts) sl.qinsts sl.k.whens sl.k.ren sl.mren [] getRd\ndef sKGoal (s : SMachine) (ps : List SEntry) (sl : SKStep) : List C :=\n  [s.f.m.pre] ++ factHyps s sl.finsts ++ (sKOut s ps sl).1\n    ++ [.not (substRC (kEndSub sl.k (sKOut s ps sl).2.1 (sKOut s ps sl).2.2) (kEndRd sl.k (sKOut s ps sl).2.2) sl.k.then_)]\n\n-- The step's terms, flags inlined, read none of the names later requests' maps are read by.\ndef sMapsOk (s : SMachine) (MZ : List Nat) : Bool :=\n  s.f.m.step.all (fun p => avoidsMapsE MZ (inlineE s.f.flags p.2))\n    && s.f.m.writes.all (fun w => avoidsMapsE MZ (inlineE s.f.flags w.2.1) && avoidsMapsE MZ (inlineE s.f.flags w.2.2))\n    && s.every.all (fun w => avoidsMapsE MZ (inlineE s.f.flags w.2.2))\n    && s.facts.all (fun l => avoidsMaps MZ l.holds)\n\ndef szone (s : SMachine) (sl : SKStep) : List Nat := tgts sl.k.ren ++ flagVars s.f.flags\n\ndef checkSKStep (s : SMachine) (ps : List SEntry) (sl : SKStep) : Bool :=\n  sl.k.whens.length == sl.k.ren.length && sl.mren.length == sl.k.ren.length && sl.k.ren.head? == some [] && sl.mren.head? == some []\n    && distinct (tgts sl.k.ren) && distinct (tgts sl.mren)\n    && sl.k.ren.all (fun r => r.all fun p => s.extVars.contains p.1)\n    && sl.k.ren.tail.all (fun r => s.extVars.all fun i => r.any (·.1 == i))\n    && sl.mren.all (fun r => r.all fun p => s.carried.contains p.1)\n    && sl.mren.tail.all (fun r => s.carried.all fun mp => r.any (·.1 == mp))\n    && sl.k.prime.all (fun q => !s.extVars.contains q.1 && !(szone s sl).contains q.1)\n    && sl.k.primeMaps.all (fun q => !s.carried.contains q.1 && !(tgts sl.mren).contains q.1)\n    && avoids (szone s sl) s.f.m.pre\n    && sl.k.whens.all (fun w => (sFrameHyps s (sLaws ps sl.pinsts) (sInsts ps sl.k.insts sl.pinsts) sl.qinsts w).all fun c => avoids (szone s sl) c && avoidsMaps (tgts sl.mren) c)\n    && sTermsOk s (szone s sl) && sMapsOk s (tgts sl.mren)\n    && checkGoal ⟨sl.k.proof.1, sKGoal s ps sl⟩ sl.k.proof.2\n\n/-! What a k-step law over sets claims -/\n\nabbrev SRequest := (Nat → Nat) × (Nat → Nat → Nat)   -- a request's inputs, and the maps it carries\n\nnoncomputable def sEnd (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → (Nat → Nat) × (Nat → Nat → Nat)\n  | ρ, M, [] => (ρ, M)\n  | ρ, M, q :: qs => sEnd s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\n-- Each step's extended request (inputs, quantified flags, witnesses), as its goal reads it.\nnoncomputable def sExts (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → List (Nat → Nat)\n  | _, _, [] => []\n  | ρ, M, q :: qs => sReq s ρ M q.1 q.2 :: sExts s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\n-- Each request allowed (the assumption, flags decided) and meeting its step's `when`.\ndef SAllowed (s : SMachine) : List C → (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → Prop\n  | w :: ws, ρ, M, q :: qs =>\n    evalC (sView s ρ M q.1 q.2).1 (sView s ρ M q.1 q.2).2 s.f.m.assume = true\n      ∧ evalC (withExt s ρ (sReq s ρ M q.1 q.2)) (withCarried s M q.2) w = true\n      ∧ SAllowed s ws (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n  | _, _, _, _ => True\n\n/-- A k-step law over sets: from every reachable state, every k requests in a row the machine allows end in a state\nwhere `then` holds: primed names read the last state and maps, plain names the first state with the first request,\neach later request read by its fresh variables and the maps it carries by their fresh names. -/\ndef SKStepHolds (s : SMachine) (sl : SKStep) : Prop :=\n  ∀ ρ M, SReach s ρ M → ∀ q₁ qs, qs.length + 1 = sl.k.whens.length → SAllowed s sl.k.whens ρ M (q₁ :: qs) →\n    evalC (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 (renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))))\n      (primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 (renMaps sl.mren ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2))) sl.k.then_ = true\n\n/-! The proof -/\n\ntheorem sMapsOk_parts {s : SMachine} {MZ : List Nat} (h : sMapsOk s MZ = true) :\n    (∀ p ∈ s.f.m.step, avoidsMapsE MZ (inlineE s.f.flags p.2) = true)\n      ∧ (∀ w ∈ s.f.m.writes, avoidsMapsE MZ (inlineE s.f.flags w.2.1) = true ∧ avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true)\n      ∧ (∀ w ∈ s.every, avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true) := by\n  simp only [sMapsOk, Bool.and_eq_true, List.all_eq_true] at h\n  exact ⟨h.1.1.1, h.1.1.2, h.1.2⟩\n\ntheorem sMapsOk_facts {s : SMachine} {MZ : List Nat} (h : sMapsOk s MZ = true) : ∀ l ∈ s.facts, avoidsMaps MZ l.holds = true := by\n  simp only [sMapsOk, Bool.and_eq_true, List.all_eq_true] at h; exact h.2\n\ntheorem renMaps_other : ∀ (rs : List (List (Nat × Nat))) (κs : List (Nat → Nat → Nat)) (b : Nat → Nat → Nat) (mp : Nat),\n    mp ∉ tgts rs → renMaps rs κs b mp = b mp\n  | [], κs, b, mp, _ => by cases κs <;> rfl\n  | r :: rs, [], b, mp, _ => rfl\n  | r :: rs, κ :: κs, b, mp, hv => by\n    simp only [tgts, List.mem_append, not_or] at hv\n    have hn : lookup (fun p : Nat × Nat => p.2 == mp) 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 [renMaps, hn]\n    exact renMaps_other rs κs b mp hv.2\n\n-- Each step's fresh map names hold the maps its request carries.\ndef MRenOK (M0 : Nat → Nat → Nat) : List (List (Nat × Nat)) → List (Nat → Nat → Nat) → Prop\n  | r :: rs, κ :: κs => (∀ p ∈ r, M0 p.2 = κ p.1) ∧ MRenOK M0 rs κs\n  | _, _ => True\n\ntheorem mrenOK_congr {M0 M0' : Nat → Nat → Nat} : ∀ (rs : List (List (Nat × Nat))) (κs : List (Nat → Nat → Nat)),\n    (∀ v ∈ tgts rs, M0 v = M0' v) → MRenOK M0' rs κs → MRenOK M0 rs κs\n  | [], _, _, _ => trivial\n  | _ :: _, [], _, _ => trivial\n  | r :: rs, κ :: κs, hag, ⟨hh, ht⟩ => by\n    refine ⟨fun p hp => ?_, mrenOK_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 renMaps_ok : ∀ (rs : List (List (Nat × Nat))) (κs : List (Nat → Nat → Nat)) (b : Nat → Nat → Nat),\n    distinct (tgts rs) = true → MRenOK (renMaps 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 => ?_, mrenOK_congr rs κs (fun v hv => ?_) (renMaps_ok rs κs b hrs)⟩\n    · simp only [renMaps, 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 [renMaps, hn]\n\ndef SHeadL (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (rd : Nat → E → E)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) : List (List (Nat × Nat)) → List (List (Nat × Nat)) → List SRequest → Prop\n  | r :: _, mr :: _, q :: _ => SHead s Z MZ W M0 σ rd ρ M r mr q.1 q.2\n  | _, _, _ => True\n\ntheorem skrun_sound (s : SMachine) (ps : List SEntry) (hl : checkSMachine s ps = true) (Z MZ : List Nat) (laws : List MLaw) (insts qinsts : List (Nat × E))\n    (hlY : ∀ ρ M ι κ, SReach s ρ M → ∀ l ∈ laws, l.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ))\n    (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n    (hfz : ∀ v ∈ flagVars s.f.flags, v ∈ Z) (hterms : sTermsOk s Z = true) (hmaps : sMapsOk s MZ = true) :\n    ∀ (ws : List C) (rs mrs : List (List (Nat × Nat))) (qs : List SRequest) (σ : List (Nat × E)) (rd : Nat → E → E)\n      (ρ : Nat → Nat) (M : Nat → Nat → Nat),\n      ws.length = rs.length → ws.length = mrs.length → ws.length = qs.length →\n      (∀ w ∈ ws, ∀ c ∈ sFrameHyps s laws insts qinsts w, avoids Z c = true ∧ avoidsMaps MZ c = true) →\n      (∀ r ∈ rs, ∀ p ∈ r, p.1 ∈ s.extVars) →\n      (∀ r ∈ rs.tail, ∀ i ∈ s.extVars, ∃ p ∈ r, p.1 = i) →\n      (∀ r ∈ mrs, ∀ p ∈ r, p.1 ∈ s.carried) →\n      (∀ r ∈ mrs.tail, ∀ mp ∈ s.carried, ∃ p ∈ r, p.1 = mp) →\n      RenOK W rs.tail (sExts s ρ M qs).tail → MRenOK M0 mrs.tail (qs.map (·.2)).tail →\n      SReach s ρ M → SDenotes s Z MZ W M0 σ rd ρ M → SHeadL s Z MZ W M0 σ rd ρ M rs mrs qs → SAllowed s ws ρ M qs →\n      (∀ c ∈ (sRun s laws insts qinsts ws rs mrs σ rd).1, evalC W M0 c = true)\n        ∧ SDenotes s Z MZ W M0 (sRun s laws insts qinsts ws rs mrs σ rd).2.1 (sRun s laws insts qinsts ws rs mrs σ rd).2.2\n            (sEnd s ρ M qs).1 (sEnd s ρ M qs).2\n  | [], rs, mrs, qs, σ, rd, ρ, M, hl1, hl2, hl3, _, _, _, _, _, _, _, _, hD, _, _ => by\n    cases rs with\n    | cons _ _ => simp at hl1\n    | nil =>\n      cases mrs with\n      | cons _ _ => simp at hl2\n      | nil =>\n        cases qs with\n        | cons _ _ => simp at hl3\n        | nil => exact ⟨fun c hc => by simp [sRun] at hc, hD⟩\n  | w :: ws, rs, mrs, qs, σ, rd, ρ, M, hl1, hl2, hl3, hav, hkeys, hcov, hmkeys, hmcov, hren, hmren, hr, hD, hH, hK => by\n    rcases rs with _ | ⟨r, rs⟩\n    · simp at hl1\n    rcases mrs with _ | ⟨mr, mrs⟩\n    · simp at hl2\n    rcases qs with _ | ⟨q, qs⟩\n    · simp at hl3\n    simp only [List.length_cons, Nat.add_right_cancel_iff] at hl1 hl2 hl3\n    simp only [List.tail_cons] at hcov hmcov\n    have hren1 : RenOK W rs (sExts s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs) := hren\n    have hmren1 : MRenOK M0 mrs (qs.map (·.2)) := hmren\n    obtain ⟨hA, hW, hK'⟩ := hK\n    have hH1 : SHead s Z MZ W M0 σ rd ρ M r mr q.1 q.2 := hH\n    obtain ⟨hfav, hstp, hwr, hev⟩ := sTermsOk_parts hterms\n    obtain ⟨hstm, hwrm, hevm⟩ := sMapsOk_parts hmaps\n    have hD' := sstep_denotes s Z MZ W M0 (sOk_of hl) hfz hfav r mr q.1 q.2 hD hH1 (hkeys r List.mem_cons_self) hstp\n      (fun w hw => (hwr w hw).1) hev hstm hwrm hevm\n    have hr' : SReach s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 := SReach.step ρ M q.1 q.2 hr hA\n    -- The next step's frame, its request set and its maps read, agrees with the next state and request.\n    have hH' : SHeadL s Z MZ W M0 (stepSub s.f (frameSub r σ) (frameRd mr rd)) (stepRdS s (frameSub r σ) (frameRd mr rd))\n        (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 rs mrs qs := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases mrs with _ | ⟨mr', mrs'⟩\n      · exact trivial\n      rcases qs with _ | ⟨q', qs'⟩\n      · exact trivial\n      have hr1 : ∀ p ∈ r', W p.2 = sReq s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 q'.1 q'.2 p.1 := hren1.1\n      have hm1 : ∀ p ∈ mr', M0 p.2 = q'.2 p.1 := hmren1.1\n      refine ⟨fun v hvz => ?_, fun mp k hmz => ?_⟩\n      · by_cases hve : v ∈ s.extVars\n        · rw [applyS_frame_in (hcov r' List.mem_cons_self v hve) hr1]\n          simp only [withExt]; rw [if_pos (List.contains_iff_mem.mpr hve)]\n        · rw [applyS_frame_out (fun p hp he => hve (by rw [← he]; exact hkeys r' (List.mem_cons_of_mem _ List.mem_cons_self) p hp)),\n            hD'.1 v hve hvz]\n          simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hve)]\n      · by_cases hmc : mp ∈ s.carried\n        · cases hlk : lookup (fun p : Nat × Nat => p.1 == mp) mr' with\n          | none =>\n            obtain ⟨p, hp, hp1⟩ := hmcov mr' List.mem_cons_self mp hmc\n            have := lookup_none_all hlk p hp\n            simp [hp1] at this\n          | some p0 =>\n            have hp0 := lookup_some hlk\n            simp only [beq_iff_eq] at hp0\n            simp only [frameRd, hlk, evalE]\n            rw [hm1 p0 hp0.1, hp0.2]; simp only [withCarried]; rw [if_pos (List.contains_iff_mem.mpr hmc)]\n        · have hlk : lookup (fun p : Nat × Nat => p.1 == mp) mr' = none := lookup_none (fun p hp => by\n            simp only [beq_eq_false_iff_ne]; intro he\n            exact hmc (by rw [← he]; exact hmkeys mr' (List.mem_cons_of_mem _ List.mem_cons_self) p hp))\n          simp only [frameRd, hlk]\n          rw [hD'.2 mp k hmc hmz]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]\n    have hren' : RenOK W rs.tail (sExts s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs).tail := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases qs with _ | ⟨q', qs'⟩\n      · cases rs' <;> exact trivial\n      exact hren1.2\n    have hmren' : MRenOK M0 mrs.tail (qs.map (·.2)).tail := by\n      rcases mrs with _ | ⟨mr', mrs'⟩\n      · exact trivial\n      rcases qs with _ | ⟨q', qs'⟩\n      · cases mrs' <;> exact trivial\n      exact hmren1.2\n    obtain ⟨ih1, ih2⟩ := skrun_sound s ps hl Z MZ laws insts qinsts hlY W M0 hfz hterms hmaps ws rs mrs qs _ _ _ _ hl1 hl2 hl3\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      (fun r' hr'' => hmkeys r' (List.mem_cons_of_mem _ hr''))\n      (fun r' hr'' => hmcov r' (List.mem_of_mem_tail hr''))\n      hren' hmren' hr' hD' hH' hK'\n    refine ⟨fun c hc => ?_, ih2⟩\n    simp only [sRun, List.mem_append, List.mem_map] at hc\n    rcases hc with ⟨c', hc', rfl⟩ | hc\n    · exact sframe_hyps s Z MZ W M0 (sOk_of hl) laws insts qinsts (hlY ρ M q.1 q.2 hr)\n        hH1 (fun c hc => (hav w List.mem_cons_self c hc).1) (fun c hc => (hav w List.mem_cons_self c hc).2) hA hW c' hc'\n    · exact ih1 c hc\n\n/-- The k-step rule over sets: an accepted k-step goal makes its law hold. -/\ntheorem skstep_sound (s : SMachine) (ps : List SEntry) (sl : SKStep)\n    (hl : checkSMachine s ps = true) (hc : checkSKStep s ps sl = true) : SKStepHolds s sl := by\n  intro ρ M hr q₁ qs hlen hK\n  simp only [checkSKStep, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hc\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hlw, hlm⟩, hhead⟩, hmhead⟩, hdist⟩, hmdist⟩, hkeys⟩, hcov⟩, hmkeys⟩, hmcov⟩, hpr⟩, hpm⟩, hpre⟩, hws⟩, hterms⟩, hmaps⟩, hgoal⟩ := hc\n  obtain ⟨hpreS, hrp⟩ := spre_parts hl\n  have hflags : ∀ v ∈ flagVars s.f.flags, v ∈ szone s sl := fun v hv => List.mem_append_right _ hv\n  obtain ⟨rs, hrs⟩ : ∃ rs, sl.k.ren = [] :: rs := by\n    cases h : sl.k.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  obtain ⟨mrs, hmrs⟩ : ∃ mrs, sl.mren = [] :: mrs := by\n    cases h : sl.mren with\n    | nil => rw [h] at hmhead; simp at hmhead\n    | cons r rs => rw [h] at hmhead; simp only [List.head?_cons, Option.some.injEq] at hmhead; exact ⟨rs, by rw [hmhead]⟩\n  let W := renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))\n  let M0 := renMaps sl.mren ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2)\n  have hWo : ∀ v, v ∉ szone s sl → W v = withExt s ρ (sReq s ρ M q₁.1 q₁.2) v := fun v hv =>\n    renEnv_other _ _ _ v (fun h => hv (List.mem_append_left _ h))\n  have hMo : ∀ mp, mp ∉ tgts sl.mren → M0 mp = withCarried s M q₁.2 mp := fun mp hmp => renMaps_other _ _ _ mp hmp\n  have hD0 : SDenotes s (szone s sl) (tgts sl.mren) W M0 [] getRd ρ M := by\n    refine ⟨fun v hve hvz => ?_, fun mp k hmc hmz => ?_⟩\n    · rw [applyS_nil', hWo v hvz]; simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hve)]\n    · simp only [getRd, evalE]; rw [hMo mp hmz]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]\n  have hH0 : SHeadL s (szone s sl) (tgts sl.mren) W M0 [] getRd ρ M sl.k.ren sl.mren (q₁ :: qs) := by\n    rw [hrs, hmrs]\n    show SHead s (szone s sl) (tgts ([] :: mrs)) W M0 [] getRd ρ M [] [] q₁.1 q₁.2\n    refine ⟨fun v hvz => ?_, fun mp k hmz => ?_⟩\n    · simp only [frameSub, List.map_nil, List.append_nil, applyS_nil']; exact hWo v hvz\n    · simp only [frameRd, lookup, getRd, evalE]; rw [hMo mp (by rw [hmrs]; exact hmz)]\n  have hren0 : RenOK W sl.k.ren.tail (sExts s ρ M (q₁ :: qs)).tail := by\n    have h : RenOK W sl.k.ren (sExts s ρ M (q₁ :: qs)) := renEnv_ok sl.k.ren _ _ hdist\n    rw [hrs] at h ⊢; exact h.2\n  have hmren0 : MRenOK M0 sl.mren.tail ((q₁ :: qs).map (·.2)).tail := by\n    have h : MRenOK M0 sl.mren ((q₁ :: qs).map (·.2)) := renMaps_ok sl.mren _ _ hmdist\n    rw [hmrs] at h ⊢; exact h.2\n  -- Every entry holds at each reachable state, so each law (and each pair's) holds in the goal's view of it.\n  have hlY : ∀ ρ M ι κ, SReach s ρ M → ∀ l ∈ sLaws ps sl.pinsts, l.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) := by\n    intro ρ M ι κ hr l hl'\n    have hall : ∀ e ∈ ps, e.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) := 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 [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hi)])\n        (fun mp hmp => by simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)])\n        (smachine_sound s ps hl ρ M hr e he)\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 sl.pinsts (skeys_apart hl) hall l hl'\n  obtain ⟨hh, hfin⟩ := skrun_sound s ps hl (szone s sl) (tgts sl.mren) (sLaws ps sl.pinsts) (sInsts ps sl.k.insts sl.pinsts) sl.qinsts hlY W M0 hflags hterms hmaps\n    sl.k.whens sl.k.ren sl.mren (q₁ :: qs) [] getRd ρ M hlw (by omega) (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    (fun r hr p hp => List.contains_iff_mem.mp (hmkeys r hr p hp))\n    (fun r hr i hi => by have := hmcov r hr i hi; simpa only [List.any_eq_true, beq_iff_eq] using this)\n    hren0 hmren0 hr hD0 hH0 hK\n  have hfin' : SDenotes s (szone s sl) (tgts sl.mren) W M0 (sKOut s ps sl).2.1 (sKOut s ps sl).2.2\n      (sEnd s ρ M (q₁ :: qs)).1 (sEnd s ρ M (q₁ :: qs)).2 := hfin\n  apply Decidable.byContradiction; intro hn\n  have hn' : ¬ evalC (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W) (primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 M0) sl.k.then_ = true := hn\n  apply sound _ _ hgoal W M0\n  intro c hc\n  simp only [sKGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with ((rfl | hc) | hc) | rfl\n  · -- The precondition: at the first state (it reads no map, no request and no fresh variable).\n    rw [noReadsC W M0 M s.f.m.pre hrp, congrC W ρ M s.f.m.pre (fun j hj => ?_)]\n    · exact pre_sreach s hpreS hrp hr\n    · rw [hWo j (avoids_occ hpre hj)]; simp only [withExt]\n      rw [if_neg (fun h' => avoids_occ hpreS hj (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ (List.contains_iff_mem.mp h')))))]\n  · -- The facts, at the first frame: it agrees with the first state away from the zone and the request.\n    exact laws_hyps_true s.facts sl.finsts W M0 (facts_frame s (sfacts_ok hl) (szone s sl) (tgts sl.mren) (sTermsOk_facts hterms) (sMapsOk_facts hmaps)\n      (fun i hie hiz => by rw [hWo i hiz]; simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)])\n      (fun mp hmc hmz => by rw [hMo mp hmz]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)])\n      (facts_sreach s (sfacts_ok hl) hr)) c hc\n  · exact hh c hc\n  · -- `then`, read across the run, is what SKStepHolds reads.\n    have hrdE : ∀ mp k, evalE W M0 (kEndRd sl.k (sKOut s ps sl).2.2 mp k)\n        = primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 M0 mp (evalE W M0 k) := by\n      intro mp k\n      simp only [kEndRd, primedMaps]\n      cases hq : lookup (fun q => q.2 == mp) sl.k.primeMaps with\n      | none => simp [evalE]\n      | some q =>\n        have hq1 := hpm q (lookup_some hq).1\n        simp only [Bool.not_eq_true'] at hq1\n        exact hfin'.2 q.1 k (by simpa using hq1.1) (by simpa using hq1.2)\n    have henv : applyS (kEndSub sl.k (sKOut s ps sl).2.1 (sKOut s ps sl).2.2) W M0\n        = primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).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.k.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 ∉ s.extVars := by simpa using hq1.1\n        have hqz : q.1 ∉ szone s sl := by simpa using hq1.2\n        show evalE W M0 (substRE (sKOut s ps sl).2.1 (sKOut s ps sl).2.2 (.var q.1)) = (sEnd s ρ M (q₁ :: qs)).1 q.1\n        rw [substR_var]; exact hfin'.1 q.1 hqi hqz\n    simp only [evalC, substR_evalC _ _ W M0 _ hrdE, henv]\n    simpa using hn'\n\nend Kern\n\n#print axioms Kern.smachine_sound\n#print axioms Kern.skstep_sound\n",
+    "Live.lean": "import Sets\n\n/-!\nLiveness under fairness: \"from leads to to\", proven sound for machines with maps and flags (`leads_sound`) and for\nmachines with sets (`sleads_sound`). 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\n/-! Machines with maps and flags -/\n\n-- What the liveness reads: no primed name; a variable unprimed is no input, flag or step target, and a map unprimed is\n-- never written (so each reads the same before and after a step). Primed names are distinct. Each request names inputs\n-- by terms that read none.\ndef liveVars (f : FMMachine) (l : Live) : List Nat :=\n  l.prime.map (·.2) ++ f.m.inputs ++ (flagVars f.flags ++ f.m.step.map (·.1)).filter (fun i => !(l.prime.map (·.1)).contains i)\ndef liveMaps (f : FMMachine) (l : Live) : List Nat :=\n  l.primeMaps.map (·.2) ++ (f.m.writes.map (·.1)).filter (fun mp => !(l.primeMaps.map (·.1)).contains mp)\ndef liveOk (f : FMMachine) (l : Live) : Bool :=\n  distinct (l.prime.map (·.2)) && distinct (l.primeMaps.map (·.2))\n    && (liveConds l).all (fun c => avoids (liveVars f l) c && avoidsMaps (liveMaps f l) c)\n    && l.helps.all (fun h => h.2.all (fun p => f.m.inputs.contains p.1 && avoids f.m.inputs (.eq p.2 p.2)))\n\n-- The step laws Lean checks, built from the liveness.\ndef liveStay (l : Live) (insts : List (Nat × E)) (proof : List VDef × Tree) : StepLaw :=\n  ⟨l.pend, liveStayC l, l.prime, l.primeMaps, insts, proof⟩\ndef liveCover (l : Live) (insts : List (Nat × E)) (proof : List VDef × Tree) : StepLaw :=\n  ⟨l.pend, liveCoverC l, l.prime, l.primeMaps, insts, proof⟩\ndef liveHelp (l : Live) (h : C × List (Nat × E)) (insts : List (Nat × E)) (proof : List VDef × Tree) : StepLaw :=\n  ⟨liveHelpWhen l h, liveHelpThen l, l.prime, l.primeMaps, insts, proof⟩\ndef liveHelpsOk (f : FMMachine) (ps : List MEntry) (l : Live) (hp : List (List (Nat × E) × (List VDef × Tree))) : Bool :=\n  l.helps.length == hp.length && (l.helps.zip hp).all (fun x => checkStepLaw f ps (liveHelp l x.1 x.2.1 x.2.2))\n\n-- A run of a machine with maps and flags: from a reachable state, each step a request the machine allows.\nstructure FRun (f : FMMachine) where\n  st : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  req : Nat → Nat → Nat\n  start : FMReach f (st 0).1 (st 0).2\n  allowed : ∀ n, evalC (decideFlags f.flags (withInputs f.m.inputs (st n).1 (req n)) (st n).2) (st n).2 f.m.assume = true\n  next : ∀ n, st (n + 1) = (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs (st n).1 (req n)) (st n).2) (st n).2,\n    writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs (st n).1 (req n)) (st n).2) (st n).2)\n\ntheorem frun_reach {f : FMMachine} (run : FRun f) : ∀ n, FMReach f (run.st n).1 (run.st n).2\n  | 0 => run.start\n  | n + 1 => by rw [run.next n]; exact FMReach.step _ _ _ (frun_reach run n) (run.allowed n)\n\ntheorem live_reads {f : FMMachine} {l : Live} (hok : liveOk f l = true) {c : C} (hc : c ∈ liveConds l)\n    (ρ ι : Nat → Nat) (M : Nat → Nat → Nat) :\n    (∀ i, occC i c = true → i ∉ l.prime.map (·.2) ∧ (i ∈ l.prime.map (·.1) ∨\n        applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M i = withInputs f.m.inputs ρ ι i))\n      ∧ (∀ mp, occMC mp c = true → mp ∉ l.primeMaps.map (·.2) ∧ (mp ∈ l.primeMaps.map (·.1) ∨\n        writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M mp = M mp))\n      ∧ (∀ i, occC i c = true → withInputs f.m.inputs ρ ι i = ρ i) := by\n  simp only [liveOk, Bool.and_eq_true, List.all_eq_true] at hok\n  have hv := hok.1.2 c hc\n  have notIn : ∀ i, occC i c = true → i ∉ l.prime.map (·.1) → i ∉ flagVars f.flags ++ f.m.step.map (·.1) := fun i hi hn hm =>\n    avoids_occ hv.1 hi (List.mem_append_right _ (List.mem_filter.mpr ⟨hm, by simpa [List.contains_iff_mem] using hn⟩))\n  have noIn : ∀ i, occC i c = true → i ∉ f.m.inputs := fun i hi hm => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_right _ hm))\n  refine ⟨fun i hi => ⟨fun h => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_left _ h)), ?_⟩, fun mp hmp => ⟨fun h => avoidsMaps_occ hv.2 hmp (List.mem_append_left _ h), ?_⟩,\n    fun i hi => withInputs_other (noIn i hi) ρ ι⟩\n  · by_cases hp : i ∈ l.prime.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hn := notIn i hi hp\n      rw [applyS_other (fun h => hn (List.mem_append_right _ h)), decide_other (fun h => hn (List.mem_append_left _ h))]\n  · by_cases hp : mp ∈ l.primeMaps.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hw : mp ∉ f.m.writes.map (·.1) := fun hm => 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 [writeMaps]\n      rw [lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro he; exact hw (by rw [← he]; exact List.mem_map_of_mem hw'))]\n\n-- The argument for machines with maps and flags, with what \"enabled\" means left open (`En`).\ntheorem fleads_core (f : FMMachine) (ps : List MEntry) (l : Live) (sinsts : List (Nat × E)) (sproof : List VDef × Tree)\n    (cinsts : List (Nat × E)) (cproof : List VDef × Tree) (hp : List (List (Nat × E) × (List VDef × Tree)))\n    (hl : checkFMMachine f ps = true) (hok : liveOk f l = true)\n    (hs : checkStepLaw f ps (liveStay l sinsts sproof) = true) (hc : checkStepLaw f ps (liveCover l cinsts cproof) = true)\n    (hh : liveHelpsOk f ps l hp = true) (run : FRun f) (En : C × List (Nat × E) → Nat → Prop)\n    (henabled : ∀ h ∈ l.helps, ∀ n, evalC (run.st n).1 (run.st n).2 l.from_ = true → evalC (run.st n).1 (run.st n).2 l.to = false →\n      evalC (run.st n).1 (run.st n).2 h.1 = true → En h n)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → En h m) → ∃ m, n ≤ m ∧ ∀ p ∈ h.2, run.req m 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 [liveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨⟨⟨hd1, hd2⟩, _⟩, hreqs⟩ := hok0\n  simp only [liveHelpsOk, 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 => withInputs f.m.inputs (run.st n).1 (run.req n))\n    (fun n => primed l.prime (run.st (n + 1)).1 (withInputs f.m.inputs (run.st n).1 (run.req n)))\n    (fun n => (run.st n).2) (fun n => primedMaps l.primeMaps (run.st (n + 1)).2 (run.st n).2)\n    (fun h n => ∀ p ∈ h.2, run.req n p.1 = evalE (run.st n).1 (run.st n).2 p.2) En ?_ ?_ ?_ ?_ ?_ ?_ henabled fair\n  · intro n c hc\n    obtain ⟨hv, hm, hx⟩ := live_reads hok hc (run.st n).1 (run.req n) (run.st n).2\n    rw [run.next n]\n    exact view_C hd1 hd2 hv hm hx (fun _ _ => rfl)\n  · intro n e he\n    obtain ⟨hv, hm, hx⟩ := live_reads hok (mem_conds_rank he) (run.st n).1 (run.req n) (run.st n).2\n    rw [run.next n]\n    exact view_E hd1 hd2 hv hm hx (fun _ _ => rfl)\n  · intro n hB\n    have := steplaw_sound f ps _ hl hs _ _ (frun_reach run n) _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := steplaw_sound f ps _ hl hc _ _ (frun_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 := steplaw_sound f ps _ hl (hall _ hpp) _ _ (frun_reach run n) _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hH\n    show evalC (withInputs f.m.inputs (run.st n).1 (run.req n)) (run.st n).2 (reqC h.2) = true\n    rw [reqC_eval]\n    intro p hp'\n    have hq := hreqs h hmem p hp'\n    simp only [withInputs, hq.1, if_true]\n    rw [hH p hp']\n    exact (congrE _ _ _ p.2 (fun i hi => withInputs_other (fun hin => avoids_occ hq.2 (by simp [occC, hi]) hin) _ _)).symm\n\n/-- Liveness under fairness, for machines with maps and flags: if the laws' proof checks, the liveness reads what it may\n(`liveOk`), and the step laws Lean builds from it check, then along every run that takes each helpful request (its\nnamed inputs as its terms) infinitely often, each state where `from` holds is followed (then or later) by one where `to`\nholds. -/\ntheorem leads_sound (f : FMMachine) (ps : List MEntry) (l : Live) (sinsts : List (Nat × E)) (sproof : List VDef × Tree)\n    (cinsts : List (Nat × E)) (cproof : List VDef × Tree) (hp : List (List (Nat × E) × (List VDef × Tree)))\n    (hl : checkFMMachine f ps = true) (hok : liveOk f l = true)\n    (hs : checkStepLaw f ps (liveStay l sinsts sproof) = true) (hc : checkStepLaw f ps (liveCover l cinsts cproof) = true)\n    (hh : liveHelpsOk f ps l hp = true) (run : FRun f)\n    (fair : ∀ h ∈ l.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, run.req m 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 :=\n  fleads_core f ps l sinsts sproof cinsts cproof hp hl hok hs hc hh run (fun _ _ => True) (fun _ _ _ _ _ _ => trivial) (fun h hh n _ => fair h hh n)\n\n/-! Weak fairness -/\n\n-- A helpful request allowed in its region: the precondition, the laws and `when` (the request's named inputs fixed, the\n-- others free) refute the assumption's failing, its flags inlined. A request names each input once; the precondition\n-- and the laws read no input.\ndef fAllowGoal (f : FMMachine) (laws : List MLaw) (insts : List (Nat × E)) (w : C) : List C :=\n  [f.m.pre] ++ scalarHyps laws ++ instHyps laws insts ++ [w, .not (inlineC f.flags f.m.assume)]\ndef checkFAllow (f : FMMachine) (ps : List MEntry) (w : C) (insts : List (Nat × E)) (proof : List VDef × Tree) : Bool :=\n  avoids f.m.inputs f.m.pre && ps.all (fun e => avoids f.m.inputs e.law.holds)\n    && checkGoal ⟨proof.1, fAllowGoal f (ps.map (·.law)) insts w⟩ proof.2\n\ntheorem fallow_sound (f : FMMachine) (ps : List MEntry) (w : C) (insts : List (Nat × E)) (proof : List VDef × Tree)\n    (hl : checkFMMachine f ps = true) (hc : checkFAllow f ps w insts proof = true) :\n    ∀ ρ M, FMReach f ρ M → ∀ ι, evalC (withInputs f.m.inputs ρ ι) M w = true →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true := by\n  intro ρ M hr ι hw\n  have hl0 := hl\n  simp only [checkFAllow, Bool.and_eq_true, List.all_eq_true] at hc\n  obtain ⟨⟨hpi, hli⟩, hgoal⟩ := hc\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at hl\n  obtain ⟨⟨⟨hf, hpref⟩, _⟩, hcm⟩ := hl\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\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 hagI : Agree f.m.inputs (withInputs f.m.inputs ρ ι) ρ := fun i hi => withInputs_other hi ρ ι\n  have hlaws : ∀ l ∈ ps.map (·.law), l.Holds (withInputs f.m.inputs ρ ι) M := fun l hl' => by\n    obtain ⟨e, he, rfl⟩ := List.mem_map.mp hl'\n    exact holds_transfer (MS := []) e.law (hli e he) (by simp [avoidsMaps]) hagI (fun _ _ => rfl) (fmmachine_sound f ps hl0 ρ M hr e he)\n  apply Decidable.byContradiction; intro hn\n  apply sound _ _ hgoal (withInputs f.m.inputs ρ ι) M\n  intro c hc'\n  simp only [fAllowGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc'\n  rcases hc' with ((rfl | hc') | hc') | rfl | rfl\n  · rw [congrC _ ρ M f.m.pre (fun j hj => hagI j (avoids_occ hpi hj))]; exact hpre\n  · exact laws_hyps_true _ insts _ _ hlaws c (List.mem_append_left _ hc')\n  · exact laws_hyps_true _ insts _ _ hlaws c (List.mem_append_right _ hc')\n  · exact hw\n  · simp only [evalC, inline_evalC]; simpa using hn\n\n-- Each helpful request proven allowed in its region (its `when` the helpful step law's), some of its other inputs fixed\n-- by witness terms over the state and params (a history's query, which its relations bound), the rest free.\ndef liveAllowsOk (f : FMMachine) (ps : List MEntry) (l : Live) (ap : List (List (Nat × E) × List (Nat × E) × (List VDef × Tree))) : 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 => f.m.inputs.contains p.1 && avoids f.m.inputs (.eq p.2 p.2))\n      && checkFAllow f ps (.and (liveHelpWhen l x.1) (reqC x.2.1)) x.2.2.1 x.2.2.2)\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/-- Liveness under weak fairness, for machines with maps and flags: as `leads_sound`, with each helpful request also\nproven allowed in its region (`liveAllowsOk`, its other inputs free); then along every run that takes each helpful\nrequest whenever, from some point on, it stays allowed (some request with its named inputs as its terms is a step the\nmachine allows), each state where `from` holds is followed by one where `to` holds. -/\ntheorem leads_wf_sound (f : FMMachine) (ps : List MEntry) (l : Live) (sinsts : List (Nat × E)) (sproof : List VDef × Tree)\n    (cinsts : List (Nat × E)) (cproof : List VDef × Tree) (hp : List (List (Nat × E) × (List VDef × Tree)))\n    (ap : List (List (Nat × E) × List (Nat × E) × (List VDef × Tree)))\n    (hl : checkFMMachine f ps = true) (hok : liveOk f l = true)\n    (hs : checkStepLaw f ps (liveStay l sinsts sproof) = true) (hc : checkStepLaw f ps (liveCover l cinsts cproof) = true)\n    (hh : liveHelpsOk f ps l hp = true) (ha : liveAllowsOk f ps l ap = true) (run : FRun f)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → ∃ ι : Nat → Nat, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (decideFlags f.flags (withInputs f.m.inputs (run.st m).1 ι) (run.st m).2) (run.st m).2 f.m.assume = true) →\n      ∃ m, n ≤ m ∧ ∀ p ∈ h.2, run.req m 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 [liveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨_, hreqs⟩ := hok0\n  simp only [liveAllowsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at ha\n  obtain ⟨halen, haall⟩ := ha\n  refine fleads_core f ps l sinsts sproof cinsts cproof hp hl hok hs hc hh run\n    (fun h m => ∃ ι : Nat → Nat, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (decideFlags f.flags (withInputs f.m.inputs (run.st m).1 ι) (run.st m).2) (run.st m).2 f.m.assume = true) ?_ fair\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  -- The request's state reads `from`, `to`, the region and the request's terms as the state does.\n  have hX : ∀ c ∈ liveConds l, evalC (withInputs f.m.inputs ρ ι) M c = evalC ρ M c := fun c hc' =>\n    congrC _ _ M c (live_reads hok hc' ρ ι M).2.2\n  -- An input fixed by its term over the state and params: the request's value of it, as the state reads the term.\n  have hfix : ∀ p : Nat × E, f.m.inputs.contains p.1 = true → avoids f.m.inputs (.eq p.2 p.2) = true → ι p.1 = evalE ρ M p.2 →\n      withInputs f.m.inputs ρ ι p.1 = evalE (withInputs f.m.inputs ρ ι) M p.2 := fun p hin hav hv => by\n    simp only [withInputs, hin, if_true]\n    rw [hv]\n    exact (congrE _ _ _ p.2 (fun i hi => withInputs_other (fun hm => avoids_occ hav (by simp [occC, hi]) hm) _ _)).symm\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 ⟨ι, hιp, fallow_sound f ps _ x.2.1 x.2.2 hl hpc ρ M (frun_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, reqC_eval, reqC_eval]\n  refine ⟨⟨⟨hP, hnQ⟩, hW, fun p hp' => ?_⟩, fun p hp' => ?_⟩\n  · have hq := hreqs h hmem p hp'\n    exact hfix p hq.1 hq.2 (hιp p hp')\n  · have hq := hwit p hp'\n    exact hfix p hq.1 hq.2 (hιw p hp')\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).\nabbrev SProof := List (Nat × E) × List (Nat × E) × List (Nat × E) × List (Nat × E × List E) × (List VDef × Tree)\ndef sliveStep (l : Live) (w t : C) (p : SProof) : SKStep :=\n  ⟨⟨[w], t, [[]], l.prime, l.primeMaps, p.1, p.2.2.2.2⟩, [[]], p.2.1, p.2.2.1, p.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\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, for machines with sets: as `leads_sound`, with each helpful request naming some inputs and\nleaving the rest, and the maps it carries, free. -/\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 ++ (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    && checkGoal ⟨p.2.2.2.2.1, 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 _ _ 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  · exact laws_hyps_true s.facts p.2.2.1 W M0 hfacts 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\nend Kern\n\n#print axioms Kern.leads_sound\n#print axioms Kern.leads_wf_sound\n#print axioms Kern.sleads_sound\n#print axioms Kern.sleads_wf_sound\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(`ghostOk`), and proves:\n- `ghost_reach`: every reachable state of the original is, outside the ghosts, a reachable state of the ghosted machine,\n  so a law of the ghosted machine that reads no ghost is a law of the original (`ghost_laws`);\n- `ghost_run`: every run of the original is, outside the ghosts, a run of the ghosted machine that takes the same requests;\n- `ever_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`) is\n  1 exactly when some step before took a request where `c` held.\n-/\n\nnamespace Kern\n\nstructure Ghosted where\n  orig : FMMachine\n  ghosts : List (Nat × E × E)   -- (variable, start over the params, step over the state before, the request and flags)\n\ndef Ghosted.vars (g : Ghosted) : List Nat := g.ghosts.map (·.1)\n\n-- The ghosted machine: the original, each ghost's start and step added.\ndef Ghosted.full (g : Ghosted) : FMMachine :=\n  ⟨{ g.orig.m with init := g.orig.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1)), step := g.orig.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2)) }, g.orig.flags⟩\n\n-- The ghosts are new names, and nothing of the original reads them.\ndef ghostOk (g : Ghosted) : Bool :=\n  distinct g.vars\n    && g.vars.all (fun v => !(g.orig.m.inputs ++ g.orig.m.init.map (·.1) ++ g.orig.m.step.map (·.1) ++ flagVars g.orig.flags).contains v)\n    && avoids g.vars g.orig.m.pre && avoids g.vars g.orig.m.assume && g.orig.flags.all (fun p => avoids g.vars p.2)\n    && g.orig.m.step.all (fun p => avoidsE g.vars p.2) && g.orig.m.init.all (fun p => avoidsE g.vars p.2)\n    && g.orig.m.writes.all (fun w => avoidsE g.vars w.2.1 && avoidsE g.vars w.2.2)\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-- 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.\ndef ghostFrom (g : Ghosted) (run : FRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  | 0 => s0\n  | n + 1 => ((applyS g.full.m.step (decideFlags g.full.flags (withInputs g.full.m.inputs (ghostFrom g run s0 n).1 (run.req n)) (ghostFrom g run s0 n).2) (ghostFrom g run s0 n).2),\n      writeMaps g.full.m.writes (decideFlags g.full.flags (withInputs g.full.m.inputs (ghostFrom g run s0 n).1 (run.req n)) (ghostFrom g run s0 n).2) (ghostFrom g run s0 n).2)\n\nsection ghost\nvariable (g : Ghosted) (hg : ghostOk g = true)\ninclude hg\n\ntheorem ghostOk_parts :\n    distinct g.vars = true ∧ (∀ v ∈ g.vars, v ∉ g.orig.m.inputs ++ g.orig.m.init.map (·.1) ++ g.orig.m.step.map (·.1) ++ flagVars g.orig.flags)\n      ∧ avoids g.vars g.orig.m.pre = true ∧ avoids g.vars g.orig.m.assume = true ∧ (∀ p ∈ g.orig.flags, avoids g.vars p.2 = true)\n      ∧ (∀ p ∈ g.orig.m.step, avoidsE g.vars p.2 = true) ∧ (∀ p ∈ g.orig.m.init, avoidsE g.vars p.2 = true)\n      ∧ (∀ w ∈ g.orig.m.writes, avoidsE g.vars w.2.1 = true ∧ avoidsE g.vars w.2.2 = true) := by\n  simp only [ghostOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at hg\n  obtain ⟨⟨⟨⟨⟨⟨⟨hd, hn⟩, hp⟩, ha⟩, hf⟩, hs⟩, hi⟩, hw⟩ := 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⟩\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 ghost_step {ρ ρg : Nat → Nat} (hag : Agree g.vars ρg ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) :\n    (evalC (decideFlags g.full.flags (withInputs g.full.m.inputs ρg ι) M) M g.full.m.assume\n        = evalC (decideFlags g.orig.flags (withInputs g.orig.m.inputs ρ ι) M) M g.orig.m.assume)\n      ∧ Agree g.vars (applyS g.full.m.step (decideFlags g.full.flags (withInputs g.full.m.inputs ρg ι) M) M)\n          (applyS g.orig.m.step (decideFlags g.orig.flags (withInputs g.orig.m.inputs ρ ι) M) M)\n      ∧ writeMaps g.full.m.writes (decideFlags g.full.flags (withInputs g.full.m.inputs ρg ι) M) M\n          = writeMaps g.orig.m.writes (decideFlags g.orig.flags (withInputs g.orig.m.inputs ρ ι) M) M := by\n  obtain ⟨_, hn, _, ha, hf, hs, _, hw⟩ := ghostOk_parts g hg\n  have hin : Agree g.vars (withInputs g.orig.m.inputs ρg ι) (withInputs g.orig.m.inputs ρ ι) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  have hD := decide_agree_on hf M hin\n  refine ⟨?_, fun i hi => ?_, ?_⟩\n  · show evalC (decideFlags g.orig.flags (withInputs g.orig.m.inputs ρg ι) M) M g.orig.m.assume = _\n    exact congrC _ _ M _ (fun i hi => hD i (avoids_occ ha hi))\n  · show applyS (g.orig.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2))) (decideFlags g.orig.flags (withInputs g.orig.m.inputs ρg ι) M) M i = _\n    rw [applyS_append_other (by simpa [Ghosted.vars] using hi)]\n    simp only [applyS]\n    cases hst : assoc g.orig.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ g.orig.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 _ _ M e (fun j hj => hD j (avoidsE_occ (hs (i, e) hm) hj))\n  · show writeMaps g.orig.m.writes (decideFlags g.orig.flags (withInputs g.orig.m.inputs ρg ι) M) M = _\n    funext mp key\n    simp only [writeMaps]\n    cases hl : lookup (fun w => w.1 == mp) g.orig.m.writes with\n    | none => rfl\n    | some w =>\n      obtain ⟨h1, h2⟩ := hw w (lookup_some hl).1\n      simp only [congrE _ _ M w.2.1 (fun j hj => hD j (avoidsE_occ h1 hj)), congrE _ _ M 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 ghost_reach : ∀ {ρ M}, FMReach g.orig ρ M → ∃ ρg, FMReach g.full ρg M ∧ Agree g.vars ρg ρ := by\n  obtain ⟨_, _, hp, _, _, _, hi, _⟩ := ghostOk_parts g hg\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 =>\n    refine ⟨applyS g.full.m.init ρ M, FMReach.start ρ M hM h0, fun i hi => ?_⟩\n    show applyS (g.orig.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ M i = applyS g.orig.m.init ρ M i\n    exact applyS_append_other (by simpa [Ghosted.vars] using hi) ρ M\n  | step ρ M ι _ ha ih =>\n    obtain ⟨ρg, hrg, hag⟩ := ih\n    obtain ⟨hA, hS, hW⟩ := ghost_step g hg hag M ι\n    refine ⟨_, ?_, hS⟩\n    rw [← hW]\n    exact FMReach.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 ghost_laws (ps : List MEntry) (hl : checkFMMachine g.full ps = true) :\n    ∀ ρ M, FMReach g.orig ρ M → ∀ e ∈ ps, avoids g.vars e.law.holds = true → e.law.Holds ρ M := by\n  intro ρ M hr e he hav\n  obtain ⟨ρg, hrg, hag⟩ := ghost_reach g hg hr\n  exact holds_transfer (V := g.vars) (MS := []) e.law hav (by simp [avoidsMaps]) (fun i hi => (hag i hi).symm) (fun _ _ => rfl)\n    (fmmachine_sound g.full ps hl ρg M hrg e he)\ntheorem ghostFrom_agree (run : FRun 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, (ghostFrom g run s0 n).2 = (run.st n).2 ∧ Agree g.vars (ghostFrom g run s0 n).1 (run.st n).1\n  | 0 => ⟨hM0, hA0⟩\n  | n + 1 => by\n    obtain ⟨hM, hag⟩ := ghostFrom_agree run s0 hM0 hA0 n\n    obtain ⟨_, hS, hW⟩ := ghost_step g hg hag (run.st n).2 (run.req n)\n    rw [run.next n]\n    simp only [ghostFrom, hM]\n    exact ⟨hW, hS⟩\n\nomit hg in\ndef ghostRun (hg : ghostOk g = true) (run : FRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) (hr : FMReach g.full s0.1 s0.2) (hM0 : s0.2 = (run.st 0).2)\n    (hA0 : Agree g.vars s0.1 (run.st 0).1) : FRun g.full :=\n  ⟨ghostFrom g run s0, run.req, hr,\n    fun n => by\n      obtain ⟨hM, hag⟩ := ghostFrom_agree g hg run s0 hM0 hA0 n\n      obtain ⟨hA, _, _⟩ := ghost_step g hg hag (run.st n).2 (run.req n)\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 ghost_run (run : FRun g.orig) : ∃ run' : FRun 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  ⟨ghostRun g hg run (Classical.choose (ghost_reach g hg run.start), (run.st 0).2) (Classical.choose_spec (ghost_reach g hg run.start)).1 rfl\n      (Classical.choose_spec (ghost_reach g hg run.start)).2, rfl,\n    ghostFrom_agree g hg run (Classical.choose (ghost_reach g hg run.start), (run.st 0).2) rfl (Classical.choose_spec (ghost_reach g hg run.start)).2⟩\n\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 ghost_run_start (run : FRun g.orig) {ρ0 : Nat → Nat} {M0 : Nat → Nat → Nat} (hM : StartMaps g.orig.m M0) (hp : evalC ρ0 M0 g.orig.m.pre = true)\n    (hst : run.st 0 = (applyS g.orig.m.init ρ0 M0, M0)) :\n    ∃ run' : FRun g.full, run'.req = run.req ∧ run'.st 0 = (applyS g.full.m.init ρ0 M0, M0) ∧ ∀ 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.m.init ρ0 M0) (run.st 0).1 := fun i hi => by\n    rw [hst]\n    show applyS (g.orig.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ0 M0 i = applyS g.orig.m.init ρ0 M0 i\n    exact applyS_append_other (by simpa [Ghosted.vars] using hi) ρ0 M0\n  have hM0 : M0 = (run.st 0).2 := by rw [hst]\n  exact ⟨ghostRun g hg run (applyS g.full.m.init ρ0 M0, M0) (FMReach.start ρ0 M0 hM hp) hM0 hA0, rfl, rfl, ghostFrom_agree g hg run (applyS g.full.m.init ρ0 M0, M0) hM0 hA0⟩\n\n-- The flags a step decides read alike in a run and its lift: the flag conditions read no ghost.\ntheorem ghost_view (run : FRun g.orig) (run' : FRun 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 (decideFlags g.orig.flags (withInputs g.orig.m.inputs (run'.st n).1 (run'.req n)) (run'.st n).2) (run'.st n).2 c\n      = evalC (decideFlags g.orig.flags (withInputs g.orig.m.inputs (run.st n).1 (run.req n)) (run.st n).2) (run.st n).2 c := by\n  obtain ⟨_, _, _, _, hf, _, _, _⟩ := ghostOk_parts g hg\n  obtain ⟨hM, hA⟩ := hag n\n  rw [hM, hreq]\n  have hin : Agree g.vars (withInputs g.orig.m.inputs (run'.st n).1 (run.req n)) (withInputs g.orig.m.inputs (run.st n).1 (run.req n)) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hA i hi\n  exact congrC _ _ _ c (fun i hi => decide_agree_on hf (run.st n).2 hin i (avoids_occ hc hi))\nend ghost\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:\nits request, its flags decided). -/\ntheorem ever_meaning (g : Ghosted) (hg : ghostOk g = true) {x : Nat} {s0 : E} {c : C} (hx : (x, s0, .ite c (.const 1) (.var x)) ∈ g.ghosts)\n    (run : FRun g.full) (h0 : (run.st 0).1 x = 0) :\n    ∀ n, (run.st n).1 x = 1 ↔ ∃ i, i < n ∧ evalC (decideFlags g.orig.flags (withInputs g.orig.m.inputs (run.st i).1 (run.req i)) (run.st i).2) (run.st i).2 c = true := by\n  obtain ⟨hd, hn, _⟩ := ghostOk_parts g hg\n  have hxv : x ∈ g.vars := List.mem_map_of_mem hx\n  have hxo := hn x hxv\n  -- x's step term in the ghosted machine is its ghost step.\n  have hassoc : assoc g.full.m.step x = some (.ite c (.const 1) (.var x)) := by\n    show assoc (g.orig.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 rw [← he]; exact 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\n        rw [List.map_map]; exact hd\n      have hm : (x, E.ite c (.const 1) (.var x)) ∈ g.ghosts.map (fun y => (y.1, y.2.2)) := List.mem_map.mpr ⟨_, hx, rfl⟩\n      exact lookup_unique_fst hd' hm\n    simp [hl]\n  intro n\n  induction n with\n  | zero => simp [h0]\n  | succ n ih =>\n    have hnext := run.next n\n    have hst : (run.st (n + 1)).1 x = if evalC (decideFlags g.orig.flags (withInputs g.orig.m.inputs (run.st n).1 (run.req n)) (run.st n).2) (run.st n).2 c = true\n        then 1 else (run.st n).1 x := by\n      rw [hnext]\n      show applyS g.full.m.step (decideFlags g.orig.flags (withInputs g.orig.m.inputs (run.st n).1 (run.req n)) (run.st n).2) (run.st n).2 x = _\n      simp only [applyS, hassoc, evalE]\n      rw [decide_other (fun h => hxo (List.mem_append_right _ h)), withInputs_other (fun h => hxo (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h))))]\n    rw [hst]\n    constructor\n    · intro h1\n      by_cases hc : evalC (decideFlags g.orig.flags (withInputs g.orig.m.inputs (run.st n).1 (run.req n)) (run.st n).2) (run.st n).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 (decideFlags g.orig.flags (withInputs g.orig.m.inputs (run.st n).1 (run.req n)) (run.st n).2) (run.st n).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.ghost_reach\n#print axioms Kern.ghost_laws\n#print axioms Kern.ghost_run\n#print axioms Kern.ever_meaning\n#print axioms Kern.ghost_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 (`Refined.full`), the spec given\nin the composite's names, and checks that neither reads the other's parts (`refinedOk`). With the relation proven of the\ncomposite (fmmachine_sound) and its step law that the spec allows every request it is sent (steplaw_sound):\n- `refine_lift`: every reachable state of the implementation is, outside the spec's part, a reachable state of the\n  composite;\n- `refine_project`: the spec's part of every reachable state of the composite is a reachable state of the spec;\n- `refines`: so every reachable state of the implementation is related, by the relation, to a reachable state of the\n  spec.\nThe same for machines with sets (`SRefined`, `srefines`): requests carry maps, the spec's among the implementation's.\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\n-- What the composite's step law states: the spec doesn't step, or it allows the request it is sent.\ndef Refined.allowed (r : Refined) : C := inlineC r.full.flags (.or r.stutter (substC r.wit r.spec.m.assume))\n\n-- The implementation's names (inputs, state, flags) and maps; the spec's (state and flags) and maps.\ndef Refined.IV (r : Refined) : List Nat := r.impl.m.inputs ++ r.impl.m.init.map (·.1) ++ r.impl.m.step.map (·.1) ++ flagVars r.impl.flags\ndef Refined.IM (r : Refined) : List Nat := r.impl.m.maps0.map (·.1) ++ r.impl.m.writes.map (·.1)\ndef Refined.SV (r : Refined) : List Nat := r.spec.m.init.map (·.1) ++ r.spec.m.step.map (·.1) ++ flagVars r.spec.flags\ndef Refined.SM (r : Refined) : List Nat := r.spec.m.maps0.map (·.1) ++ r.spec.m.writes.map (·.1)\n-- Where a reachable state of the spec and the composite's agree: everywhere but the implementation's names and the\n-- spec's flags and inputs (which a step sets before reading).\ndef Refined.X (r : Refined) : List Nat := r.IV ++ flagVars r.spec.flags ++ r.spec.m.inputs\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\ndef refinedOk (r : Refined) : Bool :=\n  -- The implementation reads no part of the spec.\n  readsNone r.SV r.SM r.impl.m.pre && readsNone r.SV r.SM r.impl.m.assume\n    && r.impl.flags.all (fun p => readsNone r.SV r.SM p.2) && r.impl.m.step.all (fun p => readsNoneE r.SV r.SM p.2)\n    && r.impl.m.init.all (fun p => readsNoneE r.SV r.SM p.2) && r.impl.m.writes.all (fun w => readsNoneE r.SV r.SM w.2.1 && readsNoneE r.SV r.SM w.2.2)\n  -- The spec reads no part of the implementation, and its flags read no flag.\n    && readsNone r.IV r.IM r.spec.m.assume && r.spec.flags.all (fun p => readsNone (r.IV ++ flagVars r.spec.flags) r.IM p.2)\n    && r.spec.m.step.all (fun p => readsNoneE r.IV r.IM p.2) && r.spec.m.init.all (fun p => readsNoneE (r.IV ++ r.spec.m.inputs) r.IM p.2)\n    && r.spec.m.writes.all (fun w => readsNoneE r.IV r.IM w.2.1 && readsNoneE r.IV r.IM w.2.2)\n  -- The spec's precondition reads the params alone.\n    && readsNone (r.X ++ r.SV) r.IM r.spec.m.pre && !readsC r.spec.m.pre\n  -- Names apart: the spec's from the implementation's, its inputs from both; maps apart.\n    && r.SV.all (fun v => !r.IV.contains v) && r.spec.m.inputs.all (fun v => !(r.IV ++ r.SV).contains v)\n    && r.SM.all (fun mp => !r.IM.contains mp)\n  -- The witness names the spec's inputs, and it and `stutter` read no flag and no spec input.\n    && r.wit.all (fun p => r.spec.m.inputs.contains p.1 && avoidsE (flagVars r.impl.flags ++ flagVars r.spec.flags ++ r.spec.m.inputs) p.2)\n    && avoids (flagVars r.impl.flags ++ flagVars r.spec.flags ++ r.spec.m.inputs) r.stutter\n\n-- Each of the spec's maps starts at one constant.\ndef refinedMapsOk (r : Refined) : Bool := distinct (r.spec.m.maps0.map (·.1))\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/-! The implementation's runs, inside the composite's -/\n\nsection lift\nvariable (r : Refined) (hok : refinedOk r = true) (hmo : refinedMapsOk r = true)\ninclude hok\n\ntheorem refined_parts :\n    readsNone r.SV r.SM r.impl.m.pre = true ∧ readsNone r.SV r.SM r.impl.m.assume = true\n      ∧ (∀ p ∈ r.impl.flags, readsNone r.SV r.SM p.2 = true) ∧ (∀ p ∈ r.impl.m.step, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ p ∈ r.impl.m.init, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ w ∈ r.impl.m.writes, readsNoneE r.SV r.SM w.2.1 = true ∧ readsNoneE r.SV r.SM w.2.2 = true)\n      ∧ readsNone r.IV r.IM r.spec.m.assume = true ∧ (∀ p ∈ r.spec.flags, readsNone (r.IV ++ flagVars r.spec.flags) r.IM p.2 = true)\n      ∧ (∀ p ∈ r.spec.m.step, readsNoneE r.IV r.IM p.2 = true) ∧ (∀ p ∈ r.spec.m.init, readsNoneE (r.IV ++ r.spec.m.inputs) r.IM p.2 = true)\n      ∧ (∀ w ∈ r.spec.m.writes, readsNoneE r.IV r.IM w.2.1 = true ∧ readsNoneE r.IV r.IM w.2.2 = true)\n      ∧ readsNone (r.X ++ r.SV) r.IM r.spec.m.pre = true ∧ readsC r.spec.m.pre = false\n      ∧ (∀ v ∈ r.SV, v ∉ r.IV) ∧ (∀ v ∈ r.spec.m.inputs, v ∉ r.IV ++ r.SV) ∧ (∀ mp ∈ r.SM, mp ∉ r.IM)\n      ∧ (∀ p ∈ r.wit, p.1 ∈ r.spec.m.inputs ∧ avoidsE (flagVars r.impl.flags ++ flagVars r.spec.flags ++ r.spec.m.inputs) p.2 = true)\n      ∧ avoids (flagVars r.impl.flags ++ flagVars r.spec.flags ++ r.spec.m.inputs) r.stutter = true := by\n  simp only [refinedOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at hok\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩, h9⟩, h10⟩, h11⟩, h12⟩, h13⟩, h14⟩, h15⟩, h16⟩, h17⟩, h18⟩ := hok\n  refine ⟨h1, h2, h3, h4, h5, fun w hw => (h6 w hw), h7, h8, h9, h10, fun w hw => h11 w hw, h12, h13, fun v hv h => ?_, fun v hv h => ?_,\n    fun mp hm h => ?_, fun p hp => ⟨List.contains_iff_mem.mp (h17 p hp).1, (h17 p hp).2⟩, h18⟩\n  · have := h14 v hv; rw [List.contains_iff_mem.mpr h] at this; cases this\n  · have := h15 v hv; rw [List.contains_iff_mem.mpr h] at this; cases this\n  · have := h16 mp hm; rw [List.contains_iff_mem.mpr h] at this; cases this\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 refine_step {ρ ρc : Nat → Nat} {M Mc : Nat → Nat → Nat} (hag : Agree r.SV ρc ρ) (hmag : ∀ mp, mp ∉ r.SM → Mc mp = M mp) (ι : Nat → Nat) :\n    (evalC (decideFlags r.full.flags (withInputs r.full.m.inputs ρc ι) Mc) Mc r.full.m.assume\n        = evalC (decideFlags r.impl.flags (withInputs r.impl.m.inputs ρ ι) M) M r.impl.m.assume)\n      ∧ Agree r.SV (applyS r.full.m.step (decideFlags r.full.flags (withInputs r.full.m.inputs ρc ι) Mc) Mc)\n          (applyS r.impl.m.step (decideFlags r.impl.flags (withInputs r.impl.m.inputs ρ ι) M) M)\n      ∧ ∀ mp, mp ∉ r.SM → writeMaps r.full.m.writes (decideFlags r.full.flags (withInputs r.full.m.inputs ρc ι) Mc) Mc mp\n          = writeMaps r.impl.m.writes (decideFlags r.impl.flags (withInputs r.impl.m.inputs ρ ι) M) M mp := by\n  obtain ⟨_, ha, hf, hs, _, hw, _⟩ := refined_parts r hok\n  have hin : Agree r.SV (withInputs r.impl.m.inputs ρc ι) (withInputs r.impl.m.inputs ρ ι) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  -- The composite's flags decide the implementation's alike, outside the spec's flag names.\n  have hD : Agree r.SV (decideFlags r.full.flags (withInputs r.full.m.inputs ρc ι) Mc) (decideFlags r.impl.flags (withInputs r.impl.m.inputs ρ ι) M) := by\n    intro i hi\n    have hif : i ∉ flagVars (r.spec.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 [Refined.SV, List.mem_append]; right\n      simpa [flagVars, Function.comp_def] using h')\n    show decideFlags (r.impl.flags ++ _) (withInputs r.impl.m.inputs ρc ι) Mc i = _\n    rw [decideFlags_of, decideFlags_of, flagOf_append_left hif]\n    cases hfo : flagOf r.impl.flags i with\n    | none => exact hin i hi\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hfo\n      simp only\n      rw [congrMC _ Mc M _ (fun mp hmp => hmag mp (avoidsMaps_occ (rn_m (hf p hp)) hmp)),\n        congrC _ _ M _ (fun j hj => hin j (avoids_occ (rn_v (hf p hp)) hj))]\n  refine ⟨?_, fun i hi => ?_, fun mp hmp => ?_⟩\n  · show evalC _ Mc r.impl.m.assume = _\n    rw [congrMC _ Mc M _ (fun mp hmp => hmag mp (avoidsMaps_occ (rn_m ha) hmp)), congrC _ _ M _ (fun j hj => hD j (avoids_occ (rn_v ha) hj))]\n  · show applyS (r.impl.m.step ++ _) _ Mc i = _\n    have hit : i ∉ (r.spec.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 [Refined.SV, List.mem_append]; left; right; simpa [Function.comp_def] using h')\n    rw [applyS_append_other hit]\n    simp only [applyS]\n    cases hst : assoc r.impl.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ r.impl.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 _ Mc M e (fun mp hmp => hmag mp (avoidsMapsE_occ (rnE_m (hs (i, e) hm)) hmp)),\n        congrE _ _ M e (fun j hj => hD j (avoidsE_occ (rnE_v (hs (i, e) hm)) hj))]\n  · funext key\n    show writeMaps (r.impl.m.writes ++ _) _ Mc mp key = _\n    have hwm : lookup (fun w : Nat × E × E => w.1 == mp) (r.spec.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 [Refined.SM, List.mem_append]; right; rw [← he]; exact List.mem_map.mpr ⟨w0, hw0, rfl⟩))\n    simp only [writeMaps, lookup_append]\n    cases hl : lookup (fun w => w.1 == mp) r.impl.m.writes with\n    | none => simp only [hwm]; exact congrFun (hmag mp hmp) key\n    | some w =>\n      obtain ⟨h1, h2⟩ := hw w (lookup_some hl).1\n      simp only\n      rw [congrME _ Mc M w.2.1 (fun mp' h => hmag mp' (avoidsMapsE_occ (rnE_m h1) h)), congrE _ _ M w.2.1 (fun j hj => hD j (avoidsE_occ (rnE_v h1) hj)),\n        congrME _ Mc M w.2.2 (fun mp' h => hmag mp' (avoidsMapsE_occ (rnE_m h2) h)), congrE _ _ M w.2.2 (fun j hj => hD j (avoidsE_occ (rnE_v h2) hj)), hmag mp hmp]\n\ninclude hmo in\n/-- Every reachable state of the implementation is, outside the spec's part, a reachable state of the composite. -/\ntheorem refine_lift : ∀ {ρ M}, FMReach r.impl ρ M → ∃ ρc Mc, FMReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ ∀ mp, mp ∉ r.SM → Mc mp = M mp := by\n  obtain ⟨hp, _, _, _, hi, _⟩ := refined_parts r hok\n  have hsm := (refined_parts r hok).2.2.2.2.2.2.2.2.2.2.2.2.2.2.2.1\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 =>\n    -- The spec's maps start at their constants; every other map as the implementation's.\n    let Mc : Nat → Nat → Nat := fun mp => match lookup (fun p => p.1 == mp) r.spec.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 [Refined.SM, List.mem_append]; left; rw [← he]; exact List.mem_map_of_mem hp'))]\n    have hpre : evalC ρ Mc r.full.m.pre = true := by\n      show evalC ρ Mc r.impl.m.pre = true\n      rw [congrMC _ Mc M _ (fun mp hmp => hMc mp (avoidsMaps_occ (rn_m hp) hmp))]; exact h0\n    have hstart : StartMaps r.full.m Mc := by\n      intro p hp' key\n      rcases List.mem_append.mp hp' with hp' | hp'\n      · -- An implementation's map: none of the spec's, so as the implementation's start has it.\n        have hn : p.1 ∉ r.SM := fun h' => hsm p.1 h' (by simp only [Refined.IM, List.mem_append]; left; exact List.mem_map_of_mem hp')\n        rw [hMc p.1 hn]; exact hM p hp' key\n      · -- A spec's map: its one constant.\n        have hl : lookup (fun q => q.1 == p.1) r.spec.m.maps0 = some p := lookup_unique1 (by simpa [refinedMapsOk] using hmo) hp'\n        simp only [Mc, hl]\n    refine ⟨_, Mc, FMReach.start ρ Mc hstart hpre, fun i hi' => ?_, hMc⟩\n    show applyS (r.impl.m.init ++ r.spec.m.init) ρ Mc i = applyS r.impl.m.init ρ M i\n    rw [applyS_append_other (by\n      intro h'; apply hi'; simp only [Refined.SV, List.mem_append]; left; left; exact h')]\n    simp only [applyS]\n    cases hst : assoc r.impl.m.init i with\n    | none => rfl\n    | some e =>\n      have hm : (i, e) ∈ r.impl.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⟩ := refine_step r hok hag hmag ι\n    exact ⟨_, _, FMReach.step ρc Mc ι hrc (by rw [hA]; exact ha), hS, hW⟩\nend lift\n\n/-! The spec's part of the composite's runs -/\n\nsection project\nvariable (r : Refined) (hok : refinedOk r = true)\ninclude hok\n\n-- The spec's view of a step (its flags decided over its state, its inputs as the witness reads them) agrees with the\n-- composite's view with the witness put in, outside the implementation's names.\ntheorem spec_view {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → Ms mp = M mp) (ι : Nat → Nat) :\n    Agree r.IV (decideFlags r.spec.flags (withInputs r.spec.m.inputs σ (applyS r.wit (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M)) Ms)\n      (applyS r.wit (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M) := by\n  obtain ⟨_, _, _, _, _, _, _, hsf, _, _, _, _, _, hsv, hsi, _, hwit, _⟩ := refined_parts r hok\n  have hwdom : ∀ i, i ∉ r.spec.m.inputs → i ∉ r.wit.map (·.1) := fun i hi h' => by\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h'; exact hi (hwit p hp).1\n  have hflagF : ∀ i, i ∉ flagVars r.impl.flags → i ∉ flagVars r.spec.flags → i ∉ flagVars r.full.flags := fun i h1 h2 h' => by\n    simp only [Refined.full, 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 witness reads alike in the composite's view and before its flags are decided.\n  have hXW : ∀ j, j ∉ flagVars r.full.flags → applyS r.wit (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M j\n      = applyS r.wit (withInputs r.full.m.inputs ρ ι) M j := fun j hj => by\n    simp only [applyS]\n    cases ha : assoc r.wit j with\n    | none => exact decide_other hj _ M\n    | some e =>\n      have hm : (j, e) ∈ r.wit := by\n        simp only [assoc, Option.map_eq_some_iff] at ha\n        obtain ⟨q, hq, rfl⟩ := ha\n        obtain ⟨hqm, hqv⟩ := lookup_some hq\n        simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n      exact congrE _ _ M e (fun k hk => decide_other (fun h' => by\n        have := avoidsE_occ (hwit (j, e) hm).2 hk\n        simp only [Refined.full, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n        rcases h' with h' | h'\n        · exact this (List.mem_append_left _ (List.mem_append_left _ h'))\n        · exact this (List.mem_append_left _ (List.mem_append_right _ (by simpa [flagVars, Function.comp_def] using h')))) _ M)\n  have hIVf : ∀ i, i ∉ r.IV → i ∉ flagVars r.impl.flags := fun i hi h' => hi (List.mem_append_right _ h')\n  have hIVi : ∀ i, i ∉ r.IV → i ∉ r.impl.m.inputs := fun i hi h' => hi (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h')))\n  intro v hv\n  by_cases hvf : v ∈ flagVars r.spec.flags\n  · -- A spec flag: decided over the spec's view; in the composite, its condition with the witness put in.\n    have hvi : v ∉ r.spec.m.inputs := fun h' => hsi v h' (List.mem_append_right _ (List.mem_append_right _ hvf))\n    cases hfo : flagOf r.spec.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.flags v = some (substC r.wit p.2) := by\n        show flagOf (r.impl.flags ++ _) v = _\n        rw [flagOf_append_right (hIVf v hv), flagOf_map, hfo]; rfl\n      rw [decideFlags_of, hfo]\n      simp only [applyS]\n      rw [assoc_none_of (hwdom v hvi)]\n      simp only\n      rw [decideFlags_of, hfull]\n      simp only\n      rw [subst_evalC, congrMC _ Ms M _ (fun mp hmp => hmag mp (avoidsMaps_occ (rn_m (hsf p hp)) hmp))]\n      rw [congrC _ (applyS r.wit (withInputs r.full.m.inputs ρ ι) M) M p.2 (fun j hj => by\n        have hj1 : j ∉ r.IV := fun h' => avoids_occ (rn_v (hsf p hp)) hj (List.mem_append_left _ h')\n        have hj2 : j ∉ flagVars r.spec.flags := fun h' => avoids_occ (rn_v (hsf p hp)) hj (List.mem_append_right _ h')\n        by_cases hji : j ∈ r.spec.m.inputs\n        · simp only [withInputs, List.contains_iff_mem.mpr hji, if_true]\n          exact hXW j (hflagF j (hIVf j hj1) hj2)\n        · rw [withInputs_other hji, hag j (fun h' => by\n            simp only [Refined.X, List.mem_append] at h'; rcases h' with (h' | h') | h'\n            · exact hj1 h'\n            · exact hj2 h'\n            · exact hji h')]\n          simp only [applyS]; rw [assoc_none_of (hwdom j hji)]\n          exact (withInputs_other (hIVi j hj1) ρ ι).symm)]\n  · by_cases hvi : v ∈ r.spec.m.inputs\n    · rw [decide_other hvf]\n      simp only [withInputs, List.contains_iff_mem.mpr hvi, if_true]\n    · rw [decide_other hvf, withInputs_other hvi, hag v (fun h' => by\n        simp only [Refined.X, List.mem_append] at h'; rcases h' with (h' | h') | h'\n        · exact hv h'\n        · exact hvf h'\n        · exact hvi h')]\n      rw [hXW v (hflagF v (hIVf v hv) hvf)]\n      simp only [applyS]\n      rw [assoc_none_of (hwdom v hvi)]\n      exact (withInputs_other (hIVi v hv) ρ ι).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.\ntheorem spec_term {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → Ms mp = M mp) (ι : Nat → Nat)\n    {e : E} (he : readsNoneE r.IV r.IM e = true) :\n    evalE (decideFlags r.spec.flags (withInputs r.spec.m.inputs σ (applyS r.wit (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M)) Ms) Ms e\n      = evalE (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M (substE r.wit e) := by\n  rw [subst_evalE, congrME _ Ms M e (fun mp hmp => hmag mp (avoidsMapsE_occ (rnE_m he) hmp))]\n  exact congrE _ _ M e (fun j hj => spec_view r hok hag hmag ι j (avoidsE_occ (rnE_v he) hj))\n\ntheorem spec_cond {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → Ms mp = M mp) (ι : Nat → Nat)\n    {c : C} (hc : readsNone r.IV r.IM c = true) :\n    evalC (decideFlags r.spec.flags (withInputs r.spec.m.inputs σ (applyS r.wit (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M)) Ms) Ms c\n      = evalC (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M (substC r.wit c) := by\n  rw [subst_evalC, congrMC _ Ms M c (fun mp hmp => hmag mp (avoidsMaps_occ (rn_m hc) hmp))]\n  exact congrC _ _ M c (fun j hj => spec_view r hok hag hmag ι j (avoids_occ (rn_v hc) hj))\n\n-- A variable none of the composite's or the spec's flags or inputs, and the composite's view reads it as the state does.\ntheorem view_plain {ρ : Nat → Nat} {M : Nat → Nat → Nat} (ι : Nat → Nat) {v : Nat} (hv : v ∉ r.X) :\n    decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M v = ρ v := by\n  simp only [Refined.X, Refined.IV, List.mem_append, not_or] at hv\n  obtain ⟨⟨⟨⟨⟨hi, _⟩, _⟩, hf⟩, hsf⟩, _⟩ := hv\n  rw [decide_other (fun h' => by\n    simp only [Refined.full, 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  exact withInputs_other hi ρ ι\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 the spec allows every request\nthe composite sends it (its step law). -/\ntheorem refine_project (hpre : ∀ ρ M, FMReach r.full ρ M → evalC ρ M r.spec.m.pre = true)\n    (hallow : ∀ ρ M, FMReach r.full ρ M → ∀ ι, evalC (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M r.full.m.assume = true →\n      evalC (withInputs r.full.m.inputs ρ ι) M r.allowed = true) :\n    ∀ {ρ M}, FMReach r.full ρ M → ∃ σ Ms, FMReach r.spec σ Ms ∧ Agree r.X σ ρ ∧ ∀ mp, mp ∉ r.IM → Ms mp = M mp := by\n  obtain ⟨_, _, _, _, _, _, hsa, _, hss, hsi, hsw, hsp, hrp, hsv, _, hsm, _, hst⟩ := refined_parts r hok\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 =>\n    -- The spec starts where the composite's state was before its start values: its precondition reads the params.\n    have hp0 : evalC ρ M r.spec.m.pre = true := by\n      have h := hpre _ M (FMReach.start ρ M hM h0)\n      have hag0 : ∀ i, occC i r.spec.m.pre = true → applyS r.full.m.init ρ M i = ρ i := fun i hi => applyS_other (fun h' => by\n        apply avoids_occ (rn_v hsp) hi\n        simp only [Refined.full, List.map_append, List.mem_append] at h'\n        rcases h' with h' | h' <;> simp [Refined.X, Refined.IV, Refined.SV, h']) ρ M\n      rwa [congrC _ ρ M r.spec.m.pre hag0] at h\n    have hMs : StartMaps r.spec.m M := fun p hp' key => hM p (List.mem_append_right _ hp') key\n    refine ⟨_, M, FMReach.start ρ M hMs hp0, fun i hi => ?_, fun _ _ => rfl⟩\n    show applyS r.spec.m.init ρ M i = applyS (r.impl.m.init ++ r.spec.m.init) ρ M i\n    rw [applyS_append_right (fun h' => hi (by simp [Refined.X, Refined.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 [Refined.allowed] at hA\n    rw [inline_evalC] at hA\n    simp only [evalC, Bool.or_eq_true] at hA\n    -- The composite's step at a variable or map of the spec's part: kept where it stutters, the spec's term otherwise.\n    have hstepS : ∀ v, v ∉ r.IV → applyS r.full.m.step (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M v\n        = applyS (r.spec.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))) (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M v :=\n      fun v hv => applyS_append_right (fun h' => hv (List.mem_append_left _ (List.mem_append_right _ h'))) _ M\n    by_cases hstut : evalC (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) 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 => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ h')))]\n        simp only [applyS]\n        cases hl : assoc (r.spec.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 [view_plain r hok ι hv]; exact hag v hv\n        | some e =>\n          obtain ⟨q, hq, hqv, rfl⟩ : ∃ q ∈ r.spec.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, view_plain r hok ι hv]; exact hag v hv\n      · funext key\n        show Ms mp key = writeMaps (r.impl.m.writes ++ _) _ M mp key\n        rw [hmag mp hmp]\n        simp only [writeMaps, lookup_append]\n        rw [lookup_none (l := r.impl.m.writes) (fun w hw => by simp only [beq_eq_false_iff_ne]; intro he; exact hmp (by\n          simp only [Refined.IM, List.mem_append]; right; rw [← he]; exact List.mem_map_of_mem hw))]\n        (try dsimp only); rw [lookup_writes_map]\n        cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.m.writes with\n        | none => rfl\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 (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M (substE r.wit w0.2.1)\n          · rw [if_pos hk, ← hk]\n          · rw [if_neg hk]\n    · -- The spec steps, sent the witness's request, which it allows.\n      have hX := hA.resolve_left hstut\n      rw [← spec_cond r hok hag hmag ι (c := r.spec.m.assume) hsa] at hX\n      refine ⟨_, _, FMReach.step σ Ms _ hrs hX, fun v hv => ?_, fun mp hmp => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ h')))]\n        simp only [applyS]\n        rw [assoc_map_fst]\n        cases hl : lookup (fun q => q.1 == v) r.spec.m.step with\n        | none =>\n          have hn : assoc r.spec.m.step v = none := by simp only [assoc, hl, Option.map_none]\n          rw [hn]; dsimp only\n          rw [view_plain r hok ι hv]\n          have hvf : v ∉ flagVars r.spec.flags := fun h' => hv (List.mem_append_left _ (List.mem_append_right _ h'))\n          have hvi : v ∉ r.spec.m.inputs := fun h' => hv (List.mem_append_right _ h')\n          rw [decide_other hvf, withInputs_other hvi]; 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.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, hstut, Bool.false_eq_true, if_false]\n          have hm : (v, q.2) ∈ r.spec.m.step := by rw [← hq.2]; exact hq.1\n          exact spec_term r hok hag hmag ι (hss (v, q.2) hm)\n      · funext key\n        show writeMaps r.spec.m.writes _ Ms mp key = writeMaps (r.impl.m.writes ++ _) _ M mp key\n        simp only [writeMaps, lookup_append]\n        rw [lookup_none (l := r.impl.m.writes) (fun w hw => by simp only [beq_eq_false_iff_ne]; intro he; exact hmp (by\n          simp only [Refined.IM, List.mem_append]; right; rw [← he]; exact List.mem_map_of_mem hw))]\n        simp only\n        rw [lookup_writes_map]\n        cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.m.writes with\n        | none => simp only [Option.map_none]; exact congrFun (hmag mp hmp) key\n        | some w0 =>\n          have hw0m := lookup_some hw0\n          obtain ⟨h1, h2⟩ := hsw w0 hw0m.1\n          simp only [Option.map_some, evalE, hstut, Bool.false_eq_true, if_false]\n          rw [spec_term r hok hag hmag ι h1, spec_term r hok hag hmag ι h2, hmag mp hmp]\nend project\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/-- What a refinement means: with the relation (and the spec's precondition, the j-th law) proven of the composite, and\nits step law that the spec allows every request it is sent, every reachable state of the implementation is, outside\nthe spec's part, a reachable state of the composite, whose spec part is a reachable state of the spec, the two related\nby every law. -/\ntheorem refines (r : Refined) (hok : refinedOk r = true) (hmo : refinedMapsOk r = true) (ps : List MEntry) (hl : checkFMMachine r.full ps = true)\n    (j : Nat) (hj : (ps[j]?).map (·.law.holds) = some r.spec.m.pre ∧ (ps[j]?).map (·.law.key) = some none)\n    (prime primeMaps : List (Nat × Nat)) (insts : List (Nat × E)) (proof : List VDef × Tree)\n    (hs : checkStepLaw r.full ps ⟨trueC, r.allowed, prime, primeMaps, insts, proof⟩ = true)\n    (hfresh : avoids (prime.map (·.2)) r.allowed = true ∧ avoidsMaps (primeMaps.map (·.2)) r.allowed = true) :\n    ∀ ρ M, FMReach r.impl ρ M → ∃ ρc Mc σ Ms, FMReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ (∀ mp, mp ∉ r.SM → Mc mp = M mp)\n      ∧ FMReach r.spec σ Ms ∧ Agree r.X σ ρc ∧ (∀ mp, mp ∉ r.IM → Ms mp = Mc mp) ∧ ∀ e ∈ ps, e.law.Holds ρc Mc := by\n  have hlaws := fmmachine_sound r.full ps hl\n  have hpre : ∀ ρ M, FMReach r.full ρ M → evalC ρ M r.spec.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 := 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 hsl := steplaw_sound r.full ps _ hl hs\n  have hallow : ∀ ρ M, FMReach r.full ρ M → ∀ ι, evalC (decideFlags r.full.flags (withInputs r.full.m.inputs ρ ι) M) M r.full.m.assume = true →\n      evalC (withInputs r.full.m.inputs ρ ι) M r.allowed = true := by\n    intro ρ M hr ι ha\n    have h := hsl ρ M hr ι ha (by simp [trueC, evalC, evalE])\n    rwa [unprimed_evalC hfresh.1 hfresh.2] at h\n  intro ρ M hr\n  obtain ⟨ρc, Mc, hrc, hag, hmag⟩ := refine_lift r hok hmo hr\n  obtain ⟨σ, Ms, hrs, hags, hmags⟩ := refine_project r hok hpre hallow hrc\n  exact ⟨ρc, Mc, σ, Ms, hrc, hag, hmag, hrs, hags, hmags, hlaws ρc Mc hrc⟩\n\n/-! Refinements over machines with sets -/\n\n/-!\nThe same for machines with sets: requests carry maps (the spec's among the implementation's, shared by name), maps are\nwritten at every key, flags hold at every key. The composite (`SRefined.full`) is built as for maps and flags, the\nspec's every-key writes and quantified flags read with the witness put in and its every-key writes kept where it\nstutters; Lean builds it from the two sides and checks neither reads the other's parts (`srOk`). Then `srefine_lift`,\n`srefine_project` and `srefines` as above, over `SReach`.\n-/\n\nopen Classical\n\nstructure SRefined where\n  impl : SMachine\n  spec : SMachine\n  wit : List (Nat × E)\n  stutter : C\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.map (·.2.1)\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\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-- A flag that holds at every key, decided over states that agree where its body reads (its key aside), is decided alike.\ntheorem ite_all_congr {X X' : Nat → Nat} {N N' : Nat → Nat → Nat} {k : Nat} {c : C}\n    (hv : ∀ i, occC i c = true → i ≠ k → X i = X' i) (hm : ∀ mp, occMC mp c = true → N mp = N' mp) :\n    (if ∀ key, holdsC (upd X k key) N c then 1 else 0) = (if ∀ key, holdsC (upd X' k key) N' c then 1 else 0) := by\n  have h : (∀ key, holdsC (upd X k key) N c) ↔ (∀ key, holdsC (upd X' k key) N' c) := by\n    apply forall_congr'; intro key\n    rw [← evalC_iff, ← evalC_iff, congrMC _ N N' c hm]\n    rw [congrC (upd X k key) (upd X' k key) N' c (fun i hi => by\n      simp only [upd]; split\n      · rfl\n      · rename_i 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 ∀ key, holdsC (upd X q.2.1 key) 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/-! 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\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 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 × Nat × C)) (g : Nat × Nat × C → C) (v : Nat) :\n    lookup (fun q : Nat × Nat × C => q.1 == v) (l.map (fun q => (q.1, q.2.1, g q))) = (lookup (fun q : Nat × 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\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 : q.2.1 ∈ bkeys r.spec := by simp only [bkeys, List.mem_append]; right; exact List.mem_map_of_mem hqm\n      simp only [Option.map_some]\n      have hc : (∀ key, holdsC (upd (withInputs r.full.f.m.inputs ρ ι) q.2.1 key) (withCarried r.full M κ) (substC r.wit q.2.2))\n          ↔ (∀ key, holdsC (applyS r.wit (upd (withInputs r.full.f.m.inputs ρ ι) q.2.1 key) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) := by\n        apply forall_congr'; intro key; rw [← evalC_iff, ← evalC_iff, subst_evalC]\n      rw [show (if ∀ key, holdsC (upd (withInputs r.full.f.m.inputs ρ ι) q.2.1 key) (withCarried r.full M κ) (substC r.wit q.2.2) then 1 else 0)\n          = (if ∀ key, holdsC (applyS r.wit (upd (withInputs r.full.f.m.inputs ρ ι) q.2.1 key) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 then 1 else 0) by\n        simp only [hc]]\n      have hkdom : q.2.1 ∉ r.wit.map (·.1) := sr_wdom r hok (hSI _ (by simp only [SRefined.SV, List.mem_append]; right; exact hk))\n      -- Both sides as one condition over every key: compare the states they read the body at.\n      have hall : ∀ key, evalC (upd (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 key) (withCarried r.spec Ms κ) q.2.2\n          = evalC (applyS r.wit (upd (withInputs r.full.f.m.inputs ρ ι) q.2.1 key) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 := by\n        intro key\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        · subst hik; simp only [upd, if_true]; rw [applyS_other hkdom]; simp [upd]\n        · simp only [upd, hik, if_false]\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 => simp only [upd, hik, if_false]; 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_upd 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)]\n            simp only [upd, hik, if_false]\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 (∀ key, holdsC (upd (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 key) (withCarried r.spec Ms κ) q.2.2)\n          ↔ (∀ key, holdsC (applyS r.wit (upd (withInputs r.full.f.m.inputs ρ ι) q.2.1 key) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) from\n        forall_congr' (fun key => by rw [← evalC_iff, ← evalC_iff, hall key])]\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))\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 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⟩, [[]], p.2.1, p.2.2.1, p.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.refine_lift\n#print axioms Kern.refine_project\n#print axioms Kern.refines\n#print axioms Kern.srefine_lift\n#print axioms Kern.srefine_project\n#print axioms Kern.srefines\n",
+};