gdp-wired 0.7.0 → 0.9.0

package/dist/core/gdp.d.ts

@@ -1,16 +1,13 @@
 import type { Named, NamesOf, Proof, Prover } from '@gdp-ts/core';
-import { type Decision, type Fun, type Rule, type StepLaw, type Verdict } from './dsl.js';
+import { type Decision, type Fun, type Rule, type StepLaw, Unproven } from './dsl.js';
 import { type Law, type State } from './machine.js';
 type AnyNamed = Named<any, any>;
 export type Mint<K extends string, A> = <S extends AnyNamed[]>(args: A, ...about: S) => Proof<K, NamesOf<S>> | null;
-export declare class Unproven extends Error {
-    readonly verdict: Verdict;
-    constructor(what: string, verdict: Verdict);
-}
+export { Unproven };
 type AnyFun = Fun<any, any, any>;
 type Conditions<O> = {
-    [k in keyof O]: O[k] extends boolean ? k : never;
-}[keyof O] & string;
+    [k in keyof O & string]: O[k] extends boolean ? k : O[k] extends Record<string, unknown> ? `${k}.${Conditions<O[k]>}` : never;
+}[keyof O & string];
 type ArgsOf<F extends AnyFun> = Parameters<F['run']>[0];
 type ParamsOf<F extends AnyFun> = NonNullable<Parameters<F['run']>[1]>;
 export declare function guard<K extends string, F extends AnyFun>(prover: Prover<K>, fn: F, field: Conditions<ReturnType<F['run']>>, opts: {
@@ -32,4 +29,3 @@ export declare function gate<K extends string, R extends AnyRule>(prover: Prover
     params?: RuleParams<R>;
     state?: State;
 }): Gate<K, InputOf<R>>;
-export {};

package/dist/core/gdp.js

@@ -1,17 +1,10 @@
-import { funOf, proveDecision, proveSteps } from "./dsl.js";
+import { Unproven, funOf, proveDecision, proveSteps } from "./dsl.js";
 import { evalC, interpret } from "./machine.js";
 import { allowed, requestEnv } from "./watch.js";
-// A verdict that isn't a checked proof, as the error a guard or gate is refused with (the verdict on `.verdict`).
-export class Unproven extends Error {
-    verdict;
-    constructor(what, verdict) {
-        const found = [verdict.goal && `goal ${verdict.goal}`, verdict.stuck, verdict.witness && `a counterexample: ${JSON.stringify(verdict.witness)}`, verdict.why].filter(Boolean).join('; ');
-        super(`${what}: ${verdict.proven ? 'proven, but the kernel did not check the proof' : `not proven${found ? ` (${found})` : ''}`}`);
-        this.verdict = verdict;
-    }
-}
+export { Unproven };
 const proven = (what, v) => { if (!(v.proven && v.checked))
     throw new Unproven(what, v); };
+const atPath = (o, path) => path.split('.').reduce((x, f) => (typeof x === 'object' && x !== null ? x[f] : undefined), o);
 // A proof wherever `fn`'s result `field` holds. Every law in `laws` must have been stated about `fn` (fn.law or
 // fn.relate) and is proven now; the arguments it is later called with must meet the function's kinds and `assume`.
 //   const access = fun('document access').inputs({...}).returns(env => ({permit: permit(env)}))
@@ -31,7 +24,7 @@ export function guard(prover, fn, field, opts) {
         const input = r.encodeInput(args);
         if (m.assume && !evalC(m.assume, { ...ps, ...input }, { scalars: {}, maps: {} }, m))
             return null;
-        return fn.run(args, params)[field] === true ? prover.prove(...about) : null;
+        return atPath(fn.run(args, params), field) === true ? prover.prove(...about) : null;
     };
 }
 // A proof for each request whose step takes `flag`, the rule's laws (and step laws) proven now. One gate holds one

package/dist/core/machine.d.ts

