gdp-wired 0.17.0 → 0.18.0

package/dist/lean-kernel/library.js

@@ -11,4 +11,6 @@ export const leanLibrary = {
     "Live.lean": "import Sets\n\n/-!\nLiveness under fairness: \"from leads to to\", proven sound for machines with sets (`sleads_sound`, and under weak\nfairness `sleads_wf_sound`); a machine with maps and flags is one with no sets. kernel.ts proves it by a rank (naturals over the state and params, compared in\norder: the first that differs decides) and helpful requests, each with the region where it helps. While `from` holds and\n`to` doesn't: every request allowed keeps `from` or reaches `to`, and reaches `to`, lowers the rank, or keeps the rank\nwith every region it was in kept (a step law); some region holds (a step law that reads no step); and each helpful\nrequest, taken in its region, reaches `to` or lowers the rank (a step law whose `when` names the inputs the request\nsets; the others, and the maps it carries, stay free: a history's queries among them). Lean builds all of them from the\nliveness and checks them with the step-law rules (StepLaw.lean's, Sets.lean's). Then along every run that takes each\nhelpful request infinitely often, each state where `from` holds is followed by one where `to` holds: the rank can't drop\nforever, once it stops dropping the region it is in stays, and that region's request comes and lowers it.\n-/\n\nnamespace Kern\n\n/-! Ranks compared in order -/\n\ndef lexB : List Nat → List Nat → Bool\n  | a' :: as', a :: as => decide (a' < a) || (decide (a' = a) && lexB as' as)\n  | _, _ => false\n\ntheorem lexB_irrefl : ∀ x : List Nat, lexB x x = false\n  | [] => rfl\n  | a :: as => by simp [lexB, lexB_irrefl as]\n\ntheorem nat_down {g : Nat → Nat} {n0 : Nat} (h : ∀ n, n0 ≤ n → g (n + 1) ≤ g n) : ∀ d, g (n0 + d) ≤ g n0\n  | 0 => Nat.le_refl _\n  | d + 1 => Nat.le_trans (h (n0 + d) (Nat.le_add_right _ _)) (nat_down h d)\n\n-- A natural that never rises from n0 on stops changing.\ntheorem nat_stable (g : Nat → Nat) : ∀ v n0, g n0 ≤ v → (∀ n, n0 ≤ n → g (n + 1) ≤ g n) →\n    ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → g m = g T := by\n  intro v\n  induction v with\n  | zero =>\n    intro n0 hv h\n    refine ⟨n0, Nat.le_refl _, fun m hm => ?_⟩\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    have := nat_down h d; omega\n  | succ v ih =>\n    intro n0 hv h\n    by_cases hall : ∀ m, n0 ≤ m → g m = g n0\n    · exact ⟨n0, Nat.le_refl _, hall⟩\n    · have hex : ∃ m, n0 ≤ m ∧ g m ≠ g n0 := Classical.byContradiction fun hno =>\n        hall fun m hm => Classical.byContradiction fun hne => hno ⟨m, hm, hne⟩\n      obtain ⟨m, hm, hne⟩ := hex\n      obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n      have := nat_down h d\n      obtain ⟨T, hT, hTm⟩ := ih (n0 + d) (by omega) (fun n hn => h n (by omega))\n      exact ⟨T, by omega, hTm⟩\n\n-- A rank of k naturals that never rises (in order) from n0 on stops changing.\ntheorem lex_stable : ∀ (k : Nat) (r : Nat → List Nat) (n0 : Nat), (∀ n, (r n).length = k) →\n    (∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n) → ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → r m = r T\n  | 0, r, n0, hk, _ => ⟨n0, Nat.le_refl _, fun m _ => by\n      rw [List.eq_nil_of_length_eq_zero (hk m), List.eq_nil_of_length_eq_zero (hk n0)]⟩\n  | k + 1, r, n0, hk, hmono => by\n    have hcons : ∀ n, r n = (r n).headD 0 :: (r n).tail := by\n      intro n\n      have := hk n\n      cases h : r n with\n      | nil => rw [h] at this; simp at this\n      | cons a as => rfl\n    have hstep : ∀ n, n0 ≤ n → (r (n + 1)).headD 0 < (r n).headD 0 ∨\n        ((r (n + 1)).headD 0 = (r n).headD 0 ∧ (lexB (r (n + 1)).tail (r n).tail = true ∨ (r (n + 1)).tail = (r n).tail)) := by\n      intro n hn\n      have h := hmono n hn\n      rw [hcons (n + 1), hcons n] at h\n      simp only [lexB, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq, List.cons.injEq] at h\n      rcases h with (h | ⟨h1, h2⟩) | ⟨h1, h2⟩\n      · exact Or.inl h\n      · exact Or.inr ⟨h1, Or.inl h2⟩\n      · exact Or.inr ⟨h1, Or.inr h2⟩\n    obtain ⟨T1, hT1, hT1m⟩ := nat_stable (fun n => (r n).headD 0) _ n0 (Nat.le_refl _) (fun n hn => by\n      rcases hstep n hn with h | ⟨h, _⟩\n      · exact Nat.le_of_lt h\n      · exact Nat.le_of_eq h)\n    obtain ⟨T2, hT2, hT2m⟩ := lex_stable k (fun n => (r n).tail) T1 (fun n => by simp [hk n]) (fun n hn => by\n      rcases hstep n (by omega) with h | ⟨_, h⟩\n      · have e1 := hT1m (n + 1) (by omega); have e2 := hT1m n hn; omega\n      · exact h)\n    refine ⟨T2, by omega, fun m hm => ?_⟩\n    have e1 := hT1m m (by omega); have e2 := hT1m T2 hT2; have e3 := hT2m m hm\n    rw [hcons m, hcons T2, e3, e1, e2]\n\n/-- Along a run: if `P ∧ ¬Q` is kept (or Q reached) with the rank never rising, and kept only with every region kept;\nsome region holds while `P ∧ ¬Q` does; and each region's helpful step reaches Q or lowers the rank there; then Q\nfollows every P, provided each helpful step is taken from any point on where it stays enabled (E), and it is enabled in\nits region while `P ∧ ¬Q` holds. With E always true, that is: each helpful step taken infinitely often. -/\ntheorem leads_of_lex {α : Type} (P Q : Nat → Prop) (r : Nat → List Nat) (k : Nat) (hk : ∀ n, (r n).length = k)\n    (helps : List α) (W H E : α → Nat → Prop)\n    (hstay : ∀ n, P n → ¬ Q n → (P (n + 1) ∨ Q (n + 1)) ∧\n      (Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true ∨ (r (n + 1) = r n ∧ ∀ h ∈ helps, W h n → W h (n + 1))))\n    (hcover : ∀ n, P n → ¬ Q n → ∃ h ∈ helps, W h n)\n    (hhelp : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → H h n → Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true)\n    (henabled : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → E h n)\n    (fair : ∀ h ∈ helps, ∀ n, (∀ m, n ≤ m → E h m) → ∃ m, n ≤ m ∧ H h m) : ∀ n, P n → ∃ m, n ≤ m ∧ Q m := by\n  intro n0 hP\n  apply Classical.byContradiction\n  intro hno\n  have hnq : ∀ m, n0 ≤ m → ¬ Q m := fun m hm hq => hno ⟨m, hm, hq⟩\n  have hPd : ∀ d, P (n0 + d) := by\n    intro d\n    induction d with\n    | zero => exact hP\n    | succ d ih =>\n      rcases (hstay (n0 + d) ih (hnq _ (Nat.le_add_right _ _))).1 with h | h\n      · exact h\n      · exact absurd h (hnq _ (by omega))\n  have hPm : ∀ m, n0 ≤ m → P m := fun m hm => by obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm; exact hPd d\n  have hmono : ∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n := by\n    intro n hn\n    rcases (hstay n (hPm n hn) (hnq n hn)).2 with h | h | ⟨h, _⟩\n    · exact absurd h (hnq _ (by omega))\n    · exact Or.inl h\n    · exact Or.inr h\n  -- The rank stops changing at T; the region T is in stays, and its helpful step would lower the rank.\n  obtain ⟨T, hT, hTm⟩ := lex_stable k r n0 hk hmono\n  have hlow : ∀ m, T ≤ m → lexB (r (m + 1)) (r m) ≠ true := fun m hm hl => by\n    rw [hTm (m + 1) (by omega), hTm m hm, lexB_irrefl] at hl; exact absurd hl (by simp)\n  obtain ⟨h, hh, hW⟩ := hcover T (hPm T hT) (hnq T hT)\n  have hWd : ∀ d, W h (T + d) := by\n    intro d\n    induction d with\n    | zero => exact hW\n    | succ d ih =>\n      rcases (hstay (T + d) (hPm _ (by omega)) (hnq _ (by omega))).2 with hq | hl | ⟨_, hkeep⟩\n      · exact absurd hq (hnq _ (by omega))\n      · exact absurd hl (hlow _ (by omega))\n      · exact hkeep h hh ih\n  obtain ⟨m, hm, hH⟩ := fair h hh T (fun m hm => by\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    exact henabled h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d))\n  obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n  rcases hhelp h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d) hH with hq | hl\n  · exact hnq _ (by omega) hq\n  · exact hlow _ (by omega) hl\n\n/-! Primed names: a condition read after a step -/\n\n-- A term with its state variables renamed to their primed names (`pr`: variable, name) and its maps to theirs (`pm`).\nmutual\ndef primeE (pr pm : List (Nat × Nat)) : E → E\n  | .var i => match lookup (fun q => q.1 == i) pr with\n    | some q => .var q.2\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (primeE pr pm a) (primeE pr pm b)\n  | .sub a b => .sub (primeE pr pm a) (primeE pr pm b)\n  | .mul k a => .mul k (primeE pr pm a)\n  | .min a b => .min (primeE pr pm a) (primeE pr pm b)\n  | .max a b => .max (primeE pr pm a) (primeE pr pm b)\n  | .prod a b => .prod (primeE pr pm a) (primeE pr pm b)\n  | .ite c t f => .ite (primeC pr pm c) (primeE pr pm t) (primeE pr pm f)\n  | .get m k => .get (match lookup (fun q => q.1 == m) pm with\n      | some q => q.2\n      | none => m) (primeE pr pm k)\ndef primeC (pr pm : List (Nat × Nat)) : C → C\n  | .le a b => .le (primeE pr pm a) (primeE pr pm b)\n  | .lt a b => .lt (primeE pr pm a) (primeE pr pm b)\n  | .eq a b => .eq (primeE pr pm a) (primeE pr pm b)\n  | .and a b => .and (primeC pr pm a) (primeC pr pm b)\n  | .or a b => .or (primeC pr pm a) (primeC pr pm b)\n  | .not a => .not (primeC pr pm a)\nend\n\n-- Read where `then` reads (primed names after, the rest before), a renamed term is the term after, wherever a variable\n-- or map it reads is renamed or the same before and after, and reads no primed name.\nsection prime\nvariable (pr pm : List (Nat × Nat)) (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n  (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat)\ninclude hpr hpm\nmutual\ntheorem primeE_eval : (e : E) → (∀ i, occE i e = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occME mp e = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalE (primed pr ρ' ρ) (primedMaps pm M' M) (primeE pr pm e) = evalE ρ' M' e\n  | .var i, hv, _ => by\n    simp only [primeE]\n    cases hl : lookup (fun q => q.1 == i) pr with\n    | some q =>\n      have ⟨hq, hqi⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqi\n      simp only [evalE, primed, lookup_ren hpr q hq, hqi]\n    | none =>\n      have hi := hv i (by simp [occE])\n      have hnot : i ∉ pr.map (·.1) := fun hm => by\n        obtain ⟨q, hq, hqi⟩ := List.mem_map.mp hm\n        have := lookup_none_all hl q hq; simp [hqi] at this\n      have hn2 : lookup (fun q => q.2 == i) pr = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hi.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [evalE, primed, hn2]\n      rcases hi.2 with h | h\n      · exact absurd h hnot\n      · exact h.symm\n  | .const n, _, _ => rfl\n  | .add a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .sub a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .mul k a, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .min a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .max a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .prod a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .ite c t f, hv, hm => by\n    simp only [primeE, evalE, primeC_eval c (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval t (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval f (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .get m k, hv, hm => by\n    have hk := primeE_eval k (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))\n    simp only [primeE, evalE, hk]\n    cases hl : lookup (fun q => q.1 == m) pm with\n    | some q =>\n      have ⟨hq, hqm⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqm\n      simp only [primedMaps, lookup_ren hpm q hq, hqm]\n    | none =>\n      have hmm := hm m (by simp [occME])\n      have hnot : m ∉ pm.map (·.1) := fun hmem => by\n        obtain ⟨q, hq, hqm⟩ := List.mem_map.mp hmem\n        have := lookup_none_all hl q hq; simp [hqm] at this\n      have hn2 : lookup (fun q => q.2 == m) pm = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hmm.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [primedMaps, hn2]\n      rcases hmm.2 with h | h\n      · exact absurd h hnot\n      · rw [h]\ntheorem primeC_eval : (c : C) → (∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalC (primed pr ρ' ρ) (primedMaps pm M' M) (primeC pr pm c) = evalC ρ' M' c\n  | .le a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .lt a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .eq a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .and a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .or a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .not a, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\nend\nend prime\n\n-- Read where `then` reads, a condition that reads no primed name is the condition before the step.\ntheorem unprimedC_eval {pr pm : List (Nat × Nat)} {c : C} (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalC (primed pr ρ' ρ) (primedMaps pm M' M) c = evalC ρ M c := by\n  rw [congrC _ ρ _ c (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrMC ρ _ M c (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\ntheorem unprimed_eval {pr pm : List (Nat × Nat)} {e : E} (hv : ∀ i, occE i e = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occME mp e = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalE (primed pr ρ' ρ) (primedMaps pm M' M) e = evalE ρ M e := by\n  rw [congrE _ ρ _ e (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrME ρ _ M e (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\n-- A condition (a term) read across a step: primed, it is read after the step; plain, before it, whether in `then`'s\n-- reading or in `when`'s; given that what it reads is renamed or unchanged by the step, and unchanged by the request.\ntheorem view_C {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {c : C} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i c = true → X i = ρ i) (hn : ∀ mp, occMC mp c = true → N mp = M mp) :\n    evalC (primed pr ρ' X) (primedMaps pm M' N) (primeC pr pm c) = evalC ρ' M' c\n      ∧ evalC (primed pr ρ' X) (primedMaps pm M' N) c = evalC ρ M c ∧ evalC X N c = evalC ρ M c := by\n  have h3 : evalC X N c = evalC ρ M c := by rw [congrMC X N M c hn]; exact congrC X ρ M c hx\n  refine ⟨primeC_eval pr pm hpr hpm X ρ' N M' c hv hm, ?_, h3⟩\n  rw [unprimedC_eval (fun i hi => (hv i hi).1) (fun mp h => (hm mp h).1), h3]\n\ntheorem view_E {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {e : E} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i (.eq e e) = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp (.eq e e) = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i (.eq e e) = true → X i = ρ i) (hn : ∀ mp, occMC mp (.eq e e) = true → N mp = M mp) :\n    evalE (primed pr ρ' X) (primedMaps pm M' N) (primeE pr pm e) = evalE ρ' M' e\n      ∧ evalE (primed pr ρ' X) (primedMaps pm M' N) e = evalE ρ M e := by\n  have h3 : evalE X N e = evalE ρ M e := by\n    rw [congrME X N M e (fun mp h => hn mp (by simp [occMC, h]))]; exact congrE X ρ M e (fun i h => hx i (by simp [occC, h]))\n  refine ⟨primeE_eval pr pm hpr hpm X ρ' N M' e (fun i h => hv i (by simp [occC, h])) (fun mp h => hm mp (by simp [occMC, h])), ?_⟩\n  rw [unprimed_eval (fun i h => (hv i (by simp [occC, h])).1) (fun mp h => (hm mp (by simp [occMC, h])).1), h3]\n\n/-! The conditions Lean builds -/\n\ndef falseC : C := .lt (.const 0) (.const 0)\n-- The rank after (as') below the rank before (as), in order; the two equal; each region, if it held, held after; some\n-- region; the request's inputs as its terms.\ndef lexLtC : List E → List E → C\n  | a' :: as', a :: as => .or (.lt a' a) (.and (.eq a' a) (lexLtC as' as))\n  | _, _ => falseC\ndef eqsC : List E → List E → C\n  | a' :: as', a :: as => .and (.eq a' a) (eqsC as' as)\n  | _, _ => trueC\ndef keepC (pr pm : List (Nat × Nat)) : List C → C\n  | [] => trueC\n  | w :: ws => .and (.or (.not w) (primeC pr pm w)) (keepC pr pm ws)\ndef anyC : List C → C\n  | [] => falseC\n  | w :: ws => .or w (anyC ws)\ndef reqC : List (Nat × E) → C\n  | [] => trueC\n  | p :: ps => .and (.eq (.var p.1) p.2) (reqC ps)\n\ntheorem lexLtC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ as' as : List E,\n    evalC ρ M (lexLtC as' as) = lexB (as'.map (evalE ρ M)) (as.map (evalE ρ M))\n  | a' :: as', a :: as => by simp only [lexLtC, lexB, evalC, List.map_cons, lexLtC_eval ρ M as' as]\n  | [], _ => by simp [lexLtC, lexB, evalC, falseC]\n  | _ :: _, [] => by simp [lexLtC, lexB, evalC, falseC]\n\ntheorem eqsC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ as' as : List E, as'.length = as.length →\n    (evalC ρ M (eqsC as' as) = true ↔ as'.map (evalE ρ M) = as.map (evalE ρ M))\n  | a' :: as', a :: as, h => by\n    simp only [eqsC, evalC, Bool.and_eq_true, decide_eq_true_eq, List.map_cons, List.cons.injEq, eqsC_eval ρ M as' as (by simpa using h)]\n  | [], [], _ => by simp [eqsC, evalC, trueC]\n  | [], _ :: _, h => by simp at h\n  | _ :: _, [], h => by simp at h\n\ntheorem keepC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) (pr pm : List (Nat × Nat)) : ∀ ws : List C,\n    evalC ρ M (keepC pr pm ws) = true ↔ ∀ w ∈ ws, evalC ρ M w = true → evalC ρ M (primeC pr pm w) = true\n  | [] => by simp [keepC, evalC, trueC]\n  | w :: ws => by\n    rw [List.forall_mem_cons, ← keepC_eval ρ M pr pm ws]\n    simp only [keepC, evalC, Bool.and_eq_true, Bool.or_eq_true, Bool.not_eq_true']\n    cases evalC ρ M w <;> simp\n\ntheorem anyC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ ws : List C, evalC ρ M (anyC ws) = true ↔ ∃ w ∈ ws, evalC ρ M w = true\n  | [] => by simp [anyC, evalC, falseC]\n  | w :: ws => by simp only [anyC, evalC, Bool.or_eq_true, anyC_eval ρ M ws, List.mem_cons, exists_eq_or_imp]\n\ntheorem reqC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ ps : List (Nat × E), evalC ρ M (reqC ps) = true ↔ ∀ p ∈ ps, ρ p.1 = evalE ρ M p.2\n  | [] => by simp [reqC, evalC, trueC]\n  | p :: ps => by\n    rw [List.forall_mem_cons, ← reqC_eval ρ M ps]\n    simp only [reqC, evalC, evalE, Bool.and_eq_true]\n    exact ⟨fun h => ⟨of_decide_eq_true h.1, h.2⟩, fun h => ⟨decide_eq_true h.1, h.2⟩⟩\n\ntheorem zip_cover {α β : Type} : ∀ (as : List α) (bs : List β), as.length = bs.length → ∀ a ∈ as, ∃ b, (a, b) ∈ as.zip bs\n  | [], [], _, a, ha => by simp at ha\n  | a :: as, b :: bs, h, x, hx => by\n    rcases List.mem_cons.mp hx with rfl | hx\n    · exact ⟨b, by simp⟩\n    · obtain ⟨b', hb'⟩ := zip_cover as bs (by simpa using h) x hx\n      exact ⟨b', by simp [hb']⟩\n  | [], _ :: _, h, _, _ => by simp at h\n  | _ :: _, [], h, _, _ => by simp at h\n\n/-! Liveness -/\n\nstructure Live where\n  from_ : C\n  to : C\n  rank : List E                         -- compared in order\n  helps : List (C × List (Nat × E))     -- (the region where it helps, the request: an input and its term over the state and params)\n  prime : List (Nat × Nat)              -- a state variable, and its primed name\n  primeMaps : List (Nat × Nat)          -- a map, and its primed name\n\ndef Live.pend (l : Live) : C := .and l.from_ (.not l.to)\ndef liveStayC (l : Live) : C :=\n  .and (.or (primeC l.prime l.primeMaps l.from_) (primeC l.prime l.primeMaps l.to))\n    (.or (primeC l.prime l.primeMaps l.to) (.or (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n      (.and (eqsC (l.rank.map (primeE l.prime l.primeMaps)) l.rank) (keepC l.prime l.primeMaps (l.helps.map (·.1))))))\ndef liveCoverC (l : Live) : C := anyC (l.helps.map (·.1))\ndef liveHelpWhen (l : Live) (h : C × List (Nat × E)) : C := .and l.pend (.and h.1 (reqC h.2))\ndef liveHelpThen (l : Live) : C := .or (primeC l.prime l.primeMaps l.to) (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n-- What reads the state alone: `from`, `to`, each part of the rank and each region.\ndef liveConds (l : Live) : List C := [l.from_, l.to] ++ l.rank.map (fun e => .eq e e) ++ l.helps.map (·.1)\n\ntheorem mem_conds_rank {l : Live} {e : E} (he : e ∈ l.rank) : C.eq e e ∈ liveConds l := by\n  simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inl (Or.inr ⟨e, he, rfl⟩)\n\n/-- The argument, given how each step reads: `B`, `BM` the state and maps `when` reads (with the request), `A`, `AM`\nthose `then` reads (primed names after the step). -/\ntheorem leads_view (l : Live) (st : Nat → (Nat → Nat) × (Nat → Nat → Nat)) (B A : Nat → Nat → Nat) (BM AM : Nat → Nat → Nat → Nat)\n    (H En : C × List (Nat × E) → Nat → Prop)\n    (hC : ∀ n, ∀ c ∈ liveConds l, evalC (A n) (AM n) (primeC l.prime l.primeMaps c) = evalC (st (n + 1)).1 (st (n + 1)).2 c\n      ∧ evalC (A n) (AM n) c = evalC (st n).1 (st n).2 c ∧ evalC (B n) (BM n) c = evalC (st n).1 (st n).2 c)\n    (hE : ∀ n, ∀ e ∈ l.rank, evalE (A n) (AM n) (primeE l.prime l.primeMaps e) = evalE (st (n + 1)).1 (st (n + 1)).2 e\n      ∧ evalE (A n) (AM n) e = evalE (st n).1 (st n).2 e)\n    (hstay : ∀ n, evalC (B n) (BM n) l.pend = true → evalC (A n) (AM n) (liveStayC l) = true)\n    (hcover : ∀ n, evalC (B n) (BM n) l.pend = true → evalC (A n) (AM n) (liveCoverC l) = true)\n    (hhelp : ∀ h ∈ l.helps, ∀ n, evalC (B n) (BM n) (liveHelpWhen l h) = true → evalC (A n) (AM n) (liveHelpThen l) = true)\n    (hreq : ∀ h ∈ l.helps, ∀ n, H h n → evalC (B n) (BM n) (reqC h.2) = true)\n    (henabled : ∀ h ∈ l.helps, ∀ n, evalC (st n).1 (st n).2 l.from_ = true → evalC (st n).1 (st n).2 l.to = false →\n      evalC (st n).1 (st n).2 h.1 = true → En h n)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → En h m) → ∃ m, n ≤ m ∧ H h m) :\n    ∀ n, evalC (st n).1 (st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (st m).1 (st m).2 l.to = true := by\n  have memF : l.from_ ∈ liveConds l := by simp [liveConds]\n  have memT : l.to ∈ liveConds l := by simp [liveConds]\n  have memH : ∀ h ∈ l.helps, h.1 ∈ liveConds l := fun h hh => by\n    simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inr ⟨h, hh, rfl⟩\n  have h1 : ∀ n, (l.rank.map (primeE l.prime l.primeMaps)).map (evalE (A n) (AM n)) = l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2) := by\n    intro n; rw [List.map_map]; exact List.map_congr_left (fun e he => (hE n e he).1)\n  have h2 : ∀ n, l.rank.map (evalE (A n) (AM n)) = l.rank.map (evalE (st n).1 (st n).2) := fun n =>\n    List.map_congr_left (fun e he => (hE n e he).2)\n  have hlex : ∀ n, evalC (A n) (AM n) (lexLtC (l.rank.map (primeE l.prime l.primeMaps)) l.rank)\n      = lexB (l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2)) (l.rank.map (evalE (st n).1 (st n).2)) := by\n    intro n; rw [lexLtC_eval, h1, h2]\n  have heqs : ∀ n, evalC (A n) (AM n) (eqsC (l.rank.map (primeE l.prime l.primeMaps)) l.rank) = true\n      ↔ l.rank.map (evalE (st (n + 1)).1 (st (n + 1)).2) = l.rank.map (evalE (st n).1 (st n).2) := by\n    intro n; rw [eqsC_eval _ _ _ _ (by simp), h1, h2]\n  have hpend : ∀ n, evalC (st n).1 (st n).2 l.from_ = true → ¬ evalC (st n).1 (st n).2 l.to = true → evalC (B n) (BM n) l.pend = true := by\n    intro n hP hnQ\n    simp only [Live.pend, evalC, Bool.and_eq_true, Bool.not_eq_true']\n    rw [(hC n _ memF).2.2, (hC n _ memT).2.2]; exact ⟨hP, by simpa using hnQ⟩\n  refine leads_of_lex (fun n => evalC (st n).1 (st n).2 l.from_ = true) (fun n => evalC (st n).1 (st n).2 l.to = true)\n    (fun n => l.rank.map (evalE (st n).1 (st n).2)) l.rank.length (fun n => by simp) l.helps\n    (fun h n => evalC (st n).1 (st n).2 h.1 = true) H En ?_ ?_ ?_ (fun h hh n hP hnQ hW => henabled h hh n hP (by simpa using hnQ) hW) fair\n  · intro n hP hnQ\n    have h := hstay n (hpend n hP hnQ)\n    simp only [liveStayC, evalC, Bool.and_eq_true, Bool.or_eq_true] at h\n    rw [(hC n _ memF).1, (hC n _ memT).1, hlex n, heqs n, keepC_eval] at h\n    refine ⟨h.1, ?_⟩\n    rcases h.2 with h2 | h2 | ⟨h2, h3⟩\n    · exact Or.inl h2\n    · exact Or.inr (Or.inl h2)\n    · refine Or.inr (Or.inr ⟨h2, fun hp hhp hW => ?_⟩)\n      have := h3 hp.1 (List.mem_map_of_mem hhp) (by rw [(hC n _ (memH hp hhp)).2.1]; exact hW)\n      rwa [(hC n _ (memH hp hhp)).1] at this\n  · intro n hP hnQ\n    have h := hcover n (hpend n hP hnQ)\n    rw [liveCoverC, anyC_eval] at h\n    obtain ⟨w, hw, hW⟩ := h\n    obtain ⟨hp, hhp, rfl⟩ := List.mem_map.mp hw\n    exact ⟨hp, hhp, by rw [← (hC n _ (memH hp hhp)).2.1]; exact hW⟩\n  · intro hp hhp n hP hnQ hW hH\n    have hB : evalC (B n) (BM n) (liveHelpWhen l hp) = true := by\n      have := hpend n hP hnQ\n      simp only [liveHelpWhen, evalC, Bool.and_eq_true]\n      rw [(hC n _ (memH hp hhp)).2.2]\n      exact ⟨this, hW, hreq hp hhp n hH⟩\n    have h := hhelp hp hhp n hB\n    simp only [liveHelpThen, evalC, Bool.or_eq_true] at h\n    rwa [(hC n _ memT).1, hlex n] at h\n\ntheorem assoc_distinct : ∀ {σ : List (Nat × E)}, distinct (σ.map (·.1)) = true → ∀ {p}, p ∈ σ → assoc σ p.1 = some p.2\n  | [], _, _, hp => by simp at hp\n  | a :: as, hd, p, hp => by\n    simp only [List.map_cons, distinct, Bool.and_eq_true, Bool.not_eq_true'] at hd\n    simp only [assoc, lookup]\n    rcases List.mem_cons.mp hp with rfl | hp\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he\n        have h1 : (as.map (·.1)).contains a.1 = true := List.contains_iff_mem.mpr (by rw [he]; exact List.mem_map_of_mem hp)\n        rw [hd.1] at h1; cases h1\n      simp only [hne, Bool.false_eq_true, if_false]\n      have := assoc_distinct hd.2 hp\n      simpa [assoc] using this\n\n/-! Machines with sets -/\n\n-- As for maps and flags, with the request's extended variables (inputs, quantified flags, witnesses) and the maps it\n-- carries read by no part of the liveness, and maps written at every key unprimed counted as written.\ndef sliveVars (s : SMachine) (l : Live) : List Nat :=\n  l.prime.map (·.2) ++ s.extVars ++ (flagVars s.f.flags ++ s.f.m.step.map (·.1)).filter (fun i => !(l.prime.map (·.1)).contains i)\ndef sliveMaps (s : SMachine) (l : Live) : List Nat :=\n  l.primeMaps.map (·.2) ++ s.carried ++ (s.f.m.writes.map (·.1) ++ s.every.map (·.1)).filter (fun mp => !(l.primeMaps.map (·.1)).contains mp)\ndef sliveOk (s : SMachine) (l : Live) : Bool :=\n  distinct (l.prime.map (·.2)) && distinct (l.primeMaps.map (·.2))\n    && (liveConds l).all (fun c => avoids (sliveVars s l) c && avoidsMaps (sliveMaps s l) c)\n    && l.helps.all (fun h => h.2.all (fun p => s.f.m.inputs.contains p.1 && avoids s.extVars (.eq p.2 p.2) && avoidsMaps s.carried (.eq p.2 p.2)))\n\n-- A step law over sets's proof: (law instances, quantified flag instances, fact instances, several-key instances, tree).\n-- A proof's instances (laws, quantified flags, facts, laws about several keys, facts about several keys) and its certificate.\nabbrev SProof := List (Nat × E) × List (Nat × List E) × List (Nat × E) × List (Nat × E × List E) × List (Nat × E × List E) × Cert\ndef sliveStep (l : Live) (w t : C) (p : SProof) : SKStep :=\n  ⟨⟨[w], t, [[]], l.prime, l.primeMaps, p.1, (p.2.2.2.2.2.1, p.2.2.2.2.2.2.2)⟩, [[]], p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2.1, p.2.2.2.2.2.2.1, []⟩\ndef sliveHelpsOk (s : SMachine) (ps : List SEntry) (l : Live) (hp : List SProof) : Bool :=\n  l.helps.length == hp.length && (l.helps.zip hp).all (fun x => checkSKStep s ps (sliveStep l (liveHelpWhen l x.1) (liveHelpThen l) x.2))\n\n-- A run of a machine with sets: each step a request (inputs, the maps it carries) the machine allows.\nstructure SRun (s : SMachine) where\n  st : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  req : Nat → SRequest\n  start : SReach s (st 0).1 (st 0).2\n  allowed : ∀ n, evalC (sView s (st n).1 (st n).2 (req n).1 (req n).2).1 (sView s (st n).1 (st n).2 (req n).1 (req n).2).2 s.f.m.assume = true\n  next : ∀ n, st (n + 1) = sNext s (st n).1 (st n).2 (req n).1 (req n).2\n\ntheorem srun_reach {s : SMachine} (run : SRun s) : ∀ n, SReach s (run.st n).1 (run.st n).2\n  | 0 => run.start\n  | n + 1 => by rw [run.next n]; exact SReach.step _ _ _ _ (srun_reach run n) (run.allowed n)\n\n-- A step law over sets of one step: every request allowed that `when` admits takes a step where `then` holds.\ntheorem skstep_one {s : SMachine} {ps : List SEntry} {l : Live} {w t : C} {p : SProof} (hl : checkSMachine s ps = true)\n    (hc : checkSKStep s ps (sliveStep l w t p) = true) : ∀ ρ M, SReach s ρ M → ∀ ι κ,\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true →\n      evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true →\n      evalC (primed l.prime (sNext s ρ M ι κ).1 (withExt s ρ (sReq s ρ M ι κ)))\n        (primedMaps l.primeMaps (sNext s ρ M ι κ).2 (withCarried s M κ)) t = true := by\n  intro ρ M hr ι κ hA hW\n  have h := skstep_sound s ps _ hl hc ρ M hr (ι, κ) [] rfl ⟨hA, hW, trivial⟩\n  simpa [sliveStep, sEnd, sExts, renEnv, renMaps, lookup] using h\n\n-- A step law over sets of one step, read as one step: every request allowed that `when` admits takes a step where `then`\n-- holds, its fresh names read as the step reads them.\ntheorem skstep_holds_one {s : SMachine} {sl : SKStep} {w : C} (h : SKStepHolds s sl) (hw : sl.k.whens = [w]) (hren : sl.k.ren = [[]])\n    (hmren : sl.mren = [[]]) : ∀ ρ M, SReach s ρ M → ∀ ι κ,\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true →\n      evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true →\n      evalC (primed sl.k.prime (sNext s ρ M ι κ).1 (withExt s ρ (sReq s ρ M ι κ)))\n        (primedMaps sl.k.primeMaps (sNext s ρ M ι κ).2 (withCarried s M κ)) sl.k.then_ = true := by\n  intro ρ M hr ι κ hA hW\n  have := h ρ M hr (ι, κ) [] (by simp [hw]) (by rw [hw]; exact ⟨hA, hW, trivial⟩)\n  rw [hren, hmren] at this\n  simpa [sEnd, sExts, renEnv, renMaps, lookup] using this\n\ntheorem decideQ_other {s : SMachine} {i : Nat} (h : i ∉ s.qVars) (X : Nat → Nat) (N : Nat → Nat → Nat) : decideQ s X N i = X i := by\n  simp only [decideQ]\n  rw [lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hq))]\n\ntheorem slive_reads {s : SMachine} {l : Live} (hok : sliveOk s l = true) {c : C} (hc : c ∈ liveConds l)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (∀ i, occC i c = true → i ∉ l.prime.map (·.2) ∧ (i ∈ l.prime.map (·.1) ∨ (sNext s ρ M ι κ).1 i = withExt s ρ (sReq s ρ M ι κ) i))\n      ∧ (∀ mp, occMC mp c = true → mp ∉ l.primeMaps.map (·.2) ∧ (mp ∈ l.primeMaps.map (·.1) ∨ (sNext s ρ M ι κ).2 mp = withCarried s M κ mp))\n      ∧ (∀ i, occC i c = true → withExt s ρ (sReq s ρ M ι κ) i = ρ i)\n      ∧ (∀ mp, occMC mp c = true → withCarried s M κ mp = M mp) := by\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok\n  have hv := hok.1.2 c hc\n  have noExt : ∀ i, occC i c = true → i ∉ s.extVars := fun i hi hm => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hext : ∀ i, occC i c = true → withExt s ρ (sReq s ρ M ι κ) i = ρ i := fun i hi => by\n    simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using noExt i hi)]\n  have noCar : ∀ mp, occMC mp c = true → mp ∉ s.carried := fun mp hmp hm => avoidsMaps_occ hv.2 hmp (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hcar : ∀ mp, occMC mp c = true → withCarried s M κ mp = M mp := fun mp hmp => by\n    simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using noCar mp hmp)]\n  refine ⟨fun i hi => ⟨fun h => avoids_occ hv.1 hi (List.mem_append_left _ (List.mem_append_left _ h)), ?_⟩,\n    fun mp hmp => ⟨fun h => avoidsMaps_occ hv.2 hmp (List.mem_append_left _ (List.mem_append_left _ h)), ?_⟩, hext, hcar⟩\n  · by_cases hp : i ∈ l.prime.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hn : i ∉ flagVars s.f.flags ++ s.f.m.step.map (·.1) := fun hm =>\n        avoids_occ hv.1 hi (List.mem_append_right _ (List.mem_filter.mpr ⟨hm, by simpa [List.contains_iff_mem] using hp⟩))\n      have hx := noExt i hi\n      simp only [SMachine.extVars, SMachine.qVars, List.mem_append, not_or] at hx\n      rw [hext i hi]\n      simp only [sNext, sView]\n      rw [applyS_other (fun h => hn (List.mem_append_right _ h)), decide_other (fun h => hn (List.mem_append_left _ h)),\n        decideQ_other (by simpa [SMachine.qVars] using hx.1.2), withInputs_other hx.1.1]\n  · by_cases hp : mp ∈ l.primeMaps.map (·.1)\n    · exact Or.inl hp\n    · right\n      have hw : mp ∉ s.f.m.writes.map (·.1) ++ s.every.map (·.1) := fun hm =>\n        avoidsMaps_occ hv.2 hmp (List.mem_append_right _ (List.mem_filter.mpr ⟨hm, by simpa [List.contains_iff_mem] using hp⟩))\n      funext k\n      simp only [sNext, everyMaps]\n      rw [lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro he; exact hw (List.mem_append_right _ (by rw [← he]; exact List.mem_map_of_mem hw')))]\n      simp only [writeMaps]\n      rw [lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro he; exact hw (List.mem_append_left _ (by rw [← he]; exact List.mem_map_of_mem hw')))]\n      rfl\n\n/-- Liveness under fairness: if the laws' proof checks, the liveness reads what it may (`sliveOk`), and the step laws Lean\nbuilds from it check, then along every run that takes each helpful request (its named inputs as its terms; the rest,\nand the maps it carries, free) infinitely often, each state where `from` holds is followed by one where `to` holds. -/\ntheorem sleads_sound (s : SMachine) (ps : List SEntry) (l : Live) (sp cp : SProof) (hp : List SProof)\n    (hl : checkSMachine s ps = true) (hok : sliveOk s l = true)\n    (hs : checkSKStep s ps (sliveStep l l.pend (liveStayC l) sp) = true) (hc : checkSKStep s ps (sliveStep l l.pend (liveCoverC l) cp) = true)\n    (hh : sliveHelpsOk s ps l hp = true) (run : SRun s)\n    (fair : ∀ h ∈ l.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :\n    ∀ n, evalC (run.st n).1 (run.st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 l.to = true := by\n  have hok0 := hok\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨⟨⟨hd1, hd2⟩, _⟩, hreqs⟩ := hok0\n  simp only [sliveHelpsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hh\n  obtain ⟨hlen, hall⟩ := hh\n  refine leads_view l run.st (fun n => withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2))\n    (fun n => primed l.prime (run.st (n + 1)).1 (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)))\n    (fun n => withCarried s (run.st n).2 (run.req n).2) (fun n => primedMaps l.primeMaps (run.st (n + 1)).2 (withCarried s (run.st n).2 (run.req n).2))\n    (fun h n => ∀ p ∈ h.2, (run.req n).1 p.1 = evalE (run.st n).1 (run.st n).2 p.2) (fun _ _ => True) ?_ ?_ ?_ ?_ ?_ ?_\n    (fun _ _ _ _ _ _ => trivial) (fun h hh n _ => fair h hh n)\n  · intro n c hc\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok hc (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_C hd1 hd2 hv hm hx hn\n  · intro n e he\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok (mem_conds_rank he) (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_E hd1 hd2 hv hm hx hn\n  · intro n hB\n    have := skstep_one hl hs _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_one hl hc _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    obtain ⟨pp, hpp⟩ := zip_cover l.helps hp hlen h hmem\n    have := skstep_one hl (hall _ hpp) _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hH\n    show evalC (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) (reqC h.2) = true\n    rw [reqC_eval]\n    intro p hp'\n    have hq := hreqs h hmem p hp'\n    obtain ⟨⟨hin, hav⟩, havm⟩ := hq\n    have hext : s.extVars.contains p.1 = true := by\n      simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inl (Or.inl (List.contains_iff_mem.mp hin))\n    have hl1 : withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2) p.1 = (run.req n).1 p.1 := by\n      simp only [withExt, hext, if_true, sReq, hin]\n    have hr1 : evalE (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) p.2\n        = evalE (run.st n).1 (run.st n).2 p.2 := by\n      rw [congrME _ _ (run.st n).2 p.2 (fun mp hmp => by\n        simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using avoidsMaps_occ havm (by simp [occMC, hmp]))])]\n      exact congrE _ _ _ p.2 (fun i hi => by\n        simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using avoids_occ hav (by simp [occC, hi]))])\n    rw [hl1, hr1]; exact hH p hp'\n\n/-! Weak fairness over sets -/\n\n-- A request whose inputs named in a list are the list's terms meets the list's condition, in the goal's view.\ntheorem sreq_list {s : SMachine} {ps' : List (Nat × E)}\n    (hc : ∀ p ∈ ps', (s.f.m.inputs.contains p.1 = true ∧ avoids s.extVars (.eq p.2 p.2) = true) ∧ avoidsMaps s.carried (.eq p.2 p.2) = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι : Nat → Nat} {κ : Nat → Nat → Nat} (hH : ∀ p ∈ ps', ι p.1 = evalE ρ M p.2) :\n    evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) (reqC ps') = true := by\n  rw [reqC_eval]\n  intro p hp'\n  obtain ⟨⟨hin, hav⟩, havm⟩ := hc p hp'\n  have hext : s.extVars.contains p.1 = true := by\n    simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inl (Or.inl (List.contains_iff_mem.mp hin))\n  have hl1 : withExt s ρ (sReq s ρ M ι κ) p.1 = ι p.1 := by simp only [withExt, hext, if_true, sReq, hin]\n  have hr1 : evalE (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) p.2 = evalE ρ M p.2 := by\n    rw [congrME _ _ M p.2 (fun mp hmp => by\n      simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using avoidsMaps_occ havm (by simp [occMC, hmp]))])]\n    exact congrE _ _ _ p.2 (fun i hi => by\n      simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using avoids_occ hav (by simp [occC, hi]))])\n  rw [hl1, hr1]; exact hH p hp'\n\ntheorem sreq_holds {s : SMachine} {l : Live} (hok : sliveOk s l = true) {h : C × List (Nat × E)} (hmem : h ∈ l.helps)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι : Nat → Nat} {κ : Nat → Nat → Nat} (hH : ∀ p ∈ h.2, ι p.1 = evalE ρ M p.2) :\n    evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) (reqC h.2) = true := by\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok\n  exact sreq_list (fun p hp' => hok.2 h hmem p hp') hH\n\n-- A helpful request allowed in its region, carrying empty sets: the precondition, the facts, the laws, `when`, each\n-- quantified flag closed, and the carried maps empty at the keys the proof names refute the assumption's failing. The\n-- facts read no request's variable or map.\ndef zeroHyps (s : SMachine) (zkeys : List E) : List C := s.carried.flatMap fun mp => zkeys.map fun t => .eq (.get mp t) (.const 0)\ndef sAllowGoal (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E) : List C :=\n  [s.f.m.pre] ++ factHyps s p.2.2.1 p.2.2.2.2.1 ++ (scalarHyps (sLaws ps p.2.2.2.1) ++ instHyps (sLaws ps p.2.2.2.1) (sInsts ps p.1 p.2.2.2.1))\n    ++ [w] ++ closingHyps s p.2.1 ++ zeroHyps s zkeys ++ [.not (inlineC s.f.flags s.f.m.assume)]\ndef checkSAllow (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E) : Bool :=\n  s.facts.all (fun l => avoids s.extVars l.holds && avoidsMaps s.carried l.holds)\n    && checkIn (sAllowGoal s ps w p zkeys) p.2.2.2.2.2\n\n-- The request carrying empty sets.\ndef noSets : Nat → Nat → Nat := fun _ _ => 0\n\ntheorem sallow_sound (s : SMachine) (ps : List SEntry) (w : C) (p : SProof) (zkeys : List E)\n    (hl : checkSMachine s ps = true) (hc : checkSAllow s ps w p zkeys = true) :\n    ∀ ρ M, SReach s ρ M → ∀ ι, evalC (withExt s ρ (sReq s ρ M ι noSets)) (withCarried s M noSets) w = true →\n      evalC (sView s ρ M ι noSets).1 (sView s ρ M ι noSets).2 s.f.m.assume = true := by\n  intro ρ M hr ι hw\n  simp only [checkSAllow, Bool.and_eq_true, List.all_eq_true] at hc\n  obtain ⟨hfa, hgoal⟩ := hc\n  have hs := sOk_of hl\n  obtain ⟨hpreS, hrp⟩ := spre_parts hl\n  let W := withExt s ρ (sReq s ρ M ι noSets)\n  let M0 := withCarried s M noSets\n  have hWo : ∀ v, v ∉ s.extVars → W v = ρ v := fun v hv => by\n    simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hv)]\n  have hMo : ∀ mp, mp ∉ s.carried → M0 mp = M mp := fun mp hmp => by\n    simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]\n  -- Every entry, and each pair's, holds in the goal's view of the state.\n  have hall : ∀ e ∈ ps, e.Holds W M0 := fun e he =>\n    sentry_transfer (slaws_avoid hl e.law (List.mem_map_of_mem he)).1 (slaws_avoid hl e.law (List.mem_map_of_mem he)).2\n      (fun i hi => by simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hi)])\n      (fun mp hmp => by simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)])\n      (smachine_sound s ps hl ρ M hr e he)\n  have hlY : ∀ l ∈ sLaws ps p.2.2.2.1, l.Holds W M0 := fun l hl' => by\n    rcases List.mem_append.mp hl' with hl' | hl'\n    · obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl'; exact SEntry.holds_law (hall e' he')\n    · exact pairLaws_hold ps p.2.2.2.1 (skeys_apart hl) hall l hl'\n  have hfacts : ∀ l ∈ s.facts, l.Holds W M0 := fun l hl' => by\n    have h := hfa l hl'\n    exact holds_transfer l h.1 h.2 (fun i hi => hWo i hi) (fun mp hmp => hMo mp hmp) (facts_sreach s (sfacts_ok hl) hr l hl')\n  apply Decidable.byContradiction; intro hn\n  apply sound_in _ _ hgoal W M0\n  intro c hc\n  simp only [sAllowGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with (((((rfl | hc) | hc) | rfl) | hc) | hc) | rfl\n  · rw [noReadsC W M0 M s.f.m.pre hrp, congrC W ρ M s.f.m.pre (fun j hj => hWo j (fun h' =>\n      avoids_occ hpreS hj (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h')))))]\n    exact pre_sreach s hpreS hrp hr\n  · -- The facts about several keys, as the reachable state has them: they read no request and no carried map.\n    have hpf : s.PFacts W M0 := fun f hf' =>\n      holdsOver_transfer f.1 (pfactsOk_parts (sfacts_ok hl) f hf').1 (pfactsOk_parts (sfacts_ok hl) f hf').2.1 f.2\n        (fun i hi => hWo i (fun h' => hi (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h')))))\n        (fun mp hmp => hMo mp (fun h' => hmp (List.mem_append_left _ (List.mem_append_left _ h'))))\n        (pfacts_sreach s (sfacts_ok hl) hr f hf')\n    exact facthyps_true s p.2.2.1 p.2.2.2.2.1 W M0 (fun f hf' => (pfactsOk_parts (sfacts_ok hl) f hf').2.2) hfacts hpf c hc\n  · exact laws_hyps_true _ _ W M0 hlY c (List.mem_append.mpr hc)\n  · exact hw\n  · exact closing_true s ρ M ι noSets hs p.2.1 c hc\n  · simp only [zeroHyps, List.mem_flatMap, List.mem_map] at hc\n    obtain ⟨mp, hmp, t, _, rfl⟩ := hc\n    simp only [evalC, evalE, M0, withCarried, List.contains_iff_mem.mpr hmp, if_true, noSets, decide_eq_true_eq]\n  · -- The assumption, inlined: the view decides the plain flags as the step does, away from the witnesses.\n    simp only [evalC, Bool.not_eq_true']\n    rw [inline_evalC]\n    have hagD := decide_agree_on (sOk_parts s hs).2.2.2.2.2.2 (withCarried s M noSets) (view_agree s ρ M ι noSets hs)\n    rw [congrC _ (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M noSets)) (withCarried s M noSets)) _ s.f.m.assume\n      (fun i hi => (hagD i (fun h => by\n        have hpa : avoids s.wVars s.f.m.assume = true := by simp only [sOk, Bool.and_eq_true] at hs; exact hs.2\n        exact avoids_occ hpa hi h)).symm)]\n    have hf : evalC (sView s ρ M ι noSets).1 (sView s ρ M ι noSets).2 s.f.m.assume = false := by simpa using hn\n    exact hf\n\ndef sliveAllowsOk (s : SMachine) (ps : List SEntry) (l : Live) (ap : List (List (Nat × E) × SProof × List E)) : Bool :=\n  l.helps.length == ap.length\n    && (l.helps.zip ap).all (fun x => distinct ((x.1.2 ++ x.2.1).map (·.1))\n      && x.2.1.all (fun p => s.f.m.inputs.contains p.1 && avoids s.extVars (.eq p.2 p.2) && avoidsMaps s.carried (.eq p.2 p.2))\n      && checkSAllow s ps (.and (liveHelpWhen l x.1) (reqC x.2.1)) x.2.2.1 x.2.2.2)\n\n/-- Liveness under weak fairness, for machines with sets: as `sleads_sound`, with each helpful request also proven\nallowed in its region carrying empty sets (`sliveAllowsOk`); then along every run that takes each helpful request\nwhenever, from some point on, it stays allowed (some request with its named inputs as its terms, carrying some sets, is a\nstep the machine allows), each state where `from` holds is followed by one where `to` holds. -/\ntheorem sleads_wf_sound (s : SMachine) (ps : List SEntry) (l : Live) (sp cp : SProof) (hp : List SProof) (ap : List (List (Nat × E) × SProof × List E))\n    (hl : checkSMachine s ps = true) (hok : sliveOk s l = true)\n    (hs : checkSKStep s ps (sliveStep l l.pend (liveStayC l) sp) = true) (hc : checkSKStep s ps (sliveStep l l.pend (liveCoverC l) cp) = true)\n    (hh : sliveHelpsOk s ps l hp = true) (ha : sliveAllowsOk s ps l ap = true) (run : SRun s)\n    (fair : ∀ h ∈ l.helps, ∀ n, (∀ m, n ≤ m → ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (sView s (run.st m).1 (run.st m).2 ι κ).1 (sView s (run.st m).1 (run.st m).2 ι κ).2 s.f.m.assume = true) →\n      ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :\n    ∀ n, evalC (run.st n).1 (run.st n).2 l.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 l.to = true := by\n  have hok0 := hok\n  simp only [sliveOk, Bool.and_eq_true, List.all_eq_true] at hok0\n  obtain ⟨⟨⟨hd1, hd2⟩, _⟩, hreqs⟩ := hok0\n  simp only [sliveHelpsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hh\n  obtain ⟨hlen, hall⟩ := hh\n  simp only [sliveAllowsOk, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at ha\n  obtain ⟨halen, haall⟩ := ha\n  refine leads_view l run.st (fun n => withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2))\n    (fun n => primed l.prime (run.st (n + 1)).1 (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)))\n    (fun n => withCarried s (run.st n).2 (run.req n).2) (fun n => primedMaps l.primeMaps (run.st (n + 1)).2 (withCarried s (run.st n).2 (run.req n).2))\n    (fun h n => ∀ p ∈ h.2, (run.req n).1 p.1 = evalE (run.st n).1 (run.st n).2 p.2)\n    (fun h m => ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)\n        ∧ evalC (sView s (run.st m).1 (run.st m).2 ι κ).1 (sView s (run.st m).1 (run.st m).2 ι κ).2 s.f.m.assume = true) ?_ ?_ ?_ ?_ ?_ ?_ ?_ fair\n  · intro n c hc\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok hc (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_C hd1 hd2 hv hm hx hn\n  · intro n e he\n    obtain ⟨hv, hm, hx, hn⟩ := slive_reads hok (mem_conds_rank he) (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    exact view_E hd1 hd2 hv hm hx hn\n  · intro n hB\n    have := skstep_one hl hs _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_one hl hc _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    obtain ⟨pp, hpp⟩ := zip_cover l.helps hp hlen h hmem\n    have := skstep_one hl (hall _ hpp) _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hH\n    show evalC (withExt s (run.st n).1 (sReq s (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2)) (withCarried s (run.st n).2 (run.req n).2) (reqC h.2) = true\n    exact sreq_holds hok hmem (fun p hp' => hH p hp')\n  · -- Enabled in its region: the request with its named inputs as its terms, the rest as the state has them, carrying\n    -- empty sets.\n    intro h hmem n hP hnQ hW\n    obtain ⟨x, hx⟩ := zip_cover l.helps ap halen h hmem\n    obtain ⟨⟨hdist, hwit⟩, hpc⟩ := haall _ hx\n    let ρ := (run.st n).1\n    let M := (run.st n).2\n    let ι := applyS (h.2 ++ x.1) ρ M\n    have hιp : ∀ p ∈ h.2, ι p.1 = evalE ρ M p.2 := fun p hp' => by\n      simp only [ι, applyS, assoc_distinct hdist (List.mem_append_left _ hp')]\n    have hιw : ∀ p ∈ x.1, ι p.1 = evalE ρ M p.2 := fun p hp' => by\n      simp only [ι, applyS, assoc_distinct hdist (List.mem_append_right _ hp')]\n    have hX : ∀ c ∈ liveConds l, evalC (withExt s ρ (sReq s ρ M ι noSets)) (withCarried s M noSets) c = evalC ρ M c := fun c hc' => by\n      obtain ⟨_, _, hx', hn'⟩ := slive_reads hok hc' ρ M ι noSets\n      rw [congrMC _ _ M c hn']; exact congrC _ _ M c hx'\n    have memF : l.from_ ∈ liveConds l := by simp [liveConds]\n    have memT : l.to ∈ liveConds l := by simp [liveConds]\n    have memH : h.1 ∈ liveConds l := by simp only [liveConds, List.mem_append, List.mem_map]; exact Or.inr ⟨h, hmem, rfl⟩\n    refine ⟨ι, noSets, hιp, sallow_sound s ps _ x.2.1 x.2.2 hl hpc ρ M (srun_reach run n) ι ?_⟩\n    simp only [liveHelpWhen, Live.pend, evalC, Bool.and_eq_true, Bool.not_eq_true']\n    rw [hX _ memF, hX _ memT, hX _ memH]\n    exact ⟨⟨⟨hP, hnQ⟩, hW, sreq_holds hok hmem hιp⟩, sreq_list (fun p hp' => hwit p hp') hιw⟩\n\n/-! Loops, as machines -/\n\n-- A loop as a machine with sets (none of them): the loop's state, inputs, precondition and assumption, its body taken\n-- where the guard holds and the state kept where it doesn't. That it halts is a liveness claim: every request helps,\n-- `to` is the guard failing, and the loop's ranks drop.\ndef Loop.machine (l : Loop) : SMachine :=\n  ⟨⟨⟨l.inputs, l.init, [], l.body.map (fun p => (p.1, E.ite l.guard p.2 (.var p.1))), [], l.pre, l.assume⟩, []⟩, [], [], [], [], [], []⟩\n\ntheorem assoc_guarded (g : C) (i : Nat) : ∀ body : List (Nat × E),\n    assoc (body.map fun p => (p.1, E.ite g p.2 (.var p.1))) i = (assoc body i).map fun e => E.ite g e (.var i)\n  | [] => rfl\n  | p :: ps => by\n    simp only [List.map_cons, assoc, lookup] at ⊢\n    by_cases h : (p.1 == i) = true\n    · have hp : p.1 = i := beq_iff_eq.mp h\n      simp only [h, ite_true, Option.map_some]; rw [hp]\n    · simp only [h, Bool.false_eq_true, ite_false]\n      have := assoc_guarded g i ps\n      simp only [assoc] at this; exact this\n\n-- The loop's machine reads a request as the loop does: its inputs set, nothing decided, no map carried.\ntheorem sView_loop (l : Loop) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sView l.machine ρ M ι κ = (withInputs l.inputs ρ ι, M) := by\n  have hc : withCarried l.machine M κ = M := by funext mp; simp [withCarried, Loop.machine]\n  have hq : decideQ l.machine (withInputs l.inputs ρ ι) M = withInputs l.inputs ρ ι := by funext v; simp [decideQ, Loop.machine, lookup]\n  simp only [sView, hc]\n  show (decideFlags [] (decideQ l.machine (withInputs l.inputs ρ ι) M) M, M) = _\n  rw [hq]; simp [decideFlags, flagSub, applyS_nil']\n\n-- Where the guard holds, a step of the loop's machine is a turn of the loop, and leaves the maps.\ntheorem sNext_loop (l : Loop) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n    (hg : evalC (withInputs l.inputs ρ ι) M l.guard = true) :\n    sNext l.machine ρ M ι κ = (applyS l.body (withInputs l.inputs ρ ι) M, M) := by\n  simp only [sNext, sView_loop]\n  refine Prod.ext ?_ ?_\n  · funext i\n    show applyS (l.body.map fun p => (p.1, E.ite l.guard p.2 (.var p.1))) (withInputs l.inputs ρ ι) M i = _\n    simp only [applyS, assoc_guarded]\n    cases assoc l.body i with\n    | none => rfl\n    | some e => simp [evalE, hg]\n  · funext mp key; simp [everyMaps, Loop.machine, lookup, writeMaps]\n\n/-- A loop halts: if the loop's machine reaches the guard failing from anywhere, along every run whose helpful requests\n(here naming no input, so every run's) recur, then for params meeting the precondition no run of turns is infinite. -/\ntheorem loop_halts_of (l : Loop) (lv : Live) (hfrom : lv.from_ = trueC) (hto : lv.to = .not l.guard) (hhelps : ∀ h ∈ lv.helps, h.2 = [])\n    (hguard : avoids l.inputs l.guard = true)\n    (hlive : ∀ run : SRun l.machine, (∀ h ∈ lv.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) →\n      ∀ n, evalC (run.st n).1 (run.st n).2 lv.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 lv.to = true)\n    (maps : Nat → Nat → Nat) (ρ0 : Nat → Nat) (h0 : evalC ρ0 maps l.pre = true) :\n    ¬ ∃ f : Nat → Nat → Nat, f 0 = applyS l.init ρ0 maps ∧ ∀ n, Turn l maps (f n) (f (n + 1)) := by\n  rintro ⟨f, hf0, hf⟩\n  let ι := fun n => Classical.choose (hf n)\n  have hg : ∀ n, evalC (withInputs l.inputs (f n) (ι n)) maps l.guard = true := fun n => (Classical.choose_spec (hf n)).1\n  have ha : ∀ n, evalC (withInputs l.inputs (f n) (ι n)) maps l.assume = true := fun n => (Classical.choose_spec (hf n)).2.1\n  have hnext : ∀ n, f (n + 1) = applyS l.body (withInputs l.inputs (f n) (ι n)) maps := fun n => (Classical.choose_spec (hf n)).2.2\n  let run : SRun l.machine := {\n    st := fun n => (f n, maps)\n    req := fun n => (ι n, fun _ _ => 0)\n    start := by\n      show SReach l.machine (f 0) maps\n      rw [hf0]\n      exact SReach.start (s := l.machine) ρ0 maps (fun p hp => by simp [Loop.machine] at hp) h0 (fun l' hl' => by simp [Loop.machine] at hl') (fun p hp => by simp [Loop.machine] at hp)\n    allowed := fun n => by\n      show evalC (sView l.machine (f n) maps (ι n) _).1 (sView l.machine (f n) maps (ι n) _).2 l.assume = true\n      rw [sView_loop]; exact ha n\n    next := fun n => by\n      show (f (n + 1), maps) = sNext l.machine (f n) maps (ι n) _\n      rw [sNext_loop l _ _ _ _ (hg n), hnext n] }\n  obtain ⟨m, _, hm⟩ := hlive run (fun h hh n => ⟨n, Nat.le_refl n, by simp [hhelps h hh]⟩) 0 (by rw [hfrom]; simp [trueC, evalC, evalE])\n  rw [hto] at hm\n  have hgm := hg m\n  rw [congrC (withInputs l.inputs (f m) (ι m)) (f m) maps l.guard (fun i hi => withInputs_other (avoids_occ hguard hi) _ _)] at hgm\n  simp only [evalC, Bool.not_eq_true'] at hm\n  show False\n  have : evalC (run.st m).1 (run.st m).2 l.guard = true := hgm\n  rw [this] at hm; exact Bool.noConfusion hm\n\nend Kern\n\n#print axioms Kern.sleads_sound\n#print axioms Kern.sleads_wf_sound\n#print axioms Kern.loop_halts_of\n",
     "Ghost.lean": "import Live\n\n/-!\nWhat a ghost means, proven: compose.ts's `ghost(m, vars)` adds state that watches a machine without changing it. Lean\nchecks that a ghosted machine is the original's parts plus each ghost's start and step, read by no part of the original\n(`sghostOk`), and proves, for machines with maps, flags and sets:\n- `sghost_reach`: every reachable state of the original is, outside the ghosts, a reachable state of the ghosted\n  machine, so a law of the ghosted machine that reads no ghost is a law of the original (`sghost_laws`);\n- `sghost_run`: every run of the original is, outside the ghosts, a run of the ghosted machine taking the same requests;\n- `sever_meaning`: along a run, a ghost that starts at 0 and is set to 1 by a step where `c` holds (compose.ts's `ever`)\n  is 1 exactly when some step before took a request where `c` held.\n-/\n\nnamespace Kern\nopen Classical\n\ntheorem lookup_unique_fst {p : Nat × E} {l : List (Nat × E)} (hd : distinct (l.map (·.1)) = true) (hp : p ∈ l) :\n    lookup (fun q => q.1 == p.1) l = some p := by\n  induction l with\n  | nil => simp at hp\n  | cons a as ih =>\n    simp only [List.map_cons] at hd\n    obtain ⟨hna, hd'⟩ := distinct_cons hd\n    simp only [lookup]\n    rcases List.mem_cons.mp hp with rfl | hp'\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hna (by rw [he]; exact List.mem_map_of_mem hp')\n      simp only [hne, Bool.false_eq_true, ite_false]; exact ih hd' hp'\n\ntheorem assoc_append_none {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ τ.map (·.1)) : assoc (σ ++ τ) i = assoc σ i := by\n  have hτ : lookup (fun p => p.1 == i) τ = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [assoc, lookup_append]\n  cases hσ : lookup (fun p => p.1 == i) σ <;> simp [hτ]\n\ntheorem applyS_append_other {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ τ.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS (σ ++ τ) ρ M i = applyS σ ρ M i := by\n  simp only [applyS, assoc_append_none h]\n\n-- The keys a machine's every-key writes and quantified flags bind.\ndef bkeys (s : SMachine) : List Nat := s.every.map (·.2.1) ++ s.qflags.flatMap (·.2.1)\n\n-- A flag that holds at every value of its keys, decided over states that agree where its body reads (its keys aside), is\n-- decided alike.\ntheorem ite_all_congr {X X' : Nat → Nat} {N N' : Nat → Nat → Nat} {ks : List Nat} {c : C}\n    (hv : ∀ i, occC i c = true → i ∉ ks → X i = X' i) (hm : ∀ mp, occMC mp c = true → N mp = N' mp) :\n    (if ∀ k, holdsC (atKeys X ks k) N c then 1 else 0) = (if ∀ k, holdsC (atKeys X' ks k) N' c then 1 else 0) := by\n  have h : (∀ k, holdsC (atKeys X ks k) N c) ↔ (∀ k, holdsC (atKeys X' ks k) N' c) := by\n    apply forall_congr'; intro k\n    rw [← evalC_iff, ← evalC_iff, congrMC _ N N' c hm]\n    rw [congrC (atKeys X ks k) (atKeys X' ks k) N' c (fun i hi => by\n      by_cases hik : i ∈ ks\n      · rw [atKeys_in hik, atKeys_in hik]\n      · rw [atKeys_out hik, atKeys_out hik]; exact hv i hi hik)]\n  simp only [h]\n\ntheorem decideQ_of (s : SMachine) (X : Nat → Nat) (N : Nat → Nat → Nat) (v : Nat) :\n    decideQ s X N v = match lookup (fun q => q.1 == v) s.qflags with\n      | some q => if ∀ k, holdsC (atKeys X q.2.1 k) N q.2.2 then 1 else 0\n      | none => X v := rfl\n\ntheorem upd_agree {V : List Nat} {X X' : Nat → Nat} (h : Agree V X X') (k v : Nat) : Agree V (upd X k v) (upd X' k v) := fun i hi => by\n  simp only [upd]; split\n  · rfl\n  · exact h i hi\n\n/-! Ghosts -/\n\nstructure SGhosted where\n  orig : SMachine\n  ghosts : List (Nat × E × E)   -- (variable, start over the params, step over the state before, the request and flags)\n\ndef SGhosted.vars (g : SGhosted) : List Nat := g.ghosts.map (·.1)\n\n-- The ghosted machine: the original, each ghost's start and step added.\ndef SGhosted.full (g : SGhosted) : SMachine :=\n  ⟨⟨⟨g.orig.f.m.inputs, g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1)), g.orig.f.m.maps0,\n      g.orig.f.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2)), g.orig.f.m.writes, g.orig.f.m.pre, g.orig.f.m.assume⟩, g.orig.f.flags⟩,\n    g.orig.carried, g.orig.every, g.orig.qflags, g.orig.wits, g.orig.facts, g.orig.pfacts⟩\n\n-- The ghosts are new names, and nothing of the original reads them.\ndef sghostOk (g : SGhosted) : Bool :=\n  distinct g.vars\n    && g.vars.all (fun v => !(g.orig.extVars ++ g.orig.f.m.init.map (·.1) ++ g.orig.f.m.step.map (·.1) ++ flagVars g.orig.f.flags ++ bkeys g.orig).contains v)\n    && avoids g.vars g.orig.f.m.pre && avoids g.vars g.orig.f.m.assume && g.orig.f.flags.all (fun p => avoids g.vars p.2)\n    && g.orig.f.m.step.all (fun p => avoidsE g.vars p.2) && g.orig.f.m.init.all (fun p => avoidsE g.vars p.2)\n    && g.orig.f.m.writes.all (fun w => avoidsE g.vars w.2.1 && avoidsE g.vars w.2.2)\n    && g.orig.every.all (fun w => avoidsE g.vars w.2.2) && g.orig.qflags.all (fun q => avoids g.vars q.2.2)\n    && g.orig.facts.all (fun l => avoids g.vars l.holds)\n\n-- The ghosted machine reads requests and decides flags as the original does.\ntheorem sview_full (g : SGhosted) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sView g.full ρ M ι κ = sView g.orig ρ M ι κ := rfl\n\n-- A run of the original lifted to the ghosted machine from a ghosted state s0 that agrees with its first: the ghosts\n-- move with each request the run takes.\nnoncomputable def sghostFrom (g : SGhosted) (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) : Nat → (Nat → Nat) × (Nat → Nat → Nat)\n  | 0 => s0\n  | n + 1 => sNext g.full (sghostFrom g run s0 n).1 (sghostFrom g run s0 n).2 (run.req n).1 (run.req n).2\n\nsection sghost\nvariable (g : SGhosted) (hg : sghostOk g = true)\ninclude hg\n\ntheorem sghostOk_parts :\n    distinct g.vars = true\n      ∧ (∀ v ∈ g.vars, v ∉ g.orig.extVars ++ g.orig.f.m.init.map (·.1) ++ g.orig.f.m.step.map (·.1) ++ flagVars g.orig.f.flags ++ bkeys g.orig)\n      ∧ avoids g.vars g.orig.f.m.pre = true ∧ avoids g.vars g.orig.f.m.assume = true ∧ (∀ p ∈ g.orig.f.flags, avoids g.vars p.2 = true)\n      ∧ (∀ p ∈ g.orig.f.m.step, avoidsE g.vars p.2 = true) ∧ (∀ p ∈ g.orig.f.m.init, avoidsE g.vars p.2 = true)\n      ∧ (∀ w ∈ g.orig.f.m.writes, avoidsE g.vars w.2.1 = true ∧ avoidsE g.vars w.2.2 = true)\n      ∧ (∀ w ∈ g.orig.every, avoidsE g.vars w.2.2 = true) ∧ (∀ q ∈ g.orig.qflags, avoids g.vars q.2.2 = true)\n      ∧ (∀ l ∈ g.orig.facts, avoids g.vars l.holds = true) := by\n  simp only [sghostOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at hg\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hd, hn⟩, hp⟩, ha⟩, hf⟩, hs⟩, hi⟩, hw⟩, he⟩, hq⟩, hfa⟩ := hg\n  exact ⟨hd, fun v hv h => (by have := hn v hv; rw [List.contains_iff_mem.mpr h] at this; cases this), hp, ha, hf, hs, hi, hw, he, hq, hfa⟩\n\n-- One step from states that agree outside the ghosts, with the same request: allowed alike, and to states that agree\n-- outside the ghosts, with the same maps.\ntheorem sghost_step {ρ ρg : Nat → Nat} (hag : Agree g.vars ρg ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    evalC (sView g.full ρg M ι κ).1 (sView g.full ρg M ι κ).2 g.full.f.m.assume = evalC (sView g.orig ρ M ι κ).1 (sView g.orig ρ M ι κ).2 g.orig.f.m.assume\n      ∧ Agree g.vars (sNext g.full ρg M ι κ).1 (sNext g.orig ρ M ι κ).1\n      ∧ (sNext g.full ρg M ι κ).2 = (sNext g.orig ρ M ι κ).2 := by\n  obtain ⟨_, _, _, ha, hf, hs, _, hw, he, hq, _⟩ := sghostOk_parts g hg\n  have hX : Agree g.vars (withInputs g.orig.f.m.inputs ρg ι) (withInputs g.orig.f.m.inputs ρ ι) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  have hQ : Agree g.vars (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ))\n      (decideQ g.orig (withInputs g.orig.f.m.inputs ρ ι) (withCarried g.orig M κ)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of]\n    cases hl : lookup (fun q => q.1 == v) g.orig.qflags with\n    | some q => exact ite_all_congr (fun i hi _ => hX i (avoids_occ (hq q (lookup_some hl).1) hi)) (fun _ _ => rfl)\n    | none => exact hX v hv\n  have hD := decide_agree_on hf (withCarried g.orig M κ) hQ\n  refine ⟨?_, fun i hi => ?_, ?_⟩\n  · show evalC (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) _ g.orig.f.m.assume = _\n    exact congrC _ _ _ _ (fun i hi => hD i (avoids_occ ha hi))\n  · show applyS (g.orig.f.m.step ++ g.ghosts.map (fun x => (x.1, x.2.2))) (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) i = _\n    rw [applyS_append_other (by simpa [SGhosted.vars] using hi)]\n    simp only [sNext, sView, applyS]\n    cases hst : assoc g.orig.f.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ g.orig.f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq', rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq'\n        simp only [beq_iff_eq] at hqv\n        rw [← hqv]; exact hqm\n      exact congrE _ _ _ e (fun j hj => hD j (avoidsE_occ (hs (i, e) hm) hj))\n  · funext mp key\n    show everyMaps g.orig (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρg ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) mp key\n      = everyMaps g.orig (decideFlags g.orig.f.flags (decideQ g.orig (withInputs g.orig.f.m.inputs ρ ι) (withCarried g.orig M κ)) (withCarried g.orig M κ)) (withCarried g.orig M κ) mp key\n    simp only [everyMaps]\n    cases hl : lookup (fun w => w.1 == mp) g.orig.every with\n    | some w => exact congrE _ _ _ w.2.2 (fun j hj => upd_agree hD w.2.1 key j (avoidsE_occ (he w (lookup_some hl).1) hj))\n    | none =>\n      simp only [writeMaps]\n      cases hl2 : lookup (fun w => w.1 == mp) g.orig.f.m.writes with\n      | none => rfl\n      | some w =>\n        obtain ⟨h1, h2⟩ := hw w (lookup_some hl2).1\n        simp only [congrE _ _ _ w.2.1 (fun j hj => hD j (avoidsE_occ h1 hj)), congrE _ _ _ w.2.2 (fun j hj => hD j (avoidsE_occ h2 hj))]\n\n/-- Every reachable state of the original is, outside the ghosts, a reachable state of the ghosted machine. -/\ntheorem sghost_reach : ∀ {ρ M}, SReach g.orig ρ M → ∃ ρg, SReach g.full ρg M ∧ Agree g.vars ρg ρ := by\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 hfa hpf =>\n    refine ⟨applyS g.full.f.m.init ρ M, SReach.start ρ M hM h0 hfa hpf, fun i hi => ?_⟩\n    show applyS (g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ M i = applyS g.orig.f.m.init ρ M i\n    exact applyS_append_other (by simpa [SGhosted.vars] using hi) ρ M\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨ρg, hrg, hag⟩ := ih\n    obtain ⟨hA, hS, hW⟩ := sghost_step g hg hag M ι κ\n    refine ⟨_, ?_, hS⟩\n    rw [← hW]\n    exact SReach.step ρg M ι κ hrg (by rw [hA]; exact ha)\n\n/-- A law of the ghosted machine that reads no ghost holds in every reachable state of the original. -/\ntheorem sghost_laws (ps : List SEntry) (hl : checkSMachine g.full ps = true) :\n    ∀ ρ M, SReach g.orig ρ M → ∀ e ∈ ps, avoids g.vars e.law.holds = true → e.Holds ρ M := by\n  intro ρ M hr e he hav\n  obtain ⟨ρg, hrg, hag⟩ := sghost_reach g hg hr\n  exact sentry_transfer (V := g.vars) (MS := []) hav (by simp [avoidsMaps]) (fun i hi => (hag i hi).symm) (fun _ _ => rfl)\n    (smachine_sound g.full ps hl ρg M hrg e he)\n\ntheorem sghostFrom_agree (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) (hM0 : s0.2 = (run.st 0).2) (hA0 : Agree g.vars s0.1 (run.st 0).1) :\n    ∀ n, (sghostFrom g run s0 n).2 = (run.st n).2 ∧ Agree g.vars (sghostFrom g run s0 n).1 (run.st n).1\n  | 0 => ⟨hM0, hA0⟩\n  | n + 1 => by\n    obtain ⟨hM, hag⟩ := sghostFrom_agree run s0 hM0 hA0 n\n    obtain ⟨_, hS, hW⟩ := sghost_step g hg hag (run.st n).2 (run.req n).1 (run.req n).2\n    rw [run.next n]\n    simp only [sghostFrom, hM]\n    exact ⟨hW, hS⟩\n\nomit hg in\nnoncomputable def sghostRun (hg : sghostOk g = true) (run : SRun g.orig) (s0 : (Nat → Nat) × (Nat → Nat → Nat)) (hr : SReach g.full s0.1 s0.2)\n    (hM0 : s0.2 = (run.st 0).2) (hA0 : Agree g.vars s0.1 (run.st 0).1) : SRun g.full :=\n  ⟨sghostFrom g run s0, run.req, hr,\n    fun n => by\n      obtain ⟨hM, hag⟩ := sghostFrom_agree g hg run s0 hM0 hA0 n\n      obtain ⟨hA, _, _⟩ := sghost_step g hg hag (run.st n).2 (run.req n).1 (run.req n).2\n      rw [hM, hA]; exact run.allowed n,\n    fun n => rfl⟩\n\n/-- Every run of the original is, outside the ghosts, a run of the ghosted machine taking the same requests. -/\ntheorem sghost_run (run : SRun g.orig) : ∃ run' : SRun g.full, run'.req = run.req ∧ ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1 :=\n  ⟨sghostRun g hg run (Classical.choose (sghost_reach g hg run.start), (run.st 0).2) (Classical.choose_spec (sghost_reach g hg run.start)).1 rfl\n      (Classical.choose_spec (sghost_reach g hg run.start)).2, rfl,\n    sghostFrom_agree g hg run (Classical.choose (sghost_reach g hg run.start), (run.st 0).2) rfl (Classical.choose_spec (sghost_reach g hg run.start)).2⟩\n/-- A run of the original from its start lifts to one of the ghosted machine from its start: each ghost at its start term. -/\ntheorem sghost_run_start (run : SRun g.orig) {ρ0 : Nat → Nat} {M0 : Nat → Nat → Nat} (hM : StartMaps g.orig.f.m M0)\n    (hp : evalC ρ0 M0 g.orig.f.m.pre = true) (hfa : ∀ l ∈ g.orig.facts, l.Holds ρ0 M0) (hpf : g.orig.PFacts ρ0 M0) (hst : run.st 0 = (applyS g.orig.f.m.init ρ0 M0, M0)) :\n    ∃ run' : SRun g.full, run'.req = run.req ∧ run'.st 0 = (applyS g.full.f.m.init ρ0 M0, M0)\n      ∧ ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1 := by\n  have hA0 : Agree g.vars (applyS g.full.f.m.init ρ0 M0) (run.st 0).1 := fun i hi => by\n    rw [hst]\n    show applyS (g.orig.f.m.init ++ g.ghosts.map (fun x => (x.1, x.2.1))) ρ0 M0 i = applyS g.orig.f.m.init ρ0 M0 i\n    exact applyS_append_other (by simpa [SGhosted.vars] using hi) ρ0 M0\n  have hM0 : M0 = (run.st 0).2 := by rw [hst]\n  exact ⟨sghostRun g hg run (applyS g.full.f.m.init ρ0 M0, M0) (SReach.start ρ0 M0 hM hp hfa hpf) hM0 hA0, rfl, rfl,\n    sghostFrom_agree g hg run (applyS g.full.f.m.init ρ0 M0, M0) hM0 hA0⟩\n\n-- A condition that reads no ghost, read where a step reads (its request, its flags decided), reads alike in a run and\n-- its lift.\ntheorem sghost_view (run : SRun g.orig) (run' : SRun g.full) (hreq : run'.req = run.req)\n    (hag : ∀ n, (run'.st n).2 = (run.st n).2 ∧ Agree g.vars (run'.st n).1 (run.st n).1) {c : C} (hc : avoids g.vars c = true) (n : Nat) :\n    evalC (sView g.orig (run'.st n).1 (run'.st n).2 (run'.req n).1 (run'.req n).2).1 (sView g.orig (run'.st n).1 (run'.st n).2 (run'.req n).1 (run'.req n).2).2 c\n      = evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c := by\n  obtain ⟨_, _, _, _, hf, _, _, _, _, hq, _⟩ := sghostOk_parts g hg\n  obtain ⟨hM, hA⟩ := hag n\n  rw [hM, hreq]\n  have hX : Agree g.vars (withInputs g.orig.f.m.inputs (run'.st n).1 (run.req n).1) (withInputs g.orig.f.m.inputs (run.st n).1 (run.req n).1) := fun i hi => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hA i hi\n  have hQ : Agree g.vars (decideQ g.orig (withInputs g.orig.f.m.inputs (run'.st n).1 (run.req n).1) (withCarried g.orig (run.st n).2 (run.req n).2))\n      (decideQ g.orig (withInputs g.orig.f.m.inputs (run.st n).1 (run.req n).1) (withCarried g.orig (run.st n).2 (run.req n).2)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of]\n    cases hl : lookup (fun q => q.1 == v) g.orig.qflags with\n    | some q => exact ite_all_congr (fun i hi _ => hX i (avoids_occ (hq q (lookup_some hl).1) hi)) (fun _ _ => rfl)\n    | none => exact hX v hv\n  exact congrC _ _ _ c (fun i hi => decide_agree_on hf _ hQ i (avoids_occ hc hi))\nend sghost\n\n/-- What `ever` means: along a run of the ghosted machine where the ghost x starts at 0, with x's step `if c then 1\nelse x`, x is 1 at step n exactly when some step before n took a request where c held (read where that step reads: its\nrequest, its flags decided). -/\ntheorem sever_meaning (g : SGhosted) (hg : sghostOk g = true) {x : Nat} {s0 : E} {c : C} (hx : (x, s0, .ite c (.const 1) (.var x)) ∈ g.ghosts)\n    (run : SRun g.full) (h0 : (run.st 0).1 x = 0) :\n    ∀ n, (run.st n).1 x = 1 ↔ ∃ i, i < n ∧ evalC (sView g.orig (run.st i).1 (run.st i).2 (run.req i).1 (run.req i).2).1\n      (sView g.orig (run.st i).1 (run.st i).2 (run.req i).1 (run.req i).2).2 c = true := by\n  obtain ⟨hd, hn, _⟩ := sghostOk_parts g hg\n  have hxv : x ∈ g.vars := List.mem_map_of_mem hx\n  have hxo := hn x hxv\n  have hassoc : assoc g.full.f.m.step x = some (.ite c (.const 1) (.var x)) := by\n    show assoc (g.orig.f.m.step ++ g.ghosts.map (fun y => (y.1, y.2.2))) x = _\n    simp only [assoc, lookup_append]\n    rw [lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact hxo (by\n      rw [← he]; exact List.mem_append_left _ (List.mem_append_left _ (List.mem_append_right _ (List.mem_map_of_mem hp)))))]\n    have hl : lookup (fun p => p.1 == x) (g.ghosts.map (fun y => (y.1, y.2.2))) = some (x, .ite c (.const 1) (.var x)) := by\n      have hd' : distinct ((g.ghosts.map (fun y => (y.1, y.2.2))).map (·.1)) = true := by rw [List.map_map]; exact hd\n      exact lookup_unique_fst hd' (List.mem_map.mpr ⟨_, hx, rfl⟩)\n    simp [hl]\n  have hxe : x ∉ g.orig.extVars := fun h => hxo (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h))))\n  have hxf : x ∉ flagVars g.orig.f.flags := fun h => hxo (List.mem_append_left _ (List.mem_append_right _ h))\n  simp only [SMachine.extVars, SMachine.qVars, List.mem_append, not_or] at hxe\n  intro n\n  induction n with\n  | zero => simp [h0]\n  | succ n ih =>\n    have hst : (run.st (n + 1)).1 x = if evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1\n        (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true then 1 else (run.st n).1 x := by\n      rw [run.next n]\n      simp only [sNext, applyS, hassoc, evalE]\n      rw [sview_full]\n      congr 1\n      simp only [sView]\n      rw [decide_other hxf, decideQ_other (by simpa [SMachine.qVars] using hxe.1.2), withInputs_other hxe.1.1]\n    rw [hst]\n    constructor\n    · intro h1\n      by_cases hc : evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true\n      · exact ⟨n, Nat.lt_succ_self n, hc⟩\n      · rw [if_neg hc] at h1\n        obtain ⟨i, hi, hci⟩ := ih.mp h1\n        exact ⟨i, Nat.lt_succ_of_lt hi, hci⟩\n    · rintro ⟨i, hi, hci⟩\n      by_cases hc : evalC (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).1 (sView g.orig (run.st n).1 (run.st n).2 (run.req n).1 (run.req n).2).2 c = true\n      · rw [if_pos hc]\n      · rw [if_neg hc]\n        rcases Nat.lt_succ_iff_lt_or_eq.mp hi with hi | rfl\n        · exact ih.mpr ⟨i, hi, hci⟩\n        · exact absurd hci hc\n\nend Kern\n\n#print axioms Kern.sghost_reach\n#print axioms Kern.sghost_laws\n#print axioms Kern.sghost_run\n#print axioms Kern.sever_meaning\n#print axioms Kern.sghost_run_start\n",
     "Refine.lean": "import Ghost\n\n/-!\nWhat a refinement means, proven: compose.ts's `refinement(impl, spec, {relation, witness, stutter})` builds one machine,\nthe implementation beside the spec, the spec sent at each of the implementation's requests the request the witness\nnames, and left as it was where `stutter` holds. Lean builds that machine from the two (`SRefined.full`), the spec\ngiven in the composite's names, and checks that neither reads the other's parts (`srOk`). The machines have maps,\nflags and sets (a machine with maps and flags is one with no sets): requests carry maps, the spec's among the\nimplementation's, shared by name. With the relation proven of the composite (smachine_sound) and its step law that the\nspec stutters or allows every request it is sent (skstep_sound):\n- `srefine_lift`: every reachable state of the implementation is, outside the spec's part, a reachable state of the\n  composite;\n- `srefine_project`: the spec's part of every reachable state of the composite is a reachable state of the spec;\n- `srefines`: so every reachable state of the implementation is related, by the relation, to a reachable state of the\n  spec.\n-/\n\nnamespace Kern\n\nstructure Refined where\n  impl : FMMachine            -- the implementation, in the composite's names\n  spec : FMMachine            -- the spec, in the composite's names (its inputs fresh)\n  wit : List (Nat × E)        -- each spec input and its term over the implementation's request and both states\n  stutter : C                 -- where the implementation's step is one the spec doesn't see\n\n-- The composite: the implementation, then the spec, its inputs read as the witness, each part kept where it stutters.\ndef Refined.full (r : Refined) : FMMachine :=\n  ⟨{ inputs := r.impl.m.inputs\n     init := r.impl.m.init ++ r.spec.m.init\n     maps0 := r.impl.m.maps0 ++ r.spec.m.maps0\n     step := r.impl.m.step ++ r.spec.m.step.map (fun p => (p.1, .ite r.stutter (.var p.1) (substE r.wit p.2)))\n     writes := r.impl.m.writes ++ r.spec.m.writes.map (fun w =>\n       (w.1, substE r.wit w.2.1, .ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2)))\n     pre := r.impl.m.pre\n     assume := r.impl.m.assume },\n   r.impl.flags ++ r.spec.flags.map (fun p => (p.1, substC r.wit p.2))⟩\n\ndef readsNone (V MS : List Nat) (c : C) : Bool := avoids V c && avoidsMaps MS c\ndef readsNoneE (V MS : List Nat) (e : E) : Bool := avoidsE V e && avoidsMapsE MS e\n\n/-! Lists and flags -/\n\ntheorem applyS_append_right {σ τ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS (σ ++ τ) ρ M i = applyS τ ρ M i := by\n  have hσ : lookup (fun p => p.1 == i) σ = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [applyS, assoc, lookup_append, hσ]\n\ntheorem flagOf_append_left {fl fl' : List (Nat × C)} {i : Nat} (h : i ∉ flagVars fl') : flagOf (fl ++ fl') i = flagOf fl i := by\n  have h' : lookup (fun p => p.1 == i) fl' = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [flagOf, lookup_append]\n  cases hl : lookup (fun p => p.1 == i) fl <;> simp [h']\n\ntheorem flagOf_append_right {fl fl' : List (Nat × C)} {i : Nat} (h : i ∉ flagVars fl) : flagOf (fl ++ fl') i = flagOf fl' i := by\n  have h' : lookup (fun p => p.1 == i) fl = none :=\n    lookup_none (fun p hp => by simp only [beq_eq_false_iff_ne]; intro he; exact h (by rw [← he]; exact List.mem_map_of_mem hp))\n  simp only [flagOf, lookup_append, h']\n\ntheorem flagOf_map {fl : List (Nat × C)} {g : C → C} (i : Nat) : flagOf (fl.map (fun p => (p.1, g p.2))) i = (flagOf fl i).map g := by\n  simp only [flagOf]\n  induction fl with\n  | nil => rfl\n  | cons a as ih =>\n    simp only [List.map_cons, lookup]\n    split <;> simp_all\n\ntheorem decideFlags_of (fl : List (Nat × C)) (X : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    decideFlags fl X M i = match flagOf fl i with\n      | some c => if evalC X M c = true then 1 else 0\n      | none => X i := by\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases flagOf fl i <;> simp [evalE]\n\ntheorem rn_v {V MS : List Nat} {c : C} (h : readsNone V MS c = true) : avoids V c = true := by simp only [readsNone, Bool.and_eq_true] at h; exact h.1\ntheorem rn_m {V MS : List Nat} {c : C} (h : readsNone V MS c = true) : avoidsMaps MS c = true := by simp only [readsNone, Bool.and_eq_true] at h; exact h.2\ntheorem rnE_v {V MS : List Nat} {e : E} (h : readsNoneE V MS e = true) : avoidsE V e = true := by simp only [readsNoneE, Bool.and_eq_true] at h; exact h.1\ntheorem rnE_m {V MS : List Nat} {e : E} (h : readsNoneE V MS e = true) : avoidsMapsE MS e = true := by simp only [readsNoneE, Bool.and_eq_true] at h; exact h.2\n\ntheorem assoc_map_fst (l : List (Nat × E)) (g : Nat × E → E) (v : Nat) :\n    assoc (l.map (fun q => (q.1, g q))) v = (lookup (fun q => q.1 == v) l).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\ntheorem lookup_writes_map (l : List (Nat × E × E)) (g : Nat × E × E → E × E) (mp : Nat) :\n    lookup (fun w : Nat × E × E => w.1 == mp) (l.map (fun w => (w.1, g w))) = (lookup (fun w : Nat × E × E => w.1 == mp) l).map (fun w => (w.1, g w)) := by\n  rw [lookup_map_pred]\n\n-- Read where `then` reads, a condition that reads no primed name is the condition before the step.\ntheorem unprimed_evalC {pr pm : List (Nat × Nat)} {c : C} (hv : avoids (pr.map (·.2)) c = true) (hm : avoidsMaps (pm.map (·.2)) c = true)\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalC (primed pr ρ' ρ) (primedMaps pm M' M) c = evalC ρ M c := by\n  rw [congrC _ ρ _ c (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact avoids_occ hv hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrMC ρ _ M c (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact avoidsMaps_occ hm hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\n\n/-! Refinements -/\n\nopen Classical\n\nstructure SRefined where\n  impl : SMachine\n  spec : SMachine\n  wit : List (Nat × E)\n  stutter : C\n\n\ndef SRefined.base (r : SRefined) : Refined := ⟨r.impl.f, r.spec.f, r.wit, r.stutter⟩\ndef SRefined.full (r : SRefined) : SMachine :=\n  ⟨r.base.full, r.impl.carried,\n   r.impl.every ++ r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2))),\n   r.impl.qflags ++ r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2)),\n   r.impl.wits ++ r.spec.wits, [], []⟩\ndef SRefined.allowed (r : SRefined) : C := inlineC r.full.f.flags (.or r.stutter (substC r.wit r.spec.f.m.assume))\n\ntheorem sfull_inputs (r : SRefined) : r.full.f.m.inputs = r.impl.f.m.inputs := rfl\ntheorem sfull_carried (r : SRefined) : r.full.carried = r.impl.carried := rfl\ntheorem sfull_flags (r : SRefined) : r.full.f.flags = r.impl.f.flags ++ r.spec.f.flags.map (fun p => (p.1, substC r.wit p.2)) := rfl\ntheorem sfull_qflags (r : SRefined) : r.full.qflags = r.impl.qflags ++ r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2)) := rfl\ntheorem sfull_every (r : SRefined) : r.full.every = r.impl.every ++ r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2))) := rfl\ntheorem sfull_step (r : SRefined) : r.full.f.m.step = r.impl.f.m.step ++ r.spec.f.m.step.map (fun p => (p.1, .ite r.stutter (.var p.1) (substE r.wit p.2))) := rfl\ntheorem sfull_writes (r : SRefined) : r.full.f.m.writes = r.impl.f.m.writes ++ r.spec.f.m.writes.map (fun w =>\n    (w.1, substE r.wit w.2.1, .ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2))) := rfl\ntheorem sfull_init (r : SRefined) : r.full.f.m.init = r.impl.f.m.init ++ r.spec.f.m.init := rfl\ntheorem sfull_maps0 (r : SRefined) : r.full.f.m.maps0 = r.impl.f.m.maps0 ++ r.spec.f.m.maps0 := rfl\ntheorem sfull_assume (r : SRefined) : r.full.f.m.assume = r.impl.f.m.assume := rfl\ntheorem sfull_pre (r : SRefined) : r.full.f.m.pre = r.impl.f.m.pre := rfl\n\n-- The implementation's names and maps (its own, and those only it carries); the spec's; where the spec's state and the\n-- composite's may differ; what the witness and `stutter` may not read.\ndef SRefined.IV (r : SRefined) : List Nat := r.impl.f.m.inputs ++ r.impl.f.m.init.map (·.1) ++ r.impl.f.m.step.map (·.1) ++ flagVars r.impl.f.flags ++ r.impl.qVars ++ bkeys r.impl\ndef SRefined.IO (r : SRefined) : List Nat := r.impl.f.m.maps0.map (·.1) ++ r.impl.f.m.writes.map (·.1) ++ r.impl.every.map (·.1)\ndef SRefined.IM (r : SRefined) : List Nat := r.IO ++ r.impl.carried.filter (fun mp => !r.spec.carried.contains mp)\ndef SRefined.SV (r : SRefined) : List Nat := r.spec.f.m.init.map (·.1) ++ r.spec.f.m.step.map (·.1) ++ flagVars r.spec.f.flags ++ r.spec.qVars ++ bkeys r.spec\ndef SRefined.SM (r : SRefined) : List Nat := r.spec.f.m.maps0.map (·.1) ++ r.spec.f.m.writes.map (·.1) ++ r.spec.every.map (·.1)\ndef SRefined.X (r : SRefined) : List Nat := r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars ++ r.spec.f.m.inputs\ndef SRefined.W (r : SRefined) : List Nat := flagVars r.impl.f.flags ++ flagVars r.spec.f.flags ++ r.spec.f.m.inputs ++ r.impl.qVars ++ r.spec.qVars ++ bkeys r.spec\n\ndef srImplOk (r : SRefined) : Bool :=\n  readsNone r.SV r.SM r.impl.f.m.pre && readsNone r.SV r.SM r.impl.f.m.assume\n    && r.impl.f.flags.all (fun p => readsNone r.SV r.SM p.2) && r.impl.f.m.step.all (fun p => readsNoneE r.SV r.SM p.2)\n    && r.impl.f.m.init.all (fun p => readsNoneE r.SV r.SM p.2)\n    && r.impl.f.m.writes.all (fun w => readsNoneE r.SV r.SM w.2.1 && readsNoneE r.SV r.SM w.2.2)\n    && r.impl.every.all (fun w => readsNoneE r.SV r.SM w.2.2) && r.impl.qflags.all (fun q => readsNone r.SV r.SM q.2.2)\ndef srSpecOk (r : SRefined) : Bool :=\n  readsNone r.IV r.IM r.spec.f.m.assume && r.spec.f.flags.all (fun p => readsNone (r.IV ++ flagVars r.spec.f.flags) r.IM p.2)\n    && r.spec.f.m.step.all (fun p => readsNoneE r.IV r.IM p.2) && r.spec.f.m.init.all (fun p => readsNoneE (r.IV ++ r.spec.f.m.inputs) r.IM p.2)\n    && r.spec.f.m.writes.all (fun w => readsNoneE r.IV r.IM w.2.1 && readsNoneE r.IV r.IM w.2.2)\n    && r.spec.every.all (fun w => readsNoneE r.IV r.IM w.2.2)\n    && r.spec.qflags.all (fun q => readsNone (r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars) r.IM q.2.2)\n    && readsNone (r.X ++ r.SV) r.IM r.spec.f.m.pre && !readsC r.spec.f.m.pre\ndef srNamesOk (r : SRefined) : Bool :=\n  r.SV.all (fun v => !r.IV.contains v) && r.spec.f.m.inputs.all (fun v => !(r.IV ++ r.SV).contains v)\n    && r.SM.all (fun mp => !r.IM.contains mp) && r.spec.carried.all (fun mp => r.impl.carried.contains mp)\n    && r.impl.carried.all (fun mp => !(r.IO ++ r.SM).contains mp)\n    && r.wit.all (fun p => r.spec.f.m.inputs.contains p.1 && avoidsE r.W p.2) && avoids r.W r.stutter\n    && r.impl.facts.isEmpty && r.spec.facts.isEmpty\ndef srOk (r : SRefined) : Bool := srImplOk r && srSpecOk r && (srNamesOk r && r.spec.pfacts.isEmpty)\n\ntheorem srImpl_parts {r : SRefined} (h : srImplOk r = true) :\n    readsNone r.SV r.SM r.impl.f.m.pre = true ∧ readsNone r.SV r.SM r.impl.f.m.assume = true\n      ∧ (∀ p ∈ r.impl.f.flags, readsNone r.SV r.SM p.2 = true) ∧ (∀ p ∈ r.impl.f.m.step, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ p ∈ r.impl.f.m.init, readsNoneE r.SV r.SM p.2 = true)\n      ∧ (∀ w ∈ r.impl.f.m.writes, readsNoneE r.SV r.SM w.2.1 = true ∧ readsNoneE r.SV r.SM w.2.2 = true)\n      ∧ (∀ w ∈ r.impl.every, readsNoneE r.SV r.SM w.2.2 = true) ∧ (∀ q ∈ r.impl.qflags, readsNone r.SV r.SM q.2.2 = true) := by\n  simp only [srImplOk, Bool.and_eq_true, List.all_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7, h8⟩\n\ntheorem srSpec_parts {r : SRefined} (h : srSpecOk r = true) :\n    readsNone r.IV r.IM r.spec.f.m.assume = true ∧ (∀ p ∈ r.spec.f.flags, readsNone (r.IV ++ flagVars r.spec.f.flags) r.IM p.2 = true)\n      ∧ (∀ p ∈ r.spec.f.m.step, readsNoneE r.IV r.IM p.2 = true) ∧ (∀ p ∈ r.spec.f.m.init, readsNoneE (r.IV ++ r.spec.f.m.inputs) r.IM p.2 = true)\n      ∧ (∀ w ∈ r.spec.f.m.writes, readsNoneE r.IV r.IM w.2.1 = true ∧ readsNoneE r.IV r.IM w.2.2 = true)\n      ∧ (∀ w ∈ r.spec.every, readsNoneE r.IV r.IM w.2.2 = true)\n      ∧ (∀ q ∈ r.spec.qflags, readsNone (r.IV ++ flagVars r.spec.f.flags ++ r.spec.qVars) r.IM q.2.2 = true)\n      ∧ readsNone (r.X ++ r.SV) r.IM r.spec.f.m.pre = true ∧ readsC r.spec.f.m.pre = false := by\n  simp only [srSpecOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩, h9⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7, h8, h9⟩\n\ntheorem srNames_parts {r : SRefined} (h : srNamesOk r = true) :\n    (∀ v ∈ r.SV, v ∉ r.IV) ∧ (∀ v ∈ r.spec.f.m.inputs, v ∉ r.IV ++ r.SV) ∧ (∀ mp ∈ r.SM, mp ∉ r.IM)\n      ∧ (∀ mp ∈ r.spec.carried, mp ∈ r.impl.carried) ∧ (∀ mp ∈ r.impl.carried, mp ∉ r.IO ++ r.SM)\n      ∧ (∀ p ∈ r.wit, p.1 ∈ r.spec.f.m.inputs ∧ avoidsE r.W p.2 = true) ∧ avoids r.W r.stutter = true\n      ∧ r.impl.facts = [] ∧ r.spec.facts = [] := by\n  simp only [srNamesOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true', List.isEmpty_iff] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩, h9⟩ := h\n  refine ⟨fun v hv hm => ?_, fun v hv hm => ?_, fun mp hm hm' => ?_, fun mp hm => List.contains_iff_mem.mp (h4 mp hm), fun mp hm hm' => ?_,\n    fun p hp => ⟨List.contains_iff_mem.mp (h6 p hp).1, (h6 p hp).2⟩, h7, h8, h9⟩\n  · have := h1 v hv; rw [List.contains_iff_mem.mpr hm] at this; cases this\n  · have := h2 v hv; rw [List.contains_iff_mem.mpr hm] at this; cases this\n  · have := h3 mp hm; rw [List.contains_iff_mem.mpr hm'] at this; cases this\n  · have := h5 mp hm; rw [List.contains_iff_mem.mpr hm'] at this; cases this\n\n/-! The implementation's runs, inside the composite's -/\n\nsection slift\nvariable (r : SRefined) (hok : srOk r = true)\ninclude hok\n\ntheorem sr_impl : srImplOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.1.1\ntheorem sr_spec : srSpecOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.1.2\ntheorem sr_names : srNamesOk r = true := by simp only [srOk, Bool.and_eq_true] at hok; exact hok.2.1\ntheorem sr_pfacts : r.spec.pfacts = [] := by simp only [srOk, Bool.and_eq_true, List.isEmpty_iff] at hok; exact hok.2.2\n\n-- One step of the composite from a state that agrees with the implementation's outside the spec's part, with the same\n-- request: allowed alike, to states that still agree.\ntheorem srefine_step {ρ ρc : Nat → Nat} {M Mc : Nat → Nat → Nat} (hag : Agree r.SV ρc ρ) (hmag : ∀ mp, mp ∉ r.SM → Mc mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    evalC (sView r.full ρc Mc ι κ).1 (sView r.full ρc Mc ι κ).2 r.full.f.m.assume = evalC (sView r.impl ρ M ι κ).1 (sView r.impl ρ M ι κ).2 r.impl.f.m.assume\n      ∧ Agree r.SV (sNext r.full ρc Mc ι κ).1 (sNext r.impl ρ M ι κ).1\n      ∧ ∀ mp, mp ∉ r.SM → (sNext r.full ρc Mc ι κ).2 mp = (sNext r.impl ρ M ι κ).2 mp := by\n  obtain ⟨_, ha, hf, hs, _, hw, he, hq⟩ := srImpl_parts (sr_impl r hok)\n  have hN : ∀ mp, mp ∉ r.SM → withCarried r.full Mc κ mp = withCarried r.impl M κ mp := fun mp hmp => by\n    show (if r.impl.carried.contains mp = true then κ mp else Mc mp) = (if r.impl.carried.contains mp = true then κ mp else M mp)\n    by_cases hc : r.impl.carried.contains mp = true\n    · rw [if_pos hc, if_pos hc]\n    · rw [if_neg hc, if_neg hc]; exact hmag mp hmp\n  have hX : Agree r.SV (withInputs r.full.f.m.inputs ρc ι) (withInputs r.impl.f.m.inputs ρ ι) := fun i hi => by\n    rw [sfull_inputs]; simp only [withInputs]; split\n    · rfl\n    · exact hag i hi\n  -- The quantified flags: the composite's decide the implementation's alike, outside the spec's names.\n  have hQ : Agree r.SV (decideQ r.full (withInputs r.full.f.m.inputs ρc ι) (withCarried r.full Mc κ))\n      (decideQ r.impl (withInputs r.impl.f.m.inputs ρ ι) (withCarried r.impl M κ)) := by\n    intro v hv\n    rw [decideQ_of, decideQ_of, sfull_qflags, lookup_append]\n    cases hl : lookup (fun q => q.1 == v) r.impl.qflags with\n    | some q =>\n      have hrd := hq q (lookup_some hl).1\n      exact ite_all_congr (fun i hi _ => hX i (avoids_occ (rn_v hrd) hi)) (fun mp hmp => hN mp (avoidsMaps_occ (rn_m hrd) hmp))\n    | none =>\n      have hn : lookup (fun q => q.1 == v) (r.spec.qflags.map (fun q => (q.1, q.2.1, substC r.wit q.2.2))) = none :=\n        lookup_none (fun q hq' => by\n          simp only [beq_eq_false_iff_ne]; intro hqv\n          obtain ⟨q0, hq0, rfl⟩ := List.mem_map.mp hq'\n          exact hv (by simp only [SRefined.SV, SMachine.qVars, List.mem_append]; left; right; rw [← hqv]; exact List.mem_map.mpr ⟨q0, hq0, rfl⟩))\n      simp only [hn]\n      exact hX v hv\n  -- The plain flags, likewise.\n  have hD : Agree r.SV (decideFlags r.full.f.flags (decideQ r.full (withInputs r.full.f.m.inputs ρc ι) (withCarried r.full Mc κ)) (withCarried r.full Mc κ))\n      (decideFlags r.impl.f.flags (decideQ r.impl (withInputs r.impl.f.m.inputs ρ ι) (withCarried r.impl M κ)) (withCarried r.impl M κ)) := by\n    intro i hi\n    have hif : i ∉ flagVars (r.spec.f.flags.map (fun p => (p.1, substC r.wit p.2))) := fun h' => hi (by\n      simp only [flagVars, List.map_map] at h'; simp only [SRefined.SV, List.mem_append]; left; left; right\n      simpa [flagVars, Function.comp_def] using h')\n    rw [sfull_flags, decideFlags_of, decideFlags_of, flagOf_append_left hif]\n    cases hfo : flagOf r.impl.f.flags i with\n    | none => exact hQ i hi\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hfo\n      simp only\n      rw [congrMC _ _ _ _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m (hf p hp)) hmp)),\n        congrC _ _ _ _ (fun j hj => hQ j (avoids_occ (rn_v (hf p hp)) hj))]\n  refine ⟨?_, fun i hi => ?_, fun mp hmp => ?_⟩\n  · simp only [sView]\n    rw [sfull_assume, congrMC _ _ _ _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m ha) hmp)), congrC _ _ _ _ (fun j hj => hD j (avoids_occ (rn_v ha) hj))]\n  · simp only [sNext, sView]\n    rw [sfull_step]\n    have hit : i ∉ (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))).map (·.1) := fun h' => hi (by\n      simp only [List.map_map] at h'; simp only [SRefined.SV, List.mem_append]; left; left; left; right; simpa [Function.comp_def] using h')\n    rw [applyS_append_other hit]\n    simp only [applyS]\n    cases hst : assoc r.impl.f.m.step i with\n    | none => exact hD i hi\n    | some e =>\n      have hm : (i, e) ∈ r.impl.f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq', rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq'\n        simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n      dsimp only\n      rw [congrME _ _ _ e (fun mp hmp => hN mp (avoidsMapsE_occ (rnE_m (hs (i, e) hm)) hmp)),\n        congrE _ _ _ e (fun j hj => hD j (avoidsE_occ (rnE_v (hs (i, e) hm)) hj))]\n  · funext key\n    simp only [sNext, sView, everyMaps]\n    rw [sfull_every, lookup_append]\n    cases hl : lookup (fun w => w.1 == mp) r.impl.every with\n    | some w =>\n      have hrd := he w (lookup_some hl).1\n      simp only\n      rw [congrME _ _ _ w.2.2 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m hrd) h)),\n        congrE _ _ _ w.2.2 (fun j hj => upd_agree hD w.2.1 key j (avoidsE_occ (rnE_v hrd) hj))]\n    | none =>\n      have hn : lookup (fun w => w.1 == mp) (r.spec.every.map (fun w => (w.1, w.2.1, E.ite r.stutter (.get w.1 (.var w.2.1)) (substE r.wit w.2.2)))) = none :=\n        lookup_none (fun w hw' => by\n          simp only [beq_eq_false_iff_ne]; intro he'\n          obtain ⟨w0, hw0, rfl⟩ := List.mem_map.mp hw'\n          exact hmp (by simp only [SRefined.SM, List.mem_append]; right; rw [← he']; exact List.mem_map.mpr ⟨w0, hw0, rfl⟩))\n      simp only [hn]\n      have hwm : lookup (fun w : Nat × E × E => w.1 == mp) (r.spec.f.m.writes.map (fun w =>\n          (w.1, substE r.wit w.2.1, E.ite r.stutter (.get w.1 (substE r.wit w.2.1)) (substE r.wit w.2.2)))) = none :=\n        lookup_none (fun w hw' => by\n          simp only [beq_eq_false_iff_ne]; intro he'\n          obtain ⟨w0, hw0, rfl⟩ := List.mem_map.mp hw'\n          exact hmp (by simp only [SRefined.SM, List.mem_append]; left; right; rw [← he']; exact List.mem_map.mpr ⟨w0, hw0, rfl⟩))\n      simp only [writeMaps]\n      rw [sfull_writes, lookup_append]\n      cases hl2 : lookup (fun w => w.1 == mp) r.impl.f.m.writes with\n      | none => simp only [hwm]; exact congrFun (hN mp hmp) key\n      | some w =>\n        obtain ⟨h1, h2⟩ := hw w (lookup_some hl2).1\n        simp only\n        rw [congrME _ _ _ w.2.1 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m h1) h)), congrE _ _ _ w.2.1 (fun j hj => hD j (avoidsE_occ (rnE_v h1) hj)),\n          congrME _ _ _ w.2.2 (fun mp' h => hN mp' (avoidsMapsE_occ (rnE_m h2) h)), congrE _ _ _ w.2.2 (fun j hj => hD j (avoidsE_occ (rnE_v h2) hj)), hN mp hmp]\n\n/-- Every reachable state of the implementation is, outside the spec's part, a reachable state of the composite. -/\ntheorem srefine_lift (hmo : distinct (r.spec.f.m.maps0.map (·.1)) = true) :\n    ∀ {ρ M}, SReach r.impl ρ M → ∃ ρc Mc, SReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ ∀ mp, mp ∉ r.SM → Mc mp = M mp := by\n  obtain ⟨hp, _, _, _, hi, _⟩ := srImpl_parts (sr_impl r hok)\n  obtain ⟨_, _, hsm, _⟩ := srNames_parts (sr_names r hok)\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 _ _ =>\n    let Mc : Nat → Nat → Nat := fun mp => match lookup (fun p => p.1 == mp) r.spec.f.m.maps0 with\n      | some p => fun _ => p.2\n      | none => M mp\n    have hMc : ∀ mp, mp ∉ r.SM → Mc mp = M mp := fun mp hmp => by\n      simp only [Mc]\n      rw [lookup_none (fun p hp' => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hmp (by simp only [SRefined.SM, List.mem_append]; left; left; rw [← he]; exact List.mem_map_of_mem hp'))]\n    have hpre : evalC ρ Mc r.full.f.m.pre = true := by\n      rw [sfull_pre, congrMC _ Mc M _ (fun mp hmp => hMc mp (avoidsMaps_occ (rn_m hp) hmp))]; exact h0\n    have hstart : StartMaps r.full.f.m Mc := by\n      intro p hp' key\n      rw [sfull_maps0] at hp'\n      rcases List.mem_append.mp hp' with hp' | hp'\n      · have hn : p.1 ∉ r.SM := fun h' => hsm p.1 h' (by\n          simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; left; left; exact List.mem_map_of_mem hp')\n        rw [hMc p.1 hn]; exact hM p hp' key\n      · have hl : lookup (fun q => q.1 == p.1) r.spec.f.m.maps0 = some p := lookup_unique1 hmo hp'\n        simp only [Mc, hl]\n    have hfacts : ∀ l ∈ r.full.facts, l.Holds ρ Mc := fun l hl => by simp [SRefined.full] at hl\n    refine ⟨_, Mc, SReach.start ρ Mc hstart hpre hfacts (fun p hp => by simp [SRefined.full] at hp), fun i hi' => ?_, hMc⟩\n    show applyS (r.impl.f.m.init ++ r.spec.f.m.init) ρ Mc i = applyS r.impl.f.m.init ρ M i\n    rw [applyS_append_other (by\n      intro h'; apply hi'; simp only [SRefined.SV, List.mem_append]; left; left; left; left; exact h')]\n    simp only [applyS]\n    cases hst : assoc r.impl.f.m.init i with\n    | none => rfl\n    | some e =>\n      have hm : (i, e) ∈ r.impl.f.m.init := by\n        simp only [assoc, Option.map_eq_some_iff] at hst\n        obtain ⟨q, hq, rfl⟩ := hst\n        obtain ⟨hqm, hqv⟩ := lookup_some hq\n        simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n      exact congrME _ Mc M e (fun mp hmp => hMc mp (avoidsMapsE_occ (rnE_m (hi (i, e) hm)) hmp))\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨ρc, Mc, hrc, hag, hmag⟩ := ih\n    obtain ⟨hA, hS, hW⟩ := srefine_step r hok hag hmag ι κ\n    exact ⟨_, _, SReach.step ρc Mc ι κ hrc (by rw [hA]; exact ha), hS, hW⟩\nend slift\n\n/-! The spec's part of the composite's runs -/\n\ntheorem lookup_qmap (l : List (Nat × List Nat × C)) (g : Nat × List Nat × C → C) (v : Nat) :\n    lookup (fun q : Nat × List Nat × C => q.1 == v) (l.map (fun q => (q.1, q.2.1, g q))) = (lookup (fun q : Nat × List Nat × C => q.1 == v) l).map (fun q => (q.1, q.2.1, g q)) := by\n  rw [lookup_map_pred]\ntheorem lookup_emap (l : List (Nat × Nat × E)) (g : Nat × Nat × E → E) (v : Nat) :\n    lookup (fun w : Nat × Nat × E => w.1 == v) (l.map (fun w => (w.1, w.2.1, g w))) = (lookup (fun w : Nat × Nat × E => w.1 == v) l).map (fun w => (w.1, w.2.1, g w)) := by\n  rw [lookup_map_pred]\n\ntheorem sView_snd (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (sView s ρ M ι κ).2 = withCarried s M κ := rfl\n\nsection sproject\nvariable (r : SRefined) (hok : srOk r = true)\ninclude hok\n\n-- The maps the spec reads: alike in its view and the composite's.\ntheorem sr_maps {M Ms : Nat → Nat → Nat} (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp) (κ : Nat → Nat → Nat) :\n    ∀ mp, mp ∉ r.IM → withCarried r.spec Ms κ mp = withCarried r.full M κ mp := by\n  obtain ⟨_, _, _, hcar, _⟩ := srNames_parts (sr_names r hok)\n  intro mp hmp\n  show (if r.spec.carried.contains mp = true then κ mp else Ms mp) = (if r.impl.carried.contains mp = true then κ mp else M mp)\n  by_cases hs : r.spec.carried.contains mp = true\n  · rw [if_pos hs, if_pos (List.contains_iff_mem.mpr (hcar mp (List.contains_iff_mem.mp hs)))]\n  · have hi : ¬ r.impl.carried.contains mp = true := fun hc => hmp (by\n      simp only [SRefined.IM, List.mem_append, List.mem_filter]; right; exact ⟨List.contains_iff_mem.mp hc, by simpa using hs⟩)\n    rw [if_neg hs, if_neg hi]\n    exact hmag mp hmp (fun h' => hs (List.contains_iff_mem.mpr h'))\n\ntheorem sr_W {v : Nat} (hv : v ∈ flagVars r.full.f.flags ∨ v ∈ r.full.qVars) : v ∈ r.W := by\n  simp only [sfull_flags, flagVars, List.map_append, List.map_map, SMachine.qVars, sfull_qflags, List.mem_append] at hv\n  simp only [SRefined.W, SMachine.qVars, flagVars, List.mem_append]\n  rcases hv with (h | h) | (h | h)\n  · left; left; left; left; left; exact h\n  · left; left; left; left; right; simpa [Function.comp_def] using h\n  · left; left; right; exact h\n  · left; right; simpa [Function.comp_def] using h\n\n-- A term the witness has, read in the composite's view, before its flags or with a key set: alike.\ntheorem sr_witE {ρ : Nat → Nat} {M : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : avoidsE r.W e = true) :\n    evalE (decideFlags r.full.f.flags (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) (withCarried r.full M κ) e\n      = evalE (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ) e := by\n  apply congrE; intro j hj\n  have hjW := avoidsE_occ he hj\n  rw [decide_other (fun h' => hjW (sr_W r hok (Or.inl h'))), decideQ_other (fun h' => hjW (sr_W r hok (Or.inr h')))]\n\ntheorem sr_wit_upd {X : Nat → Nat} {N : Nat → Nat → Nat} {e : E} (he : avoidsE r.W e = true) {k : Nat} (hk : k ∈ bkeys r.spec) (key : Nat) :\n    evalE (upd X k key) N e = evalE X N e := by\n  apply congrE; intro j hj\n  simp only [upd]; split\n  · rename_i h; subst h; exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk) (avoidsE_occ he hj)\n  · rfl\n\ntheorem sr_wit_atKeys {X : Nat → Nat} {N : Nat → Nat → Nat} {e : E} (he : avoidsE r.W e = true) {ks : List Nat} (hk : ∀ k ∈ ks, k ∈ bkeys r.spec) (v : Nat → Nat) :\n    evalE (atKeys X ks v) N e = evalE X N e := by\n  apply congrE; intro j hj\n  by_cases hjk : j ∈ ks\n  · exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk j hjk) (avoidsE_occ he hj)\n  · exact atKeys_out hjk\n\n-- The witness's domain: spec inputs.\ntheorem sr_wdom {i : Nat} (hi : i ∉ r.spec.f.m.inputs) : i ∉ r.wit.map (·.1) := fun h' => by\n  obtain ⟨_, _, _, _, _, hwit, _⟩ := srNames_parts (sr_names r hok)\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h'; exact hi (hwit p hp).1\n\ntheorem sr_wit_some {i : Nat} {e : E} (h : assoc r.wit i = some e) : (i, e) ∈ r.wit := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨q, hq, rfl⟩ := h\n  obtain ⟨hqm, hqv⟩ := lookup_some hq\n  simp only [beq_iff_eq] at hqv; rw [← hqv]; exact hqm\n\n-- The spec's quantified flags, decided over its view (its inputs as the witness reads them), agree with the composite's\n-- with the witness put in, outside the implementation's names and the spec's plain flags.\ntheorem sr_q {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    Agree (r.IV ++ flagVars r.spec.f.flags)\n      (decideQ r.spec (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) (withCarried r.spec Ms κ))\n      (applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) := by\n  obtain ⟨_, _, _, _, _, _, hsq, _, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨hsv, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hN := sr_maps r hok hmag κ\n  intro v hv\n  have hvI : v ∉ r.IV := fun h' => hv (List.mem_append_left _ h')\n  have hvF : v ∉ flagVars r.spec.f.flags := fun h' => hv (List.mem_append_right _ h')\n  -- Names of the spec's part are none of the spec's inputs.\n  have hSI : ∀ i, i ∈ r.SV → i ∉ r.spec.f.m.inputs := fun i hi h' => hsi i h' (List.mem_append_right _ hi)\n  have hIVq : ∀ i, i ∉ r.IV → i ∉ r.impl.qVars := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; right; exact h')\n  have hIVi : ∀ i, i ∉ r.IV → i ∉ r.impl.f.m.inputs := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; left; left; left; exact h')\n  have hIVf : ∀ i, i ∉ r.IV → i ∉ flagVars r.impl.f.flags := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; right; exact h')\n  have hfull_q : ∀ i, i ∉ r.impl.qVars → i ∉ r.spec.qVars → i ∉ r.full.qVars := fun i h1 h2 h' => by\n    simp only [SMachine.qVars, sfull_qflags, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact h1 h'\n    · exact h2 (by simpa [SMachine.qVars, Function.comp_def] using h')\n  have hfull_f : ∀ i, i ∉ flagVars r.impl.f.flags → i ∉ flagVars r.spec.f.flags → i ∉ flagVars r.full.f.flags := fun i h1 h2 h' => by\n    simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact h1 h'\n    · exact h2 (by simpa [flagVars, Function.comp_def] using h')\n  -- The spec inputs as the witness reads them: in the composite's view, or before its flags; the same.\n  have hιs : ∀ i, i ∈ r.spec.f.m.inputs → applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ) i\n      = applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ) i := fun i hi => by\n    have hiI : i ∉ r.IV := fun h' => hsi i hi (List.mem_append_left _ h')\n    have hiS : i ∉ r.SV := fun h' => hsi i hi (List.mem_append_right _ h')\n    have hiF : i ∉ flagVars r.full.f.flags := hfull_f i (hIVf i hiI) (fun h' => hiS (by simp only [SRefined.SV, List.mem_append]; left; left; right; exact h'))\n    simp only [applyS, sView]\n    cases ha : assoc r.wit i with\n    | none => exact decide_other hiF _ _\n    | some e =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      rw [sr_witE r hok ι κ (hwit _ hm).2]\n      exact (congrE _ _ _ e (fun j hj => decideQ_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inr h'))) _ _)).symm\n  by_cases hvq : v ∈ r.spec.qVars\n  · -- A spec's quantified flag: its body over the spec's view; in the composite, with the witness put in.\n    have hvi : v ∉ r.spec.f.m.inputs := hSI v (by simp only [SRefined.SV, List.mem_append]; left; right; exact hvq)\n    rw [decideQ_of, applyS_other (sr_wdom r hok hvi), decideQ_of, sfull_qflags, lookup_append]\n    have hn : lookup (fun q => q.1 == v) r.impl.qflags = none := lookup_none (fun q hq' => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hIVq v hvI (by rw [← he]; exact List.mem_map_of_mem hq'))\n    simp only [hn, lookup_qmap]\n    cases hl : lookup (fun q => q.1 == v) r.spec.qflags with\n    | none => exact absurd hvq (fun h' => by obtain ⟨q, hq, hqv⟩ := List.mem_map.mp h'; have := lookup_none_all hl q hq; simp [hqv] at this)\n    | some q =>\n      have hqm := (lookup_some hl).1\n      have hrd := hsq q hqm\n      have hk : ∀ k ∈ q.2.1, k ∈ bkeys r.spec := fun k hk' => by simp only [bkeys, List.mem_append]; right; exact List.mem_flatMap.mpr ⟨q, hqm, hk'⟩\n      simp only [Option.map_some]\n      have hc : (∀ k, holdsC (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ) (substC r.wit q.2.2))\n          ↔ (∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) := by\n        apply forall_congr'; intro k; rw [← evalC_iff, ← evalC_iff, subst_evalC]\n      rw [show (if ∀ k, holdsC (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ) (substC r.wit q.2.2) then 1 else 0)\n          = (if ∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 then 1 else 0) by\n        simp only [hc]]\n      have hkdom : ∀ k ∈ q.2.1, k ∉ r.wit.map (·.1) := fun k hk' => sr_wdom r hok (hSI _ (by simp only [SRefined.SV, List.mem_append]; right; exact hk k hk'))\n      -- Both sides as one condition over every value of the keys: compare the states they read the body at.\n      have hall : ∀ k, evalC (atKeys (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 k) (withCarried r.spec Ms κ) q.2.2\n          = evalC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2 := by\n        intro k\n        rw [congrMC _ _ (withCarried r.full M κ) _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m hrd) hmp))]\n        apply congrC; intro i hi\n        have hiR := avoids_occ (rn_v hrd) hi\n        simp only [List.mem_append, not_or] at hiR\n        obtain ⟨⟨hiI, hiF⟩, hiQ⟩ := hiR\n        by_cases hik : i ∈ q.2.1\n        · rw [applyS_other (hkdom i hik), atKeys_in hik, atKeys_in hik]\n        · rw [atKeys_out hik]\n          by_cases hii : i ∈ r.spec.f.m.inputs\n          · simp only [withInputs, List.contains_iff_mem.mpr hii, if_true]\n            rw [hιs i hii]\n            simp only [applyS]\n            cases ha : assoc r.wit i with\n            | none => rw [atKeys_out hik]; exact decideQ_other (fun h' => hfull_q i (hIVq i hiI) hiQ h') _ _\n            | some e =>\n              have hm := sr_wit_some r hok ha\n              dsimp only\n              rw [sr_wit_atKeys r hok (hwit _ hm).2 hk]\n              exact congrE _ _ _ e (fun j hj => decideQ_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inr h'))) _ _)\n          · rw [withInputs_other hii, applyS_other (sr_wdom r hok hii), atKeys_out hik]\n            rw [sfull_inputs, withInputs_other (hIVi i hiI)]\n            exact hag i (by simp only [SRefined.X, List.mem_append, not_or]; exact ⟨⟨⟨hiI, hiF⟩, hiQ⟩, hii⟩)\n      simp only [show (∀ k, holdsC (atKeys (withInputs r.spec.f.m.inputs σ (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ))) q.2.1 k) (withCarried r.spec Ms κ) q.2.2)\n          ↔ (∀ k, holdsC (applyS r.wit (atKeys (withInputs r.full.f.m.inputs ρ ι) q.2.1 k) (withCarried r.full M κ)) (withCarried r.full M κ) q.2.2) from\n        forall_congr' (fun k => by rw [← evalC_iff, ← evalC_iff, hall k])]\n  · rw [decideQ_other hvq]\n    by_cases hvi : v ∈ r.spec.f.m.inputs\n    · simp only [withInputs, List.contains_iff_mem.mpr hvi, if_true]\n      exact hιs v hvi\n    · rw [withInputs_other hvi, applyS_other (sr_wdom r hok hvi), decideQ_other (hfull_q v (hIVq v hvI) hvq), sfull_inputs, withInputs_other (hIVi v hvI)]\n      exact hag v (by simp only [SRefined.X, List.mem_append, not_or]; exact ⟨⟨⟨hvI, hvF⟩, hvq⟩, hvi⟩)\n\n-- The spec's view of a step agrees with the composite's with the witness put in, outside the implementation's names.\ntheorem sr_view {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    Agree r.IV (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1\n      (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) := by\n  obtain ⟨_, hsf, _, _, _, _, _, _, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨hsv, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hN := sr_maps r hok hmag κ\n  have hQ := sr_q r hok hag hmag ι κ\n  simp only [sView] at hQ\n  have hIVf : ∀ i, i ∉ r.IV → i ∉ flagVars r.impl.f.flags := fun i hi h' => hi (by simp only [SRefined.IV, List.mem_append]; left; left; right; exact h')\n  intro v hv\n  simp only [sView]\n  by_cases hvf : v ∈ flagVars r.spec.f.flags\n  · have hvi : v ∉ r.spec.f.m.inputs := fun h' => hsi v h' (List.mem_append_right _ (by simp only [SRefined.SV, List.mem_append]; left; left; right; exact hvf))\n    cases hfo : flagOf r.spec.f.flags v with\n    | none => exact absurd hvf (flagOf_none hfo)\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hfo\n      have hfull : flagOf r.full.f.flags v = some (substC r.wit p.2) := by\n        rw [sfull_flags, flagOf_append_right (hIVf v hv), flagOf_map, hfo]; rfl\n      rw [decideFlags_of, hfo, applyS_other (sr_wdom r hok hvi), decideFlags_of, hfull]\n      simp only\n      rw [subst_evalC, congrMC _ _ (withCarried r.full M κ) _ (fun mp hmp => hN mp (avoidsMaps_occ (rn_m (hsf p hp)) hmp))]\n      rw [congrC _ (applyS r.wit (decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ)) (withCarried r.full M κ)) _ p.2\n        (fun j hj => hQ j (avoids_occ (rn_v (hsf p hp)) hj))]\n  · rw [decide_other hvf]\n    have hX : v ∉ r.IV ++ flagVars r.spec.f.flags := by simp only [List.mem_append, not_or]; exact ⟨hv, hvf⟩\n    rw [hQ v hX]\n    simp only [applyS]\n    cases ha : assoc r.wit v with\n    | none =>\n      dsimp only\n      rw [decide_other (fun h' => by\n        simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n        rcases h' with h' | h'\n        · exact hIVf v hv h'\n        · exact hvf (by simpa [flagVars, Function.comp_def] using h'))]\n    | some e =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      exact congrE _ _ _ e (fun j hj => (decide_other (fun h' => avoidsE_occ (hwit _ hm).2 hj (sr_W r hok (Or.inl h'))) _ _).symm)\n\n-- A term of the spec, read in the spec's view, is the term with the witness put in, read in the composite's view; with a\n-- bound key of the spec set, alike.\ntheorem sr_term {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : readsNoneE r.IV r.IM e = true) :\n    evalE (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 (withCarried r.spec Ms κ) e\n      = evalE (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substE r.wit e) := by\n  rw [subst_evalE, congrME _ _ (withCarried r.full M κ) e (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMapsE_occ (rnE_m he) hmp))]\n  exact congrE _ _ _ e (fun j hj => sr_view r hok hag hmag ι κ j (avoidsE_occ (rnE_v he) hj))\n\ntheorem sr_cond {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {c : C} (hc : readsNone r.IV r.IM c = true) :\n    evalC (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 (withCarried r.spec Ms κ) c\n      = evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substC r.wit c) := by\n  rw [subst_evalC, congrMC _ _ (withCarried r.full M κ) c (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMaps_occ (rn_m hc) hmp))]\n  exact congrC _ _ _ c (fun j hj => sr_view r hok hag hmag ι κ j (avoids_occ (rn_v hc) hj))\n\ntheorem sr_term_upd {ρ σ : Nat → Nat} {M Ms : Nat → Nat → Nat} (hag : Agree r.X σ ρ) (hmag : ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) {e : E} (he : readsNoneE r.IV r.IM e = true) {k : Nat} (hk : k ∈ bkeys r.spec) (key : Nat) :\n    evalE (upd (sView r.spec σ Ms (applyS r.wit (sView r.full ρ M ι κ).1 (withCarried r.full M κ)) κ).1 k key) (withCarried r.spec Ms κ) e\n      = evalE (upd (sView r.full ρ M ι κ).1 k key) (withCarried r.full M κ) (substE r.wit e) := by\n  obtain ⟨_, hsi, _, _, _, hwit, _, _, _⟩ := srNames_parts (sr_names r hok)\n  have hkdom : k ∉ r.wit.map (·.1) := sr_wdom r hok (fun h' => hsi k h' (List.mem_append_right _ (by simp only [SRefined.SV, List.mem_append]; right; exact hk)))\n  rw [subst_evalE, congrME _ _ (withCarried r.full M κ) e (fun mp hmp => sr_maps r hok hmag κ mp (avoidsMapsE_occ (rnE_m he) hmp))]\n  apply congrE; intro j hj\n  by_cases hjk : j = k\n  · subst hjk; rw [applyS_other hkdom]; simp [upd]\n  · have hv := sr_view r hok hag hmag ι κ j (avoidsE_occ (rnE_v he) hj)\n    simp only [upd, hjk, if_false]\n    rw [hv]\n    simp only [applyS]\n    cases ha : assoc r.wit j with\n    | none => simp [upd, hjk]\n    | some e' =>\n      have hm := sr_wit_some r hok ha\n      dsimp only\n      exact (sr_wit_upd r hok (hwit _ hm).2 hk key).symm\n\n-- A variable none of the names the composite's view sets, nor the spec's: each view reads it as its state does.\ntheorem sr_plain_full {ρ : Nat → Nat} {M : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {v : Nat} (hv : v ∉ r.X) :\n    (sView r.full ρ M ι κ).1 v = ρ v := by\n  simp only [SRefined.X, SRefined.IV, List.mem_append, not_or] at hv\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨hi, _⟩, _⟩, hf⟩, hq⟩, _⟩, hsf⟩, hsq⟩, _⟩ := hv\n  simp only [sView]\n  rw [decide_other (fun h' => by\n    simp only [sfull_flags, flagVars, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact hf h'\n    · exact hsf (by simpa [flagVars, Function.comp_def] using h'))]\n  rw [decideQ_other (fun h' => by\n    simp only [SMachine.qVars, sfull_qflags, List.map_append, List.map_map, List.mem_append] at h'\n    rcases h' with h' | h'\n    · exact hq h'\n    · exact hsq (by simpa [SMachine.qVars, Function.comp_def] using h')), sfull_inputs]\n  exact withInputs_other hi ρ ι\n\ntheorem sr_plain_spec {σ : Nat → Nat} {Ms : Nat → Nat → Nat} (ι : Nat → Nat) (κ : Nat → Nat → Nat) {v : Nat} (hv : v ∉ r.X) :\n    (sView r.spec σ Ms ι κ).1 v = σ v := by\n  simp only [SRefined.X, List.mem_append, not_or] at hv\n  obtain ⟨⟨⟨_, hsf⟩, hsq⟩, hsi⟩ := hv\n  simp only [sView]\n  rw [decide_other hsf, decideQ_other hsq]\n  exact withInputs_other hsi σ ι\n\n/-- The spec's part of every reachable state of the composite is a reachable state of the spec, given that the spec's\nprecondition holds at every reachable state of the composite (one of its laws) and that, at every step the composite\ntakes, the spec stutters or allows the request it is sent (its step law). -/\ntheorem srefine_project (hpre : ∀ ρ M, SReach r.full ρ M → evalC ρ M r.spec.f.m.pre = true)\n    (hallow : ∀ ρ M, SReach r.full ρ M → ∀ ι κ, evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 r.full.f.m.assume = true →\n      evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 (.or r.stutter (substC r.wit r.spec.f.m.assume)) = true) :\n    ∀ {ρ M}, SReach r.full ρ M → ∃ σ Ms, SReach r.spec σ Ms ∧ Agree r.X σ ρ ∧ ∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = M mp := by\n  obtain ⟨hsa, _, hss, _, hsw, hse, _, hsp, _⟩ := srSpec_parts (sr_spec r hok)\n  obtain ⟨_, _, _, _, hcarO, _, hst, _, hsfacts⟩ := srNames_parts (sr_names r hok)\n  have hIVst : ∀ v, v ∉ r.IV → v ∉ r.impl.f.m.step.map (·.1) := fun v hv h' => hv (by simp only [SRefined.IV, List.mem_append]; left; left; left; right; exact h')\n  -- A map of the spec's part, unwritten by the implementation, read where the request carries none: the state's.\n  have hNc : ∀ (M : Nat → Nat → Nat) (κ : Nat → Nat → Nat) mp, mp ∉ r.IM → mp ∉ r.spec.carried → withCarried r.full M κ mp = M mp := fun M κ mp h1 h2 => by\n    show (if r.impl.carried.contains mp = true then κ mp else M mp) = M mp\n    rw [if_neg (fun hc => h1 (by\n      simp only [SRefined.IM, List.mem_append, List.mem_filter]; right\n      exact ⟨List.contains_iff_mem.mp hc, by simpa [List.contains_iff_mem] using h2⟩))]\n  have hIMe : ∀ mp, mp ∉ r.IM → lookup (fun w => w.1 == mp) r.impl.every = none := fun mp h => lookup_none (fun w hw => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; right; rw [← he]; exact List.mem_map_of_mem hw))\n  have hIMw : ∀ mp, mp ∉ r.IM → lookup (fun w : Nat × E × E => w.1 == mp) r.impl.f.m.writes = none := fun mp h => lookup_none (fun w hw => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact h (by simp only [SRefined.IM, SRefined.IO, List.mem_append]; left; left; right; rw [← he]; exact List.mem_map_of_mem hw))\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 _ _ =>\n    have hp0 : evalC ρ M r.spec.f.m.pre = true := by\n      have h := hpre _ M (SReach.start ρ M hM h0 (fun l hl => by simp [SRefined.full] at hl) (fun p hp => by simp [SRefined.full] at hp))\n      have hag0 : ∀ i, occC i r.spec.f.m.pre = true → applyS r.full.f.m.init ρ M i = ρ i := fun i hi => applyS_other (fun h' => by\n        apply avoids_occ (rn_v hsp) hi\n        rw [sfull_init] at h'\n        simp only [List.map_append, List.mem_append] at h'\n        rcases h' with h' | h' <;> simp [SRefined.X, SRefined.IV, SRefined.SV, h']) ρ M\n      rwa [congrC _ ρ M r.spec.f.m.pre hag0] at h\n    have hMs : StartMaps r.spec.f.m M := fun p hp' key => hM p (by rw [sfull_maps0]; exact List.mem_append_right _ hp') key\n    refine ⟨_, M, SReach.start ρ M hMs hp0 (fun l hl => by simp [hsfacts] at hl) (fun p hp => by simp [sr_pfacts r hok] at hp), fun i hi => ?_, fun _ _ _ => rfl⟩\n    show applyS r.spec.f.m.init ρ M i = applyS (r.impl.f.m.init ++ r.spec.f.m.init) ρ M i\n    rw [applyS_append_right (fun h' => hi (by simp [SRefined.X, SRefined.IV, h']))]\n  | step ρ M ι κ hr ha ih =>\n    obtain ⟨σ, Ms, hrs, hag, hmag⟩ := ih\n    have hA := hallow ρ M hr ι κ ha\n    simp only [evalC, Bool.or_eq_true, sView_snd] at hA\n    -- The composite's step at a variable of the spec's part: kept where it stutters, the spec's term otherwise.\n    have hstepS : ∀ v, v ∉ r.IV → (sNext r.full ρ M ι κ).1 v\n        = applyS (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))) (sView r.full ρ M ι κ).1 (withCarried r.full M κ) v :=\n      fun v hv => by simp only [sNext]; rw [sfull_step]; exact applyS_append_right (hIVst v hv) _ _\n    have hstutK : ∀ k ∈ bkeys r.spec, ∀ key, evalC (upd (sView r.full ρ M ι κ).1 k key) (withCarried r.full M κ) r.stutter\n        = evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter := fun k hk key => by\n      apply congrC; intro j hj; simp only [upd]; split\n      · rename_i h; subst h; exact absurd (by simp only [SRefined.W, List.mem_append]; right; exact hk) (avoids_occ hst hj)\n      · rfl\n    by_cases hstut : evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = true\n    · -- The spec doesn't step: its state is the same, and so is the composite's spec part.\n      refine ⟨σ, Ms, hrs, fun v hv => ?_, fun mp hmp hmc => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h'))))]\n        simp only [applyS]\n        cases hl : assoc (r.spec.f.m.step.map (fun p => (p.1, E.ite r.stutter (.var p.1) (substE r.wit p.2)))) v with\n        | none => dsimp only; rw [sr_plain_full r hok ι κ hv]; exact hag v hv\n        | some e =>\n          obtain ⟨q, hq, hqv, rfl⟩ : ∃ q ∈ r.spec.f.m.step, q.1 = v ∧ e = E.ite r.stutter (.var q.1) (substE r.wit q.2) := by\n            simp only [assoc, Option.map_eq_some_iff] at hl\n            obtain ⟨x, hx, rfl⟩ := hl\n            obtain ⟨hxm, hxv⟩ := lookup_some hx\n            obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hxm\n            simp only [beq_iff_eq] at hxv\n            exact ⟨q, hq, hxv, rfl⟩\n          dsimp only\n          simp only [evalE, hstut, if_true]\n          rw [hqv, sr_plain_full r hok ι κ hv]; exact hag v hv\n      · funext key\n        rw [hmag mp hmp hmc]\n        simp only [sNext, everyMaps, sView_snd]\n        rw [sfull_every, lookup_append, hIMe mp hmp]\n        simp only [lookup_emap]\n        cases hw : lookup (fun w => w.1 == mp) r.spec.every with\n        | some w =>\n          have hwm := (lookup_some hw).2\n          simp only [beq_iff_eq] at hwm\n          have hk : w.2.1 ∈ bkeys r.spec := by simp only [bkeys, List.mem_append]; left; exact List.mem_map_of_mem (lookup_some hw).1\n          simp only [Option.map_some, evalE]\n          rw [hstutK _ hk key]\n          simp only [hstut, if_true, upd, hwm, hNc M κ mp hmp hmc]\n        | none =>\n          simp only [Option.map_none, writeMaps]\n          rw [sfull_writes, lookup_append, hIMw mp hmp]\n          try dsimp only\n          rw [lookup_writes_map]\n          cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.f.m.writes with\n          | none => simp only [Option.map_none]; exact (congrFun (hNc M κ mp hmp hmc) key).symm\n          | some w0 =>\n            have hw0m := (lookup_some hw0).2\n            simp only [beq_iff_eq] at hw0m\n            simp only [Option.map_some, evalE, hstut, if_true, hw0m]\n            by_cases hk : key = evalE (sView r.full ρ M ι κ).1 (withCarried r.full M κ) (substE r.wit w0.2.1)\n            · rw [if_pos hk, ← hk]; exact (congrFun (hNc M κ mp hmp hmc) _).symm\n            · rw [if_neg hk]; exact (congrFun (hNc M κ mp hmp hmc) key).symm\n    · -- The spec steps, sent the witness's request, which it allows.\n      have hX := hA.resolve_left hstut\n      rw [← sr_cond r hok hag hmag ι κ (c := r.spec.f.m.assume) hsa] at hX\n      refine ⟨_, _, SReach.step σ Ms _ κ hrs hX, fun v hv => ?_, fun mp hmp hmc => ?_⟩\n      · rw [hstepS v (fun h' => hv (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ h'))))]\n        simp only [sNext, applyS, sView_snd]\n        rw [assoc_map_fst]\n        cases hl : lookup (fun q => q.1 == v) r.spec.f.m.step with\n        | none =>\n          have hn : assoc r.spec.f.m.step v = none := by simp only [assoc, hl, Option.map_none]\n          rw [hn]; dsimp only\n          rw [sr_plain_full r hok ι κ hv, sr_plain_spec r hok _ κ hv]; exact hag v hv\n        | some q =>\n          have hq := lookup_some hl\n          simp only [beq_iff_eq] at hq\n          have hn : assoc r.spec.f.m.step v = some q.2 := by simp only [assoc, hl, Option.map_some]\n          rw [hn]; dsimp only\n          simp only [Option.map_some, evalE, show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n          have hm : (v, q.2) ∈ r.spec.f.m.step := by rw [← hq.2]; exact hq.1\n          exact sr_term r hok hag hmag ι κ (hss (v, q.2) hm)\n      · funext key\n        simp only [sNext, everyMaps, sView_snd]\n        rw [sfull_every, lookup_append, hIMe mp hmp]\n        simp only [lookup_emap]\n        cases hw : lookup (fun w => w.1 == mp) r.spec.every with\n        | some w =>\n          have hk : w.2.1 ∈ bkeys r.spec := by simp only [bkeys, List.mem_append]; left; exact List.mem_map_of_mem (lookup_some hw).1\n          simp only [Option.map_some, evalE]\n          rw [hstutK _ hk key]\n          simp only [show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n          exact sr_term_upd r hok hag hmag ι κ (hse w (lookup_some hw).1) hk key\n        | none =>\n          simp only [Option.map_none, writeMaps]\n          rw [sfull_writes, lookup_append, hIMw mp hmp]\n          try dsimp only\n          rw [lookup_writes_map]\n          cases hw0 : lookup (fun w : Nat × E × E => w.1 == mp) r.spec.f.m.writes with\n          | none => simp only [Option.map_none]; exact congrFun (sr_maps r hok hmag κ mp hmp) key\n          | some w0 =>\n            obtain ⟨h1, h2⟩ := hsw w0 (lookup_some hw0).1\n            simp only [Option.map_some, evalE, show evalC (sView r.full ρ M ι κ).1 (withCarried r.full M κ) r.stutter = false by simpa using hstut, Bool.false_eq_true, if_false]\n            rw [sr_term r hok hag hmag ι κ h1, sr_term r hok hag hmag ι κ h2, sr_maps r hok hmag κ mp hmp]\nend sproject\n\n-- The composite's step law: on every request it takes, the spec stutters or allows the request it is sent.\ndef srStep (r : SRefined) (prime primeMaps : List (Nat × Nat)) (p : SProof) : SKStep :=\n  ⟨⟨[trueC], r.allowed, [[]], prime, primeMaps, p.1, (p.2.2.2.2.2.1, p.2.2.2.2.2.2.2)⟩, [[]], p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2.1, p.2.2.2.2.2.2.1, []⟩\n\n/-- What a refinement over sets means: with the relation (and the spec's precondition, the j-th law) proven of the\ncomposite, and its step law that the spec stutters or allows every request it is sent, every reachable state of the\nimplementation is, outside the spec's part, a reachable state of the composite, whose spec part is a reachable state of\nthe spec, the two related by every law. -/\ntheorem srefines (r : SRefined) (hok : srOk r = true) (hmo : distinct (r.spec.f.m.maps0.map (·.1)) = true) (ps : List SEntry)\n    (hl : checkSMachine r.full ps = true)\n    (j : Nat) (hj : (ps[j]?).map (·.law.holds) = some r.spec.f.m.pre ∧ (ps[j]?).map (·.law.key) = some none)\n    (prime primeMaps : List (Nat × Nat)) (p : SProof) (hs : checkSKStep r.full ps (srStep r prime primeMaps p) = true)\n    (hfresh : avoids (prime.map (·.2)) r.allowed = true ∧ avoidsMaps (primeMaps.map (·.2)) r.allowed = true)\n    (hw : avoids r.full.wVars r.allowed = true) (hiq : r.full.f.m.inputs.all (fun i => !r.full.qVars.contains i) = true) :\n    ∀ ρ M, SReach r.impl ρ M → ∃ ρc Mc σ Ms, SReach r.full ρc Mc ∧ Agree r.SV ρc ρ ∧ (∀ mp, mp ∉ r.SM → Mc mp = M mp)\n      ∧ SReach r.spec σ Ms ∧ Agree r.X σ ρc ∧ (∀ mp, mp ∉ r.IM → mp ∉ r.spec.carried → Ms mp = Mc mp) ∧ ∀ e ∈ ps, e.Holds ρc Mc := by\n  have hlaws := smachine_sound r.full ps hl\n  have hpre : ∀ ρ M, SReach r.full ρ M → evalC ρ M r.spec.f.m.pre = true := by\n    intro ρ M hr\n    cases he : ps[j]? with\n    | none => simp [he] at hj\n    | some e =>\n      simp only [he, Option.map_some, Option.some.injEq] at hj\n      have h := SEntry.holds_law (hlaws ρ M hr e (List.mem_of_getElem? he))\n      unfold MLaw.Holds at h\n      rw [hj.2] at h\n      simpa [hj.1] using h\n  have hiq' : ∀ i, i ∈ r.full.f.m.inputs → i ∉ r.full.qVars := fun i hi hq => by\n    simp only [List.all_eq_true, Bool.not_eq_true'] at hiq\n    have := hiq i hi; rw [List.contains_iff_mem.mpr hq] at this; cases this\n  have hallow : ∀ ρ M, SReach r.full ρ M → ∀ ι κ, evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 r.full.f.m.assume = true →\n      evalC (sView r.full ρ M ι κ).1 (sView r.full ρ M ι κ).2 (.or r.stutter (substC r.wit r.spec.f.m.assume)) = true := by\n    intro ρ M hr ι κ hA\n    have h := skstep_sound r.full ps _ hl hs ρ M hr (ι, κ) [] rfl ⟨hA, by simp [trueC, evalC, evalE], trivial⟩\n    have h' : evalC (primed prime (sNext r.full ρ M ι κ).1 (withExt r.full ρ (sReq r.full ρ M ι κ)))\n        (primedMaps primeMaps (sNext r.full ρ M ι κ).2 (withCarried r.full M κ)) r.allowed = true := by\n      simpa [srStep, sEnd, sExts, renEnv, renMaps, lookup] using h\n    rw [unprimed_evalC hfresh.1 hfresh.2] at h'\n    -- The request's extended variables, read as the step reads them: the inputs, and each quantified flag decided.\n    have hE : ∀ v, v ∉ r.full.wVars → withExt r.full ρ (sReq r.full ρ M ι κ) v\n        = decideQ r.full (withInputs r.full.f.m.inputs ρ ι) (withCarried r.full M κ) v := by\n      intro v hv\n      simp only [withExt, sReq]\n      by_cases hi : v ∈ r.full.f.m.inputs\n      · have hext : r.full.extVars.contains v = true := List.contains_iff_mem.mpr (by simp [SMachine.extVars, hi])\n        rw [decideQ_other (hiq' v hi)]\n        simp only [hext, if_true, List.contains_iff_mem.mpr hi, withInputs]\n      · have hin : r.full.f.m.inputs.contains v = false := by simpa [List.contains_iff_mem] using hi\n        by_cases hq : v ∈ r.full.qVars\n        · have hext : r.full.extVars.contains v = true := List.contains_iff_mem.mpr (by simp [SMachine.extVars, hq])\n          obtain ⟨q, hq0, rfl⟩ := List.mem_map.mp hq\n          cases hl : lookup (fun q' => q'.1 == q.1) r.full.qflags with\n          | none => have := lookup_none_all hl q hq0; simp at this\n          | some q' => simp only [hext, if_true, hin, Bool.false_eq_true, if_false, hl]\n        · have hext : r.full.extVars.contains v = false := by\n            simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, not_or]\n            simpa [List.contains_iff_mem] using (⟨hi, hq, hv⟩ : v ∉ r.full.f.m.inputs ∧ v ∉ r.full.qVars ∧ v ∉ r.full.wVars)\n          rw [decideQ_other hq, withInputs_other hi]\n          simp only [hext, Bool.false_eq_true, if_false]\n    rw [congrC _ _ _ r.allowed (fun i hi => hE i (avoids_occ hw hi))] at h'\n    simp only [SRefined.allowed] at h'\n    rw [inline_evalC] at h'\n    exact h'\n  intro ρ M hr\n  obtain ⟨ρc, Mc, hrc, hag, hmag⟩ := srefine_lift r hok hmo hr\n  obtain ⟨σ, Ms, hrs, hags, hmags⟩ := srefine_project r hok hpre hallow hrc\n  exact ⟨ρc, Mc, σ, Ms, hrc, hag, hmag, hrs, hags, hmags, hlaws ρc Mc hrc⟩\n\nend Kern\n\n#print axioms Kern.srefine_lift\n#print axioms Kern.srefine_project\n#print axioms Kern.srefines\n",
+    "Bridge.lean": "import Sets\nimport Cyclic\n\n/-!\nBridge: a cyclic proof of one of today's rules is a proof about the rule. Lean 4.34.0, core only, on top of\n`Sets.lean` and `Cyclic.lean`.\n\n`cyclic_sound` says what a cyclic proof's nodes say about any maps that meet its facts. core/cyclic.ts's instances say a\nrule in those terms, and this file says them back: what an instance's facts and nodes are is a function of the rule's\nown syntax here, a check (`cycMOk`) compares the exported proof against it, and a theorem carries the node to the rule's\nown meaning.\n\nMachines (`machineNodes`). A run of an `SMachine` (Sets.lean's `SReach`, with no flag that holds at every key) is put\nas maps over time: each state variable and input x as a map x@ whose cell u is x's value at time u (an input, the\nrequest taken at u), each map M (and each map a request carries) as a map M@ whose cell u + k·Ω is M's cell k at time u,\nΩ above the run's length T, so that u < Ω and the pair decodes (u = (u + k·Ω) % Ω, k = (u + k·Ω) / Ω) at every key k.\nThe facts are the start and each step (flags inlined), each map's start and step (a write at one key read at the key\nthe fact names), the functions' facts, and conditions that hold of every natural (`natC`). `cyc_machine_sound`: if the\nexported facts are among those, the node's hypotheses among the precondition, t ≤ T and T < Ω, and its conclusion the\nlaw at time t, then the law holds in every reachable state, at every value of its keys.\n-/\n\nnamespace Kern\nset_option linter.unusedSimpArgs false\nset_option linter.unusedSectionVars false\n\n/-! Lists and terms -/\n\ntheorem not_mem_of_not_contains {l : List Nat} {a : Nat} (h : (!l.contains a) = true) : a ∉ l := fun hm => by\n  rw [List.contains_iff_mem.mpr hm] at h; exact absurd h (by decide)\n\n-- A condition true of every natural: 0 ≤ e, and conjunctions of those.\ndef natC : C → Bool\n  | .le a _ => beqE a (.const 0)\n  | .and a b => natC a && natC b\n  | _ => false\n\ntheorem natC_true {ρ : Nat → Nat} {M : Nat → Nat → Nat} : ∀ c, natC c = true → evalC ρ M c = true\n  | .le a b, h => by simp only [natC] at h; rw [beqE_eq h]; simp [evalC, evalE]\n  | .and a b, h => by\n    simp only [natC, Bool.and_eq_true] at h; simp only [evalC, natC_true a h.1, natC_true b h.2, Bool.and_self]\n  | .lt _ _, h => by simp [natC] at h\n  | .eq _ _, h => by simp [natC] at h\n  | .or _ _, h => by simp [natC] at h\n  | .not _, h => by simp [natC] at h\n\n-- A list of conditions as their conjunction, as TypeScript's `and` and the exporter write it.\ndef andL : List C → C\n  | [] => trueC\n  | [a] => a\n  | a :: b :: rest => .and a (andL (b :: rest))\n\ntheorem andL_true {ρ : Nat → Nat} {M : Nat → Nat → Nat} : ∀ l : List C, (∀ c ∈ l, evalC ρ M c = true) → evalC ρ M (andL l) = true\n  | [], _ => by simp [andL, trueC, evalC, evalE]\n  | [a], h => by simpa [andL] using h a (by simp)\n  | a :: b :: rest, h => by\n    simp only [andL, evalC, Bool.and_eq_true]\n    exact ⟨h a (by simp), andL_true (b :: rest) (fun c hc => h c (List.mem_cons_of_mem _ hc))⟩\n\ntheorem evalE_ite_eq (ρ : Nat → Nat) (M : Nat → Nat → Nat) (a b t f : E) :\n    evalE ρ M (.ite (.eq a b) t f) = if evalE ρ M a = evalE ρ M b then evalE ρ M t else evalE ρ M f := by\n  show (if evalC ρ M (.eq a b) = true then evalE ρ M t else evalE ρ M f) = _\n  by_cases h : evalE ρ M a = evalE ρ M b\n  · rw [if_pos ((evalC_iff ρ M (.eq a b)).mpr h), if_pos h]\n  · rw [if_neg (fun hc => h ((evalC_iff ρ M (.eq a b)).mp hc)), if_neg h]\n\ntheorem impl_true {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : C} (h : evalC ρ M a = true → evalC ρ M b = true) :\n    evalC ρ M (.or (.not a) b) = true := by\n  cases ha : evalC ρ M a with\n  | false => simp [evalC, ha]\n  | true => simp [evalC, ha, h ha]\n\ntheorem congr2E {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (e : E) (hv : ∀ i, occE i e = true → ρ i = ρ' i)\n    (hm : ∀ m, occME m e = true → M m = M' m) : evalE ρ M e = evalE ρ' M' e := by\n  rw [congrE ρ ρ' M e hv, congrME ρ' M M' e hm]\ntheorem congr2C {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (c : C) (hv : ∀ i, occC i c = true → ρ i = ρ' i)\n    (hm : ∀ m, occMC m c = true → M m = M' m) : evalC ρ M c = evalC ρ' M' c := by\n  rw [congrC ρ ρ' M c hv, congrMC ρ' M M' c hm]\n\n-- Every read at the term `fr` read at `to` instead (core/cyclic.ts's readsAt): the same wherever the two are equal.\nmutual\ndef readsAtE (fr to : E) : E → E\n  | .var i => .var i\n  | .const n => .const n\n  | .add a b => .add (readsAtE fr to a) (readsAtE fr to b)\n  | .sub a b => .sub (readsAtE fr to a) (readsAtE fr to b)\n  | .mul k a => .mul k (readsAtE fr to a)\n  | .min a b => .min (readsAtE fr to a) (readsAtE fr to b)\n  | .max a b => .max (readsAtE fr to a) (readsAtE fr to b)\n  | .prod a b => .prod (readsAtE fr to a) (readsAtE fr to b)\n  | .ite c t f => .ite (readsAtC fr to c) (readsAtE fr to t) (readsAtE fr to f)\n  | .get m key => if beqE key fr then .get m to else .get m (readsAtE fr to key)\ndef readsAtC (fr to : E) : C → C\n  | .le a b => .le (readsAtE fr to a) (readsAtE fr to b)\n  | .lt a b => .lt (readsAtE fr to a) (readsAtE fr to b)\n  | .eq a b => .eq (readsAtE fr to a) (readsAtE fr to b)\n  | .and a b => .and (readsAtC fr to a) (readsAtC fr to b)\n  | .or a b => .or (readsAtC fr to a) (readsAtC fr to b)\n  | .not a => .not (readsAtC fr to a)\nend\n\nsection\nvariable {ρ : Nat → Nat} {M : Nat → Nat → Nat} {fr to : E} (h : evalE ρ M to = evalE ρ M fr)\ninclude h\nmutual\ntheorem readsAt_evalE : (e : E) → evalE ρ M (readsAtE fr to e) = evalE ρ M e\n  | .var _ => rfl\n  | .const _ => rfl\n  | .add a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .sub a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .mul k a => by simp only [readsAtE, evalE, readsAt_evalE a]\n  | .min a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .max a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .prod a b => by simp only [readsAtE, evalE, readsAt_evalE a, readsAt_evalE b]\n  | .ite c t f => by simp only [readsAtE, evalE, readsAt_evalC c, readsAt_evalE t, readsAt_evalE f]\n  | .get m key => by\n    simp only [readsAtE]\n    split\n    · rename_i hb; simp only [evalE, h, beqE_eq hb]\n    · simp only [evalE, readsAt_evalE key]\ntheorem readsAt_evalC : (c : C) → evalC ρ M (readsAtC fr to c) = evalC ρ M c\n  | .le a b => by simp only [readsAtC, evalC, readsAt_evalE a, readsAt_evalE b]\n  | .lt a b => by simp only [readsAtC, evalC, readsAt_evalE a, readsAt_evalE b]\n  | .eq a b => by simp only [readsAtC, evalC, readsAt_evalE a, readsAt_evalE b]\n  | .and a b => by simp only [readsAtC, evalC, readsAt_evalC a, readsAt_evalC b]\n  | .or a b => by simp only [readsAtC, evalC, readsAt_evalC a, readsAt_evalC b]\n  | .not a => by simp only [readsAtC, evalC, readsAt_evalC a]\nend\nend\n\ntheorem applyS_getD (σ : List (Nat × E)) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    applyS σ ρ M i = evalE ρ M ((assoc σ i).getD (.var i)) := by\n  simp only [applyS]; cases assoc σ i <;> rfl\n\ntheorem assoc_some_mem {σ : List (Nat × E)} {i : Nat} {e : E} (h : assoc σ i = some e) : (i, e) ∈ σ := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨p, hp, rfl⟩ := h\n  obtain ⟨hm, hq⟩ := lookup_some hp\n  have : p.1 = i := by simpa using hq\n  rw [← this]; exact hm\n\ntheorem pair_mod {u T : Nat} (h : u ≤ T) (kv : Nat) : (u + kv * (T + 1)) % (T + 1) = u := by\n  rw [Nat.add_mul_mod_self_right]; exact Nat.mod_eq_of_lt (by omega)\ntheorem pair_div {u T : Nat} (h : u ≤ T) (kv : Nat) : (u + kv * (T + 1)) / (T + 1) = kv := by\n  rw [Nat.add_mul_div_right _ _ (by omega), Nat.div_eq_of_lt (by omega), Nat.zero_add]\n\n/-! The encoding (core/cyclic.ts's machineNodes) as a function of the machine -/\n\n-- The variables a machine's facts and nodes add (a fact's time and key, the run's length, Ω, a node's time), and the\n-- maps over time: each state variable and input's, each map's.\nstructure CycEnc where\n  u : Nat\n  k : Nat\n  T : Nat\n  om : Nat\n  t : Nat\n  vtr : List (Nat × Nat)\n  mtr : List (Nat × Nat)\n\ndef CycEnc.special (ce : CycEnc) : List Nat := [ce.u, ce.k, ce.T, ce.om, ce.t]\ndef CycEnc.tm (ce : CycEnc) : List Nat := ce.vtr.map (·.2) ++ ce.mtr.map (·.2)\n\n-- A term at time w: each state variable and input read from its map at w, each map's cell k from its map at w + k·Ω.\ndef cycσ (ce : CycEnc) (w : E) : List (Nat × E) := ce.vtr.map fun p => (p.1, .get p.2 w)\ndef cycRd (ce : CycEnc) (w : E) : Nat → E → E := fun m key =>\n  match lookup (fun p => p.1 == m) ce.mtr with\n  | some p => .get p.2 (.add w (.prod key (.var ce.om)))\n  | none => .get m key\ndef trE (ce : CycEnc) (w : E) : E → E := substRE (cycσ ce w) (cycRd ce w)\ndef trC (ce : CycEnc) (w : E) : C → C := substRC (cycσ ce w) (cycRd ce w)\n\ndef cycStepped (ce : CycEnc) : C := .and (.le (.const 1) (.var ce.u)) (.le (.var ce.u) (.var ce.T))\ndef cycPrev (ce : CycEnc) : E := .sub (.var ce.u) (.const 1)\ndef cycCell (ce : CycEnc) (m : Nat) (w : E) : E := cycRd ce w m (.var ce.k)\ndef cycStepTerm (s : SMachine) (x : Nat) : E := (assoc s.f.m.step x).getD (.var x)\n\ndef cycStart (s : SMachine) (ce : CycEnc) : Fact :=\n  ⟨[ce.u], .or (.not (.le (.var ce.u) (.const 0))) (andL (trueC :: s.f.m.init.map fun p => .eq (trE ce (.var ce.u) (.var p.1)) p.2))⟩\ndef cycStep (s : SMachine) (ce : CycEnc) (withAssume : Bool) : Fact :=\n  ⟨[ce.u], .or (.not (cycStepped ce)) (andL (trueC :: ((if withAssume then [trC ce (cycPrev ce) (inlineC s.f.flags s.f.m.assume)] else [])\n    ++ s.f.m.init.map fun p => .eq (trE ce (.var ce.u) (.var p.1)) (trE ce (cycPrev ce) (inlineE s.f.flags (cycStepTerm s p.1))))))⟩\n-- A map's cell k after a step: a write at every key, its value at k; a write at one key, where k is the key, its value\n-- read at k; else the cell before.\ndef cycNext (s : SMachine) (ce : CycEnc) (m : Nat) : E :=\n  match lookup (fun w => w.1 == m) s.every with\n  | some w => trE ce (cycPrev ce) (inlineE s.f.flags (substE [(w.2.1, .var ce.k)] w.2.2))\n  | none => match lookup (fun w => w.1 == m) s.f.m.writes with\n    | some w => .ite (.eq (.var ce.k) (trE ce (cycPrev ce) (inlineE s.f.flags w.2.1)))\n        (trE ce (cycPrev ce) (readsAtE (inlineE s.f.flags w.2.1) (.var ce.k) (inlineE s.f.flags w.2.2))) (cycCell ce m (cycPrev ce))\n    | none => cycCell ce m (cycPrev ce)\ndef cycMapFacts (s : SMachine) (ce : CycEnc) : List Fact := s.f.m.maps0.flatMap fun p =>\n  [⟨[ce.u, ce.k], .or (.not (.le (.var ce.u) (.const 0))) (.eq (cycCell ce p.1 (.var ce.u)) (.const p.2))⟩,\n   ⟨[ce.u, ce.k], .or (.not (cycStepped ce)) (.eq (cycCell ce p.1 (.var ce.u)) (cycNext s ce p.1))⟩]\n-- The functions' facts, each with its further keys.\ndef cycGiven (s : SMachine) : List (MLaw × List Nat) := s.facts.map (fun l => (l, [])) ++ s.pfacts\ndef cycFnFacts (s : SMachine) : List Fact := (cycGiven s).map fun p => ⟨p.1.key.toList ++ p.2, p.1.holds⟩\n-- The step with the assumption and without it (core/cyclic.ts leaves it out when the machine has none).\ndef cycCanon (s : SMachine) (ce : CycEnc) : List Fact :=\n  cycStart s ce :: cycStep s ce true :: cycStep s ce false :: (cycMapFacts s ce ++ cycFnFacts s)\n\n/-! The check -/\n\ndef cycZ (ce : CycEnc) (keys : List Nat) : List Nat := ce.special ++ keys\ndef cycP (s : SMachine) (ce : CycEnc) (keys : List Nat) : List Nat := cycZ ce keys ++ ce.vtr.map (·.1) ++ flagVars s.f.flags\n\n-- The encoding fits the machine: every variable a step changes has its map over time, every map a step or a request\n-- changes has its own, those maps are fresh, and the added variables are apart from the machine's.\ndef cycShapeOk (s : SMachine) (ce : CycEnc) (keys : List Nat) : Bool :=\n  s.qflags.isEmpty && flagsOk s.f.flags && distinct ce.special && distinct ce.tm\n    && (cycZ ce keys).all (fun z => !(ce.vtr.map (·.1)).contains z && !(flagVars s.f.flags).contains z)\n    && keys.all (fun z => !ce.special.contains z)\n    && ce.tm.all (fun m => !(ce.mtr.map (·.1)).contains m)\n    && s.f.m.init.all (fun p => (ce.vtr.map (·.1)).contains p.1 && !s.f.m.inputs.contains p.1)\n    && s.f.m.step.all (fun p => (ce.vtr.map (·.1)).contains p.1)\n    && s.f.m.inputs.all (fun x => (ce.vtr.map (·.1)).contains x)\n    && distinct (s.f.m.init.map (·.1))\n    && s.f.m.maps0.all (fun p => (ce.mtr.map (·.1)).contains p.1 && !s.carried.contains p.1)\n    && s.carried.all (fun m => (ce.mtr.map (·.1)).contains m)\n    && s.f.m.writes.all (fun w => (ce.mtr.map (·.1)).contains w.1)\n    && s.every.all (fun w => (ce.mtr.map (·.1)).contains w.1)\n\n-- The machine's terms read none of the added variables nor the maps over time; what is read at the start (the start\n-- terms, the precondition, the functions' facts) reads no variable a step changes either.\ndef cycTermsOk (s : SMachine) (ce : CycEnc) (keys : List Nat) : Bool :=\n  s.f.flags.all (fun p => avoids (cycZ ce keys) p.2 && avoidsMaps ce.tm p.2)\n    && s.f.m.step.all (fun p => avoidsE (cycZ ce keys) p.2 && avoidsMapsE ce.tm p.2)\n    && s.f.m.writes.all (fun w => avoidsE (cycZ ce keys) w.2.1 && avoidsMapsE ce.tm w.2.1 && avoidsE (cycZ ce keys) w.2.2 && avoidsMapsE ce.tm w.2.2)\n    && s.every.all (fun w => (cycZ ce keys).all (fun z => z == w.2.1 || !occE z w.2.2) && avoidsMapsE ce.tm w.2.2)\n    && avoids (cycZ ce keys) s.f.m.assume && avoidsMaps ce.tm s.f.m.assume\n    && s.f.m.init.all (fun p => avoidsE (cycP s ce keys) p.2 && avoidsMapsE ce.tm p.2)\n    && avoids (cycP s ce keys) s.f.m.pre && avoidsMaps ce.tm s.f.m.pre\n    && (cycGiven s).all (fun g => (cycP s ce keys).all (fun z => g.1.key == some z || g.2.contains z || !occC z g.1.holds)\n      && avoidsMaps ce.tm g.1.holds)\n\n-- The law reads no added variable, no input, no map over time and no map a request carries.\ndef cycLawOk (s : SMachine) (ce : CycEnc) (law : C) : Bool :=\n  avoids (ce.special ++ s.f.m.inputs) law && avoidsMaps (ce.tm ++ s.carried) law\n\ndef factBeq (f g : Fact) : Bool := f.keys == g.keys && beqC f.holds g.holds\n\n-- Each exported fact is one of the encoding's, or true of every natural.\ndef cycFactsIn (s : SMachine) (ce : CycEnc) (facts : List Fact) : Bool :=\n  facts.all fun f => natC f.holds || (cycCanon s ce).any (factBeq f)\n\n-- The node: its conclusion the law at time t, its hypotheses among the precondition, t ≤ T and T < Ω.\ndef cycNodeOk (s : SMachine) (ce : CycEnc) (law : C) (n : CNode) : Bool :=\n  beqC n.concl (trC ce (.var ce.t) law)\n    && n.hyps.all (fun h => beqC h s.f.m.pre || beqC h (.le (.var ce.t) (.var ce.T)) || beqC h (.lt (.var ce.T) (.var ce.om)))\n\ndef cycMOk (s : SMachine) (ce : CycEnc) (facts : List Fact) (law : C) (keys : List Nat) (n : CNode) : Bool :=\n  cycShapeOk s ce keys && cycTermsOk s ce keys && cycLawOk s ce law && cycFactsIn s ce facts && cycNodeOk s ce law n\n\n/-! The checks, as propositions -/\n\ntheorem and_parts {a b : Bool} (h : (a && b) = true) : a = true ∧ b = true := by\n  cases a <;> cases b <;> simp_all\n\ntheorem mem_toList {o : Option Nat} {j : Nat} (h : j ∈ o.toList) : o = some j := by\n  cases o <;> simp_all [Option.toList]\n\ntheorem isEmpty_nil {α : Type} {l : List α} (h : l.isEmpty = true) : l = [] := by\n  cases l\n  · rfl\n  · simp [List.isEmpty] at h\n\nstructure CycShape (s : SMachine) (ce : CycEnc) (keys : List Nat) : Prop where\n  q : s.qflags = []\n  fl : flagsOk s.f.flags = true\n  dsp : distinct ce.special = true\n  dtm : distinct ce.tm = true\n  zv : ∀ z ∈ cycZ ce keys, z ∉ ce.vtr.map (·.1)\n  zf : ∀ z ∈ cycZ ce keys, z ∉ flagVars s.f.flags\n  ks : ∀ z ∈ keys, z ∉ ce.special\n  tmd : ∀ m ∈ ce.tm, m ∉ ce.mtr.map (·.1)\n  initv : ∀ p ∈ s.f.m.init, p.1 ∈ ce.vtr.map (·.1)\n  initin : ∀ p ∈ s.f.m.init, p.1 ∉ s.f.m.inputs\n  stepv : ∀ p ∈ s.f.m.step, p.1 ∈ ce.vtr.map (·.1)\n  inv : ∀ x ∈ s.f.m.inputs, x ∈ ce.vtr.map (·.1)\n  dinit : distinct (s.f.m.init.map (·.1)) = true\n  m0 : ∀ p ∈ s.f.m.maps0, p.1 ∈ ce.mtr.map (·.1)\n  m0c : ∀ p ∈ s.f.m.maps0, p.1 ∉ s.carried\n  carm : ∀ m ∈ s.carried, m ∈ ce.mtr.map (·.1)\n  wrm : ∀ w ∈ s.f.m.writes, w.1 ∈ ce.mtr.map (·.1)\n  evm : ∀ w ∈ s.every, w.1 ∈ ce.mtr.map (·.1)\n\ntheorem cycShape_of {s : SMachine} {ce : CycEnc} {keys : List Nat} (h : cycShapeOk s ce keys = true) : CycShape s ce keys := by\n  simp only [cycShapeOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hq, hfl⟩, hdsp⟩, hdtm⟩, hz⟩, hks⟩, htm⟩, hinit⟩, hstep⟩, hin⟩, hdi⟩, hm0⟩, hcar⟩, hwr⟩, hev⟩ := h\n  have hz' := List.all_eq_true.mp hz\n  have hinit' := List.all_eq_true.mp hinit\n  have hm0' := List.all_eq_true.mp hm0\n  refine ⟨isEmpty_nil hq, hfl, hdsp, hdtm, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, hdi, ?_, ?_, ?_, ?_, ?_⟩\n  · intro z hzm; exact not_mem_of_not_contains (and_parts (hz' z hzm)).1\n  · intro z hzm; exact not_mem_of_not_contains (and_parts (hz' z hzm)).2\n  · intro z hzm; exact not_mem_of_not_contains (List.all_eq_true.mp hks z hzm)\n  · intro m hm; exact not_mem_of_not_contains (List.all_eq_true.mp htm m hm)\n  · intro p hp; exact List.contains_iff_mem.mp (and_parts (hinit' p hp)).1\n  · intro p hp; exact not_mem_of_not_contains (and_parts (hinit' p hp)).2\n  · intro p hp; exact List.contains_iff_mem.mp (List.all_eq_true.mp hstep p hp)\n  · intro x hx; exact List.contains_iff_mem.mp (List.all_eq_true.mp hin x hx)\n  · intro p hp; exact List.contains_iff_mem.mp (and_parts (hm0' p hp)).1\n  · intro p hp; exact not_mem_of_not_contains (and_parts (hm0' p hp)).2\n  · intro m hm; exact List.contains_iff_mem.mp (List.all_eq_true.mp hcar m hm)\n  · intro w hw; exact List.contains_iff_mem.mp (List.all_eq_true.mp hwr w hw)\n  · intro w hw; exact List.contains_iff_mem.mp (List.all_eq_true.mp hev w hw)\n\nstructure CycTerms (s : SMachine) (ce : CycEnc) (keys : List Nat) : Prop where\n  flz : ∀ p ∈ s.f.flags, avoids (cycZ ce keys) p.2 = true\n  flm : ∀ p ∈ s.f.flags, avoidsMaps ce.tm p.2 = true\n  stz : ∀ p ∈ s.f.m.step, avoidsE (cycZ ce keys) p.2 = true\n  stm : ∀ p ∈ s.f.m.step, avoidsMapsE ce.tm p.2 = true\n  wkz : ∀ w ∈ s.f.m.writes, avoidsE (cycZ ce keys) w.2.1 = true\n  wkm : ∀ w ∈ s.f.m.writes, avoidsMapsE ce.tm w.2.1 = true\n  wvz : ∀ w ∈ s.f.m.writes, avoidsE (cycZ ce keys) w.2.2 = true\n  wvm : ∀ w ∈ s.f.m.writes, avoidsMapsE ce.tm w.2.2 = true\n  evz : ∀ w ∈ s.every, ∀ z ∈ cycZ ce keys, z ≠ w.2.1 → occE z w.2.2 = false\n  evm : ∀ w ∈ s.every, avoidsMapsE ce.tm w.2.2 = true\n  asz : avoids (cycZ ce keys) s.f.m.assume = true\n  asm : avoidsMaps ce.tm s.f.m.assume = true\n  inz : ∀ p ∈ s.f.m.init, avoidsE (cycP s ce keys) p.2 = true\n  inm : ∀ p ∈ s.f.m.init, avoidsMapsE ce.tm p.2 = true\n  prz : avoids (cycP s ce keys) s.f.m.pre = true\n  prm : avoidsMaps ce.tm s.f.m.pre = true\n  gz : ∀ g ∈ cycGiven s, ∀ z ∈ cycP s ce keys, g.1.key ≠ some z → z ∉ g.2 → occC z g.1.holds = false\n  gm : ∀ g ∈ cycGiven s, avoidsMaps ce.tm g.1.holds = true\n\ntheorem cycTerms_of {s : SMachine} {ce : CycEnc} {keys : List Nat} (h : cycTermsOk s ce keys = true) : CycTerms s ce keys := by\n  simp only [cycTermsOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨hfl, hst⟩, hw⟩, hev⟩, has⟩, ham⟩, hin⟩, hpz⟩, hpm⟩, hg⟩ := h\n  have hfl' := List.all_eq_true.mp hfl\n  have hst' := List.all_eq_true.mp hst\n  have hw' := List.all_eq_true.mp hw\n  have hev' := List.all_eq_true.mp hev\n  have hin' := List.all_eq_true.mp hin\n  have hg' := List.all_eq_true.mp hg\n  refine ⟨fun p hp => (and_parts (hfl' p hp)).1, fun p hp => (and_parts (hfl' p hp)).2,\n    fun p hp => (and_parts (hst' p hp)).1, fun p hp => (and_parts (hst' p hp)).2,\n    fun w hw => (and_parts (and_parts (and_parts (hw' w hw)).1).1).1, fun w hw => (and_parts (and_parts (and_parts (hw' w hw)).1).1).2,\n    fun w hw => (and_parts (and_parts (hw' w hw)).1).2, fun w hw => (and_parts (hw' w hw)).2,\n    fun w hw z hz hne => ?_, fun w hw => (and_parts (hev' w hw)).2,\n    has, ham, fun p hp => (and_parts (hin' p hp)).1, fun p hp => (and_parts (hin' p hp)).2, hpz, hpm,\n    fun g hg z hz hk hgs => ?_, fun g hg => (and_parts (hg' g hg)).2⟩\n  · have := List.all_eq_true.mp (and_parts (hev' w hw)).1 z hz\n    cases hb : (z == w.2.1)\n    · rw [hb] at this; simpa using this\n    · exact absurd (beq_iff_eq.mp hb) hne\n  · have := List.all_eq_true.mp (and_parts (hg' g hg)).1 z hz\n    have h1 : (g.1.key == some z) = false := by\n      cases hb : (g.1.key == some z)\n      · rfl\n      · exact absurd (beq_iff_eq.mp hb) hk\n    have h2 : g.2.contains z = false := by\n      cases hb : g.2.contains z\n      · rfl\n      · exact absurd (List.contains_iff_mem.mp hb) hgs\n    rw [h1, h2] at this; simpa using this\n\n/-! A run, step by step -/\n\nstructure CRun where\n  ρ0 : Nat → Nat                  -- before the start\n  st : Nat → Nat → Nat            -- the state at each time\n  mp : Nat → Nat → Nat → Nat      -- the maps at each time\n  ι : Nat → Nat → Nat             -- the request taken at each time\n  κ : Nat → Nat → Nat → Nat       -- the maps it carries\n\ndef CRun.N (s : SMachine) (r : CRun) (u : Nat) : Nat → Nat → Nat := withCarried s (r.mp u) (r.κ u)\ndef CRun.X (s : SMachine) (r : CRun) (u : Nat) : Nat → Nat := withInputs s.f.m.inputs (r.st u) (r.ι u)\ndef CRun.V (s : SMachine) (r : CRun) (u : Nat) : Nat → Nat := decideFlags s.f.flags (r.X s u) (r.N s u)\n\n-- A run of T steps from a start SReach allows.\nstructure CRun.Ok (s : SMachine) (r : CRun) (T : Nat) : Prop where\n  maps0 : StartMaps s.f.m (r.mp 0)\n  pre : evalC r.ρ0 (r.mp 0) s.f.m.pre = true\n  facts : ∀ l ∈ s.facts, l.Holds r.ρ0 (r.mp 0)\n  pfacts : s.PFacts r.ρ0 (r.mp 0)\n  init : r.st 0 = applyS s.f.m.init r.ρ0 (r.mp 0)\n  step : ∀ u, u < T → evalC (r.V s u) (r.N s u) s.f.m.assume = true ∧ r.st (u + 1) = applyS s.f.m.step (r.V s u) (r.N s u)\n    ∧ r.mp (u + 1) = everyMaps s (r.V s u) (r.N s u)\n\n-- The run with one more step.\ndef CRun.snoc (r : CRun) (T : Nat) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : CRun :=\n  ⟨r.ρ0, fun u => if u ≤ T then r.st u else ρ, fun u => if u ≤ T then r.mp u else M,\n    fun u => if u < T then r.ι u else ι, fun u => if u < T then r.κ u else κ⟩\n\ntheorem decideQ_nil {s : SMachine} (hq : s.qflags = []) (X : Nat → Nat) (N : Nat → Nat → Nat) : decideQ s X N = X := by\n  funext v; simp only [decideQ, hq, lookup]\n\ntheorem snoc_early {s : SMachine} {r : CRun} {T u : Nat} (hu : u < T) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat)\n    (κ : Nat → Nat → Nat) : (r.snoc T ρ M ι κ).N s u = r.N s u ∧ (r.snoc T ρ M ι κ).V s u = r.V s u\n      ∧ (r.snoc T ρ M ι κ).st (u + 1) = r.st (u + 1) ∧ (r.snoc T ρ M ι κ).mp (u + 1) = r.mp (u + 1) := by\n  have h1 : u ≤ T := Nat.le_of_lt hu\n  have h2 : u + 1 ≤ T := hu\n  refine ⟨?_, ?_, ?_, ?_⟩ <;> simp only [CRun.V, CRun.X, CRun.N, CRun.snoc, if_pos h1, if_pos hu, if_pos h2]\n\ntheorem snoc_zero {r : CRun} {T : Nat} (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (r.snoc T ρ M ι κ).ρ0 = r.ρ0 ∧ (r.snoc T ρ M ι κ).st 0 = r.st 0 ∧ (r.snoc T ρ M ι κ).mp 0 = r.mp 0 := by\n  refine ⟨rfl, ?_, ?_⟩ <;> simp only [CRun.snoc, if_pos (Nat.zero_le T)]\n\ntheorem snoc_last {r : CRun} {T : Nat} (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    (r.snoc T ρ M ι κ).st (T + 1) = ρ ∧ (r.snoc T ρ M ι κ).mp (T + 1) = M ∧ (r.snoc T ρ M ι κ).st T = r.st T\n      ∧ (r.snoc T ρ M ι κ).mp T = r.mp T ∧ (r.snoc T ρ M ι κ).ι T = ι ∧ (r.snoc T ρ M ι κ).κ T = κ := by\n  have h1 : ¬ T + 1 ≤ T := by omega\n  have h2 : ¬ T < T := Nat.lt_irrefl T\n  refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ <;> simp only [CRun.snoc, if_neg h1, if_neg h2, if_pos (Nat.le_refl T)]\n\n-- A reachable state is the end of a run (no flag holds at every key).\ntheorem reach_run {s : SMachine} (hq : s.qflags = []) :\n    ∀ {ρ M}, SReach s ρ M → ∃ (r : CRun) (T : Nat), r.Ok s T ∧ r.st T = ρ ∧ r.mp T = M := by\n  intro ρ M h\n  induction h with\n  | start ρ M hM hp hf hpf =>\n    exact ⟨⟨ρ, fun _ => applyS s.f.m.init ρ M, fun _ => M, fun _ => ρ, fun _ => M⟩, 0,\n      ⟨hM, hp, hf, hpf, rfl, fun u hu => absurd hu (Nat.not_lt_zero u)⟩, rfl, rfl⟩\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨r, T, hr, hst, hmp⟩ := ih\n    have hv : sView s ρ M ι κ = (decideFlags s.f.flags (withInputs s.f.m.inputs ρ ι) (withCarried s M κ), withCarried s M κ) := by\n      simp only [sView, decideQ_nil hq]\n    obtain ⟨l1, l2, l3, l4, l5, l6⟩ := snoc_last (r := r) (T := T) (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ\n    obtain ⟨z1, z2, z3⟩ := snoc_zero (r := r) (T := T) (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ\n    have hN : (r.snoc T (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ).N s T = (sView s ρ M ι κ).2 := by\n      rw [hv, CRun.N, l4, l6, hmp]\n    have hV : (r.snoc T (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ).V s T = (sView s ρ M ι κ).1 := by\n      rw [CRun.V, hN, CRun.X, l3, l5, hst, hv]\n    refine ⟨r.snoc T (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ, T + 1, ⟨?_, ?_, ?_, ?_, ?_, ?_⟩, l1, l2⟩\n    · rw [z3]; exact hr.maps0\n    · rw [z1, z3]; exact hr.pre\n    · rw [z1, z3]; exact hr.facts\n    · rw [z1, z3]; exact hr.pfacts\n    · rw [z1, z2, z3]; exact hr.init\n    · intro u hu\n      rcases Nat.lt_or_ge u T with hlt | hge\n      · obtain ⟨e1, e2, e3, e4⟩ := snoc_early (s := s) (r := r) hlt (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ\n        rw [e1, e2, e3, e4]; exact hr.step u hlt\n      · have hu' : u = T := by omega\n        rw [hu', hV, hN, l1, l2]\n        exact ⟨ha, rfl, rfl⟩\n\nsection run\nvariable {s : SMachine} {r : CRun} {T : Nat} (hr : r.Ok s T)\ninclude hr\n\n-- What no step changes keeps its value from before the start.\ntheorem run_frame : ∀ u, u ≤ T → ∀ i, i ∉ s.f.m.init.map (·.1) → i ∉ s.f.m.step.map (·.1) → i ∉ s.f.m.inputs →\n    i ∉ flagVars s.f.flags → r.st u i = r.ρ0 i := by\n  intro u\n  induction u with\n  | zero => intro _ i hi _ _ _; rw [hr.init]; exact applyS_other hi _ _\n  | succ u ih =>\n    intro hu i hi hs hin hf\n    rw [(hr.step u (by omega)).2.1, applyS_other hs, CRun.V, decide_other hf, CRun.X, withInputs_other hin]\n    exact ih (by omega) i hi hs hin hf\n\n-- A map no step writes and no request carries keeps its cells.\ntheorem run_maps {D : List Nat} (hc : ∀ m ∈ s.carried, m ∈ D) (hw : ∀ w ∈ s.f.m.writes, w.1 ∈ D) (he : ∀ w ∈ s.every, w.1 ∈ D) :\n    ∀ u, u ≤ T → ∀ m, m ∉ D → r.mp u m = r.mp 0 m := by\n  intro u\n  induction u with\n  | zero => intros; rfl\n  | succ u ih =>\n    intro hu m hm\n    rw [(hr.step u (by omega)).2.2]\n    funext key\n    have hne : lookup (fun w => w.1 == m) s.every = none :=\n      lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro h; exact hm (h ▸ he w hw'))\n    have hnw : lookup (fun w => w.1 == m) s.f.m.writes = none :=\n      lookup_none (fun w hw' => by simp only [beq_eq_false_iff_ne]; intro h; exact hm (h ▸ hw w hw'))\n    have hnc : ¬ s.carried.contains m = true := fun h => hm (hc m (List.contains_iff_mem.mp h))\n    simp only [everyMaps, hne, writeMaps, hnw, CRun.N, withCarried]\n    rw [if_neg hnc]\n    exact congrFun (ih (by omega) m hm) key\nend run\n\ntheorem N_not_carried {s : SMachine} {r : CRun} {u m : Nat} (hm : m ∉ s.carried) : r.N s u m = r.mp u m := by\n  simp only [CRun.N, withCarried]\n  rw [if_neg (fun h => hm (List.contains_iff_mem.mp h))]\n\n/-! The run as maps over time -/\n\ndef cycMaps (s : SMachine) (ce : CycEnc) (r : CRun) (om : Nat) : Nat → Nat → Nat := fun i =>\n  match lookup (fun p => p.2 == i) ce.vtr with\n  | some p => fun u => r.X s u p.1\n  | none => match lookup (fun p => p.2 == i) ce.mtr with\n    | some p => fun y => r.N s (y % om) p.1 (y / om)\n    | none => r.mp 0 i\n\n-- The maps a step at time u reads, as the encoding gives them: the maps over time as they are, the rest as the run's.\ndef cycView (s : SMachine) (ce : CycEnc) (r : CRun) (om u : Nat) : Nat → Nat → Nat := fun m =>\n  if ce.tm.contains m then cycMaps s ce r om m else r.N s u m\n\n-- The node's environment: t and T the run's length, Ω one above it.\ndef cycEnv (ce : CycEnc) (T : Nat) (ρ' : Nat → Nat) : Nat → Nat := fun i =>\n  if i = ce.t then T else if i = ce.T then T else if i = ce.om then T + 1 else ρ' i\n\n-- An environment a fact is read at: T and Ω as the node's, and from before the start wherever no step reaches.\ndef EnvOk (s : SMachine) (ce : CycEnc) (keys : List Nat) (r : CRun) (T : Nat) (Q : Nat → Nat) : Prop :=\n  Q ce.T = T ∧ Q ce.om = T + 1 ∧ ∀ i, i ∉ cycP s ce keys → Q i = r.ρ0 i\n\nsection enc\nvariable {s : SMachine} {ce : CycEnc} {keys : List Nat} {r : CRun} {T : Nat}\n\ntheorem tm_parts (hd : distinct ce.tm = true) :\n    distinct (ce.vtr.map (·.2)) = true ∧ distinct (ce.mtr.map (·.2)) = true ∧ ∀ a ∈ ce.vtr.map (·.2), a ∉ ce.mtr.map (·.2) :=\n  distinct_append hd\n\ntheorem cm_v (hd : distinct ce.tm = true) {om : Nat} {p : Nat × Nat} (hp : p ∈ ce.vtr) :\n    cycMaps s ce r om p.2 = fun u => r.X s u p.1 := by\n  simp only [cycMaps, lookup_ren (tm_parts hd).1 p hp]\n\ntheorem cm_m (hd : distinct ce.tm = true) {om : Nat} {p : Nat × Nat} (hp : p ∈ ce.mtr) :\n    cycMaps s ce r om p.2 = fun y => r.N s (y % om) p.1 (y / om) := by\n  obtain ⟨_, h2, h3⟩ := tm_parts hd\n  have hn : lookup (fun q => q.2 == p.2) ce.vtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact h3 q.2 (List.mem_map.mpr ⟨q, hq, rfl⟩) (List.mem_map.mpr ⟨p, hp, he.symm⟩))\n  simp only [cycMaps, hn, lookup_ren h2 p hp]\n\ntheorem cm_o {om i : Nat} (hi : i ∉ ce.tm) : cycMaps s ce r om i = r.mp 0 i := by\n  have h1 : lookup (fun q => q.2 == i) ce.vtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact hi (List.mem_append_left _ (List.mem_map.mpr ⟨q, hq, he⟩)))\n  have h2 : lookup (fun q => q.2 == i) ce.mtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact hi (List.mem_append_right _ (List.mem_map.mpr ⟨q, hq, he⟩)))\n  simp only [cycMaps, h1, h2]\n\ntheorem cv_N {om u m : Nat} (hm : m ∉ ce.tm) : cycView s ce r om u m = r.N s u m := by\n  simp only [cycView]\n  rw [if_neg (fun h => hm (List.contains_iff_mem.mp h))]\n\ntheorem notP {i : Nat} (h : i ∉ cycP s ce keys) :\n    i ∉ ce.special ∧ i ∉ keys ∧ i ∉ ce.vtr.map (·.1) ∧ i ∉ flagVars s.f.flags := by\n  simp only [cycP, cycZ, List.mem_append, not_or] at h\n  exact ⟨h.1.1.1, h.1.1.2, h.1.2, h.2⟩\n\ntheorem special_parts (h : distinct ce.special = true) :\n    ce.u ≠ ce.T ∧ ce.u ≠ ce.om ∧ ce.k ≠ ce.T ∧ ce.k ≠ ce.om ∧ ce.T ≠ ce.om ∧ ce.t ≠ ce.T ∧ ce.t ≠ ce.om := by\n  have h0 : distinct [ce.u, ce.k, ce.T, ce.om, ce.t] = true := h\n  obtain ⟨n1, d1⟩ := distinct_cons h0\n  obtain ⟨n2, d2⟩ := distinct_cons d1\n  obtain ⟨n3, d3⟩ := distinct_cons d2\n  obtain ⟨n4, _⟩ := distinct_cons d3\n  refine ⟨fun e => n1 (by rw [e]; simp), fun e => n1 (by rw [e]; simp), fun e => n2 (by rw [e]; simp),\n    fun e => n2 (by rw [e]; simp), fun e => n3 (by rw [e]; simp), fun e => n3 (by rw [← e]; simp), fun e => n4 (by rw [← e]; simp)⟩\n\ntheorem in_special {i : Nat} (h : i = ce.u ∨ i = ce.k ∨ i = ce.T ∨ i = ce.om ∨ i = ce.t) : i ∈ ce.special := by\n  simp only [CycEnc.special, List.mem_cons, List.not_mem_nil, or_false]; exact h\n\n-- Flags decided at two frames that agree off Z (and off the flags), over maps that agree off TM.\ntheorem decide_view {fl : List (Nat × C)} (hfl : flagsOk fl = true) {Z TM : List Nat} (hz : ∀ p ∈ fl, avoids Z p.2 = true)\n    (hm : ∀ p ∈ fl, avoidsMaps TM p.2 = true) {Y X : Nat → Nat} {V N : Nat → Nat → Nat}\n    (hY : ∀ j, j ∉ Z → j ∉ flagVars fl → Y j = X j) (hV : ∀ m, m ∉ TM → V m = N m) {i : Nat} (hi : i ∉ Z) :\n    decideFlags fl Y V i = decideFlags fl X N i := by\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases hc : flagOf fl i with\n  | none => exact hY i hi (flagOf_none hc)\n  | some c =>\n    obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n    simp only [Option.map_some, evalE]\n    rw [congr2C (ρ' := X) (M' := N) p.2 (fun j hj => hY j (avoids_occ (hz p hp) hj) (avoids_occ (List.all_eq_true.mp hfl p hp) hj))\n      (fun m hm' => hV m (avoidsMaps_occ (hm p hp) hm'))]\n\nvariable (hS : CycShape s ce keys) (hT : CycTerms s ce keys) (hr : r.Ok s T)\ninclude hS hT hr\n\ntheorem enc_maps {u : Nat} (hu : u ≤ T) {m : Nat} (hm : m ∉ ce.mtr.map (·.1)) : r.N s u m = r.mp 0 m := by\n  rw [N_not_carried (fun h => hm (hS.carm m h))]\n  exact run_maps hr hS.carm hS.wrm hS.evm u hu m hm\n\ntheorem enc_frame {u : Nat} (hu : u ≤ T) {i : Nat} (hv : i ∉ ce.vtr.map (·.1)) (hf : i ∉ flagVars s.f.flags) :\n    r.X s u i = r.ρ0 i := by\n  have hin : i ∉ s.f.m.inputs := fun h => hv (hS.inv i h)\n  rw [CRun.X, withInputs_other hin]\n  exact run_frame hr u hu i (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hv (hS.initv p hp))\n    (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hv (hS.stepv p hp)) hin hf\n\nvariable {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) {w : E} {u : Nat}\n  (hw : evalE Q (cycMaps s ce r (T + 1)) w = u) (hu : u ≤ T)\ninclude hQ hw hu\n\n-- A read of a map at time w: the maps over time read back the run's.\ntheorem enc_rd : ∀ m key, evalE Q (cycMaps s ce r (T + 1)) (cycRd ce w m key)\n    = cycView s ce r (T + 1) u m (evalE Q (cycMaps s ce r (T + 1)) key) := by\n  intro m key\n  simp only [cycRd]\n  split\n  · rename_i p hp\n    obtain ⟨hpm, hpe⟩ := lookup_some hp\n    have hpm' : p.1 = m := by simpa using hpe\n    have hmd : m ∈ ce.mtr.map (·.1) := List.mem_map.mpr ⟨p, hpm, hpm'⟩\n    have hmt : m ∉ ce.tm := fun h => hS.tmd m h hmd\n    rw [cv_N hmt]\n    simp only [evalE, cm_m hS.dtm hpm, hw, hQ.2.1, pair_mod hu, pair_div hu, hpm']\n  · rename_i hn\n    have hmd : m ∉ ce.mtr.map (·.1) := fun h => by\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n      have := lookup_none_all hn p hp; simp at this\n    simp only [evalE, cycView]\n    by_cases ht : ce.tm.contains m = true\n    · rw [if_pos ht]\n    · rw [if_neg ht, cm_o (fun h => ht (List.contains_iff_mem.mpr h)), enc_maps hS hT hr hu hmd]\n\ntheorem enc_trE (e : E) : evalE Q (cycMaps s ce r (T + 1)) (trE ce w e)\n    = evalE (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) e :=\n  substR_evalE (cycσ ce w) (cycRd ce w) Q (cycMaps s ce r (T + 1)) (cycView s ce r (T + 1) u) (enc_rd hS hT hr hQ hw hu) e\ntheorem enc_trC (c : C) : evalC Q (cycMaps s ce r (T + 1)) (trC ce w c)\n    = evalC (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) c :=\n  substR_evalC (cycσ ce w) (cycRd ce w) Q (cycMaps s ce r (T + 1)) (cycView s ce r (T + 1) u) (enc_rd hS hT hr hQ hw hu) c\n\ntheorem enc_σ_in {i : Nat} (hi : i ∈ ce.vtr.map (·.1)) : applyS (cycσ ce w) Q (cycMaps s ce r (T + 1)) i = r.X s u i := by\n  cases h : lookup (fun p => p.1 == i) ce.vtr with\n  | none =>\n    exfalso; obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hi\n    have := lookup_none_all h p hp; simp at this\n  | some q =>\n    obtain ⟨hq, hqi⟩ := lookup_some h\n    have hqi' : q.1 = i := by simpa using hqi\n    have ha : assoc (cycσ ce w) i = some (.get q.2 w) := by\n      simp only [assoc, cycσ, lookup_map_pred, h, Option.map_some]\n    simp only [applyS, ha, evalE, cm_v hS.dtm hq, hw, hqi']\n\ntheorem enc_σ_out {i : Nat} (hi : i ∉ ce.vtr.map (·.1)) : applyS (cycσ ce w) Q (cycMaps s ce r (T + 1)) i = Q i := by\n  apply applyS_other\n  intro h; apply hi\n  obtain ⟨a, ha, rfl⟩ := List.mem_map.mp h\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp ha\n  exact List.mem_map.mpr ⟨p, hp, rfl⟩\n\n-- The frame a traced term reads: the run's state and request at time u, off the added variables and the flags.\ntheorem enc_Y {i : Nat} (hz : i ∉ cycZ ce keys) (hf : i ∉ flagVars s.f.flags) :\n    applyS (cycσ ce w) Q (cycMaps s ce r (T + 1)) i = r.X s u i := by\n  by_cases hv : i ∈ ce.vtr.map (·.1)\n  · exact enc_σ_in hS hT hr hQ hw hu hv\n  · rw [enc_σ_out hS hT hr hQ hw hu hv, hQ.2.2 i (by\n      simp only [cycP, List.mem_append, not_or]; exact ⟨⟨hz, hv⟩, hf⟩), enc_frame hS hT hr hu hv hf]\n\ntheorem enc_D {i : Nat} (hz : i ∉ cycZ ce keys) :\n    decideFlags s.f.flags (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) i = r.V s u i :=\n  decide_view hS.fl hT.flz hT.flm (fun _ hj hf => enc_Y hS hT hr hQ hw hu hj hf) (fun m hm => cv_N hm) hz\n\n-- A machine term, its flags inlined, read at the frame of time w: the term at the run's step from u.\ntheorem enc_inl (e : E) (hz : avoidsE (cycZ ce keys) e = true) (hm : avoidsMapsE ce.tm e = true) :\n    evalE (applyS (cycσ ce w) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u) (inlineE s.f.flags e) = evalE (r.V s u) (r.N s u) e := by\n  rw [inline_evalE]\n  exact congr2E e (fun i hi => enc_D hS hT hr hQ hw hu (avoidsE_occ hz hi)) (fun m hm' => cv_N (avoidsMapsE_occ hm hm'))\n\ntheorem enc_now (e : E) (hz : avoidsE (cycZ ce keys) e = true) (hm : avoidsMapsE ce.tm e = true) :\n    evalE Q (cycMaps s ce r (T + 1)) (trE ce w (inlineE s.f.flags e)) = evalE (r.V s u) (r.N s u) e := by\n  rw [enc_trE hS hT hr hQ hw hu, enc_inl hS hT hr hQ hw hu e hz hm]\n\ntheorem enc_nowC (c : C) (hz : avoids (cycZ ce keys) c = true) (hm : avoidsMaps ce.tm c = true) :\n    evalC Q (cycMaps s ce r (T + 1)) (trC ce w (inlineC s.f.flags c)) = evalC (r.V s u) (r.N s u) c := by\n  rw [enc_trC hS hT hr hQ hw hu, inline_evalC]\n  exact congr2C c (fun i hi => enc_D hS hT hr hQ hw hu (avoids_occ hz hi)) (fun m hm' => cv_N (avoidsMaps_occ hm hm'))\nend enc\n\n/-! The facts hold of the run -/\n\ntheorem holds_any (l : MLaw) (M : Nat → Nat → Nat) : ∀ (gs : List Nat) (ρ : Nat → Nat), holdsOver l M gs ρ →\n    ∀ X : Nat → Nat, (∀ j, occC j l.holds = true → j ∉ gs → l.key ≠ some j → X j = ρ j) → evalC X M l.holds = true\n  | [], ρ, h, X, hX => by\n    simp only [holdsOver, MLaw.Holds] at h\n    split at h\n    · rename_i hk\n      rw [congrC X ρ M l.holds (fun j hj => hX j hj (by simp) (by rw [hk]; simp))]; exact h\n    · rename_i kv hk\n      rw [congrC X (upd ρ kv (X kv)) M l.holds (fun j hj => by\n        simp only [upd]\n        split\n        · rename_i e; rw [e]\n        · rename_i e; exact hX j hj (by simp) (by rw [hk]; intro h'; exact e (Option.some.inj h').symm))]\n      exact h (X kv)\n  | g :: gs, ρ, h, X, hX => by\n    simp only [holdsOver] at h\n    exact holds_any l M gs (upd ρ g (X g)) (h (X g)) X (fun j hj hgs hk => by\n      simp only [upd]\n      split\n      · rename_i e; rw [e]\n      · rename_i e\n        exact hX j hj (fun hm => by rcases List.mem_cons.mp hm with h' | h'; exact e h'; exact hgs h') hk)\n\ntheorem cycNext_every {s : SMachine} {ce : CycEnc} {m : Nat} {w : Nat × Nat × E} (h : lookup (fun w => w.1 == m) s.every = some w) :\n    cycNext s ce m = trE ce (cycPrev ce) (inlineE s.f.flags (substE [(w.2.1, .var ce.k)] w.2.2)) := by\n  simp only [cycNext, h]\ntheorem cycNext_write {s : SMachine} {ce : CycEnc} {m : Nat} {w : Nat × E × E} (he : lookup (fun w => w.1 == m) s.every = none)\n    (h : lookup (fun w => w.1 == m) s.f.m.writes = some w) :\n    cycNext s ce m = .ite (.eq (.var ce.k) (trE ce (cycPrev ce) (inlineE s.f.flags w.2.1)))\n        (trE ce (cycPrev ce) (readsAtE (inlineE s.f.flags w.2.1) (.var ce.k) (inlineE s.f.flags w.2.2))) (cycCell ce m (cycPrev ce)) := by\n  simp only [cycNext, he, h]\ntheorem cycNext_none {s : SMachine} {ce : CycEnc} {m : Nat} (he : lookup (fun w => w.1 == m) s.every = none)\n    (h : lookup (fun w => w.1 == m) s.f.m.writes = none) : cycNext s ce m = cycCell ce m (cycPrev ce) := by\n  simp only [cycNext, he, h]\ntheorem everyMaps_every {s : SMachine} {D : Nat → Nat} {N : Nat → Nat → Nat} {m key : Nat} {w : Nat × Nat × E}\n    (h : lookup (fun w => w.1 == m) s.every = some w) : everyMaps s D N m key = evalE (upd D w.2.1 key) N w.2.2 := by\n  simp only [everyMaps, h]\ntheorem everyMaps_write {s : SMachine} {D : Nat → Nat} {N : Nat → Nat → Nat} {m key : Nat} {w : Nat × E × E}\n    (he : lookup (fun w => w.1 == m) s.every = none) (h : lookup (fun w => w.1 == m) s.f.m.writes = some w) :\n    everyMaps s D N m key = if key = evalE D N w.2.1 then evalE D N w.2.2 else N m key := by\n  simp only [everyMaps, he, writeMaps, h]\ntheorem everyMaps_none {s : SMachine} {D : Nat → Nat} {N : Nat → Nat → Nat} {m key : Nat}\n    (he : lookup (fun w => w.1 == m) s.every = none) (h : lookup (fun w => w.1 == m) s.f.m.writes = none) :\n    everyMaps s D N m key = N m key := by\n  simp only [everyMaps, he, writeMaps, h]\n\nsection facts\nvariable {s : SMachine} {ce : CycEnc} {keys : List Nat} {r : CRun} {T : Nat}\n  (hS : CycShape s ce keys) (hT : CycTerms s ce keys) (hr : r.Ok s T)\ninclude hS hT hr\n\ntheorem stepTerm_avoids {x : Nat} (hx : x ∈ ce.vtr.map (·.1)) :\n    avoidsE (cycZ ce keys) (cycStepTerm s x) = true ∧ avoidsMapsE ce.tm (cycStepTerm s x) = true := by\n  simp only [cycStepTerm]\n  cases h : assoc s.f.m.step x with\n  | some e => exact ⟨hT.stz _ (assoc_some_mem h), hT.stm _ (assoc_some_mem h)⟩\n  | none =>\n    refine ⟨?_, ?_⟩\n    · simp only [Option.getD, avoidsE, List.all_eq_true, occE, Bool.not_eq_true', beq_eq_false_iff_ne]\n      intro z hz e; subst e; exact hS.zv _ hz hx\n    · simp [Option.getD, avoidsMapsE, occME]\n\ntheorem given_holds {g : MLaw × List Nat} (hg : g ∈ cycGiven s) : holdsOver g.1 (r.mp 0) g.2 r.ρ0 := by\n  simp only [cycGiven, List.mem_append, List.mem_map] at hg\n  rcases hg with ⟨l, hl, rfl⟩ | hg\n  · exact hr.facts l hl\n  · exact hr.pfacts g hg\n\ntheorem start_holds {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (cycStart s ce).holds = true := by\n  apply impl_true\n  intro h0\n  rw [evalC_iff] at h0; simp only [holdsC, evalE] at h0\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = 0 := by simp only [evalE]; omega\n  apply andL_true\n  intro c hc\n  rcases List.mem_cons.mp hc with rfl | hc\n  · simp [trueC, evalC, evalE]\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n  have ha : assoc s.f.m.init p.1 = some p.2 := by simp only [assoc, lookup_unique hS.dinit hp, Option.map_some]\n  rw [evalC_iff]; simp only [holdsC]\n  rw [enc_trE hS hT hr hQ hw (Nat.zero_le T)]\n  show applyS (cycσ ce (.var ce.u)) Q (cycMaps s ce r (T + 1)) p.1 = _\n  rw [enc_σ_in hS hT hr hQ hw (Nat.zero_le T) (hS.initv p hp), CRun.X, withInputs_other (hS.initin p hp), hr.init]\n  simp only [applyS, ha]\n  exact congr2E p.2 (fun j hj => (hQ.2.2 j (avoidsE_occ (hT.inz p hp) hj)).symm)\n    (fun m hm => (cm_o (avoidsMapsE_occ (hT.inm p hp) hm)).symm)\n\ntheorem step_holds (b : Bool) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (cycStep s ce b).holds = true := by\n  apply impl_true\n  intro h1\n  rw [evalC_iff] at h1; simp only [cycStepped, holdsC, evalE] at h1\n  obtain ⟨h1a, h1b⟩ := h1\n  have hQT := hQ.1\n  obtain ⟨u', hu'⟩ : ∃ u', Q ce.u = u' + 1 := ⟨Q ce.u - 1, by omega⟩\n  have hlt : u' < T := by omega\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (cycPrev ce) = u' := by simp only [cycPrev, evalE]; omega\n  have hw0 : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = u' + 1 := hu'\n  apply andL_true\n  intro c hc\n  rcases List.mem_cons.mp hc with rfl | hc\n  · simp [trueC, evalC, evalE]\n  rcases List.mem_append.mp hc with hc | hc\n  · cases b\n    · simp at hc\n    · simp at hc\n      subst hc\n      rw [enc_nowC hS hT hr hQ hw (Nat.le_of_lt hlt) _ hT.asz hT.asm]\n      exact (hr.step u' hlt).1\n  · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n    have hx := hS.initv p hp\n    rw [evalC_iff]; simp only [holdsC]\n    rw [enc_trE hS hT hr hQ hw0 hlt, enc_now hS hT hr hQ hw (Nat.le_of_lt hlt) _ (stepTerm_avoids hS hT hr hx).1 (stepTerm_avoids hS hT hr hx).2]\n    show applyS (cycσ ce (.var ce.u)) Q (cycMaps s ce r (T + 1)) p.1 = _\n    rw [enc_σ_in hS hT hr hQ hw0 hlt hx, CRun.X, withInputs_other (hS.initin p hp), (hr.step u' hlt).2.1, applyS_getD]\n    rfl\n\ntheorem mapStart_holds {p : Nat × Nat} (hp : p ∈ s.f.m.maps0) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (.or (.not (.le (.var ce.u) (.const 0))) (.eq (cycCell ce p.1 (.var ce.u)) (.const p.2))) = true := by\n  apply impl_true\n  intro h0\n  rw [evalC_iff] at h0; simp only [holdsC, evalE] at h0\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = 0 := by simp only [evalE]; omega\n  rw [evalC_iff]; simp only [holdsC, cycCell]\n  rw [enc_rd hS hT hr hQ hw (Nat.zero_le T), cv_N (fun h => hS.tmd _ h (hS.m0 p hp)), N_not_carried (hS.m0c p hp)]\n  exact hr.maps0 p hp _\n\ntheorem mapStep_holds {p : Nat × Nat} (hp : p ∈ s.f.m.maps0) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) :\n    evalC Q (cycMaps s ce r (T + 1)) (.or (.not (cycStepped ce)) (.eq (cycCell ce p.1 (.var ce.u)) (cycNext s ce p.1))) = true := by\n  apply impl_true\n  intro h1\n  rw [evalC_iff] at h1; simp only [cycStepped, holdsC, evalE] at h1\n  obtain ⟨h1a, h1b⟩ := h1\n  have hQT := hQ.1\n  obtain ⟨u', hu'⟩ : ∃ u', Q ce.u = u' + 1 := ⟨Q ce.u - 1, by omega⟩\n  have hlt : u' < T := by omega\n  have hw : evalE Q (cycMaps s ce r (T + 1)) (cycPrev ce) = u' := by simp only [cycPrev, evalE]; omega\n  have hw0 : evalE Q (cycMaps s ce r (T + 1)) (.var ce.u) = u' + 1 := hu'\n  have hk : evalE Q (cycMaps s ce r (T + 1)) (.var ce.k) = Q ce.k := rfl\n  have hmt : p.1 ∉ ce.tm := fun h => hS.tmd _ h (hS.m0 p hp)\n  have hsp := special_parts hS.dsp\n  have hkZ : ce.k ∈ cycZ ce keys := List.mem_append_left _ (in_special (Or.inr (Or.inl rfl)))\n  -- the frame of time u' at k: the fact's own key\n  have hYk : applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1)) ce.k = Q ce.k :=\n    enc_σ_out hS hT hr hQ hw (Nat.le_of_lt hlt) (hS.zv _ hkZ)\n  rw [evalC_iff]; simp only [holdsC, cycCell]\n  rw [enc_rd hS hT hr hQ hw0 hlt, cv_N hmt, N_not_carried (hS.m0c p hp), (hr.step u' hlt).2.2, hk]\n  by_cases hev : ∃ w, lookup (fun w => w.1 == p.1) s.every = some w\n  · obtain ⟨w, he⟩ := hev\n    obtain ⟨hwm, _⟩ := lookup_some he\n    rw [cycNext_every he, everyMaps_every he, enc_trE hS hT hr hQ hw (Nat.le_of_lt hlt), inline_evalE, subst_evalE, applyS_single]\n    have hD : evalE (decideFlags s.f.flags (applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u'))\n        (cycView s ce r (T + 1) u') (.var ce.k) = Q ce.k := by\n      show decideFlags s.f.flags (applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1))) (cycView s ce r (T + 1) u') ce.k = Q ce.k\n      rw [decide_other (hS.zf _ hkZ), hYk]\n    rw [hD]\n    refine congr2E w.2.2 (fun j hj => ?_) (fun m hm => (cv_N (avoidsMapsE_occ (hT.evm w hwm) hm)).symm)\n    simp only [upd]\n    split\n    · rfl\n    · rename_i hne\n      have hjz : j ∉ cycZ ce keys := fun hz => by\n        have := hT.evz w hwm j hz hne; rw [this] at hj; exact absurd hj (by decide)\n      exact (enc_D hS hT hr hQ hw (Nat.le_of_lt hlt) hjz).symm\n  · have he : lookup (fun w => w.1 == p.1) s.every = none := by\n      cases h : lookup (fun w => w.1 == p.1) s.every\n      · rfl\n      · exact absurd ⟨_, h⟩ hev\n    by_cases hwr' : ∃ w, lookup (fun w => w.1 == p.1) s.f.m.writes = some w\n    · obtain ⟨w, hwr⟩ := hwr'\n      obtain ⟨hwm, _⟩ := lookup_some hwr\n      rw [cycNext_write he hwr, everyMaps_write he hwr]\n      rw [evalE_ite_eq, hk, enc_now hS hT hr hQ hw (Nat.le_of_lt hlt) _ (hT.wkz w hwm) (hT.wkm w hwm)]\n      by_cases hkk : Q ce.k = evalE (r.V s u') (r.N s u') w.2.1\n      · rw [if_pos hkk, if_pos hkk, enc_trE hS hT hr hQ hw (Nat.le_of_lt hlt), readsAt_evalE]\n        · exact (enc_inl hS hT hr hQ hw (Nat.le_of_lt hlt) _ (hT.wvz w hwm) (hT.wvm w hwm)).symm\n        · show applyS (cycσ ce (cycPrev ce)) Q (cycMaps s ce r (T + 1)) ce.k = _\n          rw [hYk, enc_inl hS hT hr hQ hw (Nat.le_of_lt hlt) _ (hT.wkz w hwm) (hT.wkm w hwm)]\n          exact hkk\n      · rw [if_neg hkk, if_neg hkk, cycCell, enc_rd hS hT hr hQ hw (Nat.le_of_lt hlt), cv_N hmt, hk]\n    · have hwr : lookup (fun w => w.1 == p.1) s.f.m.writes = none := by\n        cases h : lookup (fun w => w.1 == p.1) s.f.m.writes\n        · rfl\n        · exact absurd ⟨_, h⟩ hwr'\n      rw [cycNext_none he hwr, everyMaps_none he hwr, cycCell, enc_rd hS hT hr hQ hw (Nat.le_of_lt hlt), cv_N hmt, hk]\n\ntheorem fn_holds {g : MLaw × List Nat} (hg : g ∈ cycGiven s) (X : Nat → Nat)\n    (hX : ∀ j, j ∉ cycP s ce keys → j ∉ g.1.key.toList ++ g.2 → X j = r.ρ0 j) :\n    evalC X (cycMaps s ce r (T + 1)) g.1.holds = true := by\n  rw [congrMC X (cycMaps s ce r (T + 1)) (r.mp 0) _ (fun m hm => cm_o (avoidsMaps_occ (hT.gm g hg) hm))]\n  apply holds_any g.1 (r.mp 0) g.2 r.ρ0 (given_holds hS hT hr hg) X\n  intro j hj hgs hk\n  apply hX j\n  · intro hP; have := hT.gz g hg j hP hk hgs; rw [this] at hj; exact absurd hj (by decide)\n  · intro hm\n    rcases List.mem_append.mp hm with h | h\n    · exact hk (mem_toList h)\n    · exact hgs h\n\ntheorem canon_holds {g : Fact} (hg : g ∈ cycCanon s ce) {Q : Nat → Nat} (hQ : EnvOk s ce keys r T Q) (vals : Nat → Nat) :\n    evalC (override g.keys vals Q) (cycMaps s ce r (T + 1)) g.holds = true := by\n  have hsp := special_parts hS.dsp\n  have hov : ∀ ks : List Nat, (∀ x ∈ ks, x = ce.u ∨ x = ce.k) → EnvOk s ce keys r T (override ks vals Q) := by\n    intro ks hks\n    refine ⟨?_, ?_, ?_⟩\n    · simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks _ (List.contains_iff_mem.mp h) with e | e\n        · exact hsp.1 e.symm\n        · exact hsp.2.2.1 e.symm)]\n      exact hQ.1\n    · simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks _ (List.contains_iff_mem.mp h) with e | e\n        · exact hsp.2.1 e.symm\n        · exact hsp.2.2.2.1 e.symm)]\n      exact hQ.2.1\n    · intro i hi\n      simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks _ (List.contains_iff_mem.mp h) with e | e\n        · exact (notP hi).1 (in_special (Or.inl e))\n        · exact (notP hi).1 (in_special (Or.inr (Or.inl e))))]\n      exact hQ.2.2 i hi\n  simp only [cycCanon, List.mem_cons, List.mem_append] at hg\n  rcases hg with rfl | rfl | rfl | hg | hg\n  · exact start_holds hS hT hr (hov [ce.u] (by simp))\n  · exact step_holds hS hT hr true (hov [ce.u] (by simp))\n  · exact step_holds hS hT hr false (hov [ce.u] (by simp))\n  · simp only [cycMapFacts, List.mem_flatMap, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hg\n    obtain ⟨p, hp, rfl | rfl⟩ := hg\n    · exact mapStart_holds hS hT hr hp (hov [ce.u, ce.k] (by simp))\n    · exact mapStep_holds hS hT hr hp (hov [ce.u, ce.k] (by simp))\n  · simp only [cycFnFacts, List.mem_map] at hg\n    obtain ⟨q, hq, rfl⟩ := hg\n    exact fn_holds hS hT hr hq _ (fun j hjP hjk => by\n      simp only [override]\n      rw [if_neg (fun h => hjk (List.contains_iff_mem.mp h))]\n      exact hQ.2.2 j hjP)\nend facts\n\n/-! The bridge for machines -/\n\n/-- A cyclic proof of a machine law, checked against the machine's encoding (`cycMOk`): the law holds in every state\nthe machine reaches, at every value of its keys. -/\ntheorem cyc_machine_sound (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (law : C) (keys : List Nat) (n : CNode) (hn : n ∈ nodes) (hok : cycMOk s ce facts law keys n = true) :\n    ∀ ρ M, SReach s ρ M → ∀ ρ' : Nat → Nat, (∀ i, i ∉ keys → ρ' i = ρ i) → evalC ρ' M law = true := by\n  simp only [cycMOk, Bool.and_eq_true] at hok\n  obtain ⟨⟨⟨⟨hsh, hte⟩, hlaw⟩, hfa⟩, hnd⟩ := hok\n  have hS := cycShape_of hsh\n  have hT := cycTerms_of hte\n  simp only [cycNodeOk, Bool.and_eq_true] at hnd\n  simp only [cycLawOk, Bool.and_eq_true] at hlaw\n  intro ρ M hreach ρ' hρ'\n  obtain ⟨r, T, hr, hst, hmp⟩ := reach_run hS.q hreach\n  have hsp := special_parts hS.dsp\n  have hnot : ∀ i, i ∉ ce.special → cycEnv ce T ρ' i = ρ' i := fun i hi => by\n    simp only [cycEnv]\n    rw [if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inr e)))))),\n      if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inl e))))), if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inl e))))))]\n  have hEnv : EnvOk s ce keys r T (cycEnv ce T ρ') := by\n    refine ⟨by simp [cycEnv], by simp [cycEnv, Ne.symm hsp.2.2.2.2.2.2, Ne.symm hsp.2.2.2.2.1], ?_⟩\n    intro i hi\n    obtain ⟨h1, h2, h3, h4⟩ := notP hi\n    rw [hnot i h1, hρ' i h2, ← hst]\n    exact run_frame hr T (Nat.le_refl T) i (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact h3 (hS.initv p hp))\n      (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact h3 (hS.stepv p hp)) (fun h => h3 (hS.inv i h)) h4\n  have hF : FactsHold facts (cycEnv ce T ρ') (cycMaps s ce r (T + 1)) := by\n    intro f hf vals\n    have hfi := List.all_eq_true.mp hfa f hf\n    simp only [Bool.or_eq_true] at hfi\n    rcases hfi with hnc | hcan\n    · exact natC_true _ hnc\n    · obtain ⟨g, hg, hb⟩ := List.any_eq_true.mp hcan\n      simp only [factBeq, Bool.and_eq_true, beq_iff_eq] at hb\n      rw [hb.1, beqC_eq hb.2]\n      exact canon_holds hS hT hr hg hEnv vals\n  have htT : cycEnv ce T ρ' ce.t = T := by simp [cycEnv]\n  have hH : ∀ c ∈ n.hyps, evalC (cycEnv ce T ρ') (cycMaps s ce r (T + 1)) c = true := by\n    intro c hc\n    have h := List.all_eq_true.mp hnd.2 c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with (h | h) | h\n    · rw [beqC_eq h, congr2C (ρ' := r.ρ0) (M' := r.mp 0) _ (fun j hj => hEnv.2.2 j (avoids_occ hT.prz hj))\n        (fun m hm => cm_o (avoidsMaps_occ hT.prm hm))]\n      exact hr.pre\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, htT, hEnv.1] <;> omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hEnv.1, hEnv.2.1] <;> omega\n  have hc0 := cyclic_sound facts nodes hc (cycMaps s ce r (T + 1)) (cycEnv ce T ρ') hF n hn hH\n  have htT' : evalE (cycEnv ce T ρ') (cycMaps s ce r (T + 1)) (.var ce.t) = T := htT\n  rw [beqC_eq hnd.1, enc_trC hS hT hr hEnv htT' (Nat.le_refl T)] at hc0\n  rw [congr2C (ρ' := applyS (cycσ ce (.var ce.t)) (cycEnv ce T ρ') (cycMaps s ce r (T + 1))) (M' := cycView s ce r (T + 1) T) law\n    (fun j hj => ?_) (fun m hm => ?_)]\n  · exact hc0\n  · have hj' := avoids_occ hlaw.1 hj\n    have hjs : j ∉ ce.special := fun h => hj' (List.mem_append_left _ h)\n    have hji : j ∉ s.f.m.inputs := fun h => hj' (List.mem_append_right _ h)\n    by_cases hv : j ∈ ce.vtr.map (·.1)\n    · rw [enc_σ_in hS hT hr hEnv htT' (Nat.le_refl T) hv, CRun.X, withInputs_other hji, hst]\n      exact hρ' j (fun hk => hS.zv j (List.mem_append_right _ hk) hv)\n    · rw [enc_σ_out hS hT hr hEnv htT' (Nat.le_refl T) hv, hnot j hjs]\n  · have hm' := avoidsMaps_occ hlaw.2 hm\n    rw [cv_N (fun h => hm' (List.mem_append_left _ h)), N_not_carried (fun h => hm' (List.mem_append_right _ h)), hmp]\n\n-- The same as a law of the machine about every value of its keys (Sets.lean's `holdsOver`).\ntheorem cyc_machine_holds {M : Nat → Nat → Nat} {ρ : Nat → Nat} {law : C} {key : Option Nat} {gs : List Nat}\n    (h : ∀ ρ' : Nat → Nat, (∀ i, i ∉ key.toList ++ gs → ρ' i = ρ i) → evalC ρ' M law = true) : holdsOver ⟨law, key⟩ M gs ρ := by\n  induction gs generalizing ρ with\n  | nil =>\n    cases key with\n    | none => simp only [holdsOver, MLaw.Holds]; exact h ρ (fun _ _ => rfl)\n    | some kv =>\n      simp only [holdsOver, MLaw.Holds]\n      intro v\n      exact h _ (fun i hi => by\n        simp only [upd]\n        rw [if_neg (fun e => hi (by simp [Option.toList, e]))])\n  | cons g gs ih =>\n    simp only [holdsOver]\n    intro v\n    apply ih\n    intro ρ' hρ'\n    apply h\n    intro i hi\n    rw [hρ' i (fun hm => hi (by\n      rcases List.mem_append.mp hm with h1 | h1\n      · exact List.mem_append_left _ h1\n      · exact List.mem_append_right _ (List.mem_cons_of_mem _ h1)))]\n    simp only [upd]\n    rw [if_neg (fun e => hi (List.mem_append_right _ (by rw [e]; exact List.mem_cons_self)))]\n\n/-! Recurrences (`recurNodes`) -/\n\n-- A recurrence's values: f(0) is `zero`, f(n + 1) is `next` with x read as n and prev as f(n), the rest of the\n-- environment (the further arguments) as given.\ndef recF (zero next : E) (x prev : Nat) (env : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat\n  | 0 => evalE env maps zero\n  | n + 1 => evalE (upd (upd env x n) prev (recF zero next x prev env maps n)) maps next\n\n-- The maps with one of them replaced.\ndef withMap (maps : Nat → Nat → Nat) (f : Nat) (g : Nat → Nat) : Nat → Nat → Nat := fun m => if m = f then g else maps m\n\n-- The function's map, the recurrence's x and prev, the step fact's key.\nstructure RecEnc where\n  f : Nat\n  x : Nat\n  prev : Nat\n  k : Nat\n\n-- The recurrence's two equations as recurNodes states them: f(0) = zero, and at every k, f(k + 1) = next(k, f(k)).\ndef recFacts (re : RecEnc) (zero next : E) : List Fact :=\n  [⟨[], .eq (.get re.f (.const 0)) zero⟩,\n   ⟨[re.k], .eq (.get re.f (.add (.var re.k) (.const 1))) (substE [(re.x, .var re.k), (re.prev, .get re.f (.var re.k))] next)⟩]\n\n-- The exported facts are the equations, facts given about other functions (`given`), or true of every natural; the\n-- recurrence reads its own values only through prev, and nothing given reads them.\ndef recOk (re : RecEnc) (zero next : E) (given facts : List Fact) : Bool :=\n  !occME re.f zero && !occME re.f next && !occE re.k next && re.x != re.prev && re.k != re.x && re.k != re.prev\n    && given.all (fun g => !occMC re.f g.holds)\n    && facts.all (fun g => natC g.holds || (recFacts re zero next ++ given).any (factBeq g))\n\ntheorem override_nil (vals env : Nat → Nat) : override [] vals env = env := by\n  funext i; simp [override]\n\ntheorem rec_facts {re : RecEnc} {zero next : E} {given facts : List Fact} (hok : recOk re zero next given facts = true)\n    (maps : Nat → Nat → Nat) (env : Nat → Nat) (hg : FactsHold given env maps) :\n    FactsHold facts env (withMap maps re.f (recF zero next re.x re.prev env maps)) := by\n  simp only [recOk, Bool.and_eq_true, Bool.not_eq_true', bne_iff_ne, ne_eq] at hok\n  obtain ⟨⟨⟨⟨⟨⟨⟨hz, hn⟩, hk⟩, hxp⟩, hkx⟩, hkp⟩, hgv⟩, hfa⟩ := hok\n  have hM : ∀ e : E, occME re.f e = false → ∀ ρ, evalE ρ (withMap maps re.f (recF zero next re.x re.prev env maps)) e = evalE ρ maps e :=\n    fun e he ρ => congrME ρ _ maps e (fun m hm => by\n      simp only [withMap]; rw [if_neg (fun h => by rw [h, he] at hm; exact absurd hm (by decide))])\n  intro f hf vals\n  have hfi := List.all_eq_true.mp hfa f hf\n  simp only [Bool.or_eq_true] at hfi\n  rcases hfi with hnc | hcan\n  · exact natC_true _ hnc\n  obtain ⟨g, hg', hb⟩ := List.any_eq_true.mp hcan\n  simp only [factBeq, Bool.and_eq_true, beq_iff_eq] at hb\n  rw [hb.1, beqC_eq hb.2]\n  simp only [recFacts, List.cons_append, List.nil_append, List.mem_cons] at hg'\n  rcases hg' with rfl | rfl | hg'\n  · show evalC (override [] vals env) _ (.eq (.get re.f (.const 0)) zero) = true\n    rw [override_nil, evalC_iff]\n    show withMap maps re.f (recF zero next re.x re.prev env maps) re.f 0 = evalE env _ zero\n    rw [hM zero hz env]\n    simp only [withMap, if_pos (rfl : re.f = re.f), ite_true, recF]\n  · show evalC (override [re.k] vals env) _ (.eq (.get re.f (.add (.var re.k) (.const 1)))\n      (substE [(re.x, .var re.k), (re.prev, .get re.f (.var re.k))] next)) = true\n    rw [evalC_iff]\n    show withMap maps re.f (recF zero next re.x re.prev env maps) re.f (override [re.k] vals env re.k + 1) = _\n    rw [subst_evalE, hM next hn]\n    simp only [withMap, if_pos (rfl : re.f = re.f), ite_true, recF]\n    refine congrE _ _ maps next (fun j hj => ?_)\n    have hjk : j ≠ re.k := fun h => by rw [h, hk] at hj; exact absurd hj (by decide)\n    simp only [upd, applyS, assoc, lookup]\n    by_cases hjp : j = re.prev\n    · subst hjp\n      simp [hxp, Ne.symm hxp, evalE, withMap]\n    · by_cases hjx : j = re.x\n      · subst hjx\n        simp [evalE, hxp]\n      · have h1 : (re.x == j) = false := by simpa using Ne.symm hjx\n        have h2 : (re.prev == j) = false := by simpa using Ne.symm hjp\n        simp only [hjp, hjx, if_false, h1, h2, Bool.false_eq_true, Option.map_none, override]\n        rw [if_neg (fun h => hjk (by simpa using h))]\n  · rw [congrMC _ _ maps g.holds (fun m hm => by\n      simp only [withMap]\n      rw [if_neg (fun h => by\n        have := List.all_eq_true.mp hgv g hg'; rw [h] at hm; rw [hm] at this; exact absurd this (by decide))])]\n    exact hg g hg' vals\n\n/-- A cyclic proof of a recurrence's lemmas and laws between two points (`recurNodes`), checked against its equations\n(`recOk`): every node holds of the recurrence's values (`recF`), at every environment where the facts given about the\nfunctions it reads hold. -/\ntheorem cyc_recur_sound (re : RecEnc) (zero next : E) (given facts : List Fact) (nodes : List CNode)\n    (hc : checkCyclic facts nodes = true) (hok : recOk re zero next given facts = true) (maps : Nat → Nat → Nat) (env : Nat → Nat)\n    (hg : FactsHold given env maps) : ∀ n ∈ nodes, (∀ c ∈ n.hyps, evalC env (withMap maps re.f (recF zero next re.x re.prev env maps)) c = true) →\n      evalC env (withMap maps re.f (recF zero next re.x re.prev env maps)) n.concl = true :=\n  cyclic_sound facts nodes hc _ env (rec_facts hok maps env hg)\n\ntheorem assoc_map_kv {α : Type} (l : List α) (k : α → Nat) (g : α → E) (y : Nat) :\n    assoc (l.map fun a => (k a, g a)) y = (lookup (fun a => k a == y) l).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\ntheorem holds_of_eq {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : E} (h : evalE ρ M a = evalE ρ M b) : evalC ρ M (.eq a b) = true :=\n  (evalC_iff ρ M (.eq a b)).mpr h\ntheorem holds_of_lt {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : E} (h : evalE ρ M a < evalE ρ M b) : evalC ρ M (.lt a b) = true :=\n  (evalC_iff ρ M (.lt a b)).mpr h\n\ntheorem holds_of_le {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : E} (h : evalE ρ M a ≤ evalE ρ M b) : evalC ρ M (.le a b) = true :=\n  (evalC_iff ρ M (.le a b)).mpr h\ntheorem and_true2 {ρ : Nat → Nat} {M : Nat → Nat → Nat} {a b : C} (ha : evalC ρ M a = true) (hb : evalC ρ M b = true) :\n    evalC ρ M (.and a b) = true := by simp [evalC, ha, hb]\n\n/-! Folds over trees (`foldNodes`) -/\n\ndef BTree.size : BTree → Nat\n  | .leaf _ => 1\n  | .node _ l r => l.size + r.size + 1\n-- The inputs a leaf or node carries.\ndef BTree.req : BTree → Nat → Nat\n  | .leaf ι => ι\n  | .node ι _ _ => ι\n-- The subtrees in post-order: each node after its children, so its right child just before it and its left child just\n-- before its right subtree (foldNodes' table, children numbered below their parent).\ndef BTree.flat : BTree → List BTree\n  | .leaf ι => [.leaf ι]\n  | .node ι l r => l.flat ++ r.flat ++ [.node ι l r]\n\ntheorem flat_length : ∀ t : BTree, t.flat.length = t.size\n  | .leaf _ => rfl\n  | .node _ l r => by simp [BTree.flat, BTree.size, flat_length l, flat_length r]; omega\n\ntheorem size_pos : ∀ t : BTree, 1 ≤ t.size\n  | .leaf _ => by simp [BTree.size]\n  | .node _ l r => by simp [BTree.size]\n\ntheorem flat_last : ∀ t : BTree, t.flat[t.size - 1]? = some t\n  | .leaf _ => rfl\n  | .node ι l r => by\n    simp only [BTree.flat, BTree.size]\n    rw [List.getElem?_append_right (by simp [flat_length])]\n    simp [flat_length]\n\ntheorem flat_node : ∀ (t : BTree) (i : Nat) (ι : Nat → Nat) (l r : BTree), t.flat[i]? = some (.node ι l r) →\n    l.size + r.size ≤ i ∧ t.flat[i - 1]? = some r ∧ t.flat[i - 1 - r.size]? = some l\n  | .leaf _, i, ι, l, r, h => by\n    cases i with\n    | zero => simp [BTree.flat] at h\n    | succ i => simp [BTree.flat] at h\n  | .node ι' l' r', i, ι, l, r, h => by\n    have hl := flat_length l'\n    have hr := flat_length r'\n    have pl := size_pos l'\n    have pr := size_pos r'\n    have pl2 := size_pos l\n    simp only [BTree.flat] at h ⊢\n    rcases Nat.lt_or_ge i l'.size with h1 | h1\n    · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega)] at h\n      obtain ⟨b, e1, e2⟩ := flat_node l' i ι l r h\n      refine ⟨b, ?_, ?_⟩\n      · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega), e1]\n      · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega), e2]\n    · rcases Nat.lt_or_ge i (l'.size + r'.size) with h2 | h2\n      · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl] at h\n        obtain ⟨b, e1, e2⟩ := flat_node r' (i - l'.size) ι l r h\n        refine ⟨by omega, ?_, ?_⟩\n        · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl,\n            show i - 1 - l'.size = i - l'.size - 1 by omega]\n          exact e1\n        · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl,\n            show i - 1 - r.size - l'.size = i - l'.size - 1 - r.size by omega]\n          exact e2\n      · rw [List.getElem?_append_right (by simp; omega)] at h\n        simp only [List.length_append, hl, hr] at h\n        rcases Nat.lt_or_ge i (l'.size + r'.size + 1) with h3 | h3\n        · have hi : i - (l'.size + r'.size) = 0 := by omega\n          rw [hi] at h\n          simp only [List.getElem?_cons_zero, Option.some.injEq, BTree.node.injEq] at h\n          obtain ⟨_, hll, hrr⟩ := h\n          subst hll\n          subst hrr\n          refine ⟨by omega, ?_, ?_⟩\n          · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_right (by omega), hl,\n              show i - 1 - l'.size = r'.size - 1 by omega, ← hr]\n            rw [hr]; exact flat_last r'\n          · rw [List.getElem?_append_left (by simp; omega), List.getElem?_append_left (by omega),\n              show i - 1 - r'.size = l'.size - 1 by omega]\n            exact flat_last l'\n        · rw [List.getElem?_eq_none (by simp; omega)] at h\n          exact absurd h (by simp)\n\ntheorem flat_allowed {f : Fold} {ρ : Nat → Nat} {maps : Nat → Nat → Nat} : ∀ t : BTree, Allowed f ρ maps t →\n    ∀ s ∈ t.flat, Allowed f ρ maps s\n  | .leaf ι, h, s, hs => by simp [BTree.flat] at hs; rw [hs]; exact h\n  | .node ι l r, h, s, hs => by\n    simp only [BTree.flat, List.mem_append, List.mem_singleton] at hs\n    rcases hs with (hs | hs) | hs\n    · exact flat_allowed l h.2.1 s hs\n    · exact flat_allowed r h.2.2 s hs\n    · rw [hs]; exact h\n\n-- The table's variables (a node's number n, the tree's size N) and maps (each node's kind and children, and each\n-- state variable and input's value at each node).\nstructure FoldEnc where\n  n : Nat\n  N : Nat\n  kind : Nat\n  left : Nat\n  right : Nat\n  vtr : List (Nat × Nat)\n\ndef foldσ (fe : FoldEnc) (w : E) : List (Nat × E) := fe.vtr.map fun p => (p.1, .get p.2 w)\n-- A node's frame: its inputs, and each copy read at the child's number.\ndef foldNodeσ (f : Fold) (fe : FoldEnc) : List (Nat × E) :=\n  f.inputs.map (fun i => (i, substE (foldσ fe (.var fe.n)) (.var i)))\n    ++ f.state.map (fun e => (e.2.1, substE (foldσ fe (.get fe.left (.var fe.n))) (.var e.1)))\n    ++ f.state.map (fun e => (e.2.2, substE (foldσ fe (.get fe.right (.var fe.n))) (.var e.1)))\n\n-- foldNodes' table fact: below the size, a leaf's values from its inputs, a node's from its children's, numbered below\n-- it (with the assumption at each, or without when the fold has none).\ndef foldTable (f : Fold) (fe : FoldEnc) (withAssume : Bool) : Fact :=\n  ⟨[fe.n], .or (.not (.lt (.var fe.n) (.var fe.N))) (.and (.le (.get fe.kind (.var fe.n)) (.const 1)) (.and\n    (.or (.not (.eq (.get fe.kind (.var fe.n)) (.const 0))) (andL (trueC :: ((if withAssume then [substC (foldσ fe (.var fe.n)) f.assume] else [])\n      ++ f.leaf.map fun p => .eq (substE (foldσ fe (.var fe.n)) (.var p.1)) (substE (foldσ fe (.var fe.n)) p.2)))))\n    (.or (.not (.eq (.get fe.kind (.var fe.n)) (.const 1))) (andL (.lt (.get fe.left (.var fe.n)) (.var fe.n) :: .lt (.get fe.right (.var fe.n)) (.var fe.n)\n      :: ((if withAssume then [substC (foldσ fe (.var fe.n)) f.assume] else [])\n      ++ f.leaf.map fun p => .eq (substE (foldσ fe (.var fe.n)) (.var p.1)) (substE (foldNodeσ f fe) ((assoc f.node p.1).getD (.var p.1)))))))))⟩\n\ndef foldCopies (f : Fold) : List Nat := f.state.map (·.2.1) ++ f.state.map (·.2.2)\ndef foldTM (fe : FoldEnc) : List Nat := [fe.kind, fe.left, fe.right] ++ fe.vtr.map (·.2)\ndef foldNot (f : Fold) (fe : FoldEnc) : List Nat := f.state.map (·.1) ++ foldCopies f ++ [fe.n, fe.N]\n\n-- The table fits the fold: names apart, every input and state variable with its map, leaf and node set the state\n-- variables, leaves and the assumption read no state variable or copy, nodes no state variable, the precondition\n-- params alone, the law no input or copy; none reads the added variables or maps.\ndef foldShapeOk (f : Fold) (fe : FoldEnc) : Bool :=\n  copiesOk f && distinct (f.inputs ++ f.state.map (·.1) ++ foldCopies f ++ [fe.n, fe.N]) && distinct (f.leaf.map (·.1))\n    && f.leaf.all (fun p => (f.state.map (·.1)).contains p.1 && (f.node.map (·.1)).contains p.1)\n    && f.node.all (fun p => (f.state.map (·.1)).contains p.1)\n    && distinct (foldTM fe) && (f.inputs ++ f.state.map (·.1)).all (fun x => (fe.vtr.map (·.1)).contains x)\n    && !(fe.vtr.map (·.1)).contains fe.n && !(fe.vtr.map (·.1)).contains fe.N\ndef foldTermsOk (f : Fold) (fe : FoldEnc) (law : C) : Bool :=\n  f.leaf.all (fun p => avoidsE (foldNot f fe) p.2 && avoidsMapsE (foldTM fe) p.2)\n    && f.node.all (fun p => avoidsE (f.state.map (·.1) ++ [fe.n, fe.N]) p.2 && avoidsMapsE (foldTM fe) p.2)\n    && avoids (foldNot f fe) f.assume && avoidsMaps (foldTM fe) f.assume\n    && avoids (f.inputs ++ foldNot f fe) f.pre && avoidsMaps (foldTM fe) f.pre\n    && avoids (f.inputs ++ foldCopies f ++ [fe.n, fe.N]) law && avoidsMaps (foldTM fe) law\ndef foldOk (f : Fold) (fe : FoldEnc) (facts : List Fact) (law : C) (nd : CNode) : Bool :=\n  foldShapeOk f fe && foldTermsOk f fe law\n    && facts.all (fun g => natC g.holds || [foldTable f fe true, foldTable f fe false].any (factBeq g))\n    && beqC nd.concl (substC (foldσ fe (.var fe.n)) law)\n    && nd.hyps.all (fun h => beqC h f.pre || beqC h (.lt (.var fe.n) (.var fe.N)))\n\n-- The tree as foldNodes' table.\ndef foldMaps (f : Fold) (fe : FoldEnc) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) (t : BTree) : Nat → Nat → Nat := fun i =>\n  if i = fe.kind then fun j => match t.flat[j]? with\n    | some (.node _ _ _) => 1\n    | _ => 0\n  else if i = fe.left then fun j => match t.flat[j]? with\n    | some (.node _ _ r) => j - 1 - r.size\n    | _ => 0\n  else if i = fe.right then fun j => j - 1\n  else match lookup (fun p => p.2 == i) fe.vtr with\n    | some p => fun j => match t.flat[j]? with\n      | some s => foldT f ρ maps s p.1\n      | none => 0\n    | none => maps i\n\nstructure FoldShape (f : Fold) (fe : FoldEnc) : Prop where\n  copies : copiesOk f = true\n  dvars : distinct (f.inputs ++ f.state.map (·.1) ++ foldCopies f ++ [fe.n, fe.N]) = true\n  dleaf : distinct (f.leaf.map (·.1)) = true\n  leafst : ∀ p ∈ f.leaf, p.1 ∈ f.state.map (·.1)\n  leafnode : ∀ p ∈ f.leaf, p.1 ∈ f.node.map (·.1)\n  nodest : ∀ p ∈ f.node, p.1 ∈ f.state.map (·.1)\n  dtm : distinct (foldTM fe) = true\n  vin : ∀ x ∈ f.inputs, x ∈ fe.vtr.map (·.1)\n  vst : ∀ x ∈ f.state.map (·.1), x ∈ fe.vtr.map (·.1)\n  vn : fe.n ∉ fe.vtr.map (·.1)\n  vN : fe.N ∉ fe.vtr.map (·.1)\n\ntheorem foldShape_of {f : Fold} {fe : FoldEnc} (h : foldShapeOk f fe = true) : FoldShape f fe := by\n  simp only [foldShapeOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨hc, hd⟩, hdl⟩, hl⟩, hn⟩, hdt⟩, hv⟩, hvn⟩, hvN⟩ := h\n  refine ⟨hc, hd, hdl, fun p hp => List.contains_iff_mem.mp (and_parts (List.all_eq_true.mp hl p hp)).1,\n    fun p hp => List.contains_iff_mem.mp (and_parts (List.all_eq_true.mp hl p hp)).2,\n    fun p hp => List.contains_iff_mem.mp (List.all_eq_true.mp hn p hp), hdt,\n    fun x hx => List.contains_iff_mem.mp (List.all_eq_true.mp hv x (List.mem_append_left _ hx)),\n    fun x hx => List.contains_iff_mem.mp (List.all_eq_true.mp hv x (List.mem_append_right _ hx)),\n    not_mem_of_not_contains hvn, not_mem_of_not_contains hvN⟩\n\nsection fold\nvariable {f : Fold} {fe : FoldEnc} {ρ : Nat → Nat} {maps : Nat → Nat → Nat} {t : BTree} (hS : FoldShape f fe)\ninclude hS\n\ntheorem fs_parts : fe.kind ≠ fe.left ∧ fe.kind ≠ fe.right ∧ fe.left ≠ fe.right ∧ (∀ a ∈ fe.vtr.map (·.2), a ≠ fe.kind ∧ a ≠ fe.left ∧ a ≠ fe.right)\n    ∧ distinct (fe.vtr.map (·.2)) = true := by\n  have h := hS.dtm\n  simp only [foldTM, List.cons_append, List.nil_append] at h\n  obtain ⟨n1, d1⟩ := distinct_cons h\n  obtain ⟨n2, d2⟩ := distinct_cons d1\n  obtain ⟨n3, d3⟩ := distinct_cons d2\n  refine ⟨fun e => n1 (by rw [e]; simp), fun e => n1 (by rw [e]; simp), fun e => n2 (by rw [e]; simp),\n    fun a ha => ⟨fun e => n1 (by rw [← e]; simp [ha]), fun e => n2 (by rw [← e]; simp [ha]), fun e => n3 (by rw [← e]; exact ha)⟩, d3⟩\n\ntheorem fm_kind (j : Nat) : foldMaps f fe ρ maps t fe.kind j = match t.flat[j]? with\n    | some (.node _ _ _) => 1\n    | _ => 0 := by\n  simp only [foldMaps, if_pos rfl, ite_true]\ntheorem fm_left (j : Nat) : foldMaps f fe ρ maps t fe.left j = match t.flat[j]? with\n    | some (.node _ _ r) => j - 1 - r.size\n    | _ => 0 := by\n  have := fs_parts hS\n  simp only [foldMaps, if_neg (Ne.symm this.1), if_pos rfl, ite_true]\ntheorem fm_right (j : Nat) : foldMaps f fe ρ maps t fe.right j = j - 1 := by\n  have := fs_parts hS\n  simp only [foldMaps, if_neg (Ne.symm this.2.1), if_neg (Ne.symm this.2.2.1), if_pos rfl, ite_true]\ntheorem fm_v {p : Nat × Nat} (hp : p ∈ fe.vtr) (j : Nat) : foldMaps f fe ρ maps t p.2 j = match t.flat[j]? with\n    | some s => foldT f ρ maps s p.1\n    | none => 0 := by\n  obtain ⟨_, _, _, ha, hd⟩ := fs_parts hS\n  have h3 := ha p.2 (List.mem_map.mpr ⟨p, hp, rfl⟩)\n  simp only [foldMaps, if_neg h3.1, if_neg h3.2.1, if_neg h3.2.2, lookup_ren hd p hp]\ntheorem fm_o {i : Nat} (hi : i ∉ foldTM fe) : foldMaps f fe ρ maps t i = maps i := by\n  have h1 : i ≠ fe.kind := fun e => hi (by simp [foldTM, e])\n  have h2 : i ≠ fe.left := fun e => hi (by simp [foldTM, e])\n  have h3 : i ≠ fe.right := fun e => hi (by simp [foldTM, e])\n  have hn : lookup (fun p => p.2 == i) fe.vtr = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he\n    exact hi (List.mem_append_right _ (List.mem_map.mpr ⟨q, hq, he⟩)))\n  simp only [foldMaps, if_neg h1, if_neg h2, if_neg h3, hn]\n\n-- What no leaf or node sets, and no copy: the inputs a node carries, else as before the tree.\ntheorem foldT_frame {y : Nat} (hy : y ∉ f.state.map (·.1)) (hc : y ∉ foldCopies f) (s : BTree) :\n    foldT f ρ maps s y = withInputs f.inputs ρ s.req y := by\n  cases s with\n  | leaf ι =>\n    simp only [foldT, BTree.req]\n    exact applyS_other (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hy (hS.leafst p hp)) _ _\n  | node ι l r =>\n    simp only [foldT, BTree.req]\n    rw [applyS_other (fun h => by obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact hy (hS.nodest p hp))]\n    exact withChildren_plain f _ _ _ (fun h => hc (List.mem_append_left _ h)) (fun h => hc (List.mem_append_right _ h))\n\ntheorem fold_σ_in {Q : Nat → Nat} {w : E} {j : Nat} {s : BTree} (hw : evalE Q (foldMaps f fe ρ maps t) w = j)\n    (hs : t.flat[j]? = some s) {x : Nat} (hx : x ∈ fe.vtr.map (·.1)) : applyS (foldσ fe w) Q (foldMaps f fe ρ maps t) x = foldT f ρ maps s x := by\n  cases h : lookup (fun p => p.1 == x) fe.vtr with\n  | none =>\n    exfalso; obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hx\n    have := lookup_none_all h p hp; simp at this\n  | some q =>\n    obtain ⟨hq, hqx⟩ := lookup_some h\n    have hqx' : q.1 = x := by simpa using hqx\n    have ha : assoc (foldσ fe w) x = some (.get q.2 w) := by\n      simp only [assoc, foldσ, lookup_map_pred, h, Option.map_some]\n    simp only [applyS, ha, evalE, fm_v hS hq, hw, hs, hqx']\n\ntheorem fold_σ_out {Q : Nat → Nat} {w : E} {x : Nat} (hx : x ∉ fe.vtr.map (·.1)) :\n    applyS (foldσ fe w) Q (foldMaps f fe ρ maps t) x = Q x := by\n  apply applyS_other\n  intro h; apply hx\n  obtain ⟨a, ha, rfl⟩ := List.mem_map.mp h\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp ha\n  exact List.mem_map.mpr ⟨p, hp, rfl⟩\n\n-- A term that reads no state variable, copy or added variable, at a node's frame: at its inputs.\ntheorem fold_at {Q : Nat → Nat} (hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → Q i = ρ i) {w : E} {j : Nat} {s : BTree}\n    (hw : evalE Q (foldMaps f fe ρ maps t) w = j) (hs : t.flat[j]? = some s) {y : Nat} (hy : y ∉ foldNot f fe) :\n    applyS (foldσ fe w) Q (foldMaps f fe ρ maps t) y = withInputs f.inputs ρ s.req y := by\n  have hy1 : y ∉ f.state.map (·.1) := fun h => hy (by simp only [foldNot, List.mem_append]; exact Or.inl (Or.inl h))\n  have hy2 : y ∉ foldCopies f := fun h => hy (by simp only [foldNot, List.mem_append]; exact Or.inl (Or.inr h))\n  have hy3 : y ≠ fe.n := fun e => hy (by simp [foldNot, e])\n  have hy4 : y ≠ fe.N := fun e => hy (by simp [foldNot, e])\n  by_cases hv : y ∈ fe.vtr.map (·.1)\n  · rw [fold_σ_in hS hw hs hv, foldT_frame hS hy1 hy2]\n  · rw [fold_σ_out hS hv, hQ y hy3 hy4, withInputs_other (fun h => hv (hS.vin y h))]\n\ntheorem dvars_parts : (∀ x ∈ f.inputs, x ∉ foldCopies f) ∧ fe.n ≠ fe.N ∧ (∀ x ∈ f.inputs ++ f.state.map (·.1) ++ foldCopies f, x ≠ fe.n ∧ x ≠ fe.N) := by\n  obtain ⟨d1, d2, d3⟩ := distinct_append hS.dvars\n  obtain ⟨d4, _, d6⟩ := distinct_append d1\n  obtain ⟨_, _, d9⟩ := distinct_append d4\n  obtain ⟨n1, _⟩ := distinct_cons d2\n  refine ⟨fun x hx hc => d6 x (List.mem_append_left _ hx) hc, fun e => n1 (by rw [e]; simp), fun x hx => ⟨fun e => d3 x hx (by rw [e]; simp), fun e => d3 x hx (by rw [e]; simp)⟩⟩\n\n-- A node's frame, as foldNodeσ reads it from the table: as withChildren reads it from the children.\ntheorem fold_node {Q : Nat → Nat} (hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → Q i = ρ i) {j : Nat} {ι : Nat → Nat} {l r : BTree}\n    (hs : t.flat[j]? = some (.node ι l r)) (hj : Q fe.n = j) {y : Nat} (hy1 : y ∉ f.state.map (·.1)) (hy2 : y ≠ fe.n) (hy3 : y ≠ fe.N) :\n    applyS (foldNodeσ f fe) Q (foldMaps f fe ρ maps t) y = withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r) y := by\n  obtain ⟨_, hr1, hl1⟩ := flat_node t j ι l r hs\n  have hwn : evalE Q (foldMaps f fe ρ maps t) (.var fe.n) = j := hj\n  have hwl : evalE Q (foldMaps f fe ρ maps t) (.get fe.left (.var fe.n)) = j - 1 - r.size := by\n    simp only [evalE, hj, fm_left hS, hs]\n  have hwr : evalE Q (foldMaps f fe ρ maps t) (.get fe.right (.var fe.n)) = j - 1 := by\n    simp only [evalE, hj, fm_right hS]\n  have hcp := (dvars_parts hS).1\n  simp only [applyS, foldNodeσ, assoc_append_or, assoc_map_kv, withChildren]\n  by_cases hin : y ∈ f.inputs\n  · have hl0 : lookup (fun e => e.2.1 == y) f.state = none := lookup_none (fun e he => by\n      simp only [beq_eq_false_iff_ne]; intro h; exact hcp y hin (List.mem_append_left _ (List.mem_map.mpr ⟨e, he, h⟩)))\n    have hr0 : lookup (fun e => e.2.2 == y) f.state = none := lookup_none (fun e he => by\n      simp only [beq_eq_false_iff_ne]; intro h; exact hcp y hin (List.mem_append_right _ (List.mem_map.mpr ⟨e, he, h⟩)))\n    have hi0 : (lookup (fun i => i == y) f.inputs).map (fun i => substE (foldσ fe (.var fe.n)) (.var i)) = some (substE (foldσ fe (.var fe.n)) (.var y)) := by\n      cases h : lookup (fun i => i == y) f.inputs with\n      | none => have := lookup_none_all h y hin; simp at this\n      | some i => obtain ⟨_, hi⟩ := lookup_some h; simp only [beq_iff_eq] at hi; simp [hi]\n    simp only [hl0, hr0, hi0, Option.some_or]\n    rw [subst_evalE]\n    show applyS (foldσ fe (.var fe.n)) Q (foldMaps f fe ρ maps t) y = _\n    rw [fold_σ_in hS hwn hs (hS.vin y hin), foldT_frame hS hy1 (hcp y hin)]\n    rfl\n  · have hi0 : lookup (fun i => i == y) f.inputs = none := lookup_none (fun i hi => by\n      simp only [beq_eq_false_iff_ne]; intro h; exact hin (h ▸ hi))\n    simp only [hi0, Option.map_none, Option.none_or]\n    cases hl : lookup (fun e => e.2.1 == y) f.state with\n    | some e =>\n      obtain ⟨he, _⟩ := lookup_some hl\n      simp only [Option.map_some, Option.some_or]\n      rw [subst_evalE]\n      show applyS (foldσ fe (.get fe.left (.var fe.n))) Q (foldMaps f fe ρ maps t) e.1 = _\n      exact fold_σ_in hS hwl hl1 (hS.vst e.1 (List.mem_map.mpr ⟨e, he, rfl⟩))\n    | none =>\n      simp only [Option.map_none, Option.none_or]\n      cases hr : lookup (fun e => e.2.2 == y) f.state with\n      | some e =>\n        obtain ⟨he, _⟩ := lookup_some hr\n        simp only [Option.map_some]\n        rw [subst_evalE]\n        show applyS (foldσ fe (.get fe.right (.var fe.n))) Q (foldMaps f fe ρ maps t) e.1 = _\n        exact fold_σ_in hS hwr hr1 (hS.vst e.1 (List.mem_map.mpr ⟨e, he, rfl⟩))\n      | none =>\n        simp only [Option.map_none]\n        rw [hQ y hy2 hy3, withInputs_other hin]\nend fold\n\nstructure FoldTerms (f : Fold) (fe : FoldEnc) (law : C) : Prop where\n  leafz : ∀ p ∈ f.leaf, avoidsE (foldNot f fe) p.2 = true\n  leafm : ∀ p ∈ f.leaf, avoidsMapsE (foldTM fe) p.2 = true\n  nodez : ∀ p ∈ f.node, avoidsE (f.state.map (·.1) ++ [fe.n, fe.N]) p.2 = true\n  nodem : ∀ p ∈ f.node, avoidsMapsE (foldTM fe) p.2 = true\n  asz : avoids (foldNot f fe) f.assume = true\n  asm : avoidsMaps (foldTM fe) f.assume = true\n  prz : avoids (f.inputs ++ foldNot f fe) f.pre = true\n  prm : avoidsMaps (foldTM fe) f.pre = true\n  lawz : avoids (f.inputs ++ foldCopies f ++ [fe.n, fe.N]) law = true\n  lawm : avoidsMaps (foldTM fe) law = true\n\ntheorem foldTerms_of {f : Fold} {fe : FoldEnc} {law : C} (h : foldTermsOk f fe law = true) : FoldTerms f fe law := by\n  simp only [foldTermsOk, Bool.and_eq_true] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨hl, hn⟩, ha⟩, ham⟩, hp⟩, hpm⟩, hz⟩, hzm⟩ := h\n  exact ⟨fun p hp => (and_parts (List.all_eq_true.mp hl p hp)).1, fun p hp => (and_parts (List.all_eq_true.mp hl p hp)).2,\n    fun p hp => (and_parts (List.all_eq_true.mp hn p hp)).1, fun p hp => (and_parts (List.all_eq_true.mp hn p hp)).2, ha, ham, hp, hpm, hz, hzm⟩\n\n-- The table's fact holds of the tree's table, wherever T and Ω... the size N is the tree's.\ntheorem table_holds {f : Fold} {fe : FoldEnc} {law : C} {ρ : Nat → Nat} {maps : Nat → Nat → Nat} {t : BTree} (hS : FoldShape f fe)\n    (hT : FoldTerms f fe law) (hA : Allowed f ρ maps t) (b : Bool) {Q : Nat → Nat} (hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → Q i = ρ i)\n    (hN : Q fe.N = t.size) : evalC Q (foldMaps f fe ρ maps t) (foldTable f fe b).holds = true := by\n  apply impl_true\n  intro h0\n  rw [evalC_iff] at h0; simp only [holdsC, evalE] at h0\n  rw [hN, ← flat_length] at h0\n  have hs : t.flat[Q fe.n]? = some t.flat[Q fe.n] := List.getElem?_eq_getElem h0\n  have hal := flat_allowed t hA _ (List.getElem_mem h0)\n  have hw : evalE Q (foldMaps f fe ρ maps t) (.var fe.n) = Q fe.n := rfl\n  have hkind : evalE Q (foldMaps f fe ρ maps t) (.get fe.kind (.var fe.n)) = match t.flat[Q fe.n]? with\n      | some (.node _ _ _) => 1\n      | _ => 0 := by simp only [evalE, fm_kind hS]\n  -- the assumption, at the node's own inputs\n  have hasm : ∀ (s : BTree), t.flat[Q fe.n]? = some s → evalC (withInputs f.inputs ρ s.req) maps f.assume = true →\n      evalC Q (foldMaps f fe ρ maps t) (substC (foldσ fe (.var fe.n)) f.assume) = true := by\n    intro s hs' hx\n    rw [subst_evalC, congr2C (ρ' := withInputs f.inputs ρ s.req) (M' := maps) f.assume\n      (fun y hy => fold_at hS hQ hw hs' (avoids_occ hT.asz hy)) (fun m hm => fm_o hS (avoidsMaps_occ hT.asm hm))]\n    exact hx\n  generalize t.flat[Q fe.n] = s at hs hal\n  cases s with\n  | leaf ι =>\n    have hk : evalE Q (foldMaps f fe ρ maps t) (.get fe.kind (.var fe.n)) = 0 := by rw [hkind, hs]\n    refine and_true2 (holds_of_le (by rw [hk]; simp [evalE])) (and_true2 (impl_true fun _ => ?_) (impl_true fun h1 => ?_))\n    · apply andL_true\n      intro c hc\n      rcases List.mem_cons.mp hc with rfl | hc\n      · simp [trueC, evalC, evalE]\n      rcases List.mem_append.mp hc with hc | hc\n      · cases b\n        · simp at hc\n        · simp at hc; subst hc; exact hasm _ hs hal\n      · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n        apply holds_of_eq\n        rw [subst_evalE, subst_evalE]\n        show applyS (foldσ fe (.var fe.n)) Q (foldMaps f fe ρ maps t) p.1 = _\n        rw [fold_σ_in hS hw hs (hS.vst p.1 (hS.leafst p hp)), congr2E (ρ' := withInputs f.inputs ρ ι) (M' := maps) p.2\n          (fun y hy => fold_at hS hQ hw hs (avoidsE_occ (hT.leafz p hp) hy)) (fun m hm => fm_o hS (avoidsMapsE_occ (hT.leafm p hp) hm))]\n        simp only [foldT, applyS, assoc, lookup_unique hS.dleaf hp, Option.map_some]\n    · rw [evalC_iff] at h1; simp only [holdsC, hk] at h1; simp [evalE] at h1\n  | node ι l r =>\n    obtain ⟨hb, _, _⟩ := flat_node t (Q fe.n) ι l r hs\n    have pl := size_pos l\n    have hk : evalE Q (foldMaps f fe ρ maps t) (.get fe.kind (.var fe.n)) = 1 := by rw [hkind, hs]\n    refine and_true2 (holds_of_le (by rw [hk]; simp [evalE])) (and_true2 (impl_true fun h1 => ?_) (impl_true fun _ => ?_))\n    · rw [evalC_iff] at h1; simp only [holdsC, hk] at h1; simp [evalE] at h1\n    · apply andL_true\n      intro c hc\n      rcases List.mem_cons.mp hc with rfl | hc\n      · apply holds_of_lt\n        have hl' : evalE Q (foldMaps f fe ρ maps t) (.get fe.left (.var fe.n)) = Q fe.n - 1 - r.size := by\n          simp only [evalE, fm_left hS, hs]\n        rw [hl']; show Q fe.n - 1 - r.size < Q fe.n; omega\n      rcases List.mem_cons.mp hc with rfl | hc\n      · apply holds_of_lt\n        have hr' : evalE Q (foldMaps f fe ρ maps t) (.get fe.right (.var fe.n)) = Q fe.n - 1 := by\n          simp only [evalE, fm_right hS]\n        rw [hr']; show Q fe.n - 1 < Q fe.n; omega\n      rcases List.mem_append.mp hc with hc | hc\n      · cases b\n        · simp at hc\n        · simp at hc; subst hc\n          apply hasm _ hs\n          show evalC (withInputs f.inputs ρ ι) maps f.assume = true\n          rw [← congrC (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) _ maps f.assume\n            (fun y hy => withChildren_plain f _ _ _\n              (fun h => avoids_occ hT.asz hy (by simp only [foldNot, foldCopies, List.mem_append]; exact Or.inl (Or.inr (Or.inl h))))\n              (fun h => avoids_occ hT.asz hy (by simp only [foldNot, foldCopies, List.mem_append]; exact Or.inl (Or.inr (Or.inr h)))))]\n          exact hal.1\n      · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hc\n        apply holds_of_eq\n        rw [subst_evalE, subst_evalE]\n        show applyS (foldσ fe (.var fe.n)) Q (foldMaps f fe ρ maps t) p.1 = _\n        rw [fold_σ_in hS hw hs (hS.vst p.1 (hS.leafst p hp))]\n        simp only [foldT]\n        rw [applyS_getD]\n        obtain ⟨e, he⟩ : ∃ e, assoc f.node p.1 = some e := by\n          cases h : assoc f.node p.1 with\n          | some e => exact ⟨e, rfl⟩\n          | none =>\n            exfalso; obtain ⟨q, hq, hq1⟩ := List.mem_map.mp (hS.leafnode p hp)\n            simp only [assoc, Option.map_eq_none_iff] at h\n            have := lookup_none_all h q hq; simp [hq1] at this\n        have hem := assoc_some_mem he\n        rw [he]\n        simp only [Option.getD]\n        exact congr2E e (fun y hy => (fold_node hS hQ hs rfl (fun h => avoidsE_occ (hT.nodez _ hem) hy (List.mem_append_left _ h))\n            (fun h => avoidsE_occ (hT.nodez _ hem) hy (by rw [h]; simp)) (fun h => avoidsE_occ (hT.nodez _ hem) hy (by rw [h]; simp))).symm)\n          (fun m hm => (fm_o hS (avoidsMapsE_occ (hT.nodem _ hem) hm)).symm)\n\ndef foldEnv (fe : FoldEnc) (t : BTree) (ρ : Nat → Nat) : Nat → Nat := fun i =>\n  if i = fe.n then t.size - 1 else if i = fe.N then t.size else ρ i\n\n/-- A cyclic proof of a fold's law over trees as tables (`foldNodes`), checked against the fold's table (`foldOk`): for\nparams that meet the precondition, the law holds of every tree whose inputs meet the assumption, as `fold_sound` says of\nthe structural induction. -/\ntheorem cyc_fold_sound (f : Fold) (fe : FoldEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (law : C) (nd : CNode) (hn : nd ∈ nodes) (hok : foldOk f fe facts law nd = true) (maps : Nat → Nat → Nat) (ρ : Nat → Nat)\n    (h0 : evalC ρ maps f.pre = true) : ∀ t, Allowed f ρ maps t → evalC (foldT f ρ maps t) maps law = true := by\n  intro t hA\n  simp only [foldOk, Bool.and_eq_true] at hok\n  obtain ⟨⟨⟨⟨hsh, hte⟩, hfa⟩, hcon⟩, hhy⟩ := hok\n  have hS := foldShape_of hsh\n  have hT := foldTerms_of hte\n  obtain ⟨_, hnN, hx⟩ := dvars_parts hS\n  have hE : ∀ i, i ≠ fe.n → i ≠ fe.N → foldEnv fe t ρ i = ρ i := fun i h1 h2 => by simp [foldEnv, h1, h2]\n  have hEn : foldEnv fe t ρ fe.n = t.size - 1 := by simp [foldEnv]\n  have hEN : foldEnv fe t ρ fe.N = t.size := by simp [foldEnv, Ne.symm hnN]\n  have pt := size_pos t\n  have hF : FactsHold facts (foldEnv fe t ρ) (foldMaps f fe ρ maps t) := by\n    intro g hg vals\n    have hgi := List.all_eq_true.mp hfa g hg\n    simp only [Bool.or_eq_true] at hgi\n    rcases hgi with hnc | hcan\n    · exact natC_true _ hnc\n    obtain ⟨g', hg', hb⟩ := List.any_eq_true.mp hcan\n    simp only [factBeq, Bool.and_eq_true, beq_iff_eq] at hb\n    rw [hb.1, beqC_eq hb.2]\n    have hk : g'.keys = [fe.n] := by\n      simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hg'\n      rcases hg' with rfl | rfl <;> rfl\n    have hQ : ∀ i, i ≠ fe.n → i ≠ fe.N → override g'.keys vals (foldEnv fe t ρ) i = ρ i := fun i h1 h2 => by\n      rw [hk]; simp only [override]\n      rw [if_neg (fun h => h1 (by simpa using h))]\n      exact hE i h1 h2\n    have hQN : override g'.keys vals (foldEnv fe t ρ) fe.N = t.size := by\n      rw [hk]; simp only [override]\n      rw [if_neg (fun h => hnN (by have h' : fe.N = fe.n := by simpa using h\n                                   exact h'.symm))]\n      exact hEN\n    simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hg'\n    rcases hg' with rfl | rfl\n    · exact table_holds hS hT hA true hQ hQN\n    · exact table_holds hS hT hA false hQ hQN\n  have hH : ∀ c ∈ nd.hyps, evalC (foldEnv fe t ρ) (foldMaps f fe ρ maps t) c = true := by\n    intro c hc\n    have h := List.all_eq_true.mp hhy c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with h | h\n    · rw [beqC_eq h, congr2C (ρ' := ρ) (M' := maps) _ (fun y hy => hE y\n        (fun e => avoids_occ hT.prz hy (by rw [e]; simp [foldNot])) (fun e => avoids_occ hT.prz hy (by rw [e]; simp [foldNot])))\n        (fun m hm => fm_o hS (avoidsMaps_occ hT.prm hm))]\n      exact h0\n    · rw [beqC_eq h]; apply holds_of_lt; simp only [evalE, hEn, hEN]; omega\n  have hc0 := cyclic_sound facts nodes hc (foldMaps f fe ρ maps t) (foldEnv fe t ρ) hF nd hn hH\n  have hw : evalE (foldEnv fe t ρ) (foldMaps f fe ρ maps t) (.var fe.n) = t.size - 1 := hEn\n  rw [beqC_eq hcon, subst_evalC] at hc0\n  refine (congr2C (ρ' := applyS (foldσ fe (.var fe.n)) (foldEnv fe t ρ) (foldMaps f fe ρ maps t)) (M' := foldMaps f fe ρ maps t) law\n    (fun y hy => ?_) (fun m hm => (fm_o hS (avoidsMaps_occ hT.lawm hm)).symm)).trans hc0\n  have hy' := avoids_occ hT.lawz hy\n  have hyi : y ∉ f.inputs := fun h => hy' (List.mem_append_left _ (List.mem_append_left _ h))\n  have hyc : y ∉ foldCopies f := fun h => hy' (List.mem_append_left _ (List.mem_append_right _ h))\n  have hyn : y ≠ fe.n := fun e => hy' (by rw [e]; simp)\n  have hyN : y ≠ fe.N := fun e => hy' (by rw [e]; simp)\n  by_cases hv : y ∈ fe.vtr.map (·.1)\n  · rw [fold_σ_in hS hw (flat_last t) hv]\n  · rw [fold_σ_out hS hv, hE y hyn hyN, foldT_frame hS (fun h => hv (hS.vst y h)) hyc, withInputs_other hyi]\n\nend Kern\n",
+    "Data.lean": "import Cyclic\n\n/-!\nData: recursive datatypes as values, for cyclic proofs. Lean 4.34.0, core only, on top of `Cyclic.lean`.\n\ncore/data.ts proves laws about datatypes (lists, trees, any declared with constructors whose fields are naturals or\nvalues of the datatype) by cyclic proofs over an encoding: every natural is a value of each datatype, a value is read\nthrough maps (its constructor's tag, its fields, its size), a function of several arguments is a map read at their\npairing `pk a b = (a + b)² + b` (left-nested). Nothing here is trusted beyond `Cyclic.lean`: an export defines the\ndatatype as a Lean `inductive` and the functions by pattern matching, gives each map of the encoding its meaning (the\nmodel, through a bijection between the naturals and the datatype's values), proves every fact of the cyclic proof true\nof that model, and concludes the law about the Lean definitions from `cyclic_sound`. What this file gives the exports:\n\n- `pk`, the pairing, injective (`pk_inj`), and a left inverse `unpk` (`unpk_pk`, chosen classically, so no division or\n  square root is computed);\n- `cun`, the naturals onto the pairs, in order of their sum (`cun 0 = (0, 0)`, then each pair after the last), with\n  `cpair` its inverse (`cun_cpair`, `cpair_cun`): a bijection, the one a datatype's codes are built from, each part at\n  most the whole (`cun_fst_le`, `cun_snd_le`) so a value's fields have smaller codes;\n- `tup q k i`, the i-th of k naturals packed in q by `tupk` (`tup_tupk`), at most q (`tup_le`).\n-/\n\nnamespace Kern\n\n/-! ### The pairing the encoding reads several arguments at -/\n\n/-- `(a + b)² + b`: core/dsl.ts's argsKey of two arguments. -/\ndef pk (a b : Nat) : Nat := (a + b) * (a + b) + b\n\ntheorem sq_succ (s : Nat) : (s + 1) * (s + 1) = s * s + 2 * s + 1 := by\n  rw [Nat.add_mul, Nat.mul_add, Nat.mul_one, Nat.one_mul]; omega\n\ntheorem pk_lt {a b c d : Nat} (h : a + b < c + d) : pk a b < pk c d := by\n  unfold pk\n  have h1 : (a + b + 1) * (a + b + 1) ≤ (c + d) * (c + d) := Nat.mul_self_le_mul_self h\n  have h2 := sq_succ (a + b)\n  omega\n\ntheorem pk_inj {a b c d : Nat} (h : pk a b = pk c d) : a = c ∧ b = d := by\n  have hs : a + b = c + d := by\n    rcases Nat.lt_trichotomy (a + b) (c + d) with hl | he | hg\n    · exact absurd h (Nat.ne_of_lt (pk_lt hl))\n    · exact he\n    · exact absurd h (Nat.ne_of_gt (pk_lt hg))\n  unfold pk at h\n  rw [hs] at h\n  omega\n\nopen Classical in\n/-- A left inverse of `pk`: the pair a natural is the pairing of, where it is one. -/\nnoncomputable def unpk (n : Nat) : Nat × Nat :=\n  if h : ∃ p : Nat × Nat, pk p.1 p.2 = n then Classical.choose h else (0, 0)\n\ntheorem unpk_pk (a b : Nat) : unpk (pk a b) = (a, b) := by\n  have h : ∃ p : Nat × Nat, pk p.1 p.2 = pk a b := ⟨(a, b), rfl⟩\n  unfold unpk\n  split\n  · rename_i h'\n    have ⟨h1, h2⟩ := pk_inj (Classical.choose_spec h')\n    exact Prod.ext h1 h2\n  · exact absurd h ‹_›\n\n@[simp] theorem unpk_fst (a b : Nat) : (unpk ((a + b) * (a + b) + b)).1 = a := by\n  have := unpk_pk a b; unfold pk at this; rw [this]\n@[simp] theorem unpk_snd (a b : Nat) : (unpk ((a + b) * (a + b) + b)).2 = b := by\n  have := unpk_pk a b; unfold pk at this; rw [this]\n\n-- The pairing with a 0 argument, as simp leaves it: (a + 0)² + 0 is a·a, (0 + b)² + b is b·b + b, and (0 + 0)² + 0 is 0.\n@[simp] theorem unpk_sq_fst (a : Nat) : (unpk (a * a)).1 = a := by\n  have := unpk_pk a 0; simp only [pk, Nat.add_zero] at this; rw [this]\n@[simp] theorem unpk_sq_snd (a : Nat) : (unpk (a * a)).2 = 0 := by\n  have := unpk_pk a 0; simp only [pk, Nat.add_zero] at this; rw [this]\n@[simp] theorem unpk_sqb_fst (b : Nat) : (unpk (b * b + b)).1 = 0 := by\n  have := unpk_pk 0 b; simp only [pk, Nat.zero_add] at this; rw [this]\n@[simp] theorem unpk_sqb_snd (b : Nat) : (unpk (b * b + b)).2 = b := by\n  have := unpk_pk 0 b; simp only [pk, Nat.zero_add] at this; rw [this]\n@[simp] theorem unpk_zero : unpk 0 = (0, 0) := unpk_pk 0 0\n\n/-! ### A bijection between the naturals and the pairs -/\n\n/-- The naturals onto the pairs, in order of their sum: 0 is (0, 0), and each next natural the pair after. -/\ndef cun : Nat → Nat × Nat\n  | 0 => (0, 0)\n  | n + 1 => match cun n with\n    | (0, b) => (b + 1, 0)\n    | (a + 1, b) => (a, b + 1)\n\n/-- 0 + 1 + … + s. -/\ndef tri : Nat → Nat\n  | 0 => 0\n  | s + 1 => tri s + s + 1\n\n/-- `cun`'s inverse. -/\ndef cpair (a b : Nat) : Nat := tri (a + b) + b\n\ntheorem le_tri : ∀ s, s ≤ tri s\n  | 0 => Nat.le_refl 0\n  | s + 1 => by have := le_tri s; simp only [tri]; omega\n\ntheorem cpair_succ_left (b : Nat) : cpair (b + 1) 0 = cpair 0 b + 1 := by\n  simp only [cpair, Nat.add_zero, Nat.zero_add, tri]\n\ntheorem cpair_succ_right (a b : Nat) : cpair a (b + 1) = cpair (a + 1) b + 1 := by\n  simp only [cpair]\n  have e : a + (b + 1) = a + 1 + b := by omega\n  rw [e]; omega\n\ntheorem cpair_cun : ∀ n, cpair (cun n).1 (cun n).2 = n\n  | 0 => rfl\n  | n + 1 => by\n    have ih := cpair_cun n\n    rcases h : cun n with ⟨a, b⟩\n    rw [h] at ih\n    cases a with\n    | zero => simp only [cun, h]; rw [cpair_succ_left]; simp only at ih; omega\n    | succ a => simp only [cun, h]; rw [cpair_succ_right]; simp only at ih; omega\n\ntheorem cun_tri : ∀ s b, b ≤ s → cun (tri s + b) = (s - b, b)\n  | 0, 0, _ => rfl\n  | 0, _ + 1, h => absurd h (by omega)\n  | s + 1, 0, _ => by\n    have ih := cun_tri s s (Nat.le_refl s)\n    have e : tri (s + 1) + 0 = (tri s + s) + 1 := by simp only [tri]; try omega\n    rw [e]\n    simp only [cun, ih, Nat.sub_self, Nat.sub_zero]\n  | s + 1, b + 1, h => by\n    have ih := cun_tri (s + 1) b (by omega)\n    have e : tri (s + 1) + (b + 1) = (tri (s + 1) + b) + 1 := by omega\n    rw [e]\n    simp only [cun, ih]\n    have e2 : s + 1 - b = (s - b) + 1 := by omega\n    rw [e2]\n    simp only\n    have e3 : s + 1 - (b + 1) = s - b := by omega\n    rw [e3]\n\ntheorem cun_cpair (a b : Nat) : cun (cpair a b) = (a, b) := by\n  unfold cpair\n  rw [cun_tri (a + b) b (by omega)]\n  simp\n\n@[simp] theorem cun_cpair_fst (a b : Nat) : (cun (cpair a b)).1 = a := by rw [cun_cpair]\n@[simp] theorem cun_cpair_snd (a b : Nat) : (cun (cpair a b)).2 = b := by rw [cun_cpair]\n@[simp] theorem cpair_cun_eq (n : Nat) : cpair (cun n).1 (cun n).2 = n := cpair_cun n\n\ntheorem cpair_ge (a b : Nat) : a + b ≤ cpair a b := by\n  unfold cpair; have := le_tri (a + b); omega\n\ntheorem cun_fst_le (n : Nat) : (cun n).1 ≤ n := by\n  have h := cpair_ge (cun n).1 (cun n).2; rw [cpair_cun] at h; omega\ntheorem cun_snd_le (n : Nat) : (cun n).2 ≤ n := by\n  have h := cpair_ge (cun n).1 (cun n).2; rw [cpair_cun] at h; omega\n\n/-! ### Tuples of naturals -/\n\n/-- The i-th of k naturals packed in q (`tupk`): the first is `(cun q).1`, the rest packed in `(cun q).2`, the last q\nitself. -/\ndef tup (q : Nat) : Nat → Nat → Nat\n  | 0, _ => q\n  | 1, _ => q\n  | _ + 2, 0 => (cun q).1\n  | k + 2, i + 1 => tup (cun q).2 (k + 1) i\n\n/-- Naturals packed by `cpair`, right-nested; one is itself. -/\ndef tupk : List Nat → Nat\n  | [] => 0\n  | [x] => x\n  | x :: xs => cpair x (tupk xs)\n\ntheorem tup_le : ∀ (k i q : Nat), tup q k i ≤ q\n  | 0, _, _ => Nat.le_refl _\n  | 1, _, _ => Nat.le_refl _\n  | _ + 2, 0, q => cun_fst_le q\n  | k + 2, i + 1, q => Nat.le_trans (tup_le (k + 1) i (cun q).2) (cun_snd_le q)\n\n@[simp] theorem tup_two_zero (k a q : Nat) : tup (cpair a q) (k + 2) 0 = a := by simp [tup]\n@[simp] theorem tup_two_succ (k i a q : Nat) : tup (cpair a q) (k + 2) (i + 1) = tup q (k + 1) i := by simp [tup]\n@[simp] theorem tup_one (q i : Nat) : tup q 1 i = q := rfl\n@[simp] theorem tupk_one (x : Nat) : tupk [x] = x := rfl\n@[simp] theorem tupk_cons (x y : Nat) (ys : List Nat) : tupk (x :: y :: ys) = cpair x (tupk (y :: ys)) := rfl\n\n/-! ### Facts at their keys -/\n\n/-- A condition's value as a natural is at most 1 (a function to `Bool` as the encoding reads it). -/\n@[simp] theorem ite_one_zero_le (p : Prop) [Decidable p] : (if p then 1 else 0) ≤ 1 := by\n  split <;> omega\n\n/-- A fact read at its own keys reads the values given there. -/\ntheorem override_at (keys : List Nat) (i : Nat) (h : keys.contains i = true) (vals env : Nat → Nat) :\n    override keys vals env i = vals i := by\n  unfold override; rw [if_pos h]\n\nend Kern\n",
 };