gdp-wired 0.5.0 → 0.7.0
This diff represents the content of publicly available package versions that have been released to one of the supported registries. The information contained in this diff is provided for informational purposes only and reflects changes between package versions as they appear in their respective public registries.
- package/README.md +59 -6
- package/dist/core/dsl.d.ts +1 -0
- package/dist/core/dsl.js +7 -2
- package/dist/core/gdp.d.ts +35 -0
- package/dist/core/gdp.js +66 -0
- package/dist/kernel/kernel.d.ts +2 -0
- package/dist/kernel/kernel.js +19 -17
- package/dist/lean-kernel/emit.d.ts +17 -2
- package/dist/lean-kernel/emit.js +78 -123
- package/dist/lean-kernel/library.js +3 -3
- package/package.json +18 -4
package/dist/lean-kernel/emit.js
CHANGED
|
@@ -1,6 +1,6 @@
|
|
|
1
1
|
import { atMost, n, not, pointWrite } from "../core/machine.js";
|
|
2
2
|
import { add, k, scale, sub } from "../core/solver.js";
|
|
3
|
-
import { canon, columnTerm, stateName, termColumn, historyMachine, foldObligations, leafConstraints, linear, livenessHelpful, livenessParts, livenessRanks, loopObligations, trueC, obligations, progressObligations, stepLawObligations, substC, withProducts } from "../kernel/kernel.js";
|
|
3
|
+
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";
|
|
4
4
|
import { grow, proveBuilt, proveLaws, proveStepLaws } from "../kernel/prove.js";
|
|
5
5
|
import { refinement, refinementSides } from "../core/compose.js";
|
|
6
6
|
import { leanTerms } from "./lean-terms.js";
|
|
@@ -244,36 +244,11 @@ theorem ${id}_laws : ∀ maps ρ, Reach ${id}_machine maps ρ → ∀ l ∈ ${id
|
|
|
244
244
|
export const TRUE = '.le (.const 0) (.const 0)';
|
|
245
245
|
export const grown = (g) => { const o = grow(g); if (!('tree' in o))
|
|
246
246
|
throw new Error(`${g.name}: stuck`); return o.tree; };
|
|
247
|
-
// Loops through Kern.
|
|
247
|
+
// Loops through Kern.loop_halts_of: the loop's machine (Live.lean's Loop.machine) with its invariants as laws, and its
|
|
248
|
+
// halting as a liveness (kernel.ts's loopMachine, loopLiveness); the trees are the kernel's.
|
|
248
249
|
export function loopToLean(id, l, laws, rank, tamper) {
|
|
249
|
-
|
|
250
|
-
|
|
251
|
-
const enc = (g, tree = grown(g)) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars);
|
|
252
|
-
const any0 = enc(gs[0], { leaf: [] });
|
|
253
|
-
const ix = (name) => vars.indexOf(name);
|
|
254
|
-
const lit = (lp) => `⟨${list(lp.inputs.map(name => String(ix(name))))},
|
|
255
|
-
${list(Object.entries(lp.state).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
256
|
-
${list(Object.entries(lp.body).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
257
|
-
${any0.c(lp.while)},
|
|
258
|
-
${lp.pre ? any0.c(lp.pre) : TRUE},
|
|
259
|
-
${lp.assume ? any0.c(lp.assume) : TRUE}⟩`;
|
|
260
|
-
const proof = laws.map((law, j) => {
|
|
261
|
-
const s2 = enc(gs[2 * j]), t = enc(gs[2 * j + 1]);
|
|
262
|
-
return `(${any0.c(law.holds)},\n (${s2.tab}, ${s2.tree}),\n (${t.tab}, ${t.tree}))`;
|
|
263
|
-
});
|
|
264
|
-
const r = enc(gs.at(-1));
|
|
265
|
-
const ranks = Array.isArray(rank) ? rank : [rank];
|
|
266
|
-
return `-- ${l.name}: halts with ranks ${JSON.stringify(ranks.length)}${laws.length ? `, invariants ${laws.map(law => law.name).join('; ')}` : ''} (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
267
|
-
def ${id}_loop : Loop := ${lit(l)}
|
|
268
|
-
def ${id}_proof : LoopProof := ⟨${list(proof)},
|
|
269
|
-
${list(ranks.map(any0.e))},
|
|
270
|
-
(${r.tab}, ${r.tree})⟩
|
|
271
|
-
theorem ${id}_halts : ∀ maps ρ0, evalC ρ0 maps ${id}_loop.pre = true →
|
|
272
|
-
¬ ∃ f : Nat → Nat → Nat, f 0 = applyS ${id}_loop.init ρ0 maps ∧ ∀ n, Turn ${id}_loop maps (f n) (f (n + 1)) :=
|
|
273
|
-
loop_sound ${id}_loop ${id}_proof (by decide +kernel)${tamper ? `
|
|
274
|
-
-- TAMPERED: ${tamper.what}. Lean computes the check to false.
|
|
275
|
-
def ${id}_tampered : Loop := ${lit(tamper.loop)}
|
|
276
|
-
example : checkLoop ${id}_tampered ${id}_proof = false := by decide +kernel` : ''}`;
|
|
250
|
+
loopObligations(l, laws, rank);
|
|
251
|
+
return smachineToLean(id, loopMachine(l), laws, { liveness: [loopLiveness(l, rank)], loop: { loop: l, ...(tamper ? { tamper } : {}) } });
|
|
277
252
|
}
|
|
278
253
|
// Folds through Kern.fold_sound: Lean builds the leaf and node goals; the trees are the kernel's.
|
|
279
254
|
export function foldToLean(id, f, laws, extra = '') {
|
|
@@ -441,7 +416,8 @@ theorem ${pc.id}_holds : ProgressHolds ${id}_machine ${pc.id} :=
|
|
|
441
416
|
def ${pc.id}_tampered : Progress := ${record(pc.tamper.when)}
|
|
442
417
|
example : checkProgress ${id}_machine ${id}_proof ${pc.id}_tampered = false := by decide +kernel` : ''}`;
|
|
443
418
|
});
|
|
444
|
-
// Step laws through Kern.steplaw_sound: `when` and `then` sent with the flags inlined (as kernel.ts's goal has them)
|
|
419
|
+
// Step laws through Kern.steplaw_sound: `when` and `then` sent with the flags inlined (as kernel.ts's goal has them);
|
|
420
|
+
// a law over several steps goes through smachineToLean.
|
|
445
421
|
const sp = opts.stepLaws?.length ? proveStepLaws(m, laws, opts.stepLaws) : undefined;
|
|
446
422
|
if (opts.stepLaws?.length && (!sp?.proven || !sp.proof))
|
|
447
423
|
throw new Error(`${id}: step laws not proven`);
|
|
@@ -452,9 +428,11 @@ example : checkProgress ${id}_machine ${id}_proof ${pc.id}_tampered = false := b
|
|
|
452
428
|
const insts = laws.flatMap((l, li) => (l.forall ? (sp.proof.instances[l.name] ?? []).map(key => `(${li}, ${any0.e(key)})`) : []));
|
|
453
429
|
const primes = list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), primeMaps = list(baseMaps.map(mp => `(${mapNames.indexOf(mp)}, ${mapNames.indexOf(`${mp}'`)})`));
|
|
454
430
|
const k = sl.steps ?? 1;
|
|
455
|
-
|
|
456
|
-
|
|
457
|
-
|
|
431
|
+
const when = Array.isArray(sl.when) ? sl.when[0] : sl.when;
|
|
432
|
+
if (k !== 1)
|
|
433
|
+
throw new Error(`${id}: step law ${sl.name}: a law over several steps goes through smachineToLean (Sets.lean's skstep_sound)`);
|
|
434
|
+
return `-- Step law: ${sl.name}
|
|
435
|
+
def ${id}_step${j} : StepLaw := ⟨${when ? any0.c(inlineFlags(when)) : TRUE},
|
|
458
436
|
${any0.c(inlineFlags(sl.then))},
|
|
459
437
|
${primes},
|
|
460
438
|
${primeMaps},
|
|
@@ -462,19 +440,6 @@ def ${id}_step${j} : StepLaw := ⟨${sl.when ? any0.c(inlineFlags(sl.when)) : TR
|
|
|
462
440
|
(${pr.tab}, ${pr.tree})⟩
|
|
463
441
|
theorem ${id}_step${j}_holds : StepLawHolds ${id}_machine ${id}_step${j} :=
|
|
464
442
|
steplaw_sound ${id}_machine ${id}_proof ${id}_step${j} ${id}_check (by decide +kernel)`;
|
|
465
|
-
// Through Kern.kstep_sound (Steps.lean): one `when` per step (0 <= 0 where none), the j-th request's inputs renamed.
|
|
466
|
-
const whens = sl.when === undefined ? [] : Array.isArray(sl.when) ? sl.when : [sl.when];
|
|
467
|
-
const ren = Array.from({ length: k }, (_, s2) => (s2 === 0 ? '[]' : list(m.inputs.map(i => `(${ix(i)}, ${ix(`${i}@${s2 + 1}`)})`))));
|
|
468
|
-
return `-- Step law over ${k} steps: ${sl.name}
|
|
469
|
-
def ${id}_step${j} : KStep := ⟨${list(Array.from({ length: k }, (_, s2) => (whens[s2] ? any0.c(inlineFlags(whens[s2])) : TRUE)))},
|
|
470
|
-
${any0.c(inlineFlags(sl.then))},
|
|
471
|
-
${list(ren)},
|
|
472
|
-
${primes},
|
|
473
|
-
${primeMaps},
|
|
474
|
-
${list(insts)},
|
|
475
|
-
(${pr.tab}, ${pr.tree})⟩
|
|
476
|
-
theorem ${id}_step${j}_holds : KStepHolds ${id}_machine ${id}_step${j} :=
|
|
477
|
-
kstep_sound ${id}_machine ${id}_proof ${id}_step${j} ${id}_check (by decide +kernel)`;
|
|
478
443
|
});
|
|
479
444
|
const machineDef = `def ${id}_machine : FMMachine := ${lit(m)}`;
|
|
480
445
|
return `-- ${m.name}: ${laws.map(l => l.name).join('; ')}${flagNames.length ? `, with flags ${flagNames.join(', ')}` : ''} (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')}; maps ${mapNames.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
@@ -503,7 +468,13 @@ const flagsOfM = (m) => {
|
|
|
503
468
|
export const hasSets = (m) => !!m.inputMaps?.length || Object.values(m.step.flags ?? {}).some(c => c.op === 'all') || Object.values(m.step.maps ?? {}).some(w => 'each' in w)
|
|
504
469
|
|| !!Object.keys(m.fns ?? {}).length || !!m.facts?.length;
|
|
505
470
|
const boundKeys = (m) => [...Object.values(m.step.flags ?? {}).flatMap(c => (c.op === 'all' ? [c.key] : [])), ...Object.values(m.step.maps ?? {}).flatMap(w => ('each' in w ? [w.each] : []))];
|
|
506
|
-
|
|
471
|
+
// A machine with a history goes as its plain machine (kernel.ts's historyMachine: sums as state, queries as inputs,
|
|
472
|
+
// the relations assumed), built in Lean from the machine and its history (History.lean's HMachine.plain), so every claim
|
|
473
|
+
// below is about it; with the relations' record goals, its laws hold over histories too (hmachine_sound).
|
|
474
|
+
// `historyTampers`: the history with other relations, each refused.
|
|
475
|
+
export function smachineToLean(id, given, laws, opts = {}) {
|
|
476
|
+
const hm = given.history ? { ...given, history: { ...given.history, prune: undefined } } : undefined;
|
|
477
|
+
const hplain = hm ? historyMachine(hm) : undefined, m = hplain ? hplain.machine : given;
|
|
507
478
|
const stepLaws = opts.stepLaws ?? [], rf = opts.refined, gv = opts.ghosts ?? [];
|
|
508
479
|
const claims = [];
|
|
509
480
|
const claimSteps = () => claims.flatMap(cl => cl.steps);
|
|
@@ -577,6 +548,19 @@ theorem ${lid}_holds (run : SRun ${id}_machine)
|
|
|
577
548
|
sleads_sound ${id}_machine ${id}_proof ${lid} _ _ _ ${id}_check ${lid}_ok ${lid}_stay ${lid}_cover ${lid}_helps run fair${wf}`;
|
|
578
549
|
} });
|
|
579
550
|
}
|
|
551
|
+
// A loop (Live.lean's loop_halts_of): its machine is the loop's, and its liveness says the loop halts.
|
|
552
|
+
const lp0 = opts.loop;
|
|
553
|
+
if (lp0)
|
|
554
|
+
claims.push({ steps: [], allows: [], render: () => `/-- ${lp0.loop.name} halts: for params meeting its precondition, no run of turns goes on forever. -/
|
|
555
|
+
theorem ${id}_halts : ∀ maps ρ0, evalC ρ0 maps ${id}_loop.pre = true →
|
|
556
|
+
¬ ∃ f : Nat → Nat → Nat, f 0 = applyS ${id}_loop.init ρ0 maps ∧ ∀ n, Turn ${id}_loop maps (f n) (f (n + 1)) :=
|
|
557
|
+
loop_halts_of ${id}_loop ${id}_live0 rfl rfl (by intro h hh; simp only [${id}_live0, List.mem_singleton] at hh; subst hh; rfl) (by decide +kernel) ${id}_live0_holds${lp0.tamper ? `
|
|
558
|
+
-- TAMPERED: ${lp0.tamper.what}. Lean computes the checks to false.
|
|
559
|
+
def ${id}_tampered : SMachine := Loop.machine ${loopLit(lp0.tamper.loop)}
|
|
560
|
+
example : (checkSMachine ${id}_tampered ${id}_proof && sliveOk ${id}_tampered ${id}_live0
|
|
561
|
+
&& checkSKStep ${id}_tampered ${id}_proof (sliveStep ${id}_live0 ${id}_live0.pend (liveStayC ${id}_live0) ${id}_live0_sp)
|
|
562
|
+
&& checkSKStep ${id}_tampered ${id}_proof (sliveStep ${id}_live0 ${id}_live0.pend (liveCoverC ${id}_live0) ${id}_live0_cp)
|
|
563
|
+
&& sliveHelpsOk ${id}_tampered ${id}_proof ${id}_live0 ${id}_live0_hp) = false := by decide +kernel` : ''}` });
|
|
580
564
|
// Ghosts (Ghost.lean's sghost_laws): the laws that read no ghost hold of the machine without its ghosts.
|
|
581
565
|
if (gv.length)
|
|
582
566
|
claims.push({ steps: [], allows: [], render: () => `-- The laws that read no ghost hold of the machine without its ghosts.
|
|
@@ -649,7 +633,7 @@ theorem ${id}_orig_laws : ∀ ρ M, SReach ${id}_ghosted.orig ρ M → ∀ e ∈
|
|
|
649
633
|
const vars = [...new Set([...m.params, ...m.inputs, ...Object.keys(m.state), ...keysOf, ...keysOf.map(k2 => `${k2}#`), '#', ...flags.map(([f]) => `?${f}`),
|
|
650
634
|
...quantified.map(f => `w?${f}`), ...boundKeys(m), ...(opts.tamper ? boundKeys(opts.tamper.machine) : []), ...stepLaws.flatMap(sl => (sl.forall ? [sl.forall] : [])), ...(opts.free ?? []),
|
|
651
635
|
...primes, ...later, ...Array.from({ length: k - 1 }, (_, j) => Object.keys(m.state).map(n2 => stateName(n2, j + 1))).flat(),
|
|
652
|
-
...[...goalsL, ...goalsS, ...allowGoals].flatMap(g => g.hyps.flatMap(varsOf))])];
|
|
636
|
+
...(hm ? hm.history.record.map(f => `r.${f}`) : []), ...[...goalsL, ...goalsS, ...allowGoals, ...(hplain?.goals ?? [])].flatMap(g => g.hyps.flatMap(varsOf))])];
|
|
653
637
|
const baseMaps = [...new Set([...Object.keys(m.maps ?? {}), ...Object.keys(m.step.maps ?? {}), ...Object.keys(m.fns ?? {})])];
|
|
654
638
|
const mapNames = [...new Set([...baseMaps, ...carried, ...(allSteps.length ? Object.keys(m.maps ?? {}).map(mp => `${mp}'`) : []), ...laterMaps,
|
|
655
639
|
...[...JSON.stringify([...goalsL, ...goalsS, ...allowGoals]).matchAll(/"op":"get","map":"([^"]+)"/g)].map(x2 => x2[1])])];
|
|
@@ -675,6 +659,39 @@ theorem ${id}_orig_laws : ∀ ρ M, SReach ${id}_ghosted.orig ρ M → ∀ e ∈
|
|
|
675
659
|
${list(fs.flatMap(([f, c2]) => (c2.op === 'all' ? [`(${ix(`?${f}`)}, ${ix(c2.key)}, ${c(c2.c)})`] : [])))},
|
|
676
660
|
${list(fs.flatMap(([f, c2]) => (c2.op === 'all' ? [`(${ix(`?${f}`)}, ${ix(`w?${f}`)})`] : [])))},
|
|
677
661
|
${list((mm.facts ?? []).map(l => `⟨${c(l.holds)}, ${l.forall ? `some ${ix(l.forall)}` : 'none'}⟩`))}⟩`;
|
|
662
|
+
};
|
|
663
|
+
// A loop as Live.lean's record: inputs, start, body, while, precondition, assumption.
|
|
664
|
+
const loopLit = (lp) => `⟨${list(lp.inputs.map(name => String(ix(name))))},
|
|
665
|
+
${list(Object.entries(lp.state).map(([name, e2]) => `(${ix(name)}, ${e(e2)})`))},
|
|
666
|
+
${list(Object.entries(lp.body).map(([name, e2]) => `(${ix(name)}, ${e(e2)})`))},
|
|
667
|
+
${c(lp.while)},
|
|
668
|
+
${lp.pre ? c(lp.pre) : TRUE},
|
|
669
|
+
${lp.assume ? c(lp.assume) : TRUE}⟩`;
|
|
670
|
+
// The history: the machine without it (its state without the sums, its assumption without the relations), what a
|
|
671
|
+
// record keeps and the sums, queries and relations over it.
|
|
672
|
+
const hlit = (rels) => {
|
|
673
|
+
const h = hm.history, base = { ...hm, history: undefined };
|
|
674
|
+
return `⟨${lit(base)},
|
|
675
|
+
${c(h.keep)},
|
|
676
|
+
${list(h.record.map(f => String(ix(f))))},
|
|
677
|
+
${list(h.record.map(f => String(ix(`r.${f}`))))},
|
|
678
|
+
${list(Object.entries(h.sums).map(([name, g]) => `(${ix(name)}, ${e(g)})`))},
|
|
679
|
+
${list(Object.entries(h.queries).map(([name, g]) => `(${ix(name)}, ${e(g)})`))},
|
|
680
|
+
${list(rels.map(rel => { if (rel.holds.op !== '<=')
|
|
681
|
+
throw new Error(`${id}: a relation is a <= b`); return `(${c(rel.when)}, ${e(rel.holds.a)}, ${e(rel.holds.b)})`; }))}⟩`;
|
|
682
|
+
};
|
|
683
|
+
// Each relation's record goal and its tree, the history's check, and the laws over histories.
|
|
684
|
+
const histBlock = () => {
|
|
685
|
+
const records = hplain.goals.map(g => { const out = grow(g); if (!('tree' in out))
|
|
686
|
+
throw new Error(`${id}: ${g.name} not proven`); const x2 = enc(g, out.tree); return `(${x2.tab}, ${x2.tree})`; });
|
|
687
|
+
const tampered = (opts.historyTampers ?? []).map((t, j) => `-- TAMPERED: ${t.what}. Lean computes the check to false.
|
|
688
|
+
def ${id}_tampered${j} : HMachine := ${hlit(t.relations)}
|
|
689
|
+
example : checkHMachine ${id}_tampered${j} ${id}_proof ${t.withRecordTrees ? `${id}_records` : '[]'} = false := by decide +kernel`);
|
|
690
|
+
return `def ${id}_records : List (List VDef × Tree) := ${list(records)}
|
|
691
|
+
theorem ${id}_hcheck : checkHMachine ${id}_hist ${id}_proof ${id}_records = true := by decide +kernel
|
|
692
|
+
theorem ${id}_hlaws : ∀ ρ M hist, HReach ${id}_hist ρ M hist → ∀ e ∈ ${id}_proof, e.Holds ρ M :=
|
|
693
|
+
hmachine_sound ${id}_hist ${id}_proof ${id}_records ${id}_hcheck
|
|
694
|
+
${readable(id, laws, vars, mapNames, { binders: '(ρ : Nat → Nat) (μ : Nat → Nat → Nat) (hist : List (Nat → Nat))', hyp: `HReach ${id}_hist ρ μ hist`, call: `${id}_hlaws ρ μ hist h` })}${tampered.length ? `\n${tampered.join('\n')}` : ''}`;
|
|
678
695
|
};
|
|
679
696
|
const lawIx = (name) => laws.findIndex(l => l.name === name);
|
|
680
697
|
const insts = (inst) => Object.entries(inst).filter(([name]) => lawIx(name) >= 0 && !laws[lawIx(name)].keys?.length).flatMap(([name, keys]) => keys.map(key => `(${lawIx(name)}, ${e(key)})`));
|
|
@@ -716,13 +733,15 @@ ${rf ? `def ${id}_refined : SRefined := ⟨${lit(rf.impl)},
|
|
|
716
733
|
def ${id}_machine : SMachine := ${id}_refined.full` : gv.length ? `def ${id}_ghosted : SGhosted := ⟨${lit(orig)},
|
|
717
734
|
${list(gv.map(v2 => `(${ix(v2)}, ${e(m.state[v2])}, ${e(m.step.state?.[v2] ?? { op: 'var', name: v2 })})`))}⟩
|
|
718
735
|
def ${id}_machine : SMachine := ${id}_ghosted.full
|
|
719
|
-
theorem ${id}_ghostOk : sghostOk ${id}_ghosted = true := by decide +kernel` : `def ${id}
|
|
736
|
+
theorem ${id}_ghostOk : sghostOk ${id}_ghosted = true := by decide +kernel` : hm ? `def ${id}_hist : HMachine := ${hlit(hm.history.relations ?? [])}
|
|
737
|
+
def ${id}_machine : SMachine := ${id}_hist.plain` : lp0 ? `def ${id}_loop : Loop := ${loopLit(lp0.loop)}
|
|
738
|
+
def ${id}_machine : SMachine := ${id}_loop.machine` : `def ${id}_machine : SMachine := ${lit(m)}`}
|
|
720
739
|
${entries.join('\n')}
|
|
721
740
|
def ${id}_proof : List SEntry := ${list(laws.map((_, j) => `${id}_e${j}`))}
|
|
722
741
|
theorem ${id}_check : checkSMachine ${id}_machine ${id}_proof = true := by decide +kernel
|
|
723
742
|
theorem ${id}_laws : ∀ ρ M, SReach ${id}_machine ρ M → ∀ e ∈ ${id}_proof, e.Holds ρ M :=
|
|
724
743
|
smachine_sound ${id}_machine ${id}_proof ${id}_check
|
|
725
|
-
${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 ? `
|
|
744
|
+
${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 ? `
|
|
726
745
|
-- TAMPERED: ${opts.tamper.what}. Lean computes the check to false.
|
|
727
746
|
def ${id}_tampered : SMachine := ${lit(opts.tamper.machine)}
|
|
728
747
|
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)}` : ''}`;
|
|
@@ -745,61 +764,9 @@ theorem ${id}_facts_hold (ρ : Nat → Nat) (μ : Nat → Nat → Nat) ${fns.map
|
|
|
745
764
|
// relations in the assumption) and each relation's record goal; the trees and the instance keys are the kernel's.
|
|
746
765
|
// Pruning is left out: its goals are about the runtimes (dropping a record changes no query), the laws and relations
|
|
747
766
|
// are proven over the whole history either way, and Lean's HMachine has no pruning; the TypeScript kernel checks them.
|
|
748
|
-
|
|
749
|
-
|
|
750
|
-
|
|
751
|
-
const r = proveLaws(m, laws);
|
|
752
|
-
if (!r.proven || !r.proof)
|
|
753
|
-
throw new Error(`${id}: not proven`);
|
|
754
|
-
const keysOf = [...new Set(laws.flatMap(l => (l.forall ? [l.forall] : [])))];
|
|
755
|
-
const flagNames = Object.keys(m.step.flags ?? {});
|
|
756
|
-
const sums = Object.keys(h.sums), fields = h.record.map(f => `r.${f}`);
|
|
757
|
-
const vars = [...m.params, ...m.inputs, ...Object.keys(m.state), ...sums, ...keysOf, ...keysOf.map(k2 => `${k2}#`), '#', ...flagNames.map(f => `?${f}`), ...fields];
|
|
758
|
-
const mapNames = [...new Set([...Object.keys(m.maps ?? {}), ...Object.keys(m.step.maps ?? {}), ...[...JSON.stringify(laws).matchAll(/"op":"get","map":"([^"]+)"/g)].map(x2 => x2[1])])];
|
|
759
|
-
const gs = obligations(m, laws, r.proof.instances);
|
|
760
|
-
const enc = (g, tree = r.proof.trees[g.name]) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars, mapNames);
|
|
761
|
-
const any0 = enc(gs[0], { leaf: [] });
|
|
762
|
-
const ix = (name) => { const j = vars.indexOf(name); if (j < 0)
|
|
763
|
-
throw new Error(`${id}: no variable ${name}`); return j; };
|
|
764
|
-
const rels = (rs) => list(rs.map(rel => {
|
|
765
|
-
if (rel.holds.op !== '<=')
|
|
766
|
-
throw new Error(`${id}: a relation is a <= b`);
|
|
767
|
-
return `(${any0.c(rel.when)}, ${any0.e(rel.holds.a)}, ${any0.e(rel.holds.b)})`;
|
|
768
|
-
}));
|
|
769
|
-
const lit = (rs) => `⟨⟨⟨${list(m.inputs.map(name => String(ix(name))))},
|
|
770
|
-
${list(Object.entries(m.state).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
771
|
-
${list(Object.entries(m.maps ?? {}).map(([name, c2]) => `(${mapNames.indexOf(name)}, ${c2})`))},
|
|
772
|
-
${list(Object.entries(m.step.state ?? {}).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
773
|
-
${list(Object.entries(m.step.maps ?? {}).map(([name, w]) => { const pw = pointWrite(w, 'Lean (for now)'); return `(${mapNames.indexOf(name)}, ${any0.e(pw.key)}, ${any0.e(pw.value)})`; }))},
|
|
774
|
-
${m.pre ? any0.c(m.pre) : TRUE},
|
|
775
|
-
${m.assume ? any0.c(m.assume) : TRUE}⟩,
|
|
776
|
-
${list(flagNames.map(f => `(${ix(`?${f}`)}, ${any0.c(m.step.flags[f])})`))}⟩,
|
|
777
|
-
${any0.c(h.keep)},
|
|
778
|
-
${list(h.record.map(f => String(ix(f))))},
|
|
779
|
-
${list(fields.map(f => String(ix(f))))},
|
|
780
|
-
${list(Object.entries(h.sums).map(([name, g]) => `(${ix(name)}, ${any0.e(g)})`))},
|
|
781
|
-
${list(Object.entries(h.queries).map(([name, g]) => `(${ix(name)}, ${any0.e(g)})`))},
|
|
782
|
-
${rels(rs)}⟩`;
|
|
783
|
-
const entries = laws.map((law, j) => {
|
|
784
|
-
const a = enc(gs[2 * j]), b = enc(gs[2 * j + 1]);
|
|
785
|
-
const insts = Object.entries(r.proof.instances[law.name] ?? {}).flatMap(([lname, keys]) => keys.map(key => `(${laws.findIndex(l => l.name === lname)}, ${any0.e(key)})`));
|
|
786
|
-
return `def ${id}_l${j} : MLaw := ⟨${any0.c(law.holds)}, ${law.forall ? `some ${ix(law.forall)}` : 'none'}⟩\ndef ${id}_e${j} : MEntry := ⟨${id}_l${j}, ${ix(law.forall ? `${law.forall}#` : '#')}, ${list(insts)},\n (${a.tab}, ${a.tree}),\n (${b.tab}, ${b.tree})⟩`;
|
|
787
|
-
});
|
|
788
|
-
const records = gs.slice(2 * laws.length).map(g => { const x2 = enc(g); return `(${x2.tab}, ${x2.tree})`; });
|
|
789
|
-
const tamperText = tampers.map((t, j) => `-- TAMPERED: ${t.what}. Lean computes the check to false.
|
|
790
|
-
def ${id}_tampered${j} : HMachine := ${lit(t.relations)}
|
|
791
|
-
example : checkHMachine ${id}_tampered${j} ${id}_proof ${t.withRecordTrees ? `${id}_records` : '[]'} = false := by decide +kernel`);
|
|
792
|
-
return `-- ${m.name}: ${laws.map(l => l.name).join('; ')}, with a history (sums ${sums.join(', ')}; queries ${Object.keys(h.queries).join(', ')}; ${(h.relations ?? []).length} relation(s))
|
|
793
|
-
-- (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')}; maps ${mapNames.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
794
|
-
def ${id}_machine : HMachine := ${lit(h.relations ?? [])}
|
|
795
|
-
${entries.join('\n')}
|
|
796
|
-
def ${id}_proof : List MEntry := ${list(laws.map((_, j) => `${id}_e${j}`))}
|
|
797
|
-
def ${id}_records : List (List VDef × Tree) := ${list(records)}
|
|
798
|
-
theorem ${id}_check : checkHMachine ${id}_machine ${id}_proof ${id}_records = true := by decide +kernel
|
|
799
|
-
theorem ${id}_laws : ∀ ρ M hist, HReach ${id}_machine ρ M hist → ∀ e ∈ ${id}_proof, e.law.Holds ρ M :=
|
|
800
|
-
hmachine_sound ${id}_machine ${id}_proof ${id}_records ${id}_check
|
|
801
|
-
${readable(id, laws, vars, mapNames, { binders: '(ρ : Nat → Nat) (μ : Nat → Nat → Nat) (hist : List (Nat → Nat))', hyp: `HReach ${id}_machine ρ μ hist`, call: `${id}_laws ρ μ hist h` })}${corollary ? `\n${corollary(ix)}` : ''}
|
|
802
|
-
${tamperText.join('\n')}`;
|
|
767
|
+
// A machine with a history: its laws over histories (History.lean's hmachine_sound), through smachineToLean.
|
|
768
|
+
export function hmachineToLean(id, m, laws, tampers = [], corollary) {
|
|
769
|
+
return smachineToLean(id, m, laws, { historyTampers: tampers, ...(corollary ? { after: corollary } : {}) });
|
|
803
770
|
}
|
|
804
771
|
// A Lean file proving each item, to compile against the twin (`leanLibrary`, or `leanProject` for a ready Lake project).
|
|
805
772
|
// Each machine's laws come with `<id>_laws` (the twin's theorem) and `<id>.lawN` (the law as a plain Lean statement
|
|
@@ -822,23 +789,11 @@ export function toLean(items, opts = {}) {
|
|
|
822
789
|
throw new Error(`${item.id}: not proven (${r.failed?.stuck ?? ''})`);
|
|
823
790
|
item = { ...item, laws: r.laws ?? item.laws, ...(item.stepLaws ? { stepLaws: r.stepLaws ?? item.stepLaws } : {}) };
|
|
824
791
|
}
|
|
825
|
-
|
|
826
|
-
|
|
827
|
-
// One twin: a machine without a history goes to Lean as a machine with sets (one with none, if it has none): its laws,
|
|
828
|
-
// step laws, liveness and ghosts in one export. A history's laws go through History.lean, and its step laws and
|
|
829
|
-
// liveness through its plain machine (its sums as state, its queries as inputs).
|
|
830
|
-
if (m.history) {
|
|
831
|
-
parts.push(`-- ${item.id}\n${hmachineToLean(id, m, item.laws)}`);
|
|
832
|
-
theorems.push(`${id}_laws`);
|
|
833
|
-
if (item.stepLaws?.length || item.liveness?.length) {
|
|
834
|
-
parts.push(`-- ${item.id}: step laws and liveness, on its plain machine\n${smachineToLean(`${id}s`, historyMachine(m).machine, item.laws, { stepLaws: item.stepLaws, ...(item.liveness?.length ? { liveness: item.liveness } : {}) })}`);
|
|
835
|
-
theorems.push(...(item.stepLaws ?? []).map((_, j) => `${id}s_step${j}_holds`), ...(item.liveness ?? []).map((_, j) => `${id}s_live${j}_holds`));
|
|
836
|
-
}
|
|
837
|
-
continue;
|
|
838
|
-
}
|
|
792
|
+
// One twin: every machine goes to Lean as a machine with sets (one with none, if it has none): its laws, step laws,
|
|
793
|
+
// liveness and ghosts in one export; a machine with a history as its plain machine, and its laws over histories.
|
|
839
794
|
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 } : {}),
|
|
840
795
|
...(item.ghosts?.length ? { ghosts: item.ghosts } : {}), ...(item.lean?.simp ? { simp: item.lean.simp } : {}), ...(item.lean?.after ? { after: item.lean.after } : {}) })}`);
|
|
841
|
-
theorems.push(`${id}_laws`, ...(item.stepLaws ?? []).map((_, j) => `${id}_step${j}_holds`), ...(item.liveness ?? []).map((_, j) => `${id}_live${j}_holds`));
|
|
796
|
+
theorems.push(`${id}_laws`, ...(m.history ? [`${id}_hlaws`] : []), ...(item.stepLaws ?? []).map((_, j) => `${id}_step${j}_holds`), ...(item.liveness ?? []).map((_, j) => `${id}_live${j}_holds`));
|
|
842
797
|
if (item.lean?.after)
|
|
843
798
|
theorems.push(...[...item.lean.after(() => 0).matchAll(/^theorem (\S+)/gm)].map(x2 => x2[1]));
|
|
844
799
|
}
|
|
@@ -863,9 +818,9 @@ export function toLean(items, opts = {}) {
|
|
|
863
818
|
theorems.push(id);
|
|
864
819
|
}
|
|
865
820
|
}
|
|
866
|
-
// Sets.lean (which imports Steps.lean)
|
|
821
|
+
// The file the items need: Live.lean for a liveness or a loop, Sets.lean (which imports Steps.lean) for any machine.
|
|
867
822
|
return `import History
|
|
868
|
-
import ${items.some(item => 'refinement' in item) ? 'Refine' : items.some(item => 'machine' in item && item.ghosts?.length) ? 'Ghost' : items.some(item => 'machine' in item && item.liveness?.length) ? 'Live' : items.some(item => 'machine' in item) ? 'Sets' : 'Steps'}
|
|
823
|
+
import ${items.some(item => 'refinement' in item) ? 'Refine' : items.some(item => 'machine' in item && item.ghosts?.length) ? 'Ghost' : items.some(item => ('machine' in item && item.liveness?.length) || 'loop' in item) ? 'Live' : items.some(item => 'machine' in item) ? 'Sets' : 'Steps'}
|
|
869
824
|
open Kern Cert
|
|
870
825
|
set_option maxRecDepth 100000
|
|
871
826
|
set_option maxHeartbeats 0
|