@@ -70,6 +70,34 @@ export type Machine = {
 export type Fn = {
     js: string;
     lean?: string;
+    recur?: Recurrence;
+};
+export type Recurrence = {
+    args: string[];
+    zero: E;
+    next: E;
+    lemmas: {
+        name: string;
+        holds: C;
+    }[];
+    between: {
+        name: string;
+        holds: C;
+    }[];
+    uses: Record<string, {
+        arity: number;
+        lean?: string;
+    }>;
+    proofs?: {
+        lemmas?: {
+            machine: Machine;
+            laws: Law[];
+        };
+        between?: {
+            machine: Machine;
+            laws: Law[];
+        };
+    };
 };
 export type History = {
     keep: C;

package/dist/kernel/prove.js

@@ -448,13 +448,50 @@ function fnKeys(m, goals) {
 // value that makes one of its reads one of these (by matching: a function of several arguments reads a paired key), and
 // at the keys themselves.
 const withFacts = (m, inst, keys) => ({ ...inst, ...Object.fromEntries((m.facts ?? []).filter(f => f.forall).map(f => {
-        if (f.keys?.length)
-            return [f.name, tuples(keys, f.keys.length + 1)];
+        if (f.keys?.length) {
+            // A fact about several keys reads a function of several arguments (at a paired key): each read matched against the
+            // keys the goals read binds some of the fact's keys; one match, or two that agree, binding every key is an instance.
+            const vars = [f.forall, ...f.keys], reads = fnKeys(m, [{ name: '', hyps: [f.holds] }]);
+            if (!reads.length)
+                return [f.name, tuples(keys, vars.length)];
+            const partial = reads.flatMap(pattern => keys.flatMap(key => { const b = matchMany(pattern, key, vars); return b ? [b] : []; }));
+            const whole = (b) => vars.every(x => x in b);
+            const agree = (a, b) => Object.entries(b).every(([x, e]) => !(x in a) || JSON.stringify(a[x]) === JSON.stringify(e));
+            const found = [...partial.filter(whole), ...partial.flatMap((a, i) => partial.slice(i + 1).filter(b => agree(a, b)).map(b => ({ ...a, ...b })).filter(whole))];
+            const had = inst[f.name] ?? [], out = [...had], seen = new Set();
+            for (let t = 0; t < had.length / vars.length; t++)
+                seen.add(JSON.stringify(had.slice(t * vars.length, (t + 1) * vars.length)));
+            for (const b of found) {
+                const tuple = vars.map(x => b[x]), id = JSON.stringify(tuple);
+                if (!seen.has(id)) {
+                    seen.add(id);
+                    out.push(...tuple);
+                }
+            }
+            return [f.name, out];
+        }
         const had = inst[f.name] ?? [], seen = new Set(had.map(e => JSON.stringify(e)));
         const reads = fnKeys(m, [{ name: '', hyps: [f.holds] }]);
         const at = [...keys, ...reads.flatMap(pattern => keys.flatMap(key => { const b = match(pattern, key, f.forall); return b ? [b] : []; }))];
         return [f.name, [...had, ...at.filter(e => { const id = JSON.stringify(e); return seen.has(id) ? false : (seen.add(id), true); })]];
     })) });
+// The values of the names in xs that make pattern the term, for those it reads, if some do (structurally).
+function matchMany(pattern, term, xs) {
+    const bound = {};
+    const go = (p, t) => {
+        if (p.op === 'var' && xs.includes(p.name)) {
+            if (p.name in bound)
+                return JSON.stringify(bound[p.name]) === JSON.stringify(t);
+            bound[p.name] = t;
+            return true;
+        }
+        if (p.op !== t.op)
+            return false;
+        const pe = Object.entries(p), te = t;
+        return pe.every(([k, val]) => k === 'op' || (typeof val === 'object' && val !== null ? (Array.isArray(val) ? Array.isArray(te[k]) && te[k].length === val.length && val.every((y, i) => go(y, te[k][i])) : go(val, te[k])) : val === te[k]));
+    };
+    return go(pattern, term) ? bound : undefined;
+}
 // The value of x that makes pattern the term, if one does (structurally).
 function match(pattern, term, x) {
     let bound;

package/dist/lean-kernel/emit.d.ts

@@ -1,4 +1,4 @@
-import type { C, E, Law, Machine } from '../core/machine.js';
+import type { C, E, Law, Machine, Recurrence } from '../core/machine.js';
 import { type Step } from '../core/solver.js';
 import { type Fold, type Goal, type Instances, type Liveness, type Loop, type Path, type StepLaw, type Tree } from '../kernel/kernel.js';
 import { leanLibrary } from './library.js';
@@ -92,7 +92,15 @@ export declare function smachineToLean(id: string, given: Machine, laws: Law[],
             loop: Loop;
         };
     };
+    noFacts?: boolean;
 }): string;
+type Uses = Record<string, {
+    lean?: string;
+    recur?: Recurrence;
+    arity: number;
+}>;
+export declare function recurToLean(lean: string, r: Recurrence, uses?: Uses): string;
+export declare const recurPairing = "theorem Recur.pair_inj {a b c d : Nat} (h : (a + b) * (a + b) + b = (c + d) * (c + d) + d) : a = c \u2227 b = d := by\n  have sq : \u2200 s t : Nat, s < t \u2192 s * s + s < t * t := by\n    intro s t hst\n    have h1 : (s + 1) * (s + 1) \u2264 t * t := Nat.mul_le_mul hst hst\n    have h2 : (s + 1) * (s + 1) = s * s + s + s + 1 := by simp only [Nat.add_mul, Nat.mul_add, Nat.mul_one, Nat.one_mul]; omega\n    omega\n  have hb : b \u2264 a + b := Nat.le_add_left b a\n  have hd : d \u2264 c + d := Nat.le_add_left d c\n  rcases Nat.lt_trichotomy (a + b) (c + d) with hlt | heq | hgt\n  \u00B7 have := sq _ _ hlt; omega\n  \u00B7 rw [heq] at h; omega\n  \u00B7 have := sq _ _ hgt; omega\nnoncomputable def Recur.unpair (k : Nat) : Nat \u00D7 Nat :=\n  Classical.epsilon fun p : Nat \u00D7 Nat => (p.1 + p.2) * (p.1 + p.2) + p.2 = k\ntheorem Recur.unpair_pair (a b : Nat) : Recur.unpair ((a + b) * (a + b) + b) = (a, b) := by\n  have h := Classical.epsilon_spec (p := fun p : Nat \u00D7 Nat => (p.1 + p.2) * (p.1 + p.2) + p.2 = (a + b) * (a + b) + b) \u27E8(a, b), rfl\u27E9\n  obtain \u27E8h1, h2\u27E9 := Recur.pair_inj h\n  exact Prod.ext h1 h2";
 export declare function hmachineToLean(id: string, m: Machine, laws: Law[], tampers?: {
     what: string;
     relations: {

package/dist/lean-kernel/emit.js

@@ -3,7 +3,7 @@ import { add, k, scale, sub } from "../core/solver.js";
 import { canon, columnTerm, stateName, termColumn, historyMachine, foldObligations, leafConstraints, loopLiveness, loopMachine, linear, livenessHelpful, livenessParts, livenessRanks, loopObligations, trueC, obligations, progressObligations, stepLawObligations, substC, withProducts } from "../kernel/kernel.js";
 import { grow, proveBuilt, proveLaws, proveStepLaws } from "../kernel/prove.js";
 import { refinement, refinementSides } from "../core/compose.js";
-import { leanTerms } from "./lean-terms.js";
+import { leanSurface, leanTerms } from "./lean-terms.js";
 import { leanLibrary } from "./library.js";
 export { leanLibrary };
 // --- to Lean ------------------------------------------------------------------------------------------------------------
@@ -474,8 +474,8 @@ const boundKeys = (m) => [...Object.values(m.step.flags ?? {}).flatMap(c => (c.o
 // `historyTampers`: the history with other relations, each refused.
 export function smachineToLean(id, given, laws, opts = {}) {
     const hm = given.history ? { ...given, history: { ...given.history, prune: undefined } } : undefined;
-    const hplain = hm ? historyMachine(hm) : undefined, m = hplain ? hplain.machine : given;
-    const stepLaws = opts.stepLaws ?? [], rf = opts.refined, gv = opts.ghosts ?? [];
+    const hplain = hm ? historyMachine(hm) : undefined, stepLaws = opts.stepLaws ?? [], rf = opts.refined, gv = opts.ghosts ?? [];
+    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,24 +760,230 @@ 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, opts.simp)}${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)}` : ''}`;
 }
-// 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.
-function factsProof(id, m, maps, simp = []) {
+// 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
+// function the machine reads is its key's (`<name>`, through Recur.unpair: the arguments paired as the builders pair
+// them, (a + b)² + b, which Recur.pair_inj proves injective). The kernel proved the lemmas by the same inductions; Lean
+// proves them again of the definition.
+const recurArg = (a) => `«${a}»`;
+// The arguments a key was paired from (the builders' argsKey: left-nested (k + a)² + a), if it was.
+const unpairKey = (key, n) => {
+    if (n === 1)
+        return [key];
+    if (key.op !== 'add' || key.a.op !== 'prod' || key.a.a.op !== 'add')
+        return undefined;
+    const s = key.a.a, b = key.b;
+    if (JSON.stringify(key.a.b) !== JSON.stringify(s) || JSON.stringify(s.b) !== JSON.stringify(b))
+        return undefined;
+    const rest = unpairKey(s.a, n - 1);
+    return rest ? [...rest, b] : undefined;
+};
+// f at x (and the further arguments), as Lean reads it.
+const recurCall = (lean, r, x, args = r.args.map(recurArg)) => (r.args.length ? `(${lean}_rec ${[...args, x].join(' ')})` : `(${lean} ${x})`);
+// A read of a function the recurrence uses: a recurrence by its definition at the unpaired arguments, any other by its
+// Lean term at the key.
+const useRead = (uses, where) => (map, key, e) => {
+    const u = uses[map];
+    if (!u?.lean)
+        throw new Error(`${where}: ${map} has no Lean definition`);
+    if (u.recur) {
+        const args = unpairKey(key, u.arity);
+        if (!args)
+            throw new Error(`${where}: ${map} read at a key not paired by its arguments`);
+        return recurCall(u.lean, u.recur, e(args[0]), args.slice(1).map(e));
+    }
+    return `((${u.lean}) ${e(key)})`;
+};
+// The lemmas of the recurrences a term reads, at the keys it reads them, with the names as given.
+const useLemmas = (uses, t, names, where) => {
+    const out = [];
+    const walk = (x) => {
+        if (!x || typeof x !== 'object')
+            return;
+        const o = x;
+        if (o.op === 'get' && o.map) {
+            const u = uses[o.map];
+            if (u?.recur?.lemmas.length) {
+                const args = unpairKey(o.key, u.arity), s = leanSurface(names, where, useRead(uses, where)).e;
+                out.push(`have := ${u.lean}_lemmas ${[...args.slice(1).map(s), s(args[0])].join(' ')}`);
+            }
+        }
+        for (const v of Object.values(o))
+            walk(v);
+    };
+    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;
+    const read = useRead(uses, lean);
+    const surface = (names) => leanSurface({ ...argNames, ...names }, lean, read);
+    const text = JSON.stringify(r), unfold = [self, ...(text.includes('"op":"min"') ? ['Nat.min_def'] : []), ...(text.includes('"op":"max"') ? ['Nat.max_def'] : [])].join(', ');
+    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);
+    // 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
+  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 ? `${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
+  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` : '';
+    const zero = surface({}).e(r.zero), next = surface({ x: 'x', prev: recurCall(lean, r, 'x') }).e(r.next);
+    if (!r.args.length)
+        return `def ${lean} : Nat → Nat\n  | 0 => ${zero}\n  | x + 1 => ${next}${lemmas}${between}`;
+    // The key's function: the arguments unpaired, innermost first.
+    const u = (i) => (i === r.args.length ? '(Recur.unpair k)' : `(Recur.unpair ${u(i + 1)}.1)`);
+    const keyOf = (x) => r.args.map(recurArg).reduce((k, a) => `((${k} + ${a}) * (${k} + ${a}) + ${a})`, x);
+    return `def ${self} ${binders} : Nat → Nat
+  | 0 => ${zero}
+  | x + 1 => ${next}
+noncomputable def ${lean} (k : Nat) : Nat := ${self} ${r.args.map((_, i) => `${u(i + 1)}.2`).join(' ')} ${u(1)}.1
+theorem ${lean}_key ${binders} (x : Nat) : ${lean} ${keyOf('x')} = ${self} ${args} x := by
+  simp only [${lean}, Recur.unpair_pair]${lemmas}${between}`;
+}
+// The pairing the builders read a function of several arguments by, and Lean's inverse of it (choice over the pairs:
+// Recur.pair_inj makes it the pair).
+export const recurPairing = `theorem Recur.pair_inj {a b c d : Nat} (h : (a + b) * (a + b) + b = (c + d) * (c + d) + d) : a = c ∧ b = d := by
+  have sq : ∀ s t : Nat, s < t → s * s + s < t * t := by
+    intro s t hst
+    have h1 : (s + 1) * (s + 1) ≤ t * t := Nat.mul_le_mul hst hst
+    have h2 : (s + 1) * (s + 1) = s * s + s + s + 1 := by simp only [Nat.add_mul, Nat.mul_add, Nat.mul_one, Nat.one_mul]; omega
+    omega
+  have hb : b ≤ a + b := Nat.le_add_left b a
+  have hd : d ≤ c + d := Nat.le_add_left d c
+  rcases Nat.lt_trichotomy (a + b) (c + d) with hlt | heq | hgt
+  · have := sq _ _ hlt; omega
+  · rw [heq] at h; omega
+  · have := sq _ _ hgt; omega
+noncomputable def Recur.unpair (k : Nat) : Nat × Nat :=
+  Classical.epsilon fun p : Nat × Nat => (p.1 + p.2) * (p.1 + p.2) + p.2 = k
+theorem Recur.unpair_pair (a b : Nat) : Recur.unpair ((a + b) * (a + b) + b) = (a, b) := by
+  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`;
+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]))];
+    // 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) => {
+        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(' | ')} <;> (simp only [MLaw.Holds]; try intro v); all_goals (simp [evalC, evalE, upd, ${[...fns.map((_, j) => `h${j}`), ...simp].join(', ')}]; try omega)`;
+  ${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.
@@ -777,6 +1002,25 @@ export function toLean(items, opts = {}) {
     const ident = (id) => { const s = id.replace(/[^A-Za-z0-9_]/g, '_'); return /^[A-Za-z]/.test(s) ? s : `x_${s}`; };
     const parts = [], theorems = [];
     let goals = 0;
+    // Each recurrence defined once, before the first item that reads it.
+    const recurs = new Map();
+    const recurDefs = (m) => Object.entries(m.fns ?? {}).filter(([, f]) => f.recur).map(([n, f]) => {
+        // The functions it reads are the machine's <n>.<use>, defined before it (flatFns puts them first).
+        const uses = Object.fromEntries(Object.entries(f.recur.uses).map(([u, d]) => { const g = m.fns?.[`${n}.${u}`]; return [u, { ...d, ...(g?.recur ? { recur: g.recur } : {}) }]; }));
+        const text = recurToLean(f.lean, f.recur, uses), had = recurs.get(f.lean);
+        if (had !== undefined) {
+            if (had !== text)
+                throw new Error(`${f.lean}: two recurrences of one name`);
+            return '';
+        }
+        const pairing = f.recur.args.length && !recurs.has('') ? (recurs.set('', recurPairing), `${recurPairing}\n`) : '';
+        recurs.set(f.lean, text);
+        if (f.recur.lemmas.length)
+            theorems.push(`${f.lean}_lemmas`);
+        if (f.recur.between.length)
+            theorems.push(`${f.lean}_between`);
+        return `${pairing}${text}\n`;
+    }).join('');
     for (let item of items) {
         const id = ident(item.id);
         if ('machine' in item) {
@@ -791,7 +1035,7 @@ export function toLean(items, opts = {}) {
             }
             // One twin: every machine goes to Lean as a machine with sets (one with none, if it has none): its laws, step laws,
             // liveness and ghosts in one export; a machine with a history as its plain machine, and its laws over histories.
-            parts.push(`-- ${item.id}\n${item.lean?.defs ? `${item.lean.defs}\n` : ''}${smachineToLean(id, m, item.laws, { stepLaws: item.stepLaws, ...(item.liveness?.length ? { liveness: item.liveness } : {}),
+            parts.push(`-- ${item.id}\n${recurDefs(m)}${item.lean?.defs ? `${item.lean.defs}\n` : ''}${smachineToLean(id, m, item.laws, { stepLaws: item.stepLaws, ...(item.liveness?.length ? { liveness: item.liveness } : {}),
                 ...(item.ghosts?.length ? { ghosts: item.ghosts } : {}), ...(item.lean?.simp ? { simp: item.lean.simp } : {}), ...(item.lean?.after ? { after: item.lean.after } : {}) })}`);
             theorems.push(`${id}_laws`, ...(m.history ? [`${id}_hlaws`] : []), ...(item.stepLaws ?? []).map((_, j) => `${id}_step${j}_holds`), ...(item.liveness ?? []).map((_, j) => `${id}_live${j}_holds`));
             if (item.lean?.after)

package/dist/lean-kernel/lean-terms.d.ts

@@ -3,3 +3,7 @@ export declare function leanTerms(vars: readonly string[], maps: readonly string
     e: (t: E) => string;
     c: (t: C) => string;
 };
+export declare function leanSurface(names: Record<string, string>, where: string, get?: (map: string, key: E, e: (t: E) => string) => string): {
+    e: (t: E) => string;
+    c: (t: C) => string;
+};

package/dist/lean-kernel/lean-terms.js

@@ -42,3 +42,41 @@ export function leanTerms(vars, maps, where) {
     };
     return { e, c };
 }
+// Terms and conditions as plain Lean over Nat (a recurrence's definition and its lemmas): each variable as the Lean
+// expression `names` gives it.
+export function leanSurface(names, where, get) {
+    const name = (n) => { const s = names[n]; if (s === undefined)
+        throw new Error(`${where}: no Lean expression for ${n}`); return s; };
+    const e = (t) => {
+        switch (t.op) {
+            case 'var': return name(t.name);
+            case 'const': return String(t.value);
+            case 'mul': return `(${t.k} * ${e(t.a)})`;
+            case 'add': return `(${e(t.a)} + ${e(t.b)})`;
+            case 'sub': return `(${e(t.a)} - ${e(t.b)})`;
+            case 'prod': return `(${e(t.a)} * ${e(t.b)})`;
+            case 'min':
+            case 'max': return `(${t.op} ${e(t.a)} ${e(t.b)})`;
+            case 'if': return `(if ${c(t.c)} then ${e(t.then)} else ${e(t.else)})`;
+            case 'get':
+                if (!get)
+                    throw new Error(`${where}: reads ${t.map}, a function or a map`);
+                return get(t.map, t.key, e);
+            default: return unreachable(t);
+        }
+    };
+    const c = (t) => {
+        switch (t.op) {
+            case '<=': return `${e(t.a)} ≤ ${e(t.b)}`;
+            case '<': return `${e(t.a)} < ${e(t.b)}`;
+            case '=': return `${e(t.a)} = ${e(t.b)}`;
+            case 'not': return `¬(${c(t.x)})`;
+            case 'and':
+            case 'or': return t.xs.length === 0 ? (t.op === 'and' ? 'True' : 'False') : `(${t.xs.map(c).join(t.op === 'and' ? ' ∧ ' : ' ∨ ')})`;
+            case 'flag':
+            case 'all': throw new Error(`${where}: takes no flag or quantifier`);
+            default: return unreachable(t);
+        }
+    };
+    return { e, c };
+}