gdp-wired 0.6.0 → 0.8.0

package/dist/core/gdp.d.ts

@@ -0,0 +1,31 @@
+import type { Named, NamesOf, Proof, Prover } from '@gdp-ts/core';
+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 { Unproven };
+type AnyFun = Fun<any, any, any>;
+type Conditions<O> = {
+    [k in keyof O]: O[k] extends boolean ? 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: {
+    laws: Decision[];
+    params?: ParamsOf<F>;
+}): Mint<K, ArgsOf<F>>;
+type AnyRule = Rule<any, any, any, any, any, any, any, any>;
+type FlagOf<R> = R extends Rule<any, any, any, any, infer F, any, any, any> ? keyof F & string : never;
+type InputOf<R extends AnyRule> = Parameters<R['encodeInput']>[0];
+type RuleParams<R extends AnyRule> = Parameters<R['encodeParams']>[0];
+export type Gate<K extends string, I> = {
+    request: Mint<K, I>;
+    readonly state: State;
+    values(): Record<string, unknown>;
+};
+export declare function gate<K extends string, R extends AnyRule>(prover: Prover<K>, r: R, flag: FlagOf<R>, opts: {
+    laws: Law[];
+    stepLaws?: StepLaw[];
+    params?: RuleParams<R>;
+    state?: State;
+}): Gate<K, InputOf<R>>;

package/dist/core/gdp.js

@@ -0,0 +1,58 @@
+import { Unproven, funOf, proveDecision, proveSteps } from "./dsl.js";
+import { evalC, interpret } from "./machine.js";
+import { allowed, requestEnv } from "./watch.js";
+export { Unproven };
+const proven = (what, v) => { if (!(v.proven && v.checked))
+    throw new Unproven(what, v); };
+// 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)}))
+//   const mint = guard(CanRead, access, 'permit', {laws: [access.law('...', ...)]})
+export function guard(prover, fn, field, opts) {
+    if (opts.laws.length === 0)
+        throw new Error(`${fn.name}: a guard needs a law to prove`);
+    for (const d of opts.laws) {
+        if (funOf(d) !== fn)
+            throw new Error(`${fn.name}: "${d.name}" was not stated about this function (state it with ${fn.name}.law)`);
+        proven(`${fn.name}: "${d.name}"`, proveDecision(d));
+    }
+    const r = fn.rule, m = r.machine, params = (opts.params ?? {}), ps = r.encodeParams(params);
+    if (m.pre && !evalC(m.pre, ps, { scalars: {}, maps: {} }, m))
+        throw new Error(`${fn.name}: the params ${JSON.stringify(params)} don't meet its precondition`);
+    return (args, ...about) => {
+        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;
+    };
+}
+// A proof for each request whose step takes `flag`, the rule's laws (and step laws) proven now. One gate holds one
+// run's state: keep one per state it guards (per process, or loaded and saved around each request in a transaction).
+//   const tokens = rule('one-time tokens').inputs({...}).maps({...}).flags(env => ({redeem: ...})).step(...)
+//   const redeem = gate(Redeemed, tokens, 'redeem', {laws: tokenLaws})
+//   redeem.request({op: 'redeem', token: 7}, user, token) // a Redeemed proof the first time, null after
+export function gate(prover, r, flag, opts) {
+    const m = r.machine;
+    if (!(flag in (m.step.flags ?? {})))
+        throw new Error(`${m.name}: no flag ${flag}`);
+    if (opts.laws.length + (opts.stepLaws?.length ?? 0) === 0)
+        throw new Error(`${m.name}: a gate needs a law to prove`);
+    proven(m.name, proveSteps(r, opts.laws, opts.stepLaws ?? []));
+    const params = (opts.params ?? {}), ps = r.encodeParams(params);
+    if (m.pre && !evalC(m.pre, ps, { scalars: {}, maps: {} }, m))
+        throw new Error(`${m.name}: the params ${JSON.stringify(params)} don't meet its precondition`);
+    const run = interpret(m), compiled = r.compiled();
+    let st = opts.state ?? compiled.init(ps);
+    return {
+        request: (args, ...about) => {
+            const input = r.encodeInput(args);
+            if (!allowed(m, run, ps, st, input))
+                return null;
+            const granted = requestEnv(m, run, ps, st, input)[`?${flag}`] === 1;
+            st = compiled.step(ps, st, input);
+            return granted ? prover.prove(...about) : null;
+        },
+        get state() { return st; },
+        values: () => r.decode(st),
+    };
+}

package/dist/core/machine.d.ts

@@ -70,6 +70,24 @@ 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;
+    }>;
 };
 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';
@@ -93,6 +93,13 @@ export declare function smachineToLean(id: string, given: Machine, laws: Law[],
         };
     };
 }): 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 { machine: m, origins } = specializeFacts(hplain ? hplain.machine : given, laws, stepLaws);
     const claims = [];
     const claimSteps = () => claims.flatMap(cl => cl.steps);
     // The machine's own step laws, one step or k (Sets.lean's skstep_sound).
@@ -741,24 +741,203 @@ 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` })}${factsProof(id, m, mapNames, vars, opts.simp, origins)}${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
+// 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)];
+};
+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);
+    const lemmas = r.lemmas.length ? `
+-- ${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)])}` : '';
+    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 ? `
+-- ${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)'))}
+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`;
 // 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 = []) {
+// 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()) {
     const fns = Object.entries(m.fns ?? {}), facts = m.facts ?? [];
     if (!facts.length || !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 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`;
+    };
     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
   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)`;
+  rcases hl with ${facts.map(() => 'rfl').join(' | ')}
+${facts.map(f => `  · ${tactic(f)}`).join('\n')}`;
 }
 // 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 +956,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 +989,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 };
+}

package/package.json

@@ -1,6 +1,6 @@
 {
   "name": "gdp-wired",
-  "version": "0.6.0",
+  "version": "0.8.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",
@@ -9,6 +9,7 @@
     "state-machine",
     "rate-limiting",
     "policy",
+    "gdp-ts",
     "lean",
     "automatic-prover",
     "theorem-prover",
@@ -59,6 +60,10 @@
       "types": "./dist/core/solver.d.ts",
       "default": "./dist/core/solver.js"
     },
+    "./gdp": {
+      "types": "./dist/core/gdp.d.ts",
+      "default": "./dist/core/gdp.js"
+    },
     "./package.json": "./package.json"
   },
   "files": [
@@ -69,6 +74,14 @@
   "engines": {
     "node": ">=20"
   },
+  "peerDependencies": {
+    "@gdp-ts/core": ">=0.1.0"
+  },
+  "peerDependenciesMeta": {
+    "@gdp-ts/core": {
+      "optional": true
+    }
+  },
   "scripts": {
     "typecheck": "tsc -p .",
     "lint": "oxlint --type-aware --deny-warnings --disable-nested-config",
@@ -76,13 +89,14 @@
     "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 && 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/composition.ts && bun examples/sets.ts && bun examples/quantifiers.ts && bun examples/functions.ts && bun examples/lists.ts && bun examples/sizes.ts && bun examples/liveness.ts && bun examples/budget.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 && 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/composition.ts && bun examples/sets.ts && bun examples/quantifiers.ts && bun examples/functions.ts && bun examples/datatypes.ts && bun examples/lemmas.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",
     "@types/bun": "1.3.1",
-    "typescript": "5.9.3",
     "@webgpu/types": "0.1.66",
     "oxlint": "1.88.0",
-    "oxlint-tsgolint": "7.0.2004"
+    "oxlint-tsgolint": "7.0.2004",
+    "typescript": "5.9.3"
   }
 }