gdp-wired 0.20.0 → 0.21.0

package/dist/lean-kernel/library.js

@@ -9,9 +9,9 @@ export const leanLibrary = {
     "History.lean": "import Sets\n/-!\nHistory: kernel.ts's `historyMachine`, the rule for a machine that keeps a log of the requests it accepts.\n\nA machine with a history (`HMachine`) is a machine with sets (`SMachine`: maps, flags, sets a request carries, conditions\nat every key, writes at every key) plus:\n- `keep`: whether a request is appended to the history (read with the flags decided);\n- `record`, `rvars`: the recorded inputs, and the variables (r.f) a sum or query reads them as;\n- `sums`: state variables defined as the sum, over the history, of a term of the record and the params;\n- `queries`: inputs whose value at each request is the sum, over the history before it, of a term of the record, the\n  params and the request's other (plain) inputs;\n- `rels`: relations (when, a, b): `when` (params and plain inputs) implies a ≤ b, with a and b homogeneous (+ and × by\n  a constant, no constant term) over sums and queries.\n\n`HReach` is the history semantics: the history is a list of request environments (sums and queries only read their\nrecorded inputs from them), every sum is recomputed from it, every query is computed from it at the request.\nLean builds what kernel.ts builds: the plain machine (`HMachine.plain`: each sum a state variable from 0, plus its term\nat the request when the request is kept; the relations conjoined to the assumption) and one goal per relation, a ≤ b\nfor a single record (`recordGoal`), and checks kernel.ts's side conditions (`histOk`). `hmachine_sound`: if those goals\ncheck and the plain machine's proof checks (`checkSMachine`), every law holds in every state the history semantics\nreaches. A step reads its request through the machine's view (`sView`): its flags decided, its quantified flags,\nthe maps it carries; sums, queries and relations read none of those. The step from one record to the whole history (`homog_sum`, `sum_le_map`): a homogeneous term of sums over one\nlist is the sum of the term over its elements.\n-/\nnamespace Kern\nopen Cert\n\nstructure HMachine where\n  s : SMachine                  -- the machine without its history; its inputs include the queries\n  keep : C                      -- whether the request is appended to the history (flags decided)\n  record : List Nat             -- the recorded inputs\n  rvars : List Nat              -- the record's fields as variables, one per recorded input\n  sums : List (Nat × E)         -- a sum's state variable and its term over the fields and the params\n  queries : List (Nat × E)      -- a query's input variable and its term over the fields, params and plain inputs\n  rels : List (C × E × E)       -- (when, a, b): a ≤ b whenever `when` holds\n\n-- A field reads its recorded input from the record; every other variable reads ρ.\ndef fieldEnv (h : HMachine) (rec ρ : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun p => p.1 == i) (h.rvars.zip h.record) with\n  | some p => rec p.2\n  | none => ρ i\n\ndef sumAt (h : HMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) (g : E) : Nat :=\n  (hist.map fun rec => evalE (fieldEnv h rec ρ) M g).sum\n\ndef withSums (h : HMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat := fun i =>\n  match assoc h.sums i with\n  | some g => sumAt h ρ M hist g\n  | none => ρ i\n\ndef withQueries (h : HMachine) (X : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat := fun i =>\n  match assoc h.queries i with\n  | some g => sumAt h X M hist g\n  | none => X i\n\ndef plainInputs (h : HMachine) : List Nat := h.s.f.m.inputs.filter fun i => !(h.queries.map (·.1)).contains i\n\n-- The request's inputs: the plain ones from ι, each query from the history.\ndef reqIn (h : HMachine) (ρ ι : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat :=\n  withQueries h (withInputs (plainInputs h) ρ ι) M hist\n-- The request as the step reads it: the machine's view with those inputs and the maps κ it carries (flags decided).\nnoncomputable def reqEnv (h : HMachine) (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : Nat → Nat :=\n  (sView h.s ρ M (reqIn h ρ ι M hist) κ).1\n\ndef kept (h : HMachine) (X : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : List (Nat → Nat) :=\n  if evalC X M h.keep then hist ++ [X] else hist\n\ninductive HReach (h : HMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps h.s.f.m M → evalC ρ M h.s.f.m.pre = true →\n      (∀ l ∈ h.s.facts, l.Holds ρ M) → h.s.PFacts ρ M → HReach h (withSums h (applyS h.s.f.m.init ρ M) M []) M []\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : HReach h ρ M hist →\n      evalC (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) h.s.f.m.assume = true →\n      HReach h (withSums h (applyS h.s.f.m.step (reqEnv h ρ ι κ M hist) (withCarried h.s M κ)) (withCarried h.s M κ)\n          (kept h (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) hist))\n        (everyMaps h.s (reqEnv h ρ ι κ M hist) (withCarried h.s M κ)) (kept h (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) hist)\n\n/-! What Lean builds -/\n\ndef fieldSub (h : HMachine) : List (Nat × E) := (h.rvars.zip h.record).map fun p => (p.1, .var p.2)\ndef TRUEC : C := .le (.const 0) (.const 0)\ndef relC (r : C × E × E) : C := .or (.not r.1) (.le r.2.1 r.2.2)\ndef relsC (rs : List (C × E × E)) : C := rs.foldr (fun r acc => .and (relC r) acc) TRUEC\ndef sumStep (h : HMachine) (s : Nat) (g : E) : E := .add (.var s) (.ite h.keep (substE (fieldSub h) g) (.const 0))\n\ndef HMachine.plain (h : HMachine) : SMachine :=\n  { h.s with f := ⟨{ h.s.f.m with\n      init := h.s.f.m.init ++ h.sums.map fun p => (p.1, .const 0),\n      step := h.s.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2),\n      assume := .and h.s.f.m.assume (relsC h.rels) }, h.s.f.flags⟩ }\n\n-- The variables a step decides: its flags, its quantified flags and their witnesses.\ndef fvs (h : HMachine) : List Nat := flagVars h.s.f.flags ++ h.s.qVars ++ h.s.wVars\n\n-- One record: the relation's two sides with each sum and query read as its term at that record.\ndef recordGoal (h : HMachine) (r : C × E × E) : List C :=\n  [h.s.f.m.pre, r.1, .not (.le (substE (h.sums ++ h.queries) r.2.1) (substE (h.sums ++ h.queries) r.2.2))]\n\nmutual\ndef homog (vs : List Nat) : E → Bool\n  | .var i => vs.contains i\n  | .add a b => homog vs a && homog vs b\n  | .mul _ a => homog vs a\n  | _ => false\ndef homogC (_vs : List Nat) : C → Bool\n  | _ => false\nend\n\n\n-- kernel.ts's checks: sums read the fields and params, queries also the plain inputs, `when` the params and plain\n-- inputs; nothing reads a map; the names don't collide; the precondition reads no input, flag or field.\ndef histOk (h : HMachine) : Bool :=\n  let ins := h.s.f.m.inputs\n  let qs := h.queries.map (·.1)\n  let ss := h.sums.map (·.1)\n  let st := h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1)\n  let fv := fvs h\n  h.rvars.length == h.record.length\n  && qs.all (fun q => ins.contains q)\n  && h.record.all (fun i => (plainInputs h).contains i)\n  && ss.all (fun s => !(ins ++ st ++ fv ++ h.rvars).contains s)\n  && h.rvars.all (fun v => !(ins ++ st ++ fv).contains v)\n  && fv.all (fun v => !ins.contains v)\n  && h.sums.all (fun p => avoidsE (ins ++ st ++ ss ++ fv) p.2 && !readsE p.2)\n  && h.queries.all (fun p => avoidsE (qs ++ st ++ ss ++ fv) p.2 && !readsE p.2)\n  && h.rels.all (fun r => avoids (qs ++ st ++ ss ++ fv ++ h.rvars) r.1 && !readsC r.1 && homog (ss ++ qs) r.2.1 && homog (ss ++ qs) r.2.2)\n  && avoids (ins ++ fv ++ h.rvars) h.s.f.m.pre && !readsC h.s.f.m.pre\n\n-- Per relation, (table, tree) for its record goal, in order; then the plain machine's proof.\ndef checkHMachine (h : HMachine) (ps : List SEntry) (rs : List (List VDef × Tree)) : Bool :=\n  histOk h && rs.length == h.rels.length && (h.rels.zip rs).all (fun p => checkGoal ⟨p.2.1, recordGoal h p.1⟩ p.2.2)\n    && checkSMachine h.plain ps\n\n/-! Lists and sums -/\n\ntheorem sum_map_add {α : Type} (f g : α → Nat) : ∀ l : List α, (l.map fun x => f x + g x).sum = (l.map f).sum + (l.map g).sum\n  | [] => rfl\n  | a :: as => by simp only [List.map_cons, List.sum_cons, sum_map_add f g as]; omega\n\ntheorem sum_map_mul {α : Type} (k : Nat) (f : α → Nat) : ∀ l : List α, (l.map fun x => k * f x).sum = k * (l.map f).sum\n  | [] => by simp\n  | a :: as => by simp only [List.map_cons, List.sum_cons, sum_map_mul k f as, Nat.mul_add]\n\ntheorem sum_le_map {α : Type} (f g : α → Nat) : ∀ l : List α, (∀ x ∈ l, f x ≤ g x) → (l.map f).sum ≤ (l.map g).sum\n  | [], _ => by simp\n  | a :: as, h => by\n    simp only [List.map_cons, List.sum_cons]\n    exact Nat.add_le_add (h a List.mem_cons_self) (sum_le_map f g as (fun x hx => h x (List.mem_cons_of_mem _ hx)))\n\ntheorem zip_mem_left {α β : Type} : ∀ (l1 : List α) (l2 : List β), l1.length = l2.length → ∀ a ∈ l1, ∃ b, (a, b) ∈ l1.zip l2\n  | [], _, _, a, ha => by simp at ha\n  | _ :: _, [], hl, _, _ => by simp at hl\n  | x :: xs, y :: ys, hl, a, ha => by\n    rcases List.mem_cons.mp ha with rfl | ha\n    · exact ⟨y, by simp⟩\n    · obtain ⟨b, hb⟩ := zip_mem_left xs ys (by simpa using hl) a ha\n      exact ⟨b, by simp [hb]⟩\n\n-- A homogeneous term of variables that are each a sum over one list is the sum of the term over the list.\nmutual\ntheorem homog_sum {vs : List Nat} (M : Nat → Nat → Nat) (X : Nat → Nat) (F : List (Nat → Nat))\n    (hX : ∀ v ∈ vs, X v = (F.map fun Y => Y v).sum) : (a : E) → homog vs a = true →\n    evalE X M a = (F.map fun Y => evalE Y M a).sum\n  | .var i, h => by simp only [homog, List.contains_iff_mem] at h; simp only [evalE]; exact hX i h\n  | .add a b, h => by\n    simp only [homog, Bool.and_eq_true] at h\n    simp only [evalE, homog_sum M X F hX a h.1, homog_sum M X F hX b h.2]\n    exact (sum_map_add (fun Y => evalE Y M a) (fun Y => evalE Y M b) F).symm\n  | .mul k a, h => by\n    simp only [homog] at h\n    simp only [evalE, homog_sum M X F hX a h]\n    exact (sum_map_mul k (fun Y => evalE Y M a) F).symm\n  | .const _, h => by simp [homog] at h\n  | .sub _ _, h => by simp [homog] at h\n  | .min _ _, h => by simp [homog] at h\n  | .max _ _, h => by simp [homog] at h\n  | .prod _ _, h => by simp [homog] at h\n  | .ite _ _ _, h => by simp [homog] at h\n  | .get _ _, h => by simp [homog] at h\ntheorem homog_sumC {vs : List Nat} (_M : Nat → Nat → Nat) (X : Nat → Nat) (F : List (Nat → Nat))\n    (_hX : ∀ v ∈ vs, X v = (F.map fun Y => Y v).sum) : (c : C) → homogC vs c = true → True\n  | _, _ => trivial\nend\n\n/-! Lookups -/\n\ntheorem assoc_append (l1 l2 : List (Nat × E)) (i : Nat) :\n    assoc (l1 ++ l2) i = match assoc l1 i with | some e => some e | none => assoc l2 i := by\n  simp only [assoc, lookup_append]\n  cases lookup (fun p => p.1 == i) l1 <;> rfl\n\ntheorem assoc_map_key (σ : List (Nat × E)) (F : Nat → E → E) (i : Nat) :\n    assoc (σ.map fun p => (p.1, F p.1 p.2)) i = (assoc σ i).map (F i) := by\n  simp only [assoc, lookup_map_pred]\n  cases hl : lookup (fun p => p.1 == i) σ with\n  | none => rfl\n  | some p =>\n    have := (lookup_some hl).2\n    simp only [beq_iff_eq] at this\n    subst this; rfl\n\ntheorem assoc_some_of_mem {σ : List (Nat × E)} {i : Nat} (h : i ∈ σ.map (·.1)) : ∃ e, assoc σ i = some e := by\n  cases ha : assoc σ i with\n  | some e => exact ⟨e, rfl⟩\n  | none =>\n    simp only [assoc, Option.map_eq_none_iff] at ha\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n    have := lookup_none_all ha p hp\n    simp at this\n\ntheorem fieldEnv_other (h : HMachine) {i : Nat} (hi : i ∉ h.rvars) (rec ρ : Nat → Nat) : fieldEnv h rec ρ i = ρ i := by\n  simp only [fieldEnv]\n  cases hl : lookup (fun p => p.1 == i) (h.rvars.zip h.record) with\n  | none => rfl\n  | some p =>\n    have ⟨hm, hp⟩ := lookup_some hl\n    simp only [beq_iff_eq] at hp\n    exact absurd (hp ▸ (List.of_mem_zip hm).1) hi\n\ntheorem fieldSub_apply (h : HMachine) (X : Nat → Nat) (M : Nat → Nat → Nat) : applyS (fieldSub h) X M = fieldEnv h X X := by\n  funext i\n  simp only [applyS, fieldSub, assoc, lookup_map_pred, fieldEnv]\n  cases lookup (fun p => p.1 == i) (h.rvars.zip h.record) <;> rfl\n\ntheorem sumAt_congr (h : HMachine) {ρ ρ' : Nat → Nat} (M : Nat → Nat → Nat) (hist : List (Nat → Nat)) (g : E)\n    (hag : ∀ i, occE i g = true → ρ i = ρ' i) : sumAt h ρ M hist g = sumAt h ρ' M hist g := by\n  unfold sumAt\n  congr 1\n  apply List.map_congr_left\n  intro rec _\n  exact congrE _ _ M g (fun i hi => by\n    simp only [fieldEnv]; split\n    · rfl\n    · exact hag i hi)\n\ntheorem sumAt_maps (h : HMachine) (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) (hist : List (Nat → Nat)) (g : E)\n    (hr : readsE g = false) : sumAt h ρ M hist g = sumAt h ρ M' hist g := by\n  unfold sumAt\n  congr 1\n  apply List.map_congr_left\n  intro rec _\n  exact noReadsE _ M M' g hr\n\n\n/-! The side conditions, unpacked -/\n\nstructure HOk (h : HMachine) : Prop where\n  len : h.rvars.length = h.record.length\n  qs_in : ∀ q ∈ h.queries.map (·.1), q ∈ h.s.f.m.inputs\n  rec_in : ∀ i ∈ h.record, i ∈ plainInputs h\n  ss_out : ∀ s ∈ h.sums.map (·.1), s ∉ h.s.f.m.inputs ∧ s ∉ h.s.f.m.init.map (·.1) ∧ s ∉ h.s.f.m.step.map (·.1) ∧\n    s ∉ fvs h ∧ s ∉ h.rvars\n  rv_out : ∀ v ∈ h.rvars, v ∉ h.s.f.m.inputs ∧ v ∉ h.s.f.m.init.map (·.1) ∧ v ∉ h.s.f.m.step.map (·.1) ∧ v ∉ fvs h\n  fv_out : ∀ v ∈ fvs h, v ∉ h.s.f.m.inputs\n  sums_ok : ∀ p ∈ h.sums, avoidsE (h.s.f.m.inputs ++ (h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1)) ++ h.sums.map (·.1)\n    ++ fvs h) p.2 = true ∧ readsE p.2 = false\n  queries_ok : ∀ p ∈ h.queries, avoidsE (h.queries.map (·.1) ++ (h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1))\n    ++ h.sums.map (·.1) ++ fvs h) p.2 = true ∧ readsE p.2 = false\n  rels_ok : ∀ r ∈ h.rels, avoids (h.queries.map (·.1) ++ (h.s.f.m.init.map (·.1) ++ h.s.f.m.step.map (·.1)) ++ h.sums.map (·.1)\n    ++ fvs h ++ h.rvars) r.1 = true ∧ homog (h.sums.map (·.1) ++ h.queries.map (·.1)) r.2.1 = true ∧\n    homog (h.sums.map (·.1) ++ h.queries.map (·.1)) r.2.2 = true\n  pre_ok : avoids (h.s.f.m.inputs ++ fvs h ++ h.rvars) h.s.f.m.pre = true ∧ readsC h.s.f.m.pre = false\n  rels_reads : ∀ r ∈ h.rels, readsC r.1 = false\n\ntheorem histOk_sound {h : HMachine} (hc : histOk h = true) : HOk h := by\n  simp only [histOk, Bool.and_eq_true] at hc\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hlen, hqs⟩, hrec⟩, hss⟩, hrv⟩, hfv⟩, hsums⟩, hq⟩, hrels⟩, hpre⟩, hpr⟩ := hc\n  simp only [List.all_eq_true] at hqs hrec hss hrv hfv hsums hq hrels\n  refine ⟨by simpa using hlen, fun q hq' => by simpa using hqs q hq', fun i hi => by simpa using hrec i hi, ?_, ?_, ?_, ?_, ?_, ?_,\n    ⟨hpre, by simpa using hpr⟩, ?_⟩\n  · intro s hs; have := hss s hs; simpa [not_or] using this\n  · intro v hv; have := hrv v hv; simpa [not_or] using this\n  · intro v hv; have := hfv v hv; simpa using this\n  · intro p hp; have := hsums p hp; simp only [Bool.and_eq_true] at this; exact ⟨this.1, by simpa using this.2⟩\n  · intro p hp; have := hq p hp; simp only [Bool.and_eq_true] at this; exact ⟨this.1, by simpa using this.2⟩\n  · intro r hr; have := hrels r hr; simp only [Bool.and_eq_true] at this; exact ⟨this.1.1.1, this.1.2, this.2⟩\n  · intro r hr; have := hrels r hr; simp only [Bool.and_eq_true] at this; simpa using this.1.1.2\n\n/-! The history semantics simulated by the plain machine -/\n\ntheorem withSums_other (h : HMachine) {i : Nat} (hi : i ∉ h.sums.map (·.1)) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (hist : List (Nat → Nat)) : withSums h ρ M hist i = ρ i := by\n  simp only [withSums, assoc_none_of hi]\n\ntheorem plain_sub (h : HMachine) : plainInputs h ⊆ h.s.f.m.inputs := fun _ hi => (List.mem_filter.mp hi).1\n\ntheorem decideQ_other {s : SMachine} {v : Nat} (hv : v ∉ s.qVars) (X : Nat → Nat) (N : Nat → Nat → Nat) : decideQ s X N v = X v := by\n  have : lookup (fun q => q.1 == v) s.qflags = none := lookup_none (fun q hq => by\n    simp only [beq_eq_false_iff_ne]; intro he; exact hv (by rw [← he]; exact List.mem_map_of_mem hq))\n  simp only [decideQ, this]\n\n-- What the view reads at a variable the step doesn't decide: the request's inputs, else the state.\ntheorem reqEnv_undecided (h : HMachine) {i : Nat} (hf : i ∉ fvs h) (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) :\n    reqEnv h ρ ι κ M hist i = withInputs h.s.f.m.inputs ρ (reqIn h ρ ι M hist) i := by\n  simp only [fvs, List.mem_append, not_or] at hf\n  simp only [reqEnv, sView]\n  rw [decide_other hf.1.1, decideQ_other hf.1.2]\n\ntheorem reqEnv_other {h : HMachine} (_ok : HOk h) {i : Nat} (hin : i ∉ h.s.f.m.inputs) (hf : i ∉ fvs h)\n    (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) : reqEnv h ρ ι κ M hist i = ρ i := by\n  rw [reqEnv_undecided h hf]; exact withInputs_other hin ρ _\n\n-- A query reads its sum over the history.\ntheorem reqEnv_query {h : HMachine} (ok : HOk h) {q : Nat} {g : E} (hg : assoc h.queries q = some g) (hf : q ∉ fvs h)\n    (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) :\n    reqEnv h ρ ι κ M hist q = sumAt h (withInputs (plainInputs h) ρ ι) M hist g := by\n  rw [reqEnv_undecided h hf]\n  have hin : q ∈ h.s.f.m.inputs := ok.qs_in q (assoc_mem hg)\n  simp only [withInputs, List.contains_iff_mem, hin, ite_true, reqIn, withQueries, hg]\n\n-- Any other variable the step doesn't decide reads the plain request.\ntheorem reqEnv_plain {h : HMachine} (_ok : HOk h) {i : Nat} (hq : i ∉ h.queries.map (·.1)) (hf : i ∉ fvs h)\n    (ρ ι : Nat → Nat) (κ M : Nat → Nat → Nat) (hist : List (Nat → Nat)) :\n    reqEnv h ρ ι κ M hist i = withInputs (plainInputs h) ρ ι i := by\n  rw [reqEnv_undecided h hf]\n  by_cases hin : i ∈ h.s.f.m.inputs\n  · simp only [withInputs, List.contains_iff_mem, hin, ite_true, reqIn, withQueries, assoc_none_of hq]\n  · rw [withInputs_other hin, withInputs_other (fun hp => hin (plain_sub h hp))]\n\n-- In a reached state every sum is its sum over the history.\ntheorem hsum_of_hreach {h : HMachine} (ok : HOk h) : ∀ {ρ M hist}, HReach h ρ M hist →\n    ∀ s g, assoc h.sums s = some g → ρ s = sumAt h ρ M hist g := by\n  have key : ∀ ρ1 M0 M hist s g, assoc h.sums s = some g →\n      withSums h ρ1 M0 hist s = sumAt h (withSums h ρ1 M0 hist) M hist g := by\n    intro ρ1 M0 M hist s g hs\n    obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n      simp only [assoc, Option.map_eq_some_iff] at hs\n      obtain ⟨p, hl, rfl⟩ := hs\n      exact ⟨p, (lookup_some hl).1, rfl⟩\n    have hg := ok.sums_ok p hp\n    rw [hpg] at hg\n    simp only [withSums, hs]\n    rw [sumAt_maps h ρ1 M0 M hist g hg.2]\n    exact sumAt_congr h M hist g (fun i hi => by\n      have := avoidsE_occ hg.1 hi\n      simp only [List.mem_append, not_or] at this\n      exact (withSums_other h this.1.2 ρ1 M0 hist).symm)\n  intro ρ M hist hr\n  cases hr with\n  | start ρ0 M h0 hp _ _ => exact fun s g hs => key _ M M [] s g hs\n  | step ρ0 M0 hist0 ι κ _ _ => exact fun s g hs => key _ _ _ _ s g hs\n\ntheorem relsC_true (X : Nat → Nat) (M : Nat → Nat → Nat) :\n    ∀ rs : List (C × E × E), (∀ r ∈ rs, evalC X M (relC r) = true) → evalC X M (relsC rs) = true\n  | [], _ => by simp [relsC, TRUEC, evalC, evalE]\n  | r :: rs, hr => by\n    simp only [relsC, List.foldr_cons, evalC, Bool.and_eq_true]\n    exact ⟨hr r List.mem_cons_self, relsC_true X M rs (fun r' h' => hr r' (List.mem_cons_of_mem _ h'))⟩\n\n-- At a reached state where the precondition holds, every relation holds of the request.\ntheorem rels_hold {h : HMachine} (ok : HOk h)\n    (hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {hist : List (Nat → Nat)}\n    (hsum : ∀ s g, assoc h.sums s = some g → ρ s = sumAt h ρ M hist g) (hpre : evalC ρ M h.s.f.m.pre = true)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) : evalC (reqEnv h ρ ι κ M hist) M (relsC h.rels) = true := by\n  apply relsC_true\n  intro r hr\n  obtain ⟨tt, hck⟩ := hrs r hr\n  obtain ⟨hwav, ha, hb⟩ := ok.rels_ok r hr\n  let X := reqEnv h ρ ι κ M hist\n  let X0 := withInputs (plainInputs h) ρ ι\n  let gsub := h.sums ++ h.queries\n  let F := hist.map fun rec => applyS gsub (fieldEnv h rec X) M\n  -- Each sum and each query is its sum over the history, at X.\n  have hX : ∀ v ∈ h.sums.map (·.1) ++ h.queries.map (·.1), X v = (F.map fun Y => Y v).sum := by\n    intro v hv\n    have hF : ∀ g, assoc gsub v = some g → (F.map fun Y => Y v).sum = sumAt h X M hist g := by\n      intro g hg\n      simp only [F, List.map_map, sumAt]\n      congr 1\n      apply List.map_congr_left\n      intro rec _\n      simp only [Function.comp, applyS, hg]\n    by_cases hs : v ∈ h.sums.map (·.1)\n    · obtain ⟨g, hg⟩ := assoc_some_of_mem hs\n      have hgs : assoc gsub v = some g := by simp only [gsub, assoc_append, hg]\n      rw [hF g hgs]\n      obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n        simp only [assoc, Option.map_eq_some_iff] at hg\n        obtain ⟨p, hl, rfl⟩ := hg\n        exact ⟨p, (lookup_some hl).1, rfl⟩\n      have hok := ok.sums_ok p hp\n      rw [hpg] at hok\n      have ⟨hvin, _, _, hvf, _⟩ := ok.ss_out v hs\n      show reqEnv h ρ ι κ M hist v = _\n      rw [reqEnv_other ok hvin hvf, hsum v g hg]\n      exact sumAt_congr h M hist g (fun i hi => by\n        have := avoidsE_occ hok.1 hi\n        simp only [List.mem_append, not_or] at this\n        exact (reqEnv_other ok this.1.1.1 this.2 ρ ι κ M hist).symm)\n    · have hq : v ∈ h.queries.map (·.1) := by\n        rcases List.mem_append.mp hv with h1 | h1\n        · exact absurd h1 hs\n        · exact h1\n      obtain ⟨g, hg⟩ := assoc_some_of_mem hq\n      have hgs : assoc gsub v = some g := by simp only [gsub, assoc_append, assoc_none_of hs, hg]\n      rw [hF g hgs]\n      obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.queries, p.2 = g := by\n        simp only [assoc, Option.map_eq_some_iff] at hg\n        obtain ⟨p, hl, rfl⟩ := hg\n        exact ⟨p, (lookup_some hl).1, rfl⟩\n      have hok := ok.queries_ok p hp\n      rw [hpg] at hok\n      have hvf : v ∉ fvs h := fun hf => ok.fv_out v hf (ok.qs_in v hq)\n      show reqEnv h ρ ι κ M hist v = _\n      rw [reqEnv_query ok hg hvf]\n      exact sumAt_congr h M hist g (fun i hi => by\n        have := avoidsE_occ hok.1 hi\n        simp only [List.mem_append, not_or] at this\n        exact (reqEnv_plain ok this.1.1.1 this.2 ρ ι κ M hist).symm)\n  simp only [relC, evalC, Bool.or_eq_true, Bool.not_eq_true']\n  by_cases hw : evalC X M r.1 = true\n  · right\n    simp only [decide_eq_true_eq]\n    rw [homog_sum M X F hX r.2.1 ha, homog_sum M X F hX r.2.2 hb]\n    apply sum_le_map\n    intro Y hY\n    obtain ⟨rec, _, rfl⟩ := List.mem_map.mp hY\n    have hs := sound ⟨tt.1, recordGoal h r⟩ tt.2 hck (fieldEnv h rec X) M\n    have hE : ∀ c, avoids h.rvars c = true → evalC (fieldEnv h rec X) M c = evalC X M c := fun c hc =>\n      congrC _ _ M c (fun i hi => fieldEnv_other h (avoids_occ hc hi) rec X)\n    have hpreX : evalC X M h.s.f.m.pre = true := by\n      have hp := ok.pre_ok.1\n      rw [congrC X ρ M h.s.f.m.pre (fun i hi => by\n        have := avoids_occ hp hi\n        simp only [List.mem_append, not_or] at this\n        exact reqEnv_other ok this.1.1 this.1.2 ρ ι κ M hist)]\n      exact hpre\n    apply Decidable.byContradiction\n    intro hlt\n    apply hs\n    intro c hc\n    simp only [recordGoal, List.mem_cons, List.mem_nil_iff, or_false] at hc\n    rcases hc with rfl | rfl | rfl\n    · rw [hE _ (by\n        have hp := ok.pre_ok.1\n        simp only [avoids, List.all_eq_true] at hp ⊢\n        intro i hi; exact hp i (by simp [hi]))]\n      exact hpreX\n    · rw [hE _ (by\n        simp only [avoids, List.all_eq_true] at hwav ⊢\n        intro i hi; exact hwav i (by simp [hi]))]\n      exact hw\n    · simp only [evalC, subst_evalE, Bool.not_eq_true', decide_eq_false_iff_not]\n      exact hlt\n  · left; simpa using hw\n\ntheorem start_eq {h : HMachine} (ok : HOk h) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS h.plain.f.m.init ρ M = withSums h (applyS h.s.f.m.init ρ M) M [] := by\n  funext i\n  show applyS (h.s.f.m.init ++ h.sums.map fun p => (p.1, .const 0)) ρ M i = _\n  simp only [applyS, assoc_append, withSums]\n  cases hs : assoc h.sums i with\n  | some g =>\n    have hi : i ∉ h.s.f.m.init.map (·.1) := (ok.ss_out i (assoc_mem hs)).2.1\n    simp only [assoc_none_of hi, assoc_map_snd (σ := h.sums) (g := fun _ => .const 0), hs, Option.map_some, evalE,\n      sumAt, List.map_nil, List.sum_nil]\n  | none =>\n    cases hi : assoc h.s.f.m.init i with\n    | some e => rfl\n    | none => simp only [assoc_map_snd (σ := h.sums) (g := fun _ => .const 0), hs, Option.map_none]\n\ntheorem step_eq {h : HMachine} (ok : HOk h) (X : Nat → Nat) (M : Nat → Nat → Nat) (hist : List (Nat → Nat))\n    (hX : ∀ s g, assoc h.sums s = some g → X s = sumAt h X M hist g) :\n    applyS h.plain.f.m.step X M = withSums h (applyS h.s.f.m.step X M) M (kept h X M hist) := by\n  funext i\n  show applyS (h.s.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2)) X M i = _\n  cases hs : assoc h.sums i with\n  | some g =>\n    have hmem := assoc_mem hs\n    have hi : i ∉ h.s.f.m.step.map (·.1) := (ok.ss_out i hmem).2.2.1\n    obtain ⟨p, hp, hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n      simp only [assoc, Option.map_eq_some_iff] at hs\n      obtain ⟨p, hl, rfl⟩ := hs\n      exact ⟨p, (lookup_some hl).1, rfl⟩\n    have hok := ok.sums_ok p hp\n    rw [hpg] at hok\n    have hA : assoc (h.s.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2)) i = some (sumStep h i g) := by\n      rw [assoc_append, assoc_none_of hi]\n      show assoc (h.sums.map fun p => (p.1, sumStep h p.1 p.2)) i = _\n      rw [assoc_map_key h.sums (sumStep h), hs]; rfl\n    have hL : applyS (h.s.f.m.step ++ h.sums.map fun p => (p.1, sumStep h p.1 p.2)) X M i = evalE X M (sumStep h i g) := by\n      simp only [applyS, hA]\n    have hR : withSums h (applyS h.s.f.m.step X M) M (kept h X M hist) i = sumAt h (applyS h.s.f.m.step X M) M (kept h X M hist) g := by\n      simp only [withSums, hs]\n    rw [hL, hR]\n    -- The old records read alike after the step: the term reads no state variable.\n    have hcg : ∀ hs', sumAt h (applyS h.s.f.m.step X M) M hs' g = sumAt h X M hs' g := fun hs' =>\n      sumAt_congr h M hs' g (fun j hj => by\n        have := avoidsE_occ hok.1 hj\n        simp only [List.mem_append, not_or] at this\n        exact applyS_other this.1.1.2.2 X M)\n    rw [hcg]\n    simp only [sumStep, evalE, subst_evalE, fieldSub_apply]\n    rw [hX i g hs]\n    unfold kept\n    by_cases hk : evalC X M h.keep = true\n    · simp [hk, sumAt, List.map_append, List.sum_append]\n    · simp [hk]\n  | none =>\n    have hR : withSums h (applyS h.s.f.m.step X M) M (kept h X M hist) i = applyS h.s.f.m.step X M i := by\n      simp only [withSums, hs]\n    rw [hR]\n    have hB : assoc (h.sums.map fun p => (p.1, sumStep h p.1 p.2)) i = none := by\n      rw [assoc_map_key h.sums (sumStep h), hs]; rfl\n    simp only [applyS, assoc_append]\n    cases hi : assoc h.s.f.m.step i with\n    | some e => rfl\n    | none => simp only [hB]\n\n-- Relations read no map: `when` reads none, and each side is a homogeneous term of variables.\ntheorem homog_noreads {vs : List Nat} : ∀ e : E, homog vs e = true → readsE e = false\n  | .var _, _ => rfl\n  | .const _, h => by simp [homog] at h\n  | .add a b, h => by simp only [homog, Bool.and_eq_true] at h; simp only [readsE, homog_noreads a h.1, homog_noreads b h.2, Bool.or_self]\n  | .sub _ _, h => by simp [homog] at h\n  | .mul _ a, h => by simp only [homog] at h; simp only [readsE, homog_noreads a h]\n  | .min _ _, h => by simp [homog] at h\n  | .max _ _, h => by simp [homog] at h\n  | .prod _ _, h => by simp [homog] at h\n  | .ite _ _ _, h => by simp [homog] at h\n  | .get _ _, h => by simp [homog] at h\n\ntheorem relsC_noreads {h : HMachine} (ok : HOk h) : ∀ rs : List (C × E × E), (∀ r ∈ rs, r ∈ h.rels) → readsC (relsC rs) = false\n  | [], _ => rfl\n  | r :: rs, hin => by\n    have hr := hin r List.mem_cons_self\n    obtain ⟨_, ha, hb⟩ := ok.rels_ok r hr\n    simp only [relsC, List.foldr_cons, readsC, relC, ok.rels_reads r hr, homog_noreads _ ha, homog_noreads _ hb, Bool.or_self, Bool.false_or]\n    exact relsC_noreads ok rs (fun r' h' => hin r' (List.mem_cons_of_mem _ h'))\n\ntheorem hreach_sreach {h : HMachine} (ps : List SEntry) (ok : HOk h)\n    (hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true)\n    (hsm : checkSMachine h.plain ps = true) : ∀ {ρ M hist}, HReach h ρ M hist → SReach h.plain ρ M := by\n  obtain ⟨hpreS, hrp⟩ := spre_parts hsm\n  intro ρ M hist hr\n  induction hr with\n  | start ρ M hM h0 hf hpf =>\n    rw [← start_eq ok]\n    exact SReach.start (s := h.plain) ρ M hM h0 hf hpf\n  | step ρ M hist ι κ hr ha ih =>\n    have hsum := hsum_of_hreach ok hr\n    have hp := pre_sreach h.plain hpreS hrp ih\n    -- The plain machine reads the request as the history's step does, with the relations assumed of it.\n    have hass : evalC (sView h.plain ρ M (reqIn h ρ ι M hist) κ).1 (sView h.plain ρ M (reqIn h ρ ι M hist) κ).2 h.plain.f.m.assume = true := by\n      show evalC (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) (.and h.s.f.m.assume (relsC h.rels)) = true\n      simp only [evalC, Bool.and_eq_true]\n      refine ⟨ha, ?_⟩\n      rw [noReadsC _ _ M _ (relsC_noreads ok h.rels (fun r hr' => hr'))]\n      exact rels_hold ok hrs hsum hp ι κ\n    have hstep := SReach.step (s := h.plain) ρ M (reqIn h ρ ι M hist) κ ih hass\n    have hX : ∀ s g, assoc h.sums s = some g →\n        reqEnv h ρ ι κ M hist s = sumAt h (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) hist g := by\n      intro s g hs\n      have hmem := assoc_mem hs\n      have ⟨hsin, _, _, hsf, _⟩ := ok.ss_out s hmem\n      obtain ⟨p, hp', hpg⟩ : ∃ p ∈ h.sums, p.2 = g := by\n        simp only [assoc, Option.map_eq_some_iff] at hs\n        obtain ⟨p, hl, rfl⟩ := hs\n        exact ⟨p, (lookup_some hl).1, rfl⟩\n      have hok := ok.sums_ok p hp'\n      rw [hpg] at hok\n      rw [reqEnv_other ok hsin hsf, hsum s g hs, sumAt_maps h _ (withCarried h.s M κ) M hist g hok.2]\n      exact sumAt_congr h M hist g (fun i hi => by\n        have := avoidsE_occ hok.1 hi\n        simp only [List.mem_append, not_or] at this\n        exact (reqEnv_other ok this.1.1.1 this.2 ρ ι κ M hist).symm)\n    have hst := step_eq ok (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) hist hX\n    show SReach h.plain (withSums h (applyS h.s.f.m.step (reqEnv h ρ ι κ M hist) (withCarried h.s M κ)) (withCarried h.s M κ)\n        (kept h (reqEnv h ρ ι κ M hist) (withCarried h.s M κ) hist)) (everyMaps h.s (reqEnv h ρ ι κ M hist) (withCarried h.s M κ))\n    rw [← hst]\n    exact hstep\n\n/-- The history rule: if the record goals and the plain machine's proof check, every law of the proof holds in every\nstate the machine with its history reaches (sums read as their sums over the history, queries computed from it). -/\ntheorem hmachine_sound (h : HMachine) (ps : List SEntry) (rs : List (List VDef × Tree)) (hc : checkHMachine h ps rs = true) :\n    ∀ ρ M hist, HReach h ρ M hist → ∀ e ∈ ps, e.Holds ρ M := by\n  simp only [checkHMachine, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hc\n  obtain ⟨⟨⟨hok, hlen⟩, hgoals⟩, hsm⟩ := hc\n  have ok := histOk_sound hok\n  have hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true := by\n    intro r hr\n    obtain ⟨tt, htt⟩ := zip_mem_left h.rels rs hlen.symm r hr\n    exact ⟨tt, hgoals (r, tt) htt⟩\n  intro ρ M hist hr\n  exact smachine_sound h.plain ps hsm ρ M (hreach_sreach ps ok hrs hsm hr)\n\nend Kern\n",
     "Sets.lean": "import Steps\n\n/-!\nSets: kernel.ts's machines with sets, proven sound. A set is a map with cells 0 or 1; three things go beyond FMMachine:\na request carries whole maps (`carried`: any maps at each request), a step writes a map at every key at once (`every`:\nthe value at each key, read with the key bound), and a flag may hold at every key (`qflags`: ∀ key. body, its body\nreading no flag), or at every tuple of keys (∀ k₁ … kₙ. body). Lean decides a quantified flag classically, which only the meaning needs; the checker never does.\n\nFunctions from outside the rule are maps no step writes (and no request carries); `facts` are laws about the params and\nthose maps alone, given rather than proven: a run starts where they hold, so they hold at every state, and every goal may\nassume them at the keys its proof names (`finsts`). A fact about several keys (`pfacts`: a function of several\narguments, a law between two points) is given at every value of its further keys, as a law about several keys holds,\nand a goal assumes it at the tuples its proof names (`pfinsts`).\n\nkernel.ts closes each quantified flag ?f in a goal: ?f ≤ 1; ?f = 0 ∨ body(t) at keys t the proof names (`qinsts`, a\ntuple of terms over several keys); and ?f = 1 ∨ ¬body(w) at fresh witnesses w, one per key (`wits`). A real step\nsatisfies these with w failing keys when ?f = 0, so a goal that refutes them refutes the machine. Lean builds the same\nclosed goals.\n-/\n\nnamespace Kern\nopen Classical\n\n/-! Certificates that name their hypotheses -/\n\n\n-- A proof tree with the table it reads, and the hypotheses it refutes: none named, the goal's own, in the goal's order;\n-- named, any of the goal's, in any order (each must be one of the goal's), so an exporter may lay its goal out its own\n-- way as long as each hypothesis it uses is one Lean builds.\nabbrev Cert := List VDef × List C × Tree\n-- The goal's hypotheses after the first one equal to c, if there is one.\ndef afterFirst (c : C) : List C → Option (List C)\n  | [] => none\n  | h :: t => if beqC c h then some t else afterFirst c t\n-- Each named hypothesis is one of the goal's: looked for after the last one found (exporters name them mostly in the\n-- goal's order), and from the start when it is not there.\ndef namedIn (hyps : List C) : List C → List C → Bool\n  | [], _ => true\n  | c :: cs, rest => match afterFirst c rest with\n    | some rest' => namedIn hyps cs rest'\n    | none => match afterFirst c hyps with\n      | some rest' => namedIn hyps cs rest'\n      | none => false\ndef checkIn (hyps : List C) (k : Cert) : Bool :=\n  if k.2.1.isEmpty then checkGoal ⟨k.1, hyps⟩ k.2.2\n  else namedIn hyps k.2.1 hyps && checkGoal ⟨k.1, k.2.1⟩ k.2.2\n\ntheorem afterFirst_some : ∀ {c : C} {l t : List C}, afterFirst c l = some t → c ∈ l ∧ ∀ x ∈ t, x ∈ l\n  | _, [], _, h => by simp [afterFirst] at h\n  | c, h' :: l, t, h => by\n    simp only [afterFirst] at h\n    split at h\n    · rename_i hb\n      simp only [Option.some.injEq] at h; subst h\n      exact ⟨by rw [beqC_eq hb]; exact List.mem_cons_self, fun x hx => List.mem_cons_of_mem _ hx⟩\n    · obtain ⟨h1, h2⟩ := afterFirst_some h\n      exact ⟨List.mem_cons_of_mem _ h1, fun x hx => List.mem_cons_of_mem _ (h2 x hx)⟩\n\ntheorem namedIn_sound (hyps : List C) : ∀ (cs rest : List C), (∀ x ∈ rest, x ∈ hyps) → namedIn hyps cs rest = true → ∀ c ∈ cs, c ∈ hyps\n  | [], _, _, _ => by simp\n  | c :: cs, rest, hr, h => by\n    simp only [namedIn] at h\n    split at h\n    · rename_i rest' hs\n      obtain ⟨h1, h2⟩ := afterFirst_some hs\n      intro x hx\n      rcases List.mem_cons.mp hx with rfl | hx\n      · exact hr _ h1\n      · exact namedIn_sound hyps cs rest' (fun y hy => hr y (h2 y hy)) h x hx\n    · split at h\n      · rename_i rest' hs\n        obtain ⟨h1, h2⟩ := afterFirst_some hs\n        intro x hx\n        rcases List.mem_cons.mp hx with rfl | hx\n        · exact h1\n        · exact namedIn_sound hyps cs rest' h2 h x hx\n      · simp at h\n\ntheorem sound_in (hyps : List C) (k : Cert) (h : checkIn hyps k = true) (env : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ¬ ∀ c ∈ hyps, evalC env maps c = true := by\n  intro hH\n  unfold checkIn at h\n  split at h\n  · exact sound ⟨k.1, hyps⟩ k.2.2 h env maps hH\n  · simp only [Bool.and_eq_true] at h\n    exact sound ⟨k.1, k.2.1⟩ k.2.2 h.2 env maps (fun c hc => hH c (namedIn_sound hyps k.2.1 hyps (fun _ hx => hx) h.1 c hc))\n\nstructure SMachine where\n  f : FMMachine\n  carried : List Nat               -- maps a request carries\n  every : List (Nat × Nat × E)     -- (map, bound key, value): the map at every key\n  qflags : List (Nat × List Nat × C) -- (flag variable, bound keys, body): 1 when the body holds at every value of the keys, else 0\n  wits : List (Nat × List Nat)     -- (flag variable, its witness variables: one per key)\n  facts : List MLaw                -- given about the params and the functions (maps no step writes)\n  pfacts : List (MLaw × List Nat)  -- facts about several keys: the fact about its first key, and its further keys\n\ndef SMachine.qVars (s : SMachine) : List Nat := s.qflags.map (·.1)\ndef SMachine.wVars (s : SMachine) : List Nat := s.wits.flatMap (·.2)\n\n/-! The meaning -/\n\n-- The maps a step reads: its own, with the maps the request carries.\ndef withCarried (s : SMachine) (M κ : Nat → Nat → Nat) : Nat → Nat → Nat := fun mp => if s.carried.contains mp then κ mp else M mp\n\n-- A state with the bound keys read from v.\ndef atKeys (X : Nat → Nat) (ks : List Nat) (v : Nat → Nat) : Nat → Nat := fun i => if ks.contains i then v i else X i\n\ntheorem atKeys_in {X : Nat → Nat} {ks : List Nat} {v : Nat → Nat} {i : Nat} (h : i ∈ ks) : atKeys X ks v i = v i := by\n  simp [atKeys, List.contains_iff_mem, h]\ntheorem atKeys_out {X : Nat → Nat} {ks : List Nat} {v : Nat → Nat} {i : Nat} (h : i ∉ ks) : atKeys X ks v i = X i := by\n  simp [atKeys, List.contains_iff_mem, h]\n\n-- Each quantified flag decided: 1 where its body holds at every value of its keys, else 0.\nnoncomputable def decideQ (s : SMachine) (X : Nat → Nat) (N : Nat → Nat → Nat) : Nat → Nat := fun v =>\n  match lookup (fun q => q.1 == v) s.qflags with\n  | some q => if ∀ k, holdsC (atKeys X q.2.1 k) N q.2.2 then 1 else 0\n  | none => X v\n\n-- A step's state before its terms: inputs set, quantified flags decided, then the plain flags; and the maps it reads.\nnoncomputable def sView (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : (Nat → Nat) × (Nat → Nat → Nat) :=\n  (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ), withCarried s M κ)\n\n-- The maps after a step: a map written at every key, its value there; any other as kernel.ts's writes leave it.\ndef everyMaps (s : SMachine) (D : Nat → Nat) (N : Nat → Nat → Nat) : Nat → Nat → Nat := fun mp key =>\n  match lookup (fun w => w.1 == mp) s.every with\n  | some w => evalE (upd D w.2.1 key) N w.2.2\n  | none => writeMaps s.f.m.writes D N mp key\n\nnoncomputable def sNext (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : (Nat → Nat) × (Nat → Nat → Nat) :=\n  (applyS s.f.m.step (sView s ρ M ι κ).1 (sView s ρ M ι κ).2, everyMaps s (sView s ρ M ι κ).1 (sView s ρ M ι κ).2)\n\n-- A law at every value of each of some keys.\ndef holdsOver (l : MLaw) (M : Nat → Nat → Nat) : List Nat → (Nat → Nat) → Prop\n  | [], ρ => l.Holds ρ M\n  | g :: gs, ρ => ∀ w, holdsOver l M gs (upd ρ g w)\n\n-- The facts about several keys, each at every value of its further keys.\ndef SMachine.PFacts (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop := ∀ p ∈ s.pfacts, holdsOver p.1 M p.2 ρ\n\ninductive SReach (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps s.f.m M → evalC ρ M s.f.m.pre = true → (∀ l ∈ s.facts, l.Holds ρ M) →\n      s.PFacts ρ M → SReach s (applyS s.f.m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : SReach s ρ M →\n      evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true → SReach s (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2\n\n/-! The goals -/\n\n-- Each quantified flag closed, at the tuples the proof names.\ndef closingHyps (s : SMachine) (qinsts : List (Nat × List E)) : List C :=\n  s.qflags.flatMap fun q =>\n    [.le (.var q.1) (.const 1)]\n      ++ (qinsts.filter (fun p => p.1 == q.1)).map (fun p => .or (.eq (.var q.1) (.const 0)) (substC (q.2.1.zip p.2) q.2.2))\n      ++ (match lookup (fun w => w.1 == q.1) s.wits with\n          | some w => [.or (.eq (.var q.1) (.const 1)) (.not (substC (q.2.1.zip (w.2.map .var)) q.2.2))]\n          | none => [])\n\ndef trueC : C := .le (.const 0) (.const 0)\ndef pairInsts : Nat → List (Nat × E × List E) → List (Nat × E)\n  | _, [] => []\n  | n, p :: ps => (n, p.2.1) :: pairInsts (n + 1) ps\n\n-- A fact about several keys at a tuple, as a fact about its first key: each further key read as the tuple's term.\ndef pfactLaw (s : SMachine) (p : Nat × E × List E) : MLaw :=\n  match s.pfacts[p.1]? with\n  | some f => ⟨substC (f.2.zip p.2.2) f.1.holds, f.1.key⟩\n  | none => ⟨trueC, none⟩\n\n-- The facts, at the keys the proof names, and the facts about several keys at the tuples it names.\ndef factHyps (s : SMachine) (finsts : List (Nat × E)) (pfinsts : List (Nat × E × List E)) : List C :=\n  scalarHyps s.facts ++ instHyps s.facts finsts ++ instHyps (pfinsts.map (pfactLaw s)) (pairInsts 0 pfinsts)\n\n-- A map written at every key reads, after the step, its value at the key read; any other map as stepRd reads it.\ndef stepRdS (s : SMachine) (τ : List (Nat × E)) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) s.every with\n  | some w => substRE ((w.2.1, k) :: τ) rd (inlineE s.f.flags w.2.2)\n  | none => stepRd s.f τ rd mp k\n\n-- A later step reads the maps its request carries by fresh names.\ndef frameRd (mr : List (Nat × Nat)) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun p => p.1 == mp) mr with\n  | some p => .get p.2 k\n  | none => rd mp k\n\ndef sFrameHyps (s : SMachine) (laws : List MLaw) (insts : List (Nat × E)) (qinsts : List (Nat × List E)) (w : C) : List C :=\n  scalarHyps laws ++ instHyps laws insts ++ [inlineC s.f.flags s.f.m.assume, w] ++ closingHyps s qinsts\n\n-- The state after a step, named (`names`, per step but the last: each state variable and a fresh variable): the fresh\n-- variable equals the variable's term there, and later frames read it (frameSub), so a run's frames stay small.\ndef nameHyps (n : List (Nat × Nat)) (σ : List (Nat × E)) : List C := n.map (fun p => .eq (.var p.2) ((assoc σ p.1).getD (.var p.1)))\n\ndef sRun (s : SMachine) (laws : List MLaw) (insts : List (Nat × E)) (qinsts : List (Nat × List E)) :\n    List C → List (List (Nat × Nat)) → List (List (Nat × Nat)) → List (List (Nat × Nat)) → List (Nat × E) → (Nat → E → E) → List C × List (Nat × E) × (Nat → E → E)\n  | w :: ws, r :: rs, mr :: mrs, ns, σ, rd =>\n    ((sFrameHyps s laws insts qinsts w).map (substRC (frameSub r σ) (frameRd mr rd))\n        ++ nameHyps (ns.headD []) (stepSub s.f (frameSub r σ) (frameRd mr rd))\n        ++ (sRun s laws insts qinsts ws rs mrs ns.tail (frameSub (ns.headD []) (stepSub s.f (frameSub r σ) (frameRd mr rd))) (stepRdS s (frameSub r σ) (frameRd mr rd))).1,\n      (sRun s laws insts qinsts ws rs mrs ns.tail (frameSub (ns.headD []) (stepSub s.f (frameSub r σ) (frameRd mr rd))) (stepRdS s (frameSub r σ) (frameRd mr rd))).2)\n  | _, _, _, _, σ, rd => ([], σ, rd)\n\n/-! What a step's goal reads it by -/\n\n-- Values of the keys where a quantified flag's body fails, when there are some.\nnoncomputable def witnessKeys (X : Nat → Nat) (N : Nat → Nat → Nat) (q : Nat × List Nat × C) : Nat → Nat :=\n  if h : ∃ k, ¬ holdsC (atKeys X q.2.1 k) N q.2.2 then Classical.choose h else fun _ => 0\n\ndef SMachine.extVars (s : SMachine) : List Nat := s.f.m.inputs ++ s.qVars ++ s.wVars\n\n-- A step's request as its goal reads it: the inputs, each quantified flag's value, each witness.\nnoncomputable def sReq (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : Nat → Nat := fun v =>\n  if s.f.m.inputs.contains v then ι v\n  else match lookup (fun q => q.1 == v) s.qflags with\n    | some _ => decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) v\n    | none => match lookup (fun w => w.2.contains v) s.wits with\n      | some w => match lookup (fun q => q.1 == w.1) s.qflags with\n        | some q => match lookup (fun p => p.2 == v) (q.2.1.zip w.2) with\n          | some p => witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q p.1\n          | none => 0\n        | none => 0\n      | none => 0\n\ndef withExt (s : SMachine) (ρ e : Nat → Nat) : Nat → Nat := fun v => if s.extVars.contains v then e v else ρ v\n\n-- The maps later requests carry, at their fresh names.\ndef renMaps : List (List (Nat × Nat)) → List (Nat → Nat → Nat) → (Nat → Nat → Nat) → Nat → Nat → Nat\n  | r :: rs, κ :: κs, b => fun mp => match lookup (fun p => p.2 == mp) r with\n    | some p => κ p.1\n    | none => renMaps rs κs b mp\n  | _, _, b => b\n\n/-! The checks -/\n\ndef distinctPairs (ws : List (Nat × List Nat)) : Bool := distinct (ws.map (·.1)) && distinct (ws.flatMap (·.2))\n\n-- The machine's own side conditions: inputs, flags, quantified flags and witnesses are distinct variables; a body reads no flag, quantified flag or witness, and its keys are none of them\n-- and distinct; every quantified flag has a witness per key; the plain flags and the step read no witness.\ndef sOk (s : SMachine) : Bool :=\n  flagsOk s.f.flags && distinct s.qVars && distinctPairs s.wits\n    && s.qflags.all (fun q => s.wits.any (fun w => w.1 == q.1 && w.2.length == q.2.1.length) && distinct q.2.1)\n    && distinct (s.extVars ++ flagVars s.f.flags)\n    && s.qflags.all (fun q => avoids (s.qVars ++ s.wVars ++ flagVars s.f.flags) q.2.2 && q.2.1.all (fun k => !(s.extVars ++ flagVars s.f.flags).contains k))\n    && s.f.flags.all (fun p => avoids s.wVars p.2)\n    && avoids (s.wVars ++ s.qVars) s.f.m.pre\n    && s.f.m.step.all (fun p => avoidsE s.wVars (inlineE s.f.flags p.2))\n    && s.f.m.writes.all (fun w => avoidsE s.wVars (inlineE s.f.flags w.2.1) && avoidsE s.wVars (inlineE s.f.flags w.2.2))\n    && s.every.all (fun w => avoidsE s.wVars (inlineE s.f.flags w.2.2) && !(s.extVars ++ flagVars s.f.flags).contains w.2.1\n        && !(s.f.m.writes.map (·.1)).contains w.1 && !s.carried.contains w.1)\n    && avoids s.wVars s.f.m.assume\n\n/-! One step's view -/\n\ntheorem lookup_unique {β : Type} {p : Nat × β} {l : List (Nat × β)} (hd : distinct (l.map (·.1)) = true) (hp : p ∈ l) :\n    lookup (fun q => q.1 == p.1) l = some p := by\n  induction l with\n  | nil => simp at hp\n  | cons a as ih =>\n    simp only [List.map_cons] at hd\n    obtain ⟨hna, hd'⟩ := distinct_cons hd\n    simp only [lookup]\n    rcases List.mem_cons.mp hp with rfl | hp'\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hna (by rw [he]; exact List.mem_map_of_mem hp')\n      simp only [hne, Bool.false_eq_true, ite_false]; exact ih hd' hp'\n\n-- Witnesses: distinct across the flags, each found in its flag's entry, beside its key.\ntheorem lookup_wit : ∀ {ws : List (Nat × List Nat)}, distinct (ws.flatMap (·.2)) = true → ∀ {w : Nat × List Nat} {v : Nat}, w ∈ ws → v ∈ w.2 →\n    lookup (fun w' => w'.2.contains v) ws = some w\n  | [], _, _, _, h, _ => by simp at h\n  | a :: as, hd, w, v, h, hv => by\n    simp only [List.flatMap_cons] at hd\n    obtain ⟨_, hd2, hap⟩ := distinct_append hd\n    simp only [lookup]\n    rcases List.mem_cons.mp h with rfl | h\n    · simp [List.contains_iff_mem, hv]\n    · have hna : a.2.contains v = false := by\n        have : v ∉ a.2 := fun hva => hap v hva (List.mem_flatMap.mpr ⟨w, h, hv⟩)\n        simpa [List.contains_iff_mem] using this\n      simp only [hna, Bool.false_eq_true, ite_false]\n      exact lookup_wit hd2 h hv\n\ntheorem distinct_of_flatMap : ∀ {ws : List (Nat × List Nat)}, distinct (ws.flatMap (·.2)) = true → ∀ {w : Nat × List Nat}, w ∈ ws → distinct w.2 = true\n  | [], _, _, h => by simp at h\n  | a :: as, hd, w, h => by\n    simp only [List.flatMap_cons] at hd\n    obtain ⟨hd1, hd2, _⟩ := distinct_append hd\n    rcases List.mem_cons.mp h with rfl | h\n    · exact hd1\n    · exact distinct_of_flatMap hd2 h\n\ntheorem lookup_zip_wit : ∀ {ks ws : List Nat}, distinct ws = true → ∀ {k w : Nat}, (k, w) ∈ ks.zip ws → lookup (fun p => p.2 == w) (ks.zip ws) = some (k, w)\n  | [], _, _, _, _, h => by simp at h\n  | _ :: _, [], _, _, _, h => by simp at h\n  | a :: as, b :: bs, hd, k, w, h => by\n    obtain ⟨hb, hd'⟩ := distinct_cons hd\n    simp only [List.zip_cons_cons, List.mem_cons, Prod.mk.injEq] at h\n    simp only [List.zip_cons_cons, lookup]\n    rcases h with ⟨rfl, rfl⟩ | h\n    · simp\n    · have hw : w ≠ b := fun he => hb (he ▸ (List.of_mem_zip h).2)\n      have hbw : (b == w) = false := by simp only [beq_eq_false_iff_ne]; exact fun he => hw he.symm\n      simp only [hbw, Bool.false_eq_true, ite_false]\n      exact lookup_zip_wit hd' h\n\n-- Distinct keys zipped with variables: each key reads the variable beside it.\ntheorem assoc_zip_var : ∀ {ks ws : List Nat}, distinct ks = true → ∀ {k w : Nat}, (k, w) ∈ ks.zip ws → assoc (ks.zip (ws.map E.var)) k = some (.var w)\n  | [], _, _, _, _, h => by simp at h\n  | _ :: _, [], _, _, _, h => by simp at h\n  | a :: as, b :: bs, hd, k, w, h => by\n    obtain ⟨ha, hd'⟩ := distinct_cons hd\n    simp only [List.zip_cons_cons, List.mem_cons, Prod.mk.injEq] at h\n    simp only [List.map_cons, List.zip_cons_cons, assoc, lookup]\n    rcases h with ⟨rfl, rfl⟩ | h\n    · simp\n    · have hk : k ≠ a := fun he => ha (he ▸ (List.of_mem_zip h).1)\n      have hak : (a == k) = false := by simp only [beq_eq_false_iff_ne]; exact fun he => hk he.symm\n      simp only [hak, Bool.false_eq_true, ite_false]\n      exact assoc_zip_var hd' h\n\ntheorem zip_has : ∀ {ks ws : List Nat}, ks.length = ws.length → ∀ {k : Nat}, k ∈ ks → ∃ w, (k, w) ∈ ks.zip ws\n  | [], _, _, _, h => by simp at h\n  | _ :: _, [], hl, _, _ => by simp at hl\n  | a :: as, b :: bs, hl, k, h => by\n    simp only [List.length_cons, Nat.add_right_cancel_iff] at hl\n    rcases List.mem_cons.mp h with rfl | h\n    · exact ⟨b, by simp⟩\n    · obtain ⟨w, hw⟩ := zip_has hl h\n      exact ⟨w, by simp [List.zip_cons_cons, hw]⟩\n\n-- Terms put in for the keys: the state read at the keys' values.\ntheorem applyS_zip_atKeys (ks : List Nat) (ts : List E) (X : Nat → Nat) (N : Nat → Nat → Nat) :\n    applyS (ks.zip ts) X N = atKeys X ks (applyS (ks.zip ts) X N) := by\n  funext i\n  simp only [atKeys]\n  split\n  · rfl\n  · rename_i h\n    exact applyS_other (fun hm => h (by obtain ⟨⟨a, b⟩, hp, rfl⟩ := List.mem_map.mp hm; exact List.contains_iff_mem.mpr (List.of_mem_zip hp).1)) X N\n\ntheorem lookup_unique1 {p : Nat × Nat} {l : List (Nat × Nat)} (hd : distinct (l.map (·.1)) = true) (hp : p ∈ l) :\n    lookup (fun q => q.1 == p.1) l = some p := by\n  induction l with\n  | nil => simp at hp\n  | cons a as ih =>\n    simp only [List.map_cons] at hd\n    obtain ⟨hna, hd'⟩ := distinct_cons hd\n    simp only [lookup]\n    rcases List.mem_cons.mp hp with rfl | hp'\n    · simp\n    · have hne : (a.1 == p.1) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hna (by rw [he]; exact List.mem_map_of_mem hp')\n      simp only [hne, Bool.false_eq_true, ite_false]; exact ih hd' hp'\n\ntheorem applyS_single (k : Nat) (t : E) (W : Nat → Nat) (M : Nat → Nat → Nat) : applyS [(k, t)] W M = upd W k (evalE W M t) := by\n  funext i; simp only [applyS, assoc, lookup, upd]\n  by_cases h : i = k\n  · subst h; simp\n  · have hb : (k == i) = false := by simp; omega\n    simp [hb, h]\n\n-- Agreeing states decide the plain flags alike, wherever the flag conditions don't read where they differ.\ntheorem decide_agree_on {fl : List (Nat × C)} {V : List Nat} (hav : ∀ p ∈ fl, avoids V p.2 = true) {X X' : Nat → Nat}\n    (N : Nat → Nat → Nat) (h : Agree V X X') : Agree V (decideFlags fl X N) (decideFlags fl X' N) := by\n  intro i hi\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases hc : flagOf fl i with\n  | none => exact h i hi\n  | some c =>\n    obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n    simp only [Option.map_some, evalE]\n    rw [congrC X X' N p.2 (fun j hj => h j (avoids_occ (hav p hp) hj))]\n\nsection view\nvariable (s : SMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n\ntheorem sOk_parts (hs : sOk s = true) :\n    flagsOk s.f.flags = true ∧ distinct s.qVars = true ∧ distinctPairs s.wits = true\n      ∧ (∀ q ∈ s.qflags, (∃ w ∈ s.wits, w.1 = q.1 ∧ w.2.length = q.2.1.length) ∧ distinct q.2.1 = true)\n      ∧ distinct (s.extVars ++ flagVars s.f.flags) = true\n      ∧ (∀ q ∈ s.qflags, avoids (s.qVars ++ s.wVars ++ flagVars s.f.flags) q.2.2 = true ∧ ∀ k ∈ q.2.1, k ∉ s.extVars ++ flagVars s.f.flags)\n      ∧ (∀ p ∈ s.f.flags, avoids s.wVars p.2 = true) := by\n  simp only [sOk, Bool.and_eq_true, List.all_eq_true, List.any_eq_true, beq_iff_eq, Bool.not_eq_true'] at hs\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hf, hq⟩, hw⟩, hcov⟩, hd⟩, hb⟩, hfl⟩, _⟩, _⟩, _⟩, _⟩, _⟩ := hs\n  refine ⟨hf, hq, hw, fun q hq' => ⟨(hcov q hq').1, (hcov q hq').2⟩, hd, fun q hq' => ⟨(hb q hq').1, fun k hk hm => ?_⟩, hfl⟩\n  have h2 := (hb q hq').2 k hk\n  exact absurd hm (by simpa using h2)\n\n-- The extended variables are apart: an input is no quantified flag or witness, and so on.\ntheorem ext_apart (hs : sOk s = true) :\n    (∀ v ∈ s.f.m.inputs, v ∉ s.qVars ∧ v ∉ s.wVars) ∧ (∀ v ∈ s.qVars, v ∉ s.wVars) := by\n  obtain ⟨_, _, _, _, hd, _, _⟩ := sOk_parts s hs\n  obtain ⟨hd1, _, _⟩ := distinct_append hd\n  simp only [SMachine.extVars, List.append_assoc] at hd1\n  obtain ⟨_, hd2, hi⟩ := distinct_append hd1\n  obtain ⟨_, _, hqw⟩ := distinct_append hd2\n  exact ⟨fun v hv => ⟨fun h => hi v hv (List.mem_append_left _ h), fun h => hi v hv (List.mem_append_right _ h)⟩, hqw⟩\n\n-- (F1) The goal's view and the decided quantified flags agree outside the witnesses.\ntheorem view_agree (hs : sOk s = true) :\n    Agree s.wVars (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withExt s ρ (sReq s ρ M ι κ)) := by\n  obtain ⟨hin, hqw⟩ := ext_apart s hs\n  intro v hvw\n  simp only [withExt, sReq]\n  by_cases hvi : v ∈ s.f.m.inputs\n  · have hvq : v ∉ s.qVars := (hin v hvi).1\n    have hl : lookup (fun q => q.1 == v) s.qflags = none := lookup_none (fun q hq => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hvq (by rw [← he]; exact List.mem_map_of_mem hq))\n    simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, hvi, true_or, ite_true, decideQ, hl, withInputs]\n  · by_cases hvq : v ∈ s.qVars\n    · simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, hvi, hvq, or_true, true_or, ite_true, false_or, ite_false]\n      obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hvq\n      have hl : lookup (fun q' => q'.1 == q.1) s.qflags = some q := lookup_unique (sOk_parts s hs).2.1 hq\n      simp only [hl]\n    · have hl : lookup (fun q => q.1 == v) s.qflags = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hvq (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append, hvi, hvq, hvw, or_false, ite_false, decideQ, hl, withInputs, List.contains_iff_mem]\n\n-- (F2) Every closing hypothesis holds of the real step, read in the goal's view.\ntheorem closing_true (hs : sOk s = true) (qinsts : List (Nat × List E)) :\n    ∀ c ∈ closingHyps s qinsts, evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) c = true := by\n  obtain ⟨_, hqd, hwd, hcov, _, hbody, _⟩ := sOk_parts s hs\n  obtain ⟨hin, hqw⟩ := ext_apart s hs\n  have hag := view_agree s ρ M ι κ hs\n  intro c hc\n  simp only [closingHyps, List.mem_flatMap, List.mem_append, List.mem_singleton, List.mem_map, List.mem_filter] at hc\n  obtain ⟨q, hq, hc⟩ := hc\n  have hqv : q.1 ∈ s.qVars := List.mem_map_of_mem hq\n  -- The flag's value: 1 exactly when the body holds at every value of the keys (read in either view: they agree on the body).\n  have hY : withExt s ρ (sReq s ρ M ι κ) q.1 = if ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 then 1 else 0 := by\n    rw [← hag q.1 (hqw _ hqv)]; simp only [decideQ, lookup_unique hqd hq]\n  have hbodyY : ∀ k, holdsC (atKeys (withExt s ρ (sReq s ρ M ι κ)) q.2.1 k) (withCarried s M κ) q.2.2\n      ↔ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 := by\n    intro k\n    rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 (fun j hj => by\n      simp only [atKeys]; split\n      · rfl\n      · have hjq : j ∉ s.qVars := fun h => avoids_occ (hbody q hq).1 hj (List.mem_append_left _ (List.mem_append_left _ h))\n        have hjw : j ∉ s.wVars := fun h => avoids_occ (hbody q hq).1 hj (List.mem_append_left _ (List.mem_append_right _ h))\n        rw [← hag j hjw]; simp only [decideQ]\n        rw [lookup_none (fun q' hq' => by simp only [beq_eq_false_iff_ne]; intro he; exact hjq (by rw [← he]; exact List.mem_map_of_mem hq'))])]\n  rcases hc with ((rfl | ⟨p, ⟨_, hpq⟩, rfl⟩) | hc)\n  · simp only [evalC, evalE, hY]; split <;> simp\n  · simp only [beq_iff_eq] at hpq\n    simp only [evalC, evalE, Bool.or_eq_true, decide_eq_true_eq]\n    by_cases h1 : ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2\n    · right; rw [subst_evalC, applyS_zip_atKeys, evalC_iff]; exact (hbodyY _).mpr (h1 _)\n    · left; simp [hY, h1]\n  · obtain ⟨⟨w, hw, hwq, hlen⟩, hkd⟩ := hcov q hq\n    have hlw : lookup (fun w' => w'.1 == q.1) s.wits = some w := by\n      rw [← hwq]; exact lookup_unique (by simp only [distinctPairs, Bool.and_eq_true] at hwd; exact hwd.1) hw\n    simp only [hlw, List.mem_singleton] at hc; subst hc\n    simp only [evalC, evalE, Bool.or_eq_true, decide_eq_true_eq, Bool.not_eq_true']\n    by_cases h1 : ∀ k, holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2\n    · left; simp [hY, h1]\n    · right\n      have hwd' : distinct (s.wits.flatMap (·.2)) = true := by simp only [distinctPairs, Bool.and_eq_true] at hwd; exact hwd.2\n      -- Each witness reads the failing value of the key beside it.\n      have hYw : ∀ k x, (k, x) ∈ q.2.1.zip w.2 → withExt s ρ (sReq s ρ M ι κ) x = witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q k := by\n        intro k x hkx\n        have hxw : x ∈ s.wVars := List.mem_flatMap.mpr ⟨w, hw, (List.of_mem_zip hkx).2⟩\n        have hxi : x ∉ s.f.m.inputs := fun h => (hin _ h).2 hxw\n        have hxq : x ∉ s.qVars := fun h => hqw _ h hxw\n        have hext : s.extVars.contains x = true := by\n          simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inr hxw\n        have hni : s.f.m.inputs.contains x = false := by simpa [List.contains_iff_mem] using hxi\n        simp only [withExt, hext, ite_true, sReq, hni, Bool.false_eq_true, ite_false]\n        rw [lookup_none (fun q' hq' => by\n          simp only [beq_eq_false_iff_ne]; intro he; exact hxq (by rw [← he]; exact List.mem_map_of_mem hq')),\n          lookup_wit hwd' hw (List.of_mem_zip hkx).2]\n        simp only [hwq, lookup_unique hqd hq]\n        rw [lookup_zip_wit (distinct_of_flatMap hwd' hw) hkx]\n      have hex : ∃ k, ¬ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 k) (withCarried s M κ) q.2.2 := by simpa using h1\n      have hfail : ¬ holdsC (atKeys (withInputs s.f.m.inputs ρ ι) q.2.1 (witnessKeys (withInputs s.f.m.inputs ρ ι) (withCarried s M κ) q)) (withCarried s M κ) q.2.2 := by\n        simp only [witnessKeys, dif_pos hex]; exact Classical.choose_spec hex\n      rw [subst_evalC]\n      cases hb : evalC (applyS (q.2.1.zip (w.2.map E.var)) (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ)) (withCarried s M κ) q.2.2\n      · rfl\n      · refine absurd ((hbodyY _).mp ((evalC_iff _ _ _).mp ?_)) hfail\n        rw [← hb]\n        apply congrC; intro j _\n        simp only [atKeys]; split\n        · rename_i hj\n          obtain ⟨x, hx⟩ := zip_has hlen.symm (List.contains_iff_mem.mp hj)\n          simp only [applyS, assoc_zip_var hkd hx, evalE]\n          exact (hYw j x hx).symm\n        · rename_i hj\n          exact (applyS_other (fun hm => hj (by obtain ⟨⟨a, b⟩, hp, rfl⟩ := List.mem_map.mp hm; exact List.contains_iff_mem.mpr (List.of_mem_zip hp).1)) _ _).symm\nend view\n\n/-! Which maps a term reads -/\n\nmutual\ndef occME (mp : Nat) : E → Bool\n  | .var _ => false\n  | .const _ => false\n  | .add a b => occME mp a || occME mp b\n  | .sub a b => occME mp a || occME mp b\n  | .mul _ a => occME mp a\n  | .min a b => occME mp a || occME mp b\n  | .max a b => occME mp a || occME mp b\n  | .prod a b => occME mp a || occME mp b\n  | .ite c t f => occMC mp c || occME mp t || occME mp f\n  | .get m key => m == mp || occME mp key\ndef occMC (mp : Nat) : C → Bool\n  | .le a b => occME mp a || occME mp b\n  | .lt a b => occME mp a || occME mp b\n  | .eq a b => occME mp a || occME mp b\n  | .and a b => occMC mp a || occMC mp b\n  | .or a b => occMC mp a || occMC mp b\n  | .not a => occMC mp a\nend\n\ndef avoidsMaps (ms : List Nat) (c : C) : Bool := ms.all fun mp => !occMC mp c\ndef avoidsMapsE (ms : List Nat) (e : E) : Bool := ms.all fun mp => !occME mp e\n\n-- Maps that agree on every map a term reads give it the same value.\nmutual\ntheorem congrME (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) :\n    (e : E) → (∀ mp, occME mp e = true → M mp = M' mp) → evalE ρ M e = evalE ρ M' e\n  | .var _, _ => rfl\n  | .const _, _ => rfl\n  | .add a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .sub a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .mul k a, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm]))]\n  | .min a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .max a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .prod a b, h => by simp only [evalE, congrME ρ M M' a (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occME, hm]))]\n  | .ite c t f, h => by\n    simp only [evalE, congrMC ρ M M' c (fun mp hm => h mp (by simp [occME, hm])), congrME ρ M M' t (fun mp hm => h mp (by simp [occME, hm])),\n      congrME ρ M M' f (fun mp hm => h mp (by simp [occME, hm]))]\n  | .get m key, h => by\n    simp only [evalE, congrME ρ M M' key (fun mp hm => h mp (by simp [occME, hm])), h m (by simp [occME])]\ntheorem congrMC (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) :\n    (c : C) → (∀ mp, occMC mp c = true → M mp = M' mp) → evalC ρ M c = evalC ρ M' c\n  | .le a b, h => by simp only [evalC, congrME ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .lt a b, h => by simp only [evalC, congrME ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .eq a b, h => by simp only [evalC, congrME ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrME ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .and a b, h => by simp only [evalC, congrMC ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrMC ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .or a b, h => by simp only [evalC, congrMC ρ M M' a (fun mp hm => h mp (by simp [occMC, hm])), congrMC ρ M M' b (fun mp hm => h mp (by simp [occMC, hm]))]\n  | .not a, h => by simp only [evalC, congrMC ρ M M' a (fun mp hm => h mp (by simp [occMC, hm]))]\nend\n\ntheorem avoidsMapsE_occ {ms : List Nat} {e : E} (h : avoidsMapsE ms e = true) {mp : Nat} (hm : occME mp e = true) : mp ∉ ms := by\n  intro hmem; simp only [avoidsMapsE, List.all_eq_true] at h; have := h mp hmem; simp [hm] at this\n\n-- A term avoiding some maps: so does each of its parts.\ntheorem amE {ms : List Nat} {e a : E} (h : avoidsMapsE ms e = true) (hs : ∀ mp, occME mp a = true → occME mp e = true) : avoidsMapsE ms a = true := by\n  simp only [avoidsMapsE, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occME mp a\n  · rfl\n  · simp [hs mp hq] at h\ntheorem amEC {ms : List Nat} {e : E} {c : C} (h : avoidsMapsE ms e = true) (hs : ∀ mp, occMC mp c = true → occME mp e = true) : avoidsMaps ms c = true := by\n  simp only [avoidsMapsE, avoidsMaps, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occMC mp c\n  · rfl\n  · simp [hs mp hq] at h\ntheorem amCE {ms : List Nat} {c : C} {a : E} (h : avoidsMaps ms c = true) (hs : ∀ mp, occME mp a = true → occMC mp c = true) : avoidsMapsE ms a = true := by\n  simp only [avoidsMapsE, avoidsMaps, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occME mp a\n  · rfl\n  · simp [hs mp hq] at h\ntheorem amC {ms : List Nat} {c d : C} (h : avoidsMaps ms c = true) (hs : ∀ mp, occMC mp d = true → occMC mp c = true) : avoidsMaps ms d = true := by\n  simp only [avoidsMaps, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro mp hm; specialize h mp hm; cases hq : occMC mp d\n  · rfl\n  · simp [hs mp hq] at h\n\n-- substR_evalE for a term avoiding the maps rd doesn't read as M' does.\nsection\nvariable (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M M' : Nat → Nat → Nat) (X : List Nat)\n  (hrd : ∀ m k, m ∉ X → evalE W M (rd m k) = M' m (evalE W M k))\ninclude hrd\nmutual\ntheorem substR_evalE_on : (e : E) → avoidsMapsE X e = true → evalE W M (substRE σ rd e) = evalE (applyS σ W M) M' e\n  | .var i, _ => by\n    simp only [substRE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n, _ => by simp [substRE, evalE]\n  | .add a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .sub a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .mul k a, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm]))]\n  | .min a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .max a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .prod a b, h => by simp [substRE, evalE, substR_evalE_on a (amE h (fun mp hm => by simp [occME, hm])), substR_evalE_on b (amE h (fun mp hm => by simp [occME, hm]))]\n  | .ite c t f, h => by\n    simp [substRE, evalE, substR_evalC_on c (amEC h (fun mp hm => by simp [occME, hm])), substR_evalE_on t (amE h (fun mp hm => by simp [occME, hm])),\n      substR_evalE_on f (amE h (fun mp hm => by simp [occME, hm]))]\n  | .get m key, h => by\n    have hmz : m ∉ X := avoidsMapsE_occ h (by simp [occME])\n    simp only [substRE, evalE]\n    rw [hrd m _ hmz, substR_evalE_on key (amE h (fun mp hm => by simp [occME, hm]))]\ntheorem substR_evalC_on : (c : C) → avoidsMaps X c = true → evalC W M (substRC σ rd c) = evalC (applyS σ W M) M' c\n  | .le a b, h => by simp [substRC, evalC, substR_evalE_on a (amCE h (fun mp hm => by simp [occMC, hm])), substR_evalE_on b (amCE h (fun mp hm => by simp [occMC, hm]))]\n  | .lt a b, h => by simp [substRC, evalC, substR_evalE_on a (amCE h (fun mp hm => by simp [occMC, hm])), substR_evalE_on b (amCE h (fun mp hm => by simp [occMC, hm]))]\n  | .eq a b, h => by simp [substRC, evalC, substR_evalE_on a (amCE h (fun mp hm => by simp [occMC, hm])), substR_evalE_on b (amCE h (fun mp hm => by simp [occMC, hm]))]\n  | .and a b, h => by simp [substRC, evalC, substR_evalC_on a (amC h (fun mp hm => by simp [occMC, hm])), substR_evalC_on b (amC h (fun mp hm => by simp [occMC, hm]))]\n  | .or a b, h => by simp [substRC, evalC, substR_evalC_on a (amC h (fun mp hm => by simp [occMC, hm])), substR_evalC_on b (amC h (fun mp hm => by simp [occMC, hm]))]\n  | .not a, h => by simp [substRC, evalC, substR_evalC_on a (amC h (fun mp hm => by simp [occMC, hm]))]\nend\nend\n\ntheorem substR_var (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    evalE W M (substRE σ rd (.var i)) = applyS σ W M i := by\n  simp only [substRE]; cases h : assoc σ i <;> simp [evalE, applyS, h]\n\ntheorem avoidsMaps_occ {ms : List Nat} {c : C} (h : avoidsMaps ms c = true) {mp : Nat} (hm : occMC mp c = true) : mp ∉ ms := by\n  intro hin; simp only [avoidsMaps, List.all_eq_true] at h; have := h mp hin; simp [hm] at this\n\ntheorem applyS_cons (k : Nat) (t : E) (τ : List (Nat × E)) (W : Nat → Nat) (M : Nat → Nat → Nat) :\n    applyS ((k, t) :: τ) W M = upd (applyS τ W M) k (evalE W M t) := by\n  funext i; simp only [applyS, assoc, lookup, upd]\n  by_cases h : i = k\n  · subst h; simp\n  · have hb : (k == i) = false := by simp; omega\n    simp [hb, h]\n\n-- Setting a variable no flag condition reads commutes with deciding the flags.\ntheorem decide_upd {fl : List (Nat × C)} {k : Nat} (hk : k ∉ flagVars fl) (hav : ∀ p ∈ fl, occC k p.2 = false)\n    (X : Nat → Nat) (N : Nat → Nat → Nat) (v : Nat) : decideFlags fl (upd X k v) N = upd (decideFlags fl X N) k v := by\n  funext i\n  simp only [decideFlags, applyS, assoc_flagSub, upd]\n  by_cases hi : i = k\n  · subst hi\n    have hn : flagOf fl i = none := by\n      simp only [flagOf, Option.map_eq_none_iff]\n      exact lookup_none (fun p hp => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hk (by simp only [flagVars]; rw [← he]; exact List.mem_map_of_mem hp))\n    simp [hn]\n  · simp only [hi, ite_false]\n    cases hc : flagOf fl i with\n    | none => simp\n    | some c =>\n      obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n      simp only [Option.map_some, evalE]\n      rw [congrC (upd X k v) X N p.2 (fun j hj => by\n        simp only [upd]\n        split\n        · rename_i hjk; subst hjk; have h0 := hav p hp; rw [h0] at hj; exact absurd hj (by decide)\n        · rfl)]\n\n/-! Laws read where a frame is read -/\n\n-- The scalar laws and every-key laws at their instances hold wherever the laws do.\ntheorem laws_hyps_true (laws : List MLaw) (insts : List (Nat × E)) (Y : Nat → Nat) (N : Nat → Nat → Nat)\n    (hl : ∀ l ∈ laws, l.Holds Y N) : ∀ c ∈ scalarHyps laws ++ instHyps laws insts, evalC Y N c = true := by\n  intro c hc\n  rcases List.mem_append.mp hc with hc | hc\n  · simp only [scalarHyps, List.mem_filterMap] at hc\n    obtain ⟨l, hlm, hk⟩ := hc\n    split at hk\n    · rename_i hkey\n      simp only [Option.some.injEq] at hk; subst hk\n      have := hl l hlm\n      simpa [MLaw.Holds, hkey] using this\n    · simp at hk\n  · simp only [instHyps, List.mem_filterMap] at hc\n    obtain ⟨p, _, hk⟩ := hc\n    split at hk\n    · rename_i l hlg\n      split at hk\n      · rename_i kv hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        have := hl l (List.mem_of_getElem? hlg)\n        simp only [MLaw.Holds, hkey] at this\n        rw [subst_evalC, applyS_single]\n        exact this _\n      · simp at hk\n    · simp at hk\n\n-- A law reading neither the variables nor the maps two states differ at holds in both alike.\ntheorem holds_transfer {V MS : List Nat} (l : MLaw) (hv : avoids V l.holds = true) (hm : avoidsMaps MS l.holds = true)\n    {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (hag : Agree V ρ ρ') (hmag : ∀ mp, mp ∉ MS → M mp = M' mp) :\n    l.Holds ρ' M' → l.Holds ρ M := by\n  have cong : ∀ X X' : Nat → Nat, Agree V X X' → evalC X' M' l.holds = true → evalC X M l.holds = true := by\n    intro X X' ha h\n    rw [congrMC X M M' l.holds (fun mp hmp => hmag mp (avoidsMaps_occ hm hmp)), congrC X X' M' l.holds (fun i hi => ha i (avoids_occ hv hi))]\n    exact h\n  unfold MLaw.Holds\n  split\n  · exact cong ρ ρ' hag\n  · rename_i kv _\n    intro h v\n    have ha : Agree V (upd ρ kv v) (upd ρ' kv v) := by\n      intro i hi; simp only [upd]; split\n      · rfl\n      · exact hag i hi\n    exact cong _ _ ha (h v)\n\n/-! Frames of a run of a machine with sets -/\n\n-- The frame σ, rd denotes the state ρ, M: every variable outside the extended request's and the zone Z, and every map\n-- read but those the requests carry and the zone MZ (the names later requests' maps are read by).\ndef SDenotes (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (rd : Nat → E → E)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop :=\n  (∀ v, v ∉ s.extVars → v ∉ Z → applyS σ W M0 v = ρ v) ∧ (∀ mp k, mp ∉ s.carried → mp ∉ MZ → evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n\n-- The frame a step reads (its request set) agrees with the state and request outside the zone, and reads the maps the\n-- step reads.\ndef SHead (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (rd : Nat → E → E)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (r mr : List (Nat × Nat)) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : Prop :=\n  Agree Z (applyS (frameSub r σ) W M0) (withExt s ρ (sReq s ρ M ι κ))\n    ∧ ∀ mp k, mp ∉ MZ → evalE W M0 (frameRd mr rd mp k) = withCarried s M κ mp (evalE W M0 k)\n\nsection frame\nvariable (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n\n-- A term of the step read at the frame is its value at the real step (flags decided), away from the zone and witnesses.\ntheorem sframe_term (hs : sOk s = true) (hfz : ∀ v ∈ flagVars s.f.flags, v ∈ Z) (hfav : ∀ p ∈ s.f.flags, avoids Z p.2 = true)\n    {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} {r mr : List (Nat × Nat)} {ι : Nat → Nat} {κ : Nat → Nat → Nat}\n    (hH : SHead s Z MZ W M0 σ rd ρ M r mr ι κ) (e : E) (he : avoidsE (Z ++ s.wVars) (inlineE s.f.flags e) = true)\n    (hem : avoidsMapsE MZ (inlineE s.f.flags e) = true) :\n    evalE W M0 (substRE (frameSub r σ) (frameRd mr rd) (inlineE s.f.flags e)) = evalE (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 e := by\n  obtain ⟨hX, hrd⟩ := hH\n  have hwfl := (sOk_parts s hs).2.2.2.2.2.2\n  rw [substR_evalE_on (frameSub r σ) (frameRd mr rd) W M0 (withCarried s M κ) MZ hrd _ hem,\n    congrE _ (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) _ (fun i hi => hX i (fun h => avoidsE_occ he hi (List.mem_append_left _ h))),\n    inline_evalE]\n  show evalE (decideFlags s.f.flags (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ)) (withCarried s M κ) e\n    = evalE (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) (withCarried s M κ) e\n  rw [← inline_evalE, ← inline_evalE]\n  exact congrE _ _ _ _ (fun i hi => (view_agree s ρ M ι κ hs i (fun h => avoidsE_occ he hi (List.mem_append_right _ h))).symm)\nend frame\n\n-- A substitution's terms replaced by their values: the same environment at its keys.\ntheorem assoc_zip_map (f : E → E) (i : Nat) : ∀ (ks : List Nat) (ts : List E), assoc (ks.zip (ts.map f)) i = (assoc (ks.zip ts) i).map f\n  | [], _ => by simp [assoc, lookup]\n  | _ :: _, [] => by simp [assoc, lookup]\n  | k :: ks, t :: ts => by\n    have ih := assoc_zip_map f i ks ts\n    by_cases h : k = i\n    · simp [assoc, lookup, h]\n    · simp only [assoc, List.zip_cons_cons, List.map_cons, lookup, beq_iff_eq, h, if_false] at ih ⊢; exact ih\n\ntheorem applyS_zip_const (ks : List Nat) (ts : List E) (V X : Nat → Nat) (N : Nat → Nat → Nat) (i : Nat) (h : V i = X i) :\n    applyS (ks.zip ts) V N i = applyS (ks.zip (ts.map (fun t => E.const (evalE V N t)))) X N i := by\n  simp only [applyS, assoc_zip_map]\n  cases assoc (ks.zip ts) i <;> simp [evalE, h]\n\n-- A frame's hypothesis is one of the frame without the flags' instances, or an instance of a flag.\ntheorem sframe_mem (s : SMachine) (laws : List MLaw) (insts : List (Nat × E)) (qinsts : List (Nat × List E)) (w c : C)\n    (hc : c ∈ sFrameHyps s laws insts qinsts w) :\n    c ∈ sFrameHyps s laws insts [] w ∨ ∃ q ∈ s.qflags, ∃ p ∈ qinsts, c = .or (.eq (.var q.1) (.const 0)) (substC (q.2.1.zip p.2) q.2.2) := by\n  rcases List.mem_append.mp hc with h | h\n  · exact Or.inl (List.mem_append_left _ h)\n  · obtain ⟨q, hq, h⟩ := List.mem_flatMap.mp h\n    rcases List.mem_append.mp h with h | h\n    · rcases List.mem_append.mp h with h | h\n      · exact Or.inl (List.mem_append_right _ (List.mem_flatMap.mpr ⟨q, hq, List.mem_append_left _ (List.mem_append_left _ h)⟩))\n      · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n        exact Or.inr ⟨q, hq, p, (List.mem_filter.mp hp).1, rfl⟩\n    · exact Or.inl (List.mem_append_right _ (List.mem_flatMap.mpr ⟨q, hq, List.mem_append_right _ h⟩))\n\nsection frame2\nvariable (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n\n-- Every hypothesis of a frame holds where the frame is read, given the laws in the goal's view of its state.\ntheorem sframe_hyps (hs : sOk s = true) (laws : List MLaw) (insts : List (Nat × E)) (qinsts : List (Nat × List E))\n    {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} {r mr : List (Nat × Nat)} {ι : Nat → Nat} {κ : Nat → Nat → Nat} {w : C}\n    (hlY : ∀ l ∈ laws, l.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ))\n    (hH : SHead s Z MZ W M0 σ rd ρ M r mr ι κ)\n    (hav : ∀ c ∈ sFrameHyps s laws insts [] w, avoids Z c = true)\n    (hqb : ∀ q ∈ s.qflags, avoids Z q.2.2 = true)\n    (havm : ∀ c ∈ sFrameHyps s laws insts qinsts w, avoidsMaps MZ c = true)\n    (hA : evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true)\n    (hW : evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) w = true) :\n    ∀ c ∈ sFrameHyps s laws insts qinsts w, evalC W M0 (substRC (frameSub r σ) (frameRd mr rd) c) = true := by\n  obtain ⟨hX, hrd⟩ := hH\n  intro c hc\n  rw [substR_evalC_on (frameSub r σ) (frameRd mr rd) W M0 (withCarried s M κ) MZ hrd c (havm c hc)]\n  rcases sframe_mem s laws insts qinsts w c hc with hc | ⟨q, hq, p, _, rfl⟩\n  · rw [congrC _ (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) c (fun i hi => hX i (avoids_occ (hav c hc) hi))]\n    simp only [sFrameHyps, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n    rcases hc with ((hc | rfl | rfl) | hc)\n    · exact laws_hyps_true laws insts _ _ hlY c (List.mem_append.mpr hc)\n    · -- The assumption, inlined: the view decides the plain flags as the step does, away from the witnesses.\n      rw [inline_evalC]\n      have hagD := decide_agree_on (sOk_parts s hs).2.2.2.2.2.2 (withCarried s M κ) (view_agree s ρ M ι κ hs)\n      rw [congrC _ (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) _ s.f.m.assume\n        (fun i hi => (hagD i (fun h => by\n          have hpa : avoids s.wVars s.f.m.assume = true := by simp only [sOk, Bool.and_eq_true] at hs; exact hs.2\n          exact avoids_occ hpa hi h)).symm)]\n      exact hA\n    · exact hW\n    · exact closing_true s ρ M ι κ hs [] c hc\n  · -- A flag's instance: its keys' terms may read the zone (a later step's names), the flag and its body don't. Read\n    -- in the frame it is the instance at the keys' values read in the step's view, which holds there.\n    have hq1 : q.1 ∉ Z := by\n      have hle : C.le (.var q.1) (.const 1) ∈ sFrameHyps s laws insts [] w :=\n        List.mem_append_right _ (List.mem_flatMap.mpr ⟨q, hq, List.mem_append_left _ (List.mem_append_left _ (List.mem_singleton.mpr rfl))⟩)\n      exact avoids_occ (hav _ hle) (by simp [occC, occE])\n    let ks := p.2.map (fun t => E.const (evalE (applyS (frameSub r σ) W M0) (withCarried s M κ) t))\n    have hc' := closing_true s ρ M ι κ hs [(q.1, ks)] (.or (.eq (.var q.1) (.const 0)) (substC (q.2.1.zip ks) q.2.2))\n      (List.mem_flatMap.mpr ⟨q, hq, List.mem_append_left _ (List.mem_append_right _\n        (List.mem_map.mpr ⟨(q.1, ks), List.mem_filter.mpr ⟨List.mem_singleton.mpr rfl, by simp⟩, rfl⟩))⟩)\n    have heq : evalC (applyS (frameSub r σ) W M0) (withCarried s M κ) (.or (.eq (.var q.1) (.const 0)) (substC (q.2.1.zip p.2) q.2.2))\n        = evalC (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) (.or (.eq (.var q.1) (.const 0)) (substC (q.2.1.zip ks) q.2.2)) := by\n      simp only [evalC, evalE, subst_evalC, hX q.1 hq1]\n      rw [congrC _ _ _ q.2.2 (fun i hi => applyS_zip_const q.2.1 p.2 _ _ _ i (hX i (avoids_occ (hqb q hq) hi)))]\n      rfl\n    rw [heq]; exact hc'\n\n-- One step keeps the frame denoting the state: each variable its step term, each map its writes.\ntheorem sstep_denotes (hs : sOk s = true) (hfz : ∀ v ∈ flagVars s.f.flags, v ∈ Z) (hfav : ∀ p ∈ s.f.flags, avoids Z p.2 = true)\n    {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} (r mr : List (Nat × Nat)) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n    (hD : SDenotes s Z MZ W M0 σ rd ρ M) (hH : SHead s Z MZ W M0 σ rd ρ M r mr ι κ)\n    (hrk : ∀ p ∈ r, p.1 ∈ s.extVars)\n    (hst : ∀ p ∈ s.f.m.step, avoidsE (Z ++ s.wVars) (inlineE s.f.flags p.2) = true)\n    (hwr : ∀ w ∈ s.f.m.writes, avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.1) = true ∧ avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true)\n    (hev : ∀ w ∈ s.every, avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true ∧ w.2.1 ∉ Z ∧ w.2.1 ∉ flagVars s.f.flags\n      ∧ (∀ p ∈ s.f.flags, occC w.2.1 p.2 = false) ∧ w.1 ∉ s.carried ∧ w.1 ∉ s.f.m.writes.map (·.1))\n    (hstm : ∀ p ∈ s.f.m.step, avoidsMapsE MZ (inlineE s.f.flags p.2) = true)\n    (hwrm : ∀ w ∈ s.f.m.writes, avoidsMapsE MZ (inlineE s.f.flags w.2.1) = true ∧ avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true)\n    (hevm : ∀ w ∈ s.every, avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true) :\n    SDenotes s Z MZ W M0 (stepSub s.f (frameSub r σ) (frameRd mr rd)) (stepRdS s (frameSub r σ) (frameRd mr rd)) (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 := by\n  obtain ⟨hv, hrdM⟩ := hD\n  have hH' := hH\n  obtain ⟨hX, hrd⟩ := hH\n  refine ⟨fun v hve hvz => ?_, fun mp k hmp hmz => ?_⟩\n  · simp only [sNext, applyS, stepSub, assoc_append_or, assoc_stepSub]\n    cases h : assoc s.f.m.step v with\n    | some e =>\n      have hm : (v, e) ∈ s.f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at h\n        obtain ⟨q, hq, rfl⟩ := h\n        obtain ⟨hqm, hqv⟩ := lookup_some hq\n        simp only [beq_iff_eq] at hqv\n        rw [← hqv]; exact hqm\n      simp only [Option.map_some, Option.some_or]\n      exact sframe_term s Z MZ W M0 hs hfz hfav hH' e (hst (v, e) hm) (hstm (v, e) hm)\n    | none =>\n      simp only [Option.map_none, Option.none_or]\n      have hvf : v ∉ flagVars s.f.flags := fun h' => hvz (hfz v h')\n      have hvq : v ∉ s.qVars := fun h' => hve (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inr h'))\n      have hvi : v ∉ s.f.m.inputs := fun h' => hve (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl h'))\n      show applyS (frameSub r σ) W M0 v = decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ) v\n      rw [decide_other hvf, hX v hvz]\n      simp only [withExt, decideQ, sReq]\n      rw [if_neg (by simpa [List.contains_iff_mem] using hve)]\n      rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hvq (by rw [← he]; exact List.mem_map_of_mem hq))]\n      exact (withInputs_other hvi ρ ι).symm\n  · simp only [stepRdS, sNext, everyMaps]\n    cases he : lookup (fun w => w.1 == mp) s.every with\n    | some w =>\n      obtain ⟨hval, _, hkf, hkfl, _, _⟩ := hev w (lookup_some he).1\n      simp only\n      rw [substR_evalE_on ((w.2.1, k) :: frameSub r σ) (frameRd mr rd) W M0 (withCarried s M κ) MZ hrd _ (hevm w (lookup_some he).1), applyS_cons]\n      show evalE (upd (applyS (frameSub r σ) W M0) w.2.1 (evalE W M0 k)) (withCarried s M κ) (inlineE s.f.flags w.2.2)\n        = evalE (upd (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) w.2.1 (evalE W M0 k)) (withCarried s M κ) w.2.2\n      rw [← decide_upd hkf (fun p hp => hkfl p hp), ← inline_evalE]\n      -- The frame and the step read the inlined value alike: they agree away from the zone and the witnesses.\n      exact congrE _ _ _ _ (fun i hi => by\n        simp only [upd]; split\n        · rfl\n        · have hiz : i ∉ Z := fun h => avoidsE_occ hval hi (List.mem_append_left _ h)\n          have hiw : i ∉ s.wVars := fun h => avoidsE_occ hval hi (List.mem_append_right _ h)\n          rw [hX i hiz]; exact (view_agree s ρ M ι κ hs i hiw).symm)\n    | none =>\n      simp only [stepRd, writeMaps]\n      cases hw : lookup (fun w : Nat × E × E => w.1 == mp) s.f.m.writes with\n      | none => exact hrd mp k hmz\n      | some w =>\n        have hm := (lookup_some hw).1\n        simp only [evalE, evalC, sframe_term s Z MZ W M0 hs hfz hfav hH' w.2.1 (hwr w hm).1 (hwrm w hm).1,\n          sframe_term s Z MZ W M0 hs hfz hfav hH' w.2.2 (hwr w hm).2 (hwrm w hm).2, fun k => hrd mp k hmz]\n        simp only [sView]\n        by_cases hk : evalE W M0 k = evalE (decideFlags s.f.flags (decideQ s (withInputs s.f.m.inputs ρ ι) (withCarried s M κ)) (withCarried s M κ)) (withCarried s M κ) w.2.1 <;> simp [hk]\nend frame2\n\n/-! Laws: the induction rule for machines with sets -/\n\nstructure SEntry where\n  law : MLaw\n  sk : Nat                    -- the skolem variable\n  keys2 : List Nat            -- a law about every two keys or more: its further keys, variables nothing but laws about them read\n  insts : List (Nat × E)      -- (law index, key): where the step goal assumes the laws about every key\n  qinsts : List (Nat × List E) -- (quantified flag, keys): where the step goal closes it\n  finsts : List (Nat × E)     -- (fact index, key): where both goals assume the facts\n  pinsts : List (Nat × E × List E) -- (law index, key, further keys): where the step goal assumes the laws about several keys\n  pfinsts : List (Nat × E × List E) -- (fact index, key, further keys): where both goals assume the facts about several keys\n  start : Cert\n  step : Cert\n\n-- What an entry claims: its law, at every value of each further key.\ndef SEntry.Holds (e : SEntry) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop := holdsOver e.law M e.keys2 ρ\n\n-- A law about several keys at a tuple, as a law about every first key: each further key read as the tuple's term.\ndef pairLaws (ps : List SEntry) (pinsts : List (Nat × E × List E)) : List MLaw := pinsts.map fun p =>\n  match ps[p.1]? with\n  | some e => ⟨substC (e.keys2.zip p.2.2) e.law.holds, e.law.key⟩\n  | none => ⟨trueC, none⟩\n-- The laws a frame assumes (the entries' laws, then each pair's) and where (each pair's at its first term).\ndef sLaws (ps : List SEntry) (pinsts : List (Nat × E × List E)) : List MLaw := ps.map (·.law) ++ pairLaws ps pinsts\ndef sInsts (ps : List SEntry) (insts : List (Nat × E)) (pinsts : List (Nat × E × List E)) : List (Nat × E) := insts ++ pairInsts ps.length pinsts\ndef sStartGoal (s : SMachine) (e : SEntry) : List C := [s.f.m.pre] ++ factHyps s e.finsts e.pfinsts ++ [.not (substRC s.f.m.init (rdStart s.f.m) (goalOf e.law e.sk))]\ndef sStepGoal (s : SMachine) (ps : List SEntry) (e : SEntry) : List C :=\n  [s.f.m.pre] ++ factHyps s e.finsts e.pfinsts ++ (sFrameHyps s (sLaws ps e.pinsts) (sInsts ps e.insts e.pinsts) e.qinsts trueC).map (substRC (frameSub [] []) (frameRd [] getRd))\n    ++ [.not (substRC (stepSub s.f (frameSub [] []) (frameRd [] getRd)) (stepRdS s (frameSub [] []) (frameRd [] getRd)) (goalOf e.law e.sk))]\n\n-- The machine's terms and the zone a frame keeps apart (the flags, and here the skolem).\ndef sTermsOk (s : SMachine) (Z : List Nat) : Bool :=\n  s.f.flags.all (fun p => avoids Z p.2)\n    && s.f.m.step.all (fun p => avoidsE (Z ++ s.wVars) (inlineE s.f.flags p.2))\n    && s.f.m.writes.all (fun w => avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.1) && avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) && !s.carried.contains w.1)\n    && s.every.all (fun w => avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) && !Z.contains w.2.1 && !(flagVars s.f.flags).contains w.2.1\n        && s.f.flags.all (fun p => !occC w.2.1 p.2) && !s.carried.contains w.1 && !(s.f.m.writes.map (·.1)).contains w.1)\n    && s.facts.all (fun l => avoids Z l.holds) && s.pfacts.all (fun f => avoids Z f.1.holds)\n\n-- The facts read the params and the functions alone: no request, flag or state variable, and no map a step writes or\n-- a request carries.\ndef factsOk1 (s : SMachine) : Bool :=\n  s.facts.all fun l => avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) l.holds\n    && avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) l.holds\n-- The facts about several keys alike, each about a first key apart from its further keys.\ndef pfactsOk (s : SMachine) : Bool :=\n  s.pfacts.all fun f => avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) f.1.holds\n    && avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) f.1.holds && f.2.all (fun g => f.1.key != some g)\ndef factsOk (s : SMachine) : Bool := factsOk1 s && pfactsOk s\n\n-- The skolem is fresh for the machine: no flag, body, assumption, term or write reads it, nor binds it.\ndef skFresh (s : SMachine) (sk : Nat) : Bool :=\n  s.f.flags.all (fun p => !occC sk p.2) && s.qflags.all (fun q => !occC sk q.2.2) && !occC sk s.f.m.assume\n    && s.f.m.step.all (fun p => !occE sk p.2) && s.f.m.writes.all (fun w => !occE sk w.2.1 && !occE sk w.2.2)\n    && s.every.all (fun w => !occE sk w.2.2 && w.2.1 != sk) && s.facts.all (fun l => !occC sk l.holds)\n    && s.pfacts.all (fun f => !occC sk f.1.holds)\n\n-- Further keys: each fresh as a skolem is, not the law's own key, read by no law but those about it, and no entry's skolem.\ndef key2Ok (s : SMachine) (ps : List SEntry) (e : SEntry) : Bool :=\n  e.keys2.all fun g => e.law.key != some g && skFresh s g && !(s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains g\n    && !occC g s.f.m.pre && s.f.m.init.all (fun p => !occE g p.2)\n    && ps.all (fun e' => (!occC g e'.law.holds || e'.keys2.contains g) && e'.sk != g)\n\ndef checkSMachine (s : SMachine) (ps : List SEntry) : Bool :=\n  sOk s && avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) s.f.m.pre && !readsC s.f.m.pre\n    && sTermsOk s (flagVars s.f.flags) && factsOk s\n    && ps.all fun e =>\n      avoids (s.extVars ++ flagVars s.f.flags) e.law.holds && avoidsMaps s.carried e.law.holds\n        && !(s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains e.sk\n        && ps.all (fun e' => !occC e.sk e'.law.holds) && !occC e.sk s.f.m.pre && s.f.m.init.all (fun p => !occE e.sk p.2)\n        && skFresh s e.sk && key2Ok s ps e\n        && checkIn (sStartGoal s e) e.start\n        && checkIn (sStepGoal s ps e) e.step\n\ntheorem skFresh_parts {s : SMachine} {sk : Nat} (h : skFresh s sk = true) :\n    (∀ p ∈ s.f.flags, occC sk p.2 = false) ∧ (∀ q ∈ s.qflags, occC sk q.2.2 = false) ∧ occC sk s.f.m.assume = false\n      ∧ (∀ p ∈ s.f.m.step, occE sk p.2 = false) ∧ (∀ w ∈ s.f.m.writes, occE sk w.2.1 = false ∧ occE sk w.2.2 = false)\n      ∧ (∀ w ∈ s.every, occE sk w.2.2 = false ∧ w.2.1 ≠ sk) ∧ (∀ l ∈ s.facts, occC sk l.holds = false) := by\n  simp only [skFresh, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true', bne_iff_ne, ne_eq] at h\n  obtain ⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, _⟩ := h\n  exact ⟨h1, h2, h3, h4, h5, h6, h7⟩\n\ntheorem skFresh_pfacts {s : SMachine} {sk : Nat} (h : skFresh s sk = true) : ∀ f ∈ s.pfacts, occC sk f.1.holds = false := by\n  simp only [skFresh, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h; exact h.2\n\n/-! A variable no step reads or writes: setting it commutes with a step -/\n\ntheorem withInputs_upd {ins : List Nat} {x : Nat} (hx : x ∉ ins) (ρ ι : Nat → Nat) (v : Nat) :\n    withInputs ins (upd ρ x v) ι = upd (withInputs ins ρ ι) x v := by\n  funext i\n  simp only [withInputs, upd]\n  by_cases hi : i = x\n  · subst hi; simp [List.contains_iff_mem, hx]\n  · simp [hi]\n\ntheorem decideQ_upd {s : SMachine} {x : Nat} (hq : x ∉ s.qVars) (hb : ∀ q ∈ s.qflags, occC x q.2.2 = false)\n    (X : Nat → Nat) (N : Nat → Nat → Nat) (v : Nat) : decideQ s (upd X x v) N = upd (decideQ s X N) x v := by\n  funext u\n  by_cases hux : u = x\n  · subst hux\n    have hl : lookup (fun q => q.1 == u) s.qflags = none := lookup_none (fun q hq' => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hq (by rw [← he]; exact List.mem_map_of_mem hq'))\n    simp only [decideQ, hl, upd, ite_true]\n  · simp only [upd, hux, ite_false]\n    simp only [decideQ]\n    cases hl : lookup (fun q => q.1 == u) s.qflags with\n    | none => simp [upd, hux]\n    | some q =>\n      have hbq := hb q (lookup_some hl).1\n      have hiff : ∀ k, holdsC (atKeys (upd X x v) q.2.1 k) N q.2.2 ↔ holdsC (atKeys X q.2.1 k) N q.2.2 := fun k => by\n        rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys X q.2.1 k) N q.2.2 (fun i hi => by\n          have hix : i ≠ x := fun h => by rw [h, hbq] at hi; cases hi\n          simp only [atKeys]; split\n          · rfl\n          · simp [upd, hix])]\n      simp only [hiff]\n\ntheorem sView_upd {s : SMachine} {x : Nat} (hxi : x ∉ s.f.m.inputs) (hxq : x ∉ s.qVars) (hxf : x ∉ flagVars s.f.flags)\n    (hb : ∀ q ∈ s.qflags, occC x q.2.2 = false) (hfl : ∀ p ∈ s.f.flags, occC x p.2 = false)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) (v : Nat) :\n    sView s (upd ρ x v) M ι κ = (upd (sView s ρ M ι κ).1 x v, (sView s ρ M ι κ).2) := by\n  simp only [sView, withInputs_upd hxi, decideQ_upd hxq hb, decide_upd hxf hfl]\n\ntheorem sNext_upd {s : SMachine} {x : Nat} (hxi : x ∉ s.f.m.inputs) (hxq : x ∉ s.qVars) (hxf : x ∉ flagVars s.f.flags)\n    (hb : ∀ q ∈ s.qflags, occC x q.2.2 = false) (hfl : ∀ p ∈ s.f.flags, occC x p.2 = false)\n    (hxs : x ∉ s.f.m.step.map (·.1)) (hst : ∀ p ∈ s.f.m.step, occE x p.2 = false)\n    (hwr : ∀ w ∈ s.f.m.writes, occE x w.2.1 = false ∧ occE x w.2.2 = false) (hev : ∀ w ∈ s.every, occE x w.2.2 = false ∧ w.2.1 ≠ x)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) (v : Nat) :\n    sNext s (upd ρ x v) M ι κ = (upd (sNext s ρ M ι κ).1 x v, (sNext s ρ M ι κ).2) := by\n  simp only [sNext, sView_upd hxi hxq hxf hb hfl]\n  rw [applyS_upd hxs (by simpa [List.all_eq_true] using hst)]\n  congr 1\n  funext mp key\n  simp only [everyMaps]\n  cases he : lookup (fun w => w.1 == mp) s.every with\n  | some w =>\n    obtain ⟨hv, hk⟩ := hev w (lookup_some he).1\n    exact congrE _ _ _ _ (fun i hi => by\n      have hix : i ≠ x := fun h => by rw [h, hv] at hi; cases hi\n      simp only [upd]\n      by_cases h1 : i = w.2.1\n      · simp [h1]\n      · simp [h1, hix])\n  | none =>\n    simp only [writeMaps]\n    cases hw : lookup (fun w : Nat × E × E => w.1 == mp) s.f.m.writes with\n    | none => rfl\n    | some w =>\n      obtain ⟨h1, h2⟩ := hwr w (lookup_some hw).1\n      have e1 : evalE (upd (sView s ρ M ι κ).1 x v) (sView s ρ M ι κ).2 w.2.1 = evalE (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 w.2.1 :=\n        congrE _ _ _ _ (fun i hi => by have hix : i ≠ x := (fun h => by rw [h, h1] at hi; cases hi); simp [upd, hix])\n      have e2 : evalE (upd (sView s ρ M ι κ).1 x v) (sView s ρ M ι κ).2 w.2.2 = evalE (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 w.2.2 :=\n        congrE _ _ _ _ (fun i hi => by have hix : i ≠ x := (fun h => by rw [h, h2] at hi; cases hi); simp [upd, hix])\n      simp only [e1, e2]\n\ntheorem sTermsOk_parts {s : SMachine} {Z : List Nat} (h : sTermsOk s Z = true) :\n    (∀ p ∈ s.f.flags, avoids Z p.2 = true)\n      ∧ (∀ p ∈ s.f.m.step, avoidsE (Z ++ s.wVars) (inlineE s.f.flags p.2) = true)\n      ∧ (∀ w ∈ s.f.m.writes, (avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.1) = true ∧ avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true) ∧ w.1 ∉ s.carried)\n      ∧ (∀ w ∈ s.every, avoidsE (Z ++ s.wVars) (inlineE s.f.flags w.2.2) = true ∧ w.2.1 ∉ Z ∧ w.2.1 ∉ flagVars s.f.flags\n          ∧ (∀ p ∈ s.f.flags, occC w.2.1 p.2 = false) ∧ w.1 ∉ s.carried ∧ w.1 ∉ s.f.m.writes.map (·.1)) := by\n  simp only [sTermsOk, Bool.and_eq_true, List.all_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨hf, hst⟩, hwr⟩, hev⟩, _⟩, _⟩ := h\n  refine ⟨hf, hst, fun w hw => ⟨⟨(hwr w hw).1.1, (hwr w hw).1.2⟩, by simpa using (hwr w hw).2⟩, fun w hw => ?_⟩\n  obtain ⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩ := hev w hw\n  exact ⟨h1, by simpa using h2, by simpa using h3, fun p hp => by simpa using h4 p hp, by simpa using h5, by simpa using h6⟩\n\n-- The precondition holds in every reachable state: it reads the params alone.\ntheorem pre_sreach (s : SMachine) (hp : avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) s.f.m.pre = true)\n    (hr : readsC s.f.m.pre = false) : ∀ {ρ M}, SReach s ρ M → evalC ρ M s.f.m.pre = true := by\n  intro ρ M h\n  induction h with\n  | start ρ M _ h0 _ _ =>\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M)]; exact h0\n  | step ρ M ι κ _ _ ih =>\n    rw [noReadsC _ _ M s.f.m.pre hr]\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => by\n      simp only [sNext, sView]\n      rw [applyS_other (fun h => hi (by simp [h])), decide_other (fun h => hi (by simp [h]))]\n      simp only [decideQ]\n      rw [lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hi (by simp only [SMachine.extVars, SMachine.qVars, List.mem_append, List.mem_map]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inr ⟨q, hq, he⟩))))))]\n      exact withInputs_other (fun h => hi (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inl h)))))) ρ ι)]\n    exact ih\n\n-- The facts hold in every reachable state: a run starts where they hold, and no step moves what they read.\ntheorem facts_sreach (s : SMachine) (hf : factsOk s = true) : ∀ {ρ M}, SReach s ρ M → ∀ l ∈ s.facts, l.Holds ρ M := by\n  simp only [factsOk, Bool.and_eq_true] at hf\n  have hf := hf.1\n  simp only [factsOk1, List.all_eq_true, Bool.and_eq_true] at hf\n  intro ρ M h\n  induction h with\n  | start ρ M _ _ hfa _ =>\n    intro l hl\n    exact holds_transfer l (hf l hl).1 (MS := []) (by simp [avoidsMaps])\n      (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M) (fun _ _ => rfl) (hfa l hl)\n  | step ρ M ι κ _ _ ih =>\n    intro l hl\n    refine holds_transfer l (hf l hl).1 (hf l hl).2 (fun i hi => ?_) (fun mp hmp => ?_) (ih l hl)\n    · simp only [sNext, sView]\n      rw [applyS_other (fun h => hi (by simp [h])), decide_other (fun h => hi (by simp [h]))]\n      simp only [decideQ]\n      rw [lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hi (by simp only [SMachine.extVars, SMachine.qVars, List.mem_append, List.mem_map]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inr ⟨q, hq, he⟩))))))]\n      exact withInputs_other (fun h => hi (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inl h)))))) ρ ι\n    · simp only [List.mem_append, not_or] at hmp\n      obtain ⟨⟨hmc, hme⟩, hmw⟩ := hmp\n      funext key\n      simp only [sNext, sView, everyMaps]\n      rw [lookup_none (fun w hw => by simp only [beq_eq_false_iff_ne]; intro he; exact hme (by rw [← he]; exact List.mem_map_of_mem hw))]\n      simp only [writeMaps]\n      rw [lookup_none (fun w hw => by simp only [beq_eq_false_iff_ne]; intro he; exact hmw (by rw [← he]; exact List.mem_map_of_mem hw))]\n      simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]\n\ntheorem sTermsOk_facts {s : SMachine} {Z : List Nat} (h : sTermsOk s Z = true) : ∀ l ∈ s.facts, avoids Z l.holds = true := by\n  simp only [sTermsOk, Bool.and_eq_true, List.all_eq_true] at h; exact h.1.2\ntheorem sTermsOk_pfacts {s : SMachine} {Z : List Nat} (h : sTermsOk s Z = true) : ∀ f ∈ s.pfacts, avoids Z f.1.holds = true := by\n  simp only [sTermsOk, Bool.and_eq_true, List.all_eq_true] at h; exact h.2\n\n-- The facts hold wherever the variables and maps they may read are the state's: away from the request, the flags, the\n-- state and the zone Vx, and from the maps a step writes, a request carries and the zone Mx.\ntheorem facts_frame (s : SMachine) (hfok : factsOk s = true) (Vx Mx : List Nat)\n    (hvx : ∀ l ∈ s.facts, avoids Vx l.holds = true) (hmx : ∀ l ∈ s.facts, avoidsMaps Mx l.holds = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {X : Nat → Nat} {N : Nat → Nat → Nat}\n    (hX : ∀ i, i ∉ s.extVars → i ∉ Vx → X i = ρ i) (hN : ∀ mp, mp ∉ s.carried → mp ∉ Mx → N mp = M mp)\n    (hl : ∀ l ∈ s.facts, l.Holds ρ M) : ∀ l ∈ s.facts, l.Holds X N := by\n  simp only [factsOk, Bool.and_eq_true] at hfok\n  have hfok := hfok.1\n  simp only [factsOk1, List.all_eq_true, Bool.and_eq_true] at hfok\n  intro l hl'\n  refine holds_transfer (V := (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) ++ Vx)\n    (MS := (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) ++ Mx) l\n    (by simp only [avoids, List.all_append, Bool.and_eq_true] at hfok hvx ⊢; exact ⟨(hfok l hl').1, hvx l hl'⟩)\n    (by simp only [avoidsMaps, List.all_append, Bool.and_eq_true] at hfok hmx ⊢; exact ⟨(hfok l hl').2, hmx l hl'⟩)\n    (fun i hi => hX i (fun h => hi (by simp [h])) (fun h => hi (by simp [h])))\n    (fun mp hmp => hN mp (fun h => hmp (by simp [h])) (fun h => hmp (by simp [h]))) (hl l hl')\n\n-- Two environments that agree on what a law reads and at the skolem read its goal alike.\ntheorem goalOf_agree (l : MLaw) (sk : Nat) (N : Nat → Nat → Nat) {X X' : Nat → Nat} (hsk : X sk = X' sk)\n    (h : ∀ i, occC i l.holds = true → X i = X' i) : evalC X N (goalOf l sk) = evalC X' N (goalOf l sk) := by\n  unfold goalOf\n  split\n  · exact congrC _ _ N _ h\n  · rename_i kv _\n    rw [subst_evalC, subst_evalC, applyS_single, applyS_single]\n    exact congrC _ _ N _ (fun i hi => by\n      simp only [upd, evalE]; split\n      · exact hsk\n      · exact h i hi)\n\ntheorem sOk_of {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) : sOk s = true := by\n  simp only [checkSMachine, Bool.and_eq_true] at hl; exact hl.1.1.1.1.1\n\ntheorem spre_parts {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) :\n    avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) s.f.m.pre = true ∧ readsC s.f.m.pre = false := by\n  simp only [checkSMachine, Bool.and_eq_true] at hl; exact ⟨hl.1.1.1.1.2, by simpa using hl.1.1.1.2⟩\n\ntheorem sfacts_ok {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) : factsOk s = true := by\n  simp only [checkSMachine, Bool.and_eq_true] at hl; exact hl.1.2\n\ntheorem slaws_avoid {s : SMachine} {ps : List SEntry} (hl : checkSMachine s ps = true) :\n    ∀ l ∈ ps.map (·.law), avoids s.extVars l.holds = true ∧ avoidsMaps s.carried l.holds = true := by\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true'] at hl\n  intro l hl'\n  obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl'\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩ := hl.2 e' he'\n  refine ⟨?_, h2⟩\n  simp only [avoids, List.all_append, Bool.and_eq_true] at h1 ⊢; exact h1.1\n\n/-! Entries, read at states -/\n\ntheorem upd_self (ρ : Nat → Nat) (x : Nat) : upd ρ x (ρ x) = ρ := funext fun i => by simp only [upd]; split <;> simp_all\ntheorem upd_upd_same (ρ : Nat → Nat) (x u w : Nat) : upd (upd ρ x u) x w = upd ρ x w := funext fun i => by simp only [upd]; split <;> rfl\ntheorem upd_comm (ρ : Nat → Nat) {x y : Nat} (h : x ≠ y) (u w : Nat) : upd (upd ρ x u) y w = upd (upd ρ y w) x u := funext fun i => by\n  simp only [upd]; by_cases hy : i = y <;> by_cases hx : i = x <;> simp_all\n\n-- An entry holds exactly where its law holds at every state that agrees with the state but at the further keys.\ntheorem holdsOver_any {l : MLaw} {M : Nat → Nat → Nat} : ∀ (gs : List Nat) {Y : Nat → Nat}, holdsOver l M gs Y → ∀ Z, Agree gs Z Y → l.Holds Z M\n  | [], Y, h, Z, hag => by\n    have hZ : Z = Y := funext fun i => hag i (by simp)\n    subst hZ; exact h\n  | g :: gs, Y, h, Z, hag => holdsOver_any gs (h (Z g)) Z (fun i hi => by\n      simp only [upd]; split\n      · rename_i hig; subst hig; rfl\n      · rename_i hig; exact hag i (by simp only [List.mem_cons, not_or]; exact ⟨hig, hi⟩))\n\ntheorem holdsOver_of_any {l : MLaw} {M : Nat → Nat → Nat} : ∀ (gs : List Nat) {Y : Nat → Nat}, (∀ Z, Agree gs Z Y → l.Holds Z M) → holdsOver l M gs Y\n  | [], Y, h => h Y (fun _ _ => rfl)\n  | g :: gs, Y, h => by\n    intro w\n    exact holdsOver_of_any gs (fun Z hag => h Z (fun i hi => by\n      simp only [List.mem_cons, not_or] at hi\n      rw [hag i hi.2]; simp only [upd, if_neg hi.1]))\n\ntheorem SEntry.holds_law {e : SEntry} {ρ : Nat → Nat} {M : Nat → Nat → Nat} (h : e.Holds ρ M) : e.law.Holds ρ M :=\n  holdsOver_any e.keys2 h ρ (fun _ _ => rfl)\n\n-- An entry read where its law reads alike holds alike (at every value of its further keys).\ntheorem sentry_transfer {V MS : List Nat} {e : SEntry} (hv : avoids V e.law.holds = true) (hm : avoidsMaps MS e.law.holds = true)\n    {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat} (hag : Agree V ρ ρ') (hmag : ∀ mp, mp ∉ MS → M mp = M' mp) : e.Holds ρ' M' → e.Holds ρ M := by\n  intro h\n  apply holdsOver_of_any\n  intro Z hZ\n  have h' := holdsOver_any e.keys2 h (fun i => if i ∈ e.keys2 then Z i else ρ' i) (fun i hi => by simp [hi])\n  exact holds_transfer e.law hv hm (fun i hiV => by\n    by_cases hk : i ∈ e.keys2\n    · simp [hk]\n    · simp only [hk, if_false]; rw [hZ i hk]; exact hag i hiV) hmag h'\n\n-- Setting a variable the law reads nowhere, or one of its further keys, keeps the entry.\ntheorem sentry_upd {e : SEntry} {x : Nat} (hx : occC x e.law.holds = false ∨ x ∈ e.keys2) {ρ : Nat → Nat} {M : Nat → Nat → Nat} (u : Nat) :\n    e.Holds ρ M → e.Holds (upd ρ x u) M := by\n  intro h\n  apply holdsOver_of_any\n  intro Z hZ\n  rcases hx with hx | hx\n  · have h' := holdsOver_any e.keys2 h (upd Z x (ρ x)) (fun i hi => by\n      simp only [upd]; split\n      · rename_i hix; subst hix; rfl\n      · rename_i hix; rw [hZ i hi]; simp only [upd, if_neg hix])\n    exact holds_transfer (V := [x]) (MS := []) e.law (by simp [avoids, hx]) (by simp [avoidsMaps])\n      (fun i hi => by simp only [upd]; rw [if_neg (by simpa using hi)]) (fun _ _ => rfl) h'\n  · exact holdsOver_any e.keys2 h Z (fun i hi => by\n      rw [hZ i hi]; simp only [upd]; rw [if_neg (fun h' => hi (by rw [h']; exact hx))])\n\n-- Each tuple's law holds wherever every entry does (the law's own key none of its further keys).\ntheorem pairLaws_hold (ps : List SEntry) (pinsts : List (Nat × E × List E)) (hkk : ∀ e ∈ ps, ∀ k, e.law.key = some k → k ∉ e.keys2)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (hall : ∀ e ∈ ps, e.Holds Y N) : ∀ l ∈ pairLaws ps pinsts, l.Holds Y N := by\n  have htrue : (⟨trueC, none⟩ : MLaw).Holds Y N := by simp [MLaw.Holds, trueC, evalC, evalE]\n  intro l hl\n  simp only [pairLaws, List.mem_map] at hl\n  obtain ⟨p, _, rfl⟩ := hl\n  split\n  · rename_i e he\n    have hem : e ∈ ps := List.mem_of_getElem? he\n    have hany := holdsOver_any e.keys2 (hall e hem)\n    have hdom : ∀ i, i ∉ e.keys2 → i ∉ (e.keys2.zip p.2.2).map (·.1) := fun i hi hm => by\n      obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hm; exact hi (List.of_mem_zip hq).1\n    cases hk : e.law.key with\n    | none =>\n      have h' := hany (applyS (e.keys2.zip p.2.2) Y N) (fun i hi => applyS_other (hdom i hi) Y N)\n      simp only [MLaw.Holds, hk] at h' ⊢\n      rw [subst_evalC]; exact h'\n    | some k =>\n      have hkg := hkk e hem k hk\n      simp only [MLaw.Holds, hk]\n      intro v\n      rw [subst_evalC]\n      have h' := hany (fun i => if i ∈ e.keys2 then applyS (e.keys2.zip p.2.2) (upd Y k v) N i else Y i) (fun i hi => by simp [hi])\n      simp only [MLaw.Holds, hk] at h'\n      have hZ : upd (fun i => if i ∈ e.keys2 then applyS (e.keys2.zip p.2.2) (upd Y k v) N i else Y i) k v = applyS (e.keys2.zip p.2.2) (upd Y k v) N := by\n        funext i\n        by_cases hik : i = k\n        · subst hik; simp only [upd, if_true]; rw [applyS_other (hdom i hkg)]; simp [upd]\n        · simp only [upd, if_neg hik]\n          by_cases hi : i ∈ e.keys2\n          · simp [hi]\n          · simp only [hi, if_false]; rw [applyS_other (hdom i hi)]; simp [upd, hik]\n      rw [← hZ]; exact h' v\n  · exact htrue\n\n/-! Facts about several keys -/\n\n-- A law at every value of some keys, read where it reads alike, holds alike.\ntheorem holdsOver_transfer {V MS : List Nat} (l : MLaw) (hv : avoids V l.holds = true) (hm : avoidsMaps MS l.holds = true) :\n    ∀ (gs : List Nat) {ρ ρ' : Nat → Nat} {M M' : Nat → Nat → Nat}, Agree V ρ ρ' → (∀ mp, mp ∉ MS → M mp = M' mp) →\n      holdsOver l M' gs ρ' → holdsOver l M gs ρ\n  | [], _, _, _, _, hag, hmag, h => holds_transfer l hv hm hag hmag h\n  | g :: gs, ρ, ρ', _, _, hag, hmag, h => fun w =>\n      holdsOver_transfer l hv hm gs (ρ := upd ρ g w) (ρ' := upd ρ' g w) (fun i hi => by\n        simp only [upd]; split\n        · rfl\n        · exact hag i hi) hmag (h w)\n\n-- A law at every value of its further keys holds with each set to a term (the law about its first key, at the tuple).\ntheorem holdsOver_subst (l : MLaw) (gs : List Nat) (ts : List E) (hkk : ∀ k, l.key = some k → k ∉ gs)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (h : holdsOver l N gs Y) : (⟨substC (gs.zip ts) l.holds, l.key⟩ : MLaw).Holds Y N := by\n  have hany := holdsOver_any gs h\n  have hdom : ∀ i, i ∉ gs → i ∉ (gs.zip ts).map (·.1) := fun i hi hm => by\n    obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hm; exact hi (List.of_mem_zip hq).1\n  cases hk : l.key with\n  | none =>\n    have h' := hany (applyS (gs.zip ts) Y N) (fun i hi => applyS_other (hdom i hi) Y N)\n    simp only [MLaw.Holds, hk] at h' ⊢\n    rw [subst_evalC]; exact h'\n  | some k =>\n    have hkg := hkk k hk\n    simp only [MLaw.Holds, hk]\n    intro v\n    rw [subst_evalC]\n    have h' := hany (fun i => if i ∈ gs then applyS (gs.zip ts) (upd Y k v) N i else Y i) (fun i hi => by simp [hi])\n    simp only [MLaw.Holds, hk] at h'\n    have hZ : upd (fun i => if i ∈ gs then applyS (gs.zip ts) (upd Y k v) N i else Y i) k v = applyS (gs.zip ts) (upd Y k v) N := by\n      funext i\n      by_cases hik : i = k\n      · subst hik; simp only [upd, if_true]; rw [applyS_other (hdom i hkg)]; simp [upd]\n      · simp only [upd, if_neg hik]\n        by_cases hi : i ∈ gs\n        · simp [hi]\n        · simp only [hi, if_false]; rw [applyS_other (hdom i hi)]; simp [upd, hik]\n    rw [← hZ]; exact h' v\n\ntheorem pfactsOk_parts {s : SMachine} (h : factsOk s = true) : ∀ f ∈ s.pfacts,\n    avoids (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) f.1.holds = true\n      ∧ avoidsMaps (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) f.1.holds = true ∧ ∀ k, f.1.key = some k → k ∉ f.2 := by\n  simp only [factsOk, pfactsOk, Bool.and_eq_true, List.all_eq_true, bne_iff_ne, ne_eq] at h\n  intro f hf\n  obtain ⟨⟨h1, h2⟩, h3⟩ := h.2 f hf\n  exact ⟨h1, h2, fun k hk hm => h3 k hm (by rw [hk])⟩\n\n-- The facts about several keys at the tuples a goal names hold wherever the facts do.\ntheorem pfactLaws_hold (s : SMachine) (pfinsts : List (Nat × E × List E)) (hkk : ∀ f ∈ s.pfacts, ∀ k, f.1.key = some k → k ∉ f.2)\n    {Y : Nat → Nat} {N : Nat → Nat → Nat} (hp : s.PFacts Y N) : ∀ l ∈ pfinsts.map (pfactLaw s), l.Holds Y N := by\n  intro l hl\n  obtain ⟨p, _, rfl⟩ := List.mem_map.mp hl\n  unfold pfactLaw\n  split\n  · rename_i f hf\n    have hfm : f ∈ s.pfacts := List.mem_of_getElem? hf\n    exact holdsOver_subst f.1 f.2 p.2.2 (hkk f hfm) (hp f hfm)\n  · simp [MLaw.Holds, trueC, evalC, evalE]\n\n-- A goal's facts all hold where the facts and the facts about several keys do.\ntheorem facthyps_true (s : SMachine) (finsts : List (Nat × E)) (pfinsts : List (Nat × E × List E)) (Y : Nat → Nat) (N : Nat → Nat → Nat)\n    (hkk : ∀ f ∈ s.pfacts, ∀ k, f.1.key = some k → k ∉ f.2) (hf : ∀ l ∈ s.facts, l.Holds Y N) (hp : s.PFacts Y N) :\n    ∀ c ∈ factHyps s finsts pfinsts, evalC Y N c = true := by\n  intro c hc\n  simp only [factHyps] at hc\n  rcases List.mem_append.mp hc with hc | hc\n  · exact laws_hyps_true s.facts finsts Y N hf c hc\n  · exact laws_hyps_true (pfinsts.map (pfactLaw s)) (pairInsts 0 pfinsts) Y N (pfactLaws_hold s pfinsts hkk hp) c (List.mem_append_right _ hc)\n\n-- The facts about several keys hold in every reachable state, and wherever what they read is the state's.\ntheorem pfacts_sreach (s : SMachine) (hf : factsOk s = true) : ∀ {ρ M}, SReach s ρ M → s.PFacts ρ M := by\n  have hf := pfactsOk_parts hf\n  intro ρ M h\n  induction h with\n  | start ρ M _ _ _ hpf =>\n    intro f hfm\n    exact holdsOver_transfer f.1 (hf f hfm).1 (MS := []) (by simp [avoidsMaps]) f.2\n      (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M) (fun _ _ => rfl) (hpf f hfm)\n  | step ρ M ι κ _ _ ih =>\n    intro f hfm\n    refine holdsOver_transfer f.1 (hf f hfm).1 (hf f hfm).2.1 f.2 (fun i hi => ?_) (fun mp hmp => ?_) (ih f hfm)\n    · simp only [sNext, sView]\n      rw [applyS_other (fun h => hi (by simp [h])), decide_other (fun h => hi (by simp [h]))]\n      simp only [decideQ]\n      rw [lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he\n        exact hi (by simp only [SMachine.extVars, SMachine.qVars, List.mem_append, List.mem_map]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inr ⟨q, hq, he⟩))))))]\n      exact withInputs_other (fun h => hi (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl (Or.inl (Or.inl (Or.inl h)))))) ρ ι\n    · simp only [List.mem_append, not_or] at hmp\n      obtain ⟨⟨hmc, hme⟩, hmw⟩ := hmp\n      funext key\n      simp only [sNext, sView, everyMaps]\n      rw [lookup_none (fun w hw => by simp only [beq_eq_false_iff_ne]; intro he; exact hme (by rw [← he]; exact List.mem_map_of_mem hw))]\n      simp only [writeMaps]\n      rw [lookup_none (fun w hw => by simp only [beq_eq_false_iff_ne]; intro he; exact hmw (by rw [← he]; exact List.mem_map_of_mem hw))]\n      simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]\n\ntheorem pfacts_frame (s : SMachine) (hfok : factsOk s = true) (Vx Mx : List Nat)\n    (hvx : ∀ f ∈ s.pfacts, avoids Vx f.1.holds = true) (hmx : ∀ f ∈ s.pfacts, avoidsMaps Mx f.1.holds = true)\n    {ρ : Nat → Nat} {M : Nat → Nat → Nat} {X : Nat → Nat} {N : Nat → Nat → Nat}\n    (hX : ∀ i, i ∉ s.extVars → i ∉ Vx → X i = ρ i) (hN : ∀ mp, mp ∉ s.carried → mp ∉ Mx → N mp = M mp)\n    (hl : s.PFacts ρ M) : s.PFacts X N := by\n  have hp := pfactsOk_parts hfok\n  intro f hf'\n  refine holdsOver_transfer (V := (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)) ++ Vx)\n    (MS := (s.carried ++ s.every.map (·.1) ++ s.f.m.writes.map (·.1)) ++ Mx) f.1\n    (by have h1 := (hp f hf').1; simp only [avoids, List.all_append, Bool.and_eq_true] at hvx h1 ⊢; exact ⟨h1, hvx f hf'⟩)\n    (by have h2 := (hp f hf').2.1; simp only [avoidsMaps, List.all_append, Bool.and_eq_true] at hmx h2 ⊢; exact ⟨h2, hmx f hf'⟩) f.2\n    (fun i hi => hX i (fun h => hi (by simp [h])) (fun h => hi (by simp [h])))\n    (fun mp hmp => hN mp (fun h => hmp (by simp [h])) (fun h => hmp (by simp [h]))) (hl f hf')\n\n-- A variable fresh as a skolem: setting it commutes with a step's view and with the step.\ntheorem fresh_parts {s : SMachine} {x : Nat} (hf : skFresh s x = true)\n    (hc : (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains x = false) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) (v : Nat) :\n    sNext s (upd ρ x v) M ι κ = (upd (sNext s ρ M ι κ).1 x v, (sNext s ρ M ι κ).2)\n      ∧ sView s (upd ρ x v) M ι κ = (upd (sView s ρ M ι κ).1 x v, (sView s ρ M ι κ).2)\n      ∧ x ∉ s.f.m.init.map (·.1) := by\n  obtain ⟨hf1, hf2, _, hf4, hf5, hf6, _⟩ := skFresh_parts hf\n  have hnot : x ∉ s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1) := fun hm => by\n    rw [List.contains_iff_mem.mpr hm] at hc; cases hc\n  have hE : x ∉ s.extVars := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ hm)))\n  have hF : x ∉ flagVars s.f.flags := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_right _ hm)))\n  have hS : x ∉ s.f.m.step.map (·.1) := fun hm => hnot (List.mem_append_right _ hm)\n  have hI : x ∉ s.f.m.init.map (·.1) := fun hm => hnot (List.mem_append_left _ (List.mem_append_right _ hm))\n  have hi : x ∉ s.f.m.inputs := fun hm => hE (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inl hm))\n  have hq : x ∉ s.qVars := fun hm => hE (by simp only [SMachine.extVars, List.mem_append]; exact Or.inl (Or.inr hm))\n  exact ⟨sNext_upd hi hq hF hf2 hf1 hS hf4 hf5 hf6 ρ M ι κ v, sView_upd hi hq hF hf2 hf1 ρ M ι κ v, hI⟩\n\ntheorem skey2_parts {s : SMachine} {ps : List SEntry} (h : checkSMachine s ps = true) {e : SEntry} (he : e ∈ ps) {g : Nat} (hg : g ∈ e.keys2) :\n    skFresh s g = true ∧ (s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1)).contains g = false\n      ∧ occC g s.f.m.pre = false ∧ (∀ p ∈ s.f.m.init, occE g p.2 = false) ∧ (∀ e' ∈ ps, occC g e'.law.holds = false ∨ g ∈ e'.keys2)\n      ∧ e.law.key ≠ some g := by\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true] at h\n  have hk := (h.2 e he).1.1.2\n  simp only [key2Ok, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true', bne_iff_ne, ne_eq, Bool.or_eq_true, List.contains_iff_mem] at hk\n  obtain ⟨⟨⟨⟨⟨hkey, hf⟩, hc⟩, hp⟩, hi⟩, hall⟩ := hk g hg\n  exact ⟨hf, hc, hp, hi, fun e' he' => (by have := (hall e' he').1; simpa using this), hkey⟩\n\ntheorem skeys_apart {s : SMachine} {ps : List SEntry} (h : checkSMachine s ps = true) : ∀ e ∈ ps, ∀ k, e.law.key = some k → k ∉ e.keys2 :=\n  fun e he k hk hg => (skey2_parts h he hg).2.2.2.2.2 hk\n\n/-- The start: at params that meet the precondition and the facts, with maps as declared, every law holds. -/\ntheorem sstart_case (s : SMachine) (ps : List SEntry) (h : checkSMachine s ps = true) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (hM : StartMaps s.f.m M) (h0 : evalC ρ M s.f.m.pre = true) (hfa : ∀ l ∈ s.facts, l.Holds ρ M) (hpf : s.PFacts ρ M) :\n    ∀ e ∈ ps, e.law.Holds (applyS s.f.m.init ρ M) M := by\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨_, _⟩, _⟩, _⟩, hfok⟩, h⟩ := h\n  intro e he\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨_, _⟩, hfresh⟩, hslaw⟩, hspre⟩, hsinit⟩, hskf⟩, _⟩, hst⟩, _⟩ := h e he\n  refine goalOf_holds e.law (hslaw e he) _ M (fun v => ?_)\n  apply Decidable.byContradiction; intro hn\n  apply sound_in _ _ hst (upd ρ e.sk v) M\n  intro c hc\n  simp only [sStartGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n  rcases hc with (rfl | hc) | rfl\n  · rw [congrC _ ρ M s.f.m.pre (fun i hi => by\n      simp only [upd]; split\n      · rename_i hik; subst hik; simp [hspre] at hi\n      · rfl)]\n    exact h0\n  · -- The facts hold at the start, and read not the skolem.\n    exact facthyps_true s e.finsts e.pfinsts _ M (fun f hf => (pfactsOk_parts hfok f hf).2.2)\n      (facts_frame s hfok [e.sk] [] (fun l hl => by simp [avoids, (skFresh_parts hskf).2.2.2.2.2.2 l hl])\n        (fun _ _ => by simp [avoidsMaps]) (fun i _ hik => by simp only [upd]; rw [if_neg (by simpa using hik)]) (fun _ _ _ => rfl) hfa)\n      (pfacts_frame s hfok [e.sk] [] (fun f hf => by simp [avoids, skFresh_pfacts hskf f hf])\n        (fun _ _ => by simp [avoidsMaps]) (fun i _ hik => by simp only [upd]; rw [if_neg (by simpa using hik)]) (fun _ _ _ => rfl) hpf) c hc\n  · have hrd : ∀ mp k, evalE (upd ρ e.sk v) M (rdStart s.f.m mp k) = M mp (evalE (upd ρ e.sk v) M k) := by\n      intro mp k\n      simp only [rdStart]\n      split\n      · rename_i p hp\n        have ⟨hm, hq⟩ := lookup_some hp\n        simp only [beq_iff_eq] at hq\n        simp only [evalE]; rw [← hq, hM p hm]\n      · rfl\n    simp only [evalC, substR_evalC _ _ _ M M hrd]\n    rw [applyS_upd (fun h => by simp [h] at hfresh) (by simpa [List.all_eq_true] using hsinit)]\n    simpa using hn\n\n/-- One step: from a state where the precondition, the facts and every entry hold, a request allowed keeps each law. -/\ntheorem sstep_case (s : SMachine) (ps : List SEntry) (h : checkSMachine s ps = true) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) (hp0 : evalC ρ M s.f.m.pre = true) (hfa : ∀ l ∈ s.facts, l.Holds ρ M) (hpf : s.PFacts ρ M)\n    (ih : ∀ e ∈ ps, e.Holds ρ M) (ha : evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true) :\n    ∀ e ∈ ps, e.law.Holds (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 := by\n  have hlav := slaws_avoid h\n  have hkk := skeys_apart h\n  simp only [checkSMachine, List.all_eq_true, Bool.and_eq_true, Bool.not_eq_true'] at h\n  obtain ⟨⟨⟨⟨⟨hs, hpre⟩, hrp⟩, hterms⟩, hfok⟩, h⟩ := h\n  obtain ⟨hfav, hstp, hwr, hev⟩ := sTermsOk_parts hterms\n  intro e he\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨hlx, hlm⟩, hfresh⟩, hslaw⟩, hspre⟩, _⟩, hskf⟩, _⟩, _⟩, hst⟩ := h e he\n  obtain ⟨hf1, hf2, hf3, hf4, hf5, hf6, hf7⟩ := skFresh_parts hskf\n  have hnot : e.sk ∉ s.extVars ++ flagVars s.f.flags ++ s.f.m.init.map (·.1) ++ s.f.m.step.map (·.1) := fun hm => by\n    rw [List.contains_iff_mem.mpr hm] at hfresh; cases hfresh\n  have hskE : e.sk ∉ s.extVars := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ hm)))\n  have hskF : e.sk ∉ flagVars s.f.flags := fun hm => hnot (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_right _ hm)))\n  -- The law at the next state with the carried maps in place reads as at the next state: it reads none of them.\n  refine holds_transfer (V := []) (MS := s.carried) (ρ' := (sNext s ρ M ι κ).1) (M' := withCarried s (sNext s ρ M ι κ).2 κ) e.law (by simp [avoids]) hlm (fun i _ => rfl)\n    (fun mp hmp => by simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]) ?_\n  refine goalOf_holds e.law (hslaw e he) _ _ (fun v => ?_)\n  apply Decidable.byContradiction; intro hn\n  -- The frame runs from the state with the skolem set to v: the machine reads it nowhere, so the step is the same.\n  obtain ⟨hNext, hView, _⟩ := fresh_parts hskf (by simpa [List.contains_iff_mem] using hnot) ρ M ι κ v\n  let W := withExt s (upd ρ e.sk v) (sReq s (upd ρ e.sk v) M ι κ)\n  let M0 := withCarried s M κ\n  have hH : ∀ Z, SHead s Z [] W M0 [] getRd (upd ρ e.sk v) M [] [] ι κ := fun Z => by\n    refine ⟨fun i _ => ?_, fun mp k _ => ?_⟩\n    · show applyS (frameSub [] []) W M0 i = W i\n      simp only [frameSub, List.map_nil, List.append_nil, applyS_nil']\n    · simp [frameRd, getRd, lookup, evalE, M0]\n  have hD : SDenotes s (flagVars s.f.flags) [] W M0 [] getRd (upd ρ e.sk v) M := by\n    refine ⟨fun i hie _ => ?_, fun mp k hmp _ => ?_⟩\n    · rw [applyS_nil']; simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)]\n    · simp only [getRd, evalE, M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]\n  have hD' := sstep_denotes s (flagVars s.f.flags) [] W M0 hs (fun v hv => hv) hfav [] [] ι κ hD (hH _) (fun p hp => by simp at hp)\n    hstp (fun w hw => (hwr w hw).1) hev (fun _ _ => by simp [avoidsMapsE]) (fun _ _ => by simp [avoidsMapsE]) (fun _ _ => by simp [avoidsMapsE])\n  apply sound_in _ _ hst W M0\n  intro c hc\n  simp only [sStepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false, List.mem_map] at hc\n  rcases hc with ((rfl | hc) | ⟨c', hc', rfl⟩) | rfl\n  · -- The precondition: it reads no map, no request and not the skolem.\n    rw [noReadsC W M0 M s.f.m.pre hrp, congrC W ρ M s.f.m.pre (fun i hi => ?_)]\n    · exact hp0\n    · have hi1 := avoids_occ hpre hi\n      have hik : i ≠ e.sk := fun h' => by rw [h'] at hi; simp [hspre] at hi\n      simp only [W, withExt]\n      rw [if_neg (fun h' => hi1 (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ (List.contains_iff_mem.mp h')))))]\n      simp only [upd, if_neg hik]\n  · -- The facts: they read no request, not the skolem, and no map a request carries.\n    exact facthyps_true s e.finsts e.pfinsts W M0 (fun f hf => (pfactsOk_parts hfok f hf).2.2)\n      (facts_frame s hfok [e.sk] [] (fun l hl => by simp [avoids, hf7 l hl])\n        (fun _ _ => by simp [avoidsMaps])\n        (fun i hie hik => by simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)]; simp only [upd]; rw [if_neg (by simpa using hik)])\n        (fun mp hmc _ => by simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]) hfa)\n      (pfacts_frame s hfok [e.sk] [] (fun f hf => by simp [avoids, skFresh_pfacts hskf f hf])\n        (fun _ _ => by simp [avoidsMaps])\n        (fun i hie hik => by simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)]; simp only [upd]; rw [if_neg (by simpa using hik)])\n        (fun mp hmc _ => by simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]) hpf) c hc\n  · -- The entries hold at the state with the skolem set (their laws don't read it), so in the goal's view of it, and so\n    -- does each pair's law; the assumption reads the skolem nowhere either.\n    have hA : evalC (sView s (upd ρ e.sk v) M ι κ).1 (sView s (upd ρ e.sk v) M ι κ).2 s.f.m.assume = true := by\n      rw [hView]; dsimp only\n      rw [congrC _ (sView s ρ M ι κ).1 _ _ (fun i hi => by\n        have hik : i ≠ e.sk := fun h' => by rw [h', hf3] at hi; cases hi\n        simp only [upd, if_neg hik])]\n      exact ha\n    have hallY : ∀ e' ∈ ps, e'.Holds W M0 := fun e' he' =>\n      sentry_transfer (hlav e'.law (List.mem_map_of_mem he')).1 (hlav e'.law (List.mem_map_of_mem he')).2\n        (fun i hi => by simp only [W, withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hi)])\n        (fun mp hmp => by simp only [M0, withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)])\n        (sentry_upd (Or.inl (hslaw e' he')) v (ih e' he'))\n    exact sframe_hyps s [] [] W M0 hs (sLaws ps e.pinsts) (sInsts ps e.insts e.pinsts) e.qinsts\n      (fun l hl => by\n        rcases List.mem_append.mp hl with hl | hl\n        · obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl; exact SEntry.holds_law (hallY e' he')\n        · exact pairLaws_hold ps e.pinsts hkk hallY l hl)\n      (hH []) (fun _ _ => by simp [avoids]) (fun _ _ => by simp [avoids]) (fun _ _ => by simp [avoidsMaps]) hA (by simp [trueC, evalC, evalE]) c' hc'\n  · -- The goal, read across the step: the maps a request carries read as carried, the rest as the step leaves them.\n    have hrd' : ∀ mp k, evalE W M0 (stepRdS s (frameSub [] []) (frameRd [] getRd) mp k) = withCarried s (sNext s ρ M ι κ).2 κ mp (evalE W M0 k) := by\n      intro mp k\n      by_cases hmp : mp ∈ s.carried\n      · have hne : lookup (fun w => w.1 == mp) s.every = none := lookup_none (fun w hw => by\n          simp only [beq_eq_false_iff_ne]; intro h'; exact (hev w hw).2.2.2.2.1 (by rw [h']; exact hmp))\n        have hnw : lookup (fun w : Nat × E × E => w.1 == mp) s.f.m.writes = none := lookup_none (fun w hw => by\n          simp only [beq_eq_false_iff_ne]; intro h'; exact (hwr w hw).2 (by rw [h']; exact hmp))\n        simp only [stepRdS, hne, stepRd, hnw]\n        simp [frameRd, getRd, lookup, evalE, M0, withCarried, hmp]\n      · rw [hD'.2 mp k hmp (by simp), hNext]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)]\n    simp only [evalC]\n    rw [substR_evalC _ _ W M0 _ hrd', goalOf_agree e.law e.sk _ (X' := upd (sNext s ρ M ι κ).1 e.sk v)\n      (by rw [hD'.1 e.sk hskE hskF, hNext]) (fun i hi => ?_)]\n    · simpa using hn\n    · have hi1 := avoids_occ hlx hi\n      rw [hD'.1 i (fun h' => hi1 (List.mem_append_left _ h')) (fun h' => hi1 (List.mem_append_right _ h')), hNext]\n\n/-- The induction rule with sets: for params that meet the precondition, maps that start as declared and functions that\nmeet the facts, every entry of an accepted proof holds in every reachable state (a law about several keys at every value\nof its further keys), whatever maps each request carries. -/\ntheorem smachine_sound (s : SMachine) (ps : List SEntry) (h : checkSMachine s ps = true) :\n    ∀ ρ M, SReach s ρ M → ∀ e ∈ ps, e.Holds ρ M := by\n  have hpre := spre_parts h\n  have hfok := sfacts_ok h\n  -- Facts at a state hold with a further key set: they read no further key.\n  have hfacts : ∀ {ρ : Nat → Nat} {M : Nat → Nat → Nat} {g : Nat}, skFresh s g = true → (∀ l ∈ s.facts, l.Holds ρ M) → ∀ w, ∀ l ∈ s.facts, l.Holds (upd ρ g w) M := by\n    intro ρ M g hf hfa w\n    exact facts_frame s hfok [g] [] (fun l hl => by simp [avoids, (skFresh_parts hf).2.2.2.2.2.2 l hl]) (fun _ _ => by simp [avoidsMaps])\n      (fun i _ hig' => by simp only [upd]; rw [if_neg (by simpa using hig')]) (fun _ _ _ => rfl) hfa\n  have hpfacts : ∀ {ρ : Nat → Nat} {M : Nat → Nat → Nat} {g : Nat}, skFresh s g = true → s.PFacts ρ M → ∀ w, s.PFacts (upd ρ g w) M := by\n    intro ρ M g hf hpf w\n    exact pfacts_frame s hfok [g] [] (fun f hfm => by simp [avoids, skFresh_pfacts hf f hfm]) (fun _ _ => by simp [avoidsMaps])\n      (fun i _ hig' => by simp only [upd]; rw [if_neg (by simpa using hig')]) (fun _ _ _ => rfl) hpf\n  have hpreu : ∀ {ρ : Nat → Nat} {M : Nat → Nat → Nat} {g : Nat}, occC g s.f.m.pre = false → evalC ρ M s.f.m.pre = true → ∀ w, evalC (upd ρ g w) M s.f.m.pre = true := by\n    intro ρ M g hpg h0 w\n    rw [congrC _ ρ M s.f.m.pre (fun i hi => by have hig' : i ≠ g := (fun h' => by rw [h', hpg] at hi; cases hi); simp only [upd, if_neg hig'])]; exact h0\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 hfa hpf =>\n    intro e he\n    -- Each further key set in turn, from a start state that meets the precondition and the facts.\n    suffices hs : ∀ gs : List Nat, (∀ g ∈ gs, g ∈ e.keys2) → ∀ ρ', evalC ρ' M s.f.m.pre = true → (∀ l ∈ s.facts, l.Holds ρ' M) →\n        s.PFacts ρ' M → holdsOver e.law M gs (applyS s.f.m.init ρ' M) from hs e.keys2 (fun g hg => hg) ρ h0 hfa hpf\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf hq; exact sstart_case s ps h ρ' M hM hp hf hq e he\n    | cons g gs ih =>\n      intro hsub ρ' hp hf hq w\n      obtain ⟨hfr, hc, hpg, hig, _, _⟩ := skey2_parts h he (hsub g List.mem_cons_self)\n      have hI := (fresh_parts hfr hc ρ' M (fun _ => 0) (fun _ _ => 0) 0).2.2\n      rw [← applyS_upd hI (by simpa [List.all_eq_true] using hig)]\n      exact ih (fun g' hg' => hsub g' (List.mem_cons_of_mem _ hg')) (upd ρ' g w) (hpreu hpg hp w) (hfacts hfr hf w) (hpfacts hfr hq w)\n  | step ρ M ι κ hr ha ih =>\n    intro e he\n    suffices hs : ∀ gs : List Nat, (∀ g ∈ gs, g ∈ e.keys2) → ∀ ρ', evalC ρ' M s.f.m.pre = true → (∀ l ∈ s.facts, l.Holds ρ' M) →\n        s.PFacts ρ' M → (∀ e' ∈ ps, e'.Holds ρ' M) → evalC (sView s ρ' M ι κ).1 (sView s ρ' M ι κ).2 s.f.m.assume = true →\n        holdsOver e.law (sNext s ρ' M ι κ).2 gs (sNext s ρ' M ι κ).1 from\n      hs e.keys2 (fun g hg => hg) ρ (pre_sreach s hpre.1 hpre.2 hr) (facts_sreach s hfok hr) (pfacts_sreach s hfok hr) ih ha\n    intro gs\n    induction gs with\n    | nil => intro _ ρ' hp hf hq hi ha'; exact sstep_case s ps h ρ' M ι κ hp hf hq hi ha' e he\n    | cons g gs ihg =>\n      intro hsub ρ' hp hf hq hi ha' w\n      obtain ⟨hfr, hc, hpg, _, hall, _⟩ := skey2_parts h he (hsub g List.mem_cons_self)\n      obtain ⟨hNext, hView, _⟩ := fresh_parts hfr hc ρ' M ι κ w\n      have := ihg (fun g' hg' => hsub g' (List.mem_cons_of_mem _ hg')) (upd ρ' g w) (hpreu hpg hp w) (hfacts hfr hf w) (hpfacts hfr hq w)\n        (fun e' he' => sentry_upd (hall e' he') w (hi e' he'))\n        (by\n          rw [hView]; dsimp only\n          rw [congrC _ (sView s ρ' M ι κ).1 _ _ (fun i hi => by\n            have hig' : i ≠ g := fun h' => by rw [h', (skFresh_parts hfr).2.2.1] at hi; cases hi\n            simp only [upd, if_neg hig'])]\n          exact ha')\n      rw [hNext] at this; exact this\n\n/-! k-step laws over sets -/\n\nstructure SKStep where\n  k : KStep                        -- whens (flags inlined), then, ren (each later step: every extended request variable), primes, insts, proof\n  mren : List (List (Nat × Nat))   -- per step: (carried map, the name the goal reads it by there); [] for the first step\n  qinsts : List (Nat × List E)     -- (quantified flag, keys): where each frame closes it\n  finsts : List (Nat × E)          -- (fact index, key): where the goal assumes the facts, read at the first frame\n  pinsts : List (Nat × E × List E) -- (law index, key, further keys): where each frame assumes the laws about several keys\n  pfinsts : List (Nat × E × List E) -- (fact index, key, further keys): where the goal assumes the facts about several keys\n  used : List C                    -- the hypotheses the tree refutes ([] for the goal's own, in its order)\n  names : List (List (Nat × Nat))  -- per step but the last: (state variable, the fresh variable naming it after that step)\n\ndef sKOut (s : SMachine) (ps : List SEntry) (sl : SKStep) := sRun s (sLaws ps sl.pinsts) (sInsts ps sl.k.insts sl.pinsts) sl.qinsts sl.k.whens sl.k.ren sl.mren sl.names [] getRd\ndef sKGoal (s : SMachine) (ps : List SEntry) (sl : SKStep) : List C :=\n  [s.f.m.pre] ++ factHyps s sl.finsts sl.pfinsts ++ (sKOut s ps sl).1\n    ++ [.not (substRC (kEndSub sl.k (sKOut s ps sl).2.1 (sKOut s ps sl).2.2) (kEndRd sl.k (sKOut s ps sl).2.2) sl.k.then_)]\n\n-- The step's terms, flags inlined, read none of the names later requests' maps are read by.\ndef sMapsOk (s : SMachine) (MZ : List Nat) : Bool :=\n  s.f.m.step.all (fun p => avoidsMapsE MZ (inlineE s.f.flags p.2))\n    && s.f.m.writes.all (fun w => avoidsMapsE MZ (inlineE s.f.flags w.2.1) && avoidsMapsE MZ (inlineE s.f.flags w.2.2))\n    && s.every.all (fun w => avoidsMapsE MZ (inlineE s.f.flags w.2.2))\n    && s.facts.all (fun l => avoidsMaps MZ l.holds) && s.pfacts.all (fun f => avoidsMaps MZ f.1.holds)\n\ndef szone (s : SMachine) (sl : SKStep) : List Nat := tgts sl.k.ren ++ flagVars s.f.flags ++ tgts sl.names\n\ndef checkSKStep (s : SMachine) (ps : List SEntry) (sl : SKStep) : Bool :=\n  sl.k.whens.length == sl.k.ren.length && sl.mren.length == sl.k.ren.length && sl.k.ren.head? == some [] && sl.mren.head? == some []\n    && distinct (tgts sl.k.ren) && distinct (tgts sl.mren)\n    && sl.k.ren.all (fun r => r.all fun p => s.extVars.contains p.1)\n    && sl.k.ren.tail.all (fun r => s.extVars.all fun i => r.any (·.1 == i))\n    && sl.mren.all (fun r => r.all fun p => s.carried.contains p.1)\n    && sl.mren.tail.all (fun r => s.carried.all fun mp => r.any (·.1 == mp))\n    && sl.k.prime.all (fun q => !s.extVars.contains q.1 && !(szone s sl).contains q.1)\n    && sl.k.primeMaps.all (fun q => !s.carried.contains q.1 && !(tgts sl.mren).contains q.1)\n    && avoids (szone s sl) s.f.m.pre\n    && sl.k.whens.all (fun w => (sFrameHyps s (sLaws ps sl.pinsts) (sInsts ps sl.k.insts sl.pinsts) [] w).all (fun c => avoids (szone s sl) c)\n      && (sFrameHyps s (sLaws ps sl.pinsts) (sInsts ps sl.k.insts sl.pinsts) sl.qinsts w).all (fun c => avoidsMaps (tgts sl.mren) c))\n    && s.qflags.all (fun q => avoids (szone s sl) q.2.2)\n    && sTermsOk s (szone s sl) && sMapsOk s (tgts sl.mren)\n    && checkIn (sKGoal s ps sl) ⟨sl.k.proof.1, sl.used, sl.k.proof.2⟩\n    && distinct (tgts sl.k.ren ++ tgts sl.names)\n    && sl.names.all (fun n => n.all fun p => !s.extVars.contains p.1 && !(szone s sl).contains p.1)\n    && avoids (tgts sl.names) sl.k.then_\n\n/-! What a k-step law over sets claims -/\n\nabbrev SRequest := (Nat → Nat) × (Nat → Nat → Nat)   -- a request's inputs, and the maps it carries\n\nnoncomputable def sEnd (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → (Nat → Nat) × (Nat → Nat → Nat)\n  | ρ, M, [] => (ρ, M)\n  | ρ, M, q :: qs => sEnd s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\n-- The state after each step.\nnoncomputable def sStates (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → List (Nat → Nat)\n  | _, _, [] => []\n  | ρ, M, q :: qs => (sNext s ρ M q.1 q.2).1 :: sStates s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\ntheorem evalE_assoc_getD (σ : List (Nat × E)) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (v : Nat) :\n    evalE W M0 ((assoc σ v).getD (.var v)) = applyS σ W M0 v := by\n  simp only [applyS]; cases assoc σ v <;> simp [evalE]\n\n-- Each step's extended request (inputs, quantified flags, witnesses), as its goal reads it.\nnoncomputable def sExts (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → List (Nat → Nat)\n  | _, _, [] => []\n  | ρ, M, q :: qs => sReq s ρ M q.1 q.2 :: sExts s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\n-- Each request allowed (the assumption, flags decided) and meeting its step's `when`.\ndef SAllowed (s : SMachine) : List C → (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → Prop\n  | w :: ws, ρ, M, q :: qs =>\n    evalC (sView s ρ M q.1 q.2).1 (sView s ρ M q.1 q.2).2 s.f.m.assume = true\n      ∧ evalC (withExt s ρ (sReq s ρ M q.1 q.2)) (withCarried s M q.2) w = true\n      ∧ SAllowed s ws (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n  | _, _, _, _ => True\n\n/-- A k-step law over sets: from every reachable state, every k requests in a row the machine allows end in a state\nwhere `then` holds: primed names read the last state and maps, plain names the first state with the first request,\neach later request read by its fresh variables and the maps it carries by their fresh names. -/\ndef SKStepHolds (s : SMachine) (sl : SKStep) : Prop :=\n  ∀ ρ M, SReach s ρ M → ∀ q₁ qs, qs.length + 1 = sl.k.whens.length → SAllowed s sl.k.whens ρ M (q₁ :: qs) →\n    evalC (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 (renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))))\n      (primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 (renMaps sl.mren ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2))) sl.k.then_ = true\n\n/-! The proof -/\n\ntheorem sMapsOk_parts {s : SMachine} {MZ : List Nat} (h : sMapsOk s MZ = true) :\n    (∀ p ∈ s.f.m.step, avoidsMapsE MZ (inlineE s.f.flags p.2) = true)\n      ∧ (∀ w ∈ s.f.m.writes, avoidsMapsE MZ (inlineE s.f.flags w.2.1) = true ∧ avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true)\n      ∧ (∀ w ∈ s.every, avoidsMapsE MZ (inlineE s.f.flags w.2.2) = true) := by\n  simp only [sMapsOk, Bool.and_eq_true, List.all_eq_true] at h\n  exact ⟨h.1.1.1.1, h.1.1.1.2, h.1.1.2⟩\n\ntheorem sMapsOk_facts {s : SMachine} {MZ : List Nat} (h : sMapsOk s MZ = true) : ∀ l ∈ s.facts, avoidsMaps MZ l.holds = true := by\n  simp only [sMapsOk, Bool.and_eq_true, List.all_eq_true] at h; exact h.1.2\ntheorem sMapsOk_pfacts {s : SMachine} {MZ : List Nat} (h : sMapsOk s MZ = true) : ∀ f ∈ s.pfacts, avoidsMaps MZ f.1.holds = true := by\n  simp only [sMapsOk, Bool.and_eq_true, List.all_eq_true] at h; exact h.2\n\ntheorem renMaps_other : ∀ (rs : List (List (Nat × Nat))) (κs : List (Nat → Nat → Nat)) (b : Nat → Nat → Nat) (mp : Nat),\n    mp ∉ tgts rs → renMaps rs κs b mp = b mp\n  | [], κs, b, mp, _ => by cases κs <;> rfl\n  | r :: rs, [], b, mp, _ => rfl\n  | r :: rs, κ :: κs, b, mp, hv => by\n    simp only [tgts, List.mem_append, not_or] at hv\n    have hn : lookup (fun p : Nat × Nat => p.2 == mp) r = none := lookup_none (fun p hp => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hv.1 (by rw [← he]; exact List.mem_map_of_mem hp))\n    simp only [renMaps, hn]\n    exact renMaps_other rs κs b mp hv.2\n\n-- Each step's fresh map names hold the maps its request carries.\ndef MRenOK (M0 : Nat → Nat → Nat) : List (List (Nat × Nat)) → List (Nat → Nat → Nat) → Prop\n  | r :: rs, κ :: κs => (∀ p ∈ r, M0 p.2 = κ p.1) ∧ MRenOK M0 rs κs\n  | _, _ => True\n\ntheorem mrenOK_congr {M0 M0' : Nat → Nat → Nat} : ∀ (rs : List (List (Nat × Nat))) (κs : List (Nat → Nat → Nat)),\n    (∀ v ∈ tgts rs, M0 v = M0' v) → MRenOK M0' rs κs → MRenOK M0 rs κs\n  | [], _, _, _ => trivial\n  | _ :: _, [], _, _ => trivial\n  | r :: rs, κ :: κs, hag, ⟨hh, ht⟩ => by\n    refine ⟨fun p hp => ?_, mrenOK_congr rs κs (fun v hv => hag v (by simp [tgts, hv])) ht⟩\n    rw [hag p.2 (by simp only [tgts, List.mem_append]; exact Or.inl (List.mem_map_of_mem hp))]; exact hh p hp\n\ntheorem renMaps_ok : ∀ (rs : List (List (Nat × Nat))) (κs : List (Nat → Nat → Nat)) (b : Nat → Nat → Nat),\n    distinct (tgts rs) = true → MRenOK (renMaps rs κs b) rs κs\n  | [], _, _, _ => trivial\n  | _ :: _, [], _, _ => trivial\n  | r :: rs, κ :: κs, b, hd => by\n    simp only [tgts] at hd\n    obtain ⟨hr, hrs, hdis⟩ := distinct_append hd\n    refine ⟨fun p hp => ?_, mrenOK_congr rs κs (fun v hv => ?_) (renMaps_ok rs κs b hrs)⟩\n    · simp only [renMaps, lookup_ren hr p hp]\n    · have hn : lookup (fun p : Nat × Nat => p.2 == v) r = none := lookup_none (fun p hp => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hdis v (by rw [← he]; exact List.mem_map_of_mem hp) hv)\n      simp only [renMaps, hn]\n\ndef SHeadL (s : SMachine) (Z MZ : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (rd : Nat → E → E)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) : List (List (Nat × Nat)) → List (List (Nat × Nat)) → List SRequest → Prop\n  | r :: _, mr :: _, q :: _ => SHead s Z MZ W M0 σ rd ρ M r mr q.1 q.2\n  | _, _, _ => True\n\ntheorem skrun_sound (s : SMachine) (ps : List SEntry) (hl : checkSMachine s ps = true) (Z MZ : List Nat) (laws : List MLaw) (insts : List (Nat × E)) (qinsts : List (Nat × List E))\n    (hlY : ∀ ρ M ι κ, SReach s ρ M → ∀ l ∈ laws, l.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ))\n    (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n    (hfz : ∀ v ∈ flagVars s.f.flags, v ∈ Z) (hterms : sTermsOk s Z = true) (hmaps : sMapsOk s MZ = true)\n    (hqb : ∀ q ∈ s.qflags, avoids Z q.2.2 = true) :\n    ∀ (ws : List C) (rs mrs ns : List (List (Nat × Nat))) (qs : List SRequest) (σ : List (Nat × E)) (rd : Nat → E → E)\n      (ρ : Nat → Nat) (M : Nat → Nat → Nat),\n      ws.length = rs.length → ws.length = mrs.length → ws.length = qs.length →\n      (∀ w ∈ ws, (∀ c ∈ sFrameHyps s laws insts [] w, avoids Z c = true) ∧ ∀ c ∈ sFrameHyps s laws insts qinsts w, avoidsMaps MZ c = true) →\n      (∀ r ∈ rs, ∀ p ∈ r, p.1 ∈ s.extVars) →\n      (∀ r ∈ rs.tail, ∀ i ∈ s.extVars, ∃ p ∈ r, p.1 = i) →\n      (∀ r ∈ mrs, ∀ p ∈ r, p.1 ∈ s.carried) →\n      (∀ r ∈ mrs.tail, ∀ mp ∈ s.carried, ∃ p ∈ r, p.1 = mp) →\n      RenOK W rs.tail (sExts s ρ M qs).tail → MRenOK M0 mrs.tail (qs.map (·.2)).tail →\n      (∀ n ∈ ns, ∀ p ∈ n, p.1 ∉ s.extVars ∧ p.1 ∉ Z) → RenOK W ns (sStates s ρ M qs) →\n      SReach s ρ M → SDenotes s Z MZ W M0 σ rd ρ M → SHeadL s Z MZ W M0 σ rd ρ M rs mrs qs → SAllowed s ws ρ M qs →\n      (∀ c ∈ (sRun s laws insts qinsts ws rs mrs ns σ rd).1, evalC W M0 c = true)\n        ∧ SDenotes s Z MZ W M0 (sRun s laws insts qinsts ws rs mrs ns σ rd).2.1 (sRun s laws insts qinsts ws rs mrs ns σ rd).2.2\n            (sEnd s ρ M qs).1 (sEnd s ρ M qs).2\n  | [], rs, mrs, ns, qs, σ, rd, ρ, M, hl1, hl2, hl3, _, _, _, _, _, _, _, _, _, _, hD, _, _ => by\n    cases rs with\n    | cons _ _ => simp at hl1\n    | nil =>\n      cases mrs with\n      | cons _ _ => simp at hl2\n      | nil =>\n        cases qs with\n        | cons _ _ => simp at hl3\n        | nil => exact ⟨fun c hc => by simp [sRun] at hc, hD⟩\n  | w :: ws, rs, mrs, ns, qs, σ, rd, ρ, M, hl1, hl2, hl3, hav, hkeys, hcov, hmkeys, hmcov, hren, hmren, hnsrc, hnok, hr, hD, hH, hK => by\n    rcases rs with _ | ⟨r, rs⟩\n    · simp at hl1\n    rcases mrs with _ | ⟨mr, mrs⟩\n    · simp at hl2\n    rcases qs with _ | ⟨q, qs⟩\n    · simp at hl3\n    simp only [List.length_cons, Nat.add_right_cancel_iff] at hl1 hl2 hl3\n    simp only [List.tail_cons] at hcov hmcov\n    have hren1 : RenOK W rs (sExts s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs) := hren\n    have hmren1 : MRenOK M0 mrs (qs.map (·.2)) := hmren\n    obtain ⟨hA, hW, hK'⟩ := hK\n    have hH1 : SHead s Z MZ W M0 σ rd ρ M r mr q.1 q.2 := hH\n    obtain ⟨hfav, hstp, hwr, hev⟩ := sTermsOk_parts hterms\n    obtain ⟨hstm, hwrm, hevm⟩ := sMapsOk_parts hmaps\n    have hD' := sstep_denotes s Z MZ W M0 (sOk_of hl) hfz hfav r mr q.1 q.2 hD hH1 (hkeys r List.mem_cons_self) hstp\n      (fun w hw => (hwr w hw).1) hev hstm hwrm hevm\n    have hr' : SReach s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 := SReach.step ρ M q.1 q.2 hr hA\n    -- The state after the step, named: each fresh variable holds the next state's value of the variable it names.\n    have hnames : ∀ p ∈ ns.headD [], W p.2 = (sNext s ρ M q.1 q.2).1 p.1 := by\n      cases ns with\n      | nil => intro p hp; simp at hp\n      | cons n ns' => exact hnok.1\n    have hnsrc1 : ∀ p ∈ ns.headD [], p.1 ∉ s.extVars ∧ p.1 ∉ Z := by\n      cases ns with\n      | nil => intro p hp; simp at hp\n      | cons n ns' => exact hnsrc n List.mem_cons_self\n    have hD'' : SDenotes s Z MZ W M0 (frameSub (ns.headD []) (stepSub s.f (frameSub r σ) (frameRd mr rd))) (stepRdS s (frameSub r σ) (frameRd mr rd))\n        (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 := by\n      refine ⟨fun v hve hvz => ?_, hD'.2⟩\n      by_cases hin : ∃ p ∈ ns.headD [], p.1 = v\n      · exact applyS_frame_in hin hnames\n      · rw [applyS_frame_out (fun p hp he => hin ⟨p, hp, he⟩)]; exact hD'.1 v hve hvz\n    -- The next step's frame, its request set and its maps read, agrees with the next state and request.\n    have hH' : SHeadL s Z MZ W M0 (frameSub (ns.headD []) (stepSub s.f (frameSub r σ) (frameRd mr rd))) (stepRdS s (frameSub r σ) (frameRd mr rd))\n        (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 rs mrs qs := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases mrs with _ | ⟨mr', mrs'⟩\n      · exact trivial\n      rcases qs with _ | ⟨q', qs'⟩\n      · exact trivial\n      have hr1 : ∀ p ∈ r', W p.2 = sReq s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 q'.1 q'.2 p.1 := hren1.1\n      have hm1 : ∀ p ∈ mr', M0 p.2 = q'.2 p.1 := hmren1.1\n      refine ⟨fun v hvz => ?_, fun mp k hmz => ?_⟩\n      · by_cases hve : v ∈ s.extVars\n        · rw [applyS_frame_in (hcov r' List.mem_cons_self v hve) hr1]\n          simp only [withExt]; rw [if_pos (List.contains_iff_mem.mpr hve)]\n        · rw [applyS_frame_out (fun p hp he => hve (by rw [← he]; exact hkeys r' (List.mem_cons_of_mem _ List.mem_cons_self) p hp)),\n            hD''.1 v hve hvz]\n          simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hve)]\n      · by_cases hmc : mp ∈ s.carried\n        · cases hlk : lookup (fun p : Nat × Nat => p.1 == mp) mr' with\n          | none =>\n            obtain ⟨p, hp, hp1⟩ := hmcov mr' List.mem_cons_self mp hmc\n            have := lookup_none_all hlk p hp\n            simp [hp1] at this\n          | some p0 =>\n            have hp0 := lookup_some hlk\n            simp only [beq_iff_eq] at hp0\n            simp only [frameRd, hlk, evalE]\n            rw [hm1 p0 hp0.1, hp0.2]; simp only [withCarried]; rw [if_pos (List.contains_iff_mem.mpr hmc)]\n        · have hlk : lookup (fun p : Nat × Nat => p.1 == mp) mr' = none := lookup_none (fun p hp => by\n            simp only [beq_eq_false_iff_ne]; intro he\n            exact hmc (by rw [← he]; exact hmkeys mr' (List.mem_cons_of_mem _ List.mem_cons_self) p hp))\n          simp only [frameRd, hlk]\n          rw [hD'.2 mp k hmc hmz]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]\n    have hren' : RenOK W rs.tail (sExts s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs).tail := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases qs with _ | ⟨q', qs'⟩\n      · cases rs' <;> exact trivial\n      exact hren1.2\n    have hmren' : MRenOK M0 mrs.tail (qs.map (·.2)).tail := by\n      rcases mrs with _ | ⟨mr', mrs'⟩\n      · exact trivial\n      rcases qs with _ | ⟨q', qs'⟩\n      · cases mrs' <;> exact trivial\n      exact hmren1.2\n    have hnsrc' : ∀ n ∈ ns.tail, ∀ p ∈ n, p.1 ∉ s.extVars ∧ p.1 ∉ Z := fun n hn => hnsrc n (List.mem_of_mem_tail hn)\n    have hnok' : RenOK W ns.tail (sStates s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs) := by\n      cases ns with\n      | nil => exact trivial\n      | cons n ns' => exact hnok.2\n    obtain ⟨ih1, ih2⟩ := skrun_sound s ps hl Z MZ laws insts qinsts hlY W M0 hfz hterms hmaps hqb ws rs mrs ns.tail qs _ _ _ _ hl1 hl2 hl3\n      (fun w' hw' => hav w' (List.mem_cons_of_mem _ hw'))\n      (fun r' hr'' => hkeys r' (List.mem_cons_of_mem _ hr''))\n      (fun r' hr'' => hcov r' (List.mem_of_mem_tail hr''))\n      (fun r' hr'' => hmkeys r' (List.mem_cons_of_mem _ hr''))\n      (fun r' hr'' => hmcov r' (List.mem_of_mem_tail hr''))\n      hren' hmren' hnsrc' hnok' hr' hD'' hH' hK'\n    refine ⟨fun c hc => ?_, ih2⟩\n    simp only [sRun, List.mem_append, List.mem_map] at hc\n    rcases hc with (⟨c', hc', rfl⟩ | hc) | hc\n    · exact sframe_hyps s Z MZ W M0 (sOk_of hl) laws insts qinsts (hlY ρ M q.1 q.2 hr)\n        hH1 (hav w List.mem_cons_self).1 hqb (hav w List.mem_cons_self).2 hA hW c' hc'\n    · -- Each name's equation: the fresh variable holds the next state's value, which the term denotes.\n      simp only [nameHyps, List.mem_map] at hc\n      obtain ⟨p, hp, rfl⟩ := hc\n      simp only [evalC]\n      apply decide_eq_true\n      show W p.2 = evalE W M0 ((assoc (stepSub s.f (frameSub r σ) (frameRd mr rd)) p.1).getD (.var p.1))\n      rw [hnames p hp, evalE_assoc_getD]\n      exact (hD'.1 p.1 (hnsrc1 p hp).1 (hnsrc1 p hp).2).symm\n    · exact ih1 c hc\n\n/-- The k-step rule over sets: an accepted k-step goal makes its law hold. -/\ntheorem skstep_sound (s : SMachine) (ps : List SEntry) (sl : SKStep)\n    (hl : checkSMachine s ps = true) (hc : checkSKStep s ps sl = true) : SKStepHolds s sl := by\n  intro ρ M hr q₁ qs hlen hK\n  simp only [checkSKStep, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hc\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hlw, hlm⟩, hhead⟩, hmhead⟩, hdist⟩, hmdist⟩, hkeys⟩, hcov⟩, hmkeys⟩, hmcov⟩, hpr⟩, hpm⟩, hpre⟩, hws⟩, hqb⟩, hterms⟩, hmaps⟩, hgoal⟩, hnd⟩, hnsrc⟩, hnthen⟩ := hc\n  obtain ⟨hpreS, hrp⟩ := spre_parts hl\n  have hflags : ∀ v ∈ flagVars s.f.flags, v ∈ szone s sl := fun v hv => List.mem_append_left _ (List.mem_append_right _ hv)\n  obtain ⟨rs, hrs⟩ : ∃ rs, sl.k.ren = [] :: rs := by\n    cases h : sl.k.ren with\n    | nil => rw [h] at hhead; simp at hhead\n    | cons r rs => rw [h] at hhead; simp only [List.head?_cons, Option.some.injEq] at hhead; exact ⟨rs, by rw [hhead]⟩\n  obtain ⟨mrs, hmrs⟩ : ∃ mrs, sl.mren = [] :: mrs := by\n    cases h : sl.mren with\n    | nil => rw [h] at hmhead; simp at hmhead\n    | cons r rs => rw [h] at hmhead; simp only [List.head?_cons, Option.some.injEq] at hmhead; exact ⟨rs, by rw [hmhead]⟩\n  -- The goal's environment: each later request at its fresh variables, and each step's state at its names.\n  let W0 := renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))\n  let W := renEnv sl.names (sStates s ρ M (q₁ :: qs)) W0\n  obtain ⟨_, hndn, hndis⟩ := distinct_append hnd\n  have hWn : ∀ v, v ∉ tgts sl.names → W v = W0 v := fun v hv => renEnv_other _ _ _ v hv\n  let M0 := renMaps sl.mren ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2)\n  have hWo : ∀ v, v ∉ szone s sl → W v = withExt s ρ (sReq s ρ M q₁.1 q₁.2) v := fun v hv => by\n    rw [hWn v (fun h => hv (List.mem_append_right _ h))]\n    exact renEnv_other _ _ _ v (fun h => hv (List.mem_append_left _ (List.mem_append_left _ h)))\n  have hMo : ∀ mp, mp ∉ tgts sl.mren → M0 mp = withCarried s M q₁.2 mp := fun mp hmp => renMaps_other _ _ _ mp hmp\n  have hD0 : SDenotes s (szone s sl) (tgts sl.mren) W M0 [] getRd ρ M := by\n    refine ⟨fun v hve hvz => ?_, fun mp k hmc hmz => ?_⟩\n    · rw [applyS_nil', hWo v hvz]; simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hve)]\n    · simp only [getRd, evalE]; rw [hMo mp hmz]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)]\n  have hH0 : SHeadL s (szone s sl) (tgts sl.mren) W M0 [] getRd ρ M sl.k.ren sl.mren (q₁ :: qs) := by\n    rw [hrs, hmrs]\n    show SHead s (szone s sl) (tgts ([] :: mrs)) W M0 [] getRd ρ M [] [] q₁.1 q₁.2\n    refine ⟨fun v hvz => ?_, fun mp k hmz => ?_⟩\n    · simp only [frameSub, List.map_nil, List.append_nil, applyS_nil']; exact hWo v hvz\n    · simp only [frameRd, lookup, getRd, evalE]; rw [hMo mp (by rw [hmrs]; exact hmz)]\n  have hren0 : RenOK W sl.k.ren.tail (sExts s ρ M (q₁ :: qs)).tail := by\n    have h : RenOK W sl.k.ren (sExts s ρ M (q₁ :: qs)) :=\n      renOK_congr _ _ (fun v hv => hWn v (hndis v hv)) (renEnv_ok sl.k.ren _ _ hdist)\n    rw [hrs] at h ⊢; exact h.2\n  have hmren0 : MRenOK M0 sl.mren.tail ((q₁ :: qs).map (·.2)).tail := by\n    have h : MRenOK M0 sl.mren ((q₁ :: qs).map (·.2)) := renMaps_ok sl.mren _ _ hmdist\n    rw [hmrs] at h ⊢; exact h.2\n  -- Every entry holds at each reachable state, so each law (and each pair's) holds in the goal's view of it.\n  have hlY : ∀ ρ M ι κ, SReach s ρ M → ∀ l ∈ sLaws ps sl.pinsts, l.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) := by\n    intro ρ M ι κ hr l hl'\n    have hall : ∀ e ∈ ps, e.Holds (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ) := fun e he =>\n      sentry_transfer (slaws_avoid hl e.law (List.mem_map_of_mem he)).1 (slaws_avoid hl e.law (List.mem_map_of_mem he)).2\n        (fun i hi => by simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hi)])\n        (fun mp hmp => by simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmp)])\n        (smachine_sound s ps hl ρ M hr e he)\n    rcases List.mem_append.mp hl' with hl' | hl'\n    · obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl'; exact SEntry.holds_law (hall e' he')\n    · exact pairLaws_hold ps sl.pinsts (skeys_apart hl) hall l hl'\n  obtain ⟨hh, hfin⟩ := skrun_sound s ps hl (szone s sl) (tgts sl.mren) (sLaws ps sl.pinsts) (sInsts ps sl.k.insts sl.pinsts) sl.qinsts hlY W M0 hflags hterms hmaps hqb\n    sl.k.whens sl.k.ren sl.mren sl.names (q₁ :: qs) [] getRd ρ M hlw (by omega) (by simp only [List.length_cons]; omega)\n    hws (fun r hr p hp => List.contains_iff_mem.mp (hkeys r hr p hp))\n    (fun r hr i hi => by have := hcov r hr i hi; simpa only [List.any_eq_true, beq_iff_eq] using this)\n    (fun r hr p hp => List.contains_iff_mem.mp (hmkeys r hr p hp))\n    (fun r hr i hi => by have := hmcov r hr i hi; simpa only [List.any_eq_true, beq_iff_eq] using this)\n    hren0 hmren0\n    (fun n hn p hp => by\n      have h := hnsrc n hn p hp\n      simp only [Bool.and_eq_true, Bool.not_eq_true', List.contains_iff_mem] at h\n      exact ⟨by simpa using h.1, by simpa using h.2⟩)\n    (renEnv_ok sl.names _ _ hndn) hr hD0 hH0 hK\n  have hfin' : SDenotes s (szone s sl) (tgts sl.mren) W M0 (sKOut s ps sl).2.1 (sKOut s ps sl).2.2\n      (sEnd s ρ M (q₁ :: qs)).1 (sEnd s ρ M (q₁ :: qs)).2 := hfin\n  apply Decidable.byContradiction; intro hn\n  -- `then` reads none of the names, so the goal's environment reads it as the claim's does.\n  have hn' : ¬ evalC (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W) (primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 M0) sl.k.then_ = true := by\n    rw [congrC (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W) (primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W0) _ sl.k.then_ (fun i hi => by\n      simp only [primed]; split\n      · rfl\n      · exact hWn i (avoids_occ hnthen hi))]\n    exact hn\n  apply sound_in _ _ hgoal W M0\n  intro c hc\n  simp only [sKGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with ((rfl | hc) | hc) | rfl\n  · -- The precondition: at the first state (it reads no map, no request and no fresh variable).\n    rw [noReadsC W M0 M s.f.m.pre hrp, congrC W ρ M s.f.m.pre (fun j hj => ?_)]\n    · exact pre_sreach s hpreS hrp hr\n    · rw [hWo j (avoids_occ hpre hj)]; simp only [withExt]\n      rw [if_neg (fun h' => avoids_occ hpreS hj (List.mem_append_left _ (List.mem_append_left _ (List.mem_append_left _ (List.contains_iff_mem.mp h')))))]\n  · -- The facts, at the first frame: it agrees with the first state away from the zone and the request.\n    exact facthyps_true s sl.finsts sl.pfinsts W M0 (fun f hf => (pfactsOk_parts (sfacts_ok hl) f hf).2.2)\n      (facts_frame s (sfacts_ok hl) (szone s sl) (tgts sl.mren) (sTermsOk_facts hterms) (sMapsOk_facts hmaps)\n        (fun i hie hiz => by rw [hWo i hiz]; simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)])\n        (fun mp hmc hmz => by rw [hMo mp hmz]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)])\n        (facts_sreach s (sfacts_ok hl) hr))\n      (pfacts_frame s (sfacts_ok hl) (szone s sl) (tgts sl.mren) (sTermsOk_pfacts hterms) (sMapsOk_pfacts hmaps)\n        (fun i hie hiz => by rw [hWo i hiz]; simp only [withExt]; rw [if_neg (by simpa [List.contains_iff_mem] using hie)])\n        (fun mp hmc hmz => by rw [hMo mp hmz]; simp only [withCarried]; rw [if_neg (by simpa [List.contains_iff_mem] using hmc)])\n        (pfacts_sreach s (sfacts_ok hl) hr)) c hc\n  · exact hh c hc\n  · -- `then`, read across the run, is what SKStepHolds reads.\n    have hrdE : ∀ mp k, evalE W M0 (kEndRd sl.k (sKOut s ps sl).2.2 mp k)\n        = primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 M0 mp (evalE W M0 k) := by\n      intro mp k\n      simp only [kEndRd, primedMaps]\n      cases hq : lookup (fun q => q.2 == mp) sl.k.primeMaps with\n      | none => simp [evalE]\n      | some q =>\n        have hq1 := hpm q (lookup_some hq).1\n        simp only [Bool.not_eq_true'] at hq1\n        exact hfin'.2 q.1 k (by simpa using hq1.1) (by simpa using hq1.2)\n    have henv : applyS (kEndSub sl.k (sKOut s ps sl).2.1 (sKOut s ps sl).2.2) W M0\n        = primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 W := by\n      funext i\n      rw [kEndSub, applyS_primes]\n      simp only [primed]\n      cases hq : lookup (fun q => q.2 == i) sl.k.prime with\n      | none => rfl\n      | some q =>\n        have hq1 := hpr q (lookup_some hq).1\n        simp only [Bool.not_eq_true'] at hq1\n        have hqi : q.1 ∉ s.extVars := by simpa using hq1.1\n        have hqz : q.1 ∉ szone s sl := by simpa using hq1.2\n        show evalE W M0 (substRE (sKOut s ps sl).2.1 (sKOut s ps sl).2.2 (.var q.1)) = (sEnd s ρ M (q₁ :: qs)).1 q.1\n        rw [substR_var]; exact hfin'.1 q.1 hqi hqz\n    simp only [evalC, substR_evalC _ _ W M0 _ hrdE, henv]\n    simpa using hn'\n\nend Kern\n\n#print axioms Kern.smachine_sound\n#print axioms Kern.skstep_sound\n",
     "Live.lean": "import Sets\n\n/-!\nLiveness under fairness: \"from leads to to\", proven sound for machines with sets (`sleads_sound`, and under weak\nfairness `sleads_wf_sound`); a machine with maps and flags is one with no sets. kernel.ts proves it by a rank (naturals over the state and params, compared in\norder: the first that differs decides) and helpful requests, each with the region where it helps. While `from` holds and\n`to` doesn't: every request allowed keeps `from` or reaches `to`, and reaches `to`, lowers the rank, or keeps the rank\nwith every region it was in kept (a step law); some region holds (a step law that reads no step); and each helpful\nrequest, taken in its region, reaches `to` or lowers the rank (a step law whose `when` names the inputs the request\nsets; the others, and the maps it carries, stay free: a history's queries among them). Lean builds all of them from the\nliveness and checks them with the step-law rules (StepLaw.lean's, Sets.lean's). Then along every run that takes each\nhelpful request infinitely often, each state where `from` holds is followed by one where `to` holds: the rank can't drop\nforever, once it stops dropping the region it is in stays, and that region's request comes and lowers it.\n-/\n\nnamespace Kern\n\n/-! Ranks compared in order -/\n\ndef lexB : List Nat → List Nat → Bool\n  | a' :: as', a :: as => decide (a' < a) || (decide (a' = a) && lexB as' as)\n  | _, _ => false\n\ntheorem lexB_irrefl : ∀ x : List Nat, lexB x x = false\n  | [] => rfl\n  | a :: as => by simp [lexB, lexB_irrefl as]\n\ntheorem nat_down {g : Nat → Nat} {n0 : Nat} (h : ∀ n, n0 ≤ n → g (n + 1) ≤ g n) : ∀ d, g (n0 + d) ≤ g n0\n  | 0 => Nat.le_refl _\n  | d + 1 => Nat.le_trans (h (n0 + d) (Nat.le_add_right _ _)) (nat_down h d)\n\n-- A natural that never rises from n0 on stops changing.\ntheorem nat_stable (g : Nat → Nat) : ∀ v n0, g n0 ≤ v → (∀ n, n0 ≤ n → g (n + 1) ≤ g n) →\n    ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → g m = g T := by\n  intro v\n  induction v with\n  | zero =>\n    intro n0 hv h\n    refine ⟨n0, Nat.le_refl _, fun m hm => ?_⟩\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    have := nat_down h d; omega\n  | succ v ih =>\n    intro n0 hv h\n    by_cases hall : ∀ m, n0 ≤ m → g m = g n0\n    · exact ⟨n0, Nat.le_refl _, hall⟩\n    · have hex : ∃ m, n0 ≤ m ∧ g m ≠ g n0 := Classical.byContradiction fun hno =>\n        hall fun m hm => Classical.byContradiction fun hne => hno ⟨m, hm, hne⟩\n      obtain ⟨m, hm, hne⟩ := hex\n      obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n      have := nat_down h d\n      obtain ⟨T, hT, hTm⟩ := ih (n0 + d) (by omega) (fun n hn => h n (by omega))\n      exact ⟨T, by omega, hTm⟩\n\n-- A rank of k naturals that never rises (in order) from n0 on stops changing.\ntheorem lex_stable : ∀ (k : Nat) (r : Nat → List Nat) (n0 : Nat), (∀ n, (r n).length = k) →\n    (∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n) → ∃ T, n0 ≤ T ∧ ∀ m, T ≤ m → r m = r T\n  | 0, r, n0, hk, _ => ⟨n0, Nat.le_refl _, fun m _ => by\n      rw [List.eq_nil_of_length_eq_zero (hk m), List.eq_nil_of_length_eq_zero (hk n0)]⟩\n  | k + 1, r, n0, hk, hmono => by\n    have hcons : ∀ n, r n = (r n).headD 0 :: (r n).tail := by\n      intro n\n      have := hk n\n      cases h : r n with\n      | nil => rw [h] at this; simp at this\n      | cons a as => rfl\n    have hstep : ∀ n, n0 ≤ n → (r (n + 1)).headD 0 < (r n).headD 0 ∨\n        ((r (n + 1)).headD 0 = (r n).headD 0 ∧ (lexB (r (n + 1)).tail (r n).tail = true ∨ (r (n + 1)).tail = (r n).tail)) := by\n      intro n hn\n      have h := hmono n hn\n      rw [hcons (n + 1), hcons n] at h\n      simp only [lexB, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq, List.cons.injEq] at h\n      rcases h with (h | ⟨h1, h2⟩) | ⟨h1, h2⟩\n      · exact Or.inl h\n      · exact Or.inr ⟨h1, Or.inl h2⟩\n      · exact Or.inr ⟨h1, Or.inr h2⟩\n    obtain ⟨T1, hT1, hT1m⟩ := nat_stable (fun n => (r n).headD 0) _ n0 (Nat.le_refl _) (fun n hn => by\n      rcases hstep n hn with h | ⟨h, _⟩\n      · exact Nat.le_of_lt h\n      · exact Nat.le_of_eq h)\n    obtain ⟨T2, hT2, hT2m⟩ := lex_stable k (fun n => (r n).tail) T1 (fun n => by simp [hk n]) (fun n hn => by\n      rcases hstep n (by omega) with h | ⟨_, h⟩\n      · have e1 := hT1m (n + 1) (by omega); have e2 := hT1m n hn; omega\n      · exact h)\n    refine ⟨T2, by omega, fun m hm => ?_⟩\n    have e1 := hT1m m (by omega); have e2 := hT1m T2 hT2; have e3 := hT2m m hm\n    rw [hcons m, hcons T2, e3, e1, e2]\n\n/-- Along a run: if `P ∧ ¬Q` is kept (or Q reached) with the rank never rising, and kept only with every region kept;\nsome region holds while `P ∧ ¬Q` does; and each region's helpful step reaches Q or lowers the rank there; then Q\nfollows every P, provided each helpful step is taken from any point on where it stays enabled (E), and it is enabled in\nits region while `P ∧ ¬Q` holds. With E always true, that is: each helpful step taken infinitely often. -/\ntheorem leads_of_lex {α : Type} (P Q : Nat → Prop) (r : Nat → List Nat) (k : Nat) (hk : ∀ n, (r n).length = k)\n    (helps : List α) (W H E : α → Nat → Prop)\n    (hstay : ∀ n, P n → ¬ Q n → (P (n + 1) ∨ Q (n + 1)) ∧\n      (Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true ∨ (r (n + 1) = r n ∧ ∀ h ∈ helps, W h n → W h (n + 1))))\n    (hcover : ∀ n, P n → ¬ Q n → ∃ h ∈ helps, W h n)\n    (hhelp : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → H h n → Q (n + 1) ∨ lexB (r (n + 1)) (r n) = true)\n    (henabled : ∀ h ∈ helps, ∀ n, P n → ¬ Q n → W h n → E h n)\n    (fair : ∀ h ∈ helps, ∀ n, (∀ m, n ≤ m → E h m) → ∃ m, n ≤ m ∧ H h m) : ∀ n, P n → ∃ m, n ≤ m ∧ Q m := by\n  intro n0 hP\n  apply Classical.byContradiction\n  intro hno\n  have hnq : ∀ m, n0 ≤ m → ¬ Q m := fun m hm hq => hno ⟨m, hm, hq⟩\n  have hPd : ∀ d, P (n0 + d) := by\n    intro d\n    induction d with\n    | zero => exact hP\n    | succ d ih =>\n      rcases (hstay (n0 + d) ih (hnq _ (Nat.le_add_right _ _))).1 with h | h\n      · exact h\n      · exact absurd h (hnq _ (by omega))\n  have hPm : ∀ m, n0 ≤ m → P m := fun m hm => by obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm; exact hPd d\n  have hmono : ∀ n, n0 ≤ n → lexB (r (n + 1)) (r n) = true ∨ r (n + 1) = r n := by\n    intro n hn\n    rcases (hstay n (hPm n hn) (hnq n hn)).2 with h | h | ⟨h, _⟩\n    · exact absurd h (hnq _ (by omega))\n    · exact Or.inl h\n    · exact Or.inr h\n  -- The rank stops changing at T; the region T is in stays, and its helpful step would lower the rank.\n  obtain ⟨T, hT, hTm⟩ := lex_stable k r n0 hk hmono\n  have hlow : ∀ m, T ≤ m → lexB (r (m + 1)) (r m) ≠ true := fun m hm hl => by\n    rw [hTm (m + 1) (by omega), hTm m hm, lexB_irrefl] at hl; exact absurd hl (by simp)\n  obtain ⟨h, hh, hW⟩ := hcover T (hPm T hT) (hnq T hT)\n  have hWd : ∀ d, W h (T + d) := by\n    intro d\n    induction d with\n    | zero => exact hW\n    | succ d ih =>\n      rcases (hstay (T + d) (hPm _ (by omega)) (hnq _ (by omega))).2 with hq | hl | ⟨_, hkeep⟩\n      · exact absurd hq (hnq _ (by omega))\n      · exact absurd hl (hlow _ (by omega))\n      · exact hkeep h hh ih\n  obtain ⟨m, hm, hH⟩ := fair h hh T (fun m hm => by\n    obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n    exact henabled h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d))\n  obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hm\n  rcases hhelp h hh (T + d) (hPm _ (by omega)) (hnq _ (by omega)) (hWd d) hH with hq | hl\n  · exact hnq _ (by omega) hq\n  · exact hlow _ (by omega) hl\n\n/-! Primed names: a condition read after a step -/\n\n-- A term with its state variables renamed to their primed names (`pr`: variable, name) and its maps to theirs (`pm`).\nmutual\ndef primeE (pr pm : List (Nat × Nat)) : E → E\n  | .var i => match lookup (fun q => q.1 == i) pr with\n    | some q => .var q.2\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (primeE pr pm a) (primeE pr pm b)\n  | .sub a b => .sub (primeE pr pm a) (primeE pr pm b)\n  | .mul k a => .mul k (primeE pr pm a)\n  | .min a b => .min (primeE pr pm a) (primeE pr pm b)\n  | .max a b => .max (primeE pr pm a) (primeE pr pm b)\n  | .prod a b => .prod (primeE pr pm a) (primeE pr pm b)\n  | .ite c t f => .ite (primeC pr pm c) (primeE pr pm t) (primeE pr pm f)\n  | .get m k => .get (match lookup (fun q => q.1 == m) pm with\n      | some q => q.2\n      | none => m) (primeE pr pm k)\ndef primeC (pr pm : List (Nat × Nat)) : C → C\n  | .le a b => .le (primeE pr pm a) (primeE pr pm b)\n  | .lt a b => .lt (primeE pr pm a) (primeE pr pm b)\n  | .eq a b => .eq (primeE pr pm a) (primeE pr pm b)\n  | .and a b => .and (primeC pr pm a) (primeC pr pm b)\n  | .or a b => .or (primeC pr pm a) (primeC pr pm b)\n  | .not a => .not (primeC pr pm a)\nend\n\n-- Read where `then` reads (primed names after, the rest before), a renamed term is the term after, wherever a variable\n-- or map it reads is renamed or the same before and after, and reads no primed name.\nsection prime\nvariable (pr pm : List (Nat × Nat)) (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n  (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat)\ninclude hpr hpm\nmutual\ntheorem primeE_eval : (e : E) → (∀ i, occE i e = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occME mp e = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalE (primed pr ρ' ρ) (primedMaps pm M' M) (primeE pr pm e) = evalE ρ' M' e\n  | .var i, hv, _ => by\n    simp only [primeE]\n    cases hl : lookup (fun q => q.1 == i) pr with\n    | some q =>\n      have ⟨hq, hqi⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqi\n      simp only [evalE, primed, lookup_ren hpr q hq, hqi]\n    | none =>\n      have hi := hv i (by simp [occE])\n      have hnot : i ∉ pr.map (·.1) := fun hm => by\n        obtain ⟨q, hq, hqi⟩ := List.mem_map.mp hm\n        have := lookup_none_all hl q hq; simp [hqi] at this\n      have hn2 : lookup (fun q => q.2 == i) pr = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hi.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [evalE, primed, hn2]\n      rcases hi.2 with h | h\n      · exact absurd h hnot\n      · exact h.symm\n  | .const n, _, _ => rfl\n  | .add a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .sub a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .mul k a, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .min a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .max a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .prod a b, hv, hm => by\n    simp only [primeE, evalE, primeE_eval a (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .ite c t f, hv, hm => by\n    simp only [primeE, evalE, primeC_eval c (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval t (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h])),\n      primeE_eval f (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))]\n  | .get m k, hv, hm => by\n    have hk := primeE_eval k (fun i hi => hv i (by simp [occE, hi])) (fun mp h => hm mp (by simp [occME, h]))\n    simp only [primeE, evalE, hk]\n    cases hl : lookup (fun q => q.1 == m) pm with\n    | some q =>\n      have ⟨hq, hqm⟩ := lookup_some hl\n      simp only [beq_iff_eq] at hqm\n      simp only [primedMaps, lookup_ren hpm q hq, hqm]\n    | none =>\n      have hmm := hm m (by simp [occME])\n      have hnot : m ∉ pm.map (·.1) := fun hmem => by\n        obtain ⟨q, hq, hqm⟩ := List.mem_map.mp hmem\n        have := lookup_none_all hl q hq; simp [hqm] at this\n      have hn2 : lookup (fun q => q.2 == m) pm = none := lookup_none (fun q hq => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hmm.1 (by rw [← he]; exact List.mem_map_of_mem hq))\n      simp only [primedMaps, hn2]\n      rcases hmm.2 with h | h\n      · exact absurd h hnot\n      · rw [h]\ntheorem primeC_eval : (c : C) → (∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = ρ i)) →\n    (∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = M mp)) →\n    evalC (primed pr ρ' ρ) (primedMaps pm M' M) (primeC pr pm c) = evalC ρ' M' c\n  | .le a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .lt a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .eq a b, hv, hm => by\n    simp only [primeC, evalC, primeE_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeE_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .and a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .or a b, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h])),\n      primeC_eval b (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\n  | .not a, hv, hm => by\n    simp only [primeC, evalC, primeC_eval a (fun i hi => hv i (by simp [occC, hi])) (fun mp h => hm mp (by simp [occMC, h]))]\nend\nend prime\n\n-- Read where `then` reads, a condition that reads no primed name is the condition before the step.\ntheorem unprimedC_eval {pr pm : List (Nat × Nat)} {c : C} (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalC (primed pr ρ' ρ) (primedMaps pm M' M) c = evalC ρ M c := by\n  rw [congrC _ ρ _ c (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrMC ρ _ M c (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\ntheorem unprimed_eval {pr pm : List (Nat × Nat)} {e : E} (hv : ∀ i, occE i e = true → i ∉ pr.map (·.2)) (hm : ∀ mp, occME mp e = true → mp ∉ pm.map (·.2))\n    (ρ ρ' : Nat → Nat) (M M' : Nat → Nat → Nat) : evalE (primed pr ρ' ρ) (primedMaps pm M' M) e = evalE ρ M e := by\n  rw [congrE _ ρ _ e (fun i hi => by\n    simp only [primed]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hv i hi (by rw [← he]; exact List.mem_map_of_mem hq))])]\n  exact congrME ρ _ M e (fun mp hmp => by\n    funext k; simp only [primedMaps]\n    rw [lookup_none (fun q hq => by simp only [beq_eq_false_iff_ne]; intro he; exact hm mp hmp (by rw [← he]; exact List.mem_map_of_mem hq))])\n\n-- A condition (a term) read across a step: primed, it is read after the step; plain, before it, whether in `then`'s\n-- reading or in `when`'s; given that what it reads is renamed or unchanged by the step, and unchanged by the request.\ntheorem view_C {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {c : C} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i c = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp c = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i c = true → X i = ρ i) (hn : ∀ mp, occMC mp c = true → N mp = M mp) :\n    evalC (primed pr ρ' X) (primedMaps pm M' N) (primeC pr pm c) = evalC ρ' M' c\n      ∧ evalC (primed pr ρ' X) (primedMaps pm M' N) c = evalC ρ M c ∧ evalC X N c = evalC ρ M c := by\n  have h3 : evalC X N c = evalC ρ M c := by rw [congrMC X N M c hn]; exact congrC X ρ M c hx\n  refine ⟨primeC_eval pr pm hpr hpm X ρ' N M' c hv hm, ?_, h3⟩\n  rw [unprimedC_eval (fun i hi => (hv i hi).1) (fun mp h => (hm mp h).1), h3]\n\ntheorem view_E {pr pm : List (Nat × Nat)} (hpr : distinct (pr.map (·.2)) = true) (hpm : distinct (pm.map (·.2)) = true)\n    {e : E} {ρ X ρ' : Nat → Nat} {M N M' : Nat → Nat → Nat}\n    (hv : ∀ i, occC i (.eq e e) = true → i ∉ pr.map (·.2) ∧ (i ∈ pr.map (·.1) ∨ ρ' i = X i))\n    (hm : ∀ mp, occMC mp (.eq e e) = true → mp ∉ pm.map (·.2) ∧ (mp ∈ pm.map (·.1) ∨ M' mp = N mp))\n    (hx : ∀ i, occC i (.eq e e) = true → X i = ρ i) (hn : ∀ mp, occMC mp (.eq e e) = true → N mp = M mp) :\n    evalE (primed pr ρ' X) (primedMaps pm M' N) (primeE pr pm e) = evalE ρ' M' e\n      ∧ evalE (primed pr ρ' X) (primedMaps pm M' N) e = evalE ρ M e := by\n  have h3 : evalE X N e = evalE ρ M e := by\n    rw [congrME X N M e (fun mp h => hn mp (by simp [occMC, h]))]; exact congrE X ρ M e (fun i h => hx i (by simp [occC, h]))\n  refine ⟨primeE_eval pr pm hpr hpm X ρ' N M' e (fun i h => hv i (by simp [occC, h])) (fun mp h => hm mp (by simp [occMC, h])), ?_⟩\n  rw [unprimed_eval (fun i h => (hv i (by simp [occC, h])).1) (fun mp h => (hm mp (by simp [occMC, h])).1), h3]\n\n/-! The conditions Lean builds -/\n\ndef noneC : 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 rankLtC : List E → List E → C\n  | a' :: as', a :: as => .or (.lt a' a) (.and (.eq a' a) (rankLtC as' as))\n  | _, _ => noneC\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  | [] => noneC\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 rankLtC_eval (ρ : Nat → Nat) (M : Nat → Nat → Nat) : ∀ as' as : List E,\n    evalC ρ M (rankLtC as' as) = lexB (as'.map (evalE ρ M)) (as.map (evalE ρ M))\n  | a' :: as', a :: as => by simp only [rankLtC, lexB, evalC, List.map_cons, rankLtC_eval ρ M as' as]\n  | [], _ => by simp [rankLtC, lexB, evalC, noneC]\n  | _ :: _, [] => by simp [rankLtC, lexB, evalC, noneC]\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, noneC]\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 (rankLtC (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) (rankLtC (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) (rankLtC (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 [rankLtC_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",
+    "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\n/-! There exists: a law ∃ x. P x (core/exists.ts), proven through its witness. The kernel proves a plain law: P with a\nterm of the state for each bound value (`substC σ P`, a witness term), or P over ghosts the machine gains (a ghost\nwitness, carried along the run); either way the values the law binds are some assignment of its variables, and\n`updAll` writes that assignment over the state. `some_updAll` is the step from what the kernel proved to ∃: the\nwitness's values, written over the state, satisfy P (the state elsewhere as it was). -/\n\n-- The state with each pair's variable set to its value, in order.\ndef updAll (ρ : Nat → Nat) : List (Nat × Nat) → Nat → Nat\n  | [] => ρ\n  | p :: ps => updAll (upd ρ p.1 p.2) ps\n\ntheorem updAll_val (vs : List Nat) (ρ ρ' : Nat → Nat) (i : Nat) :\n    updAll ρ (vs.map fun j => (j, ρ' j)) i = if i ∈ vs then ρ' i else ρ i := by\n  induction vs generalizing ρ with\n  | nil => simp [updAll]\n  | cons v vs ih =>\n    simp only [List.map_cons, updAll]\n    rw [ih]\n    by_cases hi : i ∈ vs\n    · simp [hi]\n    · by_cases hv : i = v\n      · subst hv; simp [hi, upd]\n      · simp [hi, hv, upd]\n\n-- A state that agrees with ρ outside V, read where c reads of V only variables in vs: ρ with vs set to its values\n-- reads alike.\ntheorem evalC_updAll (vs V : List Nat) {ρ ρ' : Nat → Nat} (hag : ∀ i, i ∉ V → ρ' i = ρ i) (c : C)\n    (hc : ∀ i, occC i c = true → i ∈ V → i ∈ vs) (M : Nat → Nat → Nat) :\n    evalC (updAll ρ (vs.map fun i => (i, ρ' i))) M c = evalC ρ' M c := by\n  apply congrC\n  intro i hi\n  rw [updAll_val]\n  by_cases hv : i ∈ vs\n  · simp [hv]\n  · simp only [hv, if_false]\n    exact (hag i (fun hV => hv (hc i hi hV))).symm\n\n/-- A law the kernel proved with witness terms σ in place (`substC σ c`) gives the existential: the terms' values,\nwritten over the state, satisfy c. -/\ntheorem some_of_subst (σ : List (Nat × E)) (c : C) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (h : evalC ρ M (substC σ c) = true) :\n    evalC (updAll ρ ((σ.map (·.1)).map fun i => (i, applyS σ ρ M i))) M c = true := by\n  rw [evalC_updAll (σ.map (·.1)) (σ.map (·.1)) (fun i hi => applyS_other hi ρ M) c (fun _ _ h => h) M, ← subst_evalC]\n  exact h\n\n/-- A law of the ghosted machine over its ghosts vs gives, at every reachable state of the original, the existential:\nthe ghosts' values there, written over the state, satisfy it. -/\ntheorem some_of_ghost (g : SGhosted) (hg : sghostOk g = true) (vs : List Nat) (c : C)\n    (hc : avoids (g.vars.filter fun i => !vs.contains i) c = true)\n    (hl : ∀ ρ M, SReach g.full ρ M → evalC ρ M c = true) :\n    ∀ ρ M, SReach g.orig ρ M → ∃ ρg : Nat → Nat, evalC (updAll ρ (vs.map fun i => (i, ρg i))) M c = true := by\n  intro ρ M hr\n  obtain ⟨ρg, hrg, hag⟩ := sghost_reach g hg hr\n  have hc' : ∀ i, occC i c = true → i ∈ g.vars → i ∈ vs := by\n    intro i hi hV\n    by_cases hv : i ∈ vs\n    · exact hv\n    · have hp : (!vs.contains i) = true := by\n        cases h : vs.contains i with\n        | false => rfl\n        | true => exact absurd (List.contains_iff_mem.mp h) hv\n      exact absurd (List.mem_filter.mpr ⟨hV, hp⟩) (avoids_occ hc hi)\n  exact ⟨ρg, by rw [evalC_updAll vs g.vars hag c hc' M]; exact hl ρg M hrg⟩\n\nend Kern\n\n#print axioms Kern.some_of_subst\n#print axioms Kern.some_of_ghost\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",
     "BridgeRules.lean": "import Bridge\nimport Refine\nimport History\n\n/-!\nBridgeRules: the rest of today's rules carried by cyclic proofs. Lean 4.34.0, core only, on top of `Bridge.lean`.\n\nBridge.lean carries a cyclic proof's node to a machine's law about every reachable state. The rules beside the laws\nclaim more: a step law (and a k-step law) is about every k allowed requests in a row from every reachable state. Here\na node over the same encoding reads the run's last k steps up to time t, each time one step back from the next (t − 1,\nt − 1 − 1, …, as a step's fact reads the time before it): the first state at t − k, the j-th request at t − (k − j), the\nstate after them at t. Its hypotheses are among the precondition, k ≤ t, t ≤ T, T < Ω and each step's `when` at its time,\nits conclusion `then` with the plain names at t − k, each later request's inputs and the maps it carries at its time, and\nthe primed names at t (`cycKOk`). `cyc_kstep_sound`: such a node of a checked cyclic proof makes the k-step law hold, as\nSets.lean's `SKStepHolds` states it (the claim `skstep_sound` proves of the usual certificate). The run is the one a\nreachable state ends (`reach_run`), extended by the k requests (`run_ext`).\n\nFrom those, what the other rules claim, each from its claims' meaning in place of their certificates: liveness under\nfairness (`sleads_of_holds`) and weak fairness (`sleads_wf_of_holds`, a helpful request allowed being a node at the\nrun's last request, `cyc_allow_sound`), a history's laws through its plain machine (`hreach_plain`), a ghosted machine's\nlaws of the original (`cyc_ghost_holds`), a refinement (`srefines_of_holds`).\n\nFlags that hold at every key (a machine with `qflags`): Bridge.lean's encoding has none. Here the machine is read as its\nsk machine (`SMachine.sk`: the flags and their witnesses inputs a request names), whose runs, every request decided as a\ngoal reads it (`sReq`, `CRun.Decided`), are the machine's off the witnesses (`sk_step`, `sk_run`); the encoding adds the\nflags' closing conditions at each time (`cycQFacts`: 0 or 1, 0 or the body at every value of its keys, 1 or the body\nfailing at the witness), which hold on such runs (`qfacts_hold`, through Sets.lean's `closing_true`). `cyc_qmachine_sound`,\n`cyc_qkstep_sound` and `cyc_qallow_sound` are the three bridges for them.\n-/\n\nnamespace Kern\nset_option linter.unusedSimpArgs false\nset_option linter.unusedSectionVars false\n\n/-! A run extended by requests -/\n\ntheorem run_snoc_ok {s : SMachine} (hq : s.qflags = []) {r : CRun} {T : Nat} (hr : r.Ok s T) {ρ : Nat → Nat}\n    {M : Nat → Nat → Nat} (hst : r.st T = ρ) (hmp : r.mp T = M) (ι : Nat → Nat) (κ : Nat → Nat → Nat)\n    (ha : evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume = true) :\n    (r.snoc T (sNext s ρ M ι κ).1 (sNext s ρ M ι κ).2 ι κ).Ok s (T + 1) := by\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 ⟨?_, ?_, ?_, ?_, ?_, ?_⟩\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\n-- A run that ends in a state, extended by requests the machine allows one after another.\ntheorem run_ext {s : SMachine} (hq : s.qflags = []) : ∀ (qs : List SRequest) (ws : List C) (r : CRun) (T : Nat)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat), r.Ok s T → r.st T = ρ → r.mp T = M → qs.length ≤ ws.length → SAllowed s ws ρ M qs →\n    ∃ r' : CRun, r'.Ok s (T + qs.length) ∧ r'.ρ0 = r.ρ0 ∧ (∀ u, u ≤ T → r'.st u = r.st u ∧ r'.mp u = r.mp u)\n      ∧ (∀ u, u < T → r'.ι u = r.ι u ∧ r'.κ u = r.κ u)\n      ∧ (∀ j, j ≤ qs.length → r'.st (T + j) = (sEnd s ρ M (qs.take j)).1 ∧ r'.mp (T + j) = (sEnd s ρ M (qs.take j)).2)\n      ∧ (∀ j (h : j < qs.length), r'.ι (T + j) = qs[j].1 ∧ r'.κ (T + j) = qs[j].2)\n  | [], _, r, T, ρ, M, hr, hst, hmp, _, _ => by\n    refine ⟨r, hr, rfl, fun _ _ => ⟨rfl, rfl⟩, fun _ _ => ⟨rfl, rfl⟩, fun j hj => ?_, fun j hj => absurd hj (Nat.not_lt_zero j)⟩\n    have : j = 0 := by simpa using hj\n    subst this\n    simp [sEnd, hst, hmp]\n  | q :: qs, [], _, _, _, _, _, _, _, hlen, _ => by simp at hlen\n  | q :: qs, w :: ws, r, T, ρ, M, hr, hst, hmp, hlen, hK => by\n    obtain ⟨ha, _, hrest⟩ := hK\n    have hr1 := run_snoc_ok hq hr hst hmp q.1 q.2 ha\n    obtain ⟨l1, l2, l3, l4, l5, l6⟩ := snoc_last (r := r) (T := T) (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 q.1 q.2\n    obtain ⟨r', hr', h0, hle, hlt, hj, hι⟩ := run_ext hq qs ws _ (T + 1) _ _ hr1 l1 l2 (by simp at hlen; omega) hrest\n    refine ⟨r', by simpa [Nat.add_assoc, Nat.add_comm 1] using hr', h0, fun u hu => ?_, fun u hu => ?_, fun j hjl => ?_, fun j hjl => ?_⟩\n    · obtain ⟨a, b⟩ := hle u (by omega)\n      rw [a, b]; simp [CRun.snoc, hu]\n    · obtain ⟨a, b⟩ := hlt u (by omega)\n      rw [a, b]; simp [CRun.snoc, hu]\n    · cases j with\n      | zero =>\n        obtain ⟨a, b⟩ := hle T (by omega)\n        rw [Nat.add_zero, a, b, l3, l4, hst, hmp]; simp [sEnd]\n      | succ j =>\n        obtain ⟨a, b⟩ := hj j (by simp at hjl; omega)\n        rw [show T + (j + 1) = T + 1 + j by omega, a, b]\n        simp [sEnd]\n    · cases j with\n      | zero =>\n        obtain ⟨a, b⟩ := hlt T (by omega)\n        rw [Nat.add_zero, a, b, l5, l6]; simp\n      | succ j =>\n        obtain ⟨a, b⟩ := hι j (by simp at hjl; omega)\n        rw [show T + (j + 1) = T + 1 + j by omega, a, b]\n        simp\n\n-- Each `when` along the requests: the j-th met at the state the first j steps reach.\ntheorem sallowed_at {s : SMachine} : ∀ (qs : List SRequest) (ws : List C) (ρ : Nat → Nat) (M : Nat → Nat → Nat),\n    SAllowed s ws ρ M qs → ∀ j (hq : j < qs.length) (hw : j < ws.length),\n      evalC (withExt s (sEnd s ρ M (qs.take j)).1 (sReq s (sEnd s ρ M (qs.take j)).1 (sEnd s ρ M (qs.take j)).2 qs[j].1 qs[j].2))\n        (withCarried s (sEnd s ρ M (qs.take j)).2 qs[j].2) ws[j] = true\n  | [], _, _, _, _, j, hq, _ => absurd hq (Nat.not_lt_zero j)\n  | _ :: _, [], _, _, _, j, _, hw => absurd hw (Nat.not_lt_zero j)\n  | q :: qs, w :: ws, ρ, M, hK, j, hq, hw => by\n    obtain ⟨_, hW, hrest⟩ := hK\n    cases j with\n    | zero => simpa [sEnd] using hW\n    | succ j =>\n      have := sallowed_at qs ws _ _ hrest j (by simp at hq; omega) (by simp at hw; omega)\n      simpa [sEnd] using this\n\n/-! A machine with no flag at every key and no witness reads its request plainly -/\n\ntheorem sReq_plain {s : SMachine} (hq : s.qflags = []) (hw : s.wits = []) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (ι : Nat → Nat) (κ : Nat → Nat → Nat) (v : Nat) : sReq s ρ M ι κ v = if s.f.m.inputs.contains v then ι v else 0 := by\n  simp only [sReq, hq, hw, lookup]\n\ntheorem withExt_plain {s : SMachine} (hq : s.qflags = []) (hw : s.wits = []) (ρ e : Nat → Nat) (v : Nat) :\n    withExt s ρ e v = if s.f.m.inputs.contains v then e v else ρ v := by\n  simp only [withExt, SMachine.extVars, SMachine.qVars, SMachine.wVars, hq, hw, List.map_nil, List.flatMap_nil, List.append_nil]\n\ntheorem sExts_plain {s : SMachine} (hq : s.qflags = []) (hw : s.wits = []) : ∀ (ρ : Nat → Nat) (M : Nat → Nat → Nat) (qs : List SRequest),\n    sExts s ρ M qs = qs.map (fun q v => if s.f.m.inputs.contains v then q.1 v else 0)\n  | _, _, [] => rfl\n  | ρ, M, q :: qs => by\n    simp only [sExts, List.map_cons, sExts_plain hq hw _ _ qs]\n    congr 1; funext v; exact sReq_plain hq hw ρ M q.1 q.2 v\n\n/-! The encoding of a k-step law -/\n\n-- Time t − n, one step back at a time (t − 1 − 1 …), as a step's fact reads the time before it: the j-th state of k at\n-- t − (k − j), the last at t.\ndef tBack (ce : CycEnc) : Nat → E\n  | 0 => .var ce.t\n  | n + 1 => .sub (tBack ce n) (.const 1)\n\ntheorem tBack_eval (ce : CycEnc) (Q : Nat → Nat) (M : Nat → Nat → Nat) : ∀ n, evalE Q M (tBack ce n) = Q ce.t - n\n  | 0 => by simp [tBack, evalE]\n  | n + 1 => by simp [tBack, evalE, tBack_eval ce Q M n]; omega\n\n-- The same times read t − n at once (as core/translate.ts's step laws over several steps read them).\ndef tSub (ce : CycEnc) : Nat → E\n  | 0 => .var ce.t\n  | n + 1 => .sub (.var ce.t) (.const (n + 1))\n\ntheorem tSub_eval (ce : CycEnc) (Q : Nat → Nat) (M : Nat → Nat → Nat) : ∀ n, evalE Q M (tSub ce n) = Q ce.t - n\n  | 0 => by simp [tSub, evalE]\n  | n + 1 => by simp [tSub, evalE]\n\n-- Either: one step back at a time (b), or at once.\ndef tAtS (tb : Bool) (ce : CycEnc) (n : Nat) : E := if tb then tBack ce n else tSub ce n\n\ntheorem tAtS_eval (tb : Bool) (ce : CycEnc) (Q : Nat → Nat) (M : Nat → Nat → Nat) (n : Nat) : evalE Q M (tAtS tb ce n) = Q ce.t - n := by\n  cases tb\n  · simp only [tAtS, Bool.false_eq_true, ↓reduceIte]; exact tSub_eval ce Q M n\n  · simp only [tAtS, ↓reduceIte]; exact tBack_eval ce Q M n\n\n-- The map over time of a traced variable, and of a map.\ndef cycVM (ce : CycEnc) (x : Nat) : Nat := ((lookup (fun p => p.1 == x) ce.vtr).map (·.2)).getD 0\ndef cycMM (ce : CycEnc) (m : Nat) : Nat := ((lookup (fun p => p.1 == m) ce.mtr).map (·.2)).getD 0\n\n-- Each later request's inputs at their fresh names, read at its time (of k steps, the j-th at t − (k − j)).\ndef kRenσ (tb : Bool) (ce : CycEnc) (k : Nat) : Nat → List (List (Nat × Nat)) → List (Nat × E)\n  | _, [] => []\n  | j, r :: rs => r.map (fun p => (p.2, .get (cycVM ce p.1) (tAtS tb ce (k - j)))) ++ kRenσ tb ce k (j + 1) rs\n\n-- The step and the carried map a fresh map name stands for.\ndef kMren : Nat → List (List (Nat × Nat)) → Nat → Option (Nat × Nat)\n  | _, [], _ => none\n  | j, r :: rs, m => match lookup (fun p => p.2 == m) r with\n    | some p => some (j, p.1)\n    | none => kMren (j + 1) rs m\n\n-- `then` over the run of k steps ending at t: primed names at t, each later request's inputs at its time, the rest at\n-- t − k.\ndef kσ (tb : Bool) (ce : CycEnc) (sl : SKStep) : List (Nat × E) :=\n  sl.k.prime.map (fun q => (q.2, .get (cycVM ce q.1) (tAtS tb ce 0))) ++ kRenσ tb ce sl.k.whens.length 0 sl.k.ren\n    ++ cycσ ce (tAtS tb ce sl.k.whens.length)\ndef kRd (tb : Bool) (ce : CycEnc) (sl : SKStep) : Nat → E → E := fun m key =>\n  match lookup (fun q => q.2 == m) sl.k.primeMaps with\n  | some q => .get (cycMM ce q.1) (.add (tAtS tb ce 0) (.prod key (.var ce.om)))\n  | none => match kMren 0 sl.mren m with\n    | some p => .get (cycMM ce p.2) (.add (tAtS tb ce (sl.k.whens.length - p.1)) (.prod key (.var ce.om)))\n    | none => cycRd ce (tAtS tb ce sl.k.whens.length) m key\n\n-- Each step's `when` at its time.\ndef kWhens (tb : Bool) (ce : CycEnc) (k : Nat) : Nat → List C → List C\n  | _, [] => []\n  | j, w :: ws => trC ce (tAtS tb ce (k - j)) w :: kWhens tb ce k (j + 1) ws\n\ntheorem kWhens_mem (tb : Bool) (ce : CycEnc) (k : Nat) : ∀ (j : Nat) (ws : List C) {c : C}, c ∈ kWhens tb ce k j ws → ∃ i, ∃ h : i < ws.length, c = trC ce (tAtS tb ce (k - (j + i))) ws[i]\n  | _, [], _, h => by simp [kWhens] at h\n  | j, w :: ws, c, h => by\n    simp only [kWhens, List.mem_cons] at h\n    rcases h with rfl | h\n    · exact ⟨0, by simp, by simp⟩\n    · obtain ⟨i, hi, rfl⟩ := kWhens_mem tb ce k (j + 1) ws h\n      exact ⟨i + 1, by simp; omega, by simp [Nat.add_assoc, Nat.add_comm 1 i]⟩\n\n/-- A k-step law's node, checked against the machine's encoding: the encoding fits the machine as for its laws, the\nlaw's fresh names stand for traced inputs and state variables and the maps for maps over time, `then` and each `when`\nread no added variable, flag or map over time, the conclusion is `then` over the run (`kσ`, `kRd`) and the hypotheses\nare among the precondition, k ≤ t, t ≤ T, T < Ω and each step's `when` at its time. -/\ndef cycKOkAt (tb : Bool) (s : SMachine) (ce : CycEnc) (facts : List Fact) (sl : SKStep) (n : CNode) : Bool :=\n  cycShapeOk s ce [] && cycTermsOk s ce [] && s.wits.isEmpty && cycFactsIn s ce facts\n    && sl.k.ren.length == sl.k.whens.length && sl.mren.length == sl.k.whens.length\n    && sl.k.ren.all (fun r => r.all fun p => s.f.m.inputs.contains p.1)\n    && sl.k.prime.all (fun q => (ce.vtr.map (·.1)).contains q.1 && !s.f.m.inputs.contains q.1)\n    && sl.mren.all (fun r => r.all fun p => s.carried.contains p.1 && !ce.tm.contains p.2)\n    && sl.k.primeMaps.all (fun q => (ce.mtr.map (·.1)).contains q.1 && !s.carried.contains q.1 && !ce.tm.contains q.2)\n    && avoids (ce.special ++ flagVars s.f.flags) sl.k.then_ && avoidsMaps ce.tm sl.k.then_\n    && sl.k.whens.all (fun w => avoids (ce.special ++ flagVars s.f.flags) w && avoidsMaps ce.tm w)\n    && beqC n.concl (substRC (kσ tb ce sl) (kRd tb ce sl) sl.k.then_)\n    && n.hyps.all (fun h => beqC h s.f.m.pre || beqC h (.le (.const sl.k.whens.length) (.var ce.t)) || beqC h (.le (.var ce.t) (.var ce.T))\n      || beqC h (.lt (.var ce.T) (.var ce.om)) || (kWhens tb ce sl.k.whens.length 0 sl.k.whens).any (beqC h))\n\n/-! The encoding read back -/\n\ntheorem applyS_app (A B : List (Nat × E)) (Q : Nat → Nat) (M : Nat → Nat → Nat) (v : Nat) :\n    applyS (A ++ B) Q M v = match assoc A v with | some e => evalE Q M e | none => applyS B Q M v := by\n  simp only [applyS, assoc_append_or]; cases assoc A v <;> simp [Option.or]\n\ntheorem assoc_ren (r : List (Nat × Nat)) (g : Nat × Nat → E) (v : Nat) :\n    assoc (r.map (fun p => (p.2, g p))) v = (lookup (fun p => p.2 == v) r).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\ntheorem not_tgt_cons {r : List (Nat × Nat)} {rs : List (List (Nat × Nat))} {v : Nat} (hv : v ∈ tgts (r :: rs))\n    (hn : lookup (fun p => p.2 == v) r = none) : v ∈ tgts rs := by\n  simp only [tgts, List.mem_append] at hv\n  rcases hv with h | h\n  · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n    have := lookup_none_all hn p hp; simp at this\n  · exact h\n\n-- Each later request's inputs at their fresh names: the run's request at its time, as renEnv reads it.\ntheorem kRen_eval (tb : Bool) (ce : CycEnc) (k : Nat) (Q : Nat → Nat) (cm : Nat → Nat → Nat) (b : Nat → Nat) (rest : List (Nat × E)) :\n    ∀ (rs : List (List (Nat × Nat))) (j : Nat) (ιs : List (Nat → Nat)), rs.length ≤ ιs.length →\n      (∀ i (hi : i < rs.length) (hι : i < ιs.length), ∀ p ∈ rs[i], evalE Q cm (.get (cycVM ce p.1) (tAtS tb ce (k - (j + i)))) = ιs[i] p.1) →\n      ∀ v, v ∈ tgts rs → applyS (kRenσ tb ce k j rs ++ rest) Q cm v = renEnv rs ιs b v\n  | [], _, _, _, _, v, hv => by simp [tgts] at hv\n  | _ :: _, _, [], hl, _, _, _ => by simp at hl\n  | r :: rs, j, ι :: ιs, hl, hX, v, hv => by\n    simp only [kRenσ, List.append_assoc]\n    rw [applyS_app, assoc_ren]\n    simp only [renEnv]\n    cases hr : lookup (fun p => p.2 == v) r with\n    | some p =>\n      have h0 := hX 0 (by simp) (by simp) p (lookup_some hr).1\n      simp only [Nat.add_zero, List.getElem_cons_zero] at h0\n      simpa using h0\n    | none =>\n      simp only [Option.map_none]\n      exact kRen_eval tb ce k Q cm b rest rs (j + 1) ιs (by simp at hl; omega)\n        (fun i hi hι p hp => by\n          have := hX (i + 1) (by simp; omega) (by simp; omega) p (by simpa using hp)\n          simpa [Nat.add_assoc, Nat.add_comm 1 i] using this) v (not_tgt_cons hv hr)\n\ntheorem kRen_out (tb : Bool) (ce : CycEnc) (k : Nat) (Q : Nat → Nat) (cm : Nat → Nat → Nat) (rest : List (Nat × E)) :\n    ∀ (rs : List (List (Nat × Nat))) (j : Nat) (v : Nat), v ∉ tgts rs → applyS (kRenσ tb ce k j rs ++ rest) Q cm v = applyS rest Q cm v\n  | [], _, _, _ => by simp [kRenσ]\n  | r :: rs, j, v, hv => by\n    simp only [kRenσ, List.append_assoc]\n    rw [applyS_app, assoc_ren]\n    have hn : lookup (fun p => p.2 == v) r = none := lookup_none (fun p hp => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hv (by simp only [tgts, List.mem_append]; exact Or.inl (List.mem_map.mpr ⟨p, hp, he⟩)))\n    simp only [hn, Option.map_none]\n    exact kRen_out tb ce k Q cm rest rs (j + 1) v (fun h => hv (by simp only [tgts, List.mem_append]; exact Or.inr h))\n\n-- The maps a later request carries at their fresh names: the run's at its time, as renMaps reads them.\ntheorem kMren_eval : ∀ (rs : List (List (Nat × Nat))) (j : Nat) (κs : List (Nat → Nat → Nat)) (b : Nat → Nat → Nat) (m : Nat),\n    rs.length ≤ κs.length →\n      (kMren j rs m = none → renMaps rs κs b m = b m)\n      ∧ (∀ i c, kMren j rs m = some (i, c) → ∃ (i' : Nat) (hi : i' < rs.length) (hκ : i' < κs.length), i = j + i'\n          ∧ (∃ p ∈ rs[i'], p.1 = c ∧ p.2 = m) ∧ renMaps rs κs b m = κs[i'] c)\n  | [], _, κs, b, m, _ => ⟨fun _ => by cases κs <;> rfl, fun _ _ h => by simp [kMren] at h⟩\n  | _ :: _, _, [], _, _, hl => by simp at hl\n  | r :: rs, j, κ :: κs, b, m, hl => by\n    have ih := kMren_eval rs (j + 1) κs b m (by simp at hl; omega)\n    cases hr : lookup (fun p => p.2 == m) r with\n    | some p =>\n      refine ⟨fun h => by simp [kMren, hr] at h, fun i c h => ?_⟩\n      simp only [kMren, hr, Option.some.injEq, Prod.mk.injEq] at h\n      obtain ⟨rfl, rfl⟩ := h\n      exact ⟨0, by simp, by simp, by simp, ⟨p, by simpa using (lookup_some hr).1, rfl, by simpa using (lookup_some hr).2⟩, by simp [renMaps, hr]⟩\n    | none =>\n      refine ⟨fun h => ?_, fun i c h => ?_⟩\n      · simp only [kMren, hr] at h; simp only [renMaps, hr]; exact ih.1 h\n      · simp only [kMren, hr] at h\n        obtain ⟨i', hi, hκ, rfl, hp, he⟩ := ih.2 i c h\n        exact ⟨i' + 1, by simp; omega, by simp; omega, by omega, by simpa using hp, by simp [renMaps, hr, he]⟩\n\ntheorem cycVM_spec {ce : CycEnc} {x : Nat} (h : x ∈ ce.vtr.map (·.1)) : ∃ p ∈ ce.vtr, p.1 = x ∧ cycVM ce x = p.2 := by\n  cases hl : lookup (fun p => p.1 == x) ce.vtr with\n  | none => obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; have := lookup_none_all hl p hp; simp at this\n  | some p => exact ⟨p, (lookup_some hl).1, by simpa using (lookup_some hl).2, by simp [cycVM, hl]⟩\ntheorem cycMM_spec {ce : CycEnc} {m : Nat} (h : m ∈ ce.mtr.map (·.1)) : ∃ p ∈ ce.mtr, p.1 = m ∧ cycMM ce m = p.2 := by\n  cases hl : lookup (fun p => p.1 == m) ce.mtr with\n  | none => obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; have := lookup_none_all hl p hp; simp at this\n  | some p => exact ⟨p, (lookup_some hl).1, by simpa using (lookup_some hl).2, by simp [cycMM, hl]⟩\n\n-- A traced variable's map over time, read at a time within the run: the run's state with its request there.\ntheorem read_vm {s : SMachine} {ce : CycEnc} {r : CRun} {om : Nat} (hd : distinct ce.tm = true) {x : Nat} (hx : x ∈ ce.vtr.map (·.1)) (u : Nat) :\n    cycMaps s ce r om (cycVM ce x) u = r.X s u x := by\n  obtain ⟨p, hp, rfl, he⟩ := cycVM_spec hx\n  rw [he, cm_v hd hp]\n-- A map's map over time, read at a time within the run and a key.\ntheorem read_mm {s : SMachine} {ce : CycEnc} {r : CRun} {T : Nat} (hd : distinct ce.tm = true) {m : Nat} (hm : m ∈ ce.mtr.map (·.1))\n    {u : Nat} (hu : u ≤ T) (kv : Nat) : cycMaps s ce r (T + 1) (cycMM ce m) (u + kv * (T + 1)) = r.N s u m kv := by\n  obtain ⟨p, hp, rfl, he⟩ := cycMM_spec hm\n  rw [he, cm_m hd hp]; simp only [pair_mod hu, pair_div hu]\n\n/-! The bridge for step laws and k-step laws -/\n\n-- The bridge for one time form (`tAtS b`).\ntheorem cyc_kstep_sound_at (tb : Bool) (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (sl : SKStep) (n : CNode) (hn : n ∈ nodes) (hok : cycKOkAt tb s ce facts sl n = true) : SKStepHolds s sl := by\n  simp only [cycKOkAt, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hok\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hsh, hte⟩, hwit⟩, hfa⟩, hrl⟩, hml⟩, hrin⟩, hpr⟩, hmr⟩, hpm⟩, hthv⟩, hthm⟩, hwh⟩, hcon⟩, hhy⟩ := hok\n  have hS := cycShape_of hsh\n  have hT := cycTerms_of hte\n  have hW : s.wits = [] := isEmpty_nil hwit\n  have hsp := special_parts hS.dsp\n  intro ρ M hr q₁ qs hlen hK\n  obtain ⟨r, T0, hr0, hst, hmp⟩ := reach_run hS.q hr\n  obtain ⟨r', hr', _, _, _, hj, hι⟩ := run_ext hS.q (q₁ :: qs) sl.k.whens r T0 ρ M hr0 hst hmp (by simp; omega) hK\n  have hk : sl.k.whens.length = (q₁ :: qs).length := by simp; omega\n  -- The node's environment: t and T the run's end (the last state's time), Ω one above it, the rest from before the\n  -- start.\n  obtain ⟨Q, hQt, hQT, hQo, hQr⟩ : ∃ Q : Nat → Nat, Q ce.t = T0 + (q₁ :: qs).length ∧ Q ce.T = T0 + (q₁ :: qs).length ∧ Q ce.om = T0 + (q₁ :: qs).length + 1\n      ∧ ∀ i, i ∉ ce.special → Q i = r'.ρ0 i :=\n    ⟨fun i => if i = ce.t then T0 + (q₁ :: qs).length else if i = ce.T then T0 + (q₁ :: qs).length else if i = ce.om then T0 + (q₁ :: qs).length + 1 else r'.ρ0 i,\n      by simp, by simp [Ne.symm hsp.2.2.2.2.2.1], by simp [Ne.symm hsp.2.2.2.2.2.2, Ne.symm hsp.2.2.2.2.1],\n      fun i hi => by\n        dsimp only\n        rw [if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inr e)))))), if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inl e))))),\n          if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inl e))))))]⟩\n  have hEnv : EnvOk s ce [] r' (T0 + (q₁ :: qs).length) Q := ⟨hQT, hQo, fun i hi => hQr i (notP hi).1⟩\n  -- The state at each time, and each request at its time.\n  have hst0 : r'.st T0 = ρ ∧ r'.mp T0 = M := by simpa [sEnd] using hj 0 (by simp)\n  have hι0 : r'.ι T0 = q₁.1 ∧ r'.κ T0 = q₁.2 := by\n    have h := hι 0 (by simp); simp only [Nat.add_zero, List.getElem_cons_zero] at h; exact h\n  have hend : r'.st (T0 + (q₁ :: qs).length) = (sEnd s ρ M (q₁ :: qs)).1 ∧ r'.mp (T0 + (q₁ :: qs).length) = (sEnd s ρ M (q₁ :: qs)).2 := by\n    simpa using hj (q₁ :: qs).length (Nat.le_refl _)\n  have hframe : ∀ u, u ≤ T0 + (q₁ :: qs).length → ∀ i, i ∉ ce.vtr.map (·.1) → i ∉ flagVars s.f.flags → r'.st u i = r'.ρ0 i := fun u hu i hv hf =>\n    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)) (fun h => hv (hS.inv i h)) hf\n  have hw0 : evalE Q (cycMaps s ce r' (T0 + (q₁ :: qs).length + 1)) (tAtS tb ce sl.k.whens.length) = T0 := by rw [tAtS_eval tb, hQt, hk]; omega\n  -- The facts hold of the run.\n  have hF : FactsHold facts Q (cycMaps s ce r' (T0 + (q₁ :: qs).length + 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  -- The node's hypotheses hold there.\n  have hH : ∀ c ∈ n.hyps, evalC Q (cycMaps s ce r' (T0 + (q₁ :: qs).length + 1)) c = true := by\n    intro c hc\n    have h := hhy c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with (((h | h) | 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, hQt, hk]; omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQt, hQT]; omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQT, hQo]; omega\n    · obtain ⟨c', hc', hb⟩ := List.any_eq_true.mp h\n      rw [beqC_eq hb]\n      obtain ⟨i, hi, rfl⟩ := kWhens_mem tb ce sl.k.whens.length 0 sl.k.whens hc'\n      have hiq : i < (q₁ :: qs).length := by omega\n      have hu : T0 + i ≤ T0 + (q₁ :: qs).length := by omega\n      have hwi : evalE Q (cycMaps s ce r' (T0 + (q₁ :: qs).length + 1)) (tAtS tb ce (sl.k.whens.length - (0 + i))) = T0 + i := by rw [tAtS_eval tb, hQt, hk]; omega\n      have hall := sallowed_at (q₁ :: qs) sl.k.whens ρ M hK i hiq hi\n      obtain ⟨hsti, hmpi⟩ := hj i (by omega)\n      obtain ⟨hιi, hκi⟩ := hι i hiq\n      have hav := hwh _ (List.getElem_mem hi)\n      rw [enc_trC hS hT hr' hEnv hwi hu]\n      rw [congr2C (ρ' := withExt s (sEnd s ρ M ((q₁ :: qs).take i)).1 (sReq s (sEnd s ρ M ((q₁ :: qs).take i)).1 (sEnd s ρ M ((q₁ :: qs).take i)).2 (q₁ :: qs)[i].1 (q₁ :: qs)[i].2))\n        (M' := withCarried s (sEnd s ρ M ((q₁ :: qs).take i)).2 (q₁ :: qs)[i].2) _ ?_ ?_]\n      · exact hall\n      · intro x hx\n        have hxz := avoids_occ hav.1 hx\n        rw [withExt_plain hS.q hW, sReq_plain hS.q hW]\n        by_cases hv : x ∈ ce.vtr.map (·.1)\n        · rw [enc_σ_in hS hT hr' hEnv hwi hu hv, CRun.X, hsti, hιi]; simp only [withInputs]; split <;> rfl\n        · have hxi : x ∉ s.f.m.inputs := fun h => hv (hS.inv x h)\n          rw [enc_σ_out hS hT hr' hEnv hwi hu hv, if_neg (fun h => hxi (List.contains_iff_mem.mp h)), ← hsti,\n            hframe _ hu x hv (fun h => hxz (List.mem_append_right _ h))]\n          exact hQr x (fun h => hxz (List.mem_append_left _ h))\n      · intro m hm\n        rw [cv_N (avoidsMaps_occ hav.2 hm), CRun.N, hmpi, hκi]\n  have hc0 := cyclic_sound facts nodes hc (cycMaps s ce r' (T0 + (q₁ :: qs).length + 1)) Q hF n hn hH\n  rw [beqC_eq hcon] at hc0\n  -- `then` over the run: the maps it reads, then its names.\n  have hTle : T0 ≤ T0 + (q₁ :: qs).length := Nat.le_add_right _ _\n  let Mt : Nat → Nat → Nat := primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 (renMaps sl.mren ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2))\n  have hrd : ∀ m key, evalE Q (cycMaps s ce r' (T0 + (q₁ :: qs).length + 1)) (kRd tb ce sl m key)\n      = (fun m => if ce.tm.contains m then cycMaps s ce r' (T0 + (q₁ :: qs).length + 1) m else Mt m) m\n        (evalE Q (cycMaps s ce r' (T0 + (q₁ :: qs).length + 1)) key) := by\n    intro m key\n    simp only [kRd]\n    cases hq : lookup (fun q => q.2 == m) sl.k.primeMaps with\n    | some q =>\n      obtain ⟨hqm, hqe⟩ := lookup_some hq\n      have hqe' : q.2 = m := by simpa using hqe\n      obtain ⟨⟨hq1, hq2⟩, hq3⟩ := hpm q hqm\n      have hnt : ¬ ce.tm.contains m = true := by rw [← hqe']; simpa using hq3\n      simp only [evalE, tAtS_eval tb, hQt, hQo, Nat.sub_zero]\n      rw [read_mm hS.dtm (List.contains_iff_mem.mp hq1) (Nat.le_refl _), N_not_carried (by simpa using hq2), hend.2, if_neg hnt]\n      simp only [Mt, primedMaps, hq]\n    | none =>\n      have hkm := kMren_eval sl.mren 0 ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2) m (by simp; omega)\n      cases hkr : kMren 0 sl.mren m with\n      | some p =>\n        obtain ⟨i', hi', hκ', hi0, ⟨p', hp', hp1, hp2⟩, hren⟩ := hkm.2 p.1 p.2 hkr\n        obtain ⟨hcar, hnt0⟩ := hmr _ (List.getElem_mem hi') p' hp'\n        have hnt : ¬ ce.tm.contains m = true := by rw [← hp2]; simpa using hnt0\n        have hiq : i' < (q₁ :: qs).length := by simpa using hκ'\n        obtain ⟨hιi, hκi⟩ := hι i' hiq\n        simp only [evalE, tAtS_eval tb, hQt, hQo, hi0, Nat.zero_add]\n        rw [show T0 + (q₁ :: qs).length - (sl.k.whens.length - i') = T0 + i' by rw [hk]; omega]\n        rw [read_mm hS.dtm (hS.carm _ (by rw [← hp1]; exact List.contains_iff_mem.mp hcar)) (by omega), CRun.N, hκi, if_neg hnt]\n        simp only [Mt, primedMaps, hq, hren, withCarried, ← hp1, hcar, if_true, List.getElem_map]\n      | none =>\n        rw [enc_rd hS hT hr' hEnv hw0 hTle]\n        simp only [cycView]\n        by_cases ht : ce.tm.contains m = true\n        · rw [if_pos ht, if_pos ht]\n        · rw [if_neg ht, if_neg ht, CRun.N, hst0.2, hι0.2]\n          simp only [Mt, primedMaps, hq, hkm.1 hkr]\n  rw [substR_evalC (kσ tb ce sl) (kRd tb ce sl) Q _ _ hrd] at hc0\n  rw [congr2C (ρ' := primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 (renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))))\n    (M' := Mt) _ ?_ ?_] at hc0\n  · exact hc0\n  · intro x hx\n    have hxz := avoids_occ hthv hx\n    simp only [kσ, List.append_assoc]\n    rw [applyS_app, assoc_ren]\n    simp only [primed]\n    cases hq : lookup (fun q => q.2 == x) sl.k.prime with\n    | some q =>\n      obtain ⟨hqm, _⟩ := lookup_some hq\n      obtain ⟨hq1, hq2⟩ := hpr q hqm\n      simp only [Option.map_some, evalE, tAtS_eval tb, hQt, Nat.sub_zero]\n      rw [read_vm hS.dtm (List.contains_iff_mem.mp hq1), CRun.X, withInputs_other (by simpa using hq2), hend.1]\n    | none =>\n      simp only [Option.map_none]\n      by_cases hxr : x ∈ tgts sl.k.ren\n      · rw [kRen_eval tb ce sl.k.whens.length Q _ _ _ sl.k.ren 0 (sExts s ρ M (q₁ :: qs)) (by rw [sExts_plain hS.q hW]; simp; omega) ?_ x hxr]\n        intro i hi hιl p hp\n        have hpin := hrin _ (List.getElem_mem hi) p hp\n        have hiq : i < (q₁ :: qs).length := by rw [sExts_plain hS.q hW] at hιl; simpa using hιl\n        obtain ⟨hιi, _⟩ := hι i hiq\n        simp only [evalE, tAtS_eval tb, hQt, Nat.zero_add]\n        rw [show T0 + (q₁ :: qs).length - (sl.k.whens.length - i) = T0 + i by rw [hk]; omega]\n        rw [read_vm hS.dtm (hS.inv _ (List.contains_iff_mem.mp hpin)), CRun.X]\n        simp only [withInputs, hpin, if_true, hιi]\n        have hx : ∀ (l : List (Nat → Nat)), l = (q₁ :: qs).map (fun q v => if s.f.m.inputs.contains v then q.1 v else 0) →\n            ∀ h : i < l.length, (q₁ :: qs)[i].1 p.1 = l[i] p.1 := by\n          intro l hl h; subst hl; simp only [List.getElem_map, hpin, if_true]\n        exact hx _ (sExts_plain hS.q hW _ _ _) hιl\n      · rw [kRen_out tb ce sl.k.whens.length Q _ _ sl.k.ren 0 x hxr, renEnv_other _ _ _ x hxr, withExt_plain hS.q hW, sReq_plain hS.q hW]\n        by_cases hv : x ∈ ce.vtr.map (·.1)\n        · rw [enc_σ_in hS hT hr' hEnv hw0 hTle hv, CRun.X, hst0.1, hι0.1]; simp only [withInputs]; split <;> rfl\n        · have hxi : x ∉ s.f.m.inputs := fun h => hv (hS.inv x h)\n          rw [enc_σ_out hS hT hr' hEnv hw0 hTle hv, if_neg (fun h => hxi (List.contains_iff_mem.mp h)), ← hst0.1,\n            hframe _ hTle x hv (fun h => hxz (List.mem_append_right _ h))]\n          exact hQr x (fun h => hxz (List.mem_append_left _ h))\n  · intro m hm\n    simp only [if_neg (fun h => avoidsMaps_occ hthm hm (List.contains_iff_mem.mp h))]\n\n-- A step law's node with its times either way (`cycKOkAt`).\ndef cycKOk (s : SMachine) (ce : CycEnc) (facts : List Fact) (sl : SKStep) (n : CNode) : Bool :=\n  cycKOkAt true s ce facts sl n || cycKOkAt false s ce facts sl n\n\n/-- A cyclic proof of a k-step law (a step law, k = 1), checked against the machine's encoding (`cycKOk`): from every\nreachable state, every k requests in a row the machine allows, each meeting its `when`, end where `then` holds. -/\ntheorem cyc_kstep_sound (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (sl : SKStep) (n : CNode) (hn : n ∈ nodes) (hok : cycKOk s ce facts sl n = true) : SKStepHolds s sl := by\n  simp only [cycKOk, Bool.or_eq_true] at hok\n  rcases hok with h | h\n  · exact cyc_kstep_sound_at true s ce facts nodes hc sl n hn h\n  · exact cyc_kstep_sound_at false s ce facts nodes hc sl n hn h\n\n/-! Liveness from step laws -/\n\n-- A step law Lean builds from a liveness (Live.lean's `sliveStep`), with no certificate: one `when`, its `then`, the\n-- liveness's primed names.\ndef liveK (l : Live) (w t : C) : SKStep := ⟨⟨[w], t, [[]], l.prime, l.primeMaps, [], ([], .leaf [] [] [] [])⟩, [[]], [], [], [], [], [], []⟩\n\n/-- Liveness under fairness from its step laws: if the liveness reads what it may (`sliveOk`) and the step laws Lean\nbuilds from it hold (`SKStepHolds`, a cyclic proof's through `cyc_kstep_sound`), then along every run that takes each\nhelpful request infinitely often, each state where `from` holds is followed by one where `to` holds. `sleads_sound`\nwith the step laws' meaning in place of their certificates. -/\ntheorem sleads_of_holds (s : SMachine) (l : Live) (hok : sliveOk s l = true)\n    (hs : SKStepHolds s (liveK l l.pend (liveStayC l))) (hc : SKStepHolds s (liveK l l.pend (liveCoverC l)))\n    (hh : ∀ h ∈ l.helps, SKStepHolds s (liveK l (liveHelpWhen l h) (liveHelpThen l))) (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  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_holds_one hs rfl rfl rfl _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_holds_one hc rfl rfl rfl _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    have := skstep_holds_one (hh h hmem) rfl rfl rfl _ _ (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_list (fun p hp => hreqs h hmem p hp) (fun p hp' => hH p hp')\n\n/-! Histories through their plain machine -/\n\n/-- A machine with a history reaches only states its plain machine reaches, once the record goals and the history's\nside conditions check (`checkHMachine` with no laws: `histOk`, the record goals, the plain machine's own conditions). -/\ntheorem hreach_plain (h : HMachine) (rs : List (List VDef × Tree)) (hc : checkHMachine h [] rs = true) :\n    ∀ ρ M hist, HReach h ρ M hist → SReach h.plain ρ M := by\n  simp only [checkHMachine, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hc\n  obtain ⟨⟨⟨hok, hlen⟩, hgoals⟩, hsm⟩ := hc\n  have hrs : ∀ r ∈ h.rels, ∃ tt : List VDef × Tree, checkGoal ⟨tt.1, recordGoal h r⟩ tt.2 = true := by\n    intro r hr\n    obtain ⟨tt, htt⟩ := zip_mem_left h.rels rs hlen.symm r hr\n    exact ⟨tt, hgoals (r, tt) htt⟩\n  intro ρ M hist hr\n  exact hreach_sreach [] (histOk_sound hok) hrs hsm hr\n\n/-! Ghosts -/\n\n/-- A law of a ghosted machine (a cyclic proof's, as `cyc_machine_sound` states it) that reads no ghost holds in every\nreachable state of the original, at every value of its keys. -/\ntheorem cyc_ghost_holds (g : SGhosted) (hg : sghostOk g = true) (law : C) (keys : List Nat) (hav : avoids g.vars law = true)\n    (hl : ∀ ρ M, SReach g.full ρ M → ∀ ρ' : Nat → Nat, (∀ i, i ∉ keys → ρ' i = ρ i) → evalC ρ' M law = true) :\n    ∀ ρ M, SReach g.orig ρ M → ∀ ρ' : Nat → Nat, (∀ i, i ∉ keys → ρ' i = ρ i) → evalC ρ' M law = true := by\n  intro ρ M hr ρ' hρ'\n  obtain ⟨ρg, hrg, hag⟩ := sghost_reach g hg hr\n  have h := hl ρg M hrg (fun i => if keys.contains i then ρ' i else ρg i) (fun i hi => by\n    rw [if_neg (fun h => hi (List.contains_iff_mem.mp h))])\n  rw [congrC _ ρ' M law (fun i hi => by\n    by_cases hk : keys.contains i = true\n    · rw [if_pos hk]\n    · rw [if_neg hk, hag i (avoids_occ hav hi), hρ' i (fun h => hk (List.contains_iff_mem.mpr h))])] at h\n  exact h\n\n/-! A helpful request allowed, and liveness under weak fairness -/\n\n/-- A request allowed: from every reachable state, every request that meets `w`, carrying empty sets, is one the\nmachine allows (its assumption holds, the flags decided): what `sallow_sound` proves of the usual certificate. -/\ndef AllowHolds (s : SMachine) (w : C) : Prop :=\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\n\n-- A carried map's cell at time t, 0: the request at t carries empty sets.\ndef cycZeroOk (s : SMachine) (ce : CycEnc) : C → Bool\n  | .eq (.get m (.add (.var a) (.prod _ (.var b)))) (.const 0) => a == ce.t && b == ce.om && s.carried.any (fun c => cycMM ce c == m)\n  | _ => false\n\n/-- A request allowed, as a node at time t over the machine's encoding: the request taken at t (the run's last, which no\nstep reads) is the one the claim is about. The node's conclusion is the assumption at t, flags inlined; its hypotheses\namong the precondition, t ≤ T, T < Ω, `w` at t, and a carried map's cell at t being 0. -/\ndef cycAOk (s : SMachine) (ce : CycEnc) (facts : List Fact) (w : C) (n : CNode) : Bool :=\n  cycShapeOk s ce [] && cycTermsOk s ce [] && s.wits.isEmpty && cycFactsIn s ce facts\n    && avoids (ce.special ++ flagVars s.f.flags) w && avoidsMaps ce.tm w\n    && beqC n.concl (trC ce (.var ce.t) (inlineC s.f.flags s.f.m.assume))\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      || beqC h (trC ce (.var ce.t) w) || cycZeroOk s ce h)\n\ntheorem cycZeroOk_spec {s : SMachine} {ce : CycEnc} {h : C} (hz : cycZeroOk s ce h = true) :\n    ∃ c key, c ∈ s.carried ∧ h = .eq (.get (cycMM ce c) (.add (.var ce.t) (.prod key (.var ce.om)))) (.const 0) := by\n  match h, hz with\n  | .eq (.get m (.add (.var a) (.prod key (.var b)))) (.const 0), hz =>\n    simp only [cycZeroOk, Bool.and_eq_true, beq_iff_eq, List.any_eq_true] at hz\n    obtain ⟨⟨rfl, rfl⟩, c, hc, hm⟩ := hz\n    exact ⟨c, key, hc, by rw [hm]⟩\n\n/-- A cyclic proof of a request's being allowed, checked against the machine's encoding (`cycAOk`). -/\ntheorem cyc_allow_sound (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (w : C) (n : CNode) (hn : n ∈ nodes) (hok : cycAOk s ce facts w n = true) : AllowHolds s w := by\n  simp only [cycAOk, Bool.and_eq_true, List.all_eq_true] at hok\n  obtain ⟨⟨⟨⟨⟨⟨⟨hsh, hte⟩, hwit⟩, hfa⟩, hwv⟩, hwm⟩, hcon⟩, hhy⟩ := hok\n  have hS := cycShape_of hsh\n  have hT := cycTerms_of hte\n  have hW : s.wits = [] := isEmpty_nil hwit\n  have hsp := special_parts hS.dsp\n  intro ρ M hr ι hw\n  obtain ⟨r, T, hr0, hst, hmp⟩ := reach_run hS.q hr\n  -- The run with the request at T (the last, which no step takes) the claim's, carrying empty sets.\n  let r2 : CRun := ⟨r.ρ0, r.st, r.mp, fun u => if u = T then ι else r.ι u, fun u => if u = T then noSets else r.κ u⟩\n  have hNX : ∀ u, u < T → r2.N s u = r.N s u ∧ r2.V s u = r.V s u := fun u hu => by\n    have hne : u ≠ T := Nat.ne_of_lt hu\n    refine ⟨?_, ?_⟩ <;> simp only [CRun.V, CRun.X, CRun.N, r2, if_neg hne]\n  have hr2 : r2.Ok s T := ⟨hr0.maps0, hr0.pre, hr0.facts, hr0.pfacts, hr0.init, fun u hu => by\n    rw [(hNX u hu).1, (hNX u hu).2]; exact hr0.step u hu⟩\n  have hX : r2.X s T = withInputs s.f.m.inputs ρ ι := by simp only [CRun.X, r2, if_pos rfl, hst, if_true]\n  have hN : r2.N s T = withCarried s M noSets := by simp only [CRun.N, r2, if_pos rfl, hmp, if_true]\n  obtain ⟨Q, hQt, hQT, hQo, hQr⟩ : ∃ Q : Nat → Nat, Q ce.t = T ∧ Q ce.T = T ∧ Q ce.om = T + 1 ∧ ∀ i, i ∉ ce.special → Q i = r.ρ0 i :=\n    ⟨fun i => if i = ce.t then T else if i = ce.T then T else if i = ce.om then T + 1 else r.ρ0 i,\n      by simp, by simp [Ne.symm hsp.2.2.2.2.2.1], by simp [Ne.symm hsp.2.2.2.2.2.2, Ne.symm hsp.2.2.2.2.1],\n      fun i hi => by\n        dsimp only\n        rw [if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inr e)))))), if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inl e))))),\n          if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inl e))))))]⟩\n  have hEnv : EnvOk s ce [] r2 T Q := ⟨hQT, hQo, fun i hi => hQr i (notP hi).1⟩\n  have hwt : evalE Q (cycMaps s ce r2 (T + 1)) (.var ce.t) = T := by simp [evalE, hQt]\n  have hF : FactsHold facts Q (cycMaps s ce r2 (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 hr2 hg hEnv vals\n  have hH : ∀ c ∈ n.hyps, evalC Q (cycMaps s ce r2 (T + 1)) c = true := by\n    intro c hc\n    have h := hhy c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with ((((h | h) | h) | h) | h)\n    · rw [beqC_eq h, congr2C (ρ' := r2.ρ0) (M' := r2.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 hr2.pre\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQt, hQT]; omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQT, hQo]; omega\n    · rw [beqC_eq h, enc_trC hS hT hr2 hEnv hwt (Nat.le_refl T)]\n      rw [congr2C (ρ' := withExt s ρ (sReq s ρ M ι noSets)) (M' := withCarried s M noSets) _ ?_ ?_]\n      · exact hw\n      · intro x hx\n        have hxz := avoids_occ hwv hx\n        rw [withExt_plain hS.q hW, sReq_plain hS.q hW]\n        by_cases hv : x ∈ ce.vtr.map (·.1)\n        · rw [enc_σ_in hS hT hr2 hEnv hwt (Nat.le_refl T) hv, hX]; simp only [withInputs]; split <;> rfl\n        · have hxi : x ∉ s.f.m.inputs := fun h => hv (hS.inv x h)\n          rw [enc_σ_out hS hT hr2 hEnv hwt (Nat.le_refl T) hv, if_neg (fun h => hxi (List.contains_iff_mem.mp h)), ← hst,\n            run_frame hr0 T (Nat.le_refl T) x (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)) hxi (fun h => hxz (List.mem_append_right _ h))]\n          exact hQr x (fun h => hxz (List.mem_append_left _ h))\n      · intro m hm\n        rw [cv_N (avoidsMaps_occ hwm hm), hN]\n    · obtain ⟨cm, key, hcm, rfl⟩ := cycZeroOk_spec h\n      rw [evalC_iff]\n      simp only [holdsC, evalE, hQt, hQo]\n      rw [read_mm hS.dtm (hS.carm cm hcm) (Nat.le_refl T), hN]\n      simp only [withCarried, List.contains_iff_mem.mpr hcm, if_true, noSets]\n  have hc0 := cyclic_sound facts nodes hc (cycMaps s ce r2 (T + 1)) Q hF n hn hH\n  rw [beqC_eq hcon, enc_nowC hS hT hr2 hEnv hwt (Nat.le_refl T) s.f.m.assume hT.asz hT.asm] at hc0\n  have hv : sView s ρ M ι noSets = (r2.V s T, r2.N s T) := by\n    simp only [sView, decideQ_nil hS.q, CRun.V, hX, hN]\n  rw [hv]; exact hc0\n\n/-- Liveness under weak fairness from its step laws and its helpful requests allowed: `sleads_wf_sound` with the step\nlaws' meaning (`SKStepHolds`) and each helpful request's being allowed in its region, with its named inputs and a\nwitness for the rest, carrying empty sets (`AllowHolds`, a cyclic proof's through `cyc_allow_sound`), in place of their\ncertificates. -/\ntheorem sleads_wf_of_holds (s : SMachine) (l : Live) (hok : sliveOk s l = true)\n    (hs : SKStepHolds s (liveK l l.pend (liveStayC l))) (hc : SKStepHolds s (liveK l l.pend (liveCoverC l)))\n    (hh : ∀ h ∈ l.helps, SKStepHolds s (liveK l (liveHelpWhen l h) (liveHelpThen l)))\n    (ha : ∀ h ∈ l.helps, ∃ wit : List (Nat × E), distinct ((h.2 ++ wit).map (·.1)) = true\n      ∧ (∀ p ∈ wit, (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      ∧ AllowHolds s (.and (liveHelpWhen l h) (reqC wit))) (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  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_holds_one hs rfl rfl rfl _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro n hB\n    have := skstep_holds_one hc rfl rfl rfl _ _ (srun_reach run n) _ _ (run.allowed n) hB\n    rw [run.next n]; exact this\n  · intro h hmem n hB\n    have := skstep_holds_one (hh h hmem) rfl rfl rfl _ _ (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 ⟨wit, hdist, hwit, hA⟩ := ha h hmem\n    let ρ := (run.st n).1\n    let M := (run.st n).2\n    let ι := applyS (h.2 ++ wit) ρ 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 ∈ wit, ι 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, hA ρ 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/-! Refinements from their laws and step law -/\n\n-- A step law's certificate where none is read (SKStepHolds reads no certificate).\ndef noSProof : SProof := ([], [], [], [], [], ([], [], .leaf [] [] [] []))\n\n/-- What a refinement over sets means, from the meaning of its claims (`srefines` with them in place of their\ncertificates): with a property `P` of every reachable state of the composite (its laws, a cyclic proof's), the spec's\nprecondition holding there, and the composite's step law that the spec stutters or allows every request it is sent\n(`SKStepHolds`, a cyclic proof's through `cyc_kstep_sound`), every reachable state of the implementation is, outside the\nspec's part, a reachable state of the composite where `P` holds, whose spec part is a reachable state of the spec. -/\ntheorem srefines_of_holds (r : SRefined) (hok : srOk r = true) (hmo : distinct (r.spec.f.m.maps0.map (·.1)) = true)\n    (P : (Nat → Nat) → (Nat → Nat → Nat) → Prop) (hlaws : ∀ ρ M, SReach r.full ρ M → P ρ M)\n    (hpre : ∀ ρ M, SReach r.full ρ M → evalC ρ M r.spec.f.m.pre = true)\n    (prime primeMaps : List (Nat × Nat)) (p : SProof) (hs : SKStepHolds r.full (srStep r prime primeMaps p))\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) ∧ P ρc Mc := by\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 := 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\n/-! Flags that hold at every key -/\n\n-- The machine with its quantified flags and their witnesses as inputs a request names: no flag holds at every key in\n-- it. A request of the machine is one of its, the flags decided and the witnesses chosen as a goal reads them (`sReq`).\ndef SMachine.sk (s : SMachine) : SMachine :=\n  ⟨⟨⟨s.extVars, s.f.m.init, s.f.m.maps0, s.f.m.step, s.f.m.writes, s.f.m.pre, s.f.m.assume⟩, s.f.flags⟩, s.carried, s.every, [], [], s.facts, s.pfacts⟩\n\nsection sk\nvariable {s : SMachine}\n\ntheorem sk_q : s.sk.qflags = [] := rfl\ntheorem sk_inputs : s.sk.f.m.inputs = s.extVars := rfl\n\n-- sReq reads the request's inputs alone (and the state where the flags' bodies read it, off the witnesses).\ntheorem sReq_inputs {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι ι' : Nat → Nat} {κ : Nat → Nat → Nat}\n    (h : ∀ v ∈ s.f.m.inputs, ι' v = ι v) : sReq s ρ M ι' κ = sReq s ρ M ι κ := by\n  have hw : withInputs s.f.m.inputs ρ ι' = withInputs s.f.m.inputs ρ ι := by\n    funext v; simp only [withInputs]; split\n    · rename_i hv; exact h v (List.contains_iff_mem.mp hv)\n    · rfl\n  funext v; simp only [sReq, hw]; split\n  · rename_i hv; exact h v (List.contains_iff_mem.mp hv)\n  · rfl\n\ntheorem sReq_input {ρ : Nat → Nat} {M : Nat → Nat → Nat} {ι : Nat → Nat} {κ : Nat → Nat → Nat} {v : Nat} (hv : v ∈ s.f.m.inputs) :\n    sReq s ρ M ι κ v = ι v := by simp only [sReq]; rw [if_pos (List.contains_iff_mem.mpr hv)]\n\ntheorem sReq_idem (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sReq s ρ M (sReq s ρ M ι κ) κ = sReq s ρ M ι κ := sReq_inputs (fun _ hv => sReq_input hv)\n\n-- The flags' bodies read no witness, so states that agree off the witnesses decide them alike.\ntheorem decideQ_agree (hs : sOk s = true) {X X' : Nat → Nat} (hag : Agree s.wVars X' X) (N : Nat → Nat → Nat) :\n    Agree s.wVars (decideQ s X' N) (decideQ s X N) := by\n  obtain ⟨_, _, _, _, _, hbody, _⟩ := sOk_parts s hs\n  intro v hv\n  simp only [decideQ]\n  cases hl : lookup (fun q => q.1 == v) s.qflags with\n  | none => exact hag v hv\n  | some q =>\n    have hq := (lookup_some hl).1\n    have hb : ∀ k, holdsC (atKeys X' q.2.1 k) N q.2.2 = holdsC (atKeys X q.2.1 k) N q.2.2 := fun k => propext (by\n      rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys X q.2.1 k) N q.2.2 (fun j hj => by\n        simp only [atKeys]; split\n        · rfl\n        · exact hag j (fun h => avoids_occ (hbody q hq).1 hj (List.mem_append_left _ (List.mem_append_right _ h))))])\n    have hiff : (∀ k, holdsC (atKeys X' q.2.1 k) N q.2.2) ↔ (∀ k, holdsC (atKeys X q.2.1 k) N q.2.2) :=\n      forall_congr' (fun k => by rw [hb k])\n    dsimp only\n    by_cases h1 : ∀ k, holdsC (atKeys X q.2.1 k) N q.2.2\n    · rw [if_pos (hiff.mpr h1), if_pos h1]\n    · rw [if_neg (fun h => h1 (hiff.mp h)), if_neg h1]\n\ntheorem choose_congr {α : Type} {p q : α → Prop} (h : p = q) (hp : ∃ x, p x) (hq : ∃ x, q x) : Classical.choose hp = Classical.choose hq := by\n  subst h; rfl\n\ntheorem witnessKeys_agree (hs : sOk s = true) {X X' : Nat → Nat} (hag : Agree s.wVars X' X) (N : Nat → Nat → Nat) {q : Nat × List Nat × C}\n    (hq : q ∈ s.qflags) : witnessKeys X' N q = witnessKeys X N q := by\n  obtain ⟨_, _, _, _, _, hbody, _⟩ := sOk_parts s hs\n  have hb : ∀ k, holdsC (atKeys X' q.2.1 k) N q.2.2 = holdsC (atKeys X q.2.1 k) N q.2.2 := fun k => propext (by\n    rw [← evalC_iff, ← evalC_iff, congrC _ (atKeys X q.2.1 k) N q.2.2 (fun j hj => by\n      simp only [atKeys]; split\n      · rfl\n      · exact hag j (fun h => avoids_occ (hbody q hq).1 hj (List.mem_append_left _ (List.mem_append_right _ h))))])\n  have hP : (fun k => holdsC (atKeys X' q.2.1 k) N q.2.2) = (fun k => holdsC (atKeys X q.2.1 k) N q.2.2) := funext hb\n  have hp2 : (fun k => ¬holdsC (atKeys X' q.2.1 k) N q.2.2) = (fun k => ¬holdsC (atKeys X q.2.1 k) N q.2.2) := funext fun k => by rw [hb k]\n  unfold witnessKeys\n  split\n  · rename_i h1\n    have h2 : ∃ k, ¬holdsC (atKeys X q.2.1 k) N q.2.2 := by obtain ⟨k, hk⟩ := h1; exact ⟨k, by rwa [← hb k]⟩\n    rw [dif_pos h2]\n    exact choose_congr hp2 h1 h2\n  · rename_i h1\n    have h2 : ¬∃ k, ¬holdsC (atKeys X q.2.1 k) N q.2.2 := fun ⟨k, hk⟩ => h1 ⟨k, by rwa [hb k]⟩\n    rw [dif_neg h2]\n\ntheorem sReq_agree (hs : sOk s = true) {ρ ρ' : Nat → Nat} (hag : Agree s.wVars ρ' ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat)\n    (κ : Nat → Nat → Nat) : sReq s ρ' M ι κ = sReq s ρ M ι κ := by\n  have hX : Agree s.wVars (withInputs s.f.m.inputs ρ' ι) (withInputs s.f.m.inputs ρ ι) := fun v hv => by\n    simp only [withInputs]; split\n    · rfl\n    · exact hag v hv\n  funext v\n  simp only [sReq]\n  split\n  · rfl\n  · split\n    · rename_i q hq\n      exact decideQ_agree hs hX _ v (fun h => (ext_apart s hs).2 v (by\n        have := (lookup_some hq); simp only [beq_iff_eq] at this; rw [← this.2]; exact List.mem_map_of_mem this.1) h)\n    · split\n      · split\n        · rename_i q hq\n          split\n          · rw [witnessKeys_agree hs hX _ (lookup_some hq).1]\n          · rfl\n        · rfl\n      · rfl\n\n-- A machine's request read by its sk machine: the view is the goal's view, which agrees with the machine's off the\n-- witnesses.\ntheorem sk_inputsView (ρ ρ' : Nat → Nat) (hag : Agree s.wVars ρ' ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    withInputs s.sk.f.m.inputs ρ' (sReq s ρ M ι κ) = withExt s ρ (sReq s ρ M ι κ) := by\n  funext v\n  simp only [withInputs, withExt, sk_inputs]\n  by_cases hv : s.extVars.contains v = true\n  · simp only [hv, ↓reduceIte]\n  · simp only [hv, Bool.false_eq_true, ↓reduceIte]\n    exact hag v (fun h => hv (by simp only [SMachine.extVars, List.contains_iff_mem, List.mem_append]; exact Or.inr h))\n\ntheorem sk_view (hs : sOk s = true) {ρ ρ' : Nat → Nat} (hag : Agree s.wVars ρ' ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    Agree s.wVars (sView s.sk ρ' M (sReq s ρ M ι κ) κ).1 (sView s ρ M ι κ).1 ∧ (sView s.sk ρ' M (sReq s ρ M ι κ) κ).2 = (sView s ρ M ι κ).2 := by\n  obtain ⟨hfl, _, _, _, _, _, hflw⟩ := sOk_parts s hs\n  refine ⟨fun i hi => ?_, rfl⟩\n  simp only [sView]\n  rw [decideQ_nil sk_q, sk_inputsView ρ ρ' hag]\n  exact decide_view (Z := s.wVars) (TM := []) hfl hflw (fun _ _ => rfl) (fun j hj _ => (view_agree s ρ M ι κ hs j hj).symm)\n    (fun _ _ => rfl) hi\n\n-- Inlining the flags keeps every variable a term reads but the flags'.\nmutual\ntheorem occE_inline (fl : List (Nat × C)) {i : Nat} (hi : flagOf fl i = none) : ∀ e : E, occE i e = true → occE i (inlineE fl e) = true\n  | .var j, h => by\n    have hj : j = i := by simpa [occE] using h\n    subst hj; simp [inlineE, hi, occE]\n  | .const _, h => by simp [occE] at h\n  | .add a b, h => by\n    simp only [occE, Bool.or_eq_true] at h; simp only [inlineE, occE, Bool.or_eq_true]\n    exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n  | .sub a b, h => by\n    simp only [occE, Bool.or_eq_true] at h; simp only [inlineE, occE, Bool.or_eq_true]\n    exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n  | .mul _ a, h => by simp only [occE] at h; simp only [inlineE, occE]; exact occE_inline fl hi a h\n  | .min a b, h => by\n    simp only [occE, Bool.or_eq_true] at h; simp only [inlineE, occE, Bool.or_eq_true]\n    exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n  | .max a b, h => by\n    simp only [occE, Bool.or_eq_true] at h; simp only [inlineE, occE, Bool.or_eq_true]\n    exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n  | .prod a b, h => by\n    simp only [occE, Bool.or_eq_true] at h; simp only [inlineE, occE, Bool.or_eq_true]\n    exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n  | .ite c t f, h => by\n    simp only [occE, Bool.or_eq_true] at h; simp only [inlineE, occE, Bool.or_eq_true]\n    rcases h with (h | h) | h\n    · exact Or.inl (Or.inl (occC_inline fl hi c h))\n    · exact Or.inl (Or.inr (occE_inline fl hi t h))\n    · exact Or.inr (occE_inline fl hi f h)\n  | .get _ key, h => by simp only [occE] at h; simp only [inlineE, occE]; exact occE_inline fl hi key h\ntheorem occC_inline (fl : List (Nat × C)) {i : Nat} (hi : flagOf fl i = none) : ∀ c : C, occC i c = true → occC i (inlineC fl c) = true\n  | .le a b, h => by\n    simp only [occC, Bool.or_eq_true] at h; simp only [inlineC, occC, Bool.or_eq_true]\n    exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n  | .lt a b, h => by\n    simp only [occC, Bool.or_eq_true] at h; simp only [inlineC, occC, Bool.or_eq_true]\n    exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n  | .eq a b, h => by\n    simp only [occC, Bool.or_eq_true] at h\n    have hd : occC i (.eq (inlineE fl a) (inlineE fl b)) = true := by\n      simp only [occC, Bool.or_eq_true]; exact h.imp (occE_inline fl hi a) (occE_inline fl hi b)\n    simp only [inlineC, eqOrFlag]\n    split\n    · split\n      · rename_i c hc\n        exfalso\n        rcases h with h | h\n        · simp only [occE, beq_iff_eq] at h; subst h; rw [hi] at hc; cases hc\n        · simp [occE] at h\n      · exact hd\n    · exact hd\n  | .and a b, h => by\n    simp only [occC, Bool.or_eq_true] at h; simp only [inlineC, occC, Bool.or_eq_true]\n    exact h.imp (occC_inline fl hi a) (occC_inline fl hi b)\n  | .or a b, h => by\n    simp only [occC, Bool.or_eq_true] at h; simp only [inlineC, occC, Bool.or_eq_true]\n    exact h.imp (occC_inline fl hi a) (occC_inline fl hi b)\n  | .not a, h => by simp only [occC] at h; simp only [inlineC, occC]; exact occC_inline fl hi a h\nend\n\ntheorem avoidsE_of_inline {fl : List (Nat × C)} {Z : List Nat} (hz : ∀ i ∈ Z, i ∉ flagVars fl) {e : E}\n    (h : avoidsE Z (inlineE fl e) = true) : avoidsE Z e = true := by\n  simp only [avoidsE, List.all_eq_true, Bool.not_eq_true'] at h ⊢\n  intro i hi\n  cases ho : occE i e\n  · rfl\n  · have hn : flagOf fl i = none := by\n      simp only [flagOf]\n      rw [lookup_none (fun p hp => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hz _ hi (by rw [← he]; exact List.mem_map_of_mem hp))]\n      rfl\n    have := h i hi; rw [occE_inline fl hn e ho] at this; cases this\n\ntheorem sOk_terms (hs : sOk s = true) : (∀ p ∈ s.f.m.step, avoidsE s.wVars (inlineE s.f.flags p.2) = true)\n    ∧ (∀ w ∈ s.f.m.writes, avoidsE s.wVars (inlineE s.f.flags w.2.1) = true ∧ avoidsE s.wVars (inlineE s.f.flags w.2.2) = true)\n    ∧ (∀ w ∈ s.every, avoidsE s.wVars (inlineE s.f.flags w.2.2) = true) ∧ avoids s.wVars s.f.m.assume = true\n    ∧ avoids (s.wVars ++ s.qVars) s.f.m.pre = true := by\n  simp only [sOk, Bool.and_eq_true, List.all_eq_true] at hs\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨_, _⟩, _⟩, _⟩, _⟩, _⟩, _⟩, hpre⟩, hst⟩, hwr⟩, hev⟩, has⟩ := hs\n  exact ⟨hst, fun w hw => hwr w hw, fun w hw => (hev w hw).1.1.1, has, hpre⟩\n\n-- The witnesses are no flags.\ntheorem wVars_flags (hs : sOk s = true) : ∀ i ∈ s.wVars, i ∉ flagVars s.f.flags := by\n  obtain ⟨_, _, _, _, hd, _, _⟩ := sOk_parts s hs\n  intro i hi hf\n  exact (distinct_append hd).2.2 i (by simp only [SMachine.extVars, List.mem_append]; exact Or.inr hi) hf\n\ntheorem sk_view_eq (ρ ρ' : Nat → Nat) (hag : Agree s.wVars ρ' ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    sView s.sk ρ' M (sReq s ρ M ι κ) κ = (decideFlags s.f.flags (withExt s ρ (sReq s ρ M ι κ)) (withCarried s M κ), withCarried s M κ) := by\n  simp only [sView]; rw [decideQ_nil sk_q, sk_inputsView ρ ρ' hag]; rfl\n\n-- A step of the machine is a step of its sk machine, its request decided: allowed alike, the state after it agreeing\n-- off the witnesses, the maps the same.\ntheorem sk_step (hs : sOk s = true) {ρ ρ' : Nat → Nat} (hag : Agree s.wVars ρ' ρ) (M : Nat → Nat → Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) :\n    evalC (sView s.sk ρ' M (sReq s ρ M ι κ) κ).1 (sView s.sk ρ' M (sReq s ρ M ι κ) κ).2 s.f.m.assume\n      = evalC (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 s.f.m.assume\n    ∧ Agree s.wVars (sNext s.sk ρ' M (sReq s ρ M ι κ) κ).1 (sNext s ρ M ι κ).1\n    ∧ (sNext s.sk ρ' M (sReq s ρ M ι κ) κ).2 = (sNext s ρ M ι κ).2 := by\n  obtain ⟨hV, hN⟩ := sk_view hs hag M ι κ\n  obtain ⟨hst, hwr, hev, has, _⟩ := sOk_terms hs\n  have hz := wVars_flags hs\n  have hraw : ∀ e : E, avoidsE s.wVars (inlineE s.f.flags e) = true → ∀ j, occE j e = true → j ∉ s.wVars :=\n    fun e he j hj => avoidsE_occ (avoidsE_of_inline hz he) hj\n  have hEq : ∀ e : E, avoidsE s.wVars (inlineE s.f.flags e) = true → ∀ (A B : Nat → Nat), Agree s.wVars A B → ∀ N : Nat → Nat → Nat,\n      evalE A N e = evalE B N e := fun e he A B hab N => congrE A B N e (fun j hj => hab j (hraw e he j hj))\n  refine ⟨?_, fun i hi => ?_, ?_⟩\n  · rw [hN, congrC _ (sView s ρ M ι κ).1 _ s.f.m.assume (fun j hj => hV j (avoids_occ has hj))]\n  · simp only [sNext, applyS]\n    rw [show s.sk.f.m.step = s.f.m.step from rfl]\n    cases ha : assoc s.f.m.step i with\n    | none => show (sView s.sk ρ' M (sReq s ρ M ι κ) κ).1 i = (sView s ρ M ι κ).1 i; exact hV i hi\n    | some e =>\n      show evalE (sView s.sk ρ' M (sReq s ρ M ι κ) κ).1 (sView s.sk ρ' M (sReq s ρ M ι κ) κ).2 e = evalE (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 e\n      obtain ⟨p, hp, rfl⟩ : ∃ p ∈ s.f.m.step, p.2 = e := by\n        simp only [assoc, Option.map_eq_some_iff] at ha; obtain ⟨p, hl, rfl⟩ := ha; exact ⟨p, (lookup_some hl).1, rfl⟩\n      rw [hN]; exact hEq p.2 (hst p hp) _ _ hV _\n  · simp only [sNext]\n    funext mp key\n    show everyMaps s (sView s.sk ρ' M (sReq s ρ M ι κ) κ).1 (sView s.sk ρ' M (sReq s ρ M ι κ) κ).2 mp key = everyMaps s (sView s ρ M ι κ).1 (sView s ρ M ι κ).2 mp key\n    rw [hN]\n    simp only [everyMaps]\n    cases hl : lookup (fun w => w.1 == mp) s.every with\n    | some w =>\n      have hu : Agree s.wVars (upd (sView s.sk ρ' M (sReq s ρ M ι κ) κ).1 w.2.1 key) (upd (sView s ρ M ι κ).1 w.2.1 key) := by\n        intro j hj; simp only [upd]; split\n        · rfl\n        · exact hV j hj\n      exact hEq w.2.2 (hev w (lookup_some hl).1) _ _ hu _\n    | none =>\n      simp only [writeMaps]\n      cases hl2 : lookup (fun w => w.1 == mp) s.f.m.writes with\n      | none => rfl\n      | some w =>\n        obtain ⟨h1, h2⟩ := hwr w (lookup_some hl2).1\n        simp only [hEq w.2.1 h1 _ _ hV, hEq w.2.2 h2 _ _ hV]\n\n-- A run's request at time u decided: its flags and witnesses as a goal reads them from its inputs.\ndef CRun.Decided (s : SMachine) (r : CRun) (u : Nat) : Prop := r.ι u = sReq s (r.st u) (r.mp u) (r.ι u) (r.κ u)\n\n-- The run with the request at T (the last, which no step takes) replaced.\ndef CRun.last (r : CRun) (T : Nat) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : CRun :=\n  ⟨r.ρ0, r.st, r.mp, fun u => if u = T then ι else r.ι u, fun u => if u = T then κ else r.κ u⟩\n\ntheorem last_ok {s' : SMachine} {r : CRun} {T : Nat} (hr : r.Ok s' T) (ι : Nat → Nat) (κ : Nat → Nat → Nat) : (r.last T ι κ).Ok s' T := by\n  have hNX : ∀ u, u < T → (r.last T ι κ).N s' u = r.N s' u ∧ (r.last T ι κ).V s' u = r.V s' u := fun u hu => by\n    have hne : u ≠ T := Nat.ne_of_lt hu\n    refine ⟨?_, ?_⟩ <;> simp only [CRun.V, CRun.X, CRun.N, CRun.last, if_neg hne]\n  exact ⟨hr.maps0, hr.pre, hr.facts, hr.pfacts, hr.init, fun u hu => by rw [(hNX u hu).1, (hNX u hu).2]; exact hr.step u hu⟩\n\n-- The request at T decided from no inputs: a decided last request.\ntheorem last_decided {r : CRun} {T : Nat} : (r.last T (sReq s (r.st T) (r.mp T) (fun _ => 0) noSets) noSets).Decided s T := by\n  simp only [CRun.Decided, CRun.last, if_pos rfl]; exact (sReq_idem _ _ _ _).symm\n\ntheorem last_other {r : CRun} {T u : Nat} (hu : u ≠ T) (ι : Nat → Nat) (κ : Nat → Nat → Nat) (h : r.Decided s u) : (r.last T ι κ).Decided s u := by\n  simp only [CRun.Decided, CRun.last, if_neg hu]; exact h\n\n-- A reachable state of the machine ends a run of its sk machine, every request of it decided, off the witnesses.\ntheorem sk_run (hs : sOk s = true) : ∀ {ρ M}, SReach s ρ M → ∃ (r : CRun) (T : Nat), r.Ok s.sk T ∧ (∀ u, u ≤ T → r.Decided s u)\n    ∧ Agree s.wVars (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 _ => sReq s (applyS s.f.m.init ρ M) M (fun _ => 0) noSets, fun _ => noSets⟩, 0,\n      ⟨hM, hp, hf, hpf, rfl, fun u hu => absurd hu (Nat.not_lt_zero u)⟩, fun _ _ => (sReq_idem _ _ _ _).symm, fun _ _ => rfl, rfl⟩\n  | step ρ M ι κ _ ha ih =>\n    obtain ⟨r, T, hr, hd, hag, hmp⟩ := ih\n    obtain ⟨hA, hS, hMn⟩ := sk_step hs hag M ι κ\n    have hr1 := run_snoc_ok sk_q hr rfl hmp (sReq s ρ M ι κ) κ (by show evalC _ _ s.f.m.assume = true; rw [hA]; exact ha)\n    let r1 := r.snoc T (sNext s.sk (r.st T) M (sReq s ρ M ι κ) κ).1 (sNext s.sk (r.st T) M (sReq s ρ M ι κ) κ).2 (sReq s ρ M ι κ) κ\n    obtain ⟨l1, l2, l3, l4, l5, l6⟩ := snoc_last (r := r) (T := T) (sNext s.sk (r.st T) M (sReq s ρ M ι κ) κ).1 (sNext s.sk (r.st T) M (sReq s ρ M ι κ) κ).2 (sReq s ρ M ι κ) κ\n    refine ⟨r1.last (T + 1) (sReq s (r1.st (T + 1)) (r1.mp (T + 1)) (fun _ => 0) noSets) noSets, T + 1, last_ok hr1 _ _, fun u hu => ?_, ?_, ?_⟩\n    · rcases Nat.lt_or_ge u T with hlt | hge\n      · refine last_other (Nat.ne_of_lt (by omega)) _ _ ?_\n        obtain ⟨e1, _, e3, e4⟩ := snoc_early (s := s.sk) (r := r) hlt (sNext s.sk (r.st T) M (sReq s ρ M ι κ) κ).1 (sNext s.sk (r.st T) M (sReq s ρ M ι κ) κ).2 (sReq s ρ M ι κ) κ\n        have h := hd u (Nat.le_of_lt hlt)\n        simp only [CRun.Decided, r1, CRun.snoc, if_pos hlt, if_pos (Nat.le_of_lt hlt)] at h ⊢\n        exact h\n      · rcases Nat.lt_or_ge u (T + 1) with hlt | hge'\n        · have hu : u = T := by omega\n          subst hu\n          refine last_other (by omega) _ _ ?_\n          simp only [CRun.Decided, r1, l3, l4, l5, l6, hmp]\n          rw [sReq_agree hs hag, sReq_idem]\n        · have hu : u = T + 1 := by omega\n          subst hu; exact last_decided\n    · show Agree s.wVars (r1.st (T + 1)) (sNext s ρ M ι κ).1\n      rw [l1]; exact hS\n    · show r1.mp (T + 1) = (sNext s ρ M ι κ).2\n      rw [l2]; exact hMn\n\n-- A guard: where u ≤ T.\ndef cycUpTo (ce : CycEnc) (c : C) : C := .or (.not (.le (.var ce.u) (.var ce.T))) (trC ce (.var ce.u) c)\n\n-- The facts the encoding adds for each flag that holds at every key, at each time u ≤ T (Sets.lean's closingHyps read\n-- at u): the flag is 0 or 1; it is 0 or its body holds at every value of its keys; it is 1 or its body fails at the\n-- witness.\ndef cycQFacts (s : SMachine) (ce : CycEnc) : List Fact :=\n  s.qflags.flatMap fun q =>\n    [⟨[ce.u], cycUpTo ce (.le (.var q.1) (.const 1))⟩, ⟨ce.u :: q.2.1, cycUpTo ce (.or (.eq (.var q.1) (.const 0)) q.2.2)⟩]\n      ++ (match lookup (fun w => w.1 == q.1) s.wits with\n          | some w => [⟨[ce.u], cycUpTo ce (.or (.eq (.var q.1) (.const 1)) (.not (substC (q.2.1.zip (w.2.map .var)) q.2.2)))⟩]\n          | none => [])\n\ntheorem assoc_zip_none : ∀ (ks : List Nat) (ts : List E), ks.length ≤ ts.length → ∀ {j : Nat}, assoc (ks.zip ts) j = none → j ∉ ks\n  | [], _, _, _, _ => by simp\n  | _ :: _, [], h, _, _ => by simp at h\n  | k :: ks, t :: ts, h, j, ha => by\n    simp only [List.zip_cons_cons, assoc, lookup] at ha\n    by_cases hk : k = j\n    · subst hk; simp at ha\n    · simp only [hk, beq_iff_eq, if_false] at ha\n      intro hm\n      rcases List.mem_cons.mp hm with hm | hm\n      · exact hk hm.symm\n      · exact assoc_zip_none ks ts (by simpa using h) (by simpa [assoc] using ha) hm\n\ntheorem assoc_zip_self (g : Nat → E) : ∀ (ks : List Nat) {j : Nat}, j ∈ ks → assoc (ks.zip (ks.map g)) j = some (g j)\n  | [], _, h => by simp at h\n  | k :: ks, j, h => by\n    simp only [List.map_cons, List.zip_cons_cons, assoc, lookup]\n    by_cases hk : k = j\n    · subst hk; simp\n    · have hj : j ∈ ks := by rcases List.mem_cons.mp h with h | h; exact absurd h.symm hk; exact h\n      have := assoc_zip_self g ks hj\n      simp only [assoc] at this\n      simp [hk, this]\n\n-- On a decided run, the encoding at a time up to T reads the goal's view of that step (Sets.lean's withExt, sReq).\ntheorem sk_X {r : CRun} {u : Nat} (hd : r.Decided s u) :\n    r.X s.sk u = withExt s (r.st u) (sReq s (r.st u) (r.mp u) (r.ι u) (r.κ u)) := by\n  funext v\n  simp only [CRun.X, withInputs, withExt, sk_inputs]\n  by_cases hv : s.extVars.contains v = true\n  · simp only [hv, ↓reduceIte]; exact congrFun hd v\n  · simp only [hv, Bool.false_eq_true, ↓reduceIte]\n\n-- A quantified flag's body reads no added variable, no flag, no map over time, and of the keys none but its own.\ndef cycBodyOk (s : SMachine) (ce : CycEnc) (keys : List Nat) : Bool :=\n  s.qflags.all fun q => avoids ce.special q.2.2 && avoidsMaps ce.tm q.2.2 && keys.all (fun k => q.2.1.contains k || !occC k q.2.2)\n    && q.2.1.all (fun k => keys.contains k)\n\nsection qfacts\nvariable {ce : CycEnc} {keys : List Nat} (hs : sOk s = true) (hS : CycShape s.sk ce keys) (hT : CycTerms s.sk ce keys)\n  {r : CRun} {T : Nat} (hr : r.Ok s.sk T) (hd : ∀ u, u ≤ T → r.Decided s u) (hb : cycBodyOk s ce keys = true)\n  {Q : Nat → Nat} (hQ : EnvOk s.sk ce keys r T Q)\ninclude hs hS hT hr hd hb hQ\n\n-- A fact over u and some keys, guarded by u ≤ T: true when its condition is, read at the run's step at u.\ntheorem upto_true {ks : List Nat} (hks : ∀ x ∈ ks, x = ce.u ∨ x ∈ keys) (hu : ce.u ∈ ks) (vals : Nat → Nat) (c : C)\n    (h : vals ce.u ≤ T → evalC (applyS (cycσ ce (.var ce.u)) (override ks vals Q) (cycMaps s.sk ce r (T + 1))) (cycView s.sk ce r (T + 1) (vals ce.u)) c = true) :\n    evalC (override ks vals Q) (cycMaps s.sk ce r (T + 1)) (cycUpTo ce c) = true := by\n  have hsp := special_parts hS.dsp\n  have hnk : ∀ i, (i = ce.T ∨ i = ce.om) → i ∉ ks := fun i hi hm => by\n    rcases hks i hm with h1 | h1\n    · rcases hi with rfl | rfl\n      · exact hsp.1 h1.symm\n      · exact hsp.2.1 h1.symm\n    · exact hS.ks i h1 (in_special (by rcases hi with rfl | rfl; exact Or.inr (Or.inr (Or.inl rfl)); exact Or.inr (Or.inr (Or.inr (Or.inl rfl)))))\n  have hQ1 : EnvOk s.sk ce keys r T (override ks vals Q) := by\n    refine ⟨?_, ?_, fun i hi => ?_⟩\n    · simp only [override]; rw [if_neg (fun h => hnk ce.T (Or.inl rfl) (List.contains_iff_mem.mp h))]; exact hQ.1\n    · simp only [override]; rw [if_neg (fun h => hnk ce.om (Or.inr rfl) (List.contains_iff_mem.mp h))]; exact hQ.2.1\n    · simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks i (List.contains_iff_mem.mp h) with h1 | h1\n        · exact (notP hi).1 (in_special (Or.inl h1))\n        · exact (notP hi).2.1 h1)]\n      exact hQ.2.2 i hi\n  have hw : evalE (override ks vals Q) (cycMaps s.sk ce r (T + 1)) (.var ce.u) = vals ce.u := by\n    simp only [evalE, override, List.contains_iff_mem.mpr hu, ite_true]\n  simp only [cycUpTo, evalC, Bool.or_eq_true, Bool.not_eq_true']\n  by_cases hle : vals ce.u ≤ T\n  · right; rw [enc_trC hS hT hr hQ1 hw hle]; exact h hle\n  · left; simp only [evalE] at hw; simp only [decide_eq_false_iff_not, evalE, hw, hQ1.1]; exact hle\n\ntheorem qbody_parts {q : Nat × List Nat × C} (hq : q ∈ s.qflags) :\n    avoids ce.special q.2.2 = true ∧ avoidsMaps ce.tm q.2.2 = true ∧ (∀ k ∈ keys, q.2.1.contains k = true ∨ occC k q.2.2 = false)\n      ∧ (∀ k ∈ q.2.1, k ∈ keys) := by\n  have h := List.all_eq_true.mp hb q hq\n  simp only [Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, Bool.not_eq_true'] at h\n  exact ⟨h.1.1.1, h.1.1.2, h.1.2, fun k hk => List.contains_iff_mem.mp (h.2 k hk)⟩\n\n-- At a time u0 ≤ T, a variable no added name or flag is reads the goal's view of the run's step there.\ntheorem upto_view {ks : List Nat} (hks : ∀ x ∈ ks, x = ce.u ∨ x ∈ keys) (vals : Nat → Nat) (hu0 : vals ce.u ≤ T) (hu : ce.u ∈ ks)\n    {j : Nat} (hz : j ∉ cycZ ce keys) (hf : j ∉ flagVars s.f.flags) :\n    applyS (cycσ ce (.var ce.u)) (override ks vals Q) (cycMaps s.sk ce r (T + 1)) j\n      = withExt s (r.st (vals ce.u)) (sReq s (r.st (vals ce.u)) (r.mp (vals ce.u)) (r.ι (vals ce.u)) (r.κ (vals ce.u))) j := by\n  have hsp := special_parts hS.dsp\n  have hQ1 : EnvOk s.sk ce keys r T (override ks vals Q) := by\n    have hnk : ∀ i, (i = ce.T ∨ i = ce.om) → i ∉ ks := fun i hi hm => by\n      rcases hks i hm with h1 | h1\n      · rcases hi with rfl | rfl\n        · exact hsp.1 h1.symm\n        · exact hsp.2.1 h1.symm\n      · exact hS.ks i h1 (in_special (by rcases hi with rfl | rfl; exact Or.inr (Or.inr (Or.inl rfl)); exact Or.inr (Or.inr (Or.inr (Or.inl rfl)))))\n    refine ⟨?_, ?_, fun i hi => ?_⟩\n    · simp only [override]; rw [if_neg (fun h => hnk ce.T (Or.inl rfl) (List.contains_iff_mem.mp h))]; exact hQ.1\n    · simp only [override]; rw [if_neg (fun h => hnk ce.om (Or.inr rfl) (List.contains_iff_mem.mp h))]; exact hQ.2.1\n    · simp only [override]\n      rw [if_neg (fun h => by\n        rcases hks i (List.contains_iff_mem.mp h) with h1 | h1\n        · exact (notP hi).1 (in_special (Or.inl h1))\n        · exact (notP hi).2.1 h1)]\n      exact hQ.2.2 i hi\n  have hw : evalE (override ks vals Q) (cycMaps s.sk ce r (T + 1)) (.var ce.u) = vals ce.u := by\n    simp only [evalE, override, List.contains_iff_mem.mpr hu, ite_true]\n  rw [enc_Y hS hT hr hQ1 hw hu0 hz hf, sk_X (hd _ hu0)]\n\n-- A variable of the goal's view: a quantified flag or a witness is traced, no added name, no flag.\ntheorem ext_free {v : Nat} (hv : v ∈ s.extVars) : v ∉ cycZ ce keys ∧ v ∉ flagVars s.f.flags := by\n  obtain ⟨_, _, _, _, hd', _, _⟩ := sOk_parts s hs\n  exact ⟨fun h => hS.zv v h (hS.inv v (by rw [sk_inputs]; exact hv)), (distinct_append hd').2.2 v hv⟩\n\ntheorem qflag_ext {q : Nat × List Nat × C} (hq : q ∈ s.qflags) : q.1 ∈ s.extVars := by\n  simp only [SMachine.extVars, SMachine.qVars, List.mem_append, List.mem_map]; exact Or.inl (Or.inr ⟨q, hq, rfl⟩)\n\n-- A body variable, not one of the body's keys: no added name, no flag.\ntheorem body_free {q : Nat × List Nat × C} (hq : q ∈ s.qflags) {j : Nat} (hj : occC j q.2.2 = true) (hk : j ∉ q.2.1) :\n    j ∉ cycZ ce keys ∧ j ∉ flagVars s.f.flags := by\n  obtain ⟨hsb, _, hkb, _⟩ := qbody_parts hs hS hT hr hd hb hQ hq\n  obtain ⟨_, _, _, _, _, hbody, _⟩ := sOk_parts s hs\n  refine ⟨fun h => ?_, fun h => avoids_occ (hbody q hq).1 hj (List.mem_append_right _ h)⟩\n  simp only [cycZ, List.mem_append] at h\n  rcases h with h | h\n  · exact avoids_occ hsb hj h\n  · rcases hkb j h with h1 | h1\n    · exact hk (List.contains_iff_mem.mp h1)\n    · rw [hj] at h1; cases h1\n\ntheorem qfacts_hold {f : Fact} (hf : f ∈ cycQFacts s ce) (vals : Nat → Nat) :\n    evalC (override f.keys vals Q) (cycMaps s.sk ce r (T + 1)) f.holds = true := by\n  simp only [cycQFacts, List.mem_flatMap, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hf\n  obtain ⟨q, hq, hf⟩ := hf\n  obtain ⟨_, hmb, _, hbk⟩ := qbody_parts hs hS hT hr hd hb hQ hq\n  have hqv := ext_free hs hS hT hr hd hb hQ (qflag_ext hs hS hT hr hd hb hQ hq)\n  -- The maps a body reads, at u0: the step's.\n  have hN : ∀ u0 m, m ∉ ce.tm → cycView s.sk ce r (T + 1) u0 m = withCarried s (r.mp u0) (r.κ u0) m := fun u0 m hm => by\n    rw [cv_N hm]; rfl\n  rcases hf with (rfl | rfl) | hf\n  · -- 0 or 1\n    refine upto_true hs hS hT hr hd hb hQ (fun x hx => by simp at hx; exact Or.inl hx) (by simp) vals _ (fun hu0 => ?_)\n    have hc := closing_true s (r.st (vals ce.u)) (r.mp (vals ce.u)) (r.ι (vals ce.u)) (r.κ (vals ce.u)) hs [] (.le (.var q.1) (.const 1)) (by\n      simp only [closingHyps, List.mem_flatMap]; exact ⟨q, hq, by simp⟩)\n    rw [evalC_iff] at hc ⊢\n    simp only [holdsC, evalE] at hc ⊢\n    rw [upto_view hs hS hT hr hd hb hQ (fun x hx => by simp at hx; exact Or.inl hx) vals hu0 (by simp) hqv.1 hqv.2]; exact hc\n  · -- 0, or the body at every value of the keys\n    have hks : ∀ x ∈ ce.u :: q.2.1, x = ce.u ∨ x ∈ keys := fun x hx => by\n      rcases List.mem_cons.mp hx with h | h; exact Or.inl h; exact Or.inr (hbk x h)\n    refine upto_true hs hS hT hr hd hb hQ hks List.mem_cons_self vals _ (fun hu0 => ?_)\n    let u0 := vals ce.u\n    let consts := q.2.1.map (fun k => E.const (vals k))\n    have hc := closing_true s (r.st u0) (r.mp u0) (r.ι u0) (r.κ u0) hs [(q.1, consts)] (.or (.eq (.var q.1) (.const 0)) (substC (q.2.1.zip consts) q.2.2)) (by\n      simp only [closingHyps, List.mem_flatMap]; exact ⟨q, hq, by simp⟩)\n    rw [evalC_iff] at hc ⊢\n    simp only [holdsC, evalE] at hc ⊢\n    rw [upto_view hs hS hT hr hd hb hQ hks vals hu0 List.mem_cons_self hqv.1 hqv.2]\n    rcases hc with hc | hc\n    · exact Or.inl hc\n    · right\n      rw [← evalC_iff] at hc ⊢\n      rw [subst_evalC] at hc\n      rw [congr2C (ρ' := applyS (q.2.1.zip consts) (withExt s (r.st u0) (sReq s (r.st u0) (r.mp u0) (r.ι u0) (r.κ u0))) (withCarried s (r.mp u0) (r.κ u0)))\n        (M' := withCarried s (r.mp u0) (r.κ u0)) q.2.2 (fun j hj => ?_) (fun m hm => hN u0 m (avoidsMaps_occ hmb hm))]\n      · exact hc\n      · by_cases hjk : j ∈ q.2.1\n        · have hr1 : applyS (q.2.1.zip consts) (withExt s (r.st u0) (sReq s (r.st u0) (r.mp u0) (r.ι u0) (r.κ u0))) (withCarried s (r.mp u0) (r.κ u0)) j = vals j := by\n            simp only [applyS, consts, assoc_zip_self (fun k => E.const (vals k)) q.2.1 hjk, evalE]\n          have hz : (cycσ ce (.var ce.u)).map (·.1) = ce.vtr.map (·.1) := by simp [cycσ]\n          rw [hr1, applyS_other (by rw [hz]; exact fun h => hS.zv j (by simp only [cycZ, List.mem_append]; exact Or.inr (hbk j hjk)) h)]\n          simp only [override, List.contains_iff_mem.mpr (List.mem_cons_of_mem _ hjk), ite_true]\n        · obtain ⟨hz, hfl⟩ := body_free hs hS hT hr hd hb hQ hq hj hjk\n          rw [upto_view hs hS hT hr hd hb hQ hks vals hu0 List.mem_cons_self hz hfl, applyS_other (fun h => hjk (by\n            obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h; exact (List.of_mem_zip hp).1))]\n  · -- 1, or the body failing at the witness\n    cases hl : lookup (fun w => w.1 == q.1) s.wits with\n    | none => rw [hl] at hf; simp at hf\n    | some w =>\n      rw [hl] at hf; simp only [List.mem_singleton] at hf; subst hf\n      refine upto_true hs hS hT hr hd hb hQ (fun x hx => by simp at hx; exact Or.inl hx) (by simp) vals _ (fun hu0 => ?_)\n      let u0 := vals ce.u\n      have hc := closing_true s (r.st u0) (r.mp u0) (r.ι u0) (r.κ u0) hs [] (.or (.eq (.var q.1) (.const 1)) (.not (substC (q.2.1.zip (w.2.map .var)) q.2.2))) (by\n        simp only [closingHyps, List.mem_flatMap]; exact ⟨q, hq, by simp [hl]⟩)\n      have hwv : ∀ v ∈ w.2, v ∈ s.extVars := fun v hv => by\n        simp only [SMachine.extVars, SMachine.wVars, List.mem_append, List.mem_flatMap]\n        exact Or.inr ⟨w, (lookup_some hl).1, hv⟩\n      have hσ : ∀ j, applyS (q.2.1.zip (w.2.map .var)) (applyS (cycσ ce (.var ce.u)) (override [ce.u] vals Q) (cycMaps s.sk ce r (T + 1))) (cycView s.sk ce r (T + 1) u0) j\n          = applyS (q.2.1.zip (w.2.map .var)) (withExt s (r.st u0) (sReq s (r.st u0) (r.mp u0) (r.ι u0) (r.κ u0))) (withCarried s (r.mp u0) (r.κ u0)) j ∨ occC j q.2.2 = false := by\n        intro j\n        by_cases hjo : occC j q.2.2 = true\n        · left\n          simp only [applyS]\n          cases ha : assoc (q.2.1.zip (w.2.map .var)) j with\n          | some e =>\n            obtain ⟨v, hv, rfl⟩ : ∃ v ∈ w.2, e = .var v := by\n              simp only [assoc, Option.map_eq_some_iff] at ha\n              obtain ⟨p, hp, rfl⟩ := ha\n              have := (lookup_some hp).1\n              obtain ⟨_, hpw⟩ := List.of_mem_zip this\n              obtain ⟨v, hv, he⟩ := List.mem_map.mp hpw\n              exact ⟨v, hv, he.symm⟩\n            simp only [evalE]\n            have hf := ext_free hs hS hT hr hd hb hQ (hwv v hv)\n            exact upto_view hs hS hT hr hd hb hQ (fun x hx => by simp at hx; exact Or.inl hx) vals hu0 (by simp) hf.1 hf.2\n          | none =>\n            have hjk : j ∉ q.2.1 := by\n              obtain ⟨_, _, hwd, hcov, _, _, _⟩ := sOk_parts s hs\n              obtain ⟨⟨w', hw', hw1, hlen⟩, _⟩ := hcov q hq\n              simp only [distinctPairs, Bool.and_eq_true] at hwd\n              have hww : w = w' := by\n                have h1 := lookup_unique hwd.1 hw'\n                rw [hw1, hl] at h1; exact Option.some.inj h1\n              subst hww\n              exact assoc_zip_none q.2.1 (w.2.map .var) (by simp [hlen]) ha\n            obtain ⟨hz, hfl⟩ := body_free hs hS hT hr hd hb hQ hq hjo hjk\n            exact upto_view hs hS hT hr hd hb hQ (fun x hx => by simp at hx; exact Or.inl hx) vals hu0 (by simp) hz hfl\n        · right; simpa using hjo\n      rw [evalC_iff] at hc ⊢\n      simp only [holdsC, evalE] at hc ⊢\n      rw [upto_view hs hS hT hr hd hb hQ (fun x hx => by simp at hx; exact Or.inl hx) vals hu0 (by simp) hqv.1 hqv.2]\n      rcases hc with hc | hc\n      · exact Or.inl hc\n      · right\n        intro hn; apply hc\n        rw [← evalC_iff] at hn ⊢\n        rw [subst_evalC]\n        rw [subst_evalC] at hn\n        rw [← congr2C (ρ' := applyS (q.2.1.zip (w.2.map .var)) (withExt s (r.st u0) (sReq s (r.st u0) (r.mp u0) (r.ι u0) (r.κ u0))) (withCarried s (r.mp u0) (r.κ u0)))\n          (M' := withCarried s (r.mp u0) (r.κ u0)) q.2.2 (fun j hj => by rcases hσ j with h | h; exact h; rw [hj] at h; cases h)\n          (fun m hm => hN u0 m (avoidsMaps_occ hmb hm))]\n        exact hn\n\nend qfacts\n\nend sk\n\nsection skseq\nvariable {s : SMachine}\n\n-- Requests in a row, read by the sk machine: each decided at the machine's state it is taken in.\nnoncomputable def skReqs (s : SMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List SRequest → List SRequest\n  | _, _, [] => []\n  | ρ, M, q :: qs => (sReq s ρ M q.1 q.2, q.2) :: skReqs s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs\n\ntheorem skReqs_length : ∀ (ρ : Nat → Nat) (M : Nat → Nat → Nat) (qs : List SRequest), (skReqs s ρ M qs).length = qs.length\n  | _, _, [] => rfl\n  | ρ, M, q :: qs => by simp [skReqs, skReqs_length _ _ qs]\n\ntheorem skReqs_take : ∀ (ρ : Nat → Nat) (M : Nat → Nat → Nat) (qs : List SRequest) (j : Nat), (skReqs s ρ M qs).take j = skReqs s ρ M (qs.take j)\n  | _, _, [], _ => by simp [skReqs]\n  | _, _, _ :: _, 0 => by simp [skReqs]\n  | ρ, M, q :: qs, j + 1 => by simp [skReqs, skReqs_take _ _ qs j]\n\n-- Along requests the machine allows, its sk machine allows theirs, each state agreeing off the witnesses, the maps the\n-- same; each `when` read alike.\ntheorem sk_allowed (hs : sOk s = true) : ∀ (ws : List C) (qs : List SRequest) (ρ ρ' : Nat → Nat) (M : Nat → Nat → Nat),\n    Agree s.wVars ρ' ρ → SAllowed s ws ρ M qs → SAllowed s.sk ws ρ' M (skReqs s ρ M qs)\n  | [], _, _, _, _, _, _ => by cases (skReqs _ _ _ _) <;> trivial\n  | _ :: _, [], _, _, _, _, _ => trivial\n  | w :: ws, q :: qs, ρ, ρ', M, hag, hK => by\n    obtain ⟨hA, hW, hrest⟩ := hK\n    obtain ⟨hA', hS', hM'⟩ := sk_step hs hag M q.1 q.2\n    refine ⟨by show evalC _ _ s.f.m.assume = true; rw [hA']; exact hA, ?_, ?_⟩\n    · show evalC (withExt s.sk ρ' (sReq s.sk ρ' M (sReq s ρ M q.1 q.2) q.2)) (withCarried s.sk M q.2) w = true\n      have he : withExt s.sk ρ' (sReq s.sk ρ' M (sReq s ρ M q.1 q.2) q.2) = withInputs s.sk.f.m.inputs ρ' (sReq s ρ M q.1 q.2) := by\n        funext v\n        rw [withExt_plain sk_q rfl, sReq_plain sk_q rfl]\n        simp only [withInputs]; split <;> rfl\n      rw [he, sk_inputsView ρ ρ' hag]; exact hW\n    · show SAllowed s.sk ws (sNext s.sk ρ' M (sReq s ρ M q.1 q.2) q.2).1 (sNext s.sk ρ' M (sReq s ρ M q.1 q.2) q.2).2\n        (skReqs s (sNext s ρ M q.1 q.2).1 (sNext s ρ M q.1 q.2).2 qs)\n      rw [hM']\n      exact sk_allowed hs ws qs _ _ _ hS' hrest\n\ntheorem sk_end (hs : sOk s = true) : ∀ (qs : List SRequest) (ρ ρ' : Nat → Nat) (M : Nat → Nat → Nat), Agree s.wVars ρ' ρ →\n    Agree s.wVars (sEnd s.sk ρ' M (skReqs s ρ M qs)).1 (sEnd s ρ M qs).1 ∧ (sEnd s.sk ρ' M (skReqs s ρ M qs)).2 = (sEnd s ρ M qs).2\n  | [], _, _, _, hag => ⟨hag, rfl⟩\n  | q :: qs, ρ, ρ', M, hag => by\n    obtain ⟨_, hS', hM'⟩ := sk_step hs hag M q.1 q.2\n    simp only [skReqs, sEnd]\n    rw [hM']\n    exact sk_end hs qs _ _ _ hS'\n\n-- The j-th request of a row, read by the sk machine.\ntheorem skReqs_get : ∀ (ρ : Nat → Nat) (M : Nat → Nat → Nat) (qs : List SRequest) (j : Nat) (h : j < qs.length),\n    (skReqs s ρ M qs)[j]'(by rw [skReqs_length]; exact h)\n      = (sReq s (sEnd s ρ M (qs.take j)).1 (sEnd s ρ M (qs.take j)).2 qs[j].1 qs[j].2, qs[j].2)\n  | _, _, [], _, h => absurd h (Nat.not_lt_zero _)\n  | ρ, M, q :: qs, 0, _ => by simp [skReqs, sEnd]\n  | ρ, M, q :: qs, j + 1, h => by\n    simp only [skReqs, List.getElem_cons_succ, List.take_succ_cons, sEnd, List.length_cons] at h ⊢\n    exact skReqs_get _ _ qs j (by omega)\n\n-- Each step's extended request, as SKStepHolds reads it.\ntheorem sExts_get : ∀ (ρ : Nat → Nat) (M : Nat → Nat → Nat) (qs : List SRequest) (j : Nat) (h : j < qs.length),\n    (sExts s ρ M qs)[j]'(by\n      have : ∀ ρ M (qs : List SRequest), (sExts s ρ M qs).length = qs.length := by\n        intro ρ M qs; induction qs generalizing ρ M with\n        | nil => rfl\n        | cons q qs ih => simp [sExts, ih]\n      rw [this]; exact h)\n      = sReq s (sEnd s ρ M (qs.take j)).1 (sEnd s ρ M (qs.take j)).2 qs[j].1 qs[j].2\n  | _, _, [], _, h => absurd h (Nat.not_lt_zero _)\n  | ρ, M, q :: qs, 0, _ => by simp [sExts, sEnd]\n  | ρ, M, q :: qs, j + 1, h => by\n    simp only [sExts, List.getElem_cons_succ, List.take_succ_cons, sEnd, List.length_cons] at h ⊢\n    exact sExts_get _ _ qs j (by omega)\n\nend skseq\n\n-- The keys the quantified flags bind.\ndef SMachine.bk (s : SMachine) : List Nat := s.qflags.flatMap (·.2.1)\n\n-- Each exported fact is one of the sk machine's encoding, one a flag that holds at every key adds, or true of every natural.\ndef cycQFactsIn (s : SMachine) (ce : CycEnc) (facts : List Fact) : Bool :=\n  facts.all fun f => natC f.holds || (cycCanon s.sk ce ++ cycQFacts s ce).any (factBeq f)\n\ntheorem qfacts_all {s : SMachine} {ce : CycEnc} {keys : List Nat} (hs : sOk s = true) (hS : CycShape s.sk ce keys) (hT : CycTerms s.sk ce keys)\n    {r : CRun} {T : Nat} (hr : r.Ok s.sk T) (hd : ∀ u, u ≤ T → r.Decided s u) (hb : cycBodyOk s ce keys = true)\n    {Q : Nat → Nat} (hQ : EnvOk s.sk ce keys r T Q) {facts : List Fact} (hfa : cycQFactsIn s ce facts = true) :\n    FactsHold facts Q (cycMaps s.sk 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    rcases List.mem_append.mp hg with hg | hg\n    · exact canon_holds hS hT hr hg hQ vals\n    · exact qfacts_hold hs hS hT hr hd hb hQ hg vals\n\n/-- A cyclic proof of a law of a machine with flags that hold at every key, checked against its sk machine's encoding\nwith those flags' facts (`cycQMOk`): the law holds in every state the machine reaches, at every value of its keys. -/\ndef cycQMOk (s : SMachine) (ce : CycEnc) (facts : List Fact) (law : C) (keys : List Nat) (n : CNode) : Bool :=\n  sOk s && cycShapeOk s.sk ce (keys ++ s.bk) && cycTermsOk s.sk ce (keys ++ s.bk) && cycBodyOk s ce (keys ++ s.bk)\n    && cycLawOk s.sk ce law && cycQFactsIn s ce facts && cycNodeOk s.sk ce law n\n\ntheorem cyc_qmachine_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 : cycQMOk 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 [cycQMOk, Bool.and_eq_true] at hok\n  obtain ⟨⟨⟨⟨⟨⟨hs, hsh⟩, hte⟩, hbo⟩, 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, hd, hag, hmp⟩ := sk_run hs 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.sk ce (keys ++ s.bk) 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    have hwi : i ∉ s.wVars := fun h => h3 (hS.inv i (by rw [sk_inputs]; simp only [SMachine.extVars, List.mem_append]; exact Or.inr h))\n    rw [hnot i h1, hρ' i (fun h => h2 (List.mem_append_left _ h)), ← hag i hwi]\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.sk ce r (T + 1)) := qfacts_all hs hS hT hr hd hbo hEnv hfa\n  have htT : cycEnv ce T ρ' ce.t = T := by simp [cycEnv]\n  have hH : ∀ c ∈ n.hyps, evalC (cycEnv ce T ρ') (cycMaps s.sk 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.sk ce r (T + 1)) (cycEnv ce T ρ') hF n hn hH\n  have htT' : evalE (cycEnv ce T ρ') (cycMaps s.sk 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.sk ce r (T + 1))) (M' := cycView s.sk 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.sk.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]\n      have hwj : j ∉ s.wVars := fun h => hji (by rw [sk_inputs]; simp only [SMachine.extVars, List.mem_append]; exact Or.inr h)\n      rw [hag j hwj]\n      exact hρ' j (fun hk => hS.zv j (List.mem_append_right _ (List.mem_append_left _ 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\n/-- A k-step law's node for a machine with flags that hold at every key, checked against its sk machine's encoding with\nthose flags' facts (`cycKOk` over the sk machine, the flags' keys apart). -/\ndef cycQKOkAt (tb : Bool) (s : SMachine) (ce : CycEnc) (facts : List Fact) (sl : SKStep) (n : CNode) : Bool :=\n  sOk s && cycShapeOk s.sk ce s.bk && cycTermsOk s.sk ce s.bk && cycBodyOk s ce s.bk && cycQFactsIn s ce facts\n    && sl.k.ren.length == sl.k.whens.length && sl.mren.length == sl.k.whens.length\n    && sl.k.ren.all (fun r => r.all fun p => s.sk.f.m.inputs.contains p.1)\n    && sl.k.prime.all (fun q => (ce.vtr.map (·.1)).contains q.1 && !s.sk.f.m.inputs.contains q.1)\n    && sl.mren.all (fun r => r.all fun p => s.carried.contains p.1 && !ce.tm.contains p.2)\n    && sl.k.primeMaps.all (fun q => (ce.mtr.map (·.1)).contains q.1 && !s.carried.contains q.1 && !ce.tm.contains q.2)\n    && avoids (ce.special ++ s.bk ++ flagVars s.f.flags) sl.k.then_ && avoidsMaps ce.tm sl.k.then_\n    && sl.k.whens.all (fun w => avoids (ce.special ++ s.bk ++ flagVars s.f.flags) w && avoidsMaps ce.tm w)\n    && beqC n.concl (substRC (kσ tb ce sl) (kRd tb ce sl) sl.k.then_)\n    && n.hyps.all (fun h => beqC h s.f.m.pre || beqC h (.le (.const sl.k.whens.length) (.var ce.t)) || beqC h (.le (.var ce.t) (.var ce.T))\n      || beqC h (.lt (.var ce.T) (.var ce.om)) || (kWhens tb ce sl.k.whens.length 0 sl.k.whens).any (beqC h))\n\ntheorem cyc_qkstep_sound_at (tb : Bool) (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (sl : SKStep) (n : CNode) (hn : n ∈ nodes) (hok : cycQKOkAt tb s ce facts sl n = true) : SKStepHolds s sl := by\n  simp only [cycQKOkAt, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hok\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hs, hsh⟩, hte⟩, hbo⟩, hfa⟩, hrl⟩, hml⟩, hrin⟩, hpr⟩, hmr⟩, hpm⟩, hthv⟩, hthm⟩, hwh⟩, hcon⟩, hhy⟩ := hok\n  have hS := cycShape_of hsh\n  have hT := cycTerms_of hte\n  have hsp := special_parts hS.dsp\n  have hcz : ∀ x, x ∉ ce.special ++ s.bk ++ flagVars s.f.flags → x ∉ cycZ ce s.bk ∧ x ∉ flagVars s.f.flags := fun x hx =>\n    ⟨fun h => hx (List.mem_append_left _ h), fun h => hx (List.mem_append_right _ h)⟩\n  intro ρ M hr q₁ qs hlen hK\n  obtain ⟨r, T0, hr0, hdec, hag, hmp⟩ := sk_run hs hr\n  have hK' := sk_allowed hs sl.k.whens (q₁ :: qs) ρ (r.st T0) M hag hK\n  have hql : (skReqs s ρ M (q₁ :: qs)).length = (q₁ :: qs).length := skReqs_length _ _ _\n  obtain ⟨r1, hr1, _, hle, hlt, hj, hι⟩ := run_ext sk_q (skReqs s ρ M (q₁ :: qs)) sl.k.whens r T0 (r.st T0) M hr0 rfl hmp (by rw [hql]; simp; omega) hK'\n  rw [hql] at hr1 hj\n  have hk : sl.k.whens.length = (q₁ :: qs).length := by simp; omega\n  -- The state after the first j requests, and the j-th request, as the sk machine's run has them.\n  have hagj : ∀ j, j ≤ (q₁ :: qs).length → Agree s.wVars (r1.st (T0 + j)) (sEnd s ρ M ((q₁ :: qs).take j)).1\n      ∧ r1.mp (T0 + j) = (sEnd s ρ M ((q₁ :: qs).take j)).2 := fun j hj' => by\n    obtain ⟨a, b⟩ := hj j hj'\n    rw [a, b, skReqs_take]; exact sk_end hs _ _ _ M hag\n  have hreqj : ∀ j (h : j < (q₁ :: qs).length), r1.ι (T0 + j) = sReq s (sEnd s ρ M ((q₁ :: qs).take j)).1 (sEnd s ρ M ((q₁ :: qs).take j)).2 (q₁ :: qs)[j].1 (q₁ :: qs)[j].2\n      ∧ r1.κ (T0 + j) = (q₁ :: qs)[j].2 := fun j h => by\n    obtain ⟨a, b⟩ := hι j (by rw [hql]; exact h)\n    have hg := skReqs_get (s := s) ρ M (q₁ :: qs) j h\n    rw [a, b]; simp only [hg, and_self]\n  -- The last request (no step takes it) decided too: every request of the run is.\n  let T' := T0 + (q₁ :: qs).length\n  let r' := r1.last T' (sReq s (r1.st T') (r1.mp T') (fun _ => 0) noSets) noSets\n  have hr' : r'.Ok s.sk T' := last_ok hr1 _ _\n  have hd' : ∀ u, u ≤ T' → r'.Decided s u := by\n    intro u hu\n    by_cases huT : u = T'\n    · subst huT; exact last_decided\n    · refine last_other huT _ _ ?_\n      rcases Nat.lt_or_ge u T0 with hlt0 | hge0\n      · have h := hdec u (Nat.le_of_lt hlt0)\n        obtain ⟨a, b⟩ := hle u (Nat.le_of_lt hlt0)\n        obtain ⟨c', d⟩ := hlt u hlt0\n        simp only [CRun.Decided, a, b, c', d] at h ⊢; exact h\n      · obtain ⟨j, rfl⟩ : ∃ j, u = T0 + j := ⟨u - T0, by omega⟩\n        have hjl : j < (q₁ :: qs).length := by simp only [T'] at hu huT; omega\n        obtain ⟨ha, hm⟩ := hagj j (Nat.le_of_lt hjl)\n        obtain ⟨hι', hκ'⟩ := hreqj j hjl\n        simp only [CRun.Decided, hι', hκ', hm]\n        rw [sReq_agree hs ha, sReq_idem]\n  -- The node's environment: t and T the run's end, Ω one above it, the rest from before the start.\n  obtain ⟨Q, hQt, hQT, hQo, hQr⟩ : ∃ Q : Nat → Nat, Q ce.t = T' ∧ Q ce.T = T' ∧ Q ce.om = T' + 1 ∧ ∀ i, i ∉ ce.special → Q i = r'.ρ0 i :=\n    ⟨fun i => if i = ce.t then T' else if i = ce.T then T' else if i = ce.om then T' + 1 else r'.ρ0 i,\n      by simp, by simp [Ne.symm hsp.2.2.2.2.2.1], by simp [Ne.symm hsp.2.2.2.2.2.2, Ne.symm hsp.2.2.2.2.1],\n      fun i hi => by\n        dsimp only\n        rw [if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inr e)))))), if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inl e))))),\n          if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inl e))))))]⟩\n  have hEnv : EnvOk s.sk ce s.bk r' T' Q := ⟨hQT, hQo, fun i hi => hQr i (notP hi).1⟩\n  have hF : FactsHold facts Q (cycMaps s.sk ce r' (T' + 1)) := qfacts_all hs hS hT hr' hd' hbo hEnv hfa\n  have hframe : ∀ u, u ≤ T' → ∀ i, i ∉ ce.vtr.map (·.1) → i ∉ flagVars s.f.flags → r'.st u i = r'.ρ0 i := fun u hu i hv hf =>\n    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)) (fun h => hv (hS.inv i h)) hf\n  have hwV : ∀ x, x ∉ ce.vtr.map (·.1) → x ∉ s.extVars := fun x hv h => hv (hS.inv x (by rw [sk_inputs]; exact h))\n  have hwW : ∀ x, x ∉ ce.vtr.map (·.1) → x ∉ s.wVars := fun x hv h => hwV x hv (by simp only [SMachine.extVars, List.mem_append]; exact Or.inr h)\n  -- What the run reads at T0 + j: the goal's view of the j-th step of the machine.\n  have hXj : ∀ j (h : j < (q₁ :: qs).length), r'.X s.sk (T0 + j) = withExt s (sEnd s ρ M ((q₁ :: qs).take j)).1\n      (sReq s (sEnd s ρ M ((q₁ :: qs).take j)).1 (sEnd s ρ M ((q₁ :: qs).take j)).2 (q₁ :: qs)[j].1 (q₁ :: qs)[j].2) := fun j h => by\n    have hne : T0 + j ≠ T' := by simp only [T']; omega\n    show withInputs s.sk.f.m.inputs (r1.st (T0 + j)) (if T0 + j = T' then _ else r1.ι (T0 + j)) = _\n    rw [if_neg hne, (hreqj j h).1]\n    exact sk_inputsView _ _ (hagj j (Nat.le_of_lt h)).1 _ _ _\n  have hNj : ∀ j (h : j < (q₁ :: qs).length), r'.N s.sk (T0 + j) = withCarried s (sEnd s ρ M ((q₁ :: qs).take j)).2 (q₁ :: qs)[j].2 := fun j h => by\n    have hne : T0 + j ≠ T' := by simp only [T']; omega\n    show withCarried s.sk (r1.mp (T0 + j)) (if T0 + j = T' then _ else r1.κ (T0 + j)) = _\n    rw [if_neg hne, (hreqj j h).2, (hagj j (Nat.le_of_lt h)).2]; rfl\n  have hq0 : 0 < (q₁ :: qs).length := by simp\n  have hw0 : evalE Q (cycMaps s.sk ce r' (T' + 1)) (tAtS tb ce sl.k.whens.length) = T0 := by rw [tAtS_eval tb, hQt, hk]; simp only [T']; omega\n  -- The node's hypotheses hold there.\n  have hH : ∀ c ∈ n.hyps, evalC Q (cycMaps s.sk ce r' (T' + 1)) c = true := by\n    intro c hc\n    have h := hhy c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with (((h | h) | h) | h) | h\n    · rw [beqC_eq h, congr2C (ρ := Q) (M := cycMaps s.sk ce r' (T' + 1)) (ρ' := r'.ρ0) (M' := r'.mp 0) s.f.m.pre\n        (fun j hj => hEnv.2.2 j (avoids_occ hT.prz hj)) (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, hQt, hk]; simp only [T']; omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQt, hQT]; omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQT, hQo]; omega\n    · obtain ⟨c', hc', hb⟩ := List.any_eq_true.mp h\n      rw [beqC_eq hb]\n      obtain ⟨i, hi, rfl⟩ := kWhens_mem tb ce sl.k.whens.length 0 sl.k.whens hc'\n      have hiq : i < (q₁ :: qs).length := by omega\n      have hu : T0 + i ≤ T' := by simp only [T']; omega\n      have hwi : evalE Q (cycMaps s.sk ce r' (T' + 1)) (tAtS tb ce (sl.k.whens.length - (0 + i))) = T0 + i := by rw [tAtS_eval tb, hQt, hk]; simp only [T']; omega\n      have hall := sallowed_at (q₁ :: qs) sl.k.whens ρ M hK i hiq hi\n      have hav := hwh _ (List.getElem_mem hi)\n      rw [enc_trC hS hT hr' hEnv hwi hu]\n      rw [congr2C (ρ' := withExt s (sEnd s ρ M ((q₁ :: qs).take i)).1 (sReq s (sEnd s ρ M ((q₁ :: qs).take i)).1 (sEnd s ρ M ((q₁ :: qs).take i)).2 (q₁ :: qs)[i].1 (q₁ :: qs)[i].2))\n        (M' := withCarried s (sEnd s ρ M ((q₁ :: qs).take i)).2 (q₁ :: qs)[i].2) _ ?_ ?_]\n      · exact hall\n      · intro x hx\n        obtain ⟨hz, hfl⟩ := hcz x (avoids_occ hav.1 hx)\n        rw [enc_Y hS hT hr' hEnv hwi hu hz hfl, hXj i hiq]\n      · intro m hm\n        rw [cv_N (avoidsMaps_occ hav.2 hm), hNj i hiq]\n  have hc0 := cyclic_sound facts nodes hc (cycMaps s.sk ce r' (T' + 1)) Q hF n hn hH\n  rw [beqC_eq hcon] at hc0\n  -- `then` over the run: the maps it reads, then its names.\n  have hTle : T0 ≤ T' := by simp only [T']; omega\n  obtain ⟨hagE, hmE⟩ : Agree s.wVars (r'.st T') (sEnd s ρ M (q₁ :: qs)).1 ∧ r'.mp T' = (sEnd s ρ M (q₁ :: qs)).2 := by\n    have h := hagj (q₁ :: qs).length (Nat.le_refl _); simp only [List.take_length] at h; exact h\n  let Mt : Nat → Nat → Nat := primedMaps sl.k.primeMaps (sEnd s ρ M (q₁ :: qs)).2 (renMaps sl.mren ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2))\n  have hrd : ∀ m key, evalE Q (cycMaps s.sk ce r' (T' + 1)) (kRd tb ce sl m key)\n      = (fun m => if ce.tm.contains m then cycMaps s.sk ce r' (T' + 1) m else Mt m) m (evalE Q (cycMaps s.sk ce r' (T' + 1)) key) := by\n    intro m key\n    simp only [kRd]\n    cases hq : lookup (fun q => q.2 == m) sl.k.primeMaps with\n    | some q =>\n      obtain ⟨hqm, hqe⟩ := lookup_some hq\n      have hqe' : q.2 = m := by simpa using hqe\n      obtain ⟨⟨hq1, hq2⟩, hq3⟩ := hpm q hqm\n      have hnt : ¬ ce.tm.contains m = true := by rw [← hqe']; simpa using hq3\n      simp only [evalE, tAtS_eval tb, hQt, hQo, Nat.sub_zero]\n      rw [read_mm hS.dtm (List.contains_iff_mem.mp hq1) (Nat.le_refl _), N_not_carried (show q.1 ∉ s.sk.carried from fun h => by simp only [Bool.not_eq_true'] at hq2; rw [List.contains_iff_mem.mpr (show q.1 ∈ s.carried from h)] at hq2; cases hq2), hmE, if_neg hnt]\n      simp only [Mt, primedMaps, hq]\n    | none =>\n      have hkm := kMren_eval sl.mren 0 ((q₁ :: qs).map (·.2)) (withCarried s M q₁.2) m (by simp; omega)\n      cases hkr : kMren 0 sl.mren m with\n      | some p =>\n        obtain ⟨i', hi', hκ', hi0, ⟨p', hp', hp1, hp2⟩, hren⟩ := hkm.2 p.1 p.2 hkr\n        obtain ⟨hcar, hnt0⟩ := hmr _ (List.getElem_mem hi') p' hp'\n        have hnt : ¬ ce.tm.contains m = true := by rw [← hp2]; simpa using hnt0\n        have hiq : i' < (q₁ :: qs).length := by simpa using hκ'\n        simp only [evalE, tAtS_eval tb, hQt, hQo, hi0, Nat.zero_add]\n        rw [show T' - (sl.k.whens.length - i') = T0 + i' by rw [hk]; simp only [T']; omega]\n        rw [read_mm hS.dtm (hS.carm _ (by rw [← hp1]; exact List.contains_iff_mem.mp hcar)) (by simp only [T']; omega), hNj i' hiq, if_neg hnt]\n        simp only [Mt, primedMaps, hq, hren, withCarried, ← hp1, hcar, if_true, List.getElem_map]\n      | none =>\n        rw [enc_rd hS hT hr' hEnv hw0 hTle]\n        simp only [cycView]\n        by_cases ht : ce.tm.contains m = true\n        · rw [if_pos ht, if_pos ht]\n        · rw [if_neg ht, if_neg ht]\n          have h0 := hNj 0 hq0\n          simp only [Nat.add_zero, List.take_zero, sEnd, List.getElem_cons_zero] at h0\n          rw [h0]\n          simp only [Mt, primedMaps, hq, hkm.1 hkr]\n  rw [substR_evalC (kσ tb ce sl) (kRd tb ce sl) Q _ _ hrd] at hc0\n  rw [congr2C (ρ' := primed sl.k.prime (sEnd s ρ M (q₁ :: qs)).1 (renEnv sl.k.ren (sExts s ρ M (q₁ :: qs)) (withExt s ρ (sReq s ρ M q₁.1 q₁.2))))\n    (M' := Mt) _ ?_ ?_] at hc0\n  · exact hc0\n  · intro x hx\n    obtain ⟨hz, hfl⟩ := hcz x (avoids_occ hthv hx)\n    simp only [kσ, List.append_assoc]\n    rw [applyS_app, assoc_ren]\n    simp only [primed]\n    cases hq : lookup (fun q => q.2 == x) sl.k.prime with\n    | some q =>\n      obtain ⟨hqm, _⟩ := lookup_some hq\n      obtain ⟨hq1, hq2⟩ := hpr q hqm\n      have hqw : q.1 ∉ s.wVars := fun h => by\n        simp only [Bool.not_eq_true'] at hq2\n        rw [List.contains_iff_mem.mpr (by rw [sk_inputs]; simp only [SMachine.extVars, List.mem_append]; exact Or.inr h)] at hq2; cases hq2\n      simp only [Option.map_some, evalE, tAtS_eval tb, hQt, Nat.sub_zero]\n      rw [read_vm hS.dtm (List.contains_iff_mem.mp hq1), CRun.X, withInputs_other (by simpa using hq2), hagE q.1 hqw]\n    | none =>\n      simp only [Option.map_none]\n      by_cases hxr : x ∈ tgts sl.k.ren\n      · have hel : ∀ ρ M (qs : List SRequest), (sExts s ρ M qs).length = qs.length := by\n          intro ρ M qs; induction qs generalizing ρ M with\n          | nil => rfl\n          | cons q qs ih => simp [sExts, ih]\n        rw [kRen_eval tb ce sl.k.whens.length Q _ _ _ sl.k.ren 0 (sExts s ρ M (q₁ :: qs)) (by rw [hel]; omega) ?_ x hxr]\n        intro i hi hιl p hp\n        have hpin := hrin _ (List.getElem_mem hi) p hp\n        have hiq : i < (q₁ :: qs).length := by rw [hel] at hιl; exact hιl\n        simp only [evalE, tAtS_eval tb, hQt, Nat.zero_add]\n        rw [show T' - (sl.k.whens.length - i) = T0 + i by rw [hk]; simp only [T']; omega]\n        rw [read_vm hS.dtm (hS.inv _ (List.contains_iff_mem.mp hpin)), hXj i hiq, sExts_get ρ M (q₁ :: qs) i hiq]\n        simp only [withExt, show s.extVars.contains p.1 = true from by rw [← sk_inputs]; exact hpin, if_true]\n      · rw [kRen_out tb ce sl.k.whens.length Q _ _ sl.k.ren 0 x hxr, renEnv_other _ _ _ x hxr]\n        have hX0 := hXj 0 hq0\n        simp only [Nat.add_zero, List.take_zero, sEnd, List.getElem_cons_zero] at hX0\n        by_cases hv : x ∈ ce.vtr.map (·.1)\n        · rw [enc_σ_in hS hT hr' hEnv hw0 hTle hv, hX0]\n        · rw [enc_σ_out hS hT hr' hEnv hw0 hTle hv, hQr x (fun h => hz (List.mem_append_left _ h))]\n          simp only [withExt, show s.extVars.contains x = false from by simpa [List.contains_iff_mem] using hwV x hv, Bool.false_eq_true, if_false]\n          have h0 := hagj 0 (Nat.zero_le _)\n          simp only [Nat.add_zero, List.take_zero, sEnd] at h0\n          rw [← h0.1 x (hwW x hv)]\n          exact (hframe T0 hTle x hv hfl).symm\n  · intro m hm\n    simp only [if_neg (fun h => avoidsMaps_occ hthm hm (List.contains_iff_mem.mp h))]\n\n\ndef cycQKOk (s : SMachine) (ce : CycEnc) (facts : List Fact) (sl : SKStep) (n : CNode) : Bool :=\n  cycQKOkAt true s ce facts sl n || cycQKOkAt false s ce facts sl n\n\ntheorem cyc_qkstep_sound (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (sl : SKStep) (n : CNode) (hn : n ∈ nodes) (hok : cycQKOk s ce facts sl n = true) : SKStepHolds s sl := by\n  simp only [cycQKOk, Bool.or_eq_true] at hok\n  rcases hok with h | h\n  · exact cyc_qkstep_sound_at true s ce facts nodes hc sl n hn h\n  · exact cyc_qkstep_sound_at false s ce facts nodes hc sl n hn h\n\n/-- A request allowed, as a node for a machine with flags that hold at every key (`cycAOk` over its sk machine, those\nflags' facts, the flags' keys apart). -/\ndef cycQAOk (s : SMachine) (ce : CycEnc) (facts : List Fact) (w : C) (n : CNode) : Bool :=\n  sOk s && cycShapeOk s.sk ce s.bk && cycTermsOk s.sk ce s.bk && cycBodyOk s ce s.bk && cycQFactsIn s ce facts\n    && avoids (ce.special ++ s.bk ++ flagVars s.f.flags) w && avoidsMaps ce.tm w\n    && beqC n.concl (trC ce (.var ce.t) (inlineC s.f.flags s.f.m.assume))\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      || beqC h (trC ce (.var ce.t) w) || cycZeroOk s ce h)\n\ntheorem cyc_qallow_sound (s : SMachine) (ce : CycEnc) (facts : List Fact) (nodes : List CNode) (hc : checkCyclic facts nodes = true)\n    (w : C) (n : CNode) (hn : n ∈ nodes) (hok : cycQAOk s ce facts w n = true) : AllowHolds s w := by\n  simp only [cycQAOk, Bool.and_eq_true, List.all_eq_true] at hok\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨hs, hsh⟩, hte⟩, hbo⟩, hfa⟩, hwv⟩, hwm⟩, hcon⟩, hhy⟩ := hok\n  have hS := cycShape_of hsh\n  have hT := cycTerms_of hte\n  have hsp := special_parts hS.dsp\n  intro ρ M hr ι hw\n  obtain ⟨r, T, hr0, hd, hag, hmp⟩ := sk_run hs hr\n  -- The run with the request at T (the last, which no step takes) the claim's, decided, carrying empty sets.\n  let r2 := r.last T (sReq s ρ M ι noSets) noSets\n  have hr2 : r2.Ok s.sk T := last_ok hr0 _ _\n  have hd2 : ∀ u, u ≤ T → r2.Decided s u := by\n    intro u hu\n    by_cases huT : u = T\n    · subst huT\n      simp only [CRun.Decided, r2, CRun.last, ↓reduceIte, hmp]\n      rw [sReq_agree hs hag, sReq_idem]\n    · exact last_other huT _ _ (hd u hu)\n  have hX : r2.X s.sk T = withExt s ρ (sReq s ρ M ι noSets) := by\n    show withInputs s.sk.f.m.inputs (r.st T) (if T = T then sReq s ρ M ι noSets else r.ι T) = _\n    rw [if_pos rfl]; exact sk_inputsView _ _ hag _ _ _\n  have hN : r2.N s.sk T = withCarried s M noSets := by\n    show withCarried s.sk (r.mp T) (if T = T then noSets else r.κ T) = _\n    rw [if_pos rfl, hmp]; rfl\n  obtain ⟨Q, hQt, hQT, hQo, hQr⟩ : ∃ Q : Nat → Nat, Q ce.t = T ∧ Q ce.T = T ∧ Q ce.om = T + 1 ∧ ∀ i, i ∉ ce.special → Q i = r.ρ0 i :=\n    ⟨fun i => if i = ce.t then T else if i = ce.T then T else if i = ce.om then T + 1 else r.ρ0 i,\n      by simp, by simp [Ne.symm hsp.2.2.2.2.2.1], by simp [Ne.symm hsp.2.2.2.2.2.2, Ne.symm hsp.2.2.2.2.1],\n      fun i hi => by\n        dsimp only\n        rw [if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inr e)))))), if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inl e))))),\n          if_neg (fun e => hi (in_special (Or.inr (Or.inr (Or.inr (Or.inl e))))))]⟩\n  have hEnv : EnvOk s.sk ce s.bk r2 T Q := ⟨hQT, hQo, fun i hi => hQr i (notP hi).1⟩\n  have hwt : evalE Q (cycMaps s.sk ce r2 (T + 1)) (.var ce.t) = T := by simp [evalE, hQt]\n  have hF : FactsHold facts Q (cycMaps s.sk ce r2 (T + 1)) := qfacts_all hs hS hT hr2 hd2 hbo hEnv hfa\n  have hH : ∀ c ∈ n.hyps, evalC Q (cycMaps s.sk ce r2 (T + 1)) c = true := by\n    intro c hc\n    have h := hhy c hc\n    simp only [Bool.or_eq_true] at h\n    rcases h with ((((h | h) | h) | h) | h)\n    · rw [beqC_eq h, congr2C (ρ := Q) (M := cycMaps s.sk ce r2 (T + 1)) (ρ' := r2.ρ0) (M' := r2.mp 0) s.f.m.pre\n        (fun j hj => hEnv.2.2 j (avoids_occ hT.prz hj)) (fun m hm => cm_o (avoidsMaps_occ hT.prm hm))]\n      exact hr2.pre\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQt, hQT]; omega\n    · rw [beqC_eq h, evalC_iff]; simp only [holdsC, evalE, hQT, hQo]; omega\n    · rw [beqC_eq h, enc_trC hS hT hr2 hEnv hwt (Nat.le_refl T)]\n      rw [congr2C (ρ' := withExt s ρ (sReq s ρ M ι noSets)) (M' := withCarried s M noSets) _ ?_ ?_]\n      · exact hw\n      · intro x hx\n        have hxz := avoids_occ hwv hx\n        rw [enc_Y hS hT hr2 hEnv hwt (Nat.le_refl T) (fun h => hxz (List.mem_append_left _ h)) (fun h => hxz (List.mem_append_right _ h)), hX]\n      · intro m hm\n        rw [cv_N (avoidsMaps_occ hwm hm), hN]\n    · obtain ⟨cm, key, hcm, rfl⟩ := cycZeroOk_spec h\n      rw [evalC_iff]\n      simp only [holdsC, evalE, hQt, hQo]\n      rw [read_mm hS.dtm (hS.carm cm hcm) (Nat.le_refl T), hN]\n      simp only [withCarried, List.contains_iff_mem.mpr hcm, if_true, noSets]\n  have hc0 := cyclic_sound facts nodes hc (cycMaps s.sk ce r2 (T + 1)) Q hF n hn hH\n  rw [beqC_eq hcon] at hc0\n  change evalC Q _ (trC ce (.var ce.t) (inlineC s.sk.f.flags s.f.m.assume)) = true at hc0\n  rw [enc_nowC hS hT hr2 hEnv hwt (Nat.le_refl T) s.f.m.assume hT.asz hT.asm] at hc0\n  obtain ⟨hV, hNv⟩ := sk_view hs hag M ι noSets\n  have hV2 : r2.V s.sk T = (sView s.sk (r.st T) M (sReq s ρ M ι noSets) noSets).1 := by\n    rw [sk_view_eq _ _ hag]; simp only [CRun.V, hX, hN]; rfl\n  have hN2 : r2.N s.sk T = (sView s ρ M ι noSets).2 := by rw [hN]; rfl\n  obtain ⟨_, _, _, has, _⟩ := sOk_terms hs\n  rw [hV2, hN2, congrC _ (sView s ρ M ι noSets).1 _ s.f.m.assume (fun j hj => hV j (avoids_occ has hj))] at hc0\n  exact hc0\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",
+    "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- `wf_fix_unique`: a definition by well-founded recursion has exactly one solution. core/data.ts takes a function whose\n  recursion isn't structural once the kernel has proven that each of its calls lowers a measure (a lexicographic tuple\n  of naturals, the order of the cyclic ranks, `lexLt`) under the path to the call; its body, read as a functional F of\n  the function, then reads it only below the argument's measure, and such an F has one fixpoint. So the function's\n  equation, a fact of its proofs, has a model (what they conclude isn't vacuous), and only one: the function as written.\n  An export defines such a function with `termination_by` the same measure, `Lx` (a tuple, ordered by `lexLt`) where\n  it has several components, and Lean checks the decrease again.\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/-! ### Definitions by well-founded recursion -/\n\n/-- A functional that reads its function only at arguments of lower measure (lexicographic, as the cyclic ranks are\nordered) has exactly one fixpoint: a function satisfying `f x = F f x` at every argument, and every other one equal to\nit. `F g x = F h x` wherever g and h agree below x's measure: a body whose calls (under the path the argument takes)\nare each at a lower measure. -/\ntheorem wf_fix_unique {α β : Type} [Inhabited β] (μ : α → List Nat) (F : (α → β) → α → β)\n    (hF : ∀ (g h : α → β) (x : α), (∀ y, lexLt (μ y) (μ x) → g y = h y) → F g x = F h x) :\n    ∃ f : α → β, (∀ x, f x = F f x) ∧ ∀ f' : α → β, (∀ x, f' x = F f' x) → f' = f := by\n  classical\n  have wf : WellFounded (InvImage lexLt μ) := InvImage.wf μ lexLt_wf\n  let G : (x : α) → ((y : α) → InvImage lexLt μ y x → β) → β :=\n    fun x rec => F (fun y => if h : lexLt (μ y) (μ x) then rec y h else default) x\n  have hfix : ∀ x, wf.fix G x = F (wf.fix G) x := by\n    intro x\n    rw [wf.fix_eq G x]\n    apply hF\n    intro y hy\n    simp [hy]\n  refine ⟨wf.fix G, hfix, fun f' hf' => funext fun x => ?_⟩\n  exact wf.induction (C := fun x => f' x = wf.fix G x) x (fun x ih => by\n    rw [hf' x, hfix x]\n    exact hF f' (wf.fix G) x (fun y hy => ih y hy))\n\n/-- A measure of several components for `termination_by`: the tuple, ordered by `lexLt` (an export's measures all have\none length). -/\nstructure Lx where\n  l : List Nat\n\ninstance : WellFoundedRelation Lx := ⟨fun a b => lexLt a.l b.l, InvImage.wf Lx.l lexLt_wf⟩\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",
 };