gdp-wired 0.8.0 → 0.9.0

package/dist/lean-kernel/emit.js

@@ -475,7 +475,7 @@ const boundKeys = (m) => [...Object.values(m.step.flags ?? {}).flatMap(c => (c.o
 export function smachineToLean(id, given, laws, opts = {}) {
     const hm = given.history ? { ...given, history: { ...given.history, prune: undefined } } : undefined;
     const hplain = hm ? historyMachine(hm) : undefined, stepLaws = opts.stepLaws ?? [], rf = opts.refined, gv = opts.ghosts ?? [];
-    const { machine: m, origins } = specializeFacts(hplain ? hplain.machine : given, laws, stepLaws);
+    const m = hplain ? hplain.machine : given;
     const claims = [];
     const claimSteps = () => claims.flatMap(cl => cl.steps);
     // The machine's own step laws, one step or k (Sets.lean's skstep_sound).
@@ -497,6 +497,7 @@ def ${id}_step${j} : SKStep := ⟨⟨${list(Array.from({ length: kk }, (_, s2) =
   ${list(qinsts(inst))},
   ${list(finsts(inst))},
   ${list(pinsts(inst))},
+  ${list(pfinsts(inst))},
   [],
   ${list(Array.from({ length: kk - 1 }, (_, s2) => list(Object.keys(m.state).map(n2 => `(${ix(n2)}, ${ix(stateName(n2, s2 + 1))})`))))}⟩
 theorem ${id}_step${j}_holds : SKStepHolds ${id}_machine ${id}_step${j} :=
@@ -608,7 +609,15 @@ theorem ${id}_orig_laws : ∀ ρ M, SReach ${id}_ghosted.orig ρ M → ∀ e ∈
         const factsF = m.facts ?? [];
         const base = [m.pre ?? trueC,
             ...factsF.filter(f => !f.forall).map(f => f.holds),
-            ...Object.entries(inst).flatMap(([name, keys]) => { const f = factsF.find(f2 => f2.name === name); return f?.forall ? keys.map(key => sub1(f.holds, { [f.forall]: key })) : []; }),
+            ...Object.entries(inst).flatMap(([name, keys]) => { const f = factsF.find(f2 => f2.name === name); return f?.forall && !f.keys?.length ? keys.map(key => sub1(f.holds, { [f.forall]: key })) : []; }),
+            // A fact about several keys at each tuple (kept flattened), as Lean reads it: the further keys, then the first.
+            ...Object.entries(inst).flatMap(([name, keys]) => {
+                const f = factsF.find(f2 => f2.name === name);
+                if (!f?.keys?.length)
+                    return [];
+                const k = f.keys.length + 1;
+                return Array.from({ length: Math.floor(keys.length / k) }, (_, t) => sub1(sub1(f.holds, Object.fromEntries(f.keys.map((kn, i) => [kn, keys[t * k + 1 + i]]))), { [f.forall]: keys[t * k] }));
+            }),
             ...laws.filter(lw => !lw.forall).map(lw => lw.holds),
             ...Object.entries(inst).flatMap(([name, keys]) => { const lw = laws.find(l2 => l2.name === name); return lw?.forall && !lw.keys?.length ? keys.map(key => sub1(lw.holds, { [lw.forall]: key })) : []; }),
             ...Object.entries(inst).flatMap(([name, keys]) => {
@@ -658,7 +667,8 @@ theorem ${id}_orig_laws : ∀ ρ M, SReach ${id}_ghosted.orig ρ M → ∀ e ∈
   ${list(ws.flatMap(([name, w]) => ('each' in w ? [`(${mx(name)}, ${ix(w.each)}, ${e(w.value)})`] : [])))},
   ${list(fs.flatMap(([f, c2]) => (c2.op === 'all' ? [`(${ix(`?${f}`)}, ${ix(c2.key)}, ${c(c2.c)})`] : [])))},
   ${list(fs.flatMap(([f, c2]) => (c2.op === 'all' ? [`(${ix(`?${f}`)}, ${ix(`w?${f}`)})`] : [])))},
-  ${list((mm.facts ?? []).map(l => `⟨${c(l.holds)}, ${l.forall ? `some ${ix(l.forall)}` : 'none'}⟩`))}⟩`;
+  ${list((mm.facts ?? []).filter(l => !l.keys?.length).map(l => `⟨${c(l.holds)}, ${l.forall ? `some ${ix(l.forall)}` : 'none'}⟩`))},
+  ${list((mm.facts ?? []).filter(l => l.keys?.length).map(l => `(⟨${c(l.holds)}, some ${ix(l.forall)}⟩, ${list(l.keys.map(k2 => String(ix(k2))))})`))}⟩`;
     };
     // A loop as Live.lean's record: inputs, start, body, while, precondition, assumption.
     const loopLit = (lp) => `⟨${list(lp.inputs.map(name => String(ix(name))))},
@@ -700,12 +710,21 @@ ${readable(id, laws, vars, mapNames, { binders: '(ρ : Nat → Nat) (μ : Nat
         const n = laws[lawIx(name)].keys.length + 1;
         return Array.from({ length: Math.floor(keys.length / n) }, (_, t) => `(${lawIx(name)}, ${e(keys[t * n])}, ${list(keys.slice(t * n + 1, t * n + n).map(e))})`);
     });
-    const finsts = (inst) => Object.entries(inst).flatMap(([name, keys]) => { const j = facts.findIndex(f => f.name === name); return j < 0 ? [] : keys.map(key => `(${j}, ${e(key)})`); });
+    // The facts about one key, and those about several (each instance a tuple, kept flattened: its first key, the rest).
+    const facts1 = facts.filter(f => !f.keys?.length), factsN = facts.filter(f => f.keys?.length);
+    const finsts = (inst) => Object.entries(inst).flatMap(([name, keys]) => { const j = facts1.findIndex(f => f.name === name); return j < 0 ? [] : keys.map(key => `(${j}, ${e(key)})`); });
+    const pfinsts = (inst) => Object.entries(inst).flatMap(([name, keys]) => {
+        const j = factsN.findIndex(f => f.name === name);
+        if (j < 0)
+            return [];
+        const n = factsN[j].keys.length + 1;
+        return Array.from({ length: Math.floor(keys.length / n) }, (_, t) => `(${j}, ${e(keys[t * n])}, ${list(keys.slice(t * n + 1, t * n + n).map(e))})`);
+    });
     const qinsts = (inst) => Object.entries(inst).filter(([name]) => name.startsWith('?')).flatMap(([f, keys]) => keys.map(key => `(${ix(f)}, ${e(key)})`));
     const entries = laws.map((law, j) => {
         const g0 = goalsL[2 * j], g1 = goalsL[2 * j + 1], a = enc(g0, lp.trees[g0.name]), b = enc(g1, lp.trees[g1.name]), inst = lp.instances[law.name] ?? {};
         return `def ${id}_l${j} : MLaw := ⟨${c(law.holds)}, ${law.forall ? `some ${ix(law.forall)}` : 'none'}⟩
-def ${id}_e${j} : SEntry := ⟨${id}_l${j}, ${ix(law.forall ? `${law.forall}#` : '#')}, ${list((law.keys ?? []).map(key => String(ix(key))))}, ${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))},
+def ${id}_e${j} : SEntry := ⟨${id}_l${j}, ${ix(law.forall ? `${law.forall}#` : '#')}, ${list((law.keys ?? []).map(key => String(ix(key))))}, ${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))}, ${list(pfinsts(inst))},
   (${a.tab}, [], ${a.tree}),
   (${b.tab}, [], ${b.tree})⟩`;
     });
@@ -714,13 +733,13 @@ def ${id}_e${j} : SEntry := ⟨${id}_l${j}, ${ix(law.forall ? `${law.forall}#` :
     const orig = { ...m, state: Object.fromEntries(Object.entries(m.state).filter(([n2]) => !gv.includes(n2))), step: { ...m.step, state: Object.fromEntries(Object.entries(m.step.state ?? {}).filter(([n2]) => !gv.includes(n2))) } };
     const h = {
         step: sl => { const g = goalsS[allSteps.indexOf(sl)]; return { pr: enc(g, r.proof.trees[g.name]), inst: instOf(sl) }; },
-        sproof: sl => { const { pr, inst } = h.step(sl); return `(${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))}, (${pr.tab}, [], ${pr.tree}))`; },
+        sproof: sl => { const { pr, inst } = h.step(sl); return `(${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))}, ${list(pfinsts(inst))}, (${pr.tab}, [], ${pr.tree}))`; },
         allow: a => {
             const f2 = allowed.get(a);
             if (!f2)
                 return undefined;
             const ar = f2.out, pr = enc(ar.goal, ar.tree), inst = ar.instances;
-            return `(${list(f2.wit.map(([inp, t]) => `(${ix(inp)}, ${e(t)})`))}, (${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))}, (${pr.tab}, ${list(ar.goal.hyps.map(c))}, ${pr.tree})), ${list(ar.goal.zkeys.map(e))})`;
+            return `(${list(f2.wit.map(([inp, t]) => `(${ix(inp)}, ${e(t)})`))}, (${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))}, ${list(pfinsts(inst))}, (${pr.tab}, ${list(ar.goal.hyps.map(c))}, ${pr.tree})), ${list(ar.goal.zkeys.map(e))})`;
         },
     };
     const records = claims.map(cl => cl.render(h)).filter(t => t.length);
@@ -741,48 +760,11 @@ def ${id}_proof : List SEntry := ${list(laws.map((_, j) => `${id}_e${j}`))}
 theorem ${id}_check : checkSMachine ${id}_machine ${id}_proof = true := by decide +kernel
 theorem ${id}_laws : ∀ ρ M, SReach ${id}_machine ρ M → ∀ e ∈ ${id}_proof, e.Holds ρ M :=
   smachine_sound ${id}_machine ${id}_proof ${id}_check
-${hm ? histBlock() : readable(id, laws, vars, mapNames, { binders: '(ρ : Nat → Nat) (μ : Nat → Nat → Nat)', hyp: `SReach ${id}_machine ρ μ`, call: `${id}_laws ρ μ h` })}${factsProof(id, m, mapNames, vars, opts.simp, origins)}${opts.tamper ? `
+${hm ? histBlock() : readable(id, laws, vars, mapNames, { binders: '(ρ : Nat → Nat) (μ : Nat → Nat → Nat)', hyp: `SReach ${id}_machine ρ μ`, call: `${id}_laws ρ μ h` })}${opts.noFacts ? '' : factsProof(id, m, mapNames, vars, opts.simp)}${opts.tamper ? `
 -- TAMPERED: ${opts.tamper.what}. Lean computes the check to false.
 def ${id}_tampered : SMachine := ${lit(opts.tamper.machine)}
 example : checkSMachine ${id}_tampered ${id}_proof = false := by decide +kernel` : ''}${records.length ? `\n\n${records.join('\n\n')}` : ''}${opts.after ? `\n\n${opts.after(ix)}` : ''}`;
 }
-function specializeFacts(m, laws, stepLaws) {
-    const origins = new Map(), facts = m.facts ?? [];
-    if (!facts.some(f => f.keys?.length))
-        return { machine: m, origins };
-    const r = proveStepLaws(m, laws, stepLaws);
-    if (!r.proven || !r.proof)
-        throw new Error(`${m.name}: not proven (${r.failed?.stuck ?? ''})`);
-    const all = [...Object.values(r.proof.laws.instances), r.proof.instances, ...Object.values(r.proof.perStep ?? {})];
-    const overParams = (t) => varsOf({ op: '=', a: t, b: t }).every(x => m.params.includes(x)) && !JSON.stringify(t).includes('"op":"get"');
-    const out = [];
-    for (const f of facts) {
-        if (!f.keys?.length) {
-            out.push(f);
-            continue;
-        }
-        const vars = [f.forall, ...f.keys], seen = new Set();
-        for (const inst of all) {
-            const keys = inst[f.name] ?? [];
-            for (let t = 0; t + vars.length <= keys.length; t += vars.length) {
-                const tuple = keys.slice(t, t + vars.length), open = tuple.map((e2, i) => [e2, i]).filter(([e2]) => !overParams(e2)).map(([, i]) => i);
-                // A tuple with two keys over the state is left out (the prover offers more instances than a proof uses): if the
-                // proof needs it, proving the machine again without it fails, and says so.
-                if (open.length > 1)
-                    continue;
-                const left = open[0] ?? 0, at = Object.fromEntries(vars.flatMap((x, i) => (i === left ? [] : [[x, tuple[i]]])));
-                const id = JSON.stringify([left, at]);
-                if (seen.has(id))
-                    continue;
-                seen.add(id);
-                const name = `${f.name} #${seen.size}`;
-                out.push({ name, forall: vars[left], holds: substC(f.holds, { vars: at, maps: {}, flags: {} }) });
-                origins.set(name, { from: f, at });
-            }
-        }
-    }
-    return { machine: { ...m, facts: out }, origins };
-}
 // A function defined by a recurrence (core/dsl.ts recur): its Lean definition by the same recurrence, and its lemmas
 // proven together by induction (each case by omega, its min, max and ifs split first), and its laws between two points
 // by induction on the distance. A function of several arguments is `<name>_rec`, its further arguments first, and the
@@ -838,6 +820,64 @@ const useLemmas = (uses, t, names, where) => {
     walk(t);
     return [...new Set(out)];
 };
+// The kernel's own proof of a recurrence's lemmas (or of its laws between two points), for Lean to check: the machine
+// it was proven by, exported with its trees (smachine_sound gives its laws at every reachable state), and the run of
+// that machine that reaches x and f(x) (or y = x + d and f(y) from x and f(x)), so each law, read there, is the lemma.
+// The proof needs no tactic beyond simp's arithmetic of the machine's terms: what the kernel proved (products of two
+// terms among it) Lean checks as the kernel's own tree.
+function recurKernel(lean, r, uses, which) {
+    const pr = r.proofs?.[which];
+    if (!pr)
+        return undefined;
+    const m = pr.machine, two = which === 'between', id = `${lean.replace(/[^A-Za-z0-9_]/g, '_')}_${two ? 'two' : 'ind'}`;
+    const vars = [...m.params, ...m.inputs, ...Object.keys(m.state)], col = (n) => { const j = vars.indexOf(n); if (j < 0)
+        throw new Error(`${id}: no column for ${n}`); return j; };
+    const fnNames = Object.keys(m.fns ?? {}), args = r.args.map(recurArg), argNames = Object.fromEntries(r.args.map(a => [a, recurArg(a)]));
+    const F = (x) => recurCall(lean, r, x);
+    const surface = leanSurface(argNames, lean, useRead(uses, lean));
+    const binders = [...r.args.map(a => `(${recurArg(a)} : Nat)`), ...(two ? ['(x : Nat)'] : [])].join(' '), ps = [...args, ...(two ? ['x'] : [])].join(' ');
+    const start = [...r.args.map(a => [a, recurArg(a)]), ...(m.params.includes('fx0') ? [['fx0', surface.e(r.zero)]] : []),
+        ...(two ? [['x', 'x'], ['fx', F('x')]] : [])];
+    const chain = (pairs, dflt, v) => pairs.reduceRight((acc, [c, e]) => `if ${v} = ${c} then ${e} else ${acc}`, dflt);
+    // What the run holds after n steps, column by column.
+    const at = (n) => two
+        ? [[col('y'), `x + ${n}`], [col('fy'), F(`(x + ${n})`)], [col('x'), 'x'], [col('fx'), F('x')], ...r.args.map(a => [col(a), recurArg(a)])]
+        : [[col('x'), n], [col('fx'), F(n)], ...r.args.map(a => [col(a), recurArg(a)])];
+    const hs = at('n').map((_, i) => `h${i}`);
+    const recurDefs = [r.args.length ? `${lean}_rec` : lean, ...Object.values(uses).flatMap(u => (u.recur ? (u.recur.args.length ? [`${u.lean}_rec`, `${u.lean}_key`] : [u.lean]) : []))];
+    const one = (m.facts ?? []).some(f => !f.keys?.length), several = (m.facts ?? []).some(f => f.keys?.length);
+    // A fact of the params at the start of the laws between: the lemma at x and f(x), its own conjunct.
+    const proj = (j, k) => (k === 1 ? '' : j < k - 1 ? `${'.2'.repeat(j)}.1` : '.2'.repeat(k - 1));
+    const cite = (f) => { const j = r.lemmas.findIndex(l => f.name === `${l.name} at x`); return two && j >= 0 ? `(${lean}_lemmas ${args.join(' ')} x)${proj(j, r.lemmas.length)}` : undefined; };
+    const factsAt = factsProof(id, m, fnNames, vars, [`${id}_ρ`, `${id}_μ`, ...recurDefs], { binders, rho: `(${id}_ρ ${ps})`, mu: `${id}_μ`, cite });
+    const unfold = [`${id}_machine`, `${id}_μ`, 'applyS', 'assoc', 'lookup', 'evalE', 'evalC', ...recurDefs].join(', ');
+    const pre = `
+${smachineToLean(id, m, pr.laws, { noFacts: true })}
+def ${id}_ρ ${binders} : Nat → Nat := fun i => ${chain(start.map(([n, e]) => [col(n), e]), '0', 'i')}
+noncomputable def ${id}_μ : Nat → Nat → Nat := fun j => ${chain(fnNames.map((n, j) => [j, `(${m.fns[n].lean})`]), 'fun _ => 0', 'j')}${factsAt}
+-- The run of ${m.name} that ${two ? 'counts y up from x' : 'counts x up from 0'}: reachable, and holding ${two ? 'y = x + n and f(y)' : 'x = n and f(x)'}.
+theorem ${id}_run ${binders} : ∀ n, ∃ ρ, SReach ${id}_machine ρ ${id}_μ ∧ ${at('n').map(([c, e]) => `ρ ${c} = ${e}`).join(' ∧ ')} := by
+  intro n
+  induction n with
+  | zero =>
+    refine ⟨_, SReach.start (${id}_ρ ${ps}) ${id}_μ ?_ ?_ ?_ ?_, ${at('0').map(() => '?_').join(', ')}⟩
+    · intro p hp; simp [${id}_machine] at hp
+    · simp [${id}_machine, evalC, evalE]
+    · ${one ? `exact ${id}_facts_at ${ps}` : `intro l hl; simp [${id}_machine] at hl`}
+    · ${several ? `exact ${id}_pfacts_at ${ps}` : `intro p hp; simp [${id}_machine] at hp`}
+    all_goals simp [${id}_ρ, ${unfold}]
+  | succ n ih =>
+    obtain ⟨ρ, hr, ${hs.join(', ')}⟩ := ih
+    refine ⟨_, SReach.step ρ ${id}_μ (fun _ => 0) (fun _ _ => 0) hr ?_, ${at('0').map(() => '?_').join(', ')}⟩
+    · simp [sView, ${id}_machine, evalC, evalE]
+    all_goals (try rw [show x + (n + 1) = x + n + 1 from by omega])
+    all_goals simp [sNext, sView, decideFlags, decideQ, flagSub, withInputs, withCarried, ${hs.join(', ')}, ${unfold}]`;
+    // The lemmas (or the laws between, after the lemmas at y): each the machine's law read on the run.
+    const own = two ? r.between.map((_, j) => r.lemmas.length + j) : r.lemmas.map((_, j) => j);
+    const each = (j) => `by have h := ${id}_laws ρ ${id}_μ hr ${id}_e${j} (by simp [${id}_proof]); simp [SEntry.Holds, holdsOver, ${id}_e${j}, ${id}_l${j}, MLaw.Holds, evalC, evalE, ${hs.join(', ')}] at h; simpa using h`;
+    const proof = (from) => `(obtain ⟨ρ, hr, ${hs.join(', ')}⟩ := ${id}_run ${from}; exact ${own.length === 1 ? `(${each(own[0])})` : `⟨${own.map(j => `(${each(j)})`).join(', ')}⟩`})`;
+    return { pre, proof };
+}
 export function recurToLean(lean, r, uses = {}) {
     const binders = r.args.map(a => `(${recurArg(a)} : Nat)`).join(' '), argNames = Object.fromEntries(r.args.map(a => [a, recurArg(a)]));
     const self = r.args.length ? `${lean}_rec` : lean;
@@ -847,22 +887,28 @@ export function recurToLean(lean, r, uses = {}) {
     const lemmaAt = (x) => r.lemmas.map(l => `(${surface({ x, fx: recurCall(lean, r, x) }).c(l.holds)})`).join(' ∧ ');
     const close = (haves) => `${haves.map(h => `${h}; `).join('')}(repeat' split) <;> omega`;
     const step = (n) => useLemmas(uses, r.next, { ...argNames, x: n, prev: recurCall(lean, r, n) }, lean);
-    const lemmas = r.lemmas.length ? `
+    // Each theorem by the kernel's proof (its machine and the run), or by induction with omega where that fails.
+    const kl = recurKernel(lean, r, uses, 'lemmas'), kb = recurKernel(lean, r, uses, 'between');
+    const lemmas = r.lemmas.length ? `${kl?.pre ?? ''}
 -- ${r.lemmas.map(l => l.name).join('; ')}
 theorem ${lean}_lemmas ${binders} (x : Nat) : ${lemmaAt('x')} := by
-  induction x with
-  | zero => (try simp only [${unfold}]); ${close(useLemmas(uses, { op: 'and', xs: r.lemmas.map(l => l.holds) }, { ...argNames, x: '0', fx: recurCall(lean, r, '0') }, lean))}
-  | succ n ih => (try simp only [${unfold}] at ih ⊢); ${close([...step('n'), ...useLemmas(uses, { op: 'and', xs: r.lemmas.map(l => l.holds) }, { ...argNames, x: '(n + 1)', fx: recurCall(lean, r, '(n + 1)') }, lean)])}` : '';
+  first
+  | ${kl ? kl.proof(`${[...r.args.map(recurArg), 'x'].join(' ')}`) : 'fail'}
+  | (induction x with
+    | zero => (try simp only [${unfold}]); ${close(useLemmas(uses, { op: 'and', xs: r.lemmas.map(l => l.holds) }, { ...argNames, x: '0', fx: recurCall(lean, r, '0') }, lean))}
+    | succ n ih => (try simp only [${unfold}] at ih ⊢); ${close([...step('n'), ...useLemmas(uses, { op: 'and', xs: r.lemmas.map(l => l.holds) }, { ...argNames, x: '(n + 1)', fx: recurCall(lean, r, '(n + 1)') }, lean)])})` : '';
     const args = r.args.map(recurArg).join(' ');
     const pairAt = (x, y) => r.between.map(l => `(${surface({ x, fx: recurCall(lean, r, x), y, fy: recurCall(lean, r, y) }).c(l.holds)})`).join(' ∧ ');
-    const between = r.between.length ? `
+    const between = r.between.length ? `${kb?.pre ?? ''}
 -- ${r.between.map(l => l.name).join('; ')}, for every x <= y
 theorem ${lean}_between_by ${binders} (x d : Nat) : ${pairAt('x', '(x + d)')} := by
-  induction d with
-  | zero => simp only [Nat.add_zero]; (repeat' split) <;> omega
-  | succ n ih =>
-    rw [show x + (n + 1) = (x + n) + 1 from by omega]
-    ${r.lemmas.length ? `have := ${lean}_lemmas ${args} (x + n); ` : ''}(try simp only [${unfold}] at ih this ⊢); ${close(step('(x + n)'))}
+  first
+  | ${kb ? kb.proof(`${[...r.args.map(recurArg), 'x', 'd'].join(' ')}`) : 'fail'}
+  | (induction d with
+    | zero => simp only [Nat.add_zero]; (repeat' split) <;> omega
+    | succ n ih =>
+      rw [show x + (n + 1) = (x + n) + 1 from by omega]
+      ${r.lemmas.length ? `have := ${lean}_lemmas ${args} (x + n); ` : ''}(try simp only [${unfold}] at ih this ⊢); ${close(step('(x + n)'))})
 theorem ${lean}_between ${binders} (x y : Nat) (h : x ≤ y) : ${pairAt('x', 'y')} := by
   obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le h
   exact ${lean}_between_by ${args} x d` : '';
@@ -899,45 +945,45 @@ theorem Recur.unpair_pair (a b : Nat) : Recur.unpair ((a + b) * (a + b) + b) = (
   have h := Classical.epsilon_spec (p := fun p : Nat × Nat => (p.1 + p.2) * (p.1 + p.2) + p.2 = (a + b) * (a + b) + b) ⟨(a, b), rfl⟩
   obtain ⟨h1, h2⟩ := Recur.pair_inj h
   exact Prod.ext h1 h2`;
-// The facts, proven in Lean of the functions' Lean definitions, when every function has one: a run that starts with
-// those functions starts where SReach asks the facts to hold. A recurrence's equations unfold its definition (a function
-// of several arguments read at its key first); its lemmas and laws between two points are its theorems at the keys.
-function factsProof(id, m, maps, vars, simp = [], origins = new Map()) {
+function factsProof(id, m, maps, vars, simp = [], at) {
     const fns = Object.entries(m.fns ?? {}), facts = m.facts ?? [];
-    if (!facts.length || !fns.length || fns.some(([, f]) => !f.lean))
+    if (!facts.length || (!at && !fns.length) || fns.some(([, f]) => !f.lean))
         return '';
     const recurs = fns.filter(([, f]) => f.recur);
     simp = [...simp, ...recurs.flatMap(([, f]) => (f.recur.args.length ? [`${f.lean}_rec`, `${f.lean}_key`] : [f.lean]))];
-    const at = leanSurface(Object.fromEntries(vars.map((x, j) => [x, `(ρ ${j})`])), `${id}'s facts`);
     // Each recurrence's key lemma rewrites the function at its key before anything else simplifies the key.
     const keyed = recurs.filter(([, f]) => f.recur.args.length).map(([, f]) => `${f.lean}_key`);
+    const hs = fns.map((_, j) => `h${j}`);
+    // A fact's proof, its keys named: the first `v`, the further ones `w1`, `w2`...: the recurrence theorem it is an
+    // instance of cited first (so that it and the goal simplify alike), then the facts' terms read and omega.
     const tactic = (fact) => {
-        // The theorem a fact is an instance of, cited first so that both it and the goal are simplified alike.
-        const cite = () => {
-            const o = origins.get(fact.name), general = o?.from ?? fact;
-            const owner = recurs.find(([n]) => general.name.startsWith(`${n}: `)), what = owner ? general.name.slice(owner[0].length + 2) : '';
-            if (!owner || !general.forall)
-                return undefined;
-            const [, f] = owner, r = f.recur, keys = [general.forall, ...(general.keys ?? [])];
-            // Each key: the one left (v), or its term, read at the columns.
-            const arg = keys.map(x => (x === fact.forall ? 'v' : `(${at.e(o?.at[x] ?? { op: 'var', name: x })})`));
-            if (r.lemmas.some(l => l.name === what))
-                return `${f.lean}_lemmas ${[...arg.slice(1), arg[0]].join(' ')}`;
-            if (r.between.some(l => l.name === what))
-                return `${f.lean}_between ${[...arg.slice(2), arg[0], arg[1]].join(' ')}`;
-            return undefined;
-        };
-        const c = cite(), hs = [...fns.map((_, j) => `h${j}`)];
-        return `simp only [MLaw.Holds]; (try intro v); ${c ? `have hc := ${c}; ` : ''}simp only [evalC, evalE, upd, ${hs.join(', ')}]${keyed.length ? `; (try simp only [${keyed.join(', ')}])` : ''}; (try simp [${[...hs, ...simp].join(', ')}]${c ? ' at hc ⊢' : ''}); all_goals omega`;
+        const keys = fact.forall ? [fact.forall, ...(fact.keys ?? [])] : [], arg = keys.map((_, i) => (i === 0 ? 'v' : `w${i}`));
+        const owner = recurs.find(([n]) => fact.name.startsWith(`${n}: `)), what = owner ? fact.name.slice(owner[0].length + 2) : '';
+        const r = owner?.[1].recur, lean = owner?.[1].lean;
+        const cite = at?.cite?.(fact) ?? (!r || !keys.length ? undefined : r.lemmas.some(l => l.name === what) ? `${lean}_lemmas ${[...arg.slice(1), arg[0]].join(' ')}`
+            : r.between.some(l => l.name === what) ? `${lean}_between ${[...arg.slice(2), arg[0], arg[1]].join(' ')}` : undefined);
+        const intro = keys.length > 1 ? `simp only [holdsOver]; intro ${arg.slice(1).join(' ')}; ` : '';
+        return `${intro}simp only [MLaw.Holds]; (try intro v); ${cite ? `have hc := ${cite}; ` : ''}simp only [${['evalC', 'evalE', 'upd', ...hs].join(', ')}]${keyed.length ? `; (try simp only [${keyed.join(', ')}])` : ''}; (try simp [${[...hs, ...simp].join(', ')}]${cite ? ' at hc ⊢' : ''}); all_goals ${cite ? 'first | omega | (simpa using hc)' : 'omega'}`;
     };
+    const one = facts.filter(f => !f.keys?.length), several = facts.filter(f => f.keys?.length);
+    const binders = at ? at.binders : `(ρ : Nat → Nat) (μ : Nat → Nat → Nat) ${fns.map(([n, f], j) => `(h${j} : μ ${maps.indexOf(n)} = ${f.lean})`).join(' ')}`;
+    const rho = at ? at.rho : 'ρ', mu = at ? at.mu : 'μ', name = at ? 'at' : 'hold';
+    // At one state and maps, each function's equation is the maps' own definition.
+    const given = at ? fns.map(([n, f], j) => `have h${j} : ${mu} ${maps.indexOf(n)} = (${f.lean}) := rfl\n  `).join('') : '';
+    const cases = (fs, h) => `rcases ${h} with ${fs.map(() => 'rfl').join(' | ')}\n${fs.map(f => `  · ${tactic(f)}`).join('\n')}`;
     return `
--- The facts hold of the functions' Lean definitions: ${fns.map(([n, f]) => `${n} := ${f.lean}`).join('; ')}.
-theorem ${id}_facts_hold (ρ : Nat → Nat) (μ : Nat → Nat → Nat) ${fns.map(([n, f], j) => `(h${j} : μ ${maps.indexOf(n)} = ${f.lean})`).join(' ')} :
-    ∀ l ∈ ${id}_machine.facts, l.Holds ρ μ := by
-  intro l hl
+-- The facts hold of the functions' Lean definitions: ${fns.map(([n, f]) => `${n} := ${f.lean}`).join('; ')}.${one.length ? `
+theorem ${id}_facts_${name} ${binders} :
+    ∀ l ∈ ${id}_machine.facts, l.Holds ${rho} ${mu} := by
+  ${given}intro l hl
   simp only [${id}_machine, List.mem_cons, List.not_mem_nil, or_false] at hl
-  rcases hl with ${facts.map(() => 'rfl').join(' | ')}
-${facts.map(f => `  · ${tactic(f)}`).join('\n')}`;
+  ${cases(one, 'hl')}` : ''}${several.length ? `
+-- The facts about several keys, at every value of their further keys.
+theorem ${id}_pfacts_${name} ${binders} :
+    ${id}_machine.PFacts ${rho} ${mu} := by
+  ${given}intro p hp
+  simp only [${id}_machine, List.mem_cons, List.not_mem_nil, or_false] at hp
+  ${cases(several, 'hp')}` : ''}`;
 }
 // Machines with a history through Kern.hmachine_sound (History.lean): Lean builds the plain machine (sums as state,
 // relations in the assumption) and each relation's record goal; the trees and the instance keys are the kernel's.