gdp-wired 0.15.0 → 0.17.0

package/dist/lean-kernel/library.js

@@ -2,6 +2,7 @@
 export const leanLibrary = {
     "Cert.lean": "/-\nCert: the trusted core of gdp-wired, with its proofs. Lean 4.34.0, core only.\n\nA row `Σ cᵢ·xᵢ + c ≤ 0` over the integers. A certificate is a list of steps that replays into rows: an input row, a\npositive combination of two earlier rows, or a cut (an earlier row whose coefficients are all g times q, replaced by q\nwith a constant c such that g·c ≤ constant + g − 1). `check` accepts when the last row has only zero coefficients and a\npositive constant. `sound`: if `check` accepts, no integer point satisfies every input row.\n\nA row holds its nonzero coefficients alone (column, coefficient), in column order, so a step costs a row's nonzeros\nrather than the table's width. Any list reads as a sum (`dot`); sorted lists stay sorted and cancel to [] under `addL`.\n\n`run_preserves` is the induction rule a step machine's laws rest on: a property true at the start and preserved by\nevery step holds after every sequence of steps.\n-/\n\nnamespace Cert\n\nstructure Row where\n  coefs : List (Nat × Int)\n  const : Int\nderiving Repr\n\ndef dot : List (Nat × Int) → List Int → Int\n  | [], _ => 0\n  | p :: rest, x => p.2 * x.getD p.1 0 + dot rest x\n\ndef eval (r : Row) (x : List Int) : Int := dot r.coefs x + r.const\n\n-- Two sorted lists merged, coefficients of one column added (a column that cancels dropped). The fuel only bounds the\n-- recursion: out of it, the lists are put side by side, which reads the same.\ndef addF : Nat → List (Nat × Int) → List (Nat × Int) → List (Nat × Int)\n  | 0, a, b => a ++ b\n  | _ + 1, [], b => b\n  | _ + 1, a, [] => a\n  | n + 1, p :: as, q :: bs =>\n    if p.1 < q.1 then p :: addF n as (q :: bs)\n    else if q.1 < p.1 then q :: addF n (p :: as) bs\n    else if p.2 + q.2 = 0 then addF n as bs else (p.1, p.2 + q.2) :: addF n as bs\n\ndef addL (a b : List (Nat × Int)) : List (Nat × Int) := addF (a.length + b.length) a b\n\ndef scaleL (m : Int) (a : List (Nat × Int)) : List (Nat × Int) := if m = 0 then [] else a.map (fun p => (p.1, m * p.2))\n\ndef allZero : List (Nat × Int) → Bool\n  | [] => true\n  | p :: a => p.2 == 0 && allZero a\n\ntheorem dot_app (x : List Int) : ∀ (a b : List (Nat × Int)), dot (a ++ b) x = dot a x + dot b x\n  | [], b => by simp [dot]\n  | p :: a, b => by simp only [List.cons_append, dot, dot_app x a b]; omega\n\ntheorem dot_addF (x : List Int) : ∀ (n : Nat) (a b : List (Nat × Int)), dot (addF n a b) x = dot a x + dot b x\n  | 0, a, b => by simp only [addF, dot_app]\n  | _ + 1, [], b => by simp [addF, dot]\n  | _ + 1, _ :: _, [] => by simp [addF, dot]\n  | n + 1, p :: as, q :: bs => by\n    simp only [addF]\n    split\n    · simp only [dot, dot_addF x n as (q :: bs)]; omega\n    · split\n      · simp only [dot, dot_addF x n (p :: as) bs]; omega\n      · have hpq : p.1 = q.1 := by omega\n        split\n        · rename_i hz\n          simp only [dot, dot_addF x n as bs, hpq]\n          have : p.2 * x.getD q.1 0 + q.2 * x.getD q.1 0 = 0 := by rw [← Int.add_mul, hz, Int.zero_mul]\n          omega\n        · simp only [dot, dot_addF x n as bs, hpq, Int.add_mul]; omega\n\ntheorem dot_addL (a b : List (Nat × Int)) (x : List Int) : dot (addL a b) x = dot a x + dot b x := dot_addF x _ a b\n\ntheorem dot_map (m : Int) (x : List Int) : ∀ (a : List (Nat × Int)), dot (a.map (fun p => (p.1, m * p.2))) x = m * dot a x\n  | [] => by simp [dot]\n  | p :: a => by simp only [List.map_cons, dot, dot_map m x a, Int.mul_add, Int.mul_assoc]\n\ntheorem dot_scaleL (m : Int) (a : List (Nat × Int)) (x : List Int) : dot (scaleL m a) x = m * dot a x := by\n  unfold scaleL\n  split\n  · rename_i h; subst h; simp [dot]\n  · exact dot_map m x a\n\ntheorem dot_allZero : ∀ (a : List (Nat × Int)) (x : List Int), allZero a = true → dot a x = 0\n  | [], _, _ => rfl\n  | p :: a, x, h => by\n    simp only [allZero, Bool.and_eq_true, beq_iff_eq] at h\n    simp [dot, h.1, dot_allZero a x h.2]\n\ninductive Step where\n  | input (i : Nat)\n  | combine (a b : Nat) (ma mb : Int)\n  | cut (of : Nat) (g : Int) (q : List (Nat × Int)) (c : Int)\nderiving Repr\n\ndef combineRow (ma mb : Int) (A B : Row) : Row :=\n  ⟨addL (scaleL ma A.coefs) (scaleL mb B.coefs), ma * A.const + mb * B.const⟩\n\ndef cutOk (A : Row) (g : Int) (q : List (Nat × Int)) (c : Int) : Bool :=\n  decide (1 ≤ g) && decide (A.coefs = scaleL g q) && decide (g * c ≤ A.const + g - 1)\n\n-- The rows so far kept newest first, with their number (step i's row is at n − 1 − i): a row is put on the front and\n-- read where it is, never past a chain of appends.\ndef replay (inputs : List Row) : List Step → Nat → List Row → Option (List Row)\n  | [], _, rows => some rows\n  | .input i :: ss, n, rows =>\n    match inputs[i]? with\n    | some r => replay inputs ss (n + 1) (r :: rows)\n    | none => none\n  | .combine a b ma mb :: ss, n, rows =>\n    match rows[n - 1 - a]?, rows[n - 1 - b]? with\n    | some A, some B => if a < n ∧ b < n ∧ 0 < ma ∧ 0 < mb then replay inputs ss (n + 1) (combineRow ma mb A B :: rows) else none\n    | _, _ => none\n  | .cut o g q c :: ss, n, rows =>\n    match rows[n - 1 - o]? with\n    | some A => if o < n ∧ cutOk A g q c then replay inputs ss (n + 1) (⟨q, c⟩ :: rows) else none\n    | none => none\n\ndef check (inputs : List Row) (steps : List Step) : Bool :=\n  match replay inputs steps 0 [] with\n  | some rows =>\n    match rows.head? with\n    | some r => allZero r.coefs && decide (0 < r.const)\n    | none => false\n  | none => false\n\ntheorem cut_sound (g d c c' : Int) (hg : 1 ≤ g) (h : g * d + c ≤ 0) (hc : g * c' ≤ c + g - 1) : d + c' ≤ 0 := by\n  have hd : g * (d + c') = g * d + g * c' := Int.mul_add g d c'\n  refine Int.not_lt.mp (fun h1 => ?_)\n  have h2 : g * 1 ≤ g * (d + c') := Int.mul_le_mul_of_nonneg_left (by omega) (by omega)\n  omega\n\n-- Every row a replay produces holds wherever the inputs and the rows so far hold.\ntheorem replay_holds (inputs : List Row) (x : List Int) (hx : ∀ r ∈ inputs, eval r x ≤ 0) :\n    ∀ (ss : List Step) (n : Nat) (rows out : List Row), (∀ r ∈ rows, eval r x ≤ 0) →\n      replay inputs ss n rows = some out → ∀ r ∈ out, eval r x ≤ 0 := by\n  intro ss\n  induction ss with\n  | nil =>\n    intro n rows out hrows h\n    simp only [replay, Option.some.injEq] at h\n    exact h ▸ hrows\n  | cons s ss ih =>\n    intro n rows out hrows h\n    cases s with\n    | input i =>\n      simp only [replay] at h\n      split at h\n      · rename_i r hr\n        refine ih _ _ out ?_ h\n        intro r' hr'\n        rcases List.mem_cons.mp hr' with hr' | hr'\n        · exact hr' ▸ hx r (List.mem_of_getElem? hr)\n        · exact hrows r' hr'\n      · exact absurd h (by simp)\n    | combine a b ma mb =>\n      simp only [replay] at h\n      split at h\n      · rename_i A B hA hB\n        split at h\n        · rename_i hm\n          refine ih _ _ out ?_ h\n          intro r' hr'\n          rcases List.mem_cons.mp hr' with hr' | hr'\n          · subst hr'\n            have eA := hrows A (List.mem_of_getElem? hA)\n            have eB := hrows B (List.mem_of_getElem? hB)\n            simp only [eval, combineRow, dot_addL, dot_scaleL] at eA eB ⊢\n            have h1 : ma * (dot A.coefs x + A.const) ≤ ma * 0 := Int.mul_le_mul_of_nonneg_left eA (by omega)\n            have h2 : mb * (dot B.coefs x + B.const) ≤ mb * 0 := Int.mul_le_mul_of_nonneg_left eB (by omega)\n            simp only [Int.mul_add, Int.mul_zero] at h1 h2\n            omega\n          · exact hrows r' hr'\n        · exact absurd h (by simp)\n      · exact absurd h (by simp)\n    | cut o g q c =>\n      simp only [replay] at h\n      split at h\n      · rename_i A hA\n        split at h\n        · rename_i hok\n          refine ih _ _ out ?_ h\n          intro r' hr'\n          rcases List.mem_cons.mp hr' with hr' | hr'\n          · subst hr'\n            simp only [cutOk, Bool.and_eq_true, decide_eq_true_eq] at hok\n            obtain ⟨_, ⟨hg, hq⟩, hc⟩ := hok\n            have eA := hrows A (List.mem_of_getElem? hA)\n            have hdot : dot A.coefs x = g * dot q x := by rw [hq, dot_scaleL]\n            simp only [eval, hdot] at eA\n            exact cut_sound g (dot q x) A.const c hg eA hc\n          · exact hrows r' hr'\n        · exact absurd h (by simp)\n      · exact absurd h (by simp)\n\n/-- A certificate the checker accepts refutes its inputs: no integer point satisfies them all. -/\ntheorem sound (inputs : List Row) (steps : List Step) (h : check inputs steps = true) (x : List Int)\n    (hx : ∀ r ∈ inputs, eval r x ≤ 0) : False := by\n  simp only [check] at h\n  split at h\n  · rename_i rows hrows\n    split at h\n    · rename_i r hr\n      simp only [Bool.and_eq_true, decide_eq_true_eq] at h\n      have hall := replay_holds inputs x hx steps 0 [] rows (by simp) hrows\n      have hm : r ∈ rows := by\n        cases rows with\n        | nil => simp at hr\n        | cons a as => simp only [List.head?, Option.some.injEq] at hr; subst hr; exact List.mem_cons_self\n      have := hall r hm\n      simp only [eval, dot_allZero r.coefs x h.1] at this\n      omega\n    · exact absurd h (by simp)\n  · exact absurd h (by simp)\n\n/-- The induction rule: what holds at the start and survives every step holds after any sequence of steps. -/\ntheorem run_preserves {S I : Type} (step : S → I → S) (P : S → Prop) (start : S)\n    (h0 : P start) (hs : ∀ s i, P s → P (step s i)) : ∀ (is : List I), P (is.foldl step start) := by\n  intro is\n  induction is generalizing start with\n  | nil => exact h0\n  | cons i is ih => exact ih (step start i) (hs start i h0)\n\nend Cert\n",
     "Kernel.lean": "import Cert\n/-!\nKernel: the Lean twin of gdp-wired's kernel/kernel.ts tree check, with its soundness proof. Lean 4.34.0, core only.\n\nA goal is a variable table and hypotheses over naturals (+, ∸, × by a constant, min, max, if, map reads; ≤, <, =,\nand, or, not). A proof is a tree of splits on linear atoms, with a leaf certificate: the rows it claims, a Cert\nderivation over them, and the pairs of cells it claims equal. At a leaf the twin computes the rows the path, the\nhypotheses' facts, the naturals and the verified cell equalities give, checks every claimed row is one of them, and\nreplays the derivation with `Cert.check`. `sound`: if `checkGoal` accepts, no naturals and no maps satisfy every\nhypothesis.\n\nThe table names what each column of a row is: a variable of the environment, or a map's cell at a key (a row over\nearlier columns). Rows compare by coefficients (`same`), so the exporter's ordering doesn't matter.\n-/\n\nnamespace Kern\nopen Cert\nset_option linter.unusedSimpArgs false\nset_option linter.unusedSectionVars false\n\nmutual\ninductive E where\n  | var (i : Nat)\n  | const (n : Nat)\n  | add (a b : E)\n  | sub (a b : E)\n  | mul (k : Nat) (a : E)\n  | min (a b : E)\n  | max (a b : E)\n  | prod (a b : E)\n  | ite (c : C) (t f : E)\n  | get (m : Nat) (key : E)\ninductive C where\n  | le (a b : E)\n  | lt (a b : E)\n  | eq (a b : E)\n  | and (a b : C)\n  | or (a b : C)\n  | not (a : C)\nend\n\nderiving instance DecidableEq for E, C\n\n/-! Boolean equality of terms and conditions, by structure: what a check compares terms with (the derived DecidableEq\nbuilds a proof at each comparison, which the kernel then reduces). -/\n\nmutual\ndef beqE : E → E → Bool\n  | .var x0, .var y0 => x0 == y0\n  | .const x0, .const y0 => x0 == y0\n  | .add x0 x1, .add y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .sub x0 x1, .sub y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .mul x0 x1, .mul y0 y1 => x0 == y0 && beqE x1 y1\n  | .min x0 x1, .min y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .max x0 x1, .max y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .prod x0 x1, .prod y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .ite x0 x1 x2, .ite y0 y1 y2 => beqC x0 y0 && beqE x1 y1 && beqE x2 y2\n  | .get x0 x1, .get y0 y1 => x0 == y0 && beqE x1 y1\n  | _, _ => false\ndef beqC : C → C → Bool\n  | .le x0 x1, .le y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .lt x0 x1, .lt y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .eq x0 x1, .eq y0 y1 => beqE x0 y0 && beqE x1 y1\n  | .and x0 x1, .and y0 y1 => beqC x0 y0 && beqC x1 y1\n  | .or x0 x1, .or y0 y1 => beqC x0 y0 && beqC x1 y1\n  | .not x0, .not y0 => beqC x0 y0\n  | _, _ => false\nend\n\nmutual\ntheorem beqE_eq : ∀ {a b : E}, beqE a b = true → a = b\n  | .var x0, .var y0, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h]\n  | .const x0, .const y0, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h]\n  | .add x0 x1, .add y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .sub x0 x1, .sub y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .mul x0 x1, .mul y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h.1, beqE_eq h.2]\n  | .min x0 x1, .min y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .max x0 x1, .max y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .prod x0 x1, .prod y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .ite x0 x1 x2, .ite y0 y1 y2, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1.1, beqE_eq h.1.2, beqE_eq h.2]\n  | .get x0 x1, .get y0 y1, h => by\n    simp only [beqE, Bool.and_eq_true, beq_iff_eq] at h\n    rw [h.1, beqE_eq h.2]\n  | .var _, .const _, h => by simp [beqE] at h\n  | .var _, .add _ _, h => by simp [beqE] at h\n  | .var _, .sub _ _, h => by simp [beqE] at h\n  | .var _, .mul _ _, h => by simp [beqE] at h\n  | .var _, .min _ _, h => by simp [beqE] at h\n  | .var _, .max _ _, h => by simp [beqE] at h\n  | .var _, .prod _ _, h => by simp [beqE] at h\n  | .var _, .ite _ _ _, h => by simp [beqE] at h\n  | .var _, .get _ _, h => by simp [beqE] at h\n  | .const _, .var _, h => by simp [beqE] at h\n  | .const _, .add _ _, h => by simp [beqE] at h\n  | .const _, .sub _ _, h => by simp [beqE] at h\n  | .const _, .mul _ _, h => by simp [beqE] at h\n  | .const _, .min _ _, h => by simp [beqE] at h\n  | .const _, .max _ _, h => by simp [beqE] at h\n  | .const _, .prod _ _, h => by simp [beqE] at h\n  | .const _, .ite _ _ _, h => by simp [beqE] at h\n  | .const _, .get _ _, h => by simp [beqE] at h\n  | .add _ _, .var _, h => by simp [beqE] at h\n  | .add _ _, .const _, h => by simp [beqE] at h\n  | .add _ _, .sub _ _, h => by simp [beqE] at h\n  | .add _ _, .mul _ _, h => by simp [beqE] at h\n  | .add _ _, .min _ _, h => by simp [beqE] at h\n  | .add _ _, .max _ _, h => by simp [beqE] at h\n  | .add _ _, .prod _ _, h => by simp [beqE] at h\n  | .add _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .add _ _, .get _ _, h => by simp [beqE] at h\n  | .sub _ _, .var _, h => by simp [beqE] at h\n  | .sub _ _, .const _, h => by simp [beqE] at h\n  | .sub _ _, .add _ _, h => by simp [beqE] at h\n  | .sub _ _, .mul _ _, h => by simp [beqE] at h\n  | .sub _ _, .min _ _, h => by simp [beqE] at h\n  | .sub _ _, .max _ _, h => by simp [beqE] at h\n  | .sub _ _, .prod _ _, h => by simp [beqE] at h\n  | .sub _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .sub _ _, .get _ _, h => by simp [beqE] at h\n  | .mul _ _, .var _, h => by simp [beqE] at h\n  | .mul _ _, .const _, h => by simp [beqE] at h\n  | .mul _ _, .add _ _, h => by simp [beqE] at h\n  | .mul _ _, .sub _ _, h => by simp [beqE] at h\n  | .mul _ _, .min _ _, h => by simp [beqE] at h\n  | .mul _ _, .max _ _, h => by simp [beqE] at h\n  | .mul _ _, .prod _ _, h => by simp [beqE] at h\n  | .mul _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .mul _ _, .get _ _, h => by simp [beqE] at h\n  | .min _ _, .var _, h => by simp [beqE] at h\n  | .min _ _, .const _, h => by simp [beqE] at h\n  | .min _ _, .add _ _, h => by simp [beqE] at h\n  | .min _ _, .sub _ _, h => by simp [beqE] at h\n  | .min _ _, .mul _ _, h => by simp [beqE] at h\n  | .min _ _, .max _ _, h => by simp [beqE] at h\n  | .min _ _, .prod _ _, h => by simp [beqE] at h\n  | .min _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .min _ _, .get _ _, h => by simp [beqE] at h\n  | .max _ _, .var _, h => by simp [beqE] at h\n  | .max _ _, .const _, h => by simp [beqE] at h\n  | .max _ _, .add _ _, h => by simp [beqE] at h\n  | .max _ _, .sub _ _, h => by simp [beqE] at h\n  | .max _ _, .mul _ _, h => by simp [beqE] at h\n  | .max _ _, .min _ _, h => by simp [beqE] at h\n  | .max _ _, .prod _ _, h => by simp [beqE] at h\n  | .max _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .max _ _, .get _ _, h => by simp [beqE] at h\n  | .prod _ _, .var _, h => by simp [beqE] at h\n  | .prod _ _, .const _, h => by simp [beqE] at h\n  | .prod _ _, .add _ _, h => by simp [beqE] at h\n  | .prod _ _, .sub _ _, h => by simp [beqE] at h\n  | .prod _ _, .mul _ _, h => by simp [beqE] at h\n  | .prod _ _, .min _ _, h => by simp [beqE] at h\n  | .prod _ _, .max _ _, h => by simp [beqE] at h\n  | .prod _ _, .ite _ _ _, h => by simp [beqE] at h\n  | .prod _ _, .get _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .var _, h => by simp [beqE] at h\n  | .ite _ _ _, .const _, h => by simp [beqE] at h\n  | .ite _ _ _, .add _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .sub _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .mul _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .min _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .max _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .prod _ _, h => by simp [beqE] at h\n  | .ite _ _ _, .get _ _, h => by simp [beqE] at h\n  | .get _ _, .var _, h => by simp [beqE] at h\n  | .get _ _, .const _, h => by simp [beqE] at h\n  | .get _ _, .add _ _, h => by simp [beqE] at h\n  | .get _ _, .sub _ _, h => by simp [beqE] at h\n  | .get _ _, .mul _ _, h => by simp [beqE] at h\n  | .get _ _, .min _ _, h => by simp [beqE] at h\n  | .get _ _, .max _ _, h => by simp [beqE] at h\n  | .get _ _, .prod _ _, h => by simp [beqE] at h\n  | .get _ _, .ite _ _ _, h => by simp [beqE] at h\ntheorem beqC_eq : ∀ {a b : C}, beqC a b = true → a = b\n  | .le x0 x1, .le y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .lt x0 x1, .lt y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .eq x0 x1, .eq y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqE_eq h.1, beqE_eq h.2]\n  | .and x0 x1, .and y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1, beqC_eq h.2]\n  | .or x0 x1, .or y0 y1, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h.1, beqC_eq h.2]\n  | .not x0, .not y0, h => by\n    simp only [beqC, Bool.and_eq_true, beq_iff_eq] at h\n    rw [beqC_eq h]\n  | .le _ _, .lt _ _, h => by simp [beqC] at h\n  | .le _ _, .eq _ _, h => by simp [beqC] at h\n  | .le _ _, .and _ _, h => by simp [beqC] at h\n  | .le _ _, .or _ _, h => by simp [beqC] at h\n  | .le _ _, .not _, h => by simp [beqC] at h\n  | .lt _ _, .le _ _, h => by simp [beqC] at h\n  | .lt _ _, .eq _ _, h => by simp [beqC] at h\n  | .lt _ _, .and _ _, h => by simp [beqC] at h\n  | .lt _ _, .or _ _, h => by simp [beqC] at h\n  | .lt _ _, .not _, h => by simp [beqC] at h\n  | .eq _ _, .le _ _, h => by simp [beqC] at h\n  | .eq _ _, .lt _ _, h => by simp [beqC] at h\n  | .eq _ _, .and _ _, h => by simp [beqC] at h\n  | .eq _ _, .or _ _, h => by simp [beqC] at h\n  | .eq _ _, .not _, h => by simp [beqC] at h\n  | .and _ _, .le _ _, h => by simp [beqC] at h\n  | .and _ _, .lt _ _, h => by simp [beqC] at h\n  | .and _ _, .eq _ _, h => by simp [beqC] at h\n  | .and _ _, .or _ _, h => by simp [beqC] at h\n  | .and _ _, .not _, h => by simp [beqC] at h\n  | .or _ _, .le _ _, h => by simp [beqC] at h\n  | .or _ _, .lt _ _, h => by simp [beqC] at h\n  | .or _ _, .eq _ _, h => by simp [beqC] at h\n  | .or _ _, .and _ _, h => by simp [beqC] at h\n  | .or _ _, .not _, h => by simp [beqC] at h\n  | .not _, .le _ _, h => by simp [beqC] at h\n  | .not _, .lt _ _, h => by simp [beqC] at h\n  | .not _, .eq _ _, h => by simp [beqC] at h\n  | .not _, .and _ _, h => by simp [beqC] at h\n  | .not _, .or _ _, h => by simp [beqC] at h\nend\n\nmutual\ndef evalE (env : Nat → Nat) (maps : Nat → Nat → Nat) : E → Nat\n  | .var i => env i\n  | .const n => n\n  | .add a b => evalE env maps a + evalE env maps b\n  | .sub a b => evalE env maps a - evalE env maps b\n  | .mul k a => k * evalE env maps a\n  | .min a b => min (evalE env maps a) (evalE env maps b)\n  | .max a b => max (evalE env maps a) (evalE env maps b)\n  | .prod a b => evalE env maps a * evalE env maps b\n  | .ite c t f => if evalC env maps c then evalE env maps t else evalE env maps f\n  | .get m key => maps m (evalE env maps key)\ndef evalC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Bool\n  | .le a b => decide (evalE env maps a ≤ evalE env maps b)\n  | .lt a b => decide (evalE env maps a < evalE env maps b)\n  | .eq a b => decide (evalE env maps a = evalE env maps b)\n  | .and a b => evalC env maps a && evalC env maps b\n  | .or a b => evalC env maps a || evalC env maps b\n  | .not a => !evalC env maps a\nend\n\n-- A condition's meaning as a proposition: what a law says in plain Lean (`evalC_iff`). Exported laws are stated with it,\n-- so a statement like `ρ x ≤ ρ cap` is the law itself, up to unfolding.\ndef holdsC (env : Nat → Nat) (maps : Nat → Nat → Nat) : C → Prop\n  | .le a b => evalE env maps a ≤ evalE env maps b\n  | .lt a b => evalE env maps a < evalE env maps b\n  | .eq a b => evalE env maps a = evalE env maps b\n  | .and a b => holdsC env maps a ∧ holdsC env maps b\n  | .or a b => holdsC env maps a ∨ holdsC env maps b\n  | .not a => ¬ holdsC env maps a\n\ntheorem evalC_iff (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ c, evalC env maps c = true ↔ holdsC env maps c\n  | .le a b => by simp [evalC, holdsC]\n  | .lt a b => by simp [evalC, holdsC]\n  | .eq a b => by simp [evalC, holdsC]\n  | .and a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .or a b => by simp [evalC, holdsC, evalC_iff env maps a, evalC_iff env maps b]\n  | .not a => by\n    have h := evalC_iff env maps a\n    simp only [evalC, holdsC]\n    cases hb : evalC env maps a <;> simp_all\n\n/-! Linear forms are Cert rows: `eval r x = dot r.coefs x + r.const`. -/\n\ndef lconst (n : Int) : Row := ⟨[], n⟩\ndef ladd (a b : Row) : Row := ⟨addL a.coefs b.coefs, a.const + b.const⟩\ndef lscale (m : Int) (a : Row) : Row := ⟨scaleL m a.coefs, m * a.const⟩\ndef lsub (a b : Row) : Row := ladd a (lscale (-1) b)\ndef lunit (j : Nat) : Row := ⟨[(j, 1)], 0⟩\n-- A row as the exporters write it: its nonzero coefficients (column, coefficient), in column order, and its constant.\ndef sp (cs : List (Nat × Int)) (c : Int) : Row := ⟨cs, c⟩\ndef same (a b : Row) : Bool := allZero (lsub a b).coefs && (lsub a b).const == 0\n-- 1 − a: over the integers, a ≤ 0 fails exactly when 1 − a ≤ 0 holds.\ndef flip (a : Row) : Row := lsub (lconst 1) a\n\ntheorem eval_lconst (n : Int) (x : List Int) : eval (lconst n) x = n := by\n  cases x <;> simp [eval, lconst, dot]\ntheorem eval_ladd (a b : Row) (x : List Int) : eval (ladd a b) x = eval a x + eval b x := by\n  simp only [eval, ladd, dot_addL]; omega\ntheorem eval_lscale (m : Int) (a : Row) (x : List Int) : eval (lscale m a) x = m * eval a x := by\n  simp only [eval, lscale, dot_scaleL, Int.mul_add]\ntheorem eval_lsub (a b : Row) (x : List Int) : eval (lsub a b) x = eval a x - eval b x := by\n  simp only [lsub, eval_ladd, eval_lscale]; omega\ntheorem eval_flip (a : Row) (x : List Int) : eval (flip a) x = 1 - eval a x := by\n  simp only [flip, eval_lsub, eval_lconst]\ntheorem eval_lunit (j : Nat) (x : List Int) : eval (lunit j) x = x.getD j 0 := by\n  simp [eval, lunit, dot]\ntheorem same_eval {a b : Row} (h : same a b = true) (x : List Int) : eval a x = eval b x := by\n  simp only [same, Bool.and_eq_true, beq_iff_eq] at h\n  have h1 : eval (lsub a b) x = 0 := by simp only [eval, dot_allZero _ x h.1, h.2]; rfl\n  rw [eval_lsub] at h1; omega\n\n/-! The path: atoms decided so far. `(l, true)` says l ≤ 0, `(l, false)` says l ≥ 1. -/\n\nabbrev Path := List (Row × Bool)\ndef PathHolds (path : Path) (x : List Int) : Prop := ∀ a ∈ path, decide (eval a.1 x ≤ 0) = a.2\n\ndef lookup {α : Type} (p : α → Bool) : List α → Option α\n  | [] => none\n  | a :: as => if p a then some a else lookup p as\ntheorem lookup_some {α : Type} {p : α → Bool} : ∀ {l : List α} {a : α}, lookup p l = some a → a ∈ l ∧ p a = true\n  | [], _, h => by simp [lookup] at h\n  | b :: bs, a, h => by\n    simp only [lookup] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨List.mem_cons_self, by assumption⟩\n    · have := lookup_some h; exact ⟨List.mem_cons_of_mem _ this.1, this.2⟩\n\ndef dec (path : Path) (l : Row) : Option Bool :=\n  if allZero l.coefs then some (decide (l.const ≤ 0))\n  else match lookup (fun a => same a.1 l) path with\n    | some a => some a.2\n    | none => match lookup (fun a => same a.1 (flip l)) path with\n      | some a => some (!a.2)\n      | none => none\n\ntheorem dec_sound {path : Path} {x : List Int} (hP : PathHolds path x) {l : Row} {b : Bool}\n    (h : dec path l = some b) : decide (eval l x ≤ 0) = b := by\n  simp only [dec] at h\n  split at h\n  · rename_i hz\n    simp only [Option.some.injEq] at h\n    subst h\n    simp [eval, dot_allZero _ x hz]\n  · split at h\n    · rename_i a ha\n      simp only [Option.some.injEq] at h; subst h\n      have ⟨hm, hs⟩ := lookup_some ha\n      rw [← hP a hm, same_eval hs]\n    · split at h\n      · rename_i a ha\n        simp only [Option.some.injEq] at h; subst h\n        have ⟨hm, hs⟩ := lookup_some ha\n        have := hP a hm\n        rw [same_eval hs, eval_flip] at this\n        rw [← this]\n        by_cases hl : eval l x ≤ 0 <;> simp [hl] <;> omega\n      · simp at h\n\n/-! The table: column j is a variable of the environment, or map m's cell at a key (a row over earlier columns). -/\n\ninductive VDef where\n  | var (i : Nat)\n  | cell (m : Nat) (key : Row)\n  | mono (fs : List Nat)        -- the product of earlier columns (a monomial)\n  | term (e : E)                -- a choice the path leaves open (∸, min, max, if), standing for its value\n\ndef prodV (x : List Int) : List Nat → Int\n  | [] => 1\n  | j :: js => x.getD j 0 * prodV x js\n\ndef valD (env : Nat → Nat) (maps : Nat → Nat → Nat) : VDef → List Int → Int\n  | .var i, _ => (env i : Int)\n  | .cell m k, x => (maps m (eval k x).toNat : Int)\n  | .mono fs, x => ((prodV x fs).toNat : Int)\n  | .term e, _ => (evalE env maps e : Int)\n\n-- x is a valuation of the table: each column holds what its definition says, and every value is a natural.\ndef Model (tab : List VDef) (env : Nat → Nat) (maps : Nat → Nat → Nat) (x : List Int) : Prop :=\n  (∀ j d, tab[j]? = some d → x.getD j 0 = valD env maps d x) ∧ ∀ j, 0 ≤ x.getD j 0\n\ndef findIdx {α : Type} (p : α → Bool) : List α → Option Nat\n  | [] => none\n  | a :: as => if p a then some 0 else (findIdx p as).map (· + 1)\ntheorem findIdx_some {α : Type} {p : α → Bool} : ∀ {l : List α} {j : Nat}, findIdx p l = some j → ∃ a, l[j]? = some a ∧ p a = true\n  | [], _, h => by simp [findIdx] at h\n  | b :: bs, j, h => by\n    simp only [findIdx] at h\n    split at h\n    · simp only [Option.some.injEq] at h; subst h; exact ⟨b, rfl, by assumption⟩\n    · cases hj : findIdx p bs with\n      | none => simp [hj] at h\n      | some i =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        obtain ⟨a, ha, hp⟩ := findIdx_some (l := bs) hj\n        exact ⟨a, by simpa using ha, hp⟩\n\ndef isVar (i : Nat) : VDef → Bool\n  | .var i' => i' == i\n  | _ => false\ndef isCell (m : Nat) (k : Row) : VDef → Bool\n  | .cell m' k' => m' == m && same k' k\n  | _ => false\ndef isTerm (e : E) : VDef → Bool\n  | .term e' => beqE e' e\n  | _ => false\n-- An open choice's column: the table's column for the whole term, if it has one.\ndef termCol (tab : List VDef) (e : E) : Option Row := (findIdx (isTerm e) tab).map lunit\ndef isMono (fs : List Nat) : VDef → Bool\n  | .mono fs' => fs' == fs\n  | _ => false\n\n/-! Products: monomials are columns, each the product of the columns its factors name (sorted, so one monomial is one\ncolumn). Multiplying two rows looks up the column of each product of two columns. -/\n\ndef ins (a : Nat) : List Nat → List Nat\n  | [] => [a]\n  | b :: bs => if a ≤ b then a :: b :: bs else b :: ins a bs\ndef srt : List Nat → List Nat\n  | [] => []\n  | a :: as => ins a (srt as)\n\ntheorem prodV_ins (x : List Int) (a : Nat) : ∀ l, prodV x (ins a l) = x.getD a 0 * prodV x l\n  | [] => by simp [ins, prodV]\n  | b :: bs => by\n    simp only [ins]; split\n    · rfl\n    · simp only [prodV, prodV_ins x a bs]; rw [Int.mul_left_comm]\ntheorem prodV_srt (x : List Int) : ∀ l, prodV x (srt l) = prodV x l\n  | [] => rfl\n  | a :: as => by simp only [srt, prodV_ins, prodV_srt x as, prodV]\ntheorem prodV_append (x : List Int) : ∀ l1 l2, prodV x (l1 ++ l2) = prodV x l1 * prodV x l2\n  | [], l2 => by simp [prodV]\n  | a :: as, l2 => by simp only [List.cons_append, prodV, prodV_append x as l2, Int.mul_assoc]\ntheorem prodV_nonneg {x : List Int} (h : ∀ j, 0 ≤ x.getD j 0) : ∀ l, 0 ≤ prodV x l\n  | [] => by simp [prodV]\n  | a :: as => Int.mul_nonneg (h a) (prodV_nonneg h as)\n\n-- A column's factors: a monomial's own, or the column itself (a variable, a map's cell, an open choice).\ndef fac (tab : List VDef) (i : Nat) : Option (List Nat) :=\n  match tab[i]? with\n  | some (.mono fs) => some fs\n  | some _ => some [i]\n  | none => none\ndef pcol (tab : List VDef) (i j : Nat) : Option Nat :=\n  match fac tab i, fac tab j with\n  | some a, some b => findIdx (isMono (srt (a ++ b))) tab\n  | _, _ => none\n\n-- x_i · Σ b x_j, over b's coefficients (column j, coefficient b)\ndef mulRow (tab : List VDef) (i : Nat) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | q :: bs => match mulRow tab i bs with\n    | none => none\n    | some r => if q.2 == 0 then some r else match pcol tab i q.1 with\n      | some k => some (ladd (lscale q.2 (lunit k)) r)\n      | none => none\n-- (Σ a x_i) · Σ b x_j\ndef mulRows (tab : List VDef) (bs : List (Nat × Int)) : List (Nat × Int) → Option Row\n  | [] => some (lconst 0)\n  | p :: as => match mulRows tab bs as with\n    | none => none\n    | some r => if p.2 == 0 then some r else match mulRow tab p.1 bs with\n      | some q => some (ladd (lscale p.2 q) r)\n      | none => none\ndef rowMul (tab : List VDef) (a b : Row) : Option Row :=\n  match mulRows tab b.coefs a.coefs with\n  | some p => some (ladd p (ladd (lscale a.const ⟨b.coefs, 0⟩) (ladd (lscale b.const ⟨a.coefs, 0⟩) (lconst (a.const * b.const)))))\n  | none => none\n\n\nmutual\ndef linear (tab : List VDef) (path : Path) : E → Option Row\n  | .var i => (findIdx (isVar i) tab).map lunit\n  | .const n => some (lconst n)\n  | .add a b => match linear tab path a, linear tab path b with\n    | some la, some lb => some (ladd la lb)\n    | _, _ => none\n  | .mul k a => match linear tab path a with\n    | some la => some (lscale k la)\n    | none => none\n  | .sub a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub lb la) with\n      | some true => some (lsub la lb)\n      | some false => some (lconst 0)\n      | none => termCol tab (.sub a b)\n    | _, _ => none\n  | .min a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some la\n      | some false => some lb\n      | none => termCol tab (.min a b)\n    | _, _ => none\n  | .max a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb) with\n      | some true => some lb\n      | some false => some la\n      | none => termCol tab (.max a b)\n    | _, _ => none\n  | .prod a b => match linear tab path a, linear tab path b with\n    | some la, some lb => rowMul tab la lb\n    | _, _ => none\n  | .ite c t f => match truth tab path c with\n    | some true => linear tab path t\n    | some false => linear tab path f\n    | none => termCol tab (.ite c t f)\n  | .get m key => match linear tab path key with\n    | some lk => (findIdx (isCell m lk) tab).map lunit\n    | none => none\ndef truth (tab : List VDef) (path : Path) : C → Option Bool\n  | .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (lsub la lb)\n    | _, _ => none\n  | .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb => dec path (ladd (lsub la lb) (lconst 1))\n    | _, _ => none\n  | .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb => match dec path (lsub la lb), dec path (lsub lb la) with\n      | some false, _ => some false\n      | _, some false => some false\n      | some true, some true => some true\n      | _, _ => none\n    | _, _ => none\n  | .and a b => match truth tab path a, truth tab path b with\n    | some false, _ => some false\n    | _, some false => some false\n    | some true, some true => some true\n    | _, _ => none\n  | .or a b => match truth tab path a, truth tab path b with\n    | some true, _ => some true\n    | _, some true => some true\n    | some false, some false => some false\n    | _, _ => none\n  | .not a => match truth tab path a with\n    | some b => some (!b)\n    | none => none\nend\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem var_col (hM : Model tab env maps x) {i j : Nat} (h : findIdx (isVar i) tab = some j) : x.getD j 0 = env i := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | var i' => simp only [isVar, beq_iff_eq] at hv; subst hv; rfl\n  | _ => simp [isVar] at hv\n\ntheorem term_col (hM : Model tab env maps x) {e : E} {j : Nat} (h : findIdx (isTerm e) tab = some j) :\n    x.getD j 0 = (evalE env maps e : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | term e' => simp only [isTerm] at hv; have he := beqE_eq hv; subst he; rfl\n  | _ => simp [isTerm] at hv\n\ntheorem termCol_sound (hM : Model tab env maps x) {e : E} {l : Row} (h : termCol tab e = some l) :\n    eval l x = (evalE env maps e : Int) := by\n  simp only [termCol] at h\n  cases hj : findIdx (isTerm e) tab with\n  | none => simp [hj] at h\n  | some j => simp only [hj, Option.map_some, Option.some.injEq] at h; subst h; rw [eval_lunit, term_col hM hj]\n\ntheorem cell_col (hM : Model tab env maps x) {m j : Nat} {k : Row} (h : findIdx (isCell m k) tab = some j) :\n    x.getD j 0 = (maps m (eval k x).toNat : Int) := by\n  obtain ⟨d, hd, hv⟩ := findIdx_some h\n  rw [hM.1 j d hd]\n  cases d with\n  | cell m' k' =>\n    simp only [isCell, Bool.and_eq_true, beq_iff_eq] at hv\n    obtain ⟨rfl, hs⟩ := hv\n    simp only [valD, same_eval hs x]\n  | _ => simp [isCell] at hv\n\ntheorem fac_val (hM : Model tab env maps x) {i : Nat} {fs : List Nat} (h : fac tab i = some fs) : x.getD i 0 = prodV x fs := by\n  simp only [fac] at h\n  split at h\n  · rename_i fs' hd\n    simp only [Option.some.injEq] at h; subst h\n    rw [hM.1 i _ hd]; simp only [valD]; exact Int.toNat_of_nonneg (prodV_nonneg hM.2 _)\n  · simp only [Option.some.injEq] at h; subst h; simp [prodV]\n  · simp at h\n\ntheorem pcol_val (hM : Model tab env maps x) {i j k : Nat} (h : pcol tab i j = some k) :\n    x.getD k 0 = x.getD i 0 * x.getD j 0 := by\n  simp only [pcol] at h\n  split at h\n  · rename_i a b ha hb\n    obtain ⟨d, hd, hv⟩ := findIdx_some h\n    cases d with\n    | mono fs =>\n      simp only [isMono, beq_iff_eq] at hv; subst hv\n      rw [hM.1 k _ hd]; simp only [valD]\n      rw [Int.toNat_of_nonneg (prodV_nonneg hM.2 _), prodV_srt, prodV_append, ← fac_val hM ha, ← fac_val hM hb]\n    | _ => simp [isMono] at hv\n  · simp at h\n\ntheorem mulRow_sound (hM : Model tab env maps x) (i : Nat) :\n    ∀ bs r, mulRow tab i bs = some r → eval r x = x.getD i 0 * dot bs x\n  | [], r, h => by simp only [mulRow, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | q :: bs, r, h => by\n    simp only [mulRow] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRow_sound hM i bs r' hr'\n      split at h\n      · rename_i hb\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at hb; simp [dot, hb, ih]\n      · split at h\n        · rename_i k hk\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, eval_lunit, pcol_val hM hk, ih]\n          simp only [dot]; rw [Int.mul_add, Int.mul_left_comm (x.getD i 0) q.2]\n        · simp at h\n\ntheorem mulRows_sound (hM : Model tab env maps x) (bs : List (Nat × Int)) :\n    ∀ as r, mulRows tab bs as = some r → eval r x = dot as x * dot bs x\n  | [], r, h => by simp only [mulRows, Option.some.injEq] at h; subst h; simp [eval_lconst, dot]\n  | p :: as, r, h => by\n    simp only [mulRows] at h\n    split at h\n    · simp at h\n    · rename_i r' hr'\n      have ih := mulRows_sound hM bs as r' hr'\n      split at h\n      · rename_i ha\n        simp only [Option.some.injEq] at h; subst h\n        simp only [beq_iff_eq] at ha; simp [dot, ha, ih]\n      · split at h\n        · rename_i q hq\n          simp only [Option.some.injEq] at h; subst h\n          rw [eval_ladd, eval_lscale, mulRow_sound hM p.1 bs q hq, ih]\n          simp only [dot]; rw [Int.add_mul, Int.mul_assoc]\n        · simp at h\n\ntheorem rowMul_sound (hM : Model tab env maps x) {a b r : Row} (h : rowMul tab a b = some r) : eval r x = eval a x * eval b x := by\n  simp only [rowMul] at h\n  split at h\n  · rename_i p hp\n    simp only [Option.some.injEq] at h; subst h\n    have e := mulRows_sound hM b.coefs a.coefs p hp\n    simp only [eval_ladd, eval_lscale, eval_lconst, e]\n    simp only [eval, Int.add_zero]\n    rw [Int.add_mul, Int.mul_add, Int.mul_add, Int.mul_comm b.const]; omega\n  · simp at h\n\nmutual\ntheorem linear_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (e : E) → (l : Row) → linear tab path e = some l → eval l x = (evalE env maps e : Int)\n  | .var i, l, h => by\n    simp only [linear] at h\n    cases hj : findIdx (isVar i) tab with\n    | none => simp [hj] at h\n    | some j =>\n      simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n      rw [eval_lunit, var_col hM hj, evalE]\n  | .const n, l, h => by\n    simp only [linear, Option.some.injEq] at h; subst h\n    simp [eval_lconst, evalE]\n  | .add a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_ladd, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; omega\n    · simp at h\n  | .mul k a, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la ha\n      simp only [Option.some.injEq] at h; subst h\n      rw [eval_lscale, linear_sound hM hP a la ha, evalE]; simp\n    · simp at h\n  | .sub a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [eval_lsub, evalE]; omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [eval_lconst, evalE]; omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .min a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.min_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .max a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      split at h\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_true_eq, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · rename_i hd\n        simp only [Option.some.injEq] at h; subst h\n        have := dec_sound hP hd\n        simp only [decide_eq_false_iff_not, eval_lsub] at this\n        rw [evalE, Nat.max_def]; split <;> omega\n      · exact termCol_sound hM h\n    · simp at h\n  | .prod a b, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i la lb ha hb\n      rw [rowMul_sound hM h, linear_sound hM hP a la ha, linear_sound hM hP b lb hb, evalE]; simp\n    · simp at h\n  | .ite c t f, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i hc\n      have := truth_sound hM hP c true hc\n      rw [linear_sound hM hP t l h, evalE, this]; rfl\n    · rename_i hc\n      have := truth_sound hM hP c false hc\n      rw [linear_sound hM hP f l h, evalE, this]; rfl\n    · exact termCol_sound hM h\n  | .get m key, l, h => by\n    simp only [linear] at h\n    split at h\n    · rename_i lk hk\n      cases hj : findIdx (isCell m lk) tab with\n      | none => simp [hj] at h\n      | some j =>\n        simp only [hj, Option.map_some, Option.some.injEq] at h; subst h\n        rw [eval_lunit, cell_col hM hj, linear_sound hM hP key lk hk, evalE]; simp\n    · simp at h\ntheorem truth_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (b : Bool) → truth tab path c = some b → evalC env maps c = b\n  | .le a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_lsub] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .lt a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      have := dec_sound hP h\n      rw [eval_ladd, eval_lsub, eval_lconst] at this\n      simp only [evalC]; rw [← this]; simp only [decide_eq_decide]; omega\n    · simp at h\n  | .eq a b', r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b' lb hb\n      simp only [evalC]\n      revert h\n      rcases h1 : dec path (lsub la lb) with _ | _ | _ <;> rcases h2 : dec path (lsub lb la) with _ | _ | _ <;>\n        intro h <;> simp only [Option.some.injEq, reduceCtorEq] at h <;> subst h <;>\n        first\n          | (have t1 := dec_sound hP h1; have t2 := dec_sound hP h2; rw [eval_lsub] at t1 t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 t2 ⊢; omega)\n          | (have t1 := dec_sound hP h1; rw [eval_lsub] at t1\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t1 ⊢; omega)\n          | (have t2 := dec_sound hP h2; rw [eval_lsub] at t2\n             simp only [decide_eq_true_eq, decide_eq_false_iff_not] at t2 ⊢; omega)\n    · simp at h\n  | .and a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' false h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1, truth_sound hM hP b' true h2]\n    · simp at h\n  | .or a b', r, h => by\n    simp only [truth] at h\n    simp only [evalC]\n    split at h\n    · rename_i h1; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a true h1]\n    · rename_i h2 _; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP b' true h2]\n    · rename_i h1 h2; simp only [Option.some.injEq] at h; subst h; simp [truth_sound hM hP a false h1, truth_sound hM hP b' false h2]\n    · simp at h\n  | .not a, r, h => by\n    simp only [truth] at h\n    split at h\n    · rename_i r' h1; simp only [Option.some.injEq] at h; subst h; simp [evalC, truth_sound hM hP a r' h1]\n    · simp at h\nend\nend\n\n/-! Facts: the rows a hypothesis gives under the path, when it has the truth value `pos`. -/\n\ndef facts (tab : List VDef) (path : Path) : Bool → C → List Row\n  | pos, .not a => facts tab path (!pos) a\n  | pos, .and a b =>\n    if pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .or a b =>\n    if !pos then facts tab path pos a ++ facts tab path pos b\n    else\n      let oa := truth tab path a != some (!pos)\n      let ob := truth tab path b != some (!pos)\n      if oa && ob then [] else if oa then facts tab path pos a else if ob then facts tab path pos b else [lconst 1]\n  | pos, .le a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb]\n      else let u := ladd (lsub lb la) (lconst 1); if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .lt a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [ladd (lsub la lb) (lconst 1)]\n      else let u := lsub lb la; if dec path u == some false then [lconst 1] else [u]\n    | _, _ => []\n  | pos, .eq a b => match linear tab path a, linear tab path b with\n    | some la, some lb =>\n      if pos then [lsub la lb, lsub lb la]\n      else\n        let u1 := ladd (lsub la lb) (lconst 1)\n        let u2 := ladd (lsub lb la) (lconst 1)\n        let o1 := dec path u1 != some false\n        let o2 := dec path u2 != some false\n        if o1 && o2 then [] else if o1 then [u1] else if o2 then [u2] else [lconst 1]\n    | _, _ => []\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {path : Path}\n\ntheorem facts_sound (hM : Model tab env maps x) (hP : PathHolds path x) :\n    (c : C) → (pos : Bool) → evalC env maps c = pos → ∀ r ∈ facts tab path pos c, eval r x ≤ 0\n  | .not a, pos, h, r, hr => by\n    simp only [facts] at hr\n    exact facts_sound hM hP a (!pos) (by simp [evalC] at h; simp [← h]) r hr\n  | .and a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | true =>\n      simp only [evalC, Bool.and_eq_true] at h\n      simp only [ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a true h.1 r hr\n      · exact facts_sound hM hP b true h.2 r hr\n    | false =>\n      simp only [Bool.false_eq_true, ite_false, Bool.not_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.and_eq_false_iff] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · rename_i _ hoa\n          have hb : truth tab path b = some true := by simp_all\n          have := tb true hb\n          exact facts_sound hM hP a false (by simp_all) r hr\n        · split at hr\n          · rename_i _ _ hob\n            have ha : truth tab path a = some true := by simp_all\n            have := ta true ha\n            exact facts_sound hM hP b false (by simp_all) r hr\n          · have ha : truth tab path a = some true := by simp_all\n            have hb : truth tab path b = some true := by simp_all\n            have := ta true ha; have := tb true hb\n            simp_all\n  | .or a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    cases pos with\n    | false =>\n      simp only [evalC, Bool.or_eq_false_iff] at h\n      simp only [Bool.not_false, ite_true, List.mem_append] at hr\n      rcases hr with hr | hr\n      · exact facts_sound hM hP a false h.1 r hr\n      · exact facts_sound hM hP b false h.2 r hr\n    | true =>\n      simp only [Bool.not_true, Bool.false_eq_true, ite_false] at hr\n      have ta := fun v (hv : truth tab path a = some v) => truth_sound hM hP a v hv\n      have tb := fun v (hv : truth tab path b = some v) => truth_sound hM hP b v hv\n      simp only [evalC, Bool.or_eq_true] at h\n      split at hr\n      · simp at hr\n      · split at hr\n        · have hb : truth tab path b = some false := by simp_all\n          have := tb false hb\n          exact facts_sound hM hP a true (by simp_all) r hr\n        · split at hr\n          · have ha : truth tab path a = some false := by simp_all\n            have := ta false ha\n            exact facts_sound hM hP b true (by simp_all) r hr\n          · have ha : truth tab path a = some false := by simp_all\n            have hb : truth tab path b = some false := by simp_all\n            have := ta false ha; have := tb false hb\n            simp_all\n  | .le a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_lsub]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_ladd, eval_lsub, eval_lconst]; omega\n    · simp at hr\n  | .lt a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_singleton] at hr; subst hr\n        rw [eval_ladd, eval_lsub, eval_lconst]; omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        split at hr\n        · rename_i hd\n          have := dec_sound hP (by simpa using hd)\n          simp only [eval_lsub, decide_eq_false_iff_not] at this; omega\n        · simp only [List.mem_singleton] at hr; subst hr\n          rw [eval_lsub]; omega\n    · simp at hr\n  | .eq a b, pos, h, r, hr => by\n    simp only [facts] at hr\n    split at hr\n    · rename_i la lb ha hb\n      have ea := linear_sound hM hP a la ha\n      have eb := linear_sound hM hP b lb hb\n      cases pos with\n      | true =>\n        simp only [evalC, decide_eq_true_eq] at h\n        simp only [ite_true, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with hr | hr <;> subst hr <;> rw [eval_lsub] <;> omega\n      | false =>\n        simp only [evalC, decide_eq_false_iff_not] at h\n        simp only [Bool.false_eq_true, ite_false] at hr\n        have d1 := fun (hv : dec path (ladd (lsub la lb) (lconst 1)) = some false) => dec_sound hP hv\n        have d2 := fun (hv : dec path (ladd (lsub lb la) (lconst 1)) = some false) => dec_sound hP hv\n        simp only [eval_ladd, eval_lsub, eval_lconst, decide_eq_false_iff_not] at d1 d2\n        split at hr\n        · simp at hr\n        · split at hr\n          · have := d2 (by simp_all)\n            simp only [List.mem_singleton] at hr; subst hr\n            rw [eval_ladd, eval_lsub, eval_lconst]; omega\n          · split at hr\n            · have := d1 (by simp_all)\n              simp only [List.mem_singleton] at hr; subst hr\n              rw [eval_ladd, eval_lsub, eval_lconst]; omega\n            · have := d1 (by simp_all); have := d2 (by simp_all); omega\n    · simp at hr\nend\n\n/-! Leaves and trees. -/\n\ndef atomRow (a : Row × Bool) : Row := if a.2 then a.1 else flip a.1\ndef natRows : Nat → List Row\n  | 0 => []\n  | n + 1 => lscale (-1) (lunit n) :: natRows n\n-- Two cells of one map whose keys the path proves equal are equal (the pair is the leaf's claim; it is checked here).\ndef cellEq (tab : List VDef) (path : Path) (p : Nat × Nat) : List Row :=\n  match tab[p.1]?, tab[p.2]? with\n  | some (.cell m k), some (.cell m' k') =>\n    if m == m' && dec path (lsub k k') == some true && dec path (lsub k' k) == some true\n    then [lsub (lunit p.1) (lunit p.2), lsub (lunit p.2) (lunit p.1)] else []\n  | _, _ => []\n-- A term column's rows: its bounds, whichever way its choice goes (min ≤ each side, max ≥ each side, a ∸ b ≥ a − b and\n-- ≤ a, an if ≤ the sum of its branches when both are constants), and its equality to the term's form under the path\n-- (the branch taken, once the path decides it).\ndef constIn (r : Row) : Bool := r.coefs.all (fun p => p.2 == 0)\ndef termBounds (j : Nat) (la lb : Row) : E → List Row\n  | .min _ _ => [lsub (lunit j) la, lsub (lunit j) lb]\n  | .max _ _ => [lsub la (lunit j), lsub lb (lunit j)]\n  | .sub _ _ => [lsub (lsub la lb) (lunit j), lsub (lunit j) la]\n  | .ite _ _ _ => [lsub (lunit j) (ladd la lb)]\n  | _ => []\ndef termRowsAt (tab : List VDef) (path : Path) (j : Nat) : List Row :=\n  match tab[j]? with\n  | some (.term e) =>\n    (match e with\n     | .min a b | .max a b | .sub a b => match linear tab path a, linear tab path b with\n       | some la, some lb => termBounds j la lb e\n       | _, _ => []\n     | .ite _ a b => match linear tab path a, linear tab path b with\n       | some la, some lb => if constIn la && constIn lb then termBounds j la lb e else []\n       | _, _ => []\n     | _ => [])\n    ++ (match linear tab path e with\n        | some r => [lsub (lunit j) r, lsub r (lunit j)]\n        | none => [])\n  | _ => []\ndef termRows (tab : List VDef) (path : Path) : List Row := (List.range tab.length).flatMap (termRowsAt tab path)\n\ndef leafRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : List Row :=\n  path.map atomRow ++ hyps.flatMap (facts tab path true) ++ natRows tab.length ++ eqs.flatMap (cellEq tab path) ++ termRows tab path\n\n-- Where a leaf's row is looked for first: the path's i-th atom (the latest decision first), a hypothesis's facts, column i's naturality, the i-th\n-- pair of equal cells, or term column j's rows. A hint only saves work: a row not found there is looked for among all\n-- of the leaf's rows, as one without a hint is.\ninductive Src where\n  | atom (i : Nat)\n  | fact (h : Nat)\n  | nat (i : Nat)\n  | eq (i : Nat)\n  | term (j : Nat)\n  | any\n\ndef srcRows (tab : List VDef) (path : Path) (hyps : List C) (eqs : List (Nat × Nat)) : Src → List Row\n  | .atom i => match path[i]? with | some a => [atomRow a] | none => []\n  | .fact h => match hyps[h]? with | some c => facts tab path true c | none => []\n  | .nat i => if i < tab.length then [lscale (-1) (lunit i)] else []\n  | .eq i => match eqs[i]? with | some p => cellEq tab path p | none => []\n  | .term j => if j < tab.length then termRowsAt tab path j else []\n  | .any => []\n\n-- A leaf may add products of two of its rows (p ≤ 0 and q ≤ 0 give −p·q ≤ 0); a pair may name an earlier product.\n-- `leafAt` is a leaf whose rows come with hints; `leafSq` one that also adds the square of each of its forms t\n-- (−t·t ≤ 0, whatever t's sign) after its rows, before the products, which may name them.\ninductive Tree where\n  | split (l : Row) (yes no : Tree)\n  | leaf (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n  | leafAt (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n  | leafSq (rows : List (Row × Src)) (sqs : List Row) (steps : List Step) (eqs : List (Nat × Nat)) (prods : List (Nat × Nat))\n\ndef squares (tab : List VDef) : List Row → Option (List Row)\n  | [] => some []\n  | t :: ts => match rowMul tab t t, squares tab ts with\n    | some r, some rs => some (lscale (-1) r :: rs)\n    | _, _ => none\n\ndef extend (tab : List VDef) : List Row → List (Nat × Nat) → Option (List Row)\n  | acc, [] => some acc\n  | acc, (i, j) :: ps => match acc[i]?, acc[j]? with\n    | some p, some q => match rowMul tab p q with\n      | some r => extend tab (acc ++ [lscale (-1) r]) ps\n      | none => none\n    | _, _ => none\n\ndef leafOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List Row) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  let comp := leafRows tab path hyps eqs\n  rows.all (fun r => comp.any (same r)) && match extend tab rows prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\n-- Each row where its hint says, or else among the leaf's rows.\ndef leafAtOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List (Row × Src)) (steps : List Step) (eqs : List (Nat × Nat))\n    (prods : List (Nat × Nat)) : Bool :=\n  rows.all (fun r => (srcRows tab path hyps eqs r.2).any (same r.1) || (leafRows tab path hyps eqs).any (same r.1))\n    && match extend tab (rows.map (·.1)) prods with\n    | some rows' => Cert.check rows' steps\n    | none => false\n\n-- Each row where its hint says, or else among the leaf's rows; then the squares, then the products.\ndef leafSqOk (tab : List VDef) (path : Path) (hyps : List C) (rows : List (Row × Src)) (sqs : List Row) (steps : List Step)\n    (eqs : List (Nat × Nat)) (prods : List (Nat × Nat)) : Bool :=\n  rows.all (fun r => (srcRows tab path hyps eqs r.2).any (same r.1) || (leafRows tab path hyps eqs).any (same r.1))\n    && match squares tab sqs with\n    | some sr => match extend tab (rows.map (·.1) ++ sr) prods with\n      | some rows' => Cert.check rows' steps\n      | none => false\n    | none => false\n\ndef checkT (tab : List VDef) (hyps : List C) : Path → Tree → Bool\n  | path, .split l y n => checkT tab hyps ((l, true) :: path) y && checkT tab hyps ((l, false) :: path) n\n  | path, .leaf rows steps eqs prods => leafOk tab path hyps rows steps eqs prods\n  | path, .leafAt rows steps eqs prods => leafAtOk tab path hyps rows steps eqs prods\n  | path, .leafSq rows sqs steps eqs prods => leafSqOk tab path hyps rows sqs steps eqs prods\n\nstructure Goal where\n  tab : List VDef\n  hyps : List C\n\n-- Each cell's key reads only earlier columns, so the table has a valuation.\ndef wfTab : Nat → List VDef → Bool\n  | _, [] => true\n  | n, .var _ :: ds => wfTab (n + 1) ds\n  | n, .cell _ k :: ds => k.coefs.all (·.1 < n) && wfTab (n + 1) ds\n  | n, .mono fs :: ds => fs.all (· < n) && wfTab (n + 1) ds\n  | n, .term _ :: ds => wfTab (n + 1) ds\n\ndef checkGoal (g : Goal) (t : Tree) : Bool := wfTab 0 g.tab && checkT g.tab g.hyps [] t\n\nsection\nvariable {tab : List VDef} {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int}\n\ntheorem natRows_sound (hM : Model tab env maps x) : ∀ n, ∀ r ∈ natRows n, eval r x ≤ 0\n  | 0, r, hr => by simp [natRows] at hr\n  | n + 1, r, hr => by\n    simp only [natRows, List.mem_cons] at hr\n    rcases hr with hr | hr\n    · subst hr; rw [eval_lscale, eval_lunit]; have := hM.2 n; omega\n    · exact natRows_sound hM n r hr\n\ntheorem termRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) :\n    ∀ r ∈ termRows tab path, eval r x ≤ 0 := by\n  intro r hr\n  simp only [termRows, List.mem_flatMap] at hr\n  obtain ⟨j, _, hr⟩ := hr\n  simp only [termRowsAt] at hr\n  split at hr\n  · rename_i e hj\n    have hx : x.getD j 0 = (evalE env maps e : Int) := by rw [hM.1 j _ hj]; rfl\n    simp only [List.mem_append] at hr\n    rcases hr with hr | hr\n    · cases e with\n      | min a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.min_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | max a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE, Nat.max_def] at hx\n          split at hx <;> rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n        · simp at hr\n      | sub a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          have ea := linear_sound hM hP a la ha\n          have eb := linear_sound hM hP b lb hb\n          simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n          simp only [evalE] at hx\n          rcases hr with rfl | rfl\n          · rw [eval_lsub, eval_lsub, eval_lunit]; omega\n          · rw [eval_lsub, eval_lunit]; omega\n        · simp at hr\n      | ite c a b =>\n        simp only at hr\n        split at hr\n        · rename_i la lb ha hb\n          split at hr\n          · have ea := linear_sound hM hP a la ha\n            have eb := linear_sound hM hP b lb hb\n            simp only [termBounds, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n            simp only [evalE] at hx\n            subst hr\n            rw [eval_lsub, eval_ladd, eval_lunit]\n            split at hx <;> omega\n          · simp at hr\n        · simp at hr\n      | _ => simp at hr\n    · split at hr\n      · rename_i r' hr'\n        have := linear_sound hM hP e r' hr'\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit] <;> omega\n      · simp at hr\n  · simp at hr\n\ntheorem leafRows_sound {path : Path} (hM : Model tab env maps x) (hP : PathHolds path x) {hyps : List C}\n    (hH : ∀ c ∈ hyps, evalC env maps c = true) (eqs : List (Nat × Nat)) : ∀ r ∈ leafRows tab path hyps eqs, eval r x ≤ 0 := by\n  intro r hr\n  simp only [leafRows, List.mem_append, List.mem_map, List.mem_flatMap] at hr\n  rcases hr with (((⟨a, ha, rfl⟩ | ⟨c, hc, hr⟩) | hr) | ⟨p, _, hr⟩) | hr\n  · have := hP a ha\n    simp only [atomRow]\n    cases h2 : a.2 with\n    | true => rw [h2] at this; simpa using this\n    | false => rw [h2] at this; simp only [decide_eq_false_iff_not] at this; simp only [ite_false, Bool.false_eq_true, eval_flip]; omega\n  · exact facts_sound hM hP c true (hH c hc) r hr\n  · exact natRows_sound hM _ r hr\n  · simp only [cellEq] at hr\n    split at hr\n    · rename_i m k m' k' h1 h2\n      split at hr\n      · rename_i hc\n        simp only [Bool.and_eq_true, beq_iff_eq] at hc\n        obtain ⟨⟨rfl, hk1⟩, hk2⟩ := hc\n        have t1 := dec_sound hP hk1; have t2 := dec_sound hP hk2\n        simp only [eval_lsub, decide_eq_true_eq] at t1 t2\n        have e1 := hM.1 p.1 _ h1; have e2 := hM.1 p.2 _ h2\n        simp only [valD] at e1 e2\n        have hkk : eval k x = eval k' x := by omega\n        simp only [List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hr\n        rcases hr with rfl | rfl <;> rw [eval_lsub, eval_lunit, eval_lunit, e1, e2, hkk] <;> omega\n      · simp at hr\n    · simp at hr\n  · exact termRows_sound hM hP r hr\n\n-- A hint names some of the leaf's rows.\ntheorem natRows_mem : ∀ {n i : Nat}, i < n → lscale (-1) (lunit i) ∈ natRows n\n  | 0, _, h => absurd h (Nat.not_lt_zero _)\n  | n + 1, i, h => by\n    simp only [natRows, List.mem_cons]\n    rcases Nat.lt_succ_iff_lt_or_eq.mp h with h | rfl\n    · exact Or.inr (natRows_mem h)\n    · exact Or.inl rfl\n\ntheorem srcRows_sub {path : Path} {hyps : List C} {eqs : List (Nat × Nat)} {r : Row} :\n    ∀ s, r ∈ srcRows tab path hyps eqs s → r ∈ leafRows tab path hyps eqs\n  | .atom i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i a ha\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append, List.mem_map]\n      exact Or.inl (Or.inl (Or.inl (Or.inl ⟨a, List.mem_of_getElem? ha, rfl⟩)))\n    · simp at hr\n  | .fact h, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i c hc\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inl (Or.inl (Or.inr ⟨c, List.mem_of_getElem? hc, hr⟩)))\n    · simp at hr\n  | .nat i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hi\n      simp only [List.mem_singleton] at hr; subst hr\n      simp only [leafRows, List.mem_append]\n      exact Or.inl (Or.inl (Or.inr (natRows_mem hi)))\n    · simp at hr\n  | .eq i, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i p hp\n      simp only [leafRows, List.mem_append, List.mem_flatMap]\n      exact Or.inl (Or.inr ⟨p, List.mem_of_getElem? hp, hr⟩)\n    · simp at hr\n  | .term j, hr => by\n    simp only [srcRows] at hr\n    split at hr\n    · rename_i hj\n      simp only [leafRows, termRows, List.mem_append, List.mem_flatMap, List.mem_range]\n      exact Or.inr ⟨j, hj, hr⟩\n    · simp at hr\n  | .any, hr => by simp [srcRows] at hr\n\ntheorem extend_sound (hM : Model tab env maps x) :\n    ∀ ps acc rows', extend tab acc ps = some rows' → (∀ r ∈ acc, eval r x ≤ 0) → ∀ r ∈ rows', eval r x ≤ 0\n  | [], acc, rows', h, ha => by simp only [extend, Option.some.injEq] at h; subst h; exact ha\n  | (i, j) :: ps, acc, rows', h, ha => by\n    simp only [extend] at h\n    split at h\n    · rename_i p q hp hq\n      split at h\n      · rename_i r hr\n        refine extend_sound hM ps _ rows' h (fun r' hr' => ?_)\n        rcases List.mem_append.mp hr' with hr' | hr'\n        · exact ha r' hr'\n        · simp only [List.mem_singleton] at hr'; subst hr'\n          have e1 := ha p (List.mem_of_getElem? hp)\n          have e2 := ha q (List.mem_of_getElem? hq)\n          rw [eval_lscale, rowMul_sound hM hr]\n          have : 0 ≤ (-eval p x) * (-eval q x) := Int.mul_nonneg (by omega) (by omega)\n          rw [Int.neg_mul_neg] at this; omega\n      · simp at h\n    · simp at h\n\ntheorem squares_sound (hM : Model tab env maps x) : ∀ ts rs, squares tab ts = some rs → ∀ r ∈ rs, eval r x ≤ 0\n  | [], rs, h => by simp only [squares, Option.some.injEq] at h; subst h; simp\n  | t :: ts, rs, h => by\n    simp only [squares] at h\n    split at h\n    · rename_i r rs' hr hrs\n      simp only [Option.some.injEq] at h; subst h\n      intro r' hr'\n      rcases List.mem_cons.mp hr' with hr' | hr'\n      · subst hr'\n        rw [eval_lscale, rowMul_sound hM hr]\n        have : 0 ≤ eval t x * eval t x := by\n          rcases Int.le_total 0 (eval t x) with h0 | h0\n          · exact Int.mul_nonneg h0 h0\n          · have := Int.mul_nonneg (show 0 ≤ -eval t x by omega) (show 0 ≤ -eval t x by omega)\n            rwa [Int.neg_mul_neg] at this\n        omega\n      · exact squares_sound hM ts rs' hrs r' hr'\n    · simp at h\n\ntheorem checkT_sound (hM : Model tab env maps x) {hyps : List C} (hH : ∀ c ∈ hyps, evalC env maps c = true) :\n    ∀ (t : Tree) (path : Path), PathHolds path x → checkT tab hyps path t = true → False\n  | .split l y n, path, hP, h => by\n    simp only [checkT, Bool.and_eq_true] at h\n    by_cases hl : eval l x ≤ 0\n    · refine checkT_sound hM hH y _ ?_ h.1\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n    · refine checkT_sound hM hH n _ ?_ h.2\n      intro a ha\n      rcases List.mem_cons.mp ha with ha | ha\n      · subst ha; simpa using hl\n      · exact hP a ha\n  | .leaf rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafOk, Bool.and_eq_true, List.all_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods rows rows' he ?_)\n      intro r hr\n      obtain ⟨c, hc, hs⟩ := h1 r hr\n      rw [same_eval hs]\n      exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\n  | .leafAt rows steps eqs prods, path, hP, h => by\n    simp only [checkT, leafAtOk, Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i rows' he\n      refine Cert.sound rows' steps h2 x (extend_sound hM prods _ rows' he ?_)\n      intro r hr\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hr\n      rcases h1 p hp with ⟨c, hc, hs⟩ | ⟨c, hc, hs⟩\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c (srcRows_sub p.2 hc)\n      · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c hc\n    · simp at h2\n  | .leafSq rows sqs steps eqs prods, path, hP, h => by\n    simp only [checkT, leafSqOk, Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, List.any_eq_true] at h\n    obtain ⟨h1, h2⟩ := h\n    split at h2\n    · rename_i sr hsr\n      split at h2\n      · rename_i rows' he\n        refine Cert.sound rows' steps h2 x (extend_sound hM prods _ rows' he ?_)\n        intro r hr\n        rcases List.mem_append.mp hr with hr | hr\n        · obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hr\n          rcases h1 p hp with ⟨c, hc, hs⟩ | ⟨c, hc, hs⟩\n          · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c (srcRows_sub p.2 hc)\n          · rw [same_eval hs]; exact leafRows_sound hM hP hH eqs c hc\n        · exact squares_sound hM sqs sr hsr r hr\n      · simp at h2\n    · simp at h2\nend\n\n/-! The table's valuation. -/\n\ndef build (env : Nat → Nat) (maps : Nat → Nat → Nat) : List VDef → List Int → List Int\n  | [], acc => acc\n  | d :: ds, acc => build env maps ds (acc ++ [valD env maps d acc])\n\ntheorem dot_append : ∀ (a : List (Nat × Int)) (l1 l2 : List Int), (∀ p ∈ a, p.1 < l1.length) → dot a (l1 ++ l2) = dot a l1\n  | [], _, _, _ => by simp [dot]\n  | p :: a, l1, l2, h => by\n    simp only [dot]\n    rw [dot_append a l1 l2 (fun q hq => h q (List.mem_cons_of_mem _ hq))]\n    have hp := h p List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hp]\n\n-- What a column may refer to: only earlier columns.\ndef Refs (n : Nat) : VDef → Prop\n  | .var _ => True\n  | .cell _ k => ∀ p ∈ k.coefs, p.1 < n\n  | .mono fs => ∀ f ∈ fs, f < n\n  | .term _ => True\n\ntheorem Refs.mono_le {n m : Nat} (h : n ≤ m) : ∀ {d : VDef}, Refs n d → Refs m d\n  | .var _, _ => trivial\n  | .cell _ _, hd => fun p hp => by have := hd p hp; omega\n  | .mono _, hd => fun f hf => by have := hd f hf; omega\n  | .term _, _ => trivial\n\ntheorem prodV_append_left (acc more : List Int) : ∀ fs : List Nat, (∀ f ∈ fs, f < acc.length) → prodV (acc ++ more) fs = prodV acc fs\n  | [], _ => rfl\n  | f :: fs, h => by\n    simp only [prodV]\n    rw [prodV_append_left acc more fs (fun g hg => h g (List.mem_cons_of_mem _ hg))]\n    have hf := h f List.mem_cons_self\n    rw [List.getD_eq_getElem?_getD, List.getD_eq_getElem?_getD, List.getElem?_append_left hf]\n\ntheorem valD_append (env : Nat → Nat) (maps : Nat → Nat → Nat) (d : VDef) (acc more : List Int)\n    (h : Refs acc.length d) : valD env maps d (acc ++ more) = valD env maps d acc := by\n  cases d with\n  | var i => rfl\n  | cell m k => simp only [Refs] at h; simp only [valD, eval, dot_append k.coefs acc more h]\n  | mono fs => simp only [valD, prodV_append_left acc more fs h]\n  | term e => rfl\n\ndef Valid (env : Nat → Nat) (maps : Nat → Nat → Nat) (acc : List Int) (pre : List VDef) : Prop :=\n  acc.length = pre.length ∧ (∀ (j : Nat) (d : VDef), pre[j]? = some d → Refs j d) ∧\n    ∀ (j : Nat) (d : VDef), pre[j]? = some d → acc[j]? = some (valD env maps d acc)\n\ntheorem valid_snoc {env : Nat → Nat} {maps : Nat → Nat → Nat} {acc : List Int} {pre : List VDef} (d : VDef)\n    (hv : Valid env maps acc pre) (hd : Refs pre.length d) :\n    Valid env maps (acc ++ [valD env maps d acc]) (pre ++ [d]) := by\n  obtain ⟨hl, hw, hx⟩ := hv\n  refine ⟨by simp [hl], ?_, ?_⟩\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj; exact hw j d' hj\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      exact Refs.mono_le (by omega) hd\n  · intro j d' hj\n    by_cases hlt : j < pre.length\n    · rw [List.getElem?_append_left hlt] at hj\n      rw [List.getElem?_append_left (by omega), hx j d' hj]\n      rw [valD_append env maps d' acc _ (Refs.mono_le (by omega) (hw j d' hj))]\n    · rw [List.getElem?_append_right (by omega)] at hj\n      have hj0 : j - pre.length = 0 := by\n        cases h : j - pre.length with\n        | zero => rfl\n        | succ n => rw [h] at hj; simp at hj\n      rw [hj0] at hj; simp only [List.getElem?_cons_zero, Option.some.injEq] at hj; subst hj\n      rw [List.getElem?_append_right (by omega), show j - acc.length = 0 by omega]\n      simp only [List.getElem?_cons_zero, Option.some.injEq]\n      rw [valD_append env maps d acc _ (by rw [hl]; exact hd)]\n\ntheorem build_valid (env : Nat → Nat) (maps : Nat → Nat → Nat) : ∀ (ds : List VDef) (acc : List Int) (pre : List VDef),\n    Valid env maps acc pre → wfTab pre.length ds = true → Valid env maps (build env maps ds acc) (pre ++ ds)\n  | [], acc, pre, hv, _ => by simpa [build] using hv\n  | d :: ds, acc, pre, hv, hw => by\n    have hd : Refs pre.length d ∧ wfTab (pre.length + 1) ds = true := by\n      cases d with\n      | var i => exact ⟨trivial, by simpa [wfTab] using hw⟩\n      | cell m k =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | mono fs =>\n        simp only [wfTab, Bool.and_eq_true, List.all_eq_true, decide_eq_true_eq] at hw\n        exact ⟨hw.1, hw.2⟩\n      | term e => exact ⟨trivial, by simpa [wfTab] using hw⟩\n    have := build_valid env maps ds _ (pre ++ [d]) (valid_snoc d hv hd.1) (by simpa using hd.2)\n    simpa [build] using this\n\ntheorem model_of_valid {env : Nat → Nat} {maps : Nat → Nat → Nat} {x : List Int} {tab : List VDef}\n    (hv : Valid env maps x tab) : Model tab env maps x := by\n  obtain ⟨hl, _, hx⟩ := hv\n  refine ⟨fun j d hj => by rw [List.getD_eq_getElem?_getD, hx j d hj]; rfl, fun j => ?_⟩\n  rw [List.getD_eq_getElem?_getD]\n  cases h : x[j]? with\n  | none => simp\n  | some v =>\n    have hj : j < tab.length := by\n      have := (List.getElem?_eq_some_iff.mp h).1; omega\n    obtain ⟨d, hd⟩ : ∃ d, tab[j]? = some d := ⟨tab[j], List.getElem?_eq_getElem hj⟩\n    rw [hx j d hd] at h\n    simp only [Option.some.injEq] at h; subst h\n    cases d <;> simp [valD]\n    exact Int.le_max_right _ _\n\n/-- The kernel's tree check is sound: an accepted goal's hypotheses hold for no naturals and no maps. -/\ntheorem sound (g : Goal) (t : Tree) (h : checkGoal g t = true) (env : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ¬ ∀ c ∈ g.hyps, evalC env maps c = true := by\n  intro hH\n  simp only [checkGoal, Bool.and_eq_true] at h\n  have hv := build_valid env maps g.tab [] [] ⟨rfl, by simp, by simp⟩ (by simpa using h.1)\n  simp only [List.nil_append] at hv\n  exact checkT_sound (model_of_valid hv) hH t [] (by simp [PathHolds]) h.2\n\n/-! Step machines with scalar state: the induction rule over kernel goals. The goals are built here, in Lean, from\nthe machine, so the TypeScript `obligations` is not trusted for these: a law holds at the start (`startGoal` is\nrefuted) and one step keeps every law (`stepGoal` is refuted, assuming them all and the request's assumption), so every\nlaw holds in every reachable state. Laws may not read the request's inputs. -/\n\ndef assoc (σ : List (Nat × E)) (i : Nat) : Option E := (lookup (fun p => p.1 == i) σ).map (·.2)\n\nmutual\ndef substE (σ : List (Nat × E)) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substE σ a) (substE σ b)\n  | .sub a b => .sub (substE σ a) (substE σ b)\n  | .mul k a => .mul k (substE σ a)\n  | .min a b => .min (substE σ a) (substE σ b)\n  | .max a b => .max (substE σ a) (substE σ b)\n  | .prod a b => .prod (substE σ a) (substE σ b)\n  | .ite c t f => .ite (substC σ c) (substE σ t) (substE σ f)\n  | .get m key => .get m (substE σ key)\ndef substC (σ : List (Nat × E)) : C → C\n  | .le a b => .le (substE σ a) (substE σ b)\n  | .lt a b => .lt (substE σ a) (substE σ b)\n  | .eq a b => .eq (substE σ a) (substE σ b)\n  | .and a b => .and (substC σ a) (substC σ b)\n  | .or a b => .or (substC σ a) (substC σ b)\n  | .not a => .not (substC σ a)\nend\n\n-- The environment after σ: each assigned variable takes its term's value, the rest keep theirs.\ndef applyS (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat :=\n  fun i => match assoc σ i with\n    | some e => evalE ρ maps e\n    | none => ρ i\n\nmutual\ntheorem subst_evalE (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → evalE ρ maps (substE σ e) = evalE (applyS σ ρ maps) maps e\n  | .var i => by\n    simp only [substE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substE, evalE]\n  | .add a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .sub a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .mul k a => by simp [substE, evalE, subst_evalE σ ρ maps a]\n  | .min a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .max a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .prod a b => by simp [substE, evalE, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .ite c t f => by simp [substE, evalE, subst_evalC σ ρ maps c, subst_evalE σ ρ maps t, subst_evalE σ ρ maps f]\n  | .get m key => by simp [substE, evalE, subst_evalE σ ρ maps key]\ntheorem subst_evalC (σ : List (Nat × E)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → evalC ρ maps (substC σ c) = evalC (applyS σ ρ maps) maps c\n  | .le a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .lt a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .eq a b => by simp [substC, evalC, subst_evalE σ ρ maps a, subst_evalE σ ρ maps b]\n  | .and a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .or a b => by simp [substC, evalC, subst_evalC σ ρ maps a, subst_evalC σ ρ maps b]\n  | .not a => by simp [substC, evalC, subst_evalC σ ρ maps a]\nend\n\nmutual\ndef occE (i : Nat) : E → Bool\n  | .var j => j == i\n  | .const _ => false\n  | .add a b => occE i a || occE i b\n  | .sub a b => occE i a || occE i b\n  | .mul _ a => occE i a\n  | .min a b => occE i a || occE i b\n  | .max a b => occE i a || occE i b\n  | .prod a b => occE i a || occE i b\n  | .ite c t f => occC i c || occE i t || occE i f\n  | .get _ key => occE i key\ndef occC (i : Nat) : C → Bool\n  | .le a b => occE i a || occE i b\n  | .lt a b => occE i a || occE i b\n  | .eq a b => occE i a || occE i b\n  | .and a b => occC i a || occC i b\n  | .or a b => occC i a || occC i b\n  | .not a => occC i a\nend\n\nmutual\ntheorem congrE (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → (∀ i, occE i e = true → ρ i = ρ' i) → evalE ρ maps e = evalE ρ' maps e\n  | .var j, h => by simp only [evalE]; exact h j (by simp [occE])\n  | .const n, _ => rfl\n  | .add a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .sub a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .mul k a, h => by simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi]))]\n  | .min a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .max a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .prod a b, h => by\n    simp only [evalE, congrE ρ ρ' maps a (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occE, hi]))]\n  | .ite c t f, h => by\n    simp only [evalE, congrC ρ ρ' maps c (fun i hi => h i (by simp [occE, hi])), congrE ρ ρ' maps t (fun i hi => h i (by simp [occE, hi])),\n      congrE ρ ρ' maps f (fun i hi => h i (by simp [occE, hi]))]\n  | .get m key, h => by simp only [evalE, congrE ρ ρ' maps key (fun i hi => h i (by simp [occE, hi]))]\ntheorem congrC (ρ ρ' : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → (∀ i, occC i c = true → ρ i = ρ' i) → evalC ρ maps c = evalC ρ' maps c\n  | .le a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .lt a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .eq a b, h => by\n    simp only [evalC, congrE ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrE ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .and a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .or a b, h => by\n    simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi])), congrC ρ ρ' maps b (fun i hi => h i (by simp [occC, hi]))]\n  | .not a, h => by simp only [evalC, congrC ρ ρ' maps a (fun i hi => h i (by simp [occC, hi]))]\nend\n\nstructure Machine where\n  inputs : List Nat\n  init : List (Nat × E)   -- each state variable's start, over the params\n  step : List (Nat × E)   -- each state variable after a request, over params, inputs and state\n  pre : C                 -- about the params alone: a precondition, so it holds at the start and at every step\n  assume : C              -- about each request (and the params); holds at a step, not at the start\n\n-- A request: its inputs replace those variables; nothing else changes until the step.\ndef withInputs (inputs : List Nat) (ρ ι : Nat → Nat) : Nat → Nat := fun i => if inputs.contains i then ι i else ρ i\n\ninductive Reach (m : Machine) (maps : Nat → Nat → Nat) : (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) : evalC ρ maps m.pre = true → Reach m maps (applyS m.init ρ maps)\n  | step (ρ ι : Nat → Nat) : Reach m maps ρ → evalC (withInputs m.inputs ρ ι) maps m.assume = true →\n      Reach m maps (applyS m.step (withInputs m.inputs ρ ι) maps)\n\ndef startGoal (m : Machine) (law : C) : List C := [m.pre, .not (substC m.init law)]\ndef stepGoal (m : Machine) (laws : List C) (law : C) : List C := [m.pre, m.assume] ++ laws ++ [.not (substC m.step law)]\n\n-- Per law: the law, then (table, tree) for its start goal and for its step goal.\nabbrev MachineProof := List (C × (List VDef × Tree) × (List VDef × Tree))\n\n-- None of `vs` occurs in c.\ndef avoids (vs : List Nat) (c : C) : Bool := vs.all fun i => !occC i c\n\n-- The precondition reads only params: no input, no variable the start or a step assigns.\ndef preOk (m : Machine) : Bool := avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre\n\ndef checkMachine (m : Machine) (ps : MachineProof) : Bool :=\n  preOk m && ps.all fun p => avoids m.inputs p.1\n    && checkGoal ⟨p.2.1.1, startGoal m p.1⟩ p.2.1.2\n    && checkGoal ⟨p.2.2.1, stepGoal m (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem avoids_occ {vs : List Nat} {c : C} (h : avoids vs c = true) {i : Nat} (hi : occC i c = true) : i ∉ vs := by\n  intro hm\n  simp only [avoids, List.all_eq_true] at h\n  have := h i hm; simp [hi] at this\n\ntheorem assoc_mem {σ : List (Nat × E)} {i : Nat} {e : E} (h : assoc σ i = some e) : i ∈ σ.map (·.1) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, _⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  simp only [beq_iff_eq] at hp\n  exact List.mem_map.mpr ⟨a, hm, hp⟩\n\n-- σ leaves every variable it doesn't assign alone.\ntheorem applyS_other {σ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    applyS σ ρ maps i = ρ i := by\n  simp only [applyS]\n  cases ha : assoc σ i with\n  | none => rfl\n  | some e => exact absurd (assoc_mem ha) h\n\ntheorem withInputs_other {inputs : List Nat} {i : Nat} (h : i ∉ inputs) (ρ ι : Nat → Nat) : withInputs inputs ρ ι i = ρ i := by\n  simp only [withInputs]; split\n  · rename_i hc; exact absurd (List.contains_iff_mem.mp hc) h\n  · rfl\n\n-- Conditions that avoid some variables read the same before and after anything that only changes those.\ntheorem evalC_avoids {vs : List Nat} {c : C} (h : avoids vs c = true) {ρ ρ' : Nat → Nat} (maps : Nat → Nat → Nat)\n    (hρ : ∀ i, i ∉ vs → ρ i = ρ' i) : evalC ρ maps c = evalC ρ' maps c :=\n  congrC ρ ρ' maps c (fun i hi => hρ i (avoids_occ h hi))\n\ntheorem pre_reach {m : Machine} (hp : preOk m = true) {maps : Nat → Nat → Nat} :\n    ∀ {ρ}, Reach m maps ρ → evalC ρ maps m.pre = true := by\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ maps)]; exact h0\n  | step ρ ι _ _ ih =>\n    rw [evalC_avoids hp maps (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n/-- The induction rule: for params that meet the precondition, every law of an accepted machine proof holds in every\nreachable state, for any maps. -/\ntheorem machine_sound (m : Machine) (ps : MachineProof) (h : checkMachine m ps = true) (maps : Nat → Nat → Nat) :\n    ∀ ρ, Reach m maps ρ → ∀ l ∈ ps.map (·.1), evalC ρ maps l = true := by\n  simp only [checkMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨hpre, h⟩ := h\n  intro ρ hr\n  induction hr with\n  | start ρ h0 =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).1.2 ρ maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [startGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · exact h0\n    · simp only [evalC, subst_evalC]; simpa using hf\n  | step ρ ι hr ha ih =>\n    intro l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    have hs := sound _ _ (h p hp).2 (withInputs m.inputs ρ ι) maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [stepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with ((rfl | rfl) | hc) | rfl\n    · rw [evalC_avoids hpre maps (ρ' := ρ) (fun i hi => withInputs_other (fun h => hi (by simp [h])) ρ ι)]\n      exact pre_reach hpre hr\n    · exact ha\n    · obtain ⟨q, hq, rfl⟩ := List.mem_map.mp hc\n      rw [evalC_avoids (h q hq).1.1 maps (ρ' := ρ) (fun i hi => withInputs_other hi ρ ι)]\n      exact ih q.1 (List.mem_map.mpr ⟨q, hq, rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa using hf\n\n/-! Loops: termination. A loop runs `body` while `guard` holds, each turn reading fresh inputs that meet `assume`. That it\nhalts is a liveness of its machine (Live.lean's Loop.machine and loop_halts_of): from anywhere, the guard fails later. -/\n\nstructure Loop where\n  inputs : List Nat\n  init : List (Nat × E)\n  body : List (Nat × E)\n  guard : C               -- while\n  pre : C                 -- about the params alone\n  assume : C              -- about each turn's inputs\n\n-- One turn: some inputs meeting the assumption, the guard holds, the body runs.\ndef Turn (l : Loop) (maps : Nat → Nat → Nat) (ρ ρ' : Nat → Nat) : Prop :=\n  ∃ ι, evalC (withInputs l.inputs ρ ι) maps l.guard = true ∧ evalC (withInputs l.inputs ρ ι) maps l.assume = true ∧\n    ρ' = applyS l.body (withInputs l.inputs ρ ι) maps\n\n/-! Folds over binary trees: structural induction. Each leaf and node carries its own inputs; a leaf's state comes from\nits inputs, a node's from its children's (read through copies of the state variables, one per side) and its inputs.\nThe goals are built here: each law holds at every leaf, and at a node whenever every law holds at both children. -/\n\nstructure Fold where\n  inputs : List Nat\n  state : List (Nat × Nat × Nat)   -- a state variable, its copy for the left child, its copy for the right child\n  leaf : List (Nat × E)\n  node : List (Nat × E)\n  pre : C\n  assume : C\n\ninductive BTree where\n  | leaf (ι : Nat → Nat)\n  | node (ι : Nat → Nat) (l r : BTree)\n\n-- A node's environment: each copy reads the child's state variable.\ndef withChildren (f : Fold) (env a b : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun e => e.2.1 == i) f.state with\n  | some e => a e.1\n  | none => match lookup (fun e => e.2.2 == i) f.state with\n    | some e => b e.1\n    | none => env i\n\ndef foldT (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Nat → Nat\n  | .leaf ι => applyS f.leaf (withInputs f.inputs ρ ι) maps\n  | .node ι l r => applyS f.node (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps\n\n-- Every leaf's and node's inputs meet the assumption.\ndef Allowed (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : BTree → Prop\n  | .leaf ι => evalC (withInputs f.inputs ρ ι) maps f.assume = true\n  | .node ι l r => evalC (withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps l) (foldT f ρ maps r)) maps f.assume = true\n      ∧ Allowed f ρ maps l ∧ Allowed f ρ maps r\n\ndef leftSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.1)\ndef rightSub (f : Fold) : List (Nat × E) := f.state.map fun e => (e.1, .var e.2.2)\n\ndef leafGoal (f : Fold) (law : C) : List C := [f.pre, f.assume, .not (substC f.leaf law)]\ndef nodeGoal (f : Fold) (laws : List C) (law : C) : List C :=\n  [f.pre, f.assume] ++ laws.flatMap (fun h => [substC (leftSub f) h, substC (rightSub f) h]) ++ [.not (substC f.node law)]\n\n-- Variables a fold changes or reads per tree: inputs, the copies, and whatever a leaf or node assigns.\ndef touched (f : Fold) : List Nat :=\n  f.inputs ++ f.state.map (·.2.1) ++ f.state.map (·.2.2) ++ f.leaf.map (·.1) ++ f.node.map (·.1)\n-- Copies name one state variable each, and no right copy is a left copy.\ndef copiesOk (f : Fold) : Bool :=\n  f.state.all fun e => f.state.all fun e' => (e.2.1 != e'.2.1 || e.1 == e'.1) && (e.2.2 != e'.2.2 || e.1 == e'.1) && e.2.2 != e'.2.1\n\n-- Per law: the law, then (table, tree) for its leaf goal and its node goal.\nabbrev FoldProof := MachineProof\n\ndef checkFold (f : Fold) (ps : FoldProof) : Bool :=\n  copiesOk f && avoids (touched f) f.pre\n    && ps.all fun p => avoids ((touched f).filter fun i => !(f.state.map (·.1)).contains i) p.1\n      && checkGoal ⟨p.2.1.1, leafGoal f p.1⟩ p.2.1.2\n      && checkGoal ⟨p.2.2.1, nodeGoal f (ps.map (·.1)) p.1⟩ p.2.2.2\n\ntheorem lookup_none {α : Type} {p : α → Bool} {l : List α} (h : ∀ a ∈ l, p a = false) : lookup p l = none := by\n  cases hl : lookup p l with\n  | none => rfl\n  | some a => have := lookup_some hl; simp [h a this.1] at this\n\ntheorem lookup_none_all {α : Type} {p : α → Bool} : ∀ {l : List α}, lookup p l = none → ∀ a ∈ l, p a = false\n  | [], _, a, ha => by simp at ha\n  | b :: bs, h, a, ha => by\n    simp only [lookup] at h\n    split at h\n    · simp at h\n    · rcases List.mem_cons.mp ha with rfl | ha\n      · simpa using (by assumption : ¬ p a = true)\n      · exact lookup_none_all h a ha\n\ntheorem withChildren_plain (f : Fold) (env a b : Nat → Nat) {i : Nat} (hl : i ∉ f.state.map (·.2.1))\n    (hr : i ∉ f.state.map (·.2.2)) : withChildren f env a b i = env i := by\n  simp only [withChildren]\n  rw [lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hl (List.mem_map.mpr ⟨e, he, h⟩)),\n    lookup_none (fun e he => by simp only [beq_eq_false_iff_ne]; intro h; exact hr (List.mem_map.mpr ⟨e, he, h⟩))]\n\ntheorem withChildren_left {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.1 = a e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  cases h : lookup (fun e' => e'.2.1 == e.2.1) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.1\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem withChildren_right {f : Fold} (hc : copiesOk f = true) (env a b : Nat → Nat) {e : Nat × Nat × Nat} (he : e ∈ f.state) :\n    withChildren f env a b e.2.2 = b e.1 := by\n  simp only [copiesOk, List.all_eq_true, Bool.and_eq_true, Bool.or_eq_true, bne_iff_ne, ne_eq, beq_iff_eq] at hc\n  simp only [withChildren]\n  rw [lookup_none (fun e' he' => by simp only [beq_eq_false_iff_ne]; intro h; exact (hc e he e' he').2 h.symm)]\n  cases h : lookup (fun e' => e'.2.2 == e.2.2) f.state with\n  | none => have := lookup_none_all h e he; simp at this\n  | some e' =>\n    have ⟨hm, hp⟩ := lookup_some h\n    simp only [beq_iff_eq] at hp\n    have := (hc e' hm e he).1.2\n    simp only [hp, not_true_eq_false, false_or] at this\n    simp only [this]\n\ntheorem foldT_other (f : Fold) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) {i : Nat} (hi : i ∉ touched f) :\n    ∀ t, foldT f ρ maps t i = ρ i\n  | .leaf ι => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n  | .node ι l r => by\n    simp only [foldT]\n    rw [applyS_other (fun h => hi (by simp [touched, h])), withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h]))\n      (fun h => hi (by simp [touched, h])), withInputs_other (fun h => hi (by simp [touched, h]))]\n\ntheorem assoc_map {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} {x : E}\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = some x) : ∃ e ∈ s, e.1 = i ∧ x = .var (g e) := by\n  simp only [assoc, Option.map_eq_some_iff] at h\n  obtain ⟨a, ha, rfl⟩ := h\n  have ⟨hm, hp⟩ := lookup_some ha\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hm\n  simp only [beq_iff_eq] at hp\n  exact ⟨e, he, hp, rfl⟩\n\ntheorem assoc_map_none {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∉ s.map (·.1)) :\n    assoc (s.map fun e => (e.1, E.var (g e))) i = none := by\n  cases h : assoc (s.map fun e => (e.1, E.var (g e))) i with\n  | none => rfl\n  | some x => obtain ⟨e, he, rfl, -⟩ := assoc_map h; exact absurd (List.mem_map.mpr ⟨e, he, rfl⟩) hi\n\ntheorem assoc_map_some {s : List (Nat × Nat × Nat)} {g : Nat × Nat × Nat → Nat} {i : Nat} (hi : i ∈ s.map (·.1))\n    (h : assoc (s.map fun e => (e.1, E.var (g e))) i = none) : False := by\n  simp only [assoc, Option.map_eq_none_iff] at h\n  obtain ⟨e, he, rfl⟩ := List.mem_map.mp hi\n  have := lookup_none_all h (e.1, E.var (g e)) (List.mem_map.mpr ⟨e, he, rfl⟩)\n  simp at this\n\n-- With no assumption (the trivially true one), every tree is allowed.\ntheorem allowed_trivial (f : Fold) (h : f.assume = .le (.const 0) (.const 0)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    ∀ t, Allowed f ρ maps t\n  | .leaf ι => by simp [Allowed, h, evalC, evalE]\n  | .node ι l r => ⟨by simp [h, evalC, evalE], allowed_trivial f h ρ maps l, allowed_trivial f h ρ maps r⟩\n\n/-- Structural induction: for params that meet the precondition, every law of an accepted fold proof holds of every\ntree whose inputs meet the assumption, for any maps. -/\ntheorem fold_sound (f : Fold) (ps : FoldProof) (h : checkFold f ps = true) (maps : Nat → Nat → Nat) (ρ : Nat → Nat)\n    (h0 : evalC ρ maps f.pre = true) : ∀ t, Allowed f ρ maps t → ∀ l ∈ ps.map (·.1), evalC (foldT f ρ maps t) maps l = true := by\n  simp only [checkFold, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hc, hpre⟩, h⟩ := h\n  have preAt : ∀ env : Nat → Nat, (∀ i, i ∉ touched f → env i = ρ i) → evalC env maps f.pre = true := fun env he => by\n    rw [evalC_avoids hpre maps (ρ' := ρ) he]; exact h0\n  -- What a law reads: the state variables, or variables no tree changes.\n  have reads : ∀ q ∈ ps, ∀ i, occC i q.1 = true → i ∈ f.state.map (·.1) ∨ i ∉ touched f := by\n    intro q hq i hi\n    by_cases hs : i ∈ f.state.map (·.1)\n    · exact Or.inl hs\n    · refine Or.inr fun ht => avoids_occ (h q hq).1.1 hi ?_\n      simp only [List.mem_filter, ht, true_and, Bool.not_eq_true', List.contains_iff_mem]\n      simpa using hs\n  intro t\n  induction t with\n  | leaf ι =>\n    intro ha l hl\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).1.2 (withInputs f.inputs ρ ι) maps\n    intro c hc\n    simp only [leafGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl | rfl\n    · exact preAt _ (fun i hi => withInputs_other (fun h => hi (by simp [touched, h])) ρ ι)\n    · exact ha\n    · simp only [evalC, subst_evalC]; simpa [foldT] using hn\n  | node ι lt rt ihl ihr =>\n    intro ha l hl\n    obtain ⟨hA, hal, har⟩ := ha\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hl\n    let Env := withChildren f (withInputs f.inputs ρ ι) (foldT f ρ maps lt) (foldT f ρ maps rt)\n    -- A law at a child, read through that side's copies.\n    have side : ∀ (g : Nat × Nat × Nat → Nat) (child : BTree),\n        (∀ e ∈ f.state, Env (g e) = foldT f ρ maps child e.1) → ∀ q ∈ ps,\n        evalC Env maps (substC (f.state.map fun e => (e.1, E.var (g e))) q.1) = evalC (foldT f ρ maps child) maps q.1 := by\n      intro g child hg q hq\n      rw [subst_evalC]\n      refine congrC _ _ maps q.1 (fun i hi => ?_)\n      cases hx : assoc (f.state.map fun e => (e.1, E.var (g e))) i with\n      | some x =>\n        obtain ⟨e, he, rfl, rfl⟩ := assoc_map hx\n        simp only [applyS, hx, evalE]; exact hg e he\n      | none =>\n        have hs : i ∉ f.state.map (·.1) := fun hm => assoc_map_some (g := g) hm hx\n        have ht : i ∉ touched f := (reads q hq i hi).resolve_left hs\n        simp only [applyS, hx, Env]\n        rw [withChildren_plain _ _ _ _ (fun h => ht (by simp [touched, h])) (fun h => ht (by simp [touched, h])),\n          withInputs_other (fun h => ht (by simp [touched, h])), foldT_other f ρ maps ht]\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ (h p hp).2 Env maps\n    intro c hc'\n    simp only [nodeGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false,\n      List.mem_flatMap] at hc'\n    rcases hc' with ((rfl | rfl) | ⟨q, hq, hcq⟩) | rfl\n    · exact preAt Env (fun i hi => by\n        simp only [Env]\n        rw [withChildren_plain _ _ _ _ (fun h => hi (by simp [touched, h])) (fun h => hi (by simp [touched, h])),\n          withInputs_other (fun h => hi (by simp [touched, h]))])\n    · exact hA\n    · obtain ⟨q', hq', rfl⟩ := List.mem_map.mp hq\n      rcases hcq with rfl | rfl\n      · simp only [leftSub]\n        rw [side (·.2.1) lt (fun e he => withChildren_left hc _ _ _ he) q' hq']\n        exact ihl hal _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n      · simp only [rightSub]\n        rw [side (·.2.2) rt (fun e he => withChildren_right hc _ _ _ he) q' hq']\n        exact ihr har _ (List.mem_map.mpr ⟨q', hq', rfl⟩)\n    · simp only [evalC, subst_evalC]; simpa [foldT, Env] using hn\n\n/-! Step machines with maps. A step may write each map at one key (read-over-write: a read after the step is the\nwritten value at the written key, the old cell elsewhere). A law may hold at every key: it is proven at a fresh skolem\nvariable and assumed, before the step, at whatever keys the proof names (instantiating ∀ is sound at any term). The\ngoals are built here, as for scalar machines. -/\n\nmutual\ndef readsE : E → Bool\n  | .var _ => false\n  | .const _ => false\n  | .add a b => readsE a || readsE b\n  | .sub a b => readsE a || readsE b\n  | .mul _ a => readsE a\n  | .min a b => readsE a || readsE b\n  | .max a b => readsE a || readsE b\n  | .prod a b => readsE a || readsE b\n  | .ite c t f => readsC c || readsE t || readsE f\n  | .get _ _ => true\ndef readsC : C → Bool\n  | .le a b => readsE a || readsE b\n  | .lt a b => readsE a || readsE b\n  | .eq a b => readsE a || readsE b\n  | .and a b => readsC a || readsC b\n  | .or a b => readsC a || readsC b\n  | .not a => readsC a\nend\n\nmutual\ntheorem noReadsE (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (e : E) → readsE e = false → evalE ρ M e = evalE ρ M' e\n  | .var _, _ => rfl\n  | .const _, _ => rfl\n  | .add a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .sub a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .mul _ a, h => by simp only [readsE] at h; simp only [evalE, noReadsE ρ M M' a h]\n  | .min a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .max a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .prod a b, h => by simp only [readsE, Bool.or_eq_false_iff] at h; simp only [evalE, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .ite c t f, h => by\n    simp only [readsE, Bool.or_eq_false_iff] at h\n    simp only [evalE, noReadsC ρ M M' c h.1.1, noReadsE ρ M M' t h.1.2, noReadsE ρ M M' f h.2]\n  | .get _ _, h => by simp [readsE] at h\ntheorem noReadsC (ρ : Nat → Nat) (M M' : Nat → Nat → Nat) : (c : C) → readsC c = false → evalC ρ M c = evalC ρ M' c\n  | .le a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .lt a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .eq a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsE ρ M M' a h.1, noReadsE ρ M M' b h.2]\n  | .and a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .or a b, h => by simp only [readsC, Bool.or_eq_false_iff] at h; simp only [evalC, noReadsC ρ M M' a h.1, noReadsC ρ M M' b h.2]\n  | .not a, h => by simp only [readsC] at h; simp only [evalC, noReadsC ρ M M' a h]\nend\n\n-- Substitution of variables by σ and of each read by `rd` (applied to the substituted key).\nmutual\ndef substRE (σ : List (Nat × E)) (rd : Nat → E → E) : E → E\n  | .var i => match assoc σ i with\n    | some e => e\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (substRE σ rd a) (substRE σ rd b)\n  | .sub a b => .sub (substRE σ rd a) (substRE σ rd b)\n  | .mul k a => .mul k (substRE σ rd a)\n  | .min a b => .min (substRE σ rd a) (substRE σ rd b)\n  | .max a b => .max (substRE σ rd a) (substRE σ rd b)\n  | .prod a b => .prod (substRE σ rd a) (substRE σ rd b)\n  | .ite c t f => .ite (substRC σ rd c) (substRE σ rd t) (substRE σ rd f)\n  | .get m key => rd m (substRE σ rd key)\ndef substRC (σ : List (Nat × E)) (rd : Nat → E → E) : C → C\n  | .le a b => .le (substRE σ rd a) (substRE σ rd b)\n  | .lt a b => .lt (substRE σ rd a) (substRE σ rd b)\n  | .eq a b => .eq (substRE σ rd a) (substRE σ rd b)\n  | .and a b => .and (substRC σ rd a) (substRC σ rd b)\n  | .or a b => .or (substRC σ rd a) (substRC σ rd b)\n  | .not a => .not (substRC σ rd a)\nend\n\nsection\nvariable (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M M' : Nat → Nat → Nat)\n  (hrd : ∀ m k, evalE W M (rd m k) = M' m (evalE W M k))\ninclude hrd\nmutual\ntheorem substR_evalE : (e : E) → evalE W M (substRE σ rd e) = evalE (applyS σ W M) M' e\n  | .var i => by\n    simp only [substRE]\n    cases h : assoc σ i <;> simp [evalE, applyS, h]\n  | .const n => by simp [substRE, evalE]\n  | .add a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .sub a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .mul k a => by simp [substRE, evalE, substR_evalE a]\n  | .min a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .max a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .prod a b => by simp [substRE, evalE, substR_evalE a, substR_evalE b]\n  | .ite c t f => by simp [substRE, evalE, substR_evalC c, substR_evalE t, substR_evalE f]\n  | .get m key => by simp only [substRE, evalE, hrd, substR_evalE key]\ntheorem substR_evalC : (c : C) → evalC W M (substRC σ rd c) = evalC (applyS σ W M) M' c\n  | .le a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .lt a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .eq a b => by simp [substRC, evalC, substR_evalE a, substR_evalE b]\n  | .and a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .or a b => by simp [substRC, evalC, substR_evalC a, substR_evalC b]\n  | .not a => by simp [substRC, evalC, substR_evalC a]\nend\nend\n\nstructure MMachine where\n  inputs : List Nat\n  init : List (Nat × E)\n  maps0 : List (Nat × Nat)       -- each map's value at every key at the start\n  step : List (Nat × E)\n  writes : List (Nat × E × E)    -- a map, the key it's written at and the value, over the state before the step\n  pre : C                        -- about the params alone, reading no map\n  assume : C                     -- about each request\n\ndef writeMaps (ws : List (Nat × E × E)) (W : Nat → Nat) (M : Nat → Nat → Nat) : Nat → Nat → Nat := fun m key =>\n  match lookup (fun w => w.1 == m) ws with\n  | some w => if key = evalE W M w.2.1 then evalE W M w.2.2 else M m key\n  | none => M m key\n\ndef StartMaps (m : MMachine) (M : Nat → Nat → Nat) : Prop := ∀ p ∈ m.maps0, ∀ key, M p.1 key = p.2\n\ninductive MReach (m : MMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps m M → evalC ρ M m.pre = true → MReach m (applyS m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : MReach m ρ M →\n      evalC (withInputs m.inputs ρ ι) M m.assume = true →\n      MReach m (applyS m.step (withInputs m.inputs ρ ι) M) (writeMaps m.writes (withInputs m.inputs ρ ι) M)\n\ndef upd (ρ : Nat → Nat) (i v : Nat) : Nat → Nat := fun j => if j = i then v else ρ j\n\n-- A law, and for a law about every key, the variable it holds at.\nstructure MLaw where\n  holds : C\n  key : Option Nat\n\ndef MLaw.Holds (l : MLaw) (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop :=\n  match l.key with\n  | none => evalC ρ M l.holds = true\n  | some kv => ∀ v, evalC (upd ρ kv v) M l.holds = true\n\ndef rdStart (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun p => p.1 == mp) m.maps0 with\n  | some p => .const p.2\n  | none => .get mp k\ndef rdStep (m : MMachine) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) m.writes with\n  | some w => .ite (.eq k w.2.1) w.2.2 (.get mp k)\n  | none => .get mp k\n\n-- What a goal proves: the law, at the skolem variable if it holds at every key.\ndef goalOf (l : MLaw) (sk : Nat) : C :=\n  match l.key with\n  | none => l.holds\n  | some kv => substC [(kv, .var sk)] l.holds\n\nstructure MEntry where\n  law : MLaw\n  sk : Nat                    -- the skolem variable\n  insts : List (Nat × E)      -- (law index, key): where the step goal assumes the laws about every key\n  start : List VDef × Tree\n  step : List VDef × Tree\n\ndef scalarHyps (laws : List MLaw) : List C := laws.filterMap fun l =>\n  match l.key with\n  | none => some l.holds\n  | some _ => none\ndef instHyps (laws : List MLaw) (insts : List (Nat × E)) : List C := insts.filterMap fun p =>\n  match laws[p.1]? with\n  | some l => match l.key with\n    | some kv => some (substC [(kv, p.2)] l.holds)\n    | none => none\n  | none => none\n\ndef mStartGoal (m : MMachine) (e : MEntry) : List C := [m.pre, .not (substRC m.init (rdStart m) (goalOf e.law e.sk))]\ndef mStepGoal (m : MMachine) (laws : List MLaw) (e : MEntry) : List C :=\n  [m.pre, m.assume] ++ scalarHyps laws ++ instHyps laws e.insts ++ [.not (substRC m.step (rdStep m) (goalOf e.law e.sk))]\n\n-- The skolem is fresh: no input or state variable, and nothing the machine or a law reads.\ndef skOk (m : MMachine) (laws : List MLaw) (sk : Nat) : Bool :=\n  !(m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)).contains sk && !occC sk m.pre && !occC sk m.assume\n    && laws.all (fun l => !occC sk l.holds) && m.init.all (fun p => !occE sk p.2) && m.step.all (fun p => !occE sk p.2)\n    && m.writes.all (fun w => !occE sk w.2.1 && !occE sk w.2.2)\n\ndef checkMMachine (m : MMachine) (ps : List MEntry) : Bool :=\n  avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre && !readsC m.pre\n    && ps.all fun e => avoids m.inputs e.law.holds && skOk m (ps.map (·.law)) e.sk\n      && checkGoal ⟨e.start.1, mStartGoal m e⟩ e.start.2\n      && checkGoal ⟨e.step.1, mStepGoal m (ps.map (·.law)) e⟩ e.step.2\n\ntheorem occ_false {i : Nat} {c : C} (h : (!occC i c) = true) : occC i c = false := by simpa using h\n\n-- A law reads the same at the skolem as it holds at every key.\ntheorem goalOf_holds (l : MLaw) {sk : Nat} (hs : occC sk l.holds = false) (ρ : Nat → Nat) (M : Nat → Nat → Nat) :\n    (∀ v, evalC (upd ρ sk v) M (goalOf l sk) = true) → l.Holds ρ M := by\n  intro h\n  unfold MLaw.Holds\n  unfold goalOf at h\n  split\n  · rename_i hk\n    simp only [hk] at h\n    have := h 0\n    rwa [congrC _ ρ M l.holds (fun i hi => by simp only [upd]; split <;> simp_all)] at this\n  · rename_i kv hk\n    simp only [hk] at h\n    intro v\n    have := h v\n    rw [subst_evalC] at this\n    rwa [congrC _ (upd ρ kv v) M l.holds (fun i hi => by\n      simp only [applyS, assoc, lookup, upd]\n      by_cases hik : i = kv\n      · subst hik; simp [evalE, upd]\n      · have hb : (kv == i) = false := by simp; omega\n        simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik]\n        split <;> simp_all)] at this\n\ntheorem pre_mreach {m : MMachine} (hp : avoids (m.inputs ++ m.init.map (·.1) ++ m.step.map (·.1)) m.pre = true)\n    (hr : readsC m.pre = false) : ∀ {ρ M}, MReach m ρ M → evalC ρ M m.pre = true := by\n  intro ρ M h\n  induction h with\n  | start ρ M _ h0 =>\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => applyS_other (fun h => hi (by simp [h])) ρ M)]; exact h0\n  | step ρ M ι _ _ ih =>\n    rw [noReadsC _ _ M m.pre hr]\n    rw [evalC_avoids hp M (ρ' := ρ) (fun i hi => by\n      rw [applyS_other (fun h => hi (by simp [h])), withInputs_other (fun h => hi (by simp [h]))])]; exact ih\n\n-- With a fresh skolem, σ commutes with setting it.\ntheorem applyS_upd {σ : List (Nat × E)} {sk : Nat} (hk : sk ∉ σ.map (·.1)) (he : σ.all (fun p => !occE sk p.2) = true)\n    (W : Nat → Nat) (M : Nat → Nat → Nat) (v : Nat) : applyS σ (upd W sk v) M = upd (applyS σ W M) sk v := by\n  funext i\n  simp only [upd]\n  by_cases hi : i = sk\n  · subst hi; rw [applyS_other hk]; simp [upd]\n  · simp only [hi, ite_false, applyS]\n    cases h : assoc σ i with\n    | none => simp [upd, hi]\n    | some e =>\n      simp only [assoc, Option.map_eq_some_iff] at h\n      obtain ⟨p, hp, rfl⟩ := h\n      have hm := (lookup_some hp).1\n      simp only [List.all_eq_true] at he\n      have := he p hm\n      exact congrE _ _ M p.2 (fun j hj => by simp only [upd]; split <;> simp_all)\n\n/-- The induction rule with maps: for params that meet the precondition and maps that start as declared, every law of\nan accepted proof holds in every reachable state (a law about every key, at every key). -/\ntheorem mmachine_sound (m : MMachine) (ps : List MEntry) (h : checkMMachine m ps = true) :\n    ∀ ρ M, MReach m ρ M → ∀ e ∈ ps, e.law.Holds ρ M := by\n  simp only [checkMMachine, List.all_eq_true, Bool.and_eq_true] at h\n  obtain ⟨⟨hpre, hrp⟩, h⟩ := h\n  simp only [Bool.not_eq_true'] at hrp\n  have hsk : ∀ e ∈ ps, _ := fun e he => (h e he).1.1.2\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 =>\n    intro e he\n    obtain ⟨⟨⟨_, hs⟩, hst⟩, _⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, _⟩, hslaw⟩, hsinit⟩, _⟩, _⟩ := hs\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ M (fun v => ?_)\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd ρ e.sk v) M\n    intro c hc\n    simp only [mStartGoal, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with rfl | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by simp only [upd]; split <;> simp_all)]; exact h0\n    · have hrd : ∀ mp k, evalE (upd ρ e.sk v) M (rdStart m mp k) = M mp (evalE (upd ρ e.sk v) M k) := by\n        intro mp k\n        simp only [rdStart]\n        split\n        · rename_i p hp\n          have ⟨hm, hq⟩ := lookup_some hp\n          simp only [beq_iff_eq] at hq\n          simp only [evalE]; rw [← hq, hM p hm]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M M hrd]\n      rw [applyS_upd (fun h => by simp [h] at hfresh) (by simpa [List.all_eq_true] using hsinit)]\n      simpa using hn\n  | step ρ M ι hr ha ih =>\n    intro e he\n    obtain ⟨⟨⟨hin, hs⟩, _⟩, hst⟩ := h e he\n    simp only [skOk, Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hs\n    obtain ⟨⟨⟨⟨⟨⟨hfresh, hspre⟩, hsas⟩, hslaw⟩, _⟩, hsstep⟩, hsw⟩ := hs\n    have hfresh' : e.sk ∉ m.inputs ∧ e.sk ∉ m.step.map (·.1) := by\n      constructor <;> intro hm <;> simp [hm] at hfresh\n    refine goalOf_holds e.law (by simpa using hslaw e.law (List.mem_map.mpr ⟨e, he, rfl⟩)) _ _ (fun v => ?_)\n    let W0 := withInputs m.inputs ρ ι\n    apply Decidable.byContradiction; intro hn\n    apply sound _ _ hst (upd W0 e.sk v) M\n    -- Reading a law about the state before the step, at the goal's environment.\n    have before : ∀ (l : MLaw), l ∈ ps.map (·.law) → ∀ (g : Nat → Nat), (∀ i, i ∉ m.inputs → i ≠ e.sk → g i = ρ i) →\n        avoids m.inputs l.holds = true → occC e.sk l.holds = false → ∀ c, c = l.holds → evalC g M c = evalC ρ M l.holds := by\n      intro l _ g hg hl hsl c hc; subst hc\n      exact congrC _ _ M l.holds (fun i hi => hg i (avoids_occ hl hi) (by intro h'; subst h'; simp [hsl] at hi))\n    intro c hc\n    simp only [mStepGoal, List.mem_append, List.mem_cons, List.mem_singleton, List.not_mem_nil, or_false] at hc\n    rcases hc with (((rfl | rfl) | hc) | hc) | rfl\n    · rw [congrC _ ρ M m.pre (fun i hi => by\n        simp only [upd, W0]\n        split\n        · rename_i h'; subst h'; simp [hspre] at hi\n        · exact withInputs_other (fun hm => avoids_occ hpre hi (by simp [hm])) ρ ι)]\n      exact pre_mreach hpre hrp hr\n    · rw [congrC _ W0 M m.assume (fun i hi => by simp only [upd]; split <;> simp_all)]; exact ha\n    · simp only [scalarHyps, List.mem_filterMap] at hc\n      obtain ⟨l, hl, hk⟩ := hc\n      split at hk\n      · rename_i hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl\n        have := ih e' he'\n        simp only [MLaw.Holds, hkey] at this\n        rw [before e'.law hl _ (fun i hi hs' => by simp only [upd, hs', ite_false, W0]; exact withInputs_other hi ρ ι)\n          (h e' he').1.1.1 (by simpa using hslaw e'.law hl) _ rfl]\n        exact this\n      · simp at hk\n    · simp only [instHyps, List.mem_filterMap] at hc\n      obtain ⟨p, _, hk⟩ := hc\n      split at hk\n      · rename_i l hl\n        split at hk\n        · rename_i kv hkey\n          simp only [Option.some.injEq] at hk; subst hk\n          have hlm : l ∈ ps.map (·.law) := List.mem_of_getElem? hl\n          obtain ⟨e', he', rfl⟩ := List.mem_map.mp hlm\n          have := ih e' he'\n          simp only [MLaw.Holds, hkey] at this\n          rw [subst_evalC]\n          have hsl : occC e.sk e'.law.holds = false := by simpa using hslaw e'.law hlm\n          rw [congrC _ (upd ρ kv (evalE (upd W0 e.sk v) M p.2)) M e'.law.holds (fun i hi => by\n            simp only [applyS, assoc, lookup, upd]\n            by_cases hik : i = kv\n            · subst hik; simp\n            · have hb : (kv == i) = false := by simp; omega\n              have hs' : i ≠ e.sk := by intro h'; subst h'; simp [hsl] at hi\n              simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik, hs', W0]\n              exact withInputs_other (avoids_occ (h e' he').1.1.1 hi) ρ ι)]\n          exact this _\n        · simp at hk\n      · simp at hk\n    · have hrd : ∀ mp k, evalE (upd W0 e.sk v) M (rdStep m mp k) = writeMaps m.writes W0 M mp (evalE (upd W0 e.sk v) M k) := by\n        intro mp k\n        simp only [rdStep, writeMaps]\n        split\n        · rename_i w hw\n          have hm := (lookup_some hw).1\n          have h1 := hsw w hm\n          try simp only [Bool.and_eq_true, Bool.not_eq_true'] at h1\n          have e1 : evalE (upd W0 e.sk v) M w.2.1 = evalE W0 M w.2.1 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          have e2 : evalE (upd W0 e.sk v) M w.2.2 = evalE W0 M w.2.2 :=\n            congrE _ _ M _ (fun j hj => by simp only [upd]; split <;> simp_all)\n          simp only [evalE, evalC, e1, e2]\n          by_cases hk : evalE (upd W0 e.sk v) M k = evalE W0 M w.2.1 <;> simp [hk]\n        · rfl\n      simp only [evalC, substR_evalC _ _ _ M _ hrd]\n      rw [applyS_upd hfresh'.2 (by simpa [List.all_eq_true] using hsstep)]\n      simpa using hn\n\nend Kern\n\n#print axioms Kern.sound\n#print axioms Kern.machine_sound\n#print axioms Kern.fold_sound\n#print axioms Kern.mmachine_sound\n",
+    "Cyclic.lean": "import Kernel\n\n/-!\nCyclic: one rule for every induction, proven sound. Lean 4.34.0, core only, on top of `Kernel.lean`.\n\nA cyclic proof is a list of nodes, each a sequent over the environment: its hypotheses imply its conclusion, for every\nenvironment and every maps that meet the facts. The facts are conditions that hold at every value of their keys (a\nfunction's equations: f(k + 1) = next(k, f(k)) at every k). A node's proof is one kernel goal, refuted by a tree: its\nhypotheses, facts at the terms it names, and what other nodes give where it uses them, against its conclusion. A use\nof node m reads m at a substitution σ of m's variables by terms over this node's frame, where a guard holds: it gives\nm's conclusion at σ, once m's hypotheses at σ follow (one goal each) and m's rank at σ is below this node's rank (one\ngoal, ranks compared in order). Uses may go to any node, the node itself included: the proof is a graph, its cycles\nthe inductions. Every back-edge lowers a rank of naturals compared in order, so every chain of uses is finite, and\n`cyclic_sound` is well-founded induction on the rank.\n\nNothing about machines, recurrences or trees is built in: those are instances, a node's variables standing for a step\ncounter, a recurrence's argument, a node of a table. The goals are built here, from the nodes, so nothing in\nkernel/cyclic.ts but its tree check is trusted beyond this file.\n-/\n\nnamespace Kern\n\n/-- A condition that holds at every value of its keys (the rest of the environment fixed). -/\nstructure Fact where\n  keys : List Nat\n  holds : C\n\n/-- A use of node `node` at `σ` where `guard` holds: a tree per hypothesis of that node (each at σ), and one for the\ndescent of its rank. -/\nstructure Use where\n  node : Nat\n  σ : List (Nat × E)\n  guard : C\n  premises : List (List VDef × Tree)\n  descent : List VDef × Tree\n\n/-- A node: hypotheses ⇒ conclusion, its rank (naturals compared in order), the facts it reads at terms\n(fact index, a term per key), the nodes it uses, and the tree of its own goal. -/\nstructure CNode where\n  hyps : List C\n  concl : C\n  rank : List E\n  insts : List (Nat × List E)\n  uses : List Use\n  main : List VDef × Tree\n\ndef falseC : C := .lt (.const 0) (.const 0)\n\n/-- `as` below `bs` in order: the first that differs is smaller. -/\ndef lexLtC : List E → List E → C\n  | a :: as, b :: bs => .or (.lt a b) (.and (.eq a b) (lexLtC as bs))\n  | _, _ => falseC\n\n/-- The same over values, for lists of one length. -/\ndef lexLt : List Nat → List Nat → Prop\n  | a :: as, b :: bs => as.length = bs.length ∧ (a < b ∨ (a = b ∧ lexLt as bs))\n  | _, _ => False\n\ndef override (keys : List Nat) (vals env : Nat → Nat) : Nat → Nat := fun i => if keys.contains i then vals i else env i\n\n/-- The facts hold: each at every value of its keys. -/\ndef FactsHold (facts : List Fact) (env : Nat → Nat) (maps : Nat → Nat → Nat) : Prop :=\n  ∀ f ∈ facts, ∀ vals : Nat → Nat, evalC (override f.keys vals env) maps f.holds = true\n\ndef cycInsts (facts : List Fact) (insts : List (Nat × List E)) : List C :=\n  insts.filterMap fun p => facts[p.1]?.map fun f => substC (f.keys.zip p.2) f.holds\n\n/-- A substitution leaves every fact's other variables alone. -/\ndef factsAvoid (facts : List Fact) (σ : List (Nat × E)) : Bool :=\n  σ.all fun p => facts.all fun f => f.keys.contains p.1 || !occC p.1 f.holds\n\ndef baseHyps (facts : List Fact) (n : CNode) : List C := n.hyps ++ cycInsts facts n.insts\ndef useHyps (nodes : List CNode) (us : List Use) : List C :=\n  us.filterMap fun u => nodes[u.node]?.map fun m => .or (.not u.guard) (substC u.σ m.concl)\ndef mainGoal (facts : List Fact) (nodes : List CNode) (n : CNode) : List C :=\n  baseHyps facts n ++ useHyps nodes n.uses ++ [.not n.concl]\ndef premiseGoal (facts : List Fact) (n : CNode) (u : Use) (c : C) : List C :=\n  baseHyps facts n ++ [u.guard, .not (substC u.σ c)]\ndef descentGoal (facts : List Fact) (n : CNode) (u : Use) (m : CNode) : List C :=\n  baseHyps facts n ++ [u.guard, .not (lexLtC (m.rank.map (substE u.σ)) n.rank)]\n\ndef checkUse (facts : List Fact) (nodes : List CNode) (n : CNode) (u : Use) : Bool :=\n  match nodes[u.node]? with\n  | none => false\n  | some m => m.rank.length == n.rank.length && factsAvoid facts u.σ && m.hyps.length == u.premises.length\n      && (m.hyps.zip u.premises).all (fun p => checkGoal ⟨p.2.1, premiseGoal facts n u p.1⟩ p.2.2)\n      && checkGoal ⟨u.descent.1, descentGoal facts n u m⟩ u.descent.2\n\ndef checkCyclic (facts : List Fact) (nodes : List CNode) : Bool :=\n  nodes.all fun n => checkGoal ⟨n.main.1, mainGoal facts nodes n⟩ n.main.2 && n.uses.all (checkUse facts nodes n)\n\nsection\nvariable {env : Nat → Nat} {maps : Nat → Nat → Nat}\n\ntheorem lexLtC_sound : ∀ (as bs : List E), as.length = bs.length → evalC env maps (lexLtC as bs) = true →\n    lexLt (as.map (evalE env maps)) (bs.map (evalE env maps))\n  | [], [], _, h => by simp [lexLtC, falseC, evalC, evalE] at h\n  | [], _ :: _, hl, _ => by simp at hl\n  | _ :: _, [], hl, _ => by simp at hl\n  | a :: as, b :: bs, hl, h => by\n    simp only [lexLtC, evalC, Bool.or_eq_true, Bool.and_eq_true, decide_eq_true_eq] at h\n    simp only [List.map_cons, lexLt, List.length_map]\n    refine ⟨by simpa using hl, ?_⟩\n    rcases h with h | ⟨h1, h2⟩\n    · exact Or.inl h\n    · exact Or.inr ⟨h1, lexLtC_sound as bs (by simpa using hl) h2⟩\n\ntheorem lex_acc_cons (n : Nat) (ihn : ∀ l : List Nat, l.length = n → Acc lexLt l) :\n    ∀ a (as : List Nat), as.length = n → Acc lexLt (a :: as) := by\n  intro a\n  refine (Nat.lt_wfRel.wf).induction (C := fun a => ∀ (as : List Nat), as.length = n → Acc lexLt (a :: as)) a ?_\n  intro a iha\n  · intro as has\n    have hacc := ihn as has\n    revert has\n    induction hacc with\n    | intro as _ ihas =>\n      intro has\n      constructor\n      intro w hw\n      cases w with\n      | nil => simp [lexLt] at hw\n      | cons c cs =>\n        simp only [lexLt] at hw\n        obtain ⟨hlen, hc⟩ := hw\n        rcases hc with hlt | ⟨rfl, hl⟩\n        · exact iha c hlt cs (by omega)\n        · exact ihas cs hl (by omega)\n\ntheorem lex_acc : ∀ n (l : List Nat), l.length = n → Acc lexLt l\n  | 0, l, h => by\n    cases l with\n    | nil => exact ⟨_, fun w hw => by cases w <;> simp [lexLt] at hw⟩\n    | cons _ _ => simp at h\n  | n + 1, l, h => by\n    cases l with\n    | nil => simp at h\n    | cons a as => exact lex_acc_cons n (lex_acc n) a as (by simpa using h)\n\ntheorem lexLt_wf : WellFounded lexLt := ⟨fun l => lex_acc l.length l rfl⟩\n\ntheorem cyc_zip_cover {α β : Type} : ∀ (as : List α) (bs : List β), as.length = bs.length → ∀ a ∈ as, ∃ b, (a, b) ∈ as.zip bs\n  | [], _, _, a, ha => by simp at ha\n  | _ :: _, [], h, _, _ => by simp at h\n  | a :: as, b :: bs, h, x, hx => by\n    simp only [List.mem_cons] at hx\n    simp only [List.zip_cons_cons, List.mem_cons]\n    rcases hx with rfl | hx\n    · exact ⟨b, Or.inl rfl⟩\n    · obtain ⟨b', hb'⟩ := cyc_zip_cover as bs (by simpa using h) x hx\n      exact ⟨b', Or.inr hb'⟩\n\ntheorem zip_keys {keys : List Nat} {ts : List E} {i : Nat} (h : i ∈ (keys.zip ts).map (·.1)) : i ∈ keys := by\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp h\n  exact (List.of_mem_zip hp).1\n\ntheorem inst_holds {facts : List Fact} (hF : FactsHold facts env maps) (insts : List (Nat × List E)) :\n    ∀ c ∈ cycInsts facts insts, evalC env maps c = true := by\n  intro c hc\n  simp only [cycInsts, List.mem_filterMap, Option.map_eq_some_iff] at hc\n  obtain ⟨p, _, f, hf, rfl⟩ := hc\n  rw [subst_evalC]\n  have he : applyS (f.keys.zip p.2) env maps = override f.keys (applyS (f.keys.zip p.2) env maps) env := by\n    funext i\n    simp only [override]\n    split\n    · rfl\n    · rename_i hi\n      exact applyS_other (fun h => hi (List.contains_iff_mem.mpr (zip_keys h))) env maps\n  rw [he]\n  exact hF f (List.mem_of_getElem? hf) _\n\ntheorem facts_after {facts : List Fact} {σ : List (Nat × E)} (hA : factsAvoid facts σ = true)\n    (hF : FactsHold facts env maps) : FactsHold facts (applyS σ env maps) maps := by\n  intro f hf vals\n  rw [congrC (override f.keys vals (applyS σ env maps)) (override f.keys vals env) maps f.holds ?_]\n  · exact hF f hf vals\n  · intro i hi\n    simp only [override]\n    split\n    · rfl\n    · rename_i hk\n      cases ha : assoc σ i with\n      | none => simp only [applyS, ha]\n      | some e =>\n        exfalso\n        obtain ⟨p, hp, rfl⟩ := List.mem_map.mp (assoc_mem ha)\n        simp only [factsAvoid, List.all_eq_true, Bool.or_eq_true, Bool.not_eq_true'] at hA\n        rcases hA p hp f hf with h | h\n        · exact hk h\n        · simp [h] at hi\n\ntheorem cyc_base {facts : List Fact} {n : CNode} (hF : FactsHold facts env maps)\n    (hH : ∀ c ∈ n.hyps, evalC env maps c = true) : ∀ c ∈ baseHyps facts n, evalC env maps c = true := by\n  intro c hc\n  simp only [baseHyps, List.mem_append] at hc\n  rcases hc with hc | hc\n  · exact hH c hc\n  · exact inst_holds hF n.insts c hc\nend\n\n/-- Every node of an accepted cyclic proof holds: for any maps, at every environment that meets the facts and the\nnode's hypotheses, its conclusion holds. -/\ntheorem cyclic_sound (facts : List Fact) (nodes : List CNode) (h : checkCyclic facts nodes = true) (maps : Nat → Nat → Nat) :\n    ∀ env, FactsHold facts env maps → ∀ n ∈ nodes, (∀ c ∈ n.hyps, evalC env maps c = true) → evalC env maps n.concl = true := by\n  have key : ∀ v : List Nat, ∀ n ∈ nodes, ∀ env, n.rank.map (evalE env maps) = v → FactsHold facts env maps →\n      (∀ c ∈ n.hyps, evalC env maps c = true) → evalC env maps n.concl = true := by\n    intro v\n    refine lexLt_wf.induction (C := fun v => ∀ n ∈ nodes, ∀ env, n.rank.map (evalE env maps) = v → FactsHold facts env maps →\n      (∀ c ∈ n.hyps, evalC env maps c = true) → evalC env maps n.concl = true) v ?_\n    intro v ih n hn env hv hF hH\n    have hc := (List.all_eq_true.mp h) n hn\n    simp only [Bool.and_eq_true] at hc\n    obtain ⟨hmain, huses⟩ := hc\n    have hbase := cyc_base hF hH\n    have huse : ∀ c ∈ useHyps nodes n.uses, evalC env maps c = true := by\n      intro c hc\n      simp only [useHyps, List.mem_filterMap, Option.map_eq_some_iff] at hc\n      obtain ⟨u, hu, m, hm, rfl⟩ := hc\n      have hcu := (List.all_eq_true.mp huses) u hu\n      simp only [checkUse, hm, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hcu\n      obtain ⟨⟨⟨⟨hlen, hav⟩, hpl⟩, hprem⟩, hdesc⟩ := hcu\n      simp only [evalC, Bool.or_eq_true, Bool.not_eq_true']\n      by_cases hg : evalC env maps u.guard = true\n      · right\n        rw [subst_evalC]\n        have hprem' : ∀ c ∈ m.hyps, evalC (applyS u.σ env maps) maps c = true := by\n          intro c hc\n          obtain ⟨p, hp⟩ := cyc_zip_cover m.hyps u.premises hpl c hc\n          have hs := sound ⟨p.1, premiseGoal facts n u c⟩ p.2 (hprem (c, p) hp) env maps\n          rw [← subst_evalC]\n          apply Decidable.byContradiction\n          intro hf\n          apply hs\n          intro c' hc'\n          simp only [premiseGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc'\n          rcases hc' with hc' | rfl | rfl\n          · exact hbase c' hc'\n          · exact hg\n          · simp only [evalC, Bool.not_eq_true']; simpa using hf\n        have hdl : evalC env maps (lexLtC (m.rank.map (substE u.σ)) n.rank) = true := by\n          have hs := sound ⟨u.descent.1, descentGoal facts n u m⟩ u.descent.2 hdesc env maps\n          apply Decidable.byContradiction\n          intro hf\n          apply hs\n          intro c' hc'\n          simp only [descentGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc'\n          rcases hc' with hc' | rfl | rfl\n          · exact hbase c' hc'\n          · exact hg\n          · simp only [evalC, Bool.not_eq_true']; simpa using hf\n        have hlx := lexLtC_sound (env := env) (maps := maps) _ _ (by simpa using hlen) hdl\n        have hrank : (m.rank.map (substE u.σ)).map (evalE env maps) = m.rank.map (evalE (applyS u.σ env maps) maps) := by\n          simp only [List.map_map]\n          exact List.map_congr_left (fun e _ => by simp [Function.comp, subst_evalE])\n        rw [hrank, hv] at hlx\n        exact ih _ hlx m (List.mem_of_getElem? hm) (applyS u.σ env maps) rfl (facts_after hav hF) hprem'\n      · left\n        simpa using hg\n    have hs := sound ⟨n.main.1, mainGoal facts nodes n⟩ n.main.2 hmain env maps\n    apply Decidable.byContradiction\n    intro hf\n    apply hs\n    intro c hc\n    simp only [mainGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n    rcases hc with (hc | hc) | rfl\n    · exact hbase c hc\n    · exact huse c hc\n    · simp only [evalC, Bool.not_eq_true']; simpa using hf\n  intro env hF n hn hH\n  exact key _ n hn env rfl hF hH\n\nend Kern\n",
     "Progress.lean": "import Kernel\n/-!\nProgress: flags and \"some request makes this happen\", the two parts of kernel.ts that Kernel.lean left to TypeScript.\n\nFlags. A step may name conditions (kernel.ts's `step.flags`), decided once per step from the request and the state\nbefore it. Step terms read flag f as `.eq (.var f) (.const 1)`; the flag's variable holds 1 when its condition holds\nand 0 when it doesn't (`decideFlags`). The exporter passes flags through untouched: Lean inlines them itself (`inlineC`\nturns each `.eq (.var f) (.const 1)` into the condition, `inlineE` any other read of f into `ite cond 1 0`, exactly what\nkernel.ts's goal builder does) and proves inlining keeps the meaning (`inline_evalE`, `inline_evalC`). A machine with\nflags reaches, outside its flag variables, exactly the states its inlined machine reaches (`freach_plain`,\n`fmreach_plain`), so the induction rules of Kernel.lean carry over (`fmachine_sound`, `fmmachine_sound`).\n\nProgress. \"In every reachable state where `when` holds, some request makes `then` true of its step\": the request is\nnamed (a term per input over the state and params), and Lean builds kernel.ts's two goals itself: the request is allowed\n(the machine's assumption holds of it), and the step it causes makes `then` hold. `then` reads the state before the step\nby plain names and after it by primed names (`prime`, `primeMaps`). `progress_sound`: for every reachable state where\n`when` holds, the named request is a step the machine allows, and `then` holds of it.\n-/\nnamespace Kern\nopen Cert\n\n/-! Flags -/\n\ndef flagOf (fl : List (Nat × C)) (i : Nat) : Option C := (lookup (fun p => p.1 == i) fl).map (·.2)\ndef flagSub (fl : List (Nat × C)) : List (Nat × E) := fl.map fun p => (p.1, .ite p.2 (.const 1) (.const 0))\ndef flagVars (fl : List (Nat × C)) : List Nat := fl.map (·.1)\n-- The state with every flag decided: flag f holds 1 when its condition holds before the step, else 0.\ndef decideFlags (fl : List (Nat × C)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) : Nat → Nat := applyS (flagSub fl) ρ maps\n\n-- A read of flag f as a condition becomes the condition itself.\ndef eqOrFlag (fl : List (Nat × C)) (a b a' b' : E) : C :=\n  match a, b with\n  | .var i, .const 1 => match flagOf fl i with\n    | some c => c\n    | none => .eq a' b'\n  | _, _ => .eq a' b'\n\nmutual\ndef inlineE (fl : List (Nat × C)) : E → E\n  | .var i => match flagOf fl i with\n    | some c => .ite c (.const 1) (.const 0)\n    | none => .var i\n  | .const n => .const n\n  | .add a b => .add (inlineE fl a) (inlineE fl b)\n  | .sub a b => .sub (inlineE fl a) (inlineE fl b)\n  | .mul k a => .mul k (inlineE fl a)\n  | .min a b => .min (inlineE fl a) (inlineE fl b)\n  | .max a b => .max (inlineE fl a) (inlineE fl b)\n  | .prod a b => .prod (inlineE fl a) (inlineE fl b)\n  | .ite c t f => .ite (inlineC fl c) (inlineE fl t) (inlineE fl f)\n  | .get m key => .get m (inlineE fl key)\ndef inlineC (fl : List (Nat × C)) : C → C\n  | .le a b => .le (inlineE fl a) (inlineE fl b)\n  | .lt a b => .lt (inlineE fl a) (inlineE fl b)\n  | .eq a b => eqOrFlag fl a b (inlineE fl a) (inlineE fl b)\n  | .and a b => .and (inlineC fl a) (inlineC fl b)\n  | .or a b => .or (inlineC fl a) (inlineC fl b)\n  | .not a => .not (inlineC fl a)\nend\n\ntheorem lookup_map_same {α : Type} (p : α → Bool) (g : α → α) (hg : ∀ a, p (g a) = p a) :\n    ∀ l : List α, lookup p (l.map g) = (lookup p l).map g\n  | [] => rfl\n  | a :: as => by\n    simp only [List.map_cons, lookup, hg]\n    split <;> simp [lookup_map_same p g hg as]\n\ntheorem lookup_map_pred {α β : Type} (p : β → Bool) (g : α → β) :\n    ∀ l : List α, lookup p (l.map g) = (lookup (fun a => p (g a)) l).map g\n  | [] => rfl\n  | a :: as => by\n    simp only [List.map_cons, lookup]\n    split <;> simp [lookup_map_pred p g as]\n\ntheorem lookup_map_fst {β γ : Type} (i : Nat) (g : β → γ) :\n    ∀ l : List (Nat × β), lookup (fun q => q.1 == i) (l.map fun q => (q.1, g q.2)) = (lookup (fun q => q.1 == i) l).map fun q => (q.1, g q.2)\n  | [] => rfl\n  | a :: as => by\n    simp only [List.map_cons, lookup]\n    split <;> simp [lookup_map_fst i g as]\n\ntheorem assoc_flagSub (fl : List (Nat × C)) (i : Nat) :\n    assoc (flagSub fl) i = (flagOf fl i).map (fun c => .ite c (.const 1) (.const 0)) := by\n  simp only [assoc, flagSub, flagOf, lookup_map_pred, Option.map_map]; rfl\n\ntheorem assoc_map_snd (σ : List (Nat × E)) (g : E → E) (i : Nat) :\n    assoc (σ.map fun p => (p.1, g p.2)) i = (assoc σ i).map g := by\n  simp only [assoc, lookup_map_pred, Option.map_map]; rfl\n\nmutual\ntheorem inline_evalE (fl : List (Nat × C)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (e : E) → evalE ρ maps (inlineE fl e) = evalE (decideFlags fl ρ maps) maps e\n  | .var i => by\n    cases h : flagOf fl i <;> simp [inlineE, h, evalE, decideFlags, applyS, assoc_flagSub]\n  | .const n => by simp [inlineE, evalE]\n  | .add a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .sub a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .mul k a => by simp [inlineE, evalE, inline_evalE fl ρ maps a]\n  | .min a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .max a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .prod a b => by simp [inlineE, evalE, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .ite c t f => by simp [inlineE, evalE, inline_evalC fl ρ maps c, inline_evalE fl ρ maps t, inline_evalE fl ρ maps f]\n  | .get m key => by simp [inlineE, evalE, inline_evalE fl ρ maps key]\ntheorem inline_evalC (fl : List (Nat × C)) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    (c : C) → evalC ρ maps (inlineC fl c) = evalC (decideFlags fl ρ maps) maps c\n  | .le a b => by simp [inlineC, evalC, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .lt a b => by simp [inlineC, evalC, inline_evalE fl ρ maps a, inline_evalE fl ρ maps b]\n  | .eq a b => by\n    have ha := inline_evalE fl ρ maps a\n    have hb := inline_evalE fl ρ maps b\n    simp only [inlineC, eqOrFlag]\n    split\n    · rename_i i\n      cases h : flagOf fl i with\n      | none => simp only [evalC, ha, hb]\n      | some c =>\n        simp only [evalC, evalE, decideFlags, applyS, assoc_flagSub, h, Option.map_some]\n        cases evalC ρ maps c <;> simp\n    · simp only [evalC, ha, hb]\n  | .and a b => by simp [inlineC, evalC, inline_evalC fl ρ maps a, inline_evalC fl ρ maps b]\n  | .or a b => by simp [inlineC, evalC, inline_evalC fl ρ maps a, inline_evalC fl ρ maps b]\n  | .not a => by simp [inlineC, evalC, inline_evalC fl ρ maps a]\nend\n\n-- Flag conditions read the request and the state, never a flag.\ndef flagsOk (fl : List (Nat × C)) : Bool := fl.all fun p => avoids (flagVars fl) p.2\n\n-- A term that reads none of these variables.\ndef avoidsE (vs : List Nat) (e : E) : Bool := vs.all fun i => !occE i e\n\ntheorem avoidsE_occ {vs : List Nat} {e : E} (h : avoidsE vs e = true) {i : Nat} (hi : occE i e = true) : i ∉ vs := by\n  intro hm\n  simp only [avoidsE, List.all_eq_true] at h\n  have := h i hm; simp [hi] at this\n\n-- Two states that agree outside some variables.\ndef Agree (vs : List Nat) (ρ ρ' : Nat → Nat) : Prop := ∀ i, i ∉ vs → ρ i = ρ' i\n\ntheorem flagOf_none {fl : List (Nat × C)} {i : Nat} (h : flagOf fl i = none) : i ∉ flagVars fl := by\n  intro hm\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hm\n  simp only [flagOf, Option.map_eq_none_iff] at h\n  have := lookup_none_all h p hp\n  simp at this\n\ntheorem flagOf_some {fl : List (Nat × C)} {i : Nat} {c : C} (h : flagOf fl i = some c) : ∃ p ∈ fl, p.2 = c := by\n  simp only [flagOf, Option.map_eq_some_iff] at h\n  obtain ⟨p, hp, rfl⟩ := h\n  exact ⟨p, (lookup_some hp).1, rfl⟩\n\ntheorem decide_other {fl : List (Nat × C)} {i : Nat} (hi : i ∉ flagVars fl) (ρ : Nat → Nat) (maps : Nat → Nat → Nat) :\n    decideFlags fl ρ maps i = ρ i :=\n  applyS_other (by simpa [flagSub, flagVars] using hi) ρ maps\n\n-- States that agree outside the flags decide the flags alike, so they agree everywhere once the flags are decided.\ntheorem decide_agree {fl : List (Nat × C)} (hf : flagsOk fl = true) {X X' : Nat → Nat} (maps : Nat → Nat → Nat)\n    (h : Agree (flagVars fl) X X') : decideFlags fl X maps = decideFlags fl X' maps := by\n  funext i\n  simp only [decideFlags, applyS, assoc_flagSub]\n  cases hc : flagOf fl i with\n  | none => exact h i (flagOf_none hc)\n  | some c =>\n    obtain ⟨p, hp, rfl⟩ := flagOf_some hc\n    simp only [flagsOk, List.all_eq_true] at hf\n    have hav := hf p hp\n    simp only [Option.map_some, evalE]\n    rw [congrC X X' maps p.2 (fun j hj => h j (avoids_occ hav hj))]\n\ntheorem withInputs_agree {vs ins : List Nat} {ρ ρ' : Nat → Nat} (h : Agree vs ρ ρ') (ι : Nat → Nat) :\n    Agree vs (withInputs ins ρ ι) (withInputs ins ρ' ι) := by\n  intro i hi; simp only [withInputs]; split\n  · rfl\n  · exact h i hi\n\n/-! Scalar machines with flags -/\n\nstructure FMachine where\n  m : Machine                 -- step terms and the assumption may read flags\n  flags : List (Nat × C)      -- each flag's variable and its condition\n\ndef FMachine.plain (f : FMachine) : Machine :=\n  { f.m with step := f.m.step.map (fun p => (p.1, inlineE f.flags p.2)), assume := inlineC f.flags f.m.assume }\n\ninductive FReach (f : FMachine) (maps : Nat → Nat → Nat) : (Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) : evalC ρ maps f.m.pre = true → FReach f maps (applyS f.m.init ρ maps)\n  | step (ρ ι : Nat → Nat) : FReach f maps ρ →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) maps) maps f.m.assume = true →\n      FReach f maps (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) maps) maps)\n\ndef checkFMachine (f : FMachine) (ps : MachineProof) : Bool :=\n  flagsOk f.flags && ps.all (fun p => avoids (flagVars f.flags) p.1) && checkMachine f.plain ps\n\ntheorem freach_plain (f : FMachine) (hf : flagsOk f.flags = true) (maps : Nat → Nat → Nat) :\n    ∀ {ρ}, FReach f maps ρ → ∃ ρ₀, Reach f.plain maps ρ₀ ∧ Agree (flagVars f.flags) ρ ρ₀ := by\n  intro ρ hr\n  induction hr with\n  | start ρ h0 => exact ⟨_, Reach.start (m := f.plain) ρ h0, fun _ _ => rfl⟩\n  | step ρ ι _ ha ih =>\n    obtain ⟨ρ₀, hr₀, hag⟩ := ih\n    have hdec := decide_agree hf maps (withInputs_agree (ins := f.m.inputs) hag ι)\n    refine ⟨_, Reach.step (m := f.plain) ρ₀ ι hr₀ ?_, ?_⟩\n    · show evalC (withInputs f.m.inputs ρ₀ ι) maps (inlineC f.flags f.m.assume) = true\n      rw [inline_evalC, ← hdec]; exact ha\n    · intro i hi\n      show _ = applyS (f.m.step.map (fun p => (p.1, inlineE f.flags p.2))) (withInputs f.m.inputs ρ₀ ι) maps i\n      simp only [applyS, assoc_map_snd]\n      cases h : assoc f.m.step i with\n      | none =>\n        simp only [Option.map_none]\n        rw [decide_other hi]; exact withInputs_agree (ins := f.m.inputs) hag ι i hi\n      | some e => simp only [Option.map_some, inline_evalE, hdec]\n\n/-- Flags inlined by Lean: every law of an accepted proof of the inlined machine, none reading a flag, holds in every\nstate the machine with flags reaches. -/\ntheorem fmachine_sound (f : FMachine) (ps : MachineProof) (h : checkFMachine f ps = true) (maps : Nat → Nat → Nat) :\n    ∀ ρ, FReach f maps ρ → ∀ l ∈ ps.map (·.1), evalC ρ maps l = true := by\n  simp only [checkFMachine, Bool.and_eq_true, List.all_eq_true] at h\n  obtain ⟨⟨hf, hl⟩, hc⟩ := h\n  intro ρ hr l hlm\n  obtain ⟨ρ₀, hr₀, hag⟩ := freach_plain f hf maps hr\n  obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hlm\n  rw [congrC ρ ρ₀ maps p.1 (fun j hj => hag j (avoids_occ (hl p hp) hj))]\n  exact machine_sound f.plain ps hc maps ρ₀ hr₀ p.1 hlm\n\n/-! Machines with maps and flags -/\n\nstructure FMMachine where\n  m : MMachine\n  flags : List (Nat × C)\n\ndef inlineW (fl : List (Nat × C)) (ws : List (Nat × E × E)) : List (Nat × E × E) :=\n  ws.map fun w => (w.1, inlineE fl w.2.1, inlineE fl w.2.2)\n\ndef FMMachine.plain (f : FMMachine) : MMachine :=\n  { f.m with\n    step := f.m.step.map (fun p => (p.1, inlineE f.flags p.2))\n    writes := inlineW f.flags f.m.writes\n    assume := inlineC f.flags f.m.assume }\n\ninductive FMReach (f : FMMachine) : (Nat → Nat) → (Nat → Nat → Nat) → Prop\n  | start (ρ : Nat → Nat) (M : Nat → Nat → Nat) : StartMaps f.m M → evalC ρ M f.m.pre = true → FMReach f (applyS f.m.init ρ M) M\n  | step (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : FMReach f ρ M →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true →\n      FMReach f (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M)\n        (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M)\n\ndef checkFMMachine (f : FMMachine) (ps : List MEntry) : Bool :=\n  flagsOk f.flags && avoids (flagVars f.flags) f.m.pre && ps.all (fun e => avoids (flagVars f.flags) e.law.holds)\n    && checkMMachine f.plain ps\n\ntheorem writeMaps_inline (fl : List (Nat × C)) (ws : List (Nat × E × E)) (X : Nat → Nat) (M : Nat → Nat → Nat) :\n    writeMaps (inlineW fl ws) X M = writeMaps ws (decideFlags fl X M) M := by\n  funext mp key\n  simp only [writeMaps, inlineW, lookup_map_pred]\n  cases lookup (fun w : Nat × E × E => w.1 == mp) ws with\n  | none => rfl\n  | some w => simp only [Option.map_some, inline_evalE]\n\ntheorem fmreach_plain (f : FMMachine) (hf : flagsOk f.flags = true) :\n    ∀ {ρ M}, FMReach f ρ M → ∃ ρ₀, MReach f.plain ρ₀ M ∧ Agree (flagVars f.flags) ρ ρ₀ := by\n  intro ρ M hr\n  induction hr with\n  | start ρ M hM h0 => exact ⟨_, MReach.start (m := f.plain) ρ M hM h0, fun _ _ => rfl⟩\n  | step ρ M ι _ ha ih =>\n    obtain ⟨ρ₀, hr₀, hag⟩ := ih\n    have hdec := decide_agree hf M (withInputs_agree (ins := f.m.inputs) hag ι)\n    have hstep := MReach.step (m := f.plain) ρ₀ M ι hr₀ (by\n      show evalC (withInputs f.m.inputs ρ₀ ι) M (inlineC f.flags f.m.assume) = true\n      rw [inline_evalC, ← hdec]; exact ha)\n    have hw : writeMaps f.plain.writes (withInputs f.plain.inputs ρ₀ ι) M\n        = writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M := by\n      show writeMaps (inlineW f.flags f.m.writes) (withInputs f.m.inputs ρ₀ ι) M = _\n      rw [writeMaps_inline, ← hdec]\n    rw [hw] at hstep\n    refine ⟨_, hstep, ?_⟩\n    intro i hi\n    show _ = applyS (f.m.step.map (fun p => (p.1, inlineE f.flags p.2))) (withInputs f.m.inputs ρ₀ ι) M i\n    simp only [applyS, assoc_map_snd]\n    cases h : assoc f.m.step i with\n    | none =>\n      simp only [Option.map_none]\n      rw [decide_other hi]; exact withInputs_agree (ins := f.m.inputs) hag ι i hi\n    | some e => simp only [Option.map_some, inline_evalE, hdec]\n\n-- A law that reads no flag holds alike in states that agree outside the flags.\ntheorem holds_agree {vs : List Nat} (l : MLaw) (hav : avoids vs l.holds = true) {ρ ρ₀ : Nat → Nat} (hag : Agree vs ρ ρ₀)\n    (M : Nat → Nat → Nat) : l.Holds ρ₀ M → l.Holds ρ M := by\n  unfold MLaw.Holds\n  split\n  · intro h; rwa [congrC ρ ρ₀ M l.holds (fun j hj => hag j (avoids_occ hav hj))]\n  · rename_i kv _\n    intro h v\n    rw [congrC (upd ρ kv v) (upd ρ₀ kv v) M l.holds (fun j hj => by\n      simp only [upd]; split\n      · rfl\n      · exact hag j (avoids_occ hav hj))]\n    exact h v\n\n/-- Flags inlined by Lean, with maps: every law of an accepted proof of the inlined machine holds in every state the\nmachine with flags reaches. -/\ntheorem fmmachine_sound (f : FMMachine) (ps : List MEntry) (h : checkFMMachine f ps = true) :\n    ∀ ρ M, FMReach f ρ M → ∀ e ∈ ps, e.law.Holds ρ M := by\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at h\n  obtain ⟨⟨⟨hf, _⟩, hl⟩, hc⟩ := h\n  intro ρ M hr e he\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  exact holds_agree e.law (hl e he) hag M (mmachine_sound f.plain ps hc ρ₀ M hr₀ e he)\n\n/-! Progress -/\n\nstructure Progress where\n  when : C\n  then_ : C\n  req : List (Nat × E)          -- the request: an input and its term over the state and params\n  prime : List (Nat × Nat)      -- a state variable, and the name `then` reads its value after the step by\n  primeMaps : List (Nat × Nat)  -- a map, and the name `then` reads it after the step by\n  insts : List (Nat × E)        -- (law index, key): where the goals assume the laws about every key\n  allowed : List VDef × Tree\n  causes : List VDef × Tree\n\n-- A term of the step, at the named request: flags inlined, then the request's terms for the inputs.\ndef nowE (f : FMMachine) (pp : Progress) (e : E) : E := substE pp.req (inlineE f.flags e)\n-- What a state variable is after the step: its step term, or itself.\ndef stepTerm (f : FMMachine) (v : Nat) : E :=\n  match assoc f.m.step v with\n  | some e => e\n  | none => .var v\ndef primeSub (f : FMMachine) (pp : Progress) : List (Nat × E) := pp.prime.map fun q => (q.2, nowE f pp (stepTerm f q.1))\n-- A read of a primed map is the map after the step's write (read-over-write); any other read is the map before.\ndef rdAfter (f : FMMachine) (pp : Progress) : Nat → E → E := fun mp k =>\n  match lookup (fun q => q.2 == mp) pp.primeMaps with\n  | some q => match lookup (fun w => w.1 == q.1) f.m.writes with\n    | some w => .ite (.eq k (nowE f pp w.2.1)) (nowE f pp w.2.2) (.get q.1 k)\n    | none => .get q.1 k\n  | none => .get mp k\n\ndef progressBefore (f : FMMachine) (laws : List MLaw) (pp : Progress) : List C :=\n  [f.m.pre] ++ scalarHyps laws ++ instHyps laws pp.insts ++ [pp.when]\ndef allowedGoal (f : FMMachine) (laws : List MLaw) (pp : Progress) : List C :=\n  progressBefore f laws pp ++ [.not (substC pp.req (inlineC f.flags f.m.assume))]\ndef causesGoal (f : FMMachine) (laws : List MLaw) (pp : Progress) : List C :=\n  progressBefore f laws pp ++ [.not (substRC (pp.req ++ primeSub f pp) (rdAfter f pp) pp.then_)]\n\n-- The request names only inputs, no primed name is an input, and `then` reads no flag.\ndef checkProgress (f : FMMachine) (ps : List MEntry) (pp : Progress) : Bool :=\n  pp.req.all (fun p => f.m.inputs.contains p.1) && pp.prime.all (fun q => !f.m.inputs.contains q.2)\n    && avoids (flagVars f.flags) pp.then_\n    && checkGoal ⟨pp.allowed.1, allowedGoal f (ps.map (·.law)) pp⟩ pp.allowed.2\n    && checkGoal ⟨pp.causes.1, causesGoal f (ps.map (·.law)) pp⟩ pp.causes.2\n\n-- What `then` reads: primed names after the step, the rest before it (with the request's inputs).\ndef primed (prime : List (Nat × Nat)) (after before : Nat → Nat) : Nat → Nat := fun i =>\n  match lookup (fun q => q.2 == i) prime with\n  | some q => after q.1\n  | none => before i\ndef primedMaps (pm : List (Nat × Nat)) (after before : Nat → Nat → Nat) : Nat → Nat → Nat := fun mp =>\n  match lookup (fun q => q.2 == mp) pm with\n  | some q => after q.1\n  | none => before mp\n\ntheorem lookup_append {α : Type} (p : α → Bool) : ∀ (l1 l2 : List α),\n    lookup p (l1 ++ l2) = match lookup p l1 with | some a => some a | none => lookup p l2\n  | [], _ => rfl\n  | a :: as, l2 => by simp only [List.cons_append, lookup]; split <;> simp [lookup_append p as l2]\n\ntheorem assoc_none_of {σ : List (Nat × E)} {i : Nat} (h : i ∉ σ.map (·.1)) : assoc σ i = none := by\n  cases ha : assoc σ i with\n  | none => rfl\n  | some e => exact absurd (assoc_mem ha) h\n\n-- Every hypothesis before the request holds at a reachable state where `when` holds.\ntheorem before_true (f : FMMachine) (ps : List MEntry) (pp : Progress) (ρ : Nat → Nat) (M : Nat → Nat → Nat)\n    (hpre : evalC ρ M f.m.pre = true) (hlaws : ∀ e ∈ ps, e.law.Holds ρ M) (hw : evalC ρ M pp.when = true) :\n    ∀ c ∈ progressBefore f (ps.map (·.law)) pp, evalC ρ M c = true := by\n  intro c hc\n  simp only [progressBefore, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with ((rfl | hc) | hc) | rfl\n  · exact hpre\n  · simp only [scalarHyps, List.mem_filterMap] at hc\n    obtain ⟨l, hl, hk⟩ := hc\n    split at hk\n    · rename_i hkey\n      simp only [Option.some.injEq] at hk; subst hk\n      obtain ⟨e', he', rfl⟩ := List.mem_map.mp hl\n      have := hlaws e' he'\n      simpa [MLaw.Holds, hkey] using this\n    · simp at hk\n  · simp only [instHyps, List.mem_filterMap] at hc\n    obtain ⟨p, _, hk⟩ := hc\n    split at hk\n    · rename_i l hl\n      split at hk\n      · rename_i kv hkey\n        simp only [Option.some.injEq] at hk; subst hk\n        have hlm : l ∈ ps.map (·.law) := List.mem_of_getElem? hl\n        obtain ⟨e', he', rfl⟩ := List.mem_map.mp hlm\n        have := hlaws e' he'\n        simp only [MLaw.Holds, hkey] at this\n        rw [subst_evalC]\n        rw [congrC _ (upd ρ kv (evalE ρ M p.2)) M e'.law.holds (fun i _ => by\n          simp only [applyS, assoc, lookup, upd]\n          by_cases hik : i = kv\n          · subst hik; simp\n          · have hb : (kv == i) = false := by simp; omega\n            simp only [hb, Bool.false_eq_true, ite_false, Option.map_none, hik])]\n        exact this _\n      · simp at hk\n    · simp at hk\n  · exact hw\n\n/-- Progress: in every reachable state where `when` holds, the named request (its inputs ι, the rest of the state as it\nis) is a step the machine allows, and `then` holds of that step: primed names read the state and maps after it, plain\nnames the state before it with the request's inputs. -/\ndef ProgressHolds (f : FMMachine) (pp : Progress) : Prop :=\n    ∀ ρ M, FMReach f ρ M → evalC ρ M pp.when = true →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M f.m.assume = true ∧\n      evalC (primed pp.prime (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M)\n          (withInputs f.m.inputs ρ (applyS pp.req ρ M)))\n        (primedMaps pp.primeMaps (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M) M)\n        pp.then_ = true\n\ntheorem progress_sound (f : FMMachine) (ps : List MEntry) (pp : Progress)\n    (hl : checkFMMachine f ps = true) (hp : checkProgress f ps pp = true) : ProgressHolds f pp := by\n  unfold ProgressHolds\n  revert hl hp\n  intro hl hp\n  show ∀ ρ M, FMReach f ρ M → evalC ρ M pp.when = true →\n      evalC (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M f.m.assume = true ∧\n      evalC (primed pp.prime (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M)\n          (withInputs f.m.inputs ρ (applyS pp.req ρ M)))\n        (primedMaps pp.primeMaps (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M) M)\n        pp.then_ = true\n  have hl0 := hl\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at hl\n  obtain ⟨⟨⟨hf, hpref⟩, hlf⟩, hc⟩ := hl\n  simp only [checkProgress, Bool.and_eq_true, List.all_eq_true] at hp\n  obtain ⟨⟨⟨⟨hreq, hprime⟩, _⟩, hal⟩, hca⟩ := hp\n  intro ρ M hr hw\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  -- The laws and the precondition hold here.\n  have hlaws : ∀ e ∈ ps, e.law.Holds ρ M := fmmachine_sound f ps hl0 ρ M hr\n  have hcm := hc\n  simp only [checkMMachine, Bool.and_eq_true] at hcm\n  obtain ⟨⟨hpa, hpr⟩, _⟩ := hcm\n  simp only [Bool.not_eq_true'] at hpr\n  have hpre : evalC ρ M f.m.pre = true := by\n    rw [congrC ρ ρ₀ M f.m.pre (fun j hj => hag j (avoids_occ hpref hj))]\n    exact pre_mreach (m := f.plain) hpa hpr hr₀\n  have hb := before_true f ps pp ρ M hpre hlaws hw\n  -- The request's state: its inputs, the rest as it is.\n  have hX : applyS pp.req ρ M = withInputs f.m.inputs ρ (applyS pp.req ρ M) := by\n    funext i\n    simp only [withInputs]\n    split\n    · rfl\n    · rename_i hi\n      exact applyS_other (fun hm => by\n        obtain ⟨p, hp', rfl⟩ := List.mem_map.mp hm\n        exact hi (by simpa using hreq p hp')) ρ M\n  refine ⟨?_, ?_⟩\n  · apply Decidable.byContradiction; intro hn\n    apply sound _ _ hal ρ M\n    intro c hc'\n    simp only [allowedGoal, List.mem_append, List.mem_singleton] at hc'\n    rcases hc' with hc' | rfl\n    · exact hb c hc'\n    · simp only [evalC, subst_evalC, inline_evalC]\n      rw [← hX] at hn; simpa using hn\n  · apply Decidable.byContradiction; intro hn\n    apply sound _ _ hca ρ M\n    intro c hc'\n    simp only [causesGoal, List.mem_append, List.mem_singleton] at hc'\n    rcases hc' with hc' | rfl\n    · exact hb c hc'\n    · let e := decideFlags f.flags (applyS pp.req ρ M) M\n      have hnow : ∀ t, evalE ρ M (nowE f pp t) = evalE e M t := by\n        intro t; simp only [nowE, subst_evalE, inline_evalE, e]\n      have hrd : ∀ mp k, evalE ρ M (rdAfter f pp mp k)\n          = primedMaps pp.primeMaps (writeMaps f.m.writes e M) M mp (evalE ρ M k) := by\n        intro mp k\n        simp only [rdAfter, primedMaps]\n        cases hq : lookup (fun q => q.2 == mp) pp.primeMaps with\n        | none => simp [evalE]\n        | some q =>\n          simp only [writeMaps]\n          cases hw : lookup (fun w => w.1 == q.1) f.m.writes with\n          | none => simp [evalE]\n          | some w =>\n            simp only [evalE, evalC, hnow]\n            by_cases hk : evalE ρ M k = evalE e M w.2.1 <;> simp [hk]\n      have henv : applyS (pp.req ++ primeSub f pp) ρ M = primed pp.prime (applyS f.m.step e M) (applyS pp.req ρ M) := by\n        funext i\n        have hps : lookup (fun p : Nat × E => p.1 == i) (primeSub f pp)\n            = (lookup (fun q => q.2 == i) pp.prime).map (fun q => (q.2, nowE f pp (stepTerm f q.1))) := by\n          simp only [primeSub, lookup_map_pred]\n        simp only [primed, applyS, assoc, lookup_append, hps]\n        cases hq : lookup (fun q => q.2 == i) pp.prime with\n        | none => cases lookup (fun p => p.1 == i) pp.req <;> rfl\n        | some q =>\n          have ⟨hqm, hqi⟩ := lookup_some hq\n          simp only [beq_iff_eq] at hqi\n          have h1 : lookup (fun p => p.1 == i) pp.req = none := by\n            cases h1 : lookup (fun p => p.1 == i) pp.req with\n            | none => rfl\n            | some p =>\n              exfalso\n              have ⟨hpm, hpi⟩ := lookup_some h1\n              simp only [beq_iff_eq] at hpi\n              have h3 := hprime q hqm\n              have h4 := hreq p hpm\n              rw [hpi, ← hqi] at h4\n              simp at h3 h4; exact h3 h4\n          simp only [h1, Option.map_some]\n          rw [hnow]\n          simp only [stepTerm]\n          cases hs : assoc f.m.step q.1 with\n          | none =>\n            rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = none from hs]\n            simp [evalE, e]\n          | some t =>\n            rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = some t from hs]\n      simp only [evalC, substR_evalC _ _ _ M _ hrd, henv]\n      rw [← hX] at hn; simpa [e] using hn\n\n-- The named request is a step the machine takes: the state after it is reachable too.\ntheorem progress_reach (f : FMMachine) (ps : List MEntry) (pp : Progress)\n    (hl : checkFMMachine f ps = true) (hp : checkProgress f ps pp = true) {ρ M} (hr : FMReach f ρ M)\n    (hw : evalC ρ M pp.when = true) :\n    FMReach f (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M)\n      (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ (applyS pp.req ρ M)) M) M) :=\n  FMReach.step ρ M _ hr (progress_sound f ps pp hl hp ρ M hr hw).1\n\nend Kern\n\n#print axioms Kern.inline_evalC\n#print axioms Kern.fmachine_sound\n#print axioms Kern.fmmachine_sound\n#print axioms Kern.progress_sound\n#print axioms Kern.progress_reach\n",
     "StepLaw.lean": "import Progress\n\n/-!\nStepLaw: kernel.ts's step laws, \"every request the machine allows takes a step where `then` holds\", proven sound.\n\n`then` reads the state before the step (with the request's inputs) by plain names and the state and maps after it by\nprimed names (`prime`, `primeMaps`), as Progress does; `when` narrows the requests. Where Progress names one request\nand must prove it allowed, a step law is about every request: its inputs are any `ι`, and the machine's assumption\n(flags decided) is a hypothesis. Lean builds the goal itself from the machine (`stepLawGoal`, reusing Progress's\n`progressBefore`, `primeSub` and `rdAfter` with an empty request), and `steplaw_sound` shows that an accepted tree makes\n`StepLawHolds` true in every reachable state. The exporter inlines flags into `when` and `then` (as kernel.ts's goal\ndoes), so both must read no flag variable.\n-/\n\nnamespace Kern\n\nstructure StepLaw where\n  when : C\n  then_ : C\n  prime : List (Nat × Nat)      -- a state variable, and the name `then` reads its value after the step by\n  primeMaps : List (Nat × Nat)  -- a map, and the name `then` reads it after the step by\n  insts : List (Nat × E)        -- (law index, key): where the goal assumes the laws about every key\n  proof : List VDef × Tree\n\n-- The same goal shape as Progress's, with no request named: the request's inputs are the inputs as they are.\ndef asProgress (sl : StepLaw) : Progress := ⟨sl.when, sl.then_, [], sl.prime, sl.primeMaps, sl.insts, sl.proof, sl.proof⟩\n\ndef stepLawGoal (f : FMMachine) (laws : List MLaw) (sl : StepLaw) : List C :=\n  progressBefore f laws (asProgress sl)\n    ++ [inlineC f.flags f.m.assume, .not (substRC (primeSub f (asProgress sl)) (rdAfter f (asProgress sl)) sl.then_)]\n\ndef checkStepLaw (f : FMMachine) (ps : List MEntry) (sl : StepLaw) : Bool :=\n  avoids (flagVars f.flags) sl.then_ && avoids (flagVars f.flags) sl.when\n    && checkGoal ⟨sl.proof.1, stepLawGoal f (ps.map (·.law)) sl⟩ sl.proof.2\n\n/-- A step law: in every reachable state, every request (inputs ι) the machine allows with its flags decided, and that\n`when` admits, takes a step where `then` holds: primed names read the state and maps after it, plain names the state\nbefore it with the request's inputs. -/\ndef StepLawHolds (f : FMMachine) (sl : StepLaw) : Prop :=\n  ∀ ρ M, FMReach f ρ M → ∀ ι : Nat → Nat,\n    evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true →\n    evalC (withInputs f.m.inputs ρ ι) M sl.when = true →\n    evalC (primed sl.prime (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M) (withInputs f.m.inputs ρ ι))\n      (primedMaps sl.primeMaps (writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M) M)\n      sl.then_ = true\n\ntheorem applyS_nil (ρ : Nat → Nat) (M : Nat → Nat → Nat) : applyS [] ρ M = ρ := by\n  funext i; simp [applyS, assoc, lookup]\n\ntheorem steplaw_sound (f : FMMachine) (ps : List MEntry) (sl : StepLaw)\n    (hl : checkFMMachine f ps = true) (hs : checkStepLaw f ps sl = true) : StepLawHolds f sl := by\n  intro ρ M hr ι hA hW\n  have hl0 := hl\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at hl\n  obtain ⟨⟨⟨hf, hpref⟩, _⟩, hc⟩ := hl\n  simp only [checkStepLaw, Bool.and_eq_true] at hs\n  obtain ⟨_, hgoal⟩ := hs\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  -- The laws and the precondition hold in the reachable state.\n  have hlaws : ∀ e ∈ ps, e.law.Holds ρ M := fmmachine_sound f ps hl0 ρ M hr\n  have hcm := hc\n  simp only [checkMMachine, Bool.and_eq_true, List.all_eq_true] at hcm\n  obtain ⟨⟨hpa, hpr⟩, hent⟩ := hcm\n  try simp only [Bool.not_eq_true'] at hpr\n  have hpre : evalC ρ M f.m.pre = true := by\n    rw [congrC ρ ρ₀ M f.m.pre (fun j hj => hag j (avoids_occ hpref hj))]\n    exact pre_mreach (m := f.plain) hpa hpr hr₀\n  -- They hold with the request's inputs too: neither reads an input.\n  have hagX : Agree f.m.inputs (withInputs f.m.inputs ρ ι) ρ := fun i hi => withInputs_other hi ρ ι\n  have hpreX : evalC (withInputs f.m.inputs ρ ι) M f.m.pre = true := by\n    rw [congrC (withInputs f.m.inputs ρ ι) ρ M f.m.pre (fun j hj => hagX j (fun h =>\n      avoids_occ hpa hj (List.mem_append_left _ (List.mem_append_left _ h))))]\n    exact hpre\n  have hlawsX : ∀ e ∈ ps, e.law.Holds (withInputs f.m.inputs ρ ι) M := by\n    intro e he\n    have hav := hent e he\n    exact holds_agree e.law hav.1.1.1 hagX M (hlaws e he)\n  have hb := before_true f ps (asProgress sl) (withInputs f.m.inputs ρ ι) M hpreX hlawsX hW\n  apply Decidable.byContradiction; intro hn\n  apply sound _ _ hgoal (withInputs f.m.inputs ρ ι) M\n  intro c hc'\n  simp only [stepLawGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc'\n  rcases hc' with hc' | rfl | rfl\n  · exact hb c hc'\n  · rw [inline_evalC]; exact hA\n  · let e := decideFlags f.flags (withInputs f.m.inputs ρ ι) M\n    have hnow : ∀ t, evalE (withInputs f.m.inputs ρ ι) M (nowE f (asProgress sl) t) = evalE e M t := by\n      intro t; simp only [nowE, asProgress, subst_evalE, applyS_nil, inline_evalE, e]\n    have hrd : ∀ mp k, evalE (withInputs f.m.inputs ρ ι) M (rdAfter f (asProgress sl) mp k)\n        = primedMaps sl.primeMaps (writeMaps f.m.writes e M) M mp (evalE (withInputs f.m.inputs ρ ι) M k) := by\n      intro mp k\n      simp only [rdAfter, primedMaps, asProgress]\n      cases hq : lookup (fun q => q.2 == mp) sl.primeMaps with\n      | none => simp [evalE]\n      | some q =>\n        simp only [writeMaps]\n        cases hw : lookup (fun w => w.1 == q.1) f.m.writes with\n        | none => simp [evalE]\n        | some w =>\n          have h1 := hnow w.2.1\n          have h2 := hnow w.2.2\n          simp only [asProgress] at h1 h2\n          simp only [evalE, evalC, h1, h2]\n          by_cases hk : evalE (withInputs f.m.inputs ρ ι) M k = evalE e M w.2.1 <;> simp [hk]\n    have henv : applyS (primeSub f (asProgress sl)) (withInputs f.m.inputs ρ ι) M = primed sl.prime (applyS f.m.step e M) (withInputs f.m.inputs ρ ι) := by\n      funext i\n      have hps : lookup (fun p : Nat × E => p.1 == i) (primeSub f (asProgress sl))\n          = (lookup (fun q => q.2 == i) sl.prime).map (fun q => (q.2, nowE f (asProgress sl) (stepTerm f q.1))) := by\n        simp only [primeSub, asProgress, lookup_map_pred]\n      simp only [primed, applyS, assoc, hps]\n      cases hq : lookup (fun q => q.2 == i) sl.prime with\n      | none => rfl\n      | some q =>\n        simp only [Option.map_some]\n        rw [hnow]\n        simp only [stepTerm]\n        cases hs : assoc f.m.step q.1 with\n        | none =>\n          rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = none from hs]\n          simp [evalE, e]\n        | some t =>\n          rw [show Option.map (fun x => x.2) (lookup (fun p => p.1 == q.1) f.m.step) = some t from hs]\n    simp only [evalC, substR_evalC _ _ _ M _ hrd, henv]\n    simpa [e] using hn\n\nend Kern\n\n#print axioms Kern.steplaw_sound\n",
     "Steps.lean": "import StepLaw\n\n/-!\nSteps: kernel.ts's k-step laws, \"every k requests in a row that the machine allows, each meeting its `when`, take a\nreachable state to one where `then` holds\", proven sound.\n\nThe goal is a symbolic run, as kernel.ts builds it: a frame is a substitution (each state variable a term over the\nfirst state) and a read of each map (a term over the first state's maps); a step composes the machine's step terms\n(flags inlined) after the frame, and a map read after it is read-over-write. Before each step the laws, the assumption\nand that step's `when` are read at the frame; the first step reads its request's inputs by their own names, the j-th\n(j ≥ 2) by fresh variables (`ren`). `then` reads the first state by plain names and the last by primed ones.\n\nOne invariant carries the proof (`Denotes`, kept by `step_denotes`): the frame denotes the real state after j steps\n(outside the inputs, the fresh variables and the flags) and the real maps. So every hypothesis holds at the first state\nwith the fresh variables set to the later requests (`krun_sound`), and a refuted goal leaves `then` no way to fail\n(`kstep_sound`). Lean builds the goal itself; only the tree comes from TypeScript.\n-/\n\nnamespace Kern\n\nstructure KStep where\n  whens : List C                 -- one per step, flags inlined (0 ≤ 0 for a step with none); k is the length\n  then_ : C\n  ren : List (List (Nat × Nat))  -- per step: (input, the variable the goal reads it by there); [] for the first step\n  prime : List (Nat × Nat)       -- a state variable, and the name `then` reads its value after the last step by\n  primeMaps : List (Nat × Nat)   -- a map, and the name `then` reads it after the last step by\n  insts : List (Nat × E)         -- (law index, key): where each frame assumes the laws about every key\n  proof : List VDef × Tree\n\ndef frameSub (r : List (Nat × Nat)) (σ : List (Nat × E)) : List (Nat × E) := r.map (fun p => (p.1, .var p.2)) ++ σ\ndef stepSub (f : FMMachine) (τ : List (Nat × E)) (rd : Nat → E → E) : List (Nat × E) :=\n  f.m.step.map (fun p => (p.1, substRE τ rd (inlineE f.flags p.2))) ++ τ\ndef stepRd (f : FMMachine) (τ : List (Nat × E)) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun w => w.1 == mp) f.m.writes with\n  | some w => .ite (.eq k (substRE τ rd (inlineE f.flags w.2.1))) (substRE τ rd (inlineE f.flags w.2.2)) (rd mp k)\n  | none => rd mp k\ndef frameHyps (f : FMMachine) (laws : List MLaw) (insts : List (Nat × E)) (w : C) : List C :=\n  scalarHyps laws ++ instHyps laws insts ++ [inlineC f.flags f.m.assume, w]\n\n-- The hypotheses along the steps, and the frame after them.\ndef kRun (f : FMMachine) (laws : List MLaw) (insts : List (Nat × E)) :\n    List C → List (List (Nat × Nat)) → List (Nat × E) → (Nat → E → E) → List C × List (Nat × E) × (Nat → E → E)\n  | w :: ws, r :: rs, σ, rd =>\n    ((frameHyps f laws insts w).map (substRC (frameSub r σ) rd) ++ (kRun f laws insts ws rs (stepSub f (frameSub r σ) rd) (stepRd f (frameSub r σ) rd)).1,\n      (kRun f laws insts ws rs (stepSub f (frameSub r σ) rd) (stepRd f (frameSub r σ) rd)).2)\n  | _, _, σ, rd => ([], σ, rd)\n\ndef getRd : Nat → E → E := fun mp k => .get mp k\ndef kEndSub (sl : KStep) (σ : List (Nat × E)) (rd : Nat → E → E) : List (Nat × E) :=\n  sl.prime.map fun q => (q.2, substRE σ rd (.var q.1))\ndef kEndRd (sl : KStep) (rd : Nat → E → E) : Nat → E → E := fun mp k =>\n  match lookup (fun q => q.2 == mp) sl.primeMaps with\n  | some q => rd q.1 k\n  | none => .get mp k\n\ndef kOut (f : FMMachine) (laws : List MLaw) (sl : KStep) := kRun f laws sl.insts sl.whens sl.ren [] getRd\ndef kGoal (f : FMMachine) (laws : List MLaw) (sl : KStep) : List C :=\n  [f.m.pre] ++ (kOut f laws sl).1 ++ [.not (substRC (kEndSub sl (kOut f laws sl).2.1 (kOut f laws sl).2.2) (kEndRd sl (kOut f laws sl).2.2) sl.then_)]\n\ndef distinct : List Nat → Bool\n  | [] => true\n  | a :: as => !as.contains a && distinct as\n\ndef tgts : List (List (Nat × Nat)) → List Nat\n  | [] => []\n  | r :: rs => r.map (·.2) ++ tgts rs\ndef zone (f : FMMachine) (sl : KStep) : List Nat := tgts sl.ren ++ flagVars f.flags\n\ndef checkKStep (f : FMMachine) (ps : List MEntry) (sl : KStep) : Bool :=\n  sl.whens.length == sl.ren.length && sl.ren.head? == some [] && distinct (tgts sl.ren)\n    && sl.ren.all (fun r => r.all fun p => f.m.inputs.contains p.1)\n    && sl.ren.tail.all (fun r => f.m.inputs.all fun i => r.any (·.1 == i))\n    && (tgts sl.ren).all (fun v => !f.m.inputs.contains v)\n    && sl.prime.all (fun q => !f.m.inputs.contains q.1 && !(zone f sl).contains q.1)\n    && avoids (zone f sl) f.m.pre\n    && sl.whens.all (fun w => (frameHyps f (ps.map (·.law)) sl.insts w).all (avoids (zone f sl)))\n    && f.m.step.all (fun p => avoidsE (zone f sl) (inlineE f.flags p.2))\n    && f.m.writes.all (fun w => avoidsE (zone f sl) (inlineE f.flags w.2.1) && avoidsE (zone f sl) (inlineE f.flags w.2.2))\n    && avoids (flagVars f.flags) sl.then_\n    && checkGoal ⟨sl.proof.1, kGoal f (ps.map (·.law)) sl⟩ sl.proof.2\n\n/-! What a k-step law claims -/\n\n-- One step from ρ, M with request ι: flags decided, then the step's terms and writes.\ndef kNext (f : FMMachine) (ρ : Nat → Nat) (M : Nat → Nat → Nat) (ι : Nat → Nat) : (Nat → Nat) × (Nat → Nat → Nat) :=\n  (applyS f.m.step (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M,\n   writeMaps f.m.writes (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M)\n\ndef kEnd (f : FMMachine) : (Nat → Nat) → (Nat → Nat → Nat) → List (Nat → Nat) → (Nat → Nat) × (Nat → Nat → Nat)\n  | ρ, M, [] => (ρ, M)\n  | ρ, M, ι :: ιs => kEnd f (kNext f ρ M ι).1 (kNext f ρ M ι).2 ιs\n\n-- Each request allowed (the assumption, flags decided) and meeting its step's `when`.\ndef KAllowed (f : FMMachine) : List C → (Nat → Nat) → (Nat → Nat → Nat) → List (Nat → Nat) → Prop\n  | w :: ws, ρ, M, ι :: ιs =>\n    evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true\n      ∧ evalC (withInputs f.m.inputs ρ ι) M w = true ∧ KAllowed f ws (kNext f ρ M ι).1 (kNext f ρ M ι).2 ιs\n  | _, _, _, _ => True\n\n-- What `then`'s plain names read: the first state with the first request, each later request at its fresh variables.\ndef renEnv : List (List (Nat × Nat)) → List (Nat → Nat) → (Nat → Nat) → Nat → Nat\n  | r :: rs, ι :: ιs, b => fun v => match lookup (fun p => p.2 == v) r with\n    | some p => ι p.1\n    | none => renEnv rs ιs b v\n  | _, _, b => b\n\n/-- A k-step law: from every reachable state, every k requests in a row the machine allows (each with its flags\ndecided, each meeting its `when`) end in a state where `then` holds: primed names read the last state and maps, plain\nnames the first state with the first request, and each later request's inputs are read by their fresh variables. -/\ndef KStepHolds (f : FMMachine) (sl : KStep) : Prop :=\n  ∀ ρ M, FMReach f ρ M → ∀ ι₁ ιs, ιs.length + 1 = sl.whens.length → KAllowed f sl.whens ρ M (ι₁ :: ιs) →\n    evalC (primed sl.prime (kEnd f ρ M (ι₁ :: ιs)).1 (renEnv sl.ren (ι₁ :: ιs) (withInputs f.m.inputs ρ ι₁)))\n      (primedMaps sl.primeMaps (kEnd f ρ M (ι₁ :: ιs)).2 M) sl.then_ = true\n\n/-! Lists -/\n\ntheorem distinct_cons {a : Nat} {as : List Nat} (h : distinct (a :: as) = true) : a ∉ as ∧ distinct as = true := by\n  simp only [distinct, Bool.and_eq_true, Bool.not_eq_true'] at h\n  refine ⟨fun hm => ?_, h.2⟩\n  have h1 := h.1\n  simp at h1\n  exact h1 hm\n\ntheorem distinct_append : ∀ {l1 l2 : List Nat}, distinct (l1 ++ l2) = true →\n    distinct l1 = true ∧ distinct l2 = true ∧ ∀ a ∈ l1, a ∉ l2\n  | [], l2, h => ⟨rfl, h, fun _ ha => by simp at ha⟩\n  | a :: as, l2, h => by\n    rw [List.cons_append] at h\n    obtain ⟨hn, hd⟩ := distinct_cons h\n    obtain ⟨h1, h2, h3⟩ := distinct_append hd\n    refine ⟨by simp only [distinct, h1, Bool.and_true, Bool.not_eq_true']; simpa using fun h' => hn (List.mem_append_left l2 h'), h2, fun x hx => ?_⟩\n    rcases List.mem_cons.mp hx with rfl | hx'\n    · exact fun h' => hn (List.mem_append_right _ h')\n    · exact h3 x hx'\n\ntheorem assoc_append_or (l1 l2 : List (Nat × E)) (i : Nat) : assoc (l1 ++ l2) i = (assoc l1 i).or (assoc l2 i) := by\n  simp only [assoc, lookup_append]\n  cases lookup (fun p : Nat × E => p.1 == i) l1 <;> rfl\n\ntheorem applyS_nil' (W : Nat → Nat) (M : Nat → Nat → Nat) : applyS [] W M = W := by\n  funext i; simp [applyS, assoc, lookup]\n\ntheorem assoc_stepSub (f : FMMachine) (τ : List (Nat × E)) (rd : Nat → E → E) (v : Nat) :\n    assoc (f.m.step.map (fun p => (p.1, substRE τ rd (inlineE f.flags p.2)))) v = (assoc f.m.step v).map (fun e => substRE τ rd (inlineE f.flags e)) :=\n  assoc_map_snd f.m.step (fun e => substRE τ rd (inlineE f.flags e)) v\n\n-- Reading `then`'s primed names: each the frame's term for its state variable, the rest as they are.\ntheorem applyS_primes (σ : List (Nat × E)) (rd : Nat → E → E) (W : Nat → Nat) (M : Nat → Nat → Nat) (i : Nat) :\n    ∀ l : List (Nat × Nat), applyS (l.map fun q => (q.2, substRE σ rd (.var q.1))) W M i\n      = match lookup (fun q => q.2 == i) l with\n        | some q => evalE W M (substRE σ rd (.var q.1))\n        | none => W i\n  | [] => by simp [applyS, assoc, lookup]\n  | a :: as => by\n    have ih := applyS_primes σ rd W M i as\n    simp only [applyS, assoc, List.map_cons, lookup] at ih ⊢\n    by_cases h : a.2 = i\n    · simp [h]\n    · have hb : (a.2 == i) = false := by simpa using h\n      simp only [hb, Bool.false_eq_true, ite_false]; exact ih\n\n-- A fresh variable of one step reads its request.\ntheorem lookup_ren : ∀ {r : List (Nat × Nat)}, distinct (r.map (·.2)) = true → ∀ p ∈ r, lookup (fun q => q.2 == p.2) r = some p\n  | [], _, p, hp => by simp at hp\n  | a :: as, hd, p, hp => by\n    simp only [List.map_cons] at hd\n    obtain ⟨hna, hd'⟩ := distinct_cons hd\n    simp only [lookup]\n    rcases List.mem_cons.mp hp with rfl | hp'\n    · simp\n    · have hne : (a.2 == p.2) = false := by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hna (by rw [he]; exact List.mem_map_of_mem hp')\n      simp only [hne, Bool.false_eq_true, ite_false]; exact lookup_ren hd' p hp'\n\ntheorem renEnv_other : ∀ (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)) (b : Nat → Nat) (v : Nat),\n    v ∉ tgts rs → renEnv rs ιs b v = b v\n  | [], ιs, b, v, _ => by cases ιs <;> rfl\n  | r :: rs, [], b, v, _ => rfl\n  | r :: rs, ι :: ιs, b, v, hv => by\n    simp only [tgts, List.mem_append, not_or] at hv\n    have hn : lookup (fun p : Nat × Nat => p.2 == v) r = none := lookup_none (fun p hp => by\n      simp only [beq_eq_false_iff_ne]; intro he; exact hv.1 (by rw [← he]; exact List.mem_map_of_mem hp))\n    simp only [renEnv, hn]\n    exact renEnv_other rs ιs b v hv.2\n\n-- Each step's fresh variables hold its request's inputs.\ndef RenOK (W : Nat → Nat) : List (List (Nat × Nat)) → List (Nat → Nat) → Prop\n  | r :: rs, ι :: ιs => (∀ p ∈ r, W p.2 = ι p.1) ∧ RenOK W rs ιs\n  | _, _ => True\n\ntheorem renOK_congr {W W' : Nat → Nat} : ∀ (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)),\n    (∀ v ∈ tgts rs, W v = W' v) → RenOK W' rs ιs → RenOK W rs ιs\n  | [], _, _, _ => trivial\n  | _ :: _, [], _, _ => trivial\n  | r :: rs, ι :: ιs, hag, ⟨hh, ht⟩ => by\n    refine ⟨fun p hp => ?_, renOK_congr rs ιs (fun v hv => hag v (by simp [tgts, hv])) ht⟩\n    rw [hag p.2 (by simp only [tgts, List.mem_append]; exact Or.inl (List.mem_map_of_mem hp))]; exact hh p hp\n\ntheorem renEnv_ok : ∀ (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)) (b : Nat → Nat),\n    distinct (tgts rs) = true → RenOK (renEnv rs ιs b) rs ιs\n  | [], _, _, _ => trivial\n  | _ :: _, [], _, _ => trivial\n  | r :: rs, ι :: ιs, b, hd => by\n    simp only [tgts] at hd\n    obtain ⟨hr, hrs, hdis⟩ := distinct_append hd\n    refine ⟨fun p hp => ?_, renOK_congr rs ιs (fun v hv => ?_) (renEnv_ok rs ιs b hrs)⟩\n    · simp only [renEnv, lookup_ren hr p hp]\n    · have hn : lookup (fun p : Nat × Nat => p.2 == v) r = none := lookup_none (fun p hp => by\n        simp only [beq_eq_false_iff_ne]; intro he; exact hdis v (by rw [← he]; exact List.mem_map_of_mem hp) hv)\n      simp only [renEnv, hn]\n\n/-! Frames -/\n\n-- A step's input, read at a frame whose fresh variables hold the request.\ntheorem applyS_frame_in {r : List (Nat × Nat)} {σ : List (Nat × E)} {W : Nat → Nat} {M0 : Nat → Nat → Nat} {ι : Nat → Nat} {i : Nat}\n    (hcov : ∃ p ∈ r, p.1 = i) (hval : ∀ p ∈ r, W p.2 = ι p.1) : applyS (frameSub r σ) W M0 i = ι i := by\n  simp only [applyS, frameSub, assoc_append_or]\n  cases h : assoc (r.map fun p => (p.1, E.var p.2)) i with\n  | none =>\n    obtain ⟨p, hp, rfl⟩ := hcov\n    simp only [assoc, Option.map_eq_none_iff] at h\n    have := lookup_none_all h (p.1, .var p.2) (List.mem_map_of_mem hp)\n    simp at this\n  | some e =>\n    simp only [assoc, Option.map_eq_some_iff] at h\n    obtain ⟨q, hq, rfl⟩ := h\n    obtain ⟨hqm, hqi⟩ := lookup_some hq\n    obtain ⟨p, hp, rfl⟩ := List.mem_map.mp hqm\n    simp at hqi\n    simp only [Option.some_or, evalE, hval p hp, hqi]\n\n-- Any other variable reads through to the frame.\ntheorem applyS_frame_out {r : List (Nat × Nat)} {σ : List (Nat × E)} {W : Nat → Nat} {M0 : Nat → Nat → Nat} {i : Nat}\n    (hi : ∀ p ∈ r, p.1 ≠ i) : applyS (frameSub r σ) W M0 i = applyS σ W M0 i := by\n  have hn : assoc (r.map fun p => (p.1, E.var p.2)) i = none := by\n    simp only [assoc, Option.map_eq_none_iff]\n    exact lookup_none (fun a ha => by\n      obtain ⟨p, hp, rfl⟩ := List.mem_map.mp ha\n      simp only [beq_eq_false_iff_ne]; exact hi p hp)\n  simp only [applyS, frameSub, assoc_append_or, hn, Option.none_or]\n\n-- The frame σ, rd denotes the state ρ, M (read from the first state W, M0): every variable outside the inputs and\n-- the zone, and every map read.\ndef Denotes (f : FMMachine) (Z : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (rd : Nat → E → E)\n    (ρ : Nat → Nat) (M : Nat → Nat → Nat) : Prop :=\n  (∀ v, v ∉ f.m.inputs → v ∉ Z → applyS σ W M0 v = ρ v) ∧ (∀ mp k, evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n\n-- The frame a step reads (its inputs set) agrees with the state and request outside the zone.\ndef HeadAgree (f : FMMachine) (Z : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat) (σ : List (Nat × E)) (ρ : Nat → Nat) :\n    List (List (Nat × Nat)) → List (Nat → Nat) → Prop\n  | r :: _, ι :: _ => Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι)\n  | _, _ => True\n\nsection\nvariable (f : FMMachine) (Z : List Nat) (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n\n-- A term of the step read at the frame is its value at the real state, flags decided.\ntheorem frame_term {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} {r : List (Nat × Nat)} {ι : Nat → Nat}\n    (hrd : ∀ mp k, evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n    (hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι)) (e : E) (he : avoidsE Z (inlineE f.flags e) = true) :\n    evalE W M0 (substRE (frameSub r σ) rd (inlineE f.flags e)) = evalE (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M e := by\n  rw [substR_evalE (frameSub r σ) rd W M0 M hrd,\n    congrE _ (withInputs f.m.inputs ρ ι) M _ (fun i hi => hX i (avoidsE_occ he hi)), inline_evalE]\n\ntheorem step_denotes {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat} (r : List (Nat × Nat)) (ι : Nat → Nat)\n    (hD : Denotes f Z W M0 σ rd ρ M)\n    (hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι))\n    (hfz : ∀ v ∈ flagVars f.flags, v ∈ Z)\n    (hst : ∀ p ∈ f.m.step, avoidsE Z (inlineE f.flags p.2) = true)\n    (hwr : ∀ w ∈ f.m.writes, avoidsE Z (inlineE f.flags w.2.1) = true ∧ avoidsE Z (inlineE f.flags w.2.2) = true) :\n    Denotes f Z W M0 (stepSub f (frameSub r σ) rd) (stepRd f (frameSub r σ) rd) (kNext f ρ M ι).1 (kNext f ρ M ι).2 := by\n  obtain ⟨_, hrd⟩ := hD\n  refine ⟨fun v hvi hvz => ?_, fun mp k => ?_⟩\n  · simp only [kNext, applyS, stepSub, assoc_append_or, assoc_stepSub]\n    cases h : assoc f.m.step v with\n    | some e =>\n      have hm : (v, e) ∈ f.m.step := by\n        simp only [assoc, Option.map_eq_some_iff] at h\n        obtain ⟨q, hq, rfl⟩ := h\n        obtain ⟨hqm, hqv⟩ := lookup_some hq\n        simp only [beq_iff_eq] at hqv\n        rw [← hqv]; exact hqm\n      simp only [Option.map_some, Option.some_or]\n      exact frame_term f Z W M0 hrd hX e (hst (v, e) hm)\n    | none =>\n      simp only [Option.map_none, Option.none_or]\n      have hvf : v ∉ flagVars f.flags := fun h' => hvz (hfz v h')\n      rw [decide_other hvf, withInputs_other hvi]\n      show applyS (frameSub r σ) W M0 v = ρ v\n      rw [hX v hvz, withInputs_other hvi]\n  · simp only [kNext, stepRd, writeMaps]\n    cases hw : lookup (fun w : Nat × E × E => w.1 == mp) f.m.writes with\n    | none => simp only [hrd]\n    | some w =>\n      have hm := (lookup_some hw).1\n      simp only [evalE, evalC, frame_term f Z W M0 hrd hX w.2.1 (hwr w hm).1, frame_term f Z W M0 hrd hX w.2.2 (hwr w hm).2, hrd]\n      by_cases hk : evalE W M0 k = evalE (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M w.2.1 <;> simp [hk]\nend\n\n-- The laws and the precondition hold at a reachable state with any request's inputs (neither reads an input).\ntheorem reach_facts (f : FMMachine) (ps : List MEntry) (hl : checkFMMachine f ps = true) {ρ : Nat → Nat} {M : Nat → Nat → Nat}\n    (hr : FMReach f ρ M) (ι : Nat → Nat) :\n    evalC (withInputs f.m.inputs ρ ι) M f.m.pre = true ∧ ∀ e ∈ ps, e.law.Holds (withInputs f.m.inputs ρ ι) M := by\n  have hl0 := hl\n  simp only [checkFMMachine, Bool.and_eq_true, List.all_eq_true] at hl\n  obtain ⟨⟨⟨hf, hpref⟩, _⟩, hc⟩ := hl\n  obtain ⟨ρ₀, hr₀, hag⟩ := fmreach_plain f hf hr\n  have hlaws : ∀ e ∈ ps, e.law.Holds ρ M := fmmachine_sound f ps hl0 ρ M hr\n  have hcm := hc\n  simp only [checkMMachine, Bool.and_eq_true, List.all_eq_true] at hcm\n  obtain ⟨⟨hpa, hpr⟩, hent⟩ := hcm\n  try simp only [Bool.not_eq_true'] at hpr\n  have hpre : evalC ρ M f.m.pre = true := by\n    rw [congrC ρ ρ₀ M f.m.pre (fun j hj => hag j (avoids_occ hpref hj))]\n    exact pre_mreach (m := f.plain) hpa hpr hr₀\n  have hagX : Agree f.m.inputs (withInputs f.m.inputs ρ ι) ρ := fun i hi => withInputs_other hi ρ ι\n  refine ⟨?_, fun e he => holds_agree e.law (hent e he).1.1.1 hagX M (hlaws e he)⟩\n  rw [congrC (withInputs f.m.inputs ρ ι) ρ M f.m.pre (fun j hj => hagX j (fun h =>\n    avoids_occ hpa hj (List.mem_append_left _ (List.mem_append_left _ h))))]\n  exact hpre\n\n-- Every hypothesis of a frame holds where the frame is read.\ntheorem frame_hyps (f : FMMachine) (ps : List MEntry) (hl : checkFMMachine f ps = true) (Z : List Nat) (insts : List (Nat × E))\n    {W : Nat → Nat} {M0 : Nat → Nat → Nat} {σ : List (Nat × E)} {rd : Nat → E → E} {ρ : Nat → Nat} {M : Nat → Nat → Nat}\n    {r : List (Nat × Nat)} {ι : Nat → Nat} {w : C}\n    (hr : FMReach f ρ M) (hrd : ∀ mp k, evalE W M0 (rd mp k) = M mp (evalE W M0 k))\n    (hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι))\n    (hav : ∀ c ∈ frameHyps f (ps.map (·.law)) insts w, avoids Z c = true)\n    (hA : evalC (decideFlags f.flags (withInputs f.m.inputs ρ ι) M) M f.m.assume = true)\n    (hW : evalC (withInputs f.m.inputs ρ ι) M w = true) :\n    ∀ c ∈ frameHyps f (ps.map (·.law)) insts w, evalC W M0 (substRC (frameSub r σ) rd c) = true := by\n  intro c hc\n  obtain ⟨hpre, hlaws⟩ := reach_facts f ps hl hr ι\n  have hb := before_true f ps ⟨w, w, [], [], [], insts, ([], .leaf [] [] [] []), ([], .leaf [] [] [] [])⟩ _ M hpre hlaws hW\n  have hY : evalC (withInputs f.m.inputs ρ ι) M c = true := by\n    simp only [frameHyps, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n    rcases hc with (hc | hc) | rfl | rfl\n    · exact hb c (by simp only [progressBefore, List.mem_append]; exact Or.inl (Or.inl (Or.inr hc)))\n    · exact hb c (by simp only [progressBefore, List.mem_append]; exact Or.inl (Or.inr hc))\n    · rw [inline_evalC]; exact hA\n    · exact hW\n  rw [substR_evalC (frameSub r σ) rd W M0 M hrd, congrC _ (withInputs f.m.inputs ρ ι) M c (fun i hi => hX i (avoids_occ (hav c hc) hi))]\n  exact hY\n\ntheorem krun_sound (f : FMMachine) (ps : List MEntry) (hl : checkFMMachine f ps = true) (Z : List Nat) (insts : List (Nat × E))\n    (W : Nat → Nat) (M0 : Nat → Nat → Nat)\n    (hfz : ∀ v ∈ flagVars f.flags, v ∈ Z)\n    (hst : ∀ p ∈ f.m.step, avoidsE Z (inlineE f.flags p.2) = true)\n    (hwr : ∀ w ∈ f.m.writes, avoidsE Z (inlineE f.flags w.2.1) = true ∧ avoidsE Z (inlineE f.flags w.2.2) = true) :\n    ∀ (ws : List C) (rs : List (List (Nat × Nat))) (ιs : List (Nat → Nat)) (σ : List (Nat × E)) (rd : Nat → E → E)\n      (ρ : Nat → Nat) (M : Nat → Nat → Nat),\n      ws.length = rs.length → ws.length = ιs.length →\n      (∀ w ∈ ws, ∀ c ∈ frameHyps f (ps.map (·.law)) insts w, avoids Z c = true) →\n      (∀ r ∈ rs, ∀ p ∈ r, p.1 ∈ f.m.inputs) →\n      (∀ r ∈ rs.tail, ∀ i ∈ f.m.inputs, ∃ p ∈ r, p.1 = i) →\n      RenOK W rs.tail ιs.tail →\n      FMReach f ρ M → Denotes f Z W M0 σ rd ρ M → HeadAgree f Z W M0 σ ρ rs ιs → KAllowed f ws ρ M ιs →\n      (∀ c ∈ (kRun f (ps.map (·.law)) insts ws rs σ rd).1, evalC W M0 c = true)\n        ∧ Denotes f Z W M0 (kRun f (ps.map (·.law)) insts ws rs σ rd).2.1 (kRun f (ps.map (·.law)) insts ws rs σ rd).2.2\n            (kEnd f ρ M ιs).1 (kEnd f ρ M ιs).2\n  | [], rs, ιs, σ, rd, ρ, M, hl1, hl2, _, _, _, _, _, hD, _, _ => by\n    cases rs with\n    | cons _ _ => simp at hl1\n    | nil =>\n      cases ιs with\n      | cons _ _ => simp at hl2\n      | nil => exact ⟨fun c hc => by simp [kRun] at hc, hD⟩\n  | w :: ws, rs, ιs, σ, rd, ρ, M, hl1, hl2, hav, hkeys, hcov, hren, hr, hD, hH, hK => by\n    rcases rs with _ | ⟨r, rs⟩\n    · simp at hl1\n    rcases ιs with _ | ⟨ι, ιs⟩\n    · simp at hl2\n    simp only [List.length_cons, Nat.add_right_cancel_iff] at hl1 hl2\n    simp only [List.tail_cons] at hcov hren\n    obtain ⟨hA, hW, hK'⟩ := hK\n    have hX : Agree Z (applyS (frameSub r σ) W M0) (withInputs f.m.inputs ρ ι) := hH\n    have hD' := step_denotes f Z W M0 r ι hD hX hfz hst hwr\n    have hr' : FMReach f (kNext f ρ M ι).1 (kNext f ρ M ι).2 := FMReach.step ρ M ι hr hA\n    -- The next step's frame, its inputs set, agrees with the next state and request.\n    have hH' : HeadAgree f Z W M0 (stepSub f (frameSub r σ) rd) (kNext f ρ M ι).1 rs ιs := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases ιs with _ | ⟨ι', ιs'⟩\n      · exact trivial\n      intro v hvz\n      by_cases hvi : v ∈ f.m.inputs\n      · show applyS (frameSub r' (stepSub f (frameSub r σ) rd)) W M0 v = withInputs f.m.inputs (kNext f ρ M ι).1 ι' v\n        rw [applyS_frame_in (hcov r' List.mem_cons_self v hvi) hren.1]\n        simp only [withInputs, List.contains_iff_mem, hvi, ite_true]\n      · show applyS (frameSub r' (stepSub f (frameSub r σ) rd)) W M0 v = withInputs f.m.inputs (kNext f ρ M ι).1 ι' v\n        rw [applyS_frame_out (fun p hp he => hvi (by rw [← he]; exact hkeys r' (List.mem_cons_of_mem _ List.mem_cons_self) p hp)),\n          hD'.1 v hvi hvz, withInputs_other hvi]\n    have hren' : RenOK W rs.tail ιs.tail := by\n      rcases rs with _ | ⟨r', rs'⟩\n      · exact trivial\n      rcases ιs with _ | ⟨ι', ιs'⟩\n      · cases rs' <;> exact trivial\n      exact hren.2\n    obtain ⟨ih1, ih2⟩ := krun_sound f ps hl Z insts W M0 hfz hst hwr ws rs ιs _ _ _ _ hl1 hl2\n      (fun w' hw' => hav w' (List.mem_cons_of_mem _ hw'))\n      (fun r' hr'' => hkeys r' (List.mem_cons_of_mem _ hr''))\n      (fun r' hr'' => hcov r' (List.mem_of_mem_tail hr''))\n      hren' hr' hD' hH' hK'\n    refine ⟨fun c hc => ?_, ih2⟩\n    simp only [kRun, List.mem_append, List.mem_map] at hc\n    rcases hc with ⟨c', hc', rfl⟩ | hc\n    · exact frame_hyps f ps hl Z insts hr hD.2 hX (hav w List.mem_cons_self) hA hW c' hc'\n    · exact ih1 c hc\n\ntheorem kstep_sound (f : FMMachine) (ps : List MEntry) (sl : KStep)\n    (hl : checkFMMachine f ps = true) (hs : checkKStep f ps sl = true) : KStepHolds f sl := by\n  intro ρ M hr ι₁ ιs hlen hK\n  simp only [checkKStep, Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at hs\n  obtain ⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨⟨hlw, hhead⟩, hdist⟩, hkeys⟩, hcov⟩, hrv⟩, hpr⟩, hpre⟩, hws⟩, hst⟩, hwr⟩, hthen⟩, hgoal⟩ := hs\n  have hflags : ∀ v ∈ flagVars f.flags, v ∈ zone f sl := fun v hv => List.mem_append_right _ hv\n  obtain ⟨rs, hrs⟩ : ∃ rs, sl.ren = [] :: rs := by\n    cases h : sl.ren with\n    | nil => rw [h] at hhead; simp at hhead\n    | cons r rs => rw [h] at hhead; simp only [List.head?_cons, Option.some.injEq] at hhead; exact ⟨rs, by rw [hhead]⟩\n  let W := renEnv sl.ren (ι₁ :: ιs) (withInputs f.m.inputs ρ ι₁)\n  have hWo : ∀ v, v ∉ zone f sl → W v = withInputs f.m.inputs ρ ι₁ v := fun v hv =>\n    renEnv_other _ _ _ v (fun h => hv (List.mem_append_left _ h))\n  have hD0 : Denotes f (zone f sl) W M [] getRd ρ M :=\n    ⟨fun v hvi hvz => by rw [applyS_nil', hWo v hvz, withInputs_other hvi], fun mp k => by simp [getRd, evalE]⟩\n  have hH0 : HeadAgree f (zone f sl) W M [] ρ sl.ren (ι₁ :: ιs) := by\n    rw [hrs]\n    show Agree _ (applyS (frameSub [] []) W M) (withInputs f.m.inputs ρ ι₁)\n    intro v hvz\n    simp only [frameSub, List.map_nil, List.append_nil, applyS_nil']; exact hWo v hvz\n  have hren0 : RenOK W sl.ren.tail (ι₁ :: ιs).tail := by\n    have h : RenOK W sl.ren (ι₁ :: ιs) := renEnv_ok sl.ren (ι₁ :: ιs) (withInputs f.m.inputs ρ ι₁) hdist\n    rw [hrs] at h ⊢; exact h.2\n  obtain ⟨hh, hfin⟩ := krun_sound f ps hl (zone f sl) sl.insts W M hflags\n    hst hwr\n    sl.whens sl.ren (ι₁ :: ιs) [] getRd ρ M hlw (by simp only [List.length_cons]; omega)\n    hws (fun r hr p hp => List.contains_iff_mem.mp (hkeys r hr p hp))\n    (fun r hr i hi => by have := hcov r hr i hi; simpa only [List.any_eq_true, beq_iff_eq] using this)\n    hren0 hr hD0 hH0 hK\n  apply Decidable.byContradiction; intro hn\n  apply sound _ _ hgoal W M\n  intro c hc\n  simp only [kGoal, List.mem_append, List.mem_cons, List.not_mem_nil, or_false] at hc\n  rcases hc with (rfl | hc) | rfl\n  · -- The precondition: at the first state (it reads no input and no fresh variable).\n    obtain ⟨hpX, _⟩ := reach_facts f ps hl hr ι₁\n    rw [congrC W (withInputs f.m.inputs ρ ι₁) M f.m.pre (fun j hj => hWo j (avoids_occ hpre hj))]; exact hpX\n  · exact hh c hc\n  · -- `then`, read across the run, is what KStepHolds reads.\n    have hrdE : ∀ mp k, evalE W M (kEndRd sl (kOut f (ps.map (·.law)) sl).2.2 mp k)\n        = primedMaps sl.primeMaps (kEnd f ρ M (ι₁ :: ιs)).2 M mp (evalE W M k) := by\n      intro mp k\n      simp only [kEndRd, primedMaps]\n      cases hq : lookup (fun q => q.2 == mp) sl.primeMaps with\n      | none => simp [evalE]\n      | some q => exact hfin.2 q.1 k\n    have henv : applyS (kEndSub sl (kOut f (ps.map (·.law)) sl).2.1 (kOut f (ps.map (·.law)) sl).2.2) W M\n        = primed sl.prime (kEnd f ρ M (ι₁ :: ιs)).1 W := by\n      funext i\n      rw [kEndSub, applyS_primes]\n      simp only [primed]\n      cases hq : lookup (fun q => q.2 == i) sl.prime with\n      | none => rfl\n      | some q =>\n        have hq1 := hpr q (lookup_some hq).1\n        simp only [Bool.not_eq_true'] at hq1\n        have hqi : q.1 ∉ f.m.inputs := by simpa using hq1.1\n        have hqz : q.1 ∉ zone f sl := by simpa using hq1.2\n        show evalE W M (substRE (kOut f (ps.map (·.law)) sl).2.1 (kOut f (ps.map (·.law)) sl).2.2 (.var q.1)) = (kEnd f ρ M (ι₁ :: ιs)).1 q.1\n        have hfin' : Denotes f (zone f sl) W M (kOut f (ps.map fun e : MEntry => e.law) sl).2.1 (kOut f (ps.map fun e : MEntry => e.law) sl).2.2\n            (kEnd f ρ M (ι₁ :: ιs)).1 (kEnd f ρ M (ι₁ :: ιs)).2 := hfin\n        exact (substR_evalE (kOut f (ps.map fun e : MEntry => e.law) sl).2.1 _ W M _ hfin'.2 (.var q.1)).trans (hfin'.1 q.1 hqi hqz)\n    simp only [evalC, substR_evalC _ _ W M _ hrdE, henv]\n    simpa using hn\n\nend Kern\n\n#print axioms Kern.kstep_sound\n",

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "gdp-wired",
-  "version": "0.15.0",
+  "version": "0.17.0",
   "description": "An automatic prover for stateful rules (budgets, caps, windows, workflows, policies): laws proven with no proof to write, checked again in Lean, counterexamples found on the GPU, the rule shipped as code",
   "keywords": [
     "verification",
@@ -60,6 +60,10 @@
       "types": "./dist/core/discover.d.ts",
       "default": "./dist/core/discover.js"
     },
+    "./cyclic": {
+      "types": "./dist/core/cyclic.d.ts",
+      "default": "./dist/core/cyclic.js"
+    },
     "./infer": {
       "types": "./dist/core/infer.d.ts",
       "default": "./dist/core/infer.js"
@@ -101,7 +105,7 @@
     "build": "bun scripts/build.ts",
     "prepublishOnly": "bun scripts/build.ts",
     "smoke": "sh scripts/smoke.sh",
-    "test": "bun scripts/gen-lean-library.ts --check && cd core && bun test solver.test.ts dsl.test.ts conformance.test.ts compose.test.ts quantifiers.test.ts functions.test.ts keyterms.test.ts lists.test.ts liveness.test.ts sizes.test.ts values.test.ts builders.test.ts gdp.test.ts datatypes.test.ts lemmas.test.ts discover.test.ts infer.test.ts invoices.test.ts folds.test.ts trees.test.ts pairs.test.ts chart.test.ts xstate.test.ts && cd ../kernel && bun test tamper.test.ts refusals.test.ts steplaw.test.ts sets.test.ts && cd ../examples && bun test examples.test.ts && cd .. && bun examples/readme.ts && bun examples/guide.ts && bun examples/composition.ts && bun examples/sets.ts && bun examples/quantifiers.ts && bun examples/functions.ts && bun examples/datatypes.ts && bun examples/lemmas.ts && bun examples/discover.ts && bun examples/invoices.ts && bun examples/folds.ts && bun examples/trees.ts && bun examples/pairs.ts && bun examples/groups.ts && bun examples/charts.ts && bun examples/xstate.ts && bun examples/infer.ts && bun examples/lists.ts && bun examples/sizes.ts && bun examples/liveness.ts && bun examples/budget.ts && bun examples/gdp.ts && bun examples/steps.ts && bun examples/jev-fabric/run.ts"
+    "test": "bun scripts/gen-lean-library.ts --check && cd core && bun test solver.test.ts dsl.test.ts conformance.test.ts compose.test.ts quantifiers.test.ts functions.test.ts keyterms.test.ts lists.test.ts liveness.test.ts sizes.test.ts values.test.ts builders.test.ts gdp.test.ts datatypes.test.ts lemmas.test.ts discover.test.ts infer.test.ts cyclic.test.ts seqs.test.ts search.test.ts invoices.test.ts folds.test.ts trees.test.ts pairs.test.ts chart.test.ts xstate.test.ts && cd ../kernel && bun test tamper.test.ts refusals.test.ts steplaw.test.ts sets.test.ts && cd ../examples && bun test examples.test.ts && cd .. && bun examples/readme.ts && bun examples/guide.ts && bun examples/composition.ts && bun examples/sets.ts && bun examples/quantifiers.ts && bun examples/functions.ts && bun examples/datatypes.ts && bun examples/lemmas.ts && bun examples/discover.ts && bun examples/invoices.ts && bun examples/folds.ts && bun examples/trees.ts && bun examples/pairs.ts && bun examples/groups.ts && bun examples/charts.ts && bun examples/xstate.ts && bun examples/infer.ts && bun examples/cyclic.ts && bun examples/scopes.ts && bun examples/lists.ts && bun examples/sizes.ts && bun examples/liveness.ts && bun examples/budget.ts && bun examples/gdp.ts && bun examples/steps.ts && bun examples/jev-fabric/run.ts"
   },
   "devDependencies": {
     "@gdp-ts/core": "0.1.0",