gdp-wired 0.3.0 → 0.4.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 +106 -113
- package/dist/core/dsl.d.ts +188 -4
- package/dist/core/dsl.js +733 -52
- package/dist/core/watch.d.ts +14 -0
- package/dist/core/watch.js +78 -0
- package/dist/kernel/kernel.d.ts +1 -0
- package/dist/kernel/kernel.js +1 -1
- package/dist/kernel/prove.d.ts +3 -0
- package/dist/kernel/prove.js +21 -6
- package/dist/lean-kernel/emit.d.ts +2 -10
- package/dist/lean-kernel/emit.js +131 -192
- package/dist/lean-kernel/library.js +4 -4
- package/package.json +2 -2
package/dist/lean-kernel/emit.js
CHANGED
|
@@ -363,13 +363,16 @@ function liveLit(l, t, ix, primes, primeMaps) {
|
|
|
363
363
|
${primes},
|
|
364
364
|
${primeMaps}⟩`;
|
|
365
365
|
}
|
|
366
|
+
// The base twin's export (Progress.lean, StepLaw.lean, Steps.lean): laws, step laws, k-step laws and progress over a
|
|
367
|
+
// machine with maps and flags, for the demos in export-kernel.ts. Everything built on top (liveness, ghosts, refinement)
|
|
368
|
+
// goes through the sets twin, smachineToLean.
|
|
366
369
|
export function mmachineToLean(id, m, laws, opts = {}) {
|
|
367
370
|
const r = proveLaws(m, laws);
|
|
368
371
|
if (!r.proven || !r.proof)
|
|
369
372
|
throw new Error(`${id}: not proven`);
|
|
370
373
|
const keysOf = [...new Set(laws.flatMap(l => (l.forall ? [l.forall] : [])))];
|
|
371
374
|
const flagNames = Object.keys(m.step.flags ?? {});
|
|
372
|
-
const primed = !!(opts.progress || opts.stepLaws?.length
|
|
375
|
+
const primed = !!(opts.progress || opts.stepLaws?.length);
|
|
373
376
|
const primes = primed ? Object.keys(m.state).map(s2 => `${s2}'`) : [];
|
|
374
377
|
// A k-step law reads the j-th request's inputs (j >= 2) by input@j.
|
|
375
378
|
const later = [...new Set((opts.stepLaws ?? []).flatMap(sl => Array.from({ length: (sl.steps ?? 1) - 1 }, (_, j) => m.inputs.map(i => `${i}@${j + 2}`)).flat()))];
|
|
@@ -421,9 +424,6 @@ example : checkProgress ${id}_machine ${id}_proof ${pc.id}_tampered = false := b
|
|
|
421
424
|
if (opts.stepLaws?.length && (!sp?.proven || !sp.proof))
|
|
422
425
|
throw new Error(`${id}: step laws not proven`);
|
|
423
426
|
const inlineFlags = (c) => substC(c, { vars: {}, maps: {}, flags: m.step.flags ?? {} });
|
|
424
|
-
// Lean's inlineC: each flag a condition reads becomes `if c then 1 else 0 = 1`, c as the machine's literal has it.
|
|
425
|
-
const flagVar = Object.fromEntries(Object.keys(m.step.flags ?? {}).map(f => [f, { op: '=', a: { op: 'var', name: `?${f}` }, b: n(1) }]));
|
|
426
|
-
const leanInline = (c) => substC(c, { vars: {}, maps: {}, flags: Object.fromEntries(Object.entries(m.step.flags ?? {}).map(([f, fc]) => [f, { op: '=', a: { op: 'if', c: substC(fc, { vars: {}, maps: {}, flags: flagVar }), then: n(1), else: n(0) }, b: n(1) }])) });
|
|
427
427
|
const stepRecords = (opts.stepLaws ?? []).map((sl, j) => {
|
|
428
428
|
const goal = stepLawObligations(m, laws, sp.proof.instances, sl)[0];
|
|
429
429
|
const pr = enc(goal, sp.proof.trees[goal.name]);
|
|
@@ -454,86 +454,7 @@ def ${id}_step${j} : KStep := ⟨${list(Array.from({ length: k }, (_, s2) => (wh
|
|
|
454
454
|
theorem ${id}_step${j}_holds : KStepHolds ${id}_machine ${id}_step${j} :=
|
|
455
455
|
kstep_sound ${id}_machine ${id}_proof ${id}_step${j} ${id}_check (by decide +kernel)`;
|
|
456
456
|
});
|
|
457
|
-
|
|
458
|
-
// the liveness; the trees and instances are the kernel's.
|
|
459
|
-
const liveRecords = (opts.liveness ?? []).map((l, j) => {
|
|
460
|
-
const { stay, cover, helps } = livenessParts(m, l);
|
|
461
|
-
const a = proveStepLaws(m, laws, [stay, cover, ...helps]);
|
|
462
|
-
if (!a.proven || !a.proof)
|
|
463
|
-
throw new Error(`${id}: liveness ${l.name} not proven`);
|
|
464
|
-
const proofOf = (sl) => {
|
|
465
|
-
const inst = a.proof.perStep?.[sl.name] ?? a.proof.instances, g = stepLawObligations(m, laws, inst, sl)[0], pr = enc(g, a.proof.trees[g.name]);
|
|
466
|
-
return { insts: list(laws.flatMap((lw, li) => (lw.forall ? (inst[lw.name] ?? []).map(key => `(${li}, ${any0.e(key)})`) : []))), tree: `(${pr.tab}, ${pr.tree})` };
|
|
467
|
-
};
|
|
468
|
-
const ps = proofOf(stay), pc = proofOf(cover), ph = helps.map(proofOf), lid = `${id}_live${j}`;
|
|
469
|
-
// Weak fairness, where each helpful request is proven allowed in its region, its other inputs free (Live.lean's
|
|
470
|
-
// fAllowGoal, built here as Lean builds it: the flags in the assumption inlined as `if c then 1 else 0 = 1`).
|
|
471
|
-
const allows = helps.map((hs, i) => {
|
|
472
|
-
const found = withWitness(m, livenessHelpful(l)[i].request, wit => {
|
|
473
|
-
const r2 = proveBuilt(m, laws, inst => ({ name: `${hs.name}: allowed`, hyps: [m.pre ?? trueC, ...laws.filter(lw => !lw.forall).map(lw => lw.holds),
|
|
474
|
-
...laws.flatMap(lw => (lw.forall ? (inst[lw.name] ?? []).map(key => substC(lw.holds, { vars: { [lw.forall]: key }, maps: {}, flags: {} })) : [])),
|
|
475
|
-
{ op: 'and', xs: [hs.when, reqTS(wit)] }, { op: 'not', x: leanInline(m.assume ?? trueC) }] }));
|
|
476
|
-
return r2.proven ? r2 : undefined;
|
|
477
|
-
});
|
|
478
|
-
if (!found)
|
|
479
|
-
return undefined;
|
|
480
|
-
const r2 = found.out, pr = enc(r2.goal, r2.tree);
|
|
481
|
-
return `(${list(found.wit.map(([inp, t]) => `(${ix(inp)}, ${any0.e(t)})`))}, ${list(laws.flatMap((lw, li) => (lw.forall ? (r2.instances[lw.name] ?? []).map(key => `(${li}, ${any0.e(key)})`) : [])))}, (${pr.tab}, ${pr.tree}))`;
|
|
482
|
-
});
|
|
483
|
-
const wf = allows.every(a => a !== undefined) ? `
|
|
484
|
-
theorem ${lid}_allows : liveAllowsOk ${id}_machine ${id}_proof ${lid} ${list(allows)} = true := by decide +kernel
|
|
485
|
-
/-- ${l.name}, under weak fairness: along every run that takes each helpful request whenever, from some point on, it
|
|
486
|
-
stays allowed, \`from\` is followed by \`to\`. -/
|
|
487
|
-
theorem ${lid}_holds_wf (run : FRun ${id}_machine)
|
|
488
|
-
(fair : ∀ h ∈ ${lid}.helps, ∀ n, (∀ m, n ≤ m → ∃ ι : Nat → Nat, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)
|
|
489
|
-
∧ evalC (decideFlags ${id}_machine.flags (withInputs ${id}_machine.m.inputs (run.st m).1 ι) (run.st m).2) (run.st m).2 ${id}_machine.m.assume = true) →
|
|
490
|
-
∃ m, n ≤ m ∧ ∀ p ∈ h.2, run.req m p.1 = evalE (run.st m).1 (run.st m).2 p.2) :
|
|
491
|
-
∀ n, evalC (run.st n).1 (run.st n).2 ${lid}.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 ${lid}.to = true :=
|
|
492
|
-
leads_wf_sound ${id}_machine ${id}_proof ${lid} _ _ _ _ _ _ ${id}_check ${lid}_ok ${lid}_stay ${lid}_cover ${lid}_helps ${lid}_allows run fair` : '';
|
|
493
|
-
return `-- Liveness: ${l.name}
|
|
494
|
-
def ${lid} : Live := ${liveLit(l, any0, ix, list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), list(baseMaps.map(mp => `(${mapNames.indexOf(mp)}, ${mapNames.indexOf(`${mp}'`)})`)))}
|
|
495
|
-
theorem ${lid}_ok : liveOk ${id}_machine ${lid} = true := by decide +kernel
|
|
496
|
-
theorem ${lid}_stay : checkStepLaw ${id}_machine ${id}_proof (liveStay ${lid} ${ps.insts} ${ps.tree}) = true := by decide +kernel
|
|
497
|
-
theorem ${lid}_cover : checkStepLaw ${id}_machine ${id}_proof (liveCover ${lid} ${pc.insts} ${pc.tree}) = true := by decide +kernel
|
|
498
|
-
theorem ${lid}_helps : liveHelpsOk ${id}_machine ${id}_proof ${lid} ${list(ph.map(p => `(${p.insts}, ${p.tree})`))} = true := by decide +kernel
|
|
499
|
-
/-- ${l.name}: along every run that takes each helpful request infinitely often, \`from\` is followed by \`to\`. -/
|
|
500
|
-
theorem ${lid}_holds (run : FRun ${id}_machine)
|
|
501
|
-
(fair : ∀ h ∈ ${lid}.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, run.req m p.1 = evalE (run.st m).1 (run.st m).2 p.2) :
|
|
502
|
-
∀ n, evalC (run.st n).1 (run.st n).2 ${lid}.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 ${lid}.to = true :=
|
|
503
|
-
leads_sound ${id}_machine ${id}_proof ${lid} _ _ _ _ _ ${id}_check ${lid}_ok ${lid}_stay ${lid}_cover ${lid}_helps run fair${wf}`;
|
|
504
|
-
});
|
|
505
|
-
// A ghosted machine (compose.ts's ghost): the original and its ghosts, the machine Lean checks built from them
|
|
506
|
-
// (Ghost.lean), so the laws that read no ghost are laws of the original.
|
|
507
|
-
const gv = opts.ghosts ?? [];
|
|
508
|
-
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))) } };
|
|
509
|
-
const rf = opts.refined;
|
|
510
|
-
const machineDef = rf ? `def ${id}_refined : Refined := ⟨${lit(rf.impl)},
|
|
511
|
-
${lit(rf.spec)},
|
|
512
|
-
${list(Object.entries(rf.wit).map(([inp, e2]) => `(${ix(`b_${inp}`)}, ${any0.e(e2)})`))},
|
|
513
|
-
${any0.c(rf.stutter)}⟩
|
|
514
|
-
def ${id}_machine : FMMachine := ${id}_refined.full` : gv.length ? `def ${id}_ghosted : Ghosted := ⟨${lit(orig)},
|
|
515
|
-
${list(gv.map(v2 => `(${ix(v2)}, ${any0.e(m.state[v2])}, ${any0.e(m.step.state?.[v2] ?? { op: 'var', name: v2 })})`))}⟩
|
|
516
|
-
def ${id}_machine : FMMachine := ${id}_ghosted.full
|
|
517
|
-
theorem ${id}_ghostOk : ghostOk ${id}_ghosted = true := by decide +kernel` : `def ${id}_machine : FMMachine := ${lit(m)}`;
|
|
518
|
-
// What the refinement means (Refine.lean's refines), from the laws and the step law (the spec allows the request).
|
|
519
|
-
const refinesText = () => {
|
|
520
|
-
const sl = opts.stepLaws[0], goal = stepLawObligations(m, laws, sp.proof.instances, sl)[0], pr = enc(goal, sp.proof.trees[goal.name]);
|
|
521
|
-
const insts = list(laws.flatMap((l, li) => (l.forall ? (sp.proof.instances[l.name] ?? []).map(key => `(${li}, ${any0.e(key)})`) : [])));
|
|
522
|
-
const primes = list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), primeMaps = list(baseMaps.map(mp => `(${mapNames.indexOf(mp)}, ${mapNames.indexOf(`${mp}'`)})`));
|
|
523
|
-
return `
|
|
524
|
-
|
|
525
|
-
-- What the refinement means: every reachable state of the implementation, beside a reachable state of the spec, related
|
|
526
|
-
-- by every law.
|
|
527
|
-
theorem ${id}_allowed : checkStepLaw ${id}_machine ${id}_proof ⟨trueC, ${id}_refined.allowed, ${primes}, ${primeMaps}, ${insts}, (${pr.tab}, ${pr.tree})⟩ = true := by decide +kernel
|
|
528
|
-
theorem ${id}_refines : ∀ ρ M, FMReach ${id}_refined.impl ρ M → ∃ ρc Mc σ Ms, FMReach ${id}_refined.full ρc Mc ∧ Agree ${id}_refined.SV ρc ρ
|
|
529
|
-
∧ (∀ mp, mp ∉ ${id}_refined.SM → Mc mp = M mp) ∧ FMReach ${id}_refined.spec σ Ms ∧ Agree ${id}_refined.X σ ρc
|
|
530
|
-
∧ (∀ mp, mp ∉ ${id}_refined.IM → Ms mp = Mc mp) ∧ ∀ e ∈ ${id}_proof, e.law.Holds ρc Mc :=
|
|
531
|
-
refines ${id}_refined (by decide +kernel) (by decide +kernel) ${id}_proof ${id}_check ${rf.specPre} ⟨rfl, rfl⟩ ${primes} ${primeMaps} ${insts} (${pr.tab}, ${pr.tree}) ${id}_allowed (by decide +kernel)`;
|
|
532
|
-
};
|
|
533
|
-
const ghostLaws = gv.length ? `
|
|
534
|
-
-- The laws that read no ghost hold of the machine without its ghosts.
|
|
535
|
-
theorem ${id}_orig_laws : ∀ ρ M, FMReach ${id}_ghosted.orig ρ M → ∀ e ∈ ${id}_proof, avoids ${id}_ghosted.vars e.law.holds = true → e.law.Holds ρ M :=
|
|
536
|
-
ghost_laws ${id}_ghosted ${id}_ghostOk ${id}_proof ${id}_check` : '';
|
|
457
|
+
const machineDef = `def ${id}_machine : FMMachine := ${lit(m)}`;
|
|
537
458
|
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(', ')})
|
|
538
459
|
${machineDef}
|
|
539
460
|
${entries.join('\n')}
|
|
@@ -544,7 +465,7 @@ theorem ${id}_laws : ∀ ρ M, FMReach ${id}_machine ρ M → ∀ e ∈ ${id}_pr
|
|
|
544
465
|
${readable(id, laws, vars, mapNames, { binders: '(ρ : Nat → Nat) (μ : Nat → Nat → Nat)', hyp: `FMReach ${id}_machine ρ μ`, call: `${id}_laws ρ μ h` })}${opts.corollary ? `\n${opts.corollary}` : ''}${opts.tamper ? `
|
|
545
466
|
-- TAMPERED: ${opts.tamper.what}. Lean computes the check to false.
|
|
546
467
|
def ${id}_tampered : FMMachine := ${lit(opts.tamper.machine)}
|
|
547
|
-
example : checkFMMachine ${id}_tampered ${id}_proof = false := by decide +kernel` : ''}${progress.length ? `\n\n${progress.join('\n\n')}` : ''}${stepRecords.length ? `\n\n${stepRecords.join('\n\n')}` : ''}
|
|
468
|
+
example : checkFMMachine ${id}_tampered ${id}_proof = false := by decide +kernel` : ''}${progress.length ? `\n\n${progress.join('\n\n')}` : ''}${stepRecords.length ? `\n\n${stepRecords.join('\n\n')}` : ''}`;
|
|
548
469
|
}
|
|
549
470
|
// Machines with sets through Kern.smachine_sound and Kern.skstep_sound (Sets.lean): maps a request carries, flags that
|
|
550
471
|
// hold at every key (each its 0/1 variable ?f, closed at the proof's keys and at a witness w?f) and writes at every
|
|
@@ -561,22 +482,97 @@ export const hasSets = (m) => !!m.inputMaps?.length || Object.values(m.step.flag
|
|
|
561
482
|
|| !!Object.keys(m.fns ?? {}).length || !!m.facts?.length;
|
|
562
483
|
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] : []))];
|
|
563
484
|
export function smachineToLean(id, m, laws, opts = {}) {
|
|
564
|
-
const stepLaws = opts.stepLaws ?? [];
|
|
565
|
-
|
|
566
|
-
const
|
|
567
|
-
|
|
485
|
+
const stepLaws = opts.stepLaws ?? [], rf = opts.refined, gv = opts.ghosts ?? [];
|
|
486
|
+
const claims = [];
|
|
487
|
+
const claimSteps = () => claims.flatMap(cl => cl.steps);
|
|
488
|
+
// The machine's own step laws, one step or k (Sets.lean's skstep_sound).
|
|
489
|
+
if (!rf)
|
|
490
|
+
stepLaws.forEach((sl, j) => claims.push({ steps: [sl], allows: [], render: h => {
|
|
491
|
+
const { pr, inst } = h.step(sl), kk = sl.steps ?? 1;
|
|
492
|
+
const whens = sl.when === undefined ? [] : Array.isArray(sl.when) ? sl.when : [sl.when];
|
|
493
|
+
const ren = Array.from({ length: kk }, (_, s2) => (s2 === 0 ? '[]' : list(ext.map(v => `(${ix(v)}, ${ix(`${v}@${s2 + 1}`)})`))));
|
|
494
|
+
const mren = Array.from({ length: kk }, (_, s2) => (s2 === 0 ? '[]' : list(carried.map(mp => `(${mx(mp)}, ${mx(`${mp}@${s2 + 1}`)})`))));
|
|
495
|
+
return `-- Step law${kk > 1 ? ` over ${kk} steps` : ''}: ${sl.name}
|
|
496
|
+
def ${id}_step${j} : SKStep := ⟨⟨${list(Array.from({ length: kk }, (_, s2) => (whens[s2] ? c(inline(whens[s2])) : TRUE)))},
|
|
497
|
+
${c(inline(sl.then))},
|
|
498
|
+
${list(ren)},
|
|
499
|
+
${list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`))},
|
|
500
|
+
${list(Object.keys(m.maps ?? {}).map(mp => `(${mx(mp)}, ${mx(`${mp}'`)})`))},
|
|
501
|
+
${list(insts(inst))},
|
|
502
|
+
(${pr.tab}, ${pr.tree})⟩,
|
|
503
|
+
${list(mren)},
|
|
504
|
+
${list(qinsts(inst))},
|
|
505
|
+
${list(finsts(inst))},
|
|
506
|
+
${list(pinsts(inst))},
|
|
507
|
+
[]⟩
|
|
508
|
+
theorem ${id}_step${j}_holds : SKStepHolds ${id}_machine ${id}_step${j} :=
|
|
509
|
+
skstep_sound ${id}_machine ${id}_proof ${id}_step${j} ${id}_check (by decide +kernel)`;
|
|
510
|
+
} }));
|
|
511
|
+
// A refinement (Refine.lean's SRefined): its step law, that the spec stutters or allows the request it is sent; srefines
|
|
512
|
+
// says what the whole means.
|
|
513
|
+
if (rf)
|
|
514
|
+
claims.push({ steps: [stepLaws[0]], allows: [], render: h => {
|
|
515
|
+
const primesL = list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), primeMapsL = list(Object.keys(m.maps ?? {}).map(mp => `(${mx(mp)}, ${mx(`${mp}'`)})`));
|
|
516
|
+
const proofL = h.sproof(stepLaws[0]);
|
|
517
|
+
return `theorem ${id}_allowed : checkSKStep ${id}_machine ${id}_proof (srStep ${id}_refined ${primesL} ${primeMapsL} ${proofL}) = true := by decide +kernel
|
|
518
|
+
theorem ${id}_refines : ∀ ρ M, SReach ${id}_refined.impl ρ M → ∃ ρc Mc σ Ms, SReach ${id}_refined.full ρc Mc ∧ Agree ${id}_refined.SV ρc ρ
|
|
519
|
+
∧ (∀ mp, mp ∉ ${id}_refined.SM → Mc mp = M mp) ∧ SReach ${id}_refined.spec σ Ms ∧ Agree ${id}_refined.X σ ρc
|
|
520
|
+
∧ (∀ mp, mp ∉ ${id}_refined.IM → mp ∉ ${id}_refined.spec.carried → Ms mp = Mc mp) ∧ ∀ e ∈ ${id}_proof, e.Holds ρc Mc :=
|
|
521
|
+
srefines ${id}_refined (by decide +kernel) (by decide +kernel) ${id}_proof ${id}_check ${rf.specPre} ⟨rfl, rfl⟩ ${primesL} ${primeMapsL} ${proofL} ${id}_allowed (by decide +kernel) (by decide +kernel) (by decide +kernel)`;
|
|
522
|
+
} });
|
|
523
|
+
// Liveness (Live.lean's sleads_sound): its step laws (stay, cover, one per helpful request), and where each helpful
|
|
524
|
+
// request is proven allowed in its region, the same under weak fairness (sleads_wf_sound).
|
|
525
|
+
for (const [j, l] of (opts.liveness ?? []).entries()) {
|
|
526
|
+
const { stay, cover, helps } = livenessParts(m, l), helpful = livenessHelpful(l), lid = `${id}_live${j}`;
|
|
527
|
+
const allows = helps.map((hs, i) => ({ when: hs.when, request: helpful[i].request }));
|
|
528
|
+
claims.push({ steps: [stay, cover, ...helps], allows, render: h => {
|
|
529
|
+
const al = allows.map(h.allow);
|
|
530
|
+
const wf = al.every(a => a !== undefined) ? `
|
|
531
|
+
def ${lid}_ap : List (List (Nat × E) × SProof × List E) := ${list(al)}
|
|
532
|
+
theorem ${lid}_allows : sliveAllowsOk ${id}_machine ${id}_proof ${lid} ${lid}_ap = true := by decide +kernel
|
|
533
|
+
/-- ${l.name}, under weak fairness: along every run that takes each helpful request whenever, from some point on, it
|
|
534
|
+
stays allowed, \`from\` is followed by \`to\`. -/
|
|
535
|
+
theorem ${lid}_holds_wf (run : SRun ${id}_machine)
|
|
536
|
+
(fair : ∀ h ∈ ${lid}.helps, ∀ n, (∀ m, n ≤ m → ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)
|
|
537
|
+
∧ evalC (sView ${id}_machine (run.st m).1 (run.st m).2 ι κ).1 (sView ${id}_machine (run.st m).1 (run.st m).2 ι κ).2 ${id}_machine.f.m.assume = true) →
|
|
538
|
+
∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :
|
|
539
|
+
∀ n, evalC (run.st n).1 (run.st n).2 ${lid}.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 ${lid}.to = true :=
|
|
540
|
+
sleads_wf_sound ${id}_machine ${id}_proof ${lid} _ _ _ _ ${id}_check ${lid}_ok ${lid}_stay ${lid}_cover ${lid}_helps ${lid}_allows run fair` : '';
|
|
541
|
+
return `-- Liveness: ${l.name}
|
|
542
|
+
def ${lid} : Live := ${liveLit(l, { e, c }, ix, list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), list(Object.keys(m.maps ?? {}).map(mp => `(${mx(mp)}, ${mx(`${mp}'`)})`)))}
|
|
543
|
+
def ${lid}_sp : SProof := ${h.sproof(stay)}
|
|
544
|
+
def ${lid}_cp : SProof := ${h.sproof(cover)}
|
|
545
|
+
def ${lid}_hp : List SProof := ${list(helps.map(h.sproof))}
|
|
546
|
+
theorem ${lid}_ok : sliveOk ${id}_machine ${lid} = true := by decide +kernel
|
|
547
|
+
theorem ${lid}_stay : checkSKStep ${id}_machine ${id}_proof (sliveStep ${lid} ${lid}.pend (liveStayC ${lid}) ${lid}_sp) = true := by decide +kernel
|
|
548
|
+
theorem ${lid}_cover : checkSKStep ${id}_machine ${id}_proof (sliveStep ${lid} ${lid}.pend (liveCoverC ${lid}) ${lid}_cp) = true := by decide +kernel
|
|
549
|
+
theorem ${lid}_helps : sliveHelpsOk ${id}_machine ${id}_proof ${lid} ${lid}_hp = true := by decide +kernel
|
|
550
|
+
/-- ${l.name}: along every run that takes each helpful request infinitely often, \`from\` is followed by \`to\`. -/
|
|
551
|
+
theorem ${lid}_holds (run : SRun ${id}_machine)
|
|
552
|
+
(fair : ∀ h ∈ ${lid}.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :
|
|
553
|
+
∀ n, evalC (run.st n).1 (run.st n).2 ${lid}.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 ${lid}.to = true :=
|
|
554
|
+
sleads_sound ${id}_machine ${id}_proof ${lid} _ _ _ ${id}_check ${lid}_ok ${lid}_stay ${lid}_cover ${lid}_helps run fair${wf}`;
|
|
555
|
+
} });
|
|
556
|
+
}
|
|
557
|
+
// Ghosts (Ghost.lean's sghost_laws): the laws that read no ghost hold of the machine without its ghosts.
|
|
558
|
+
if (gv.length)
|
|
559
|
+
claims.push({ steps: [], allows: [], render: () => `-- The laws that read no ghost hold of the machine without its ghosts.
|
|
560
|
+
theorem ${id}_orig_laws : ∀ ρ M, SReach ${id}_ghosted.orig ρ M → ∀ e ∈ ${id}_proof, avoids ${id}_ghosted.vars e.law.holds = true → e.Holds ρ M :=
|
|
561
|
+
sghost_laws ${id}_ghosted ${id}_ghostOk ${id}_proof ${id}_check` });
|
|
562
|
+
const allSteps = claimSteps();
|
|
563
|
+
const r = proveStepLaws(m, laws, allSteps);
|
|
568
564
|
if (!r.proven || !r.proof)
|
|
569
565
|
throw new Error(`${id}: not proven`);
|
|
570
566
|
const lp = r.proof.laws, si = r.proof.instances;
|
|
571
567
|
const flags = Object.entries(m.step.flags ?? {}), quantified = flags.filter(([, c]) => c.op === 'all').map(([f]) => f);
|
|
572
568
|
const carried = m.inputMaps ?? [], facts = m.facts ?? [], keysOf = [...new Set([...laws, ...facts].flatMap(l => [l.forall, ...(l.keys ?? [])].filter((k) => !!k)))];
|
|
573
|
-
const k = Math.max(1, ...
|
|
569
|
+
const k = Math.max(1, ...allSteps.map(sl => sl.steps ?? 1));
|
|
574
570
|
const ext = [...m.inputs, ...quantified.flatMap(f => [`?${f}`, `w?${f}`])];
|
|
575
571
|
const later = Array.from({ length: k - 1 }, (_, j) => ext.map(v => `${v}@${j + 2}`)).flat();
|
|
576
572
|
const laterMaps = Array.from({ length: k - 1 }, (_, j) => carried.map(mp => `${mp}@${j + 2}`)).flat();
|
|
577
|
-
const primes =
|
|
573
|
+
const primes = allSteps.length ? Object.keys(m.state).map(s2 => `${s2}'`) : [];
|
|
578
574
|
const instOf = (sl) => r.proof.perStep?.[sl.name] ?? si;
|
|
579
|
-
const goalsL = obligations(m, laws, lp.instances), goalsS =
|
|
575
|
+
const goalsL = obligations(m, laws, lp.instances), goalsS = allSteps.map(sl => stepLawObligations(m, laws, instOf(sl), sl)[0]);
|
|
580
576
|
// Weak fairness over sets: each helpful request allowed in its region carrying empty sets (Live.lean's sAllowGoal,
|
|
581
577
|
// built here as Lean builds it: facts, laws, `when`, each quantified flag closed, the carried maps 0 at the keys read,
|
|
582
578
|
// and the assumption's failing, its plain flags inlined as `if c then 1 else 0 = 1`).
|
|
@@ -622,16 +618,16 @@ export function smachineToLean(id, m, laws, opts = {}) {
|
|
|
622
618
|
const last = { op: 'not', x: sInline(m.assume ?? trueC) }, zkeys = carriedKeys([...base, last]);
|
|
623
619
|
return { name: 'allowed', hyps: [...base, ...(m.inputMaps ?? []).flatMap(mp => zkeys.map(t => eqC({ op: 'get', map: mp, key: t }, zero1(0)))), last], zkeys };
|
|
624
620
|
};
|
|
625
|
-
const
|
|
626
|
-
|
|
627
|
-
|
|
628
|
-
|
|
629
|
-
const allowGoals =
|
|
621
|
+
const allowed = new Map(claims.flatMap(cl => cl.allows).map(a => [a, withWitness(m, a.request, wit => {
|
|
622
|
+
const r2 = proveBuilt(m, laws, inst => allowGoalS(inst, { op: 'and', xs: [a.when, reqTS(wit)] }));
|
|
623
|
+
return r2.proven ? r2 : undefined;
|
|
624
|
+
})]));
|
|
625
|
+
const allowGoals = [...allowed.values()].flatMap(a => (a ? [a.out.goal] : []));
|
|
630
626
|
const vars = [...new Set([...m.params, ...m.inputs, ...Object.keys(m.state), ...keysOf, ...keysOf.map(k2 => `${k2}#`), '#', ...flags.map(([f]) => `?${f}`),
|
|
631
627
|
...quantified.map(f => `w?${f}`), ...boundKeys(m), ...(opts.tamper ? boundKeys(opts.tamper.machine) : []), ...stepLaws.flatMap(sl => (sl.forall ? [sl.forall] : [])), ...(opts.free ?? []),
|
|
632
628
|
...primes, ...later, ...[...goalsL, ...goalsS, ...allowGoals].flatMap(g => g.hyps.flatMap(varsOf))])];
|
|
633
629
|
const baseMaps = [...new Set([...Object.keys(m.maps ?? {}), ...Object.keys(m.step.maps ?? {}), ...Object.keys(m.fns ?? {})])];
|
|
634
|
-
const mapNames = [...new Set([...baseMaps, ...carried, ...(
|
|
630
|
+
const mapNames = [...new Set([...baseMaps, ...carried, ...(allSteps.length ? Object.keys(m.maps ?? {}).map(mp => `${mp}'`) : []), ...laterMaps,
|
|
635
631
|
...[...JSON.stringify([...goalsL, ...goalsS, ...allowGoals]).matchAll(/"op":"get","map":"([^"]+)"/g)].map(x2 => x2[1])])];
|
|
636
632
|
const enc = (g, tree) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars, mapNames);
|
|
637
633
|
const { e, c } = leanTerms(vars, mapNames, id);
|
|
@@ -669,85 +665,34 @@ export function smachineToLean(id, m, laws, opts = {}) {
|
|
|
669
665
|
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] ?? {};
|
|
670
666
|
return `def ${id}_l${j} : MLaw := ⟨${c(law.holds)}, ${law.forall ? `some ${ix(law.forall)}` : 'none'}⟩
|
|
671
667
|
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))},
|
|
672
|
-
(${a.tab}, ${a.tree}),
|
|
673
|
-
(${b.tab}, ${b.tree})⟩`;
|
|
674
|
-
});
|
|
675
|
-
// A refinement over sets (Refine.lean's SRefined): Lean builds the composite from its two sides; its one step law is
|
|
676
|
-
// that the spec stutters or allows the request it is sent, and srefines says what the whole means.
|
|
677
|
-
const rf = opts.refined;
|
|
678
|
-
const refineRecord = rf ? (() => {
|
|
679
|
-
const g = goalsS[0], pr = enc(g, r.proof.trees[g.name]), inst = instOf(stepLaws[0]);
|
|
680
|
-
const primesL = list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), primeMapsL = list(Object.keys(m.maps ?? {}).map(mp => `(${mx(mp)}, ${mx(`${mp}'`)})`));
|
|
681
|
-
const proofL = `(${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))}, (${pr.tab}, ${pr.tree}))`;
|
|
682
|
-
return `theorem ${id}_allowed : checkSKStep ${id}_machine ${id}_proof (srStep ${id}_refined ${primesL} ${primeMapsL} ${proofL}) = true := by decide +kernel
|
|
683
|
-
theorem ${id}_refines : ∀ ρ M, SReach ${id}_refined.impl ρ M → ∃ ρc Mc σ Ms, SReach ${id}_refined.full ρc Mc ∧ Agree ${id}_refined.SV ρc ρ
|
|
684
|
-
∧ (∀ mp, mp ∉ ${id}_refined.SM → Mc mp = M mp) ∧ SReach ${id}_refined.spec σ Ms ∧ Agree ${id}_refined.X σ ρc
|
|
685
|
-
∧ (∀ mp, mp ∉ ${id}_refined.IM → mp ∉ ${id}_refined.spec.carried → Ms mp = Mc mp) ∧ ∀ e ∈ ${id}_proof, e.Holds ρc Mc :=
|
|
686
|
-
srefines ${id}_refined (by decide +kernel) (by decide +kernel) ${id}_proof ${id}_check ${rf.specPre} ⟨rfl, rfl⟩ ${primesL} ${primeMapsL} ${proofL} ${id}_allowed (by decide +kernel) (by decide +kernel) (by decide +kernel)`;
|
|
687
|
-
})() : '';
|
|
688
|
-
const stepRecords = (rf ? [] : stepLaws).map((sl, j) => {
|
|
689
|
-
const g = goalsS[j], pr = enc(g, r.proof.trees[g.name]), kk = sl.steps ?? 1;
|
|
690
|
-
const whens = sl.when === undefined ? [] : Array.isArray(sl.when) ? sl.when : [sl.when];
|
|
691
|
-
const ren = Array.from({ length: kk }, (_, s2) => (s2 === 0 ? '[]' : list(ext.map(v => `(${ix(v)}, ${ix(`${v}@${s2 + 1}`)})`))));
|
|
692
|
-
const mren = Array.from({ length: kk }, (_, s2) => (s2 === 0 ? '[]' : list(carried.map(mp => `(${mx(mp)}, ${mx(`${mp}@${s2 + 1}`)})`))));
|
|
693
|
-
return `-- Step law${kk > 1 ? ` over ${kk} steps` : ''}: ${sl.name}
|
|
694
|
-
def ${id}_step${j} : SKStep := ⟨⟨${list(Array.from({ length: kk }, (_, s2) => (whens[s2] ? c(inline(whens[s2])) : TRUE)))},
|
|
695
|
-
${c(inline(sl.then))},
|
|
696
|
-
${list(ren)},
|
|
697
|
-
${list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`))},
|
|
698
|
-
${list(Object.keys(m.maps ?? {}).map(mp => `(${mx(mp)}, ${mx(`${mp}'`)})`))},
|
|
699
|
-
${list(insts(instOf(sl)))},
|
|
700
|
-
(${pr.tab}, ${pr.tree})⟩,
|
|
701
|
-
${list(mren)},
|
|
702
|
-
${list(qinsts(instOf(sl)))},
|
|
703
|
-
${list(finsts(instOf(sl)))},
|
|
704
|
-
${list(pinsts(instOf(sl)))}⟩
|
|
705
|
-
theorem ${id}_step${j}_holds : SKStepHolds ${id}_machine ${id}_step${j} :=
|
|
706
|
-
skstep_sound ${id}_machine ${id}_proof ${id}_step${j} ${id}_check (by decide +kernel)`;
|
|
707
|
-
});
|
|
708
|
-
const liveRecords = (opts.liveness ?? []).map((l, j) => {
|
|
709
|
-
const { stay, cover, helps } = liveParts[j], lid = `${id}_live${j}`;
|
|
710
|
-
const al = allowS[j];
|
|
711
|
-
const wf = al.every(a => a !== undefined) ? `
|
|
712
|
-
def ${lid}_ap : List (List (Nat × E) × SProof × List E) := ${list(al.map(f2 => {
|
|
713
|
-
const a = f2.out, pr = enc(a.goal, a.tree), inst = a.instances;
|
|
714
|
-
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}, ${pr.tree})), ${list(a.goal.zkeys.map(e))})`;
|
|
715
|
-
}))}
|
|
716
|
-
theorem ${lid}_allows : sliveAllowsOk ${id}_machine ${id}_proof ${lid} ${lid}_ap = true := by decide +kernel
|
|
717
|
-
/-- ${l.name}, under weak fairness: along every run that takes each helpful request whenever, from some point on, it
|
|
718
|
-
stays allowed, \`from\` is followed by \`to\`. -/
|
|
719
|
-
theorem ${lid}_holds_wf (run : SRun ${id}_machine)
|
|
720
|
-
(fair : ∀ h ∈ ${lid}.helps, ∀ n, (∀ m, n ≤ m → ∃ ι κ, (∀ p ∈ h.2, ι p.1 = evalE (run.st m).1 (run.st m).2 p.2)
|
|
721
|
-
∧ evalC (sView ${id}_machine (run.st m).1 (run.st m).2 ι κ).1 (sView ${id}_machine (run.st m).1 (run.st m).2 ι κ).2 ${id}_machine.f.m.assume = true) →
|
|
722
|
-
∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :
|
|
723
|
-
∀ n, evalC (run.st n).1 (run.st n).2 ${lid}.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 ${lid}.to = true :=
|
|
724
|
-
sleads_wf_sound ${id}_machine ${id}_proof ${lid} _ _ _ _ ${id}_check ${lid}_ok ${lid}_stay ${lid}_cover ${lid}_helps ${lid}_allows run fair` : '';
|
|
725
|
-
const proofOf = (sl) => {
|
|
726
|
-
const g = goalsS[stepLaws.length + liveSteps.indexOf(sl)], pr = enc(g, r.proof.trees[g.name]), inst = instOf(sl);
|
|
727
|
-
return `(${list(insts(inst))}, ${list(qinsts(inst))}, ${list(finsts(inst))}, ${list(pinsts(inst))}, (${pr.tab}, ${pr.tree}))`;
|
|
728
|
-
};
|
|
729
|
-
return `-- Liveness: ${l.name}
|
|
730
|
-
def ${lid} : Live := ${liveLit(l, { e, c }, ix, list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), list(Object.keys(m.maps ?? {}).map(mp => `(${mx(mp)}, ${mx(`${mp}'`)})`)))}
|
|
731
|
-
def ${lid}_sp : SProof := ${proofOf(stay)}
|
|
732
|
-
def ${lid}_cp : SProof := ${proofOf(cover)}
|
|
733
|
-
def ${lid}_hp : List SProof := ${list(helps.map(proofOf))}
|
|
734
|
-
theorem ${lid}_ok : sliveOk ${id}_machine ${lid} = true := by decide +kernel
|
|
735
|
-
theorem ${lid}_stay : checkSKStep ${id}_machine ${id}_proof (sliveStep ${lid} ${lid}.pend (liveStayC ${lid}) ${lid}_sp) = true := by decide +kernel
|
|
736
|
-
theorem ${lid}_cover : checkSKStep ${id}_machine ${id}_proof (sliveStep ${lid} ${lid}.pend (liveCoverC ${lid}) ${lid}_cp) = true := by decide +kernel
|
|
737
|
-
theorem ${lid}_helps : sliveHelpsOk ${id}_machine ${id}_proof ${lid} ${lid}_hp = true := by decide +kernel
|
|
738
|
-
/-- ${l.name}: along every run that takes each helpful request infinitely often, \`from\` is followed by \`to\`. -/
|
|
739
|
-
theorem ${lid}_holds (run : SRun ${id}_machine)
|
|
740
|
-
(fair : ∀ h ∈ ${lid}.helps, ∀ n, ∃ m, n ≤ m ∧ ∀ p ∈ h.2, (run.req m).1 p.1 = evalE (run.st m).1 (run.st m).2 p.2) :
|
|
741
|
-
∀ n, evalC (run.st n).1 (run.st n).2 ${lid}.from_ = true → ∃ m, n ≤ m ∧ evalC (run.st m).1 (run.st m).2 ${lid}.to = true :=
|
|
742
|
-
sleads_sound ${id}_machine ${id}_proof ${lid} _ _ _ ${id}_check ${lid}_ok ${lid}_stay ${lid}_cover ${lid}_helps run fair${wf}`;
|
|
668
|
+
(${a.tab}, [], ${a.tree}),
|
|
669
|
+
(${b.tab}, [], ${b.tree})⟩`;
|
|
743
670
|
});
|
|
671
|
+
// A ghosted machine (compose.ts's ghost): the original and its ghosts, the machine Lean checks built from them
|
|
672
|
+
// (Ghost.lean), so the laws that read no ghost are laws of the original.
|
|
673
|
+
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))) } };
|
|
674
|
+
const h = {
|
|
675
|
+
step: sl => { const g = goalsS[allSteps.indexOf(sl)]; return { pr: enc(g, r.proof.trees[g.name]), inst: instOf(sl) }; },
|
|
676
|
+
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}))`; },
|
|
677
|
+
allow: a => {
|
|
678
|
+
const f2 = allowed.get(a);
|
|
679
|
+
if (!f2)
|
|
680
|
+
return undefined;
|
|
681
|
+
const ar = f2.out, pr = enc(ar.goal, ar.tree), inst = ar.instances;
|
|
682
|
+
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))})`;
|
|
683
|
+
},
|
|
684
|
+
};
|
|
685
|
+
const records = claims.map(cl => cl.render(h)).filter(t => t.length);
|
|
744
686
|
return `-- ${m.name}: ${laws.map(l => l.name).join('; ')}, with sets (carried ${carried.join(', ') || 'none'}; quantified flags ${quantified.join(', ') || 'none'})
|
|
745
687
|
-- (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')}; maps ${mapNames.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
746
688
|
${rf ? `def ${id}_refined : SRefined := ⟨${lit(rf.impl)},
|
|
747
689
|
${lit(rf.spec)},
|
|
748
690
|
${list(Object.entries(rf.wit).map(([inp, t]) => `(${ix(`b_${inp}`)}, ${e(t)})`))},
|
|
749
691
|
${c(rf.stutter)}⟩
|
|
750
|
-
def ${id}_machine : SMachine := ${id}_refined.full` : `def ${id}
|
|
692
|
+
def ${id}_machine : SMachine := ${id}_refined.full` : gv.length ? `def ${id}_ghosted : SGhosted := ⟨${lit(orig)},
|
|
693
|
+
${list(gv.map(v2 => `(${ix(v2)}, ${e(m.state[v2])}, ${e(m.step.state?.[v2] ?? { op: 'var', name: v2 })})`))}⟩
|
|
694
|
+
def ${id}_machine : SMachine := ${id}_ghosted.full
|
|
695
|
+
theorem ${id}_ghostOk : sghostOk ${id}_ghosted = true := by decide +kernel` : `def ${id}_machine : SMachine := ${lit(m)}`}
|
|
751
696
|
${entries.join('\n')}
|
|
752
697
|
def ${id}_proof : List SEntry := ${list(laws.map((_, j) => `${id}_e${j}`))}
|
|
753
698
|
theorem ${id}_check : checkSMachine ${id}_machine ${id}_proof = true := by decide +kernel
|
|
@@ -756,7 +701,7 @@ theorem ${id}_laws : ∀ ρ M, SReach ${id}_machine ρ M → ∀ e ∈ ${id}_pro
|
|
|
756
701
|
${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 ? `
|
|
757
702
|
-- TAMPERED: ${opts.tamper.what}. Lean computes the check to false.
|
|
758
703
|
def ${id}_tampered : SMachine := ${lit(opts.tamper.machine)}
|
|
759
|
-
example : checkSMachine ${id}_tampered ${id}_proof = false := by decide +kernel` : ''}${
|
|
704
|
+
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)}` : ''}`;
|
|
760
705
|
}
|
|
761
706
|
// The facts, proven in Lean of the functions' Lean definitions, when every function has one: a run that starts with
|
|
762
707
|
// those functions starts where SReach asks the facts to hold.
|
|
@@ -855,29 +800,23 @@ export function toLean(items, opts = {}) {
|
|
|
855
800
|
}
|
|
856
801
|
if (m.history && (m.fns || m.facts))
|
|
857
802
|
throw new Error(`${item.id}: functions on a machine with a history aren't exported to Lean yet`);
|
|
858
|
-
|
|
859
|
-
|
|
860
|
-
|
|
861
|
-
|
|
803
|
+
// One twin: a machine without a history goes to Lean as a machine with sets (one with none, if it has none): its laws,
|
|
804
|
+
// step laws, liveness and ghosts in one export. A history's laws go through History.lean, and its step laws and
|
|
805
|
+
// liveness through its plain machine (its sums as state, its queries as inputs).
|
|
806
|
+
if (m.history) {
|
|
807
|
+
parts.push(`-- ${item.id}\n${hmachineToLean(id, m, item.laws)}`);
|
|
808
|
+
theorems.push(`${id}_laws`);
|
|
809
|
+
if (item.stepLaws?.length || item.liveness?.length) {
|
|
810
|
+
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 } : {}) })}`);
|
|
811
|
+
theorems.push(...(item.stepLaws ?? []).map((_, j) => `${id}s_step${j}_holds`), ...(item.liveness ?? []).map((_, j) => `${id}s_live${j}_holds`));
|
|
812
|
+
}
|
|
862
813
|
continue;
|
|
863
814
|
}
|
|
864
|
-
|
|
865
|
-
|
|
866
|
-
|
|
867
|
-
item.liveness.forEach((_, j) => theorems.push(`${id}s_live${j}_holds`));
|
|
868
|
-
}
|
|
869
|
-
const ghosted = item.ghosts?.length ? { ghosts: item.ghosts, stepLaws: item.stepLaws ?? [], ...(item.lean?.after ? { after: item.lean.after } : {}) } : {};
|
|
870
|
-
parts.push(`-- ${item.id}\n${m.history ? hmachineToLean(id, m, item.laws) : mmachineToLean(id, m, item.laws, { ...(item.liveness?.length ? { liveness: item.liveness } : {}), ...ghosted })}`);
|
|
871
|
-
theorems.push(`${id}_laws`, ...(m.history ? [] : (item.liveness ?? []).map((_, j) => `${id}_live${j}_holds`)));
|
|
872
|
-
if (item.ghosts?.length)
|
|
873
|
-
item.stepLaws?.forEach((_, j) => theorems.push(`${id}_step${j}_holds`));
|
|
815
|
+
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 } : {}),
|
|
816
|
+
...(item.ghosts?.length ? { ghosts: item.ghosts } : {}), ...(item.lean?.simp ? { simp: item.lean.simp } : {}), ...(item.lean?.after ? { after: item.lean.after } : {}) })}`);
|
|
817
|
+
theorems.push(`${id}_laws`, ...(item.stepLaws ?? []).map((_, j) => `${id}_step${j}_holds`), ...(item.liveness ?? []).map((_, j) => `${id}_live${j}_holds`));
|
|
874
818
|
if (item.lean?.after)
|
|
875
819
|
theorems.push(...[...item.lean.after(() => 0).matchAll(/^theorem (\S+)/gm)].map(x2 => x2[1]));
|
|
876
|
-
else if (item.stepLaws?.length) {
|
|
877
|
-
const plain = m.history ? historyMachine(m).machine : m, sid = m.history ? `${id}s` : `${id}_steps`;
|
|
878
|
-
parts.push(`-- ${item.id}: step laws\n${mmachineToLean(sid, plain, item.laws, { stepLaws: item.stepLaws })}`);
|
|
879
|
-
item.stepLaws.forEach((_, j) => theorems.push(`${sid}_step${j}_holds`));
|
|
880
|
-
}
|
|
881
820
|
}
|
|
882
821
|
else if ('refinement' in item) {
|
|
883
822
|
const { impl, spec, relation, witness } = item.refinement;
|
|
@@ -886,7 +825,7 @@ export function toLean(items, opts = {}) {
|
|
|
886
825
|
const laws = [...relation, { name: `${spec.name}'s precondition`, holds: spec.pre ?? atMost(n(0), n(0)) }];
|
|
887
826
|
const sl = R.stepLaws[0] ?? { name: `${spec.name} allows the request it is sent`, then: { op: 'or', xs: [stutter, atMost(n(0), n(0))] } };
|
|
888
827
|
const refined = { impl: S.impl, spec: S.spec, wit: witness, stutter, specPre: relation.length }, free = spec.inputs.map(i => `b_${i}`);
|
|
889
|
-
parts.push(`-- ${item.id}\n${
|
|
828
|
+
parts.push(`-- ${item.id}\n${smachineToLean(id, R.machine, laws, { stepLaws: [sl], free, refined })}`);
|
|
890
829
|
theorems.push(`${id}_laws`, `${id}_refines`);
|
|
891
830
|
}
|
|
892
831
|
else if ('loop' in item) {
|
|
@@ -902,7 +841,7 @@ export function toLean(items, opts = {}) {
|
|
|
902
841
|
}
|
|
903
842
|
// Sets.lean (which imports Steps.lean) only when a machine has sets.
|
|
904
843
|
return `import History
|
|
905
|
-
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
|
|
844
|
+
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'}
|
|
906
845
|
open Kern Cert
|
|
907
846
|
set_option maxRecDepth 100000
|
|
908
847
|
set_option maxHeartbeats 0
|