gdp-wired 0.12.1 → 0.12.2

package/dist/lean-kernel/library.js

@@ -1,12 +1,12 @@
 // 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\nA row holds its nonzero coefficients alone (column, coefficient), in column order, so a step costs a row's nonzeros\nrather than the table's width. Any list reads as a sum (`dot`); sorted lists stay sorted and cancel to [] under `addL`.\n\n`run_preserves` is the induction rule a step machine's laws rest on: a property true at the start and preserved by\nevery step holds after every sequence of steps.\n-/\n\nnamespace Cert\n\nstructure Row where\n  coefs : List (Nat × Int)\n  const : Int\nderiving Repr\n\ndef dot : List (Nat × Int) → List Int → Int\n  | [], _ => 0\n  | p :: rest, x => p.2 * x.getD p.1 0 + dot rest x\n\ndef eval (r : Row) (x : List Int) : Int := dot r.coefs x + r.const\n\n-- Two sorted lists merged, coefficients of one column added (a column that cancels dropped). The fuel only bounds the\n-- recursion: out of it, the lists are put side by side, which reads the same.\ndef addF : Nat → List (Nat × Int) → List (Nat × Int) → List (Nat × Int)\n  | 0, a, b => a ++ b\n  | _ + 1, [], b => b\n  | _ + 1, a, [] => a\n  | n + 1, p :: as, q :: bs =>\n    if p.1 < q.1 then p :: addF n as (q :: bs)\n    else if q.1 < p.1 then q :: addF n (p :: as) bs\n    else if p.2 + q.2 = 0 then addF n as bs else (p.1, p.2 + q.2) :: addF n as bs\n\ndef addL (a b : List (Nat × Int)) : List (Nat × Int) := addF (a.length + b.length) a b\n\ndef scaleL (m : Int) (a : List (Nat × Int)) : List (Nat × Int) := if m = 0 then [] else a.map (fun p => (p.1, m * p.2))\n\ndef allZero : List (Nat × Int) → Bool\n  | [] => true\n  | p :: a => p.2 == 0 && allZero a\n\ntheorem dot_app (x : List Int) : ∀ (a b : List (Nat × Int)), dot (a ++ b) x = dot a x + dot b x\n  | [], b => by simp [dot]\n  | p :: a, b => by simp only [List.cons_append, dot, dot_app x a b]; omega\n\ntheorem dot_addF (x : List Int) : ∀ (n : Nat) (a b : List (Nat × Int)), dot (addF n a b) x = dot a x + dot b x\n  | 0, a, b => by simp only [addF, dot_app]\n  | _ + 1, [], b => by simp [addF, dot]\n  | _ + 1, _ :: _, [] => by simp [addF, dot]\n  | n + 1, p :: as, q :: bs => by\n    simp only [addF]\n    split\n    · simp only [dot, dot_addF x n as (q :: bs)]; omega\n    · split\n      · simp only [dot, dot_addF x n (p :: as) bs]; omega\n      · have hpq : p.1 = q.1 := by omega\n        split\n        · rename_i hz\n          simp only [dot, dot_addF x n as bs, hpq]\n          have : p.2 * x.getD q.1 0 + q.2 * x.getD q.1 0 = 0 := by rw [← Int.add_mul, hz, Int.zero_mul]\n          omega\n        · simp only [dot, dot_addF x n as bs, hpq, Int.add_mul]; omega\n\ntheorem dot_addL (a b : List (Nat × Int)) (x : List Int) : dot (addL a b) x = dot a x + dot b x := dot_addF x _ a b\n\ntheorem dot_map (m : Int) (x : List Int) : ∀ (a : List (Nat × Int)), dot (a.map (fun p => (p.1, m * p.2))) x = m * dot a x\n  | [] => by simp [dot]\n  | p :: a => by simp only [List.map_cons, dot, dot_map m x a, Int.mul_add, Int.mul_assoc]\n\ntheorem dot_scaleL (m : Int) (a : List (Nat × Int)) (x : List Int) : dot (scaleL m a) x = m * dot a x := by\n  unfold scaleL\n  split\n  · rename_i h; subst h; simp [dot]\n  · exact dot_map m x a\n\ntheorem dot_allZero : ∀ (a : List (Nat × Int)) (x : List Int), allZero a = true → dot a x = 0\n  | [], _, _ => rfl\n  | p :: a, x, h => by\n    simp only [allZero, Bool.and_eq_true, beq_iff_eq] at h\n    simp [dot, h.1, dot_allZero a x h.2]\n\ninductive Step where\n  | input (i : Nat)\n  | combine (a b : Nat) (ma mb : Int)\n  | cut (of : Nat) (g : Int) (q : List (Nat × Int)) (c : Int)\nderiving Repr\n\ndef combineRow (ma mb : Int) (A B : Row) : Row :=\n  ⟨addL (scaleL ma A.coefs) (scaleL mb B.coefs), ma * A.const + mb * B.const⟩\n\ndef cutOk (A : Row) (g : Int) (q : List (Nat × Int)) (c : Int) : Bool :=\n  decide (1 ≤ g) && decide (A.coefs = scaleL g q) && decide (g * c ≤ A.const + g - 1)\n\n-- The rows so far kept newest first, with their number (step i's row is at n − 1 − i): a row is put on the front and\n-- read where it is, never past a chain of appends.\ndef replay (inputs : List Row) : List Step → Nat → List Row → Option (List Row)\n  | [], _, rows => some rows\n  | .input i :: ss, n, rows =>\n    match inputs[i]? with\n    | some r => replay inputs ss (n + 1) (r :: rows)\n    | none => none\n  | .combine a b ma mb :: ss, n, rows =>\n    match rows[n - 1 - a]?, rows[n - 1 - b]? with\n    | some A, some B => if a < n ∧ b < n ∧ 0 < ma ∧ 0 < mb then replay inputs ss (n + 1) (combineRow ma mb A B :: rows) else none\n    | _, _ => none\n  | .cut o g q c :: ss, n, rows =>\n    match rows[n - 1 - o]? with\n    | some A => if o < n ∧ cutOk A g q c then replay inputs ss (n + 1) (⟨q, c⟩ :: rows) else none\n    | none => none\n\ndef check (inputs : List Row) (steps : List Step) : Bool :=\n  match replay inputs steps 0 [] with\n  | some rows =>\n    match rows.head? with\n    | some r => allZero r.coefs && decide (0 < r.const)\n    | none => false\n  | none => false\n\ntheorem cut_sound (g d c c' : Int) (hg : 1 ≤ g) (h : g * d + c ≤ 0) (hc : g * c' ≤ c + g - 1) : d + c' ≤ 0 := by\n  have hd : g * (d + c') = g * d + g * c' := Int.mul_add g d c'\n  refine Int.not_lt.mp (fun h1 => ?_)\n  have h2 : g * 1 ≤ g * (d + c') := Int.mul_le_mul_of_nonneg_left (by omega) (by omega)\n  omega\n\n-- Every row a replay produces holds wherever the inputs and the rows so far hold.\ntheorem replay_holds (inputs : List Row) (x : List Int) (hx : ∀ r ∈ inputs, eval r x ≤ 0) :\n    ∀ (ss : List Step) (n : Nat) (rows out : List Row), (∀ r ∈ rows, eval r x ≤ 0) →\n      replay inputs ss n rows = some out → ∀ r ∈ out, eval r x ≤ 0 := by\n  intro ss\n  induction ss with\n  | nil =>\n    intro n rows out hrows h\n    simp only [replay, Option.some.injEq] at h\n    exact h ▸ hrows\n  | cons s ss ih =>\n    intro n rows out hrows h\n    cases s with\n    | input i =>\n      simp only [replay] at h\n      split at h\n      · rename_i r hr\n        refine ih _ _ out ?_ h\n        intro r' hr'\n        rcases List.mem_cons.mp hr' with hr' | hr'\n        · exact hr' ▸ hx r (List.mem_of_getElem? hr)\n        · exact hrows r' hr'\n      · exact absurd h (by simp)\n    | combine a b ma mb =>\n      simp only [replay] at h\n      split at h\n      · rename_i A B hA hB\n        split at h\n        · rename_i hm\n          refine ih _ _ out ?_ h\n          intro r' hr'\n          rcases List.mem_cons.mp hr' with hr' | hr'\n          · subst hr'\n            have eA := hrows A (List.mem_of_getElem? hA)\n            have eB := hrows B (List.mem_of_getElem? hB)\n            simp only [eval, combineRow, dot_addL, dot_scaleL] at eA eB ⊢\n            have h1 : ma * (dot A.coefs x + A.const) ≤ ma * 0 := Int.mul_le_mul_of_nonneg_left eA (by omega)\n            have h2 : mb * (dot B.coefs x + B.const) ≤ mb * 0 := Int.mul_le_mul_of_nonneg_left eB (by omega)\n            simp only [Int.mul_add, Int.mul_zero] at h1 h2\n            omega\n          · exact hrows r' hr'\n        · exact absurd h (by simp)\n      · exact absurd h (by simp)\n    | cut o g q c =>\n      simp only [replay] at h\n      split at h\n      · rename_i A hA\n        split at h\n        · rename_i hok\n          refine ih _ _ out ?_ h\n          intro r' hr'\n          rcases List.mem_cons.mp hr' with hr' | hr'\n          · subst hr'\n            simp only [cutOk, Bool.and_eq_true, decide_eq_true_eq] at hok\n            obtain ⟨_, ⟨hg, hq⟩, hc⟩ := hok\n            have eA := hrows A (List.mem_of_getElem? hA)\n            have hdot : dot A.coefs x = g * dot q x := by rw [hq, dot_scaleL]\n            simp only [eval, hdot] at eA\n            exact cut_sound g (dot q x) A.const c hg eA hc\n          · exact hrows r' hr'\n        · exact absurd h (by simp)\n      · exact absurd h (by simp)\n\n/-- A certificate the checker accepts refutes its inputs: no integer point satisfies them all. -/\ntheorem sound (inputs : List Row) (steps : List Step) (h : check inputs steps = true) (x : List Int)\n    (hx : ∀ r ∈ inputs, eval r x ≤ 0) : False := by\n  simp only [check] at h\n  split at h\n  · rename_i rows hrows\n    split at h\n    · rename_i r hr\n      simp only [Bool.and_eq_true, decide_eq_true_eq] at h\n      have hall := replay_holds inputs x hx steps 0 [] rows (by simp) hrows\n      have hm : r ∈ rows := by\n        cases rows with\n        | nil => simp at hr\n        | cons a as => simp only [List.head?, Option.some.injEq] at hr; subst hr; exact List.mem_cons_self\n      have := hall r hm\n      simp only [eval, dot_allZero r.coefs x h.1] at this\n      omega\n    · exact absurd h (by simp)\n  · exact absurd h (by simp)\n\n/-- The induction rule: what holds at the start and survives every step holds after any sequence of steps. -/\ntheorem run_preserves {S I : Type} (step : S → I → S) (P : S → Prop) (start : S)\n    (h0 : P start) (hs : ∀ s i, P s → P (step s i)) : ∀ (is : List I), P (is.foldl step start) := by\n  intro is\n  induction is generalizing start with\n  | nil => exact h0\n  | cons i is ih => exact ih (step start i) (hs start i h0)\n\nend Cert\n",
-    "Kernel.lean": "import Cert\n/-!\nKernel: the Lean twin of gdp-wired's kernel/kernel.ts tree check, with its soundness proof. Lean 4.34.0, core only.\n\nA goal is a variable table and hypotheses over naturals (+, ∸, × by a constant, min, max, if, map reads; ≤, <, =,\nand, or, not). A proof is a tree of splits on linear atoms, with a leaf certificate: the rows it claims, a Cert\nderivation over them, and the pairs of cells it claims equal. At a leaf the twin computes the rows the path, the\nhypotheses' facts, the naturals and the verified cell equalities give, checks every claimed row is one of them, and\nreplays the derivation with `Cert.check`. `sound`: if `checkGoal` accepts, no naturals and no maps satisfy every\nhypothesis.\n\nThe table names what each column of a row is: a variable of the environment, or a map's cell at a key (a row over\nearlier columns). Rows compare by coefficients (`same`), so the exporter's ordering doesn't matter.\n-/\n\nnamespace Kern\nopen Cert\nset_option linter.unusedSimpArgs false\nset_option linter.unusedSectionVars false\n\nmutual\ninductive E where\n  | var (i : Nat)\n  | const (n : Nat)\n  | add (a b : E)\n  | sub (a b : E)\n  | mul (k : Nat) (a : E)\n  | min (a b : E)\n  | max (a b : E)\n  | prod (a b : E)\n  | ite (c : C) (t f : E)\n  | get (m : Nat) (key : E)\ninductive C where\n  | le (a b : E)\n  | lt (a b : E)\n  | eq (a b : E)\n  | and (a b : C)\n  | or (a b : C)\n  | not (a : C)\nend\n\nderiving instance DecidableEq for E, C\n\nmutual\ndef evalE (env : Nat → Nat) (maps : Nat → Nat → Nat) : E → Nat\n  | .var i => env i\n  | .const n => n\n  | .add a b => evalE env maps a + evalE env maps b\n  | .sub a b => evalE env maps a - evalE env maps b\n  | .mul k a => k * evalE env maps a\n  | .min a b => min (evalE env maps a) (evalE env maps b)\n  | .max a b => max (evalE env maps a) (evalE env maps b)\n  | .prod a b => evalE env maps a * evalE env maps b\n  | .ite c t f => if evalC env maps c then evalE env maps t else evalE env maps f\n  | .get m key => maps m (evalE env maps key)\ndef evalC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Bool\n  | .le a b => decide (evalE env maps a ≤ evalE env maps b)\n  | .lt a b => decide (evalE env maps a < evalE env maps b)\n  | .eq a b => decide (evalE env maps a = evalE env maps b)\n  | .and a b => evalC env maps a && evalC env maps b\n  | .or a b => evalC env maps a || evalC env maps b\n  | .not a => !evalC env maps a\nend\n\n-- A condition's meaning as a proposition: what a law says in plain Lean (`evalC_iff`). Exported laws are stated with it,\n-- so a statement like `ρ x ≤ ρ cap` is the law itself, up to unfolding.\ndef holdsC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Prop\n  | .le a b => evalE env maps a ≤ evalE env maps b\n  | .lt a b => evalE env maps a < evalE env maps b\n  | .eq a b => evalE env maps a = evalE env maps b\n  | .and a b => holdsC env maps a ∧ holdsC env maps b\n  | .or a b => holdsC env maps a ∨ holdsC env maps b\n  | .not a => ¬ holdsC env maps a\n\ntheorem evalC_iff (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ c, evalC env maps c = true ↔ holdsC env maps c\n  | .le a b => by simp [evalC, holdsC]\n  | .lt a b => by simp [evalC, holdsC]\n  | .eq a b => by simp [evalC, holdsC]\n  | .and a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .or a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .not a => by\n    have h := evalC_iff env maps a\n    simp only [evalC, holdsC]\n    cases hb : evalC env maps a <;> simp_all\n\n/-! Linear forms are Cert rows: `eval r x = dot r.coefs x + r.const`. -/\n\ndef lconst (n : Int) : Row := ⟨[], n⟩\ndef ladd (a b : Row) : Row := ⟨addL a.coefs b.coefs, a.const + b.const⟩\ndef lscale (m : Int) (a : Row) : Row := ⟨scaleL m a.coefs, m * a.const⟩\ndef lsub (a b : Row) : Row := ladd a (lscale (-1) b)\ndef lunit (j : Nat) : Row := ⟨[(j, 1)], 0⟩\n-- A row as the exporters write it: its nonzero coefficients (column, coefficient), in column order, and its constant.\ndef sp (cs : List (Nat × Int)) (c : Int) : Row := ⟨cs, c⟩\ndef same (a b : Row) : Bool := allZero (lsub a b).coefs && (lsub a b).const == 0\n-- 1 − a: over the integers, a ≤ 0 fails exactly when 1 − a ≤ 0 holds.\ndef flip (a : Row) : Row := lsub (lconst 1) a\n\ntheorem eval_lconst (n : Int) (x : List Int) : eval (lconst n) x = n := by\n  cases x <;> simp [eval, lconst, dot]\ntheorem eval_ladd (a b : Row) (x : List Int) : eval (ladd a b) x = eval a x + eval b x := by\n  simp only [eval, ladd, dot_addL]; omega\ntheorem eval_lscale (m : Int) (a : Row) (x : List Int) : eval (lscale m a) x = m * eval a x := by\n  simp only [eval, lscale, dot_scaleL, Int.mul_add]\ntheorem eval_lsub (a b : Row) (x : List Int) : eval (lsub a b) x = eval a x - eval b x := by\n  simp only [lsub, eval_ladd, eval_lscale]; omega\ntheorem eval_flip (a : Row) (x : List Int) : eval (flip a) x = 1 - eval a x := by\n  simp only [flip, eval_lsub, eval_lconst]\ntheorem eval_lunit (j : Nat) (x : List Int) : eval (lunit j) x = x.getD j 0 := by\n  simp [eval, lunit, dot]\ntheorem same_eval {a b : Row} (h : same a b = true) (x : List Int) : eval a x = eval b x := by\n  simp only [same, Bool.and_eq_true, beq_iff_eq] at h\n  have h1 : eval (lsub a b) x = 0 := by simp only [eval, dot_allZero _ x h.1, h.2]; rfl\n  rw [eval_lsub] at h1; omega\n\n/-! The path: atoms decided so far. `(l, true)` says l ≤ 0, `(l, false)` says l ≥ 1. -/\n\nabbrev Path := List (Row × Bool)\ndef PathHolds (path : Path) (x : List Int) : Prop := ∀ a ∈ path, decide (eval a.1 x ≤ 0) = a.2\n\ndef lookup {α : Type} (p : α → Bool) : List α → Option α\n  | [] => none\n  | a :: as => if p a then some a else lookup p as\ntheorem lookup_some {α : Type} {p : α → Bool} : ∀ {l : List α} {a : α}, lookup p l = some a → a ∈ l ∧ p a = true\n  | [], _, h => by simp [lookup] at h\n  | b :: bs, a, h => by\n    simp only [lookup] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨List.mem_cons_self, by assumption⟩\n    · have := lookup_some h; exact ⟨List.mem_cons_of_mem _ this.1, this.2⟩\n\ndef dec (path : Path) (l : Row) : Option Bool :=\n  if allZero l.coefs then some (decide (l.const ≤ 0))\n  else match lookup (fun a => same a.1 l) path with\n    | some a => some a.2\n    | none => match lookup (fun a => same a.1 (flip l)) path with\n      | some a => some (!a.2)\n      | none => none\n\ntheorem dec_sound {path : Path} {x : List Int} (hP : PathHolds path x) {l : Row} {b : Bool}\n    (h : dec path l = some b) : decide (eval l x ≤ 0) = b := by\n  simp only [dec] at h\n  split at h\n  · rename_i hz\n    simp only [Option.some.injEq] at h\n    subst h\n    simp [eval, dot_allZero _ x hz]\n  · split at h\n    · rename_i a ha\n      simp only [Option.some.injEq] at h; subst h\n      have ⟨hm, hs⟩ := lookup_some ha\n      rw [← hP a hm, same_eval hs]\n    · split at h\n      · rename_i a ha\n        simp only [Option.some.injEq] at h; subst h\n        have ⟨hm, hs⟩ := lookup_some ha\n        have := hP a hm\n        rw [same_eval hs, eval_flip] at this\n        rw [← this]\n        by_cases hl : eval l x ≤ 0 <;> simp [hl] <;> omega\n      · simp at h\n\n/-! The table: column j is a variable of the environment, or map m's cell at a key (a row over earlier columns). -/\n\ninductive VDef where\n  | var (i : Nat)\n  | cell (m : Nat) (key : Row)\n  | mono (fs : List Nat)        -- the product of earlier columns (a monomial)\n  | term (e : E)                -- a choice the path leaves open (∸, min, max, if), standing for its value\n\ndef prodV (x : List Int) : List Nat → Int\n  | [] => 1\n  | j :: js => x.getD j 0 * prodV x js\n\ndef valD (env : Nat → Nat) (maps : Nat → Nat → Nat) : VDef → List Int → Int\n  | .var i, _ => (env i : Int)\n  | .cell m k, x => (maps m (eval k x).toNat : Int)\n  | .mono fs, x => ((prodV x fs).toNat : Int)\n  | .term e, _ => (evalE env maps e : Int)\n\n-- x is a valuation of the table: each column holds what its definition says, and every value is a natural.\ndef Model (tab : List VDef) (env : Nat → Nat) (maps : Nat → Nat → Nat) (x : List Int) : Prop :=\n  (∀ j d, tab[j]? = some d → x.getD j 0 = valD env maps d x) ∧ ∀ j, 0 ≤ x.getD j 0\n\ndef findIdx {α : Type} (p : α → Bool) : List α → Option Nat\n  | [] => none\n  | a :: as => if p a then some 0 else (findIdx p as).map (· + 1)\ntheorem findIdx_some {α : Type} {p : α → Bool} : ∀ {l : List α} {j : Nat}, findIdx p l = some j → ∃ a, l[j]? = some a ∧ p a = true\n  | [], _, h => by simp [findIdx] at h\n  | b :: bs, j, h => by\n    simp only [findIdx] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨b, rfl, by assumption⟩\n    · cases hj : findIdx p bs with\n      | none => simp [hj] at h\n      | some i =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        obtain ⟨a, ha, hp⟩ := findIdx_some (l := bs) hj\n        exact ⟨a, by simpa using ha, hp⟩\n\ndef isVar (i : Nat) : VDef → Bool\n  | .var i' => i' == i\n  | _ => false\ndef isCell (m : Nat) (k : Row) : VDef → Bool\n  | .cell m' k' => m' == m && same k' k\n  | _ => false\ndef isTerm (e : E) : VDef → Bool\n  | .term e' => e' == e\n  | _ => false\n-- An open choice's column: the table's column for the whole term, if it has one.\ndef termCol (tab : List VDef) (e : E) : Option Row := (findIdx (isTerm e) tab).map lunit\ndef isMono (fs : List Nat) : VDef → Bool\n  | .mono fs' => fs' == fs\n  | _ => false\n\n/-! Products: monomials are columns, each the product of the columns its factors name (sorted, so one monomial is one\ncolumn). Multiplying two rows looks up the column of each product of two columns. -/\n\ndef ins (a : Nat) : List Nat → List Nat\n  | [] => [a]\n  | b :: bs => if a ≤ b then a :: b :: bs else b :: ins a bs\ndef srt : List Nat → List Nat\n  | [] => []\n  | a :: as => ins a (srt as)\n\ntheorem prodV_ins (x : List Int) (a : Nat) : ∀ l, prodV x (ins a l) = x.getD a 0 * prodV x l\n  | [] => by simp [ins, prodV]\n  | b :: bs => by\n    simp only [ins]; split\n    · rfl\n    · simp only [prodV, prodV_ins x a bs]; rw [Int.mul_left_comm]\ntheorem prodV_srt (x : List Int) : ∀ l, prodV x (srt l) = prodV x l\n  | [] => rfl\n  | a :: as => by simp only [srt, prodV_ins, prodV_srt x as, prodV]\ntheorem prodV_append (x : List Int) : ∀ l1 l2, prodV x (l1 ++ l2) = prodV x l1 * prodV x l2\n  | [], l2 => by simp [prodV]\n  | a :: as, l2 => by simp only [List.cons_append, prodV, prodV_append x as l2, Int.mul_assoc]\ntheorem prodV_nonneg {x : List Int} (h : ∀ j, 0 ≤ x.getD j 0) : ∀ l, 0 ≤ prodV x l\n  | [] => by simp [prodV]\n  | a :: as => Int.mul_nonneg (h a) (prodV_nonneg h as)\n\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 · Σ b x_j, over b's coefficients (column j, coefficient b)\ndef mulRow (tab : List VDef) (i : Nat) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | q :: bs => match mulRow tab i bs with\n    | none => none\n    | some r => if q.2 == 0 then some r else match pcol tab i q.1 with\n      | some k => some (ladd (lscale q.2 (lunit k)) r)\n      | none => none\n-- (Σ a x_i) · Σ b x_j\ndef mulRows (tab : List VDef) (bs : List (Nat × Int)) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | p :: as => match mulRows tab bs as with\n    | none => none\n    | some r => if p.2 == 0 then some r else match mulRow tab p.1 bs with\n      | some q => some (ladd (lscale p.2 q) r)\n      | none => none\ndef rowMul (tab : List VDef) (a b : Row) : Option Row :=\n  match mulRows tab b.coefs a.coefs with\n  | some p => some (ladd p (ladd (lscale a.const ⟨b.coefs, 0⟩) (ladd (lscale b.const ⟨a.coefs, 0⟩) (lconst (a.const * b.const)))))\n  | none => none\n\n\nmutual\ndef linear (tab : List VDef) (path : Path) : E → Option Row\n  | .var i => (findIdx (isVar i) tab).map lunit\n  | .const n => some (lconst n)\n  | .add a b => match linear tab path a, linear tab path b with\n    | some la, some lb => some (ladd la lb)\n    | _, _ => none\n  | .mul k a => match linear tab path a with\n    | some la => some (lscale k la)\n    | none => none\n  | .sub a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub lb la) with\n      | some true => some (lsub la lb)\n      | some false => some (lconst 0)\n      | none => termCol tab (.sub a b)\n    | _, _ => none\n  | .min a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some la\n      | some false => some lb\n      | none => termCol tab (.min a b)\n    | _, _ => none\n  | .max a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some lb\n      | some false => some la\n      | none => termCol tab (.max a b)\n    | _, _ => none\n  | .prod a b => match linear tab path a, linear tab path b with\n    | some la, some lb => rowMul tab la lb\n    | _, _ => none\n  | .ite c t f => match truth tab path c with\n    | some true => linear tab path t\n    | some false => linear tab path f\n    | none => termCol tab (.ite c t f)\n  | .get m key => match linear tab path key with\n    | some lk => (findIdx (isCell m lk) tab).map lunit\n    | none => none\ndef truth (tab : List VDef) (path : Path) : C → Option Bool\n  | .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (lsub la lb)\n    | _, _ => none\n  | .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (ladd (lsub la lb) (lconst 1))\n    | _, _ => none\n  | .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb), dec path (lsub lb la) with\n      | some false, _ => some false\n      | _, some false => some false\n      | some true, some true => some true\n      | _, _ => none\n    | _, _ => none\n  | .and a b => match truth tab path a, truth tab path b with\n    | some false, _ => some false\n    | _, some false => some false\n    | some true, some true => some true\n    | _, _ => none\n  | .or a b => match truth tab path a, truth tab path b with\n    | some true, _ => some true\n    | _, some true => some true\n    | some false, some false => some false\n    | _, _ => none\n  | .not a => match truth tab path a with\n    | some b => some (!b)\n    | none => none\nend\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem var_col (hM : Model tab env maps x) {i j : Nat} (h : findIdx (isVar i) tab = some j) : x.getD j 0 = env i := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | var i' => simp only [isVar, beq_iff_eq] at hv; subst hv; rfl\n  | _ => simp [isVar] at hv\n\ntheorem term_col (hM : Model tab env maps x) {e : E} {j : Nat} (h : findIdx (isTerm e) tab = some j) :\n    x.getD j 0 = (evalE env maps e : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | term e' => simp only [isTerm, beq_iff_eq] at hv; subst hv; rfl\n  | _ => simp [isTerm] at hv\n\ntheorem termCol_sound (hM : Model tab env maps x) {e : E} {l : Row} (h : termCol tab e = some l) :\n    eval l x = (evalE env maps e : Int) := by\n  simp only [termCol] at h\n  cases hj : findIdx (isTerm e) tab with\n  | none => simp [hj] at h\n  | some j => simp only [hj, Option.map_some, Option.some.injEq] at h; subst h; rw [eval_lunit, term_col hM hj]\n\ntheorem cell_col (hM : Model tab env maps x) {m j : Nat} {k : Row} (h : findIdx (isCell m k) tab = some j) :\n    x.getD j 0 = (maps m (eval k x).toNat : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | cell m' k' =>\n    simp only [isCell, Bool.and_eq_true, beq_iff_eq] at hv\n    obtain ⟨rfl, hs⟩ := hv\n    simp only [valD, same_eval hs x]\n  | _ => simp [isCell] at hv\n\ntheorem fac_val (hM : Model tab env maps x) {i : Nat} {fs : List Nat} (h : fac tab i = some fs) : x.getD i 0 = prodV x fs := by\n  simp only [fac] at h\n  split at h\n  · 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    ∀ bs r, mulRow tab i bs = some r → eval r x = x.getD i 0 * dot bs x\n  | [], r, h => by simp only [mulRow, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | q :: bs, r, h => by\n    simp only [mulRow] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRow_sound hM i bs r' hr'\n      split at h\n      · rename_i hb\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at hb; simp [dot, hb, ih]\n      · split at h\n        · rename_i k hk\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, eval_lunit, pcol_val hM hk, ih]\n          simp only [dot]; rw [Int.mul_add, Int.mul_left_comm (x.getD i 0) q.2]\n        · simp at h\n\ntheorem mulRows_sound (hM : Model tab env maps x) (bs : List (Nat × Int)) :\n    ∀ as r, mulRows tab bs as = some r → eval r x = dot as x * dot bs x\n  | [], r, h => by simp only [mulRows, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | p :: as, r, h => by\n    simp only [mulRows] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRows_sound hM bs as r' hr'\n      split at h\n      · rename_i ha\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at ha; simp [dot, ha, ih]\n      · split at h\n        · rename_i q hq\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, mulRow_sound hM p.1 bs q hq, ih]\n          simp only [dot]; rw [Int.add_mul, Int.mul_assoc]\n        · simp at h\n\ntheorem rowMul_sound (hM : Model tab env maps x) {a b r : Row} (h : rowMul tab a b = some r) : eval r x = eval a x * eval b x := by\n  simp only [rowMul] at h\n  split at h\n  · rename_i p hp\n    simp only [Option.some.injEq] at h; subst h\n    have e := mulRows_sound hM b.coefs a.coefs p hp\n    simp only [eval_ladd, eval_lscale, eval_lconst, e]\n    simp only [eval, Int.add_zero]\n    rw [Int.add_mul, Int.mul_add, Int.mul_add, Int.mul_comm b.const]; omega\n  · simp at h\n\nmutual\ntheorem linear_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (e : E) → (l : Row) → linear tab path e = some l → eval l x = (evalE env maps e : Int)\n  | .var i, l, h => by\n    simp only [linear] at h\n    cases hj : findIdx (isVar i) tab with\n    | none => simp [hj] at h\n    | some j =>\n      simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n      rw [eval_lunit, var_col hM hj, evalE]\n  | .const n, l, h => by\n    simp only [linear, Option.some.injEq] at h; subst h\n    simp [eval_lconst, evalE]\n  | .add a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_ladd, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; omega\n    · simp at h\n  | .mul k a, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la ha\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_lscale, linear_sound hM hP a la ha, evalE]; simp\n    · simp at h\n  | .sub a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [eval_lsub, evalE]; omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [eval_lconst, evalE]; omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .min a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .max a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .prod a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      rw [rowMul_sound hM h, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; simp\n    · simp at h\n  | .ite c t f, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i hc\n      have := truth_sound hM hP c true hc\n      rw [linear_sound hM hP t l h, evalE, this]; rfl\n    · rename_i hc\n      have := truth_sound hM hP c false hc\n      rw [linear_sound hM hP f l h, evalE, this]; rfl\n    · exact termCol_sound hM h\n  | .get m key, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i lk hk\n      cases hj : findIdx (isCell m lk) tab with\n      | none => simp [hj] at h\n      | some j =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        rw [eval_lunit, cell_col hM hj, linear_sound hM hP key lk hk, evalE]; simp\n    · simp at h\ntheorem truth_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (b : Bool) → truth tab path c = some b → evalC env maps c = b\n  | .le a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_lsub] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .lt a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_ladd, eval_lsub, eval_lconst] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .eq a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      simp only [evalC]\n      revert h\n      rcases h1 : dec path (lsub la lb) with _ | _ | _ <;> rcases h2 : dec path (lsub lb la) with _ | _ | _ <;>\n        intro h <;> simp only [Option.some.injEq, reduceCtorEq] at h <;> subst h <;>\n        first\n          | (have t1 := dec_sound hP h1; have t2 := dec_sound hP h2; rw [eval_lsub] at t1 t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 t2 ⊢; omega)\n          | (have t1 := dec_sound hP h1; rw [eval_lsub] at t1\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 ⊢; omega)\n          | (have t2 := dec_sound hP h2; rw [eval_lsub] at t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t2 ⊢; omega)\n    · simp at h\n  | .and a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' false h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1, truth_sound hM hP b' true h2]\n    · simp at h\n  | .or a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' true h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1, truth_sound hM hP b' false h2]\n    · simp at h\n  | .not a, r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i r' h1; simp only [Option.some.injEq] at h; subst h; simp [evalC, truth_sound hM hP a r' h1]\n    · simp at h\nend\nend\n\n/-! Facts: the rows a hypothesis gives under the path, when it has the truth value `pos`. -/\n\ndef facts (tab : List VDef) (path : Path) : Bool → C → List Row\n  | pos, .not a => facts tab path (!pos) a\n  | pos, .and a b =>\n    if pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .or a b =>\n    if !pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb]\n      else let u := ladd (lsub lb la) (lconst 1); if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [ladd (lsub la lb) (lconst 1)]\n      else let u := lsub lb la; if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb, lsub lb la]\n      else\n        let u1 := ladd (lsub la lb) (lconst 1)\n        let u2 := ladd (lsub lb la) (lconst 1)\n        let o1 := dec path u1 != some false\n        let o2 := dec path u2 != some false\n        if o1 && o2 then [] else if o1 then [u1] else if o2 then [u2] else [lconst 1]\n    | _, _ => []\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem facts_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (pos : Bool) → evalC env maps c = pos → ∀ r ∈ facts tab path pos c, eval r x ≤ 0\n  | .not a, pos, h, r, hr => by\n    simp only [facts] at hr\n    exact facts_sound hM hP a (!pos) (by simp [evalC] at h; simp [← h]) r hr\n  | .and a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | true =>\n      simp only [evalC, Bool.and_eq_true] at h\n      simp only [ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a true h.1 r hr\n      · exact facts_sound hM hP b true h.2 r hr\n    | false =>\n      simp only [Bool.false_eq_true, ite_false, Bool.not_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.and_eq_false_iff] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · rename_i _ hoa\n          have hb : truth tab path b = some true := by simp_all\n          have := tb true hb\n          exact facts_sound hM hP a false (by simp_all) r hr\n        · split at hr\n          · rename_i _ _ hob\n            have ha : truth tab path a = some true := by simp_all\n            have := ta true ha\n            exact facts_sound hM hP b false (by simp_all) r hr\n          · have ha : truth tab path a = some true := by simp_all\n            have hb : truth tab path b = some true := by simp_all\n            have := ta true ha; have := tb true hb\n            simp_all\n  | .or a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | false =>\n      simp only [evalC, Bool.or_eq_false_iff] at h\n      simp only [Bool.not_false, ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a false h.1 r hr\n      · exact facts_sound hM hP b false h.2 r hr\n    | true =>\n      simp only [Bool.not_true, Bool.false_eq_true, ite_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.or_eq_true] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · have hb : truth tab path b = some false := by simp_all\n          have := tb false hb\n          exact facts_sound hM hP a true (by simp_all) r hr\n        · split at hr\n          · have ha : truth tab path a = some false := by simp_all\n            have := ta false ha\n            exact facts_sound hM hP b true (by simp_all) r hr\n          · have ha : truth tab path a = some false := by simp_all\n            have hb : truth tab path b = some false := by simp_all\n            have := ta false ha; have := tb false hb\n            simp_all\n  | .le a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_lsub]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_ladd, eval_lsub, eval_lconst]; omega\n    · simp at hr\n  | .lt a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_ladd, eval_lsub, eval_lconst]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_lsub, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_lsub]; omega\n    · simp at hr\n  | .eq a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with hr | hr <;> subst hr <;> rw [eval_lsub] <;> omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        have d1 := fun (hv : dec path (ladd (lsub la lb) (lconst 1)) = some false) => dec_sound hP hv\n        have d2 := fun (hv : dec path (ladd (lsub lb la) (lconst 1)) = some false) => dec_sound hP hv\n        simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at d1 d2\n        split at hr\n        · simp at hr\n        · split at hr\n          · have := d2 (by simp_all)\n            simp only [List.mem_singleton] at hr; subst hr\n            rw [eval_ladd, eval_lsub, eval_lconst]; omega\n          · split at hr\n            · have := d1 (by simp_all)\n              simp only [List.mem_singleton] at hr; subst hr\n              rw [eval_ladd, eval_lsub, eval_lconst]; omega\n            · have := d1 (by simp_all); have := d2 (by simp_all); omega\n    · simp at hr\nend\n\n/-! Leaves and trees. -/\n\ndef atomRow (a : Row × Bool) : Row := if a.2 then a.1 else flip a.1\ndef natRows : Nat → List Row\n  | 0 => []\n  | n + 1 => lscale (-1) (lunit n) :: natRows n\n-- Two cells of one map whose keys the path proves equal are equal (the pair is the leaf's claim; it is checked here).\ndef cellEq (tab : List VDef) (path : Path) (p : Nat × Nat) : List Row :=\n  match tab[p.1]?, tab[p.2]? with\n  | some (.cell m k), some (.cell m' k') =>\n    if m == m' && dec path (lsub k k') == some true && dec path (lsub k' k) == some true\n    then [lsub (lunit p.1) (lunit p.2), lsub (lunit p.2) (lunit p.1)] else []\n  | _, _ => []\n-- A term column's rows: its bounds, whichever way its choice goes (min ≤ each side, max ≥ each side, a ∸ b ≥ a − b and\n-- ≤ a), and its equality to the term's form under the path (the branch taken, once the path decides it).\ndef termBounds (j : Nat) (la lb : Row) : E → List Row\n  | .min _ _ => [lsub (lunit j) la, lsub (lunit j) lb]\n  | .max _ _ => [lsub la (lunit j), lsub lb (lunit j)]\n  | .sub _ _ => [lsub (lsub la lb) (lunit j), lsub (lunit j) la]\n  | _ => []\ndef termRowsAt (tab : List VDef) (path : Path) (j : Nat) : List Row :=\n  match tab[j]? with\n  | some (.term e) =>\n    (match e with\n     | .min a b | .max a b | .sub a b => match linear tab path a, linear tab path b with\n       | some la, some lb => termBounds j la lb e\n       | _, _ => []\n     | _ => [])\n    ++ (match linear tab path e with\n        | some r => [lsub (lunit j) r, lsub r (lunit j)]\n        | none => [])\n  | _ => []\ndef termRows (tab : List VDef) (path : Path) : List Row := (List.range tab.length).flatMap (termRowsAt tab path)\n\ndef leafRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : List Row :=\n  path.map atomRow ++ hyps.flatMap (facts tab path true) ++ natRows tab.length ++ eqs.flatMap (cellEq tab path) ++ termRows tab path\n\n-- Where a leaf's row is looked for first: the path's i-th atom (the latest decision first), a hypothesis's facts, column i's naturality, the i-th\n-- pair of equal cells, or term column j's rows. A hint only saves work: a row not found there is looked for among all\n-- of the leaf's rows, as one without a hint is.\ninductive Src where\n  | atom (i : Nat)\n  | fact (h : Nat)\n  | nat (i : Nat)\n  | eq (i : Nat)\n  | term (j : Nat)\n  | any\n\ndef srcRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : Src → List Row\n  | .atom i => match path[i]? with | some a => [atomRow a] | none => []\n  | .fact h => match hyps[h]? with | some c => facts tab path true c | none => []\n  | .nat i => if i < tab.length then [lscale (-1) (lunit i)] else []\n  | .eq i => match eqs[i]? with | some p => cellEq tab path p | none => []\n  | .term j => if j < tab.length then termRowsAt tab path j else []\n  | .any => []\n\n-- A leaf may add products of two of its rows (p ≤ 0 and q ≤ 0 give −p·q ≤ 0); a pair may name an earlier product.\n-- `leafAt` is a leaf whose rows come with hints.\ninductive Tree where\n  | split (l : Row) (yes no : Tree)\n  | leaf (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n  | leafAt (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n\ndef extend (tab : List VDef) : List Row → List (Nat × Nat) → Option (List Row)\n  | acc, [] => some acc\n  | acc, (i, j) :: ps => match acc[i]?, acc[j]? with\n    | some p, some q => match rowMul tab p q with\n      | some r => extend tab (acc ++ [lscale (-1) r]) ps\n      | none => none\n    | _, _ => none\n\ndef leafOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  let comp := leafRows tab path hyps eqs\n  rows.all (fun r => comp.any (same r)) && match extend tab rows prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\n-- Each row where its hint says, or else among the leaf's rows.\ndef leafAtOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  rows.all (fun r => (srcRows tab path hyps eqs r.2).any (same r.1) || (leafRows tab path hyps eqs).any (same r.1))\n    && match extend tab (rows.map (·.1)) prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\ndef checkT (tab : List VDef) (hyps : List C) : Path → Tree → Bool\n  | path, .split l y n => checkT tab hyps ((l, true) :: path) y && checkT tab hyps ((l, false) :: path) n\n  | path, .leaf rows steps eqs prods => leafOk tab path hyps rows steps eqs prods\n  | path, .leafAt rows steps eqs prods => leafAtOk tab path hyps rows steps eqs prods\n\nstructure Goal where\n  tab : List VDef\n  hyps : List C\n\n-- Each cell's key reads only earlier columns, so the table has a valuation.\ndef wfTab : Nat → List VDef → Bool\n  | _, [] => true\n  | n, .var _ :: ds => wfTab (n + 1) ds\n  | n, .cell _ k :: ds => k.coefs.all (·.1 < n) && wfTab (n + 1) ds\n  | n, .mono fs :: ds => fs.all (· < n) && wfTab (n + 1) ds\n  | n, .term _ :: ds => wfTab (n + 1) ds\n\ndef checkGoal (g : Goal) (t : Tree) : Bool := wfTab 0 g.tab && checkT g.tab g.hyps [] t\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int}\n\ntheorem natRows_sound (hM : Model tab env maps x) : ∀ n, ∀ r ∈ natRows n, eval r x ≤ 0\n  | 0, r, hr => by simp [natRows] at hr\n  | n + 1, r, hr => by\n    simp only [natRows, List.mem_cons] at hr\n    rcases hr with hr | hr\n    · subst hr; rw [eval_lscale, eval_lunit]; have := hM.2 n; omega\n    · exact natRows_sound hM n r hr\n\ntheorem termRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) :\n    ∀ r ∈ termRows tab path, eval r x ≤ 0 := by\n  intro r hr\n  simp only [termRows, List.mem_flatMap] at hr\n  obtain ⟨j, _, hr⟩ := hr\n  simp only [termRowsAt] at hr\n  split at hr\n  · rename_i e hj\n    have hx : x.getD j 0 = (evalE env maps e : Int) := by rw [hM.1 j _ hj]; rfl\n    simp only [List.mem_append] at hr\n    rcases hr with hr | hr\n    · cases e with\n      | min a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.min_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | max a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.max_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | sub a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE] at hx\n          rcases hr with rfl | rfl\n          · rw [eval_lsub, eval_lsub, eval_lunit]; omega\n          · rw [eval_lsub, eval_lunit]; omega\n        · simp at hr\n      | _ => simp at hr\n    · split at hr\n      · rename_i r' hr'\n        have := linear_sound hM hP e r' hr'\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n      · simp at hr\n  · simp at hr\n\ntheorem leafRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) {hyps : List C}\n    (hH : ∀ c ∈ hyps, evalC env maps c = true) (eqs : List (Nat × Nat)) : ∀ r ∈ leafRows tab path hyps eqs, eval r x ≤ 0 := by\n  intro r hr\n  simp only [leafRows, List.mem_append, List.mem_map, List.mem_flatMap] at hr\n  rcases hr with (((⟨a, ha, rfl⟩ | ⟨c, hc, hr⟩) | hr) | ⟨p, _, hr⟩) | hr\n  · have := hP a ha\n    simp only [atomRow]\n    cases h2 : a.2 with\n    | true => rw [h2] at this; simpa using this\n    | false => rw [h2] at this; simp only [decide_eq_false_iff_not] at this; simp only [ite_false, Bool.false_eq_true, eval_flip]; omega\n  · exact facts_sound hM hP c true (hH c hc) r hr\n  · exact natRows_sound hM _ r hr\n  · simp only [cellEq] at hr\n    split at hr\n    · rename_i m k m' k' h1 h2\n      split at hr\n      · rename_i hc\n        simp only [Bool.and_eq_true, beq_iff_eq] at hc\n        obtain ⟨⟨rfl, hk1⟩, hk2⟩ := hc\n        have t1 := dec_sound hP hk1; have t2 := dec_sound hP hk2\n        simp only [eval_lsub, decide_eq_true_eq] at t1 t2\n        have e1 := hM.1 p.1 _ h1; have e2 := hM.1 p.2 _ h2\n        simp only [valD] at e1 e2\n        have hkk : eval k x = eval k' x := by omega\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit, eval_lunit, e1, e2, hkk] <;> omega\n      · simp at hr\n    · simp at hr\n  · exact termRows_sound hM hP r hr\n\n-- A hint names some of the leaf's rows.\ntheorem natRows_mem : ∀ {n i : Nat}, i < n → lscale (-1) (lunit i) ∈ natRows n\n  | 0, _, h => absurd h (Nat.not_lt_zero _)\n  | n + 1, i, h => by\n    simp only [natRows, List.mem_cons]\n    rcases Nat.lt_succ_iff_lt_or_eq.mp h with h | rfl\n    · exact Or.inr (natRows_mem h)\n    · exact Or.inl rfl\n\ntheorem srcRows_sub {path : Path} {hyps : List C} {eqs : List (Nat × Nat)} {r : Row} :\n    ∀ s, r ∈ srcRows tab path hyps eqs s → r ∈ leafRows tab path hyps eqs\n  | .atom i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i a ha\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append, List.mem_map]\n      exact Or.inl (Or.inl (Or.inl (Or.inl ⟨a, List.mem_of_getElem? ha, rfl⟩)))\n    · simp at hr\n  | .fact h, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i c hc\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inl (Or.inl (Or.inr ⟨c, List.mem_of_getElem? hc, hr⟩)))\n    · simp at hr\n  | .nat i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hi\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append]\n      exact Or.inl (Or.inl (Or.inr (natRows_mem hi)))\n    · simp at hr\n  | .eq i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i p hp\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inr ⟨p, List.mem_of_getElem? hp, hr⟩)\n    · simp at hr\n  | .term j, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hj\n      simp only [leafRows, termRows, List.mem_append, List.mem_flatMap, List.mem_range]\n      exact Or.inr ⟨j, hj, hr⟩\n    · simp at hr\n  | .any, hr => by simp [srcRows] at hr\n\ntheorem extend_sound (hM : Model tab env maps x) :\n    ∀ ps acc rows', extend tab acc ps = some rows' → (∀ r ∈ acc, eval r x ≤ 0) → ∀ r ∈ rows', eval r x ≤ 0\n  | [], acc, rows', h, ha => by simp only [extend, Option.some.injEq] at h; subst h; exact ha\n  | (i, j) :: ps, acc, rows', h, ha => by\n    simp only [extend] at h\n    split at h\n    · rename_i p q hp hq\n      split at h\n      · rename_i r hr\n        refine extend_sound hM ps _ rows' h (fun r' hr' => ?_)\n        rcases List.mem_append.mp hr' with hr' | hr'\n        · exact ha r' hr'\n        · simp only [List.mem_singleton] at hr'; subst hr'\n          have e1 := ha p (List.mem_of_getElem? hp)\n          have e2 := ha q (List.mem_of_getElem? hq)\n          rw [eval_lscale, rowMul_sound hM hr]\n          have : 0 ≤ (-eval p x) * (-eval q x) := Int.mul_nonneg (by omega) (by omega)\n          rw [Int.neg_mul_neg] at this; omega\n      · simp at h\n    · simp at h\n\ntheorem checkT_sound (hM : Model tab env maps x) {hyps : List C} (hH : ∀ c ∈ hyps, evalC env maps c = true) :\n    ∀ (t : Tree) (path : Path), PathHolds path x → checkT tab hyps path t = true → False\n  | .split l y n, path, hP, h => by\n    simp only [checkT, Bool.and_eq_true] at h\n    by_cases hl : eval l x ≤ 0\n    · refine checkT_sound hM hH y _ ?_ h.1\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n    · refine checkT_sound hM hH n _ ?_ h.2\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n  | .leaf rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafOk, Bool.and_eq_true, List.all_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods rows rows' he ?_)\n      intro r hr\n      obtain ⟨c, hc, hs⟩ := h1 r hr\n      rw [same_eval hs]\n      exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\n  | .leafAt rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafAtOk, Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods _ rows' he ?_)\n      intro r hr\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hr\n      rcases h1 p hp with ⟨c, hc, hs⟩ | ⟨c, hc, hs⟩\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c (srcRows_sub p.2 hc)\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\nend\n\n/-! The table's valuation. -/\n\ndef build (env : Nat → Nat) (maps : Nat → Nat → Nat) : List VDef → List Int → List Int\n  | [], acc => acc\n  | d :: ds, acc => build env maps ds (acc ++ [valD env maps d acc])\n\ntheorem dot_append : ∀ (a : List (Nat × Int)) (l1 l2 : List Int), (∀ p ∈ a, p.1 < l1.length) → dot a (l1 ++ l2) = dot a l1\n  | [], _, _, _ => by simp [dot]\n  | p :: a, l1, l2, h => by\n    simp only [dot]\n    rw [dot_append a l1 l2 (fun q hq => h q (List.mem_cons_of_mem _ hq))]\n    have hp := h p List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hp]\n\n-- What a column may refer to: only earlier columns.\ndef Refs (n : Nat) : VDef → Prop\n  | .var _ => True\n  | .cell _ k => ∀ p ∈ k.coefs, p.1 < n\n  | .mono fs => ∀ f ∈ fs, f < n\n  | .term _ => True\n\ntheorem Refs.mono_le {n m : Nat} (h : n ≤ m) : ∀ {d : VDef}, Refs n d → Refs m d\n  | .var _, _ => trivial\n  | .cell _ _, hd => fun p hp => by have := hd p hp; omega\n  | .mono _, hd => fun f hf => by have := hd f hf; omega\n  | .term _, _ => trivial\n\ntheorem prodV_append_left (acc more : List Int) : ∀ fs : List Nat, (∀ f ∈ fs, f < acc.length) → prodV (acc ++ more) fs = prodV acc fs\n  | [], _ => rfl\n  | f :: fs, h => by\n    simp only [prodV]\n    rw [prodV_append_left acc more fs (fun g hg => h g (List.mem_cons_of_mem _ hg))]\n    have hf := h f List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hf]\n\ntheorem valD_append (env : Nat → Nat) (maps : Nat → Nat → Nat) (d : VDef) (acc more : List Int)\n    (h : Refs acc.length d) : valD env maps d (acc ++ more) = valD env maps d acc := by\n  cases d with\n  | var i => rfl\n  | cell m k => simp only [Refs] at h; simp only [valD, eval, dot_append k.coefs acc more h]\n  | mono fs => simp only [valD, prodV_append_left acc more fs h]\n  | term e => rfl\n\ndef Valid (env : Nat → Nat) (maps : Nat → Nat → Nat) (acc : List Int) (pre : List VDef) : Prop :=\n  acc.length = pre.length ∧ (∀ (j : Nat) (d : VDef), pre[j]? = some d → Refs j d) ∧\n    ∀ (j : Nat) (d : VDef), pre[j]? = some d → acc[j]? = some (valD env maps d acc)\n\ntheorem valid_snoc {env : Nat → Nat} {maps : Nat → Nat → Nat} {acc : List Int} {pre : List VDef} (d : VDef)\n    (hv : Valid env maps acc pre) (hd : Refs pre.length d) :\n    Valid env maps (acc ++ [valD env maps d acc]) (pre ++ [d]) := by\n  obtain ⟨hl, hw, hx⟩ := hv\n  refine ⟨by simp [hl], ?_, ?_⟩\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj; exact hw j d' hj\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      exact Refs.mono_le (by omega) hd\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj\n      rw [List.getElem?_append_left (by omega), hx j d' hj]\n      rw [valD_append env maps d' acc _ (Refs.mono_le (by omega) (hw j d' hj))]\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      rw [List.getElem?_append_right (by omega), show j - acc.length = 0 by omega]\n      simp only [List.getElem?_cons_zero, Option.some.injEq]\n      rw [valD_append env maps d acc _ (by rw [hl]; exact hd)]\n\ntheorem build_valid (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ (ds : List VDef) (acc : List Int) (pre : List VDef),\n    Valid env maps acc pre → wfTab pre.length ds = true → Valid env maps (build env maps ds acc) (pre ++ ds)\n  | [], acc, pre, hv, _ => by simpa [build] using hv\n  | d :: ds, acc, pre, hv, hw => by\n    have hd : Refs pre.length d ∧ wfTab (pre.length + 1) ds = true := by\n      cases d with\n      | var i => exact ⟨trivial, by simpa [wfTab] using hw⟩\n      | cell m k =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | mono fs =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | term e => exact ⟨trivial, by simpa [wfTab] using hw⟩\n    have := build_valid env maps ds _ (pre ++ [d]) (valid_snoc d hv hd.1) (by simpa using hd.2)\n    simpa [build] using this\n\ntheorem model_of_valid {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {tab : List VDef}\n    (hv : Valid env maps x tab) : Model tab env maps x := by\n  obtain ⟨hl, _, hx⟩ := hv\n  refine ⟨fun j d hj => by rw [List.getD_eq_getElem?_getD, hx j d hj]; rfl, fun j => ?_⟩\n  rw [List.getD_eq_getElem?_getD]\n  cases h : x[j]? with\n  | none => simp\n  | some v =>\n    have hj : j < tab.length := by\n      have := (List.getElem?_eq_some_iff.mp h).1; omega\n    obtain ⟨d, hd⟩ : ∃ d, tab[j]? = some d := ⟨tab[j], List.getElem?_eq_getElem hj⟩\n    rw [hx j d hd] at h\n    simp only [Option.some.injEq] at h; subst h\n    cases d <;> simp [valD]\n    exact Int.le_max_right _ _\n\n/-- The kernel's tree check is sound: an accepted goal's hypotheses hold for no naturals and no maps. -/\ntheorem sound (g : Goal) (t : Tree) (h : checkGoal g t = true) (env : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ¬ ∀ c ∈ g.hyps, evalC env maps c = true := by\n  intro hH\n  simp only [checkGoal, Bool.and_eq_true] at h\n  have hv := build_valid env maps g.tab [] [] ⟨rfl, by simp, by simp⟩ (by simpa using h.1)\n  simp only [List.nil_append] at hv\n  exact checkT_sound (model_of_valid hv) hH t [] (by simp [PathHolds]) h.2\n\n/-! Step machines with scalar state: the induction rule over kernel goals. The goals are built here, in Lean, from\nthe machine, so the TypeScript `obligations` is not trusted for these: a law holds at the start (`startGoal` is\nrefuted) and one step keeps every law (`stepGoal` is refuted, assuming them all and the request's assumption), so every\nlaw holds in every reachable state. Laws may not read the request's inputs. -/\n\ndef assoc (σ : List (Nat × E)) (i : Nat) : Option E := (lookup (fun p => p.1 == i) σ).map (·.2)\n\nmutual\ndef substE (σ : List (Nat × E)) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substE σ a) (substE σ b)\n  | .sub a b => .sub (substE σ a) (substE σ b)\n  | .mul k a => .mul k (substE σ a)\n  | .min a b => .min (substE σ a) (substE σ b)\n  | .max a b => .max (substE σ a) (substE σ b)\n  | .prod a b => .prod (substE σ a) (substE σ b)\n  | .ite c t f => .ite (substC σ c) (substE σ t) (substE σ f)\n  | .get m key => .get m (substE σ key)\ndef substC (σ : List (Nat × E)) : C → C\n  | .le a b => .le (substE σ a) (substE σ b)\n  | .lt a b => .lt (substE σ a) (substE σ b)\n  | .eq a b => .eq (substE σ a) (substE σ b)\n  | .and a b => .and (substC σ a) (substC σ b)\n  | .or a b => .or (substC σ a) (substC σ b)\n  | .not a => .not (substC σ a)\nend\n\n-- The environment after σ: each assigned variable takes its term's value, the rest keep theirs.\ndef applyS (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat :=\n  fun i => match assoc σ i with\n    | some e => evalE ρ maps e\n    | none => ρ i\n\nmutual\ntheorem subst_evalE (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → evalE ρ maps (substE σ e) = evalE (applyS σ ρ maps) maps e\n  | .var i => by\n    simp only [substE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substE, evalE]\n  | .add a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .sub a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .mul k a => by simp [substE, evalE, subst_evalE σ ρ maps a]\n  | .min a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .max a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .prod a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .ite c t f => by simp [substE, evalE, subst_evalC σ ρ maps c, subst_evalE σ ρ maps t, subst_evalE σ ρ maps f]\n  | .get m key => by simp [substE, evalE, subst_evalE σ ρ maps key]\ntheorem subst_evalC (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → evalC ρ maps (substC σ c) = evalC (applyS σ ρ maps) maps c\n  | .le a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .lt a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .eq a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .and a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .or a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .not a => by simp [substC, evalC, subst_evalC σ ρ maps a]\nend\n\nmutual\ndef occE (i : Nat) : E → Bool\n  | .var j => j == i\n  | .const _ => false\n  | .add a b => occE i a || occE i b\n  | .sub a b => occE i a || occE i b\n  | .mul _ a => occE i a\n  | .min a b => occE i a || occE i b\n  | .max a b => occE i a || occE i b\n  | .prod a b => occE i a || occE i b\n  | .ite c t f => occC i c || occE i t || occE i f\n  | .get _ key => occE i key\ndef occC (i : Nat) : C → Bool\n  | .le a b => occE i a || occE i b\n  | .lt a b => occE i a || occE i b\n  | .eq a b => occE i a || occE i b\n  | .and a b => occC i a || occC i b\n  | .or a b => occC i a || occC i b\n  | .not a => occC i a\nend\n\nmutual\ntheorem congrE (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → (∀ i, occE i e = true → ρ i = ρ' i) → evalE ρ maps e = evalE ρ' maps e\n  | .var j, h => by simp only [evalE]; exact h j (by simp [occE])\n  | .const n, _ => rfl\n  | .add a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .sub a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .mul k a, h => by simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi]))]\n  | .min a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .max a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .prod a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .ite c t f, h => by\n    simp only [evalE, congrC ρ ρ' maps c (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps t (fun i hi => h i (by simp [occE, hi])),\n      congrE ρ ρ' maps f (fun i hi => h i (by simp [occE, hi]))]\n  | .get m key, h => by simp only [evalE, congrE ρ ρ' maps key (fun i hi => h i (by simp [occE, hi]))]\ntheorem congrC (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → (∀ i, occC i c = true → ρ i = ρ' i) → evalC ρ maps c = evalC ρ' maps c\n  | .le a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .lt a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .eq a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .and a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .or a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .not a, h => by simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi]))]\nend\n\nstructure Machine where\n  inputs : List Nat\n  init : List (Nat × E)   -- each state variable's start, over the params\n  step : List (Nat × E)   -- each state variable after a request, over params, inputs and state\n  pre : C                 -- about the params alone: a precondition, so it holds at the start and at every step\n  assume : C              -- about each request (and the params); holds at a step, not at the start\n\n-- A request: its inputs replace those variables; nothing else changes until the step.\ndef withInputs (inputs : List Nat) (ρ ι : Nat → Nat) : Nat → Nat := fun i => if inputs.contains i then ι i else ρ i\n\ninductive Reach (m : Machine) (maps : Nat → Nat → Nat) : (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) : evalC ρ maps m.pre = true → Reach m maps (applyS m.init ρ maps)\n  | step (ρ ι : Nat → Nat) : Reach m maps ρ → evalC (withInputs m.inputs ρ ι) maps m.assume = true →\n      Reach m maps (applyS m.step (withInputs m.inputs ρ ι) maps)\n\ndef startGoal (m : Machine) (law : C) : List C := [m.pre, .not (substC m.init law)]\ndef stepGoal (m : Machine) (laws : List C) (law : C) : List C := [m.pre, m.assume] ++ laws ++ [.not (substC m.step law)]\n\n-- Per law: the law, then (table, tree) for its start goal and for its step goal.\nabbrev MachineProof := List (C × (List VDef × Tree) × (List VDef × Tree))\n\n-- None of `vs` occurs in c.\ndef avoids (vs : List Nat) (c : C) : Bool := vs.all fun i => !occC i c\n\n-- The precondition reads only params: no input, no variable the start or a step assigns.\ndef preOk (m : Machine) : Bool := avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre\n\ndef checkMachine (m : Machine) (ps : MachineProof) : Bool :=\n  preOk m && ps.all fun p => avoids m.inputs p.1\n    && checkGoal ⟨p.2.1.1, startGoal m p.1⟩ p.2.1.2\n    && checkGoal ⟨p.2.2.1, stepGoal m (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem avoids_occ {vs : List Nat} {c : C} (h : avoids vs c = true) {i : Nat} (hi : occC i c = true) : i ∉ vs := by\n  intro hm\n  simp only [avoids, List.all_eq_true] at h\n  have := h i hm; simp [hi] at this\n\ntheorem assoc_mem {σ : List (Nat × E)} {i : Nat} {e : E} (h : assoc σ i = some e) : i ∈ σ.map (·.1) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, _⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  simp only [beq_iff_eq] at hp\n  exact List.mem_map.mpr ⟨a, hm, hp⟩\n\n-- σ leaves every variable it doesn't assign alone.\ntheorem applyS_other {σ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    applyS σ ρ maps i = ρ i := by\n  simp only [applyS]\n  cases ha : assoc σ i with\n  | none => rfl\n  | some e => exact absurd (assoc_mem ha) h\n\ntheorem withInputs_other {inputs : List Nat} {i : Nat} (h : i ∉ inputs) (ρ ι : Nat → Nat) : withInputs inputs ρ ι i = ρ i := by\n  simp only [withInputs]; split\n  · rename_i hc; exact absurd (List.contains_iff_mem.mp hc) h\n  · rfl\n\n-- Conditions that avoid some variables read the same before and after anything that only changes those.\ntheorem evalC_avoids {vs : List Nat} {c : C} (h : avoids vs c = true) {ρ ρ' : Nat → Nat} (maps : Nat → Nat → Nat)\n    (hρ : ∀ i, i ∉ vs → ρ i = ρ' i) : evalC ρ maps c = evalC ρ' maps c :=\n  congrC ρ ρ' maps c (fun i hi => hρ i (avoids_occ h hi))\n\ntheorem pre_reach {m : Machine} (hp : preOk m = true) {maps : Nat → Nat → Nat} :\n    ∀ {ρ}, Reach m maps ρ → evalC ρ maps m.pre = true := by\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ maps)]; exact h0\n  | step ρ ι _ _ ih =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n/-- The induction rule: for params that meet the precondition, every law of an accepted machine proof holds in every\nreachable state, for any maps. -/\ntheorem machine_sound (m : Machine) (ps : MachineProof) (h : checkMachine m ps = true) (maps : Nat → Nat → Nat) :\n    ∀ ρ, Reach m maps ρ → ∀ l ∈ ps.map (·.1), evalC ρ maps l = true := by\n  simp only [checkMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨hpre, h⟩ := h\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).1.2 ρ maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [startGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · exact h0\n    · simp only [evalC, subst_evalC]; simpa using hf\n  | step ρ ι hr ha ih =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).2 (withInputs m.inputs ρ ι) maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [stepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with ((rfl | rfl) | hc) | rfl\n    · rw [evalC_avoids hpre maps (ρ' := ρ) (fun i hi => withInputs_other (fun h => hi (by simp [h])) ρ ι)]\n      exact pre_reach hpre hr\n    · exact ha\n    · obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hc\n      rw [evalC_avoids (h q hq).1.1 maps (ρ' := ρ) (fun i hi => withInputs_other hi ρ ι)]\n      exact ih q.1 (List.mem_map.mpr ⟨q, hq, rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa using hf\n\n/-! Loops: termination. A loop runs `body` while `guard` holds, each turn reading fresh inputs that meet `assume`. That it\nhalts is a liveness of its machine (Live.lean's Loop.machine and loop_halts_of): from anywhere, the guard fails later. -/\n\nstructure Loop where\n  inputs : List Nat\n  init : List (Nat × E)\n  body : List (Nat × E)\n  guard : C               -- while\n  pre : C                 -- about the params alone\n  assume : C              -- about each turn's inputs\n\n-- One turn: some inputs meeting the assumption, the guard holds, the body runs.\ndef Turn (l : Loop) (maps : Nat → Nat → Nat) (ρ ρ' : Nat → Nat) : Prop :=\n  ∃ ι, evalC (withInputs l.inputs ρ ι) maps l.guard = true ∧ evalC (withInputs l.inputs ρ ι) maps l.assume = true ∧\n    ρ' = applyS l.body (withInputs l.inputs ρ ι) maps\n\n/-! Folds over binary trees: structural induction. Each leaf and node carries its own inputs; a leaf's state comes from\nits inputs, a node's from its children's (read through copies of the state variables, one per side) and its inputs.\nThe goals are built here: each law holds at every leaf, and at a node whenever every law holds at both children. -/\n\nstructure Fold where\n  inputs : List Nat\n  state : List (Nat × Nat × Nat)   -- a state variable, its copy for the left child, its copy for the right child\n  leaf : List (Nat × E)\n  node : List (Nat × E)\n  pre : C\n  assume : C\n\ninductive BTree where\n  | leaf (ι : Nat → Nat)\n  | node (ι : Nat → Nat) (l r : BTree)\n\n-- A node's environment: each copy reads the child's state variable.\ndef withChildren (f : Fold) (env a b : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun e => e.2.1 == i) f.state with\n  | some e => a e.1\n  | none => match lookup (fun e => e.2.2 == i) f.state with\n    | some e => b e.1\n    | none => env i\n\ndef foldT (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Nat → Nat\n  | .leaf ι => applyS f.leaf (withInputs f.inputs ρ ι) maps\n  | .node ι l r => applyS f.node (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps\n\n-- Every leaf's and node's inputs meet the assumption.\ndef Allowed (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Prop\n  | .leaf ι => evalC (withInputs f.inputs ρ ι) maps f.assume = true\n  | .node ι l r => evalC (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps f.assume = true\n      ∧ Allowed f ρ maps l ∧ Allowed f ρ maps r\n\ndef leftSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.1)\ndef rightSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.2)\n\ndef leafGoal (f : Fold) (law : C) : List C := [f.pre, f.assume, .not (substC f.leaf law)]\ndef nodeGoal (f : Fold) (laws : List C) (law : C) : List C :=\n  [f.pre, f.assume] ++ laws.flatMap (fun h => [substC (leftSub f) h, substC (rightSub f) h]) ++ [.not (substC f.node law)]\n\n-- Variables a fold changes or reads per tree: inputs, the copies, and whatever a leaf or node assigns.\ndef touched (f : Fold) : List Nat :=\n  f.inputs ++ f.state.map (·.2.1) ++ f.state.map (·.2.2) ++ f.leaf.map (·.1) ++ f.node.map (·.1)\n-- Copies name one state variable each, and no right copy is a left copy.\ndef copiesOk (f : Fold) : Bool :=\n  f.state.all fun e => f.state.all fun e' => (e.2.1 != e'.2.1 || e.1 == e'.1) && (e.2.2 != e'.2.2 || e.1 == e'.1) && e.2.2 != e'.2.1\n\n-- Per law: the law, then (table, tree) for its leaf goal and its node goal.\nabbrev FoldProof := MachineProof\n\ndef checkFold (f : Fold) (ps : FoldProof) : Bool :=\n  copiesOk f && avoids (touched f) f.pre\n    && ps.all fun p => avoids ((touched f).filter fun i => !(f.state.map (·.1)).contains i) p.1\n      && checkGoal ⟨p.2.1.1, leafGoal f p.1⟩ p.2.1.2\n      && checkGoal ⟨p.2.2.1, nodeGoal f (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem lookup_none {α : Type} {p : α → Bool} {l : List α} (h : ∀ a ∈ l, p a = false) : lookup p l = none := by\n  cases hl : lookup p l with\n  | none => rfl\n  | some a => have := lookup_some hl; simp [h a this.1] at this\n\ntheorem lookup_none_all {α : Type} {p : α → Bool} : ∀ {l : List α}, lookup p l = none → ∀ a ∈ l, p a = false\n  | [], _, a, ha => by simp at ha\n  | b :: bs, h, a, ha => by\n    simp only [lookup] at h\n    split at h\n    · simp at h\n    · rcases List.mem_cons.mp ha with rfl | ha\n      · simpa using (by assumption : ¬ p a = true)\n      · exact lookup_none_all h a ha\n\ntheorem withChildren_plain (f : Fold) (env a b : Nat → Nat) {i : Nat} (hl : i ∉ f.state.map (·.2.1))\n    (hr : i ∉ f.state.map (·.2.2)) : withChildren f env a b i = env i := by\n  simp only [withChildren]\n  rw [lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hl (List.mem_map.mpr ⟨e, he, h⟩)),\n    lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hr (List.mem_map.mpr ⟨e, he, h⟩))]\n\ntheorem withChildren_left {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.1 = a e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  cases h : lookup (fun e' => e'.2.1 == e.2.1) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.1\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem withChildren_right {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.2 = b e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  rw [lookup_none (fun e' he' => by simp only [beq_eq_false_iff_ne]; intro h; exact (hc e he e' he').2 h.symm)]\n  cases h : lookup (fun e' => e'.2.2 == e.2.2) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.2\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem foldT_other (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) {i : Nat} (hi : i ∉ touched f) :\n    ∀ t, foldT f ρ maps t i = ρ i\n  | .leaf ι => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n  | .node ι l r => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h]))\n      (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n\ntheorem assoc_map {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} {x : E}\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = some x) : ∃ e ∈ s, e.1 = i ∧ x = .var (g e) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, rfl⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hm\n  simp only [beq_iff_eq] at hp\n  exact ⟨e, he, hp, rfl⟩\n\ntheorem assoc_map_none {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∉ s.map (·.1)) :\n    assoc (s.map fun e => (e.1, E.var (g e))) i = none := by\n  cases h : assoc (s.map fun e => (e.1, E.var (g e))) i with\n  | none => rfl\n  | some x => obtain ⟨e, he, rfl, -⟩ := assoc_map h; exact absurd (List.mem_map.mpr ⟨e, he, rfl⟩) hi\n\ntheorem assoc_map_some {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∈ s.map (·.1))\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = none) : False := by\n  simp only [assoc, Option.map_eq_none_iff] at h\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hi\n  have := lookup_none_all h (e.1, E.var (g e)) (List.mem_map.mpr ⟨e, he, rfl⟩)\n  simp at this\n\n-- With no assumption (the trivially true one), every tree is allowed.\ntheorem allowed_trivial (f : Fold) (h : f.assume = .le (.const 0) (.const 0)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ∀ t, Allowed f ρ maps t\n  | .leaf ι => by simp [Allowed, h, evalC, evalE]\n  | .node ι l r => ⟨by simp [h, evalC, evalE], allowed_trivial f h ρ maps l, allowed_trivial f h ρ maps r⟩\n\n/-- Structural induction: for params that meet the precondition, every law of an accepted fold proof holds of every\ntree whose inputs meet the assumption, for any maps. -/\ntheorem fold_sound (f : Fold) (ps : FoldProof) (h : checkFold f ps = true) (maps : Nat → Nat → Nat) (ρ : Nat → Nat)\n    (h0 : evalC ρ maps f.pre = true) : ∀ t, Allowed f ρ maps t → ∀ l ∈ ps.map (·.1), evalC (foldT f ρ maps t) maps l = true := by\n  simp only [checkFold, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hc, hpre⟩, h⟩ := h\n  have preAt : ∀ env : Nat → Nat, (∀ i, i ∉ touched f → env i = ρ i) → evalC env maps f.pre = true := fun env he => by\n    rw [evalC_avoids hpre maps (ρ' := ρ) he]; exact h0\n  -- What a law reads: the state variables, or variables no tree changes.\n  have reads : ∀ q ∈ ps, ∀ i, occC i q.1 = true → i ∈ f.state.map (·.1) ∨ i ∉ touched f := by\n    intro q hq i hi\n    by_cases hs : i ∈ f.state.map (·.1)\n    · exact Or.inl hs\n    · refine Or.inr fun ht => avoids_occ (h q hq).1.1 hi ?_\n      simp only [List.mem_filter, ht, true_and, Bool.not_eq_true', List.contains_iff_mem]\n      simpa using hs\n  intro t\n  induction t with\n  | leaf ι =>\n    intro ha l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).1.2 (withInputs f.inputs ρ ι) maps\n    intro c hc\n    simp only [leafGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl | rfl\n    · exact preAt _ (fun i hi => withInputs_other (fun h => hi (by simp [touched, h])) ρ ι)\n    · exact ha\n    · simp only [evalC, subst_evalC]; simpa [foldT] using hn\n  | node ι lt rt ihl ihr =>\n    intro ha l hl\n    obtain ⟨hA, hal, har⟩ := ha\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    let Env := withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps lt) (foldT f ρ maps rt)\n    -- A law at a child, read through that side's copies.\n    have side : ∀ (g : Nat × Nat × Nat → Nat) (child : BTree),\n        (∀ e ∈ f.state, Env (g e) = foldT f ρ maps child e.1) → ∀ q ∈ ps,\n        evalC Env maps (substC (f.state.map fun e => (e.1, E.var (g e))) q.1) = evalC (foldT f ρ maps child) maps q.1 := by\n      intro g child hg q hq\n      rw [subst_evalC]\n      refine congrC _ _ maps q.1 (fun i hi => ?_)\n      cases hx : assoc (f.state.map fun e => (e.1, E.var (g e))) i with\n      | some x =>\n        obtain ⟨e, he, rfl, rfl⟩ := assoc_map hx\n        simp only [applyS, hx, evalE]; exact hg e he\n      | none =>\n        have hs : i ∉ f.state.map (·.1) := fun hm => assoc_map_some (g := g) hm hx\n        have ht : i ∉ touched f := (reads q hq i hi).resolve_left hs\n        simp only [applyS, hx, Env]\n        rw [withChildren_plain _ _ _ _ (fun h => ht (by simp [touched, h])) (fun h => ht (by simp [touched, h])),\n          withInputs_other (fun h => ht (by simp [touched, h])), foldT_other f ρ maps ht]\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).2 Env maps\n    intro c hc'\n    simp only [nodeGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false,\n      List.mem_flatMap] at hc'\n    rcases hc' with ((rfl | rfl) | ⟨q, hq, hcq⟩) | rfl\n    · exact preAt Env (fun i hi => by\n        simp only [Env]\n        rw [withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h])) (fun h => hi (by simp [touched, h])),\n          withInputs_other (fun h => hi (by simp [touched, h]))])\n    · exact hA\n    · obtain ⟨q', hq', rfl⟩ := List.mem_map.mp hq\n      rcases hcq with rfl | rfl\n      · simp only [leftSub]\n        rw [side (·.2.1) lt (fun e he => withChildren_left hc _ _ _ he) q' hq']\n        exact ihl hal _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n      · simp only [rightSub]\n        rw [side (·.2.2) rt (fun e he => withChildren_right hc _ _ _ he) q' hq']\n        exact ihr har _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa [foldT, Env] using hn\n\n/-! Step machines with maps. A step may write each map at one key (read-over-write: a read after the step is the\nwritten value at the written key, the old cell elsewhere). A law may hold at every key: it is proven at a fresh skolem\nvariable and assumed, before the step, at whatever keys the proof names (instantiating ∀ is sound at any term). The\ngoals are built here, as for scalar machines. -/\n\nmutual\ndef readsE : E → Bool\n  | .var _ => false\n  | .const _ => false\n  | .add a b => readsE a || readsE b\n  | .sub a b => readsE a || readsE b\n  | .mul _ a => readsE a\n  | .min a b => readsE a || readsE b\n  | .max a b => readsE a || readsE b\n  | .prod a b => readsE a || readsE b\n  | .ite c t f => readsC c || readsE t || readsE f\n  | .get _ _ => true\ndef readsC : C → Bool\n  | .le a b => readsE a || readsE b\n  | .lt a b => readsE a || readsE b\n  | .eq a b => readsE a || readsE b\n  | .and a b => readsC a || readsC b\n  | .or a b => readsC a || readsC b\n  | .not a => readsC a\nend\n\nmutual\ntheorem noReadsE (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (e : E) → readsE e = false → evalE ρ M e = evalE ρ M' e\n  | .var _, _ => rfl\n  | .const _, _ => rfl\n  | .add a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .sub a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .mul _ a, h => by simp only [readsE] at h; simp only [evalE, noReadsE ρ M M' a h]\n  | .min a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .max a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .prod a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .ite c t f, h => by\n    simp only [readsE, Bool.or_eq_false_iff] at h\n    simp only [evalE, noReadsC ρ M M' c h.1.1, noReadsE ρ M M' t h.1.2, noReadsE ρ M M' f h.2]\n  | .get _ _, h => by simp [readsE] at h\ntheorem noReadsC (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (c : C) → readsC c = false → evalC ρ M c = evalC ρ M' c\n  | .le a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .lt a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .eq a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .and a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .or a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .not a, h => by simp only [readsC] at h; simp only [evalC, noReadsC ρ M M' a h]\nend\n\n-- Substitution of variables by σ and of each read by `rd` (applied to the substituted key).\nmutual\ndef substRE (σ : List (Nat × E)) (rd : Nat → E → E) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substRE σ rd a) (substRE σ rd b)\n  | .sub a b => .sub (substRE σ rd a) (substRE σ rd b)\n  | .mul k a => .mul k (substRE σ rd a)\n  | .min a b => .min (substRE σ rd a) (substRE σ rd b)\n  | .max a b => .max (substRE σ rd a) (substRE σ rd b)\n  | .prod a b => .prod (substRE σ rd a) (substRE σ rd b)\n  | .ite c t f => .ite (substRC σ rd c) (substRE σ rd t) (substRE σ rd f)\n  | .get m key => rd m (substRE σ rd key)\ndef substRC (σ : List (Nat × E)) (rd : Nat → E → E) : C → C\n  | .le a b => .le (substRE σ rd a) (substRE σ rd b)\n  | .lt a b => .lt (substRE σ rd a) (substRE σ rd b)\n  | .eq a b => .eq (substRE σ rd a) (substRE σ rd b)\n  | .and a b => .and (substRC σ rd a) (substRC σ rd b)\n  | .or a b => .or (substRC σ rd a) (substRC σ rd b)\n  | .not a => .not (substRC σ rd a)\nend\n\nsection\nvariable (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M M' : Nat → Nat → Nat)\n  (hrd : ∀ m k, evalE W M (rd m k) = M' m (evalE W M k))\ninclude hrd\nmutual\ntheorem substR_evalE : (e : E) → evalE W M (substRE σ rd e) = evalE (applyS σ W M) M' e\n  | .var i => by\n    simp only [substRE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substRE, evalE]\n  | .add a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .sub a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .mul k a => by simp [substRE, evalE, substR_evalE a]\n  | .min a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .max a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .prod a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .ite c t f => by simp [substRE, evalE, substR_evalC c, substR_evalE t, substR_evalE f]\n  | .get m key => by simp only [substRE, evalE, hrd, substR_evalE key]\ntheorem substR_evalC : (c : C) → evalC W M (substRC σ rd c) = evalC (applyS σ W M) M' c\n  | .le a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .lt a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .eq a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .and a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .or a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .not a => by simp [substRC, evalC, substR_evalC a]\nend\nend\n\nstructure MMachine where\n  inputs : List Nat\n  init : List (Nat × E)\n  maps0 : List (Nat × Nat)       -- each map's value at every key at the start\n  step : List (Nat × E)\n  writes : List (Nat × E × E)    -- a map, the key it's written at and the value, over the state before the step\n  pre : C                        -- about the params alone, reading no map\n  assume : C                     -- about each request\n\ndef writeMaps (ws : List (Nat × E × E)) (W : Nat → Nat) (M : Nat → Nat → Nat) : Nat → Nat → Nat := fun m key =>\n  match lookup (fun w => w.1 == m) ws with\n  | some w => if key = evalE W M w.2.1 then evalE W M w.2.2 else M m key\n  | none => M m key\n\ndef StartMaps (m : MMachine) (M : Nat → Nat → Nat) : Prop := ∀ p ∈ m.maps0, ∀ key, M p.1 key = p.2\n\ninductive MReach (m : MMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps m M → evalC ρ M m.pre = true → MReach m (applyS m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : MReach m ρ M →\n      evalC (withInputs m.inputs ρ ι) M m.assume = true →\n      MReach m (applyS m.step (withInputs m.inputs ρ ι) M) (writeMaps m.writes (withInputs m.inputs ρ ι) M)\n\ndef upd (ρ : Nat → Nat) (i v : Nat) : Nat → Nat := fun j => if j = i then v else ρ j\n\n-- A law, and for a law about every key, the variable it holds at.\nstructure MLaw where\n  holds : C\n  key : Option Nat\n\ndef MLaw.Holds (l : MLaw) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop :=\n  match l.key with\n  | none => evalC ρ M l.holds = true\n  | some kv => ∀ v, evalC (upd ρ kv v) M l.holds = true\n\ndef rdStart (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun p => p.1 == mp) m.maps0 with\n  | some p => .const p.2\n  | none => .get mp k\ndef rdStep (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) m.writes with\n  | some w => .ite (.eq k w.2.1) w.2.2 (.get mp k)\n  | none => .get mp k\n\n-- What a goal proves: the law, at the skolem variable if it holds at every key.\ndef goalOf (l : MLaw) (sk : Nat) : C :=\n  match l.key with\n  | none => l.holds\n  | some kv => substC [(kv, .var sk)] l.holds\n\nstructure MEntry where\n  law : MLaw\n  sk : Nat                    -- the skolem variable\n  insts : List (Nat × E)      -- (law index, key): where the step goal assumes the laws about every key\n  start : List VDef × Tree\n  step : List VDef × Tree\n\ndef scalarHyps (laws : List MLaw) : List C := laws.filterMap fun l =>\n  match l.key with\n  | none => some l.holds\n  | some _ => none\ndef instHyps (laws : List MLaw) (insts : List (Nat × E)) : List C := insts.filterMap fun p =>\n  match laws[p.1]? with\n  | some l => match l.key with\n    | some kv => some (substC [(kv, p.2)] l.holds)\n    | none => none\n  | none => none\n\ndef mStartGoal (m : MMachine) (e : MEntry) : List C := [m.pre, .not (substRC m.init (rdStart m) (goalOf e.law e.sk))]\ndef mStepGoal (m : MMachine) (laws : List MLaw) (e : MEntry) : List C :=\n  [m.pre, m.assume] ++ scalarHyps laws ++ instHyps laws e.insts ++ [.not (substRC m.step (rdStep m) (goalOf e.law e.sk))]\n\n-- The skolem is fresh: no input or state variable, and nothing the machine or a law reads.\ndef skOk (m : MMachine) (laws : List MLaw) (sk : Nat) : Bool :=\n  !(m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)).contains sk && !occC sk m.pre && !occC sk m.assume\n    && laws.all (fun l => !occC sk l.holds) && m.init.all (fun p => !occE sk p.2) && m.step.all (fun p => !occE sk p.2)\n    && m.writes.all (fun w => !occE sk w.2.1 && !occE sk w.2.2)\n\ndef checkMMachine (m : MMachine) (ps : List MEntry) : Bool :=\n  avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre && !readsC m.pre\n    && ps.all fun e => avoids m.inputs e.law.holds && skOk m (ps.map (·.law)) e.sk\n      && checkGoal ⟨e.start.1, mStartGoal m e⟩ e.start.2\n      && checkGoal ⟨e.step.1, mStepGoal m (ps.map (·.law)) e⟩ e.step.2\n\ntheorem occ_false {i : Nat} {c : C} (h : (!occC i c) = true) : occC i c = false := by simpa using h\n\n-- A law reads the same at the skolem as it holds at every key.\ntheorem goalOf_holds (l : MLaw) {sk : Nat} (hs : occC sk l.holds = false) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    (∀ v, evalC (upd ρ sk v) M (goalOf l sk) = true) → l.Holds ρ M := by\n  intro h\n  unfold MLaw.Holds\n  unfold goalOf at h\n  split\n  · rename_i hk\n    simp only [hk] at h\n    have := h 0\n    rwa [congrC _ ρ M l.holds (fun i hi => by simp only [upd]; split <;> simp_all)] at this\n  · rename_i kv hk\n    simp only [hk] at h\n    intro v\n    have := h v\n    rw [subst_evalC] at this\n    rwa [congrC _ (upd ρ kv v) M l.holds (fun i hi => by\n      simp only [applyS, assoc, lookup, upd]\n      by_cases hik : i = kv\n      · subst hik; simp [evalE, upd]\n      · have hb : (kv == i) = false := by simp; omega\n        simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik]\n        split <;> simp_all)] at this\n\ntheorem pre_mreach {m : MMachine} (hp : avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre = true)\n    (hr : readsC m.pre = false) : ∀ {ρ M}, MReach m ρ M → evalC ρ M m.pre = true := by\n  intro ρ M h\n  induction h with\n  | start ρ M _ h0 =>\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M)]; exact h0\n  | step ρ M ι _ _ ih =>\n    rw [noReadsC _ _ M m.pre hr]\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n-- With a fresh skolem, σ commutes with setting it.\ntheorem applyS_upd {σ : List (Nat × E)} {sk : Nat} (hk : sk ∉ σ.map (·.1)) (he : σ.all (fun p => !occE sk p.2) = true)\n    (W : Nat → Nat) (M : Nat → Nat → Nat) (v : Nat) : applyS σ (upd W sk v) M = upd (applyS σ W M) sk v := by\n  funext i\n  simp only [upd]\n  by_cases hi : i = sk\n  · subst hi; rw [applyS_other hk]; simp [upd]\n  · simp only [hi, ite_false, applyS]\n    cases h : assoc σ i with\n    | none => simp [upd, hi]\n    | some e =>\n      simp only [assoc, Option.map_eq_some_iff] at h\n      obtain ⟨p, hp, rfl⟩ := h\n      have hm := (lookup_some hp).1\n      simp only [List.all_eq_true] at he\n      have := he p hm\n      exact congrE _ _ M p.2 (fun j hj => by simp only [upd]; split <;> simp_all)\n\n/-- The induction rule with maps: for params that meet the precondition and maps that start as declared, every law of\nan accepted proof holds in every reachable state (a law about every key, at every key). -/\ntheorem mmachine_sound (m : MMachine) (ps : List MEntry) (h : checkMMachine m ps = true) :\n    ∀ ρ M, MReach m ρ M → ∀ e ∈ ps, e.law.Holds ρ M := by\n  simp only [checkMMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hpre, hrp⟩, h⟩ := h\n  simp only [Bool.not_eq_true'] at hrp\n  have hsk : ∀ e ∈ ps, _ := fun e he => (h e he).1.1.2\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 =>\n    intro e he\n    obtain ⟨⟨⟨_, hs⟩, hst⟩, _⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, _⟩, hslaw⟩, hsinit⟩, _⟩, _⟩ := hs\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ M (fun v => ?_)\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd ρ e.sk v) M\n    intro c hc\n    simp only [mStartGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by simp only [upd]; split <;> simp_all)]; exact h0\n    · have hrd : ∀ mp k, evalE (upd ρ e.sk v) M (rdStart m mp k) = M mp (evalE (upd ρ e.sk v) M k) := by\n        intro mp k\n        simp only [rdStart]\n        split\n        · rename_i p hp\n          have ⟨hm, hq⟩ := lookup_some hp\n          simp only [beq_iff_eq] at hq\n          simp only [evalE]; rw [← hq, hM p hm]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M M hrd]\n      rw [applyS_upd (fun h => by simp [h] at hfresh) (by simpa [List.all_eq_true] using hsinit)]\n      simpa using hn\n  | step ρ M ι hr ha ih =>\n    intro e he\n    obtain ⟨⟨⟨hin, hs⟩, _⟩, hst⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, hsas⟩, hslaw⟩, _⟩, hsstep⟩, hsw⟩ := hs\n    have hfresh' : e.sk ∉ m.inputs ∧ e.sk ∉ m.step.map (·.1) := by\n      constructor <;> intro hm <;> simp [hm] at hfresh\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ _ (fun v => ?_)\n    let W0 := withInputs m.inputs ρ ι\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd W0 e.sk v) M\n    -- Reading a law about the state before the step, at the goal's environment.\n    have before : ∀ (l : MLaw), l ∈ ps.map (·.law) → ∀ (g : Nat → Nat), (∀ i, i ∉ m.inputs → i ≠ e.sk → g i = ρ i) →\n        avoids m.inputs l.holds = true → occC e.sk l.holds = false → ∀ c, c = l.holds → evalC g M c = evalC ρ M l.holds := by\n      intro l _ g hg hl hsl c hc; subst hc\n      exact congrC _ _ M l.holds (fun i hi => hg i (avoids_occ hl hi) (by intro h'; subst h'; simp [hsl] at hi))\n    intro c hc\n    simp only [mStepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with (((rfl | rfl) | hc) | hc) | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by\n        simp only [upd, W0]\n        split\n        · rename_i h'; subst h'; simp [hspre] at hi\n        · exact withInputs_other (fun hm => avoids_occ hpre hi (by simp [hm])) ρ ι)]\n      exact pre_mreach hpre hrp hr\n    · rw [congrC _ W0 M m.assume (fun i hi => by simp only [upd]; split <;> simp_all)]; exact ha\n    · simp only [scalarHyps, List.mem_filterMap] at hc\n      obtain ⟨l, hl, hk⟩ := hc\n      split at hk\n      · rename_i hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl\n        have := ih e' he'\n        simp only [MLaw.Holds, hkey] at this\n        rw [before e'.law hl _ (fun i hi hs' => by simp only [upd, hs', ite_false, W0]; exact withInputs_other hi ρ ι)\n          (h e' he').1.1.1 (by simpa using hslaw e'.law hl) _ rfl]\n        exact this\n      · simp at hk\n    · simp only [instHyps, List.mem_filterMap] at hc\n      obtain ⟨p, _, hk⟩ := hc\n      split at hk\n      · rename_i l hl\n        split at hk\n        · rename_i kv hkey\n          simp only [Option.some.injEq] at hk; subst hk\n          have hlm : l ∈ ps.map (·.law) := List.mem_of_getElem? hl\n          obtain ⟨e', he', rfl⟩ := List.mem_map.mp hlm\n          have := ih e' he'\n          simp only [MLaw.Holds, hkey] at this\n          rw [subst_evalC]\n          have hsl : occC e.sk e'.law.holds = false := by simpa using hslaw e'.law hlm\n          rw [congrC _ (upd ρ kv (evalE (upd W0 e.sk v) M p.2)) M e'.law.holds (fun i hi => by\n            simp only [applyS, assoc, lookup, upd]\n            by_cases hik : i = kv\n            · subst hik; simp\n            · have hb : (kv == i) = false := by simp; omega\n              have hs' : i ≠ e.sk := by intro h'; subst h'; simp [hsl] at hi\n              simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik, hs', W0]\n              exact withInputs_other (avoids_occ (h e' he').1.1.1 hi) ρ ι)]\n          exact this _\n        · simp at hk\n      · simp at hk\n    · have hrd : ∀ mp k, evalE (upd W0 e.sk v) M (rdStep m mp k) = writeMaps m.writes W0 M mp (evalE (upd W0 e.sk v) M k) := by\n        intro mp k\n        simp only [rdStep, writeMaps]\n        split\n        · rename_i w hw\n          have hm := (lookup_some hw).1\n          have h1 := hsw w hm\n          try simp only [Bool.and_eq_true, Bool.not_eq_true'] at h1\n          have e1 : evalE (upd W0 e.sk v) M w.2.1 = evalE W0 M w.2.1 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          have e2 : evalE (upd W0 e.sk v) M w.2.2 = evalE W0 M w.2.2 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          simp only [evalE, evalC, e1, e2]\n          by_cases hk : evalE (upd W0 e.sk v) M k = evalE W0 M w.2.1 <;> simp [hk]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M _ hrd]\n      rw [applyS_upd hfresh'.2 (by simpa [List.all_eq_true] using hsstep)]\n      simpa using hn\n\nend Kern\n\n#print axioms Kern.sound\n#print axioms Kern.machine_sound\n#print axioms Kern.fold_sound\n#print axioms Kern.mmachine_sound\n",
+    "Kernel.lean": "import Cert\n/-!\nKernel: the Lean twin of gdp-wired's kernel/kernel.ts tree check, with its soundness proof. Lean 4.34.0, core only.\n\nA goal is a variable table and hypotheses over naturals (+, ∸, × by a constant, min, max, if, map reads; ≤, <, =,\nand, or, not). A proof is a tree of splits on linear atoms, with a leaf certificate: the rows it claims, a Cert\nderivation over them, and the pairs of cells it claims equal. At a leaf the twin computes the rows the path, the\nhypotheses' facts, the naturals and the verified cell equalities give, checks every claimed row is one of them, and\nreplays the derivation with `Cert.check`. `sound`: if `checkGoal` accepts, no naturals and no maps satisfy every\nhypothesis.\n\nThe table names what each column of a row is: a variable of the environment, or a map's cell at a key (a row over\nearlier columns). Rows compare by coefficients (`same`), so the exporter's ordering doesn't matter.\n-/\n\nnamespace Kern\nopen Cert\nset_option linter.unusedSimpArgs false\nset_option linter.unusedSectionVars false\n\nmutual\ninductive E where\n  | var (i : Nat)\n  | const (n : Nat)\n  | add (a b : E)\n  | sub (a b : E)\n  | mul (k : Nat) (a : E)\n  | min (a b : E)\n  | max (a b : E)\n  | prod (a b : E)\n  | ite (c : C) (t f : E)\n  | get (m : Nat) (key : E)\ninductive C where\n  | le (a b : E)\n  | lt (a b : E)\n  | eq (a b : E)\n  | and (a b : C)\n  | or (a b : C)\n  | not (a : C)\nend\n\nderiving instance DecidableEq for E, C\n\n/-! Boolean equality of terms and conditions, by structure: what a check compares terms with (the derived DecidableEq\nbuilds a proof at each comparison, which the kernel then reduces). -/\n\nmutual\ndef beqE : E → E → Bool\n  | .var x0, .var y0 => x0 == y0\n  | .const x0, .const y0 => x0 == y0\n  | .add x0 x1, .add y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .sub x0 x1, .sub y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .mul x0 x1, .mul y0 y1 => x0 == y0 && beqE x1 y1\n  | .min x0 x1, .min y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .max x0 x1, .max y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .prod x0 x1, .prod y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .ite x0 x1 x2, .ite y0 y1 y2 => beqC x0 y0 && beqE x1 y1 && beqE x2 y2\n  | .get x0 x1, .get y0 y1 => x0 == y0 && beqE x1 y1\n  | _, _ => false\ndef beqC : C → C → Bool\n  | .le x0 x1, .le y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .lt x0 x1, .lt y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .eq x0 x1, .eq y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .and x0 x1, .and y0 y1 => beqC x0 y0 && beqC x1 y1\n  | .or x0 x1, .or y0 y1 => beqC x0 y0 && beqC x1 y1\n  | .not x0, .not y0 => beqC x0 y0\n  | _, _ => false\nend\n\nmutual\ntheorem beqE_eq : ∀ {a b : E}, beqE a b = true → a = b\n  | .var x0, .var y0, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h]\n  | .const x0, .const y0, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h]\n  | .add x0 x1, .add y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .sub x0 x1, .sub y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .mul x0 x1, .mul y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h.1, beqE_eq h.2]\n  | .min x0 x1, .min y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .max x0 x1, .max y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .prod x0 x1, .prod y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .ite x0 x1 x2, .ite y0 y1 y2, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1.1, beqE_eq h.1.2, beqE_eq h.2]\n  | .get x0 x1, .get y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h.1, beqE_eq h.2]\n  | .var _, .const _, h => by simp [beqE] at h\n  | .var _, .add _ _, h => by simp [beqE] at h\n  | .var _, .sub _ _, h => by simp [beqE] at h\n  | .var _, .mul _ _, h => by simp [beqE] at h\n  | .var _, .min _ _, h => by simp [beqE] at h\n  | .var _, .max _ _, h => by simp [beqE] at h\n  | .var _, .prod _ _, h => by simp [beqE] at h\n  | .var _, .ite _ _ _, h => by simp [beqE] at h\n  | .var _, .get _ _, h => by simp [beqE] at h\n  | .const _, .var _, h => by simp [beqE] at h\n  | .const _, .add _ _, h => by simp [beqE] at h\n  | .const _, .sub _ _, h => by simp [beqE] at h\n  | .const _, .mul _ _, h => by simp [beqE] at h\n  | .const _, .min _ _, h => by simp [beqE] at h\n  | .const _, .max _ _, h => by simp [beqE] at h\n  | .const _, .prod _ _, h => by simp [beqE] at h\n  | .const _, .ite _ _ _, h => by simp [beqE] at h\n  | .const _, .get _ _, h => by simp [beqE] at h\n  | .add _ _, .var _, h => by simp [beqE] at h\n  | .add _ _, .const _, h => by simp [beqE] at h\n  | .add _ _, .sub _ _, h => by simp [beqE] at h\n  | .add _ _, .mul _ _, h => by simp [beqE] at h\n  | .add _ _, .min _ _, h => by simp [beqE] at h\n  | .add _ _, .max _ _, h => by simp [beqE] at h\n  | .add _ _, .prod _ _, h => by simp [beqE] at h\n  | .add _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .add _ _, .get _ _, h => by simp [beqE] at h\n  | .sub _ _, .var _, h => by simp [beqE] at h\n  | .sub _ _, .const _, h => by simp [beqE] at h\n  | .sub _ _, .add _ _, h => by simp [beqE] at h\n  | .sub _ _, .mul _ _, h => by simp [beqE] at h\n  | .sub _ _, .min _ _, h => by simp [beqE] at h\n  | .sub _ _, .max _ _, h => by simp [beqE] at h\n  | .sub _ _, .prod _ _, h => by simp [beqE] at h\n  | .sub _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .sub _ _, .get _ _, h => by simp [beqE] at h\n  | .mul _ _, .var _, h => by simp [beqE] at h\n  | .mul _ _, .const _, h => by simp [beqE] at h\n  | .mul _ _, .add _ _, h => by simp [beqE] at h\n  | .mul _ _, .sub _ _, h => by simp [beqE] at h\n  | .mul _ _, .min _ _, h => by simp [beqE] at h\n  | .mul _ _, .max _ _, h => by simp [beqE] at h\n  | .mul _ _, .prod _ _, h => by simp [beqE] at h\n  | .mul _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .mul _ _, .get _ _, h => by simp [beqE] at h\n  | .min _ _, .var _, h => by simp [beqE] at h\n  | .min _ _, .const _, h => by simp [beqE] at h\n  | .min _ _, .add _ _, h => by simp [beqE] at h\n  | .min _ _, .sub _ _, h => by simp [beqE] at h\n  | .min _ _, .mul _ _, h => by simp [beqE] at h\n  | .min _ _, .max _ _, h => by simp [beqE] at h\n  | .min _ _, .prod _ _, h => by simp [beqE] at h\n  | .min _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .min _ _, .get _ _, h => by simp [beqE] at h\n  | .max _ _, .var _, h => by simp [beqE] at h\n  | .max _ _, .const _, h => by simp [beqE] at h\n  | .max _ _, .add _ _, h => by simp [beqE] at h\n  | .max _ _, .sub _ _, h => by simp [beqE] at h\n  | .max _ _, .mul _ _, h => by simp [beqE] at h\n  | .max _ _, .min _ _, h => by simp [beqE] at h\n  | .max _ _, .prod _ _, h => by simp [beqE] at h\n  | .max _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .max _ _, .get _ _, h => by simp [beqE] at h\n  | .prod _ _, .var _, h => by simp [beqE] at h\n  | .prod _ _, .const _, h => by simp [beqE] at h\n  | .prod _ _, .add _ _, h => by simp [beqE] at h\n  | .prod _ _, .sub _ _, h => by simp [beqE] at h\n  | .prod _ _, .mul _ _, h => by simp [beqE] at h\n  | .prod _ _, .min _ _, h => by simp [beqE] at h\n  | .prod _ _, .max _ _, h => by simp [beqE] at h\n  | .prod _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .prod _ _, .get _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .var _, h => by simp [beqE] at h\n  | .ite _ _ _, .const _, h => by simp [beqE] at h\n  | .ite _ _ _, .add _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .sub _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .mul _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .min _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .max _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .prod _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .get _ _, h => by simp [beqE] at h\n  | .get _ _, .var _, h => by simp [beqE] at h\n  | .get _ _, .const _, h => by simp [beqE] at h\n  | .get _ _, .add _ _, h => by simp [beqE] at h\n  | .get _ _, .sub _ _, h => by simp [beqE] at h\n  | .get _ _, .mul _ _, h => by simp [beqE] at h\n  | .get _ _, .min _ _, h => by simp [beqE] at h\n  | .get _ _, .max _ _, h => by simp [beqE] at h\n  | .get _ _, .prod _ _, h => by simp [beqE] at h\n  | .get _ _, .ite _ _ _, h => by simp [beqE] at h\ntheorem beqC_eq : ∀ {a b : C}, beqC a b = true → a = b\n  | .le x0 x1, .le y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .lt x0 x1, .lt y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .eq x0 x1, .eq y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .and x0 x1, .and y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1, beqC_eq h.2]\n  | .or x0 x1, .or y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1, beqC_eq h.2]\n  | .not x0, .not y0, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h]\n  | .le _ _, .lt _ _, h => by simp [beqC] at h\n  | .le _ _, .eq _ _, h => by simp [beqC] at h\n  | .le _ _, .and _ _, h => by simp [beqC] at h\n  | .le _ _, .or _ _, h => by simp [beqC] at h\n  | .le _ _, .not _, h => by simp [beqC] at h\n  | .lt _ _, .le _ _, h => by simp [beqC] at h\n  | .lt _ _, .eq _ _, h => by simp [beqC] at h\n  | .lt _ _, .and _ _, h => by simp [beqC] at h\n  | .lt _ _, .or _ _, h => by simp [beqC] at h\n  | .lt _ _, .not _, h => by simp [beqC] at h\n  | .eq _ _, .le _ _, h => by simp [beqC] at h\n  | .eq _ _, .lt _ _, h => by simp [beqC] at h\n  | .eq _ _, .and _ _, h => by simp [beqC] at h\n  | .eq _ _, .or _ _, h => by simp [beqC] at h\n  | .eq _ _, .not _, h => by simp [beqC] at h\n  | .and _ _, .le _ _, h => by simp [beqC] at h\n  | .and _ _, .lt _ _, h => by simp [beqC] at h\n  | .and _ _, .eq _ _, h => by simp [beqC] at h\n  | .and _ _, .or _ _, h => by simp [beqC] at h\n  | .and _ _, .not _, h => by simp [beqC] at h\n  | .or _ _, .le _ _, h => by simp [beqC] at h\n  | .or _ _, .lt _ _, h => by simp [beqC] at h\n  | .or _ _, .eq _ _, h => by simp [beqC] at h\n  | .or _ _, .and _ _, h => by simp [beqC] at h\n  | .or _ _, .not _, h => by simp [beqC] at h\n  | .not _, .le _ _, h => by simp [beqC] at h\n  | .not _, .lt _ _, h => by simp [beqC] at h\n  | .not _, .eq _ _, h => by simp [beqC] at h\n  | .not _, .and _ _, h => by simp [beqC] at h\n  | .not _, .or _ _, h => by simp [beqC] at h\nend\n\nmutual\ndef evalE (env : Nat → Nat) (maps : Nat → Nat → Nat) : E → Nat\n  | .var i => env i\n  | .const n => n\n  | .add a b => evalE env maps a + evalE env maps b\n  | .sub a b => evalE env maps a - evalE env maps b\n  | .mul k a => k * evalE env maps a\n  | .min a b => min (evalE env maps a) (evalE env maps b)\n  | .max a b => max (evalE env maps a) (evalE env maps b)\n  | .prod a b => evalE env maps a * evalE env maps b\n  | .ite c t f => if evalC env maps c then evalE env maps t else evalE env maps f\n  | .get m key => maps m (evalE env maps key)\ndef evalC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Bool\n  | .le a b => decide (evalE env maps a ≤ evalE env maps b)\n  | .lt a b => decide (evalE env maps a < evalE env maps b)\n  | .eq a b => decide (evalE env maps a = evalE env maps b)\n  | .and a b => evalC env maps a && evalC env maps b\n  | .or a b => evalC env maps a || evalC env maps b\n  | .not a => !evalC env maps a\nend\n\n-- A condition's meaning as a proposition: what a law says in plain Lean (`evalC_iff`). Exported laws are stated with it,\n-- so a statement like `ρ x ≤ ρ cap` is the law itself, up to unfolding.\ndef holdsC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Prop\n  | .le a b => evalE env maps a ≤ evalE env maps b\n  | .lt a b => evalE env maps a < evalE env maps b\n  | .eq a b => evalE env maps a = evalE env maps b\n  | .and a b => holdsC env maps a ∧ holdsC env maps b\n  | .or a b => holdsC env maps a ∨ holdsC env maps b\n  | .not a => ¬ holdsC env maps a\n\ntheorem evalC_iff (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ c, evalC env maps c = true ↔ holdsC env maps c\n  | .le a b => by simp [evalC, holdsC]\n  | .lt a b => by simp [evalC, holdsC]\n  | .eq a b => by simp [evalC, holdsC]\n  | .and a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .or a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .not a => by\n    have h := evalC_iff env maps a\n    simp only [evalC, holdsC]\n    cases hb : evalC env maps a <;> simp_all\n\n/-! Linear forms are Cert rows: `eval r x = dot r.coefs x + r.const`. -/\n\ndef lconst (n : Int) : Row := ⟨[], n⟩\ndef ladd (a b : Row) : Row := ⟨addL a.coefs b.coefs, a.const + b.const⟩\ndef lscale (m : Int) (a : Row) : Row := ⟨scaleL m a.coefs, m * a.const⟩\ndef lsub (a b : Row) : Row := ladd a (lscale (-1) b)\ndef lunit (j : Nat) : Row := ⟨[(j, 1)], 0⟩\n-- A row as the exporters write it: its nonzero coefficients (column, coefficient), in column order, and its constant.\ndef sp (cs : List (Nat × Int)) (c : Int) : Row := ⟨cs, c⟩\ndef same (a b : Row) : Bool := allZero (lsub a b).coefs && (lsub a b).const == 0\n-- 1 − a: over the integers, a ≤ 0 fails exactly when 1 − a ≤ 0 holds.\ndef flip (a : Row) : Row := lsub (lconst 1) a\n\ntheorem eval_lconst (n : Int) (x : List Int) : eval (lconst n) x = n := by\n  cases x <;> simp [eval, lconst, dot]\ntheorem eval_ladd (a b : Row) (x : List Int) : eval (ladd a b) x = eval a x + eval b x := by\n  simp only [eval, ladd, dot_addL]; omega\ntheorem eval_lscale (m : Int) (a : Row) (x : List Int) : eval (lscale m a) x = m * eval a x := by\n  simp only [eval, lscale, dot_scaleL, Int.mul_add]\ntheorem eval_lsub (a b : Row) (x : List Int) : eval (lsub a b) x = eval a x - eval b x := by\n  simp only [lsub, eval_ladd, eval_lscale]; omega\ntheorem eval_flip (a : Row) (x : List Int) : eval (flip a) x = 1 - eval a x := by\n  simp only [flip, eval_lsub, eval_lconst]\ntheorem eval_lunit (j : Nat) (x : List Int) : eval (lunit j) x = x.getD j 0 := by\n  simp [eval, lunit, dot]\ntheorem same_eval {a b : Row} (h : same a b = true) (x : List Int) : eval a x = eval b x := by\n  simp only [same, Bool.and_eq_true, beq_iff_eq] at h\n  have h1 : eval (lsub a b) x = 0 := by simp only [eval, dot_allZero _ x h.1, h.2]; rfl\n  rw [eval_lsub] at h1; omega\n\n/-! The path: atoms decided so far. `(l, true)` says l ≤ 0, `(l, false)` says l ≥ 1. -/\n\nabbrev Path := List (Row × Bool)\ndef PathHolds (path : Path) (x : List Int) : Prop := ∀ a ∈ path, decide (eval a.1 x ≤ 0) = a.2\n\ndef lookup {α : Type} (p : α → Bool) : List α → Option α\n  | [] => none\n  | a :: as => if p a then some a else lookup p as\ntheorem lookup_some {α : Type} {p : α → Bool} : ∀ {l : List α} {a : α}, lookup p l = some a → a ∈ l ∧ p a = true\n  | [], _, h => by simp [lookup] at h\n  | b :: bs, a, h => by\n    simp only [lookup] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨List.mem_cons_self, by assumption⟩\n    · have := lookup_some h; exact ⟨List.mem_cons_of_mem _ this.1, this.2⟩\n\ndef dec (path : Path) (l : Row) : Option Bool :=\n  if allZero l.coefs then some (decide (l.const ≤ 0))\n  else match lookup (fun a => same a.1 l) path with\n    | some a => some a.2\n    | none => match lookup (fun a => same a.1 (flip l)) path with\n      | some a => some (!a.2)\n      | none => none\n\ntheorem dec_sound {path : Path} {x : List Int} (hP : PathHolds path x) {l : Row} {b : Bool}\n    (h : dec path l = some b) : decide (eval l x ≤ 0) = b := by\n  simp only [dec] at h\n  split at h\n  · rename_i hz\n    simp only [Option.some.injEq] at h\n    subst h\n    simp [eval, dot_allZero _ x hz]\n  · split at h\n    · rename_i a ha\n      simp only [Option.some.injEq] at h; subst h\n      have ⟨hm, hs⟩ := lookup_some ha\n      rw [← hP a hm, same_eval hs]\n    · split at h\n      · rename_i a ha\n        simp only [Option.some.injEq] at h; subst h\n        have ⟨hm, hs⟩ := lookup_some ha\n        have := hP a hm\n        rw [same_eval hs, eval_flip] at this\n        rw [← this]\n        by_cases hl : eval l x ≤ 0 <;> simp [hl] <;> omega\n      · simp at h\n\n/-! The table: column j is a variable of the environment, or map m's cell at a key (a row over earlier columns). -/\n\ninductive VDef where\n  | var (i : Nat)\n  | cell (m : Nat) (key : Row)\n  | mono (fs : List Nat)        -- the product of earlier columns (a monomial)\n  | term (e : E)                -- a choice the path leaves open (∸, min, max, if), standing for its value\n\ndef prodV (x : List Int) : List Nat → Int\n  | [] => 1\n  | j :: js => x.getD j 0 * prodV x js\n\ndef valD (env : Nat → Nat) (maps : Nat → Nat → Nat) : VDef → List Int → Int\n  | .var i, _ => (env i : Int)\n  | .cell m k, x => (maps m (eval k x).toNat : Int)\n  | .mono fs, x => ((prodV x fs).toNat : Int)\n  | .term e, _ => (evalE env maps e : Int)\n\n-- x is a valuation of the table: each column holds what its definition says, and every value is a natural.\ndef Model (tab : List VDef) (env : Nat → Nat) (maps : Nat → Nat → Nat) (x : List Int) : Prop :=\n  (∀ j d, tab[j]? = some d → x.getD j 0 = valD env maps d x) ∧ ∀ j, 0 ≤ x.getD j 0\n\ndef findIdx {α : Type} (p : α → Bool) : List α → Option Nat\n  | [] => none\n  | a :: as => if p a then some 0 else (findIdx p as).map (· + 1)\ntheorem findIdx_some {α : Type} {p : α → Bool} : ∀ {l : List α} {j : Nat}, findIdx p l = some j → ∃ a, l[j]? = some a ∧ p a = true\n  | [], _, h => by simp [findIdx] at h\n  | b :: bs, j, h => by\n    simp only [findIdx] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨b, rfl, by assumption⟩\n    · cases hj : findIdx p bs with\n      | none => simp [hj] at h\n      | some i =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        obtain ⟨a, ha, hp⟩ := findIdx_some (l := bs) hj\n        exact ⟨a, by simpa using ha, hp⟩\n\ndef isVar (i : Nat) : VDef → Bool\n  | .var i' => i' == i\n  | _ => false\ndef isCell (m : Nat) (k : Row) : VDef → Bool\n  | .cell m' k' => m' == m && same k' k\n  | _ => false\ndef isTerm (e : E) : VDef → Bool\n  | .term e' => beqE e' e\n  | _ => false\n-- An open choice's column: the table's column for the whole term, if it has one.\ndef termCol (tab : List VDef) (e : E) : Option Row := (findIdx (isTerm e) tab).map lunit\ndef isMono (fs : List Nat) : VDef → Bool\n  | .mono fs' => fs' == fs\n  | _ => false\n\n/-! Products: monomials are columns, each the product of the columns its factors name (sorted, so one monomial is one\ncolumn). Multiplying two rows looks up the column of each product of two columns. -/\n\ndef ins (a : Nat) : List Nat → List Nat\n  | [] => [a]\n  | b :: bs => if a ≤ b then a :: b :: bs else b :: ins a bs\ndef srt : List Nat → List Nat\n  | [] => []\n  | a :: as => ins a (srt as)\n\ntheorem prodV_ins (x : List Int) (a : Nat) : ∀ l, prodV x (ins a l) = x.getD a 0 * prodV x l\n  | [] => by simp [ins, prodV]\n  | b :: bs => by\n    simp only [ins]; split\n    · rfl\n    · simp only [prodV, prodV_ins x a bs]; rw [Int.mul_left_comm]\ntheorem prodV_srt (x : List Int) : ∀ l, prodV x (srt l) = prodV x l\n  | [] => rfl\n  | a :: as => by simp only [srt, prodV_ins, prodV_srt x as, prodV]\ntheorem prodV_append (x : List Int) : ∀ l1 l2, prodV x (l1 ++ l2) = prodV x l1 * prodV x l2\n  | [], l2 => by simp [prodV]\n  | a :: as, l2 => by simp only [List.cons_append, prodV, prodV_append x as l2, Int.mul_assoc]\ntheorem prodV_nonneg {x : List Int} (h : ∀ j, 0 ≤ x.getD j 0) : ∀ l, 0 ≤ prodV x l\n  | [] => by simp [prodV]\n  | a :: as => Int.mul_nonneg (h a) (prodV_nonneg h as)\n\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 · Σ b x_j, over b's coefficients (column j, coefficient b)\ndef mulRow (tab : List VDef) (i : Nat) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | q :: bs => match mulRow tab i bs with\n    | none => none\n    | some r => if q.2 == 0 then some r else match pcol tab i q.1 with\n      | some k => some (ladd (lscale q.2 (lunit k)) r)\n      | none => none\n-- (Σ a x_i) · Σ b x_j\ndef mulRows (tab : List VDef) (bs : List (Nat × Int)) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | p :: as => match mulRows tab bs as with\n    | none => none\n    | some r => if p.2 == 0 then some r else match mulRow tab p.1 bs with\n      | some q => some (ladd (lscale p.2 q) r)\n      | none => none\ndef rowMul (tab : List VDef) (a b : Row) : Option Row :=\n  match mulRows tab b.coefs a.coefs with\n  | some p => some (ladd p (ladd (lscale a.const ⟨b.coefs, 0⟩) (ladd (lscale b.const ⟨a.coefs, 0⟩) (lconst (a.const * b.const)))))\n  | none => none\n\n\nmutual\ndef linear (tab : List VDef) (path : Path) : E → Option Row\n  | .var i => (findIdx (isVar i) tab).map lunit\n  | .const n => some (lconst n)\n  | .add a b => match linear tab path a, linear tab path b with\n    | some la, some lb => some (ladd la lb)\n    | _, _ => none\n  | .mul k a => match linear tab path a with\n    | some la => some (lscale k la)\n    | none => none\n  | .sub a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub lb la) with\n      | some true => some (lsub la lb)\n      | some false => some (lconst 0)\n      | none => termCol tab (.sub a b)\n    | _, _ => none\n  | .min a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some la\n      | some false => some lb\n      | none => termCol tab (.min a b)\n    | _, _ => none\n  | .max a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some lb\n      | some false => some la\n      | none => termCol tab (.max a b)\n    | _, _ => none\n  | .prod a b => match linear tab path a, linear tab path b with\n    | some la, some lb => rowMul tab la lb\n    | _, _ => none\n  | .ite c t f => match truth tab path c with\n    | some true => linear tab path t\n    | some false => linear tab path f\n    | none => termCol tab (.ite c t f)\n  | .get m key => match linear tab path key with\n    | some lk => (findIdx (isCell m lk) tab).map lunit\n    | none => none\ndef truth (tab : List VDef) (path : Path) : C → Option Bool\n  | .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (lsub la lb)\n    | _, _ => none\n  | .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (ladd (lsub la lb) (lconst 1))\n    | _, _ => none\n  | .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb), dec path (lsub lb la) with\n      | some false, _ => some false\n      | _, some false => some false\n      | some true, some true => some true\n      | _, _ => none\n    | _, _ => none\n  | .and a b => match truth tab path a, truth tab path b with\n    | some false, _ => some false\n    | _, some false => some false\n    | some true, some true => some true\n    | _, _ => none\n  | .or a b => match truth tab path a, truth tab path b with\n    | some true, _ => some true\n    | _, some true => some true\n    | some false, some false => some false\n    | _, _ => none\n  | .not a => match truth tab path a with\n    | some b => some (!b)\n    | none => none\nend\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem var_col (hM : Model tab env maps x) {i j : Nat} (h : findIdx (isVar i) tab = some j) : x.getD j 0 = env i := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | var i' => simp only [isVar, beq_iff_eq] at hv; subst hv; rfl\n  | _ => simp [isVar] at hv\n\ntheorem term_col (hM : Model tab env maps x) {e : E} {j : Nat} (h : findIdx (isTerm e) tab = some j) :\n    x.getD j 0 = (evalE env maps e : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | term e' => simp only [isTerm] at hv; have he := beqE_eq hv; subst he; rfl\n  | _ => simp [isTerm] at hv\n\ntheorem termCol_sound (hM : Model tab env maps x) {e : E} {l : Row} (h : termCol tab e = some l) :\n    eval l x = (evalE env maps e : Int) := by\n  simp only [termCol] at h\n  cases hj : findIdx (isTerm e) tab with\n  | none => simp [hj] at h\n  | some j => simp only [hj, Option.map_some, Option.some.injEq] at h; subst h; rw [eval_lunit, term_col hM hj]\n\ntheorem cell_col (hM : Model tab env maps x) {m j : Nat} {k : Row} (h : findIdx (isCell m k) tab = some j) :\n    x.getD j 0 = (maps m (eval k x).toNat : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | cell m' k' =>\n    simp only [isCell, Bool.and_eq_true, beq_iff_eq] at hv\n    obtain ⟨rfl, hs⟩ := hv\n    simp only [valD, same_eval hs x]\n  | _ => simp [isCell] at hv\n\ntheorem fac_val (hM : Model tab env maps x) {i : Nat} {fs : List Nat} (h : fac tab i = some fs) : x.getD i 0 = prodV x fs := by\n  simp only [fac] at h\n  split at h\n  · 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    ∀ bs r, mulRow tab i bs = some r → eval r x = x.getD i 0 * dot bs x\n  | [], r, h => by simp only [mulRow, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | q :: bs, r, h => by\n    simp only [mulRow] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRow_sound hM i bs r' hr'\n      split at h\n      · rename_i hb\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at hb; simp [dot, hb, ih]\n      · split at h\n        · rename_i k hk\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, eval_lunit, pcol_val hM hk, ih]\n          simp only [dot]; rw [Int.mul_add, Int.mul_left_comm (x.getD i 0) q.2]\n        · simp at h\n\ntheorem mulRows_sound (hM : Model tab env maps x) (bs : List (Nat × Int)) :\n    ∀ as r, mulRows tab bs as = some r → eval r x = dot as x * dot bs x\n  | [], r, h => by simp only [mulRows, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | p :: as, r, h => by\n    simp only [mulRows] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRows_sound hM bs as r' hr'\n      split at h\n      · rename_i ha\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at ha; simp [dot, ha, ih]\n      · split at h\n        · rename_i q hq\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, mulRow_sound hM p.1 bs q hq, ih]\n          simp only [dot]; rw [Int.add_mul, Int.mul_assoc]\n        · simp at h\n\ntheorem rowMul_sound (hM : Model tab env maps x) {a b r : Row} (h : rowMul tab a b = some r) : eval r x = eval a x * eval b x := by\n  simp only [rowMul] at h\n  split at h\n  · rename_i p hp\n    simp only [Option.some.injEq] at h; subst h\n    have e := mulRows_sound hM b.coefs a.coefs p hp\n    simp only [eval_ladd, eval_lscale, eval_lconst, e]\n    simp only [eval, Int.add_zero]\n    rw [Int.add_mul, Int.mul_add, Int.mul_add, Int.mul_comm b.const]; omega\n  · simp at h\n\nmutual\ntheorem linear_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (e : E) → (l : Row) → linear tab path e = some l → eval l x = (evalE env maps e : Int)\n  | .var i, l, h => by\n    simp only [linear] at h\n    cases hj : findIdx (isVar i) tab with\n    | none => simp [hj] at h\n    | some j =>\n      simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n      rw [eval_lunit, var_col hM hj, evalE]\n  | .const n, l, h => by\n    simp only [linear, Option.some.injEq] at h; subst h\n    simp [eval_lconst, evalE]\n  | .add a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_ladd, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; omega\n    · simp at h\n  | .mul k a, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la ha\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_lscale, linear_sound hM hP a la ha, evalE]; simp\n    · simp at h\n  | .sub a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [eval_lsub, evalE]; omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [eval_lconst, evalE]; omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .min a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .max a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .prod a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      rw [rowMul_sound hM h, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; simp\n    · simp at h\n  | .ite c t f, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i hc\n      have := truth_sound hM hP c true hc\n      rw [linear_sound hM hP t l h, evalE, this]; rfl\n    · rename_i hc\n      have := truth_sound hM hP c false hc\n      rw [linear_sound hM hP f l h, evalE, this]; rfl\n    · exact termCol_sound hM h\n  | .get m key, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i lk hk\n      cases hj : findIdx (isCell m lk) tab with\n      | none => simp [hj] at h\n      | some j =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        rw [eval_lunit, cell_col hM hj, linear_sound hM hP key lk hk, evalE]; simp\n    · simp at h\ntheorem truth_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (b : Bool) → truth tab path c = some b → evalC env maps c = b\n  | .le a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_lsub] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .lt a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_ladd, eval_lsub, eval_lconst] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .eq a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      simp only [evalC]\n      revert h\n      rcases h1 : dec path (lsub la lb) with _ | _ | _ <;> rcases h2 : dec path (lsub lb la) with _ | _ | _ <;>\n        intro h <;> simp only [Option.some.injEq, reduceCtorEq] at h <;> subst h <;>\n        first\n          | (have t1 := dec_sound hP h1; have t2 := dec_sound hP h2; rw [eval_lsub] at t1 t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 t2 ⊢; omega)\n          | (have t1 := dec_sound hP h1; rw [eval_lsub] at t1\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 ⊢; omega)\n          | (have t2 := dec_sound hP h2; rw [eval_lsub] at t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t2 ⊢; omega)\n    · simp at h\n  | .and a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' false h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1, truth_sound hM hP b' true h2]\n    · simp at h\n  | .or a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' true h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1, truth_sound hM hP b' false h2]\n    · simp at h\n  | .not a, r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i r' h1; simp only [Option.some.injEq] at h; subst h; simp [evalC, truth_sound hM hP a r' h1]\n    · simp at h\nend\nend\n\n/-! Facts: the rows a hypothesis gives under the path, when it has the truth value `pos`. -/\n\ndef facts (tab : List VDef) (path : Path) : Bool → C → List Row\n  | pos, .not a => facts tab path (!pos) a\n  | pos, .and a b =>\n    if pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .or a b =>\n    if !pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb]\n      else let u := ladd (lsub lb la) (lconst 1); if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [ladd (lsub la lb) (lconst 1)]\n      else let u := lsub lb la; if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb, lsub lb la]\n      else\n        let u1 := ladd (lsub la lb) (lconst 1)\n        let u2 := ladd (lsub lb la) (lconst 1)\n        let o1 := dec path u1 != some false\n        let o2 := dec path u2 != some false\n        if o1 && o2 then [] else if o1 then [u1] else if o2 then [u2] else [lconst 1]\n    | _, _ => []\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem facts_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (pos : Bool) → evalC env maps c = pos → ∀ r ∈ facts tab path pos c, eval r x ≤ 0\n  | .not a, pos, h, r, hr => by\n    simp only [facts] at hr\n    exact facts_sound hM hP a (!pos) (by simp [evalC] at h; simp [← h]) r hr\n  | .and a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | true =>\n      simp only [evalC, Bool.and_eq_true] at h\n      simp only [ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a true h.1 r hr\n      · exact facts_sound hM hP b true h.2 r hr\n    | false =>\n      simp only [Bool.false_eq_true, ite_false, Bool.not_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.and_eq_false_iff] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · rename_i _ hoa\n          have hb : truth tab path b = some true := by simp_all\n          have := tb true hb\n          exact facts_sound hM hP a false (by simp_all) r hr\n        · split at hr\n          · rename_i _ _ hob\n            have ha : truth tab path a = some true := by simp_all\n            have := ta true ha\n            exact facts_sound hM hP b false (by simp_all) r hr\n          · have ha : truth tab path a = some true := by simp_all\n            have hb : truth tab path b = some true := by simp_all\n            have := ta true ha; have := tb true hb\n            simp_all\n  | .or a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | false =>\n      simp only [evalC, Bool.or_eq_false_iff] at h\n      simp only [Bool.not_false, ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a false h.1 r hr\n      · exact facts_sound hM hP b false h.2 r hr\n    | true =>\n      simp only [Bool.not_true, Bool.false_eq_true, ite_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.or_eq_true] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · have hb : truth tab path b = some false := by simp_all\n          have := tb false hb\n          exact facts_sound hM hP a true (by simp_all) r hr\n        · split at hr\n          · have ha : truth tab path a = some false := by simp_all\n            have := ta false ha\n            exact facts_sound hM hP b true (by simp_all) r hr\n          · have ha : truth tab path a = some false := by simp_all\n            have hb : truth tab path b = some false := by simp_all\n            have := ta false ha; have := tb false hb\n            simp_all\n  | .le a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_lsub]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_ladd, eval_lsub, eval_lconst]; omega\n    · simp at hr\n  | .lt a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_ladd, eval_lsub, eval_lconst]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_lsub, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_lsub]; omega\n    · simp at hr\n  | .eq a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with hr | hr <;> subst hr <;> rw [eval_lsub] <;> omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        have d1 := fun (hv : dec path (ladd (lsub la lb) (lconst 1)) = some false) => dec_sound hP hv\n        have d2 := fun (hv : dec path (ladd (lsub lb la) (lconst 1)) = some false) => dec_sound hP hv\n        simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at d1 d2\n        split at hr\n        · simp at hr\n        · split at hr\n          · have := d2 (by simp_all)\n            simp only [List.mem_singleton] at hr; subst hr\n            rw [eval_ladd, eval_lsub, eval_lconst]; omega\n          · split at hr\n            · have := d1 (by simp_all)\n              simp only [List.mem_singleton] at hr; subst hr\n              rw [eval_ladd, eval_lsub, eval_lconst]; omega\n            · have := d1 (by simp_all); have := d2 (by simp_all); omega\n    · simp at hr\nend\n\n/-! Leaves and trees. -/\n\ndef atomRow (a : Row × Bool) : Row := if a.2 then a.1 else flip a.1\ndef natRows : Nat → List Row\n  | 0 => []\n  | n + 1 => lscale (-1) (lunit n) :: natRows n\n-- Two cells of one map whose keys the path proves equal are equal (the pair is the leaf's claim; it is checked here).\ndef cellEq (tab : List VDef) (path : Path) (p : Nat × Nat) : List Row :=\n  match tab[p.1]?, tab[p.2]? with\n  | some (.cell m k), some (.cell m' k') =>\n    if m == m' && dec path (lsub k k') == some true && dec path (lsub k' k) == some true\n    then [lsub (lunit p.1) (lunit p.2), lsub (lunit p.2) (lunit p.1)] else []\n  | _, _ => []\n-- A term column's rows: its bounds, whichever way its choice goes (min ≤ each side, max ≥ each side, a ∸ b ≥ a − b and\n-- ≤ a), and its equality to the term's form under the path (the branch taken, once the path decides it).\ndef termBounds (j : Nat) (la lb : Row) : E → List Row\n  | .min _ _ => [lsub (lunit j) la, lsub (lunit j) lb]\n  | .max _ _ => [lsub la (lunit j), lsub lb (lunit j)]\n  | .sub _ _ => [lsub (lsub la lb) (lunit j), lsub (lunit j) la]\n  | _ => []\ndef termRowsAt (tab : List VDef) (path : Path) (j : Nat) : List Row :=\n  match tab[j]? with\n  | some (.term e) =>\n    (match e with\n     | .min a b | .max a b | .sub a b => match linear tab path a, linear tab path b with\n       | some la, some lb => termBounds j la lb e\n       | _, _ => []\n     | _ => [])\n    ++ (match linear tab path e with\n        | some r => [lsub (lunit j) r, lsub r (lunit j)]\n        | none => [])\n  | _ => []\ndef termRows (tab : List VDef) (path : Path) : List Row := (List.range tab.length).flatMap (termRowsAt tab path)\n\ndef leafRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : List Row :=\n  path.map atomRow ++ hyps.flatMap (facts tab path true) ++ natRows tab.length ++ eqs.flatMap (cellEq tab path) ++ termRows tab path\n\n-- Where a leaf's row is looked for first: the path's i-th atom (the latest decision first), a hypothesis's facts, column i's naturality, the i-th\n-- pair of equal cells, or term column j's rows. A hint only saves work: a row not found there is looked for among all\n-- of the leaf's rows, as one without a hint is.\ninductive Src where\n  | atom (i : Nat)\n  | fact (h : Nat)\n  | nat (i : Nat)\n  | eq (i : Nat)\n  | term (j : Nat)\n  | any\n\ndef srcRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : Src → List Row\n  | .atom i => match path[i]? with | some a => [atomRow a] | none => []\n  | .fact h => match hyps[h]? with | some c => facts tab path true c | none => []\n  | .nat i => if i < tab.length then [lscale (-1) (lunit i)] else []\n  | .eq i => match eqs[i]? with | some p => cellEq tab path p | none => []\n  | .term j => if j < tab.length then termRowsAt tab path j else []\n  | .any => []\n\n-- A leaf may add products of two of its rows (p ≤ 0 and q ≤ 0 give −p·q ≤ 0); a pair may name an earlier product.\n-- `leafAt` is a leaf whose rows come with hints.\ninductive Tree where\n  | split (l : Row) (yes no : Tree)\n  | leaf (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n  | leafAt (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n\ndef extend (tab : List VDef) : List Row → List (Nat × Nat) → Option (List Row)\n  | acc, [] => some acc\n  | acc, (i, j) :: ps => match acc[i]?, acc[j]? with\n    | some p, some q => match rowMul tab p q with\n      | some r => extend tab (acc ++ [lscale (-1) r]) ps\n      | none => none\n    | _, _ => none\n\ndef leafOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  let comp := leafRows tab path hyps eqs\n  rows.all (fun r => comp.any (same r)) && match extend tab rows prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\n-- Each row where its hint says, or else among the leaf's rows.\ndef leafAtOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  rows.all (fun r => (srcRows tab path hyps eqs r.2).any (same r.1) || (leafRows tab path hyps eqs).any (same r.1))\n    && match extend tab (rows.map (·.1)) prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\ndef checkT (tab : List VDef) (hyps : List C) : Path → Tree → Bool\n  | path, .split l y n => checkT tab hyps ((l, true) :: path) y && checkT tab hyps ((l, false) :: path) n\n  | path, .leaf rows steps eqs prods => leafOk tab path hyps rows steps eqs prods\n  | path, .leafAt rows steps eqs prods => leafAtOk tab path hyps rows steps eqs prods\n\nstructure Goal where\n  tab : List VDef\n  hyps : List C\n\n-- Each cell's key reads only earlier columns, so the table has a valuation.\ndef wfTab : Nat → List VDef → Bool\n  | _, [] => true\n  | n, .var _ :: ds => wfTab (n + 1) ds\n  | n, .cell _ k :: ds => k.coefs.all (·.1 < n) && wfTab (n + 1) ds\n  | n, .mono fs :: ds => fs.all (· < n) && wfTab (n + 1) ds\n  | n, .term _ :: ds => wfTab (n + 1) ds\n\ndef checkGoal (g : Goal) (t : Tree) : Bool := wfTab 0 g.tab && checkT g.tab g.hyps [] t\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int}\n\ntheorem natRows_sound (hM : Model tab env maps x) : ∀ n, ∀ r ∈ natRows n, eval r x ≤ 0\n  | 0, r, hr => by simp [natRows] at hr\n  | n + 1, r, hr => by\n    simp only [natRows, List.mem_cons] at hr\n    rcases hr with hr | hr\n    · subst hr; rw [eval_lscale, eval_lunit]; have := hM.2 n; omega\n    · exact natRows_sound hM n r hr\n\ntheorem termRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) :\n    ∀ r ∈ termRows tab path, eval r x ≤ 0 := by\n  intro r hr\n  simp only [termRows, List.mem_flatMap] at hr\n  obtain ⟨j, _, hr⟩ := hr\n  simp only [termRowsAt] at hr\n  split at hr\n  · rename_i e hj\n    have hx : x.getD j 0 = (evalE env maps e : Int) := by rw [hM.1 j _ hj]; rfl\n    simp only [List.mem_append] at hr\n    rcases hr with hr | hr\n    · cases e with\n      | min a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.min_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | max a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.max_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | sub a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE] at hx\n          rcases hr with rfl | rfl\n          · rw [eval_lsub, eval_lsub, eval_lunit]; omega\n          · rw [eval_lsub, eval_lunit]; omega\n        · simp at hr\n      | _ => simp at hr\n    · split at hr\n      · rename_i r' hr'\n        have := linear_sound hM hP e r' hr'\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n      · simp at hr\n  · simp at hr\n\ntheorem leafRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) {hyps : List C}\n    (hH : ∀ c ∈ hyps, evalC env maps c = true) (eqs : List (Nat × Nat)) : ∀ r ∈ leafRows tab path hyps eqs, eval r x ≤ 0 := by\n  intro r hr\n  simp only [leafRows, List.mem_append, List.mem_map, List.mem_flatMap] at hr\n  rcases hr with (((⟨a, ha, rfl⟩ | ⟨c, hc, hr⟩) | hr) | ⟨p, _, hr⟩) | hr\n  · have := hP a ha\n    simp only [atomRow]\n    cases h2 : a.2 with\n    | true => rw [h2] at this; simpa using this\n    | false => rw [h2] at this; simp only [decide_eq_false_iff_not] at this; simp only [ite_false, Bool.false_eq_true, eval_flip]; omega\n  · exact facts_sound hM hP c true (hH c hc) r hr\n  · exact natRows_sound hM _ r hr\n  · simp only [cellEq] at hr\n    split at hr\n    · rename_i m k m' k' h1 h2\n      split at hr\n      · rename_i hc\n        simp only [Bool.and_eq_true, beq_iff_eq] at hc\n        obtain ⟨⟨rfl, hk1⟩, hk2⟩ := hc\n        have t1 := dec_sound hP hk1; have t2 := dec_sound hP hk2\n        simp only [eval_lsub, decide_eq_true_eq] at t1 t2\n        have e1 := hM.1 p.1 _ h1; have e2 := hM.1 p.2 _ h2\n        simp only [valD] at e1 e2\n        have hkk : eval k x = eval k' x := by omega\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit, eval_lunit, e1, e2, hkk] <;> omega\n      · simp at hr\n    · simp at hr\n  · exact termRows_sound hM hP r hr\n\n-- A hint names some of the leaf's rows.\ntheorem natRows_mem : ∀ {n i : Nat}, i < n → lscale (-1) (lunit i) ∈ natRows n\n  | 0, _, h => absurd h (Nat.not_lt_zero _)\n  | n + 1, i, h => by\n    simp only [natRows, List.mem_cons]\n    rcases Nat.lt_succ_iff_lt_or_eq.mp h with h | rfl\n    · exact Or.inr (natRows_mem h)\n    · exact Or.inl rfl\n\ntheorem srcRows_sub {path : Path} {hyps : List C} {eqs : List (Nat × Nat)} {r : Row} :\n    ∀ s, r ∈ srcRows tab path hyps eqs s → r ∈ leafRows tab path hyps eqs\n  | .atom i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i a ha\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append, List.mem_map]\n      exact Or.inl (Or.inl (Or.inl (Or.inl ⟨a, List.mem_of_getElem? ha, rfl⟩)))\n    · simp at hr\n  | .fact h, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i c hc\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inl (Or.inl (Or.inr ⟨c, List.mem_of_getElem? hc, hr⟩)))\n    · simp at hr\n  | .nat i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hi\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append]\n      exact Or.inl (Or.inl (Or.inr (natRows_mem hi)))\n    · simp at hr\n  | .eq i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i p hp\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inr ⟨p, List.mem_of_getElem? hp, hr⟩)\n    · simp at hr\n  | .term j, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hj\n      simp only [leafRows, termRows, List.mem_append, List.mem_flatMap, List.mem_range]\n      exact Or.inr ⟨j, hj, hr⟩\n    · simp at hr\n  | .any, hr => by simp [srcRows] at hr\n\ntheorem extend_sound (hM : Model tab env maps x) :\n    ∀ ps acc rows', extend tab acc ps = some rows' → (∀ r ∈ acc, eval r x ≤ 0) → ∀ r ∈ rows', eval r x ≤ 0\n  | [], acc, rows', h, ha => by simp only [extend, Option.some.injEq] at h; subst h; exact ha\n  | (i, j) :: ps, acc, rows', h, ha => by\n    simp only [extend] at h\n    split at h\n    · rename_i p q hp hq\n      split at h\n      · rename_i r hr\n        refine extend_sound hM ps _ rows' h (fun r' hr' => ?_)\n        rcases List.mem_append.mp hr' with hr' | hr'\n        · exact ha r' hr'\n        · simp only [List.mem_singleton] at hr'; subst hr'\n          have e1 := ha p (List.mem_of_getElem? hp)\n          have e2 := ha q (List.mem_of_getElem? hq)\n          rw [eval_lscale, rowMul_sound hM hr]\n          have : 0 ≤ (-eval p x) * (-eval q x) := Int.mul_nonneg (by omega) (by omega)\n          rw [Int.neg_mul_neg] at this; omega\n      · simp at h\n    · simp at h\n\ntheorem checkT_sound (hM : Model tab env maps x) {hyps : List C} (hH : ∀ c ∈ hyps, evalC env maps c = true) :\n    ∀ (t : Tree) (path : Path), PathHolds path x → checkT tab hyps path t = true → False\n  | .split l y n, path, hP, h => by\n    simp only [checkT, Bool.and_eq_true] at h\n    by_cases hl : eval l x ≤ 0\n    · refine checkT_sound hM hH y _ ?_ h.1\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n    · refine checkT_sound hM hH n _ ?_ h.2\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n  | .leaf rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafOk, Bool.and_eq_true, List.all_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods rows rows' he ?_)\n      intro r hr\n      obtain ⟨c, hc, hs⟩ := h1 r hr\n      rw [same_eval hs]\n      exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\n  | .leafAt rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafAtOk, Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods _ rows' he ?_)\n      intro r hr\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hr\n      rcases h1 p hp with ⟨c, hc, hs⟩ | ⟨c, hc, hs⟩\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c (srcRows_sub p.2 hc)\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\nend\n\n/-! The table's valuation. -/\n\ndef build (env : Nat → Nat) (maps : Nat → Nat → Nat) : List VDef → List Int → List Int\n  | [], acc => acc\n  | d :: ds, acc => build env maps ds (acc ++ [valD env maps d acc])\n\ntheorem dot_append : ∀ (a : List (Nat × Int)) (l1 l2 : List Int), (∀ p ∈ a, p.1 < l1.length) → dot a (l1 ++ l2) = dot a l1\n  | [], _, _, _ => by simp [dot]\n  | p :: a, l1, l2, h => by\n    simp only [dot]\n    rw [dot_append a l1 l2 (fun q hq => h q (List.mem_cons_of_mem _ hq))]\n    have hp := h p List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hp]\n\n-- What a column may refer to: only earlier columns.\ndef Refs (n : Nat) : VDef → Prop\n  | .var _ => True\n  | .cell _ k => ∀ p ∈ k.coefs, p.1 < n\n  | .mono fs => ∀ f ∈ fs, f < n\n  | .term _ => True\n\ntheorem Refs.mono_le {n m : Nat} (h : n ≤ m) : ∀ {d : VDef}, Refs n d → Refs m d\n  | .var _, _ => trivial\n  | .cell _ _, hd => fun p hp => by have := hd p hp; omega\n  | .mono _, hd => fun f hf => by have := hd f hf; omega\n  | .term _, _ => trivial\n\ntheorem prodV_append_left (acc more : List Int) : ∀ fs : List Nat, (∀ f ∈ fs, f < acc.length) → prodV (acc ++ more) fs = prodV acc fs\n  | [], _ => rfl\n  | f :: fs, h => by\n    simp only [prodV]\n    rw [prodV_append_left acc more fs (fun g hg => h g (List.mem_cons_of_mem _ hg))]\n    have hf := h f List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hf]\n\ntheorem valD_append (env : Nat → Nat) (maps : Nat → Nat → Nat) (d : VDef) (acc more : List Int)\n    (h : Refs acc.length d) : valD env maps d (acc ++ more) = valD env maps d acc := by\n  cases d with\n  | var i => rfl\n  | cell m k => simp only [Refs] at h; simp only [valD, eval, dot_append k.coefs acc more h]\n  | mono fs => simp only [valD, prodV_append_left acc more fs h]\n  | term e => rfl\n\ndef Valid (env : Nat → Nat) (maps : Nat → Nat → Nat) (acc : List Int) (pre : List VDef) : Prop :=\n  acc.length = pre.length ∧ (∀ (j : Nat) (d : VDef), pre[j]? = some d → Refs j d) ∧\n    ∀ (j : Nat) (d : VDef), pre[j]? = some d → acc[j]? = some (valD env maps d acc)\n\ntheorem valid_snoc {env : Nat → Nat} {maps : Nat → Nat → Nat} {acc : List Int} {pre : List VDef} (d : VDef)\n    (hv : Valid env maps acc pre) (hd : Refs pre.length d) :\n    Valid env maps (acc ++ [valD env maps d acc]) (pre ++ [d]) := by\n  obtain ⟨hl, hw, hx⟩ := hv\n  refine ⟨by simp [hl], ?_, ?_⟩\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj; exact hw j d' hj\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      exact Refs.mono_le (by omega) hd\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj\n      rw [List.getElem?_append_left (by omega), hx j d' hj]\n      rw [valD_append env maps d' acc _ (Refs.mono_le (by omega) (hw j d' hj))]\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      rw [List.getElem?_append_right (by omega), show j - acc.length = 0 by omega]\n      simp only [List.getElem?_cons_zero, Option.some.injEq]\n      rw [valD_append env maps d acc _ (by rw [hl]; exact hd)]\n\ntheorem build_valid (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ (ds : List VDef) (acc : List Int) (pre : List VDef),\n    Valid env maps acc pre → wfTab pre.length ds = true → Valid env maps (build env maps ds acc) (pre ++ ds)\n  | [], acc, pre, hv, _ => by simpa [build] using hv\n  | d :: ds, acc, pre, hv, hw => by\n    have hd : Refs pre.length d ∧ wfTab (pre.length + 1) ds = true := by\n      cases d with\n      | var i => exact ⟨trivial, by simpa [wfTab] using hw⟩\n      | cell m k =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | mono fs =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | term e => exact ⟨trivial, by simpa [wfTab] using hw⟩\n    have := build_valid env maps ds _ (pre ++ [d]) (valid_snoc d hv hd.1) (by simpa using hd.2)\n    simpa [build] using this\n\ntheorem model_of_valid {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {tab : List VDef}\n    (hv : Valid env maps x tab) : Model tab env maps x := by\n  obtain ⟨hl, _, hx⟩ := hv\n  refine ⟨fun j d hj => by rw [List.getD_eq_getElem?_getD, hx j d hj]; rfl, fun j => ?_⟩\n  rw [List.getD_eq_getElem?_getD]\n  cases h : x[j]? with\n  | none => simp\n  | some v =>\n    have hj : j < tab.length := by\n      have := (List.getElem?_eq_some_iff.mp h).1; omega\n    obtain ⟨d, hd⟩ : ∃ d, tab[j]? = some d := ⟨tab[j], List.getElem?_eq_getElem hj⟩\n    rw [hx j d hd] at h\n    simp only [Option.some.injEq] at h; subst h\n    cases d <;> simp [valD]\n    exact Int.le_max_right _ _\n\n/-- The kernel's tree check is sound: an accepted goal's hypotheses hold for no naturals and no maps. -/\ntheorem sound (g : Goal) (t : Tree) (h : checkGoal g t = true) (env : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ¬ ∀ c ∈ g.hyps, evalC env maps c = true := by\n  intro hH\n  simp only [checkGoal, Bool.and_eq_true] at h\n  have hv := build_valid env maps g.tab [] [] ⟨rfl, by simp, by simp⟩ (by simpa using h.1)\n  simp only [List.nil_append] at hv\n  exact checkT_sound (model_of_valid hv) hH t [] (by simp [PathHolds]) h.2\n\n/-! Step machines with scalar state: the induction rule over kernel goals. The goals are built here, in Lean, from\nthe machine, so the TypeScript `obligations` is not trusted for these: a law holds at the start (`startGoal` is\nrefuted) and one step keeps every law (`stepGoal` is refuted, assuming them all and the request's assumption), so every\nlaw holds in every reachable state. Laws may not read the request's inputs. -/\n\ndef assoc (σ : List (Nat × E)) (i : Nat) : Option E := (lookup (fun p => p.1 == i) σ).map (·.2)\n\nmutual\ndef substE (σ : List (Nat × E)) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substE σ a) (substE σ b)\n  | .sub a b => .sub (substE σ a) (substE σ b)\n  | .mul k a => .mul k (substE σ a)\n  | .min a b => .min (substE σ a) (substE σ b)\n  | .max a b => .max (substE σ a) (substE σ b)\n  | .prod a b => .prod (substE σ a) (substE σ b)\n  | .ite c t f => .ite (substC σ c) (substE σ t) (substE σ f)\n  | .get m key => .get m (substE σ key)\ndef substC (σ : List (Nat × E)) : C → C\n  | .le a b => .le (substE σ a) (substE σ b)\n  | .lt a b => .lt (substE σ a) (substE σ b)\n  | .eq a b => .eq (substE σ a) (substE σ b)\n  | .and a b => .and (substC σ a) (substC σ b)\n  | .or a b => .or (substC σ a) (substC σ b)\n  | .not a => .not (substC σ a)\nend\n\n-- The environment after σ: each assigned variable takes its term's value, the rest keep theirs.\ndef applyS (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat :=\n  fun i => match assoc σ i with\n    | some e => evalE ρ maps e\n    | none => ρ i\n\nmutual\ntheorem subst_evalE (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → evalE ρ maps (substE σ e) = evalE (applyS σ ρ maps) maps e\n  | .var i => by\n    simp only [substE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substE, evalE]\n  | .add a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .sub a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .mul k a => by simp [substE, evalE, subst_evalE σ ρ maps a]\n  | .min a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .max a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .prod a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .ite c t f => by simp [substE, evalE, subst_evalC σ ρ maps c, subst_evalE σ ρ maps t, subst_evalE σ ρ maps f]\n  | .get m key => by simp [substE, evalE, subst_evalE σ ρ maps key]\ntheorem subst_evalC (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → evalC ρ maps (substC σ c) = evalC (applyS σ ρ maps) maps c\n  | .le a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .lt a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .eq a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .and a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .or a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .not a => by simp [substC, evalC, subst_evalC σ ρ maps a]\nend\n\nmutual\ndef occE (i : Nat) : E → Bool\n  | .var j => j == i\n  | .const _ => false\n  | .add a b => occE i a || occE i b\n  | .sub a b => occE i a || occE i b\n  | .mul _ a => occE i a\n  | .min a b => occE i a || occE i b\n  | .max a b => occE i a || occE i b\n  | .prod a b => occE i a || occE i b\n  | .ite c t f => occC i c || occE i t || occE i f\n  | .get _ key => occE i key\ndef occC (i : Nat) : C → Bool\n  | .le a b => occE i a || occE i b\n  | .lt a b => occE i a || occE i b\n  | .eq a b => occE i a || occE i b\n  | .and a b => occC i a || occC i b\n  | .or a b => occC i a || occC i b\n  | .not a => occC i a\nend\n\nmutual\ntheorem congrE (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → (∀ i, occE i e = true → ρ i = ρ' i) → evalE ρ maps e = evalE ρ' maps e\n  | .var j, h => by simp only [evalE]; exact h j (by simp [occE])\n  | .const n, _ => rfl\n  | .add a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .sub a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .mul k a, h => by simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi]))]\n  | .min a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .max a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .prod a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .ite c t f, h => by\n    simp only [evalE, congrC ρ ρ' maps c (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps t (fun i hi => h i (by simp [occE, hi])),\n      congrE ρ ρ' maps f (fun i hi => h i (by simp [occE, hi]))]\n  | .get m key, h => by simp only [evalE, congrE ρ ρ' maps key (fun i hi => h i (by simp [occE, hi]))]\ntheorem congrC (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → (∀ i, occC i c = true → ρ i = ρ' i) → evalC ρ maps c = evalC ρ' maps c\n  | .le a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .lt a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .eq a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .and a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .or a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .not a, h => by simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi]))]\nend\n\nstructure Machine where\n  inputs : List Nat\n  init : List (Nat × E)   -- each state variable's start, over the params\n  step : List (Nat × E)   -- each state variable after a request, over params, inputs and state\n  pre : C                 -- about the params alone: a precondition, so it holds at the start and at every step\n  assume : C              -- about each request (and the params); holds at a step, not at the start\n\n-- A request: its inputs replace those variables; nothing else changes until the step.\ndef withInputs (inputs : List Nat) (ρ ι : Nat → Nat) : Nat → Nat := fun i => if inputs.contains i then ι i else ρ i\n\ninductive Reach (m : Machine) (maps : Nat → Nat → Nat) : (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) : evalC ρ maps m.pre = true → Reach m maps (applyS m.init ρ maps)\n  | step (ρ ι : Nat → Nat) : Reach m maps ρ → evalC (withInputs m.inputs ρ ι) maps m.assume = true →\n      Reach m maps (applyS m.step (withInputs m.inputs ρ ι) maps)\n\ndef startGoal (m : Machine) (law : C) : List C := [m.pre, .not (substC m.init law)]\ndef stepGoal (m : Machine) (laws : List C) (law : C) : List C := [m.pre, m.assume] ++ laws ++ [.not (substC m.step law)]\n\n-- Per law: the law, then (table, tree) for its start goal and for its step goal.\nabbrev MachineProof := List (C × (List VDef × Tree) × (List VDef × Tree))\n\n-- None of `vs` occurs in c.\ndef avoids (vs : List Nat) (c : C) : Bool := vs.all fun i => !occC i c\n\n-- The precondition reads only params: no input, no variable the start or a step assigns.\ndef preOk (m : Machine) : Bool := avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre\n\ndef checkMachine (m : Machine) (ps : MachineProof) : Bool :=\n  preOk m && ps.all fun p => avoids m.inputs p.1\n    && checkGoal ⟨p.2.1.1, startGoal m p.1⟩ p.2.1.2\n    && checkGoal ⟨p.2.2.1, stepGoal m (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem avoids_occ {vs : List Nat} {c : C} (h : avoids vs c = true) {i : Nat} (hi : occC i c = true) : i ∉ vs := by\n  intro hm\n  simp only [avoids, List.all_eq_true] at h\n  have := h i hm; simp [hi] at this\n\ntheorem assoc_mem {σ : List (Nat × E)} {i : Nat} {e : E} (h : assoc σ i = some e) : i ∈ σ.map (·.1) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, _⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  simp only [beq_iff_eq] at hp\n  exact List.mem_map.mpr ⟨a, hm, hp⟩\n\n-- σ leaves every variable it doesn't assign alone.\ntheorem applyS_other {σ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    applyS σ ρ maps i = ρ i := by\n  simp only [applyS]\n  cases ha : assoc σ i with\n  | none => rfl\n  | some e => exact absurd (assoc_mem ha) h\n\ntheorem withInputs_other {inputs : List Nat} {i : Nat} (h : i ∉ inputs) (ρ ι : Nat → Nat) : withInputs inputs ρ ι i = ρ i := by\n  simp only [withInputs]; split\n  · rename_i hc; exact absurd (List.contains_iff_mem.mp hc) h\n  · rfl\n\n-- Conditions that avoid some variables read the same before and after anything that only changes those.\ntheorem evalC_avoids {vs : List Nat} {c : C} (h : avoids vs c = true) {ρ ρ' : Nat → Nat} (maps : Nat → Nat → Nat)\n    (hρ : ∀ i, i ∉ vs → ρ i = ρ' i) : evalC ρ maps c = evalC ρ' maps c :=\n  congrC ρ ρ' maps c (fun i hi => hρ i (avoids_occ h hi))\n\ntheorem pre_reach {m : Machine} (hp : preOk m = true) {maps : Nat → Nat → Nat} :\n    ∀ {ρ}, Reach m maps ρ → evalC ρ maps m.pre = true := by\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ maps)]; exact h0\n  | step ρ ι _ _ ih =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n/-- The induction rule: for params that meet the precondition, every law of an accepted machine proof holds in every\nreachable state, for any maps. -/\ntheorem machine_sound (m : Machine) (ps : MachineProof) (h : checkMachine m ps = true) (maps : Nat → Nat → Nat) :\n    ∀ ρ, Reach m maps ρ → ∀ l ∈ ps.map (·.1), evalC ρ maps l = true := by\n  simp only [checkMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨hpre, h⟩ := h\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).1.2 ρ maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [startGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · exact h0\n    · simp only [evalC, subst_evalC]; simpa using hf\n  | step ρ ι hr ha ih =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).2 (withInputs m.inputs ρ ι) maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [stepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with ((rfl | rfl) | hc) | rfl\n    · rw [evalC_avoids hpre maps (ρ' := ρ) (fun i hi => withInputs_other (fun h => hi (by simp [h])) ρ ι)]\n      exact pre_reach hpre hr\n    · exact ha\n    · obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hc\n      rw [evalC_avoids (h q hq).1.1 maps (ρ' := ρ) (fun i hi => withInputs_other hi ρ ι)]\n      exact ih q.1 (List.mem_map.mpr ⟨q, hq, rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa using hf\n\n/-! Loops: termination. A loop runs `body` while `guard` holds, each turn reading fresh inputs that meet `assume`. That it\nhalts is a liveness of its machine (Live.lean's Loop.machine and loop_halts_of): from anywhere, the guard fails later. -/\n\nstructure Loop where\n  inputs : List Nat\n  init : List (Nat × E)\n  body : List (Nat × E)\n  guard : C               -- while\n  pre : C                 -- about the params alone\n  assume : C              -- about each turn's inputs\n\n-- One turn: some inputs meeting the assumption, the guard holds, the body runs.\ndef Turn (l : Loop) (maps : Nat → Nat → Nat) (ρ ρ' : Nat → Nat) : Prop :=\n  ∃ ι, evalC (withInputs l.inputs ρ ι) maps l.guard = true ∧ evalC (withInputs l.inputs ρ ι) maps l.assume = true ∧\n    ρ' = applyS l.body (withInputs l.inputs ρ ι) maps\n\n/-! Folds over binary trees: structural induction. Each leaf and node carries its own inputs; a leaf's state comes from\nits inputs, a node's from its children's (read through copies of the state variables, one per side) and its inputs.\nThe goals are built here: each law holds at every leaf, and at a node whenever every law holds at both children. -/\n\nstructure Fold where\n  inputs : List Nat\n  state : List (Nat × Nat × Nat)   -- a state variable, its copy for the left child, its copy for the right child\n  leaf : List (Nat × E)\n  node : List (Nat × E)\n  pre : C\n  assume : C\n\ninductive BTree where\n  | leaf (ι : Nat → Nat)\n  | node (ι : Nat → Nat) (l r : BTree)\n\n-- A node's environment: each copy reads the child's state variable.\ndef withChildren (f : Fold) (env a b : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun e => e.2.1 == i) f.state with\n  | some e => a e.1\n  | none => match lookup (fun e => e.2.2 == i) f.state with\n    | some e => b e.1\n    | none => env i\n\ndef foldT (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Nat → Nat\n  | .leaf ι => applyS f.leaf (withInputs f.inputs ρ ι) maps\n  | .node ι l r => applyS f.node (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps\n\n-- Every leaf's and node's inputs meet the assumption.\ndef Allowed (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Prop\n  | .leaf ι => evalC (withInputs f.inputs ρ ι) maps f.assume = true\n  | .node ι l r => evalC (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps f.assume = true\n      ∧ Allowed f ρ maps l ∧ Allowed f ρ maps r\n\ndef leftSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.1)\ndef rightSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.2)\n\ndef leafGoal (f : Fold) (law : C) : List C := [f.pre, f.assume, .not (substC f.leaf law)]\ndef nodeGoal (f : Fold) (laws : List C) (law : C) : List C :=\n  [f.pre, f.assume] ++ laws.flatMap (fun h => [substC (leftSub f) h, substC (rightSub f) h]) ++ [.not (substC f.node law)]\n\n-- Variables a fold changes or reads per tree: inputs, the copies, and whatever a leaf or node assigns.\ndef touched (f : Fold) : List Nat :=\n  f.inputs ++ f.state.map (·.2.1) ++ f.state.map (·.2.2) ++ f.leaf.map (·.1) ++ f.node.map (·.1)\n-- Copies name one state variable each, and no right copy is a left copy.\ndef copiesOk (f : Fold) : Bool :=\n  f.state.all fun e => f.state.all fun e' => (e.2.1 != e'.2.1 || e.1 == e'.1) && (e.2.2 != e'.2.2 || e.1 == e'.1) && e.2.2 != e'.2.1\n\n-- Per law: the law, then (table, tree) for its leaf goal and its node goal.\nabbrev FoldProof := MachineProof\n\ndef checkFold (f : Fold) (ps : FoldProof) : Bool :=\n  copiesOk f && avoids (touched f) f.pre\n    && ps.all fun p => avoids ((touched f).filter fun i => !(f.state.map (·.1)).contains i) p.1\n      && checkGoal ⟨p.2.1.1, leafGoal f p.1⟩ p.2.1.2\n      && checkGoal ⟨p.2.2.1, nodeGoal f (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem lookup_none {α : Type} {p : α → Bool} {l : List α} (h : ∀ a ∈ l, p a = false) : lookup p l = none := by\n  cases hl : lookup p l with\n  | none => rfl\n  | some a => have := lookup_some hl; simp [h a this.1] at this\n\ntheorem lookup_none_all {α : Type} {p : α → Bool} : ∀ {l : List α}, lookup p l = none → ∀ a ∈ l, p a = false\n  | [], _, a, ha => by simp at ha\n  | b :: bs, h, a, ha => by\n    simp only [lookup] at h\n    split at h\n    · simp at h\n    · rcases List.mem_cons.mp ha with rfl | ha\n      · simpa using (by assumption : ¬ p a = true)\n      · exact lookup_none_all h a ha\n\ntheorem withChildren_plain (f : Fold) (env a b : Nat → Nat) {i : Nat} (hl : i ∉ f.state.map (·.2.1))\n    (hr : i ∉ f.state.map (·.2.2)) : withChildren f env a b i = env i := by\n  simp only [withChildren]\n  rw [lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hl (List.mem_map.mpr ⟨e, he, h⟩)),\n    lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hr (List.mem_map.mpr ⟨e, he, h⟩))]\n\ntheorem withChildren_left {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.1 = a e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  cases h : lookup (fun e' => e'.2.1 == e.2.1) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.1\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem withChildren_right {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.2 = b e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  rw [lookup_none (fun e' he' => by simp only [beq_eq_false_iff_ne]; intro h; exact (hc e he e' he').2 h.symm)]\n  cases h : lookup (fun e' => e'.2.2 == e.2.2) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.2\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem foldT_other (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) {i : Nat} (hi : i ∉ touched f) :\n    ∀ t, foldT f ρ maps t i = ρ i\n  | .leaf ι => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n  | .node ι l r => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h]))\n      (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n\ntheorem assoc_map {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} {x : E}\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = some x) : ∃ e ∈ s, e.1 = i ∧ x = .var (g e) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, rfl⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hm\n  simp only [beq_iff_eq] at hp\n  exact ⟨e, he, hp, rfl⟩\n\ntheorem assoc_map_none {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∉ s.map (·.1)) :\n    assoc (s.map fun e => (e.1, E.var (g e))) i = none := by\n  cases h : assoc (s.map fun e => (e.1, E.var (g e))) i with\n  | none => rfl\n  | some x => obtain ⟨e, he, rfl, -⟩ := assoc_map h; exact absurd (List.mem_map.mpr ⟨e, he, rfl⟩) hi\n\ntheorem assoc_map_some {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∈ s.map (·.1))\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = none) : False := by\n  simp only [assoc, Option.map_eq_none_iff] at h\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hi\n  have := lookup_none_all h (e.1, E.var (g e)) (List.mem_map.mpr ⟨e, he, rfl⟩)\n  simp at this\n\n-- With no assumption (the trivially true one), every tree is allowed.\ntheorem allowed_trivial (f : Fold) (h : f.assume = .le (.const 0) (.const 0)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ∀ t, Allowed f ρ maps t\n  | .leaf ι => by simp [Allowed, h, evalC, evalE]\n  | .node ι l r => ⟨by simp [h, evalC, evalE], allowed_trivial f h ρ maps l, allowed_trivial f h ρ maps r⟩\n\n/-- Structural induction: for params that meet the precondition, every law of an accepted fold proof holds of every\ntree whose inputs meet the assumption, for any maps. -/\ntheorem fold_sound (f : Fold) (ps : FoldProof) (h : checkFold f ps = true) (maps : Nat → Nat → Nat) (ρ : Nat → Nat)\n    (h0 : evalC ρ maps f.pre = true) : ∀ t, Allowed f ρ maps t → ∀ l ∈ ps.map (·.1), evalC (foldT f ρ maps t) maps l = true := by\n  simp only [checkFold, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hc, hpre⟩, h⟩ := h\n  have preAt : ∀ env : Nat → Nat, (∀ i, i ∉ touched f → env i = ρ i) → evalC env maps f.pre = true := fun env he => by\n    rw [evalC_avoids hpre maps (ρ' := ρ) he]; exact h0\n  -- What a law reads: the state variables, or variables no tree changes.\n  have reads : ∀ q ∈ ps, ∀ i, occC i q.1 = true → i ∈ f.state.map (·.1) ∨ i ∉ touched f := by\n    intro q hq i hi\n    by_cases hs : i ∈ f.state.map (·.1)\n    · exact Or.inl hs\n    · refine Or.inr fun ht => avoids_occ (h q hq).1.1 hi ?_\n      simp only [List.mem_filter, ht, true_and, Bool.not_eq_true', List.contains_iff_mem]\n      simpa using hs\n  intro t\n  induction t with\n  | leaf ι =>\n    intro ha l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).1.2 (withInputs f.inputs ρ ι) maps\n    intro c hc\n    simp only [leafGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl | rfl\n    · exact preAt _ (fun i hi => withInputs_other (fun h => hi (by simp [touched, h])) ρ ι)\n    · exact ha\n    · simp only [evalC, subst_evalC]; simpa [foldT] using hn\n  | node ι lt rt ihl ihr =>\n    intro ha l hl\n    obtain ⟨hA, hal, har⟩ := ha\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    let Env := withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps lt) (foldT f ρ maps rt)\n    -- A law at a child, read through that side's copies.\n    have side : ∀ (g : Nat × Nat × Nat → Nat) (child : BTree),\n        (∀ e ∈ f.state, Env (g e) = foldT f ρ maps child e.1) → ∀ q ∈ ps,\n        evalC Env maps (substC (f.state.map fun e => (e.1, E.var (g e))) q.1) = evalC (foldT f ρ maps child) maps q.1 := by\n      intro g child hg q hq\n      rw [subst_evalC]\n      refine congrC _ _ maps q.1 (fun i hi => ?_)\n      cases hx : assoc (f.state.map fun e => (e.1, E.var (g e))) i with\n      | some x =>\n        obtain ⟨e, he, rfl, rfl⟩ := assoc_map hx\n        simp only [applyS, hx, evalE]; exact hg e he\n      | none =>\n        have hs : i ∉ f.state.map (·.1) := fun hm => assoc_map_some (g := g) hm hx\n        have ht : i ∉ touched f := (reads q hq i hi).resolve_left hs\n        simp only [applyS, hx, Env]\n        rw [withChildren_plain _ _ _ _ (fun h => ht (by simp [touched, h])) (fun h => ht (by simp [touched, h])),\n          withInputs_other (fun h => ht (by simp [touched, h])), foldT_other f ρ maps ht]\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).2 Env maps\n    intro c hc'\n    simp only [nodeGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false,\n      List.mem_flatMap] at hc'\n    rcases hc' with ((rfl | rfl) | ⟨q, hq, hcq⟩) | rfl\n    · exact preAt Env (fun i hi => by\n        simp only [Env]\n        rw [withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h])) (fun h => hi (by simp [touched, h])),\n          withInputs_other (fun h => hi (by simp [touched, h]))])\n    · exact hA\n    · obtain ⟨q', hq', rfl⟩ := List.mem_map.mp hq\n      rcases hcq with rfl | rfl\n      · simp only [leftSub]\n        rw [side (·.2.1) lt (fun e he => withChildren_left hc _ _ _ he) q' hq']\n        exact ihl hal _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n      · simp only [rightSub]\n        rw [side (·.2.2) rt (fun e he => withChildren_right hc _ _ _ he) q' hq']\n        exact ihr har _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa [foldT, Env] using hn\n\n/-! Step machines with maps. A step may write each map at one key (read-over-write: a read after the step is the\nwritten value at the written key, the old cell elsewhere). A law may hold at every key: it is proven at a fresh skolem\nvariable and assumed, before the step, at whatever keys the proof names (instantiating ∀ is sound at any term). The\ngoals are built here, as for scalar machines. -/\n\nmutual\ndef readsE : E → Bool\n  | .var _ => false\n  | .const _ => false\n  | .add a b => readsE a || readsE b\n  | .sub a b => readsE a || readsE b\n  | .mul _ a => readsE a\n  | .min a b => readsE a || readsE b\n  | .max a b => readsE a || readsE b\n  | .prod a b => readsE a || readsE b\n  | .ite c t f => readsC c || readsE t || readsE f\n  | .get _ _ => true\ndef readsC : C → Bool\n  | .le a b => readsE a || readsE b\n  | .lt a b => readsE a || readsE b\n  | .eq a b => readsE a || readsE b\n  | .and a b => readsC a || readsC b\n  | .or a b => readsC a || readsC b\n  | .not a => readsC a\nend\n\nmutual\ntheorem noReadsE (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (e : E) → readsE e = false → evalE ρ M e = evalE ρ M' e\n  | .var _, _ => rfl\n  | .const _, _ => rfl\n  | .add a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .sub a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .mul _ a, h => by simp only [readsE] at h; simp only [evalE, noReadsE ρ M M' a h]\n  | .min a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .max a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .prod a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .ite c t f, h => by\n    simp only [readsE, Bool.or_eq_false_iff] at h\n    simp only [evalE, noReadsC ρ M M' c h.1.1, noReadsE ρ M M' t h.1.2, noReadsE ρ M M' f h.2]\n  | .get _ _, h => by simp [readsE] at h\ntheorem noReadsC (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (c : C) → readsC c = false → evalC ρ M c = evalC ρ M' c\n  | .le a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .lt a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .eq a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .and a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .or a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .not a, h => by simp only [readsC] at h; simp only [evalC, noReadsC ρ M M' a h]\nend\n\n-- Substitution of variables by σ and of each read by `rd` (applied to the substituted key).\nmutual\ndef substRE (σ : List (Nat × E)) (rd : Nat → E → E) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substRE σ rd a) (substRE σ rd b)\n  | .sub a b => .sub (substRE σ rd a) (substRE σ rd b)\n  | .mul k a => .mul k (substRE σ rd a)\n  | .min a b => .min (substRE σ rd a) (substRE σ rd b)\n  | .max a b => .max (substRE σ rd a) (substRE σ rd b)\n  | .prod a b => .prod (substRE σ rd a) (substRE σ rd b)\n  | .ite c t f => .ite (substRC σ rd c) (substRE σ rd t) (substRE σ rd f)\n  | .get m key => rd m (substRE σ rd key)\ndef substRC (σ : List (Nat × E)) (rd : Nat → E → E) : C → C\n  | .le a b => .le (substRE σ rd a) (substRE σ rd b)\n  | .lt a b => .lt (substRE σ rd a) (substRE σ rd b)\n  | .eq a b => .eq (substRE σ rd a) (substRE σ rd b)\n  | .and a b => .and (substRC σ rd a) (substRC σ rd b)\n  | .or a b => .or (substRC σ rd a) (substRC σ rd b)\n  | .not a => .not (substRC σ rd a)\nend\n\nsection\nvariable (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M M' : Nat → Nat → Nat)\n  (hrd : ∀ m k, evalE W M (rd m k) = M' m (evalE W M k))\ninclude hrd\nmutual\ntheorem substR_evalE : (e : E) → evalE W M (substRE σ rd e) = evalE (applyS σ W M) M' e\n  | .var i => by\n    simp only [substRE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substRE, evalE]\n  | .add a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .sub a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .mul k a => by simp [substRE, evalE, substR_evalE a]\n  | .min a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .max a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .prod a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .ite c t f => by simp [substRE, evalE, substR_evalC c, substR_evalE t, substR_evalE f]\n  | .get m key => by simp only [substRE, evalE, hrd, substR_evalE key]\ntheorem substR_evalC : (c : C) → evalC W M (substRC σ rd c) = evalC (applyS σ W M) M' c\n  | .le a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .lt a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .eq a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .and a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .or a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .not a => by simp [substRC, evalC, substR_evalC a]\nend\nend\n\nstructure MMachine where\n  inputs : List Nat\n  init : List (Nat × E)\n  maps0 : List (Nat × Nat)       -- each map's value at every key at the start\n  step : List (Nat × E)\n  writes : List (Nat × E × E)    -- a map, the key it's written at and the value, over the state before the step\n  pre : C                        -- about the params alone, reading no map\n  assume : C                     -- about each request\n\ndef writeMaps (ws : List (Nat × E × E)) (W : Nat → Nat) (M : Nat → Nat → Nat) : Nat → Nat → Nat := fun m key =>\n  match lookup (fun w => w.1 == m) ws with\n  | some w => if key = evalE W M w.2.1 then evalE W M w.2.2 else M m key\n  | none => M m key\n\ndef StartMaps (m : MMachine) (M : Nat → Nat → Nat) : Prop := ∀ p ∈ m.maps0, ∀ key, M p.1 key = p.2\n\ninductive MReach (m : MMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps m M → evalC ρ M m.pre = true → MReach m (applyS m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : MReach m ρ M →\n      evalC (withInputs m.inputs ρ ι) M m.assume = true →\n      MReach m (applyS m.step (withInputs m.inputs ρ ι) M) (writeMaps m.writes (withInputs m.inputs ρ ι) M)\n\ndef upd (ρ : Nat → Nat) (i v : Nat) : Nat → Nat := fun j => if j = i then v else ρ j\n\n-- A law, and for a law about every key, the variable it holds at.\nstructure MLaw where\n  holds : C\n  key : Option Nat\n\ndef MLaw.Holds (l : MLaw) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop :=\n  match l.key with\n  | none => evalC ρ M l.holds = true\n  | some kv => ∀ v, evalC (upd ρ kv v) M l.holds = true\n\ndef rdStart (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun p => p.1 == mp) m.maps0 with\n  | some p => .const p.2\n  | none => .get mp k\ndef rdStep (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) m.writes with\n  | some w => .ite (.eq k w.2.1) w.2.2 (.get mp k)\n  | none => .get mp k\n\n-- What a goal proves: the law, at the skolem variable if it holds at every key.\ndef goalOf (l : MLaw) (sk : Nat) : C :=\n  match l.key with\n  | none => l.holds\n  | some kv => substC [(kv, .var sk)] l.holds\n\nstructure MEntry where\n  law : MLaw\n  sk : Nat                    -- the skolem variable\n  insts : List (Nat × E)      -- (law index, key): where the step goal assumes the laws about every key\n  start : List VDef × Tree\n  step : List VDef × Tree\n\ndef scalarHyps (laws : List MLaw) : List C := laws.filterMap fun l =>\n  match l.key with\n  | none => some l.holds\n  | some _ => none\ndef instHyps (laws : List MLaw) (insts : List (Nat × E)) : List C := insts.filterMap fun p =>\n  match laws[p.1]? with\n  | some l => match l.key with\n    | some kv => some (substC [(kv, p.2)] l.holds)\n    | none => none\n  | none => none\n\ndef mStartGoal (m : MMachine) (e : MEntry) : List C := [m.pre, .not (substRC m.init (rdStart m) (goalOf e.law e.sk))]\ndef mStepGoal (m : MMachine) (laws : List MLaw) (e : MEntry) : List C :=\n  [m.pre, m.assume] ++ scalarHyps laws ++ instHyps laws e.insts ++ [.not (substRC m.step (rdStep m) (goalOf e.law e.sk))]\n\n-- The skolem is fresh: no input or state variable, and nothing the machine or a law reads.\ndef skOk (m : MMachine) (laws : List MLaw) (sk : Nat) : Bool :=\n  !(m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)).contains sk && !occC sk m.pre && !occC sk m.assume\n    && laws.all (fun l => !occC sk l.holds) && m.init.all (fun p => !occE sk p.2) && m.step.all (fun p => !occE sk p.2)\n    && m.writes.all (fun w => !occE sk w.2.1 && !occE sk w.2.2)\n\ndef checkMMachine (m : MMachine) (ps : List MEntry) : Bool :=\n  avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre && !readsC m.pre\n    && ps.all fun e => avoids m.inputs e.law.holds && skOk m (ps.map (·.law)) e.sk\n      && checkGoal ⟨e.start.1, mStartGoal m e⟩ e.start.2\n      && checkGoal ⟨e.step.1, mStepGoal m (ps.map (·.law)) e⟩ e.step.2\n\ntheorem occ_false {i : Nat} {c : C} (h : (!occC i c) = true) : occC i c = false := by simpa using h\n\n-- A law reads the same at the skolem as it holds at every key.\ntheorem goalOf_holds (l : MLaw) {sk : Nat} (hs : occC sk l.holds = false) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    (∀ v, evalC (upd ρ sk v) M (goalOf l sk) = true) → l.Holds ρ M := by\n  intro h\n  unfold MLaw.Holds\n  unfold goalOf at h\n  split\n  · rename_i hk\n    simp only [hk] at h\n    have := h 0\n    rwa [congrC _ ρ M l.holds (fun i hi => by simp only [upd]; split <;> simp_all)] at this\n  · rename_i kv hk\n    simp only [hk] at h\n    intro v\n    have := h v\n    rw [subst_evalC] at this\n    rwa [congrC _ (upd ρ kv v) M l.holds (fun i hi => by\n      simp only [applyS, assoc, lookup, upd]\n      by_cases hik : i = kv\n      · subst hik; simp [evalE, upd]\n      · have hb : (kv == i) = false := by simp; omega\n        simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik]\n        split <;> simp_all)] at this\n\ntheorem pre_mreach {m : MMachine} (hp : avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre = true)\n    (hr : readsC m.pre = false) : ∀ {ρ M}, MReach m ρ M → evalC ρ M m.pre = true := by\n  intro ρ M h\n  induction h with\n  | start ρ M _ h0 =>\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M)]; exact h0\n  | step ρ M ι _ _ ih =>\n    rw [noReadsC _ _ M m.pre hr]\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n-- With a fresh skolem, σ commutes with setting it.\ntheorem applyS_upd {σ : List (Nat × E)} {sk : Nat} (hk : sk ∉ σ.map (·.1)) (he : σ.all (fun p => !occE sk p.2) = true)\n    (W : Nat → Nat) (M : Nat → Nat → Nat) (v : Nat) : applyS σ (upd W sk v) M = upd (applyS σ W M) sk v := by\n  funext i\n  simp only [upd]\n  by_cases hi : i = sk\n  · subst hi; rw [applyS_other hk]; simp [upd]\n  · simp only [hi, ite_false, applyS]\n    cases h : assoc σ i with\n    | none => simp [upd, hi]\n    | some e =>\n      simp only [assoc, Option.map_eq_some_iff] at h\n      obtain ⟨p, hp, rfl⟩ := h\n      have hm := (lookup_some hp).1\n      simp only [List.all_eq_true] at he\n      have := he p hm\n      exact congrE _ _ M p.2 (fun j hj => by simp only [upd]; split <;> simp_all)\n\n/-- The induction rule with maps: for params that meet the precondition and maps that start as declared, every law of\nan accepted proof holds in every reachable state (a law about every key, at every key). -/\ntheorem mmachine_sound (m : MMachine) (ps : List MEntry) (h : checkMMachine m ps = true) :\n    ∀ ρ M, MReach m ρ M → ∀ e ∈ ps, e.law.Holds ρ M := by\n  simp only [checkMMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hpre, hrp⟩, h⟩ := h\n  simp only [Bool.not_eq_true'] at hrp\n  have hsk : ∀ e ∈ ps, _ := fun e he => (h e he).1.1.2\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 =>\n    intro e he\n    obtain ⟨⟨⟨_, hs⟩, hst⟩, _⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, _⟩, hslaw⟩, hsinit⟩, _⟩, _⟩ := hs\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ M (fun v => ?_)\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd ρ e.sk v) M\n    intro c hc\n    simp only [mStartGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by simp only [upd]; split <;> simp_all)]; exact h0\n    · have hrd : ∀ mp k, evalE (upd ρ e.sk v) M (rdStart m mp k) = M mp (evalE (upd ρ e.sk v) M k) := by\n        intro mp k\n        simp only [rdStart]\n        split\n        · rename_i p hp\n          have ⟨hm, hq⟩ := lookup_some hp\n          simp only [beq_iff_eq] at hq\n          simp only [evalE]; rw [← hq, hM p hm]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M M hrd]\n      rw [applyS_upd (fun h => by simp [h] at hfresh) (by simpa [List.all_eq_true] using hsinit)]\n      simpa using hn\n  | step ρ M ι hr ha ih =>\n    intro e he\n    obtain ⟨⟨⟨hin, hs⟩, _⟩, hst⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, hsas⟩, hslaw⟩, _⟩, hsstep⟩, hsw⟩ := hs\n    have hfresh' : e.sk ∉ m.inputs ∧ e.sk ∉ m.step.map (·.1) := by\n      constructor <;> intro hm <;> simp [hm] at hfresh\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ _ (fun v => ?_)\n    let W0 := withInputs m.inputs ρ ι\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd W0 e.sk v) M\n    -- Reading a law about the state before the step, at the goal's environment.\n    have before : ∀ (l : MLaw), l ∈ ps.map (·.law) → ∀ (g : Nat → Nat), (∀ i, i ∉ m.inputs → i ≠ e.sk → g i = ρ i) →\n        avoids m.inputs l.holds = true → occC e.sk l.holds = false → ∀ c, c = l.holds → evalC g M c = evalC ρ M l.holds := by\n      intro l _ g hg hl hsl c hc; subst hc\n      exact congrC _ _ M l.holds (fun i hi => hg i (avoids_occ hl hi) (by intro h'; subst h'; simp [hsl] at hi))\n    intro c hc\n    simp only [mStepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with (((rfl | rfl) | hc) | hc) | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by\n        simp only [upd, W0]\n        split\n        · rename_i h'; subst h'; simp [hspre] at hi\n        · exact withInputs_other (fun hm => avoids_occ hpre hi (by simp [hm])) ρ ι)]\n      exact pre_mreach hpre hrp hr\n    · rw [congrC _ W0 M m.assume (fun i hi => by simp only [upd]; split <;> simp_all)]; exact ha\n    · simp only [scalarHyps, List.mem_filterMap] at hc\n      obtain ⟨l, hl, hk⟩ := hc\n      split at hk\n      · rename_i hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl\n        have := ih e' he'\n        simp only [MLaw.Holds, hkey] at this\n        rw [before e'.law hl _ (fun i hi hs' => by simp only [upd, hs', ite_false, W0]; exact withInputs_other hi ρ ι)\n          (h e' he').1.1.1 (by simpa using hslaw e'.law hl) _ rfl]\n        exact this\n      · simp at hk\n    · simp only [instHyps, List.mem_filterMap] at hc\n      obtain ⟨p, _, hk⟩ := hc\n      split at hk\n      · rename_i l hl\n        split at hk\n        · rename_i kv hkey\n          simp only [Option.some.injEq] at hk; subst hk\n          have hlm : l ∈ ps.map (·.law) := List.mem_of_getElem? hl\n          obtain ⟨e', he', rfl⟩ := List.mem_map.mp hlm\n          have := ih e' he'\n          simp only [MLaw.Holds, hkey] at this\n          rw [subst_evalC]\n          have hsl : occC e.sk e'.law.holds = false := by simpa using hslaw e'.law hlm\n          rw [congrC _ (upd ρ kv (evalE (upd W0 e.sk v) M p.2)) M e'.law.holds (fun i hi => by\n            simp only [applyS, assoc, lookup, upd]\n            by_cases hik : i = kv\n            · subst hik; simp\n            · have hb : (kv == i) = false := by simp; omega\n              have hs' : i ≠ e.sk := by intro h'; subst h'; simp [hsl] at hi\n              simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik, hs', W0]\n              exact withInputs_other (avoids_occ (h e' he').1.1.1 hi) ρ ι)]\n          exact this _\n        · simp at hk\n      · simp at hk\n    · have hrd : ∀ mp k, evalE (upd W0 e.sk v) M (rdStep m mp k) = writeMaps m.writes W0 M mp (evalE (upd W0 e.sk v) M k) := by\n        intro mp k\n        simp only [rdStep, writeMaps]\n        split\n        · rename_i w hw\n          have hm := (lookup_some hw).1\n          have h1 := hsw w hm\n          try simp only [Bool.and_eq_true, Bool.not_eq_true'] at h1\n          have e1 : evalE (upd W0 e.sk v) M w.2.1 = evalE W0 M w.2.1 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          have e2 : evalE (upd W0 e.sk v) M w.2.2 = evalE W0 M w.2.2 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          simp only [evalE, evalC, e1, e2]\n          by_cases hk : evalE (upd W0 e.sk v) M k = evalE W0 M w.2.1 <;> simp [hk]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M _ hrd]\n      rw [applyS_upd hfresh'.2 (by simpa [List.all_eq_true] using hsstep)]\n      simpa using hn\n\nend Kern\n\n#print axioms Kern.sound\n#print axioms Kern.machine_sound\n#print axioms Kern.fold_sound\n#print axioms Kern.mmachine_sound\n",
     "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 Sets\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 sets (`SMachine`: maps, flags, sets a request carries, conditions\nat every key, writes at every key) 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 (`checkSMachine`), every law holds in every state the history semantics\nreaches. A step reads its request through the machine's view (`sView`): its flags decided, its quantified flags,\nthe maps it carries; sums, queries and relations read none of those. 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  s : SMachine                  -- 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.s.f.m.inputs.filter fun i => !(h.queries.map (·.1)).contains i\n\n-- The request's inputs: the plain ones from ι, each query from the history.\ndef reqIn (h : HMachine) (ρ ι : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat :=\n  withQueries h (withInputs (plainInputs h) ρ ι) M hist\n-- The request as the step reads it: the machine's view with those inputs and the maps κ it carries (flags decided).\nnoncomputable def reqEnv (h : HMachine) (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat :=\n  (sView h.s ρ M (reqIn h ρ ι M hist) κ).1\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.s.f.m M → evalC ρ M h.s.f.m.pre = true →\n      (∀ l ∈ h.s.facts, l.Holds ρ M) → h.s.PFacts ρ M → HReach h (withSums h (applyS h.s.f.m.init ρ M) M []) M []\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : HReach h ρ M hist →\n      evalC (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) h.s.f.m.assume = true →\n      HReach h (withSums h (applyS h.s.f.m.step (reqEnv h ρ ι κ M hist) (withCarried h.s M κ)) (withCarried h.s M κ)\n          (kept h (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) hist))\n        (everyMaps h.s (reqEnv h ρ ι κ M hist) (withCarried h.s M κ)) (kept h (reqEnv h ρ ι κ M hist) (withCarried h.s 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) : SMachine :=\n  { h.s with f := ⟨{ h.s.f.m with\n      init := h.s.f.m.init ++ h.sums.map fun p => (p.1, .const 0),\n      step := h.s.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2),\n      assume := .and h.s.f.m.assume (relsC h.rels) }, h.s.f.flags⟩ }\n\n-- The variables a step decides: its flags, its quantified flags and their witnesses.\ndef fvs (h : HMachine) : List Nat := flagVars h.s.f.flags ++ h.s.qVars ++ h.s.wVars\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.s.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.s.f.m.inputs\n  let qs := h.queries.map (·.1)\n  let ss := h.sums.map (·.1)\n  let st := h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1)\n  let fv := fvs h\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.s.f.m.pre && !readsC h.s.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 SEntry) (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    && checkSMachine 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.s.f.m.inputs\n  rec_in : ∀ i ∈ h.record, i ∈ plainInputs h\n  ss_out : ∀ s ∈ h.sums.map (·.1), s ∉ h.s.f.m.inputs ∧ s ∉ h.s.f.m.init.map (·.1) ∧ s ∉ h.s.f.m.step.map (·.1) ∧\n    s ∉ fvs h ∧ s ∉ h.rvars\n  rv_out : ∀ v ∈ h.rvars, v ∉ h.s.f.m.inputs ∧ v ∉ h.s.f.m.init.map (·.1) ∧ v ∉ h.s.f.m.step.map (·.1) ∧ v ∉ fvs h\n  fv_out : ∀ v ∈ fvs h, v ∉ h.s.f.m.inputs\n  sums_ok : ∀ p ∈ h.sums, avoidsE (h.s.f.m.inputs ++ (h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1)) ++ h.sums.map (·.1)\n    ++ fvs h) p.2 = true ∧ readsE p.2 = false\n  queries_ok : ∀ p ∈ h.queries, avoidsE (h.queries.map (·.1) ++ (h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1))\n    ++ h.sums.map (·.1) ++ fvs h) p.2 = true ∧ readsE p.2 = false\n  rels_ok : ∀ r ∈ h.rels, avoids (h.queries.map (·.1) ++ (h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1)) ++ h.sums.map (·.1)\n    ++ fvs h ++ 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.s.f.m.inputs ++ fvs h ++ h.rvars) h.s.f.m.pre = true ∧ readsC h.s.f.m.pre = false\n  rels_reads : ∀ r ∈ h.rels, readsC r.1 = 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  · intro r hr; have := hrels r hr; simp only [Bool.and_eq_true] at this; simpa using this.1.1.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.s.f.m.inputs := fun _ hi => (List.mem_filter.mp hi).1\n\ntheorem decideQ_other {s : SMachine} {v : Nat} (hv : v ∉ s.qVars) (X : Nat → Nat) (N : Nat → Nat → Nat) : decideQ s X N v = X v := by\n  have : 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 hv (by rw [← he]; exact List.mem_map_of_mem hq))\n  simp only [decideQ, this]\n\n-- What the view reads at a variable the step doesn't decide: the request's inputs, else the state.\ntheorem reqEnv_undecided (h : HMachine) {i : Nat} (hf : i ∉ fvs h) (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) :\n    reqEnv h ρ ι κ M hist i = withInputs h.s.f.m.inputs ρ (reqIn h ρ ι M hist) i := by\n  simp only [fvs, List.mem_append, not_or] at hf\n  simp only [reqEnv, sView]\n  rw [decide_other hf.1.1, decideQ_other hf.1.2]\n\ntheorem reqEnv_other {h : HMachine} (_ok : HOk h) {i : Nat} (hin : i ∉ h.s.f.m.inputs) (hf : i ∉ fvs h)\n    (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : reqEnv h ρ ι κ M hist i = ρ i := by\n  rw [reqEnv_undecided h hf]; exact withInputs_other hin ρ _\n\n-- A query reads its sum over the history.\ntheorem reqEnv_query {h : HMachine} (ok : HOk h) {q : Nat} {g : E} (hg : assoc h.queries q = some g) (hf : q ∉ fvs h)\n    (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) :\n    reqEnv h ρ ι κ M hist q = sumAt h (withInputs (plainInputs h) ρ ι) M hist g := by\n  rw [reqEnv_undecided h hf]\n  have hin : q ∈ h.s.f.m.inputs := ok.qs_in q (assoc_mem hg)\n  simp only [withInputs, List.contains_iff_mem, hin, ite_true, reqIn, withQueries, hg]\n\n-- Any other variable the step doesn't decide reads the plain request.\ntheorem reqEnv_plain {h : HMachine} (_ok : HOk h) {i : Nat} (hq : i ∉ h.queries.map (·.1)) (hf : i ∉ fvs h)\n    (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) :\n    reqEnv h ρ ι κ M hist i = withInputs (plainInputs h) ρ ι i := by\n  rw [reqEnv_undecided h hf]\n  by_cases hin : i ∈ h.s.f.m.inputs\n  · simp only [withInputs, List.contains_iff_mem, hin, ite_true, reqIn, withQueries, assoc_none_of hq]\n  · rw [withInputs_other hin, 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 _ _ _ _ s g hs\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.s.f.m.pre = true)\n    (ι : Nat → Nat) (κ : Nat → 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 ∉ fvs h := fun hf => ok.fv_out v hf (ok.qs_in v hq)\n      show reqEnv h ρ ι κ M hist v = _\n      rw [reqEnv_query ok hg hvf]\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_plain ok this.1.1.1 this.2 ρ ι κ M hist).symm)\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.s.f.m.pre = true := by\n      have hp := ok.pre_ok.1\n      rw [congrC X ρ M h.s.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.f.m.init ρ M = withSums h (applyS h.s.f.m.init ρ M) M [] := by\n  funext i\n  show applyS (h.s.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.s.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.s.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 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.f.m.step X M = withSums h (applyS h.s.f.m.step X M) M (kept h X M hist) := by\n  funext i\n  show applyS (h.s.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.s.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.s.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.s.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.s.f.m.step X M) M (kept h X M hist) i = sumAt h (applyS h.s.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.s.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.s.f.m.step X M) M (kept h X M hist) i = applyS h.s.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.s.f.m.step i with\n    | some e => rfl\n    | none => simp only [hB]\n\n-- Relations read no map: `when` reads none, and each side is a homogeneous term of variables.\ntheorem homog_noreads {vs : List Nat} : ∀ e : E, homog vs e = true → readsE e = false\n  | .var _, _ => rfl\n  | .const _, h => by simp [homog] at h\n  | .add a b, h => by simp only [homog, Bool.and_eq_true] at h; simp only [readsE, homog_noreads a h.1, homog_noreads b h.2, Bool.or_self]\n  | .sub _ _, h => by simp [homog] at h\n  | .mul _ a, h => by simp only [homog] at h; simp only [readsE, homog_noreads a 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\n\ntheorem relsC_noreads {h : HMachine} (ok : HOk h) : ∀ rs : List (C × E × E), (∀ r ∈ rs, r ∈ h.rels) → readsC (relsC rs) = false\n  | [], _ => rfl\n  | r :: rs, hin => by\n    have hr := hin r List.mem_cons_self\n    obtain ⟨_, ha, hb⟩ := ok.rels_ok r hr\n    simp only [relsC, List.foldr_cons, readsC, relC, ok.rels_reads r hr, homog_noreads _ ha, homog_noreads _ hb, Bool.or_self, Bool.false_or]\n    exact relsC_noreads ok rs (fun r' h' => hin r' (List.mem_cons_of_mem _ h'))\n\ntheorem hreach_sreach {h : HMachine} (ps : List SEntry) (ok : HOk h)\n    (hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true)\n    (hsm : checkSMachine h.plain ps = true) : ∀ {ρ M hist}, HReach h ρ M hist → SReach h.plain ρ M := by\n  obtain ⟨hpreS, hrp⟩ := spre_parts hsm\n  intro ρ M hist hr\n  induction hr with\n  | start ρ M hM h0 hf hpf =>\n    rw [← start_eq ok]\n    exact SReach.start (s := h.plain) ρ M hM h0 hf hpf\n  | step ρ M hist ι κ hr ha ih =>\n    have hsum := hsum_of_hreach ok hr\n    have hp := pre_sreach h.plain hpreS hrp ih\n    -- The plain machine reads the request as the history's step does, with the relations assumed of it.\n    have hass : evalC (sView h.plain ρ M (reqIn h ρ ι M hist) κ).1 (sView h.plain ρ M (reqIn h ρ ι M hist) κ).2 h.plain.f.m.assume = true := by\n      show evalC (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) (.and h.s.f.m.assume (relsC h.rels)) = true\n      simp only [evalC, Bool.and_eq_true]\n      refine ⟨ha, ?_⟩\n      rw [noReadsC _ _ M _ (relsC_noreads ok h.rels (fun r hr' => hr'))]\n      exact rels_hold ok hrs hsum hp ι κ\n    have hstep := SReach.step (s := h.plain) ρ M (reqIn h ρ ι M hist) κ ih hass\n    have hX : ∀ s g, assoc h.sums s = some g →\n        reqEnv h ρ ι κ M hist s = sumAt h (reqEnv h ρ ι κ M hist) (withCarried h.s 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, sumAt_maps h _ (withCarried h.s M κ) M hist g hok.2]\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) (withCarried h.s M κ) hist hX\n    show SReach h.plain (withSums h (applyS h.s.f.m.step (reqEnv h ρ ι κ M hist) (withCarried h.s M κ)) (withCarried h.s M κ)\n        (kept h (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) hist)) (everyMaps h.s (reqEnv h ρ ι κ M hist) (withCarried h.s 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 SEntry) (rs : List (List VDef × Tree)) (hc : checkHMachine h ps rs = true) :\n    ∀ ρ M hist, HReach h ρ M hist → ∀ e ∈ ps, e.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⟩, hsm⟩ := 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 smachine_sound h.plain ps hsm ρ M (hreach_sreach ps ok hrs hsm 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), or at every tuple of keys (∀ k₁ … kₙ. body). 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`). A fact about several keys (`pfacts`: a function of several\narguments, a law between two points) is given at every value of its further keys, as a law about several keys holds,\nand a goal assumes it at the tuples its proof names (`pfinsts`).\n\nkernel.ts closes each quantified flag ?f in a goal: ?f ≤ 1; ?f = 0 ∨ body(t) at keys t the proof names (`qinsts`, a\ntuple of terms over several keys); and ?f = 1 ∨ ¬body(w) at fresh witnesses w, one per key (`wits`). A real step\nsatisfies these with w failing keys when ?f = 0, so a goal that refutes them refutes the machine. Lean builds the same\nclosed goals.\n-/\n\nnamespace Kern\nopen Classical\n\n/-! Certificates that name their hypotheses -/\n\n\n-- A proof tree with the table it reads, and the hypotheses it refutes: none named, the goal's own, in the goal's order;\n-- named, any of the goal's, in any order (each must be one of the goal's), so an exporter may lay its goal out its own\n-- way as long as each hypothesis it uses is one Lean builds.\nabbrev Cert := List VDef × List C × Tree\ndef checkIn (hyps : List C) (k : Cert) : Bool :=\n  if k.2.1.isEmpty then checkGoal ⟨k.1, hyps⟩ k.2.2\n  else k.2.1.all (fun c => hyps.contains c) && checkGoal ⟨k.1, k.2.1⟩ k.2.2\n\ntheorem sound_in (hyps : List C) (k : Cert) (h : checkIn hyps k = true) (env : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ¬ ∀ c ∈ hyps, evalC env maps c = true := by\n  intro hH\n  unfold checkIn at h\n  split at h\n  · exact sound ⟨k.1, hyps⟩ k.2.2 h env maps hH\n  · simp only [Bool.and_eq_true, List.all_eq_true] at h\n    exact sound ⟨k.1, k.2.1⟩ k.2.2 h.2 env maps (fun c hc => hH c (List.contains_iff_mem.mp (h.1 c hc)))\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 × List Nat × C) -- (flag variable, bound keys, body): 1 when the body holds at every value of the keys, else 0\n  wits : List (Nat × List Nat)     -- (flag variable, its witness variables: one per key)\n  facts : List MLaw                -- given about the params and the functions (maps no step writes)\n  pfacts : List (MLaw × List Nat)  -- facts about several keys: the fact about its first key, and its further keys\n\ndef SMachine.qVars (s : SMachine) : List Nat := s.qflags.map (·.1)\ndef SMachine.wVars (s : SMachine) : List Nat := s.wits.flatMap (·.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-- A state with the bound keys read from v.\ndef atKeys (X : Nat → Nat) (ks : List Nat) (v : Nat → Nat) : Nat → Nat := fun i => if ks.contains i then v i else X i\n\ntheorem atKeys_in {X : Nat → Nat} {ks : List Nat} {v : Nat → Nat} {i : Nat} (h : i ∈ ks) : atKeys X ks v i = v i := by\n  simp [atKeys, List.contains_iff_mem, h]\ntheorem atKeys_out {X : Nat → Nat} {ks : List Nat} {v : Nat → Nat} {i : Nat} (h : i ∉ ks) : atKeys X ks v i = X i := by\n  simp [atKeys, List.contains_iff_mem, h]\n\n-- Each quantified flag decided: 1 where its body holds at every value of its keys, 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 ∀ k, holdsC (atKeys X q.2.1 k) 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\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-- The facts about several keys, each at every value of its further keys.\ndef SMachine.PFacts (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop := ∀ p ∈ s.pfacts, holdsOver p.1 M p.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      s.PFacts ρ M → 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 tuples the proof names.\ndef closingHyps (s : SMachine) (qinsts : List (Nat × List 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.zip 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.zip (w.2.map .var)) q.2.2))]\n          | none => [])\n\ndef trueC : C := .le (.const 0) (.const 0)\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\n-- A fact about several keys at a tuple, as a fact about its first key: each further key read as the tuple's term.\ndef pfactLaw (s : SMachine) (p : Nat × E × List E) : MLaw :=\n  match s.pfacts[p.1]? with\n  | some f => ⟨substC (f.2.zip p.2.2) f.1.holds, f.1.key⟩\n  | none => ⟨trueC, none⟩\n\n-- The facts, at the keys the proof names, and the facts about several keys at the tuples it names.\ndef factHyps (s : SMachine) (finsts : List (Nat × E)) (pfinsts : List (Nat × E × List E)) : List C :=\n  scalarHyps s.facts ++ instHyps s.facts finsts ++ instHyps (pfinsts.map (pfactLaw s)) (pairInsts 0 pfinsts)\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 : List (Nat × E)) (qinsts : List (Nat × List E)) (w : C) : List C :=\n  scalarHyps laws ++ instHyps laws insts ++ [inlineC s.f.flags s.f.m.assume, w] ++ closingHyps s qinsts\n\n-- The state after a step, named (`names`, per step but the last: each state variable and a fresh variable): the fresh\n-- variable equals the variable's term there, and later frames read it (frameSub), so a run's frames stay small.\ndef nameHyps (n : List (Nat × Nat)) (σ : List (Nat × E)) : List C := n.map (fun p => .eq (.var p.2) ((assoc σ p.1).getD (.var p.1)))\n\ndef sRun (s : SMachine) (laws : List MLaw) (insts : List (Nat × E)) (qinsts : List (Nat × List E)) :\n    List C → List (List (Nat × Nat)) → 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, ns, σ, rd =>\n    ((sFrameHyps s laws insts qinsts w).map (substRC (frameSub r σ) (frameRd mr rd))\n        ++ nameHyps (ns.headD []) (stepSub s.f (frameSub r σ) (frameRd mr rd))\n        ++ (sRun s laws insts qinsts ws rs mrs ns.tail (frameSub (ns.headD []) (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 ns.tail (frameSub (ns.headD []) (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-- Values of the keys where a quantified flag's body fails, when there are some.\nnoncomputable def witnessKeys (X : Nat → Nat) (N : Nat → Nat → Nat) (q : Nat × List Nat × C) : Nat → Nat :=\n  if h : ∃ k, ¬ holdsC (atKeys X q.2.1 k) N q.2.2 then Classical.choose h else fun _ => 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.contains v) s.wits with\n      | some w => match lookup (fun q => q.1 == w.1) s.qflags with\n        | some q => match lookup (fun p => p.2 == v) (q.2.1.zip w.2) with\n          | some p => witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q p.1\n          | none => 0\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 × List Nat)) : Bool := distinct (ws.map (·.1)) && distinct (ws.flatMap (·.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 keys are none of them\n-- and distinct; every quantified flag has a witness per key; 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 (fun w => w.1 == q.1 && w.2.length == q.2.1.length) && distinct q.2.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 && q.2.1.all (fun k => !(s.extVars ++ flagVars s.f.flags).contains k))\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 {β : Type} {p : Nat × β} {l : List (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\n-- Witnesses: distinct across the flags, each found in its flag's entry, beside its key.\ntheorem lookup_wit : ∀ {ws : List (Nat × List Nat)}, distinct (ws.flatMap (·.2)) = true → ∀ {w : Nat × List Nat} {v : Nat}, w ∈ ws → v ∈ w.2 →\n    lookup (fun w' => w'.2.contains v) ws = some w\n  | [], _, _, _, h, _ => by simp at h\n  | a :: as, hd, w, v, h, hv => by\n    simp only [List.flatMap_cons] at hd\n    obtain ⟨_, hd2, hap⟩ := distinct_append hd\n    simp only [lookup]\n    rcases List.mem_cons.mp h with rfl | h\n    · simp [List.contains_iff_mem, hv]\n    · have hna : a.2.contains v = false := by\n        have : v ∉ a.2 := fun hva => hap v hva (List.mem_flatMap.mpr ⟨w, h, hv⟩)\n        simpa [List.contains_iff_mem] using this\n      simp only [hna, Bool.false_eq_true, ite_false]\n      exact lookup_wit hd2 h hv\n\ntheorem distinct_of_flatMap : ∀ {ws : List (Nat × List Nat)}, distinct (ws.flatMap (·.2)) = true → ∀ {w : Nat × List Nat}, w ∈ ws → distinct w.2 = true\n  | [], _, _, h => by simp at h\n  | a :: as, hd, w, h => by\n    simp only [List.flatMap_cons] at hd\n    obtain ⟨hd1, hd2, _⟩ := distinct_append hd\n    rcases List.mem_cons.mp h with rfl | h\n    · exact hd1\n    · exact distinct_of_flatMap hd2 h\n\ntheorem lookup_zip_wit : ∀ {ks ws : List Nat}, distinct ws = true → ∀ {k w : Nat}, (k, w) ∈ ks.zip ws → lookup (fun p => p.2 == w) (ks.zip ws) = some (k, w)\n  | [], _, _, _, _, h => by simp at h\n  | _ :: _, [], _, _, _, h => by simp at h\n  | a :: as, b :: bs, hd, k, w, h => by\n    obtain ⟨hb, hd'⟩ := distinct_cons hd\n    simp only [List.zip_cons_cons, List.mem_cons, Prod.mk.injEq] at h\n    simp only [List.zip_cons_cons, lookup]\n    rcases h with ⟨rfl, rfl⟩ | h\n    · simp\n    · have hw : w ≠ b := fun he => hb (he ▸ (List.of_mem_zip h).2)\n      have hbw : (b == w) = false := by simp only [beq_eq_false_iff_ne]; exact fun he => hw he.symm\n      simp only [hbw, Bool.false_eq_true, ite_false]\n      exact lookup_zip_wit hd' h\n\n-- Distinct keys zipped with variables: each key reads the variable beside it.\ntheorem assoc_zip_var : ∀ {ks ws : List Nat}, distinct ks = true → ∀ {k w : Nat}, (k, w) ∈ ks.zip ws → assoc (ks.zip (ws.map E.var)) k = some (.var w)\n  | [], _, _, _, _, h => by simp at h\n  | _ :: _, [], _, _, _, h => by simp at h\n  | a :: as, b :: bs, hd, k, w, h => by\n    obtain ⟨ha, hd'⟩ := distinct_cons hd\n    simp only [List.zip_cons_cons, List.mem_cons, Prod.mk.injEq] at h\n    simp only [List.map_cons, List.zip_cons_cons, assoc, lookup]\n    rcases h with ⟨rfl, rfl⟩ | h\n    · simp\n    · have hk : k ≠ a := fun he => ha (he ▸ (List.of_mem_zip h).1)\n      have hak : (a == k) = false := by simp only [beq_eq_false_iff_ne]; exact fun he => hk he.symm\n      simp only [hak, Bool.false_eq_true, ite_false]\n      exact assoc_zip_var hd' h\n\ntheorem zip_has : ∀ {ks ws : List Nat}, ks.length = ws.length → ∀ {k : Nat}, k ∈ ks → ∃ w, (k, w) ∈ ks.zip ws\n  | [], _, _, _, h => by simp at h\n  | _ :: _, [], hl, _, _ => by simp at hl\n  | a :: as, b :: bs, hl, k, h => by\n    simp only [List.length_cons, Nat.add_right_cancel_iff] at hl\n    rcases List.mem_cons.mp h with rfl | h\n    · exact ⟨b, by simp⟩\n    · obtain ⟨w, hw⟩ := zip_has hl h\n      exact ⟨w, by simp [List.zip_cons_cons, hw]⟩\n\n-- Terms put in for the keys: the state read at the keys' values.\ntheorem applyS_zip_atKeys (ks : List Nat) (ts : List E) (X : Nat → Nat) (N : Nat → Nat → Nat) :\n    applyS (ks.zip ts) X N = atKeys X ks (applyS (ks.zip ts) X N) := by\n  funext i\n  simp only [atKeys]\n  split\n  · rfl\n  · rename_i h\n    exact applyS_other (fun hm => h (by obtain ⟨⟨a, b⟩, hp, rfl⟩ := List.mem_map.mp hm; exact List.contains_iff_mem.mpr (List.of_mem_zip hp).1)) X N\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\n      ∧ (∀ q ∈ s.qflags, (∃ w ∈ s.wits, w.1 = q.1 ∧ w.2.length = q.2.1.length) ∧ distinct q.2.1 = true)\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 ∧ ∀ k ∈ q.2.1, k ∉ 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').1, (hcov q hq').2⟩, hd, fun q hq' => ⟨(hb q hq').1, fun k hk hm => ?_⟩, hfl⟩\n  have h2 := (hb q hq').2 k hk\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 × List 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 value of the keys (read in either view: they agree on the body).\n  have hY : withExt s ρ (sReq s ρ M ι κ) q.1 = if ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (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 : ∀ k, holdsC (atKeys (withExt s ρ (sReq s ρ M ι κ)) q.2.1 k) (withCarried s M κ) q.2.2\n      ↔ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 := by\n    intro k\n    rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 (fun j hj => by\n      simp only [atKeys]; 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 : ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2\n    · right; rw [subst_evalC, applyS_zip_atKeys, evalC_iff]; exact (hbodyY _).mpr (h1 _)\n    · left; simp [hY, h1]\n  · obtain ⟨⟨w, hw, hwq, hlen⟩, hkd⟩ := hcov q hq\n    have hlw : lookup (fun w' => w'.1 == q.1) s.wits = some w := by\n      rw [← hwq]; exact lookup_unique (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 : ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2\n    · left; simp [hY, h1]\n    · right\n      have hwd' : distinct (s.wits.flatMap (·.2)) = true := by simp only [distinctPairs, Bool.and_eq_true] at hwd; exact hwd.2\n      -- Each witness reads the failing value of the key beside it.\n      have hYw : ∀ k x, (k, x) ∈ q.2.1.zip w.2 → withExt s ρ (sReq s ρ M ι κ) x = witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q k := by\n        intro k x hkx\n        have hxw : x ∈ s.wVars := List.mem_flatMap.mpr ⟨w, hw, (List.of_mem_zip hkx).2⟩\n        have hxi : x ∉ s.f.m.inputs := fun h => (hin _ h).2 hxw\n        have hxq : x ∉ s.qVars := fun h => hqw _ h hxw\n        have hext : s.extVars.contains x = true := by\n          simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inr hxw\n        have hni : s.f.m.inputs.contains x = false := by simpa [List.contains_iff_mem] using hxi\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 hxq (by rw [← he]; exact List.mem_map_of_mem hq')),\n          lookup_wit hwd' hw (List.of_mem_zip hkx).2]\n        simp only [hwq, lookup_unique hqd hq]\n        rw [lookup_zip_wit (distinct_of_flatMap hwd' hw) hkx]\n      have hex : ∃ k, ¬ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 := by simpa using h1\n      have hfail : ¬ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 (witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q)) (withCarried s M κ) q.2.2 := by\n        simp only [witnessKeys, dif_pos hex]; exact Classical.choose_spec hex\n      rw [subst_evalC]\n      cases hb : evalC (applyS (q.2.1.zip (w.2.map E.var)) (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ)) (withCarried s M κ) q.2.2\n      · rfl\n      · refine absurd ((hbodyY _).mp ((evalC_iff _ _ _).mp ?_)) hfail\n        rw [← hb]\n        apply congrC; intro j _\n        simp only [atKeys]; split\n        · rename_i hj\n          obtain ⟨x, hx⟩ := zip_has hlen.symm (List.contains_iff_mem.mp hj)\n          simp only [applyS, assoc_zip_var hkd hx, evalE]\n          exact (hYw j x hx).symm\n        · rename_i hj\n          exact (applyS_other (fun hm => hj (by obtain ⟨⟨a, b⟩, hp, rfl⟩ := List.mem_map.mp hm; exact List.contains_iff_mem.mpr (List.of_mem_zip hp).1)) _ _).symm\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 : List (Nat × E)) (qinsts : List (Nat × List 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 × List E) -- (quantified flag, keys): 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  pfinsts : List (Nat × E × List E) -- (fact index, key, further keys): where both goals assume the facts about several keys\n  start : Cert\n  step : Cert\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\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⟩\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 e.pfinsts ++ [.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 e.pfinsts ++ (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) && s.pfacts.all (fun f => avoids Z f.1.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 factsOk1 (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-- The facts about several keys alike, each about a first key apart from its further keys.\ndef pfactsOk (s : SMachine) : Bool :=\n  s.pfacts.all fun f => avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) f.1.holds\n    && avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) f.1.holds && f.2.all (fun g => f.1.key != some g)\ndef factsOk (s : SMachine) : Bool := factsOk1 s && pfactsOk s\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    && s.pfacts.all (fun f => !occC sk f.1.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        && checkIn (sStartGoal s e) e.start\n        && checkIn (sStepGoal s ps e) e.step\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\ntheorem skFresh_pfacts {s : SMachine} {sk : Nat} (h : skFresh s sk = true) : ∀ f ∈ s.pfacts, occC sk f.1.holds = false := by\n  simp only [skFresh, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h; exact h.2\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 : ∀ k, holdsC (atKeys (upd X x v) q.2.1 k) N q.2.2 ↔ holdsC (atKeys X q.2.1 k) N q.2.2 := fun k => by\n        rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys X q.2.1 k) 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 [atKeys]; split\n          · rfl\n          · simp [upd, 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, Bool.and_eq_true] at hf\n  have hf := hf.1\n  simp only [factsOk1, 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.1.2\ntheorem sTermsOk_pfacts {s : SMachine} {Z : List Nat} (h : sTermsOk s Z = true) : ∀ f ∈ s.pfacts, avoids Z f.1.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, Bool.and_eq_true] at hfok\n  have hfok := hfok.1\n  simp only [factsOk1, 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/-! Facts about several keys -/\n\n-- A law at every value of some keys, read where it reads alike, holds alike.\ntheorem holdsOver_transfer {V MS : List Nat} (l : MLaw) (hv : avoids V l.holds = true) (hm : avoidsMaps MS l.holds = true) :\n    ∀ (gs : List Nat) {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat}, Agree V ρ ρ' → (∀ mp, mp ∉ MS → M mp = M' mp) →\n      holdsOver l M' gs ρ' → holdsOver l M gs ρ\n  | [], _, _, _, _, hag, hmag, h => holds_transfer l hv hm hag hmag h\n  | g :: gs, ρ, ρ', _, _, hag, hmag, h => fun w =>\n      holdsOver_transfer l hv hm gs (ρ := upd ρ g w) (ρ' := upd ρ' g w) (fun i hi => by\n        simp only [upd]; split\n        · rfl\n        · exact hag i hi) hmag (h w)\n\n-- A law at every value of its further keys holds with each set to a term (the law about its first key, at the tuple).\ntheorem holdsOver_subst (l : MLaw) (gs : List Nat) (ts : List E) (hkk : ∀ k, l.key = some k → k ∉ gs)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (h : holdsOver l N gs Y) : (⟨substC (gs.zip ts) l.holds, l.key⟩ : MLaw).Holds Y N := by\n  have hany := holdsOver_any gs h\n  have hdom : ∀ i, i ∉ gs → i ∉ (gs.zip ts).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 : l.key with\n  | none =>\n    have h' := hany (applyS (gs.zip ts) 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 k hk\n    simp only [MLaw.Holds, hk]\n    intro v\n    rw [subst_evalC]\n    have h' := hany (fun i => if i ∈ gs then applyS (gs.zip ts) (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 ∈ gs then applyS (gs.zip ts) (upd Y k v) N i else Y i) k v = applyS (gs.zip ts) (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 ∈ gs\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\ntheorem pfactsOk_parts {s : SMachine} (h : factsOk s = true) : ∀ f ∈ s.pfacts,\n    avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) f.1.holds = true\n      ∧ avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) f.1.holds = true ∧ ∀ k, f.1.key = some k → k ∉ f.2 := by\n  simp only [factsOk, pfactsOk, Bool.and_eq_true, List.all_eq_true, bne_iff_ne, ne_eq] at h\n  intro f hf\n  obtain ⟨⟨h1, h2⟩, h3⟩ := h.2 f hf\n  exact ⟨h1, h2, fun k hk hm => h3 k hm (by rw [hk])⟩\n\n-- The facts about several keys at the tuples a goal names hold wherever the facts do.\ntheorem pfactLaws_hold (s : SMachine) (pfinsts : List (Nat × E × List E)) (hkk : ∀ f ∈ s.pfacts, ∀ k, f.1.key = some k → k ∉ f.2)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (hp : s.PFacts Y N) : ∀ l ∈ pfinsts.map (pfactLaw s), l.Holds Y N := by\n  intro l hl\n  obtain ⟨p, _, rfl⟩ := List.mem_map.mp hl\n  unfold pfactLaw\n  split\n  · rename_i f hf\n    have hfm : f ∈ s.pfacts := List.mem_of_getElem? hf\n    exact holdsOver_subst f.1 f.2 p.2.2 (hkk f hfm) (hp f hfm)\n  · simp [MLaw.Holds, trueC, evalC, evalE]\n\n-- A goal's facts all hold where the facts and the facts about several keys do.\ntheorem facthyps_true (s : SMachine) (finsts : List (Nat × E)) (pfinsts : List (Nat × E × List E)) (Y : Nat → Nat) (N : Nat → Nat → Nat)\n    (hkk : ∀ f ∈ s.pfacts, ∀ k, f.1.key = some k → k ∉ f.2) (hf : ∀ l ∈ s.facts, l.Holds Y N) (hp : s.PFacts Y N) :\n    ∀ c ∈ factHyps s finsts pfinsts, evalC Y N c = true := by\n  intro c hc\n  simp only [factHyps] at hc\n  rcases List.mem_append.mp hc with hc | hc\n  · exact laws_hyps_true s.facts finsts Y N hf c hc\n  · exact laws_hyps_true (pfinsts.map (pfactLaw s)) (pairInsts 0 pfinsts) Y N (pfactLaws_hold s pfinsts hkk hp) c (List.mem_append_right _ hc)\n\n-- The facts about several keys hold in every reachable state, and wherever what they read is the state's.\ntheorem pfacts_sreach (s : SMachine) (hf : factsOk s = true) : ∀ {ρ M}, SReach s ρ M → s.PFacts ρ M := by\n  have hf := pfactsOk_parts hf\n  intro ρ M h\n  induction h with\n  | start ρ M _ _ _ hpf =>\n    intro f hfm\n    exact holdsOver_transfer f.1 (hf f hfm).1 (MS := []) (by simp [avoidsMaps]) f.2\n      (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M) (fun _ _ => rfl) (hpf f hfm)\n  | step ρ M ι κ _ _ ih =>\n    intro f hfm\n    refine holdsOver_transfer f.1 (hf f hfm).1 (hf f hfm).2.1 f.2 (fun i hi => ?_) (fun mp hmp => ?_) (ih f hfm)\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 pfacts_frame (s : SMachine) (hfok : factsOk s = true) (Vx Mx : List Nat)\n    (hvx : ∀ f ∈ s.pfacts, avoids Vx f.1.holds = true) (hmx : ∀ f ∈ s.pfacts, avoidsMaps Mx f.1.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 : s.PFacts ρ M) : s.PFacts X N := by\n  have hp := pfactsOk_parts hfok\n  intro f hf'\n  refine holdsOver_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) f.1\n    (by have h1 := (hp f hf').1; simp only [avoids, List.all_append, Bool.and_eq_true] at hvx h1 ⊢; exact ⟨h1, hvx f hf'⟩)\n    (by have h2 := (hp f hf').2.1; simp only [avoidsMaps, List.all_append, Bool.and_eq_true] at hmx h2 ⊢; exact ⟨h2, hmx f hf'⟩) f.2\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 f hf')\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) (hpf : s.PFacts ρ 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_in _ _ 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 facthyps_true s e.finsts e.pfinsts _ M (fun f hf => (pfactsOk_parts hfok f hf).2.2)\n      (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)\n      (pfacts_frame s hfok [e.sk] [] (fun f hf => by simp [avoids, skFresh_pfacts hskf f hf])\n        (fun _ _ => by simp [avoidsMaps]) (fun i _ hik => by simp only [upd]; rw [if_neg (by simpa using hik)]) (fun _ _ _ => rfl) hpf) 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) (hpf : s.PFacts ρ 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_in _ _ 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 facthyps_true s e.finsts e.pfinsts W M0 (fun f hf => (pfactsOk_parts hfok f hf).2.2)\n      (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)\n      (pfacts_frame s hfok [e.sk] [] (fun f hf => by simp [avoids, skFresh_pfacts hskf f hf])\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)]) hpf) 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 hpfacts : ∀ {ρ : Nat → Nat} {M : Nat → Nat → Nat} {g : Nat}, skFresh s g = true → s.PFacts ρ M → ∀ w, s.PFacts (upd ρ g w) M := by\n    intro ρ M g hf hpf w\n    exact pfacts_frame s hfok [g] [] (fun f hfm => by simp [avoids, skFresh_pfacts hf f hfm]) (fun _ _ => by simp [avoidsMaps])\n      (fun i _ hig' => by simp only [upd]; rw [if_neg (by simpa using hig')]) (fun _ _ _ => rfl) hpf\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 hpf =>\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        s.PFacts ρ' M → holdsOver e.law M gs (applyS s.f.m.init ρ' M) from hs e.keys2 (fun g hg => hg) ρ h0 hfa hpf\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf hq; exact sstart_case s ps h ρ' M hM hp hf hq e he\n    | cons g gs ih =>\n      intro hsub ρ' hp hf hq 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) (hpfacts hfr hq 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        s.PFacts ρ' M → (∀ 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) (pfacts_sreach s hfok hr) ih ha\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf hq hi ha'; exact sstep_case s ps h ρ' M ι κ hp hf hq hi ha' e he\n    | cons g gs ihg =>\n      intro hsub ρ' hp hf hq 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) (hpfacts hfr hq 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 × List E)     -- (quantified flag, keys): 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  pfinsts : List (Nat × E × List E) -- (fact index, key, further keys): where the goal assumes the facts about several keys\n  used : List C                    -- the hypotheses the tree refutes ([] for the goal's own, in its order)\n  names : List (List (Nat × Nat))  -- per step but the last: (state variable, the fresh variable naming it after that step)\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 sl.names [] getRd\ndef sKGoal (s : SMachine) (ps : List SEntry) (sl : SKStep) : List C :=\n  [s.f.m.pre] ++ factHyps s sl.finsts sl.pfinsts ++ (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) && s.pfacts.all (fun f => avoidsMaps MZ f.1.holds)\n\ndef szone (s : SMachine) (sl : SKStep) : List Nat := tgts sl.k.ren ++ flagVars s.f.flags ++ tgts sl.names\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    && checkIn (sKGoal s ps sl) ⟨sl.k.proof.1, sl.used, sl.k.proof.2⟩\n    && distinct (tgts sl.k.ren ++ tgts sl.names)\n    && sl.names.all (fun n => n.all fun p => !s.extVars.contains p.1 && !(szone s sl).contains p.1)\n    && avoids (tgts sl.names) sl.k.then_\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-- The state after each step.\nnoncomputable def sStates (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → List (Nat → Nat)\n  | _, _, [] => []\n  | ρ, M, q :: qs => (sNext s ρ M q.1 q.2).1 :: sStates s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\ntheorem evalE_assoc_getD (σ : List (Nat × E)) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (v : Nat) :\n    evalE W M0 ((assoc σ v).getD (.var v)) = applyS σ W M0 v := by\n  simp only [applyS]; cases assoc σ v <;> simp [evalE]\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.1, h.1.1.1.2, h.1.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.1.2\ntheorem sMapsOk_pfacts {s : SMachine} {MZ : List Nat} (h : sMapsOk s MZ = true) : ∀ f ∈ s.pfacts, avoidsMaps MZ f.1.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 : List (Nat × E)) (qinsts : List (Nat × List 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 ns : 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      (∀ n ∈ ns, ∀ p ∈ n, p.1 ∉ s.extVars ∧ p.1 ∉ Z) → RenOK W ns (sStates s ρ M qs) →\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 ns σ rd).1, evalC W M0 c = true)\n        ∧ SDenotes s Z MZ W M0 (sRun s laws insts qinsts ws rs mrs ns σ rd).2.1 (sRun s laws insts qinsts ws rs mrs ns σ rd).2.2\n            (sEnd s ρ M qs).1 (sEnd s ρ M qs).2\n  | [], rs, mrs, ns, 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, ns, qs, σ, rd, ρ, M, hl1, hl2, hl3, hav, hkeys, hcov, hmkeys, hmcov, hren, hmren, hnsrc, hnok, 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 state after the step, named: each fresh variable holds the next state's value of the variable it names.\n    have hnames : ∀ p ∈ ns.headD [], W p.2 = (sNext s ρ M q.1 q.2).1 p.1 := by\n      cases ns with\n      | nil => intro p hp; simp at hp\n      | cons n ns' => exact hnok.1\n    have hnsrc1 : ∀ p ∈ ns.headD [], p.1 ∉ s.extVars ∧ p.1 ∉ Z := by\n      cases ns with\n      | nil => intro p hp; simp at hp\n      | cons n ns' => exact hnsrc n List.mem_cons_self\n    have hD'' : SDenotes s Z MZ W M0 (frameSub (ns.headD []) (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 := by\n      refine ⟨fun v hve hvz => ?_, hD'.2⟩\n      by_cases hin : ∃ p ∈ ns.headD [], p.1 = v\n      · exact applyS_frame_in hin hnames\n      · rw [applyS_frame_out (fun p hp he => hin ⟨p, hp, he⟩)]; exact hD'.1 v hve hvz\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 (frameSub (ns.headD []) (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    have hnsrc' : ∀ n ∈ ns.tail, ∀ p ∈ n, p.1 ∉ s.extVars ∧ p.1 ∉ Z := fun n hn => hnsrc n (List.mem_of_mem_tail hn)\n    have hnok' : RenOK W ns.tail (sStates s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs) := by\n      cases ns with\n      | nil => exact trivial\n      | cons n ns' => exact hnok.2\n    obtain ⟨ih1, ih2⟩ := skrun_sound s ps hl Z MZ laws insts qinsts hlY W M0 hfz hterms hmaps ws rs mrs ns.tail 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' hnsrc' hnok' 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) | 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    · -- Each name's equation: the fresh variable holds the next state's value, which the term denotes.\n      simp only [nameHyps, List.mem_map] at hc\n      obtain ⟨p, hp, rfl⟩ := hc\n      simp only [evalC]\n      apply decide_eq_true\n      show W p.2 = evalE W M0 ((assoc (stepSub s.f (frameSub r σ) (frameRd mr rd)) p.1).getD (.var p.1))\n      rw [hnames p hp, evalE_assoc_getD]\n      exact (hD'.1 p.1 (hnsrc1 p hp).1 (hnsrc1 p hp).2).symm\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⟩, hnd⟩, hnsrc⟩, hnthen⟩ := 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_left _ (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  -- The goal's environment: each later request at its fresh variables, and each step's state at its names.\n  let W0 := renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))\n  let W := renEnv sl.names (sStates s ρ M (q₁ :: qs)) W0\n  obtain ⟨_, hndn, hndis⟩ := distinct_append hnd\n  have hWn : ∀ v, v ∉ tgts sl.names → W v = W0 v := fun v hv => renEnv_other _ _ _ v hv\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 => by\n    rw [hWn v (fun h => hv (List.mem_append_right _ h))]\n    exact renEnv_other _ _ _ v (fun h => hv (List.mem_append_left _ (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)) :=\n      renOK_congr _ _ (fun v hv => hWn v (hndis v hv)) (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 sl.names (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\n    (fun n hn p hp => by\n      have h := hnsrc n hn p hp\n      simp only [Bool.and_eq_true, Bool.not_eq_true', List.contains_iff_mem] at h\n      exact ⟨by simpa using h.1, by simpa using h.2⟩)\n    (renEnv_ok sl.names _ _ hndn) 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  -- `then` reads none of the names, so the goal's environment reads it as the claim's does.\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 := by\n    rw [congrC (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W) (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W0) _ sl.k.then_ (fun i hi => by\n      simp only [primed]; split\n      · rfl\n      · exact hWn i (avoids_occ hnthen hi))]\n    exact hn\n  apply sound_in _ _ 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 facthyps_true s sl.finsts sl.pfinsts W M0 (fun f hf => (pfactsOk_parts (sfacts_ok hl) f hf).2.2)\n      (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))\n      (pfacts_frame s (sfacts_ok hl) (szone s sl) (tgts sl.mren) (sTermsOk_pfacts hterms) (sMapsOk_pfacts 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        (pfacts_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",
+    "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), or at every tuple of keys (∀ k₁ … kₙ. body). 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`). A fact about several keys (`pfacts`: a function of several\narguments, a law between two points) is given at every value of its further keys, as a law about several keys holds,\nand a goal assumes it at the tuples its proof names (`pfinsts`).\n\nkernel.ts closes each quantified flag ?f in a goal: ?f ≤ 1; ?f = 0 ∨ body(t) at keys t the proof names (`qinsts`, a\ntuple of terms over several keys); and ?f = 1 ∨ ¬body(w) at fresh witnesses w, one per key (`wits`). A real step\nsatisfies these with w failing keys when ?f = 0, so a goal that refutes them refutes the machine. Lean builds the same\nclosed goals.\n-/\n\nnamespace Kern\nopen Classical\n\n/-! Certificates that name their hypotheses -/\n\n\n-- A proof tree with the table it reads, and the hypotheses it refutes: none named, the goal's own, in the goal's order;\n-- named, any of the goal's, in any order (each must be one of the goal's), so an exporter may lay its goal out its own\n-- way as long as each hypothesis it uses is one Lean builds.\nabbrev Cert := List VDef × List C × Tree\n-- The goal's hypotheses after the first one equal to c, if there is one.\ndef afterFirst (c : C) : List C → Option (List C)\n  | [] => none\n  | h :: t => if beqC c h then some t else afterFirst c t\n-- Each named hypothesis is one of the goal's: looked for after the last one found (exporters name them mostly in the\n-- goal's order), and from the start when it is not there.\ndef namedIn (hyps : List C) : List C → List C → Bool\n  | [], _ => true\n  | c :: cs, rest => match afterFirst c rest with\n    | some rest' => namedIn hyps cs rest'\n    | none => match afterFirst c hyps with\n      | some rest' => namedIn hyps cs rest'\n      | none => false\ndef checkIn (hyps : List C) (k : Cert) : Bool :=\n  if k.2.1.isEmpty then checkGoal ⟨k.1, hyps⟩ k.2.2\n  else namedIn hyps k.2.1 hyps && checkGoal ⟨k.1, k.2.1⟩ k.2.2\n\ntheorem afterFirst_some : ∀ {c : C} {l t : List C}, afterFirst c l = some t → c ∈ l ∧ ∀ x ∈ t, x ∈ l\n  | _, [], _, h => by simp [afterFirst] at h\n  | c, h' :: l, t, h => by\n    simp only [afterFirst] at h\n    split at h\n    · rename_i hb\n      simp only [Option.some.injEq] at h; subst h\n      exact ⟨by rw [beqC_eq hb]; exact List.mem_cons_self, fun x hx => List.mem_cons_of_mem _ hx⟩\n    · obtain ⟨h1, h2⟩ := afterFirst_some h\n      exact ⟨List.mem_cons_of_mem _ h1, fun x hx => List.mem_cons_of_mem _ (h2 x hx)⟩\n\ntheorem namedIn_sound (hyps : List C) : ∀ (cs rest : List C), (∀ x ∈ rest, x ∈ hyps) → namedIn hyps cs rest = true → ∀ c ∈ cs, c ∈ hyps\n  | [], _, _, _ => by simp\n  | c :: cs, rest, hr, h => by\n    simp only [namedIn] at h\n    split at h\n    · rename_i rest' hs\n      obtain ⟨h1, h2⟩ := afterFirst_some hs\n      intro x hx\n      rcases List.mem_cons.mp hx with rfl | hx\n      · exact hr _ h1\n      · exact namedIn_sound hyps cs rest' (fun y hy => hr y (h2 y hy)) h x hx\n    · split at h\n      · rename_i rest' hs\n        obtain ⟨h1, h2⟩ := afterFirst_some hs\n        intro x hx\n        rcases List.mem_cons.mp hx with rfl | hx\n        · exact h1\n        · exact namedIn_sound hyps cs rest' h2 h x hx\n      · simp at h\n\ntheorem sound_in (hyps : List C) (k : Cert) (h : checkIn hyps k = true) (env : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ¬ ∀ c ∈ hyps, evalC env maps c = true := by\n  intro hH\n  unfold checkIn at h\n  split at h\n  · exact sound ⟨k.1, hyps⟩ k.2.2 h env maps hH\n  · simp only [Bool.and_eq_true] at h\n    exact sound ⟨k.1, k.2.1⟩ k.2.2 h.2 env maps (fun c hc => hH c (namedIn_sound hyps k.2.1 hyps (fun _ hx => hx) h.1 c hc))\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 × List Nat × C) -- (flag variable, bound keys, body): 1 when the body holds at every value of the keys, else 0\n  wits : List (Nat × List Nat)     -- (flag variable, its witness variables: one per key)\n  facts : List MLaw                -- given about the params and the functions (maps no step writes)\n  pfacts : List (MLaw × List Nat)  -- facts about several keys: the fact about its first key, and its further keys\n\ndef SMachine.qVars (s : SMachine) : List Nat := s.qflags.map (·.1)\ndef SMachine.wVars (s : SMachine) : List Nat := s.wits.flatMap (·.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-- A state with the bound keys read from v.\ndef atKeys (X : Nat → Nat) (ks : List Nat) (v : Nat → Nat) : Nat → Nat := fun i => if ks.contains i then v i else X i\n\ntheorem atKeys_in {X : Nat → Nat} {ks : List Nat} {v : Nat → Nat} {i : Nat} (h : i ∈ ks) : atKeys X ks v i = v i := by\n  simp [atKeys, List.contains_iff_mem, h]\ntheorem atKeys_out {X : Nat → Nat} {ks : List Nat} {v : Nat → Nat} {i : Nat} (h : i ∉ ks) : atKeys X ks v i = X i := by\n  simp [atKeys, List.contains_iff_mem, h]\n\n-- Each quantified flag decided: 1 where its body holds at every value of its keys, 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 ∀ k, holdsC (atKeys X q.2.1 k) 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\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-- The facts about several keys, each at every value of its further keys.\ndef SMachine.PFacts (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop := ∀ p ∈ s.pfacts, holdsOver p.1 M p.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      s.PFacts ρ M → 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 tuples the proof names.\ndef closingHyps (s : SMachine) (qinsts : List (Nat × List 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.zip 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.zip (w.2.map .var)) q.2.2))]\n          | none => [])\n\ndef trueC : C := .le (.const 0) (.const 0)\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\n-- A fact about several keys at a tuple, as a fact about its first key: each further key read as the tuple's term.\ndef pfactLaw (s : SMachine) (p : Nat × E × List E) : MLaw :=\n  match s.pfacts[p.1]? with\n  | some f => ⟨substC (f.2.zip p.2.2) f.1.holds, f.1.key⟩\n  | none => ⟨trueC, none⟩\n\n-- The facts, at the keys the proof names, and the facts about several keys at the tuples it names.\ndef factHyps (s : SMachine) (finsts : List (Nat × E)) (pfinsts : List (Nat × E × List E)) : List C :=\n  scalarHyps s.facts ++ instHyps s.facts finsts ++ instHyps (pfinsts.map (pfactLaw s)) (pairInsts 0 pfinsts)\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 : List (Nat × E)) (qinsts : List (Nat × List E)) (w : C) : List C :=\n  scalarHyps laws ++ instHyps laws insts ++ [inlineC s.f.flags s.f.m.assume, w] ++ closingHyps s qinsts\n\n-- The state after a step, named (`names`, per step but the last: each state variable and a fresh variable): the fresh\n-- variable equals the variable's term there, and later frames read it (frameSub), so a run's frames stay small.\ndef nameHyps (n : List (Nat × Nat)) (σ : List (Nat × E)) : List C := n.map (fun p => .eq (.var p.2) ((assoc σ p.1).getD (.var p.1)))\n\ndef sRun (s : SMachine) (laws : List MLaw) (insts : List (Nat × E)) (qinsts : List (Nat × List E)) :\n    List C → List (List (Nat × Nat)) → 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, ns, σ, rd =>\n    ((sFrameHyps s laws insts qinsts w).map (substRC (frameSub r σ) (frameRd mr rd))\n        ++ nameHyps (ns.headD []) (stepSub s.f (frameSub r σ) (frameRd mr rd))\n        ++ (sRun s laws insts qinsts ws rs mrs ns.tail (frameSub (ns.headD []) (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 ns.tail (frameSub (ns.headD []) (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-- Values of the keys where a quantified flag's body fails, when there are some.\nnoncomputable def witnessKeys (X : Nat → Nat) (N : Nat → Nat → Nat) (q : Nat × List Nat × C) : Nat → Nat :=\n  if h : ∃ k, ¬ holdsC (atKeys X q.2.1 k) N q.2.2 then Classical.choose h else fun _ => 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.contains v) s.wits with\n      | some w => match lookup (fun q => q.1 == w.1) s.qflags with\n        | some q => match lookup (fun p => p.2 == v) (q.2.1.zip w.2) with\n          | some p => witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q p.1\n          | none => 0\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 × List Nat)) : Bool := distinct (ws.map (·.1)) && distinct (ws.flatMap (·.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 keys are none of them\n-- and distinct; every quantified flag has a witness per key; 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 (fun w => w.1 == q.1 && w.2.length == q.2.1.length) && distinct q.2.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 && q.2.1.all (fun k => !(s.extVars ++ flagVars s.f.flags).contains k))\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 {β : Type} {p : Nat × β} {l : List (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\n-- Witnesses: distinct across the flags, each found in its flag's entry, beside its key.\ntheorem lookup_wit : ∀ {ws : List (Nat × List Nat)}, distinct (ws.flatMap (·.2)) = true → ∀ {w : Nat × List Nat} {v : Nat}, w ∈ ws → v ∈ w.2 →\n    lookup (fun w' => w'.2.contains v) ws = some w\n  | [], _, _, _, h, _ => by simp at h\n  | a :: as, hd, w, v, h, hv => by\n    simp only [List.flatMap_cons] at hd\n    obtain ⟨_, hd2, hap⟩ := distinct_append hd\n    simp only [lookup]\n    rcases List.mem_cons.mp h with rfl | h\n    · simp [List.contains_iff_mem, hv]\n    · have hna : a.2.contains v = false := by\n        have : v ∉ a.2 := fun hva => hap v hva (List.mem_flatMap.mpr ⟨w, h, hv⟩)\n        simpa [List.contains_iff_mem] using this\n      simp only [hna, Bool.false_eq_true, ite_false]\n      exact lookup_wit hd2 h hv\n\ntheorem distinct_of_flatMap : ∀ {ws : List (Nat × List Nat)}, distinct (ws.flatMap (·.2)) = true → ∀ {w : Nat × List Nat}, w ∈ ws → distinct w.2 = true\n  | [], _, _, h => by simp at h\n  | a :: as, hd, w, h => by\n    simp only [List.flatMap_cons] at hd\n    obtain ⟨hd1, hd2, _⟩ := distinct_append hd\n    rcases List.mem_cons.mp h with rfl | h\n    · exact hd1\n    · exact distinct_of_flatMap hd2 h\n\ntheorem lookup_zip_wit : ∀ {ks ws : List Nat}, distinct ws = true → ∀ {k w : Nat}, (k, w) ∈ ks.zip ws → lookup (fun p => p.2 == w) (ks.zip ws) = some (k, w)\n  | [], _, _, _, _, h => by simp at h\n  | _ :: _, [], _, _, _, h => by simp at h\n  | a :: as, b :: bs, hd, k, w, h => by\n    obtain ⟨hb, hd'⟩ := distinct_cons hd\n    simp only [List.zip_cons_cons, List.mem_cons, Prod.mk.injEq] at h\n    simp only [List.zip_cons_cons, lookup]\n    rcases h with ⟨rfl, rfl⟩ | h\n    · simp\n    · have hw : w ≠ b := fun he => hb (he ▸ (List.of_mem_zip h).2)\n      have hbw : (b == w) = false := by simp only [beq_eq_false_iff_ne]; exact fun he => hw he.symm\n      simp only [hbw, Bool.false_eq_true, ite_false]\n      exact lookup_zip_wit hd' h\n\n-- Distinct keys zipped with variables: each key reads the variable beside it.\ntheorem assoc_zip_var : ∀ {ks ws : List Nat}, distinct ks = true → ∀ {k w : Nat}, (k, w) ∈ ks.zip ws → assoc (ks.zip (ws.map E.var)) k = some (.var w)\n  | [], _, _, _, _, h => by simp at h\n  | _ :: _, [], _, _, _, h => by simp at h\n  | a :: as, b :: bs, hd, k, w, h => by\n    obtain ⟨ha, hd'⟩ := distinct_cons hd\n    simp only [List.zip_cons_cons, List.mem_cons, Prod.mk.injEq] at h\n    simp only [List.map_cons, List.zip_cons_cons, assoc, lookup]\n    rcases h with ⟨rfl, rfl⟩ | h\n    · simp\n    · have hk : k ≠ a := fun he => ha (he ▸ (List.of_mem_zip h).1)\n      have hak : (a == k) = false := by simp only [beq_eq_false_iff_ne]; exact fun he => hk he.symm\n      simp only [hak, Bool.false_eq_true, ite_false]\n      exact assoc_zip_var hd' h\n\ntheorem zip_has : ∀ {ks ws : List Nat}, ks.length = ws.length → ∀ {k : Nat}, k ∈ ks → ∃ w, (k, w) ∈ ks.zip ws\n  | [], _, _, _, h => by simp at h\n  | _ :: _, [], hl, _, _ => by simp at hl\n  | a :: as, b :: bs, hl, k, h => by\n    simp only [List.length_cons, Nat.add_right_cancel_iff] at hl\n    rcases List.mem_cons.mp h with rfl | h\n    · exact ⟨b, by simp⟩\n    · obtain ⟨w, hw⟩ := zip_has hl h\n      exact ⟨w, by simp [List.zip_cons_cons, hw]⟩\n\n-- Terms put in for the keys: the state read at the keys' values.\ntheorem applyS_zip_atKeys (ks : List Nat) (ts : List E) (X : Nat → Nat) (N : Nat → Nat → Nat) :\n    applyS (ks.zip ts) X N = atKeys X ks (applyS (ks.zip ts) X N) := by\n  funext i\n  simp only [atKeys]\n  split\n  · rfl\n  · rename_i h\n    exact applyS_other (fun hm => h (by obtain ⟨⟨a, b⟩, hp, rfl⟩ := List.mem_map.mp hm; exact List.contains_iff_mem.mpr (List.of_mem_zip hp).1)) X N\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\n      ∧ (∀ q ∈ s.qflags, (∃ w ∈ s.wits, w.1 = q.1 ∧ w.2.length = q.2.1.length) ∧ distinct q.2.1 = true)\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 ∧ ∀ k ∈ q.2.1, k ∉ 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').1, (hcov q hq').2⟩, hd, fun q hq' => ⟨(hb q hq').1, fun k hk hm => ?_⟩, hfl⟩\n  have h2 := (hb q hq').2 k hk\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 × List 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 value of the keys (read in either view: they agree on the body).\n  have hY : withExt s ρ (sReq s ρ M ι κ) q.1 = if ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (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 : ∀ k, holdsC (atKeys (withExt s ρ (sReq s ρ M ι κ)) q.2.1 k) (withCarried s M κ) q.2.2\n      ↔ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 := by\n    intro k\n    rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 (fun j hj => by\n      simp only [atKeys]; 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 : ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2\n    · right; rw [subst_evalC, applyS_zip_atKeys, evalC_iff]; exact (hbodyY _).mpr (h1 _)\n    · left; simp [hY, h1]\n  · obtain ⟨⟨w, hw, hwq, hlen⟩, hkd⟩ := hcov q hq\n    have hlw : lookup (fun w' => w'.1 == q.1) s.wits = some w := by\n      rw [← hwq]; exact lookup_unique (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 : ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2\n    · left; simp [hY, h1]\n    · right\n      have hwd' : distinct (s.wits.flatMap (·.2)) = true := by simp only [distinctPairs, Bool.and_eq_true] at hwd; exact hwd.2\n      -- Each witness reads the failing value of the key beside it.\n      have hYw : ∀ k x, (k, x) ∈ q.2.1.zip w.2 → withExt s ρ (sReq s ρ M ι κ) x = witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q k := by\n        intro k x hkx\n        have hxw : x ∈ s.wVars := List.mem_flatMap.mpr ⟨w, hw, (List.of_mem_zip hkx).2⟩\n        have hxi : x ∉ s.f.m.inputs := fun h => (hin _ h).2 hxw\n        have hxq : x ∉ s.qVars := fun h => hqw _ h hxw\n        have hext : s.extVars.contains x = true := by\n          simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inr hxw\n        have hni : s.f.m.inputs.contains x = false := by simpa [List.contains_iff_mem] using hxi\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 hxq (by rw [← he]; exact List.mem_map_of_mem hq')),\n          lookup_wit hwd' hw (List.of_mem_zip hkx).2]\n        simp only [hwq, lookup_unique hqd hq]\n        rw [lookup_zip_wit (distinct_of_flatMap hwd' hw) hkx]\n      have hex : ∃ k, ¬ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 := by simpa using h1\n      have hfail : ¬ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 (witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q)) (withCarried s M κ) q.2.2 := by\n        simp only [witnessKeys, dif_pos hex]; exact Classical.choose_spec hex\n      rw [subst_evalC]\n      cases hb : evalC (applyS (q.2.1.zip (w.2.map E.var)) (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ)) (withCarried s M κ) q.2.2\n      · rfl\n      · refine absurd ((hbodyY _).mp ((evalC_iff _ _ _).mp ?_)) hfail\n        rw [← hb]\n        apply congrC; intro j _\n        simp only [atKeys]; split\n        · rename_i hj\n          obtain ⟨x, hx⟩ := zip_has hlen.symm (List.contains_iff_mem.mp hj)\n          simp only [applyS, assoc_zip_var hkd hx, evalE]\n          exact (hYw j x hx).symm\n        · rename_i hj\n          exact (applyS_other (fun hm => hj (by obtain ⟨⟨a, b⟩, hp, rfl⟩ := List.mem_map.mp hm; exact List.contains_iff_mem.mpr (List.of_mem_zip hp).1)) _ _).symm\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 : List (Nat × E)) (qinsts : List (Nat × List 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 × List E) -- (quantified flag, keys): 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  pfinsts : List (Nat × E × List E) -- (fact index, key, further keys): where both goals assume the facts about several keys\n  start : Cert\n  step : Cert\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\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⟩\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 e.pfinsts ++ [.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 e.pfinsts ++ (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) && s.pfacts.all (fun f => avoids Z f.1.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 factsOk1 (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-- The facts about several keys alike, each about a first key apart from its further keys.\ndef pfactsOk (s : SMachine) : Bool :=\n  s.pfacts.all fun f => avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) f.1.holds\n    && avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) f.1.holds && f.2.all (fun g => f.1.key != some g)\ndef factsOk (s : SMachine) : Bool := factsOk1 s && pfactsOk s\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    && s.pfacts.all (fun f => !occC sk f.1.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        && checkIn (sStartGoal s e) e.start\n        && checkIn (sStepGoal s ps e) e.step\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\ntheorem skFresh_pfacts {s : SMachine} {sk : Nat} (h : skFresh s sk = true) : ∀ f ∈ s.pfacts, occC sk f.1.holds = false := by\n  simp only [skFresh, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h; exact h.2\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 : ∀ k, holdsC (atKeys (upd X x v) q.2.1 k) N q.2.2 ↔ holdsC (atKeys X q.2.1 k) N q.2.2 := fun k => by\n        rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys X q.2.1 k) 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 [atKeys]; split\n          · rfl\n          · simp [upd, 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, Bool.and_eq_true] at hf\n  have hf := hf.1\n  simp only [factsOk1, 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.1.2\ntheorem sTermsOk_pfacts {s : SMachine} {Z : List Nat} (h : sTermsOk s Z = true) : ∀ f ∈ s.pfacts, avoids Z f.1.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, Bool.and_eq_true] at hfok\n  have hfok := hfok.1\n  simp only [factsOk1, 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/-! Facts about several keys -/\n\n-- A law at every value of some keys, read where it reads alike, holds alike.\ntheorem holdsOver_transfer {V MS : List Nat} (l : MLaw) (hv : avoids V l.holds = true) (hm : avoidsMaps MS l.holds = true) :\n    ∀ (gs : List Nat) {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat}, Agree V ρ ρ' → (∀ mp, mp ∉ MS → M mp = M' mp) →\n      holdsOver l M' gs ρ' → holdsOver l M gs ρ\n  | [], _, _, _, _, hag, hmag, h => holds_transfer l hv hm hag hmag h\n  | g :: gs, ρ, ρ', _, _, hag, hmag, h => fun w =>\n      holdsOver_transfer l hv hm gs (ρ := upd ρ g w) (ρ' := upd ρ' g w) (fun i hi => by\n        simp only [upd]; split\n        · rfl\n        · exact hag i hi) hmag (h w)\n\n-- A law at every value of its further keys holds with each set to a term (the law about its first key, at the tuple).\ntheorem holdsOver_subst (l : MLaw) (gs : List Nat) (ts : List E) (hkk : ∀ k, l.key = some k → k ∉ gs)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (h : holdsOver l N gs Y) : (⟨substC (gs.zip ts) l.holds, l.key⟩ : MLaw).Holds Y N := by\n  have hany := holdsOver_any gs h\n  have hdom : ∀ i, i ∉ gs → i ∉ (gs.zip ts).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 : l.key with\n  | none =>\n    have h' := hany (applyS (gs.zip ts) 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 k hk\n    simp only [MLaw.Holds, hk]\n    intro v\n    rw [subst_evalC]\n    have h' := hany (fun i => if i ∈ gs then applyS (gs.zip ts) (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 ∈ gs then applyS (gs.zip ts) (upd Y k v) N i else Y i) k v = applyS (gs.zip ts) (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 ∈ gs\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\ntheorem pfactsOk_parts {s : SMachine} (h : factsOk s = true) : ∀ f ∈ s.pfacts,\n    avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) f.1.holds = true\n      ∧ avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) f.1.holds = true ∧ ∀ k, f.1.key = some k → k ∉ f.2 := by\n  simp only [factsOk, pfactsOk, Bool.and_eq_true, List.all_eq_true, bne_iff_ne, ne_eq] at h\n  intro f hf\n  obtain ⟨⟨h1, h2⟩, h3⟩ := h.2 f hf\n  exact ⟨h1, h2, fun k hk hm => h3 k hm (by rw [hk])⟩\n\n-- The facts about several keys at the tuples a goal names hold wherever the facts do.\ntheorem pfactLaws_hold (s : SMachine) (pfinsts : List (Nat × E × List E)) (hkk : ∀ f ∈ s.pfacts, ∀ k, f.1.key = some k → k ∉ f.2)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (hp : s.PFacts Y N) : ∀ l ∈ pfinsts.map (pfactLaw s), l.Holds Y N := by\n  intro l hl\n  obtain ⟨p, _, rfl⟩ := List.mem_map.mp hl\n  unfold pfactLaw\n  split\n  · rename_i f hf\n    have hfm : f ∈ s.pfacts := List.mem_of_getElem? hf\n    exact holdsOver_subst f.1 f.2 p.2.2 (hkk f hfm) (hp f hfm)\n  · simp [MLaw.Holds, trueC, evalC, evalE]\n\n-- A goal's facts all hold where the facts and the facts about several keys do.\ntheorem facthyps_true (s : SMachine) (finsts : List (Nat × E)) (pfinsts : List (Nat × E × List E)) (Y : Nat → Nat) (N : Nat → Nat → Nat)\n    (hkk : ∀ f ∈ s.pfacts, ∀ k, f.1.key = some k → k ∉ f.2) (hf : ∀ l ∈ s.facts, l.Holds Y N) (hp : s.PFacts Y N) :\n    ∀ c ∈ factHyps s finsts pfinsts, evalC Y N c = true := by\n  intro c hc\n  simp only [factHyps] at hc\n  rcases List.mem_append.mp hc with hc | hc\n  · exact laws_hyps_true s.facts finsts Y N hf c hc\n  · exact laws_hyps_true (pfinsts.map (pfactLaw s)) (pairInsts 0 pfinsts) Y N (pfactLaws_hold s pfinsts hkk hp) c (List.mem_append_right _ hc)\n\n-- The facts about several keys hold in every reachable state, and wherever what they read is the state's.\ntheorem pfacts_sreach (s : SMachine) (hf : factsOk s = true) : ∀ {ρ M}, SReach s ρ M → s.PFacts ρ M := by\n  have hf := pfactsOk_parts hf\n  intro ρ M h\n  induction h with\n  | start ρ M _ _ _ hpf =>\n    intro f hfm\n    exact holdsOver_transfer f.1 (hf f hfm).1 (MS := []) (by simp [avoidsMaps]) f.2\n      (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M) (fun _ _ => rfl) (hpf f hfm)\n  | step ρ M ι κ _ _ ih =>\n    intro f hfm\n    refine holdsOver_transfer f.1 (hf f hfm).1 (hf f hfm).2.1 f.2 (fun i hi => ?_) (fun mp hmp => ?_) (ih f hfm)\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 pfacts_frame (s : SMachine) (hfok : factsOk s = true) (Vx Mx : List Nat)\n    (hvx : ∀ f ∈ s.pfacts, avoids Vx f.1.holds = true) (hmx : ∀ f ∈ s.pfacts, avoidsMaps Mx f.1.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 : s.PFacts ρ M) : s.PFacts X N := by\n  have hp := pfactsOk_parts hfok\n  intro f hf'\n  refine holdsOver_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) f.1\n    (by have h1 := (hp f hf').1; simp only [avoids, List.all_append, Bool.and_eq_true] at hvx h1 ⊢; exact ⟨h1, hvx f hf'⟩)\n    (by have h2 := (hp f hf').2.1; simp only [avoidsMaps, List.all_append, Bool.and_eq_true] at hmx h2 ⊢; exact ⟨h2, hmx f hf'⟩) f.2\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 f hf')\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) (hpf : s.PFacts ρ 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_in _ _ 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 facthyps_true s e.finsts e.pfinsts _ M (fun f hf => (pfactsOk_parts hfok f hf).2.2)\n      (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)\n      (pfacts_frame s hfok [e.sk] [] (fun f hf => by simp [avoids, skFresh_pfacts hskf f hf])\n        (fun _ _ => by simp [avoidsMaps]) (fun i _ hik => by simp only [upd]; rw [if_neg (by simpa using hik)]) (fun _ _ _ => rfl) hpf) 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) (hpf : s.PFacts ρ 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_in _ _ 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 facthyps_true s e.finsts e.pfinsts W M0 (fun f hf => (pfactsOk_parts hfok f hf).2.2)\n      (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)\n      (pfacts_frame s hfok [e.sk] [] (fun f hf => by simp [avoids, skFresh_pfacts hskf f hf])\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)]) hpf) 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 hpfacts : ∀ {ρ : Nat → Nat} {M : Nat → Nat → Nat} {g : Nat}, skFresh s g = true → s.PFacts ρ M → ∀ w, s.PFacts (upd ρ g w) M := by\n    intro ρ M g hf hpf w\n    exact pfacts_frame s hfok [g] [] (fun f hfm => by simp [avoids, skFresh_pfacts hf f hfm]) (fun _ _ => by simp [avoidsMaps])\n      (fun i _ hig' => by simp only [upd]; rw [if_neg (by simpa using hig')]) (fun _ _ _ => rfl) hpf\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 hpf =>\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        s.PFacts ρ' M → holdsOver e.law M gs (applyS s.f.m.init ρ' M) from hs e.keys2 (fun g hg => hg) ρ h0 hfa hpf\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf hq; exact sstart_case s ps h ρ' M hM hp hf hq e he\n    | cons g gs ih =>\n      intro hsub ρ' hp hf hq 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) (hpfacts hfr hq 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        s.PFacts ρ' M → (∀ 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) (pfacts_sreach s hfok hr) ih ha\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf hq hi ha'; exact sstep_case s ps h ρ' M ι κ hp hf hq hi ha' e he\n    | cons g gs ihg =>\n      intro hsub ρ' hp hf hq 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) (hpfacts hfr hq 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 × List E)     -- (quantified flag, keys): 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  pfinsts : List (Nat × E × List E) -- (fact index, key, further keys): where the goal assumes the facts about several keys\n  used : List C                    -- the hypotheses the tree refutes ([] for the goal's own, in its order)\n  names : List (List (Nat × Nat))  -- per step but the last: (state variable, the fresh variable naming it after that step)\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 sl.names [] getRd\ndef sKGoal (s : SMachine) (ps : List SEntry) (sl : SKStep) : List C :=\n  [s.f.m.pre] ++ factHyps s sl.finsts sl.pfinsts ++ (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) && s.pfacts.all (fun f => avoidsMaps MZ f.1.holds)\n\ndef szone (s : SMachine) (sl : SKStep) : List Nat := tgts sl.k.ren ++ flagVars s.f.flags ++ tgts sl.names\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    && checkIn (sKGoal s ps sl) ⟨sl.k.proof.1, sl.used, sl.k.proof.2⟩\n    && distinct (tgts sl.k.ren ++ tgts sl.names)\n    && sl.names.all (fun n => n.all fun p => !s.extVars.contains p.1 && !(szone s sl).contains p.1)\n    && avoids (tgts sl.names) sl.k.then_\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-- The state after each step.\nnoncomputable def sStates (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → List (Nat → Nat)\n  | _, _, [] => []\n  | ρ, M, q :: qs => (sNext s ρ M q.1 q.2).1 :: sStates s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\ntheorem evalE_assoc_getD (σ : List (Nat × E)) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (v : Nat) :\n    evalE W M0 ((assoc σ v).getD (.var v)) = applyS σ W M0 v := by\n  simp only [applyS]; cases assoc σ v <;> simp [evalE]\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.1, h.1.1.1.2, h.1.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.1.2\ntheorem sMapsOk_pfacts {s : SMachine} {MZ : List Nat} (h : sMapsOk s MZ = true) : ∀ f ∈ s.pfacts, avoidsMaps MZ f.1.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 : List (Nat × E)) (qinsts : List (Nat × List 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 ns : 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      (∀ n ∈ ns, ∀ p ∈ n, p.1 ∉ s.extVars ∧ p.1 ∉ Z) → RenOK W ns (sStates s ρ M qs) →\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 ns σ rd).1, evalC W M0 c = true)\n        ∧ SDenotes s Z MZ W M0 (sRun s laws insts qinsts ws rs mrs ns σ rd).2.1 (sRun s laws insts qinsts ws rs mrs ns σ rd).2.2\n            (sEnd s ρ M qs).1 (sEnd s ρ M qs).2\n  | [], rs, mrs, ns, 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, ns, qs, σ, rd, ρ, M, hl1, hl2, hl3, hav, hkeys, hcov, hmkeys, hmcov, hren, hmren, hnsrc, hnok, 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 state after the step, named: each fresh variable holds the next state's value of the variable it names.\n    have hnames : ∀ p ∈ ns.headD [], W p.2 = (sNext s ρ M q.1 q.2).1 p.1 := by\n      cases ns with\n      | nil => intro p hp; simp at hp\n      | cons n ns' => exact hnok.1\n    have hnsrc1 : ∀ p ∈ ns.headD [], p.1 ∉ s.extVars ∧ p.1 ∉ Z := by\n      cases ns with\n      | nil => intro p hp; simp at hp\n      | cons n ns' => exact hnsrc n List.mem_cons_self\n    have hD'' : SDenotes s Z MZ W M0 (frameSub (ns.headD []) (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 := by\n      refine ⟨fun v hve hvz => ?_, hD'.2⟩\n      by_cases hin : ∃ p ∈ ns.headD [], p.1 = v\n      · exact applyS_frame_in hin hnames\n      · rw [applyS_frame_out (fun p hp he => hin ⟨p, hp, he⟩)]; exact hD'.1 v hve hvz\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 (frameSub (ns.headD []) (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    have hnsrc' : ∀ n ∈ ns.tail, ∀ p ∈ n, p.1 ∉ s.extVars ∧ p.1 ∉ Z := fun n hn => hnsrc n (List.mem_of_mem_tail hn)\n    have hnok' : RenOK W ns.tail (sStates s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs) := by\n      cases ns with\n      | nil => exact trivial\n      | cons n ns' => exact hnok.2\n    obtain ⟨ih1, ih2⟩ := skrun_sound s ps hl Z MZ laws insts qinsts hlY W M0 hfz hterms hmaps ws rs mrs ns.tail 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' hnsrc' hnok' 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) | 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    · -- Each name's equation: the fresh variable holds the next state's value, which the term denotes.\n      simp only [nameHyps, List.mem_map] at hc\n      obtain ⟨p, hp, rfl⟩ := hc\n      simp only [evalC]\n      apply decide_eq_true\n      show W p.2 = evalE W M0 ((assoc (stepSub s.f (frameSub r σ) (frameRd mr rd)) p.1).getD (.var p.1))\n      rw [hnames p hp, evalE_assoc_getD]\n      exact (hD'.1 p.1 (hnsrc1 p hp).1 (hnsrc1 p hp).2).symm\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⟩, hnd⟩, hnsrc⟩, hnthen⟩ := 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_left _ (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  -- The goal's environment: each later request at its fresh variables, and each step's state at its names.\n  let W0 := renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))\n  let W := renEnv sl.names (sStates s ρ M (q₁ :: qs)) W0\n  obtain ⟨_, hndn, hndis⟩ := distinct_append hnd\n  have hWn : ∀ v, v ∉ tgts sl.names → W v = W0 v := fun v hv => renEnv_other _ _ _ v hv\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 => by\n    rw [hWn v (fun h => hv (List.mem_append_right _ h))]\n    exact renEnv_other _ _ _ v (fun h => hv (List.mem_append_left _ (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)) :=\n      renOK_congr _ _ (fun v hv => hWn v (hndis v hv)) (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 sl.names (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\n    (fun n hn p hp => by\n      have h := hnsrc n hn p hp\n      simp only [Bool.and_eq_true, Bool.not_eq_true', List.contains_iff_mem] at h\n      exact ⟨by simpa using h.1, by simpa using h.2⟩)\n    (renEnv_ok sl.names _ _ hndn) 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  -- `then` reads none of the names, so the goal's environment reads it as the claim's does.\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 := by\n    rw [congrC (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W) (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W0) _ sl.k.then_ (fun i hi => by\n      simp only [primed]; split\n      · rfl\n      · exact hWn i (avoids_occ hnthen hi))]\n    exact hn\n  apply sound_in _ _ 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 facthyps_true s sl.finsts sl.pfinsts W M0 (fun f hf => (pfactsOk_parts (sfacts_ok hl) f hf).2.2)\n      (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))\n      (pfacts_frame s (sfacts_ok hl) (szone s sl) (tgts sl.mren) (sTermsOk_pfacts hterms) (sMapsOk_pfacts 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        (pfacts_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 sets (`sleads_sound`, and under weak\nfairness `sleads_wf_sound`); a machine with maps and flags is one with no sets. kernel.ts proves it by a rank (naturals over the state and params, compared in\norder: the first that differs decides) and helpful requests, each with the region where it helps. While `from` holds and\n`to` doesn't: every request allowed keeps `from` or reaches `to`, and reaches `to`, lowers the rank, or keeps the rank\nwith every region it was in kept (a step law); some region holds (a step law that reads no step); and each helpful\nrequest, taken in its region, reaches `to` or lowers the rank (a step law whose `when` names the inputs the request\nsets; the others, and the maps it carries, stay free: a history's queries among them). Lean builds all of them from the\nliveness and checks them with the step-law rules (StepLaw.lean's, Sets.lean's). Then along every run that takes each\nhelpful request infinitely often, each state where `from` holds is followed by one where `to` holds: the rank can't drop\nforever, once it stops dropping the region it is in stays, and that region's request comes and lowers it.\n-/\n\nnamespace Kern\n\n/-! Ranks compared in order -/\n\ndef lexB : List Nat → List Nat → Bool\n  | a' :: as', a :: as => decide (a' < a) || (decide (a' = a) && lexB as' as)\n  | _, _ => false\n\ntheorem lexB_irrefl : ∀ x : List Nat, lexB x x = false\n  | [] => rfl\n  | a :: as => by simp [lexB, lexB_irrefl as]\n\ntheorem nat_down {g : Nat → Nat} {n0 : Nat} (h : ∀ n, n0 ≤ n → g (n + 1) ≤ g n) : ∀ d, g (n0 + d) ≤ g n0\n  | 0 => Nat.le_refl _\n  | d + 1 => Nat.le_trans (h (n0 + d) (Nat.le_add_right _ _)) (nat_down h d)\n\n-- A natural that never rises from n0 on stops changing.\ntheorem nat_stable (g : Nat → Nat) : ∀ v n0, g n0 ≤ v → (∀ n, n0 ≤ n → g (n + 1) ≤ g n) →\n    ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → g m = g T := by\n  intro v\n  induction v with\n  | zero =>\n    intro n0 hv h\n    refine ⟨n0, Nat.le_refl _, fun m hm => ?_⟩\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    have := nat_down h d; omega\n  | succ v ih =>\n    intro n0 hv h\n    by_cases hall : ∀ m, n0 ≤ m → g m = g n0\n    · exact ⟨n0, Nat.le_refl _, hall⟩\n    · have hex : ∃ m, n0 ≤ m ∧ g m ≠ g n0 := Classical.byContradiction fun hno =>\n        hall fun m hm => Classical.byContradiction fun hne => hno ⟨m, hm, hne⟩\n      obtain ⟨m, hm, hne⟩ := hex\n      obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n      have := nat_down h d\n      obtain ⟨T, hT, hTm⟩ := ih (n0 + d) (by omega) (fun n hn => h n (by omega))\n      exact ⟨T, by omega, hTm⟩\n\n-- A rank of k naturals that never rises (in order) from n0 on stops changing.\ntheorem lex_stable : ∀ (k : Nat) (r : Nat → List Nat) (n0 : Nat), (∀ n, (r n).length = k) →\n    (∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n) → ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → r m = r T\n  | 0, r, n0, hk, _ => ⟨n0, Nat.le_refl _, fun m _ => by\n      rw [List.eq_nil_of_length_eq_zero (hk m), List.eq_nil_of_length_eq_zero (hk n0)]⟩\n  | k + 1, r, n0, hk, hmono => by\n    have hcons : ∀ n, r n = (r n).headD 0 :: (r n).tail := by\n      intro n\n      have := hk n\n      cases h : r n with\n      | nil => rw [h] at this; simp at this\n      | cons a as => rfl\n    have hstep : ∀ n, n0 ≤ n → (r (n + 1)).headD 0 < (r n).headD 0 ∨\n        ((r (n + 1)).headD 0 = (r n).headD 0 ∧ (lexB (r (n + 1)).tail (r n).tail = true ∨ (r (n + 1)).tail = (r n).tail)) := by\n      intro n hn\n      have h := hmono n hn\n      rw [hcons (n + 1), hcons n] at h\n      simp only [lexB, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq, List.cons.injEq] at h\n      rcases h with (h | ⟨h1, h2⟩) | ⟨h1, h2⟩\n      · exact Or.inl h\n      · exact Or.inr ⟨h1, Or.inl h2⟩\n      · exact Or.inr ⟨h1, Or.inr h2⟩\n    obtain ⟨T1, hT1, hT1m⟩ := nat_stable (fun n => (r n).headD 0) _ n0 (Nat.le_refl _) (fun n hn => by\n      rcases hstep n hn with h | ⟨h, _⟩\n      · exact Nat.le_of_lt h\n      · exact Nat.le_of_eq h)\n    obtain ⟨T2, hT2, hT2m⟩ := lex_stable k (fun n => (r n).tail) T1 (fun n => by simp [hk n]) (fun n hn => by\n      rcases hstep n (by omega) with h | ⟨_, h⟩\n      · have e1 := hT1m (n + 1) (by omega); have e2 := hT1m n hn; omega\n      · exact h)\n    refine ⟨T2, by omega, fun m hm => ?_⟩\n    have e1 := hT1m m (by omega); have e2 := hT1m T2 hT2; have e3 := hT2m m hm\n    rw [hcons m, hcons T2, e3, e1, e2]\n\n/-- Along a run: if `P ∧ ¬Q` is kept (or Q reached) with the rank never rising, and kept only with every region kept;\nsome region holds while `P ∧ ¬Q` does; and each region's helpful step reaches Q or lowers the rank there; then Q\nfollows every P, provided each helpful step is taken from any point on where it stays enabled (E), and it is enabled in\nits region while `P ∧ ¬Q` holds. With E always true, that is: each helpful step taken infinitely often. -/\ntheorem leads_of_lex {α : Type} (P Q : Nat → Prop) (r : Nat → List Nat) (k : Nat) (hk : ∀ n, (r n).length = k)\n    (helps : List α) (W H E : α → Nat → Prop)\n    (hstay : ∀ n, P n → ¬ Q n → (P (n + 1) ∨ Q (n + 1)) ∧\n      (Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true ∨ (r (n + 1) = r n ∧ ∀ h ∈ helps, W h n → W h (n + 1))))\n    (hcover : ∀ n, P n → ¬ Q n → ∃ h ∈ helps, W h n)\n    (hhelp : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → H h n → Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true)\n    (henabled : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → E h n)\n    (fair : ∀ h ∈ helps, ∀ n, (∀ m, n ≤ m → E h m) → ∃ m, n ≤ m ∧ H h m) : ∀ n, P n → ∃ m, n ≤ m ∧ Q m := by\n  intro n0 hP\n  apply Classical.byContradiction\n  intro hno\n  have hnq : ∀ m, n0 ≤ m → ¬ Q m := fun m hm hq => hno ⟨m, hm, hq⟩\n  have hPd : ∀ d, P (n0 + d) := by\n    intro d\n    induction d with\n    | zero => exact hP\n    | succ d ih =>\n      rcases (hstay (n0 + d) ih (hnq _ (Nat.le_add_right _ _))).1 with h | h\n      · exact h\n      · exact absurd h (hnq _ (by omega))\n  have hPm : ∀ m, n0 ≤ m → P m := fun m hm => by obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm; exact hPd d\n  have hmono : ∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n := by\n    intro n hn\n    rcases (hstay n (hPm n hn) (hnq n hn)).2 with h | h | ⟨h, _⟩\n    · exact absurd h (hnq _ (by omega))\n    · exact Or.inl h\n    · exact Or.inr h\n  -- The rank stops changing at T; the region T is in stays, and its helpful step would lower the rank.\n  obtain ⟨T, hT, hTm⟩ := lex_stable k r n0 hk hmono\n  have hlow : ∀ m, T ≤ m → lexB (r (m + 1)) (r m) ≠ true := fun m hm hl => by\n    rw [hTm (m + 1) (by omega), hTm m hm, lexB_irrefl] at hl; exact absurd hl (by simp)\n  obtain ⟨h, hh, hW⟩ := hcover T (hPm T hT) (hnq T hT)\n  have hWd : ∀ d, W h (T + d) := by\n    intro d\n    induction d with\n    | zero => exact hW\n    | succ d ih =>\n      rcases (hstay (T + d) (hPm _ (by omega)) (hnq _ (by omega))).2 with hq | hl | ⟨_, hkeep⟩\n      · exact absurd hq (hnq _ (by omega))\n      · exact absurd hl (hlow _ (by omega))\n      · exact hkeep h hh ih\n  obtain ⟨m, hm, hH⟩ := fair h hh T (fun m hm => by\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    exact henabled h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d))\n  obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n  rcases hhelp h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d) hH with hq | hl\n  · exact hnq _ (by omega) hq\n  · exact hlow _ (by omega) hl\n\n/-! Primed names: a condition read after a step -/\n\n-- A term with its state variables renamed to their primed names (`pr`: variable, name) and its maps to theirs (`pm`).\nmutual\ndef primeE (pr pm : List (Nat × Nat)) : E → E\n  | .var i => match lookup (fun q => q.1 == i) pr with\n    | some q => .var q.2\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (primeE pr pm a) (primeE pr pm b)\n  | .sub a b => .sub (primeE pr pm a) (primeE pr pm b)\n  | .mul k a => .mul k (primeE pr pm a)\n  | .min a b => .min (primeE pr pm a) (primeE pr pm b)\n  | .max a b => .max (primeE pr pm a) (primeE pr pm b)\n  | .prod a b => .prod (primeE pr pm a) (primeE pr pm b)\n  | .ite c t f => .ite (primeC pr pm c) (primeE pr pm t) (primeE pr pm f)\n  | .get m k => .get (match lookup (fun q => q.1 == m) pm with\n      | some q => q.2\n      | none => m) (primeE pr pm k)\ndef primeC (pr pm : List (Nat × Nat)) : C → C\n  | .le a b => .le (primeE pr pm a) (primeE pr pm b)\n  | .lt a b => .lt (primeE pr pm a) (primeE pr pm b)\n  | .eq a b => .eq (primeE pr pm a) (primeE pr pm b)\n  | .and a b => .and (primeC pr pm a) (primeC pr pm b)\n  | .or a b => .or (primeC pr pm a) (primeC pr pm b)\n  | .not a => .not (primeC pr pm a)\nend\n\n-- Read where `then` reads (primed names after, the rest before), a renamed term is the term after, wherever a variable\n-- or map it reads is renamed or the same before and after, and reads no primed name.\nsection prime\nvariable (pr pm : List (Nat × Nat)) (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n  (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat)\ninclude hpr hpm\nmutual\ntheorem primeE_eval : (e : E) → (∀ i, occE i e = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occME mp e = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalE (primed pr ρ' ρ) (primedMaps pm M' M) (primeE pr pm e) = evalE ρ' M' e\n  | .var i, hv, _ => by\n    simp only [primeE]\n    cases hl : lookup (fun q => q.1 == i) pr with\n    | some q =>\n      have ⟨hq, hqi⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqi\n      simp only [evalE, primed, lookup_ren hpr q hq, hqi]\n    | none =>\n      have hi := hv i (by simp [occE])\n      have hnot : i ∉ pr.map (·.1) := fun hm => by\n        obtain ⟨q, hq, hqi⟩ := List.mem_map.mp hm\n        have := lookup_none_all hl q hq; simp [hqi] at this\n      have hn2 : lookup (fun q => q.2 == i) pr = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hi.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [evalE, primed, hn2]\n      rcases hi.2 with h | h\n      · exact absurd h hnot\n      · exact h.symm\n  | .const n, _, _ => rfl\n  | .add a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .sub a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .mul k a, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .min a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .max a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .prod a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .ite c t f, hv, hm => by\n    simp only [primeE, evalE, primeC_eval c (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval t (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval f (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .get m k, hv, hm => by\n    have hk := primeE_eval k (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))\n    simp only [primeE, evalE, hk]\n    cases hl : lookup (fun q => q.1 == m) pm with\n    | some q =>\n      have ⟨hq, hqm⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqm\n      simp only [primedMaps, lookup_ren hpm q hq, hqm]\n    | none =>\n      have hmm := hm m (by simp [occME])\n      have hnot : m ∉ pm.map (·.1) := fun hmem => by\n        obtain ⟨q, hq, hqm⟩ := List.mem_map.mp hmem\n        have := lookup_none_all hl q hq; simp [hqm] at this\n      have hn2 : lookup (fun q => q.2 == m) pm = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hmm.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [primedMaps, hn2]\n      rcases hmm.2 with h | h\n      · exact absurd h hnot\n      · rw [h]\ntheorem primeC_eval : (c : C) → (∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalC (primed pr ρ' ρ) (primedMaps pm M' M) (primeC pr pm c) = evalC ρ' M' c\n  | .le a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .lt a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .eq a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .and a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .or a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .not a, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\nend\nend prime\n\n-- Read where `then` reads, a condition that reads no primed name is the condition before the step.\ntheorem unprimedC_eval {pr pm : List (Nat × Nat)} {c : C} (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalC (primed pr ρ' ρ) (primedMaps pm M' M) c = evalC ρ M c := by\n  rw [congrC _ ρ _ c (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrMC ρ _ M c (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\ntheorem unprimed_eval {pr pm : List (Nat × Nat)} {e : E} (hv : ∀ i, occE i e = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occME mp e = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalE (primed pr ρ' ρ) (primedMaps pm M' M) e = evalE ρ M e := by\n  rw [congrE _ ρ _ e (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrME ρ _ M e (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\n-- A condition (a term) read across a step: primed, it is read after the step; plain, before it, whether in `then`'s\n-- reading or in `when`'s; given that what it reads is renamed or unchanged by the step, and unchanged by the request.\ntheorem view_C {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {c : C} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i c = true → X i = ρ i) (hn : ∀ mp, occMC mp c = true → N mp = M mp) :\n    evalC (primed pr ρ' X) (primedMaps pm M' N) (primeC pr pm c) = evalC ρ' M' c\n      ∧ evalC (primed pr ρ' X) (primedMaps pm M' N) c = evalC ρ M c ∧ evalC X N c = evalC ρ M c := by\n  have h3 : evalC X N c = evalC ρ M c := by rw [congrMC X N M c hn]; exact congrC X ρ M c hx\n  refine ⟨primeC_eval pr pm hpr hpm X ρ' N M' c hv hm, ?_, h3⟩\n  rw [unprimedC_eval (fun i hi => (hv i hi).1) (fun mp h => (hm mp h).1), h3]\n\ntheorem view_E {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {e : E} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i (.eq e e) = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp (.eq e e) = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i (.eq e e) = true → X i = ρ i) (hn : ∀ mp, occMC mp (.eq e e) = true → N mp = M mp) :\n    evalE (primed pr ρ' X) (primedMaps pm M' N) (primeE pr pm e) = evalE ρ' M' e\n      ∧ evalE (primed pr ρ' X) (primedMaps pm M' N) e = evalE ρ M e := by\n  have h3 : evalE X N e = evalE ρ M e := by\n    rw [congrME X N M e (fun mp h => hn mp (by simp [occMC, h]))]; exact congrE X ρ M e (fun i h => hx i (by simp [occC, h]))\n  refine ⟨primeE_eval pr pm hpr hpm X ρ' N M' e (fun i h => hv i (by simp [occC, h])) (fun mp h => hm mp (by simp [occMC, h])), ?_⟩\n  rw [unprimed_eval (fun i h => (hv i (by simp [occC, h])).1) (fun mp h => (hm mp (by simp [occMC, h])).1), h3]\n\n/-! The conditions Lean builds -/\n\ndef falseC : C := .lt (.const 0) (.const 0)\n-- The rank after (as') below the rank before (as), in order; the two equal; each region, if it held, held after; some\n-- region; the request's inputs as its terms.\ndef lexLtC : List E → List E → C\n  | a' :: as', a :: as => .or (.lt a' a) (.and (.eq a' a) (lexLtC as' as))\n  | _, _ => falseC\ndef eqsC : List E → List E → C\n  | a' :: as', a :: as => .and (.eq a' a) (eqsC as' as)\n  | _, _ => trueC\ndef keepC (pr pm : List (Nat × Nat)) : List C → C\n  | [] => trueC\n  | w :: ws => .and (.or (.not w) (primeC pr pm w)) (keepC pr pm ws)\ndef anyC : List C → C\n  | [] => falseC\n  | w :: ws => .or w (anyC ws)\ndef reqC : List (Nat × E) → C\n  | [] => trueC\n  | p :: ps => .and (.eq (.var p.1) p.2) (reqC ps)\n\ntheorem lexLtC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ as' as : List E,\n    evalC ρ M (lexLtC as' as) = lexB (as'.map (evalE ρ M)) (as.map (evalE ρ M))\n  | a' :: as', a :: as => by simp only [lexLtC, lexB, evalC, List.map_cons, lexLtC_eval ρ M as' as]\n  | [], _ => by simp [lexLtC, lexB, evalC, falseC]\n  | _ :: _, [] => by simp [lexLtC, lexB, evalC, falseC]\n\ntheorem eqsC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ as' as : List E, as'.length = as.length →\n    (evalC ρ M (eqsC as' as) = true ↔ as'.map (evalE ρ M) = as.map (evalE ρ M))\n  | a' :: as', a :: as, h => by\n    simp only [eqsC, evalC, Bool.and_eq_true, decide_eq_true_eq, List.map_cons, List.cons.injEq, eqsC_eval ρ M as' as (by simpa using h)]\n  | [], [], _ => by simp [eqsC, evalC, trueC]\n  | [], _ :: _, h => by simp at h\n  | _ :: _, [], h => by simp at h\n\ntheorem keepC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) (pr pm : List (Nat × Nat)) : ∀ ws : List C,\n    evalC ρ M (keepC pr pm ws) = true ↔ ∀ w ∈ ws, evalC ρ M w = true → evalC ρ M (primeC pr pm w) = true\n  | [] => by simp [keepC, evalC, trueC]\n  | w :: ws => by\n    rw [List.forall_mem_cons, ← keepC_eval ρ M pr pm ws]\n    simp only [keepC, evalC, Bool.and_eq_true, Bool.or_eq_true, Bool.not_eq_true']\n    cases evalC ρ M w <;> simp\n\ntheorem anyC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ ws : List C, evalC ρ M (anyC ws) = true ↔ ∃ w ∈ ws, evalC ρ M w = true\n  | [] => by simp [anyC, evalC, falseC]\n  | w :: ws => by simp only [anyC, evalC, Bool.or_eq_true, anyC_eval ρ M ws, List.mem_cons, exists_eq_or_imp]\n\ntheorem reqC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ ps : List (Nat × E), evalC ρ M (reqC ps) = true ↔ ∀ p ∈ ps, ρ p.1 = evalE ρ M p.2\n  | [] => by simp [reqC, evalC, trueC]\n  | p :: ps => by\n    rw [List.forall_mem_cons, ← reqC_eval ρ M ps]\n    simp only [reqC, evalC, evalE, Bool.and_eq_true]\n    exact ⟨fun h => ⟨of_decide_eq_true h.1, h.2⟩, fun h => ⟨decide_eq_true h.1, h.2⟩⟩\n\ntheorem zip_cover {α β : Type} : ∀ (as : List α) (bs : List β), as.length = bs.length → ∀ a ∈ as, ∃ b, (a, b) ∈ as.zip bs\n  | [], [], _, a, ha => by simp at ha\n  | a :: as, b :: bs, h, x, hx => by\n    rcases List.mem_cons.mp hx with rfl | hx\n    · exact ⟨b, by simp⟩\n    · obtain ⟨b', hb'⟩ := zip_cover as bs (by simpa using h) x hx\n      exact ⟨b', by simp [hb']⟩\n  | [], _ :: _, h, _, _ => by simp at h\n  | _ :: _, [], h, _, _ => by simp at h\n\n/-! Liveness -/\n\nstructure Live where\n  from_ : C\n  to : C\n  rank : List E                         -- compared in order\n  helps : List (C × List (Nat × E))     -- (the region where it helps, the request: an input and its term over the state and params)\n  prime : List (Nat × Nat)              -- a state variable, and its primed name\n  primeMaps : List (Nat × Nat)          -- a map, and its primed name\n\ndef Live.pend (l : Live) : C := .and l.from_ (.not l.to)\ndef liveStayC (l : Live) : C :=\n  .and (.or (primeC l.prime l.primeMaps l.from_) (primeC l.prime l.primeMaps l.to))\n    (.or (primeC l.prime l.primeMaps l.to) (.or (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n      (.and (eqsC (l.rank.map (primeE l.prime l.primeMaps)) l.rank) (keepC l.prime l.primeMaps (l.helps.map (·.1))))))\ndef liveCoverC (l : Live) : C := anyC (l.helps.map (·.1))\ndef liveHelpWhen (l : Live) (h : C × List (Nat × E)) : C := .and l.pend (.and h.1 (reqC h.2))\ndef liveHelpThen (l : Live) : C := .or (primeC l.prime l.primeMaps l.to) (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n-- What reads the state alone: `from`, `to`, each part of the rank and each region.\ndef liveConds (l : Live) : List C := [l.from_, l.to] ++ l.rank.map (fun e => .eq e e) ++ l.helps.map (·.1)\n\ntheorem mem_conds_rank {l : Live} {e : E} (he : e ∈ l.rank) : C.eq e e ∈ liveConds l := by\n  simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inl (Or.inr ⟨e, he, rfl⟩)\n\n/-- The argument, given how each step reads: `B`, `BM` the state and maps `when` reads (with the request), `A`, `AM`\nthose `then` reads (primed names after the step). -/\ntheorem leads_view (l : Live) (st : Nat → (Nat → Nat) × (Nat → Nat → Nat)) (B A : Nat → Nat → Nat) (BM AM : Nat → Nat → Nat → Nat)\n    (H En : C × List (Nat × E) → Nat → Prop)\n    (hC : ∀ n, ∀ c ∈ liveConds l, evalC (A n) (AM n) (primeC l.prime l.primeMaps c) = evalC (st (n + 1)).1 (st (n + 1)).2 c\n      ∧ evalC (A n) (AM n) c = evalC (st n).1 (st n).2 c ∧ evalC (B n) (BM n) c = evalC (st n).1 (st n).2 c)\n    (hE : ∀ n, ∀ e ∈ l.rank, evalE (A n) (AM n) (primeE l.prime l.primeMaps e) = evalE (st (n + 1)).1 (st (n + 1)).2 e\n      ∧ evalE (A n) (AM n) e = evalE (st n).1 (st n).2 e)\n    (hstay : ∀ n, evalC (B n) (BM n) l.pend = true → evalC (A n) (AM n) (liveStayC l) = true)\n    (hcover : ∀ n, evalC (B n) (BM n) l.pend = true → evalC (A n) (AM n) (liveCoverC l) = true)\n    (hhelp : ∀ h ∈ l.helps, ∀ n, evalC (B n) (BM n) (liveHelpWhen l h) = true → evalC (A n) (AM n) (liveHelpThen l) = true)\n    (hreq : ∀ h ∈ l.helps, ∀ n, H h n → evalC (B n) (BM n) (reqC h.2) = true)\n    (henabled : ∀ h ∈ l.helps, ∀ n, evalC (st n).1 (st n).2 l.from_ = true → evalC (st n).1 (st n).2 l.to = false →\n      evalC (st n).1 (st n).2 h.1 = true → En h n)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → En h m) → ∃ m, n ≤ m ∧ H h m) :\n    ∀ n, evalC (st n).1 (st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (st m).1 (st m).2 l.to = true := by\n  have memF : l.from_ ∈ liveConds l := by simp [liveConds]\n  have memT : l.to ∈ liveConds l := by simp [liveConds]\n  have memH : ∀ h ∈ l.helps, h.1 ∈ liveConds l := fun h hh => by\n    simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inr ⟨h, hh, rfl⟩\n  have h1 : ∀ n, (l.rank.map (primeE l.prime l.primeMaps)).map (evalE (A n) (AM n)) = l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2) := by\n    intro n; rw [List.map_map]; exact List.map_congr_left (fun e he => (hE n e he).1)\n  have h2 : ∀ n, l.rank.map (evalE (A n) (AM n)) = l.rank.map (evalE (st n).1 (st n).2) := fun n =>\n    List.map_congr_left (fun e he => (hE n e he).2)\n  have hlex : ∀ n, evalC (A n) (AM n) (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n      = lexB (l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2)) (l.rank.map (evalE (st n).1 (st n).2)) := by\n    intro n; rw [lexLtC_eval, h1, h2]\n  have heqs : ∀ n, evalC (A n) (AM n) (eqsC (l.rank.map (primeE l.prime l.primeMaps)) l.rank) = true\n      ↔ l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2) = l.rank.map (evalE (st n).1 (st n).2) := by\n    intro n; rw [eqsC_eval _ _ _ _ (by simp), h1, h2]\n  have hpend : ∀ n, evalC (st n).1 (st n).2 l.from_ = true → ¬ evalC (st n).1 (st n).2 l.to = true → evalC (B n) (BM n) l.pend = true := by\n    intro n hP hnQ\n    simp only [Live.pend, evalC, Bool.and_eq_true, Bool.not_eq_true']\n    rw [(hC n _ memF).2.2, (hC n _ memT).2.2]; exact ⟨hP, by simpa using hnQ⟩\n  refine leads_of_lex (fun n => evalC (st n).1 (st n).2 l.from_ = true) (fun n => evalC (st n).1 (st n).2 l.to = true)\n    (fun n => l.rank.map (evalE (st n).1 (st n).2)) l.rank.length (fun n => by simp) l.helps\n    (fun h n => evalC (st n).1 (st n).2 h.1 = true) H En ?_ ?_ ?_ (fun h hh n hP hnQ hW => henabled h hh n hP (by simpa using hnQ) hW) fair\n  · intro n hP hnQ\n    have h := hstay n (hpend n hP hnQ)\n    simp only [liveStayC, evalC, Bool.and_eq_true, Bool.or_eq_true] at h\n    rw [(hC n _ memF).1, (hC n _ memT).1, hlex n, heqs n, keepC_eval] at h\n    refine ⟨h.1, ?_⟩\n    rcases h.2 with h2 | h2 | ⟨h2, h3⟩\n    · exact Or.inl h2\n    · exact Or.inr (Or.inl h2)\n    · refine Or.inr (Or.inr ⟨h2, fun hp hhp hW => ?_⟩)\n      have := h3 hp.1 (List.mem_map_of_mem hhp) (by rw [(hC n _ (memH hp hhp)).2.1]; exact hW)\n      rwa [(hC n _ (memH hp hhp)).1] at this\n  · intro n hP hnQ\n    have h := hcover n (hpend n hP hnQ)\n    rw [liveCoverC, anyC_eval] at h\n    obtain ⟨w, hw, hW⟩ := h\n    obtain ⟨hp, hhp, rfl⟩ := List.mem_map.mp hw\n    exact ⟨hp, hhp, by rw [← (hC n _ (memH hp hhp)).2.1]; exact hW⟩\n  · intro hp hhp n hP hnQ hW hH\n    have hB : evalC (B n) (BM n) (liveHelpWhen l hp) = true := by\n      have := hpend n hP hnQ\n      simp only [liveHelpWhen, evalC, Bool.and_eq_true]\n      rw [(hC n _ (memH hp hhp)).2.2]\n      exact ⟨this, hW, hreq hp hhp n hH⟩\n    have h := hhelp hp hhp n hB\n    simp only [liveHelpThen, evalC, Bool.or_eq_true] at h\n    rwa [(hC n _ memT).1, hlex n] at h\n\ntheorem assoc_distinct : ∀ {σ : List (Nat × E)}, distinct (σ.map (·.1)) = true → ∀ {p}, p ∈ σ → assoc σ p.1 = some p.2\n  | [], _, _, hp => by simp at hp\n  | a :: as, hd, p, hp => by\n    simp only [List.map_cons, distinct, Bool.and_eq_true, Bool.not_eq_true'] at hd\n    simp only [assoc, lookup]\n    rcases List.mem_cons.mp hp with rfl | hp\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he\n        have h1 : (as.map (·.1)).contains a.1 = true := List.contains_iff_mem.mpr (by rw [he]; exact List.mem_map_of_mem hp)\n        rw [hd.1] at h1; cases h1\n      simp only [hne, Bool.false_eq_true, if_false]\n      have := assoc_distinct hd.2 hp\n      simpa [assoc] using this\n\n/-! Machines with sets -/\n\n-- As for maps and flags, with the request's extended variables (inputs, quantified flags, witnesses) and the maps it\n-- carries read by no part of the liveness, and maps written at every key unprimed counted as written.\ndef sliveVars (s : SMachine) (l : Live) : List Nat :=\n  l.prime.map (·.2) ++ s.extVars ++ (flagVars s.f.flags ++ s.f.m.step.map (·.1)).filter (fun i => !(l.prime.map (·.1)).contains i)\ndef sliveMaps (s : SMachine) (l : Live) : List Nat :=\n  l.primeMaps.map (·.2) ++ s.carried ++ (s.f.m.writes.map (·.1) ++ s.every.map (·.1)).filter (fun mp => !(l.primeMaps.map (·.1)).contains mp)\ndef sliveOk (s : SMachine) (l : Live) : Bool :=\n  distinct (l.prime.map (·.2)) && distinct (l.primeMaps.map (·.2))\n    && (liveConds l).all (fun c => avoids (sliveVars s l) c && avoidsMaps (sliveMaps s l) c)\n    && l.helps.all (fun h => h.2.all (fun p => s.f.m.inputs.contains p.1 && avoids s.extVars (.eq p.2 p.2) && avoidsMaps s.carried (.eq p.2 p.2)))\n\n-- A step law over sets's proof: (law instances, quantified flag instances, fact instances, several-key instances, tree).\n-- A proof's instances (laws, quantified flags, facts, laws about several keys, facts about several keys) and its certificate.\nabbrev SProof := List (Nat × E) × List (Nat × List E) × List (Nat × E) × List (Nat × E × List E) × List (Nat × E × List E) × Cert\ndef sliveStep (l : Live) (w t : C) (p : SProof) : SKStep :=\n  ⟨⟨[w], t, [[]], l.prime, l.primeMaps, p.1, (p.2.2.2.2.2.1, p.2.2.2.2.2.2.2)⟩, [[]], p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2.1, p.2.2.2.2.2.2.1, []⟩\ndef sliveHelpsOk (s : SMachine) (ps : List SEntry) (l : Live) (hp : List SProof) : Bool :=\n  l.helps.length == hp.length && (l.helps.zip hp).all (fun x => checkSKStep s ps (sliveStep l (liveHelpWhen l x.1) (liveHelpThen l) x.2))\n\n-- A run of a machine with sets: each step a request (inputs, the maps it carries) the machine allows.\nstructure SRun (s : SMachine) where\n  st : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  req : Nat → SRequest\n  start : SReach s (st 0).1 (st 0).2\n  allowed : ∀ n, evalC (sView s (st n).1 (st n).2 (req n).1 (req n).2).1 (sView s (st n).1 (st n).2 (req n).1 (req n).2).2 s.f.m.assume = true\n  next : ∀ n, st (n + 1) = sNext s (st n).1 (st n).2 (req n).1 (req n).2\n\ntheorem srun_reach {s : SMachine} (run : SRun s) : ∀ n, SReach s (run.st n).1 (run.st n).2\n  | 0 => run.start\n  | n + 1 => by rw [run.next n]; exact SReach.step _ _ _ _ (srun_reach run n) (run.allowed n)\n\n-- A step law over sets of one step: every request allowed that `when` admits takes a step where `then` holds.\ntheorem skstep_one {s : SMachine} {ps : List SEntry} {l : Live} {w t : C} {p : SProof} (hl : checkSMachine s ps = true)\n    (hc : checkSKStep s ps (sliveStep l w t p) = true) : ∀ ρ M, SReach s ρ M → ∀ ι κ,\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true →\n      evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true →\n      evalC (primed l.prime (sNext s ρ M ι κ).1 (withExt s ρ (sReq s ρ M ι κ)))\n        (primedMaps l.primeMaps (sNext s ρ M ι κ).2 (withCarried s M κ)) t = true := by\n  intro ρ M hr ι κ hA hW\n  have h := skstep_sound s ps _ hl hc ρ M hr (ι, κ) [] rfl ⟨hA, hW, trivial⟩\n  simpa [sliveStep, sEnd, sExts, renEnv, renMaps, lookup] using h\n\n-- A step law over sets of one step, read as one step: every request allowed that `when` admits takes a step where `then`\n-- holds, its fresh names read as the step reads them.\ntheorem skstep_holds_one {s : SMachine} {sl : SKStep} {w : C} (h : SKStepHolds s sl) (hw : sl.k.whens = [w]) (hren : sl.k.ren = [[]])\n    (hmren : sl.mren = [[]]) : ∀ ρ M, SReach s ρ M → ∀ ι κ,\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true →\n      evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true →\n      evalC (primed sl.k.prime (sNext s ρ M ι κ).1 (withExt s ρ (sReq s ρ M ι κ)))\n        (primedMaps sl.k.primeMaps (sNext s ρ M ι κ).2 (withCarried s M κ)) sl.k.then_ = true := by\n  intro ρ M hr ι κ hA hW\n  have := h ρ M hr (ι, κ) [] (by simp [hw]) (by rw [hw]; exact ⟨hA, hW, trivial⟩)\n  rw [hren, hmren] at this\n  simpa [sEnd, sExts, renEnv, renMaps, lookup] using this\n\ntheorem decideQ_other {s : SMachine} {i : Nat} (h : i ∉ s.qVars) (X : Nat → Nat) (N : Nat → Nat → Nat) : decideQ s X N i = X i := by\n  simp only [decideQ]\n  rw [lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hq))]\n\ntheorem slive_reads {s : SMachine} {l : Live} (hok : sliveOk s l = true) {c : C} (hc : c ∈ liveConds l)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (∀ i, occC i c = true → i ∉ l.prime.map (·.2) ∧ (i ∈ l.prime.map (·.1) ∨ (sNext s ρ M ι κ).1 i = withExt s ρ (sReq s ρ M ι κ) i))\n      ∧ (∀ mp, occMC mp c = true → mp ∉ l.primeMaps.map (·.2) ∧ (mp ∈ l.primeMaps.map (·.1) ∨ (sNext s ρ M ι κ).2 mp = withCarried s M κ mp))\n      ∧ (∀ i, occC i c = true → withExt s ρ (sReq s ρ M ι κ) i = ρ i)\n      ∧ (∀ mp, occMC mp c = true → withCarried s M κ mp = M mp) := by\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok\n  have hv := hok.1.2 c hc\n  have noExt : ∀ i, occC i c = true → i ∉ s.extVars := fun i hi hm => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hext : ∀ i, occC i c = true → withExt s ρ (sReq s ρ M ι κ) i = ρ i := fun i hi => by\n    simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using noExt i hi)]\n  have noCar : ∀ mp, occMC mp c = true → mp ∉ s.carried := fun mp hmp hm => avoidsMaps_occ hv.2 hmp (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hcar : ∀ mp, occMC mp c = true → withCarried s M κ mp = M mp := fun mp hmp => by\n    simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using noCar mp hmp)]\n  refine ⟨fun i hi => ⟨fun h => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_left _ h)), ?_⟩,\n    fun mp hmp => ⟨fun h => avoidsMaps_occ hv.2 hmp (List.mem_append_left _ (List.mem_append_left _ h)), ?_⟩, hext, hcar⟩\n  · by_cases hp : i ∈ l.prime.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hn : i ∉ flagVars s.f.flags ++ s.f.m.step.map (·.1) := fun hm =>\n        avoids_occ hv.1 hi (List.mem_append_right _ (List.mem_filter.mpr ⟨hm, by simpa [List.contains_iff_mem] using hp⟩))\n      have hx := noExt i hi\n      simp only [SMachine.extVars, SMachine.qVars, List.mem_append, not_or] at hx\n      rw [hext i hi]\n      simp only [sNext, sView]\n      rw [applyS_other (fun h => hn (List.mem_append_right _ h)), decide_other (fun h => hn (List.mem_append_left _ h)),\n        decideQ_other (by simpa [SMachine.qVars] using hx.1.2), withInputs_other hx.1.1]\n  · by_cases hp : mp ∈ l.primeMaps.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hw : mp ∉ s.f.m.writes.map (·.1) ++ s.every.map (·.1) := fun hm =>\n        avoidsMaps_occ hv.2 hmp (List.mem_append_right _ (List.mem_filter.mpr ⟨hm, by simpa [List.contains_iff_mem] using hp⟩))\n      funext k\n      simp only [sNext, everyMaps]\n      rw [lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro he; exact hw (List.mem_append_right _ (by rw [← he]; exact List.mem_map_of_mem hw')))]\n      simp only [writeMaps]\n      rw [lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro he; exact hw (List.mem_append_left _ (by rw [← he]; exact List.mem_map_of_mem hw')))]\n      rfl\n\n/-- Liveness under fairness: if the laws' proof checks, the liveness reads what it may (`sliveOk`), and the step laws Lean\nbuilds from it check, then along every run that takes each helpful request (its named inputs as its terms; the rest,\nand the maps it carries, free) infinitely often, each state where `from` holds is followed by one where `to` holds. -/\ntheorem sleads_sound (s : SMachine) (ps : List SEntry) (l : Live) (sp cp : SProof) (hp : List SProof)\n    (hl : checkSMachine s ps = true) (hok : sliveOk s l = true)\n    (hs : checkSKStep s ps (sliveStep l l.pend (liveStayC l) sp) = true) (hc : checkSKStep s ps (sliveStep l l.pend (liveCoverC l) cp) = true)\n    (hh : sliveHelpsOk s ps l hp = true) (run : SRun s)\n    (fair : ∀ h ∈ l.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :\n    ∀ n, evalC (run.st n).1 (run.st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 l.to = true := by\n  have hok0 := hok\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨⟨⟨hd1, hd2⟩, _⟩, hreqs⟩ := hok0\n  simp only [sliveHelpsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hh\n  obtain ⟨hlen, hall⟩ := hh\n  refine leads_view l run.st (fun n => withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2))\n    (fun n => primed l.prime (run.st (n + 1)).1 (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)))\n    (fun n => withCarried s (run.st n).2 (run.req n).2) (fun n => primedMaps l.primeMaps (run.st (n + 1)).2 (withCarried s (run.st n).2 (run.req n).2))\n    (fun h n => ∀ p ∈ h.2, (run.req n).1 p.1 = evalE (run.st n).1 (run.st n).2 p.2) (fun _ _ => True) ?_ ?_ ?_ ?_ ?_ ?_\n    (fun _ _ _ _ _ _ => trivial) (fun h hh n _ => fair h hh n)\n  · intro n c hc\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok hc (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_C hd1 hd2 hv hm hx hn\n  · intro n e he\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok (mem_conds_rank he) (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_E hd1 hd2 hv hm hx hn\n  · intro n hB\n    have := skstep_one hl hs _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_one hl hc _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    obtain ⟨pp, hpp⟩ := zip_cover l.helps hp hlen h hmem\n    have := skstep_one hl (hall _ hpp) _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hH\n    show evalC (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) (reqC h.2) = true\n    rw [reqC_eval]\n    intro p hp'\n    have hq := hreqs h hmem p hp'\n    obtain ⟨⟨hin, hav⟩, havm⟩ := hq\n    have hext : s.extVars.contains p.1 = true := by\n      simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inl (Or.inl (List.contains_iff_mem.mp hin))\n    have hl1 : withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2) p.1 = (run.req n).1 p.1 := by\n      simp only [withExt, hext, if_true, sReq, hin]\n    have hr1 : evalE (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) p.2\n        = evalE (run.st n).1 (run.st n).2 p.2 := by\n      rw [congrME _ _ (run.st n).2 p.2 (fun mp hmp => by\n        simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using avoidsMaps_occ havm (by simp [occMC, hmp]))])]\n      exact congrE _ _ _ p.2 (fun i hi => by\n        simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using avoids_occ hav (by simp [occC, hi]))])\n    rw [hl1, hr1]; exact hH p hp'\n\n/-! Weak fairness over sets -/\n\n-- A request whose inputs named in a list are the list's terms meets the list's condition, in the goal's view.\ntheorem sreq_list {s : SMachine} {ps' : List (Nat × E)}\n    (hc : ∀ p ∈ ps', (s.f.m.inputs.contains p.1 = true ∧ avoids s.extVars (.eq p.2 p.2) = true) ∧ avoidsMaps s.carried (.eq p.2 p.2) = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι : Nat → Nat} {κ : Nat → Nat → Nat} (hH : ∀ p ∈ ps', ι p.1 = evalE ρ M p.2) :\n    evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) (reqC ps') = true := by\n  rw [reqC_eval]\n  intro p hp'\n  obtain ⟨⟨hin, hav⟩, havm⟩ := hc p hp'\n  have hext : s.extVars.contains p.1 = true := by\n    simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inl (Or.inl (List.contains_iff_mem.mp hin))\n  have hl1 : withExt s ρ (sReq s ρ M ι κ) p.1 = ι p.1 := by simp only [withExt, hext, if_true, sReq, hin]\n  have hr1 : evalE (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) p.2 = evalE ρ M p.2 := by\n    rw [congrME _ _ M p.2 (fun mp hmp => by\n      simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using avoidsMaps_occ havm (by simp [occMC, hmp]))])]\n    exact congrE _ _ _ p.2 (fun i hi => by\n      simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using avoids_occ hav (by simp [occC, hi]))])\n  rw [hl1, hr1]; exact hH p hp'\n\ntheorem sreq_holds {s : SMachine} {l : Live} (hok : sliveOk s l = true) {h : C × List (Nat × E)} (hmem : h ∈ l.helps)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι : Nat → Nat} {κ : Nat → Nat → Nat} (hH : ∀ p ∈ h.2, ι p.1 = evalE ρ M p.2) :\n    evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) (reqC h.2) = true := by\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok\n  exact sreq_list (fun p hp' => hok.2 h hmem p hp') hH\n\n-- A helpful request allowed in its region, carrying empty sets: the precondition, the facts, the laws, `when`, each\n-- quantified flag closed, and the carried maps empty at the keys the proof names refute the assumption's failing. The\n-- facts read no request's variable or map.\ndef zeroHyps (s : SMachine) (zkeys : List E) : List C := s.carried.flatMap fun mp => zkeys.map fun t => .eq (.get mp t) (.const 0)\ndef sAllowGoal (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E) : List C :=\n  [s.f.m.pre] ++ factHyps s p.2.2.1 p.2.2.2.2.1 ++ (scalarHyps (sLaws ps p.2.2.2.1) ++ instHyps (sLaws ps p.2.2.2.1) (sInsts ps p.1 p.2.2.2.1))\n    ++ [w] ++ closingHyps s p.2.1 ++ zeroHyps s zkeys ++ [.not (inlineC s.f.flags s.f.m.assume)]\ndef checkSAllow (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E) : Bool :=\n  s.facts.all (fun l => avoids s.extVars l.holds && avoidsMaps s.carried l.holds)\n    && checkIn (sAllowGoal s ps w p zkeys) p.2.2.2.2.2\n\n-- The request carrying empty sets.\ndef noSets : Nat → Nat → Nat := fun _ _ => 0\n\ntheorem sallow_sound (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E)\n    (hl : checkSMachine s ps = true) (hc : checkSAllow s ps w p zkeys = true) :\n    ∀ ρ M, SReach s ρ M → ∀ ι, evalC (withExt s ρ (sReq s ρ M ι noSets)) (withCarried s M noSets) w = true →\n      evalC (sView s ρ M ι noSets).1 (sView s ρ M ι noSets).2 s.f.m.assume = true := by\n  intro ρ M hr ι hw\n  simp only [checkSAllow, Bool.and_eq_true, List.all_eq_true] at hc\n  obtain ⟨hfa, hgoal⟩ := hc\n  have hs := sOk_of hl\n  obtain ⟨hpreS, hrp⟩ := spre_parts hl\n  let W := withExt s ρ (sReq s ρ M ι noSets)\n  let M0 := withCarried s M noSets\n  have hWo : ∀ v, v ∉ s.extVars → W v = ρ v := fun v hv => by\n    simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hv)]\n  have hMo : ∀ mp, mp ∉ s.carried → M0 mp = M mp := fun mp hmp => by\n    simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]\n  -- Every entry, and each pair's, holds in the goal's view of the state.\n  have hall : ∀ e ∈ ps, e.Holds W M0 := fun e he =>\n    sentry_transfer (slaws_avoid hl e.law (List.mem_map_of_mem he)).1 (slaws_avoid hl e.law (List.mem_map_of_mem he)).2\n      (fun i hi => by simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hi)])\n      (fun mp hmp => by simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)])\n      (smachine_sound s ps hl ρ M hr e he)\n  have hlY : ∀ l ∈ sLaws ps p.2.2.2.1, l.Holds W M0 := fun l hl' => by\n    rcases List.mem_append.mp hl' with hl' | hl'\n    · obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl'; exact SEntry.holds_law (hall e' he')\n    · exact pairLaws_hold ps p.2.2.2.1 (skeys_apart hl) hall l hl'\n  have hfacts : ∀ l ∈ s.facts, l.Holds W M0 := fun l hl' => by\n    have h := hfa l hl'\n    exact holds_transfer l h.1 h.2 (fun i hi => hWo i hi) (fun mp hmp => hMo mp hmp) (facts_sreach s (sfacts_ok hl) hr l hl')\n  apply Decidable.byContradiction; intro hn\n  apply sound_in _ _ hgoal W M0\n  intro c hc\n  simp only [sAllowGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with (((((rfl | hc) | hc) | rfl) | hc) | hc) | rfl\n  · rw [noReadsC W M0 M s.f.m.pre hrp, congrC W ρ M s.f.m.pre (fun j hj => hWo j (fun h' =>\n      avoids_occ hpreS hj (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h')))))]\n    exact pre_sreach s hpreS hrp hr\n  · -- The facts about several keys, as the reachable state has them: they read no request and no carried map.\n    have hpf : s.PFacts W M0 := fun f hf' =>\n      holdsOver_transfer f.1 (pfactsOk_parts (sfacts_ok hl) f hf').1 (pfactsOk_parts (sfacts_ok hl) f hf').2.1 f.2\n        (fun i hi => hWo i (fun h' => hi (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h')))))\n        (fun mp hmp => hMo mp (fun h' => hmp (List.mem_append_left _ (List.mem_append_left _ h'))))\n        (pfacts_sreach s (sfacts_ok hl) hr f hf')\n    exact facthyps_true s p.2.2.1 p.2.2.2.2.1 W M0 (fun f hf' => (pfactsOk_parts (sfacts_ok hl) f hf').2.2) hfacts hpf c hc\n  · exact laws_hyps_true _ _ W M0 hlY c (List.mem_append.mpr hc)\n  · exact hw\n  · exact closing_true s ρ M ι noSets hs p.2.1 c hc\n  · simp only [zeroHyps, List.mem_flatMap, List.mem_map] at hc\n    obtain ⟨mp, hmp, t, _, rfl⟩ := hc\n    simp only [evalC, evalE, M0, withCarried, List.contains_iff_mem.mpr hmp, if_true, noSets, decide_eq_true_eq]\n  · -- The assumption, inlined: the view decides the plain flags as the step does, away from the witnesses.\n    simp only [evalC, Bool.not_eq_true']\n    rw [inline_evalC]\n    have hagD := decide_agree_on (sOk_parts s hs).2.2.2.2.2.2 (withCarried s M noSets) (view_agree s ρ M ι noSets hs)\n    rw [congrC _ (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M noSets)) (withCarried s M noSets)) _ s.f.m.assume\n      (fun i hi => (hagD i (fun h => by\n        have hpa : avoids s.wVars s.f.m.assume = true := by simp only [sOk, Bool.and_eq_true] at hs; exact hs.2\n        exact avoids_occ hpa hi h)).symm)]\n    have hf : evalC (sView s ρ M ι noSets).1 (sView s ρ M ι noSets).2 s.f.m.assume = false := by simpa using hn\n    exact hf\n\ndef sliveAllowsOk (s : SMachine) (ps : List SEntry) (l : Live) (ap : List (List (Nat × E) × SProof × List E)) : Bool :=\n  l.helps.length == ap.length\n    && (l.helps.zip ap).all (fun x => distinct ((x.1.2 ++ x.2.1).map (·.1))\n      && x.2.1.all (fun p => s.f.m.inputs.contains p.1 && avoids s.extVars (.eq p.2 p.2) && avoidsMaps s.carried (.eq p.2 p.2))\n      && checkSAllow s ps (.and (liveHelpWhen l x.1) (reqC x.2.1)) x.2.2.1 x.2.2.2)\n\n/-- Liveness under weak fairness, for machines with sets: as `sleads_sound`, with each helpful request also proven\nallowed in its region carrying empty sets (`sliveAllowsOk`); then along every run that takes each helpful request\nwhenever, from some point on, it stays allowed (some request with its named inputs as its terms, carrying some sets, is a\nstep the machine allows), each state where `from` holds is followed by one where `to` holds. -/\ntheorem sleads_wf_sound (s : SMachine) (ps : List SEntry) (l : Live) (sp cp : SProof) (hp : List SProof) (ap : List (List (Nat × E) × SProof × List E))\n    (hl : checkSMachine s ps = true) (hok : sliveOk s l = true)\n    (hs : checkSKStep s ps (sliveStep l l.pend (liveStayC l) sp) = true) (hc : checkSKStep s ps (sliveStep l l.pend (liveCoverC l) cp) = true)\n    (hh : sliveHelpsOk s ps l hp = true) (ha : sliveAllowsOk s ps l ap = true) (run : SRun s)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (sView s (run.st m).1 (run.st m).2 ι κ).1 (sView s (run.st m).1 (run.st m).2 ι κ).2 s.f.m.assume = true) →\n      ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :\n    ∀ n, evalC (run.st n).1 (run.st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 l.to = true := by\n  have hok0 := hok\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨⟨⟨hd1, hd2⟩, _⟩, hreqs⟩ := hok0\n  simp only [sliveHelpsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hh\n  obtain ⟨hlen, hall⟩ := hh\n  simp only [sliveAllowsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at ha\n  obtain ⟨halen, haall⟩ := ha\n  refine leads_view l run.st (fun n => withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2))\n    (fun n => primed l.prime (run.st (n + 1)).1 (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)))\n    (fun n => withCarried s (run.st n).2 (run.req n).2) (fun n => primedMaps l.primeMaps (run.st (n + 1)).2 (withCarried s (run.st n).2 (run.req n).2))\n    (fun h n => ∀ p ∈ h.2, (run.req n).1 p.1 = evalE (run.st n).1 (run.st n).2 p.2)\n    (fun h m => ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (sView s (run.st m).1 (run.st m).2 ι κ).1 (sView s (run.st m).1 (run.st m).2 ι κ).2 s.f.m.assume = true) ?_ ?_ ?_ ?_ ?_ ?_ ?_ fair\n  · intro n c hc\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok hc (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_C hd1 hd2 hv hm hx hn\n  · intro n e he\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok (mem_conds_rank he) (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_E hd1 hd2 hv hm hx hn\n  · intro n hB\n    have := skstep_one hl hs _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_one hl hc _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    obtain ⟨pp, hpp⟩ := zip_cover l.helps hp hlen h hmem\n    have := skstep_one hl (hall _ hpp) _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hH\n    show evalC (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) (reqC h.2) = true\n    exact sreq_holds hok hmem (fun p hp' => hH p hp')\n  · -- Enabled in its region: the request with its named inputs as its terms, the rest as the state has them, carrying\n    -- empty sets.\n    intro h hmem n hP hnQ hW\n    obtain ⟨x, hx⟩ := zip_cover l.helps ap halen h hmem\n    obtain ⟨⟨hdist, hwit⟩, hpc⟩ := haall _ hx\n    let ρ := (run.st n).1\n    let M := (run.st n).2\n    let ι := applyS (h.2 ++ x.1) ρ M\n    have hιp : ∀ p ∈ h.2, ι p.1 = evalE ρ M p.2 := fun p hp' => by\n      simp only [ι, applyS, assoc_distinct hdist (List.mem_append_left _ hp')]\n    have hιw : ∀ p ∈ x.1, ι p.1 = evalE ρ M p.2 := fun p hp' => by\n      simp only [ι, applyS, assoc_distinct hdist (List.mem_append_right _ hp')]\n    have hX : ∀ c ∈ liveConds l, evalC (withExt s ρ (sReq s ρ M ι noSets)) (withCarried s M noSets) c = evalC ρ M c := fun c hc' => by\n      obtain ⟨_, _, hx', hn'⟩ := slive_reads hok hc' ρ M ι noSets\n      rw [congrMC _ _ M c hn']; exact congrC _ _ M c hx'\n    have memF : l.from_ ∈ liveConds l := by simp [liveConds]\n    have memT : l.to ∈ liveConds l := by simp [liveConds]\n    have memH : h.1 ∈ liveConds l := by simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inr ⟨h, hmem, rfl⟩\n    refine ⟨ι, noSets, hιp, sallow_sound s ps _ x.2.1 x.2.2 hl hpc ρ M (srun_reach run n) ι ?_⟩\n    simp only [liveHelpWhen, Live.pend, evalC, Bool.and_eq_true, Bool.not_eq_true']\n    rw [hX _ memF, hX _ memT, hX _ memH]\n    exact ⟨⟨⟨hP, hnQ⟩, hW, sreq_holds hok hmem hιp⟩, sreq_list (fun p hp' => hwit p hp') hιw⟩\n\n/-! Loops, as machines -/\n\n-- A loop as a machine with sets (none of them): the loop's state, inputs, precondition and assumption, its body taken\n-- where the guard holds and the state kept where it doesn't. That it halts is a liveness claim: every request helps,\n-- `to` is the guard failing, and the loop's ranks drop.\ndef Loop.machine (l : Loop) : SMachine :=\n  ⟨⟨⟨l.inputs, l.init, [], l.body.map (fun p => (p.1, E.ite l.guard p.2 (.var p.1))), [], l.pre, l.assume⟩, []⟩, [], [], [], [], [], []⟩\n\ntheorem assoc_guarded (g : C) (i : Nat) : ∀ body : List (Nat × E),\n    assoc (body.map fun p => (p.1, E.ite g p.2 (.var p.1))) i = (assoc body i).map fun e => E.ite g e (.var i)\n  | [] => rfl\n  | p :: ps => by\n    simp only [List.map_cons, assoc, lookup] at ⊢\n    by_cases h : (p.1 == i) = true\n    · have hp : p.1 = i := beq_iff_eq.mp h\n      simp only [h, ite_true, Option.map_some]; rw [hp]\n    · simp only [h, Bool.false_eq_true, ite_false]\n      have := assoc_guarded g i ps\n      simp only [assoc] at this; exact this\n\n-- The loop's machine reads a request as the loop does: its inputs set, nothing decided, no map carried.\ntheorem sView_loop (l : Loop) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sView l.machine ρ M ι κ = (withInputs l.inputs ρ ι, M) := by\n  have hc : withCarried l.machine M κ = M := by funext mp; simp [withCarried, Loop.machine]\n  have hq : decideQ l.machine (withInputs l.inputs ρ ι) M = withInputs l.inputs ρ ι := by funext v; simp [decideQ, Loop.machine, lookup]\n  simp only [sView, hc]\n  show (decideFlags [] (decideQ l.machine (withInputs l.inputs ρ ι) M) M, M) = _\n  rw [hq]; simp [decideFlags, flagSub, applyS_nil']\n\n-- Where the guard holds, a step of the loop's machine is a turn of the loop, and leaves the maps.\ntheorem sNext_loop (l : Loop) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n    (hg : evalC (withInputs l.inputs ρ ι) M l.guard = true) :\n    sNext l.machine ρ M ι κ = (applyS l.body (withInputs l.inputs ρ ι) M, M) := by\n  simp only [sNext, sView_loop]\n  refine Prod.ext ?_ ?_\n  · funext i\n    show applyS (l.body.map fun p => (p.1, E.ite l.guard p.2 (.var p.1))) (withInputs l.inputs ρ ι) M i = _\n    simp only [applyS, assoc_guarded]\n    cases assoc l.body i with\n    | none => rfl\n    | some e => simp [evalE, hg]\n  · funext mp key; simp [everyMaps, Loop.machine, lookup, writeMaps]\n\n/-- A loop halts: if the loop's machine reaches the guard failing from anywhere, along every run whose helpful requests\n(here naming no input, so every run's) recur, then for params meeting the precondition no run of turns is infinite. -/\ntheorem loop_halts_of (l : Loop) (lv : Live) (hfrom : lv.from_ = trueC) (hto : lv.to = .not l.guard) (hhelps : ∀ h ∈ lv.helps, h.2 = [])\n    (hguard : avoids l.inputs l.guard = true)\n    (hlive : ∀ run : SRun l.machine, (∀ h ∈ lv.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) →\n      ∀ n, evalC (run.st n).1 (run.st n).2 lv.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 lv.to = true)\n    (maps : Nat → Nat → Nat) (ρ0 : Nat → Nat) (h0 : evalC ρ0 maps l.pre = true) :\n    ¬ ∃ f : Nat → Nat → Nat, f 0 = applyS l.init ρ0 maps ∧ ∀ n, Turn l maps (f n) (f (n + 1)) := by\n  rintro ⟨f, hf0, hf⟩\n  let ι := fun n => Classical.choose (hf n)\n  have hg : ∀ n, evalC (withInputs l.inputs (f n) (ι n)) maps l.guard = true := fun n => (Classical.choose_spec (hf n)).1\n  have ha : ∀ n, evalC (withInputs l.inputs (f n) (ι n)) maps l.assume = true := fun n => (Classical.choose_spec (hf n)).2.1\n  have hnext : ∀ n, f (n + 1) = applyS l.body (withInputs l.inputs (f n) (ι n)) maps := fun n => (Classical.choose_spec (hf n)).2.2\n  let run : SRun l.machine := {\n    st := fun n => (f n, maps)\n    req := fun n => (ι n, fun _ _ => 0)\n    start := by\n      show SReach l.machine (f 0) maps\n      rw [hf0]\n      exact SReach.start (s := l.machine) ρ0 maps (fun p hp => by simp [Loop.machine] at hp) h0 (fun l' hl' => by simp [Loop.machine] at hl') (fun p hp => by simp [Loop.machine] at hp)\n    allowed := fun n => by\n      show evalC (sView l.machine (f n) maps (ι n) _).1 (sView l.machine (f n) maps (ι n) _).2 l.assume = true\n      rw [sView_loop]; exact ha n\n    next := fun n => by\n      show (f (n + 1), maps) = sNext l.machine (f n) maps (ι n) _\n      rw [sNext_loop l _ _ _ _ (hg n), hnext n] }\n  obtain ⟨m, _, hm⟩ := hlive run (fun h hh n => ⟨n, Nat.le_refl n, by simp [hhelps h hh]⟩) 0 (by rw [hfrom]; simp [trueC, evalC, evalE])\n  rw [hto] at hm\n  have hgm := hg m\n  rw [congrC (withInputs l.inputs (f m) (ι m)) (f m) maps l.guard (fun i hi => withInputs_other (avoids_occ hguard hi) _ _)] at hgm\n  simp only [evalC, Bool.not_eq_true'] at hm\n  show False\n  have : evalC (run.st m).1 (run.st m).2 l.guard = true := hgm\n  rw [this] at hm; exact Bool.noConfusion hm\n\nend Kern\n\n#print axioms Kern.sleads_sound\n#print axioms Kern.sleads_wf_sound\n#print axioms Kern.loop_halts_of\n",
     "Ghost.lean": "import Live\n\n/-!\nWhat a ghost means, proven: compose.ts's `ghost(m, vars)` adds state that watches a machine without changing it. Lean\nchecks that a ghosted machine is the original's parts plus each ghost's start and step, read by no part of the original\n(`sghostOk`), and proves, for machines with maps, flags and sets:\n- `sghost_reach`: every reachable state of the original is, outside the ghosts, a reachable state of the ghosted\n  machine, so a law of the ghosted machine that reads no ghost is a law of the original (`sghost_laws`);\n- `sghost_run`: every run of the original is, outside the ghosts, a run of the ghosted machine taking the same requests;\n- `sever_meaning`: along a run, a ghost that starts at 0 and is set to 1 by a step where `c` holds (compose.ts's `ever`)\n  is 1 exactly when some step before took a request where `c` held.\n-/\n\nnamespace Kern\nopen Classical\n\ntheorem lookup_unique_fst {p : Nat × E} {l : List (Nat × E)} (hd : distinct (l.map (·.1)) = true) (hp : p ∈ l) :\n    lookup (fun q => q.1 == p.1) l = some p := by\n  induction l with\n  | nil => simp at hp\n  | cons a as ih =>\n    simp only [List.map_cons] at hd\n    obtain ⟨hna, hd'⟩ := distinct_cons hd\n    simp only [lookup]\n    rcases List.mem_cons.mp hp with rfl | hp'\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hna (by rw [he]; exact List.mem_map_of_mem hp')\n      simp only [hne, Bool.false_eq_true, ite_false]; exact ih hd' hp'\n\ntheorem assoc_append_none {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ τ.map (·.1)) : assoc (σ ++ τ) i = assoc σ i := by\n  have hτ : lookup (fun p => p.1 == i) τ = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [assoc, lookup_append]\n  cases hσ : lookup (fun p => p.1 == i) σ <;> simp [hτ]\n\ntheorem applyS_append_other {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ τ.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS (σ ++ τ) ρ M i = applyS σ ρ M i := by\n  simp only [applyS, assoc_append_none h]\n\n-- The keys a machine's every-key writes and quantified flags bind.\ndef bkeys (s : SMachine) : List Nat := s.every.map (·.2.1) ++ s.qflags.flatMap (·.2.1)\n\n-- A flag that holds at every value of its keys, decided over states that agree where its body reads (its keys aside), is\n-- decided alike.\ntheorem ite_all_congr {X X' : Nat → Nat} {N N' : Nat → Nat → Nat} {ks : List Nat} {c : C}\n    (hv : ∀ i, occC i c = true → i ∉ ks → X i = X' i) (hm : ∀ mp, occMC mp c = true → N mp = N' mp) :\n    (if ∀ k, holdsC (atKeys X ks k) N c then 1 else 0) = (if ∀ k, holdsC (atKeys X' ks k) N' c then 1 else 0) := by\n  have h : (∀ k, holdsC (atKeys X ks k) N c) ↔ (∀ k, holdsC (atKeys X' ks k) N' c) := by\n    apply forall_congr'; intro k\n    rw [← evalC_iff, ← evalC_iff, congrMC _ N N' c hm]\n    rw [congrC (atKeys X ks k) (atKeys X' ks k) N' c (fun i hi => by\n      by_cases hik : i ∈ ks\n      · rw [atKeys_in hik, atKeys_in hik]\n      · rw [atKeys_out hik, atKeys_out hik]; exact hv i hi hik)]\n  simp only [h]\n\ntheorem decideQ_of (s : SMachine) (X : Nat → Nat) (N : Nat → Nat → Nat) (v : Nat) :\n    decideQ s X N v = match lookup (fun q => q.1 == v) s.qflags with\n      | some q => if ∀ k, holdsC (atKeys X q.2.1 k) N q.2.2 then 1 else 0\n      | none => X v := rfl\n\ntheorem upd_agree {V : List Nat} {X X' : Nat → Nat} (h : Agree V X X') (k v : Nat) : Agree V (upd X k v) (upd X' k v) := fun i hi => by\n  simp only [upd]; split\n  · rfl\n  · exact h i hi\n\n/-! Ghosts -/\n\nstructure SGhosted where\n  orig : SMachine\n  ghosts : List (Nat × E × E)   -- (variable, start over the params, step over the state before, the request and flags)\n\ndef SGhosted.vars (g : SGhosted) : List Nat := g.ghosts.map (·.1)\n\n-- The ghosted machine: the original, each ghost's start and step added.\ndef SGhosted.full (g : SGhosted) : SMachine :=\n  ⟨⟨⟨g.orig.f.m.inputs, g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1)), g.orig.f.m.maps0,\n      g.orig.f.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2)), g.orig.f.m.writes, g.orig.f.m.pre, g.orig.f.m.assume⟩, g.orig.f.flags⟩,\n    g.orig.carried, g.orig.every, g.orig.qflags, g.orig.wits, g.orig.facts, g.orig.pfacts⟩\n\n-- The ghosts are new names, and nothing of the original reads them.\ndef sghostOk (g : SGhosted) : Bool :=\n  distinct g.vars\n    && g.vars.all (fun v => !(g.orig.extVars ++ g.orig.f.m.init.map (·.1) ++ g.orig.f.m.step.map (·.1) ++ flagVars g.orig.f.flags ++ bkeys g.orig).contains v)\n    && avoids g.vars g.orig.f.m.pre && avoids g.vars g.orig.f.m.assume && g.orig.f.flags.all (fun p => avoids g.vars p.2)\n    && g.orig.f.m.step.all (fun p => avoidsE g.vars p.2) && g.orig.f.m.init.all (fun p => avoidsE g.vars p.2)\n    && g.orig.f.m.writes.all (fun w => avoidsE g.vars w.2.1 && avoidsE g.vars w.2.2)\n    && g.orig.every.all (fun w => avoidsE g.vars w.2.2) && g.orig.qflags.all (fun q => avoids g.vars q.2.2)\n    && g.orig.facts.all (fun l => avoids g.vars l.holds)\n\n-- The ghosted machine reads requests and decides flags as the original does.\ntheorem sview_full (g : SGhosted) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sView g.full ρ M ι κ = sView g.orig ρ M ι κ := rfl\n\n-- A run of the original lifted to the ghosted machine from a ghosted state s0 that agrees with its first: the ghosts\n-- move with each request the run takes.\nnoncomputable def sghostFrom (g : SGhosted) (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  | 0 => s0\n  | n + 1 => sNext g.full (sghostFrom g run s0 n).1 (sghostFrom g run s0 n).2 (run.req n).1 (run.req n).2\n\nsection sghost\nvariable (g : SGhosted) (hg : sghostOk g = true)\ninclude hg\n\ntheorem sghostOk_parts :\n    distinct g.vars = true\n      ∧ (∀ v ∈ g.vars, v ∉ g.orig.extVars ++ g.orig.f.m.init.map (·.1) ++ g.orig.f.m.step.map (·.1) ++ flagVars g.orig.f.flags ++ bkeys g.orig)\n      ∧ avoids g.vars g.orig.f.m.pre = true ∧ avoids g.vars g.orig.f.m.assume = true ∧ (∀ p ∈ g.orig.f.flags, avoids g.vars p.2 = true)\n      ∧ (∀ p ∈ g.orig.f.m.step, avoidsE g.vars p.2 = true) ∧ (∀ p ∈ g.orig.f.m.init, avoidsE g.vars p.2 = true)\n      ∧ (∀ w ∈ g.orig.f.m.writes, avoidsE g.vars w.2.1 = true ∧ avoidsE g.vars w.2.2 = true)\n      ∧ (∀ w ∈ g.orig.every, avoidsE g.vars w.2.2 = true) ∧ (∀ q ∈ g.orig.qflags, avoids g.vars q.2.2 = true)\n      ∧ (∀ l ∈ g.orig.facts, avoids g.vars l.holds = true) := by\n  simp only [sghostOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at hg\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hd, hn⟩, hp⟩, ha⟩, hf⟩, hs⟩, hi⟩, hw⟩, he⟩, hq⟩, hfa⟩ := hg\n  exact ⟨hd, fun v hv h => (by have := hn v hv; rw [List.contains_iff_mem.mpr h] at this; cases this), hp, ha, hf, hs, hi, hw, he, hq, hfa⟩\n\n-- One step from states that agree outside the ghosts, with the same request: allowed alike, and to states that agree\n-- outside the ghosts, with the same maps.\ntheorem sghost_step {ρ ρg : Nat → Nat} (hag : Agree g.vars ρg ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    evalC (sView g.full ρg M ι κ).1 (sView g.full ρg M ι κ).2 g.full.f.m.assume = evalC (sView g.orig ρ M ι κ).1 (sView g.orig ρ M ι κ).2 g.orig.f.m.assume\n      ∧ Agree g.vars (sNext g.full ρg M ι κ).1 (sNext g.orig ρ M ι κ).1\n      ∧ (sNext g.full ρg M ι κ).2 = (sNext g.orig ρ M ι κ).2 := by\n  obtain ⟨_, _, _, ha, hf, hs, _, hw, he, hq, _⟩ := sghostOk_parts g hg\n  have hX : Agree g.vars (withInputs g.orig.f.m.inputs ρg ι) (withInputs g.orig.f.m.inputs ρ ι) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  have hQ : Agree g.vars (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ))\n      (decideQ g.orig (withInputs g.orig.f.m.inputs ρ ι) (withCarried g.orig M κ)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of]\n    cases hl : lookup (fun q => q.1 == v) g.orig.qflags with\n    | some q => exact ite_all_congr (fun i hi _ => hX i (avoids_occ (hq q (lookup_some hl).1) hi)) (fun _ _ => rfl)\n    | none => exact hX v hv\n  have hD := decide_agree_on hf (withCarried g.orig M κ) hQ\n  refine ⟨?_, fun i hi => ?_, ?_⟩\n  · show evalC (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) _ g.orig.f.m.assume = _\n    exact congrC _ _ _ _ (fun i hi => hD i (avoids_occ ha hi))\n  · show applyS (g.orig.f.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2))) (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) i = _\n    rw [applyS_append_other (by simpa [SGhosted.vars] using hi)]\n    simp only [sNext, sView, applyS]\n    cases hst : assoc g.orig.f.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ g.orig.f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq', rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq'\n        simp only [beq_iff_eq] at hqv\n        rw [← hqv]; exact hqm\n      exact congrE _ _ _ e (fun j hj => hD j (avoidsE_occ (hs (i, e) hm) hj))\n  · funext mp key\n    show everyMaps g.orig (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) mp key\n      = everyMaps g.orig (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρ ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) mp key\n    simp only [everyMaps]\n    cases hl : lookup (fun w => w.1 == mp) g.orig.every with\n    | some w => exact congrE _ _ _ w.2.2 (fun j hj => upd_agree hD w.2.1 key j (avoidsE_occ (he w (lookup_some hl).1) hj))\n    | none =>\n      simp only [writeMaps]\n      cases hl2 : lookup (fun w => w.1 == mp) g.orig.f.m.writes with\n      | none => rfl\n      | some w =>\n        obtain ⟨h1, h2⟩ := hw w (lookup_some hl2).1\n        simp only [congrE _ _ _ w.2.1 (fun j hj => hD j (avoidsE_occ h1 hj)), congrE _ _ _ w.2.2 (fun j hj => hD j (avoidsE_occ h2 hj))]\n\n/-- Every reachable state of the original is, outside the ghosts, a reachable state of the ghosted machine. -/\ntheorem sghost_reach : ∀ {ρ M}, SReach g.orig ρ M → ∃ ρg, SReach g.full ρg M ∧ Agree g.vars ρg ρ := by\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 hfa hpf =>\n    refine ⟨applyS g.full.f.m.init ρ M, SReach.start ρ M hM h0 hfa hpf, fun i hi => ?_⟩\n    show applyS (g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ M i = applyS g.orig.f.m.init ρ M i\n    exact applyS_append_other (by simpa [SGhosted.vars] using hi) ρ M\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨ρg, hrg, hag⟩ := ih\n    obtain ⟨hA, hS, hW⟩ := sghost_step g hg hag M ι κ\n    refine ⟨_, ?_, hS⟩\n    rw [← hW]\n    exact SReach.step ρg M ι κ hrg (by rw [hA]; exact ha)\n\n/-- A law of the ghosted machine that reads no ghost holds in every reachable state of the original. -/\ntheorem sghost_laws (ps : List SEntry) (hl : checkSMachine g.full ps = true) :\n    ∀ ρ M, SReach g.orig ρ M → ∀ e ∈ ps, avoids g.vars e.law.holds = true → e.Holds ρ M := by\n  intro ρ M hr e he hav\n  obtain ⟨ρg, hrg, hag⟩ := sghost_reach g hg hr\n  exact sentry_transfer (V := g.vars) (MS := []) hav (by simp [avoidsMaps]) (fun i hi => (hag i hi).symm) (fun _ _ => rfl)\n    (smachine_sound g.full ps hl ρg M hrg e he)\n\ntheorem sghostFrom_agree (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) (hM0 : s0.2 = (run.st 0).2) (hA0 : Agree g.vars s0.1 (run.st 0).1) :\n    ∀ n, (sghostFrom g run s0 n).2 = (run.st n).2 ∧ Agree g.vars (sghostFrom g run s0 n).1 (run.st n).1\n  | 0 => ⟨hM0, hA0⟩\n  | n + 1 => by\n    obtain ⟨hM, hag⟩ := sghostFrom_agree run s0 hM0 hA0 n\n    obtain ⟨_, hS, hW⟩ := sghost_step g hg hag (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    simp only [sghostFrom, hM]\n    exact ⟨hW, hS⟩\n\nomit hg in\nnoncomputable def sghostRun (hg : sghostOk g = true) (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) (hr : SReach g.full s0.1 s0.2)\n    (hM0 : s0.2 = (run.st 0).2) (hA0 : Agree g.vars s0.1 (run.st 0).1) : SRun g.full :=\n  ⟨sghostFrom g run s0, run.req, hr,\n    fun n => by\n      obtain ⟨hM, hag⟩ := sghostFrom_agree g hg run s0 hM0 hA0 n\n      obtain ⟨hA, _, _⟩ := sghost_step g hg hag (run.st n).2 (run.req n).1 (run.req n).2\n      rw [hM, hA]; exact run.allowed n,\n    fun n => rfl⟩\n\n/-- Every run of the original is, outside the ghosts, a run of the ghosted machine taking the same requests. -/\ntheorem sghost_run (run : SRun g.orig) : ∃ run' : SRun g.full, run'.req = run.req ∧ ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1 :=\n  ⟨sghostRun g hg run (Classical.choose (sghost_reach g hg run.start), (run.st 0).2) (Classical.choose_spec (sghost_reach g hg run.start)).1 rfl\n      (Classical.choose_spec (sghost_reach g hg run.start)).2, rfl,\n    sghostFrom_agree g hg run (Classical.choose (sghost_reach g hg run.start), (run.st 0).2) rfl (Classical.choose_spec (sghost_reach g hg run.start)).2⟩\n/-- A run of the original from its start lifts to one of the ghosted machine from its start: each ghost at its start term. -/\ntheorem sghost_run_start (run : SRun g.orig) {ρ0 : Nat → Nat} {M0 : Nat → Nat → Nat} (hM : StartMaps g.orig.f.m M0)\n    (hp : evalC ρ0 M0 g.orig.f.m.pre = true) (hfa : ∀ l ∈ g.orig.facts, l.Holds ρ0 M0) (hpf : g.orig.PFacts ρ0 M0) (hst : run.st 0 = (applyS g.orig.f.m.init ρ0 M0, M0)) :\n    ∃ run' : SRun g.full, run'.req = run.req ∧ run'.st 0 = (applyS g.full.f.m.init ρ0 M0, M0)\n      ∧ ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1 := by\n  have hA0 : Agree g.vars (applyS g.full.f.m.init ρ0 M0) (run.st 0).1 := fun i hi => by\n    rw [hst]\n    show applyS (g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ0 M0 i = applyS g.orig.f.m.init ρ0 M0 i\n    exact applyS_append_other (by simpa [SGhosted.vars] using hi) ρ0 M0\n  have hM0 : M0 = (run.st 0).2 := by rw [hst]\n  exact ⟨sghostRun g hg run (applyS g.full.f.m.init ρ0 M0, M0) (SReach.start ρ0 M0 hM hp hfa hpf) hM0 hA0, rfl, rfl,\n    sghostFrom_agree g hg run (applyS g.full.f.m.init ρ0 M0, M0) hM0 hA0⟩\n\n-- A condition that reads no ghost, read where a step reads (its request, its flags decided), reads alike in a run and\n-- its lift.\ntheorem sghost_view (run : SRun g.orig) (run' : SRun g.full) (hreq : run'.req = run.req)\n    (hag : ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1) {c : C} (hc : avoids g.vars c = true) (n : Nat) :\n    evalC (sView g.orig (run'.st n).1 (run'.st n).2 (run'.req n).1 (run'.req n).2).1 (sView g.orig (run'.st n).1 (run'.st n).2 (run'.req n).1 (run'.req n).2).2 c\n      = evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c := by\n  obtain ⟨_, _, _, _, hf, _, _, _, _, hq, _⟩ := sghostOk_parts g hg\n  obtain ⟨hM, hA⟩ := hag n\n  rw [hM, hreq]\n  have hX : Agree g.vars (withInputs g.orig.f.m.inputs (run'.st n).1 (run.req n).1) (withInputs g.orig.f.m.inputs (run.st n).1 (run.req n).1) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hA i hi\n  have hQ : Agree g.vars (decideQ g.orig (withInputs g.orig.f.m.inputs (run'.st n).1 (run.req n).1) (withCarried g.orig (run.st n).2 (run.req n).2))\n      (decideQ g.orig (withInputs g.orig.f.m.inputs (run.st n).1 (run.req n).1) (withCarried g.orig (run.st n).2 (run.req n).2)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of]\n    cases hl : lookup (fun q => q.1 == v) g.orig.qflags with\n    | some q => exact ite_all_congr (fun i hi _ => hX i (avoids_occ (hq q (lookup_some hl).1) hi)) (fun _ _ => rfl)\n    | none => exact hX v hv\n  exact congrC _ _ _ c (fun i hi => decide_agree_on hf _ hQ i (avoids_occ hc hi))\nend sghost\n\n/-- What `ever` means: along a run of the ghosted machine where the ghost x starts at 0, with x's step `if c then 1\nelse x`, x is 1 at step n exactly when some step before n took a request where c held (read where that step reads: its\nrequest, its flags decided). -/\ntheorem sever_meaning (g : SGhosted) (hg : sghostOk g = true) {x : Nat} {s0 : E} {c : C} (hx : (x, s0, .ite c (.const 1) (.var x)) ∈ g.ghosts)\n    (run : SRun g.full) (h0 : (run.st 0).1 x = 0) :\n    ∀ n, (run.st n).1 x = 1 ↔ ∃ i, i < n ∧ evalC (sView g.orig (run.st i).1 (run.st i).2 (run.req i).1 (run.req i).2).1\n      (sView g.orig (run.st i).1 (run.st i).2 (run.req i).1 (run.req i).2).2 c = true := by\n  obtain ⟨hd, hn, _⟩ := sghostOk_parts g hg\n  have hxv : x ∈ g.vars := List.mem_map_of_mem hx\n  have hxo := hn x hxv\n  have hassoc : assoc g.full.f.m.step x = some (.ite c (.const 1) (.var x)) := by\n    show assoc (g.orig.f.m.step ++ g.ghosts.map (fun y => (y.1, y.2.2))) x = _\n    simp only [assoc, lookup_append]\n    rw [lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact hxo (by\n      rw [← he]; exact List.mem_append_left _ (List.mem_append_left _ (List.mem_append_right _ (List.mem_map_of_mem hp)))))]\n    have hl : lookup (fun p => p.1 == x) (g.ghosts.map (fun y => (y.1, y.2.2))) = some (x, .ite c (.const 1) (.var x)) := by\n      have hd' : distinct ((g.ghosts.map (fun y => (y.1, y.2.2))).map (·.1)) = true := by rw [List.map_map]; exact hd\n      exact lookup_unique_fst hd' (List.mem_map.mpr ⟨_, hx, rfl⟩)\n    simp [hl]\n  have hxe : x ∉ g.orig.extVars := fun h => hxo (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h))))\n  have hxf : x ∉ flagVars g.orig.f.flags := fun h => hxo (List.mem_append_left _ (List.mem_append_right _ h))\n  simp only [SMachine.extVars, SMachine.qVars, List.mem_append, not_or] at hxe\n  intro n\n  induction n with\n  | zero => simp [h0]\n  | succ n ih =>\n    have hst : (run.st (n + 1)).1 x = if evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1\n        (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true then 1 else (run.st n).1 x := by\n      rw [run.next n]\n      simp only [sNext, applyS, hassoc, evalE]\n      rw [sview_full]\n      congr 1\n      simp only [sView]\n      rw [decide_other hxf, decideQ_other (by simpa [SMachine.qVars] using hxe.1.2), withInputs_other hxe.1.1]\n    rw [hst]\n    constructor\n    · intro h1\n      by_cases hc : evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true\n      · exact ⟨n, Nat.lt_succ_self n, hc⟩\n      · rw [if_neg hc] at h1\n        obtain ⟨i, hi, hci⟩ := ih.mp h1\n        exact ⟨i, Nat.lt_succ_of_lt hi, hci⟩\n    · rintro ⟨i, hi, hci⟩\n      by_cases hc : evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true\n      · rw [if_pos hc]\n      · rw [if_neg hc]\n        rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hi | rfl\n        · exact ih.mpr ⟨i, hi, hci⟩\n        · exact absurd hci hc\n\nend Kern\n\n#print axioms Kern.sghost_reach\n#print axioms Kern.sghost_laws\n#print axioms Kern.sghost_run\n#print axioms Kern.sever_meaning\n#print axioms Kern.sghost_run_start\n",
     "Refine.lean": "import Ghost\n\n/-!\nWhat a refinement means, proven: compose.ts's `refinement(impl, spec, {relation, witness, stutter})` builds one machine,\nthe implementation beside the spec, the spec sent at each of the implementation's requests the request the witness\nnames, and left as it was where `stutter` holds. Lean builds that machine from the two (`SRefined.full`), the spec\ngiven in the composite's names, and checks that neither reads the other's parts (`srOk`). The machines have maps,\nflags and sets (a machine with maps and flags is one with no sets): requests carry maps, the spec's among the\nimplementation's, shared by name. With the relation proven of the composite (smachine_sound) and its step law that the\nspec stutters or allows every request it is sent (skstep_sound):\n- `srefine_lift`: every reachable state of the implementation is, outside the spec's part, a reachable state of the\n  composite;\n- `srefine_project`: the spec's part of every reachable state of the composite is a reachable state of the spec;\n- `srefines`: so every reachable state of the implementation is related, by the relation, to a reachable state of the\n  spec.\n-/\n\nnamespace Kern\n\nstructure Refined where\n  impl : FMMachine            -- the implementation, in the composite's names\n  spec : FMMachine            -- the spec, in the composite's names (its inputs fresh)\n  wit : List (Nat × E)        -- each spec input and its term over the implementation's request and both states\n  stutter : C                 -- where the implementation's step is one the spec doesn't see\n\n-- The composite: the implementation, then the spec, its inputs read as the witness, each part kept where it stutters.\ndef Refined.full (r : Refined) : FMMachine :=\n  ⟨{ inputs := r.impl.m.inputs\n     init := r.impl.m.init ++ r.spec.m.init\n     maps0 := r.impl.m.maps0 ++ r.spec.m.maps0\n     step := r.impl.m.step ++ r.spec.m.step.map (fun p => (p.1, .ite r.stutter (.var p.1) (substE r.wit p.2)))\n     writes := r.impl.m.writes ++ r.spec.m.writes.map (fun w =>\n       (w.1, substE r.wit w.2.1, .ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2)))\n     pre := r.impl.m.pre\n     assume := r.impl.m.assume },\n   r.impl.flags ++ r.spec.flags.map (fun p => (p.1, substC r.wit p.2))⟩\n\ndef readsNone (V MS : List Nat) (c : C) : Bool := avoids V c && avoidsMaps MS c\ndef readsNoneE (V MS : List Nat) (e : E) : Bool := avoidsE V e && avoidsMapsE MS e\n\n/-! Lists and flags -/\n\ntheorem applyS_append_right {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS (σ ++ τ) ρ M i = applyS τ ρ M i := by\n  have hσ : lookup (fun p => p.1 == i) σ = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [applyS, assoc, lookup_append, hσ]\n\ntheorem flagOf_append_left {fl fl' : List (Nat × C)} {i : Nat} (h : i ∉ flagVars fl') : flagOf (fl ++ fl') i = flagOf fl i := by\n  have h' : lookup (fun p => p.1 == i) fl' = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [flagOf, lookup_append]\n  cases hl : lookup (fun p => p.1 == i) fl <;> simp [h']\n\ntheorem flagOf_append_right {fl fl' : List (Nat × C)} {i : Nat} (h : i ∉ flagVars fl) : flagOf (fl ++ fl') i = flagOf fl' i := by\n  have h' : lookup (fun p => p.1 == i) fl = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [flagOf, lookup_append, h']\n\ntheorem flagOf_map {fl : List (Nat × C)} {g : C → C} (i : Nat) : flagOf (fl.map (fun p => (p.1, g p.2))) i = (flagOf fl i).map g := by\n  simp only [flagOf]\n  induction fl with\n  | nil => rfl\n  | cons a as ih =>\n    simp only [List.map_cons, lookup]\n    split <;> simp_all\n\ntheorem decideFlags_of (fl : List (Nat × C)) (X : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    decideFlags fl X M i = match flagOf fl i with\n      | some c => if evalC X M c = true then 1 else 0\n      | none => X i := by\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases flagOf fl i <;> simp [evalE]\n\ntheorem rn_v {V MS : List Nat} {c : C} (h : readsNone V MS c = true) : avoids V c = true := by simp only [readsNone, Bool.and_eq_true] at h; exact h.1\ntheorem rn_m {V MS : List Nat} {c : C} (h : readsNone V MS c = true) : avoidsMaps MS c = true := by simp only [readsNone, Bool.and_eq_true] at h; exact h.2\ntheorem rnE_v {V MS : List Nat} {e : E} (h : readsNoneE V MS e = true) : avoidsE V e = true := by simp only [readsNoneE, Bool.and_eq_true] at h; exact h.1\ntheorem rnE_m {V MS : List Nat} {e : E} (h : readsNoneE V MS e = true) : avoidsMapsE MS e = true := by simp only [readsNoneE, Bool.and_eq_true] at h; exact h.2\n\ntheorem assoc_map_fst (l : List (Nat × E)) (g : Nat × E → E) (v : Nat) :\n    assoc (l.map (fun q => (q.1, g q))) v = (lookup (fun q => q.1 == v) l).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\ntheorem lookup_writes_map (l : List (Nat × E × E)) (g : Nat × E × E → E × E) (mp : Nat) :\n    lookup (fun w : Nat × E × E => w.1 == mp) (l.map (fun w => (w.1, g w))) = (lookup (fun w : Nat × E × E => w.1 == mp) l).map (fun w => (w.1, g w)) := by\n  rw [lookup_map_pred]\n\n-- Read where `then` reads, a condition that reads no primed name is the condition before the step.\ntheorem unprimed_evalC {pr pm : List (Nat × Nat)} {c : C} (hv : avoids (pr.map (·.2)) c = true) (hm : avoidsMaps (pm.map (·.2)) c = true)\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalC (primed pr ρ' ρ) (primedMaps pm M' M) c = evalC ρ M c := by\n  rw [congrC _ ρ _ c (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact avoids_occ hv hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrMC ρ _ M c (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact avoidsMaps_occ hm hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\n\n/-! Refinements -/\n\nopen Classical\n\nstructure SRefined where\n  impl : SMachine\n  spec : SMachine\n  wit : List (Nat × E)\n  stutter : C\n\n\ndef SRefined.base (r : SRefined) : Refined := ⟨r.impl.f, r.spec.f, r.wit, r.stutter⟩\ndef SRefined.full (r : SRefined) : SMachine :=\n  ⟨r.base.full, r.impl.carried,\n   r.impl.every ++ r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2))),\n   r.impl.qflags ++ r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2)),\n   r.impl.wits ++ r.spec.wits, [], []⟩\ndef SRefined.allowed (r : SRefined) : C := inlineC r.full.f.flags (.or r.stutter (substC r.wit r.spec.f.m.assume))\n\ntheorem sfull_inputs (r : SRefined) : r.full.f.m.inputs = r.impl.f.m.inputs := rfl\ntheorem sfull_carried (r : SRefined) : r.full.carried = r.impl.carried := rfl\ntheorem sfull_flags (r : SRefined) : r.full.f.flags = r.impl.f.flags ++ r.spec.f.flags.map (fun p => (p.1, substC r.wit p.2)) := rfl\ntheorem sfull_qflags (r : SRefined) : r.full.qflags = r.impl.qflags ++ r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2)) := rfl\ntheorem sfull_every (r : SRefined) : r.full.every = r.impl.every ++ r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2))) := rfl\ntheorem sfull_step (r : SRefined) : r.full.f.m.step = r.impl.f.m.step ++ r.spec.f.m.step.map (fun p => (p.1, .ite r.stutter (.var p.1) (substE r.wit p.2))) := rfl\ntheorem sfull_writes (r : SRefined) : r.full.f.m.writes = r.impl.f.m.writes ++ r.spec.f.m.writes.map (fun w =>\n    (w.1, substE r.wit w.2.1, .ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2))) := rfl\ntheorem sfull_init (r : SRefined) : r.full.f.m.init = r.impl.f.m.init ++ r.spec.f.m.init := rfl\ntheorem sfull_maps0 (r : SRefined) : r.full.f.m.maps0 = r.impl.f.m.maps0 ++ r.spec.f.m.maps0 := rfl\ntheorem sfull_assume (r : SRefined) : r.full.f.m.assume = r.impl.f.m.assume := rfl\ntheorem sfull_pre (r : SRefined) : r.full.f.m.pre = r.impl.f.m.pre := rfl\n\n-- The implementation's names and maps (its own, and those only it carries); the spec's; where the spec's state and the\n-- composite's may differ; what the witness and `stutter` may not read.\ndef SRefined.IV (r : SRefined) : List Nat := r.impl.f.m.inputs ++ r.impl.f.m.init.map (·.1) ++ r.impl.f.m.step.map (·.1) ++ flagVars r.impl.f.flags ++ r.impl.qVars ++ bkeys r.impl\ndef SRefined.IO (r : SRefined) : List Nat := r.impl.f.m.maps0.map (·.1) ++ r.impl.f.m.writes.map (·.1) ++ r.impl.every.map (·.1)\ndef SRefined.IM (r : SRefined) : List Nat := r.IO ++ r.impl.carried.filter (fun mp => !r.spec.carried.contains mp)\ndef SRefined.SV (r : SRefined) : List Nat := r.spec.f.m.init.map (·.1) ++ r.spec.f.m.step.map (·.1) ++ flagVars r.spec.f.flags ++ r.spec.qVars ++ bkeys r.spec\ndef SRefined.SM (r : SRefined) : List Nat := r.spec.f.m.maps0.map (·.1) ++ r.spec.f.m.writes.map (·.1) ++ r.spec.every.map (·.1)\ndef SRefined.X (r : SRefined) : List Nat := r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars ++ r.spec.f.m.inputs\ndef SRefined.W (r : SRefined) : List Nat := flagVars r.impl.f.flags ++ flagVars r.spec.f.flags ++ r.spec.f.m.inputs ++ r.impl.qVars ++ r.spec.qVars ++ bkeys r.spec\n\ndef srImplOk (r : SRefined) : Bool :=\n  readsNone r.SV r.SM r.impl.f.m.pre && readsNone r.SV r.SM r.impl.f.m.assume\n    && r.impl.f.flags.all (fun p => readsNone r.SV r.SM p.2) && r.impl.f.m.step.all (fun p => readsNoneE r.SV r.SM p.2)\n    && r.impl.f.m.init.all (fun p => readsNoneE r.SV r.SM p.2)\n    && r.impl.f.m.writes.all (fun w => readsNoneE r.SV r.SM w.2.1 && readsNoneE r.SV r.SM w.2.2)\n    && r.impl.every.all (fun w => readsNoneE r.SV r.SM w.2.2) && r.impl.qflags.all (fun q => readsNone r.SV r.SM q.2.2)\ndef srSpecOk (r : SRefined) : Bool :=\n  readsNone r.IV r.IM r.spec.f.m.assume && r.spec.f.flags.all (fun p => readsNone (r.IV ++ flagVars r.spec.f.flags) r.IM p.2)\n    && r.spec.f.m.step.all (fun p => readsNoneE r.IV r.IM p.2) && r.spec.f.m.init.all (fun p => readsNoneE (r.IV ++ r.spec.f.m.inputs) r.IM p.2)\n    && r.spec.f.m.writes.all (fun w => readsNoneE r.IV r.IM w.2.1 && readsNoneE r.IV r.IM w.2.2)\n    && r.spec.every.all (fun w => readsNoneE r.IV r.IM w.2.2)\n    && r.spec.qflags.all (fun q => readsNone (r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars) r.IM q.2.2)\n    && readsNone (r.X ++ r.SV) r.IM r.spec.f.m.pre && !readsC r.spec.f.m.pre\ndef srNamesOk (r : SRefined) : Bool :=\n  r.SV.all (fun v => !r.IV.contains v) && r.spec.f.m.inputs.all (fun v => !(r.IV ++ r.SV).contains v)\n    && r.SM.all (fun mp => !r.IM.contains mp) && r.spec.carried.all (fun mp => r.impl.carried.contains mp)\n    && r.impl.carried.all (fun mp => !(r.IO ++ r.SM).contains mp)\n    && r.wit.all (fun p => r.spec.f.m.inputs.contains p.1 && avoidsE r.W p.2) && avoids r.W r.stutter\n    && r.impl.facts.isEmpty && r.spec.facts.isEmpty\ndef srOk (r : SRefined) : Bool := srImplOk r && srSpecOk r && (srNamesOk r && r.spec.pfacts.isEmpty)\n\ntheorem srImpl_parts {r : SRefined} (h : srImplOk r = true) :\n    readsNone r.SV r.SM r.impl.f.m.pre = true ∧ readsNone r.SV r.SM r.impl.f.m.assume = true\n      ∧ (∀ p ∈ r.impl.f.flags, readsNone r.SV r.SM p.2 = true) ∧ (∀ p ∈ r.impl.f.m.step, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ p ∈ r.impl.f.m.init, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ w ∈ r.impl.f.m.writes, readsNoneE r.SV r.SM w.2.1 = true ∧ readsNoneE r.SV r.SM w.2.2 = true)\n      ∧ (∀ w ∈ r.impl.every, readsNoneE r.SV r.SM w.2.2 = true) ∧ (∀ q ∈ r.impl.qflags, readsNone r.SV r.SM q.2.2 = true) := by\n  simp only [srImplOk, Bool.and_eq_true, List.all_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7, h8⟩\n\ntheorem srSpec_parts {r : SRefined} (h : srSpecOk r = true) :\n    readsNone r.IV r.IM r.spec.f.m.assume = true ∧ (∀ p ∈ r.spec.f.flags, readsNone (r.IV ++ flagVars r.spec.f.flags) r.IM p.2 = true)\n      ∧ (∀ p ∈ r.spec.f.m.step, readsNoneE r.IV r.IM p.2 = true) ∧ (∀ p ∈ r.spec.f.m.init, readsNoneE (r.IV ++ r.spec.f.m.inputs) r.IM p.2 = true)\n      ∧ (∀ w ∈ r.spec.f.m.writes, readsNoneE r.IV r.IM w.2.1 = true ∧ readsNoneE r.IV r.IM w.2.2 = true)\n      ∧ (∀ w ∈ r.spec.every, readsNoneE r.IV r.IM w.2.2 = true)\n      ∧ (∀ q ∈ r.spec.qflags, readsNone (r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars) r.IM q.2.2 = true)\n      ∧ readsNone (r.X ++ r.SV) r.IM r.spec.f.m.pre = true ∧ readsC r.spec.f.m.pre = false := by\n  simp only [srSpecOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩, h9⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9⟩\n\ntheorem srNames_parts {r : SRefined} (h : srNamesOk r = true) :\n    (∀ v ∈ r.SV, v ∉ r.IV) ∧ (∀ v ∈ r.spec.f.m.inputs, v ∉ r.IV ++ r.SV) ∧ (∀ mp ∈ r.SM, mp ∉ r.IM)\n      ∧ (∀ mp ∈ r.spec.carried, mp ∈ r.impl.carried) ∧ (∀ mp ∈ r.impl.carried, mp ∉ r.IO ++ r.SM)\n      ∧ (∀ p ∈ r.wit, p.1 ∈ r.spec.f.m.inputs ∧ avoidsE r.W p.2 = true) ∧ avoids r.W r.stutter = true\n      ∧ r.impl.facts = [] ∧ r.spec.facts = [] := by\n  simp only [srNamesOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true', List.isEmpty_iff] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩, h9⟩ := h\n  refine ⟨fun v hv hm => ?_, fun v hv hm => ?_, fun mp hm hm' => ?_, fun mp hm => List.contains_iff_mem.mp (h4 mp hm), fun mp hm hm' => ?_,\n    fun p hp => ⟨List.contains_iff_mem.mp (h6 p hp).1, (h6 p hp).2⟩, h7, h8, h9⟩\n  · have := h1 v hv; rw [List.contains_iff_mem.mpr hm] at this; cases this\n  · have := h2 v hv; rw [List.contains_iff_mem.mpr hm] at this; cases this\n  · have := h3 mp hm; rw [List.contains_iff_mem.mpr hm'] at this; cases this\n  · have := h5 mp hm; rw [List.contains_iff_mem.mpr hm'] at this; cases this\n\n/-! The implementation's runs, inside the composite's -/\n\nsection slift\nvariable (r : SRefined) (hok : srOk r = true)\ninclude hok\n\ntheorem sr_impl : srImplOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.1.1\ntheorem sr_spec : srSpecOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.1.2\ntheorem sr_names : srNamesOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.2.1\ntheorem sr_pfacts : r.spec.pfacts = [] := by simp only [srOk, Bool.and_eq_true, List.isEmpty_iff] at hok; exact hok.2.2\n\n-- One step of the composite from a state that agrees with the implementation's outside the spec's part, with the same\n-- request: allowed alike, to states that still agree.\ntheorem srefine_step {ρ ρc : Nat → Nat} {M Mc : Nat → Nat → Nat} (hag : Agree r.SV ρc ρ) (hmag : ∀ mp, mp ∉ r.SM → Mc mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    evalC (sView r.full ρc Mc ι κ).1 (sView r.full ρc Mc ι κ).2 r.full.f.m.assume = evalC (sView r.impl ρ M ι κ).1 (sView r.impl ρ M ι κ).2 r.impl.f.m.assume\n      ∧ Agree r.SV (sNext r.full ρc Mc ι κ).1 (sNext r.impl ρ M ι κ).1\n      ∧ ∀ mp, mp ∉ r.SM → (sNext r.full ρc Mc ι κ).2 mp = (sNext r.impl ρ M ι κ).2 mp := by\n  obtain ⟨_, ha, hf, hs, _, hw, he, hq⟩ := srImpl_parts (sr_impl r hok)\n  have hN : ∀ mp, mp ∉ r.SM → withCarried r.full Mc κ mp = withCarried r.impl M κ mp := fun mp hmp => by\n    show (if r.impl.carried.contains mp = true then κ mp else Mc mp) = (if r.impl.carried.contains mp = true then κ mp else M mp)\n    by_cases hc : r.impl.carried.contains mp = true\n    · rw [if_pos hc, if_pos hc]\n    · rw [if_neg hc, if_neg hc]; exact hmag mp hmp\n  have hX : Agree r.SV (withInputs r.full.f.m.inputs ρc ι) (withInputs r.impl.f.m.inputs ρ ι) := fun i hi => by\n    rw [sfull_inputs]; simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  -- The quantified flags: the composite's decide the implementation's alike, outside the spec's names.\n  have hQ : Agree r.SV (decideQ r.full (withInputs r.full.f.m.inputs ρc ι) (withCarried r.full Mc κ))\n      (decideQ r.impl (withInputs r.impl.f.m.inputs ρ ι) (withCarried r.impl M κ)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of, sfull_qflags, lookup_append]\n    cases hl : lookup (fun q => q.1 == v) r.impl.qflags with\n    | some q =>\n      have hrd := hq q (lookup_some hl).1\n      exact ite_all_congr (fun i hi _ => hX i (avoids_occ (rn_v hrd) hi)) (fun mp hmp => hN mp (avoidsMaps_occ (rn_m hrd) hmp))\n    | none =>\n      have hn : lookup (fun q => q.1 == v) (r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2))) = none :=\n        lookup_none (fun q hq' => by\n          simp only [beq_eq_false_iff_ne]; intro hqv\n          obtain ⟨q0, hq0, rfl⟩ := List.mem_map.mp hq'\n          exact hv (by simp only [SRefined.SV, SMachine.qVars, List.mem_append]; left; right; rw [← hqv]; exact List.mem_map.mpr ⟨q0, hq0, rfl⟩))\n      simp only [hn]\n      exact hX v hv\n  -- The plain flags, likewise.\n  have hD : Agree r.SV (decideFlags r.full.f.flags (decideQ r.full (withInputs r.full.f.m.inputs ρc ι) (withCarried r.full Mc κ)) (withCarried r.full Mc κ))\n      (decideFlags r.impl.f.flags (decideQ r.impl (withInputs r.impl.f.m.inputs ρ ι) (withCarried r.impl M κ)) (withCarried r.impl M κ)) := by\n    intro i hi\n    have hif : i ∉ flagVars (r.spec.f.flags.map (fun p => (p.1, substC r.wit p.2))) := fun h' => hi (by\n      simp only [flagVars, List.map_map] at h'; simp only [SRefined.SV, List.mem_append]; left; left; right\n      simpa [flagVars, Function.comp_def] using h')\n    rw [sfull_flags, decideFlags_of, decideFlags_of, flagOf_append_left hif]\n    cases hfo : flagOf r.impl.f.flags i with\n    | none => exact hQ i hi\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hfo\n      simp only\n      rw [congrMC _ _ _ _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m (hf p hp)) hmp)),\n        congrC _ _ _ _ (fun j hj => hQ j (avoids_occ (rn_v (hf p hp)) hj))]\n  refine ⟨?_, fun i hi => ?_, fun mp hmp => ?_⟩\n  · simp only [sView]\n    rw [sfull_assume, congrMC _ _ _ _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m ha) hmp)), congrC _ _ _ _ (fun j hj => hD j (avoids_occ (rn_v ha) hj))]\n  · simp only [sNext, sView]\n    rw [sfull_step]\n    have hit : i ∉ (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))).map (·.1) := fun h' => hi (by\n      simp only [List.map_map] at h'; simp only [SRefined.SV, List.mem_append]; left; left; left; right; simpa [Function.comp_def] using h')\n    rw [applyS_append_other hit]\n    simp only [applyS]\n    cases hst : assoc r.impl.f.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ r.impl.f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq', rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq'\n        simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n      dsimp only\n      rw [congrME _ _ _ e (fun mp hmp => hN mp (avoidsMapsE_occ (rnE_m (hs (i, e) hm)) hmp)),\n        congrE _ _ _ e (fun j hj => hD j (avoidsE_occ (rnE_v (hs (i, e) hm)) hj))]\n  · funext key\n    simp only [sNext, sView, everyMaps]\n    rw [sfull_every, lookup_append]\n    cases hl : lookup (fun w => w.1 == mp) r.impl.every with\n    | some w =>\n      have hrd := he w (lookup_some hl).1\n      simp only\n      rw [congrME _ _ _ w.2.2 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m hrd) h)),\n        congrE _ _ _ w.2.2 (fun j hj => upd_agree hD w.2.1 key j (avoidsE_occ (rnE_v hrd) hj))]\n    | none =>\n      have hn : lookup (fun w => w.1 == mp) (r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2)))) = none :=\n        lookup_none (fun w hw' => by\n          simp only [beq_eq_false_iff_ne]; intro he'\n          obtain ⟨w0, hw0, rfl⟩ := List.mem_map.mp hw'\n          exact hmp (by simp only [SRefined.SM, List.mem_append]; right; rw [← he']; exact List.mem_map.mpr ⟨w0, hw0, rfl⟩))\n      simp only [hn]\n      have hwm : lookup (fun w : Nat × E × E => w.1 == mp) (r.spec.f.m.writes.map (fun w =>\n          (w.1, substE r.wit w.2.1, E.ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2)))) = none :=\n        lookup_none (fun w hw' => by\n          simp only [beq_eq_false_iff_ne]; intro he'\n          obtain ⟨w0, hw0, rfl⟩ := List.mem_map.mp hw'\n          exact hmp (by simp only [SRefined.SM, List.mem_append]; left; right; rw [← he']; exact List.mem_map.mpr ⟨w0, hw0, rfl⟩))\n      simp only [writeMaps]\n      rw [sfull_writes, lookup_append]\n      cases hl2 : lookup (fun w => w.1 == mp) r.impl.f.m.writes with\n      | none => simp only [hwm]; exact congrFun (hN mp hmp) key\n      | some w =>\n        obtain ⟨h1, h2⟩ := hw w (lookup_some hl2).1\n        simp only\n        rw [congrME _ _ _ w.2.1 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m h1) h)), congrE _ _ _ w.2.1 (fun j hj => hD j (avoidsE_occ (rnE_v h1) hj)),\n          congrME _ _ _ w.2.2 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m h2) h)), congrE _ _ _ w.2.2 (fun j hj => hD j (avoidsE_occ (rnE_v h2) hj)), hN mp hmp]\n\n/-- Every reachable state of the implementation is, outside the spec's part, a reachable state of the composite. -/\ntheorem srefine_lift (hmo : distinct (r.spec.f.m.maps0.map (·.1)) = true) :\n    ∀ {ρ M}, SReach r.impl ρ M → ∃ ρc Mc, SReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ ∀ mp, mp ∉ r.SM → Mc mp = M mp := by\n  obtain ⟨hp, _, _, _, hi, _⟩ := srImpl_parts (sr_impl r hok)\n  obtain ⟨_, _, hsm, _⟩ := srNames_parts (sr_names r hok)\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 _ _ =>\n    let Mc : Nat → Nat → Nat := fun mp => match lookup (fun p => p.1 == mp) r.spec.f.m.maps0 with\n      | some p => fun _ => p.2\n      | none => M mp\n    have hMc : ∀ mp, mp ∉ r.SM → Mc mp = M mp := fun mp hmp => by\n      simp only [Mc]\n      rw [lookup_none (fun p hp' => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hmp (by simp only [SRefined.SM, List.mem_append]; left; left; rw [← he]; exact List.mem_map_of_mem hp'))]\n    have hpre : evalC ρ Mc r.full.f.m.pre = true := by\n      rw [sfull_pre, congrMC _ Mc M _ (fun mp hmp => hMc mp (avoidsMaps_occ (rn_m hp) hmp))]; exact h0\n    have hstart : StartMaps r.full.f.m Mc := by\n      intro p hp' key\n      rw [sfull_maps0] at hp'\n      rcases List.mem_append.mp hp' with hp' | hp'\n      · have hn : p.1 ∉ r.SM := fun h' => hsm p.1 h' (by\n          simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; left; left; exact List.mem_map_of_mem hp')\n        rw [hMc p.1 hn]; exact hM p hp' key\n      · have hl : lookup (fun q => q.1 == p.1) r.spec.f.m.maps0 = some p := lookup_unique1 hmo hp'\n        simp only [Mc, hl]\n    have hfacts : ∀ l ∈ r.full.facts, l.Holds ρ Mc := fun l hl => by simp [SRefined.full] at hl\n    refine ⟨_, Mc, SReach.start ρ Mc hstart hpre hfacts (fun p hp => by simp [SRefined.full] at hp), fun i hi' => ?_, hMc⟩\n    show applyS (r.impl.f.m.init ++ r.spec.f.m.init) ρ Mc i = applyS r.impl.f.m.init ρ M i\n    rw [applyS_append_other (by\n      intro h'; apply hi'; simp only [SRefined.SV, List.mem_append]; left; left; left; left; exact h')]\n    simp only [applyS]\n    cases hst : assoc r.impl.f.m.init i with\n    | none => rfl\n    | some e =>\n      have hm : (i, e) ∈ r.impl.f.m.init := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq, rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq\n        simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n      exact congrME _ Mc M e (fun mp hmp => hMc mp (avoidsMapsE_occ (rnE_m (hi (i, e) hm)) hmp))\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨ρc, Mc, hrc, hag, hmag⟩ := ih\n    obtain ⟨hA, hS, hW⟩ := srefine_step r hok hag hmag ι κ\n    exact ⟨_, _, SReach.step ρc Mc ι κ hrc (by rw [hA]; exact ha), hS, hW⟩\nend slift\n\n/-! The spec's part of the composite's runs -/\n\ntheorem lookup_qmap (l : List (Nat × List Nat × C)) (g : Nat × List Nat × C → C) (v : Nat) :\n    lookup (fun q : Nat × List Nat × C => q.1 == v) (l.map (fun q => (q.1, q.2.1, g q))) = (lookup (fun q : Nat × List Nat × C => q.1 == v) l).map (fun q => (q.1, q.2.1, g q)) := by\n  rw [lookup_map_pred]\ntheorem lookup_emap (l : List (Nat × Nat × E)) (g : Nat × Nat × E → E) (v : Nat) :\n    lookup (fun w : Nat × Nat × E => w.1 == v) (l.map (fun w => (w.1, w.2.1, g w))) = (lookup (fun w : Nat × Nat × E => w.1 == v) l).map (fun w => (w.1, w.2.1, g w)) := by\n  rw [lookup_map_pred]\n\ntheorem sView_snd (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (sView s ρ M ι κ).2 = withCarried s M κ := rfl\n\nsection sproject\nvariable (r : SRefined) (hok : srOk r = true)\ninclude hok\n\n-- The maps the spec reads: alike in its view and the composite's.\ntheorem sr_maps {M Ms : Nat → Nat → Nat} (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp) (κ : Nat → Nat → Nat) :\n    ∀ mp, mp ∉ r.IM → withCarried r.spec Ms κ mp = withCarried r.full M κ mp := by\n  obtain ⟨_, _, _, hcar, _⟩ := srNames_parts (sr_names r hok)\n  intro mp hmp\n  show (if r.spec.carried.contains mp = true then κ mp else Ms mp) = (if r.impl.carried.contains mp = true then κ mp else M mp)\n  by_cases hs : r.spec.carried.contains mp = true\n  · rw [if_pos hs, if_pos (List.contains_iff_mem.mpr (hcar mp (List.contains_iff_mem.mp hs)))]\n  · have hi : ¬ r.impl.carried.contains mp = true := fun hc => hmp (by\n      simp only [SRefined.IM, List.mem_append, List.mem_filter]; right; exact ⟨List.contains_iff_mem.mp hc, by simpa using hs⟩)\n    rw [if_neg hs, if_neg hi]\n    exact hmag mp hmp (fun h' => hs (List.contains_iff_mem.mpr h'))\n\ntheorem sr_W {v : Nat} (hv : v ∈ flagVars r.full.f.flags ∨ v ∈ r.full.qVars) : v ∈ r.W := by\n  simp only [sfull_flags, flagVars, List.map_append, List.map_map, SMachine.qVars, sfull_qflags, List.mem_append] at hv\n  simp only [SRefined.W, SMachine.qVars, flagVars, List.mem_append]\n  rcases hv with (h | h) | (h | h)\n  · left; left; left; left; left; exact h\n  · left; left; left; left; right; simpa [Function.comp_def] using h\n  · left; left; right; exact h\n  · left; right; simpa [Function.comp_def] using h\n\n-- A term the witness has, read in the composite's view, before its flags or with a key set: alike.\ntheorem sr_witE {ρ : Nat → Nat} {M : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : avoidsE r.W e = true) :\n    evalE (decideFlags r.full.f.flags (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) (withCarried r.full M κ) e\n      = evalE (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ) e := by\n  apply congrE; intro j hj\n  have hjW := avoidsE_occ he hj\n  rw [decide_other (fun h' => hjW (sr_W r hok (Or.inl h'))), decideQ_other (fun h' => hjW (sr_W r hok (Or.inr h')))]\n\ntheorem sr_wit_upd {X : Nat → Nat} {N : Nat → Nat → Nat} {e : E} (he : avoidsE r.W e = true) {k : Nat} (hk : k ∈ bkeys r.spec) (key : Nat) :\n    evalE (upd X k key) N e = evalE X N e := by\n  apply congrE; intro j hj\n  simp only [upd]; split\n  · rename_i h; subst h; exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk) (avoidsE_occ he hj)\n  · rfl\n\ntheorem sr_wit_atKeys {X : Nat → Nat} {N : Nat → Nat → Nat} {e : E} (he : avoidsE r.W e = true) {ks : List Nat} (hk : ∀ k ∈ ks, k ∈ bkeys r.spec) (v : Nat → Nat) :\n    evalE (atKeys X ks v) N e = evalE X N e := by\n  apply congrE; intro j hj\n  by_cases hjk : j ∈ ks\n  · exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk j hjk) (avoidsE_occ he hj)\n  · exact atKeys_out hjk\n\n-- The witness's domain: spec inputs.\ntheorem sr_wdom {i : Nat} (hi : i ∉ r.spec.f.m.inputs) : i ∉ r.wit.map (·.1) := fun h' => by\n  obtain ⟨_, _, _, _, _, hwit, _⟩ := srNames_parts (sr_names r hok)\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h'; exact hi (hwit p hp).1\n\ntheorem sr_wit_some {i : Nat} {e : E} (h : assoc r.wit i = some e) : (i, e) ∈ r.wit := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨q, hq, rfl⟩ := h\n  obtain ⟨hqm, hqv⟩ := lookup_some hq\n  simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n\n-- The spec's quantified flags, decided over its view (its inputs as the witness reads them), agree with the composite's\n-- with the witness put in, outside the implementation's names and the spec's plain flags.\ntheorem sr_q {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    Agree (r.IV ++ flagVars r.spec.f.flags)\n      (decideQ r.spec (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) (withCarried r.spec Ms κ))\n      (applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) := by\n  obtain ⟨_, _, _, _, _, _, hsq, _, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨hsv, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hN := sr_maps r hok hmag κ\n  intro v hv\n  have hvI : v ∉ r.IV := fun h' => hv (List.mem_append_left _ h')\n  have hvF : v ∉ flagVars r.spec.f.flags := fun h' => hv (List.mem_append_right _ h')\n  -- Names of the spec's part are none of the spec's inputs.\n  have hSI : ∀ i, i ∈ r.SV → i ∉ r.spec.f.m.inputs := fun i hi h' => hsi i h' (List.mem_append_right _ hi)\n  have hIVq : ∀ i, i ∉ r.IV → i ∉ r.impl.qVars := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; right; exact h')\n  have hIVi : ∀ i, i ∉ r.IV → i ∉ r.impl.f.m.inputs := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; left; left; left; exact h')\n  have hIVf : ∀ i, i ∉ r.IV → i ∉ flagVars r.impl.f.flags := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; right; exact h')\n  have hfull_q : ∀ i, i ∉ r.impl.qVars → i ∉ r.spec.qVars → i ∉ r.full.qVars := fun i h1 h2 h' => by\n    simp only [SMachine.qVars, sfull_qflags, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact h1 h'\n    · exact h2 (by simpa [SMachine.qVars, Function.comp_def] using h')\n  have hfull_f : ∀ i, i ∉ flagVars r.impl.f.flags → i ∉ flagVars r.spec.f.flags → i ∉ flagVars r.full.f.flags := fun i h1 h2 h' => by\n    simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact h1 h'\n    · exact h2 (by simpa [flagVars, Function.comp_def] using h')\n  -- The spec inputs as the witness reads them: in the composite's view, or before its flags; the same.\n  have hιs : ∀ i, i ∈ r.spec.f.m.inputs → applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ) i\n      = applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ) i := fun i hi => by\n    have hiI : i ∉ r.IV := fun h' => hsi i hi (List.mem_append_left _ h')\n    have hiS : i ∉ r.SV := fun h' => hsi i hi (List.mem_append_right _ h')\n    have hiF : i ∉ flagVars r.full.f.flags := hfull_f i (hIVf i hiI) (fun h' => hiS (by simp only [SRefined.SV, List.mem_append]; left; left; right; exact h'))\n    simp only [applyS, sView]\n    cases ha : assoc r.wit i with\n    | none => exact decide_other hiF _ _\n    | some e =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      rw [sr_witE r hok ι κ (hwit _ hm).2]\n      exact (congrE _ _ _ e (fun j hj => decideQ_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inr h'))) _ _)).symm\n  by_cases hvq : v ∈ r.spec.qVars\n  · -- A spec's quantified flag: its body over the spec's view; in the composite, with the witness put in.\n    have hvi : v ∉ r.spec.f.m.inputs := hSI v (by simp only [SRefined.SV, List.mem_append]; left; right; exact hvq)\n    rw [decideQ_of, applyS_other (sr_wdom r hok hvi), decideQ_of, sfull_qflags, lookup_append]\n    have hn : lookup (fun q => q.1 == v) r.impl.qflags = none := lookup_none (fun q hq' => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hIVq v hvI (by rw [← he]; exact List.mem_map_of_mem hq'))\n    simp only [hn, lookup_qmap]\n    cases hl : lookup (fun q => q.1 == v) r.spec.qflags with\n    | none => exact absurd hvq (fun h' => by obtain ⟨q, hq, hqv⟩ := List.mem_map.mp h'; have := lookup_none_all hl q hq; simp [hqv] at this)\n    | some q =>\n      have hqm := (lookup_some hl).1\n      have hrd := hsq q hqm\n      have hk : ∀ k ∈ q.2.1, k ∈ bkeys r.spec := fun k hk' => by simp only [bkeys, List.mem_append]; right; exact List.mem_flatMap.mpr ⟨q, hqm, hk'⟩\n      simp only [Option.map_some]\n      have hc : (∀ k, holdsC (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ) (substC r.wit q.2.2))\n          ↔ (∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) := by\n        apply forall_congr'; intro k; rw [← evalC_iff, ← evalC_iff, subst_evalC]\n      rw [show (if ∀ k, holdsC (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ) (substC r.wit q.2.2) then 1 else 0)\n          = (if ∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 then 1 else 0) by\n        simp only [hc]]\n      have hkdom : ∀ k ∈ q.2.1, k ∉ r.wit.map (·.1) := fun k hk' => sr_wdom r hok (hSI _ (by simp only [SRefined.SV, List.mem_append]; right; exact hk k hk'))\n      -- Both sides as one condition over every value of the keys: compare the states they read the body at.\n      have hall : ∀ k, evalC (atKeys (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 k) (withCarried r.spec Ms κ) q.2.2\n          = evalC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 := by\n        intro k\n        rw [congrMC _ _ (withCarried r.full M κ) _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m hrd) hmp))]\n        apply congrC; intro i hi\n        have hiR := avoids_occ (rn_v hrd) hi\n        simp only [List.mem_append, not_or] at hiR\n        obtain ⟨⟨hiI, hiF⟩, hiQ⟩ := hiR\n        by_cases hik : i ∈ q.2.1\n        · rw [applyS_other (hkdom i hik), atKeys_in hik, atKeys_in hik]\n        · rw [atKeys_out hik]\n          by_cases hii : i ∈ r.spec.f.m.inputs\n          · simp only [withInputs, List.contains_iff_mem.mpr hii, if_true]\n            rw [hιs i hii]\n            simp only [applyS]\n            cases ha : assoc r.wit i with\n            | none => rw [atKeys_out hik]; exact decideQ_other (fun h' => hfull_q i (hIVq i hiI) hiQ h') _ _\n            | some e =>\n              have hm := sr_wit_some r hok ha\n              dsimp only\n              rw [sr_wit_atKeys r hok (hwit _ hm).2 hk]\n              exact congrE _ _ _ e (fun j hj => decideQ_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inr h'))) _ _)\n          · rw [withInputs_other hii, applyS_other (sr_wdom r hok hii), atKeys_out hik]\n            rw [sfull_inputs, withInputs_other (hIVi i hiI)]\n            exact hag i (by simp only [SRefined.X, List.mem_append, not_or]; exact ⟨⟨⟨hiI, hiF⟩, hiQ⟩, hii⟩)\n      simp only [show (∀ k, holdsC (atKeys (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 k) (withCarried r.spec Ms κ) q.2.2)\n          ↔ (∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) from\n        forall_congr' (fun k => by rw [← evalC_iff, ← evalC_iff, hall k])]\n  · rw [decideQ_other hvq]\n    by_cases hvi : v ∈ r.spec.f.m.inputs\n    · simp only [withInputs, List.contains_iff_mem.mpr hvi, if_true]\n      exact hιs v hvi\n    · rw [withInputs_other hvi, applyS_other (sr_wdom r hok hvi), decideQ_other (hfull_q v (hIVq v hvI) hvq), sfull_inputs, withInputs_other (hIVi v hvI)]\n      exact hag v (by simp only [SRefined.X, List.mem_append, not_or]; exact ⟨⟨⟨hvI, hvF⟩, hvq⟩, hvi⟩)\n\n-- The spec's view of a step agrees with the composite's with the witness put in, outside the implementation's names.\ntheorem sr_view {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    Agree r.IV (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1\n      (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) := by\n  obtain ⟨_, hsf, _, _, _, _, _, _, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨hsv, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hN := sr_maps r hok hmag κ\n  have hQ := sr_q r hok hag hmag ι κ\n  simp only [sView] at hQ\n  have hIVf : ∀ i, i ∉ r.IV → i ∉ flagVars r.impl.f.flags := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; right; exact h')\n  intro v hv\n  simp only [sView]\n  by_cases hvf : v ∈ flagVars r.spec.f.flags\n  · have hvi : v ∉ r.spec.f.m.inputs := fun h' => hsi v h' (List.mem_append_right _ (by simp only [SRefined.SV, List.mem_append]; left; left; right; exact hvf))\n    cases hfo : flagOf r.spec.f.flags v with\n    | none => exact absurd hvf (flagOf_none hfo)\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hfo\n      have hfull : flagOf r.full.f.flags v = some (substC r.wit p.2) := by\n        rw [sfull_flags, flagOf_append_right (hIVf v hv), flagOf_map, hfo]; rfl\n      rw [decideFlags_of, hfo, applyS_other (sr_wdom r hok hvi), decideFlags_of, hfull]\n      simp only\n      rw [subst_evalC, congrMC _ _ (withCarried r.full M κ) _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m (hsf p hp)) hmp))]\n      rw [congrC _ (applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) _ p.2\n        (fun j hj => hQ j (avoids_occ (rn_v (hsf p hp)) hj))]\n  · rw [decide_other hvf]\n    have hX : v ∉ r.IV ++ flagVars r.spec.f.flags := by simp only [List.mem_append, not_or]; exact ⟨hv, hvf⟩\n    rw [hQ v hX]\n    simp only [applyS]\n    cases ha : assoc r.wit v with\n    | none =>\n      dsimp only\n      rw [decide_other (fun h' => by\n        simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n        rcases h' with h' | h'\n        · exact hIVf v hv h'\n        · exact hvf (by simpa [flagVars, Function.comp_def] using h'))]\n    | some e =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      exact congrE _ _ _ e (fun j hj => (decide_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inl h'))) _ _).symm)\n\n-- A term of the spec, read in the spec's view, is the term with the witness put in, read in the composite's view; with a\n-- bound key of the spec set, alike.\ntheorem sr_term {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : readsNoneE r.IV r.IM e = true) :\n    evalE (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 (withCarried r.spec Ms κ) e\n      = evalE (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substE r.wit e) := by\n  rw [subst_evalE, congrME _ _ (withCarried r.full M κ) e (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMapsE_occ (rnE_m he) hmp))]\n  exact congrE _ _ _ e (fun j hj => sr_view r hok hag hmag ι κ j (avoidsE_occ (rnE_v he) hj))\n\ntheorem sr_cond {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {c : C} (hc : readsNone r.IV r.IM c = true) :\n    evalC (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 (withCarried r.spec Ms κ) c\n      = evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substC r.wit c) := by\n  rw [subst_evalC, congrMC _ _ (withCarried r.full M κ) c (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMaps_occ (rn_m hc) hmp))]\n  exact congrC _ _ _ c (fun j hj => sr_view r hok hag hmag ι κ j (avoids_occ (rn_v hc) hj))\n\ntheorem sr_term_upd {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : readsNoneE r.IV r.IM e = true) {k : Nat} (hk : k ∈ bkeys r.spec) (key : Nat) :\n    evalE (upd (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 k key) (withCarried r.spec Ms κ) e\n      = evalE (upd (sView r.full ρ M ι κ).1 k key) (withCarried r.full M κ) (substE r.wit e) := by\n  obtain ⟨_, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hkdom : k ∉ r.wit.map (·.1) := sr_wdom r hok (fun h' => hsi k h' (List.mem_append_right _ (by simp only [SRefined.SV, List.mem_append]; right; exact hk)))\n  rw [subst_evalE, congrME _ _ (withCarried r.full M κ) e (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMapsE_occ (rnE_m he) hmp))]\n  apply congrE; intro j hj\n  by_cases hjk : j = k\n  · subst hjk; rw [applyS_other hkdom]; simp [upd]\n  · have hv := sr_view r hok hag hmag ι κ j (avoidsE_occ (rnE_v he) hj)\n    simp only [upd, hjk, if_false]\n    rw [hv]\n    simp only [applyS]\n    cases ha : assoc r.wit j with\n    | none => simp [upd, hjk]\n    | some e' =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      exact (sr_wit_upd r hok (hwit _ hm).2 hk key).symm\n\n-- A variable none of the names the composite's view sets, nor the spec's: each view reads it as its state does.\ntheorem sr_plain_full {ρ : Nat → Nat} {M : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {v : Nat} (hv : v ∉ r.X) :\n    (sView r.full ρ M ι κ).1 v = ρ v := by\n  simp only [SRefined.X, SRefined.IV, List.mem_append, not_or] at hv\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨hi, _⟩, _⟩, hf⟩, hq⟩, _⟩, hsf⟩, hsq⟩, _⟩ := hv\n  simp only [sView]\n  rw [decide_other (fun h' => by\n    simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact hf h'\n    · exact hsf (by simpa [flagVars, Function.comp_def] using h'))]\n  rw [decideQ_other (fun h' => by\n    simp only [SMachine.qVars, sfull_qflags, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact hq h'\n    · exact hsq (by simpa [SMachine.qVars, Function.comp_def] using h')), sfull_inputs]\n  exact withInputs_other hi ρ ι\n\ntheorem sr_plain_spec {σ : Nat → Nat} {Ms : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {v : Nat} (hv : v ∉ r.X) :\n    (sView r.spec σ Ms ι κ).1 v = σ v := by\n  simp only [SRefined.X, List.mem_append, not_or] at hv\n  obtain ⟨⟨⟨_, hsf⟩, hsq⟩, hsi⟩ := hv\n  simp only [sView]\n  rw [decide_other hsf, decideQ_other hsq]\n  exact withInputs_other hsi σ ι\n\n/-- The spec's part of every reachable state of the composite is a reachable state of the spec, given that the spec's\nprecondition holds at every reachable state of the composite (one of its laws) and that, at every step the composite\ntakes, the spec stutters or allows the request it is sent (its step law). -/\ntheorem srefine_project (hpre : ∀ ρ M, SReach r.full ρ M → evalC ρ M r.spec.f.m.pre = true)\n    (hallow : ∀ ρ M, SReach r.full ρ M → ∀ ι κ, evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 r.full.f.m.assume = true →\n      evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 (.or r.stutter (substC r.wit r.spec.f.m.assume)) = true) :\n    ∀ {ρ M}, SReach r.full ρ M → ∃ σ Ms, SReach r.spec σ Ms ∧ Agree r.X σ ρ ∧ ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp := by\n  obtain ⟨hsa, _, hss, _, hsw, hse, _, hsp, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨_, _, _, _, hcarO, _, hst, _, hsfacts⟩ := srNames_parts (sr_names r hok)\n  have hIVst : ∀ v, v ∉ r.IV → v ∉ r.impl.f.m.step.map (·.1) := fun v hv h' => hv (by simp only [SRefined.IV, List.mem_append]; left; left; left; right; exact h')\n  -- A map of the spec's part, unwritten by the implementation, read where the request carries none: the state's.\n  have hNc : ∀ (M : Nat → Nat → Nat) (κ : Nat → Nat → Nat) mp, mp ∉ r.IM → mp ∉ r.spec.carried → withCarried r.full M κ mp = M mp := fun M κ mp h1 h2 => by\n    show (if r.impl.carried.contains mp = true then κ mp else M mp) = M mp\n    rw [if_neg (fun hc => h1 (by\n      simp only [SRefined.IM, List.mem_append, List.mem_filter]; right\n      exact ⟨List.contains_iff_mem.mp hc, by simpa [List.contains_iff_mem] using h2⟩))]\n  have hIMe : ∀ mp, mp ∉ r.IM → lookup (fun w => w.1 == mp) r.impl.every = none := fun mp h => lookup_none (fun w hw => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; right; rw [← he]; exact List.mem_map_of_mem hw))\n  have hIMw : ∀ mp, mp ∉ r.IM → lookup (fun w : Nat × E × E => w.1 == mp) r.impl.f.m.writes = none := fun mp h => lookup_none (fun w hw => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; left; right; rw [← he]; exact List.mem_map_of_mem hw))\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 _ _ =>\n    have hp0 : evalC ρ M r.spec.f.m.pre = true := by\n      have h := hpre _ M (SReach.start ρ M hM h0 (fun l hl => by simp [SRefined.full] at hl) (fun p hp => by simp [SRefined.full] at hp))\n      have hag0 : ∀ i, occC i r.spec.f.m.pre = true → applyS r.full.f.m.init ρ M i = ρ i := fun i hi => applyS_other (fun h' => by\n        apply avoids_occ (rn_v hsp) hi\n        rw [sfull_init] at h'\n        simp only [List.map_append, List.mem_append] at h'\n        rcases h' with h' | h' <;> simp [SRefined.X, SRefined.IV, SRefined.SV, h']) ρ M\n      rwa [congrC _ ρ M r.spec.f.m.pre hag0] at h\n    have hMs : StartMaps r.spec.f.m M := fun p hp' key => hM p (by rw [sfull_maps0]; exact List.mem_append_right _ hp') key\n    refine ⟨_, M, SReach.start ρ M hMs hp0 (fun l hl => by simp [hsfacts] at hl) (fun p hp => by simp [sr_pfacts r hok] at hp), fun i hi => ?_, fun _ _ _ => rfl⟩\n    show applyS r.spec.f.m.init ρ M i = applyS (r.impl.f.m.init ++ r.spec.f.m.init) ρ M i\n    rw [applyS_append_right (fun h' => hi (by simp [SRefined.X, SRefined.IV, h']))]\n  | step ρ M ι κ hr ha ih =>\n    obtain ⟨σ, Ms, hrs, hag, hmag⟩ := ih\n    have hA := hallow ρ M hr ι κ ha\n    simp only [evalC, Bool.or_eq_true, sView_snd] at hA\n    -- The composite's step at a variable of the spec's part: kept where it stutters, the spec's term otherwise.\n    have hstepS : ∀ v, v ∉ r.IV → (sNext r.full ρ M ι κ).1 v\n        = applyS (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))) (sView r.full ρ M ι κ).1 (withCarried r.full M κ) v :=\n      fun v hv => by simp only [sNext]; rw [sfull_step]; exact applyS_append_right (hIVst v hv) _ _\n    have hstutK : ∀ k ∈ bkeys r.spec, ∀ key, evalC (upd (sView r.full ρ M ι κ).1 k key) (withCarried r.full M κ) r.stutter\n        = evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter := fun k hk key => by\n      apply congrC; intro j hj; simp only [upd]; split\n      · rename_i h; subst h; exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk) (avoids_occ hst hj)\n      · rfl\n    by_cases hstut : evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = true\n    · -- The spec doesn't step: its state is the same, and so is the composite's spec part.\n      refine ⟨σ, Ms, hrs, fun v hv => ?_, fun mp hmp hmc => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h'))))]\n        simp only [applyS]\n        cases hl : assoc (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))) v with\n        | none => dsimp only; rw [sr_plain_full r hok ι κ hv]; exact hag v hv\n        | some e =>\n          obtain ⟨q, hq, hqv, rfl⟩ : ∃ q ∈ r.spec.f.m.step, q.1 = v ∧ e = E.ite r.stutter (.var q.1) (substE r.wit q.2) := by\n            simp only [assoc, Option.map_eq_some_iff] at hl\n            obtain ⟨x, hx, rfl⟩ := hl\n            obtain ⟨hxm, hxv⟩ := lookup_some hx\n            obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hxm\n            simp only [beq_iff_eq] at hxv\n            exact ⟨q, hq, hxv, rfl⟩\n          dsimp only\n          simp only [evalE, hstut, if_true]\n          rw [hqv, sr_plain_full r hok ι κ hv]; exact hag v hv\n      · funext key\n        rw [hmag mp hmp hmc]\n        simp only [sNext, everyMaps, sView_snd]\n        rw [sfull_every, lookup_append, hIMe mp hmp]\n        simp only [lookup_emap]\n        cases hw : lookup (fun w => w.1 == mp) r.spec.every with\n        | some w =>\n          have hwm := (lookup_some hw).2\n          simp only [beq_iff_eq] at hwm\n          have hk : w.2.1 ∈ bkeys r.spec := by simp only [bkeys, List.mem_append]; left; exact List.mem_map_of_mem (lookup_some hw).1\n          simp only [Option.map_some, evalE]\n          rw [hstutK _ hk key]\n          simp only [hstut, if_true, upd, hwm, hNc M κ mp hmp hmc]\n        | none =>\n          simp only [Option.map_none, writeMaps]\n          rw [sfull_writes, lookup_append, hIMw mp hmp]\n          try dsimp only\n          rw [lookup_writes_map]\n          cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.f.m.writes with\n          | none => simp only [Option.map_none]; exact (congrFun (hNc M κ mp hmp hmc) key).symm\n          | some w0 =>\n            have hw0m := (lookup_some hw0).2\n            simp only [beq_iff_eq] at hw0m\n            simp only [Option.map_some, evalE, hstut, if_true, hw0m]\n            by_cases hk : key = evalE (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substE r.wit w0.2.1)\n            · rw [if_pos hk, ← hk]; exact (congrFun (hNc M κ mp hmp hmc) _).symm\n            · rw [if_neg hk]; exact (congrFun (hNc M κ mp hmp hmc) key).symm\n    · -- The spec steps, sent the witness's request, which it allows.\n      have hX := hA.resolve_left hstut\n      rw [← sr_cond r hok hag hmag ι κ (c := r.spec.f.m.assume) hsa] at hX\n      refine ⟨_, _, SReach.step σ Ms _ κ hrs hX, fun v hv => ?_, fun mp hmp hmc => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h'))))]\n        simp only [sNext, applyS, sView_snd]\n        rw [assoc_map_fst]\n        cases hl : lookup (fun q => q.1 == v) r.spec.f.m.step with\n        | none =>\n          have hn : assoc r.spec.f.m.step v = none := by simp only [assoc, hl, Option.map_none]\n          rw [hn]; dsimp only\n          rw [sr_plain_full r hok ι κ hv, sr_plain_spec r hok _ κ hv]; exact hag v hv\n        | some q =>\n          have hq := lookup_some hl\n          simp only [beq_iff_eq] at hq\n          have hn : assoc r.spec.f.m.step v = some q.2 := by simp only [assoc, hl, Option.map_some]\n          rw [hn]; dsimp only\n          simp only [Option.map_some, evalE, show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n          have hm : (v, q.2) ∈ r.spec.f.m.step := by rw [← hq.2]; exact hq.1\n          exact sr_term r hok hag hmag ι κ (hss (v, q.2) hm)\n      · funext key\n        simp only [sNext, everyMaps, sView_snd]\n        rw [sfull_every, lookup_append, hIMe mp hmp]\n        simp only [lookup_emap]\n        cases hw : lookup (fun w => w.1 == mp) r.spec.every with\n        | some w =>\n          have hk : w.2.1 ∈ bkeys r.spec := by simp only [bkeys, List.mem_append]; left; exact List.mem_map_of_mem (lookup_some hw).1\n          simp only [Option.map_some, evalE]\n          rw [hstutK _ hk key]\n          simp only [show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n          exact sr_term_upd r hok hag hmag ι κ (hse w (lookup_some hw).1) hk key\n        | none =>\n          simp only [Option.map_none, writeMaps]\n          rw [sfull_writes, lookup_append, hIMw mp hmp]\n          try dsimp only\n          rw [lookup_writes_map]\n          cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.f.m.writes with\n          | none => simp only [Option.map_none]; exact congrFun (sr_maps r hok hmag κ mp hmp) key\n          | some w0 =>\n            obtain ⟨h1, h2⟩ := hsw w0 (lookup_some hw0).1\n            simp only [Option.map_some, evalE, show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n            rw [sr_term r hok hag hmag ι κ h1, sr_term r hok hag hmag ι κ h2, sr_maps r hok hmag κ mp hmp]\nend sproject\n\n-- The composite's step law: on every request it takes, the spec stutters or allows the request it is sent.\ndef srStep (r : SRefined) (prime primeMaps : List (Nat × Nat)) (p : SProof) : SKStep :=\n  ⟨⟨[trueC], r.allowed, [[]], prime, primeMaps, p.1, (p.2.2.2.2.2.1, p.2.2.2.2.2.2.2)⟩, [[]], p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2.1, p.2.2.2.2.2.2.1, []⟩\n\n/-- What a refinement over sets means: with the relation (and the spec's precondition, the j-th law) proven of the\ncomposite, and its step law that the spec stutters or allows every request it is sent, every reachable state of the\nimplementation is, outside the spec's part, a reachable state of the composite, whose spec part is a reachable state of\nthe spec, the two related by every law. -/\ntheorem srefines (r : SRefined) (hok : srOk r = true) (hmo : distinct (r.spec.f.m.maps0.map (·.1)) = true) (ps : List SEntry)\n    (hl : checkSMachine r.full ps = true)\n    (j : Nat) (hj : (ps[j]?).map (·.law.holds) = some r.spec.f.m.pre ∧ (ps[j]?).map (·.law.key) = some none)\n    (prime primeMaps : List (Nat × Nat)) (p : SProof) (hs : checkSKStep r.full ps (srStep r prime primeMaps p) = true)\n    (hfresh : avoids (prime.map (·.2)) r.allowed = true ∧ avoidsMaps (primeMaps.map (·.2)) r.allowed = true)\n    (hw : avoids r.full.wVars r.allowed = true) (hiq : r.full.f.m.inputs.all (fun i => !r.full.qVars.contains i) = true) :\n    ∀ ρ M, SReach r.impl ρ M → ∃ ρc Mc σ Ms, SReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ (∀ mp, mp ∉ r.SM → Mc mp = M mp)\n      ∧ SReach r.spec σ Ms ∧ Agree r.X σ ρc ∧ (∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = Mc mp) ∧ ∀ e ∈ ps, e.Holds ρc Mc := by\n  have hlaws := smachine_sound r.full ps hl\n  have hpre : ∀ ρ M, SReach r.full ρ M → evalC ρ M r.spec.f.m.pre = true := by\n    intro ρ M hr\n    cases he : ps[j]? with\n    | none => simp [he] at hj\n    | some e =>\n      simp only [he, Option.map_some, Option.some.injEq] at hj\n      have h := SEntry.holds_law (hlaws ρ M hr e (List.mem_of_getElem? he))\n      unfold MLaw.Holds at h\n      rw [hj.2] at h\n      simpa [hj.1] using h\n  have hiq' : ∀ i, i ∈ r.full.f.m.inputs → i ∉ r.full.qVars := fun i hi hq => by\n    simp only [List.all_eq_true, Bool.not_eq_true'] at hiq\n    have := hiq i hi; rw [List.contains_iff_mem.mpr hq] at this; cases this\n  have hallow : ∀ ρ M, SReach r.full ρ M → ∀ ι κ, evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 r.full.f.m.assume = true →\n      evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 (.or r.stutter (substC r.wit r.spec.f.m.assume)) = true := by\n    intro ρ M hr ι κ hA\n    have h := skstep_sound r.full ps _ hl hs ρ M hr (ι, κ) [] rfl ⟨hA, by simp [trueC, evalC, evalE], trivial⟩\n    have h' : evalC (primed prime (sNext r.full ρ M ι κ).1 (withExt r.full ρ (sReq r.full ρ M ι κ)))\n        (primedMaps primeMaps (sNext r.full ρ M ι κ).2 (withCarried r.full M κ)) r.allowed = true := by\n      simpa [srStep, sEnd, sExts, renEnv, renMaps, lookup] using h\n    rw [unprimed_evalC hfresh.1 hfresh.2] at h'\n    -- The request's extended variables, read as the step reads them: the inputs, and each quantified flag decided.\n    have hE : ∀ v, v ∉ r.full.wVars → withExt r.full ρ (sReq r.full ρ M ι κ) v\n        = decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ) v := by\n      intro v hv\n      simp only [withExt, sReq]\n      by_cases hi : v ∈ r.full.f.m.inputs\n      · have hext : r.full.extVars.contains v = true := List.contains_iff_mem.mpr (by simp [SMachine.extVars, hi])\n        rw [decideQ_other (hiq' v hi)]\n        simp only [hext, if_true, List.contains_iff_mem.mpr hi, withInputs]\n      · have hin : r.full.f.m.inputs.contains v = false := by simpa [List.contains_iff_mem] using hi\n        by_cases hq : v ∈ r.full.qVars\n        · have hext : r.full.extVars.contains v = true := List.contains_iff_mem.mpr (by simp [SMachine.extVars, hq])\n          obtain ⟨q, hq0, rfl⟩ := List.mem_map.mp hq\n          cases hl : lookup (fun q' => q'.1 == q.1) r.full.qflags with\n          | none => have := lookup_none_all hl q hq0; simp at this\n          | some q' => simp only [hext, if_true, hin, Bool.false_eq_true, if_false, hl]\n        · have hext : r.full.extVars.contains v = false := by\n            simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, not_or]\n            simpa [List.contains_iff_mem] using (⟨hi, hq, hv⟩ : v ∉ r.full.f.m.inputs ∧ v ∉ r.full.qVars ∧ v ∉ r.full.wVars)\n          rw [decideQ_other hq, withInputs_other hi]\n          simp only [hext, Bool.false_eq_true, if_false]\n    rw [congrC _ _ _ r.allowed (fun i hi => hE i (avoids_occ hw hi))] at h'\n    simp only [SRefined.allowed] at h'\n    rw [inline_evalC] at h'\n    exact h'\n  intro ρ M hr\n  obtain ⟨ρc, Mc, hrc, hag, hmag⟩ := srefine_lift r hok hmo hr\n  obtain ⟨σ, Ms, hrs, hags, hmags⟩ := srefine_project r hok hpre hallow hrc\n  exact ⟨ρc, Mc, σ, Ms, hrc, hag, hmag, hrs, hags, hmags, hlaws ρc Mc hrc⟩\n\nend Kern\n\n#print axioms Kern.srefine_lift\n#print axioms Kern.srefine_project\n#print axioms Kern.srefines\n",