gdp-wired 0.2.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 +128 -92
- package/dist/core/compose.d.ts +15 -1
- package/dist/core/compose.js +132 -8
- package/dist/core/dsl.d.ts +272 -17
- package/dist/core/dsl.js +1098 -60
- package/dist/core/machine.d.ts +34 -6
- package/dist/core/machine.js +194 -22
- package/dist/core/watch.d.ts +14 -0
- package/dist/core/watch.js +78 -0
- package/dist/kernel/kernel.d.ts +30 -2
- package/dist/kernel/kernel.js +306 -48
- package/dist/kernel/prove.d.ts +36 -9
- package/dist/kernel/prove.js +317 -28
- package/dist/lean-kernel/emit.d.ts +124 -0
- package/dist/lean-kernel/emit.js +875 -0
- package/dist/lean-kernel/lean-terms.d.ts +5 -0
- package/dist/lean-kernel/lean-terms.js +44 -0
- package/dist/lean-kernel/library.d.ts +1 -0
- package/dist/lean-kernel/library.js +13 -0
- package/package.json +11 -4
|
@@ -0,0 +1,875 @@
|
|
|
1
|
+
import { atMost, n, not, pointWrite } from "../core/machine.js";
|
|
2
|
+
import { add, k, scale, sub } from "../core/solver.js";
|
|
3
|
+
import { canon, historyMachine, foldObligations, leafConstraints, linear, livenessHelpful, livenessParts, livenessRanks, loopObligations, trueC, obligations, progressObligations, stepLawObligations, substC, withProducts } from "../kernel/kernel.js";
|
|
4
|
+
import { grow, proveBuilt, proveLaws, proveStepLaws } from "../kernel/prove.js";
|
|
5
|
+
import { refinement, refinementSides } from "../core/compose.js";
|
|
6
|
+
import { leanTerms } from "./lean-terms.js";
|
|
7
|
+
import { leanLibrary } from "./library.js";
|
|
8
|
+
export { leanLibrary };
|
|
9
|
+
// --- to Lean ------------------------------------------------------------------------------------------------------------
|
|
10
|
+
const varsOf = (c) => [...JSON.stringify(c).matchAll(/"op":"var","name":"([^"]+)"/g)].map(m => m[1]);
|
|
11
|
+
const parseKey = (text) => {
|
|
12
|
+
const lin = {};
|
|
13
|
+
let depth = 0, start = 0;
|
|
14
|
+
for (let i = 0; i <= text.length; i++) {
|
|
15
|
+
const ch = text[i];
|
|
16
|
+
if (ch === '[')
|
|
17
|
+
depth++;
|
|
18
|
+
else if (ch === ']')
|
|
19
|
+
depth--;
|
|
20
|
+
else if ((ch === ',' && depth === 0) || i === text.length) {
|
|
21
|
+
if (i > start) {
|
|
22
|
+
const part = text.slice(start, i), at = part.lastIndexOf(':');
|
|
23
|
+
lin[part.slice(0, at)] = Number(part.slice(at + 1));
|
|
24
|
+
}
|
|
25
|
+
start = i + 1;
|
|
26
|
+
}
|
|
27
|
+
}
|
|
28
|
+
return lin;
|
|
29
|
+
};
|
|
30
|
+
const cellKey = (cell) => parseKey(cell.slice(cell.indexOf('[') + 1, -1));
|
|
31
|
+
const cellMap = (cell) => cell.slice(0, cell.indexOf('['));
|
|
32
|
+
const decide = (lin, path) => {
|
|
33
|
+
if (Object.keys(lin).every(key => key === '1'))
|
|
34
|
+
return (lin['1'] ?? 0) <= 0;
|
|
35
|
+
const d = path.get(canon(lin))?.holds;
|
|
36
|
+
if (d !== undefined)
|
|
37
|
+
return d;
|
|
38
|
+
const f = path.get(canon(add(k(1), scale(lin, -1))))?.holds;
|
|
39
|
+
return f === undefined ? undefined : !f;
|
|
40
|
+
};
|
|
41
|
+
export const int = (v) => (v < 0 ? `(${v})` : String(v));
|
|
42
|
+
export const list = (xs) => `[${xs.join(', ')}]`;
|
|
43
|
+
export function leaves(t, path, visit) {
|
|
44
|
+
if ('leaf' in t)
|
|
45
|
+
return visit(t, path);
|
|
46
|
+
const id = canon(t.split);
|
|
47
|
+
leaves(t.yes, new Map(path).set(id, { lin: t.split, holds: true }), visit);
|
|
48
|
+
leaves(t.no, new Map(path).set(id, { lin: t.split, holds: false }), visit);
|
|
49
|
+
}
|
|
50
|
+
export function encode(ex, tamper = false, dropStep = true, globalVars, globalMaps) {
|
|
51
|
+
const { goal, tree } = ex;
|
|
52
|
+
// Columns: every variable of the hypotheses, then every cell any leaf uses (and the cells inside their keys),
|
|
53
|
+
// shallower cells first so a key reads only earlier columns.
|
|
54
|
+
const vars = globalVars ?? [...new Set(goal.hyps.flatMap(varsOf))];
|
|
55
|
+
const cells = new Set();
|
|
56
|
+
const addCell = (name) => { if (cells.has(name))
|
|
57
|
+
return; cells.add(name); for (const key of Object.keys(cellKey(name)))
|
|
58
|
+
if (key.includes('['))
|
|
59
|
+
addCell(key); };
|
|
60
|
+
// Monomials: every one a leaf's rows or products use, or that a product term has under the leaf's path.
|
|
61
|
+
const monos = new Set();
|
|
62
|
+
const subterms = (c) => {
|
|
63
|
+
const out2 = [];
|
|
64
|
+
const we = (e) => { out2.push(e); if (e.op === 'if') {
|
|
65
|
+
wc(e.c);
|
|
66
|
+
we(e.then);
|
|
67
|
+
we(e.else);
|
|
68
|
+
}
|
|
69
|
+
else if (e.op === 'get')
|
|
70
|
+
we(e.key);
|
|
71
|
+
else if ('a' in e) {
|
|
72
|
+
we(e.a);
|
|
73
|
+
if ('b' in e)
|
|
74
|
+
we(e.b);
|
|
75
|
+
} };
|
|
76
|
+
const wc = (c2) => (c2.op === 'flag' ? undefined : c2.op === 'all' ? wc(c2.c) : c2.op === 'not' ? wc(c2.x) : c2.op === 'and' || c2.op === 'or' ? c2.xs.forEach(wc) : (we(c2.a), we(c2.b)));
|
|
77
|
+
wc(c);
|
|
78
|
+
return out2;
|
|
79
|
+
};
|
|
80
|
+
leaves(tree, new Map(), (leaf, path) => {
|
|
81
|
+
for (const r of withProducts(leafConstraints(goal, path), leaf.products ?? []))
|
|
82
|
+
for (const key of Object.keys(r.lin)) {
|
|
83
|
+
if (key.includes('['))
|
|
84
|
+
addCell(key);
|
|
85
|
+
else if (key.includes('*'))
|
|
86
|
+
monos.add(key);
|
|
87
|
+
}
|
|
88
|
+
for (const h of goal.hyps)
|
|
89
|
+
for (const e of subterms(h))
|
|
90
|
+
if (e.op === 'prod')
|
|
91
|
+
for (const key of Object.keys(linear(e, path) ?? {}))
|
|
92
|
+
if (key.includes('*'))
|
|
93
|
+
monos.add(key);
|
|
94
|
+
});
|
|
95
|
+
const depth = (name) => name.split('[').length;
|
|
96
|
+
const cols = [...vars, ...[...monos].sort((a, b) => a.split('*').length - b.split('*').length), ...[...cells].sort((a, b) => depth(a) - depth(b))];
|
|
97
|
+
const col = new Map(cols.map((name, j) => [name, j]));
|
|
98
|
+
const maps = globalMaps ?? [...new Set([...[...cells].map(cellMap), ...goal.hyps.flatMap(h => [...JSON.stringify(h).matchAll(/"op":"get","map":"([^"]+)"/g)].map(m => m[1]))])];
|
|
99
|
+
const dense = (lin) => {
|
|
100
|
+
const coefs = new Array(cols.length).fill(0);
|
|
101
|
+
for (const [key, c] of Object.entries(lin))
|
|
102
|
+
if (key !== '1') {
|
|
103
|
+
const j = col.get(key);
|
|
104
|
+
if (j === undefined)
|
|
105
|
+
throw new Error(`${ex.name}: no column for ${key}`);
|
|
106
|
+
coefs[j] = c;
|
|
107
|
+
}
|
|
108
|
+
while (coefs.length && coefs.at(-1) === 0)
|
|
109
|
+
coefs.pop();
|
|
110
|
+
return coefs;
|
|
111
|
+
};
|
|
112
|
+
const row = (lin) => `⟨${list(dense(lin).map(int))}, ${int(lin['1'] ?? 0)}⟩`;
|
|
113
|
+
const tab = cols.map(name => (name.includes('[') ? `.cell ${maps.indexOf(cellMap(name))} ${row(cellKey(name))}`
|
|
114
|
+
: name.includes('*') ? `.mono ${list(name.split('*').map(f => { const j = vars.indexOf(f); if (j < 0)
|
|
115
|
+
throw new Error(`${ex.name}: factor ${f}`); return j; }).sort((a, b) => a - b).map(String))}`
|
|
116
|
+
: `.var ${vars.indexOf(name)}`));
|
|
117
|
+
const { e, c } = leanTerms(vars, maps, ex.name);
|
|
118
|
+
let leafNo = 0;
|
|
119
|
+
const lean = (t, path) => {
|
|
120
|
+
if (!('leaf' in t)) {
|
|
121
|
+
const id = canon(t.split);
|
|
122
|
+
return `.split ${row(t.split)}\n (${lean(t.yes, new Map(path).set(id, { lin: t.split, holds: true }))})\n (${lean(t.no, new Map(path).set(id, { lin: t.split, holds: false }))})`;
|
|
123
|
+
}
|
|
124
|
+
const base = leafConstraints(goal, path), prods = t.products ?? [];
|
|
125
|
+
const rows = withProducts(base, prods).map(r => r.lin), n0 = base.length;
|
|
126
|
+
// Only the rows the derivation and the products read, renumbered (products follow them, in order); cuts carry
|
|
127
|
+
// their quotient row (Cert's format).
|
|
128
|
+
const used = [...new Set([...t.leaf.flatMap(s => (s.kind === 'input' && s.index < n0 ? [s.index] : [])), ...prods.flat().filter(i => i < n0)])].sort((a, b) => a - b);
|
|
129
|
+
const at = new Map(used.map((old, j) => [old, j]));
|
|
130
|
+
const idx = (i) => (i < n0 ? at.get(i) : used.length + i - n0);
|
|
131
|
+
const replay = [];
|
|
132
|
+
let steps = t.leaf.map(s => {
|
|
133
|
+
if (s.kind === 'input') {
|
|
134
|
+
replay.push(rows[s.index]);
|
|
135
|
+
return `.input ${idx(s.index)}`;
|
|
136
|
+
}
|
|
137
|
+
if (s.kind === 'combine') {
|
|
138
|
+
replay.push(add(scale(replay[s.a], s.ma), scale(replay[s.b], s.mb)));
|
|
139
|
+
return `.combine ${s.a} ${s.b} ${int(s.ma)} ${int(s.mb)}`;
|
|
140
|
+
}
|
|
141
|
+
const from = replay[s.of];
|
|
142
|
+
const q = Object.fromEntries(Object.entries(from).filter(([key]) => key !== '1').map(([key, v]) => [key, v / s.g]));
|
|
143
|
+
const cc = Math.ceil((from['1'] ?? 0) / s.g);
|
|
144
|
+
replay.push({ ...q, 1: cc });
|
|
145
|
+
return `.cut ${s.of} ${int(s.g)} ${list(dense(q).map(int))} ${int(cc)}`;
|
|
146
|
+
});
|
|
147
|
+
if (tamper && dropStep && leafNo++ === 0)
|
|
148
|
+
steps = steps.slice(0, -1); // the first leaf loses its last step
|
|
149
|
+
// Cell pairs the path proves equal (Lean re-checks each).
|
|
150
|
+
const eqs = [];
|
|
151
|
+
const cellCols = cols.map((name, j) => ({ name, j })).filter(c2 => c2.name.includes('['));
|
|
152
|
+
for (const [a, p] of cellCols.entries())
|
|
153
|
+
for (const q of cellCols.slice(a + 1)) {
|
|
154
|
+
if (cellMap(p.name) !== cellMap(q.name))
|
|
155
|
+
continue;
|
|
156
|
+
const d = sub(cellKey(p.name), cellKey(q.name));
|
|
157
|
+
if (decide(d, path) === true && decide(scale(d, -1), path) === true)
|
|
158
|
+
eqs.push(`(${p.j}, ${q.j})`);
|
|
159
|
+
}
|
|
160
|
+
return `.leaf ${list(used.map(u => row(rows[u])))} ${list(steps)} ${list(eqs)} ${list(prods.map(([i, j]) => `(${idx(i)}, ${idx(j)})`))}`;
|
|
161
|
+
};
|
|
162
|
+
return { tab: list(tab), hyps: list(goal.hyps.map(c)), tree: lean(tree, new Map()), cols, c, e };
|
|
163
|
+
}
|
|
164
|
+
export function goalToLean(ex, i, tamper = false, dropStep = true) {
|
|
165
|
+
const { tab, hyps, tree, cols } = encode(ex, tamper, dropStep);
|
|
166
|
+
const name = tamper ? `tampered${i}` : `t${i}`;
|
|
167
|
+
const body = `def ${name}_goal : Goal := ⟨${tab},\n ${hyps}⟩
|
|
168
|
+
def ${name}_tree : Tree :=
|
|
169
|
+
${tree}`;
|
|
170
|
+
return tamper
|
|
171
|
+
? `-- TAMPERED: ${ex.name}${dropStep ? ", the first leaf's derivation without its last step" : ''}. Lean computes the check to false.
|
|
172
|
+
${body}
|
|
173
|
+
example : checkGoal ${name}_goal ${name}_tree = false := by decide +kernel`
|
|
174
|
+
: `-- ${ex.name} (${cols.length} columns)
|
|
175
|
+
${body}
|
|
176
|
+
theorem ${name} : ∀ env maps, ¬ ∀ c ∈ ${name}_goal.hyps, evalC env maps c = true :=
|
|
177
|
+
sound ${name}_goal ${name}_tree (by decide +kernel)`;
|
|
178
|
+
}
|
|
179
|
+
// Whole machines through Kern.machine_sound: Lean builds the goals from the machine; the trees are the kernel's.
|
|
180
|
+
export function machineToLean(id, m, laws, corollary) {
|
|
181
|
+
if (m.maps && Object.keys(m.maps).length)
|
|
182
|
+
throw new Error('machine_sound covers scalar state only');
|
|
183
|
+
const r = proveLaws(m, laws);
|
|
184
|
+
if (!r.proven || !r.proof)
|
|
185
|
+
throw new Error(`${id}: not proven`);
|
|
186
|
+
const flags = Object.entries(m.step.flags ?? {});
|
|
187
|
+
const vars = [...m.params, ...m.inputs, ...Object.keys(m.state), ...flags.map(([f]) => `?${f}`)];
|
|
188
|
+
const gs = obligations(m, laws, r.proof.instances);
|
|
189
|
+
const enc = (g) => encode({ name: `${id}: ${g.name}`, goal: g, tree: r.proof.trees[g.name] }, false, true, vars);
|
|
190
|
+
const any0 = enc(gs[0]);
|
|
191
|
+
const ix = (name) => vars.indexOf(name);
|
|
192
|
+
const machine = `⟨${list(m.inputs.map(name => String(ix(name))))},
|
|
193
|
+
${list(Object.entries(m.state).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
194
|
+
${list(Object.entries(m.step.state ?? {}).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
195
|
+
${m.pre ? any0.c(m.pre) : TRUE},
|
|
196
|
+
${m.assume ? any0.c(m.assume) : TRUE}⟩`;
|
|
197
|
+
const proof = laws.map((law, j) => {
|
|
198
|
+
const s = enc(gs[2 * j]), t = enc(gs[2 * j + 1]);
|
|
199
|
+
return `(${any0.c(law.holds)},\n (${s.tab}, ${s.tree}),\n (${t.tab}, ${t.tree}))`;
|
|
200
|
+
});
|
|
201
|
+
if (flags.length) {
|
|
202
|
+
// Flags pass through untouched; Lean inlines them (FMachine.plain) and fmachine_sound covers the machine with flags.
|
|
203
|
+
const fl = (mm) => list(Object.entries(mm.step.flags ?? {}).map(([f, c2]) => `(${ix(`?${f}`)}, ${any0.c(c2)})`));
|
|
204
|
+
const lit = (mm) => `⟨⟨${list(mm.inputs.map(name => String(ix(name))))},
|
|
205
|
+
${list(Object.entries(mm.state).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
206
|
+
${list(Object.entries(mm.step.state ?? {}).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
207
|
+
${mm.pre ? any0.c(mm.pre) : TRUE},
|
|
208
|
+
${mm.assume ? any0.c(mm.assume) : TRUE}⟩,
|
|
209
|
+
${fl(mm)}⟩`;
|
|
210
|
+
return `-- ${m.name}: ${laws.map(l => l.name).join('; ')}, with flags ${flags.map(([f]) => f).join(', ')} (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
211
|
+
def ${id}_machine : FMachine := ${lit(m)}
|
|
212
|
+
def ${id}_proof : MachineProof := ${list(proof)}
|
|
213
|
+
theorem ${id}_laws : ∀ maps ρ, FReach ${id}_machine maps ρ → ∀ l ∈ ${id}_proof.map (·.1), evalC ρ maps l = true :=
|
|
214
|
+
fmachine_sound ${id}_machine ${id}_proof (by decide +kernel)${corollary ? `\n${corollary}` : ''}`;
|
|
215
|
+
}
|
|
216
|
+
return `-- ${m.name}: ${laws.map(l => l.name).join('; ')} (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
217
|
+
def ${id}_machine : Machine := ${machine}
|
|
218
|
+
def ${id}_proof : MachineProof := ${list(proof)}
|
|
219
|
+
theorem ${id}_laws : ∀ maps ρ, Reach ${id}_machine maps ρ → ∀ l ∈ ${id}_proof.map (·.1), evalC ρ maps l = true :=
|
|
220
|
+
machine_sound ${id}_machine ${id}_proof (by decide +kernel)${corollary ? `\n${corollary}` : ''}`;
|
|
221
|
+
}
|
|
222
|
+
export const TRUE = '.le (.const 0) (.const 0)';
|
|
223
|
+
export const grown = (g) => { const o = grow(g); if (!('tree' in o))
|
|
224
|
+
throw new Error(`${g.name}: stuck`); return o.tree; };
|
|
225
|
+
// Loops through Kern.loop_sound: Lean builds the invariant and rank goals from the loop; the trees are the kernel's.
|
|
226
|
+
export function loopToLean(id, l, laws, rank, tamper) {
|
|
227
|
+
const vars = [...l.params, ...l.inputs, ...Object.keys(l.state)];
|
|
228
|
+
const gs = loopObligations(l, laws, rank);
|
|
229
|
+
const enc = (g, tree = grown(g)) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars);
|
|
230
|
+
const any0 = enc(gs[0], { leaf: [] });
|
|
231
|
+
const ix = (name) => vars.indexOf(name);
|
|
232
|
+
const lit = (lp) => `⟨${list(lp.inputs.map(name => String(ix(name))))},
|
|
233
|
+
${list(Object.entries(lp.state).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
234
|
+
${list(Object.entries(lp.body).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
235
|
+
${any0.c(lp.while)},
|
|
236
|
+
${lp.pre ? any0.c(lp.pre) : TRUE},
|
|
237
|
+
${lp.assume ? any0.c(lp.assume) : TRUE}⟩`;
|
|
238
|
+
const proof = laws.map((law, j) => {
|
|
239
|
+
const s2 = enc(gs[2 * j]), t = enc(gs[2 * j + 1]);
|
|
240
|
+
return `(${any0.c(law.holds)},\n (${s2.tab}, ${s2.tree}),\n (${t.tab}, ${t.tree}))`;
|
|
241
|
+
});
|
|
242
|
+
const r = enc(gs.at(-1));
|
|
243
|
+
const ranks = Array.isArray(rank) ? rank : [rank];
|
|
244
|
+
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(', ')})
|
|
245
|
+
def ${id}_loop : Loop := ${lit(l)}
|
|
246
|
+
def ${id}_proof : LoopProof := ⟨${list(proof)},
|
|
247
|
+
${list(ranks.map(any0.e))},
|
|
248
|
+
(${r.tab}, ${r.tree})⟩
|
|
249
|
+
theorem ${id}_halts : ∀ maps ρ0, evalC ρ0 maps ${id}_loop.pre = true →
|
|
250
|
+
¬ ∃ f : Nat → Nat → Nat, f 0 = applyS ${id}_loop.init ρ0 maps ∧ ∀ n, Turn ${id}_loop maps (f n) (f (n + 1)) :=
|
|
251
|
+
loop_sound ${id}_loop ${id}_proof (by decide +kernel)${tamper ? `
|
|
252
|
+
-- TAMPERED: ${tamper.what}. Lean computes the check to false.
|
|
253
|
+
def ${id}_tampered : Loop := ${lit(tamper.loop)}
|
|
254
|
+
example : checkLoop ${id}_tampered ${id}_proof = false := by decide +kernel` : ''}`;
|
|
255
|
+
}
|
|
256
|
+
// Folds through Kern.fold_sound: Lean builds the leaf and node goals; the trees are the kernel's.
|
|
257
|
+
export function foldToLean(id, f, laws, extra = '') {
|
|
258
|
+
const st = Object.keys(f.leaf);
|
|
259
|
+
const vars = [...f.params, ...f.inputs, ...st, ...st.map(n2 => `l_${n2}`), ...st.map(n2 => `r_${n2}`)];
|
|
260
|
+
const gs = foldObligations(f, laws);
|
|
261
|
+
const enc = (g, tree = grown(g)) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars);
|
|
262
|
+
const any0 = enc(gs[0], { leaf: [] });
|
|
263
|
+
const ix = (name) => vars.indexOf(name);
|
|
264
|
+
const fold = `⟨${list(f.inputs.map(name => String(ix(name))))},
|
|
265
|
+
${list(st.map(n2 => `(${ix(n2)}, ${ix(`l_${n2}`)}, ${ix(`r_${n2}`)})`))},
|
|
266
|
+
${list(Object.entries(f.leaf).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
267
|
+
${list(Object.entries(f.node).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
268
|
+
${f.pre ? any0.c(f.pre) : TRUE},
|
|
269
|
+
${f.assume ? any0.c(f.assume) : TRUE}⟩`;
|
|
270
|
+
const proof = laws.map((law, j) => {
|
|
271
|
+
const a = enc(gs[2 * j]), b = enc(gs[2 * j + 1]);
|
|
272
|
+
return `(${any0.c(law.holds)},\n (${a.tab}, ${a.tree}),\n (${b.tab}, ${b.tree}))`;
|
|
273
|
+
});
|
|
274
|
+
return `-- ${f.name}: ${laws.map(law => law.name).join('; ')} (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
275
|
+
def ${id}_fold : Fold := ${fold}
|
|
276
|
+
def ${id}_proof : FoldProof := ${list(proof)}
|
|
277
|
+
theorem ${id}_laws : ∀ maps ρ, evalC ρ maps ${id}_fold.pre = true → ∀ t, Allowed ${id}_fold ρ maps t →
|
|
278
|
+
∀ l ∈ ${id}_proof.map (·.1), evalC (foldT ${id}_fold ρ maps t) maps l = true :=
|
|
279
|
+
fold_sound ${id}_fold ${id}_proof (by decide +kernel)${extra}`;
|
|
280
|
+
}
|
|
281
|
+
// Machines with maps (and flags) through Kern.fmmachine_sound: Lean inlines the flags, then builds the start and step
|
|
282
|
+
// goals (read-over-write, ∀-laws at the proof's keys and at a skolem); the trees and the instance keys are the kernel's.
|
|
283
|
+
// Progress laws through Kern.progress_sound: Lean builds "the request is allowed" and "the step it causes"; a false
|
|
284
|
+
// variant is offered the true one's proof, and Lean computes the check to false.
|
|
285
|
+
// Readable corollaries: each law as a plain Lean statement over named variables (ρ the state, μ the maps, each name an
|
|
286
|
+
// abbreviation for its column), proven from the machine's theorem by unfolding the law's own definition. The statement
|
|
287
|
+
// is what a Lean development cites; the column numbers stay inside the namespace.
|
|
288
|
+
export function readable(id, laws, vars, maps, reach) {
|
|
289
|
+
for (const name of [...vars, ...maps])
|
|
290
|
+
if (name === 'ρ' || name === 'μ' || name.includes('«') || name.includes('»'))
|
|
291
|
+
throw new Error(`${id}: the name ${name} can't be a Lean abbreviation here`);
|
|
292
|
+
const q = (name) => `«${name}»`;
|
|
293
|
+
const statement = (law) => {
|
|
294
|
+
const t = (e) => {
|
|
295
|
+
switch (e.op) {
|
|
296
|
+
case 'var': {
|
|
297
|
+
const j = (law.keys ?? []).indexOf(e.name);
|
|
298
|
+
return e.name === law.forall ? 'k' : j >= 0 ? `k${j + 2}` : `ρ ${q(e.name)}`;
|
|
299
|
+
}
|
|
300
|
+
case 'const': return String(e.value);
|
|
301
|
+
case 'add': return `(${t(e.a)} + ${t(e.b)})`;
|
|
302
|
+
case 'sub': return `(${t(e.a)} - ${t(e.b)})`;
|
|
303
|
+
case 'mul': return `(${e.k} * ${t(e.a)})`;
|
|
304
|
+
case 'prod': return `(${t(e.a)} * ${t(e.b)})`;
|
|
305
|
+
case 'min':
|
|
306
|
+
case 'max': return `(${e.op} ${t(e.a)} ${t(e.b)})`;
|
|
307
|
+
case 'if': return `(if ${p(e.c)} then ${t(e.then)} else ${t(e.else)})`;
|
|
308
|
+
case 'get': return `(μ ${q(e.map)} (${t(e.key)}))`;
|
|
309
|
+
}
|
|
310
|
+
};
|
|
311
|
+
const p = (c) => {
|
|
312
|
+
switch (c.op) {
|
|
313
|
+
case '<=': return `${t(c.a)} ≤ ${t(c.b)}`;
|
|
314
|
+
case '<': return `${t(c.a)} < ${t(c.b)}`;
|
|
315
|
+
case '=': return `${t(c.a)} = ${t(c.b)}`;
|
|
316
|
+
case 'and': return c.xs.length ? `(${c.xs.map(p).join(' ∧ ')})` : 'True';
|
|
317
|
+
case 'or': return c.xs.length ? `(${c.xs.map(p).join(' ∨ ')})` : 'False';
|
|
318
|
+
case 'not': return `¬(${p(c.x)})`;
|
|
319
|
+
case 'flag': throw new Error(`${id}: a law reads no flag`);
|
|
320
|
+
case 'all': throw new Error(`${id}: a law has no quantifier inside`);
|
|
321
|
+
}
|
|
322
|
+
};
|
|
323
|
+
return law.keys?.length ? `∀ k ${law.keys.map((_, j) => `k${j + 2}`).join(' ')} : Nat, ${p(law.holds)}` : law.forall ? `∀ k : Nat, ${p(law.holds)}` : p(law.holds);
|
|
324
|
+
};
|
|
325
|
+
const used = new Set(laws.flatMap(l => [...JSON.stringify(l.holds).matchAll(/"name":"([^"]+)"|"map":"([^"]+)"/g)].map(m => m[1] ?? m[2]).filter(name => name !== l.forall && !(l.keys ?? []).includes(name))));
|
|
326
|
+
return `namespace ${id}
|
|
327
|
+
${[...vars.filter(v => used.has(v)).map(v => `abbrev ${q(v)} : Nat := ${vars.indexOf(v)}`), ...maps.filter(mp => used.has(mp)).map(mp => `abbrev ${q(mp)} : Nat := ${maps.indexOf(mp)}`)].join('\n')}
|
|
328
|
+
${laws.map((law, j) => (law.stated ? `-- ${law.name}: as written, with some key; proven (below) with the prover's witness in place\n` : '') + (JSON.stringify(law.holds).includes('"op":"if"') ? `-- ${law.name}: its terms read an if, so no plain statement here (${id}_laws holds it)` : `/-- ${law.name.replace(/-\//g, '- /')} -/
|
|
329
|
+
theorem law${j} ${reach.binders} (h : ${reach.hyp}) : ${statement(law)} := by
|
|
330
|
+
${law.keys?.length ? `have hl : ${id}_e${j}.Holds ρ μ := ${reach.call} ${id}_e${j} (by simp [${id}_proof])
|
|
331
|
+
exact fun k ${law.keys.map((_, i) => `k${i + 2}`).join(' ')} => (evalC_iff (upd (${law.keys.reduce((acc, key, i) => `upd (${acc}) ${vars.indexOf(key)} k${i + 2}`, 'ρ')}) ${vars.indexOf(law.forall)} k) μ ${id}_l${j}.holds).mp (hl ${law.keys.map((_, i) => `k${i + 2}`).join(' ')} k)` : `have hl : ${id}_l${j}.Holds ρ μ := ${reach.call} ${id}_e${j} (by simp [${id}_proof])
|
|
332
|
+
${law.forall ? `exact fun k => (evalC_iff (upd ρ ${vars.indexOf(law.forall)} k) μ ${id}_l${j}.holds).mp (hl k)` : `exact (evalC_iff ρ μ ${id}_l${j}.holds).mp hl`}`}`)).join('\n')}
|
|
333
|
+
end ${id}`;
|
|
334
|
+
}
|
|
335
|
+
// Live.lean's reqC: each input named by its term, two parts per and.
|
|
336
|
+
const reqTS = (req) => (req.length ? { op: 'and', xs: [{ op: '=', a: { op: 'var', name: req[0][0] }, b: req[0][1] }, reqTS(req.slice(1))] } : { op: '<=', a: { op: 'const', value: 0 }, b: { op: 'const', value: 0 } });
|
|
337
|
+
// Witnesses for a helpful request's free inputs, for its allowed goal: all free first, then each free input fixed to 0, a
|
|
338
|
+
// state variable or a param (a history's query, say, which its relations bound), the first combination that proves.
|
|
339
|
+
function withWitness(m, request, attempt) {
|
|
340
|
+
const free = m.inputs.filter(i => !(i in request));
|
|
341
|
+
const cands = [undefined, { op: 'const', value: 0 }, ...Object.keys(m.state).map(v => ({ op: 'var', name: v })), ...m.params.map(v => ({ op: 'var', name: v }))];
|
|
342
|
+
const combos = [[]];
|
|
343
|
+
if (free.length <= 2) {
|
|
344
|
+
const go = (i, acc) => { if (i === free.length) {
|
|
345
|
+
if (acc.length)
|
|
346
|
+
combos.push(acc);
|
|
347
|
+
return;
|
|
348
|
+
} for (const c of cands)
|
|
349
|
+
go(i + 1, c ? [...acc, [free[i], c]] : acc); };
|
|
350
|
+
go(0, []);
|
|
351
|
+
}
|
|
352
|
+
for (const wit of combos) {
|
|
353
|
+
const out = attempt(wit);
|
|
354
|
+
if (out !== undefined)
|
|
355
|
+
return { wit, out };
|
|
356
|
+
}
|
|
357
|
+
return undefined;
|
|
358
|
+
}
|
|
359
|
+
// A liveness as Live.lean's record: from, to, the rank's parts, each helpful request with its region, the primes.
|
|
360
|
+
function liveLit(l, t, ix, primes, primeMaps) {
|
|
361
|
+
return `⟨${t.c(l.from)}, ${t.c(l.to)}, ${list(livenessRanks(l).map(t.e))},
|
|
362
|
+
${list(livenessHelpful(l).map(h => `(${t.c(h.when)}, ${list(Object.entries(h.request).map(([inp, x]) => `(${ix(inp)}, ${t.e(x)})`))})`))},
|
|
363
|
+
${primes},
|
|
364
|
+
${primeMaps}⟩`;
|
|
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.
|
|
369
|
+
export function mmachineToLean(id, m, laws, opts = {}) {
|
|
370
|
+
const r = proveLaws(m, laws);
|
|
371
|
+
if (!r.proven || !r.proof)
|
|
372
|
+
throw new Error(`${id}: not proven`);
|
|
373
|
+
const keysOf = [...new Set(laws.flatMap(l => (l.forall ? [l.forall] : [])))];
|
|
374
|
+
const flagNames = Object.keys(m.step.flags ?? {});
|
|
375
|
+
const primed = !!(opts.progress || opts.stepLaws?.length);
|
|
376
|
+
const primes = primed ? Object.keys(m.state).map(s2 => `${s2}'`) : [];
|
|
377
|
+
// A k-step law reads the j-th request's inputs (j >= 2) by input@j.
|
|
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()))];
|
|
379
|
+
const vars = [...m.params, ...m.inputs, ...Object.keys(m.state), ...keysOf, ...keysOf.map(k2 => `${k2}#`), '#', ...flagNames.map(f => `?${f}`), ...(opts.free ?? []), ...(opts.stepLaws ?? []).flatMap(sl => (sl.forall ? [sl.forall] : [])), ...primes, ...later];
|
|
380
|
+
const baseMaps = [...new Set([...Object.keys(m.maps ?? {}), ...Object.keys(m.step.maps ?? {}), ...[...JSON.stringify(laws).matchAll(/"op":"get","map":"([^"]+)"/g)].map(x2 => x2[1])])];
|
|
381
|
+
const mapNames = [...baseMaps, ...(primed ? baseMaps.map(mp => `${mp}'`) : [])];
|
|
382
|
+
const gs = obligations(m, laws, r.proof.instances);
|
|
383
|
+
const enc = (g, tree = r.proof.trees[g.name]) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars, mapNames);
|
|
384
|
+
const any0 = enc(gs[0], { leaf: [] });
|
|
385
|
+
const ix = (name) => vars.indexOf(name);
|
|
386
|
+
const lit = (mm) => `⟨⟨${list(mm.inputs.map(name => String(ix(name))))},
|
|
387
|
+
${list(Object.entries(mm.state).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
388
|
+
${list(Object.entries(mm.maps ?? {}).map(([name, c2]) => `(${mapNames.indexOf(name)}, ${c2})`))},
|
|
389
|
+
${list(Object.entries(mm.step.state ?? {}).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
390
|
+
${list(Object.entries(mm.step.maps ?? {}).map(([name, w]) => { const pw = pointWrite(w, 'Lean (for now)'); return `(${mapNames.indexOf(name)}, ${any0.e(pw.key)}, ${any0.e(pw.value)})`; }))},
|
|
391
|
+
${mm.pre ? any0.c(mm.pre) : TRUE},
|
|
392
|
+
${mm.assume ? any0.c(mm.assume) : TRUE}⟩,
|
|
393
|
+
${list(Object.entries(mm.step.flags ?? {}).map(([f, c2]) => `(${ix(`?${f}`)}, ${any0.c(c2)})`))}⟩`;
|
|
394
|
+
const entries = laws.map((law, j) => {
|
|
395
|
+
const a = enc(gs[2 * j]), b = enc(gs[2 * j + 1]);
|
|
396
|
+
const insts = Object.entries(r.proof.instances[law.name] ?? {}).flatMap(([lname, keys]) => keys.map(key => `(${laws.findIndex(l => l.name === lname)}, ${any0.e(key)})`));
|
|
397
|
+
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})⟩`;
|
|
398
|
+
});
|
|
399
|
+
const progress = (opts.progress ?? []).map(pc => {
|
|
400
|
+
const gs2 = progressObligations(m, laws, pc.instances, { name: pc.name, when: pc.when, then: pc.then, request: pc.request });
|
|
401
|
+
const causes = gs2.at(-1);
|
|
402
|
+
// Lean always has the allowed goal; without an assumption it is refuted by its own last hypothesis.
|
|
403
|
+
const allowed = m.assume ? gs2[0] : { name: `${pc.name}: the request is allowed`, hyps: [...causes.hyps.slice(0, -1), not(atMost(n(0), n(0)))] };
|
|
404
|
+
const ea = enc(allowed, grown(allowed)), ec = enc(causes, grown(causes));
|
|
405
|
+
const insts = laws.flatMap((l, j) => (l.forall ? (pc.instances[l.name] ?? []).map(key => `(${j}, ${any0.e(key)})`) : []));
|
|
406
|
+
const record = (when) => `⟨${any0.c(when)},
|
|
407
|
+
${any0.c(pc.then)},
|
|
408
|
+
${list(Object.entries(pc.request).map(([inp, e]) => `(${ix(inp)}, ${any0.e(e)})`))},
|
|
409
|
+
${list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`))},
|
|
410
|
+
${list(baseMaps.map(mp => `(${mapNames.indexOf(mp)}, ${mapNames.indexOf(`${mp}'`)})`))},
|
|
411
|
+
${list(insts)},
|
|
412
|
+
(${ea.tab}, ${ea.tree}),
|
|
413
|
+
(${ec.tab}, ${ec.tree})⟩`;
|
|
414
|
+
return `-- Progress: ${pc.name}
|
|
415
|
+
def ${pc.id} : Progress := ${record(pc.when)}
|
|
416
|
+
theorem ${pc.id}_holds : ProgressHolds ${id}_machine ${pc.id} :=
|
|
417
|
+
progress_sound ${id}_machine ${id}_proof ${pc.id} ${id}_check (by decide +kernel)${pc.tamper ? `
|
|
418
|
+
-- TAMPERED: ${pc.tamper.what}: the proof above offered for it. Lean computes the check to false.
|
|
419
|
+
def ${pc.id}_tampered : Progress := ${record(pc.tamper.when)}
|
|
420
|
+
example : checkProgress ${id}_machine ${id}_proof ${pc.id}_tampered = false := by decide +kernel` : ''}`;
|
|
421
|
+
});
|
|
422
|
+
// Step laws through Kern.steplaw_sound: `when` and `then` sent with the flags inlined (as kernel.ts's goal has them).
|
|
423
|
+
const sp = opts.stepLaws?.length ? proveStepLaws(m, laws, opts.stepLaws) : undefined;
|
|
424
|
+
if (opts.stepLaws?.length && (!sp?.proven || !sp.proof))
|
|
425
|
+
throw new Error(`${id}: step laws not proven`);
|
|
426
|
+
const inlineFlags = (c) => substC(c, { vars: {}, maps: {}, flags: m.step.flags ?? {} });
|
|
427
|
+
const stepRecords = (opts.stepLaws ?? []).map((sl, j) => {
|
|
428
|
+
const goal = stepLawObligations(m, laws, sp.proof.instances, sl)[0];
|
|
429
|
+
const pr = enc(goal, sp.proof.trees[goal.name]);
|
|
430
|
+
const insts = laws.flatMap((l, li) => (l.forall ? (sp.proof.instances[l.name] ?? []).map(key => `(${li}, ${any0.e(key)})`) : []));
|
|
431
|
+
const primes = list(Object.keys(m.state).map(s2 => `(${ix(s2)}, ${ix(`${s2}'`)})`)), primeMaps = list(baseMaps.map(mp => `(${mapNames.indexOf(mp)}, ${mapNames.indexOf(`${mp}'`)})`));
|
|
432
|
+
const k = sl.steps ?? 1;
|
|
433
|
+
if (k === 1 && !Array.isArray(sl.when))
|
|
434
|
+
return `-- Step law: ${sl.name}
|
|
435
|
+
def ${id}_step${j} : StepLaw := ⟨${sl.when ? any0.c(inlineFlags(sl.when)) : TRUE},
|
|
436
|
+
${any0.c(inlineFlags(sl.then))},
|
|
437
|
+
${primes},
|
|
438
|
+
${primeMaps},
|
|
439
|
+
${list(insts)},
|
|
440
|
+
(${pr.tab}, ${pr.tree})⟩
|
|
441
|
+
theorem ${id}_step${j}_holds : StepLawHolds ${id}_machine ${id}_step${j} :=
|
|
442
|
+
steplaw_sound ${id}_machine ${id}_proof ${id}_step${j} ${id}_check (by decide +kernel)`;
|
|
443
|
+
// Through Kern.kstep_sound (Steps.lean): one `when` per step (0 <= 0 where none), the j-th request's inputs renamed.
|
|
444
|
+
const whens = sl.when === undefined ? [] : Array.isArray(sl.when) ? sl.when : [sl.when];
|
|
445
|
+
const ren = Array.from({ length: k }, (_, s2) => (s2 === 0 ? '[]' : list(m.inputs.map(i => `(${ix(i)}, ${ix(`${i}@${s2 + 1}`)})`))));
|
|
446
|
+
return `-- Step law over ${k} steps: ${sl.name}
|
|
447
|
+
def ${id}_step${j} : KStep := ⟨${list(Array.from({ length: k }, (_, s2) => (whens[s2] ? any0.c(inlineFlags(whens[s2])) : TRUE)))},
|
|
448
|
+
${any0.c(inlineFlags(sl.then))},
|
|
449
|
+
${list(ren)},
|
|
450
|
+
${primes},
|
|
451
|
+
${primeMaps},
|
|
452
|
+
${list(insts)},
|
|
453
|
+
(${pr.tab}, ${pr.tree})⟩
|
|
454
|
+
theorem ${id}_step${j}_holds : KStepHolds ${id}_machine ${id}_step${j} :=
|
|
455
|
+
kstep_sound ${id}_machine ${id}_proof ${id}_step${j} ${id}_check (by decide +kernel)`;
|
|
456
|
+
});
|
|
457
|
+
const machineDef = `def ${id}_machine : FMMachine := ${lit(m)}`;
|
|
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(', ')})
|
|
459
|
+
${machineDef}
|
|
460
|
+
${entries.join('\n')}
|
|
461
|
+
def ${id}_proof : List MEntry := ${list(laws.map((_, j) => `${id}_e${j}`))}
|
|
462
|
+
theorem ${id}_check : checkFMMachine ${id}_machine ${id}_proof = true := by decide +kernel
|
|
463
|
+
theorem ${id}_laws : ∀ ρ M, FMReach ${id}_machine ρ M → ∀ e ∈ ${id}_proof, e.law.Holds ρ M :=
|
|
464
|
+
fmmachine_sound ${id}_machine ${id}_proof ${id}_check
|
|
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 ? `
|
|
466
|
+
-- TAMPERED: ${opts.tamper.what}. Lean computes the check to false.
|
|
467
|
+
def ${id}_tampered : FMMachine := ${lit(opts.tamper.machine)}
|
|
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')}` : ''}`;
|
|
469
|
+
}
|
|
470
|
+
// Machines with sets through Kern.smachine_sound and Kern.skstep_sound (Sets.lean): maps a request carries, flags that
|
|
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
|
|
472
|
+
// key. Lean builds every goal from the machine; the trees, the instance keys and the flag instances are the kernel's.
|
|
473
|
+
// Step laws, one step or k, go through the k-step rule, the j-th request read by input@j, ?f@j, w?f@j and Map@j.
|
|
474
|
+
const flagsOfM = (m) => {
|
|
475
|
+
const out = {};
|
|
476
|
+
for (const [f, c] of Object.entries(m.step.flags ?? {}))
|
|
477
|
+
out[f] = c.op === 'all' ? { op: '=', a: { op: 'var', name: `?${f}` }, b: { op: 'const', value: 1 } } : substC(c, { vars: {}, maps: {}, flags: out });
|
|
478
|
+
return out;
|
|
479
|
+
};
|
|
480
|
+
// Sets, or functions with facts: both go through Sets.lean.
|
|
481
|
+
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)
|
|
482
|
+
|| !!Object.keys(m.fns ?? {}).length || !!m.facts?.length;
|
|
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] : []))];
|
|
484
|
+
export function smachineToLean(id, m, laws, opts = {}) {
|
|
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);
|
|
564
|
+
if (!r.proven || !r.proof)
|
|
565
|
+
throw new Error(`${id}: not proven`);
|
|
566
|
+
const lp = r.proof.laws, si = r.proof.instances;
|
|
567
|
+
const flags = Object.entries(m.step.flags ?? {}), quantified = flags.filter(([, c]) => c.op === 'all').map(([f]) => f);
|
|
568
|
+
const carried = m.inputMaps ?? [], facts = m.facts ?? [], keysOf = [...new Set([...laws, ...facts].flatMap(l => [l.forall, ...(l.keys ?? [])].filter((k) => !!k)))];
|
|
569
|
+
const k = Math.max(1, ...allSteps.map(sl => sl.steps ?? 1));
|
|
570
|
+
const ext = [...m.inputs, ...quantified.flatMap(f => [`?${f}`, `w?${f}`])];
|
|
571
|
+
const later = Array.from({ length: k - 1 }, (_, j) => ext.map(v => `${v}@${j + 2}`)).flat();
|
|
572
|
+
const laterMaps = Array.from({ length: k - 1 }, (_, j) => carried.map(mp => `${mp}@${j + 2}`)).flat();
|
|
573
|
+
const primes = allSteps.length ? Object.keys(m.state).map(s2 => `${s2}'`) : [];
|
|
574
|
+
const instOf = (sl) => r.proof.perStep?.[sl.name] ?? si;
|
|
575
|
+
const goalsL = obligations(m, laws, lp.instances), goalsS = allSteps.map(sl => stepLawObligations(m, laws, instOf(sl), sl)[0]);
|
|
576
|
+
// Weak fairness over sets: each helpful request allowed in its region carrying empty sets (Live.lean's sAllowGoal,
|
|
577
|
+
// built here as Lean builds it: facts, laws, `when`, each quantified flag closed, the carried maps 0 at the keys read,
|
|
578
|
+
// and the assumption's failing, its plain flags inlined as `if c then 1 else 0 = 1`).
|
|
579
|
+
const zero1 = (k) => ({ op: 'const', value: k }), eqC = (a, b) => ({ op: '=', a, b });
|
|
580
|
+
const fl0 = flagsOfM(m), allFlags = Object.entries(m.step.flags ?? {});
|
|
581
|
+
const sInline = (c2) => substC(c2, { vars: {}, maps: {}, flags: Object.fromEntries(allFlags.map(([f, fc]) => [f, fc.op === 'all' ? eqC({ op: 'var', name: `?${f}` }, zero1(1)) : eqC({ op: 'if', c: fl0[f], then: zero1(1), else: zero1(0) }, zero1(1))])) });
|
|
582
|
+
const sub1 = (c2, vars) => substC(c2, { vars, maps: {}, flags: {} });
|
|
583
|
+
const carriedKeys = (cs) => {
|
|
584
|
+
const out = new Map();
|
|
585
|
+
const inE = (x2) => { if (x2.op === 'get') {
|
|
586
|
+
if ((m.inputMaps ?? []).includes(x2.map))
|
|
587
|
+
out.set(JSON.stringify(x2.key), x2.key);
|
|
588
|
+
inE(x2.key);
|
|
589
|
+
}
|
|
590
|
+
else if (x2.op === 'if')
|
|
591
|
+
(inC(x2.c), inE(x2.then), inE(x2.else));
|
|
592
|
+
else if (x2.op === 'mul')
|
|
593
|
+
inE(x2.a);
|
|
594
|
+
else if ('a' in x2)
|
|
595
|
+
(inE(x2.a), inE(x2.b)); };
|
|
596
|
+
const inC = (c2) => (c2.op === 'flag' || c2.op === 'all' ? undefined : c2.op === 'not' ? inC(c2.x) : c2.op === 'and' || c2.op === 'or' ? c2.xs.forEach(inC) : (inE(c2.a), inE(c2.b)));
|
|
597
|
+
cs.forEach(inC);
|
|
598
|
+
return [...out.values()];
|
|
599
|
+
};
|
|
600
|
+
const allowGoalS = (inst, w) => {
|
|
601
|
+
const factsF = m.facts ?? [];
|
|
602
|
+
const base = [m.pre ?? trueC,
|
|
603
|
+
...factsF.filter(f => !f.forall).map(f => f.holds),
|
|
604
|
+
...Object.entries(inst).flatMap(([name, keys]) => { const f = factsF.find(f2 => f2.name === name); return f?.forall ? keys.map(key => sub1(f.holds, { [f.forall]: key })) : []; }),
|
|
605
|
+
...laws.filter(lw => !lw.forall).map(lw => lw.holds),
|
|
606
|
+
...Object.entries(inst).flatMap(([name, keys]) => { const lw = laws.find(l2 => l2.name === name); return lw?.forall && !lw.keys?.length ? keys.map(key => sub1(lw.holds, { [lw.forall]: key })) : []; }),
|
|
607
|
+
...Object.entries(inst).flatMap(([name, keys]) => {
|
|
608
|
+
const lw = laws.find(l2 => l2.name === name);
|
|
609
|
+
if (!lw?.keys?.length)
|
|
610
|
+
return [];
|
|
611
|
+
const k = lw.keys.length + 1;
|
|
612
|
+
return Array.from({ length: Math.floor(keys.length / k) }, (_, t) => sub1(sub1(lw.holds, Object.fromEntries(lw.keys.map((kn, i) => [kn, keys[t * k + 1 + i]]))), { [lw.forall]: keys[t * k] }));
|
|
613
|
+
}),
|
|
614
|
+
w,
|
|
615
|
+
...allFlags.flatMap(([f, fc]) => (fc.op === 'all' ? [{ op: '<=', a: { op: 'var', name: `?${f}` }, b: zero1(1) },
|
|
616
|
+
...(inst[`?${f}`] ?? []).map((key) => ({ op: 'or', xs: [eqC({ op: 'var', name: `?${f}` }, zero1(0)), sub1(fc.c, { [fc.key]: key })] })),
|
|
617
|
+
{ op: 'or', xs: [eqC({ op: 'var', name: `?${f}` }, zero1(1)), { op: 'not', x: sub1(fc.c, { [fc.key]: { op: 'var', name: `w?${f}` } }) }] }] : []))];
|
|
618
|
+
const last = { op: 'not', x: sInline(m.assume ?? trueC) }, zkeys = carriedKeys([...base, last]);
|
|
619
|
+
return { name: 'allowed', hyps: [...base, ...(m.inputMaps ?? []).flatMap(mp => zkeys.map(t => eqC({ op: 'get', map: mp, key: t }, zero1(0)))), last], zkeys };
|
|
620
|
+
};
|
|
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] : []));
|
|
626
|
+
const vars = [...new Set([...m.params, ...m.inputs, ...Object.keys(m.state), ...keysOf, ...keysOf.map(k2 => `${k2}#`), '#', ...flags.map(([f]) => `?${f}`),
|
|
627
|
+
...quantified.map(f => `w?${f}`), ...boundKeys(m), ...(opts.tamper ? boundKeys(opts.tamper.machine) : []), ...stepLaws.flatMap(sl => (sl.forall ? [sl.forall] : [])), ...(opts.free ?? []),
|
|
628
|
+
...primes, ...later, ...[...goalsL, ...goalsS, ...allowGoals].flatMap(g => g.hyps.flatMap(varsOf))])];
|
|
629
|
+
const baseMaps = [...new Set([...Object.keys(m.maps ?? {}), ...Object.keys(m.step.maps ?? {}), ...Object.keys(m.fns ?? {})])];
|
|
630
|
+
const mapNames = [...new Set([...baseMaps, ...carried, ...(allSteps.length ? Object.keys(m.maps ?? {}).map(mp => `${mp}'`) : []), ...laterMaps,
|
|
631
|
+
...[...JSON.stringify([...goalsL, ...goalsS, ...allowGoals]).matchAll(/"op":"get","map":"([^"]+)"/g)].map(x2 => x2[1])])];
|
|
632
|
+
const enc = (g, tree) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars, mapNames);
|
|
633
|
+
const { e, c } = leanTerms(vars, mapNames, id);
|
|
634
|
+
const ix = (name) => { const j = vars.indexOf(name); if (j < 0)
|
|
635
|
+
throw new Error(`${id}: no variable for ${name}`); return j; };
|
|
636
|
+
const mx = (name) => { const j = mapNames.indexOf(name); if (j < 0)
|
|
637
|
+
throw new Error(`${id}: no map for ${name}`); return j; };
|
|
638
|
+
const inline = (c2) => substC(c2, { vars: {}, maps: {}, flags: flagsOfM(m) });
|
|
639
|
+
const lit = (mm) => {
|
|
640
|
+
const fl = flagsOfM(mm), fs = Object.entries(mm.step.flags ?? {}), ws = Object.entries(mm.step.maps ?? {});
|
|
641
|
+
return `⟨⟨⟨${list(mm.inputs.map(name => String(ix(name))))},
|
|
642
|
+
${list(Object.entries(mm.state).map(([name, e2]) => `(${ix(name)}, ${e(e2)})`))},
|
|
643
|
+
${list(Object.entries(mm.maps ?? {}).map(([name, c2]) => `(${mx(name)}, ${c2})`))},
|
|
644
|
+
${list(Object.entries(mm.step.state ?? {}).map(([name, e2]) => `(${ix(name)}, ${e(e2)})`))},
|
|
645
|
+
${list(ws.flatMap(([name, w]) => ('each' in w ? [] : [`(${mx(name)}, ${e(w.key)}, ${e(w.value)})`])))},
|
|
646
|
+
${mm.pre ? c(mm.pre) : TRUE},
|
|
647
|
+
${mm.assume ? c(mm.assume) : TRUE}⟩,
|
|
648
|
+
${list(fs.flatMap(([f, c2]) => (c2.op === 'all' ? [] : [`(${ix(`?${f}`)}, ${c(fl[f])})`])))}⟩,
|
|
649
|
+
${list((mm.inputMaps ?? []).map(mp => String(mx(mp))))},
|
|
650
|
+
${list(ws.flatMap(([name, w]) => ('each' in w ? [`(${mx(name)}, ${ix(w.each)}, ${e(w.value)})`] : [])))},
|
|
651
|
+
${list(fs.flatMap(([f, c2]) => (c2.op === 'all' ? [`(${ix(`?${f}`)}, ${ix(c2.key)}, ${c(c2.c)})`] : [])))},
|
|
652
|
+
${list(fs.flatMap(([f, c2]) => (c2.op === 'all' ? [`(${ix(`?${f}`)}, ${ix(`w?${f}`)})`] : [])))},
|
|
653
|
+
${list((mm.facts ?? []).map(l => `⟨${c(l.holds)}, ${l.forall ? `some ${ix(l.forall)}` : 'none'}⟩`))}⟩`;
|
|
654
|
+
};
|
|
655
|
+
const lawIx = (name) => laws.findIndex(l => l.name === name);
|
|
656
|
+
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)})`));
|
|
657
|
+
// A law about every two keys or more is assumed at tuples (kept flattened): the first key, and the rest.
|
|
658
|
+
const pinsts = (inst) => Object.entries(inst).filter(([name]) => lawIx(name) >= 0 && laws[lawIx(name)].keys?.length).flatMap(([name, keys]) => {
|
|
659
|
+
const n = laws[lawIx(name)].keys.length + 1;
|
|
660
|
+
return Array.from({ length: Math.floor(keys.length / n) }, (_, t) => `(${lawIx(name)}, ${e(keys[t * n])}, ${list(keys.slice(t * n + 1, t * n + n).map(e))})`);
|
|
661
|
+
});
|
|
662
|
+
const finsts = (inst) => Object.entries(inst).flatMap(([name, keys]) => { const j = facts.findIndex(f => f.name === name); return j < 0 ? [] : keys.map(key => `(${j}, ${e(key)})`); });
|
|
663
|
+
const qinsts = (inst) => Object.entries(inst).filter(([name]) => name.startsWith('?')).flatMap(([f, keys]) => keys.map(key => `(${ix(f)}, ${e(key)})`));
|
|
664
|
+
const entries = laws.map((law, j) => {
|
|
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] ?? {};
|
|
666
|
+
return `def ${id}_l${j} : MLaw := ⟨${c(law.holds)}, ${law.forall ? `some ${ix(law.forall)}` : 'none'}⟩
|
|
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))},
|
|
668
|
+
(${a.tab}, [], ${a.tree}),
|
|
669
|
+
(${b.tab}, [], ${b.tree})⟩`;
|
|
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);
|
|
686
|
+
return `-- ${m.name}: ${laws.map(l => l.name).join('; ')}, with sets (carried ${carried.join(', ') || 'none'}; quantified flags ${quantified.join(', ') || 'none'})
|
|
687
|
+
-- (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')}; maps ${mapNames.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
688
|
+
${rf ? `def ${id}_refined : SRefined := ⟨${lit(rf.impl)},
|
|
689
|
+
${lit(rf.spec)},
|
|
690
|
+
${list(Object.entries(rf.wit).map(([inp, t]) => `(${ix(`b_${inp}`)}, ${e(t)})`))},
|
|
691
|
+
${c(rf.stutter)}⟩
|
|
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)}`}
|
|
696
|
+
${entries.join('\n')}
|
|
697
|
+
def ${id}_proof : List SEntry := ${list(laws.map((_, j) => `${id}_e${j}`))}
|
|
698
|
+
theorem ${id}_check : checkSMachine ${id}_machine ${id}_proof = true := by decide +kernel
|
|
699
|
+
theorem ${id}_laws : ∀ ρ M, SReach ${id}_machine ρ M → ∀ e ∈ ${id}_proof, e.Holds ρ M :=
|
|
700
|
+
smachine_sound ${id}_machine ${id}_proof ${id}_check
|
|
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 ? `
|
|
702
|
+
-- TAMPERED: ${opts.tamper.what}. Lean computes the check to false.
|
|
703
|
+
def ${id}_tampered : SMachine := ${lit(opts.tamper.machine)}
|
|
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)}` : ''}`;
|
|
705
|
+
}
|
|
706
|
+
// The facts, proven in Lean of the functions' Lean definitions, when every function has one: a run that starts with
|
|
707
|
+
// those functions starts where SReach asks the facts to hold.
|
|
708
|
+
function factsProof(id, m, maps, simp = []) {
|
|
709
|
+
const fns = Object.entries(m.fns ?? {}), facts = m.facts ?? [];
|
|
710
|
+
if (!facts.length || !fns.length || fns.some(([, f]) => !f.lean))
|
|
711
|
+
return '';
|
|
712
|
+
return `
|
|
713
|
+
-- The facts hold of the functions' Lean definitions: ${fns.map(([n, f]) => `${n} := ${f.lean}`).join('; ')}.
|
|
714
|
+
theorem ${id}_facts_hold (ρ : Nat → Nat) (μ : Nat → Nat → Nat) ${fns.map(([n, f], j) => `(h${j} : μ ${maps.indexOf(n)} = ${f.lean})`).join(' ')} :
|
|
715
|
+
∀ l ∈ ${id}_machine.facts, l.Holds ρ μ := by
|
|
716
|
+
intro l hl
|
|
717
|
+
simp only [${id}_machine, List.mem_cons, List.not_mem_nil, or_false] at hl
|
|
718
|
+
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)`;
|
|
719
|
+
}
|
|
720
|
+
// Machines with a history through Kern.hmachine_sound (History.lean): Lean builds the plain machine (sums as state,
|
|
721
|
+
// relations in the assumption) and each relation's record goal; the trees and the instance keys are the kernel's.
|
|
722
|
+
// Pruning is left out: its goals are about the runtimes (dropping a record changes no query), the laws and relations
|
|
723
|
+
// are proven over the whole history either way, and Lean's HMachine has no pruning; the TypeScript kernel checks them.
|
|
724
|
+
export function hmachineToLean(id, pruned, laws, tampers = [], corollary) {
|
|
725
|
+
const m = { ...pruned, history: { ...pruned.history, prune: undefined } };
|
|
726
|
+
const h = m.history;
|
|
727
|
+
const r = proveLaws(m, laws);
|
|
728
|
+
if (!r.proven || !r.proof)
|
|
729
|
+
throw new Error(`${id}: not proven`);
|
|
730
|
+
const keysOf = [...new Set(laws.flatMap(l => (l.forall ? [l.forall] : [])))];
|
|
731
|
+
const flagNames = Object.keys(m.step.flags ?? {});
|
|
732
|
+
const sums = Object.keys(h.sums), fields = h.record.map(f => `r.${f}`);
|
|
733
|
+
const vars = [...m.params, ...m.inputs, ...Object.keys(m.state), ...sums, ...keysOf, ...keysOf.map(k2 => `${k2}#`), '#', ...flagNames.map(f => `?${f}`), ...fields];
|
|
734
|
+
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])])];
|
|
735
|
+
const gs = obligations(m, laws, r.proof.instances);
|
|
736
|
+
const enc = (g, tree = r.proof.trees[g.name]) => encode({ name: `${id}: ${g.name}`, goal: g, tree }, false, true, vars, mapNames);
|
|
737
|
+
const any0 = enc(gs[0], { leaf: [] });
|
|
738
|
+
const ix = (name) => { const j = vars.indexOf(name); if (j < 0)
|
|
739
|
+
throw new Error(`${id}: no variable ${name}`); return j; };
|
|
740
|
+
const rels = (rs) => list(rs.map(rel => {
|
|
741
|
+
if (rel.holds.op !== '<=')
|
|
742
|
+
throw new Error(`${id}: a relation is a <= b`);
|
|
743
|
+
return `(${any0.c(rel.when)}, ${any0.e(rel.holds.a)}, ${any0.e(rel.holds.b)})`;
|
|
744
|
+
}));
|
|
745
|
+
const lit = (rs) => `⟨⟨⟨${list(m.inputs.map(name => String(ix(name))))},
|
|
746
|
+
${list(Object.entries(m.state).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
747
|
+
${list(Object.entries(m.maps ?? {}).map(([name, c2]) => `(${mapNames.indexOf(name)}, ${c2})`))},
|
|
748
|
+
${list(Object.entries(m.step.state ?? {}).map(([name, e]) => `(${ix(name)}, ${any0.e(e)})`))},
|
|
749
|
+
${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)})`; }))},
|
|
750
|
+
${m.pre ? any0.c(m.pre) : TRUE},
|
|
751
|
+
${m.assume ? any0.c(m.assume) : TRUE}⟩,
|
|
752
|
+
${list(flagNames.map(f => `(${ix(`?${f}`)}, ${any0.c(m.step.flags[f])})`))}⟩,
|
|
753
|
+
${any0.c(h.keep)},
|
|
754
|
+
${list(h.record.map(f => String(ix(f))))},
|
|
755
|
+
${list(fields.map(f => String(ix(f))))},
|
|
756
|
+
${list(Object.entries(h.sums).map(([name, g]) => `(${ix(name)}, ${any0.e(g)})`))},
|
|
757
|
+
${list(Object.entries(h.queries).map(([name, g]) => `(${ix(name)}, ${any0.e(g)})`))},
|
|
758
|
+
${rels(rs)}⟩`;
|
|
759
|
+
const entries = laws.map((law, j) => {
|
|
760
|
+
const a = enc(gs[2 * j]), b = enc(gs[2 * j + 1]);
|
|
761
|
+
const insts = Object.entries(r.proof.instances[law.name] ?? {}).flatMap(([lname, keys]) => keys.map(key => `(${laws.findIndex(l => l.name === lname)}, ${any0.e(key)})`));
|
|
762
|
+
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})⟩`;
|
|
763
|
+
});
|
|
764
|
+
const records = gs.slice(2 * laws.length).map(g => { const x2 = enc(g); return `(${x2.tab}, ${x2.tree})`; });
|
|
765
|
+
const tamperText = tampers.map((t, j) => `-- TAMPERED: ${t.what}. Lean computes the check to false.
|
|
766
|
+
def ${id}_tampered${j} : HMachine := ${lit(t.relations)}
|
|
767
|
+
example : checkHMachine ${id}_tampered${j} ${id}_proof ${t.withRecordTrees ? `${id}_records` : '[]'} = false := by decide +kernel`);
|
|
768
|
+
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))
|
|
769
|
+
-- (variables ${vars.map((v2, j) => `${j} ${v2}`).join(', ')}; maps ${mapNames.map((v2, j) => `${j} ${v2}`).join(', ')})
|
|
770
|
+
def ${id}_machine : HMachine := ${lit(h.relations ?? [])}
|
|
771
|
+
${entries.join('\n')}
|
|
772
|
+
def ${id}_proof : List MEntry := ${list(laws.map((_, j) => `${id}_e${j}`))}
|
|
773
|
+
def ${id}_records : List (List VDef × Tree) := ${list(records)}
|
|
774
|
+
theorem ${id}_check : checkHMachine ${id}_machine ${id}_proof ${id}_records = true := by decide +kernel
|
|
775
|
+
theorem ${id}_laws : ∀ ρ M hist, HReach ${id}_machine ρ M hist → ∀ e ∈ ${id}_proof, e.law.Holds ρ M :=
|
|
776
|
+
hmachine_sound ${id}_machine ${id}_proof ${id}_records ${id}_check
|
|
777
|
+
${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)}` : ''}
|
|
778
|
+
${tamperText.join('\n')}`;
|
|
779
|
+
}
|
|
780
|
+
// A Lean file proving each item, to compile against the twin (`leanLibrary`, or `leanProject` for a ready Lake project).
|
|
781
|
+
// Each machine's laws come with `<id>_laws` (the twin's theorem) and `<id>.lawN` (the law as a plain Lean statement
|
|
782
|
+
// over named variables); step laws with `<id>_stepN_holds` (on the plain machine, `<id>s`, for a machine with a history);
|
|
783
|
+
// loops with `<id>_halts`; decisions with `<id>`. A machine with sets has its step laws as `<id>_stepN_holds`.
|
|
784
|
+
// Throws if the kernel can't prove one.
|
|
785
|
+
export function toLean(items, opts = {}) {
|
|
786
|
+
const ident = (id) => { const s = id.replace(/[^A-Za-z0-9_]/g, '_'); return /^[A-Za-z]/.test(s) ? s : `x_${s}`; };
|
|
787
|
+
const parts = [], theorems = [];
|
|
788
|
+
let goals = 0;
|
|
789
|
+
for (let item of items) {
|
|
790
|
+
const id = ident(item.id);
|
|
791
|
+
if ('machine' in item) {
|
|
792
|
+
const m = item.machine;
|
|
793
|
+
// Laws with some key go in as the prover proved them: with its witness in place (the stronger law).
|
|
794
|
+
const someKey = (c) => JSON.stringify(c).includes('"op":"all"');
|
|
795
|
+
if ([...item.laws.map(l => l.holds), ...(item.stepLaws ?? []).map(sl => sl.then)].some(someKey)) {
|
|
796
|
+
const r = proveStepLaws(m, item.laws, item.stepLaws ?? []);
|
|
797
|
+
if (!r.proven)
|
|
798
|
+
throw new Error(`${item.id}: not proven (${r.failed?.stuck ?? ''})`);
|
|
799
|
+
item = { ...item, laws: r.laws ?? item.laws, ...(item.stepLaws ? { stepLaws: r.stepLaws ?? item.stepLaws } : {}) };
|
|
800
|
+
}
|
|
801
|
+
if (m.history && (m.fns || m.facts))
|
|
802
|
+
throw new Error(`${item.id}: functions on a machine with a history aren't exported to Lean yet`);
|
|
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
|
+
}
|
|
813
|
+
continue;
|
|
814
|
+
}
|
|
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`));
|
|
818
|
+
if (item.lean?.after)
|
|
819
|
+
theorems.push(...[...item.lean.after(() => 0).matchAll(/^theorem (\S+)/gm)].map(x2 => x2[1]));
|
|
820
|
+
}
|
|
821
|
+
else if ('refinement' in item) {
|
|
822
|
+
const { impl, spec, relation, witness } = item.refinement;
|
|
823
|
+
const stutter = item.refinement.stutter ?? { op: '<', a: n(0), b: n(0) };
|
|
824
|
+
const R = refinement(impl, spec, { relation, witness, stutter }), S = refinementSides(impl, spec);
|
|
825
|
+
const laws = [...relation, { name: `${spec.name}'s precondition`, holds: spec.pre ?? atMost(n(0), n(0)) }];
|
|
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))] } };
|
|
827
|
+
const refined = { impl: S.impl, spec: S.spec, wit: witness, stutter, specPre: relation.length }, free = spec.inputs.map(i => `b_${i}`);
|
|
828
|
+
parts.push(`-- ${item.id}\n${smachineToLean(id, R.machine, laws, { stepLaws: [sl], free, refined })}`);
|
|
829
|
+
theorems.push(`${id}_laws`, `${id}_refines`);
|
|
830
|
+
}
|
|
831
|
+
else if ('loop' in item) {
|
|
832
|
+
parts.push(`-- ${item.id}\n${loopToLean(id, item.loop, item.laws ?? [], item.rank)}`);
|
|
833
|
+
theorems.push(`${id}_halts`);
|
|
834
|
+
}
|
|
835
|
+
else {
|
|
836
|
+
// goalToLean names its theorem t<i>; here it is the item's id.
|
|
837
|
+
const n = goals++;
|
|
838
|
+
parts.push(goalToLean({ name: item.id, goal: item.goal, tree: grown(item.goal) }, n, false).replace(new RegExp(`\\bt${n}(_goal|_tree)?\\b`, 'g'), (_, suffix) => `${id}${suffix ?? ''}`));
|
|
839
|
+
theorems.push(id);
|
|
840
|
+
}
|
|
841
|
+
}
|
|
842
|
+
// Sets.lean (which imports Steps.lean) only when a machine has sets.
|
|
843
|
+
return `import History
|
|
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'}
|
|
845
|
+
open Kern Cert
|
|
846
|
+
set_option maxRecDepth 100000
|
|
847
|
+
set_option maxHeartbeats 0
|
|
848
|
+
|
|
849
|
+
/-! ${opts.title ?? 'Laws proven by gdp-wired'}: the kernel's proofs, checked by Lean against the twin (Kernel.lean and the
|
|
850
|
+
files it imports), whose soundness theorems are proven there. -/
|
|
851
|
+
|
|
852
|
+
${parts.join('\n\n')}
|
|
853
|
+
|
|
854
|
+
${theorems.map(t => `#print axioms ${t}`).join('\n')}
|
|
855
|
+
`;
|
|
856
|
+
}
|
|
857
|
+
// A Lake project that builds the twin and the file: `lake build` in its folder checks every proof.
|
|
858
|
+
export function leanProject(file, opts = {}) {
|
|
859
|
+
const name = opts.name ?? 'Proofs';
|
|
860
|
+
const modules = [...Object.keys(leanLibrary).map(f => f.replace(/\.lean$/, '')), name];
|
|
861
|
+
return {
|
|
862
|
+
...leanLibrary,
|
|
863
|
+
[`${name}.lean`]: file,
|
|
864
|
+
'lean-toolchain': 'leanprover/lean4:v4.34.0\n',
|
|
865
|
+
'lakefile.lean': `import Lake
|
|
866
|
+
open Lake DSL
|
|
867
|
+
|
|
868
|
+
package ${name.toLowerCase()}
|
|
869
|
+
|
|
870
|
+
@[default_target]
|
|
871
|
+
lean_lib ${name} where
|
|
872
|
+
roots := #[${modules.map(mod => `\`${mod}`).join(', ')}]
|
|
873
|
+
`,
|
|
874
|
+
};
|
|
875
|
+
}
|