diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index b67789c..277ad42 100644 --- a/RELEASE_NOTES.md +++ b/RELEASE_NOTES.md @@ -1,3 +1,107 @@ +# MeTTaScript 2.8.0 + +A property-testing library written in MeTTa, `collapse` matching current Hyperon, and interpreter work that +makes deep tail recursion finish instead of overflowing. + +## Property testing: `@mettascript/fuzz` + +State a property that should hold for every input, and the library generates inputs, finds a counterexample, +and shrinks it to the smallest one that still fails: + +```metta +!(import! &self fuzz) + +(: reverse-involution (-> Atom FuzzProperty)) +(= (reverse-involution $xs) (expect-atom-equal (reverse (reverse $xs)) $xs)) + +!(fuzz-check reverse-involution (gen-list (gen-int -100 100) 0 40) reverse-involution + (fuzz-config (Runs 200))) +``` + +The policy is MeTTa. Generation, shrinking, the run loop, the state machines, and the search are rewrite +rules in `packages/fuzz/src/metta`, and TypeScript supplies only what a representation needs: a random +source, a structural key over atoms, and a versioned atom codec. + +What the library covers: + +- Generators as data, from scalars and text through `gen-tuple`, `gen-list`, `gen-map`, `gen-bind`, + `gen-filter`, `gen-recursive`, and `gen-custom`. Because a generator is an atom rather than a function, + the same declaration can be replayed from a seed, shrunk, or enumerated. +- Grammar and type-directed generation, so a generated term is a sentence of a declared language or a + well-typed term rather than a random tree. +- Shrinking under a named order, `mettascript-shrink-v1`, so the smallest form is stable across runs rather + than a function of the seed. The result says whether it reached a local minimum, or stopped early and why. +- Exhaustive checking with a choice-vector cursor. `FuzzExhaustivelyVerified` carries the domain count and + means the whole domain passed. A domain that does not fit the bound is reported as an incomplete run, + never as verified. +- Model-based state machines: describe the system as a model you trust and the real thing you do not, and a + divergence shrinks to the shortest command sequence that separates them. +- Bounded reachability, breadth first, over a transition relation that may return several next states. A + reported witness is replayed from the initial state before it is trusted, and the four answers stay + distinct: a witness, exhaustion of a finite model, nothing found at or below `MaxDepth`, and a cutoff. +- Expectation combinators that carry a tag and details, so a failure says what was wrong rather than + returning `False`. + +Every run is a function of its seed. The random source, the shrink order, the replay keys, and the +enumeration order are all named and versioned, so a reported failure reproduces. + +## Running suites from the command line + +Declare tests as data and let the CLI find them: + +```bash +metta fuzz suite.metta # run every (FuzzTest ...) declaration +metta fuzz --exhaustive suite.metta # enumerate each domain instead +metta fuzz --corpus regressions suite.metta # replay stored counterexamples, record new ones +metta reach suite.metta # run every (FuzzReachTest ...) declaration +``` + +Exit codes make the command a test gate: 0 for a pass or a definitive answer, 1 for a property failure, 2 +for invalid input or corrupt stored data, 3 for an incomplete run. Results go to stdout and diagnostics to +stderr, so `--json` prints exactly one document. + +Reading a suite runs its declarations, not its `!` queries, so discovery cannot become a way to execute +whatever else a file would have done. `import!` and `register-module!` are kept, because a property defined +in an imported file would be undefined without them. + +`--corpus ` keeps found counterexamples as text so a later run replays them before generating anything +new, one file per case named for the digest of its contents. Commit the directory and the failure travels +with the code that caused it. Values are stored through the versioned codec rather than printed, so a +counterexample of `NaN` or `-0.0` comes back exactly, and a corpus file that cannot be read stops the run +instead of quietly dropping a known failure. + +## `collapse` returns a plain expression + +`collapse` now matches current Hyperon and returns a plain expression of its ordered results. Zero +results produce `()`, one result produces `(value)`, and multiple results produce `(first second ...)`. +The comma symbol is ordinary data when passed to `superpose`. + +Programs that compared an empty collapse with `(,)` must compare it with `()`. Programs that first bound +the collapsed expression and then removed its leading comma with `cdr-atom` should use the bound expression +directly. The existing `superpose (cdr-atom (collapse ...))` computed-tuple idiom is unchanged because +`superpose` evaluates that well-typed argument before splitting it. + +## Deep recursion finishes instead of overflowing + +Tail calls now carry a fuel budget through the interpreter's trampoline and through the compiled impure +driver, and a chain continues past bound variables rather than stopping at the first one. Native evaluation +nesting is capped, with open atoms exempt because an unbound-variable self-expansion mints fresh variables +at constant logical depth and would otherwise branch until memory ran out. Programs that used to report +`StackOverflow` on a deep but flat recursion now complete; a run that genuinely cannot terminate is cut by +fuel and says so. + +Tabling learned to stop paying for itself where it does not help. `Error` payloads no longer count as +recursive calls when deciding whether a call is worth tabling, which is what had made the prelude's own +`let*` rule look doubly recursive and got the busiest control construct in the language memoized with keys +that could never hit. On a 400-step accumulator loop that cost 6.53s and 1479MB; it is now 2.53s and 227MB, +with the curve linear and matching the tabling-disabled baseline. A table whose memo goes unread is also +revoked now, per functor, after 256 stored entries with no read. Refusing a memo can only cost time and +never change a result, and the byte-identical differential against untabled evaluation is unchanged. + +Smaller engine fixes: negative zero survives formatting, a NaN argument propagates errors lazily like any +other, state handles pass to grounded operations opaquely, and impure-head and NaN scans are cached over +shared subtrees. + # MeTTaScript 2.7.0 Leveled logging you can leave in the code, and two interpreter forms that now carry the types they always diff --git a/compat/browser/package.json b/compat/browser/package.json index 6a061ee..750b8be 100644 --- a/compat/browser/package.json +++ b/compat/browser/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/browser", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/core/package.json b/compat/core/package.json index 830229f..913cb26 100644 --- a/compat/core/package.json +++ b/compat/core/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/core", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/das-client/package.json b/compat/das-client/package.json index 425f31d..01452dc 100644 --- a/compat/das-client/package.json +++ b/compat/das-client/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/das-client", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/das-gateway/package.json b/compat/das-gateway/package.json index 54f5b77..4a43029 100644 --- a/compat/das-gateway/package.json +++ b/compat/das-gateway/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/das-gateway", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/debug/package.json b/compat/debug/package.json index f8a1499..1993a01 100644 --- a/compat/debug/package.json +++ b/compat/debug/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/debug", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/edsl/package.json b/compat/edsl/package.json index 7032194..bf4161b 100644 --- a/compat/edsl/package.json +++ b/compat/edsl/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/edsl", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/fuzz/package.json b/compat/fuzz/package.json new file mode 100644 index 0000000..7a1f58b --- /dev/null +++ b/compat/fuzz/package.json @@ -0,0 +1,43 @@ +{ + "name": "@metta-ts/fuzz", + "version": "2.8.0", + "license": "MIT", + "type": "module", + "main": "./dist/index.js", + "types": "./dist/index.d.ts", + "exports": { + ".": { + "types": "./dist/index.d.ts", + "default": "./dist/index.js" + }, + "./package.json": "./package.json" + }, + "files": [ + "dist" + ], + "scripts": { + "build": "tsup src/index.ts --format esm --dts --clean" + }, + "dependencies": { + "@mettascript/fuzz": "workspace:*" + }, + "author": "MesTTo", + "engines": { + "node": ">=20" + }, + "sideEffects": true, + "module": "./dist/index.js", + "publishConfig": { + "access": "public" + }, + "description": "Compatibility shim for @mettascript/fuzz.", + "repository": { + "type": "git", + "url": "git+https://github.com/MesTTo/MeTTaScript.git", + "directory": "packages/fuzz" + }, + "homepage": "https://github.com/MesTTo/MeTTaScript#readme", + "bugs": { + "url": "https://github.com/MesTTo/MeTTaScript/issues" + } +} diff --git a/compat/fuzz/src/index.ts b/compat/fuzz/src/index.ts new file mode 100644 index 0000000..56d4933 --- /dev/null +++ b/compat/fuzz/src/index.ts @@ -0,0 +1,5 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +export * from "@mettascript/fuzz"; diff --git a/compat/fuzz/tsconfig.json b/compat/fuzz/tsconfig.json new file mode 100644 index 0000000..ca4f265 --- /dev/null +++ b/compat/fuzz/tsconfig.json @@ -0,0 +1,9 @@ +{ + "extends": "../../tsconfig.base.json", + "include": ["src"], + "compilerOptions": { + "outDir": "dist", + "rootDir": "src", + "types": ["node"] + } +} diff --git a/compat/grapher/package.json b/compat/grapher/package.json index c58379c..b015ce2 100644 --- a/compat/grapher/package.json +++ b/compat/grapher/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/grapher", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/hyperon/package.json b/compat/hyperon/package.json index 3680398..cc069d6 100644 --- a/compat/hyperon/package.json +++ b/compat/hyperon/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/hyperon", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/libraries/package.json b/compat/libraries/package.json index 81ca971..7072d53 100644 --- a/compat/libraries/package.json +++ b/compat/libraries/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/libraries", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/node/package.json b/compat/node/package.json index 260f77e..66a09c8 100644 --- a/compat/node/package.json +++ b/compat/node/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/node", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/prolog/package.json b/compat/prolog/package.json index befc6b7..98ff3a9 100644 --- a/compat/prolog/package.json +++ b/compat/prolog/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/prolog", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/compat/py/package.json b/compat/py/package.json index 05eca4c..f6d1cd8 100644 --- a/compat/py/package.json +++ b/compat/py/package.json @@ -1,6 +1,6 @@ { "name": "@metta-ts/py", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/corpus/b4_nondeterm.metta b/corpus/b4_nondeterm.metta index 0059f4d..29a3ad7 100644 --- a/corpus/b4_nondeterm.metta +++ b/corpus/b4_nondeterm.metta @@ -22,14 +22,14 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; `collapse` converts a nondeterministic result into an explicit comma tuple +; `collapse` converts a nondeterministic result into a tuple ; We don't use it above, because the order of non-deterministic results ; is not guaranteed ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; !(assertEqual (collapse (match &self (= (shape) $x) $x)) - (,)) + ()) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -56,7 +56,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; !(assertEqual (collapse (shape)) - (, (shape))) + ((shape))) !(assertEqualToResult (shape) ((shape))) diff --git a/corpus/d5_auto_types.metta b/corpus/d5_auto_types.metta index 4c012ef..8cab456 100644 --- a/corpus/d5_auto_types.metta +++ b/corpus/d5_auto_types.metta @@ -43,7 +43,7 @@ Auto type-checking can be enabled ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; !(assertEqualToResult (collapse (+ 5 "S")) - ((, (Error (+ 5 "S") (BadArgType 2 Number String))))) + (((Error (+ 5 "S") (BadArgType 2 Number String))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/corpus/test_stdlib.metta b/corpus/test_stdlib.metta index e6af07e..51a2897 100644 --- a/corpus/test_stdlib.metta +++ b/corpus/test_stdlib.metta @@ -65,7 +65,7 @@ (())) !(assertEqualToResult (assertIncludes (superpose (41 42 43)) (A)) - ((Error (assertIncludes (superpose (41 42 43)) (A)) (assertIncludes error: (A) not included in result: (, 41 42 43))))) + ((Error (assertIncludes (superpose (41 42 43)) (A)) (assertIncludes error: (A) not included in result: (41 42 43))))) !(assertEqualToResult (= (f) (+ 1 2)) diff --git a/examples/package.json b/examples/package.json index ef40968..8debf5c 100644 --- a/examples/package.json +++ b/examples/package.json @@ -5,35 +5,38 @@ "type": "module", "description": "Runnable TypeScript examples for MeTTa TS. Run with: npx tsx examples/.ts", "scripts": { - "quickstart": "tsx quickstart.ts", - "grounded-ops": "tsx grounded-ops.ts", "async": "tsx async.ts", + "browser-interop": "tsx browser-interop/smoke.ts", + "browser-interop:bundle-check": "node browser-interop/check-pure-bundle.mjs", + "concurrency": "tsx concurrency.ts", + "custom-matching": "tsx custom-matching.ts", "edsl": "tsx edsl.ts", + "grapher": "tsx grapher.ts", + "grapher-gif": "tsx grapher-gif.ts", + "grounded-ops": "tsx grounded-ops.ts", "hyperon-api": "tsx hyperon-api.ts", + "js-interop": "tsx js-interop.ts", + "json-module": "tsx json-module.ts", "matching": "tsx matching.ts", "nondeterminism": "tsx nondeterminism.ts", - "stdlib": "tsx stdlib.ts", - "standard-libraries": "metta-ts standard-libraries.metta", - "types": "tsx types.ts", - "js-interop": "tsx js-interop.ts", - "python-interop": "tsx python-interop.ts", + "parallel-matcher": "tsx parallel-matcher.ts", "prolog-interop": "tsx prolog-interop.ts", - "browser-interop": "tsx browser-interop/smoke.ts", - "browser-interop:bundle-check": "node browser-interop/check-pure-bundle.mjs", - "json-module": "tsx json-module.ts", - "custom-matching": "tsx custom-matching.ts", - "concurrency": "tsx concurrency.ts", - "transactions": "tsx transactions.ts", + "property-testing": "tsx property-testing.ts", + "property-testing:cli": "metta fuzz property-testing.metta", + "python-interop": "tsx python-interop.ts", + "quickstart": "tsx quickstart.ts", "scaling": "tsx scaling.ts", - "parallel-matcher": "tsx parallel-matcher.ts", - "grapher": "tsx grapher.ts", - "grapher-gif": "tsx grapher-gif.ts", - "typecheck": "tsc --noEmit" + "standard-libraries": "metta-ts standard-libraries.metta", + "stdlib": "tsx stdlib.ts", + "transactions": "tsx transactions.ts", + "typecheck": "tsc --noEmit", + "types": "tsx types.ts" }, "dependencies": { "@mettascript/browser": "workspace:*", "@mettascript/core": "workspace:*", "@mettascript/edsl": "workspace:*", + "@mettascript/fuzz": "workspace:*", "@mettascript/grapher": "workspace:*", "@mettascript/hyperon": "workspace:*", "@mettascript/node": "workspace:*", diff --git a/examples/property-testing.metta b/examples/property-testing.metta new file mode 100644 index 0000000..7bec661 --- /dev/null +++ b/examples/property-testing.metta @@ -0,0 +1,49 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; A suite declared as data. Run it with `metta fuzz property-testing.metta`, which finds every +; declaration below, runs it, prints a line each, and exits 1 because one of them fails on purpose. +; +; The `!` query at the bottom is NOT run by `metta fuzz`: reading a suite executes the declarations, not +; the file. Run the file with `metta run property-testing.metta` to see that query instead. + +; True for every list. +(: reverse-involution (-> Atom FuzzProperty)) +(= (reverse-involution $xs) (expect-atom-equal (reverse (reverse $xs)) $xs)) + +; True for every list of naturals, and false as soon as an element is negative. Left in as the failing +; declaration, so the suite shows a shrunk counterexample and a non-zero exit code. +(: sum-nonnegative (-> Atom FuzzProperty)) +(= (sum-nonnegative $xs) + (expect-true (>= (foldl-atom $xs 0 $a $b (+ $a $b)) 0) (Sum $xs))) + +; Small enough to enumerate: under `metta fuzz --exhaustive` this domain is covered rather than sampled. +; The list declaration above is not: lists of up to forty integers from a range of 201 do not fit any +; bound, so exhaustive mode reports it as an incomplete run instead of pretending to have covered it. +(: bool-involution (-> Atom FuzzProperty)) +(= (bool-involution $b) (expect-atom-equal (not (not $b)) $b)) + +(FuzzTest involution (gen-list (gen-int -100 100) 0 40) reverse-involution + (fuzz-config (Runs 100))) +(FuzzTest sum (gen-list (gen-int -10 10) 1 6) sum-nonnegative + (fuzz-config (Seed 1) (Runs 50) (EdgeCases 0))) +(FuzzTest booleans (gen-bool) bool-involution (fuzz-config (MaxEnumerated 10))) + +; A bounded search over a model, for `metta reach property-testing.metta`. The counter stops at four, so +; the model is finite and the search can reach exhaustion rather than a depth answer. +(= (counter-enumerate (Count $n)) + (if (< $n 4) (FiniteCommands up split) (FiniteCommands))) +(= (counter-transition (Count $n) up) (Count (+ $n 1))) +(= (counter-transition (Count $n) split) (superpose ((Count (+ $n 1)) (Count (+ $n 2))))) +(= (counter-at-three (Count $n)) (== $n 3)) +(= (counter-at-ninety (Count $n)) (== $n 90)) + +(FuzzReachTest reaches-three (Count 0) + counter-enumerate counter-transition counter-at-three + (reach-config (MaxDepth 20))) +(FuzzReachTest never-ninety (Count 0) + counter-enumerate counter-transition counter-at-ninety + (reach-config (MaxDepth 20))) + +!(println! "metta run executes this; metta fuzz does not") diff --git a/examples/property-testing.ts b/examples/property-testing.ts new file mode 100644 index 0000000..f376f00 --- /dev/null +++ b/examples/property-testing.ts @@ -0,0 +1,74 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// Property testing: state what should hold for every input, let the library find and shrink a +// counterexample, and read the result from TypeScript. +// +// Run it (after `pnpm build`): npx tsx examples/property-testing.ts +import { MeTTa } from "@mettascript/hyperon"; +import { decodeFuzzOutcome, renderOutcomeLine } from "@mettascript/fuzz"; +import { format, parseAll, standardTokenizer } from "@mettascript/core"; + +const m = new MeTTa(); + +// A property takes one generated value and returns a FuzzProperty. Declare a concrete return type, not +// Atom, or the call is left unreduced. +m.run(` + !(import! &self fuzz) + + (: reverse-involution (-> Atom FuzzProperty)) + (= (reverse-involution $xs) (expect-atom-equal (reverse (reverse $xs)) $xs)) + + (: sum-nonnegative (-> Atom FuzzProperty)) + (= (sum-nonnegative $xs) + (expect-true (>= (foldl-atom $xs 0 $a $b (+ $a $b)) 0) (Sum $xs))) +`); + +/** One result atom, decoded and rendered the way `metta fuzz` renders it. */ +function check(query: string): string { + const printed = m.run(`!${query}`).at(-1)![0]!.toString(); + const [atom] = parseAll(printed, standardTokenizer()); + return renderOutcomeLine(decodeFuzzOutcome(atom!.atom)); +} + +// True for every list, so this passes and reports how many cases it took. +console.log( + check(`(fuzz-check reverse-involution (gen-list (gen-int -100 100) 0 40) reverse-involution + (fuzz-config (Runs 100)))`), +); // ok reverse-involution 113 cases, seed 0 + +// Not true: the elements can be negative. Generation finds (4 -5), and shrinking reduces it to (-1), +// the smallest list that still fails. +console.log( + check(`(fuzz-check sum-nonnegative (gen-list (gen-int -10 10) 1 6) sum-nonnegative + (fuzz-config (Seed 1) (Runs 50) (EdgeCases 0)))`), +); // FAILED sum-nonnegative ExpectedTrue (-1) + +// A small domain can be enumerated instead of sampled, which covers it rather than testing it. +m.run(` + (: bool-involution (-> Atom FuzzProperty)) + (= (bool-involution $b) (expect-atom-equal (not (not $b)) $b)) +`); +console.log( + check(`(fuzz-check-exhaustive bool-involution (gen-bool) bool-involution + (fuzz-config (MaxEnumerated 10)))`), +); // ok bool-involution exhaustive, 2 trees + +// The typed view carries the whole result, so a harness can act on the parts it cares about. +const printed = m + .run( + `!(fuzz-check sum-nonnegative (gen-list (gen-int -10 10) 1 6) sum-nonnegative + (fuzz-config (Seed 1) (Runs 50) (EdgeCases 0)))`, + ) + .at(-1)![0]! + .toString(); +const outcome = decodeFuzzOutcome(parseAll(printed, standardTokenizer())[0]!.atom); +if (outcome.kind === "failed") { + console.log("failure tag:", outcome.failureTag); // ExpectedTrue + console.log("original:", format(outcome.originalValue!)); // (4 -5) + console.log("shrunk to:", format(outcome.smallestValue!)); // (-1) + // The shrink report stays an atom: it says whether the value is locally minimal under the named order, + // and how many candidates were tried to get there. + console.log("shrink:", format(outcome.shrink!)); +} diff --git a/packages/browser/package.json b/packages/browser/package.json index 7361fc8..f403c32 100644 --- a/packages/browser/package.json +++ b/packages/browser/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/browser", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", @@ -32,6 +32,7 @@ }, "dependencies": { "@mettascript/core": "workspace:*", + "@mettascript/fuzz": "workspace:*", "@mettascript/libraries": "workspace:*" }, "author": "MesTTo", diff --git a/packages/browser/src/source.test.ts b/packages/browser/src/source.test.ts index 705a96e..be73657 100644 --- a/packages/browser/src/source.test.ts +++ b/packages/browser/src/source.test.ts @@ -16,6 +16,42 @@ const lastResults = (rs: ReturnType): string[] => rs.at(-1)?.results.map(format) ?? []; describe("browser source runners", () => { + it("uses the same deterministic fuzz kernel vectors as the package entry", () => { + const results = runSource(` + !(import! &self fuzz) + !(_fuzz-rng-init 42) + !(let* ( + ($r0 (_fuzz-rng-init 42)) + ((FuzzDraw $a $r1) (_fuzz-draw-int $r0 -10 10)) + ((FuzzDraw $b $r2) (_fuzz-draw-int $r1 -10 10)) + ((FuzzDraw $c $r3) (_fuzz-draw-int $r2 -10 10))) + ($a $b $c $r3)) + !(_fuzz-atom-key Alpha (pair $left $left $right)) + !(_fuzz-make-variable 17) + `); + expect(results.map((result) => result.results.map(format))).toEqual([ + ["()"], + ["(FuzzRng xorshift128plus-v1 -1 -43 42 0)"], + ["(-9 -3 -5 (FuzzRng xorshift128plus-v1 352322880 526288222 704468 -1339159583))"], + ['"mettascript-atom-key-v1;E4:S4:pair;V2:%0;V2:%0;V2:%1;"'], + ["$fuzz-17"], + ]); + }); + + it("runs a whole property test through the module, not only its kernel", () => { + // Registering the grounded operations is not the same as the MeTTa module being usable, so this + // checks the thing a user actually calls. + const results = runSource(` + !(import! &self fuzz) + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + !(fuzz-check smoke (gen-int 0 9) always (fuzz-config (Runs 3) (EdgeCases 0))) + `); + expect(results.at(-1)!.results.map(format)[0]).toContain( + "(FuzzPassed (Property smoke) (Seed 0)", + ); + }); + it("runs a source string with in-memory imports", () => { const imports = new Map([ [ diff --git a/packages/browser/src/source.ts b/packages/browser/src/source.ts index 64b01cf..61dae00 100644 --- a/packages/browser/src/source.ts +++ b/packages/browser/src/source.ts @@ -6,6 +6,7 @@ // from an in-memory VFS, async forms run through the core async driver, and browser hyperpose uses Web Workers // when the host exposes them. import "@mettascript/libraries"; +import "@mettascript/fuzz"; import { DEFAULT_FUEL, evalSequential, diff --git a/packages/core/package.json b/packages/core/package.json index 80f3348..428d30f 100644 --- a/packages/core/package.json +++ b/packages/core/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/core", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/packages/core/src/async-eval.test.ts b/packages/core/src/async-eval.test.ts index 9a747f8..00f9d4f 100644 --- a/packages/core/src/async-eval.test.ts +++ b/packages/core/src/async-eval.test.ts @@ -43,7 +43,7 @@ describe("async evaluation (generator dual-driver)", () => { ( await runProgramAsync("!(collapse (fetch-double (superpose (1 2 3))))", ops) )[0]!.results.map(format), - ).toEqual(["(, 2 4 6)"]); + ).toEqual(["(2 4 6)"]); }); it("a pure program gives the same result via the async runner", async () => { diff --git a/packages/core/src/atom.ts b/packages/core/src/atom.ts index fb69337..82eec65 100644 --- a/packages/core/src/atom.ts +++ b/packages/core/src/atom.ts @@ -530,10 +530,12 @@ function hasNanGround(a: Atom): boolean { const cached = exprHasNanCache.get(a); if (cached !== undefined) return cached; // Iterative DFS with short-circuit so a deep term cannot overflow the host stack. A cached subtree is - // used directly (true short-circuits, false is skipped); an uncached one has its children pushed. Only - // the queried root is memoised here — an intermediate node is re-derived on a future query, a caching - // detail, not a result change. Result is the same `NaN anywhere in the tree` test. + // used directly (true short-circuits, false is skipped). Every expression visited by a clean walk is + // memoised, not just the queried root: `atomEq`'s identity fast path asks this question of every fresh + // wrapper around a stable large subtree (a machine state rebuilt around a shared accumulator each + // step), and root-only caching re-walked that shared structure once per fresh wrapper. const stack: Atom[] = [a]; + const visited: ExprAtom[] = []; let found = false; while (stack.length > 0) { const cur = stack.pop()!; @@ -548,10 +550,17 @@ function hasNanGround(a: Atom): boolean { found = true; break; } - if (c === undefined) for (const x of cur.items) stack.push(x); + if (c === undefined) { + visited.push(cur); + for (const x of cur.items) stack.push(x); + } } } - exprHasNanCache.set(a, found); + if (found) { + exprHasNanCache.set(a, true); + } else { + for (const node of visited) exprHasNanCache.set(node, false); + } return found; } diff --git a/packages/core/src/auto-tabling-completion.test.ts b/packages/core/src/auto-tabling-completion.test.ts index d14ac5c..da407bd 100644 --- a/packages/core/src/auto-tabling-completion.test.ts +++ b/packages/core/src/auto-tabling-completion.test.ts @@ -25,7 +25,7 @@ describe("adaptive local-linear tabling", () => { !(collapse (path a $z)) `; - expect(results(src)).toEqual(["(, b c d)"]); + expect(results(src)).toEqual(["(b c d)"]); }); it("keeps non-cyclic calls as exact ordered bags", () => { @@ -36,7 +36,7 @@ describe("adaptive local-linear tabling", () => { !(collapse (choice $x)) `; - expect(results(src)).toEqual(["(, A A B)"]); + expect(results(src)).toEqual(["(A A B)"]); }); it("returns TableResourceLimit when an active table cannot fit the shared budget", () => { @@ -57,7 +57,7 @@ describe("adaptive local-linear tabling", () => { const [pairs] = mettaEval(env, 100_000, initSt(), [], query); expect(pairs.map((pair) => format(pair[0]))).toEqual([ - "(, (Error (path a $z) TableResourceLimit))", + "((Error (path a $z) TableResourceLimit))", ]); }); }); diff --git a/packages/core/src/builtins.ts b/packages/core/src/builtins.ts index ddfe8af..0792bb4 100644 --- a/packages/core/src/builtins.ts +++ b/packages/core/src/builtins.ts @@ -540,14 +540,6 @@ const msSubtract = (lhs: readonly Atom[], rhs: readonly Atom[]): Atom[] => { } return out; }; -const resultItems = (xs: readonly Atom[]): Atom[] => - xs.length > 0 && xs[0]!.kind === "sym" && xs[0]!.name === "," ? xs.slice(1) : [...xs]; -const isResultBag = (xs: readonly Atom[]): boolean => - xs.length > 0 && xs[0]!.kind === "sym" && xs[0]!.name === ","; -const unionItems = (lhs: readonly Atom[], rhs: readonly Atom[]): Atom[] => - isResultBag(lhs) && isResultBag(rhs) - ? [sym(","), ...lhs.slice(1), ...rhs.slice(1)] - : [...lhs, ...rhs]; const removeFirstBy = ( eq: (a: Atom, b: Atom) => boolean, a: Atom, @@ -598,7 +590,7 @@ const assertEqOp = const a0 = args[0]; const e0 = args[1]; if (a0?.kind !== "expr" || e0?.kind !== "expr") return ierr("expected two expressions"); - const okEq = bagEqBy(eq, resultItems(a0.items), resultItems(e0.items)); + const okEq = bagEqBy(eq, a0.items, e0.items); if (okEq) return ok(emptyExpr); const msg = args.length === 4 ? args[3]! : sym("results-are-not-equal"); return ok(expr([sym("Error"), args[2]!, msg])); @@ -1205,7 +1197,7 @@ const stdEntries: Array<[string, GroundFn]> = [ (args) => { const e = exprArgs(args); return e && e.length === 2 - ? ok(expr(unionItems(e[0]!, e[1]!))) + ? ok(expr([...e[0]!, ...e[1]!])) : ierr("union-atom expects two expressions"); }, ], @@ -1231,7 +1223,7 @@ const stdEntries: Array<[string, GroundFn]> = [ "superpose", (args) => { const e = exprArgs(args); - if (e && e.length === 1) return ok(...resultItems(e[0]!)); + if (e && e.length === 1) return ok(...e[0]!); // Hyperon 0.2.10's exact error atom: the message is a bare (space-containing) symbol, printed // unquoted, and the erring call is reconstructed with the reduced argument. return ok(superposeArgError("superpose", args)); @@ -1241,7 +1233,7 @@ const stdEntries: Array<[string, GroundFn]> = [ "hyperpose", (args) => { const e = exprArgs(args); - if (e && e.length === 1) return ok(...resultItems(e[0]!)); + if (e && e.length === 1) return ok(...e[0]!); return ok(superposeArgError("hyperpose", args)); }, ], @@ -1250,13 +1242,10 @@ const stdEntries: Array<[string, GroundFn]> = [ (args) => { const e = exprArgs(args); if (!e || e.length !== 1) return ierr("collapse-extract expects one expression"); - // LeaTTa represents a collapsed bag as a comma tuple `(, r1 r2 ...)`. `resultItems` strips the comma - // when a bag is spread back through `superpose`. + // Hyperon returns a plain expression `(r1 r2 ...)`, with `()` for zero results. Each collapse-bind + // entry is an `(atom bindings)` pair; take the atom and preserve order and multiplicity. return ok( - expr([ - sym(","), - ...e[0]!.map((p) => (p.kind === "expr" && p.items.length > 0 ? p.items[0]! : p)), - ]), + expr(e[0]!.map((p) => (p.kind === "expr" && p.items.length > 0 ? p.items[0]! : p))), ); }, ], diff --git a/packages/core/src/choice-plan.ts b/packages/core/src/choice-plan.ts index 2782a8f..b917292 100644 --- a/packages/core/src/choice-plan.ts +++ b/packages/core/src/choice-plan.ts @@ -217,9 +217,7 @@ function compileSuperpose( run(frame, emit) { source.run(frame, (value) => { if (value.kind !== "expr") return abort(); - const first = value.items[0]; - const start = first?.kind === "sym" && first.name === "," ? 1 : 0; - for (let index = start; index < value.items.length; index++) emit(value.items[index]!); + for (const item of value.items) emit(item); }); }, }; diff --git a/packages/core/src/collapse-hyperon.test.ts b/packages/core/src/collapse-hyperon.test.ts new file mode 100644 index 0000000..3d8212e --- /dev/null +++ b/packages/core/src/collapse-hyperon.test.ts @@ -0,0 +1,44 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import { describe, expect, it } from "vitest"; +import { format } from "./parser"; +import { runProgram } from "./runner"; + +const printed = (source: string): string[][] => + runProgram(source).map((query) => query.results.map(format)); + +describe("Hyperon collapse semantics", () => { + it("returns a plain ordered expression for zero, one, duplicate, and multiple results", () => { + expect( + printed(` + (= (one) 2) + (= (many) a) + (= (many) a) + (= (many) b) + !(collapse (match &self (missing $x) $x)) + !(collapse (one)) + !(collapse (many)) + !(collapse (superpose (a b))) + `), + ).toEqual([["()"], ["(2)"], ["(a a b)"], ["(a b)"]]); + }); + + it("does not give the comma symbol special meaning inside superpose", () => { + expect( + printed(` + !(superpose (, a b)) + !(collapse (superpose (, a b))) + `), + ).toEqual([[",", "a", "b"], ["(, a b)"]]); + }); + + it("keeps the choice-plan route byte-identical to ordinary evaluation", () => { + const source = "!(collapse (superpose ((superpose (1 2)) (superpose (3 4)))))"; + const fallback = `(= (>= never never) False)\n${source}`; + + expect(printed(source)).toEqual([["(1 3 1 4 2 3 2 4)"]]); + expect(printed(source)).toEqual(printed(fallback)); + }); +}); diff --git a/packages/core/src/compat-parity.test.ts b/packages/core/src/compat-parity.test.ts index 53e8a5d..f179d6f 100644 --- a/packages/core/src/compat-parity.test.ts +++ b/packages/core/src/compat-parity.test.ts @@ -11,16 +11,30 @@ import { describe, expect, it } from "vitest"; // while the canonical lists the hyperpose worker, so a bundler tree-shook the worker's side-effect import // to an empty file. This asserts every shim mirrors its canonical's sideEffects, so a shim can never again // drift into dropping a worker entry. +// +// It also asserts the pairing in the other direction. Walking only compat/* cannot notice a canonical with +// no shim at all, which is how a new package ships under one scope: @mettascript/fuzz was publishable for +// a while with no @metta-ts/fuzz beside it. Every publishable canonical needs its shim, and every package +// needs the same version, which is what the release bump refuses to run without. const ROOT = process.cwd(); const COMPAT = resolve(ROOT, "compat"); const PACKAGES = resolve(ROOT, "packages"); -const readSideEffects = (dir: string): unknown => - (JSON.parse(readFileSync(resolve(dir, "package.json"), "utf8")) as { sideEffects?: unknown }) - .sideEffects; +interface Manifest { + readonly sideEffects?: unknown; + readonly private?: boolean; + readonly version?: string; +} + +const manifest = (dir: string): Manifest => + JSON.parse(readFileSync(resolve(dir, "package.json"), "utf8")) as Manifest; -const shimNames = readdirSync(COMPAT).filter((name) => - existsSync(resolve(COMPAT, name, "package.json")), +const namesIn = (base: string): string[] => + readdirSync(base).filter((name) => existsSync(resolve(base, name, "package.json"))); + +const shimNames = namesIn(COMPAT); +const publishable = namesIn(PACKAGES).filter( + (name) => manifest(resolve(PACKAGES, name)).private !== true, ); describe("compat shim / canonical sideEffects parity", () => { @@ -28,8 +42,21 @@ describe("compat shim / canonical sideEffects parity", () => { expect(existsSync(resolve(PACKAGES, name, "package.json")), `packages/${name} exists`).toBe( true, ); - expect(readSideEffects(resolve(COMPAT, name))).toEqual( - readSideEffects(resolve(PACKAGES, name)), + expect(manifest(resolve(COMPAT, name)).sideEffects).toEqual( + manifest(resolve(PACKAGES, name)).sideEffects, ); }); + + it.each(publishable)("packages/%s has a compat shim", (name) => { + expect(existsSync(resolve(COMPAT, name, "package.json")), `compat/${name} exists`).toBe(true); + }); + + it("versions every package in lockstep", () => { + const versions = [ + ...shimNames.map((name) => manifest(resolve(COMPAT, name)).version), + ...publishable.map((name) => manifest(resolve(PACKAGES, name)).version), + ]; + + expect([...new Set(versions)]).toHaveLength(1); + }); }); diff --git a/packages/core/src/compile-impure.test.ts b/packages/core/src/compile-impure.test.ts index d8daeb2..3386397 100644 --- a/packages/core/src/compile-impure.test.ts +++ b/packages/core/src/compile-impure.test.ts @@ -64,7 +64,7 @@ describe("compiled impure body (matespace VM de-risk)", () => { const mateOnce = ` (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) (= (mate) @@ -84,26 +84,41 @@ describe("compiled impure body (matespace VM de-risk)", () => { expect(c.out).toEqual(run(mateOnce, false).out); expect(c.out[2]).toEqual(["()"]); expect(c.out[3]).toEqual([]); - expect(c.out[4]).toEqual(["(, (M Z) (W Z) (C Z))"]); + expect(c.out[4]).toEqual(["((M Z) (W Z) (C Z))"]); }); - // The regression guard for the matespace/scale OOM. A self-call recurses natively, so a deep impure - // recursion overflows the host stack exactly as the interpreter does, producing the identical - // `(Error StackOverflow)` and rolling back every partial add-atom. The compiled path must NOT - // trampoline this to completion: doing so built 1,000,000 atoms on scale.metta and ran the suite out of - // memory, and diverged from the interpreter, which stops at the same native limit. At depth 200000 both - // overflow well within the worker stack, so the test is fast (the overflow is cheap) — if the compiled - // path ever ran unbounded again, this would build atoms until it timed out or ran out of memory. + // The regression guard for the matespace/scale OOM, inverted to the flat-tail semantics: Hyperon + // completes this shape (verified live on hyperon 0.2.10, `(build 300)` returns done plus every item) + // and PeTTa completes it flat via last-call optimization, so both modes must COMPLETE it with O(1) + // evaluation frames — the compiled VM through its tail-call driver, the interpreter through the + // trampoline's chain transfers. At depth 100000 a regression back to one native or heap frame per + // step either crashes the worker or times out, so completion here IS the memory guard. const deep = ` (= (build $n) (if (== $n 0) done (let $x (add-atom &self (item $n)) (build (- $n 1))))) - !(build 200000) + !(build 100000) !(collapse (match &self (item $k) $k))`; - it("deep impure recursion overflows identically to the interpreter (no unbounded loop)", () => { + it("deep impure tail recursion completes identically in both modes (flat, no native overflow)", () => { const compiled = run(deep, true); expect(compiled).toEqual(run(deep, false)); - // It overflowed rather than completing, and the partial build rolled back to an empty space. - expect(compiled.out[0]![0]).toContain("StackOverflow"); - expect(compiled.out[1]).toEqual(["(,)"]); + expect(compiled.out[0]).toEqual(["done"]); + expect(compiled.out[1]![0]).toMatch(/^\(100000 99999 /); + }, 60_000); + + // A runaway impure tail cycle must cut on fuel with the standard StackOverflow atom in both modes + // (never hang, never overflow natively). Effects up to the cut persist, as Hyperon's error model + // keeps prior add-atoms; the two modes debit fuel at different per-step rates, so only the cut + // itself is asserted, not the partial space. + const spin = ` + (= (spin $n) (let $x (add-atom &self (tick $n)) (spin (+ $n 1)))) + !(spin 0)`; + it("a runaway impure tail cycle cuts on fuel with a StackOverflow error in both modes", () => { + for (const compiled of [true, false]) { + const env = compiled ? compiledEnvWith(spin) : envWith(spin); + const [pairs] = mettaEval(env, 50_000, initSt(), [], bangAtoms(spin)[0]!); + expect(pairs.map((p) => format(p[0])).join(" "), `compiled=${compiled}`).toContain( + "StackOverflow", + ); + } }); // A doubly-recursive impure function whose body returns a TUPLE of two recursive calls, matespacefast's diff --git a/packages/core/src/compile.test.ts b/packages/core/src/compile.test.ts index 232c301..c1a34e6 100644 --- a/packages/core/src/compile.test.ts +++ b/packages/core/src/compile.test.ts @@ -343,7 +343,7 @@ describe("deterministic-core compiler", () => { describe("impure saturation compiler (case-over-match + add-if-absent)", () => { const SATURATION = ` (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) (= (expand-once) @@ -378,7 +378,7 @@ describe("deterministic-core compiler", () => { it("a duplicate add prunes to nothing, identically", () => { compareCompiledAndInterpreted(` (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) (= (seed) (add-atom &self (k a))) @@ -393,7 +393,7 @@ describe("deterministic-core compiler", () => { it("a case whose every branch prunes yields nothing, identically", () => { compareCompiledAndInterpreted(` (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) (= (grow) @@ -411,7 +411,7 @@ describe("deterministic-core compiler", () => { // worlds, so the interpreter re-runs from the untouched state and the outputs agree. compareCompiledAndInterpreted(` (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) (= (grow) @@ -427,7 +427,7 @@ describe("deterministic-core compiler", () => { it("add-if-absent on a named space, identically", () => { compareCompiledAndInterpreted(` (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) (= (put $s $a) (let $r (add-atom-no-duplicate $s $a) done)) diff --git a/packages/core/src/compile.ts b/packages/core/src/compile.ts index 88dde1e..3113f3c 100644 --- a/packages/core/src/compile.ts +++ b/packages/core/src/compile.ts @@ -177,6 +177,10 @@ export interface CompiledImpureOps { * holders enter it before invoking another user equation. */ readonly evaluationDepth?: EvaluationDepth; readonly maxStackDepth?: number; + /** Remaining evaluator fuel at the compiled boundary. Bounds the imperative tail-call driver: each + * tail transfer debits one unit, mirroring the interpreter's per-transfer cost, so a runaway impure + * tail cycle cuts with the same StackOverflow atom instead of spinning. */ + readonly fuel?: number | undefined; readonly addAtom: (env: MinEnv, st: St, space: Atom, atom: Atom) => St | undefined; /** Solutions of a `(match space pattern template)` under the current world: the instantiated * template plus that solution's bindings, in the interpreter's own candidate order, and the @@ -201,6 +205,20 @@ export interface CompiledImpureOps { ) => { readonly added: boolean; readonly state: St } | undefined; } type ImpEval = { readonly value: Atom; readonly st: St } | typeof BAIL; +/** A tail call another (or the same) imperative holder should continue. Produced only by a call in + * tail position; the holder-entry driver loops on it, so a tail-recursive impure chain (`build`, + * a saturation walk) runs iteratively instead of growing the host stack one `run` frame per step. */ +interface ImpTail { + readonly tail: true; + readonly op: string; + readonly holder: ImperativeHolder; + readonly vals: readonly Atom[]; + readonly st: St; +} +type ImpStep = ImpEval | ImpTail; +function isImpTail(r: ImpStep): r is ImpTail { + return r !== BAIL && (r as ImpTail).tail === true; +} type ImpEmit = (value: Atom, st: St) => St | typeof BAIL; type ImpForEach = ( slots: readonly Atom[], @@ -215,6 +233,9 @@ interface ImperativeHolder { clauseCount: number; run: (partAtoms: readonly Atom[], st: St, ops: CompiledImpureOps, discard?: boolean) => ImpEval; runForEach?: ImpForEach; + /** The compiled body, exposed so the tail-call driver can continue a chain without re-entering + * `run` (which would rebuild the loop and recurse). */ + body?: ImpCompiled; } // A compiled nondeterministic let*-chain functor (the backward-chainer class); see the section // header above compileNondet. `run` returns every solution in clause-major depth-first order, or @@ -2052,9 +2073,7 @@ function choiceUnionSeed(env: MinEnv, rhs: Atom): ChoiceUnionClause | undefined !choiceUnionStaticData(env, source) ) return undefined; - const first = source.items[0]!; - const start = first.kind === "sym" && first.name === "," ? 1 : 0; - return { tag: "seed", values: source.items.slice(start) }; + return { tag: "seed", values: source.items }; } function choiceUnionRecursiveCall(atom: Atom, functor: string, parameter: string): boolean { @@ -4004,7 +4023,7 @@ type ImpNode = ( st: St, ops: CompiledImpureOps, discard?: boolean, -) => ImpEval; +) => ImpStep; type ImperativeFns = Map; const IMP_GROUNDED = new Set(["==", "!=", "<", ">", "<=", ">=", "+", "-", "*", "%"]); @@ -4046,6 +4065,29 @@ function impConst(atom: Atom): ImpCompiled { return { node: (_slots, st) => ({ value: atom, st }), directEffect: false, callees: new Set() }; } +// Fuel backstop when a compiled boundary supplied no budget: large enough for any legitimate +// chain the counter limits admit, small enough that a runaway cycle still cuts. +const IMP_TAIL_FUEL_BACKSTOP = 100_000_000; + +/** Drive a node result to a final value, looping tail-call transfers iteratively. One transfer costs + * one unit of fuel (the interpreter's per-transfer debit); exhaustion throws the depth overflow the + * compiled boundary turns into `(Error StackOverflow)` with effects kept, as the interpreter's + * fuel cut does. */ +function impDrive(first: ImpStep, ops: CompiledImpureOps, discard: boolean | undefined): ImpEval { + let r = first; + let budget = ops.fuel ?? IMP_TAIL_FUEL_BACKSTOP; + while (isImpTail(r)) { + if (budget <= 0) throw new EvaluationDepthOverflow(expr([sym(r.op), ...r.vals]), r.st); + budget -= 1; + const h = r.holder; + const body = h.body; + if (body === undefined || r.vals.length !== h.arity || r.vals.some((a) => !a.ground)) + return BAIL; + r = body.node(r.vals, addCounter(r.st, 1), ops, discard); + } + return r; +} + function impForEach( part: ImpCompiled, slots: readonly Atom[], @@ -4055,7 +4097,7 @@ function impForEach( emit: ImpEmit, ): St | typeof BAIL { if (part.forEach !== undefined) return part.forEach(slots, st, ops, discard, emit); - const r = part.node(slots, st, ops, discard); + const r = impDrive(part.node(slots, st, ops, discard), ops, discard); if (r === BAIL) return BAIL; return r.value === EMPTY_VALUE ? r.st : emit(r.value, r.st); } @@ -4069,7 +4111,7 @@ function impAssembleExpr(parts: readonly ImpCompiled[]): ImpCompiled { let cur = st; for (const part of parts) { const r = part.node(slots, cur, ops); - if (r === BAIL) return BAIL; + if (r === BAIL || isImpTail(r)) return BAIL; // parts are never tail positions out.push(r.value); cur = r.st; } @@ -4092,7 +4134,7 @@ function impEvalArgs( let empty = false; for (const part of parts) { const r = part.node(slots, cur, ops); - if (r === BAIL) return BAIL; + if (r === BAIL || isImpTail(r)) return BAIL; // arguments are never tail positions if (r.value === EMPTY_VALUE) empty = true; vals.push(r.value); cur = r.st; @@ -4154,10 +4196,8 @@ function compileImpGrounded( }; } -const collapsedEmptyExpr = expr([sym(",")]); - // Structural pieces of the add-if-absent idiom, matched over the RULE's atoms (variables in place): -// `(if (== (,) (collapse (once (match S A A)))) (add-atom S A) (empty))`. The same shape the +// `(if (== () (collapse (once (match S A A)))) (add-atom S A) (empty))`. The same shape the // interpreter's tryFastNamedAddIfAbsent recognises at runtime; compiled it becomes one ops call. function impMatchInsideOnce(a: Atom): ExprAtom | undefined { if (a.kind !== "expr" || a.items.length !== 2) return undefined; @@ -4180,8 +4220,8 @@ function impEmptyCollapseMatch(a: Atom): ExprAtom | undefined { ? impMatchInsideOnce(x.items[1]!) : undefined; }; - if (atomEq(a.items[1]!, collapsedEmptyExpr)) return fromCollapse(a.items[2]!); - if (atomEq(a.items[2]!, collapsedEmptyExpr)) return fromCollapse(a.items[1]!); + if (atomEq(a.items[1]!, emptyExpr)) return fromCollapse(a.items[2]!); + if (atomEq(a.items[2]!, emptyExpr)) return fromCollapse(a.items[1]!); return undefined; } @@ -4214,9 +4254,9 @@ function compileImpAddIfAbsent( const addIfAbsent = ops.addIfAbsent; if (addIfAbsent === undefined) return BAIL; const s = space.node(slots, st, ops); - if (s === BAIL) return BAIL; + if (s === BAIL || isImpTail(s)) return BAIL; const a = atom.node(slots, s.st, ops); - if (a === BAIL) return BAIL; + if (a === BAIL || isImpTail(a)) return BAIL; const r = addIfAbsent(env, a.st, s.value, a.value); if (r === undefined) return BAIL; return { value: r.added ? emptyExpr : EMPTY_VALUE, st: r.state }; @@ -4243,7 +4283,7 @@ function compileImpIf( return { node: (slots, st, ops, discard) => { const c = cond.node(slots, st, ops); // the condition is needed, never discarded - if (c === BAIL) return BAIL; + if (c === BAIL || isImpTail(c)) return BAIL; if (c.value === EMPTY_VALUE) return { value: EMPTY_VALUE, st: c.st }; const stIf = addCounter(c.st, 2); if (c.value.kind !== "gnd" || c.value.value.g !== "bool") return BAIL; @@ -4251,7 +4291,7 @@ function compileImpIf( }, forEach: (slots, st, ops, discard, emit) => { const c = cond.node(slots, st, ops); // the condition is needed, never discarded - if (c === BAIL) return BAIL; + if (c === BAIL || isImpTail(c)) return BAIL; if (c.value === EMPTY_VALUE) return c.st; const stIf = addCounter(c.st, 2); if (c.value.kind !== "gnd" || c.value.value.g !== "bool") return BAIL; @@ -4282,7 +4322,7 @@ function compileImpLet( return { node: (slots, st, ops, discard) => { const v = value.node(slots, st, ops); // the bound value is read by the body, never discarded - if (v === BAIL) return BAIL; + if (v === BAIL || isImpTail(v)) return BAIL; // An Empty value has no results, so the let yields nothing: skip the body. if (v.value === EMPTY_VALUE) return { value: EMPTY_VALUE, st: v.st }; const local = slots.slice(); @@ -4336,7 +4376,7 @@ function compileImpLetStar( let cur = addCounter(st, 1); for (const binding of bindings) { const v = binding.value.node(local, cur, ops); // each bound value is read later, never discarded - if (v === BAIL) return BAIL; + if (v === BAIL || isImpTail(v)) return BAIL; // An Empty value has no results, so the whole let* yields nothing. if (v.value === EMPTY_VALUE) return { value: EMPTY_VALUE, st: v.st }; local[binding.slot] = v.value; @@ -4380,9 +4420,9 @@ function compileImpAddAtom( return { node: (slots, st, ops) => { const s = space.node(slots, st, ops); - if (s === BAIL) return BAIL; + if (s === BAIL || isImpTail(s)) return BAIL; const a = atom.node(slots, s.st, ops); - if (a === BAIL) return BAIL; + if (a === BAIL || isImpTail(a)) return BAIL; const st2 = ops.addAtom(env, a.st, s.value, a.value); return st2 === undefined ? BAIL : { value: emptyExpr, st: st2 }; }, @@ -4493,20 +4533,27 @@ function compileImpCaseMatch( const matchSolutions = ops.matchSolutions; if (matchSolutions === undefined) return BAIL; const s = space.node(slots, st, ops); - if (s === BAIL) return BAIL; + if (s === BAIL || isImpTail(s)) return BAIL; const p = pattern.node(slots, s.st, ops); - if (p === BAIL) return BAIL; + if (p === BAIL || isImpTail(p)) return BAIL; const t = template.node(slots, p.st, ops); - if (t === BAIL) return BAIL; + if (t === BAIL || isImpTail(t)) return BAIL; const m = matchSolutions(env, t.st, s.value, p.value, t.value); if (m === undefined) return BAIL; let cur = addCounter(t.st, m.counterDelta); const local = slots.slice(); let survived: Atom | undefined; const pairs = scrut.firstOnly ? m.pairs.slice(0, 1) : m.pairs; - for (const [value] of pairs) { - local[slot] = value; - const r = body.node(local, cur, ops, discard); + for (let i = 0; i < pairs.length; i++) { + local[slot] = pairs[i]![0]; + let r = body.node(local, cur, ops, discard); + // A tail transfer from the last solution with no earlier survivor IS the case's result + // (Empty included), so it may defer to the caller's driver. Any other position must know + // the branch's value (Empty-pruning, the single-survivor check), so drive it here. + if (isImpTail(r)) { + if (i === pairs.length - 1 && survived === undefined) return r; + r = impDrive(r, ops, discard); + } if (r === BAIL) return BAIL; cur = r.st; if (r.value !== EMPTY_VALUE) { @@ -4520,11 +4567,11 @@ function compileImpCaseMatch( const matchSolutions = ops.matchSolutions; if (matchSolutions === undefined) return BAIL; const s = space.node(slots, st, ops); - if (s === BAIL) return BAIL; + if (s === BAIL || isImpTail(s)) return BAIL; const p = pattern.node(slots, s.st, ops); - if (p === BAIL) return BAIL; + if (p === BAIL || isImpTail(p)) return BAIL; const t = template.node(slots, p.st, ops); - if (t === BAIL) return BAIL; + if (t === BAIL || isImpTail(t)) return BAIL; const m = matchSolutions(env, t.st, s.value, p.value, t.value); if (m === undefined) return BAIL; let cur = addCounter(t.st, m.counterDelta); @@ -4583,12 +4630,20 @@ function compileImpCall( if (r === BAIL) return BAIL; // An Empty argument makes the call empty without invoking it (args already ran for effects). if (r.empty) return { value: EMPTY_VALUE, st: r.st }; + // A tail call transfers instead of invoking: the holder-entry driver continues the chain, so + // deep tail recursion (`build`, a saturation walk) is iterative on the heap, PeTTa's LCO. + if (tail) return { tail: true, op, holder: h, vals: r.vals, st: r.st }; return runNested(ops, r.vals, r.st, () => h.run(r.vals, r.st, ops, discard)); }, forEach: (slots, st, ops, discard, emit) => { const r = impEvalArgs(parts, slots, st, ops); // call args are needed, never discarded if (r === BAIL) return BAIL; if (r.empty) return r.st; + if (tail) { + const v = impDrive({ tail: true, op, holder: h, vals: r.vals, st: r.st }, ops, discard); + if (v === BAIL) return BAIL; + return v.value === EMPTY_VALUE ? v.st : emit(v.value, v.st); + } if (h.runForEach !== undefined) return runNested(ops, r.vals, r.st, () => h.runForEach!(r.vals, r.st, ops, discard, emit)); const v = runNested(ops, r.vals, r.st, () => h.run(r.vals, r.st, ops, discard)); @@ -4619,7 +4674,7 @@ function compileImpTuple( let empty = false; for (const part of compiled) { const r = part.node(slots, cur, ops, true); - if (r === BAIL) return BAIL; + if (r === BAIL || isImpTail(r)) return BAIL; // tuple items are never tail positions if (r.value === EMPTY_VALUE) empty = true; cur = r.st; } @@ -4630,7 +4685,7 @@ function compileImpTuple( let empty = false; for (const part of compiled) { const r = part.node(slots, cur, ops); - if (r === BAIL) return BAIL; + if (r === BAIL || isImpTail(r)) return BAIL; // tuple items are never tail positions if (r.value === EMPTY_VALUE) empty = true; out.push(r.value); cur = r.st; @@ -4644,7 +4699,7 @@ function compileImpTuple( node, forEach: (slots, st, ops, discard, emit) => { const r = node(slots, st, ops, discard); - if (r === BAIL) return BAIL; + if (r === BAIL || isImpTail(r)) return BAIL; return r.value === EMPTY_VALUE ? r.st : emit(r.value, r.st); }, ...impMeta(compiled), @@ -4747,17 +4802,19 @@ function compileImperative(env: MinEnv, compiled: CompiledFns): void { for (const [f, body] of bodies) { const arity = cand.get(f)!.params.length; + holders.get(f)!.body = body; holders.get(f)!.run = (partAtoms, st, ops, discard) => { if (partAtoms.length !== arity || partAtoms.some((a) => !a.ground)) return BAIL; - // A self-call recurses natively (compileImpCall -> h.run -> body.node), so deep recursion grows the - // host stack exactly as the interpreter's does. A native stack overflow must PROPAGATE to the - // top-level `mettaEval` catch, which turns it into `(Error StackOverflow)` — byte-identical - // to the interpreter overflowing on the same call. Returning BAIL on a RangeError instead would fall - // back to the interpreter, which re-reduces one level and re-enters the compiled function for the - // rest, overflowing again: O(depth^2) bail+overflow that lets a StackOverflow escape. So catch only a - // thrown BAIL sentinel and let everything else (RangeError included) unwind. + // Tail calls come back as transfer sentinels and loop here (impDrive), so a deep tail-recursive + // chain runs iteratively and a runaway one cuts on fuel with `(Error StackOverflow)`, + // matching the interpreter's flat tail semantics. Non-tail recursion still grows the host stack; + // a native overflow must PROPAGATE to the top-level `mettaEval` catch, which turns it into the + // same error — returning BAIL on a RangeError instead would fall back to the interpreter, which + // re-reduces one level and re-enters the compiled function for the rest, overflowing again: + // O(depth^2) bail+overflow that lets a StackOverflow escape. So catch only a thrown BAIL + // sentinel and let everything else (RangeError included) unwind. try { - return body.node(partAtoms, addCounter(st, 1), ops, discard); + return impDrive(body.node(partAtoms, addCounter(st, 1), ops, discard), ops, discard); } catch (e) { if (e === BAIL) return BAIL; throw e; @@ -4905,7 +4962,7 @@ export function runCompiled( const runtimeOps = ops === undefined || depth === undefined ? ops - : { ...ops, evaluationDepth: depth, maxStackDepth: st.world.maxStackDepth }; + : { ...ops, evaluationDepth: depth, maxStackDepth: st.world.maxStackDepth, fuel }; const overflowResult = (error: EvaluationDepthOverflow, counterDelta = 0): CompiledRunResult => { const overflowState = error.state as St | undefined; return { diff --git a/packages/core/src/concurrency.test.ts b/packages/core/src/concurrency.test.ts index d62354b..e38bc62 100644 --- a/packages/core/src/concurrency.test.ts +++ b/packages/core/src/concurrency.test.ts @@ -30,7 +30,7 @@ afterEach(() => { describe("par", () => { it("evaluates branches concurrently and unions their results", async () => { - expect(await last("!(collapse (par (aw 3) (aw 4) (aw 2)))")).toEqual(["(, 3 4 2)"]); + expect(await last("!(collapse (par (aw 3) (aw 4) (aw 2)))")).toEqual(["(3 4 2)"]); }); it("runs concurrently (total time ~ slowest branch, not the sum)", async () => { @@ -45,7 +45,7 @@ describe("par", () => { !(par (add-atom &self (k 1)) (add-atom &self (k 2)) (add-atom &self (k 3))) !(collapse (match &self (k $v) $v)) `), - ).toEqual(["(, 1 2 3)"]); + ).toEqual(["(1 2 3)"]); }); }); @@ -64,7 +64,7 @@ describe("race / once", () => { !(race (let $x (aw 40) (add-atom &self (k slow))) (aw 2)) !(collapse (match &self (k $v) $v)) `); - expect(out).toEqual(["(,)"]); // empty tuple: (k slow) was never added; the loser was cancelled before its add-atom + expect(out).toEqual(["()"]); // empty tuple: (k slow) was never added; the loser was cancelled before its add-atom }); it("once cuts nondeterminism to the first result (and works synchronously)", async () => { diff --git a/packages/core/src/eval-depth.ts b/packages/core/src/eval-depth.ts index fb99236..c11aeff 100644 --- a/packages/core/src/eval-depth.ts +++ b/packages/core/src/eval-depth.ts @@ -7,6 +7,13 @@ import type { Atom } from "./atom"; /** Native recursion stays on the fast path below this logical user-call depth. */ export const EVALUATION_TRAMPOLINE_DEPTH = 32; +/** Hard cap on natively nested evaluation frames. Logical depth misses tail transfers (they + * reuse their level), so a long tail chain nests one native generator quartet per step; at + * roughly 340 bytes a frame the default Node stack fits about 250 of them. Handing off to the + * heap continuation driver at half that keeps headroom for grounded-op internals while leaving + * ordinary deep evaluation on the fast native path. */ +export const NATIVE_EVALUATION_NESTING_LIMIT = 128; + /** The default language-level call bound. Explicit `max-stack-depth 0` remains unlimited. */ export const DEFAULT_MAX_STACK_DEPTH = 320; @@ -56,6 +63,11 @@ export class EvaluationDepth { private observed: number; private readonly floor: number; private marker: ActiveEvaluationDepthSpan | undefined; + /** Native evaluation-frame nesting. Unlike `level`, this counts every frame descent, so a chain + * of tail transfers (which reuse their logical level) still raises it. The evaluator hands a + * branch to the heap continuation driver when this crosses the trampoline threshold, which is + * what keeps arbitrarily long tail loops off the JS stack. */ + private nativeLevel = 0; constructor(level = 0) { this.level = level; @@ -67,6 +79,18 @@ export class EvaluationDepth { return this.level; } + get native(): number { + return this.nativeLevel; + } + + enterNative(): void { + this.nativeLevel += 1; + } + + leaveNative(): void { + this.nativeLevel -= 1; + } + get maximum(): number { return this.observed; } diff --git a/packages/core/src/eval.ts b/packages/core/src/eval.ts index 94f4c50..6135d1b 100644 --- a/packages/core/src/eval.ts +++ b/packages/core/src/eval.ts @@ -80,9 +80,16 @@ import { EVALUATION_TRAMPOLINE_DEPTH, EvaluationDepth, type EvaluationDepthSpan, + NATIVE_EVALUATION_NESTING_LIMIT, } from "./eval-depth"; import { DEFAULT_MAX_STEPS } from "./eval-steps"; import { canCompactAtom, FlatAtomSpace } from "./flat-atomspace"; +import { + declareGroundedOperationEffect, + groundedOperationEffect, + type GroundedOperationEffect, + registeredBuiltinGroundedOperations, +} from "./grounded-extensions"; import { instantiate } from "./instantiate"; import { addVarBinding, matchAtoms, matchAtomsScoped, merge } from "./match"; import { addInt, type IntVal, subInt } from "./number"; @@ -104,6 +111,7 @@ import { analyzePurity as analyzePurityRef, analyzeTableWorth, functorCallCount, + inertArgumentPositions, IMPURE_OPS, isTablingImpureHead, keyWellFormed, @@ -212,14 +220,45 @@ async function runGenAsync(gen: Gen, signal?: AbortSignal): Promise { return r.value; } +function fuzzEffectDeniedAtom( + call: Atom, + effect: GroundedOperationEffect, + operation: string, +): Atom { + return expr([sym("Error"), call, expr([sym("FuzzEffectDenied"), sym(effect), sym(operation)])]); +} + +function fuzzSandboxDenies(env: MinEnv, effect: GroundedOperationEffect): boolean { + return env.fuzzEffectPolicy === "Sandboxed" && (effect === "Host" || effect === "AsyncHost"); +} + /** The grounded-operation boundary: a sync op returns immediately; an async op (in `env.agt`) yields its - * Promise, which the async driver awaits and the sync driver rejects. */ -function* callGroundedG(env: MinEnv, op: string, args: readonly Atom[]): Gen { + * Promise, which the async driver awaits and the sync driver rejects. A sandbox rejection is returned as + * data before the handler is called, so an untrusted handler cannot leak an effect and then report failure. */ +function* callGroundedG( + env: MinEnv, + call: Atom, + op: string, + args: readonly Atom[], +): Gen { const af = env.agt.get(op); if (af !== undefined) { + if (env.fuzzEffectPolicy === "Sandboxed") { + const effect = env.asyncGroundedEffects.get(op) ?? "AsyncHost"; + if (fuzzSandboxDenies(env, effect)) + return { tag: "ok", results: [fuzzEffectDeniedAtom(call, effect, op)] }; + } pendingAsyncOp = op; return (yield af(args)) as ReduceResult; } + const operation = env.gt.get(op); + if (operation === undefined) return { tag: "noReduce" }; + if (env.fuzzEffectPolicy === "Sandboxed") { + const effect = + env.groundedEffects.get(op) ?? (isTableSafeGroundedOp(op, operation) ? "Pure" : "Host"); + if (fuzzSandboxDenies(env, effect)) + return { tag: "ok", results: [fuzzEffectDeniedAtom(call, effect, op)] }; + } return callGrounded(env.gt, op, args); } @@ -280,8 +319,6 @@ const frame = ( const notReducibleA = sym("NotReducible"); const emptyA = sym("Empty"); -const collapsedEmptyA = expr([sym(",")]); -const collapsedEmptySpellings: readonly Atom[] = [emptyExpr, collapsedEmptyA]; const unitA = emptyExpr; const errAtom = (a: Atom, msg: string): Atom => expr([sym("Error"), a, sym(msg)]); const errTextAtom = (a: Atom, msg: string): Atom => expr([sym("Error"), a, gstr(msg)]); @@ -417,7 +454,40 @@ const EMBEDDED = new Set([ "race", "once", "with-mutex", + // Case-local evaluator used by @mettascript/fuzz. Its first argument is lazy. + "_fuzz-eval-case", ]); + +const WORLD_EMBEDDED_OPS: ReadonlySet = new Set([ + "evalc", + "context-space", + "match", + "get-type-space", + "new-state", + "get-state", + "change-state!", + "new-space", + "new-mork-space", + "fork-space", + "add-atom", + "remove-atom", + "get-atoms", + "bind!", + "pragma!", + // Reads world.logLevel, so it must not be treated as referentially transparent across pragma! changes. + "log-enabled?", + "transaction", +]); +const HOST_EMBEDDED_OPS: ReadonlySet = new Set(["import!"]); +const ASYNC_HOST_EMBEDDED_OPS: ReadonlySet = new Set(["par", "race", "with-mutex"]); + +function embeddedOperationEffect(op: string): GroundedOperationEffect { + if (ASYNC_HOST_EMBEDDED_OPS.has(op)) return "AsyncHost"; + if (HOST_EMBEDDED_OPS.has(op)) return "Host"; + if (WORLD_EMBEDDED_OPS.has(op)) return "World"; + return "Pure"; +} + function isEmbeddedOp(a: Atom): boolean { const op = opOf(a); return op !== undefined && EMBEDDED.has(op); @@ -462,8 +532,47 @@ function isDefinedHead(env: MinEnv, w: World, name: string): boolean { // Iterative (explicit-stack) term walk: a deep result term (e.g. the derivative of a deep product) would // otherwise recurse to the term's depth and overflow the host stack. Normal-form is an AND over every // subterm's head being an undefined symbol, so the visit order does not affect the result. +// +// The verdict is a pure function of the atom plus the visible rule tables: the env's static rule index, +// signatures, and grounded tables (mutated only through registration, which bumps groundedEpoch), the +// world's runtime rules (selfRuleVersion), and the static-removal log (append-only, so its object identity +// changes on every removal). Atoms are immutable and `instantiate` shares unchanged subterms, so a growing +// accumulator threaded through interpreter steps re-presents the same expression objects each step; without +// a cache this walk re-visits that shared structure once per step and a loop that only conses onto its +// state goes quadratic (measured 28.6s for 16k steps; the same identity-memo lineage as exprVarsCache). +// A node verified true covers its whole subtree; a false verdict is cached on the node whose head decided +// it and on the queried root. +interface NormalFormEntry { + readonly env: MinEnv; + readonly selfRuleVersion: number; + readonly removedStatic: unknown; + readonly groundedEpoch: number; + readonly res: boolean; +} +const normalFormCache = new WeakMap(); + +function normalFormEntry(env: MinEnv, w: World, res: boolean): NormalFormEntry { + return { + env, + selfRuleVersion: w.selfRuleVersion, + removedStatic: w.removedStatic, + groundedEpoch: env.groundedEpoch, + res, + }; +} + +function normalFormEntryValid(entry: NormalFormEntry, env: MinEnv, w: World): boolean { + return ( + entry.env === env && + entry.selfRuleVersion === w.selfRuleVersion && + entry.removedStatic === w.removedStatic && + entry.groundedEpoch === env.groundedEpoch + ); +} + function isNormalForm(env: MinEnv, w: World, t: Atom): boolean { const stack: Atom[] = [t]; + const verified: Atom[] = []; while (stack.length > 0) { const cur = stack.pop()!; switch (cur.kind) { @@ -471,18 +580,37 @@ function isNormalForm(env: MinEnv, w: World, t: Atom): boolean { case "gnd": break; case "sym": - if (isDefinedHead(env, w, cur.name)) return false; + if (isDefinedHead(env, w, cur.name)) { + if (t.kind === "expr") normalFormCache.set(t, normalFormEntry(env, w, false)); + return false; + } break; case "expr": { const its = cur.items; if (its.length === 0) break; + const cached = normalFormCache.get(cur); + if (cached !== undefined && normalFormEntryValid(cached, env, w)) { + if (cached.res) break; + if (t.kind === "expr" && t !== cur) normalFormCache.set(t, cached); + return false; + } const h = its[0]!; - if (h.kind !== "sym" || isDefinedHead(env, w, h.name)) return false; + if (h.kind !== "sym" || isDefinedHead(env, w, h.name)) { + const entry = normalFormEntry(env, w, false); + normalFormCache.set(cur, entry); + if (t.kind === "expr" && t !== cur) normalFormCache.set(t, entry); + return false; + } + verified.push(cur); for (let i = 1; i < its.length; i++) stack.push(its[i]!); break; } } } + if (verified.length > 0) { + const entry = normalFormEntry(env, w, true); + for (const node of verified) normalFormCache.set(node, entry); + } return true; } @@ -544,28 +672,134 @@ function exprRuleHeadSyms(varRules: ReadonlyArray<[Atom, Atom]>): ReadonlySet(); + +function standardQuoteOnly(env: MinEnv, w: World): boolean { + const cached = standardQuoteCache.get(env); + if ( + cached !== undefined && + cached.selfRuleVersion === w.selfRuleVersion && + cached.removedStatic === w.removedStatic + ) + return cached.res; + let res = false; + if (!w.selfRules.has("quote")) { + const rules = visibleStaticRulesForHead(env, w, "quote"); + if (rules.length === 1) { + const [lhs, rhs] = rules[0]!; + res = format(lhs) === "(quote $atom)" && format(rhs) === "NotReducible"; + } + } + standardQuoteCache.set(env, { + selfRuleVersion: w.selfRuleVersion, + removedStatic: w.removedStatic, + res, + }); + return res; +} + +// A head is reducibly defined when an equation or an implementation can actually rewrite it. A bare +// type signature is not that: a sig-only head is a constructor, whose application either type-checks +// (and then evaluates to itself, subterms aside) or is pruned/errored by the type layer. Typing +// constructors is the normal MeTTa idiom, so treating every sig as reducible would deny inertness to +// exactly the structures programs hold most (typed result and state records). +function reduciblyDefinedHead(env: MinEnv, w: World, name: string): boolean { + return ( + hasVisibleStaticRuleHead(env, w, name) || + w.selfRules.has(name) || + env.gt.has(name) || + env.agt.has(name) || + IMPURE_OPS.has(name) + ); +} + +// Inert verdicts also depend on the type tables (a constructor application is inert only while its +// arguments type-check), so entries carry the space version beside the rule-table signature. +interface InertEntry extends NormalFormEntry { + readonly spaceVersion: number; +} +const inertDataCache = new WeakMap(); + +function inertEntry(env: MinEnv, w: World, res: boolean): InertEntry { + return { ...normalFormEntry(env, w, res), spaceVersion: w.spaceVersion }; +} + +function inertEntryValid(entry: InertEntry, env: MinEnv, w: World): boolean { + return normalFormEntryValid(entry, env, w) && entry.spaceVersion === w.spaceVersion; +} + function isInertData(env: MinEnv, w: World, t: Atom, exprHeads: ReadonlySet): boolean { - switch (t.kind) { - case "var": - case "gnd": - return true; - case "sym": - return !isDefinedHead(env, w, t.name); - case "expr": { - const its = t.items; - if (its.length === 0) return true; - const h = its[0]!; - if (h.kind === "sym") { - if (isDefinedHead(env, w, h.name)) return false; - } else if (h.kind === "expr" && h.items.length > 0) { - const hh = h.items[0]!; - if (hh.kind === "sym" && exprHeads.has(hh.name)) return false; + const quoteInert = standardQuoteOnly(env, w); + const stack: Atom[] = [t]; + const verified: Atom[] = []; + const fail = (deciding: Atom): false => { + const entry = inertEntry(env, w, false); + if (deciding.kind === "expr") inertDataCache.set(deciding, entry); + if (t.kind === "expr" && t !== deciding) inertDataCache.set(t, entry); + return false; + }; + while (stack.length > 0) { + const cur = stack.pop()!; + switch (cur.kind) { + case "var": + case "gnd": + break; + case "sym": + if (reduciblyDefinedHead(env, w, cur.name)) return fail(cur); + break; + case "expr": { + const its = cur.items; + if (its.length === 0) break; + const cached = inertDataCache.get(cur); + if (cached !== undefined && inertEntryValid(cached, env, w)) { + if (cached.res) break; + if (t.kind === "expr" && t !== cur) inertDataCache.set(t, cached); + return false; + } + const h = its[0]!; + if (h.kind === "sym") { + if (quoteInert && h.name === "quote" && its.length === 2) { + verified.push(cur); + break; + } + if (reduciblyDefinedHead(env, w, h.name)) return fail(cur); + const sigs = env.sigs.get(h.name); + if (sigs !== undefined) { + const args = its.slice(1); + if ( + checkApplication(env, w, h.name, args, sigs) !== null || + typeMismatch(env, w, h.name, args, sigs) !== undefined + ) + return fail(cur); + } + } else if (h.kind === "expr" && h.items.length > 0) { + const hh = h.items[0]!; + if (hh.kind === "sym" && exprHeads.has(hh.name)) return fail(cur); + } + verified.push(cur); + for (let i = 0; i < its.length; i++) stack.push(its[i]!); + break; } - for (let i = 0; i < its.length; i++) - if (!isInertData(env, w, its[i]!, exprHeads)) return false; - return true; } } + if (verified.length > 0) { + const entry = inertEntry(env, w, true); + for (const node of verified) inertDataCache.set(node, entry); + } + return true; } // ---------- atom_to_stack ---------- @@ -629,6 +863,12 @@ export interface MinEnv { exprTypes: Array<[Atom, Atom]>; /** Async grounded operations, dispatched by the async runner; empty for pure synchronous evaluation. */ agt: Map; + /** Effect declarations for named sync and async grounded operations. Missing sync declarations are + * treated as Host and missing async declarations as AsyncHost by the fuzz sandbox. */ + groundedEffects: Map; + asyncGroundedEffects: Map; + /** Active case-local effect policy. Undefined during ordinary evaluation. */ + fuzzEffectPolicy?: "Sandboxed" | "ExternalEffects" | undefined; /** Optional host-language import hook used by async `import!` for files outside the MeTTa import map. */ hostImport?: HostImportFn; /** Optional opt-in execution trace sink. `undefined` when tracing is off, so emit sites cost one branch. @@ -659,20 +899,20 @@ export interface MinEnv { /** Positive only while an idempotent unique(collapse ...) consumer evaluates a proven-pure ground call. */ distinctGroundDepth?: number | undefined; /** Functor names proven tabling-safe by `analyzePurity`; recomputed when equations change. */ - pureFunctors?: Set; + pureFunctors?: Set | undefined; /** Functor names proven safe for MODED tabling by `analyzePurity(env, MODED_IMPURE_OPS)` — a superset of * `pureFunctors` (only `empty`, which is genuinely pure, is treated more permissively); recomputed * alongside it. */ - modedPureFunctors?: Set; + modedPureFunctors?: Set | undefined; /** Functor names whose only permitted atom-space dependency is `match`; their table keys include the * current space-content version. */ - spaceReadPureFunctors?: Set; + spaceReadPureFunctors?: Set | undefined; /** Pure functors whose rule SCC has branching recursion, so ground tabling is likely useful. */ - tableWorth?: Set; + tableWorth?: Set | undefined; /** Pure functors whose rule SCC has branching recursion under the moded purity rules. */ - modedTableWorth?: Set; + modedTableWorth?: Set | undefined; /** Space-read-pure functors whose rule SCC has branching recursion. */ - spaceReadTableWorth?: Set; + spaceReadTableWorth?: Set | undefined; /** Set when equations changed and the purity/profitability analysis must be refreshed before evaluation. */ tablingDirty?: boolean | undefined; /** Memo for `getTypes` of ground atoms: a ground atom's type is a pure function of the env's type tables, @@ -684,9 +924,14 @@ export interface MinEnv { * a branch that errored or (under firstOnly) lost the race. It re-evaluates each branch from the program's * rules in a worker, so it is only used when a branch is pure and the space carries no runtime additions, * so it is identical to evaluating in line. */ - parEval?: (branchSrcs: string[], firstOnly: boolean) => (Atom[] | null)[]; + parEval?: ((branchSrcs: string[], firstOnly: boolean) => (Atom[] | null)[]) | undefined; /** Async host-worker equivalent, used by browser Web Workers and other non-blocking hosts. */ - parEvalAsync?: (branchSrcs: string[], firstOnly: boolean) => Promise<(Atom[] | null)[]>; + parEvalAsync?: + | ((branchSrcs: string[], firstOnly: boolean) => Promise<(Atom[] | null)[]>) + | undefined; + /** Bumped whenever a grounded operation is registered onto this env, so identity-keyed caches that + * read `gt`/`agt` (the normal-form verdict cache) can tell a mutated table from the one they saw. */ + groundedEpoch: number; /** Compiled pure deterministic functions (the int/bool functional core); undefined when disabled. */ compiled?: CompiledFns | undefined; /** Set when an equation changed, so the compiler re-runs before the next query. */ @@ -1013,18 +1258,40 @@ function addGroundedOperationType(env: MinEnv, name: string, op: GroundFn): void /** An empty environment for grounding table `gt`. Grow it with `addAtomToEnv`. */ export function emptyEnv(gt: GroundingTable): MinEnv { + const registered = registeredBuiltinGroundedOperations(); + const operations = gt; + for (const entry of registered) { + const existing = operations.get(entry.name); + if (existing !== undefined && existing !== entry.operation) + throw new Error( + `built-in grounded operation '${entry.name}' shadows an environment operation`, + ); + operations.set(entry.name, entry.operation); + } + const groundedEffects = new Map(); + for (const [name, operation] of operations) + groundedEffects.set( + name, + groundedOperationEffect(operation) ?? + (isTableSafeGroundedOp(name, operation) ? "Pure" : "Host"), + ); + for (const entry of registered) groundedEffects.set(entry.name, entry.effect); const env: MinEnv = { ruleIndex: new Map(), varRules: [], varRulesVar: [], sigs: new Map(), - gt, + gt: operations, atoms: new StaticAtomStore(), types: new Map(), imports: new Map(), loadedModules: new Map(), exprTypes: [], agt: new Map(), + groundedEffects, + groundedEpoch: 0, + asyncGroundedEffects: new Map(), + fuzzEffectPolicy: undefined, mutexes: new Map(), evaluatedAtoms: new WeakSet(), factIndex: new Map(), @@ -1041,7 +1308,7 @@ export function emptyEnv(gt: GroundingTable): MinEnv { useMatchEvalMark: true, useDirectMatch: true, }; - for (const [name, op] of gt) addGroundedOperationType(env, name, op); + for (const [name, op] of operations) addGroundedOperationType(env, name, op); return env; } @@ -1068,6 +1335,7 @@ function invalidateTabling(env: MinEnv): void { } function invalidateGroundedRegistration(env: MinEnv): void { + env.groundedEpoch += 1; env.evaluatedAtoms = new WeakSet(); invalidateTabling(env); // Compiled nodes inline the standard grounded arithmetic and comparison semantics. A host can replace @@ -1078,15 +1346,28 @@ function invalidateGroundedRegistration(env: MinEnv): void { } /** Register a sync grounded operation and invalidate analyses that may have classified its name. */ -export function registerGroundedOperation(env: MinEnv, name: string, op: GroundFn): void { +export function registerGroundedOperation( + env: MinEnv, + name: string, + op: GroundFn, + effect: GroundedOperationEffect = "Host", +): void { env.gt.set(name, op); + env.groundedEffects.set(name, effect); + declareGroundedOperationEffect(op, effect); addGroundedOperationType(env, name, op); invalidateGroundedRegistration(env); } /** Register an async grounded operation and invalidate analyses that may have classified its name. */ -export function registerAsyncGroundedOperation(env: MinEnv, name: string, op: AsyncGroundFn): void { +export function registerAsyncGroundedOperation( + env: MinEnv, + name: string, + op: AsyncGroundFn, + effect: GroundedOperationEffect = "AsyncHost", +): void { env.agt.set(name, op); + env.asyncGroundedEffects.set(name, effect); invalidateGroundedRegistration(env); } @@ -1604,6 +1885,8 @@ function namedSpaceEnv(env: MinEnv, w: World, name: string): MinEnv { const view = buildEnv(namedSpaceAtoms(w.spaces.get(name)), env.gt); view.imports = env.imports; view.loadedModules = env.loadedModules; + view.groundedEffects = new Map(env.groundedEffects); + view.asyncGroundedEffects = new Map(env.asyncGroundedEffects); if (env.intern !== undefined) view.intern = env.intern; return view; } @@ -1851,6 +2134,16 @@ function spaceName(w: World, a: Atom): string | undefined { const r = resolveTok(w, a); return r.kind === "sym" ? r.name : undefined; } +// Comparison ops with Hyperon's value semantics for state atoms: `(== (new-state 1) (new-state 1))` +// is True there, so these (and only these) grounded ops receive state-resolved arguments. +const stateValueCompareOps: ReadonlySet = new Set([ + "==", + "_assert-results-are-equal", + "_assert-results-are-equal-msg", + "_assert-results-are-alpha-equal", + "_assert-results-are-alpha-equal-msg", +]); + function resolveStates(w: World, a: Atom): Atom { if (w.store.size === 0) return a; // no state cells: identity, skip the tree clone (hot path) if (a.kind === "expr") { @@ -2082,7 +2375,7 @@ function* evalOpG(env: MinEnv, st: St, prev: Stack, x: Atom, b: Bindings): Gen<[ const namedMatch = tryFastNamedOnceMatch(env, st, match, b); if (namedMatch !== undefined) { const items = namedMatch.value === undefined ? [] : [namedMatch.value]; - return [[evalResult(prev, expr([sym(","), ...items]), b)], namedMatch.state]; + return [[evalResult(prev, expr(items), b)], namedMatch.state]; } } } @@ -2100,12 +2393,23 @@ function* evalOpG(env: MinEnv, st: St, prev: Stack, x: Atom, b: Bindings): Gen<[ x2.kind === "expr" && !(pettaOpNames.has(op) && hasRuleFor(env, st.world, st.counter, x2)); if (useGrounded) { + // Grounded arguments keep `(State n)` handles intact: Hyperon passes state atoms opaquely + // through structure, so `(cons-atom $handle ())` must yield the handle, not its content. + // Equality is the exception — Hyperon's state atoms compare by their current value, so the + // world-blind comparison ops get state-resolved arguments. Space reads and match patterns + // still resolve states (the live-state-in-space feature); `get-state`/`change-state!` + // dereference explicitly as special forms. + const resolveForOp = stateValueCompareOps.has(op!) && st.world.store.size !== 0; let args = x2.items .slice(1) - .map((a) => resolveStates(st.world, subTokens(st.world, a, env.intern))); + .map((a) => + resolveForOp + ? resolveStates(st.world, subTokens(st.world, a, env.intern)) + : subTokens(st.world, a, env.intern), + ); if (op === "repr" && args.length === 1) args = [partialApplicationView(env, st.world, args[0]!)]; - const r = yield* callGroundedG(env, op!, args); + const r = yield* callGroundedG(env, x2, op!, args); if (r.tag === "ok") { const effects = applyReduceEffects(env, st, b, r.effects); if (effects.tag === "error") return [[finItem(prev, errAtom(x2, effects.msg), b)], st]; @@ -2122,9 +2426,9 @@ function* evalOpG(env: MinEnv, st: St, prev: Stack, x: Atom, b: Bindings): Gen<[ if (x2.kind === "expr" && x2.items.length > 0) { const head = x2.items[0]!; if (head.kind === "gnd" && head.exec !== undefined) { - const args = x2.items - .slice(1) - .map((a) => resolveStates(st.world, subTokens(st.world, a, env.intern))); + if (fuzzSandboxDenies(env, "Host")) + return [[finItem(prev, fuzzEffectDeniedAtom(x2, "Host", ""), b)], st]; + const args = x2.items.slice(1).map((a) => subTokens(st.world, a, env.intern)); try { const results = head.exec(args); if (results instanceof Promise) { @@ -2231,6 +2535,192 @@ function containsResourceLimit(a: Atom): boolean { return false; } +function nonnegativeSafeInteger(atom: Atom): number | undefined { + if (atom.kind !== "gnd" || atom.value.g !== "int") return undefined; + const value = atom.value.n; + if (typeof value === "number") + return Number.isSafeInteger(value) && value >= 0 ? value : undefined; + return value >= 0n && value <= BigInt(Number.MAX_SAFE_INTEGER) ? Number(value) : undefined; +} + +function directFuzzEffectDeniedReason( + atom: Atom, +): { readonly effect: GroundedOperationEffect; readonly operation: string } | undefined { + if ( + atom.kind !== "expr" || + atom.items.length !== 3 || + atom.items[0]!.kind !== "sym" || + atom.items[0]!.name !== "Error" + ) + return undefined; + const reason = atom.items[2]!; + if ( + reason.kind !== "expr" || + reason.items.length !== 3 || + reason.items[0]!.kind !== "sym" || + reason.items[0]!.name !== "FuzzEffectDenied" || + reason.items[1]!.kind !== "sym" || + reason.items[2]!.kind !== "sym" + ) + return undefined; + const effect = reason.items[1]!.name; + if (effect !== "Pure" && effect !== "World" && effect !== "Host" && effect !== "AsyncHost") + return undefined; + return { effect, operation: reason.items[2]!.name }; +} + +function fuzzEffectDeniedReason( + atom: Atom, +): { readonly effect: GroundedOperationEffect; readonly operation: string } | undefined { + const pending = [atom]; + while (pending.length > 0) { + const next = pending.pop()!; + const denied = directFuzzEffectDeniedReason(next); + if (denied !== undefined) return denied; + if (next.kind === "expr") + for (let i = next.items.length - 1; i >= 0; i--) pending.push(next.items[i]!); + } + return undefined; +} + +function containsStackOverflow(atom: Atom): boolean { + const pending = [atom]; + while (pending.length > 0) { + const next = pending.pop()!; + if (isStackOverflowAtom(next)) return true; + if (next.kind === "expr") for (const item of next.items) pending.push(item); + } + return false; +} + +function fuzzCaseStatus(results: readonly Atom[]): Atom { + for (const result of results) { + const denied = fuzzEffectDeniedReason(result); + if (denied !== undefined) + return expr([sym("EffectDenied"), sym(denied.effect), sym(denied.operation)]); + } + for (const result of results) { + if (containsResourceLimit(result)) return sym("ResourceLimit"); + if (containsStackOverflow(result)) return sym("StackOverflow"); + } + return sym("Completed"); +} + +interface FuzzEnvironmentSnapshot { + readonly sigs: MinEnv["sigs"]; + readonly types: MinEnv["types"]; + readonly exprTypes: MinEnv["exprTypes"]; + readonly loadedModules: MinEnv["loadedModules"]; + readonly typeCache: MinEnv["typeCache"]; + readonly tableSpace: MinEnv["tableSpace"]; + readonly distinctGroundDepth: MinEnv["distinctGroundDepth"]; + readonly pureFunctors: MinEnv["pureFunctors"]; + readonly modedPureFunctors: MinEnv["modedPureFunctors"]; + readonly spaceReadPureFunctors: MinEnv["spaceReadPureFunctors"]; + readonly tableWorth: MinEnv["tableWorth"]; + readonly modedTableWorth: MinEnv["modedTableWorth"]; + readonly spaceReadTableWorth: MinEnv["spaceReadTableWorth"]; + readonly tablingDirty: MinEnv["tablingDirty"]; + readonly evaluatedAtoms: MinEnv["evaluatedAtoms"]; + readonly compiled: MinEnv["compiled"]; + readonly compileDirty: MinEnv["compileDirty"]; + readonly compiledComplete: MinEnv["compiledComplete"]; + readonly mutexes: MinEnv["mutexes"]; + readonly trace: MinEnv["trace"]; + readonly parEval: MinEnv["parEval"]; + readonly parEvalAsync: MinEnv["parEvalAsync"]; + readonly fuzzEffectPolicy: MinEnv["fuzzEffectPolicy"]; +} + +/** Isolate evaluator-owned mutable caches and import metadata for one case. + * + * World data is isolated separately through copy-on-write. The extra snapshot matters when a case adds a + * runtime equation: that invalidates compilation and tabling on MinEnv even though the equation itself is + * stored in World. + */ +function isolateFuzzEnvironment(env: MinEnv, policy: "Sandboxed" | "ExternalEffects"): () => void { + const snapshot: FuzzEnvironmentSnapshot = { + sigs: env.sigs, + types: env.types, + exprTypes: env.exprTypes, + loadedModules: env.loadedModules, + typeCache: env.typeCache, + tableSpace: env.tableSpace, + distinctGroundDepth: env.distinctGroundDepth, + pureFunctors: env.pureFunctors, + modedPureFunctors: env.modedPureFunctors, + spaceReadPureFunctors: env.spaceReadPureFunctors, + tableWorth: env.tableWorth, + modedTableWorth: env.modedTableWorth, + spaceReadTableWorth: env.spaceReadTableWorth, + tablingDirty: env.tablingDirty, + evaluatedAtoms: env.evaluatedAtoms, + compiled: env.compiled, + compileDirty: env.compileDirty, + compiledComplete: env.compiledComplete, + mutexes: env.mutexes, + trace: env.trace, + parEval: env.parEval, + parEvalAsync: env.parEvalAsync, + fuzzEffectPolicy: env.fuzzEffectPolicy, + }; + + env.sigs = new Map(env.sigs); + env.types = new Map(env.types); + env.exprTypes = [...env.exprTypes]; + env.loadedModules = new Map( + [...env.loadedModules].map(([space, modules]) => [space, new Set(modules)]), + ); + env.typeCache = undefined; + env.tableSpace = env.tableSpace === undefined ? undefined : new TableSpace(); + env.distinctGroundDepth = undefined; + env.pureFunctors = env.pureFunctors === undefined ? undefined : new Set(env.pureFunctors); + env.modedPureFunctors = + env.modedPureFunctors === undefined ? undefined : new Set(env.modedPureFunctors); + env.spaceReadPureFunctors = + env.spaceReadPureFunctors === undefined ? undefined : new Set(env.spaceReadPureFunctors); + env.tableWorth = env.tableWorth === undefined ? undefined : new Set(env.tableWorth); + env.modedTableWorth = + env.modedTableWorth === undefined ? undefined : new Set(env.modedTableWorth); + env.spaceReadTableWorth = + env.spaceReadTableWorth === undefined ? undefined : new Set(env.spaceReadTableWorth); + env.evaluatedAtoms = new WeakSet(); + env.compiled = env.compiled === undefined ? undefined : new Map(env.compiled); + env.mutexes = new Map(); + env.fuzzEffectPolicy = policy; + if (policy === "Sandboxed") { + env.trace = undefined; + env.parEval = undefined; + env.parEvalAsync = undefined; + } + + return () => { + env.sigs = snapshot.sigs; + env.types = snapshot.types; + env.exprTypes = snapshot.exprTypes; + env.loadedModules = snapshot.loadedModules; + env.typeCache = snapshot.typeCache; + env.tableSpace = snapshot.tableSpace; + env.distinctGroundDepth = snapshot.distinctGroundDepth; + env.pureFunctors = snapshot.pureFunctors; + env.modedPureFunctors = snapshot.modedPureFunctors; + env.spaceReadPureFunctors = snapshot.spaceReadPureFunctors; + env.tableWorth = snapshot.tableWorth; + env.modedTableWorth = snapshot.modedTableWorth; + env.spaceReadTableWorth = snapshot.spaceReadTableWorth; + env.tablingDirty = snapshot.tablingDirty; + env.evaluatedAtoms = snapshot.evaluatedAtoms; + env.compiled = snapshot.compiled; + env.compileDirty = snapshot.compileDirty; + env.compiledComplete = snapshot.compiledComplete; + env.mutexes = snapshot.mutexes; + env.trace = snapshot.trace; + env.parEval = snapshot.parEval; + env.parEvalAsync = snapshot.parEvalAsync; + env.fuzzEffectPolicy = snapshot.fuzzEffectPolicy; + }; +} + function stepLimitReached(st: St): boolean { const { maxSteps, stepStart } = st.world; return maxSteps > 0 && st.counter - stepStart >= maxSteps; @@ -2354,10 +2844,31 @@ function queryVarsOf(args: readonly Atom[]): readonly string[] { for (const a of args) if (!a.ground) out.push(...atomVars(a)); return out; } +// The variables of every pending frame AFTER resolving through `b`: a var `b` binds contributes its +// resolved value's variables, an unbound one contributes itself. Computed on the raw frame atoms by +// expanding names through the binding instead of instantiating each frame: a frame that embeds a large +// accumulator made every metta-thread (so every constructor-subterm evaluation) pay O(state) just to +// read variable names — the same disease fd574b8 cured for chain steps. Frame atoms and resolved values +// hit the identity-cached atomVarsOf, and ground values contribute nothing, so the walk is O(live set). function scopeVars(env: MinEnv, b: Bindings, prev: Stack): string[] { const out: string[] = []; const seen = new Set(); - for (let p = prev; p !== null; p = p.tail) collectVars(inst(env, b, p.head.atom), out, seen); + const visited = new Set(); + const pending: string[] = []; + for (let p = prev; p !== null; p = p.tail) collectVars(p.head.atom, pending, visited); + const memo = new Map(); + while (pending.length > 0) { + const name = pending.pop()!; + const value = resolveBoundVarFix(env, b, name, memo); + if (value === undefined || (value.kind === "var" && value.name === name)) { + if (!seen.has(name)) { + seen.add(name); + out.push(name); + } + continue; + } + collectVars(value, pending, visited); + } return out; } function chainLiveVars(template: Atom, name: string, value: Atom, prev: Stack): string[] { @@ -2711,10 +3222,10 @@ export function checkApplication( /** The superpose/hyperpose argument policy. Hyperon 0.2.10 never evaluates the argument tuple: it splits * the raw expression and evaluates each ELEMENT as a result, so `(superpose (+ - *))` enumerates the * three operators as data. PeTTa instead evaluates the argument and splits the value, which computed - * tuples rely on: `(superpose (cdr-atom (collapse (match …))))` must reduce before splitting. The engine - * reconciles the two: an argument that is a well-typed call keeps the evaluate-then-split path, while a - * tuple whose head cannot be applied (a type or arity error — operators carried as data) is enumerated - * raw, matching Hyperon. Runtime errors from well-typed calls still evaluate and propagate as errors. + * tuples rely on. The engine reconciles the two: an argument that is a well-typed call keeps the + * evaluate-then-split path, while a tuple whose head cannot be applied (a type or arity error; operators + * carried as data) is enumerated raw, matching Hyperon. Runtime errors from well-typed calls still + * evaluate and propagate as errors. * `hyperpose`'s concurrent path (`hyperposeBranchSources`) already forks the raw items, so this also * converges its sequential fallback with the parallel branches. `collapse-extract` (LeaTTa's bag * spread) is unaffected and always evaluates. */ @@ -2987,9 +3498,11 @@ function* sealedTemplatesG( let nextTemplate = tmpl; for (let i = 0; i < items.length; i++) { cur = { counter: cur.counter + 1, world: cur.world }; - const sealedResult = yield* callGroundedG(env, "sealed", [makeExpr(env, [v]), nextTemplate]); + const call = makeExpr(env, [sym("sealed"), makeExpr(env, [v]), nextTemplate]); + const sealedResult = yield* callGroundedG(env, call, "sealed", call.items.slice(1)); if (sealedResult.tag !== "ok" || sealedResult.results.length !== 1) return undefined; const nextSealed = sealedResult.results[0]!; + if (isErrorAtom(nextSealed)) return undefined; sealed.push(nextSealed); nextTemplate = nextSealed; } @@ -3922,6 +4435,11 @@ function* interpretStack1G( const a = top.atom; const op = opOf(a); const it2 = a.kind === "expr" ? a.items : []; + if (env.fuzzEffectPolicy === "Sandboxed" && op !== undefined) { + const effect = embeddedOperationEffect(op); + if (fuzzSandboxDenies(env, effect)) + return [[finItem(prev, fuzzEffectDeniedAtom(inst(env, it.bnd, a), effect, op), it.bnd)], st]; + } switch (op) { case "eval": if (it2.length === 2) return yield* evalOpG(env, st, prev, it2[1]!, it.bnd); @@ -4072,6 +4590,97 @@ function* interpretStack1G( st2, ]; } + case "_fuzz-eval-case": { + if (it2.length !== 5) break; + const call = inst(env, it.bnd, a); + const requestedSteps = nonnegativeSafeInteger(inst(env, it.bnd, it2[2]!)); + const requestedDepth = nonnegativeSafeInteger(inst(env, it.bnd, it2[3]!)); + const policyAtom = inst(env, it.bnd, it2[4]!); + const policy = + policyAtom.kind === "sym" && + (policyAtom.name === "Sandboxed" || policyAtom.name === "ExternalEffects") + ? policyAtom.name + : undefined; + if (requestedSteps === undefined) + return [ + [finItem(prev, errAtom(call, "fuzz case steps must be a nonnegative integer"), it.bnd)], + st, + ]; + if (requestedDepth === undefined) + return [ + [finItem(prev, errAtom(call, "fuzz case depth must be a nonnegative integer"), it.bnd)], + st, + ]; + if (policy === undefined) + return [[finItem(prev, errAtom(call, "unknown fuzz effect policy"), it.bnd)], st]; + if (env.fuzzEffectPolicy === "Sandboxed" && policy === "ExternalEffects") + return [ + [finItem(prev, errAtom(call, "fuzz effect policy cannot be escalated"), it.bnd)], + st, + ]; + + const snapshotWorld = st.world; + const outerStepsRemaining = + snapshotWorld.maxSteps === 0 + ? undefined + : Math.max(0, snapshotWorld.maxSteps - (st.counter - snapshotWorld.stepStart)); + if (outerStepsRemaining === 0) { + const limited = resourceLimitAtom(env, inst(env, it.bnd, it2[1]!)); + const outcome = makeExpr(env, [ + sym("FuzzCaseOutcome"), + sym("ResourceLimit"), + makeExpr(env, [limited]), + gint(0), + ]); + return [[finItem(prev, outcome, it.bnd)], st]; + } + + const caseWorld = cloneWorld(snapshotWorld); + caseWorld.stepStart = st.counter; + caseWorld.maxSteps = + outerStepsRemaining === undefined + ? requestedSteps + : requestedSteps === 0 + ? outerStepsRemaining + : Math.min(requestedSteps, outerStepsRemaining); + const caseDepth = depth.fork(); + const requestedDepthLimit = requestedDepth === 0 ? 0 : caseDepth.current + requestedDepth; + caseWorld.maxStackDepth = + snapshotWorld.maxStackDepth === 0 + ? requestedDepthLimit + : requestedDepthLimit === 0 + ? snapshotWorld.maxStackDepth + : Math.min(snapshotWorld.maxStackDepth, requestedDepthLimit); + const restoreEnvironment = isolateFuzzEnvironment(env, policy); + let pairs: Array<[Atom, Bindings]>; + let caseState: St; + try { + [pairs, caseState] = yield* mettaEvalG( + env, + fuel, + { counter: st.counter, world: caseWorld }, + it.bnd, + it2[1]!, + caseDepth, + trampoline, + ); + } finally { + restoreEnvironment(); + depth.absorb(caseDepth); + } + + const results = pairs.map(([result, bindings]) => inst(env, bindings, result)); + const outcome = makeExpr(env, [ + sym("FuzzCaseOutcome"), + fuzzCaseStatus(results), + makeExpr(env, results), + gint(BigInt(Math.max(0, caseState.counter - st.counter))), + ]); + return [ + [finItem(prev, outcome, it.bnd)], + { counter: caseState.counter, world: snapshotWorld }, + ]; + } // TS-native extension. `(transaction )` evaluates the body and atomically commits its // space mutations only if the body succeeds. Because the world is threaded copy-on-write // (cloneWorld -> new St), commit/rollback is snapshot-and-restore: keep the body's world on @@ -4749,8 +5358,8 @@ function matchFromEmptyCollapseCheck(a: Atom): ExprAtom | undefined { x.kind === "expr" && opOf(x) === "collapse" && x.items.length === 2 ? matchInsideOnce(x.items[1]!) : undefined; - if (collapsedEmptySpellings.some((e) => atomEq(left, e))) return collapseArg(right); - if (collapsedEmptySpellings.some((e) => atomEq(right, e))) return collapseArg(left); + if (atomEq(left, emptyExpr)) return collapseArg(right); + if (atomEq(right, emptyExpr)) return collapseArg(left); return undefined; } @@ -6103,7 +6712,7 @@ function runtimeFunctorTableWorth( if (cached !== undefined) return cached; const targets = new Set([op]); const directBranching = [...(env.ruleIndex.get(op) ?? []), ...(w.selfRules.get(op) ?? [])].some( - ([, rhs]) => functorCallCount(rhs, targets) >= 2, + ([, rhs]) => functorCallCount(rhs, targets, inertArgumentPositions(env)) >= 2, ); const worth = staticWorth || directBranching; runtimeTableWorthCache.set(ck, worth); @@ -6112,11 +6721,63 @@ function runtimeFunctorTableWorth( type CompletedTableKey = TableKey; +// Tabling admission re-checks the same immutable call arguments as an accumulator grows across +// steps; without a cache this walk re-visits a shared large argument once per call, which turns a +// worklist whose analyses each table-check a few calls into O(state) per call. The verdict depends +// only on the atom, the impure-op set, and the grounded tables (mutated only through registration, +// which bumps groundedEpoch), so it is cached by node identity like the normal-form verdict. A node +// verified clean covers its whole subtree; a containing verdict lands on the queried root. +interface ImpureHeadEntry { + readonly env: MinEnv; + readonly groundedEpoch: number; + readonly perSet: Map, boolean>; +} +const impureHeadCache = new WeakMap(); + +function impureHeadEntryFor(env: MinEnv, a: Atom): ImpureHeadEntry { + const cached = impureHeadCache.get(a); + if (cached !== undefined && cached.env === env && cached.groundedEpoch === env.groundedEpoch) + return cached; + const fresh: ImpureHeadEntry = { env, groundedEpoch: env.groundedEpoch, perSet: new Map() }; + impureHeadCache.set(a, fresh); + return fresh; +} + function containsImpureHead(env: MinEnv, a: Atom, impureOps: ReadonlySet): boolean { if (a.kind !== "expr" || a.items.length === 0) return false; - const h = a.items[0]!; - if (h.kind === "sym" && isTablingImpureHead(env, h.name, impureOps)) return true; - return a.items.some((it) => containsImpureHead(env, it, impureOps)); + const rootEntry = impureHeadEntryFor(env, a); + const rootCached = rootEntry.perSet.get(impureOps); + if (rootCached !== undefined) return rootCached; + const stack: Atom[] = [a]; + const verifiedClean: Atom[] = []; + let contains = false; + while (stack.length > 0) { + const cur = stack.pop()!; + if (cur.kind !== "expr" || cur.items.length === 0) continue; + const cached = impureHeadCache.get(cur); + if (cached !== undefined && cached.env === env && cached.groundedEpoch === env.groundedEpoch) { + const verdict = cached.perSet.get(impureOps); + if (verdict === false) continue; + if (verdict === true) { + contains = true; + break; + } + } + const h = cur.items[0]!; + if (h.kind === "sym" && isTablingImpureHead(env, h.name, impureOps)) { + impureHeadEntryFor(env, cur).perSet.set(impureOps, true); + contains = true; + break; + } + verifiedClean.push(cur); + for (let i = 0; i < cur.items.length; i += 1) stack.push(cur.items[i]!); + } + if (contains) { + rootEntry.perSet.set(impureOps, true); + return true; + } + for (const node of verifiedClean) impureHeadEntryFor(env, node).perSet.set(impureOps, false); + return false; } function groundTableVersionIfAdmissible( @@ -6125,7 +6786,13 @@ function groundTableVersionIfAdmissible( op: string, call: Atom, ): TableVersion | undefined { - if (env.tableSpace === undefined || !call.ground || !keyWellFormed(call)) return undefined; + if ( + env.tableSpace === undefined || + !call.ground || + !keyWellFormed(call) || + !env.tableSpace.admitsFunctor(op) + ) + return undefined; const runtimeRulesVisible = world.selfRules.size > 0 || world.selfVarRules.length > 0; const runtimeVersion = runtimeRulesVisible ? world.selfRuleVersion : 0; if (runtimeRulesVisible) { @@ -6927,7 +7594,7 @@ function tryFastUniqueChoiceFunction( choicePlanApplication(env, world), ); if (planned === undefined) return undefined; - return [sym(","), ...planned]; + return planned; } function streamCaseSource( @@ -7251,6 +7918,13 @@ function* mettaEvalBodyG( let lbnd = bnd; let lst = st; let lw = w; + // Each tail transfer is one virtual nested call, so it costs one unit of fuel exactly as the + // recursive path it replaces did. This is what bounds a runaway tail cycle: the chain stays + // depth-flat, but exhausting `lfuel` cuts it with the same StackOverflow atom as deep recursion. + let lfuel = fuel; + // True once a tail transfer has happened. The entry application must be var-free for its caller + // to observe no bindings; after that, chain-internal steps may carry app-local variables. + let inChain = false; const pendingKeys: CompletedTableKey[] = []; const flushReturn = (res: Array<[Atom, Bindings]>, stR: St): [Array<[Atom, Bindings]>, St] => { const finalRes = @@ -7268,6 +7942,7 @@ function* mettaEvalBodyG( return [finalRes, stR]; }; reduceTrampoline: for (;;) { + if (lfuel <= 0) return flushReturn([[depthOverflowAtom(env, lw), lbnd]], lst); const op = (lw.items[0] as { name: string }).name; const args = lw.items.slice(1); if ( @@ -7296,8 +7971,7 @@ function* mettaEvalBodyG( choicePlanDataExpression(env, lst.world), choicePlanApplication(env, lst.world), ); - if (planned !== undefined) - return flushReturn([[makeExpr(env, [sym(","), ...planned]), lbnd]], lst); + if (planned !== undefined) return flushReturn([[makeExpr(env, planned), lbnd]], lst); const collapsedOp = opOf(collapsedCall); const tableVersion = collapsedOp === undefined || @@ -7326,7 +8000,7 @@ function* mettaEvalBodyG( lst, ); if (native?.tag === "ok") { - const unique = dedupAlphaStable([sym(","), ...native.answers]); + const unique = dedupAlphaStable(native.answers); return flushReturn([[makeExpr(env, unique), lbnd]], lst); } } @@ -7336,7 +8010,7 @@ function* mettaEvalBodyG( try { const [answers, distinctState] = yield* mettaEvalG( env, - fuel - 1, + lfuel - 1, lst, lbnd, collapsedCall, @@ -7344,7 +8018,7 @@ function* mettaEvalBodyG( trampoline, ); enforceDistinctLimit(env, answers.length); - const unique = dedupAlphaStable([sym(","), ...answers.map((answer) => answer[0])]); + const unique = dedupAlphaStable(answers.map((answer) => answer[0])); return flushReturn([[makeExpr(env, unique), lbnd]], distinctState); } catch (error) { if (error !== DISTINCT_RESOURCE_LIMIT) throw error; @@ -7365,15 +8039,14 @@ function* mettaEvalBodyG( choicePlanDataExpression(env, lst.world), choicePlanApplication(env, lst.world), ); - if (planned !== undefined) - return flushReturn([[makeExpr(env, [sym(","), ...planned]), lbnd]], lst); + if (planned !== undefined) return flushReturn([[makeExpr(env, planned), lbnd]], lst); } const match = matchInsideOnce(args[0]!); if (match !== undefined) { const namedMatch = tryFastNamedOnceMatch(env, lst, match, lbnd); if (namedMatch !== undefined && !counterExceedsStepLimit(lst, namedMatch.state.counter)) { const items = namedMatch.value === undefined ? [] : [namedMatch.value]; - return flushReturn([[expr([sym(","), ...items]), lbnd]], namedMatch.state); + return flushReturn([[expr(items), lbnd]], namedMatch.state); } } } @@ -7410,16 +8083,16 @@ function* mettaEvalBodyG( // bare `match` (e.g. peano's `(demo-peano ...)`). const z = args[0]!.items[1]!; if (z.kind === "expr" && opOf(z) === "match" && z.items.length === 4) { - const counted = yield* countTailMatchG(env, fuel, lst, lbnd, z, depth, trampoline); + const counted = yield* countTailMatchG(env, lfuel, lst, lbnd, z, depth, trampoline); return flushReturn([[gint(BigInt(counted.count)), lbnd]], counted.state); } - const routed = yield* tryCollapseRouteG(env, fuel, lst, lbnd, z, depth, trampoline); + const routed = yield* tryCollapseRouteG(env, lfuel, lst, lbnd, z, depth, trampoline); if (routed !== undefined) return flushReturn([[gint(BigInt(routed.count)), lbnd]], routed.state); let count = 0; const [, stC] = yield* interpretLoopG( env, - fuel, + lfuel, lst, [ { @@ -7454,7 +8127,7 @@ function* mettaEvalBodyG( if (source !== undefined) { const [selected, stCase] = yield* interpretLoopG( env, - fuel, + lfuel, lst, source, depth, @@ -7462,7 +8135,7 @@ function* mettaEvalBodyG( ); const [pairs, stReduced] = yield* reduceChildrenG( env, - fuel, + lfuel, stCase, selected, () => undefined, @@ -7480,11 +8153,14 @@ function* mettaEvalBodyG( sig !== undefined && sig.length > 0 && atomEq(sig[sig.length - 1]!, sym("Atom")); // Concurrency primitives drive their own branches; their arguments stay unevaluated regardless of // arity, so a `par`/`race`/`with-mutex` branch is evaluated concurrently, not eagerly in sequence. - const mask = LAZY_ARGS_OPS.has(op) - ? args.map(() => false) - : LEATTA_EVAL_ARGS_OPS.has(op) - ? args.map((ae) => !isSuperposeDataTuple(env, lst.world, op, ae)) - : argMask(sig, args.length); + const mask = + op === "_fuzz-eval-case" && args.length === 4 + ? [false, true, true, false] + : LAZY_ARGS_OPS.has(op) + ? args.map(() => false) + : LEATTA_EVAL_ARGS_OPS.has(op) + ? args.map((ae) => !isSuperposeDataTuple(env, lst.world, op, ae)) + : argMask(sig, args.length); // (1) type-directed argument evaluation, binding-threaded let partials: Array<[Atom[], Bindings]> = [[[], []]]; let cur = lst; @@ -7514,14 +8190,14 @@ function* mettaEvalBodyG( ? yield* driveMettaEvalG({ kind: EVAL_REQUEST, env, - fuel: fuel - 1, + fuel: lfuel - 1, state: cur, bindings: accB, atom: ae, depth, reuseDepthLevel: tailArgument, }) - : yield* mettaEvalG(env, fuel - 1, cur, accB, ae, depth, trampoline, tailArgument); + : yield* mettaEvalG(env, lfuel - 1, cur, accB, ae, depth, trampoline, tailArgument); cur = st2; for (const p of ps) { nextParts.push([[...accAtoms, p[0]], mergeRestrict(env, queryVars, accB, p[1])]); @@ -7538,10 +8214,16 @@ function* mettaEvalBodyG( let cur2 = cur; const tabling = env.tableSpace !== undefined && queryVars.length === 0; for (const [partAtoms, partB] of partials) { - // error propagation: a type-directed-evaluated arg reduced to an error and changed + // Error propagation applies only when evaluation changed an argument into an error. Reference + // identity proves a lazy argument was untouched even when it contains NaN, which intentionally + // compares unequal to itself under MeTTa numeric equality. let errFound: Atom | undefined; for (let i = 0; i < partAtoms.length; i++) { - if (isErr(partAtoms[i]!) && !atomEq(partAtoms[i]!, args[i]!)) { + if ( + isErr(partAtoms[i]!) && + partAtoms[i] !== args[i] && + !atomEq(partAtoms[i]!, args[i]!) + ) { errFound = partAtoms[i]!; break; } @@ -7567,7 +8249,7 @@ function* mettaEvalBodyG( if (op === "foldl-atom" && canUseNativeFoldlAtom(env, cur2.world)) { const folded = yield* evalFoldlAtomCallG( env, - fuel, + lfuel, cur2, partAtoms, partB, @@ -7585,7 +8267,7 @@ function* mettaEvalBodyG( if (op === "map-atom" && canUseNativeMapAtom(env, cur2.world)) { const mapped = yield* evalMapAtomCallG( env, - fuel, + lfuel, cur2, partAtoms, partB, @@ -7603,7 +8285,7 @@ function* mettaEvalBodyG( if (op === "filter-atom" && canUseNativeFilterAtom(env, cur2.world)) { const filtered = yield* evalFilterAtomCallG( env, - fuel, + lfuel, cur2, partAtoms, partB, @@ -7625,7 +8307,7 @@ function* mettaEvalBodyG( ) { const picked = yield* evalMaxByAtomG( env, - fuel, + lfuel, cur2, partAtoms, partB, @@ -7645,7 +8327,15 @@ function* mettaEvalBodyG( !env.ruleIndex.has("top-k-by-atom") && !cur2.world.selfRules.has("top-k-by-atom") ) { - const topk = yield* evalTopKByAtomG(env, fuel, cur2, partAtoms, partB, depth, trampoline); + const topk = yield* evalTopKByAtomG( + env, + lfuel, + cur2, + partAtoms, + partB, + depth, + trampoline, + ); if (topk !== undefined && !counterExceedsStepLimit(cur2, topk.state.counter)) { if (env.trace) env.trace({ kind: "grounded", op }); cur2 = topk.state; @@ -7700,7 +8390,12 @@ function* mettaEvalBodyG( continue; } } - if (env.tableSpace !== undefined && !wApp.ground && keyWellFormed(wApp)) { + if ( + env.tableSpace !== undefined && + !wApp.ground && + keyWellFormed(wApp) && + env.tableSpace.admitsFunctor(op) + ) { const runtimeRulesVisible = cur2.world.selfRules.size > 0 || cur2.world.selfVarRules.length > 0; modedRuntimeVersion = runtimeRulesVisible ? cur2.world.selfRuleVersion : 0; @@ -7738,7 +8433,7 @@ function* mettaEvalBodyG( cur2, COMPILED_IMPURE_OPS, undefined, - fuel, + lfuel, depth, ); // A compiled run reports the same logical counter advance as the interpreter. If the atomic @@ -7772,33 +8467,24 @@ function* mettaEvalBodyG( !(opReturnsAtom && !isEmbeddedOp(nextAtom)) && !atomEq(nextAtom, wApp) ) { - const nextOp = (nextAtom.items[0] as { name: string }).name; - const staticRules = nextOp === op ? env.ruleIndex.get(op) : undefined; - // A lone all-variable direct self rewrite has no rule-level base case. Keep its former - // recursive path so a runaway call still reaches the native overflow guard instead of - // spinning forever in a loop that deliberately does not consume evaluator fuel. - const loneCatchAllSelfCall = - staticRules?.length === 1 && - staticRules[0]![0].kind === "expr" && - staticRules[0]![0].items.slice(1).every((item) => item.kind === "var"); - if (!loneCatchAllSelfCall) { - if (cr.counterDelta !== 0) - cur2 = { - counter: cur2.counter + cr.counterDelta, - world: cur2.world, - }; - if (groundKey !== undefined) pendingKeys.push(groundKey); - la = nextAtom; - lbnd = emptyBindings; - lst = cur2; - lw = nextAtom; - continue reduceTrampoline; - } + if (cr.counterDelta !== 0) + cur2 = { + counter: cur2.counter + cr.counterDelta, + world: cur2.world, + }; + if (groundKey !== undefined) pendingKeys.push(groundKey); + lfuel -= 1; + inChain = true; + la = nextAtom; + lbnd = emptyBindings; + lst = cur2; + lw = nextAtom; + continue reduceTrampoline; } } const [handled, st4] = yield* reduceCompiledResultsG( env, - fuel, + lfuel, cur2, queryVars, partB, @@ -7924,7 +8610,7 @@ function* mettaEvalBodyG( const runProducerPass = function* (start: St): Gen<[Array<[Atom, Bindings]>, St]> { const [pairs, st3] = yield* interpretLoopG( env, - fuel, + lfuel, start, [ { @@ -7937,7 +8623,7 @@ function* mettaEvalBodyG( ); return yield* reduceRulePairsG( env, - fuel, + lfuel, st3, queryVars, partB, @@ -7971,7 +8657,7 @@ function* mettaEvalBodyG( let maxCounter = Math.max(start.counter, firstState.counter); let rounds = 1; while (added > 0 && !active.overBudget) { - if (rounds >= fuel) { + if (rounds >= lfuel) { out.push([makeExpr(env, [sym("Error"), wApp, sym("StackOverflow")]), partB]); added = 0; break; @@ -8012,7 +8698,7 @@ function* mettaEvalBodyG( } else { const [pairs, st3] = yield* interpretLoopG( env, - fuel, + lfuel, cur2, [ { @@ -8029,16 +8715,26 @@ function* mettaEvalBodyG( // via reduceTrampoline instead of recursing into mettaEvalG, so the native stack stays flat down a // deep tail-recursive chain. Defer this call's tabling key to pendingKeys: it shares the chain's // normal form, so flushReturn caches it (and every key above it) once the chain terminates. - if (partials.length === 1 && queryVars.length === 0 && pairs.length === 1) { + // A chain-internal step may carry app-local variables (a let pattern flowing through its + // prelude `unify` body). Those cannot be observed by the chain's caller: the entry step was + // var-free, and `finalPair` instantiates every result, so a var either bakes its value into + // `p[0]` or is still genuinely unbound. Transferring on them keeps `(let $x (impure!) (f ...))` + // tail loops flat, the MOPS `K[uσ]` rewrite, instead of nesting one frame per step. + if ( + partials.length === 1 && + (queryVars.length === 0 || inChain) && + pairs.length === 1 + ) { const p = pairs[0]!; - // A resource cut is terminal, never a tail-call continuation. Re-feeding it into the - // trampoline would repeatedly cut without consuming fuel. + // A resource cut is terminal, never a tail-call continuation. if (isEvaluationLimitAtom(p[0])) return flushReturn([[p[0], restrictBnd(env, queryVars, p[1])]], cur2); const isData = atomEq(p[0], notReducibleA) || atomEq(p[0], wApp); if (!isData && !(opReturnsAtom && !isEmbeddedOp(p[0])) && opOf(p[0]) !== undefined) { const pb = mergeRestrict(env, queryVars, partB, p[1]); if (eligible && key !== undefined) pendingKeys.push(key); + lfuel -= 1; + inChain = true; la = p[0]; lbnd = pb; lst = cur2; @@ -8050,7 +8746,7 @@ function* mettaEvalBodyG( } const [reduced, st4] = yield* reduceRulePairsG( env, - fuel, + lfuel, cur2, queryVars, partB, @@ -8188,9 +8884,11 @@ function* mettaEvalFrameG( reuseLevel: reuseDepthLevel, }; const depthSpan = depth.beginSpan(); + depth.enterNative(); try { return yield* mettaEvalBodyG(env, fuel, st, bnd, a, w, depth, lease, depthSpan, trampoline); } finally { + depth.leaveNative(); depth.endSpan(depthSpan); if (lease.ownsLevel) depth.leave(); } @@ -8272,7 +8970,16 @@ function* mettaEvalG( depth, reuseDepthLevel, }) as EvalRes; - if (depth.current >= EVALUATION_TRAMPOLINE_DEPTH - 1) + // Logical depth misses tail transfers (they reuse their level), so a long tail chain would + // otherwise nest one native generator frame per step; the native cap catches that too. Open + // atoms (unbound variables left after instantiation) are exempt from the native cap: an open + // self-expansion mints fresh variables at every level (a match-anything rule head fed its own + // body), so the heap driver would branch on it until memory dies, while native recursion cuts + // it fast and the top-level catch reports the observable `(Error StackOverflow)`. + if ( + depth.current >= EVALUATION_TRAMPOLINE_DEPTH - 1 || + (depth.native >= NATIVE_EVALUATION_NESTING_LIMIT && (a.ground || inst(env, bnd, a).ground)) + ) return yield* driveMettaEvalG({ kind: EVAL_REQUEST, env, @@ -8318,6 +9025,12 @@ function restrictPublicLimitBindings( const pairs = result[0].map((pair): [Atom, Bindings] => isEvaluationLimitAtom(pair[0]) ? [pair[0], restrictBnd(env, vars, pair[1])] : pair, ); + // The public entry is the one place every resource cut flows through (the trampoline's fuel cut, + // the plan machine's exhaustion, a compiled runtime cut), so the trace bus reports the overflow + // here against the query, as the native-overflow catch always has. A depth cut deeper in the + // evaluator may already have announced its own cut point; the query-level event complements it. + if (env.trace !== undefined && pairs.some((pair) => containsStackOverflow(pair[0]))) + env.trace({ kind: "overflow", atom: format(query) }); return [pairs, result[1]]; } diff --git a/packages/core/src/fuzz-sandbox.test.ts b/packages/core/src/fuzz-sandbox.test.ts new file mode 100644 index 0000000..8eba590 --- /dev/null +++ b/packages/core/src/fuzz-sandbox.test.ts @@ -0,0 +1,378 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import { afterEach, describe, expect, it } from "vitest"; +import { gint, sym, type Atom } from "./atom"; +import { setOutputSink, stdTable, type GroundFn } from "./builtins"; +import { buildEnv, initSt, mettaEval, registerGroundedOperation, type AsyncGroundFn } from "./eval"; +import { + registerBuiltinGroundedOperation, + registeredBuiltinGroundedOperations, +} from "./grounded-extensions"; +import { format, parseAll } from "./parser"; +import { preludeAtoms, runProgram, runProgramAsync, standardTokenizer } from "./runner"; +import { TableSpace } from "./table-space"; + +const FUZZ_CASE_TYPE = "(: _fuzz-eval-case (-> Atom Number Number Atom Atom))"; + +function printed(src: string): string[][] { + return runProgram(`${FUZZ_CASE_TYPE}\n${src}`).map((query) => query.results.map(format)); +} + +function parseAtom(src: string): Atom { + const parsed = parseAll(src, standardTokenizer()); + if (parsed.length !== 1) throw new Error(`expected one atom, got ${parsed.length}`); + return parsed[0]!.atom; +} + +let restoreOutput: ((line: string) => void) | undefined; +afterEach(() => { + if (restoreOutput !== undefined) setOutputSink(restoreOutput); + restoreOutput = undefined; +}); + +describe("built-in grounded operation extensions", () => { + it("registers an operation idempotently and installs it in every fresh environment", () => { + const op: GroundFn = () => ({ tag: "ok", results: [gint(73)] }); + registerBuiltinGroundedOperation("_fuzz-test-global-op", op, "Pure"); + registerBuiltinGroundedOperation("_fuzz-test-global-op", op, "Pure"); + + const registrations = registeredBuiltinGroundedOperations().filter( + (entry) => entry.name === "_fuzz-test-global-op", + ); + expect(registrations).toEqual([ + { name: "_fuzz-test-global-op", operation: op, effect: "Pure" }, + ]); + expect(runProgram("!(_fuzz-test-global-op)")[0]!.results.map(format)).toEqual(["73"]); + }); + + it("rejects a conflicting registration", () => { + const first: GroundFn = () => ({ tag: "ok", results: [sym("first")] }); + registerBuiltinGroundedOperation("_fuzz-test-conflict", first, "Pure"); + expect(() => + registerBuiltinGroundedOperation( + "_fuzz-test-conflict", + () => ({ tag: "ok", results: [sym("second")] }), + "Pure", + ), + ).toThrow(/already registered/); + expect(() => registerBuiltinGroundedOperation("_fuzz-test-conflict", first, "Host")).toThrow( + /already registered/, + ); + }); +}); + +describe("_fuzz-eval-case result capture", () => { + it("keeps the complete ordered result bag, including duplicates", () => { + const result = printed( + "!(_fuzz-eval-case (superpose (first second first)) 10000 100 Sandboxed)", + )[0]!; + expect(result).toHaveLength(1); + expect(result[0]).toMatch(/^\(FuzzCaseOutcome Completed \(first second first\) [0-9]+\)$/); + }); + + it("distinguishes a zero-result property from an Empty atom", () => { + const out = printed(` + !(_fuzz-eval-case (superpose ()) 10000 100 Sandboxed) + !(_fuzz-eval-case Empty 10000 100 Sandboxed) + `); + expect(out[0]![0]).toMatch(/^\(FuzzCaseOutcome Completed \(\) [0-9]+\)$/); + expect(out[1]![0]).toMatch(/^\(FuzzCaseOutcome Completed \(Empty\) [0-9]+\)$/); + }); + + it("does not evaluate the lazy body before installing the effect barrier", () => { + const lines: string[] = []; + restoreOutput = setOutputSink((line) => lines.push(line)); + const result = printed( + "!(_fuzz-eval-case (println! should-not-print) 10000 100 Sandboxed)", + )[0]![0]!; + + expect(lines).toEqual([]); + expect(result).toContain("(EffectDenied Host println!)"); + expect(result).toContain("(FuzzEffectDenied Host println!)"); + }); +}); + +describe("_fuzz-eval-case rollback", () => { + it("restores added facts, removed static atoms, and runtime rules", () => { + const out = printed(` + (kept 1) + !(_fuzz-eval-case + (let $_ (add-atom &self (case-fact 2)) + (let $_ (remove-atom &self (kept 1)) + (let $_ (add-atom &self (= (case-only) 9)) + (superpose ((case-only) + (collapse (match &self (case-fact $x) $x)) + (collapse (match &self (kept $x) $x))))))) + 10000 100 Sandboxed) + !(case-only) + !(collapse (match &self (case-fact $x) $x)) + !(collapse (match &self (kept $x) $x)) + `); + + expect(out[0]![0]).toContain("(9 (2) ())"); + expect(out[1]).toEqual(["(case-only)"]); + expect(out[2]).toEqual(["()"]); + expect(out[3]).toEqual(["(1)"]); + }); + + it("restores named spaces, state cells, and tokens", () => { + const out = printed(` + !(bind! &case-space (new-space)) + !(bind! &case-state (new-state 2)) + !(_fuzz-eval-case + (let $added (add-atom &case-space (inside 3)) + (let $changed (change-state! &case-state 4) + (let $bound (bind! case-token changed) + (get-state &case-state)))) + 10000 100 Sandboxed) + !(collapse (get-atoms &case-space)) + !(get-state &case-state) + ! case-token + `); + + expect(out[2]![0]).toContain("(4)"); + expect(out[3]).toEqual(["()"]); + expect(out[4]).toEqual(["2"]); + expect(out[5]).toEqual(["case-token"]); + }); + + it("rolls back on ordinary errors and resource cutoffs", () => { + const out = printed(` + !(_fuzz-eval-case + (let $_ (add-atom &self (from-error)) + (Error subject failure)) + 10000 100 Sandboxed) + !(collapse (match &self (from-error) found)) + !(_fuzz-eval-case + (let $_ (add-atom &self (from-cutoff)) + (collapse (match &self $x $x))) + 1 100 Sandboxed) + !(collapse (match &self (from-cutoff) found)) + `); + + expect(out[0]![0]).toContain("(Error subject failure)"); + expect(out[1]).toEqual(["()"]); + expect(out[2]![0]).toContain("ResourceLimit"); + expect(out[3]).toEqual(["()"]); + }); + + it("restores evaluator caches invalidated by a case-local runtime rule", () => { + const env = buildEnv([...preludeAtoms(), parseAtom(FUZZ_CASE_TYPE)], stdTable()); + const tables = new TableSpace(); + env.tableSpace = tables; + env.tablingDirty = true; + env.compiled = new Map(); + env.compileDirty = true; + env.compiledComplete = false; + const caseCall = parseAtom( + "(_fuzz-eval-case (let $added (add-atom &self (= (case-rule) 1)) (case-rule)) 10000 100 Sandboxed)", + ); + const [, warmedState] = mettaEval(env, 100_000, initSt(), [], caseCall); + const compiled = env.compiled; + const pureFunctors = env.pureFunctors; + const compileDirty = env.compileDirty; + const compiledComplete = env.compiledComplete; + const tablingDirty = env.tablingDirty; + tables.clear(); + const tableKey = tables.key("ground", parseAtom("(cached-call)"), 0); + tables.rememberCompleted(tableKey, 0, [gint(11)]); + + mettaEval(env, 100_000, warmedState, [], caseCall); + + expect(env.tableSpace).toBe(tables); + expect(env.tableSpace.stats()).toEqual({ entries: 1, answers: 1, approxCells: 2 }); + expect(env.compiled).toBe(compiled); + expect(env.compileDirty).toBe(compileDirty); + expect(env.compiledComplete).toBe(compiledComplete); + expect(env.pureFunctors).toBe(pureFunctors); + expect(env.tablingDirty).toBe(tablingDirty); + }); + + it("keeps generated ids monotone even though their worlds are rolled back", () => { + const out = printed(` + !(new-space) + !(_fuzz-eval-case (new-space) 10000 100 Sandboxed) + !(new-space) + `); + const before = out[0]![0]!; + const inside = /\((&space-[0-9]+)\)/.exec(out[1]![0]!)?.[1]; + const after = out[2]![0]!; + expect([before, inside, after]).toEqual(["&space-0", "&space-1", "&space-2"]); + }); + + it("applies a case-local depth allowance and restores the outer allowance", () => { + const deep = "(S ".repeat(20) + "Z" + ")".repeat(20); + const shallow = "(S ".repeat(4) + "Z" + ")".repeat(4); + const out = printed(` + (= (deep Z) done) + (= (deep (S $n)) (wrap (deep $n))) + !(_fuzz-eval-case (deep ${deep}) 10000 5 Sandboxed) + !(deep ${shallow}) + `); + expect(out[0]![0]).toContain("(FuzzCaseOutcome StackOverflow"); + expect(out[0]![0]).toContain("StackOverflow"); + expect(out[1]).toEqual(["(wrap (wrap (wrap (wrap done))))"]); + }); +}); + +describe("_fuzz-eval-case effect policy", () => { + it("denies unknown host operations before calling them", () => { + let calls = 0; + const env = buildEnv( + [...preludeAtoms(), parseAtom(FUZZ_CASE_TYPE), parseAtom("(: host-probe (-> Number))")], + stdTable(), + ); + registerGroundedOperation(env, "host-probe", () => { + calls += 1; + return { tag: "ok", results: [gint(1)] }; + }); + + const [pairs] = mettaEval( + env, + 100_000, + initSt(), + [], + parseAtom("(_fuzz-eval-case (host-probe) 10000 100 Sandboxed)"), + ); + expect(calls).toBe(0); + expect(pairs.map((pair) => format(pair[0]))[0]).toContain("(EffectDenied Host host-probe)"); + }); + + it("allows operations explicitly registered as pure", () => { + let calls = 0; + const env = buildEnv( + [...preludeAtoms(), parseAtom(FUZZ_CASE_TYPE), parseAtom("(: pure-probe (-> Number))")], + stdTable(), + ); + registerGroundedOperation( + env, + "pure-probe", + () => { + calls += 1; + return { tag: "ok", results: [gint(7)] }; + }, + "Pure", + ); + + const [pairs] = mettaEval( + env, + 100_000, + initSt(), + [], + parseAtom("(_fuzz-eval-case (pure-probe) 10000 100 Sandboxed)"), + ); + expect(calls).toBe(1); + expect(pairs.map((pair) => format(pair[0]))[0]).toMatch( + /^\(FuzzCaseOutcome Completed \(7\) [0-9]+\)$/, + ); + }); + + it("denies time, randomness, import, and concurrent host work", () => { + const out = printed(` + !(_fuzz-eval-case (current-time) 10000 100 Sandboxed) + !(_fuzz-eval-case (random-int 0 10) 10000 100 Sandboxed) + !(_fuzz-eval-case (import! &self json) 10000 100 Sandboxed) + !(_fuzz-eval-case (race 1 2) 10000 100 Sandboxed) + `); + expect(out[0]![0]).toContain("(EffectDenied Host current-time)"); + expect(out[1]![0]).toContain("(EffectDenied Host random-int)"); + expect(out[2]![0]).toContain("(EffectDenied Host import!)"); + expect(out[3]![0]).toContain("(EffectDenied AsyncHost race)"); + }); + + it("denies every standard output and file operation before execution", () => { + const lines: string[] = []; + restoreOutput = setOutputSink((line) => lines.push(line)); + const out = printed(` + !(_fuzz-eval-case (print! hidden) 10000 100 Sandboxed) + !(_fuzz-eval-case (println! hidden) 10000 100 Sandboxed) + !(_fuzz-eval-case (trace! hidden retained) 10000 100 Sandboxed) + !(_fuzz-eval-case (file-open! "/path/that/does/not/exist" "r") 10000 100 Sandboxed) + `); + expect(lines).toEqual([]); + expect(out[0]![0]).toContain("(EffectDenied Host print!)"); + expect(out[1]![0]).toContain("(EffectDenied Host println!)"); + expect(out[2]![0]).toContain("(EffectDenied Host println!)"); + expect(out[3]![0]).toContain("(EffectDenied Host file-open!)"); + }); + + it("allows declared world effects and rolls their changes back", () => { + let calls = 0; + const env = buildEnv( + [...preludeAtoms(), parseAtom(FUZZ_CASE_TYPE), parseAtom("(: world-probe (-> Atom))")], + stdTable(), + ); + registerGroundedOperation( + env, + "world-probe", + () => { + calls += 1; + return { + tag: "ok", + results: [sym("changed")], + effects: [ + { + kind: "addAtom", + space: sym("&self"), + atom: parseAtom("(world-effect leaked)"), + }, + ], + }; + }, + "World", + ); + let state = initSt(); + const [, afterCase] = mettaEval( + env, + 100_000, + state, + [], + parseAtom("(_fuzz-eval-case (world-probe) 10000 100 Sandboxed)"), + ); + state = afterCase; + const [matches] = mettaEval( + env, + 100_000, + state, + [], + parseAtom("(collapse (match &self (world-effect $x) $x))"), + ); + expect(calls).toBe(1); + expect(matches.map((pair) => format(pair[0]))).toEqual(["()"]); + }); + + it("allows host effects only when ExternalEffects is requested explicitly", () => { + const lines: string[] = []; + restoreOutput = setOutputSink((line) => lines.push(line)); + const out = printed("!(_fuzz-eval-case (println! external-line) 10000 100 ExternalEffects)"); + expect(lines).toEqual(["external-line"]); + expect(out[0]![0]).toMatch(/^\(FuzzCaseOutcome Completed \(\(\)\) [0-9]+\)$/); + }); + + it("does not let a nested case escalate a sandboxed policy", () => { + const out = printed(` + !(_fuzz-eval-case + (_fuzz-eval-case (println! forbidden) 10000 100 ExternalEffects) + 10000 100 Sandboxed) + `); + expect(out[0]![0]).toContain("fuzz effect policy cannot be escalated"); + }); + + it("denies async grounded operations before awaiting them", async () => { + let calls = 0; + const operation: AsyncGroundFn = async () => { + calls += 1; + return { tag: "ok", results: [gint(5)] }; + }; + const out = await runProgramAsync( + `${FUZZ_CASE_TYPE} + (: async-probe (-> Number)) + !(_fuzz-eval-case (async-probe) 10000 100 Sandboxed)`, + new Map([["async-probe", operation]]), + ); + expect(calls).toBe(0); + expect(out[0]!.results.map(format)[0]).toContain("(EffectDenied AsyncHost async-probe)"); + }); +}); diff --git a/packages/core/src/grounded-extensions.ts b/packages/core/src/grounded-extensions.ts new file mode 100644 index 0000000..4dc2e9f --- /dev/null +++ b/packages/core/src/grounded-extensions.ts @@ -0,0 +1,55 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import type { GroundFn } from "./builtins"; + +/** Observable effects an evaluator operation may perform. */ +export type GroundedOperationEffect = "Pure" | "World" | "Host" | "AsyncHost"; + +export interface BuiltinGroundedOperation { + readonly name: string; + readonly operation: GroundFn; + readonly effect: GroundedOperationEffect; +} + +const registry = new Map(); +const declaredEffects = new WeakMap(); + +/** Attach an effect declaration to an operation so environments rebuilt from its grounding table retain it. */ +export function declareGroundedOperationEffect( + operation: GroundFn, + effect: GroundedOperationEffect, +): void { + declaredEffects.set(operation, effect); +} + +/** Return the effect declaration attached to an operation, if one was supplied. */ +export function groundedOperationEffect(operation: GroundFn): GroundedOperationEffect | undefined { + return declaredEffects.get(operation); +} + +/** Register a grounded operation that is installed in each subsequently created environment. + * + * Repeating the same registration is a no-op. A package cannot silently replace another package's + * operation or change its declared effect. + */ +export function registerBuiltinGroundedOperation( + name: string, + operation: GroundFn, + effect: GroundedOperationEffect = "Host", +): void { + if (name.length === 0) throw new Error("built-in grounded operation name cannot be empty"); + const existing = registry.get(name); + if (existing !== undefined) { + if (existing.operation === operation && existing.effect === effect) return; + throw new Error(`built-in grounded operation '${name}' is already registered`); + } + declareGroundedOperationEffect(operation, effect); + registry.set(name, { name, operation, effect }); +} + +/** A stable snapshot of globally registered grounded operations in registration order. */ +export function registeredBuiltinGroundedOperations(): readonly BuiltinGroundedOperation[] { + return [...registry.values()]; +} diff --git a/packages/core/src/index-match.test.ts b/packages/core/src/index-match.test.ts index f2664aa..0c49747 100644 --- a/packages/core/src/index-match.test.ts +++ b/packages/core/src/index-match.test.ts @@ -28,7 +28,7 @@ const queueLib = ` (= (empty-queue) (queue () () 0)) (= (add-unique-or-fail $space $Expression) (let $st (s (repra $Expression)) - (if (== (,) (collapse (once (match $space $st True)))) + (if (== () (collapse (once (match $space $st True)))) (add-atom $space $st) (empty)))) `; @@ -40,7 +40,7 @@ describe("ground-fact index fast path — correctness vs a scan", () => { !(add-atom &self (num (S Z))) !(add-atom &self (num (S (S Z)))) !(collapse (match &self (num (S Z)) found))`; - expect(last(src)).toEqual(["(, found)"]); // exactly one match + expect(last(src)).toEqual(["(found)"]); // exactly one match }); it("absent ground atom yields no match (the common peano case)", () => { @@ -48,7 +48,7 @@ describe("ground-fact index fast path — correctness vs a scan", () => { !(add-atom &self (num Z)) !(add-atom &self (num (S Z))) !(collapse (match &self (num (S (S (S Z)))) found))`; - expect(last(src)).toEqual(["(,)"]); + expect(last(src)).toEqual(["()"]); }); it("preserves multiplicity: a duplicated atom matches once per copy", () => { @@ -57,7 +57,7 @@ describe("ground-fact index fast path — correctness vs a scan", () => { !(add-atom &self (p a)) !(add-atom &self (p a)) !(collapse (match &self (p a) hit))`; - expect(last(src)).toEqual(["(, hit hit hit)"]); + expect(last(src)).toEqual(["(hit hit hit)"]); }); it("remove-atom decrements the index", () => { @@ -66,7 +66,7 @@ describe("ground-fact index fast path — correctness vs a scan", () => { !(add-atom &self (p a)) !(remove-atom &self (p a)) !(collapse (match &self (p a) hit))`; - expect(last(src)).toEqual(["(, hit)"]); // 2 added, 1 removed -> 1 left + expect(last(src)).toEqual(["(hit)"]); // 2 added, 1 removed -> 1 left }); it("a ground pattern still unifies a NON-ground runtime atom (fast path must disable)", () => { @@ -75,7 +75,7 @@ describe("ground-fact index fast path — correctness vs a scan", () => { !(add-atom &self (edge $x 2)) !(collapse (match &self (edge 1 2) hit))`; // The ground (edge 1 2) and the variable (edge $x 2) both match -> two results. - expect(last(src)).toEqual(["(, hit hit)"]); + expect(last(src)).toEqual(["(hit hit)"]); }); it("variable-in-pattern queries are unaffected (not a ground pattern)", () => { @@ -83,7 +83,7 @@ describe("ground-fact index fast path — correctness vs a scan", () => { !(add-atom &self (num Z)) !(add-atom &self (num (S Z))) !(collapse (match &self (num $x) $x))`; - expect(sorted(last(src))).toEqual(sorted(["(, Z (S Z))"])); + expect(sorted(last(src))).toEqual(sorted(["(Z (S Z))"])); }); // Hyperon's open issues 1079 / 1076: Space::visit can undercount atoms that share a head symbol. A @@ -97,23 +97,23 @@ describe("ground-fact index fast path — correctness vs a scan", () => { !(add-atom &self (foo 3)) !(add-atom &self (foo 1)) !(collapse (match &self (foo $x) $x))`; - expect(sorted(last(src))).toEqual(sorted(["(, 1 2 3 1)"])); + expect(sorted(last(src))).toEqual(sorted(["(1 2 3 1)"])); }); it("many distinct ground atoms all match exactly (bucket spread, no collisions lost)", () => { let src = ""; for (let i = 0; i < 200; i++) src += `!(add-atom &self (k ${i}))\n`; src += `!(collapse (match &self (k 137) hit))`; - expect(last(src)).toEqual(["(, hit)"]); + expect(last(src)).toEqual(["(hit)"]); src = src.replace("(k 137)", "(k 999)"); // absent - expect(last(src)).toEqual(["(,)"]); + expect(last(src)).toEqual(["()"]); }); it("nested/structured ground atoms match by structure, not identity", () => { const src = ` !(add-atom &self (pair (a b) (c d))) !(collapse (match &self (pair (a b) (c d)) yes))`; - expect(last(src)).toEqual(["(, yes)"]); + expect(last(src)).toEqual(["(yes)"]); }); }); @@ -124,7 +124,7 @@ describe("named-space ground index fast path", () => { !(add-atom &kb (num (S Z))) !(add-atom &kb (num (S (S Z)))) !(collapse (match &kb (num (S Z)) found))`; - expect(last(src)).toEqual(["(, found)"]); + expect(last(src)).toEqual(["(found)"]); }); it("preserves named-space duplicate multiplicity", () => { @@ -133,7 +133,7 @@ describe("named-space ground index fast path", () => { !(add-atom &kb (p a)) !(add-atom &kb (p a)) !(collapse (match &kb (p a) hit))`; - expect(last(src)).toEqual(["(, hit hit hit)"]); + expect(last(src)).toEqual(["(hit hit hit)"]); }); it("falls back to the scan when a non-ground named atom can unify", () => { @@ -141,7 +141,7 @@ describe("named-space ground index fast path", () => { !(add-atom &kb (edge 1 2)) !(add-atom &kb (edge $x 2)) !(collapse (match &kb (edge 1 2) hit))`; - expect(last(src)).toEqual(["(, hit hit)"]); + expect(last(src)).toEqual(["(hit hit)"]); }); it("remove-atom updates a named space while preserving insertion order", () => { @@ -151,7 +151,7 @@ describe("named-space ground index fast path", () => { !(add-atom &kb (p a)) !(remove-atom &kb (p a)) !(collapse (get-atoms &kb))`; - expect(last(src)).toEqual(["(, (p b) (p a))"]); + expect(last(src)).toEqual(["((p b) (p a))"]); }); it("fork-space materializes a named space in insertion order", () => { @@ -161,14 +161,14 @@ describe("named-space ground index fast path", () => { !(let $fork (fork-space &kb) (let $_ (add-atom $fork (p c)) (collapse (match $fork (p $x) $x))))`; - expect(last(src)).toEqual(["(, a b c)"]); + expect(last(src)).toEqual(["(a b c)"]); }); it("import! appends module atoms into a named space", () => { const src = ` !(import! &kb concurrency) !(collapse (match &kb (: transaction (-> Atom %Undefined%)) found))`; - expect(last(src)).toEqual(["(, found)"]); + expect(last(src)).toEqual(["(found)"]); }); it("once over exact named membership advances the counter as the full scan did", () => { @@ -188,21 +188,21 @@ describe("named-space ground index fast path", () => { !(add-atom &kb (p b)) !(collapse (once (match &kb (p b) ok))) !(collapse (once (match &kb (p z) ok)))`; - expect(last(src)).toEqual(["(,)"]); - expect(runProgram(src, 50_000_000)[2]!.results.map(format)).toEqual(["(, ok)"]); + expect(last(src)).toEqual(["()"]); + expect(runProgram(src, 50_000_000)[2]!.results.map(format)).toEqual(["(ok)"]); }); it("canonical add-unique-or-fail keeps one named-space copy", () => { const src = ` (= (add-unique-or-fail $space $Expression) (let $st (s (repra $Expression)) - (if (== (,) (collapse (once (match $space $st True)))) + (if (== () (collapse (once (match $space $st True)))) (add-atom $space $st) (empty)))) !(add-unique-or-fail &dup (a b)) !(add-unique-or-fail &dup (a b)) !(collapse (get-atoms &dup))`; - expect(last(src)).toEqual(["(, (s (repra (a b))))"]); + expect(last(src)).toEqual(["((s (repra (a b))))"]); }); }); diff --git a/packages/core/src/index.ts b/packages/core/src/index.ts index 74f57df..33f4a85 100644 --- a/packages/core/src/index.ts +++ b/packages/core/src/index.ts @@ -26,6 +26,7 @@ export * from "./import-graph"; export type { TraceEvent, TraceSink } from "./trace"; export * from "./host"; export * from "./extensions"; +export * from "./grounded-extensions"; export * from "./stdlib"; export * from "./flat-kb"; export * from "./flat-atomspace"; diff --git a/packages/core/src/match-index.test.ts b/packages/core/src/match-index.test.ts index 212f7b5..5bc5ce5 100644 --- a/packages/core/src/match-index.test.ts +++ b/packages/core/src/match-index.test.ts @@ -56,7 +56,7 @@ describe("match functor indexing", () => { !(add-atom &self (Q x 9)) !(collapse (match &self (P $k $v) $v)) `), - ).toEqual(["(, 1 2)"]); + ).toEqual(["(1 2)"]); }); it("a variable-headed query still scans everything", () => { @@ -65,7 +65,7 @@ describe("match functor indexing", () => { !(add-atom &self (Foo 1)) !(collapse (match &self ($f 1) $f)) `), - ).toEqual(["(, Foo)"]); + ).toEqual(["(Foo)"]); }); it("conjunctive match works through the index", () => { @@ -75,7 +75,7 @@ describe("match functor indexing", () => { !(add-atom &self (link B C)) !(collapse (match &self (, (link $x $y) (link $y $z)) ($x $z))) `), - ).toEqual(["(, (A C))"]); + ).toEqual(["((A C))"]); }); it("scales: one match over a 100k-atom KB is fast and correct", () => { @@ -118,7 +118,7 @@ describe("match functor indexing", () => { !(add-atom &self (edge $a 9)) !(collapse (match &self (edge 1 $y) $y)) `), - ).toEqual(["(, 2 9)"]); + ).toEqual(["(2 9)"]); }); it("keeps a custom grounded matcher eligible for a leaf-key query", () => { @@ -282,7 +282,7 @@ describe("static nested argument-head indexing", () => { !(remove-atom &self (edge (red c) (north n) second)) !(collapse (match &self (edge (red $x) (north $y) $value) $value)) `), - ).toEqual(["(, first third)"]); + ).toEqual(["(first third)"]); }); it("falls back when state resolution can change a nested head", () => { @@ -313,7 +313,7 @@ describe("static nested argument-head indexing", () => { !(add-atom &self (edge (red c) runtime)) !(collapse (match &self (edge (red $key) $value) $value)) `), - ).toEqual(["(, static runtime)"]); + ).toEqual(["(static runtime)"]); }); it("falls back for a nested constraint inside a conjunction", () => { @@ -325,7 +325,7 @@ describe("static nested argument-head indexing", () => { !(collapse (match &self (, (edge (red $key) $value) (allowed $value)) $value)) `), - ).toEqual(["(, first)"]); + ).toEqual(["(first)"]); }); it("preserves the full candidate counter through once", () => { diff --git a/packages/core/src/nondeterminism-optim.test.ts b/packages/core/src/nondeterminism-optim.test.ts index ae9351d..f2178a7 100644 --- a/packages/core/src/nondeterminism-optim.test.ts +++ b/packages/core/src/nondeterminism-optim.test.ts @@ -56,7 +56,7 @@ describe("compiled pure choice evaluation", () => { it("preserves nested superpose order and multiplicity", () => { const src = "!(collapse (superpose ((superpose (1 2)) (superpose (3 4)))))"; const reference = withoutChoicePlan(src); - expect(formatted(src)).toEqual([["(, 1 3 1 4 2 3 2 4)"]]); + expect(formatted(src)).toEqual([["(1 3 1 4 2 3 2 4)"]]); expect(formatted(src)).toEqual(formatted(reference)); }); @@ -69,7 +69,7 @@ describe("compiled pure choice evaluation", () => { (+ $X $Y)))`; const reference = withoutChoicePlan(src); expect(formatted(src)).toEqual(formatted(reference)); - expect(formatted(src)[0]).toEqual(["(, 2 2 3 2 2 3 3 3 4)"]); + expect(formatted(src)[0]).toEqual(["(2 2 3 2 2 3 3 3 4)"]); }); it("streams first-seen answers for unique choice products", () => { @@ -81,11 +81,11 @@ describe("compiled pure choice evaluation", () => { ($Y (superpose $T))) (+ $X $Y))))`; const reference = withoutChoicePlan(src); - expect(formatted(src)).toEqual([["(, 2 3 4)"]]); + expect(formatted(src)).toEqual([["(2 3 4)"]]); expect(formatted(src)).toEqual(formatted(reference)); }); - it("spreads collapsed result bags without emitting the comma marker", () => { + it("treats a comma inside the superposed expression as an ordinary result", () => { const src = ` !(collapse (superpose (,))) !(collapse (superpose (, 1 2)))`; @@ -104,7 +104,7 @@ describe("compiled pure choice evaluation", () => { ())) !(range 1 7)`; const reference = withoutChoicePlan(src); - expect(formatted(src)).toEqual([["(,)"]]); + expect(formatted(src)).toEqual([["()"]]); expect(formatted(src)).toEqual(formatted(reference)); }); @@ -112,7 +112,7 @@ describe("compiled pure choice evaluation", () => { for (const op of ["==", "!="]) { const src = `!(collapse (${op} 5 "S"))`; const reference = withoutChoicePlan(src); - expect(formatted(src)).toEqual([[`(, (Error (${op} 5 "S") (BadArgType 2 Number String)))`]]); + expect(formatted(src)).toEqual([[`((Error (${op} 5 "S") (BadArgType 2 Number String)))`]]); expect(formatted(src)).toEqual(formatted(reference)); } }); @@ -120,7 +120,7 @@ describe("compiled pure choice evaluation", () => { it("preserves != choice products", () => { const src = `!(collapse (let* (($T (1 2)) ($X (superpose $T)) ($Y (superpose $T))) (!= $X $Y)))`; const reference = withoutChoicePlan(src); - expect(formatted(src)).toEqual([["(, False True True False)"]]); + expect(formatted(src)).toEqual([["(False True True False)"]]); expect(formatted(src)).toEqual(formatted(reference)); }); @@ -172,7 +172,7 @@ describe("compiled pure choice evaluation", () => { ($F 3)))`; const reference = withoutChoicePlan(src); - expect(formatted(src)).toEqual([["(, 5)"]]); + expect(formatted(src)).toEqual([["(5)"]]); expect(formatted(src)).toEqual(formatted(reference)); }); @@ -185,7 +185,7 @@ describe("compiled pure choice evaluation", () => { )[0]!.atom; const [pairs] = mettaEval(env, FUEL, initSt(), [], query); - expect(pairs.map((pair) => format(pair[0]))).toEqual(["(, 99 99 99 99)"]); + expect(pairs.map((pair) => format(pair[0]))).toEqual(["(99 99 99 99)"]); }); }); diff --git a/packages/core/src/optim-fuzz.test.ts b/packages/core/src/optim-fuzz.test.ts index c23f320..bb7190b 100644 --- a/packages/core/src/optim-fuzz.test.ts +++ b/packages/core/src/optim-fuzz.test.ts @@ -45,9 +45,7 @@ function runAgg(src: string, on: boolean): string[][] { } function tuplePayloadLength(a: Atom): number { - if (a.kind !== "expr") return 0; - const head = a.items[0]; - return head?.kind === "sym" && head.name === "," ? a.items.length - 1 : a.items.length; + return a.kind === "expr" ? a.items.length : 0; } /** Compiled vs interpreted, with `St` threaded across the whole program so side effects accumulate. Returns diff --git a/packages/core/src/parser.test.ts b/packages/core/src/parser.test.ts index 24e9ff8..5d786f9 100644 --- a/packages/core/src/parser.test.ts +++ b/packages/core/src/parser.test.ts @@ -27,6 +27,15 @@ describe("parser", () => { expect(format(parse('"hi there"', tk())!)).toBe('"hi there"'); }); + it("preserves the sign of a grounded negative zero", () => { + const atom = parse("-0.0", tk())!; + expect(format(atom)).toBe("-0.0"); + expect(atom.kind).toBe("gnd"); + if (atom.kind === "gnd" && atom.value.g === "float") { + expect(Object.is(atom.value.n, -0)).toBe(true); + } + }); + it("skips comments and reads a program atom-by-atom, tracking the bang flag", () => { const atoms = parseAll("; a comment\n(a b)\n!(+ 1 2)", tk()); expect(atoms.length).toBe(2); diff --git a/packages/core/src/parser.ts b/packages/core/src/parser.ts index a1db85f..9e9a3e7 100644 --- a/packages/core/src/parser.ts +++ b/packages/core/src/parser.ts @@ -208,7 +208,7 @@ function formatLeaf(a: Atom): string { case "int": return String(v.n); case "float": - return Number.isInteger(v.n) ? v.n.toFixed(1) : String(v.n); + return Object.is(v.n, -0) ? "-0.0" : Number.isInteger(v.n) ? v.n.toFixed(1) : String(v.n); case "str": return JSON.stringify(v.s); case "bool": diff --git a/packages/core/src/petta-compat.test.ts b/packages/core/src/petta-compat.test.ts index dbe3471..b0afc98 100644 --- a/packages/core/src/petta-compat.test.ts +++ b/packages/core/src/petta-compat.test.ts @@ -50,16 +50,16 @@ describe("PeTTa-compat stdlib ops", () => { expect(one("(= (length (Cons $h $t)) custom)\n!(length (a b c))")).toBe("3"); }); - it("the corpus `test` op is strict and uses LeaTTa conventions", () => { - // `collapse` returns an explicit comma tuple. - expect(one("!(test (collapse (superpose (1 2 3))) (, 1 2 3))")).toBe("()"); + it("the corpus `test` op is strict about expected values", () => { + // Hyperon's `collapse` returns a plain expression. + expect(one("!(test (collapse (superpose (1 2 3))) (1 2 3))")).toBe("()"); // Written in MeTTaScript conventions: grounded Bool `False`, full float `8.0`. expect(one("!(test (is-member z (a b)) False)")).toBe("()"); expect(one("!(test (+ 3.0 5.0) 8.0)")).toBe("()"); // A genuinely different value fails. expect(one("!(test (+ 1 1) 3)")).toContain("test-failed"); - // And the comparison is strict: non-LeaTTa expected values do NOT pass. - expect(one("!(test (collapse (superpose (1 2 3))) (1 2 3))")).toContain("test-failed"); + // The comparison is strict: the old comma-tagged collapse representation does not pass. + expect(one("!(test (collapse (superpose (1 2 3))) (, 1 2 3))")).toContain("test-failed"); expect(one("!(test (is-member z (a b)) false)")).toContain("test-failed"); expect(one("!(test (+ 3.0 5.0) 9)")).toContain("test-failed"); }); diff --git a/packages/core/src/petta-stdlib.ts b/packages/core/src/petta-stdlib.ts index 7778461..26863b4 100644 --- a/packages/core/src/petta-stdlib.ts +++ b/packages/core/src/petta-stdlib.ts @@ -52,7 +52,7 @@ export const PETTA_STDLIB_SRC = ` ; ---- foldall: fold an aggregator over ALL nondeterministic results of a generator ---- ; The generator is Atom-typed so it reaches foldall unevaluated; collapse then runs it and collects the - ; results into Hyperon's comma tuple. fold-over walks the payload, not the comma marker. The aggregator + ; results into Hyperon's plain result expression. fold-over walks that expression. The aggregator ; stays Atom-typed (a symbol or a lambda); the accumulator is evaluated so each application reduces. (: foldall (-> Atom Atom Atom %Undefined%)) (: fold-over (-> Atom %Undefined% Atom %Undefined%)) @@ -62,8 +62,8 @@ export const PETTA_STDLIB_SRC = ` (let* (($h (car-atom $t)) ($r (cdr-atom $t))) (fold-over $agg ($agg $acc $h) $r)))) (= (foldall $agg $gen $init) - (let* (($rs (collapse $gen)) ($payload (cdr-atom $rs))) - (fold-over $agg $init $payload))) + (let $rs (collapse $gen) + (fold-over $agg $init $rs))) ; ---- cons (PeTTa alias of cons-atom) ---- (= (cons $h $t) (cons-atom $h $t)) @@ -90,8 +90,8 @@ export const PETTA_STDLIB_SRC = ` (let* (($h (car-atom $rs)) ($r (cdr-atom $rs)) ($ok ($check $h))) (if $ok (all-true $check $r) False)))) (= (forall $gen $check) - (let* (($rs (collapse $gen)) ($payload (cdr-atom $rs))) - (all-true $check $payload))) + (let $rs (collapse $gen) + (all-true $check $rs))) ; ---- foldl: fold a function over a list, init as the seed; applies ($f elem acc), left to right ---- (: foldl (-> Atom %Undefined% %Undefined% %Undefined%)) diff --git a/packages/core/src/range-index.test.ts b/packages/core/src/range-index.test.ts index 274d9e5..886bca1 100644 --- a/packages/core/src/range-index.test.ts +++ b/packages/core/src/range-index.test.ts @@ -235,7 +235,7 @@ describe("experimental.rangeIndex handles unordered numeric atoms", () => { // The query's lower bound is >= 0, and -0 >= 0 holds, so the row must appear on both paths. const facts = [edgeFact(1n, gfloat(-0)), edgeFact(2n, gint(3n)), edgeFact(3n, gint(-2n))]; expect(evalStaticFacts(facts, true)).toEqual(evalStaticFacts(facts, false)); - expect(evalStaticFacts(facts, true)).toContain("(Row 1 0.0)"); // the formatter prints -0 as 0.0 + expect(evalStaticFacts(facts, true)).toContain("(Row 1 -0.0)"); }); }); diff --git a/packages/core/src/runner.test.ts b/packages/core/src/runner.test.ts index 74fc44f..2f111ad 100644 --- a/packages/core/src/runner.test.ts +++ b/packages/core/src/runner.test.ts @@ -2,7 +2,7 @@ // // SPDX-License-Identifier: MIT -import { describe, it, expect } from "vitest"; +import { describe, it, expect, vi } from "vitest"; import { runProgram, standardTokenizer } from "./runner"; import { format, parseAll } from "./parser"; import type { Atom } from "./atom"; @@ -56,9 +56,9 @@ describe("runner + stdlib prelude", () => { `); expect(r[1]!.results.map(format)).toEqual(['"(function1)"']); - expect(r[2]!.results.map(format)).toEqual(["(,)"]); + expect(r[2]!.results.map(format)).toEqual(["()"]); expect(r[4]!.results.map(format)).toEqual(['"(OK)"']); - expect(r[5]!.results.map(format)).toEqual(["(, (OK))"]); + expect(r[5]!.results.map(format)).toEqual(["((OK))"]); }); it("remove-atom deletes runtime &self rules from the function index", () => { @@ -72,7 +72,7 @@ describe("runner + stdlib prelude", () => { expect(r[1]!.results.map(format)).toEqual(["old"]); expect(r[3]!.results.map(format)).toEqual(["(dyn)"]); - expect(r[4]!.results.map(format)).toEqual(["(,)"]); + expect(r[4]!.results.map(format)).toEqual(["()"]); }); it("cons-atom requires an expression tail (does not wrap a non-expression)", () => { @@ -112,6 +112,19 @@ describe("runner + stdlib prelude", () => { expect(r[1]!.results.map(format)).toEqual(["is-range-empty"]); }); + it("random-int does not use its optional RNG argument as reproducible state", () => { + const random = vi.spyOn(Math, "random").mockReturnValueOnce(0.1).mockReturnValueOnce(0.9); + try { + const r = runProgram(` + !(random-int &same-rng 0 10) + !(random-int &same-rng 0 10) + `); + expect(r.map((query) => query.results.map(format))).toEqual([["1"], ["9"]]); + } finally { + random.mockRestore(); + } + }); + it("get-type-space consults the named space's type declarations", () => { const r = runProgram(` !(add-atom &kb (: Foo Bar)) @@ -188,13 +201,13 @@ describe("runner + stdlib prelude", () => { expect(q('!(!= 5 "S")')).toEqual(['(Error (!= 5 "S") (BadArgType 2 Number String))']); expect(q("!(!= (Error source cause) anything)")).toEqual(["(Error source cause)"]); expect(q("!(collapse (!= (superpose (1 2)) (superpose (1 3))))")).toEqual([ - "(, False True True True)", + "(False True True True)", ]); }); it("keeps != type metadata out of &self", () => { expect(q("(left != right)\n!(collapse (match &self ($a != $b) ($a $b)))")).toEqual([ - "(, (left right))", + "((left right))", ]); }); @@ -248,7 +261,7 @@ describe("runner + stdlib prelude", () => { it("keeps Empty in result bags like LeaTTa", () => { expect(q("! Empty")).toEqual(["Empty"]); expect(q("!(superpose (Empty a))")).toEqual(["Empty", "a"]); - expect(q("!(collapse (superpose (Empty a)))")).toEqual(["(, Empty a)"]); + expect(q("!(collapse (superpose (Empty a)))")).toEqual(["(Empty a)"]); expect(q("!(unify a a Empty fail)")).toEqual(["Empty"]); expect(q("!(unify a b then Empty)")).toEqual(["Empty"]); expect( @@ -289,6 +302,6 @@ describe("runner + stdlib prelude", () => { 100_000, imports, ).map((group) => group.results.map(format)); - expect(out.slice(-2)).toEqual([["(, only)"], ["(, only)"]]); + expect(out.slice(-2)).toEqual([["(only)"], ["(only)"]]); }); }); diff --git a/packages/core/src/semantic-conformance.test.ts b/packages/core/src/semantic-conformance.test.ts index 3eca71d..aea7428 100644 --- a/packages/core/src/semantic-conformance.test.ts +++ b/packages/core/src/semantic-conformance.test.ts @@ -207,8 +207,8 @@ describe("superpose argument policy (Hyperon-identical)", () => { describe("superpose argument policy (deliberate dialect divergences)", () => { // These three keep PeTTa's evaluate-then-split for a WELL-TYPED call argument, which computed - // tuples rely on (`(case (superpose (cdr-atom (collapse (match …)))) …)` in the corpus). Hyperon - // 0.2.10 never evaluates the argument and would return the raw split noted per case. + // tuples rely on. Hyperon 0.2.10 never evaluates the argument and would return the raw split noted + // per case. it("evaluates a well-typed nullary call before splitting", () => { // Hyperon 0.2.10 returns `[t]` (raw split). PeTTa and this engine evaluate `(t)` first. diff --git a/packages/core/src/table-space.ts b/packages/core/src/table-space.ts index c659c97..f14136e 100644 --- a/packages/core/src/table-space.ts +++ b/packages/core/src/table-space.ts @@ -10,6 +10,9 @@ const token = (tag: number, payload = 0): number => (tag << 28) | payload | 0; export interface TableKey { readonly tokens: readonly number[]; readonly generation: number; + /** Head functor of the tabled call, so utility is attributed per functor. A chain of keys + * remembered together can span several functors, which is why the key carries its own. */ + readonly functor?: string | undefined; } export interface VariantAtomKey { @@ -166,6 +169,9 @@ const DEFAULT_TABLE_BUDGET: TableBudget = { maxInternerLeaves: 250_000, }; +/** Entries a functor may store with no read before its memo is revoked. */ +const UTILITY_REVOKE_AFTER = 256; + const DOMAIN_GROUND = -1; const DOMAIN_MODED = -2; const DOMAIN_GROUND_DISTINCT = -3; @@ -194,6 +200,9 @@ export class TableSpace { private activeCount = 0; private activeAnswers = 0; private activeCells = 0; + /** Measured utility per functor: how many entries it stored, and how many were ever read back. + * A memo that never hits is pure overhead, so admission revokes it (see `admitsFunctor`). */ + private readonly functorUtility = new Map(); constructor(private readonly budget: TableBudget = DEFAULT_TABLE_BUDGET) {} @@ -215,9 +224,11 @@ export class TableSpace { ? DOMAIN_GROUND_SPACE_READ_DISTINCT : DOMAIN_MODED; const versionTokens = typeof version === "number" ? [version] : version; + const head = call.kind === "expr" ? call.items[0] : undefined; return { tokens: [domain, this.generation, ...versionTokens, ...encoded.tokens], generation: this.generation, + functor: head?.kind === "sym" ? head.name : undefined, varNames: encoded.varNames, canonicalMap: encoded.canonicalMap, }; @@ -231,10 +242,33 @@ export class TableSpace { if (!this.isCurrentKey(key)) return undefined; const entry = this.completed.get(key.tokens); if (entry === undefined) return undefined; + if (key.functor !== undefined) { + const utility = this.functorUtility.get(key.functor); + if (utility !== undefined) utility.hits += 1; + } this.touch(entry); return entry; } + /** Whether this functor's memo has earned its keep. A table is a pure memo, so refusing one can + * only cost time, never change a result; that is what makes measured revocation safe. The static + * profitability analysis (`analyzeTableWorth`) can only guess from the call graph, and a wrong + * guess is expensive: a functor that threads an accumulator stores one large key per iteration + * and hits none of them. So admission also watches the outcome, and once a functor has stored + * `UTILITY_REVOKE_AFTER` entries without a single read it stops being tabled for the rest of the + * run. The threshold sits far above any plausible warm-up (a memo that pays starts hitting + * within a few dozen entries) and far below the millions of tokens a runaway table burns. */ + admitsFunctor(functor: string): boolean { + const utility = this.functorUtility.get(functor); + return utility === undefined || utility.hits > 0 || utility.inserts < UTILITY_REVOKE_AFTER; + } + + /** Measured per-functor table utility, for tests and diagnostics. */ + functorUtilityOf(functor: string): { inserts: number; hits: number } | undefined { + const utility = this.functorUtility.get(functor); + return utility === undefined ? undefined : { ...utility }; + } + rememberCompleted( key: TableKey, numCallVars: number, @@ -247,6 +281,11 @@ export class TableSpace { this.maybeResetInterner(); return; } + if (key.functor !== undefined) { + const utility = this.functorUtility.get(key.functor); + if (utility === undefined) this.functorUtility.set(key.functor, { inserts: 1, hits: 0 }); + else utility.inserts += 1; + } const old = this.completed.get(key.tokens); if (old !== undefined) this.remove(old); const entry: MutableCompletedTableEntry = { diff --git a/packages/core/src/tabling-control-form.test.ts b/packages/core/src/tabling-control-form.test.ts index 890307a..34ba1f3 100644 --- a/packages/core/src/tabling-control-form.test.ts +++ b/packages/core/src/tabling-control-form.test.ts @@ -11,9 +11,17 @@ // not regress that optimization. import { describe, expect, it } from "vitest"; +import { gfloat } from "./atom.js"; +import { registerBuiltinGroundedOperation } from "./grounded-extensions.js"; import { format } from "./parser"; import { runProgram } from "./runner"; +registerBuiltinGroundedOperation( + "_test-control-form-nan", + () => ({ tag: "ok", results: [gfloat(Number.NaN)] }), + "Pure", +); + const run = (src: string, tabling: boolean): string[] => runProgram(src, 100_000, new Map(), { tabling }).at(-1)!.results.map(format); @@ -53,4 +61,29 @@ describe("compiled/tabled result normalization", () => { expect(run(src, false)).toEqual(["(result value)"]); expect(run(src, true)).toEqual(["(result value)"]); }); + + it("binds a grounded NaN through let* identically with and without tabling", () => { + expect(run("!(_test-control-form-nan)", false)).toEqual(["NaN"]); + expect(run("!(let $value (_test-control-form-nan) (result $value))", false)).toEqual([ + "(result NaN)", + ]); + const lazyError = ` + !(let $nan (_test-control-form-nan) + (unify value value + success + (Error unused $nan))) + `; + expect(run(lazyError, false)).toEqual(["success"]); + expect(run(lazyError, true)).toEqual(["success"]); + const src = ` + (: bind-nan (-> Atom %Undefined%)) + (= (bind-nan $value) + (let* (($constant value)) + (result $value $constant))) + !(let $nan (_test-control-form-nan) + (bind-nan $nan)) + `; + expect(run(src, false)).toEqual(["(result NaN value)"]); + expect(run(src, true)).toEqual(["(result NaN value)"]); + }); }); diff --git a/packages/core/src/tabling.test.ts b/packages/core/src/tabling.test.ts index 10c0c62..79b84c4 100644 --- a/packages/core/src/tabling.test.ts +++ b/packages/core/src/tabling.test.ts @@ -320,3 +320,54 @@ describe("runtime-rule tabling (fibadd)", () => { ); }); }); + +// A table is a pure memo, so refusing one can only cost time and never change a result. That is what +// lets admission watch the OUTCOME rather than trust the static call-graph guess: a functor that +// stores entry after entry and never reads one back is pure overhead, whatever the analysis thought. +describe("measured table utility", () => { + const space = () => new TableSpace(); + const keyFor = (ts: TableSpace, call: string) => + ts.key("ground", parseAll(call, standardTokenizer())[0]!.atom, 0); + + it("keeps admitting a functor whose memo is read back", () => { + const ts = space(); + for (let i = 0; i < 1000; i++) { + const key = keyFor(ts, `(f ${i})`); + ts.rememberCompleted(key, 0, [sym("answer")]); + expect(ts.getCompleted(key)).toBeDefined(); + } + + expect(ts.admitsFunctor("f")).toBe(true); + const utility = ts.functorUtilityOf("f"); + expect(utility?.inserts).toBe(1000); + expect(utility?.hits).toBe(1000); + }); + + it("revokes a functor that stores entries and never reads one", () => { + const ts = space(); + // Every call is distinct, so no entry can ever be read back — the accumulator-loop shape. + for (let i = 0; i < 300; i++) ts.rememberCompleted(keyFor(ts, `(g ${i})`), 0, [sym("answer")]); + + expect(ts.admitsFunctor("g")).toBe(false); + expect(ts.functorUtilityOf("g")?.hits).toBe(0); + // Revocation is per functor: an unrelated one is untouched. + expect(ts.admitsFunctor("f")).toBe(true); + }); + + it("does not revoke before the warm-up threshold", () => { + const ts = space(); + for (let i = 0; i < 32; i++) ts.rememberCompleted(keyFor(ts, `(h ${i})`), 0, [sym("answer")]); + + expect(ts.admitsFunctor("h")).toBe(true); + }); + + it("a single read keeps a functor admitted for the rest of the run", () => { + const ts = space(); + const read = keyFor(ts, "(i 0)"); + ts.rememberCompleted(read, 0, [sym("answer")]); + expect(ts.getCompleted(read)).toBeDefined(); + for (let i = 1; i < 400; i++) ts.rememberCompleted(keyFor(ts, `(i ${i})`), 0, [sym("answer")]); + + expect(ts.admitsFunctor("i")).toBe(true); + }); +}); diff --git a/packages/core/src/tabling.ts b/packages/core/src/tabling.ts index 0f82ee3..1d7a95d 100644 --- a/packages/core/src/tabling.ts +++ b/packages/core/src/tabling.ts @@ -28,6 +28,7 @@ export const IMPURE_OPS: ReadonlySet = new Set([ "bind!", "import!", "transaction", + "_fuzz-eval-case", "context-space", "par", "race", @@ -153,18 +154,54 @@ function callHeads(a: Atom, out: Set): void { for (const it of a.items) callHeads(it, out); } -/** How many calls in `a` target any functor in `targets`. */ -export function functorCallCount(a: Atom, targets: ReadonlySet): number { +/** Occurrences of `targets` in positions a rule body can actually evaluate. + * + * `inertArgument(head, index)` reports a position that can never become a redex, so an occurrence + * there is a mention rather than a call. Over-counting only risks tabling something, which is the + * prior behaviour; under-counting loses a table that pays, so the predicate stays deliberately + * narrow. */ +export function functorCallCount( + a: Atom, + targets: ReadonlySet, + inertArgument?: (head: string, index: number) => boolean, +): number { if (a.kind !== "expr" || a.items.length === 0) return 0; - let n = a.items[0]!.kind === "sym" && targets.has((a.items[0] as { name: string }).name) ? 1 : 0; - for (const it of a.items) n += functorCallCount(it, targets); + const head = a.items[0]!; + let n = head.kind === "sym" && targets.has((head as { name: string }).name) ? 1 : 0; + const inert = + inertArgument !== undefined && head.kind === "sym" + ? (index: number) => inertArgument((head as { name: string }).name, index) + : undefined; + for (let i = 0; i < a.items.length; i++) { + if (i > 0 && inert?.(i - 1) === true) continue; + n += functorCallCount(a.items[i]!, targets, inertArgument); + } return n; } +/** Argument positions a rule body can never evaluate. + * + * Only `Error`'s payload qualifies. `Error` is the standard error constructor: its parameters are + * declared `Atom`, it has no equation, and no evaluator instruction hands an `Error` argument back + * for evaluation, so `(Error (f $x) reason)` mentions `f` as diagnostic data. That mention used to + * make the prelude's own `let*` look doubly recursive — `(Error (let* $pairs $template) + * bad-let-star)` is its second occurrence — which admitted `let*` to automatic tabling. Since + * `let*` carries whole templates and accumulators, its keys were the largest in the system and + * could never hit: a 200-iteration accumulator loop spent 3.5 million key tokens on it and ran + * quadratically. + * + * Control constructs are deliberately excluded even when a parameter is declared unevaluated: `let` + * rewrites to `unify`, and `unify` returns the chosen branch for the caller to evaluate, so those + * positions do become redexes. */ +export function inertArgumentPositions(env: MinEnv): (head: string, index: number) => boolean { + return (head) => head === "Error" && !env.ruleIndex.has("Error"); +} + /** Pure functors worth automatic tabling. A recursive SCC is worth tabling when some rule body branches * into that same SCC at least twice. This keeps fib/proof-search overlap tabled while avoiding unbounded * caches for single-tail recursion such as factorial or trial division. */ export function analyzeTableWorth(env: MinEnv, pureFunctors: ReadonlySet): Set { + const inert = inertArgumentPositions(env); const deps = new Map>(); const bodies = new Map(); for (const [k, eqs] of env.ruleIndex) { @@ -227,7 +264,7 @@ export function analyzeTableWorth(env: MinEnv, pureFunctors: ReadonlySet }); if (!recursive) continue; const branchesInsideComponent = component.some((f) => - (bodies.get(f) ?? []).some((rhs) => functorCallCount(rhs, componentSet) >= 2), + (bodies.get(f) ?? []).some((rhs) => functorCallCount(rhs, componentSet, inert) >= 2), ); if (!branchesInsideComponent) continue; for (const f of component) if (pureFunctors.has(f)) worth.add(f); @@ -240,15 +277,32 @@ export function analyzeTableWorth(env: MinEnv, pureFunctors: ReadonlySet * appear in a ground call, so the float check is the only one needed in P1. */ // Iterative explicit-stack walk so a deep key term cannot overflow the host stack: a key is well-formed // unless some grounded leaf is a float, an order-independent check over the whole tree. +// Purely structural (floats anywhere spoil a table key), so the verdict is cacheable by node identity +// forever. Admission re-checks the same immutable call atoms as an accumulator grows across interpreter +// steps; skipping already-verified shared subtrees keeps that re-check O(1) instead of O(term). +const keyWellFormedCache = new WeakMap(); + export function keyWellFormed(a: Atom): boolean { const stack: Atom[] = [a]; + const verified: Atom[] = []; while (stack.length > 0) { const cur = stack.pop()!; if (cur.kind === "gnd") { - if (cur.value.g === "float") return false; + if (cur.value.g === "float") { + if (a.kind === "expr") keyWellFormedCache.set(a, false); + return false; + } } else if (cur.kind === "expr") { + const cached = keyWellFormedCache.get(cur); + if (cached !== undefined) { + if (cached) continue; + if (a !== cur) keyWellFormedCache.set(a, false); + return false; + } + verified.push(cur); for (const x of cur.items) stack.push(x); } } + for (const node of verified) keyWellFormedCache.set(node, true); return true; } diff --git a/packages/core/src/tail-trampoline.test.ts b/packages/core/src/tail-trampoline.test.ts index e68cacb..36c7fe0 100644 --- a/packages/core/src/tail-trampoline.test.ts +++ b/packages/core/src/tail-trampoline.test.ts @@ -46,6 +46,7 @@ function runIsolated( testCase: IsolatedCase, mode: "on" | "off" | "interpreted", timeoutMs = NONTERMINATION_TIMEOUT_MS, + fuel = ISOLATED_FUEL, ): IsolatedOutcome { const run = spawnSync( process.execPath, @@ -53,7 +54,7 @@ function runIsolated( { cwd: process.cwd(), encoding: "utf8", - input: JSON.stringify({ ...testCase, mode, fuel: ISOLATED_FUEL }), + input: JSON.stringify({ ...testCase, mode, fuel }), timeout: timeoutMs, killSignal: "SIGTERM", maxBuffer: 1 << 20, @@ -190,11 +191,24 @@ describe("depth-neutral argument trampoline", () => { }); describe("compiled tail-call nontermination differential", () => { + // Tail transfers iterate on the heap in every mode, so a runaway tail cycle no longer grows + // the native stack; the resource bound that stops it is fuel, and exhaustion must surface as + // the same StackOverflow error in the interpreter and in both compiled modes. A mode that + // ignored fuel would run forever and show up here as a timeout. + // + // The wall clock is only there to catch that, so it is generous and the fuel is small. Burning + // fuel costs time in proportion to it, measured at 3.9s for 200,000 and 1.1s for 50,000 in the + // slowest mode, and the first version of this test paired 200,000 with a ten-second budget: it + // passed locally and timed out on a shared CI runner that was also running the differential + // suite. That made it a performance assertion by accident. Fifty thousand still iterates the + // cycle tens of thousands of times, and a minute is long enough that only a mode which never + // terminates reaches it. + const RUNAWAY_FUEL = 50_000; + const RUNAWAY_TIMEOUT_MS = 60_000; const runawayCases: Array< IsolatedCase & { readonly name: string; readonly holderNames: string[]; - readonly expected: Record<"on" | "off" | "interpreted", IsolatedOutcome["outcome"]>; } > = [ { @@ -204,11 +218,6 @@ describe("compiled tail-call nontermination differential", () => { (= (flip-self 1) 0)`, query: "(self 0)", holderNames: ["self", "flip-self"], - expected: { - on: "stack-overflow-error", - off: "stack-overflow-error", - interpreted: "timeout", - }, }, { name: "mutual recursion", @@ -216,7 +225,6 @@ describe("compiled tail-call nontermination differential", () => { (= (b $n) (a $n))`, query: "(a 0)", holderNames: ["a", "b"], - expected: { on: "timeout", off: "stack-overflow-error", interpreted: "timeout" }, }, { name: "multi-rule tail cycle", @@ -224,7 +232,6 @@ describe("compiled tail-call nontermination differential", () => { (= (phase B) (phase A))`, query: "(phase A)", holderNames: ["phase"], - expected: { on: "timeout", off: "stack-overflow-error", interpreted: "timeout" }, }, { name: "tail cycle through a compiled operator", @@ -234,22 +241,25 @@ describe("compiled tail-call nontermination differential", () => { (= (flip B) A)`, query: "(spin A)", holderNames: ["spin", "flip"], - expected: { on: "timeout", off: "stack-overflow-error", interpreted: "timeout" }, }, ]; for (const testCase of runawayCases) { for (const mode of ["on", "off", "interpreted"] as const) { - it(`${testCase.name}: ${mode}`, async () => { - const outcome = await runIsolated(testCase, mode); - expect(outcome.outcome).toBe(testCase.expected[mode]); - if (mode !== "interpreted") - for (const name of testCase.holderNames) expect(outcome.holders[name]).toBeDefined(); - if (outcome.outcome === "stack-overflow-error") { - expect(outcome.results).toHaveLength(1); - expect(outcome.results[0]).toContain("StackOverflow"); - } - }, 5_000); + it( + `${testCase.name}: ${mode}`, + async () => { + const outcome = await runIsolated(testCase, mode, RUNAWAY_TIMEOUT_MS, RUNAWAY_FUEL); + expect(outcome.outcome).toBe("stack-overflow-error"); + if (mode !== "interpreted") + for (const name of testCase.holderNames) expect(outcome.holders[name]).toBeDefined(); + if (outcome.outcome === "stack-overflow-error") { + expect(outcome.results).toHaveLength(1); + expect(outcome.results[0]).toContain("StackOverflow"); + } + }, + RUNAWAY_TIMEOUT_MS + 30_000, + ); } } @@ -266,10 +276,12 @@ describe("compiled tail-call nontermination differential", () => { offOutcome: "result", }, { + // The guarded multi-rule shape previously exhausted the native stack with the tail + // continuation off; heap-capped nesting completes it in every mode. name: "deep guarded multi-rule count-down", rules: GUARDED_MULTI_RULE_COUNTDOWN, query: "(count 6000)", - offOutcome: "stack-overflow-error", + offOutcome: "result", }, ]; diff --git a/packages/core/src/transaction.test.ts b/packages/core/src/transaction.test.ts index 8db247e..9a93614 100644 --- a/packages/core/src/transaction.test.ts +++ b/packages/core/src/transaction.test.ts @@ -8,7 +8,7 @@ import { format } from "./parser"; // `transaction` (TS-native extension, opt-in via `!(import! &self concurrency)`): evaluate the body // and commit its space mutations only on success; roll back (snapshot/restore the copy-on-write world) -// on a thrown Error atom or zero results. `collapse` renders a LeaTTa comma tuple `(, a b ...)`. +// on a thrown Error atom or zero results. `collapse` returns Hyperon's plain result expression `(a b ...)`. const last = (src: string): string[] => { const rs = runProgram(src); return rs[rs.length - 1]!.results.map(format); @@ -23,7 +23,7 @@ describe("transaction", () => { !(transaction (add-atom &self (cnt 7))) !(collapse (match &self (cnt $v) $v)) `), - ).toEqual(["(, 5 7)"]); + ).toEqual(["(5 7)"]); }); it("rolls back when the body adds then produces zero results", () => { @@ -34,7 +34,7 @@ describe("transaction", () => { !(transaction (let $u (add-atom &self (cnt 6)) (superpose ()))) !(collapse (match &self (cnt $v) $v)) `), - ).toEqual(["(, 5)"]); + ).toEqual(["(5)"]); }); it("the transaction itself returns the body's results (zero on rollback)", () => { @@ -55,6 +55,6 @@ describe("transaction", () => { !(transaction (let $u (add-atom &self (cnt 9)) (superpose (1 Empty)))) !(collapse (match &self (cnt $v) $v)) `), - ).toEqual(["(, 5 9)"]); + ).toEqual(["(5 9)"]); }); }); diff --git a/packages/das-client/package.json b/packages/das-client/package.json index 442d0b3..ca4a427 100644 --- a/packages/das-client/package.json +++ b/packages/das-client/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/das-client", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/packages/das-gateway/package.json b/packages/das-gateway/package.json index dcb840b..e54e2a7 100644 --- a/packages/das-gateway/package.json +++ b/packages/das-gateway/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/das-gateway", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/packages/debug/package.json b/packages/debug/package.json index 0a2a77c..6abe802 100644 --- a/packages/debug/package.json +++ b/packages/debug/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/debug", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/packages/edsl/package.json b/packages/edsl/package.json index 1ce4911..fe7a288 100644 --- a/packages/edsl/package.json +++ b/packages/edsl/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/edsl", - "version": "2.7.0", + "version": "2.8.0", "author": "MesTTo", "license": "MIT", "description": "Ergonomic, typed TypeScript eDSL for MeTTa: term builders, tagged templates, host-interop builders, and auto-grounding of TypeScript values.", diff --git a/packages/fuzz/README.md b/packages/fuzz/README.md new file mode 100644 index 0000000..e8f7bec --- /dev/null +++ b/packages/fuzz/README.md @@ -0,0 +1,169 @@ +# @mettascript/fuzz + +Property testing for [MeTTaScript](https://github.com/MesTTo/MeTTaScript), written in MeTTa. You declare a generator and a property, and the library generates cases, shrinks a failure to its smallest form, and hands back a result you can replay. It also enumerates small domains exhaustively, checks a real system against a model over command sequences, and searches a transition relation for a reachable state. + +The policy lives in MeTTa: generation, shrinking, the run loop, the state machines, and the search are all rewrite rules you can read in `src/metta`. TypeScript supplies only what a representation needs, in one place: a splitmix/xoroshiro random source, a structural key over atoms, and a versioned atom codec. + +## Install + +```bash +npm install @mettascript/fuzz +``` + +Importing the package registers the `fuzz` module, so MeTTa code reaches it with `import!`. + +## Usage + +```metta +!(import! &self fuzz) + +(: reverse-involution (-> Atom FuzzProperty)) +(= (reverse-involution $xs) + (expect-atom-equal (reverse (reverse $xs)) $xs)) + +!(fuzz-check reverse-involution + (gen-list (gen-int -100 100) 0 40) + reverse-involution + (fuzz-config (Runs 200))) +``` + +A passing run reports what it did: + +```text +(FuzzPassed (Property reverse-involution) (Seed 0) + (FuzzStatistics (Counts (Passed 213) (PropertyDiscards 0) (GenerationDiscards 0) + (Regressions 0) (Examples 0) (Edges 13) (Random 200)) ...)) +``` + +`Runs` counts the random cases. Edge cases are drawn on top of them, which is why 200 runs report 213 +passes here: the generator's boundary values are tried first, then the random ones. + +Write the property with the expectation combinators rather than a bare `Bool`, so a failure carries a tag and details you can read: + +- `(fuzz-pass)` and `(fuzz-fail
)` are the two results everything else builds on. +- `(expect-true
)`, `(expect-false ...)`. +- `(expect-atom-equal )` compares structurally; `(expect-alpha-equal ...)` ignores variable names. +- `(expect-results-exact )` compares result bags in order; `-alpha`, `-multiset` and `-set` relax that to variable renaming, order, and multiplicity. + +## Generators + +Generators are data, not functions: `(gen-int 0 9)` is an atom the runner interprets, which is what lets one declaration be replayed, shrunk, and enumerated. + +- Scalars: `gen-bool`, `gen-int`, `gen-int-origin`, `gen-sized-int`, `gen-float`, `gen-float-range`, `gen-float-bits`, `gen-char`, `gen-char-ascii`, `gen-char-unicode`, `gen-symbol`, `gen-syntax-token`, `gen-const`. +- Text: `gen-string`, `gen-ascii-string`, `gen-unicode-string`. +- Structure: `gen-tuple`, `gen-list`, `gen-option`, `gen-element`, `gen-one-of`, `gen-frequency`. +- Combinators: `gen-map`, `gen-bind`, `gen-filter`, `gen-sized`, `gen-resize`, `gen-recursive`, `gen-custom`. +- Grammars and types: `gen-grammar`, `gen-grammar-root`, `gen-well-typed` generate from a declared grammar or from type constructors, so you can generate well-formed terms of a language rather than raw trees. + +## Shrinking + +A failure is shrunk before it is reported, under a named order (`mettascript-shrink-v1`) so the smallest form is stable across runs rather than a function of the seed. The result says whether it reached a local minimum or stopped early, and why. A custom generator can supply its own shrinker; anything else shrinks through its decision tree. + +## Exhaustive checking + +For a small domain, enumerate it instead of sampling: + +```metta +(: always (-> Atom FuzzProperty)) +(= (always $value) (fuzz-pass)) + +!(fuzz-check-exhaustive small (gen-bool) always (fuzz-config (MaxEnumerated 10))) +``` + +`(FuzzExhaustivelyVerified (Property small) (DomainCount 2) ...)` means the whole domain was covered, which is a proof over that domain rather than evidence. A domain that does not fit the bound is reported as an incomplete run, never as verified. + +## State machines + +Check a real system against a model over generated command sequences. Generation walks the model only, so a command sequence is chosen without touching the real system; execution then runs both and compares. + +```metta +(= (counter-initialize) (new-state 0)) +(: counter-command-generator (-> Atom %Undefined%)) +(= (counter-command-generator $model) (gen-element (increment reset))) +(= (counter-precondition $model $command) True) +(= (counter-execute $real increment) + (let $seen (get-state $real) + (let $changed (change-state! $real (+ $seen 1)) + (+ $seen 1)))) +(= (counter-execute $real reset) (let $changed (change-state! $real 0) 0)) +(= (counter-next-model (Count $n) increment) (Count (+ $n 1))) +(= (counter-next-model (Count $n) reset) (Count 0)) +(= (counter-postcondition (Count $n) increment $result) (== $result (+ $n 1))) +(= (counter-postcondition (Count $n) reset $result) (== $result 0)) +(= (counter-invariant (Count $n)) (>= $n 0)) +(= (counter-cleanup $real) Done) + +(FuzzMachine Counter + (InitialModel (Count 0)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) + +!(fuzz-check-machine Counter (fuzz-config (Runs 20) (MaxSize 6))) +``` + +A divergence shrinks to a shorter command sequence that still diverges, so you get the shortest sequence that separates the real system from the model rather than the one that happened to be generated. + +## Bounded reachability + +Search a transition relation, breadth first, for a state that satisfies a target: + +```metta +(= (counter-enumerate (Count $n)) + (if (< $n 4) (FiniteCommands up split) (FiniteCommands))) +(= (counter-transition (Count $n) up) (Count (+ $n 1))) +(= (counter-transition (Count $n) split) (superpose ((Count (+ $n 1)) (Count (+ $n 2))))) +(= (counter-target (Count $n)) (== $n 3)) + +!(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth 20))) +``` + +A transition may return several next states, and the whole ordered result bag becomes outgoing edges, so a witness records which branch it took and can be replayed through a nondeterministic model. + +The outcomes are deliberately distinct. `FuzzReachable` carries a witness that was replayed from the initial state before being reported. `FuzzReachabilityExhausted` means unreachable in the declared finite model. `FuzzUnreachableWithinDepth` means only that nothing was found at or below `MaxDepth`. Every limit, incomplete enumeration, or replay mismatch is a `FuzzReachabilityCutoff` and never becomes exhaustion. + +## Running a suite from the command line + +Declare tests as data and run the file with [`@mettascript/node`](https://github.com/MesTTo/MeTTaScript/tree/main/packages/node): + +```metta +(FuzzTest involution (gen-list (gen-int -20 20) 0 6) reverse-involution + (fuzz-config (Runs 200))) +``` + +```bash +metta fuzz suite.metta # run every declaration +metta fuzz --seed 7 --runs 50 suite.metta # override each declaration's config +metta fuzz --exhaustive suite.metta # enumerate each domain instead +metta fuzz --corpus regressions suite.metta # replay stored counterexamples, record new ones +metta reach suite.metta # run every (FuzzReachTest ...) +``` + +The CLI runs the declarations a file carries, not the file's own `!` queries. Exit codes are 0 for a pass or a definitive answer, 1 for a property failure, 2 for invalid input or corrupt stored data, and 3 for an incomplete run. + +`--corpus ` keeps found counterexamples as text so a later run replays them first, one file per case, meant to be committed. Values go through the versioned codec rather than plain formatting, so a counterexample of `NaN` survives exactly. + +## Reading a result from TypeScript + +Results are atoms. `decodeFuzzOutcome` turns one into a typed union, `renderOutcomeLine` gives the one-line form, and `exitCodeForOutcomes` gives the worst-first exit code for a whole run: + +```ts +import { decodeFuzzOutcome, exitCodeForOutcomes, renderOutcomeLine } from "@mettascript/fuzz"; + +const outcome = decodeFuzzOutcome(resultAtom); +if (outcome.kind === "failed") console.log(renderOutcomeLine(outcome)); +process.exit(exitCodeForOutcomes([outcome])); +``` + +The decoder is strict: an atom it does not recognize becomes an `undecodable` outcome rather than a pass. + +## Determinism + +A run is a function of its seed. The random source, the shrink order, the replay keys, and the exhaustive enumeration order are all named and versioned, so a reported failure reproduces, and `metta fuzz --seed ` twice gives the same cases. diff --git a/packages/fuzz/package.json b/packages/fuzz/package.json new file mode 100644 index 0000000..9b94098 --- /dev/null +++ b/packages/fuzz/package.json @@ -0,0 +1,54 @@ +{ + "name": "@mettascript/fuzz", + "version": "2.8.0", + "license": "MIT", + "type": "module", + "main": "./dist/index.js", + "module": "./dist/index.js", + "types": "./dist/index.d.ts", + "exports": { + ".": { + "types": "./dist/index.d.ts", + "default": "./dist/index.js" + }, + "./package.json": "./package.json" + }, + "files": [ + "dist" + ], + "scripts": { + "generate": "node scripts/generate-module.mjs", + "generate:check": "node scripts/generate-module.mjs --check", + "prebuild": "pnpm generate:check", + "build": "tsup src/index.ts --format esm --dts --clean" + }, + "dependencies": { + "@mettascript/core": "workspace:*", + "pure-rand": "8.4.2" + }, + "author": "MesTTo", + "engines": { + "node": ">=20" + }, + "sideEffects": true, + "publishConfig": { + "access": "public" + }, + "description": "MeTTa-native property testing, shrinking, state-machine testing, and bounded verification for MeTTaScript.", + "keywords": [ + "metta", + "hyperon", + "property-testing", + "fuzzing", + "model-checking" + ], + "repository": { + "type": "git", + "url": "git+https://github.com/MesTTo/MeTTaScript.git", + "directory": "packages/fuzz" + }, + "homepage": "https://github.com/MesTTo/MeTTaScript#readme", + "bugs": { + "url": "https://github.com/MesTTo/MeTTaScript/issues" + } +} diff --git a/packages/fuzz/scripts/generate-module.mjs b/packages/fuzz/scripts/generate-module.mjs new file mode 100644 index 0000000..3326841 --- /dev/null +++ b/packages/fuzz/scripts/generate-module.mjs @@ -0,0 +1,138 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import { mkdirSync, readdirSync, readFileSync, writeFileSync } from "node:fs"; +import { dirname, join } from "node:path"; +import { fileURLToPath } from "node:url"; +import { format } from "prettier"; + +const root = dirname(dirname(fileURLToPath(import.meta.url))); +const sourceDir = join(root, "src", "metta"); +const outputFile = join(root, "src", "generated", "module.ts"); +const check = process.argv.includes("--check"); + +const fragments = readdirSync(sourceDir) + .filter((name) => /^\d{2}-.*\.metta$/.test(name)) + .sort(); + +if (fragments.length === 0) { + throw new Error("no numbered MeTTa source fragments found"); +} + +const source = fragments + .map((name) => readFileSync(join(sourceDir, name), "utf8").trimEnd()) + .join("\n\n"); + +// A misplaced closing paren can keep a file balanced while folding sibling switch arms into +// one arm; switch-internal then silently reduces the whole call to Empty. Parse every fragment +// and reject any switch arm that is not exactly (pattern template) before emitting the module. +function parseForms(text, name) { + const forms = []; + const stack = []; + let token = ""; + let inString = false; + let inComment = false; + const push = (item) => { + if (stack.length === 0) forms.push(item); + else stack[stack.length - 1].push(item); + }; + const flush = () => { + if (token !== "") { + push(token); + token = ""; + } + }; + for (let i = 0; i < text.length; i += 1) { + const ch = text[i]; + if (inComment) { + if (ch === "\n") inComment = false; + continue; + } + if (inString) { + token += ch; + if (ch === "\\") token += text[++i] ?? ""; + else if (ch === '"') inString = false; + continue; + } + if (ch === '"') { + token += ch; + inString = true; + } else if (ch === ";") { + flush(); + inComment = true; + } else if (ch === "(") { + flush(); + stack.push([]); + } else if (ch === ")") { + flush(); + const done = stack.pop(); + if (done === undefined) throw new Error(`${name}: unbalanced ')'`); + push(done); + } else if (ch === " " || ch === "\t" || ch === "\n" || ch === "\r") { + flush(); + } else { + token += ch; + } + } + flush(); + if (stack.length !== 0) throw new Error(`${name}: unbalanced '('`); + return forms; +} + +function lintSwitchArms(form, name, path) { + if (!Array.isArray(form)) return; + if ((form[0] === "switch" || form[0] === "switch-minimal") && form.length === 3) { + const cases = form[2]; + if (Array.isArray(cases)) { + cases.forEach((arm, index) => { + if (!Array.isArray(arm) || arm.length !== 2) + throw new Error( + `${name}: switch arm ${index} in ${path} has ${ + Array.isArray(arm) ? arm.length : "a non-expression" + } items; every arm must be exactly (pattern template)`, + ); + }); + } + } + for (const item of form) lintSwitchArms(item, name, path); +} + +for (const name of fragments) { + const text = readFileSync(join(sourceDir, name), "utf8"); + for (const form of parseForms(text, name)) { + const path = + Array.isArray(form) && Array.isArray(form[1]) && typeof form[1][0] === "string" + ? form[1][0] + : "top level"; + lintSwitchArms(form, name, path); + } +} + +const generated = await format( + [ + "// SPDX-FileCopyrightText: 2026 MesTTo", + "//", + "// SPDX-License-Identifier: MIT", + "", + "// Generated by scripts/generate-module.mjs. Do not edit.", + `export const FUZZ_MODULE_SRC = ${JSON.stringify(source + "\n")};`, + "", + ].join("\n"), + { parser: "typescript" }, +); + +if (check) { + let current; + try { + current = readFileSync(outputFile, "utf8"); + } catch { + throw new Error("generated fuzz module is missing; run pnpm generate"); + } + if (current !== generated) { + throw new Error("generated fuzz module is stale; run pnpm generate"); + } +} else { + mkdirSync(dirname(outputFile), { recursive: true }); + writeFileSync(outputFile, generated); +} diff --git a/packages/fuzz/src/corpus.test.ts b/packages/fuzz/src/corpus.test.ts new file mode 100644 index 0000000..813b6cb --- /dev/null +++ b/packages/fuzz/src/corpus.test.ts @@ -0,0 +1,169 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// The corpus representation: an entry has to survive being written as text and read back exactly, for +// every kind of value the codec can carry, and a reader has to refuse anything it does not recognize +// rather than let it through. + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { + atomEq, + expr, + format, + gbool, + gfloat, + gint, + gnd, + gstr, + gunit, + sym, + variable, + type Atom, +} from "@mettascript/core"; +import { corpusRegressionFact, parseCorpusEntries, renderCorpusEntry } from "./corpus.js"; + +function roundTrip(value: Atom): Atom | string { + const rendered = renderCorpusEntry({ property: "p", value }); + if (!rendered.ok) return `render: ${rendered.reason}`; + const parsed = parseCorpusEntries(rendered.value); + if (!parsed.ok) return `parse: ${parsed.reason}`; + if (parsed.value.length !== 1) return `parse: ${parsed.value.length} entries`; + return parsed.value[0]!.value; +} + +// One value per payload kind the codec emits, plus the cases where text is the risk: escapes, the +// float words, and an empty expression. +const VALUES: readonly (readonly [string, Atom])[] = [ + ["symbol", sym("Counter")], + ["symbol needing care", sym('a b"c')], + ["variable", variable("x")], + ["integer", gint(1_000_000)], + ["negative integer", gint(-42)], + ["big integer", gint(9_007_199_254_740_993n)], + ["float", gfloat(0.1)], + ["negative zero", gfloat(-0)], + ["infinity", gfloat(Number.POSITIVE_INFINITY)], + ["negative infinity", gfloat(Number.NEGATIVE_INFINITY)], + ["string", gstr("hello")], + ["string with escapes", gstr('a"b\\c\nd\te')], + ["unicode string", gstr("héllo ☃ 𝄞")], + ["boolean", gbool(true)], + ["unit", gunit], + ["empty expression", expr([])], + ["nested expression", expr([sym("A"), expr([sym("B"), gint(1), gfloat(2.5)]), gstr("c")])], + ["deep expression", expr([sym("f"), expr([sym("f"), expr([sym("f"), gint(0)])])])], +]; + +describe("fuzz corpus entries", () => { + it.each(VALUES)("round-trips a %s through text", (_label, value) => { + const back = roundTrip(value); + expect(typeof back === "string" ? back : format(back)).toBe(format(value)); + expect(typeof back !== "string" && atomEq(back, value)).toBe(true); + }); + + it("round-trips NaN, which has no source syntax at all", () => { + // NaN never equals itself, so the check is on the bits: the entry stores the two 32-bit words. + const rendered = renderCorpusEntry({ property: "p", value: gfloat(Number.NaN) }); + expect(rendered.ok && rendered.value).toContain("(Float64Bits 2146959360 0)"); + const back = roundTrip(gfloat(Number.NaN)); + expect(typeof back !== "string" && back.kind === "gnd" && back.value.g === "float").toBe(true); + expect( + typeof back !== "string" && back.kind === "gnd" && back.value.g === "float" + ? Number.isNaN(back.value.n as number) + : false, + ).toBe(true); + }); + + it("keeps -0 apart from 0, which formatting alone would not", () => { + const negative = roundTrip(gfloat(-0)); + expect( + typeof negative !== "string" && negative.kind === "gnd" && negative.value.g === "float", + ).toBe(true); + if (typeof negative !== "string" && negative.kind === "gnd" && negative.value.g === "float") { + expect(Object.is(negative.value.n, -0)).toBe(true); + } + }); + + it("names the property and the entry format in the text", () => { + const rendered = renderCorpusEntry({ property: "boundary", value: gint(5) }); + + expect(rendered.ok && rendered.value).toContain( + "(FuzzCorpusEntry 1 boundary (FuzzEncodedAtom 1 (Integer 5)))", + ); + // A reader should be able to tell what the file is for without knowing the tool. + expect(rendered.ok && rendered.value).toContain("; Commit this file"); + }); + + it("refuses a value with no storable encoding", () => { + // An external grounded value is a live host object, the shape a space handle takes: it has no text + // form, so an entry must not claim to hold one. + const handle = gnd({ g: "ext", kind: "Space", id: "&x" }); + + expect(renderCorpusEntry({ property: "p", value: handle }).ok).toBe(false); + const nested = renderCorpusEntry({ property: "p", value: expr([sym("Holds"), handle]) }); + // Refused wherever it sits, not only at the top: the encoder reports the first offending leaf. + expect(nested.ok).toBe(false); + expect(!nested.ok && nested.reason).toContain("no storable encoding"); + expect(!nested.ok && nested.reason).toContain("ExternalGrounded"); + }); + + it("reads several entries from one file, in order", () => { + const text = [ + "(FuzzCorpusEntry 1 first (FuzzEncodedAtom 1 (Integer 1)))", + '(FuzzCorpusEntry 1 second (FuzzEncodedAtom 1 (Symbol "two")))', + ].join("\n"); + const parsed = parseCorpusEntries(text); + + expect(parsed.ok && parsed.value.map((entry) => entry.property)).toEqual(["first", "second"]); + expect(parsed.ok && format(parsed.value[1]!.value)).toBe("two"); + }); + + it("refuses anything it does not recognize", () => { + const cases: readonly (readonly [string, string, string])[] = [ + ["empty", "", "no entries"], + ["comment only", "; nothing here\n", "no entries"], + ["a query", '!(println! "ran")', "data, not queries"], + [ + "wrong head", + "(Regression 1 p (FuzzEncodedAtom 1 (Integer 1)))", + "expected (FuzzCorpusEntry", + ], + ["wrong arity", "(FuzzCorpusEntry 1 p)", "expected (FuzzCorpusEntry"], + ["future format", "(FuzzCorpusEntry 2 p (FuzzEncodedAtom 1 (Integer 1)))", "expected 1"], + [ + "property not a symbol", + '(FuzzCorpusEntry 1 "p" (FuzzEncodedAtom 1 (Integer 1)))', + "symbol", + ], + ["payload not encoded", "(FuzzCorpusEntry 1 p 5)", "undecodable"], + ["unknown payload tag", "(FuzzCorpusEntry 1 p (FuzzEncodedAtom 1 (Nope 5)))", "undecodable"], + ["future codec", "(FuzzCorpusEntry 1 p (FuzzEncodedAtom 9 (Integer 1)))", "undecodable"], + ["unbalanced", "(FuzzCorpusEntry 1 p", "unreadable"], + ]; + + for (const [label, text, reason] of cases) { + const parsed = parseCorpusEntries(text); + expect(parsed.ok, label).toBe(false); + expect(!parsed.ok && parsed.reason, label).toContain(reason); + } + }); + + it("refuses a whole file when one entry in it is wrong", () => { + // Skipping the bad entry would drop a known failure from the run while still calling the run clean. + const parsed = parseCorpusEntries( + ["(FuzzCorpusEntry 1 good (FuzzEncodedAtom 1 (Integer 1)))", "(Something else)"].join("\n"), + ); + + expect(parsed.ok).toBe(false); + }); + + it("builds the fact that puts an entry in front of a run", () => { + // The runner matches (FuzzRegression ) in the space; the replay slot is + // None because a stored entry carries the value only. + expect(format(corpusRegressionFact({ property: "boundary", value: gint(5) }))).toBe( + "(FuzzRegression boundary 5 None)", + ); + }); +}); diff --git a/packages/fuzz/src/corpus.ts b/packages/fuzz/src/corpus.ts new file mode 100644 index 0000000..0ea0518 --- /dev/null +++ b/packages/fuzz/src/corpus.ts @@ -0,0 +1,129 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// A regression corpus: the counterexamples a run already found, kept as text so a later run replays +// them before generating anything new. The runner already has the replay phase — it matches +// `(FuzzRegression )` facts in the space and runs them first — so a corpus +// is just those facts, written down. +// +// The design follows proptest's regression files and Go's fuzz corpus: one entry per counterexample, +// each self-describing and version-stamped, meant to be committed to source control so the failure +// travels with the code that caused it. Entries are content-addressed by the host, which is what makes +// a repeated write a no-op and deduplication structural rather than a comparison pass. +// +// An entry stores the value through the same versioned codec MeTTa uses for replay, not through plain +// formatting. That matters for values with no source syntax: a float is stored as its two 32-bit words, +// so NaN and the infinities survive a round trip exactly, and a grounded value with no encoding is +// refused outright instead of being written back as something else. +// +// An entry stores the value and nothing else. The recorded replay of the original failure is not kept: +// the runner uses it only as reporting context, and a stored generator key goes stale the moment the +// generator changes, which would make a corpus entry claim more than it can support. A replayed entry +// therefore carries no decision tree and is not shrunk again, reported as `(NotShrunk (Reason +// NoDecisionTree))`. That is what a corpus should do: the stored value is already the smallest one the +// run that found it could reach. + +import { format, gint, parseAll, standardTokenizer, sym, expr, type Atom } from "@mettascript/core"; +import { decodeAtomFromStorage, encodeAtomForStorage } from "./kernel.js"; + +/** Bumped when the on-disk entry shape changes. A reader refuses anything else. */ +export const FUZZ_CORPUS_FORMAT = 1; + +const ENTRY_HEAD = "FuzzCorpusEntry"; +const KERNEL_ERROR_HEAD = "FuzzKernelError"; + +const HEADER = `; A counterexample MeTTaScript's fuzzer found, kept so later runs replay it first. +; Commit this file: the failure then travels with the code that caused it. +; Written by \`metta fuzz --corpus\`. Values use the versioned replay codec, not source syntax. +`; + +export interface FuzzCorpusEntry { + /** The id of the declaration the counterexample belongs to. */ + readonly property: string; + /** The counterexample itself, decoded. */ + readonly value: Atom; +} + +export type FuzzCorpusResult = { readonly ok: true; readonly value: T } | FuzzCorpusFailure; + +export interface FuzzCorpusFailure { + readonly ok: false; + readonly reason: string; +} + +function failed(reason: string): FuzzCorpusFailure { + return { ok: false, reason }; +} + +function isKernelError(atom: Atom): boolean { + return ( + atom.kind === "expr" && + atom.items.length > 0 && + atom.items[0]?.kind === "sym" && + atom.items[0].name === KERNEL_ERROR_HEAD + ); +} + +/** + * The text of one corpus entry, or why the value cannot be stored. A value carrying a grounded object + * with no encoding, such as a live space handle, has no text form and is refused here. + */ +export function renderCorpusEntry(entry: FuzzCorpusEntry): FuzzCorpusResult { + const encoded = encodeAtomForStorage(entry.value); + if (isKernelError(encoded)) + return failed(`the value has no storable encoding: ${format(encoded)}`); + const fact = expr([sym(ENTRY_HEAD), gint(FUZZ_CORPUS_FORMAT), sym(entry.property), encoded]); + return { ok: true, value: `${HEADER}${format(fact)}\n` }; +} + +/** + * The entry a file holds, or why it cannot be read. Every top-level atom must be one well-formed entry: + * a corpus file is data, and a reader that skipped what it did not recognize would let anything else in + * the file travel into the program alongside the entries. + */ +export function parseCorpusEntries(text: string): FuzzCorpusResult { + let tops; + try { + tops = parseAll(text, standardTokenizer()); + } catch (error) { + return failed(`unreadable: ${error instanceof Error ? error.message : String(error)}`); + } + if (tops.length === 0) return failed("no entries"); + + const entries: FuzzCorpusEntry[] = []; + for (const top of tops) { + if (top.bang) return failed("a corpus file holds data, not queries"); + const atom = top.atom; + if ( + atom.kind !== "expr" || + atom.items.length !== 4 || + atom.items[0]?.kind !== "sym" || + atom.items[0].name !== ENTRY_HEAD + ) { + return failed(`expected (${ENTRY_HEAD} ${FUZZ_CORPUS_FORMAT} )`); + } + const version = atom.items[1]!; + if ( + version.kind !== "gnd" || + version.value.g !== "int" || + Number(version.value.n) !== FUZZ_CORPUS_FORMAT + ) { + return failed(`unsupported entry format, expected ${FUZZ_CORPUS_FORMAT}`); + } + const property = atom.items[2]!; + if (property.kind !== "sym") return failed("the property id must be a symbol"); + const decoded = decodeAtomFromStorage(atom.items[3]!); + if (isKernelError(decoded)) return failed(`undecodable value: ${format(decoded)}`); + entries.push({ property: property.name, value: decoded }); + } + return { ok: true, value: entries }; +} + +/** + * The fact that puts an entry in front of a run. The replay slot is `None`, as it is for a declared + * example: the value is what reproduces the failure. + */ +export function corpusRegressionFact(entry: FuzzCorpusEntry): Atom { + return expr([sym("FuzzRegression"), sym(entry.property), entry.value, sym("None")]); +} diff --git a/packages/fuzz/src/decode.test.ts b/packages/fuzz/src/decode.test.ts new file mode 100644 index 0000000..0f050d3 --- /dev/null +++ b/packages/fuzz/src/decode.test.ts @@ -0,0 +1,194 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { parseAll, standardTokenizer, format } from "@mettascript/core"; +import { + decodeFuzzOutcome, + exitCodeForOutcome, + exitCodeForOutcomes, + renderOutcomeLine, + FUZZ_EXIT_OK, + FUZZ_EXIT_PROPERTY_FAILURE, + FUZZ_EXIT_INVALID, + FUZZ_EXIT_INCOMPLETE, + type FuzzOutcome, +} from "./decode.js"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +const parse = (src: string) => parseAll(src, standardTokenizer())[0]!.atom; +const decode = (src: string) => decodeFuzzOutcome(parse(src)); + +// Decode the real thing, not a hand-written imitation: run the library and feed its own result atom +// back through the decoder. A shape drift in the MeTTa side then fails here rather than silently +// decoding as a pass. +const outcomeOf = (body: string): FuzzOutcome => { + const printedResult = printed(body).at(-1)![0]!; + return decodeFuzzOutcome(parse(printedResult)); +}; + +const ALWAYS = ` + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) +`; +const NEVER = ` + (: never (-> Atom FuzzProperty)) + (= (never $value) (fuzz-fail Wrong (Saw $value))) +`; + +describe("public result decoding", () => { + it("decodes a real passing run, including its counts", () => { + const outcome = outcomeOf(` + ${ALWAYS} + !(fuzz-check ok-property (gen-int 0 3) always (fuzz-config (Seed 7) (Runs 3) (EdgeCases 2))) + `); + + expect(outcome.kind).toBe("passed"); + if (outcome.kind !== "passed") return; + expect(outcome.property).toBe("ok-property"); + expect(outcome.seed).toBe(7); + expect(outcome.statistics?.counts.passed).toBeGreaterThan(0); + expect(outcome.statistics?.counts.edges).toBe(2); + expect(exitCodeForOutcome(outcome)).toBe(FUZZ_EXIT_OK); + }); + + it("decodes a real failing run down to the shrunk value", () => { + const outcome = outcomeOf(` + ${NEVER} + !(fuzz-check bad-property (gen-int 0 9) never (fuzz-config (Seed 1) (Runs 5))) + `); + + expect(outcome.kind).toBe("failed"); + if (outcome.kind !== "failed") return; + expect(outcome.property).toBe("bad-property"); + expect(outcome.failureTag).toBe("Wrong"); + // Shrinking drives an integer toward its origin, so the smallest counterexample is 0. + expect(outcome.smallestValue).toBeDefined(); + expect(format(outcome.smallestValue!)).toBe("0"); + // The original is decoded too, because the difference between the two is information: this property + // rejects everything, so the first edge case fails and shrinking still reduces it to 0. + expect(outcome.originalValue).toBeDefined(); + expect(format(outcome.originalDetails!)).toContain("(Saw "); + // A decoded field is the value rather than the label around it, so the details are the (Details ...) + // record and the replay is the (FuzzReplay ...) record. + expect(format(outcome.smallestDetails!)).toBe("(Details (Saw 0))"); + expect(format(outcome.replay!)).toMatch(/^\(FuzzReplay \(Format 2\)/); + expect(exitCodeForOutcome(outcome)).toBe(FUZZ_EXIT_PROPERTY_FAILURE); + }); + + it("decodes a real exhaustive verification", () => { + const outcome = outcomeOf(` + ${ALWAYS} + !(fuzz-check-exhaustive small (gen-bool) always (fuzz-config (MaxEnumerated 10))) + `); + + expect(outcome.kind).toBe("exhaustively-verified"); + if (outcome.kind !== "exhaustively-verified") return; + expect(outcome.domainCount).toBe(2); + expect(exitCodeForOutcome(outcome)).toBe(FUZZ_EXIT_OK); + }); + + it("decodes a real reachability witness with its branch indices", () => { + const outcome = outcomeOf(` + (= (enumerate (Count $n)) (if (< $n 3) (FiniteCommands up) (FiniteCommands))) + (= (step (Count $n) up) (Count (+ $n 1))) + (= (target (Count $n)) (== $n 2)) + !(fuzz-reachable Counter (Count 0) enumerate step target (reach-config (MaxDepth 5))) + `); + + expect(outcome.kind).toBe("reachable"); + if (outcome.kind !== "reachable") return; + expect(outcome.property).toBe("Counter"); + expect(outcome.depth).toBe(2); + expect(outcome.commands.map(format)).toEqual(["up", "up"]); + expect(outcome.witness).toHaveLength(2); + expect(outcome.witness[0]).toEqual({ + commandIndex: 0, + command: expect.objectContaining({ kind: "sym" }), + branch: 0, + }); + expect(outcome.counts?.states).toBeGreaterThan(0); + expect(exitCodeForOutcome(outcome)).toBe(FUZZ_EXIT_OK); + }); + + it("grades reachability answers by completeness, not by whether the target was found", () => { + const bounded = decode( + "(FuzzUnreachableWithinDepth (Property M) (Depth 3)" + + " (ReachStatistics (States 4) (Transitions 6) (Depth 3)))", + ); + const exhausted = decode( + "(FuzzReachabilityExhausted (Property M) (States 9) (Depth 4)" + + " (ReachStatistics (States 9) (Transitions 12) (Depth 4)))", + ); + const cutoff = decode( + "(FuzzReachabilityCutoff (Property M) (Reason (MaxStatesReached (MaxStates 2)))" + + " (ReachStatistics (States 2) (Transitions 3) (Depth 1)))", + ); + + // A finite exhaustion is a definitive answer; a depth answer and a cutoff are explicitly bounded. + expect(exitCodeForOutcome(exhausted)).toBe(FUZZ_EXIT_OK); + expect(exitCodeForOutcome(bounded)).toBe(FUZZ_EXIT_INCOMPLETE); + expect(exitCodeForOutcome(cutoff)).toBe(FUZZ_EXIT_INCOMPLETE); + expect(bounded.kind === "unreachable-within-depth" && bounded.depth).toBe(3); + expect(cutoff.kind === "reachability-cutoff" && cutoff.counts?.states).toBe(2); + }); + + it("decodes give-up and invalid results", () => { + const gaveUp = decode( + "(FuzzGaveUp (Property p) GenerationDiscards (FuzzStatistics" + + " (Counts (Passed 0) (PropertyDiscards 0) (GenerationDiscards 9) (Regressions 0)" + + " (Examples 0) (Edges 0) (Random 0)) (Labels ()) (Collected ()) (Coverage ())))", + ); + const invalid = decode("(FuzzInvalid InvalidConfig (InvalidRuns (Runs -1)))"); + + expect(gaveUp.kind).toBe("gave-up"); + expect(gaveUp.kind === "gave-up" && gaveUp.reason).toBe("GenerationDiscards"); + expect(gaveUp.kind === "gave-up" && gaveUp.statistics?.counts.generationDiscards).toBe(9); + expect(exitCodeForOutcome(gaveUp)).toBe(FUZZ_EXIT_INCOMPLETE); + + expect(invalid.kind).toBe("invalid"); + expect(invalid.kind === "invalid" && invalid.code).toBe("InvalidConfig"); + expect(exitCodeForOutcome(invalid)).toBe(FUZZ_EXIT_INVALID); + }); + + it("refuses to guess: an unknown or truncated shape is undecodable, never a pass", () => { + for (const src of [ + "(FuzzSomethingNew (Property p))", + "(FuzzPassed (Seed 1))", + "(FuzzFailed (Property p))", + "(FuzzInvalid (NotASymbolCode 1))", + "just-a-symbol", + ]) { + const outcome = decode(src); + expect(outcome.kind, src).toBe("undecodable"); + expect(exitCodeForOutcome(outcome), src).toBe(FUZZ_EXIT_INVALID); + } + }); + + it("takes the most severe exit code across a suite", () => { + const pass = decode("(FuzzPassed (Property a) (Seed 0))"); + const fail = decode("(FuzzFailed (Property b) (FailureTag T))"); + const incomplete = decode("(FuzzGaveUp (Property c) GenerationDiscards)"); + const invalid = decode("(FuzzInvalid Bad)"); + + expect(exitCodeForOutcomes([])).toBe(FUZZ_EXIT_OK); + expect(exitCodeForOutcomes([pass, pass])).toBe(FUZZ_EXIT_OK); + expect(exitCodeForOutcomes([pass, incomplete])).toBe(FUZZ_EXIT_INCOMPLETE); + // A found counterexample is more actionable than an incomplete run, so it wins. + expect(exitCodeForOutcomes([pass, incomplete, fail])).toBe(FUZZ_EXIT_PROPERTY_FAILURE); + // A result that could not be trusted to run outranks everything. + expect(exitCodeForOutcomes([fail, incomplete, invalid])).toBe(FUZZ_EXIT_INVALID); + }); + + it("renders one line per outcome", () => { + expect(renderOutcomeLine(decode("(FuzzPassed (Property a) (Seed 4))"))).toContain("ok a"); + expect(renderOutcomeLine(decode("(FuzzFailed (Property b) (FailureTag Boom))"))).toContain( + "FAILED b Boom", + ); + expect(renderOutcomeLine(decode("(FuzzGaveUp (Property c) TooManyDiscards)"))).toContain( + "gave up c TooManyDiscards", + ); + }); +}); diff --git a/packages/fuzz/src/decode.ts b/packages/fuzz/src/decode.ts new file mode 100644 index 0000000..6c8e594 --- /dev/null +++ b/packages/fuzz/src/decode.ts @@ -0,0 +1,490 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// Strict decoders for the library's public result atoms. +// +// The MeTTa side is the source of truth: a run returns one result atom carrying everything a caller +// could need. A host that wants to render, persist, or exit on that result should not re-parse it by +// string matching, so this module turns each public outcome into a discriminated TypeScript value and +// keeps the original atom alongside it. +// +// Strict means a shape that is not recognized becomes `{ kind: "undecodable" }` with the reason, +// never a partially-filled success. A silently-tolerated shape change would let a host report a pass +// for a result it did not understand, which is the one failure mode worth designing against. + +import { type Atom, format } from "@mettascript/core"; + +/** The counts every run reports. */ +export interface FuzzCounts { + readonly passed: number; + readonly propertyDiscards: number; + readonly generationDiscards: number; + readonly regressions: number; + readonly examples: number; + readonly edges: number; + readonly random: number; +} + +export interface FuzzStatistics { + readonly counts: FuzzCounts; + /** `(Labels ...)`, `(Collected ...)`, `(Coverage ...)` kept as atoms: their shape is user data. */ + readonly labels: Atom | undefined; + readonly collected: Atom | undefined; + readonly coverage: Atom | undefined; +} + +export interface ReachCounts { + readonly states: number; + readonly transitions: number; + readonly depth: number; +} + +/** One transition of a reachability witness. */ +export interface ReachStep { + readonly commandIndex: number; + readonly command: Atom; + readonly branch: number; +} + +export type FuzzOutcome = + | { + readonly kind: "passed"; + readonly property: string; + readonly seed: number | undefined; + readonly statistics: FuzzStatistics | undefined; + readonly atom: Atom; + } + | { + readonly kind: "failed"; + readonly property: string; + readonly phase: string | undefined; + readonly caseIndex: number | undefined; + readonly failureTag: string; + /** What generation produced, before shrinking. */ + readonly originalValue: Atom | undefined; + readonly originalDetails: Atom | undefined; + /** What shrinking reduced it to, which is the one to report first. */ + readonly smallestValue: Atom | undefined; + readonly smallestDetails: Atom | undefined; + readonly replay: Atom | undefined; + readonly shrink: Atom | undefined; + readonly statistics: FuzzStatistics | undefined; + readonly atom: Atom; + } + | { + readonly kind: "gave-up"; + readonly property: string; + readonly reason: string; + readonly statistics: FuzzStatistics | undefined; + readonly atom: Atom; + } + | { + readonly kind: "exhaustively-verified"; + readonly property: string; + readonly domainCount: number | undefined; + readonly enumerated: number | undefined; + readonly atom: Atom; + } + | { + readonly kind: "invalid"; + readonly code: string; + readonly details: readonly Atom[]; + readonly atom: Atom; + } + | { + readonly kind: "reachable"; + readonly property: string; + readonly depth: number | undefined; + readonly commands: readonly Atom[]; + readonly witness: readonly ReachStep[]; + readonly target: Atom | undefined; + readonly counts: ReachCounts | undefined; + readonly atom: Atom; + } + | { + readonly kind: "unreachable-within-depth"; + readonly property: string; + readonly depth: number | undefined; + readonly counts: ReachCounts | undefined; + readonly atom: Atom; + } + | { + readonly kind: "reachability-exhausted"; + readonly property: string; + readonly states: number | undefined; + readonly counts: ReachCounts | undefined; + readonly atom: Atom; + } + | { + readonly kind: "reachability-cutoff"; + readonly property: string; + readonly reason: Atom | undefined; + readonly counts: ReachCounts | undefined; + readonly atom: Atom; + } + | { + readonly kind: "undecodable"; + readonly reason: string; + readonly atom: Atom; + }; + +const headName = (atom: Atom): string | undefined => + atom.kind === "expr" && atom.items.length > 0 && atom.items[0]!.kind === "sym" + ? (atom.items[0] as { name: string }).name + : undefined; + +/** The first `(
...): the code is the first item after the head. + const code = atom.kind === "expr" ? symbolValue(atom.items[1]) : undefined; + if (code === undefined) + return { kind: "undecodable", reason: "FuzzInvalid without a symbol code", atom }; + return { + kind: "invalid", + code, + details: atom.kind === "expr" ? atom.items.slice(2) : [], + atom, + }; + } + case "FuzzReachable": { + const property = propertyOf(atom); + if (property === undefined) + return { kind: "undecodable", reason: "FuzzReachable without (Property ...)", atom }; + const commands = fieldValue(atom, "Commands"); + return { + kind: "reachable", + property, + depth: integerValue(fieldValue(atom, "Depth")), + commands: commands?.kind === "expr" ? commands.items : [], + witness: decodeWitness(atom), + target: unquote(fieldValue(atom, "Target")), + counts: decodeReachCounts(atom), + atom, + }; + } + case "FuzzUnreachableWithinDepth": { + const property = propertyOf(atom); + if (property === undefined) + return { + kind: "undecodable", + reason: "FuzzUnreachableWithinDepth without (Property ...)", + atom, + }; + return { + kind: "unreachable-within-depth", + property, + depth: integerValue(fieldValue(atom, "Depth")), + counts: decodeReachCounts(atom), + atom, + }; + } + case "FuzzReachabilityExhausted": { + const property = propertyOf(atom); + if (property === undefined) + return { + kind: "undecodable", + reason: "FuzzReachabilityExhausted without (Property ...)", + atom, + }; + return { + kind: "reachability-exhausted", + property, + states: integerValue(fieldValue(atom, "States")), + counts: decodeReachCounts(atom), + atom, + }; + } + case "FuzzReachabilityCutoff": { + const property = propertyOf(atom); + if (property === undefined) + return { + kind: "undecodable", + reason: "FuzzReachabilityCutoff without (Property ...)", + atom, + }; + return { + kind: "reachability-cutoff", + property, + reason: fieldValue(atom, "Reason"), + counts: decodeReachCounts(atom), + atom, + }; + } + default: + return { kind: "undecodable", reason: `unknown result head ${head}`, atom }; + } +} + +/** Process exit codes. Documented as part of the CLI contract, so scripts can branch on them. */ +export const FUZZ_EXIT_OK = 0; +export const FUZZ_EXIT_PROPERTY_FAILURE = 1; +export const FUZZ_EXIT_INVALID = 2; +export const FUZZ_EXIT_INCOMPLETE = 3; + +export type FuzzExitCode = 0 | 1 | 2 | 3; + +/** The exit code one outcome deserves. + * + * A reachability answer is graded by how complete it is rather than by whether finding the target is + * good news, which the tool cannot know: a replayed witness and a finite exhaustion are both + * definitive answers, while a depth answer and any cutoff are explicitly bounded and report + * incomplete. */ +export function exitCodeForOutcome(outcome: FuzzOutcome): FuzzExitCode { + switch (outcome.kind) { + case "passed": + case "exhaustively-verified": + case "reachable": + case "reachability-exhausted": + return FUZZ_EXIT_OK; + case "failed": + return FUZZ_EXIT_PROPERTY_FAILURE; + case "invalid": + case "undecodable": + return FUZZ_EXIT_INVALID; + case "gave-up": + case "unreachable-within-depth": + case "reachability-cutoff": + return FUZZ_EXIT_INCOMPLETE; + } +} + +// Worst-first precedence for a whole run. An invalid result outranks a property failure because it +// means the run could not be trusted to execute; a property failure outranks an incomplete run +// because a found counterexample is the more actionable finding. +const EXIT_PRECEDENCE: readonly FuzzExitCode[] = [ + FUZZ_EXIT_INVALID, + FUZZ_EXIT_PROPERTY_FAILURE, + FUZZ_EXIT_INCOMPLETE, + FUZZ_EXIT_OK, +]; + +/** The exit code for a set of outcomes: the most severe one present, or OK when there are none. */ +export function exitCodeForOutcomes(outcomes: readonly FuzzOutcome[]): FuzzExitCode { + const seen = new Set(outcomes.map(exitCodeForOutcome)); + for (const code of EXIT_PRECEDENCE) if (seen.has(code)) return code; + return FUZZ_EXIT_OK; +} + +// A witness may be hundreds of commands long, which is unreadable on one line. The head is shown with +// the true total so the elision cannot be mistaken for the whole witness; the full command list is in +// the result atom. +const WITNESS_HEAD = 8; + +function renderCommands(commands: readonly Atom[]): string { + const head = commands.slice(0, WITNESS_HEAD).map(format).join(" "); + return commands.length <= WITNESS_HEAD ? head : `${head} ... (${commands.length} commands)`; +} + +/** A single terminal line for an outcome. The full atom stays available for JSON and artifacts. */ +export function renderOutcomeLine(outcome: FuzzOutcome): string { + switch (outcome.kind) { + case "passed": { + const counts = outcome.statistics?.counts; + const cases = counts === undefined ? "" : ` ${counts.passed} cases`; + const seed = outcome.seed === undefined ? "" : `, seed ${outcome.seed}`; + return `ok ${outcome.property}${cases}${seed}`; + } + case "exhaustively-verified": + return `ok ${outcome.property} exhaustive, ${outcome.domainCount ?? "?"} trees`; + case "failed": { + const smallest = + outcome.smallestValue === undefined ? "" : ` ${format(outcome.smallestValue)}`; + return `FAILED ${outcome.property} ${outcome.failureTag}${smallest}`; + } + case "gave-up": + return `gave up ${outcome.property} ${outcome.reason}`; + case "invalid": + return `invalid ${outcome.code}`; + case "reachable": + return `reached ${outcome.property} in ${outcome.depth ?? "?"} steps: ${renderCommands( + outcome.commands, + )}`; + case "unreachable-within-depth": + return `bounded ${outcome.property} no target at or below depth ${outcome.depth ?? "?"}`; + case "reachability-exhausted": + return `ok ${outcome.property} unreachable in ${outcome.states ?? "?"} states`; + case "reachability-cutoff": + return `cutoff ${outcome.property} ${ + outcome.reason === undefined ? "" : format(outcome.reason) + }`; + case "undecodable": + return `invalid undecodable result: ${outcome.reason}`; + } +} diff --git a/packages/fuzz/src/generated.test.ts b/packages/fuzz/src/generated.test.ts new file mode 100644 index 0000000..d87480c --- /dev/null +++ b/packages/fuzz/src/generated.test.ts @@ -0,0 +1,24 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import { execFileSync } from "node:child_process"; +import { dirname, join } from "node:path"; +import { fileURLToPath } from "node:url"; +import { describe, expect, it } from "vitest"; + +// `pnpm build` already refuses a stale module through `prebuild`, but test runs load +// `src/generated/module.ts` directly, so a stale file would silently execute outdated +// MeTTa sources here. This keeps the freshness check on the test path too. +describe("generated fuzz module", () => { + it("matches the MeTTa sources", () => { + const script = join( + dirname(dirname(fileURLToPath(import.meta.url))), + "scripts", + "generate-module.mjs", + ); + expect(() => + execFileSync(process.execPath, [script, "--check"], { stdio: "pipe" }), + ).not.toThrow(); + }); +}); diff --git a/packages/fuzz/src/generated/module.ts b/packages/fuzz/src/generated/module.ts new file mode 100644 index 0000000..e2926dc --- /dev/null +++ b/packages/fuzz/src/generated/module.ts @@ -0,0 +1,7 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// Generated by scripts/generate-module.mjs. Do not edit. +export const FUZZ_MODULE_SRC = + "; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Private grounded kernel data.\n(: FuzzRng Type)\n(: FuzzDraw Type)\n(: FuzzKernelError Type)\n\n(: _fuzz-rng-init (-> Number Atom))\n(: _fuzz-draw-int (-> Atom Number Number Atom))\n(: _fuzz-atom-key (-> Symbol Atom Atom))\n(: _fuzz-deduplicate-exact (-> Expression Atom))\n(: _fuzz-deduplicate-replay (-> Expression Atom))\n(: _fuzz-exact-member (-> Atom Expression Atom))\n(: _fuzz-replay-member (-> Atom Expression Atom))\n(: _fuzz-make-variable (-> Number Variable))\n(: _fuzz-variable-marker (-> Number Atom))\n(: _fuzz-contains-variable-marker (-> Atom Bool))\n(: _fuzz-materialize-grammar-sample (-> Atom Atom Atom %Undefined%))\n(: _fuzz-expression-append (-> Expression Atom Atom))\n(: _fuzz-expression-concat (-> Expression Expression Expression))\n(: _fuzz-grammar-summary-alternatives (-> Expression Atom Atom))\n(: _fuzz-grammar-summary-replace (-> Expression Atom Expression Atom))\n(: _fuzz-expression-view (-> Atom Atom))\n(: _fuzz-grammar-field-expressions (-> Atom Atom))\n(: _fuzz-grammar-replace-fields (-> Atom Expression Atom))\n(: _fuzz-grammar-index-references (-> Atom Atom))\n(: _fuzz-grammar-template-profile (-> Atom Atom))\n(: _fuzz-grammar-validation-plan (-> Atom Atom))\n(: _fuzz-grammar-template-reference-plan (-> Atom Atom))\n(: _fuzz-atom-ground (-> Atom Bool))\n(: _fuzz-custom-replay-tree (-> Atom Atom Atom))\n(: _fuzz-custom-replay-equal (-> Atom Atom Bool))\n(: _fuzz-float64-bits (-> Number Atom))\n(: _fuzz-float64-from-bits (-> Number Number Number))\n(: _fuzz-float64-index (-> Number Atom))\n(: _fuzz-float64-from-index (-> Number Number))\n(: _fuzz-unicode-character (-> Number Symbol))\n(: _fuzz-replay-equal (-> Atom Atom Bool))\n(: _fuzz-encode-atom (-> Atom Atom))\n(: _fuzz-decode-atom (-> Atom Atom))\n\n; Public generator, driver, sample, and property data.\n(: FuzzGenerator Type)\n(: FuzzDriver Type)\n(: FuzzDecision Type)\n(: FuzzSample Type)\n(: FuzzProperty Type)\n(: FuzzRunResult Type)\n(: FuzzSample (-> Atom Atom Atom FuzzSample))\n(: CustomReplayTree (-> Atom Atom))\n(: CustomReplayProtocolError (-> Atom Expression Atom))\n\n; Reified generator constructors.\n(: gen-const (-> Atom %Undefined%))\n(: gen-bool (-> %Undefined%))\n(: gen-int (-> Number Number %Undefined%))\n(: gen-int-origin (-> Number Number Number %Undefined%))\n(: gen-sized-int (-> %Undefined%))\n(: gen-float (-> %Undefined%))\n(: gen-float-range (-> Number Number %Undefined%))\n(: gen-float-bits (-> %Undefined%))\n(: gen-char (-> %Undefined%))\n(: gen-char-ascii (-> %Undefined%))\n(: gen-char-unicode (-> %Undefined%))\n(: gen-string (-> %Undefined% Number Number %Undefined%))\n(: gen-ascii-string (-> Number Number %Undefined%))\n(: gen-unicode-string (-> Number Number %Undefined%))\n(: gen-symbol (-> %Undefined%))\n(: gen-symbol-range (-> Number Number %Undefined%))\n(: gen-syntax-token (-> %Undefined%))\n(: gen-syntax-token-range (-> Number Number %Undefined%))\n(: gen-element (-> Expression %Undefined%))\n(: gen-frequency (-> Expression %Undefined%))\n(: gen-one-of (-> Expression %Undefined%))\n(: gen-tuple (-> Expression %Undefined%))\n(: gen-list (-> %Undefined% Number Number %Undefined%))\n(: gen-option (-> %Undefined% %Undefined%))\n(: gen-map (-> Atom %Undefined% %Undefined%))\n(: gen-bind (-> Atom %Undefined% %Undefined%))\n(: gen-filter (-> %Undefined% Atom Number %Undefined%))\n(: gen-sized (-> Atom %Undefined%))\n(: gen-resize (-> Number %Undefined% %Undefined%))\n(: gen-recursive (-> %Undefined% Atom %Undefined%))\n(: gen-custom (-> Atom Expression %Undefined%))\n(: gen-grammar (-> Atom %Undefined%))\n(: gen-grammar-root (-> Atom Atom %Undefined%))\n(: gen-well-typed (-> Atom Atom %Undefined%))\n\n; Grammar schemas are syntax data. Quoted carriers and Atom or Expression parameters keep templates,\n; nonterminals, and binding sorts unreduced while MeTTa relations validate and interpret their markers.\n(: FuzzTypeConstructors (-> Expression Atom))\n(: GrammarProduction (-> Number Number Atom Atom Atom))\n(: GrammarValidationTask (-> Atom Expression Atom))\n(: GrammarFitTask (-> Atom Expression Number Atom))\n(: GrammarRequest (-> Atom Atom Expression Number Atom))\n(: StaticGrammar (-> Atom Expression Atom))\n(: StaticTypeGrammar (-> Atom Expression Atom))\n(: DynamicTypeGrammar (-> Atom Atom))\n(: GrammarResult (-> Atom Atom Number Atom Atom))\n(: GrammarChildrenResult (-> Expression Atom Number Expression Number Atom))\n(: GrammarFieldExpressions (-> Expression Atom))\n(: FuzzExpressionView (-> Atom Expression Expression Atom))\n(: FuzzAtomLeaf (-> Atom))\n(: GrammarGeneratorValidationTask (-> Atom Atom))\n(: ResolvedGrammarField (-> Atom Atom))\n(: ResolvedGrammarFields (-> Expression Atom))\n(: NormalizedGrammarTemplate (-> Atom Atom))\n(: PreparedGrammarTemplate (-> Atom Number Number Number Number Atom))\n(: ValidatedGrammarProductions (-> Expression Number Atom))\n(: ValidatedGrammar (-> Atom Atom Expression Number Atom))\n(: PreparedTypeConstructors (-> Expression Number Atom))\n(: ValidatedTypeGrammar (-> Atom Atom Expression Number Atom))\n(: GrammarRequirementAlternative (-> Expression Atom))\n(: GrammarRequirementAlternatives (-> Expression Atom))\n(: GrammarRequirementSummaryEntry (-> Atom Expression Atom))\n(: GrammarSummaryMergeState (-> Bool Expression Atom))\n(: GrammarProductivityPassState (-> Bool Expression Atom))\n(: GrammarProductivityPass (-> Bool Expression Atom))\n(: GrammarMissingTarget (-> Atom Atom))\n(: GrammarRequirementStack (-> Expression Atom))\n(: GrammarValidationPlan (-> Expression Atom))\n(: GrammarValidationState (-> Expression Expression Atom))\n(: GrammarReferenceTargets (-> Expression Atom))\n(: GrammarBindingValidationState\n (-> Expression Expression Number Atom))\n(: _fuzz-grammar-generator-validation-tasks\n (-> Expression %Undefined% %Undefined%))\n(: _fuzz-grammar-generator-child-task (-> Atom %Undefined% %Undefined%))\n(: _fuzz-grammar-frequency-validation\n (-> Expression %Undefined% Number %Undefined%))\n(: _fuzz-validate-grammar-field-generator (-> Atom %Undefined%))\n(: _fuzz-grammar-field-from-results (-> Atom Expression %Undefined%))\n(: _fuzz-resolve-grammar-field (-> Atom %Undefined%))\n(: _fuzz-resolve-grammar-fields-loop\n (-> Expression %Undefined% %Undefined%))\n(: _fuzz-normalize-grammar-template-fields (-> Atom %Undefined%))\n(: _fuzz-prepare-grammar-template (-> Atom Atom %Undefined%))\n(: _fuzz-grammar-template-switch (-> Atom Expression %Undefined%))\n(: _fuzz-normalize-grammar-productions (-> Atom Expression %Undefined%))\n(: _fuzz-build-grammar (-> Atom Atom Expression %Undefined%))\n(: _fuzz-grammar-target-member (-> Atom Expression %Undefined%))\n(: _fuzz-grammar-add-target (-> Atom Expression %Undefined%))\n(: _fuzz-grammar-reference-targets-loop\n (-> Expression Expression %Undefined%))\n(: _fuzz-grammar-reference-targets (-> Expression %Undefined%))\n(: _fuzz-validate-normalized-grammar\n (-> Atom Atom Expression Number %Undefined%))\n(: _fuzz-grammar-from-results\n (-> Atom Atom Expression %Undefined%))\n(: _fuzz-gen-grammar-root-ground\n (-> Atom Atom %Undefined%))\n(: _fuzz-normalize-type-constructors-loop\n (-> Atom Atom Expression Number %Undefined% Number %Undefined%))\n(: _fuzz-normalize-type-constructors (-> Atom Atom Expression %Undefined%))\n(: _fuzz-static-productions-for-target-loop\n (-> Expression Atom Expression %Undefined%))\n(: _fuzz-source-productions (-> Atom Atom %Undefined%))\n(: _fuzz-type-schema-from-results\n (-> Atom Atom Expression %Undefined%))\n(: _fuzz-finalize-type-grammar\n (-> Atom Atom Expression Number %Undefined%))\n(: _fuzz-build-type-grammar-prepared\n (-> Atom Atom Atom Expression Expression Expression Number Number Expression Number %Undefined%))\n(: _fuzz-build-type-grammar-available\n (-> Atom Atom Atom Expression Expression Expression Number Number Atom %Undefined%))\n(: _fuzz-build-type-grammar-type\n (-> Atom Atom Atom Expression Expression Expression Number Number %Undefined%))\n(: _fuzz-build-type-grammar-loop\n (-> Atom Atom Expression Expression Expression Number Number %Undefined%))\n(: _fuzz-build-type-grammar\n (-> Atom Atom %Undefined%))\n(: _fuzz-gen-well-typed-ground\n (-> Atom Atom %Undefined%))\n(: _fuzz-validate-grammar-template (-> Atom Atom %Undefined%))\n(: _fuzz-validate-grammar-binding-step\n (-> Atom Atom %Undefined%))\n(: _fuzz-validate-grammar-bindings (-> Expression %Undefined%))\n(: _fuzz-grammar-validation-enter-scope\n (-> Atom Expression Expression Expression %Undefined%))\n(: _fuzz-grammar-validation-exit-scope\n (-> Expression Expression %Undefined%))\n(: _fuzz-grammar-validation-event\n (-> Atom Atom Atom %Undefined%))\n(: _fuzz-grammar-validation-from-fold\n (-> Atom Atom %Undefined%))\n(: _fuzz-template-reference-targets (-> Atom %Undefined% %Undefined%))\n(: _fuzz-template-reference-target-step\n (-> Expression Atom %Undefined%))\n(: _fuzz-grammar-summary-merge-alternative\n (-> Bool Atom Expression Atom %Undefined%))\n(: _fuzz-grammar-summary-merge-step\n (-> Atom Atom Atom %Undefined%))\n(: _fuzz-grammar-summary-merge\n (-> Atom Expression Expression %Undefined%))\n(: _fuzz-grammar-template-requirements\n (-> Atom Expression %Undefined%))\n(: _fuzz-grammar-summary-has-target\n (-> Atom Expression %Undefined%))\n(: _fuzz-grammar-summary-has-closed-target\n (-> Atom Expression %Undefined%))\n(: _fuzz-first-unsummarized-target-step\n (-> Atom Atom Expression %Undefined%))\n(: _fuzz-first-unsummarized-target\n (-> Expression Expression %Undefined%))\n(: _fuzz-grammar-all-targets-summarized-step\n (-> Atom Atom Expression %Undefined%))\n(: _fuzz-grammar-all-targets-summarized\n (-> Expression Expression %Undefined%))\n(: _fuzz-grammar-productivity-result\n (-> Atom Atom Expression Expression %Undefined%))\n(: _fuzz-grammar-productivity-fixedpoint\n (-> Atom Atom Expression Expression Expression %Undefined%))\n(: _fuzz-validate-grammar-productivity\n (-> Atom Atom Expression Expression %Undefined%))\n(: _fuzz-grammar-scope-has-id-step\n (-> Bool Atom Number Bool))\n(: _fuzz-grammar-scope-has-id (-> Expression Number Bool))\n(: _fuzz-grammar-scopes-disjoint-step\n (-> Bool Atom Expression Bool))\n(: _fuzz-grammar-scopes-disjoint (-> Expression Expression Bool))\n(: _fuzz-grammar-scope-values\n (-> Expression Atom Expression %Undefined%))\n(: _fuzz-eligible-productions\n (-> Atom Atom Expression Number %Undefined%))\n(: _fuzz-generate-grammar-nonterminal\n (-> Atom Atom Expression Number Atom Number %Undefined%))\n\n; Driver constructors and one-sample entry points.\n(: fuzz-random-driver (-> Number %Undefined%))\n(: fuzz-edge-driver (-> Number %Undefined%))\n(: fuzz-replay-driver (-> Atom %Undefined%))\n(: fuzz-exhaustive-driver (-> %Undefined%))\n(: _fuzz-exhaustive-resume-driver (-> Atom %Undefined%))\n(: _fuzz-exhaustive-next-plan (-> Atom %Undefined%))\n(: _fuzz-exhaustive-plan-prefix (-> Atom Atom %Undefined%))\n(: ExhaustiveCursor (-> Atom Number Atom Atom))\n(: ExhaustiveFrame (-> Number Number Atom))\n(: ExhaustivePlan (-> Atom Atom))\n(: fuzz-enumerate (-> %Undefined% Number Number %Undefined%))\n(: FrequencyIndexChoice (-> Number Atom Atom Atom Atom))\n(: FuzzEnumerateRun (-> Atom Number Number Atom Number Number Number Atom Atom))\n(: FuzzEnumeration (-> Atom Atom Atom Atom Atom))\n(: FuzzEnumerationTruncated (-> Atom Atom Atom Atom Atom))\n(: fuzz-bytes-driver (-> Expression %Undefined%))\n(: fuzz-generate (-> %Undefined% %Undefined% Number %Undefined%))\n(: fuzz-generate-random (-> %Undefined% Number Number %Undefined%))\n(: fuzz-generate-edge (-> %Undefined% Number Number %Undefined%))\n(: fuzz-generate-bytes (-> %Undefined% Expression Number %Undefined%))\n(: fuzz-replay (-> %Undefined% Atom Number %Undefined%))\n(: _fuzz-shrink-replay (-> %Undefined% Atom Number %Undefined%))\n\n; Property outcomes and case classification.\n(: _fuzz-eval-case (-> Atom Number Number Atom Atom))\n(: fuzz-pass (-> FuzzProperty))\n(: fuzz-fail (-> Atom Atom FuzzProperty))\n(: fuzz-discard (-> Atom FuzzProperty))\n(: expect-true (-> Bool Atom FuzzProperty))\n(: expect-false (-> Bool Atom FuzzProperty))\n(: expect-atom-equal (-> %Undefined% %Undefined% FuzzProperty))\n(: expect-alpha-equal (-> %Undefined% %Undefined% FuzzProperty))\n(: expect-results-exact (-> %Undefined% %Undefined% FuzzProperty))\n(: expect-results-alpha (-> %Undefined% %Undefined% FuzzProperty))\n(: expect-results-multiset (-> %Undefined% %Undefined% FuzzProperty))\n(: expect-results-set (-> %Undefined% %Undefined% FuzzProperty))\n(: implies (-> Bool Atom FuzzProperty))\n(: classify (-> Bool %Undefined% Atom FuzzProperty))\n(: collect (-> %Undefined% Atom FuzzProperty))\n(: cover (-> Number Bool %Undefined% Atom FuzzProperty))\n(: counterexample (-> %Undefined% Atom FuzzProperty))\n(: all-results (-> Atom Atom))\n(: any-result (-> Atom Atom))\n(: fuzz-equal (-> %Undefined% %Undefined% FuzzProperty))\n(: fuzz-alpha-equal (-> %Undefined% %Undefined% FuzzProperty))\n(: fuzz-implies (-> Bool Atom FuzzProperty))\n(: fuzz-annotate (-> %Undefined% Atom FuzzProperty))\n(: fuzz-classify (-> Bool %Undefined% Atom FuzzProperty))\n(: fuzz-collect (-> %Undefined% Atom FuzzProperty))\n(: fuzz-cover (-> Number %Undefined% Bool Atom FuzzProperty))\n(: _fuzz-normalize-property-result (-> Atom %Undefined%))\n(: _fuzz-evaluate-property (-> Atom Atom Atom Number Number Atom %Undefined%))\n(: fuzz-default-config (-> %Undefined%))\n(: fuzz-check (-> Atom %Undefined% Atom %Undefined% %Undefined%))\n(: fuzz-check-exhaustive (-> Atom %Undefined% Atom %Undefined% %Undefined%))\n(: _fuzz-check-with (-> Atom %Undefined% Atom %Undefined% Atom %Undefined%))\n\n; Model-based state machines.\n(: FuzzMachine Type)\n(: gen-machine (-> Atom %Undefined%))\n(: fuzz-check-machine (-> Atom %Undefined% %Undefined%))\n(: _fuzz-machine-spec (-> Atom %Undefined%))\n(: _fuzz-machine-spec-results (-> Atom Expression %Undefined%))\n(: _fuzz-machine-call-zero (-> Atom Atom %Undefined%))\n(: _fuzz-machine-call-two (-> Atom Atom Atom Atom %Undefined%))\n(: _fuzz-machine-call-three (-> Atom Atom Atom Atom Atom %Undefined%))\n(: _fuzz-machine-bool-two (-> Atom Atom Atom Atom %Undefined%))\n(: _fuzz-machine-command-descriptor (-> Atom Atom %Undefined%))\n(: MachineDraw (-> Atom Atom Atom Atom Number Number Atom Atom))\n(: MachineCommandDrawn (-> Atom Atom Atom Atom))\n(: MachineSpec (-> Atom Atom Atom Atom Atom Atom Atom Atom Atom Atom))\n(: MachineSequence (-> Atom Atom Atom))\n(: ValidMachineSpec (-> Atom Atom))\n(: FuzzMachineRun (-> Atom Atom Atom Atom))\n(: MachineGenRun (-> Atom Atom Atom Number Atom Number Atom Atom Atom))\n(: MachineExecRun (-> Atom Atom Atom Atom Number Atom))\n(: MachineVerdict (-> Atom Atom))\n; Bounded state reachability. The search-state constructors take their payload as Atom so a state\n; or command carried across a loop iteration is never re-evaluated.\n(: fuzz-reachable (-> Atom %Undefined% Atom Atom Atom %Undefined% %Undefined%))\n(: reach-config-defaults (-> %Undefined%))\n(: FuzzReachEquivariant (-> Atom Atom))\n(: ReachSpec (-> Atom Atom Atom Atom Atom Atom Atom))\n(: ReachRun (-> Atom Atom Atom Atom Atom Number Atom Atom Atom))\n(: ReachNode (-> Atom Atom Atom))\n(: ReachCounts (-> Number Number Atom))\n(: ReachCommands (-> Atom Atom Atom Number Atom))\n(: ReachBranches (-> Atom Atom Atom Number Atom Number Atom))\n(: ReachReplay (-> Atom Atom Atom Number Atom))\n(: ReachConfigValues (-> Atom Atom Atom Atom Atom))\n(: ReachConfigFold (-> Atom Expression Atom))\n(: ReachKey (-> Atom Atom))\n(: ReachUnkeyable (-> Atom Atom Atom))\n(: ReachItem (-> Atom Atom))\n(: ReachFinite (-> Expression Atom))\n(: ReachIncomplete (-> Atom Atom))\n(: ReachMalformed (-> Atom Atom))\n(: ReachFound (-> Atom Atom Atom))\n(: ReachExhausted (-> Number Atom))\n(: ReachUnreachableWithinDepth (-> Number Atom))\n(: ReachCutoff (-> Atom Atom))\n(: ReachReplayState (-> Atom Atom))\n(: ReachReplayed (-> Atom Atom))\n(: ReachReplayFailed (-> Atom Atom))\n(: Step (-> Number Atom Number Atom))\n(: CallAll (-> Atom Atom))\n(: _fuzz-call-all-two (-> Atom Atom Atom Atom %Undefined%))\n(: _fuzz-call-all-results (-> %Undefined% Atom %Undefined%))\n(: _fuzz-pair-values (-> %Undefined% %Undefined%))\n(: _fuzz-expression-head (-> Atom %Undefined%))\n(: _fuzz-reach-bound-value (-> Atom Bool))\n(: _fuzz-reach-config-set (-> Atom Atom %Undefined%))\n(: _fuzz-reach-config-values (-> Atom %Undefined%))\n(: _fuzz-reach-config-get (-> Atom Atom %Undefined%))\n(: _fuzz-reach-state-key (-> Atom Atom %Undefined%))\n(: _fuzz-reach-command-items (-> Atom %Undefined%))\n(: _fuzz-reach-nth (-> Atom Number %Undefined%))\n(: _fuzz-reach-cutoff (-> Atom Atom %Undefined%))\n(: _fuzz-reach-searching (-> Atom Bool))\n(: _fuzz-reach-at-depth-limit (-> Number Atom Bool))\n(: _fuzz-reach-note-beyond-depth (-> Atom Atom %Undefined%))\n(: _fuzz-reach-expand (-> Atom Atom %Undefined%))\n(: _fuzz-reach-apply (-> Atom Atom Atom Number %Undefined%))\n(: _fuzz-reach-visit (-> Atom Atom Atom Number Number Atom %Undefined%))\n(: _fuzz-reach-judge (-> Atom Atom Atom Atom %Undefined%))\n(: _fuzz-reach-target (-> Atom Atom Atom Atom Atom %Undefined%))\n(: _fuzz-reach-enqueue (-> Atom Atom Atom Atom Atom %Undefined%))\n(: _fuzz-reach-confirm (-> Atom Atom Atom %Undefined%))\n(: _fuzz-reach-same-state (-> Atom Atom Atom Bool))\n(: _fuzz-reach-replay (-> Atom Atom %Undefined%))\n(: _fuzz-reach-replay-apply (-> Atom Atom Atom Number %Undefined%))\n(: _fuzz-reach-replay-transition (-> Atom Atom Atom Number Number %Undefined%))\n(: _fuzz-reach-identity-permitted (-> Atom Atom Bool))\n(: _fuzz-reach-start (-> Atom Atom Atom Atom Atom Atom %Undefined%))\n(: _fuzz-reach-run (-> Atom Atom Atom %Undefined%))\n(: _fuzz-reach-report (-> Atom %Undefined%))\n(: _fuzz-reach-witness-commands (-> Atom %Undefined%))\n(: ReachWitnessFold (-> Atom Atom Atom))\n(: FuzzPairValuesFold (-> Atom Atom Atom))\n(: FuzzLeafDistanceFold (-> Atom Atom Atom))\n(: FuzzRepeatFold (-> Atom Number Atom Atom))\n\n(: FuzzExhaustiveRun (-> Atom Atom Atom Atom Atom Atom Number Number Atom Atom))\n(: FuzzExhaustivelyVerified (-> Atom Atom Atom Atom Atom))\n(: ExhaustiveStatistics (-> Atom Atom Atom Atom))\n\n; Helpers that intentionally receive generated expressions as data.\n(: _fuzz-if-generation-error (-> %Undefined% Atom %Undefined%))\n(: _fuzz-is-integer (-> Number Bool))\n(: _fuzz-expected-integer (-> Atom Number %Undefined%))\n(: _fuzz-call-results-bind (-> %Undefined% Atom %Undefined%))\n(: _fuzz-bool-result (-> Atom Atom %Undefined%))\n(: CallOne (-> Atom Atom))\n(: _fuzz-call-one (-> Atom Atom Atom %Undefined%))\n(: _fuzz-call-bool (-> Atom Atom Atom %Undefined%))\n(: _fuzz-driver-int (-> %Undefined% Number Number Number %Undefined%))\n(: _fuzz-byte-width (-> Number Number Number Number))\n(: _fuzz-read-bytes (-> Expression Number Number Number %Undefined%))\n(: _fuzz-generate-many (-> Expression %Undefined% Number Expression Expression %Undefined%))\n(: _fuzz-generate-filter (-> %Undefined% Atom Number Number %Undefined% Number Expression %Undefined%))\n(: _fuzz-wrap-sample (-> Atom Atom Atom %Undefined% %Undefined%))\n(: _fuzz-two-children (-> Atom Atom Expression))\n(: _fuzz-repeat-generator (-> Atom Number Expression))\n(: CustomCapabilities (-> Atom Expression %Undefined%))\n(: DriveCustom (-> Atom Expression Atom Number %Undefined%))\n(: EdgeChoices (-> Atom Expression Number %Undefined%))\n(: ShrinkChoices (-> Atom Expression Atom %Undefined%))\n(: FuzzTypeSchema (-> Atom Atom %Undefined%))\n\n; ---- grammar machine ----\n; Constructors and relations of the generation machine and the productivity worklist. Every\n; slot that carries raw template syntax or generated values is Atom-typed: an Atom parameter\n; is not reduced at a call or construction, which is what keeps held user syntax unevaluated\n; through the machine.\n(: FuzzStack (-> Atom Atom Atom))\n(: FuzzStackTake (-> Expression Atom Atom))\n(: GF (-> Atom Atom Atom))\n(: FPlan (-> Expression Number Number Number Atom))\n(: FExpr (-> Number Number Number Atom))\n(: FRef (-> Atom Atom))\n(: FProd (-> Atom Number Number Atom Atom))\n(: FBind (-> Atom Number Atom Atom))\n(: FScoped (-> Expression Atom))\n(: FScope (-> Atom Atom))\n(: FuzzGenRun (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom))\n(: FuzzGenCut (-> Atom Atom Atom Number Atom Number Atom Atom Atom Atom))\n(: FuzzGenDone (-> Atom Atom))\n(: GILit (-> Atom Atom))\n(: GIField (-> Atom Atom))\n(: GIRef (-> Atom Number Number Atom))\n(: GIFresh (-> Atom Atom))\n(: GIUse (-> Atom Atom))\n(: GIBind (-> Atom Expression Atom))\n(: GIScoped (-> Expression Number Atom Expression Atom))\n(: GIExprEnter (-> Number Atom))\n(: GIExprBuild (-> Atom))\n(: GrammarTemplatePlan (-> Expression Atom))\n(: GrammarAlternativesAdd (-> Bool Expression Atom))\n(: GrammarProductions (-> Expression Atom))\n(: GrammarDependents (-> Expression Atom))\n(: EligibleGrammarProductions (-> Expression Atom))\n(: FitDuplicateGrammarBindingId (-> Atom Atom))\n(: FuzzProductivityQueue (-> Expression Atom Expression Atom))\n(: _fuzz-gen-loop (-> %Undefined% %Undefined%))\n(: _fuzz-gen-finished (-> %Undefined% Bool))\n(: _fuzz-gen-step (-> %Undefined% %Undefined%))\n(: _fuzz-gen-push\n (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Atom %Undefined%))\n(: _fuzz-gen-run-step\n (-> Atom Atom Atom Number Atom Number Atom Number Atom %Undefined%))\n(: _fuzz-gen-cut-step\n (-> Atom Atom Atom Number Atom Number Atom Atom Atom %Undefined%))\n(: _fuzz-gen-instr\n (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Number %Undefined%))\n(: _fuzz-gen-insert-expr (-> Atom Number Number Number Atom))\n(: _fuzz-gen-field\n (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Atom %Undefined%))\n(: _fuzz-gen-use\n (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom %Undefined%))\n(: _fuzz-gen-nonterminal\n (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Number %Undefined%))\n(: _fuzz-gen-choose\n (-> Atom Atom Atom Number Atom Number Atom Number Atom Number Expression Atom %Undefined%))\n(: _fuzz-eligible-productions (-> Atom Atom Expression Number %Undefined%))\n(: _fuzz-eligible-productions-checked (-> Expression Atom Expression Number %Undefined%))\n(: _fuzz-grammar-summary-merge-candidate\n (-> Bool Expression Expression Expression Atom %Undefined%))\n(: _fuzz-productivity-done (-> %Undefined% Bool))\n(: _fuzz-productivity-changed (-> Expression Atom Atom Expression %Undefined%))\n(: _fuzz-productivity-analyze (-> Expression Atom Expression Atom Atom %Undefined%))\n(: _fuzz-productivity-step (-> %Undefined% %Undefined%))\n(: _fuzz-productivity-loop (-> %Undefined% %Undefined%))\n(: _fuzz-grammar-template-requirements-op (-> Atom Expression Atom))\n(: _fuzz-grammar-eligible-productions-op (-> Expression Atom Expression Number Atom))\n(: _fuzz-grammar-dependents-of (-> Expression Atom Atom))\n(: _fuzz-index-stack (-> Number Atom))\n(: _fuzz-stack-take (-> Atom Number Atom))\n(: _fuzz-stack-push-all (-> Atom Expression Atom))\n(: _fuzz-grammar-template-plan (-> Atom Atom))\n(: _fuzz-grammar-alternatives-add (-> Expression Expression Atom))\n(: GrammarMachineStart (-> Atom Atom Expression Number Atom Atom))\n(: GrammarMachineResume (-> Atom Atom Atom))\n(: GrammarMachineDone (-> Atom Atom))\n(: GrammarMachineNeed (-> Atom Atom Atom))\n(: EvaluateGenerator (-> Atom Atom Number Atom))\n(: WithDriver (-> Atom Number Atom))\n(: _fuzz-grammar-machine-op (-> Atom Atom))\n(: _fuzz-gen-trampoline (-> %Undefined% %Undefined%))\n(: _fuzz-generate-grammar-nonterminal-reference\n (-> Atom Atom Expression Number Atom Number %Undefined%))\n(: FuzzDecisionLeaves (-> Expression Atom))\n(: _fuzz-decision-leaves-op (-> Atom Atom))\n(: GrammarUnproductive (-> Atom Atom))\n(: _fuzz-grammar-productivity-op (-> Expression Atom Expression Atom))\n(: _fuzz-validate-grammar-productivity-reference\n (-> Atom Atom Expression Expression %Undefined%))\n(: GrammarTargets (-> Expression Atom))\n(: GrammarMissingReference (-> Atom Atom))\n(: FuzzNormalizeWalk (-> Atom Atom Number Atom Number Atom))\n(: _fuzz-grammar-targets-op (-> Expression Atom))\n(: _fuzz-grammar-validate-references-op (-> Expression Expression Atom))\n(: _fuzz-stack-to-expression (-> Atom Atom))\n(: _fuzz-normalize-walk-done (-> %Undefined% Bool))\n(: _fuzz-normalize-walk-step (-> %Undefined% %Undefined%))\n(: _fuzz-normalize-walk-loop (-> %Undefined% %Undefined%))\n(: _fuzz-normalize-walk-prepared\n (-> Atom Atom Number Atom Number Number Atom Atom %Undefined%))\n(: _fuzz-validated-references\n (-> Atom Atom Expression Number Expression %Undefined%))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Constructor errors remain normal MeTTa data so callers can report them without a host exception.\n(= (_fuzz-generation-error $code $details)\n (FuzzGenerationError $code (Details $details)))\n\n(= (_fuzz-generation-error $code $first $second)\n (FuzzGenerationError $code (Details $first $second)))\n\n(= (_fuzz-generation-error $code $first $second $third)\n (FuzzGenerationError $code (Details $first $second $third)))\n\n(= (_fuzz-generation-error $code $first $second $third $fourth)\n (FuzzGenerationError\n $code\n (Details $first $second $third $fourth)))\n\n(= (_fuzz-if-generation-error $candidate $otherwise)\n (switch $candidate\n (((FuzzGenerationError $code $details) $candidate)\n ($valid $otherwise))))\n\n(= (_fuzz-is-integer $value)\n (and\n (== (isnan-math $value) False)\n (and\n (== (isinf-math $value) False)\n (== $value (trunc-math $value)))))\n\n(= (_fuzz-expected-integer $parameter $value)\n (_fuzz-generation-error ExpectedInteger\n (Parameter $parameter)\n (Value $value)))\n\n(= (_fuzz-default-int-origin $lower $upper)\n (if (and (<= $lower 0) (>= $upper 0))\n 0\n (if (> $lower 0) $lower $upper)))\n\n(= (_fuzz-default-float-origin $lower-index $upper-index)\n (_fuzz-default-int-origin $lower-index $upper-index))\n\n(= (_fuzz-validated-float-index $parameter $value)\n (let $indexed (_fuzz-float64-index $value)\n (switch $indexed\n (((Float64Index $index)\n (if (and\n (<= -9218868437227405312 $index)\n (<= $index 9218868437227405311))\n (ValidatedFloatIndex $index)\n (_fuzz-generation-error\n NonFiniteFloatBound\n (Parameter $parameter)\n (Value $value))))\n ((FuzzKernelError InvalidFloat $operation ExpectedFloat)\n (_fuzz-generation-error\n ExpectedFloat\n (Parameter $parameter)\n (Value $value)))\n ((FuzzKernelError InvalidFloat $operation NaNHasNoOrderedIndex)\n (_fuzz-generation-error\n NaNFloatBound\n (Parameter $parameter)\n (Value $value)))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $indexed)))\n ($bad\n (_fuzz-generation-error\n MalformedFloatIndex\n (OperationResult $bad)))))))\n\n(= (gen-const $value)\n (GenConst $value))\n\n(= (gen-bool)\n (GenBool))\n\n(= (gen-int $lower $upper)\n (if (_fuzz-is-integer $lower)\n (if (_fuzz-is-integer $upper)\n (if (<= $lower $upper)\n (GenInt $lower $upper (_fuzz-default-int-origin $lower $upper))\n (_fuzz-generation-error InvalidIntegerBounds (Bounds $lower $upper)))\n (_fuzz-expected-integer UpperBound $upper))\n (_fuzz-expected-integer LowerBound $lower)))\n\n(= (gen-int-origin $lower $upper $origin)\n (if (_fuzz-is-integer $lower)\n (if (_fuzz-is-integer $upper)\n (if (<= $lower $upper)\n (if (_fuzz-is-integer $origin)\n (if (and (<= $lower $origin) (<= $origin $upper))\n (GenInt $lower $upper $origin)\n (_fuzz-generation-error InvalidIntegerOrigin\n (Bounds $lower $upper)\n (Origin $origin)))\n (_fuzz-expected-integer Origin $origin))\n (_fuzz-generation-error InvalidIntegerBounds (Bounds $lower $upper)))\n (_fuzz-expected-integer UpperBound $upper))\n (_fuzz-expected-integer LowerBound $lower)))\n\n(= (gen-sized-int)\n (GenSized _fuzz-sized-int-generator))\n\n(: _fuzz-sized-int-generator (-> Number %Undefined%))\n(= (_fuzz-sized-int-generator $size)\n (gen-int (- 0 $size) $size))\n\n(= (gen-float)\n (GenFloatRange\n -9218868437227405312\n 9218868437227405311\n 0))\n\n(= (_fuzz-float-range-from-upper\n $lower\n $upper\n $lower-index\n $upper-result)\n (switch $upper-result\n (((FuzzGenerationError $code $details) $upper-result)\n ((ValidatedFloatIndex $upper-index)\n (if (<= $lower-index $upper-index)\n (GenFloatRange\n $lower-index\n $upper-index\n (_fuzz-default-float-origin\n $lower-index\n $upper-index))\n (_fuzz-generation-error\n InvalidFloatBounds\n (Bounds $lower $upper))))\n ($bad\n (_fuzz-generation-error\n MalformedFloatIndex\n (OperationResult $bad))))))\n\n(= (_fuzz-float-range-from-lower\n $lower\n $upper\n $lower-result)\n (switch $lower-result\n (((FuzzGenerationError $code $details) $lower-result)\n ((ValidatedFloatIndex $lower-index)\n (_fuzz-float-range-from-upper\n $lower\n $upper\n $lower-index\n (_fuzz-validated-float-index UpperBound $upper)))\n ($bad\n (_fuzz-generation-error\n MalformedFloatIndex\n (OperationResult $bad))))))\n\n(= (gen-float-range $lower $upper)\n (_fuzz-float-range-from-lower\n $lower\n $upper\n (_fuzz-validated-float-index LowerBound $lower)))\n\n(= (gen-float-bits)\n (GenFloatBits))\n\n(= (_fuzz-character-from-index $index)\n (_fuzz-unicode-character $index))\n\n(= (_fuzz-characters $characters)\n (stringToChars $characters))\n\n(= (gen-char)\n (gen-map\n _fuzz-character-from-index\n (gen-int 32 126)))\n\n(= (gen-char-ascii)\n (gen-map\n _fuzz-character-from-index\n (gen-int 0 127)))\n\n(= (gen-char-unicode)\n (gen-map\n _fuzz-character-from-index\n (gen-int 0 1112061)))\n\n(= (_fuzz-characters-to-string $characters)\n (charsToString $characters))\n\n(= (gen-string $character-generator $minimum $maximum)\n (gen-map\n _fuzz-characters-to-string\n (gen-list\n $character-generator\n $minimum\n $maximum)))\n\n(= (gen-ascii-string $minimum $maximum)\n (gen-string\n (gen-char-ascii)\n $minimum\n $maximum))\n\n(= (gen-unicode-string $minimum $maximum)\n (gen-string\n (gen-char-unicode)\n $minimum\n $maximum))\n\n(= (_fuzz-parser-safe-first-characters)\n (_fuzz-characters\n \"abcdefghijklmnopqrstuvwxyz_\"))\n\n(= (_fuzz-parser-safe-rest-characters)\n (_fuzz-characters\n \"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-*/<>=!?\"))\n\n(= (_fuzz-symbol-from-parts $parts)\n (switch $parts\n ((($first $rest)\n (let $characters (cons-atom $first $rest)\n (let $name (charsToString $characters)\n (atom_concat $name))))\n ($bad\n (_fuzz-generation-error\n MalformedSymbolParts\n (Value $bad))))))\n\n(= (gen-symbol-range $minimum $maximum)\n (if (_fuzz-is-integer $minimum)\n (if (_fuzz-is-integer $maximum)\n (if (and\n (<= 1 $minimum)\n (<= $minimum $maximum))\n (gen-map\n _fuzz-symbol-from-parts\n (gen-tuple\n ((gen-element\n (_fuzz-parser-safe-first-characters))\n (gen-list\n (gen-element\n (_fuzz-parser-safe-rest-characters))\n (- $minimum 1)\n (- $maximum 1)))))\n (_fuzz-generation-error\n InvalidSymbolLengthBounds\n (Minimum $minimum)\n (Maximum $maximum)))\n (_fuzz-expected-integer\n MaximumLength\n $maximum))\n (_fuzz-expected-integer\n MinimumLength\n $minimum)))\n\n(= (_fuzz-symbol-at-size $size)\n (gen-symbol-range 1 (max 1 $size)))\n\n(= (gen-symbol)\n (gen-sized _fuzz-symbol-at-size))\n\n(= (_fuzz-syntax-token-characters)\n (_fuzz-characters\n \"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$!+-*/<>=?.,:@#%^&|~`'[]{}\\\\\"))\n\n(= (gen-syntax-token-range $minimum $maximum)\n (if (_fuzz-is-integer $minimum)\n (if (_fuzz-is-integer $maximum)\n (if (and\n (<= 1 $minimum)\n (<= $minimum $maximum))\n (gen-string\n (gen-element\n (_fuzz-syntax-token-characters))\n $minimum\n $maximum)\n (_fuzz-generation-error\n InvalidTokenLengthBounds\n (Minimum $minimum)\n (Maximum $maximum)))\n (_fuzz-expected-integer\n MaximumLength\n $maximum))\n (_fuzz-expected-integer\n MinimumLength\n $minimum)))\n\n(= (_fuzz-syntax-token-at-size $size)\n (gen-syntax-token-range 1 (max 1 $size)))\n\n(= (gen-syntax-token)\n (gen-sized _fuzz-syntax-token-at-size))\n\n(= (gen-element $values)\n (if (> (length $values) 0)\n (GenElement $values)\n (_fuzz-generation-error EmptyElementSet (Values $values))))\n\n(= (_fuzz-frequency-total $entries $total)\n (if (== $entries ())\n (if (> $total 0)\n (FrequencyTotal $total)\n (_fuzz-generation-error EmptyFrequency (Entries $entries)))\n (let* ((($entry $tail) (decons-atom $entries)))\n (switch $entry\n ((($weight $generator)\n (if (_fuzz-is-integer $weight)\n (if (> $weight 0)\n (_fuzz-frequency-total $tail (+ $total $weight))\n (_fuzz-generation-error InvalidFrequencyWeight\n (Weight $weight)\n (Generator $generator)))\n (_fuzz-expected-integer FrequencyWeight $weight)))\n ($bad\n (_fuzz-generation-error MalformedFrequencyEntry (Entry $bad))))))))\n\n(= (gen-frequency $entries)\n (let $total (_fuzz-frequency-total $entries 0)\n (switch $total\n (((FuzzGenerationError $code $details) $total)\n ((FrequencyTotal $weight) (GenFrequency $entries $weight))\n ($bad (_fuzz-generation-error MalformedFrequency (Value $bad)))))))\n\n(= (_fuzz-weight-one $generators)\n (if (== $generators ())\n ()\n (let* ((($generator $tail) (decons-atom $generators))\n ($rest (_fuzz-weight-one $tail)))\n (cons-atom (1 $generator) $rest))))\n\n(= (gen-one-of $generators)\n (gen-frequency (_fuzz-weight-one $generators)))\n\n(= (gen-tuple $generators)\n (GenTuple $generators))\n\n(= (gen-list $generator $minimum $maximum)\n (_fuzz-if-generation-error\n $generator\n (if (_fuzz-is-integer $minimum)\n (if (_fuzz-is-integer $maximum)\n (if (and (<= 0 $minimum) (<= $minimum $maximum))\n (GenList $generator $minimum $maximum)\n (_fuzz-generation-error InvalidListBounds\n (Minimum $minimum)\n (Maximum $maximum)))\n (_fuzz-expected-integer MaximumLength $maximum))\n (_fuzz-expected-integer MinimumLength $minimum))))\n\n(= (gen-option $generator)\n (_fuzz-if-generation-error $generator (GenOption $generator)))\n\n(= (gen-map $function $generator)\n (_fuzz-if-generation-error $generator (GenMap $function $generator)))\n\n(= (gen-bind $generator $function)\n (_fuzz-if-generation-error $generator (GenBind $generator $function)))\n\n(= (gen-filter $generator $predicate $maximum-attempts)\n (_fuzz-if-generation-error\n $generator\n (if (_fuzz-is-integer $maximum-attempts)\n (if (> $maximum-attempts 0)\n (GenFilter $generator $predicate $maximum-attempts)\n (_fuzz-generation-error InvalidFilterAttempts\n (MaximumAttempts $maximum-attempts)))\n (_fuzz-expected-integer MaximumAttempts $maximum-attempts))))\n\n(= (gen-sized $function)\n (GenSized $function))\n\n(= (gen-resize $size $generator)\n (_fuzz-if-generation-error\n $generator\n (if (_fuzz-is-integer $size)\n (if (>= $size 0)\n (GenResize $size $generator)\n (_fuzz-generation-error InvalidSize (Size $size)))\n (_fuzz-expected-integer Size $size))))\n\n(= (gen-recursive $base $step)\n (_fuzz-if-generation-error $base (GenRecursive $base $step)))\n\n(= (gen-custom $name $arguments)\n (GenCustom $name $arguments))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Custom generators declare their supported drivers as normal MeTTa data. Replay and shrink replay are\n; mandatory because the runner records and reduces derivation trees rather than opaque output values.\n(= (_fuzz-custom-driver-mode $driver)\n (switch $driver\n (((FuzzDriver Random $state) Random)\n ((FuzzDriver Edge $state) Edge)\n ((FuzzDriver Replay $state) Replay)\n ((FuzzDriver ShrinkReplay $state) ShrinkReplay)\n ((FuzzDriver Exhaustive $state) Exhaustive)\n ((FuzzDriver Bytes $state) Bytes)\n ($bad\n (_fuzz-generation-error\n MalformedDriver\n (Driver $bad))))))\n\n(= (_fuzz-known-custom-mode $mode)\n (switch $mode\n ((Random True)\n (Edge True)\n (Replay True)\n (ShrinkReplay True)\n (Exhaustive True)\n (Bytes True)\n ($bad False))))\n\n(= (_fuzz-valid-custom-modes-loop\n $remaining\n $seen)\n (if (== $remaining ())\n True\n (let* ((($mode $tail)\n (decons-atom $remaining)))\n (if (_fuzz-known-custom-mode $mode)\n (if (is-member $mode $seen)\n False\n (_fuzz-valid-custom-modes-loop\n $tail\n (append $seen ($mode))))\n False))))\n\n(= (_fuzz-valid-custom-modes $modes)\n (if (== (get-metatype $modes) Expression)\n (and\n (_fuzz-valid-custom-modes-loop $modes ())\n (and\n (is-member Replay $modes)\n (is-member ShrinkReplay $modes)))\n False))\n\n(= (_fuzz-custom-capabilities-from-results\n $name\n $arguments\n $results)\n (switch $results\n ((()\n (_fuzz-generation-error\n MissingCustomCapabilities\n (Name $name)\n (Arguments $arguments)))\n (($single)\n (switch $single\n (((CustomCapabilities $seen-name $seen-arguments)\n (_fuzz-generation-error\n MissingCustomCapabilities\n (Name $name)\n (Arguments $arguments)))\n ((FuzzCustomCapabilities (Modes $modes))\n (if (_fuzz-valid-custom-modes $modes)\n (ValidCustomCapabilities $modes)\n (_fuzz-generation-error\n InvalidCustomCapabilities\n (Name $name)\n (Modes $modes))))\n ($bad\n (_fuzz-generation-error\n MalformedCustomCapabilities\n (Name $name)\n (Value $bad))))))\n ($many\n (_fuzz-generation-error\n AmbiguousCustomCapabilities\n (Name $name)\n (Results $many))))))\n\n(= (_fuzz-custom-capabilities $name $arguments)\n (let $results\n (collapse\n (CustomCapabilities\n $name\n $arguments))\n (_fuzz-custom-capabilities-from-results\n $name\n $arguments\n $results)))\n\n(= (_fuzz-custom-wrap\n $name\n $arguments\n $sample)\n (switch $sample\n (((FuzzSample $value $next-driver $tree)\n (let $wrapped-tree\n (Decision\n Custom\n (CustomGenerator\n (Name $name)\n (Arguments $arguments))\n ()\n ($tree))\n (if (== $name _fuzz-grammar)\n (_fuzz-materialize-grammar-sample\n $value\n $next-driver\n $wrapped-tree)\n (FuzzSample\n $value\n $next-driver\n $wrapped-tree))))\n ((FuzzGenerationDiscard\n $reason\n $next-driver\n $tree)\n (FuzzGenerationDiscard\n $reason\n $next-driver\n (Decision\n Custom\n (CustomGenerator\n (Name $name)\n (Arguments $arguments))\n ()\n ($tree))))\n ((FuzzGenerationError $code $details)\n $sample)\n ($bad\n (_fuzz-generation-error\n MalformedGenerationResult\n (Value $bad))))))\n\n; Every driver mode is deterministic (the exhaustive cursor included), so DriveCustom must\n; produce exactly one result in every mode.\n(= (_fuzz-drive-custom-results\n $name\n $arguments\n $mode\n $results)\n (switch $results\n ((()\n (_fuzz-generation-error\n MissingCustomGenerator\n (Name $name)))\n (($sample)\n (switch $sample\n (((DriveCustom\n $seen-name\n $seen-arguments\n $seen-driver\n $seen-size)\n (_fuzz-generation-error\n MissingCustomGenerator\n (Name $name)))\n ($value\n (_fuzz-custom-wrap\n $name\n $arguments\n $value)))))\n ($many\n (_fuzz-generation-error\n AmbiguousCustomGenerator\n (Name $name)\n (Mode $mode)\n (Results $many))))))\n\n(= (_fuzz-drive-custom\n $name\n $arguments\n $driver\n $size\n $mode)\n (let $results\n (collapse\n (DriveCustom\n $name\n $arguments\n $driver\n $size))\n (_fuzz-drive-custom-results\n $name\n $arguments\n $mode\n $results)))\n\n(= (_fuzz-drive-custom-validated\n $name\n $arguments\n $driver\n $size\n $mode)\n (let $original\n (_fuzz-drive-custom\n $name\n $arguments\n $driver\n $size\n $mode)\n (if (== $mode Replay)\n $original\n (let $request\n (_fuzz-custom-replay-tree\n $original\n $mode)\n (switch $request\n (((CustomReplayTree $tree)\n (let $replayed\n (fuzz-replay\n (GenCustom $name $arguments)\n $tree\n $size)\n (if (_fuzz-custom-replay-equal\n $original\n $replayed)\n $original\n (_fuzz-generation-error\n CustomReplayMismatch\n (Name $name)\n (Mode $mode)\n (Original $original)\n (Replay $replayed)))))\n ((CustomReplaySkip)\n $original)\n ((CustomReplayProtocolError\n $code\n $details)\n (FuzzGenerationError\n $code\n $details))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $request)))\n ($bad-request\n (_fuzz-generation-error\n MalformedCustomReplayRequest\n (Name $name)\n (Value $bad-request)))))))))\n\n; An explicit edge hook supplies inner derivation trees. Each tree is replayed through DriveCustom before\n; it can become a sample, so an edge hook cannot bypass the generator or invent an incompatible value.\n(= (_fuzz-custom-edge-replayed\n $name\n $next-index\n $result)\n (switch $result\n (((FuzzSample $value $replay-driver $tree)\n (FuzzSample\n $value\n (FuzzDriver Edge $next-index)\n $tree))\n ((FuzzGenerationDiscard\n $reason\n $replay-driver\n $tree)\n (FuzzGenerationDiscard\n $reason\n (FuzzDriver Edge $next-index)\n $tree))\n ((FuzzGenerationError $code $details) $result)\n ($bad\n (_fuzz-generation-error\n MalformedCustomEdgeReplay\n (Name $name)\n (Value $bad))))))\n\n(= (_fuzz-custom-edge-from-choices\n $name\n $arguments\n $size\n $index\n $choices)\n (if (== $choices ())\n (_fuzz-generation-error\n EmptyCustomEdgeChoices\n (Name $name))\n (let* (($position\n (% $index (length $choices)))\n ($child-tree\n (index-atom\n $choices\n $position))\n ($tree\n (Decision\n Custom\n (CustomGenerator\n (Name $name)\n (Arguments $arguments))\n ()\n ($child-tree)))\n ($replayed\n (fuzz-replay\n (GenCustom $name $arguments)\n $tree\n $size)))\n (_fuzz-custom-edge-replayed\n $name\n (+ $index 1)\n $replayed))))\n\n(= (_fuzz-custom-edge-results\n $name\n $arguments\n $size\n $index\n $results)\n (switch $results\n ((()\n (NoCustomEdgeChoices))\n (($single)\n (switch $single\n (((EdgeChoices\n $seen-name\n $seen-arguments\n $seen-size)\n (NoCustomEdgeChoices))\n ((CustomEdgeChoices $choices)\n (if (== (get-metatype $choices) Expression)\n (_fuzz-custom-edge-from-choices\n $name\n $arguments\n $size\n $index\n $choices)\n (_fuzz-generation-error\n MalformedCustomEdgeChoices\n (Name $name)\n (Value $choices))))\n ($bad\n (_fuzz-generation-error\n MalformedCustomEdgeChoices\n (Name $name)\n (Value $bad))))))\n ($many\n (_fuzz-generation-error\n AmbiguousCustomEdgeChoices\n (Name $name)\n (Results $many))))))\n\n(= (_fuzz-custom-edge\n $name\n $arguments\n $size\n $index)\n (let $results\n (collapse\n (EdgeChoices\n $name\n $arguments\n $size))\n (_fuzz-custom-edge-results\n $name\n $arguments\n $size\n $index\n $results)))\n\n(= (_fuzz-generate-custom-supported\n $name\n $arguments\n $driver\n $size\n $mode)\n (switch $driver\n (((FuzzDriver Edge $index)\n (let $edge\n (_fuzz-custom-edge\n $name\n $arguments\n $size\n $index)\n (switch $edge\n (((NoCustomEdgeChoices)\n (_fuzz-drive-custom-validated\n $name\n $arguments\n $driver\n $size\n $mode))\n ($available $available)))))\n ($other\n (_fuzz-drive-custom-validated\n $name\n $arguments\n $driver\n $size\n $mode)))))\n\n(= (_fuzz-generate-custom-for-mode\n $name\n $arguments\n $driver\n $size\n $mode\n $capabilities)\n (switch $capabilities\n (((ValidCustomCapabilities $modes)\n (if (is-member $mode $modes)\n (_fuzz-generate-custom-supported\n $name\n $arguments\n $driver\n $size\n $mode)\n (_fuzz-generation-error\n UnsupportedCustomDriver\n (Name $name)\n (Mode $mode))))\n ((FuzzGenerationError $code $details)\n $capabilities)\n ($bad\n (_fuzz-generation-error\n MalformedCustomCapabilities\n (Name $name)\n (Value $bad))))))\n\n(= (_fuzz-generate-custom-checked\n $name\n $arguments\n $driver\n $size)\n (let $mode (_fuzz-custom-driver-mode $driver)\n (switch $mode\n (((FuzzGenerationError $code $details) $mode)\n ($valid-mode\n (_fuzz-generate-custom-for-mode\n $name\n $arguments\n $driver\n $size\n $valid-mode\n (_fuzz-custom-capabilities\n $name\n $arguments)))))))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; A dynamic generator function must have one result. This prevents its nondeterminism from being\n; confused with alternatives chosen by the active driver. The call runs under `collapse-bind`\n; and the single result is extracted purely by unification: `collapse` would re-evaluate the\n; collected results and grounded list operations resolve their arguments, either of which\n; dereferences a live value such as a state handle.\n; Flat accumulator, not recurse-then-cons: a relation may return hundreds of results and each\n; recursive-then-cons step would cost an evaluator frame.\n(= (_fuzz-pair-values $pairs)\n (_fuzz-pair-values-loop (FuzzPairValuesFold $pairs ())))\n\n(= (_fuzz-pair-values-loop $state)\n (if (_fuzz-pair-values-finished $state)\n $state\n (_fuzz-pair-values-loop (_fuzz-pair-values-step $state))))\n\n(= (_fuzz-pair-values-finished $state)\n (unify $state (FuzzPairValuesFold $pairs $reversed) False True))\n\n(= (_fuzz-pair-values-step $state)\n (unify $state\n (FuzzPairValuesFold $pairs $reversed)\n (if (== $pairs ())\n (reverse $reversed)\n (let ($head $tail) (decons-atom $pairs)\n (let $value\n (unify $head ($result $bindings) $result $head)\n (let $next (cons-atom $value $reversed)\n (FuzzPairValuesFold $tail $next)))))\n $state))\n\n(= (_fuzz-call-results-bind $pairs $context)\n (unify $pairs\n (($value $bindings))\n (CallOne $value)\n (unify $pairs\n ()\n (_fuzz-generation-error FunctionReturnedNoResults $context)\n (let $values (_fuzz-pair-values $pairs)\n (_fuzz-generation-error\n FunctionReturnedMultipleResults\n $context\n (Results $values))))))\n\n; The collapse-bind sits inside a function/chain context (the prelude's own `case` idiom) so its\n; argument reaches it RAW. As an evaluated argument the call would branch first — Hyperon-verified:\n; `(callrb (collapse-bind (f 1)) ctx)` with a two-rule f yields two singleton results in both\n; engines — and a nondeterministic user relation would slip through the cardinality check as\n; parallel single-result branches instead of being rejected.\n(= (_fuzz-call-one $function $argument $context)\n (function\n (chain (context-space) $space\n (chain (collapse-bind (metta ($function $argument) %Undefined% $space)) $pairs\n (chain (eval (_fuzz-call-results-bind $pairs $context)) $out\n (return $out))))))\n\n(= (_fuzz-bool-result $called $context)\n (switch $called\n (((CallOne True) (CallBool True))\n ((CallOne False) (CallBool False))\n ((CallOne $bad)\n (_fuzz-generation-error PredicateReturnedNonBoolean\n $context\n (Value $bad)))\n ((FuzzGenerationError $code $details) $called)\n ($bad\n (_fuzz-generation-error MalformedFunctionResult\n $context\n (Value $bad))))))\n\n(= (_fuzz-call-bool $function $argument $context)\n (_fuzz-bool-result (_fuzz-call-one $function $argument $context) $context))\n\n(= (_fuzz-wrap-sample $kind $metadata $selection $sample)\n (switch $sample\n (((FuzzSample $value $next-driver $tree)\n (let $children (cons-atom $tree ())\n (FuzzSample\n $value\n $next-driver\n (Decision $kind $metadata $selection $children))))\n ((FuzzGenerationDiscard $reason $next-driver $tree)\n (let $children (cons-atom $tree ())\n (FuzzGenerationDiscard\n $reason\n $next-driver\n (Decision $kind $metadata $selection $children))))\n ((FuzzGenerationError $code $details) $sample)\n ($bad\n (_fuzz-generation-error MalformedGenerationResult (Value $bad))))))\n\n(= (_fuzz-two-children $first $second)\n (let $tail (cons-atom $second ())\n (cons-atom $first $tail)))\n\n(= (_fuzz-choice-sample $choice)\n (switch $choice\n (((DriverChoice $value $next-driver $decision)\n (FuzzSample $value $next-driver $decision))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error MalformedDriverChoice (Value $bad))))))\n\n(= (_fuzz-generate-bool $driver)\n (let $choice (_fuzz-driver-int $driver 0 1 0)\n (switch $choice\n (((DriverChoice 0 $next-driver $decision)\n (let $children (cons-atom $decision ())\n (FuzzSample\n False\n $next-driver\n (Decision Bool (Count 2) (Value False) $children))))\n ((DriverChoice 1 $next-driver $decision)\n (let $children (cons-atom $decision ())\n (FuzzSample\n True\n $next-driver\n (Decision Bool (Count 2) (Value True) $children))))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error MalformedBooleanChoice (Value $bad)))))))\n\n(= (_fuzz-float-range-from-value\n $lower-index\n $upper-index\n $index\n $next-driver\n $decision\n $value)\n (switch $value\n (((FuzzKernelError $code $operation $detail)\n (_fuzz-generation-error\n KernelError\n (OperationResult $value)))\n ($float\n (let $children (cons-atom $decision ())\n (FuzzSample\n $float\n $next-driver\n (Decision\n FloatRange\n (Indices $lower-index $upper-index)\n (Index $index)\n $children)))))))\n\n(= (_fuzz-float-range-sample\n $lower-index\n $upper-index\n $origin-index\n $choice)\n (switch $choice\n (((DriverChoice $index $next-driver $decision)\n (_fuzz-float-range-from-value\n $lower-index\n $upper-index\n $index\n $next-driver\n $decision\n (_fuzz-float64-from-index $index)))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error\n MalformedFloatChoice\n (Value $bad))))))\n\n(= (_fuzz-generate-float-range\n $lower-index\n $upper-index\n $origin-index\n $driver)\n (switch $driver\n (((FuzzDriver Edge $index)\n (let* (($a\n (_fuzz-edge-candidates\n $lower-index\n $upper-index\n $origin-index))\n ($b\n (_fuzz-edge-add\n -2\n $lower-index\n $upper-index\n $a))\n ($c\n (_fuzz-edge-add\n -4503599627370496\n $lower-index\n $upper-index\n $b))\n ($d\n (_fuzz-edge-add\n -4503599627370497\n $lower-index\n $upper-index\n $c))\n ($e\n (_fuzz-edge-add\n 4503599627370495\n $lower-index\n $upper-index\n $d))\n ($f\n (_fuzz-edge-add\n 4503599627370496\n $lower-index\n $upper-index\n $e))\n ($g\n (_fuzz-edge-add\n -4607182418800017409\n $lower-index\n $upper-index\n $f))\n ($candidates\n (_fuzz-edge-add\n 4607182418800017408\n $lower-index\n $upper-index\n $g))\n ($position (% $index (length $candidates)))\n ($selected\n (index-atom $candidates $position)))\n (_fuzz-float-range-sample\n $lower-index\n $upper-index\n $origin-index\n (DriverChoice\n $selected\n (FuzzDriver Edge (+ $index 1))\n (_fuzz-int-decision\n $lower-index\n $upper-index\n $origin-index\n $selected)))))\n ($other\n (_fuzz-float-range-sample\n $lower-index\n $upper-index\n $origin-index\n (_fuzz-driver-int\n $other\n $lower-index\n $upper-index\n $origin-index))))))\n\n(= (_fuzz-float-bit-edge-pairs)\n ((0 0)\n (2147483648 0)\n (1072693248 0)\n (3220176896 0)\n (0 1)\n (2147483648 1)\n (2146435071 4294967295)\n (4293918719 4294967295)\n (2146435072 0)\n (4293918720 0)\n (2146959360 0)\n (4294443008 0)\n (2146435072 1)\n (4293918720 1)\n (2146959360 23)\n (4294443008 23)\n (1048576 0)\n (2148532224 0)\n (1048575 4294967295)\n (2148532223 4294967295)))\n\n(= (_fuzz-float-bits-sample\n $high\n $low\n $next-driver\n $high-decision\n $low-decision)\n (let $value (_fuzz-float64-from-bits $high $low)\n (switch $value\n (((FuzzKernelError $code $operation $detail)\n (_fuzz-generation-error\n KernelError\n (OperationResult $value)))\n ($float\n (let $children\n (_fuzz-two-children\n $high-decision\n $low-decision)\n (FuzzSample\n $float\n $next-driver\n (Decision\n FloatBits\n (Format IEEE754Binary64)\n (Bits $high $low)\n $children))))))))\n\n(= (_fuzz-generate-float-bits-edge $index)\n (let* (($pairs (_fuzz-float-bit-edge-pairs))\n ($position (% $index (length $pairs)))\n ($pair (index-atom $pairs $position)))\n (switch $pair\n ((($high $low)\n (_fuzz-float-bits-sample\n $high\n $low\n (FuzzDriver Edge (+ $index 2))\n (_fuzz-int-decision 0 4294967295 0 $high)\n (_fuzz-int-decision 0 4294967295 0 $low)))\n ($bad\n (_fuzz-generation-error\n MalformedFloatEdge\n (Value $bad)))))))\n\n(= (_fuzz-generate-float-bits-from-low\n (DriverChoice $high $after-high $high-decision)\n $low-choice)\n (switch $low-choice\n (((DriverChoice $low $next-driver $low-decision)\n (_fuzz-float-bits-sample\n $high\n $low\n $next-driver\n $high-decision\n $low-decision))\n ((FuzzGenerationError $code $details) $low-choice)\n ($bad\n (_fuzz-generation-error\n MalformedFloatLowWordChoice\n (Value $bad))))))\n\n(= (_fuzz-generate-float-bits $driver)\n (switch $driver\n (((FuzzDriver Edge $index)\n (_fuzz-generate-float-bits-edge $index))\n ($other\n (let $high-choice\n (_fuzz-driver-int $other 0 4294967295 0)\n (switch $high-choice\n (((DriverChoice $high $after-high $high-decision)\n (_fuzz-generate-float-bits-from-low\n $high-choice\n (_fuzz-driver-int\n $after-high\n 0\n 4294967295\n 0)))\n ((FuzzGenerationError $code $details) $high-choice)\n ($bad\n (_fuzz-generation-error\n MalformedFloatHighWordChoice\n (Value $bad))))))))))\n\n(= (_fuzz-generate-element $values $driver)\n (let* (($count (length $values))\n ($choice (_fuzz-driver-int $driver 0 (- $count 1) 0)))\n (switch $choice\n (((DriverChoice $index $next-driver $decision)\n (let* (($value (index-atom $values $index))\n ($children (cons-atom $decision ())))\n (FuzzSample\n $value\n $next-driver\n (Decision Element (Count $count) (Index $index) $children))))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error MalformedElementChoice (Value $bad)))))))\n\n(= (_fuzz-frequency-select $entries $ticket $offset $index)\n (if (== $entries ())\n (_fuzz-generation-error FrequencyTicketOutOfBounds\n (Ticket $ticket)\n (Offset $offset))\n (let* ((($entry $tail) (decons-atom $entries)))\n (switch $entry\n ((($weight $generator)\n (let $next-offset (+ $offset $weight)\n (if (<= $ticket $next-offset)\n (FrequencySelection $index $generator)\n (_fuzz-frequency-select\n $tail\n $ticket\n $next-offset\n (+ $index 1)))))\n ($bad\n (_fuzz-generation-error MalformedFrequencyEntry\n (Entry $bad))))))))\n\n; Weights bias only the Random ticket draw; every other driver and the recorded decision work\n; in entry-index space [0, count-1]. Exhaustive enumeration therefore visits each entry once,\n; and a replayed tree is weight-independent, exactly like grammar production choice.\n(= (_fuzz-frequency-index-choice $entries $total $driver)\n (switch $driver\n (((FuzzDriver Random $rng)\n (let $draw (_fuzz-draw-int $rng 1 $total)\n (switch $draw\n (((FuzzDraw $ticket $next-rng)\n (let $selected (_fuzz-frequency-select $entries $ticket 0 0)\n (switch $selected\n (((FrequencySelection $index $generator)\n (let* (($count (length $entries))\n ($decision (_fuzz-int-decision 0 (- $count 1) 0 $index)))\n (FrequencyIndexChoice\n $index\n $generator\n (FuzzDriver Random $next-rng)\n $decision)))\n ((FuzzGenerationError $code $details) $selected)\n ($bad\n (_fuzz-generation-error\n MalformedFrequencySelection\n (Value $bad)))))))\n ($bad\n (_fuzz-generation-error KernelError (OperationResult $bad)))))))\n ($other\n (let* (($count (length $entries))\n ($choice (_fuzz-driver-int $driver 0 (- $count 1) 0)))\n (switch $choice\n (((DriverChoice $index $next-driver $decision)\n (let $entry (index-atom $entries $index)\n (switch $entry\n ((($weight $generator)\n (FrequencyIndexChoice\n $index\n $generator\n $next-driver\n $decision))\n ($bad\n (_fuzz-generation-error\n MalformedFrequencyEntry\n (Entry $bad)))))))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error\n MalformedDriverChoice\n (Value $bad))))))))))\n\n(= (_fuzz-generate-frequency $entries $total $driver $size)\n (let $choice (_fuzz-frequency-index-choice $entries $total $driver)\n (switch $choice\n (((FrequencyIndexChoice $index $generator $next-driver $decision)\n (let $child\n (fuzz-generate $generator $next-driver (max 0 (- $size 1)))\n (switch $child\n (((FuzzSample $value $final-driver $tree)\n (let $children (_fuzz-two-children $decision $tree)\n (FuzzSample\n $value\n $final-driver\n (Decision\n Frequency\n (Total $total)\n (Index $index)\n $children))))\n ((FuzzGenerationDiscard $reason $final-driver $tree)\n (let $children (_fuzz-two-children $decision $tree)\n (FuzzGenerationDiscard\n $reason\n $final-driver\n (Decision\n Frequency\n (Total $total)\n (Index $index)\n $children))))\n ((FuzzGenerationError $code $details) $child)\n ($bad\n (_fuzz-generation-error\n MalformedGenerationResult\n (Value $bad)))))))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error MalformedFrequencyChoice (Value $bad)))))))\n\n(= (_fuzz-generate-many $generators $driver $size $values-reversed $trees-reversed)\n (if (== $generators ())\n (GeneratedMany\n (reverse $values-reversed)\n $driver\n (reverse $trees-reversed))\n (let* ((($generator $tail) (decons-atom $generators))\n ($sample (fuzz-generate $generator $driver $size)))\n (switch $sample\n (((FuzzSample $value $next-driver $tree)\n (let* (($next-values\n (cons-atom $value $values-reversed))\n ($next-trees\n (cons-atom $tree $trees-reversed)))\n (_fuzz-generate-many\n $tail\n $next-driver\n $size\n $next-values\n $next-trees)))\n ((FuzzGenerationDiscard $reason $next-driver $tree)\n (GeneratedManyDiscard\n $reason\n $next-driver\n (reverse (cons-atom $tree $trees-reversed))))\n ((FuzzGenerationError $code $details) $sample)\n ($bad\n (_fuzz-generation-error\n MalformedGenerationResult\n (Value $bad))))))))\n\n(= (_fuzz-generate-tuple $generators $driver $size)\n (let* (($count (length $generators))\n ($child-size (if (> $count 0) (/ $size $count) 0))\n ($generated (_fuzz-generate-many $generators $driver $child-size () ())))\n (switch $generated\n (((GeneratedMany $values $next-driver $trees)\n (FuzzSample\n $values\n $next-driver\n (Decision Tuple (Count $count) () $trees)))\n ((GeneratedManyDiscard $reason $next-driver $trees)\n (FuzzGenerationDiscard\n $reason\n $next-driver\n (Decision Tuple (Count $count) () $trees)))\n ((FuzzGenerationError $code $details) $generated)\n ($bad\n (_fuzz-generation-error MalformedTupleGeneration (Value $bad)))))))\n\n; Flat accumulator, not recurse-then-cons: a drawn list length may be in the thousands and each\n; recursive-then-cons step would cost an evaluator frame. Every element is the same generator, so\n; the accumulation order is not observable and no final reverse is needed.\n(= (_fuzz-repeat-generator $generator $count)\n (_fuzz-repeat-generator-loop (FuzzRepeatFold $generator $count ())))\n\n(= (_fuzz-repeat-generator-loop $state)\n (if (_fuzz-repeat-generator-finished $state)\n $state\n (_fuzz-repeat-generator-loop (_fuzz-repeat-generator-step $state))))\n\n(= (_fuzz-repeat-generator-finished $state)\n (unify $state (FuzzRepeatFold $generator $count $repeated) False True))\n\n(= (_fuzz-repeat-generator-step $state)\n (unify $state\n (FuzzRepeatFold $generator $count $repeated)\n (if (> $count 0)\n (let $next (cons-atom $generator $repeated)\n (FuzzRepeatFold $generator (- $count 1) $next))\n $repeated)\n $state))\n\n(= (_fuzz-generate-list $generator $minimum $maximum $driver $size)\n (let* (($effective-maximum (min $maximum (+ $minimum $size)))\n ($choice\n (_fuzz-driver-int\n $driver\n $minimum\n $effective-maximum\n $minimum)))\n (switch $choice\n (((DriverChoice $length $next-driver $length-decision)\n (let* (($child-size (if (> $length 0) (/ $size $length) 0))\n ($generators (_fuzz-repeat-generator $generator $length))\n ($generated\n (_fuzz-generate-many\n $generators\n $next-driver\n $child-size\n ()\n ())))\n (switch $generated\n (((GeneratedMany $values $final-driver $trees)\n (let $children (cons-atom $length-decision $trees)\n (FuzzSample\n $values\n $final-driver\n (Decision\n List\n (Bounds $minimum $maximum)\n (Length $length)\n $children))))\n ((GeneratedManyDiscard $reason $final-driver $trees)\n (let $children (cons-atom $length-decision $trees)\n (FuzzGenerationDiscard\n $reason\n $final-driver\n (Decision\n List\n (Bounds $minimum $maximum)\n (Length $length)\n $children))))\n ((FuzzGenerationError $code $details) $generated)\n ($bad\n (_fuzz-generation-error\n MalformedListGeneration\n (Value $bad)))))))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error MalformedListChoice (Value $bad)))))))\n\n(= (_fuzz-generate-option $generator $driver $size)\n (let $choice (_fuzz-driver-int $driver 0 1 0)\n (switch $choice\n (((DriverChoice 0 $next-driver $decision)\n (let $children (cons-atom $decision ())\n (FuzzSample\n (None)\n $next-driver\n (Decision Option (Count 2) (Index 0) $children))))\n ((DriverChoice 1 $next-driver $decision)\n (let $child\n (fuzz-generate\n $generator\n $next-driver\n (max 0 (- $size 1)))\n (switch $child\n (((FuzzSample $value $final-driver $tree)\n (let $children (_fuzz-two-children $decision $tree)\n (FuzzSample\n (Some $value)\n $final-driver\n (Decision Option (Count 2) (Index 1) $children))))\n ((FuzzGenerationDiscard $reason $final-driver $tree)\n (let $children (_fuzz-two-children $decision $tree)\n (FuzzGenerationDiscard\n $reason\n $final-driver\n (Decision Option (Count 2) (Index 1) $children))))\n ((FuzzGenerationError $code $details) $child)\n ($bad\n (_fuzz-generation-error\n MalformedOptionGeneration\n (Value $bad)))))))\n ((FuzzGenerationError $code $details) $choice)\n ($bad\n (_fuzz-generation-error MalformedOptionChoice (Value $bad)))))))\n\n(= (_fuzz-generate-map $function $generator $driver $size)\n (let $source (fuzz-generate $generator $driver $size)\n (switch $source\n (((FuzzSample $value $next-driver $tree)\n (let $mapped\n (_fuzz-call-one\n $function\n $value\n (MapFunction $function))\n (switch $mapped\n (((CallOne $mapped-value)\n (let $children (cons-atom $tree ())\n (FuzzSample\n $mapped-value\n $next-driver\n (Decision Map (Function $function) () $children))))\n ((FuzzGenerationError $code $details) $mapped)\n ($bad\n (_fuzz-generation-error MalformedMapResult (Value $bad)))))))\n ((FuzzGenerationDiscard $reason $next-driver $tree)\n (_fuzz-wrap-sample\n Map\n (Function $function)\n ()\n $source))\n ((FuzzGenerationError $code $details) $source)\n ($bad\n (_fuzz-generation-error MalformedMapSource (Value $bad)))))))\n\n(= (_fuzz-generate-bind $source-generator $function $driver $size)\n (let* (($source-size (/ $size 2))\n ($dependent-size (- $size $source-size))\n ($source\n (fuzz-generate\n $source-generator\n $driver\n $source-size)))\n (switch $source\n (((FuzzSample $source-value $next-driver $source-tree)\n (let $called\n (_fuzz-call-one\n $function\n $source-value\n (BindFunction $function))\n (switch $called\n (((CallOne $dependent-generator)\n (let $dependent\n (fuzz-generate\n $dependent-generator\n $next-driver\n $dependent-size)\n (switch $dependent\n (((FuzzSample $value $final-driver $dependent-tree)\n (let $children\n (_fuzz-two-children $source-tree $dependent-tree)\n (FuzzSample\n $value\n $final-driver\n (Decision\n Bind\n (Function $function)\n ()\n $children))))\n ((FuzzGenerationDiscard\n $reason\n $final-driver\n $dependent-tree)\n (let $children\n (_fuzz-two-children $source-tree $dependent-tree)\n (FuzzGenerationDiscard\n $reason\n $final-driver\n (Decision\n Bind\n (Function $function)\n ()\n $children))))\n ((FuzzGenerationError $code $details) $dependent)\n ($bad\n (_fuzz-generation-error\n MalformedBindGeneration\n (Value $bad)))))))\n ((FuzzGenerationError $code $details) $called)\n ($bad\n (_fuzz-generation-error\n MalformedBindFunctionResult\n (Value $bad)))))))\n ((FuzzGenerationDiscard $reason $next-driver $tree)\n (_fuzz-wrap-sample\n Bind\n (Function $function)\n ()\n $source))\n ((FuzzGenerationError $code $details) $source)\n ($bad\n (_fuzz-generation-error MalformedBindSource (Value $bad)))))))\n\n(= (_fuzz-filter-total $remaining $used)\n (+ $remaining $used))\n\n(= (_fuzz-filter-discard $remaining $used $driver $trees-reversed)\n (let* (($total (_fuzz-filter-total $remaining $used))\n ($trees (reverse $trees-reversed)))\n (FuzzGenerationDiscard\n (FilterExhausted (MaximumAttempts $total))\n $driver\n (Decision\n Filter\n (MaximumAttempts $total)\n (Attempts $used)\n $trees))))\n\n(= (_fuzz-generate-filter\n $generator\n $predicate\n $remaining\n $used\n $driver\n $size\n $trees-reversed)\n (if (<= $remaining 0)\n (_fuzz-filter-discard\n $remaining\n $used\n $driver\n $trees-reversed)\n (let $sample (fuzz-generate $generator $driver $size)\n (switch $sample\n (((FuzzSample $value $next-driver $tree)\n (let $accepted\n (_fuzz-call-bool\n $predicate\n $value\n (FilterPredicate $predicate))\n (switch $accepted\n (((CallBool True)\n (let* (($attempts (+ $used 1))\n ($total\n (_fuzz-filter-total\n $remaining\n $used))\n ($trees\n (reverse\n (cons-atom $tree $trees-reversed))))\n (FuzzSample\n $value\n $next-driver\n (Decision\n Filter\n (MaximumAttempts $total)\n (Attempts $attempts)\n $trees))))\n ((CallBool False)\n (let $next-trees\n (cons-atom $tree $trees-reversed)\n (_fuzz-generate-filter\n $generator\n $predicate\n (- $remaining 1)\n (+ $used 1)\n $next-driver\n $size\n $next-trees)))\n ((FuzzGenerationError $code $details) $accepted)\n ($bad\n (_fuzz-generation-error\n MalformedFilterPredicateResult\n (Value $bad)))))))\n ((FuzzGenerationDiscard $reason $next-driver $tree)\n (let $next-trees\n (cons-atom $tree $trees-reversed)\n (_fuzz-generate-filter\n $generator\n $predicate\n (- $remaining 1)\n (+ $used 1)\n $next-driver\n $size\n $next-trees)))\n ((FuzzGenerationError $code $details) $sample)\n ($bad\n (_fuzz-generation-error\n MalformedFilterGeneration\n (Value $bad))))))))\n\n(= (_fuzz-generate-sized $function $driver $size)\n (let $called\n (_fuzz-call-one\n $function\n $size\n (SizedFunction $function))\n (switch $called\n (((CallOne $generator)\n (let $sample (fuzz-generate $generator $driver $size)\n (_fuzz-wrap-sample\n Sized\n (Size $size)\n ()\n $sample)))\n ((FuzzGenerationError $code $details) $called)\n ($bad\n (_fuzz-generation-error\n MalformedSizedFunctionResult\n (Value $bad)))))))\n\n(= (_fuzz-generate-resize $new-size $generator $driver)\n (let $sample (fuzz-generate $generator $driver $new-size)\n (_fuzz-wrap-sample\n Resize\n (Size $new-size)\n ()\n $sample)))\n\n(= (_fuzz-generate-recursive $base $step $driver $size)\n (if (<= $size 0)\n (let $sample (fuzz-generate $base $driver 0)\n (_fuzz-wrap-sample\n Recursive\n (Size 0)\n (Branch Base)\n $sample))\n (let* (($child-size (- $size 1))\n ($self\n (GenResize\n $child-size\n (GenRecursive $base $step)))\n ($called\n (_fuzz-call-one\n $step\n $self\n (RecursiveStep $step))))\n (switch $called\n (((CallOne $generator)\n (let $sample\n (fuzz-generate\n $generator\n $driver\n $child-size)\n (_fuzz-wrap-sample\n Recursive\n (Size $size)\n (Branch Step)\n $sample)))\n ((FuzzGenerationError $code $details) $called)\n ($bad\n (_fuzz-generation-error\n MalformedRecursiveStep\n (Value $bad))))))))\n\n(= (_fuzz-generate-custom $name $arguments $driver $size)\n (_fuzz-generate-custom-checked\n $name\n $arguments\n $driver\n $size))\n\n(= (fuzz-generate $generator $driver $size)\n (if (_fuzz-is-integer $size)\n (if (< $size 0)\n (_fuzz-generation-error InvalidSize (Size $size))\n (switch $generator\n (((FuzzGenerationError $code $details) $generator)\n ((GenConst $value)\n (FuzzSample\n $value\n $driver\n (Decision Const () (Value $value) ())))\n ((GenBool)\n (_fuzz-generate-bool $driver))\n ((GenInt $lower $upper $origin)\n (_fuzz-choice-sample\n (_fuzz-driver-int\n $driver\n $lower\n $upper\n $origin)))\n ((GenFloatRange $lower-index $upper-index $origin-index)\n (_fuzz-generate-float-range\n $lower-index\n $upper-index\n $origin-index\n $driver))\n ((GenFloatBits)\n (_fuzz-generate-float-bits $driver))\n ((GenElement $values)\n (_fuzz-generate-element $values $driver))\n ((GenFrequency $entries $total)\n (_fuzz-generate-frequency\n $entries\n $total\n $driver\n $size))\n ((GenTuple $generators)\n (_fuzz-generate-tuple\n $generators\n $driver\n $size))\n ((GenList $child $minimum $maximum)\n (_fuzz-generate-list\n $child\n $minimum\n $maximum\n $driver\n $size))\n ((GenOption $child)\n (_fuzz-generate-option $child $driver $size))\n ((GenMap $function $child)\n (_fuzz-generate-map\n $function\n $child\n $driver\n $size))\n ((GenBind $child $function)\n (_fuzz-generate-bind\n $child\n $function\n $driver\n $size))\n ((GenFilter $child $predicate $maximum-attempts)\n (_fuzz-generate-filter\n $child\n $predicate\n $maximum-attempts\n 0\n $driver\n $size\n ()))\n ((GenSized $function)\n (_fuzz-generate-sized\n $function\n $driver\n $size))\n ((GenResize $new-size $child)\n (_fuzz-generate-resize\n $new-size\n $child\n $driver))\n ((GenRecursive $base $step)\n (_fuzz-generate-recursive\n $base\n $step\n $driver\n $size))\n ((GenCustom $name $arguments)\n (_fuzz-generate-custom\n $name\n $arguments\n $driver\n $size))\n ($bad\n (_fuzz-generation-error\n MalformedGenerator\n (Generator $bad))))))\n (_fuzz-expected-integer Size $size)))\n\n(= (fuzz-generate-random $generator $seed $size)\n (let $driver (fuzz-random-driver $seed)\n (switch $driver\n (((FuzzGenerationError $code $details) $driver)\n ($valid\n (fuzz-generate $generator $valid $size))))))\n\n(= (fuzz-generate-edge $generator $index $size)\n (let $driver (fuzz-edge-driver $index)\n (switch $driver\n (((FuzzGenerationError $code $details) $driver)\n ($valid\n (fuzz-generate $generator $valid $size))))))\n\n(= (fuzz-generate-bytes $generator $bytes $size)\n (let $driver (fuzz-bytes-driver $bytes)\n (switch $driver\n (((FuzzGenerationError $code $details) $driver)\n ($valid\n (fuzz-generate $generator $valid $size))))))\n\n(= (_fuzz-validate-finished-replay\n $expected-tree\n $actual-tree\n $remaining\n $cursor\n $result)\n (if (== $remaining ())\n (if (_fuzz-replay-equal $expected-tree $actual-tree)\n $result\n (_fuzz-generation-error\n ReplayMismatch\n (ExpectedTree $expected-tree)\n (ActualTree $actual-tree)))\n (_fuzz-generation-error\n TrailingReplayDecisions\n (Path $cursor)\n (Remaining $remaining))))\n\n(= (_fuzz-finish-replay $expected-tree $result)\n (switch $result\n (((FuzzSample\n $value\n (FuzzDriver Replay (ReplayState $remaining $cursor))\n $actual-tree)\n (_fuzz-validate-finished-replay\n $expected-tree\n $actual-tree\n $remaining\n $cursor\n $result))\n ((FuzzGenerationDiscard\n $reason\n (FuzzDriver Replay (ReplayState $remaining $cursor))\n $actual-tree)\n (_fuzz-validate-finished-replay\n $expected-tree\n $actual-tree\n $remaining\n $cursor\n $result))\n ((FuzzGenerationError $code $details) $result)\n ($bad\n (_fuzz-generation-error\n MalformedReplayResult\n (Value $bad))))))\n\n(= (fuzz-replay $generator $decision-tree $size)\n (let $driver (fuzz-replay-driver $decision-tree)\n (switch $driver\n (((FuzzGenerationError $code $details) $driver)\n ($valid\n (_fuzz-finish-replay\n $decision-tree\n (fuzz-generate $generator $valid $size)))))))\n\n; Enumerates the generator's whole decision domain at one size with the exhaustive cursor,\n; in depth-first order. Generation discards count as enumerated attempts but not as domain\n; members. Stops at $limit attempts with FuzzEnumerationTruncated; a completed walk returns\n; (FuzzEnumeration (DomainCount n) (Enumerated m) (GenerationDiscards g) (Samples ...)).\n(= (fuzz-enumerate $generator $limit $size)\n (if (_fuzz-is-integer $limit)\n (if (> $limit 0)\n (_fuzz-enumerate-loop\n (FuzzEnumerateRun $generator $size $limit () 0 0 0 ()))\n (_fuzz-generation-error InvalidEnumerationLimit (Limit $limit)))\n (_fuzz-expected-integer EnumerationLimit $limit)))\n\n(= (_fuzz-enumerate-loop $state)\n (if (_fuzz-enumerate-finished $state)\n $state\n (_fuzz-enumerate-loop (_fuzz-enumerate-step $state))))\n\n(= (_fuzz-enumerate-finished $state)\n (unify $state\n (FuzzEnumerateRun $generator $size $limit $plan $enumerated $accepted $discards $samples)\n False\n True))\n\n(= (_fuzz-enumerate-step $state)\n (unify $state\n (FuzzEnumerateRun $generator $size $limit $plan $enumerated $accepted $discards $samples)\n (if (>= $enumerated $limit)\n (FuzzEnumerationTruncated\n (Enumerated $enumerated)\n (DomainCount $accepted)\n (GenerationDiscards $discards)\n (Samples $samples))\n (let $driver (_fuzz-exhaustive-resume-driver $plan)\n (let $result (fuzz-generate $generator $driver $size)\n (switch $result\n (((FuzzSample $value (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames)) $tree)\n (let $collected (_fuzz-expression-append $samples $result)\n (_fuzz-enumerate-advance\n $generator $size $limit $frames\n (+ $enumerated 1) (+ $accepted 1) $discards $collected)))\n ((FuzzGenerationDiscard $reason (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames)) $tree)\n (_fuzz-enumerate-advance\n $generator $size $limit $frames\n (+ $enumerated 1) $accepted (+ $discards 1) $samples))\n ((FuzzGenerationError $code $details) $result)\n ($bad\n (_fuzz-generation-error MalformedExhaustiveOutcome (Value $bad))))))))\n (_fuzz-generation-error MalformedEnumerationState (State $state))))\n\n(= (_fuzz-enumerate-advance $generator $size $limit $frames $enumerated $accepted $discards $samples)\n (let $advanced (_fuzz-exhaustive-next-plan $frames)\n (switch $advanced\n (((ExhaustivePlan $plan)\n (FuzzEnumerateRun $generator $size $limit $plan $enumerated $accepted $discards $samples))\n (ExhaustiveComplete\n (FuzzEnumeration\n (DomainCount $accepted)\n (Enumerated $enumerated)\n (GenerationDiscards $discards)\n (Samples $samples)))\n ((FuzzGenerationError $code $details) $advanced)\n ($bad\n (_fuzz-generation-error MalformedExhaustiveAdvance (Value $bad)))))))\n\n(= (_fuzz-finish-shrink-replay $result)\n (switch $result\n (((FuzzSample $value $driver $actual-tree)\n (FuzzShrinkReplay $value $actual-tree))\n ((FuzzGenerationDiscard $reason $driver $actual-tree)\n (FuzzShrinkDiscard $reason $actual-tree))\n ((FuzzGenerationError $code $details) $result)\n ($bad\n (_fuzz-generation-error\n MalformedShrinkReplayResult\n (Value $bad))))))\n\n(= (_fuzz-shrink-replay $generator $decision-tree $size)\n (let $driver (_fuzz-shrink-replay-driver $decision-tree)\n (switch $driver\n (((FuzzGenerationError $code $details) $driver)\n ($valid\n (_fuzz-finish-shrink-replay\n (fuzz-generate $generator $valid $size)))))))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n(= (_fuzz-int-decision $lower $upper $origin $value)\n (Decision\n Int\n (Bounds $lower $upper)\n (Origin $origin)\n (Value $value)\n ()))\n\n(= (fuzz-random-driver $seed)\n (if (_fuzz-is-integer $seed)\n (let $rng (_fuzz-rng-init $seed)\n (switch $rng\n (((FuzzRng $algorithm $s01 $s00 $s11 $s10)\n (FuzzDriver Random $rng))\n ($bad\n (_fuzz-generation-error KernelError (OperationResult $bad))))))\n (_fuzz-expected-integer Seed $seed)))\n\n(= (fuzz-edge-driver $index)\n (if (_fuzz-is-integer $index)\n (if (>= $index 0)\n (FuzzDriver Edge $index)\n (_fuzz-generation-error InvalidEdgeIndex (Index $index)))\n (_fuzz-expected-integer EdgeIndex $index)))\n\n; One exhaustive run follows one choice vector: each integer decision reads its planned\n; offset (or defaults to zero past the plan) and records an (ExhaustiveFrame offset count)\n; newest-first. Enumeration is the odometer over recorded frames, driven by\n; `_fuzz-exhaustive-next-plan`; a lone driver generates the leftmost path deterministically.\n(= (fuzz-exhaustive-driver)\n (FuzzDriver Exhaustive (ExhaustiveCursor () 0 ())))\n\n(= (_fuzz-exhaustive-resume-driver $choices)\n (FuzzDriver Exhaustive (ExhaustiveCursor $choices 0 ())))\n\n; Odometer advance: increment the rightmost frame that has another branch and drop the\n; suffix; later decisions are reconstructed by default-zero descent, which is what keeps\n; enumeration exact for dependent generators. Frames arrive newest-first; the returned\n; (ExhaustivePlan offsets) is oldest-first. ExhaustiveComplete means the domain is done.\n(= (_fuzz-exhaustive-next-plan $frames-reversed)\n (if-decons-expr\n $frames-reversed\n $frame\n $earlier\n (switch $frame\n (((ExhaustiveFrame $offset $count)\n (if (< (+ $offset 1) $count)\n (let $bumped (+ $offset 1)\n (let $plan (_fuzz-exhaustive-plan-prefix $earlier ($bumped))\n (ExhaustivePlan $plan)))\n (_fuzz-exhaustive-next-plan $earlier)))\n ($bad\n (_fuzz-generation-error MalformedExhaustiveFrame (Frame $bad)))))\n ExhaustiveComplete))\n\n(= (_fuzz-exhaustive-plan-prefix $frames-reversed $accumulator)\n (if-decons-expr\n $frames-reversed\n $frame\n $earlier\n (switch $frame\n (((ExhaustiveFrame $offset $count)\n (let $next (cons-atom $offset $accumulator)\n (_fuzz-exhaustive-plan-prefix $earlier $next)))\n ($bad\n (_fuzz-generation-error MalformedExhaustiveFrame (Frame $bad)))))\n $accumulator))\n\n(= (_fuzz-valid-bytes $bytes)\n (if (== $bytes ())\n True\n (let* ((($byte $tail) (decons-atom $bytes)))\n (if (and\n (_fuzz-is-integer $byte)\n (and (<= 0 $byte) (<= $byte 255)))\n (_fuzz-valid-bytes $tail)\n False))))\n\n(= (fuzz-bytes-driver $bytes)\n (if (_fuzz-valid-bytes $bytes)\n (FuzzDriver Bytes (BytesState $bytes 0))\n (_fuzz-generation-error InvalidByteInput (Bytes $bytes))))\n\n(= (_fuzz-edge-add $candidate $lower $upper $candidates)\n (if (and (<= $lower $candidate) (<= $candidate $upper))\n (if (is-member $candidate $candidates)\n $candidates\n (append $candidates ($candidate)))\n $candidates))\n\n(= (_fuzz-edge-candidates $lower $upper $origin)\n (let* (($a (_fuzz-edge-add $origin $lower $upper ()))\n ($b (_fuzz-edge-add $lower $lower $upper $a))\n ($c (_fuzz-edge-add $upper $lower $upper $b))\n ($d (_fuzz-edge-add 0 $lower $upper $c))\n ($e (_fuzz-edge-add -1 $lower $upper $d))\n ($f (_fuzz-edge-add 1 $lower $upper $e))\n ($mid (/ (+ $lower $upper) 2)))\n (_fuzz-edge-add $mid $lower $upper $f)))\n\n(= (_fuzz-driver-int-random $rng $lower $upper $origin)\n (let $draw (_fuzz-draw-int $rng $lower $upper)\n (switch $draw\n (((FuzzDraw $value $next-rng)\n (DriverChoice\n $value\n (FuzzDriver Random $next-rng)\n (_fuzz-int-decision $lower $upper $origin $value)))\n ($bad\n (_fuzz-generation-error KernelError (OperationResult $bad)))))))\n\n(= (_fuzz-driver-int-edge $index $lower $upper $origin)\n (let* (($candidates (_fuzz-edge-candidates $lower $upper $origin))\n ($count (length $candidates))\n ($position (% $index $count))\n ($value (index-atom $candidates $position)))\n (DriverChoice\n $value\n (FuzzDriver Edge (+ $index 1))\n (_fuzz-int-decision $lower $upper $origin $value))))\n\n(= (_fuzz-inspect-int-decision $decision $lower $upper $origin)\n (switch $decision\n (((Decision\n Int\n (Bounds $seen-lower $seen-upper)\n (Origin $seen-origin)\n (Value $value)\n ())\n (if (and\n (== $lower $seen-lower)\n (and\n (== $upper $seen-upper)\n (== $origin $seen-origin)))\n (if (and (<= $lower $value) (<= $value $upper))\n (CompatibleIntDecision $value)\n (IntDecisionValueOutOfBounds $value))\n (IntDecisionMetadataMismatch\n (Bounds $seen-lower $seen-upper)\n (Origin $seen-origin))))\n ($bad (MalformedIntDecision $bad)))))\n\n(= (_fuzz-driver-int-replay $state $lower $upper $origin)\n (switch $state\n (((ReplayState $decisions $cursor)\n (if (== $decisions ())\n (_fuzz-generation-error ReplayMismatch\n (Path $cursor)\n (Expected\n (Decision\n Int\n (Bounds $lower $upper)\n (Origin $origin)\n (Value Any)\n ()))\n (Actual EndOfTrace))\n (let ($decision $tail) (decons-atom $decisions)\n (let $inspected\n (_fuzz-inspect-int-decision\n $decision\n $lower\n $upper\n $origin)\n (switch $inspected\n (((CompatibleIntDecision $value)\n (DriverChoice\n $value\n (FuzzDriver Replay (ReplayState $tail (+ $cursor 1)))\n $decision))\n ((IntDecisionValueOutOfBounds $value)\n (_fuzz-generation-error ReplayValueOutOfBounds\n (Path $cursor)\n (Bounds $lower $upper)\n (Value $value)))\n ((IntDecisionMetadataMismatch\n (Bounds $seen-lower $seen-upper)\n (Origin $seen-origin))\n (_fuzz-generation-error ReplayMismatch\n (Path $cursor)\n (ExpectedBounds $lower $upper)\n (ActualBounds $seen-lower $seen-upper)\n (Origins $origin $seen-origin)))\n ((MalformedIntDecision $bad)\n (_fuzz-generation-error ReplayMismatch\n (Path $cursor)\n (Expected IntDecision)\n (Actual $bad)))))))))\n ($bad-state\n (_fuzz-generation-error MalformedReplayState (State $bad-state))))))\n\n(= (_fuzz-shrink-replay-default-int\n $decisions\n $cursor\n $lower\n $upper\n $origin)\n (let $value (max $lower (min $upper $origin))\n (DriverChoice\n $value\n (FuzzDriver\n ShrinkReplay\n (ShrinkReplayState $decisions $cursor))\n (_fuzz-int-decision $lower $upper $origin $value))))\n\n(= (_fuzz-driver-int-shrink-replay-loop\n $decisions\n $cursor\n $lower\n $upper\n $origin)\n (if (== $decisions ())\n (_fuzz-shrink-replay-default-int\n ()\n $cursor\n $lower\n $upper\n $origin)\n (let ($decision $tail) (decons-atom $decisions)\n (let $next-cursor (+ $cursor 1)\n (let $inspected\n (_fuzz-inspect-int-decision\n $decision\n $lower\n $upper\n $origin)\n (switch $inspected\n (((CompatibleIntDecision $value)\n (DriverChoice\n $value\n (FuzzDriver\n ShrinkReplay\n (ShrinkReplayState $tail $next-cursor))\n $decision))\n ($incompatible\n (_fuzz-driver-int-shrink-replay-loop\n $tail\n $next-cursor\n $lower\n $upper\n $origin)))))))))\n\n(= (_fuzz-driver-int-shrink-replay $state $lower $upper $origin)\n (switch $state\n (((ShrinkReplayState $decisions $cursor)\n (_fuzz-driver-int-shrink-replay-loop\n $decisions\n $cursor\n $lower\n $upper\n $origin))\n ($bad-state\n (_fuzz-generation-error\n MalformedShrinkReplayState\n (State $bad-state))))))\n\n(= (_fuzz-driver-int-exhaustive $state $lower $upper $origin)\n (switch $state\n (((ExhaustiveCursor $choices $cursor $frames)\n (let* (($count (+ (- $upper $lower) 1))\n ($offset\n (if (< $cursor (length $choices))\n (index-atom $choices $cursor)\n 0)))\n (if (and (<= 0 $offset) (< $offset $count))\n (let* (($value (+ $lower $offset))\n ($frame (ExhaustiveFrame $offset $count))\n ($next-frames (cons-atom $frame $frames)))\n (DriverChoice\n $value\n (FuzzDriver\n Exhaustive\n (ExhaustiveCursor $choices (+ $cursor 1) $next-frames))\n (_fuzz-int-decision $lower $upper $origin $value)))\n (_fuzz-generation-error ExhaustiveResumeMismatch\n (Offset $offset)\n (Bounds $lower $upper)))))\n ($bad-state\n (_fuzz-generation-error\n MalformedExhaustiveState\n (State $bad-state))))))\n\n(= (_fuzz-byte-width $span $capacity $width)\n (if (>= $capacity $span)\n $width\n (_fuzz-byte-width $span (* $capacity 256) (+ $width 1))))\n\n(= (_fuzz-read-bytes $bytes $cursor $remaining $accumulator)\n (if (<= $remaining 0)\n (ByteRead $accumulator $cursor)\n (if (< $cursor (length $bytes))\n (let* (($byte (index-atom $bytes $cursor))\n ($next (+ (* $accumulator 256) $byte)))\n (_fuzz-read-bytes\n $bytes\n (+ $cursor 1)\n (- $remaining 1)\n $next))\n (_fuzz-generation-error BytesExhausted\n (Cursor $cursor)\n (Remaining $remaining)))))\n\n(= (_fuzz-driver-int-bytes $state $lower $upper $origin)\n (switch $state\n (((BytesState $bytes $cursor)\n (let* (($span (+ (- $upper $lower) 1))\n ($width (_fuzz-byte-width $span 256 1))\n ($read (_fuzz-read-bytes $bytes $cursor $width 0)))\n (switch $read\n (((ByteRead $raw $next-cursor)\n (let $value (+ $lower (% $raw $span))\n (DriverChoice\n $value\n (FuzzDriver Bytes (BytesState $bytes $next-cursor))\n (_fuzz-int-decision $lower $upper $origin $value))))\n ((FuzzGenerationError $code $details) $read)\n ($bad\n (_fuzz-generation-error\n MalformedByteRead\n (OperationResult $bad)))))))\n ($bad-state\n (_fuzz-generation-error MalformedByteState (State $bad-state))))))\n\n(= (_fuzz-driver-int $driver $lower $upper $origin)\n (if (> $lower $upper)\n (_fuzz-generation-error InvalidIntegerBounds (Bounds $lower $upper))\n (switch $driver\n (((FuzzDriver Random $rng)\n (_fuzz-driver-int-random $rng $lower $upper $origin))\n ((FuzzDriver Edge $index)\n (_fuzz-driver-int-edge $index $lower $upper $origin))\n ((FuzzDriver Replay $state)\n (_fuzz-driver-int-replay $state $lower $upper $origin))\n ((FuzzDriver ShrinkReplay $state)\n (_fuzz-driver-int-shrink-replay\n $state\n $lower\n $upper\n $origin))\n ((FuzzDriver Exhaustive $state)\n (_fuzz-driver-int-exhaustive $state $lower $upper $origin))\n ((FuzzDriver Bytes $state)\n (_fuzz-driver-int-bytes $state $lower $upper $origin))\n ($bad\n (_fuzz-generation-error MalformedDriver (Driver $bad)))))))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Decision trees flatten to their Int leaves kernel-side (one linear pass); the drivers\n; only consume the resulting leaf list.\n(= (fuzz-replay-driver $decision-tree)\n (let $leaves (_fuzz-decision-leaves-op $decision-tree)\n (unify $leaves\n (FuzzDecisionLeaves $flat)\n (FuzzDriver Replay (ReplayState $flat 0))\n (unify $leaves\n (FuzzGenerationError $code $details)\n $leaves\n (unify $leaves\n $bad\n (_fuzz-generation-error MalformedDecisionTree (Decision $bad))\n Empty)))))\n\n(= (_fuzz-shrink-replay-driver $decision-tree)\n (let $leaves (_fuzz-decision-leaves-op $decision-tree)\n (unify $leaves\n (FuzzDecisionLeaves $flat)\n (FuzzDriver\n ShrinkReplay\n (ShrinkReplayState $flat 0))\n (unify $leaves\n (FuzzGenerationError $code $details)\n $leaves\n (unify $leaves\n $bad\n (_fuzz-generation-error MalformedDecisionTree (Decision $bad))\n Empty)))))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Canonical property outcomes.\n(= (fuzz-pass)\n (Pass))\n\n(= (fuzz-fail $tag $details)\n (Fail $tag $details))\n\n(= (fuzz-discard $reason)\n (Discard $reason))\n\n(= (expect-true $condition $details)\n (if $condition\n (Pass)\n (Fail ExpectedTrue $details)))\n\n(= (expect-false $condition $details)\n (if $condition\n (Fail ExpectedFalse $details)\n (Pass)))\n\n(= (expect-atom-equal $actual $expected)\n (if (== $actual $expected)\n (Pass)\n (Fail\n NotEqual\n ((Actual $actual) (Expected $expected)))))\n\n(= (expect-alpha-equal $actual $expected)\n (if (=alpha $actual $expected)\n (Pass)\n (Fail\n NotAlphaEqual\n ((Actual $actual) (Expected $expected)))))\n\n(= (expect-results-exact $actual $expected)\n (if (== $actual $expected)\n (Pass)\n (Fail\n ResultsNotExact\n ((Actual $actual) (Expected $expected)))))\n\n(= (expect-results-alpha $actual $expected)\n (if (=alpha $actual $expected)\n (Pass)\n (Fail\n ResultsNotAlphaEqual\n ((Actual $actual) (Expected $expected)))))\n\n(= (_fuzz-remove-exact-loop $target $remaining $prefix)\n (if (== $remaining ())\n NotFound\n (let* ((($value $tail) (decons-atom $remaining)))\n (if (== $target $value)\n (Removed (append $prefix $tail))\n (_fuzz-remove-exact-loop\n $target\n $tail\n (append $prefix (cons-atom $value ())))))))\n\n(= (_fuzz-remove-exact $target $values)\n (_fuzz-remove-exact-loop $target $values ()))\n\n(= (_fuzz-results-multiset-equal $left $right)\n (if (== $left ())\n (== $right ())\n (let* ((($value $tail) (decons-atom $left))\n ($removed (_fuzz-remove-exact $value $right)))\n (switch $removed\n (((Removed $remaining)\n (_fuzz-results-multiset-equal $tail $remaining))\n (NotFound False)\n ($bad False))))))\n\n(= (_fuzz-every-member-exact $values $other)\n (if (== $values ())\n True\n (let* ((($value $tail) (decons-atom $values)))\n (if (is-member $value $other)\n (_fuzz-every-member-exact $tail $other)\n False))))\n\n(= (_fuzz-results-set-equal $left $right)\n (and\n (_fuzz-every-member-exact $left $right)\n (_fuzz-every-member-exact $right $left)))\n\n(= (expect-results-multiset $actual $expected)\n (if (_fuzz-results-multiset-equal $actual $expected)\n (Pass)\n (Fail\n ResultsNotMultisetEqual\n ((Actual $actual) (Expected $expected)))))\n\n(= (expect-results-set $actual $expected)\n (if (_fuzz-results-set-equal $actual $expected)\n (Pass)\n (Fail\n ResultsNotSetEqual\n ((Actual $actual) (Expected $expected)))))\n\n; The property argument stays lazy so a false precondition cannot run it.\n(= (implies $condition $property)\n (if $condition\n $property\n (Discard ImplicationFalse)))\n\n(= (classify $condition $label $property)\n (if $condition\n (FuzzClassified $label $property)\n $property))\n\n(= (collect $value $property)\n (FuzzCollected $value $property))\n\n(= (cover $minimum-percent $condition $label $property)\n (if (and\n (<= 0 $minimum-percent)\n (<= $minimum-percent 100))\n (FuzzCovered\n $minimum-percent\n $label\n $condition\n $property)\n (FuzzInvalidProperty\n InvalidCoveragePercentage\n (MinimumPercent $minimum-percent))))\n\n(= (counterexample $note $property)\n (FuzzAnnotated $note $property))\n\n; Compatibility aliases use the canonical outcomes.\n(= (fuzz-equal $actual $expected)\n (expect-atom-equal $actual $expected))\n\n(= (fuzz-alpha-equal $actual $expected)\n (expect-alpha-equal $actual $expected))\n\n(= (fuzz-implies $condition $property)\n (implies $condition $property))\n\n(= (fuzz-annotate $note $property)\n (counterexample $note $property))\n\n(= (fuzz-classify $condition $label $property)\n (classify $condition $label $property))\n\n(= (fuzz-collect $value $property)\n (collect $value $property))\n\n(= (fuzz-cover $minimum-percent $label $condition $property)\n (cover $minimum-percent $condition $label $property))\n\n; Quantifier wrappers are passed as the property-function argument to fuzz-check.\n(= (all-results $property)\n (FuzzPropertyFunction All $property))\n\n(= (any-result $property)\n (FuzzPropertyFunction Any $property))\n\n(= (_fuzz-normalized-add-annotation $annotation $normalized)\n (switch $normalized\n (((NormalizedProperty\n $status\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations)\n (NormalizedProperty\n $status\n $tag\n $details\n $labels\n $collected\n $coverage\n (append $annotations (cons-atom $annotation ()))))\n ($bad\n (NormalizedProperty\n Invalid\n InvalidPropertyWrapper\n (Value $bad)\n ()\n ()\n ()\n ())))))\n\n(= (_fuzz-normalized-add-label $label $normalized)\n (switch $normalized\n (((NormalizedProperty\n $status\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations)\n (NormalizedProperty\n $status\n $tag\n $details\n (append $labels (cons-atom $label ()))\n $collected\n $coverage\n $annotations))\n ($bad\n (NormalizedProperty\n Invalid\n InvalidPropertyWrapper\n (Value $bad)\n ()\n ()\n ()\n ())))))\n\n(= (_fuzz-normalized-add-collected $value $normalized)\n (switch $normalized\n (((NormalizedProperty\n $status\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations)\n (NormalizedProperty\n $status\n $tag\n $details\n $labels\n (append $collected (cons-atom $value ()))\n $coverage\n $annotations))\n ($bad\n (NormalizedProperty\n Invalid\n InvalidPropertyWrapper\n (Value $bad)\n ()\n ()\n ()\n ())))))\n\n(= (_fuzz-normalized-add-coverage\n $minimum-percent\n $label\n $hit\n $normalized)\n (switch $normalized\n (((NormalizedProperty\n $status\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations)\n (let $observation\n (CoverageObservation $minimum-percent $label $hit)\n (NormalizedProperty\n $status\n $tag\n $details\n $labels\n $collected\n (append $coverage (cons-atom $observation ()))\n $annotations)))\n ($bad\n (NormalizedProperty\n Invalid\n InvalidPropertyWrapper\n (Value $bad)\n ()\n ()\n ()\n ())))))\n\n(= (_fuzz-normalize-property-result $result)\n (switch $result\n (((Pass)\n (NormalizedProperty Pass None () () () () ()))\n (True\n (NormalizedProperty Pass None () () () () ()))\n (False\n (NormalizedProperty Fail BooleanFalse () () () () ()))\n ((Fail $tag $details)\n (NormalizedProperty Fail $tag $details () () () ()))\n ((Discard $reason)\n (NormalizedProperty Discard Discarded $reason () () () ()))\n ((FuzzAnnotated $annotation $outcome)\n (_fuzz-normalized-add-annotation\n $annotation\n (_fuzz-normalize-property-result $outcome)))\n ((FuzzClassified $label $outcome)\n (_fuzz-normalized-add-label\n $label\n (_fuzz-normalize-property-result $outcome)))\n ((FuzzCollected $value $outcome)\n (_fuzz-normalized-add-collected\n $value\n (_fuzz-normalize-property-result $outcome)))\n ((FuzzCovered $minimum-percent $label $hit $outcome)\n (_fuzz-normalized-add-coverage\n $minimum-percent\n $label\n $hit\n (_fuzz-normalize-property-result $outcome)))\n ((FuzzInvalidProperty $code $details)\n (NormalizedProperty Invalid $code $details () () () ()))\n ((Error $subject ResourceLimit)\n (NormalizedProperty\n Cutoff\n ResourceLimit\n (Error $subject ResourceLimit)\n ()\n ()\n ()\n ()))\n ((Error $subject StackOverflow)\n (NormalizedProperty\n Cutoff\n StackOverflow\n (Error $subject StackOverflow)\n ()\n ()\n ()\n ()))\n ((Error $subject TableResourceLimit)\n (NormalizedProperty\n Cutoff\n TableResourceLimit\n (Error $subject TableResourceLimit)\n ()\n ()\n ()\n ()))\n ((Error $subject $reason)\n (NormalizedProperty\n Fail\n LanguageError\n (Error $subject $reason)\n ()\n ()\n ()\n ()))\n ($bad\n (NormalizedProperty\n Invalid\n MalformedPropertyResult\n (Value $bad)\n ()\n ()\n ()\n ())))))\n\n(= (_fuzz-first-result $current $candidate)\n (switch $current\n ((None (Some $candidate))\n ((Some $value) $current)\n ($bad (Some $candidate)))))\n\n(= (_fuzz-classification-add $normalized $state)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (switch $normalized\n (((NormalizedProperty\n $status\n $tag\n $details\n $new-labels\n $new-collected\n $new-coverage\n $new-annotations)\n (let* (($next-pass-count\n (if (== $status Pass)\n (+ $pass-count 1)\n $pass-count))\n ($next-fail\n (if (== $status Fail)\n (_fuzz-first-result $first-fail $normalized)\n $first-fail))\n ($next-discard\n (if (== $status Discard)\n (_fuzz-first-result $first-discard $normalized)\n $first-discard))\n ($next-cutoff\n (if (== $status Cutoff)\n (_fuzz-first-result $first-cutoff $normalized)\n $first-cutoff))\n ($next-invalid\n (if (== $status Invalid)\n (_fuzz-first-result $first-invalid $normalized)\n $first-invalid)))\n (PropertyClassification\n $next-pass-count\n $next-fail\n $next-discard\n $next-cutoff\n $next-invalid\n (append $labels $new-labels)\n (append $collected $new-collected)\n (append $coverage $new-coverage)\n (append $annotations $new-annotations))))\n ($bad\n (PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n (Some\n (NormalizedProperty\n Invalid\n InvalidNormalizedProperty\n (Value $bad)\n ()\n ()\n ()\n ()))\n $labels\n $collected\n $coverage\n $annotations)))))\n ($bad-state $bad-state))))\n\n(= (_fuzz-classify-results-loop $remaining $state)\n (if (== $remaining ())\n $state\n (let* ((($result $tail) (decons-atom $remaining))\n ($normalized\n (_fuzz-normalize-property-result $result))\n ($next\n (_fuzz-classification-add $normalized $state)))\n (_fuzz-classify-results-loop $tail $next))))\n\n(= (_fuzz-case-from-normalized\n $normalized\n $state\n $results\n $steps)\n (switch $normalized\n (((NormalizedProperty\n $status\n $tag\n $details\n $ignored-labels\n $ignored-collected\n $ignored-coverage\n $ignored-annotations)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (FuzzCaseResult\n $status\n $tag\n (Details $details)\n (Labels $labels)\n (Collected $collected)\n (Coverage $coverage)\n (Annotations $annotations)\n (Results $results)\n (Steps $steps)))\n ($bad-state\n (FuzzCaseResult\n Invalid\n InvalidClassificationState\n (Details (Value $bad-state))\n (Labels ())\n (Collected ())\n (Coverage ())\n (Annotations ())\n (Results $results)\n (Steps $steps))))))\n ($bad\n (FuzzCaseResult\n Invalid\n InvalidNormalizedProperty\n (Details (Value $bad))\n (Labels ())\n (Collected ())\n (Coverage ())\n (Annotations ())\n (Results $results)\n (Steps $steps))))))\n\n(= (_fuzz-synthetic-case $status $tag $details $state $results $steps)\n (_fuzz-case-from-normalized\n (NormalizedProperty $status $tag $details () () () ())\n $state\n $results\n $steps))\n\n(= (_fuzz-case-from-option\n $option\n $fallback-status\n $fallback-tag\n $state\n $results\n $steps)\n (switch $option\n (((Some $normalized)\n (_fuzz-case-from-normalized\n $normalized\n $state\n $results\n $steps))\n (None\n (_fuzz-synthetic-case\n $fallback-status\n $fallback-tag\n ()\n $state\n $results\n $steps))\n ($bad\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationOption\n (Value $bad)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-default-after-fail $state $results $steps)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (switch $first-cutoff\n (((Some $cutoff)\n (_fuzz-case-from-normalized\n $cutoff\n $state\n $results\n $steps))\n (None\n (if (> $pass-count 0)\n (_fuzz-synthetic-case\n Pass\n None\n ()\n $state\n $results\n $steps)\n (_fuzz-case-from-option\n $first-discard\n Invalid\n NoPropertyResult\n $state\n $results\n $steps))))))\n ($bad-state\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationState\n (Value $bad-state)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-default $state $results $steps)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (switch $first-fail\n (((Some $failure)\n (_fuzz-case-from-normalized\n $failure\n $state\n $results\n $steps))\n (None\n (_fuzz-finish-default-after-fail\n $state\n $results\n $steps)))))\n ($bad-state\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationState\n (Value $bad-state)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-all-after-fail $state $results $steps)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (switch $first-cutoff\n (((Some $cutoff)\n (_fuzz-case-from-normalized\n $cutoff\n $state\n $results\n $steps))\n (None\n (switch $first-discard\n (((Some $discard)\n (_fuzz-case-from-normalized\n $discard\n $state\n $results\n $steps))\n (None\n (if (> $pass-count 0)\n (_fuzz-synthetic-case\n Pass\n None\n ()\n $state\n $results\n $steps)\n (_fuzz-synthetic-case\n Invalid\n NoPropertyResult\n ()\n $state\n $results\n $steps)))))))))\n ($bad-state\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationState\n (Value $bad-state)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-all $state $results $steps)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (switch $first-fail\n (((Some $failure)\n (_fuzz-case-from-normalized\n $failure\n $state\n $results\n $steps))\n (None\n (_fuzz-finish-all-after-fail\n $state\n $results\n $steps)))))\n ($bad-state\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationState\n (Value $bad-state)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-any-after-pass $state $results $steps)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (switch $first-fail\n (((Some $failure)\n (_fuzz-case-from-normalized\n $failure\n $state\n $results\n $steps))\n (None\n (switch $first-cutoff\n (((Some $cutoff)\n (_fuzz-case-from-normalized\n $cutoff\n $state\n $results\n $steps))\n (None\n (_fuzz-case-from-option\n $first-discard\n Invalid\n NoPropertyResult\n $state\n $results\n $steps))))))))\n ($bad-state\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationState\n (Value $bad-state)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-any $state $results $steps)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (if (> $pass-count 0)\n (_fuzz-synthetic-case\n Pass\n None\n ()\n $state\n $results\n $steps)\n (_fuzz-finish-any-after-pass\n $state\n $results\n $steps)))\n ($bad-state\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationState\n (Value $bad-state)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-valid-classification\n $quantifier\n $state\n $results\n $steps)\n (if (== $quantifier Default)\n (_fuzz-finish-default $state $results $steps)\n (if (== $quantifier All)\n (_fuzz-finish-all $state $results $steps)\n (if (== $quantifier Any)\n (_fuzz-finish-any $state $results $steps)\n (_fuzz-synthetic-case\n Invalid\n InvalidQuantifier\n (Quantifier $quantifier)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-finish-property-classification\n $quantifier\n $state\n $results\n $steps)\n (switch $state\n (((PropertyClassification\n $pass-count\n $first-fail\n $first-discard\n $first-cutoff\n $first-invalid\n $labels\n $collected\n $coverage\n $annotations)\n (switch $first-invalid\n (((Some $invalid)\n (_fuzz-case-from-normalized\n $invalid\n $state\n $results\n $steps))\n (None\n (_fuzz-finish-valid-classification\n $quantifier\n $state\n $results\n $steps)))))\n ($bad-state\n (_fuzz-synthetic-case\n Invalid\n InvalidClassificationState\n (Value $bad-state)\n $state\n $results\n $steps)))))\n\n(= (_fuzz-initial-classification $outcome-status)\n (if (== $outcome-status Completed)\n (PropertyClassification\n 0 None None None None () () () ())\n (if (== $outcome-status ResourceLimit)\n (PropertyClassification\n 0\n None\n None\n (Some\n (NormalizedProperty\n Cutoff ResourceLimit () () () () ()))\n None\n ()\n ()\n ()\n ())\n (if (== $outcome-status StackOverflow)\n (PropertyClassification\n 0\n None\n None\n (Some\n (NormalizedProperty\n Cutoff StackOverflow () () () () ()))\n None\n ()\n ()\n ()\n ())\n (PropertyClassification\n 0\n None\n None\n None\n (Some\n (NormalizedProperty\n Invalid\n InvalidEvaluatorStatus\n (Status $outcome-status)\n ()\n ()\n ()\n ()))\n ()\n ()\n ()\n ())))))\n\n(= (_fuzz-classify-property-results\n $quantifier\n $results\n $steps\n $outcome-status)\n (if (== $results ())\n (let $state (_fuzz-initial-classification $outcome-status)\n (_fuzz-synthetic-case\n Invalid\n NoPropertyResult\n ()\n $state\n $results\n $steps))\n (let* (($initial\n (_fuzz-initial-classification $outcome-status))\n ($classified\n (_fuzz-classify-results-loop\n $results\n $initial)))\n (_fuzz-finish-property-classification\n $quantifier\n $classified\n $results\n $steps))))\n\n(= (_fuzz-evaluate-property\n $property\n $quantifier\n $value\n $maximum-steps\n $maximum-depth\n $effect-policy)\n (let $resolved-policy $effect-policy\n (let $outcome\n (_fuzz-eval-case\n ($property $value)\n $maximum-steps\n $maximum-depth\n $resolved-policy)\n (switch $outcome\n (((FuzzCaseOutcome Completed $results $steps)\n (_fuzz-classify-property-results\n $quantifier\n $results\n $steps\n Completed))\n ((FuzzCaseOutcome ResourceLimit $results $steps)\n (_fuzz-classify-property-results\n $quantifier\n $results\n $steps\n ResourceLimit))\n ((FuzzCaseOutcome StackOverflow $results $steps)\n (_fuzz-classify-property-results\n $quantifier\n $results\n $steps\n StackOverflow))\n ((FuzzCaseOutcome\n (EffectDenied $effect $operation)\n $results\n $steps)\n (let $state\n (PropertyClassification\n 0 None None None None () () () ())\n (_fuzz-synthetic-case\n HostFault\n EffectDenied\n ((Effect $effect) (Operation $operation))\n $state\n $results\n $steps)))\n ($bad\n (let $state\n (PropertyClassification\n 0 None None None None () () () ())\n (_fuzz-synthetic-case\n Invalid\n InvalidEvaluatorOutcome\n (Value $bad)\n $state\n ()\n 0))))))))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n(= (_fuzz-default-config-data)\n (FuzzConfig\n (Runs 100)\n (Seed 0)\n (MaxSize 100)\n (MaxDiscards 1000)\n (MaxShrinks 1000)\n (MaxShrinkImprovements 1000)\n (CaseSteps 100000)\n (CaseDepth 1000)\n (EffectPolicy Sandboxed)\n (EdgeCases 16)\n ; A safety bound on exhaustive mode, sized against what a case actually costs. One case is\n ; milliseconds of interpretation here, measured at roughly 7ms for a scalar generator and 18ms for a\n ; list of forty, so a bound of 10000 meant a domain that cannot fit ground for three minutes before\n ; saying so. A thousand keeps that under half a minute. A domain larger than this is still coverable,\n ; by asking for it: the run reports EnumerationLimit rather than pretending to have covered it.\n (MaxEnumerated 1000)\n (FailureMode SameFailureTag)))\n\n(= (fuzz-default-config)\n (_fuzz-default-config-data))\n\n(= (_fuzz-config-option-name $option)\n (switch $option\n (((Runs $value) Runs)\n ((Seed $value) Seed)\n ((MaxSize $value) MaxSize)\n ((MaxDiscards $value) MaxDiscards)\n ((MaxShrinks $value) MaxShrinks)\n ((MaxShrinkImprovements $value) MaxShrinkImprovements)\n ((CaseSteps $value) CaseSteps)\n ((CaseDepth $value) CaseDepth)\n ((EffectPolicy $value) EffectPolicy)\n ((EdgeCases $value) EdgeCases)\n ((MaxEnumerated $value) MaxEnumerated)\n ((FailureMode $value) FailureMode)\n ($bad (InvalidOption $bad)))))\n\n(= (_fuzz-valid-nonnegative-integer $value)\n (and (_fuzz-is-integer $value) (>= $value 0)))\n\n(= (_fuzz-valid-positive-integer $value)\n (and (_fuzz-is-integer $value) (> $value 0)))\n\n(= (_fuzz-config-values $config)\n (switch $config\n (((FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzConfigValues\n $runs\n $seed\n $maximum-size\n $maximum-discards\n $maximum-shrinks\n $maximum-improvements\n $case-steps\n $case-depth\n $effect-policy\n $edge-cases\n $maximum-enumerated\n $failure-mode))\n ($bad\n (FuzzInvalid InvalidConfig (MalformedConfig $bad))))))\n\n(= (_fuzz-config-set $option $config)\n (let $values (_fuzz-config-values $config)\n (switch $values\n (((FuzzConfigValues\n $runs\n $seed\n $maximum-size\n $maximum-discards\n $maximum-shrinks\n $maximum-improvements\n $case-steps\n $case-depth\n $effect-policy\n $edge-cases\n $maximum-enumerated\n $failure-mode)\n (switch $option\n (((Runs $value)\n (if (_fuzz-valid-positive-integer $value)\n (FuzzConfig\n (Runs $value)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidRuns (Runs $value)))))\n ((Seed $value)\n (if (_fuzz-is-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $value)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidSeed (Seed $value)))))\n ((MaxSize $value)\n (if (_fuzz-valid-nonnegative-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $value)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidMaxSize (MaxSize $value)))))\n ((MaxDiscards $value)\n (if (_fuzz-valid-nonnegative-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $value)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidMaxDiscards (MaxDiscards $value)))))\n ((MaxShrinks $value)\n (if (_fuzz-valid-nonnegative-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $value)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidMaxShrinks (MaxShrinks $value)))))\n ((MaxShrinkImprovements $value)\n (if (_fuzz-valid-nonnegative-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $value)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidMaxShrinkImprovements\n (MaxShrinkImprovements $value)))))\n ((CaseSteps $value)\n (if (_fuzz-valid-nonnegative-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $value)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidCaseSteps (CaseSteps $value)))))\n ((CaseDepth $value)\n (if (_fuzz-valid-nonnegative-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $value)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidCaseDepth (CaseDepth $value)))))\n ((EffectPolicy $value)\n (if (or\n (== $value Sandboxed)\n (== $value ExternalEffects))\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $value)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidEffectPolicy (EffectPolicy $value)))))\n ((EdgeCases $value)\n (if (_fuzz-valid-nonnegative-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $value)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidEdgeCases (EdgeCases $value)))))\n ((MaxEnumerated $value)\n (if (_fuzz-valid-positive-integer $value)\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $value)\n (FailureMode $failure-mode))\n (FuzzInvalid\n InvalidConfig\n (InvalidMaxEnumerated (MaxEnumerated $value)))))\n ((FailureMode $value)\n (if (or\n (== $value SameFailureTag)\n (== $value AnyFailure))\n (FuzzConfig\n (Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $value))\n (FuzzInvalid\n InvalidConfig\n (InvalidFailureMode (FailureMode $value)))))\n ($bad\n (FuzzInvalid InvalidConfig (UnknownOption $bad))))))\n ((FuzzInvalid $code $details) $values)\n ($bad\n (FuzzInvalid InvalidConfig (MalformedConfigValues $bad)))))))\n\n(= (_fuzz-config-options $options $config $seen)\n (if (== $options ())\n $config\n (let* ((($option $tail) (decons-atom $options))\n ($name (_fuzz-config-option-name $option)))\n (switch $name\n (((InvalidOption $bad)\n (FuzzInvalid InvalidConfig (UnknownOption $bad)))\n ($valid-name\n (if (is-member $valid-name $seen)\n (FuzzInvalid InvalidConfig (DuplicateOption $valid-name))\n (let $next (_fuzz-config-set $option $config)\n (switch $next\n (((FuzzInvalid $code $details) $next)\n ($valid-config\n (_fuzz-config-options\n $tail\n $valid-config\n (append\n $seen\n (cons-atom $valid-name ()))))))))))))))\n\n(= (_fuzz-build-config $options)\n (_fuzz-config-options\n $options\n (_fuzz-default-config-data)\n ()))\n\n(= (fuzz-config)\n (_fuzz-build-config ()))\n\n(= (fuzz-config $a)\n (_fuzz-build-config ($a)))\n\n(= (fuzz-config $a $b)\n (_fuzz-build-config ($a $b)))\n\n(= (fuzz-config $a $b $c)\n (_fuzz-build-config ($a $b $c)))\n\n(= (fuzz-config $a $b $c $d)\n (_fuzz-build-config ($a $b $c $d)))\n\n(= (fuzz-config $a $b $c $d $e)\n (_fuzz-build-config ($a $b $c $d $e)))\n\n(= (fuzz-config $a $b $c $d $e $f)\n (_fuzz-build-config ($a $b $c $d $e $f)))\n\n(= (fuzz-config $a $b $c $d $e $f $g)\n (_fuzz-build-config ($a $b $c $d $e $f $g)))\n\n(= (fuzz-config $a $b $c $d $e $f $g $h)\n (_fuzz-build-config ($a $b $c $d $e $f $g $h)))\n\n(= (fuzz-config $a $b $c $d $e $f $g $h $i)\n (_fuzz-build-config ($a $b $c $d $e $f $g $h $i)))\n\n(= (fuzz-config $a $b $c $d $e $f $g $h $i $j)\n (_fuzz-build-config ($a $b $c $d $e $f $g $h $i $j)))\n\n(= (fuzz-config $a $b $c $d $e $f $g $h $i $j $k)\n (_fuzz-build-config ($a $b $c $d $e $f $g $h $i $j $k)))\n\n(= (fuzz-config $a $b $c $d $e $f $g $h $i $j $k $l)\n (_fuzz-build-config ($a $b $c $d $e $f $g $h $i $j $k $l)))\n\n(= (_fuzz-config-get $name $config)\n (let $values (_fuzz-config-values $config)\n (switch $values\n (((FuzzConfigValues\n $runs\n $seed\n $maximum-size\n $maximum-discards\n $maximum-shrinks\n $maximum-improvements\n $case-steps\n $case-depth\n $effect-policy\n $edge-cases\n $maximum-enumerated\n $failure-mode)\n (switch $name\n ((Runs $runs)\n (Seed $seed)\n (MaxSize $maximum-size)\n (MaxDiscards $maximum-discards)\n (MaxShrinks $maximum-shrinks)\n (MaxShrinkImprovements $maximum-improvements)\n (CaseSteps $case-steps)\n (CaseDepth $case-depth)\n (EffectPolicy $effect-policy)\n (EdgeCases $edge-cases)\n (MaxEnumerated $maximum-enumerated)\n (FailureMode $failure-mode)\n ($bad (FuzzInvalid InvalidConfig (UnknownConfigField $bad))))))\n ((FuzzInvalid $code $details) $values)\n ($bad\n (FuzzInvalid InvalidConfig (MalformedConfigValues $bad)))))))\n\n(= (_fuzz-validate-config $config)\n (let $values (_fuzz-config-values $config)\n (switch $values\n (((FuzzConfigValues\n $runs\n $seed\n $maximum-size\n $maximum-discards\n $maximum-shrinks\n $maximum-improvements\n $case-steps\n $case-depth\n $effect-policy\n $edge-cases\n $maximum-enumerated\n $failure-mode)\n $config)\n ((FuzzInvalid $code $details) $values)\n ($bad\n (FuzzInvalid InvalidConfig (MalformedConfigValues $bad)))))))\n\n(= (_fuzz-resolve-property-function $property)\n (switch $property\n (((FuzzPropertyFunction All $function)\n (ResolvedProperty All $function))\n ((FuzzPropertyFunction Any $function)\n (ResolvedProperty Any $function))\n ((FuzzPropertyFunction Default $function)\n (ResolvedProperty Default $function))\n ($function\n (ResolvedProperty Default $function)))))\n\n(= (_fuzz-validate-property-signature $property)\n (let $type (get-type $property)\n (if (== $type (-> Atom FuzzProperty))\n ValidPropertySignature\n (FuzzInvalid\n MissingPropertySignature\n (Property $property)\n (Expected (-> Atom FuzzProperty))))))\n\n(= (_fuzz-count-one $item $counts)\n (if (== $counts ())\n (cons-atom (FuzzCount $item 1) ())\n (let* ((($entry $tail) (decons-atom $counts)))\n (switch $entry\n (((FuzzCount $seen $count)\n (if (== $item $seen)\n (cons-atom\n (FuzzCount $seen (+ $count 1))\n $tail)\n (cons-atom\n $entry\n (_fuzz-count-one $item $tail))))\n ($bad\n (cons-atom\n $entry\n (_fuzz-count-one $item $tail))))))))\n\n(= (_fuzz-count-all $items $counts)\n (if (== $items ())\n $counts\n (let* ((($item $tail) (decons-atom $items))\n ($next (_fuzz-count-one $item $counts)))\n (_fuzz-count-all $tail $next))))\n\n(= (_fuzz-coverage-one\n $minimum-percent\n $label\n $hit\n $counts)\n (if (== $counts ())\n (let $hits (if $hit 1 0)\n (cons-atom\n (CoverageCount $minimum-percent $label $hits 1)\n ()))\n (let* ((($entry $tail) (decons-atom $counts)))\n (switch $entry\n (((CoverageCount\n $seen-minimum\n $seen-label\n $hits\n $total)\n (if (== $label $seen-label)\n (let* (($next-minimum\n (max $minimum-percent $seen-minimum))\n ($next-hits\n (if $hit (+ $hits 1) $hits)))\n (cons-atom\n (CoverageCount\n $next-minimum\n $seen-label\n $next-hits\n (+ $total 1))\n $tail))\n (cons-atom\n $entry\n (_fuzz-coverage-one\n $minimum-percent\n $label\n $hit\n $tail))))\n ($bad\n (cons-atom\n $entry\n (_fuzz-coverage-one\n $minimum-percent\n $label\n $hit\n $tail))))))))\n\n(= (_fuzz-coverage-all $observations $counts)\n (if (== $observations ())\n $counts\n (let* ((($observation $tail)\n (decons-atom $observations)))\n (switch $observation\n (((CoverageObservation\n $minimum-percent\n $label\n $hit)\n (_fuzz-coverage-all\n $tail\n (_fuzz-coverage-one\n $minimum-percent\n $label\n $hit\n $counts)))\n ($bad\n (_fuzz-coverage-all $tail $counts)))))))\n\n(= (_fuzz-initial-run-state)\n (FuzzRunState\n 0 0 0 0 0 0 0 () () ()))\n\n(= (_fuzz-state-attempt $phase $state)\n (switch $state\n (((FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (FuzzRunState\n $passed\n $property-discards\n $generation-discards\n (if (== $phase Regression)\n (+ $regressions 1)\n $regressions)\n (if (== $phase Example)\n (+ $examples 1)\n $examples)\n (if (== $phase Edge)\n (+ $edges 1)\n $edges)\n (if (== $phase Random)\n (+ $random 1)\n $random)\n $labels\n $collected\n $coverage))\n ($bad $bad))))\n\n(= (_fuzz-state-pass $case $state)\n (switch $case\n (((FuzzCaseResult\n Pass\n $tag\n $details\n (Labels $new-labels)\n (Collected $new-collected)\n (Coverage $new-coverage)\n $annotations\n $results\n $steps)\n (switch $state\n (((FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (FuzzRunState\n (+ $passed 1)\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n (_fuzz-count-all $new-labels $labels)\n (_fuzz-count-all $new-collected $collected)\n (_fuzz-coverage-all $new-coverage $coverage)))\n ($bad-state $bad-state))))\n ($bad-case $state))))\n\n(= (_fuzz-state-property-discard $state)\n (switch $state\n (((FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (FuzzRunState\n $passed\n (+ $property-discards 1)\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage))\n ($bad $bad))))\n\n(= (_fuzz-state-generation-discard $state)\n (switch $state\n (((FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (FuzzRunState\n $passed\n $property-discards\n (+ $generation-discards 1)\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage))\n ($bad $bad))))\n\n(= (_fuzz-run-statistics $state)\n (switch $state\n (((FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (FuzzStatistics\n (Counts\n (Passed $passed)\n (PropertyDiscards $property-discards)\n (GenerationDiscards $generation-discards)\n (Regressions $regressions)\n (Examples $examples)\n (Edges $edges)\n (Random $random))\n (Labels $labels)\n (Collected $collected)\n (Coverage $coverage)))\n ($bad\n (FuzzStatistics\n (InvalidRunState $bad)\n (Labels ())\n (Collected ())\n (Coverage ()))))))\n\n(= (_fuzz-discard-limit-exceeded $config $state)\n (switch $state\n (((FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (let $limit (_fuzz-config-get MaxDiscards $config)\n (> (+ $property-discards $generation-discards) $limit)))\n ($bad True))))\n\n(= (_fuzz-first-insufficient-coverage $coverage)\n (if (== $coverage ())\n None\n (let* ((($entry $tail) (decons-atom $coverage)))\n (switch $entry\n (((CoverageCount\n $minimum-percent\n $label\n $hits\n $total)\n (if (< (* $hits 100) (* $minimum-percent $total))\n (Some $entry)\n (_fuzz-first-insufficient-coverage $tail)))\n ($bad\n (_fuzz-first-insufficient-coverage $tail)))))))\n\n(= (_fuzz-finish-run $property-id $config $state)\n (switch $state\n (((FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (let $insufficient\n (_fuzz-first-insufficient-coverage $coverage)\n (switch $insufficient\n (((Some\n (CoverageCount\n $minimum-percent\n $label\n $hits\n $total))\n (FuzzInsufficientCoverage\n (Property $property-id)\n (Requirement\n $label\n (MinimumPercent $minimum-percent)\n (Hits $hits)\n (Total $total))\n (_fuzz-run-statistics $state)))\n (None\n (FuzzPassed\n (Property $property-id)\n (Seed (_fuzz-config-get Seed $config))\n (_fuzz-run-statistics $state)))))))\n ($bad\n (FuzzInvalid InvalidRunState (State $bad))))))\n\n(= (_fuzz-failure-signature $tag)\n (_fuzz-atom-key AlphaReplay (PropertyFailure $tag)))\n\n(= (_fuzz-failed\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state)\n (_fuzz-finalize-failure\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state))\n\n(= (_fuzz-invalid-case\n $property-id\n $phase\n $case-index\n $case\n $state)\n (switch $case\n (((FuzzCaseResult\n Invalid\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations\n $results\n $steps)\n (FuzzInvalid\n $tag\n (Property $property-id)\n (Phase $phase)\n (CaseIndex $case-index)\n $details\n $results\n (_fuzz-run-statistics $state)))\n ($bad\n (FuzzInvalid\n InvalidCase\n (Property $property-id)\n (Case $bad))))))\n\n(= (_fuzz-cutoff\n $property-id\n $phase\n $case-index\n $case\n $state)\n (switch $case\n (((FuzzCaseResult\n Cutoff\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations\n $results\n $steps)\n (FuzzCutoff\n (Property $property-id)\n (Phase $phase)\n (CaseIndex $case-index)\n (CutoffTag $tag)\n $details\n $results\n (_fuzz-run-statistics $state)))\n ($bad\n (FuzzInvalid\n InvalidCutoffCase\n (Property $property-id)\n (Case $bad))))))\n\n(= (_fuzz-host-fault\n $property-id\n $phase\n $case-index\n $case\n $state)\n (switch $case\n (((FuzzCaseResult\n HostFault\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations\n $results\n $steps)\n (FuzzHostFault\n (Property $property-id)\n (Phase $phase)\n (CaseIndex $case-index)\n (FaultTag $tag)\n $details\n $results\n (_fuzz-run-statistics $state)))\n ($bad\n (FuzzInvalid\n InvalidHostFaultCase\n (Property $property-id)\n (Case $bad))))))\n\n(= (_fuzz-handle-case\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $discard-policy)\n (switch $case\n (((FuzzCaseResult Pass $tag $details $labels $collected $coverage $annotations $results $steps)\n (FuzzContinue Pass (_fuzz-state-pass $case $state)))\n ((FuzzCaseResult Discard $tag $details $labels $collected $coverage $annotations $results $steps)\n (if (== $discard-policy Reject)\n (FuzzInvalid\n ConcreteCaseDiscarded\n (Property $property-id)\n (Phase $phase)\n (CaseIndex $case-index)\n $details)\n (let $next (_fuzz-state-property-discard $state)\n (if (_fuzz-discard-limit-exceeded $config $next)\n (FuzzGaveUp\n (Property $property-id)\n PropertyDiscards\n (_fuzz-run-statistics $next))\n (FuzzContinue Discard $next)))))\n ((FuzzCaseResult Fail $tag $details $labels $collected $coverage $annotations $results $steps)\n (_fuzz-failed\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state))\n ((FuzzCaseResult Invalid $tag $details $labels $collected $coverage $annotations $results $steps)\n (_fuzz-invalid-case\n $property-id $phase $case-index $case $state))\n ((FuzzCaseResult Cutoff $tag $details $labels $collected $coverage $annotations $results $steps)\n (_fuzz-cutoff\n $property-id $phase $case-index $case $state))\n ((FuzzCaseResult HostFault $tag $details $labels $collected $coverage $annotations $results $steps)\n (_fuzz-host-fault\n $property-id $phase $case-index $case $state))\n ($bad\n (FuzzInvalid\n MalformedCaseResult\n (Property $property-id)\n (Case $bad))))))\n\n(= (_fuzz-map-regressions $entries $index)\n (if (== $entries ())\n ()\n (let* ((($entry $tail) (decons-atom $entries))\n ($rest\n (_fuzz-map-regressions\n $tail\n (+ $index 1))))\n (switch $entry\n (((FuzzRegression $value $replay)\n (cons-atom\n (FuzzConcrete\n Regression\n $index\n $value\n $replay)\n $rest))\n ($bad\n (cons-atom\n (FuzzConcrete\n Regression\n $index\n (MalformedRegression $bad)\n None)\n $rest)))))))\n\n(= (_fuzz-map-examples $entries $index)\n (if (== $entries ())\n ()\n (let* ((($entry $tail) (decons-atom $entries))\n ($rest\n (_fuzz-map-examples\n $tail\n (+ $index 1))))\n (switch $entry\n (((FuzzExample $value)\n (cons-atom\n (FuzzConcrete Example $index $value None)\n $rest))\n ($bad\n (cons-atom\n (FuzzConcrete\n Example\n $index\n (MalformedExample $bad)\n None)\n $rest)))))))\n\n(= (_fuzz-run-concrete\n $remaining\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (if (== $remaining ())\n (_fuzz-run-edges\n 0\n (_fuzz-config-get EdgeCases $config)\n ()\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (let* ((($entry $tail) (decons-atom $remaining)))\n (switch $entry\n (((FuzzConcrete\n $phase\n $index\n $value\n $replay)\n (let* (($attempted\n (_fuzz-state-attempt $phase $state))\n ($case\n (_fuzz-evaluate-property\n $property\n $quantifier\n $value\n (_fuzz-config-get CaseSteps $config)\n (_fuzz-config-get CaseDepth $config)\n (_fuzz-config-get\n EffectPolicy\n $config)))\n ($handled\n (_fuzz-handle-case\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $index\n (Concrete (Replay $replay))\n 0\n $value\n None\n $case\n $config\n $attempted\n Reject)))\n (switch $handled\n (((FuzzContinue Pass $next-state)\n (_fuzz-run-concrete\n $tail\n $property-id\n $generator\n $property\n $quantifier\n $config\n $next-state))\n ($result $result)))))\n ($bad\n (FuzzInvalid\n MalformedConcreteCase\n (Property $property-id)\n (Case $bad))))))))\n\n(= (_fuzz-generation-discard\n $property-id\n $config\n $state)\n (let $next (_fuzz-state-generation-discard $state)\n (if (_fuzz-discard-limit-exceeded $config $next)\n (FuzzGaveUp\n (Property $property-id)\n GenerationDiscards\n (_fuzz-run-statistics $next))\n (FuzzContinue GenerationDiscard $next))))\n\n(= (_fuzz-run-edge-with-valid-key\n $key\n $value\n $tree\n $raw-index\n $remaining\n $seen\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (if (is-member $key $seen)\n (_fuzz-run-edges\n (+ $raw-index 1)\n (- $remaining 1)\n $seen\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (let* (($attempted\n (_fuzz-state-attempt Edge $state))\n ($case\n (_fuzz-evaluate-property\n $property\n $quantifier\n $value\n (_fuzz-config-get CaseSteps $config)\n (_fuzz-config-get CaseDepth $config)\n (_fuzz-config-get\n EffectPolicy\n $config)))\n ($handled\n (_fuzz-handle-case\n $property-id\n $generator\n $property\n $quantifier\n Edge\n $raw-index\n (Edge (Index $raw-index))\n (_fuzz-config-get MaxSize $config)\n $value\n $tree\n $case\n $config\n $attempted\n Count)))\n (switch $handled\n (((FuzzContinue $status $next-state)\n (_fuzz-run-edges\n (+ $raw-index 1)\n (- $remaining 1)\n (append\n $seen\n (cons-atom $key ()))\n $property-id\n $generator\n $property\n $quantifier\n $config\n $next-state))\n ($result $result))))))\n\n(= (_fuzz-run-edge-with-key\n $key\n $value\n $tree\n $raw-index\n $remaining\n $seen\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (switch $key\n (((FuzzKernelError $code $details)\n (FuzzInvalid\n NonReplayableEdgeDecision\n (Property $property-id)\n (Phase Edge)\n (ErrorCode $code)\n $details))\n ($valid\n (_fuzz-run-edge-with-valid-key\n $valid\n $value\n $tree\n $raw-index\n $remaining\n $seen\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)))))\n\n(= (_fuzz-run-edges\n $raw-index\n $remaining\n $seen\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (if (<= $remaining 0)\n (_fuzz-run-random\n 0\n 0\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (let $generated\n (fuzz-generate-edge\n $generator\n $raw-index\n (_fuzz-config-get MaxSize $config))\n (switch $generated\n (((FuzzSample $value $driver $tree)\n (let $key (_fuzz-atom-key Replay $tree)\n (_fuzz-run-edge-with-key\n $key\n $value\n $tree\n $raw-index\n $remaining\n $seen\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)))\n ((FuzzGenerationDiscard $reason $driver $tree)\n (let* (($attempted\n (_fuzz-state-attempt Edge $state))\n ($handled\n (_fuzz-generation-discard\n $property-id\n $config\n $attempted)))\n (switch $handled\n (((FuzzContinue\n GenerationDiscard\n $next-state)\n (_fuzz-run-edges\n (+ $raw-index 1)\n (- $remaining 1)\n $seen\n $property-id\n $generator\n $property\n $quantifier\n $config\n $next-state))\n ($result $result)))))\n ((FuzzGenerationError $code $details)\n (FuzzInvalid\n GenerationError\n (Property $property-id)\n (Phase Edge)\n (ErrorCode $code)\n $details))\n ($bad\n (FuzzInvalid\n MalformedGenerationResult\n (Property $property-id)\n (Phase Edge)\n (Value $bad))))))))\n\n(= (_fuzz-size-for-case $case-index $maximum-size)\n (% $case-index (+ $maximum-size 1)))\n\n(= (_fuzz-run-random\n $attempt-index\n $successful-random\n $property-id\n $generator\n $property\n $quantifier\n $config\n $state)\n (if (>= $successful-random (_fuzz-config-get Runs $config))\n (_fuzz-finish-run $property-id $config $state)\n (let* (($size\n (_fuzz-size-for-case\n $successful-random\n (_fuzz-config-get MaxSize $config)))\n ($seed\n (+ (_fuzz-config-get Seed $config)\n $attempt-index))\n ($generated\n (fuzz-generate-random\n $generator\n $seed\n $size)))\n (switch $generated\n (((FuzzSample $value $driver $tree)\n (let* (($attempted\n (_fuzz-state-attempt Random $state))\n ($case\n (_fuzz-evaluate-property\n $property\n $quantifier\n $value\n (_fuzz-config-get CaseSteps $config)\n (_fuzz-config-get CaseDepth $config)\n (_fuzz-config-get\n EffectPolicy\n $config)))\n ($handled\n (_fuzz-handle-case\n $property-id\n $generator\n $property\n $quantifier\n Random\n $attempt-index\n (Random\n (Rng xorshift128plus-v1)\n (Seed (_fuzz-config-get Seed $config))\n (Case $attempt-index)\n (Size $size))\n $size\n $value\n $tree\n $case\n $config\n $attempted\n Count)))\n (switch $handled\n (((FuzzContinue Pass $next-state)\n (_fuzz-run-random\n (+ $attempt-index 1)\n (+ $successful-random 1)\n $property-id\n $generator\n $property\n $quantifier\n $config\n $next-state))\n ((FuzzContinue Discard $next-state)\n (_fuzz-run-random\n (+ $attempt-index 1)\n $successful-random\n $property-id\n $generator\n $property\n $quantifier\n $config\n $next-state))\n ($result $result)))))\n ((FuzzGenerationDiscard $reason $driver $tree)\n (let* (($attempted\n (_fuzz-state-attempt Random $state))\n ($handled\n (_fuzz-generation-discard\n $property-id\n $config\n $attempted)))\n (switch $handled\n (((FuzzContinue\n GenerationDiscard\n $next-state)\n (_fuzz-run-random\n (+ $attempt-index 1)\n $successful-random\n $property-id\n $generator\n $property\n $quantifier\n $config\n $next-state))\n ($result $result)))))\n ((FuzzGenerationError $code $details)\n (FuzzInvalid\n GenerationError\n (Property $property-id)\n (Phase Random)\n (ErrorCode $code)\n $details))\n ($bad\n (FuzzInvalid\n MalformedGenerationResult\n (Property $property-id)\n (Phase Random)\n (Value $bad))))))))\n\n(= (_fuzz-start-run\n $property-id\n $generator\n $property\n $quantifier\n $config)\n (let* (($regressions\n (collapse\n (match &self\n (FuzzRegression\n $property-id\n $value\n $replay)\n (FuzzRegression $value $replay))))\n ($examples\n (collapse\n (match &self\n (FuzzExample $property-id $value)\n (FuzzExample $value))))\n ($concrete\n (append\n (_fuzz-map-regressions $regressions 0)\n (_fuzz-map-examples $examples 0))))\n (_fuzz-run-concrete\n $concrete\n $property-id\n $generator\n $property\n $quantifier\n $config\n (_fuzz-initial-run-state))))\n\n(= (fuzz-check $property-id $generator $property-function $config)\n (_fuzz-check-with\n $property-id\n $generator\n $property-function\n $config\n RandomPhases))\n\n; Exhaustive mode makes a stronger claim than fuzz-check: every decision tree the generator\n; accepts at size MaxSize passes the property. It walks the whole domain with the exhaustive\n; cursor and skips the regression, example, edge, and random phases; pinned concrete cases\n; belong to fuzz-check.\n(= (fuzz-check-exhaustive $property-id $generator $property-function $config)\n (_fuzz-check-with\n $property-id\n $generator\n $property-function\n $config\n ExhaustiveDomain))\n\n(= (_fuzz-check-with $property-id $generator $property-function $config $mode)\n (switch $generator\n (((FuzzGenerationError $code $details)\n (FuzzInvalid\n InvalidGenerator\n (Property $property-id)\n (ErrorCode $code)\n $details))\n ($valid-generator\n (let $validated-config (_fuzz-validate-config $config)\n (switch $validated-config\n (((FuzzInvalid $code $details) $validated-config)\n ((FuzzInvalid $code $first $second) $validated-config)\n ($valid-config\n (let $resolved\n (_fuzz-resolve-property-function\n $property-function)\n (switch $resolved\n (((ResolvedProperty\n $quantifier\n $property)\n (let $signature\n (_fuzz-validate-property-signature\n $property)\n (switch $signature\n ((ValidPropertySignature\n (if (== $mode ExhaustiveDomain)\n (_fuzz-start-exhaustive\n $property-id\n $valid-generator\n $property\n $quantifier\n $valid-config)\n (_fuzz-start-run\n $property-id\n $valid-generator\n $property\n $quantifier\n $valid-config)))\n ((FuzzInvalid $code $first $second)\n $signature)\n ((FuzzInvalid $code $details)\n $signature)\n ($bad-signature\n (FuzzInvalid\n InvalidPropertySignatureResult\n (Property $property)\n (Value $bad-signature)))))))\n ($bad\n (FuzzInvalid\n InvalidPropertyFunction\n (Property $property-id)\n (Value $bad))))))))))))))\n\n(= (_fuzz-start-exhaustive\n $property-id\n $generator\n $property\n $quantifier\n $config)\n (let $initial (_fuzz-initial-run-state)\n (_fuzz-exhaustive-check-loop\n (FuzzExhaustiveRun\n $property-id\n $generator\n $property\n $quantifier\n $config\n ()\n 0\n 0\n $initial))))\n\n(= (_fuzz-exhaustive-check-loop $state)\n (if (_fuzz-exhaustive-check-finished $state)\n $state\n (_fuzz-exhaustive-check-loop\n (_fuzz-exhaustive-check-step $state))))\n\n(= (_fuzz-exhaustive-check-finished $state)\n (unify $state\n (FuzzExhaustiveRun\n $property-id $generator $property $quantifier $config\n $plan $enumerated $accepted $run-state)\n False\n True))\n\n; One cursor run per step. Generation discards are legitimate domain holes, so MaxDiscards\n; does not apply to them here; MaxEnumerated caps every terminal attempt instead.\n(= (_fuzz-exhaustive-check-step $state)\n (unify $state\n (FuzzExhaustiveRun\n $property-id $generator $property $quantifier $config\n $plan $enumerated $accepted $run-state)\n (if (>= $enumerated (_fuzz-config-get MaxEnumerated $config))\n (FuzzGaveUp\n (Property $property-id)\n EnumerationLimit\n (_fuzz-exhaustive-statistics $enumerated $accepted $run-state))\n (let* (($size (_fuzz-config-get MaxSize $config))\n ($driver (_fuzz-exhaustive-resume-driver $plan))\n ($generated (fuzz-generate $generator $driver $size)))\n (switch $generated\n (((FuzzSample\n $value\n (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames))\n $tree)\n (_fuzz-exhaustive-check-case\n $property-id $generator $property $quantifier $config\n $frames $enumerated $accepted $run-state $value $tree $size))\n ((FuzzGenerationDiscard\n $reason\n (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames))\n $tree)\n (_fuzz-exhaustive-check-advance\n $property-id $generator $property $quantifier $config\n $frames\n (+ $enumerated 1)\n $accepted\n (_fuzz-state-generation-discard $run-state)))\n ((FuzzGenerationError $code $details)\n (FuzzInvalid\n GenerationError\n (Property $property-id)\n (Phase Exhaustive)\n (ErrorCode $code)\n $details))\n ($bad\n (FuzzInvalid\n MalformedGenerationResult\n (Property $property-id)\n (Phase Exhaustive)\n (Value $bad)))))))\n (FuzzInvalid MalformedExhaustiveRunState (Value $state))))\n\n; Every accepted tree is replayed before its property case counts: the tree must rebuild the\n; same value through the replay driver, which is what licenses the final verified claim.\n(= (_fuzz-exhaustive-check-case\n $property-id $generator $property $quantifier $config\n $frames $enumerated $accepted $run-state $value $tree $size)\n (let $replayed (fuzz-replay $generator $tree $size)\n (switch $replayed\n (((FuzzSample $replay-value $replay-driver $replay-tree)\n (if (_fuzz-replay-equal $value $replay-value)\n (let* (($coordinates\n (_fuzz-exhaustive-plan-prefix $frames ()))\n ($attempted\n (_fuzz-state-attempt Exhaustive $run-state))\n ($case\n (_fuzz-evaluate-property\n $property\n $quantifier\n $value\n (_fuzz-config-get CaseSteps $config)\n (_fuzz-config-get CaseDepth $config)\n (_fuzz-config-get EffectPolicy $config)))\n ($handled\n (_fuzz-handle-case\n $property-id\n $generator\n $property\n $quantifier\n Exhaustive\n $enumerated\n (Exhaustive\n (Choices $coordinates)\n (Case $enumerated)\n (Size $size))\n $size\n $value\n $tree\n $case\n $config\n $attempted\n Count)))\n (switch $handled\n (((FuzzContinue Pass $next-state)\n (_fuzz-exhaustive-check-advance\n $property-id $generator $property $quantifier $config\n $frames\n (+ $enumerated 1)\n (+ $accepted 1)\n $next-state))\n ((FuzzContinue Discard $next-state)\n (_fuzz-exhaustive-check-advance\n $property-id $generator $property $quantifier $config\n $frames\n (+ $enumerated 1)\n (+ $accepted 1)\n $next-state))\n ($result $result))))\n (FuzzInvalid\n ExhaustiveReplayMismatch\n (Property $property-id)\n (Value $value)\n (ReplayedValue $replay-value))))\n ((FuzzGenerationError $code $details)\n (FuzzInvalid\n ExhaustiveReplayFailure\n (Property $property-id)\n (ErrorCode $code)\n $details))\n ((FuzzGenerationDiscard $replay-reason $replay-driver $replay-tree)\n (FuzzInvalid\n ExhaustiveReplayDiscarded\n (Property $property-id)\n (Reason $replay-reason)))\n ($bad\n (FuzzInvalid\n MalformedReplayResult\n (Property $property-id)\n (Value $bad)))))))\n\n(= (_fuzz-exhaustive-check-advance\n $property-id $generator $property $quantifier $config\n $frames $enumerated $accepted $run-state)\n (let $advanced (_fuzz-exhaustive-next-plan $frames)\n (switch $advanced\n (((ExhaustivePlan $plan)\n (FuzzExhaustiveRun\n $property-id $generator $property $quantifier $config\n $plan $enumerated $accepted $run-state))\n (ExhaustiveComplete\n (_fuzz-finish-exhaustive\n $property-id $enumerated $accepted $run-state))\n ($bad\n (FuzzInvalid\n ExhaustiveAdvanceFailure\n (Property $property-id)\n (Value $bad)))))))\n\n; Verified demands the full walk: a non-empty accepted domain, no property discards (those\n; cases were never checked), and satisfied coverage requirements. Anything less is an\n; explicit invalid or gave-up result, never a pass.\n(= (_fuzz-finish-exhaustive $property-id $enumerated $accepted $run-state)\n (if (== $accepted 0)\n (let $statistics\n (_fuzz-exhaustive-statistics $enumerated $accepted $run-state)\n (FuzzInvalid\n EmptyExhaustiveDomain\n (Property $property-id)\n $statistics))\n (unify $run-state\n (FuzzRunState\n $passed\n $property-discards\n $generation-discards\n $regressions\n $examples\n $edges\n $random\n $labels\n $collected\n $coverage)\n (let $statistics\n (_fuzz-exhaustive-statistics $enumerated $accepted $run-state)\n (if (> $property-discards 0)\n (FuzzGaveUp\n (Property $property-id)\n ExhaustivePropertyDiscards\n $statistics)\n (let $insufficient\n (_fuzz-first-insufficient-coverage $coverage)\n (switch $insufficient\n (((Some\n (CoverageCount\n $minimum-percent\n $label\n $hits\n $total))\n (FuzzInsufficientCoverage\n (Property $property-id)\n (Requirement\n $label\n (MinimumPercent $minimum-percent)\n (Hits $hits)\n (Total $total))\n $statistics))\n (None\n (FuzzExhaustivelyVerified\n (Property $property-id)\n (DomainCount $accepted)\n (Enumerated $enumerated)\n $statistics)))))))\n (FuzzInvalid InvalidRunState (State $run-state)))))\n\n(= (_fuzz-exhaustive-statistics $enumerated $accepted $run-state)\n (let $statistics (_fuzz-run-statistics $run-state)\n (ExhaustiveStatistics\n (Enumerated $enumerated)\n (DomainCount $accepted)\n $statistics)))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; List edits used by collection and child shrink passes.\n(= (_fuzz-list-take-loop $values $remaining $reversed)\n (if (or (<= $remaining 0) (== $values ()))\n (reverse $reversed)\n (let* ((($value $tail) (decons-atom $values)))\n (_fuzz-list-take-loop\n $tail\n (- $remaining 1)\n (cons-atom $value $reversed)))))\n\n(= (_fuzz-list-take $values $count)\n (_fuzz-list-take-loop $values $count ()))\n\n(= (_fuzz-list-drop $values $count)\n (if (or (<= $count 0) (== $values ()))\n $values\n (let* ((($value $tail) (decons-atom $values)))\n (_fuzz-list-drop $tail (- $count 1)))))\n\n(= (_fuzz-list-remove-range $values $start $count)\n (append\n (_fuzz-list-take $values $start)\n (_fuzz-list-drop $values (+ $start $count))))\n\n(= (_fuzz-add-shrink-value $candidate $current $values)\n (if (or\n (== $candidate $current)\n (is-member $candidate $values))\n $values\n (append $values (cons-atom $candidate ()))))\n\n(= (_fuzz-halves $value)\n (if (<= $value 0)\n ()\n (let $next (trunc-math (/ $value 2))\n (cons-atom $value (_fuzz-halves $next)))))\n\n(= (_fuzz-int-midpoint-values\n $current\n $direction\n $halves\n $values)\n (if (== $halves ())\n $values\n (let* ((($half $tail) (decons-atom $halves))\n ($candidate\n (- $current (* $direction $half)))\n ($next\n (_fuzz-add-shrink-value\n $candidate\n $current\n $values)))\n (_fuzz-int-midpoint-values\n $current\n $direction\n $tail\n $next))))\n\n; A bound is a shrink candidate only when it sits strictly closer to the origin than the current\n; value. The far-side bound is an anti-shrink: on the machine length decision it re-inflated an\n; accepted (increment increment increment) counterexample back to six commands, because the lenient\n; shrink replay filled the missing draws from each decision's origin and the longer run still failed.\n(= (_fuzz-int-bound-candidate $bound $current $distance $origin $values)\n (if (< (abs-math (- $bound $origin)) $distance)\n (_fuzz-add-shrink-value $bound $current $values)\n $values))\n\n(= (_fuzz-int-value-candidates $current $lower $upper $origin)\n (if (== $current $origin)\n ()\n (let* (($distance (abs-math (- $current $origin)))\n ($direction (if (> $current $origin) 1 -1))\n ($first-half (trunc-math (/ $distance 2)))\n ($with-origin\n (_fuzz-add-shrink-value\n $origin\n $current\n ()))\n ($with-midpoints\n (_fuzz-int-midpoint-values\n $current\n $direction\n (_fuzz-halves $first-half)\n $with-origin))\n ($with-lower\n (_fuzz-int-bound-candidate\n $lower\n $current\n $distance\n $origin\n $with-midpoints)))\n (_fuzz-int-bound-candidate\n $upper\n $current\n $distance\n $origin\n $with-lower))))\n\n(= (_fuzz-int-decision-candidates-loop\n $values\n $lower\n $upper\n $origin\n $reversed)\n (if (== $values ())\n (reverse $reversed)\n (let* ((($value $tail) (decons-atom $values)))\n (_fuzz-int-decision-candidates-loop\n $tail\n $lower\n $upper\n $origin\n (cons-atom\n (_fuzz-int-decision\n $lower\n $upper\n $origin\n $value)\n $reversed)))))\n\n(= (_fuzz-int-decision-candidates $decision)\n (switch $decision\n (((Decision\n Int\n (Bounds $lower $upper)\n (Origin $origin)\n (Value $current)\n ())\n (_fuzz-int-decision-candidates-loop\n (_fuzz-int-value-candidates\n $current\n $lower\n $upper\n $origin)\n $lower\n $upper\n $origin\n ()))\n ($bad ()))))\n\n(= (_fuzz-wrap-first-child-candidates\n $kind\n $metadata\n $selection\n $candidates\n $tail\n $reversed)\n (if (== $candidates ())\n (reverse $reversed)\n (let* ((($candidate $rest) (decons-atom $candidates))\n ($children (cons-atom $candidate $tail)))\n (_fuzz-wrap-first-child-candidates\n $kind\n $metadata\n $selection\n $rest\n $tail\n (cons-atom\n (Decision\n $kind\n $metadata\n $selection\n $children)\n $reversed)))))\n\n(= (_fuzz-choice-root-candidates $decision)\n (switch $decision\n (((Decision $kind $metadata $selection $children)\n (if (or\n (== $kind Bool)\n (or\n (== $kind Element)\n (or\n (== $kind Frequency)\n (== $kind Option))))\n (if (== $children ())\n ()\n (let* ((($choice $tail) (decons-atom $children)))\n (_fuzz-wrap-first-child-candidates\n $kind\n $metadata\n $selection\n (_fuzz-int-decision-candidates $choice)\n $tail\n ())))\n ()))\n ($bad ()))))\n\n; Lists remove the largest legal chunks first, then smaller chunks.\n(= (_fuzz-list-removal-candidates-at\n $minimum\n $maximum\n $length\n $length-lower\n $length-upper\n $length-origin\n $items\n $chunk\n $start\n $reversed)\n (if (>= $start $length)\n (reverse $reversed)\n (let* (($available (- $length $start))\n ($removed (min $chunk $available))\n ($new-length (- $length $removed))\n ($remaining\n (_fuzz-list-remove-range\n $items\n $start\n $removed))\n ($next-start (+ $start $chunk)))\n (if (< $new-length $minimum)\n (_fuzz-list-removal-candidates-at\n $minimum\n $maximum\n $length\n $length-lower\n $length-upper\n $length-origin\n $items\n $chunk\n $next-start\n $reversed)\n (let* (($length-decision\n (_fuzz-int-decision\n $length-lower\n $length-upper\n $length-origin\n $new-length))\n ($children\n (cons-atom\n $length-decision\n $remaining))\n ($candidate\n (Decision\n List\n (Bounds $minimum $maximum)\n (Length $new-length)\n $children)))\n (_fuzz-list-removal-candidates-at\n $minimum\n $maximum\n $length\n $length-lower\n $length-upper\n $length-origin\n $items\n $chunk\n $next-start\n (cons-atom $candidate $reversed)))))))\n\n(= (_fuzz-list-removal-candidates-sizes\n $minimum\n $maximum\n $length\n $length-lower\n $length-upper\n $length-origin\n $items\n $sizes\n $candidates)\n (if (== $sizes ())\n $candidates\n (let* ((($chunk $tail) (decons-atom $sizes))\n ($for-size\n (_fuzz-list-removal-candidates-at\n $minimum\n $maximum\n $length\n $length-lower\n $length-upper\n $length-origin\n $items\n $chunk\n 0\n ())))\n (_fuzz-list-removal-candidates-sizes\n $minimum\n $maximum\n $length\n $length-lower\n $length-upper\n $length-origin\n $items\n $tail\n (append $candidates $for-size)))))\n\n(= (_fuzz-list-root-candidates $decision)\n (switch $decision\n (((Decision\n List\n (Bounds $minimum $maximum)\n (Length $length)\n $children)\n (if (== $children ())\n ()\n (let* ((($length-decision $items)\n (decons-atom $children)))\n (switch $length-decision\n (((Decision\n Int\n (Bounds $length-lower $length-upper)\n (Origin $length-origin)\n (Value $seen-length)\n ())\n (if (and\n (== $length $seen-length)\n (> $length $minimum))\n (_fuzz-list-removal-candidates-sizes\n $minimum\n $maximum\n $length\n $length-lower\n $length-upper\n $length-origin\n $items\n (_fuzz-halves (- $length $minimum))\n ())\n ()))\n ($bad ()))))))\n ($bad ()))))\n\n(= (_fuzz-generic-removal-candidates-at\n $kind\n $metadata\n $selection\n $children\n $length\n $chunk\n $start\n $reversed)\n (if (>= $start $length)\n (reverse $reversed)\n (let* (($available (- $length $start))\n ($removed (min $chunk $available))\n ($remaining\n (_fuzz-list-remove-range\n $children\n $start\n $removed))\n ($candidate\n (Decision\n $kind\n $metadata\n $selection\n $remaining)))\n (_fuzz-generic-removal-candidates-at\n $kind\n $metadata\n $selection\n $children\n $length\n $chunk\n (+ $start $chunk)\n (cons-atom $candidate $reversed)))))\n\n(= (_fuzz-generic-removal-candidates-sizes\n $kind\n $metadata\n $selection\n $children\n $length\n $sizes\n $candidates)\n (if (== $sizes ())\n $candidates\n (let* ((($chunk $tail) (decons-atom $sizes))\n ($for-size\n (_fuzz-generic-removal-candidates-at\n $kind\n $metadata\n $selection\n $children\n $length\n $chunk\n 0\n ())))\n (_fuzz-generic-removal-candidates-sizes\n $kind\n $metadata\n $selection\n $children\n $length\n $tail\n (append $candidates $for-size)))))\n\n(= (_fuzz-collection-root-candidates $decision)\n (let $lists (_fuzz-list-root-candidates $decision)\n (if (== $lists ())\n (switch $decision\n (((Decision\n Filter\n $metadata\n $selection\n $children)\n (let $count (length $children)\n (if (> $count 0)\n (_fuzz-generic-removal-candidates-sizes\n Filter\n $metadata\n $selection\n $children\n $count\n (_fuzz-halves $count)\n ())\n ())))\n ((Decision\n Recursive\n $metadata\n $selection\n $children)\n (if (> (length $children) 0)\n (cons-atom\n (Decision\n Recursive\n $metadata\n $selection\n ())\n ())\n ()))\n ($bad ())))\n $lists)))\n\n(= (_fuzz-numeric-root-candidates $decision)\n (_fuzz-int-decision-candidates $decision))\n\n(= (_fuzz-wrap-child-candidates\n $kind\n $metadata\n $selection\n $prefix\n $tail\n $candidates\n $reversed)\n (if (== $candidates ())\n (reverse $reversed)\n (let* ((($candidate $rest)\n (decons-atom $candidates))\n ($children\n (append\n $prefix\n (cons-atom $candidate $tail))))\n (_fuzz-wrap-child-candidates\n $kind\n $metadata\n $selection\n $prefix\n $tail\n $rest\n (cons-atom\n (Decision\n $kind\n $metadata\n $selection\n $children)\n $reversed)))))\n\n(= (_fuzz-child-shrink-candidates-loop\n $kind\n $metadata\n $selection\n $remaining\n $prefix\n $candidates)\n (if (== $remaining ())\n $candidates\n (let ($child $tail) (decons-atom $remaining)\n (let $root-candidates\n (_fuzz-built-in-root-candidates $child)\n (let $nested-candidates\n (switch $child\n (((Decision\n $child-kind\n $child-metadata\n $child-selection\n $child-children)\n (_fuzz-child-shrink-candidates-loop\n $child-kind\n $child-metadata\n $child-selection\n $child-children\n ()\n ()))\n ($bad ())))\n (let $custom-candidates\n (_fuzz-custom-root-candidates $child)\n (let $child-candidates\n (_fuzz-deduplicate-trees\n (append\n $root-candidates\n (append\n $custom-candidates\n $nested-candidates)))\n (let $wrapped\n (_fuzz-wrap-child-candidates\n $kind\n $metadata\n $selection\n $prefix\n $tail\n $child-candidates\n ())\n (_fuzz-child-shrink-candidates-loop\n $kind\n $metadata\n $selection\n $tail\n (append\n $prefix\n (cons-atom $child ()))\n (append $candidates $wrapped))))))))))\n\n(= (_fuzz-child-shrink-candidates $decision)\n (switch $decision\n (((Decision $kind $metadata $selection $children)\n (_fuzz-child-shrink-candidates-loop\n $kind\n $metadata\n $selection\n $children\n ()\n ()))\n ($bad ()))))\n\n(= (_fuzz-valid-custom-shrink-candidates\n $results\n $name\n $arguments\n $candidates)\n (if (== $results ())\n $candidates\n (let* ((($result $tail) (decons-atom $results))\n ($next\n (switch $result\n (((Decision\n Custom\n (CustomGenerator\n (Name $name)\n (Arguments $arguments))\n $selection\n $children)\n (append\n $candidates\n (cons-atom $result ())))\n ($bad $candidates)))))\n (_fuzz-valid-custom-shrink-candidates\n $tail\n $name\n $arguments\n $next))))\n\n(= (_fuzz-custom-root-candidates $decision)\n (switch $decision\n (((Decision\n Custom\n (CustomGenerator\n (Name $name)\n (Arguments $arguments))\n $selection\n $children)\n (let $results\n (collapse\n (ShrinkChoices\n $name\n $arguments\n $decision))\n (_fuzz-valid-custom-shrink-candidates\n $results\n $name\n $arguments\n ())))\n ($bad ()))))\n\n(= (_fuzz-deduplicate-trees $trees)\n (_fuzz-deduplicate-replay $trees))\n\n(= (_fuzz-built-in-root-candidates $decision)\n (let $collections\n (_fuzz-collection-root-candidates $decision)\n (let $choices\n (_fuzz-choice-root-candidates $decision)\n (let $numeric\n (_fuzz-numeric-root-candidates $decision)\n (append\n $collections\n (append $choices $numeric))))))\n\n; The output order is the public shrink relation.\n(= (_fuzz-shrink-candidates $decision)\n (switch $decision\n (((Decision\n Int\n (Bounds $lower $upper)\n (Origin $origin)\n (Value $value)\n ())\n (_fuzz-deduplicate-trees\n (_fuzz-int-decision-candidates $decision)))\n ((Decision $kind $metadata $selection $children)\n (let $root-candidates\n (_fuzz-built-in-root-candidates $decision)\n (let $custom-candidates\n (_fuzz-custom-root-candidates $decision)\n (let $child-candidates\n (_fuzz-child-shrink-candidates $decision)\n ; Custom root candidates come before child descent: a custom hook's structural\n ; reductions (removing machine commands, dropping branches) shrink faster than\n ; simplifying values inside a structure that is about to disappear.\n (_fuzz-deduplicate-trees\n (append\n $root-candidates\n (append\n $custom-candidates\n $child-candidates)))))))\n ($bad ()))))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; A grammar is an ordinary atom in &self:\n; (FuzzGrammar name (Productions ((Production weight target template) ...)))\n\n; `switch` evaluates its subject. Grammar templates are source atoms, so use `unify` to inspect them\n; without firing user rules whose heads happen to occur in generated syntax.\n(= (_fuzz-grammar-template-switch\n $atom\n $cases)\n (if-decons-expr\n $cases\n $case\n $tail\n (unify\n $case\n ($pattern $template)\n (unify\n $atom\n $pattern\n $template\n (_fuzz-grammar-template-switch\n $atom\n $tail))\n (_fuzz-generation-error\n MalformedGrammarTemplateCase\n (Case $case)))\n Empty))\n\n(= (_fuzz-grammar-generator-validation-tasks\n $remaining\n $tasks)\n (if (== $remaining ())\n $tasks\n (let* ((($generator $tail)\n (decons-atom $remaining))\n ($next\n (cons-atom\n (GrammarGeneratorValidationTask\n $generator)\n $tasks)))\n (_fuzz-grammar-generator-validation-tasks\n $tail\n $next))))\n\n(= (_fuzz-grammar-generator-child-task\n $child\n $tasks)\n (cons-atom\n (GrammarGeneratorValidationTask $child)\n $tasks))\n\n(= (_fuzz-grammar-frequency-validation\n $remaining\n $tasks\n $total)\n (if (== $remaining ())\n (ValidatedGrammarFrequency\n $tasks\n $total)\n (let* ((($entry $tail)\n (decons-atom $remaining)))\n (_fuzz-grammar-template-switch $entry\n ((($weight $generator)\n (if (_fuzz-is-integer $weight)\n (if (> $weight 0)\n (_fuzz-grammar-frequency-validation\n $tail\n (_fuzz-grammar-generator-child-task\n $generator\n $tasks)\n (+ $total $weight))\n (_fuzz-generation-error\n InvalidFrequencyWeight\n (Weight $weight)\n (Generator $generator)))\n (_fuzz-expected-integer\n FrequencyWeight\n $weight)))\n ($bad\n (_fuzz-generation-error\n MalformedFrequencyEntry\n (Entry $bad))))))))\n\n(= (_fuzz-grammar-validate-int-generator\n $lower\n $upper\n $origin\n $tasks)\n (let $validated\n (gen-int-origin\n $lower\n $upper\n $origin)\n (switch $validated\n (((GenInt\n $seen-lower\n $seen-upper\n $seen-origin)\n (_fuzz-validate-grammar-field-generator-loop\n $tasks))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldGenerator\n (Generator\n (GenInt\n $lower\n $upper\n $origin))))))))\n\n(= (_fuzz-grammar-validate-float-generator\n $lower\n $upper\n $origin\n $tasks)\n (if (_fuzz-is-integer $lower)\n (if (_fuzz-is-integer $upper)\n (if (_fuzz-is-integer $origin)\n (if (and\n (<= -9218868437227405312 $lower)\n (and\n (<= $lower $origin)\n (and\n (<= $origin $upper)\n (<= $upper\n 9218868437227405311))))\n (_fuzz-validate-grammar-field-generator-loop\n $tasks)\n (_fuzz-generation-error\n InvalidFloatBounds\n (IndexBounds\n $lower\n $upper\n $origin)))\n (_fuzz-expected-integer\n FloatOriginIndex\n $origin))\n (_fuzz-expected-integer\n FloatUpperIndex\n $upper))\n (_fuzz-expected-integer\n FloatLowerIndex\n $lower)))\n\n(= (_fuzz-grammar-validate-list-generator\n $child\n $minimum\n $maximum\n $tasks)\n (let $validated\n (gen-list\n $child\n $minimum\n $maximum)\n (switch $validated\n (((GenList\n $seen-child\n $seen-minimum\n $seen-maximum)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-child-task\n $child\n $tasks)))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldGenerator\n (Generator\n (GenList\n $child\n $minimum\n $maximum))))))))\n\n(= (_fuzz-grammar-validate-filter-generator\n $child\n $predicate\n $maximum-attempts\n $tasks)\n (let $validated\n (gen-filter\n $child\n $predicate\n $maximum-attempts)\n (switch $validated\n (((GenFilter\n $seen-child\n $seen-predicate\n $seen-maximum-attempts)\n (if (_fuzz-atom-ground $predicate)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-child-task\n $child\n $tasks))\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator\n (GenFilter\n $child\n $predicate\n $maximum-attempts)))))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldGenerator\n (Generator\n (GenFilter\n $child\n $predicate\n $maximum-attempts))))))))\n\n(= (_fuzz-grammar-validate-resize-generator\n $size\n $child\n $tasks)\n (let $validated\n (gen-resize $size $child)\n (switch $validated\n (((GenResize $seen-size $seen-child)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-child-task\n $child\n $tasks)))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldGenerator\n (Generator\n (GenResize $size $child))))))))\n\n(= (_fuzz-validate-grammar-field-generator-loop\n $tasks)\n (if (== $tasks ())\n (ValidGrammarFieldGenerator)\n (let* ((($task $tail)\n (decons-atom $tasks)))\n (switch $task\n (((GrammarGeneratorValidationTask\n $generator)\n (switch $generator\n (((FuzzGenerationError\n $code\n $details)\n $generator)\n ((GenConst $value)\n (if (_fuzz-atom-ground $value)\n (_fuzz-validate-grammar-field-generator-loop\n $tail)\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator $generator))))\n ((GenBool)\n (_fuzz-validate-grammar-field-generator-loop\n $tail))\n ((GenInt $lower $upper $origin)\n (_fuzz-grammar-validate-int-generator\n $lower\n $upper\n $origin\n $tail))\n ((GenFloatRange\n $lower-index\n $upper-index\n $origin-index)\n (_fuzz-grammar-validate-float-generator\n $lower-index\n $upper-index\n $origin-index\n $tail))\n ((GenFloatBits)\n (_fuzz-validate-grammar-field-generator-loop\n $tail))\n ((GenElement $values)\n (if (and\n (== (get-metatype $values)\n Expression)\n (> (length $values) 0))\n (if (_fuzz-atom-ground $values)\n (_fuzz-validate-grammar-field-generator-loop\n $tail)\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator $generator)))\n (_fuzz-generation-error\n EmptyElementSet\n (Values $values))))\n ((GenFrequency $entries $total)\n (let $validated\n (_fuzz-grammar-frequency-validation\n $entries\n $tail\n 0)\n (switch $validated\n (((ValidatedGrammarFrequency\n $next-tasks\n $calculated-total)\n (if (== $total $calculated-total)\n (_fuzz-validate-grammar-field-generator-loop\n $next-tasks)\n (_fuzz-generation-error\n InvalidFrequencyTotal\n (Expected $calculated-total)\n (Actual $total))))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldGenerator\n (Generator $generator)))))))\n ((GenTuple $generators)\n (if (== (get-metatype $generators)\n Expression)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-validation-tasks\n $generators\n $tail))\n (_fuzz-generation-error\n MalformedGrammarFieldGenerator\n (Generator $generator))))\n ((GenList $child $minimum $maximum)\n (_fuzz-grammar-validate-list-generator\n $child\n $minimum\n $maximum\n $tail))\n ((GenOption $child)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-child-task\n $child\n $tail)))\n ((GenMap $function $child)\n (if (_fuzz-atom-ground $function)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-child-task\n $child\n $tail))\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator $generator))))\n ((GenBind $child $function)\n (if (_fuzz-atom-ground $function)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-child-task\n $child\n $tail))\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator $generator))))\n ((GenFilter\n $child\n $predicate\n $maximum-attempts)\n (_fuzz-grammar-validate-filter-generator\n $child\n $predicate\n $maximum-attempts\n $tail))\n ((GenSized $function)\n (if (_fuzz-atom-ground $function)\n (_fuzz-validate-grammar-field-generator-loop\n $tail)\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator $generator))))\n ((GenResize $size $child)\n (_fuzz-grammar-validate-resize-generator\n $size\n $child\n $tail))\n ((GenRecursive $base $step)\n (if (_fuzz-atom-ground $step)\n (_fuzz-validate-grammar-field-generator-loop\n (_fuzz-grammar-generator-child-task\n $base\n $tail))\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator $generator))))\n ((GenCustom $name $arguments)\n (if (and\n (_fuzz-atom-ground $name)\n (_fuzz-atom-ground $arguments))\n (_fuzz-validate-grammar-field-generator-loop\n $tail)\n (_fuzz-generation-error\n NonGroundGrammarFieldGenerator\n (Generator $generator))))\n ($bad-generator\n (_fuzz-generation-error\n MalformedGrammarFieldGenerator\n (Generator $bad-generator))))))\n ($bad-task\n (_fuzz-generation-error\n MalformedGrammarGeneratorValidationTask\n (Value $bad-task))))))))\n\n(= (_fuzz-validate-grammar-field-generator\n $generator)\n (_fuzz-validate-grammar-field-generator-loop\n ((GrammarGeneratorValidationTask\n $generator))))\n\n(= (_fuzz-grammar-field-from-results\n $quoted-expression\n $results)\n (switch $results\n ((()\n (_fuzz-generation-error\n MissingGrammarFieldGenerator\n (Expression $quoted-expression)))\n (($generator)\n (let $validated\n (_fuzz-validate-grammar-field-generator\n $generator)\n (switch $validated\n (((ValidGrammarFieldGenerator)\n (ResolvedGrammarField $generator))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldValidation\n (Value $bad)))))))\n ($many\n (_fuzz-generation-error\n AmbiguousGrammarFieldGenerator\n (Expression $quoted-expression)\n (Results $many))))))\n\n(= (_fuzz-resolve-grammar-field\n $expression)\n (_fuzz-grammar-field-from-results\n (quote $expression)\n (collapse $expression)))\n\n(= (_fuzz-resolve-grammar-fields-loop\n $remaining\n $resolved)\n (if (== $remaining ())\n (ResolvedGrammarFields $resolved)\n (let* ((($quoted-expression $tail)\n (decons-atom $remaining)))\n (_fuzz-grammar-template-switch $quoted-expression\n (((quote $expression)\n (let $field\n (_fuzz-resolve-grammar-field\n $expression)\n (switch $field\n (((ResolvedGrammarField $generator)\n (let $next\n (_fuzz-expression-append\n $resolved\n $generator)\n (_fuzz-resolve-grammar-fields-loop\n $tail\n $next)))\n ((FuzzGenerationError $code $details)\n $field)\n ($bad\n (_fuzz-generation-error\n MalformedResolvedGrammarField\n (Value $bad)))))))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldExpression\n (Value $bad))))))))\n\n(= (_fuzz-normalize-grammar-template-fields\n $template)\n (let $fields\n (_fuzz-grammar-field-expressions\n $template)\n (switch $fields\n (((GrammarFieldExpressions $expressions)\n (let $resolved\n (_fuzz-resolve-grammar-fields-loop\n $expressions\n ())\n (switch $resolved\n (((ResolvedGrammarFields $generators)\n (let $normalized-template\n (_fuzz-grammar-replace-fields\n $template\n $generators)\n (NormalizedGrammarTemplate\n (quote $normalized-template))))\n ((FuzzGenerationError $code $details)\n $resolved)\n ($bad\n (_fuzz-generation-error\n MalformedResolvedGrammarFields\n (Value $bad)))))))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $fields)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldExpressions\n (Value $bad)))))))\n\n(= (_fuzz-prepare-grammar-template\n $grammar\n $template)\n (let $profile\n (_fuzz-grammar-template-profile\n $template)\n (switch $profile\n (((GrammarTemplateProfile\n (Ground True)\n (References $references)\n (MinimumNextId $minimum-next-id)\n (Nodes $nodes)\n (Depth $depth))\n (let $normalized\n (_fuzz-normalize-grammar-template-fields\n $template)\n (switch $normalized\n (((NormalizedGrammarTemplate\n (quote $normalized-template))\n (let $validated\n (_fuzz-validate-grammar-template\n $grammar\n $normalized-template)\n (switch $validated\n (((ValidGrammarTemplate)\n (let $indexed-template\n (_fuzz-grammar-index-references\n $normalized-template)\n (PreparedGrammarTemplate\n (quote $indexed-template)\n $references\n $minimum-next-id\n $nodes\n $depth)))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTemplateValidation\n (Grammar $grammar)\n (Value $bad)))))))\n ((FuzzGenerationError $code $details)\n $normalized)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTemplateNormalization\n (Grammar $grammar)\n (Value $bad)))))))\n ((GrammarTemplateProfile\n (Ground False)\n (References $references)\n (MinimumNextId $minimum-next-id)\n (Nodes $nodes)\n (Depth $depth))\n (_fuzz-generation-error\n NonGroundGrammarTemplate\n (Grammar $grammar)\n (Template $template)))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $profile)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTemplateProfile\n (Grammar $grammar)\n (Value $bad)))))))\n\n(= (_fuzz-validate-grammar-binding-step\n $state\n $binding)\n (switch $state\n (((FuzzGenerationError $code $details)\n $state)\n ((GrammarBindingValidationState\n $seen\n $normalized\n $next-id)\n (_fuzz-grammar-template-switch $binding\n (((Binding $sort $id)\n (if (_fuzz-is-integer $id)\n (if (>= $id 0)\n (let $present\n (_fuzz-exact-member\n $id\n $seen)\n (switch $present\n ((True\n (_fuzz-generation-error\n DuplicateGrammarBindingId\n (BindingId $id)))\n (False\n (let $next-seen\n (_fuzz-expression-append\n $seen\n $id)\n (let $next-normalized\n (_fuzz-expression-append\n $normalized\n (GrammarBinding\n (quote $sort)\n $id))\n (GrammarBindingValidationState\n $next-seen\n $next-normalized\n (max $next-id (+ $id 1))))))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $present)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarBindingMembership\n (Value $bad))))))\n (_fuzz-generation-error\n InvalidGrammarBindingId\n (BindingId $id)))\n (_fuzz-expected-integer\n GrammarBindingId\n $id)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarBinding\n (Binding $bad))))))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarBindingValidationState\n (Value $bad))))))\n\n(= (_fuzz-validate-grammar-bindings $bindings)\n (let $view\n (_fuzz-expression-view $bindings)\n (switch $view\n (((FuzzExpressionView\n $arity\n $forward\n $reversed)\n (let $folded\n (foldl-atom\n $bindings\n (GrammarBindingValidationState\n ()\n ()\n 0)\n $state\n $binding\n (_fuzz-validate-grammar-binding-step\n $state\n $binding))\n (switch $folded\n (((GrammarBindingValidationState\n $seen\n $normalized\n $next-id)\n (ValidGrammarBindings\n $normalized\n $next-id))\n ((FuzzGenerationError $code $details)\n $folded)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarBindingValidationState\n (Value $bad)))))))\n ((FuzzAtomLeaf)\n (_fuzz-generation-error\n MalformedGrammarBindings\n (Bindings $bindings)))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $view)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarBindingView\n (Value $bad)))))))\n\n(= (_fuzz-grammar-validation-enter-scope\n $grammar\n $bindings\n $scopes\n $used)\n (if-decons-expr\n $scopes\n $scope\n $parents\n (let $validated\n (_fuzz-validate-grammar-bindings\n $bindings)\n (switch $validated\n (((ValidGrammarBindings\n $normalized\n $next-id)\n (if (_fuzz-grammar-scopes-disjoint\n $normalized\n $used)\n (let $bound-scope\n (_fuzz-expression-concat\n $normalized\n $scope)\n (let $next-scopes\n (cons-atom\n $bound-scope\n $scopes)\n (let $next-used\n (_fuzz-expression-concat\n $normalized\n $used)\n (GrammarValidationState\n $next-scopes\n $next-used))))\n (_fuzz-generation-error\n DuplicateGrammarBindingId\n (Bindings $bindings))))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarBindingValidation\n (Grammar $grammar)\n (Value $bad))))))\n (_fuzz-generation-error\n MalformedGrammarValidationScopes\n (Scopes $scopes))))\n\n(= (_fuzz-grammar-validation-exit-scope\n $scopes\n $used)\n (if-decons-expr\n $scopes\n $scope\n $parents\n (if-decons-expr\n $parents\n $parent\n $rest\n (GrammarValidationState\n $parents\n $used)\n (_fuzz-generation-error\n UnbalancedGrammarValidationScope\n (Scopes $scopes)))\n (_fuzz-generation-error\n UnbalancedGrammarValidationScope\n (Scopes $scopes))))\n\n(= (_fuzz-grammar-validation-event\n $state\n $event\n $grammar)\n (switch $state\n (((GrammarValidationState\n $scopes\n $used)\n (_fuzz-grammar-template-switch $event\n (((GrammarValidationField\n (quote $generator))\n (let $validated\n (_fuzz-validate-grammar-field-generator\n $generator)\n (switch $validated\n (((ValidGrammarFieldGenerator)\n $state)\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarFieldValidation\n (Grammar $grammar)\n (Value $bad)))))))\n ((GrammarValidationScopedEnter\n (quote $bindings))\n (_fuzz-grammar-validation-enter-scope\n $grammar\n $bindings\n $scopes\n $used))\n ((GrammarValidationScopedExit)\n (_fuzz-grammar-validation-exit-scope\n $scopes\n $used))\n ((GrammarValidationMalformed\n (quote $template))\n (_fuzz-generation-error\n MalformedGrammarTemplate\n (Grammar $grammar)\n (Template (quote $template))))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarValidationEvent\n (Grammar $grammar)\n (Value $bad))))))\n ((FuzzGenerationError $code $details)\n $state)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarValidationState\n (Grammar $grammar)\n (Value $bad))))))\n\n(= (_fuzz-grammar-validation-from-fold\n $grammar\n $folded)\n (switch $folded\n (((GrammarValidationState\n (())\n $used)\n (ValidGrammarTemplate))\n ((GrammarValidationState\n $scopes\n $used)\n (_fuzz-generation-error\n UnbalancedGrammarValidationScope\n (Grammar $grammar)\n (Scopes $scopes)))\n ((FuzzGenerationError $code $details)\n $folded)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarValidationState\n (Grammar $grammar)\n (Value $bad))))))\n\n(= (_fuzz-validate-grammar-template\n $grammar\n $template)\n (let $planned\n (_fuzz-grammar-validation-plan\n $template)\n (switch $planned\n (((GrammarValidationPlan $events)\n (_fuzz-grammar-validation-from-fold\n $grammar\n (foldl-atom\n $events\n (GrammarValidationState\n (())\n ())\n $state\n $event\n (_fuzz-grammar-validation-event\n $state\n $event\n $grammar))))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $planned)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarValidationPlan\n (Grammar $grammar)\n (Value $bad)))))))\n\n; Normalization walks productions as a bare-tail machine: field resolution inside\n; `_fuzz-prepare-grammar-template` evaluates user Field expressions, so the per-production\n; work stays MeTTa; the walk itself must not pay stack depth or quadratic accumulation, so\n; the accumulator is a nested stack flattened once at the end.\n(= (_fuzz-normalize-walk-done $state)\n (unify $state\n (FuzzNormalizeWalk $grammar $remaining $index $accumulated $minimum-next-id)\n (unify $remaining () True False)\n True))\n\n(= (_fuzz-normalize-walk-prepared\n $grammar\n $tail\n $index\n $accumulated\n $minimum-next-id\n $weight\n $target\n $prepared)\n (unify $prepared\n (PreparedGrammarTemplate\n (quote $normalized-template)\n $references\n $template-minimum-next-id\n $nodes\n $depth)\n (FuzzNormalizeWalk\n $grammar\n $tail\n (+ $index 1)\n (FuzzStack\n (GrammarProduction\n $index\n $weight\n (quote $target)\n (quote $normalized-template))\n $accumulated)\n (max $minimum-next-id $template-minimum-next-id))\n (unify $prepared\n (FuzzGenerationError $code $details)\n $prepared\n (unify $prepared\n $bad\n (_fuzz-generation-error\n MalformedPreparedGrammarTemplate\n (Grammar $grammar)\n (Value $bad))\n Empty))))\n\n(= (_fuzz-normalize-walk-step $state)\n (unify $state\n (FuzzNormalizeWalk $grammar $remaining $index $accumulated $minimum-next-id)\n (if-decons-expr\n $remaining\n $production\n $tail\n (_fuzz-grammar-template-switch $production\n (((Production $weight $target $template)\n (if (_fuzz-is-integer $weight)\n (if (> $weight 0)\n (if (_fuzz-atom-ground $target)\n (let $prepared\n (_fuzz-prepare-grammar-template\n $grammar\n $template)\n (_fuzz-normalize-walk-prepared\n $grammar\n $tail\n $index\n $accumulated\n $minimum-next-id\n $weight\n $target\n $prepared))\n (_fuzz-generation-error\n NonGroundGrammarProductionTarget\n (Grammar $grammar)\n (ProductionIndex $index)\n (Target (quote $target))))\n (_fuzz-generation-error\n InvalidGrammarProductionWeight\n (Grammar $grammar)\n (ProductionIndex $index)\n (Weight $weight)))\n (_fuzz-expected-integer\n GrammarProductionWeight\n $weight)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarProduction\n (Grammar $grammar)\n (ProductionIndex $index)\n (Production $bad)))))\n (_fuzz-generation-error\n MalformedGrammarProductions\n (Grammar $grammar)\n (Productions $remaining)))\n $state))\n\n(= (_fuzz-normalize-walk-loop $state)\n (if (_fuzz-normalize-walk-done $state)\n $state\n (_fuzz-normalize-walk-loop\n (_fuzz-normalize-walk-step $state))))\n\n(= (_fuzz-normalize-grammar-productions\n $grammar\n $productions)\n (if-decons-expr\n $productions\n $first\n $tail\n (let $settled\n (_fuzz-normalize-walk-loop\n (FuzzNormalizeWalk\n $grammar\n $productions\n 0\n FuzzStackBottom\n 0))\n (unify $settled\n (FuzzNormalizeWalk $seen-grammar $remaining $count $accumulated $minimum-next-id)\n (let $flattened (_fuzz-stack-to-expression $accumulated)\n (unify $flattened\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $flattened))\n (unify $flattened\n $normalized\n (ValidatedGrammarProductions\n $normalized\n $minimum-next-id)\n Empty)))\n (unify $settled\n (FuzzGenerationError $code $details)\n $settled\n (unify $settled\n $bad\n (_fuzz-generation-error\n MalformedGrammarNormalization\n (Grammar $grammar)\n (Value $bad))\n Empty))))\n (unify\n $productions\n ()\n (_fuzz-generation-error\n EmptyGrammar\n (Grammar $grammar))\n (_fuzz-generation-error\n MalformedGrammarProductions\n (Grammar $grammar)\n (Productions $productions)))))\n\n(= (_fuzz-grammar-target-member\n $target\n $targets)\n (if-decons-expr\n $targets\n $quoted\n $tail\n (_fuzz-grammar-template-switch $quoted\n (((quote $candidate)\n (if (noreduce-eq $target $candidate)\n True\n (_fuzz-grammar-target-member\n $target\n $tail)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTarget\n (Value $bad)))))\n False))\n\n(= (_fuzz-grammar-add-target\n $target\n $targets)\n (if (_fuzz-grammar-target-member\n $target\n $targets)\n $targets\n (_fuzz-expression-append\n $targets\n (quote $target))))\n\n(= (_fuzz-template-reference-target-step\n $targets\n $quoted)\n (_fuzz-grammar-template-switch $quoted\n (((quote $target)\n (_fuzz-grammar-add-target\n $target\n $targets))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTarget\n (Value $bad))))))\n\n(= (_fuzz-template-reference-targets\n $template\n $targets)\n (let $planned\n (_fuzz-grammar-template-reference-plan\n $template)\n (switch $planned\n (((GrammarReferenceTargets $references)\n (foldl-atom\n $references\n $targets\n $seen\n $quoted\n (_fuzz-template-reference-target-step\n $seen\n $quoted)))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $planned)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarReferencePlan\n (Value $bad)))))))\n\n(= (_fuzz-grammar-reference-targets-loop\n $productions\n $targets)\n (if-decons-expr\n $productions\n $production\n $tail\n (_fuzz-grammar-template-switch $production\n (((GrammarProduction\n $index\n $weight\n (quote $target)\n (quote $template))\n (_fuzz-grammar-reference-targets-loop\n $tail\n (_fuzz-template-reference-targets\n $template\n $targets)))\n ($bad\n (_fuzz-generation-error\n MalformedNormalizedGrammarProduction\n (Production $bad)))))\n $targets))\n\n(= (_fuzz-grammar-reference-targets\n $productions)\n (_fuzz-grammar-reference-targets-loop\n $productions\n ()))\n\n(= (_fuzz-grammar-summary-merge-candidate\n $changed\n $candidate\n $current-alternatives\n $summary\n $target)\n (let $added\n (_fuzz-grammar-alternatives-add\n $current-alternatives\n $candidate)\n (unify $added\n (GrammarAlternativesAdd False $same)\n (GrammarSummaryMergeState\n $changed\n $summary)\n (unify $added\n (GrammarAlternativesAdd True $next)\n (let $replaced\n (_fuzz-grammar-summary-replace\n $summary\n $target\n $next)\n (unify $replaced\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $replaced))\n (unify $replaced\n $next-summary\n (GrammarSummaryMergeState\n True\n $next-summary)\n Empty)))\n (unify $added\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $added))\n (unify $added\n $bad\n (_fuzz-generation-error\n MalformedGrammarRequirementDominance\n (Value $bad))\n Empty))))))\n\n(= (_fuzz-grammar-summary-merge-alternative\n $changed\n $alternative\n $summary\n $target)\n (_fuzz-grammar-template-switch $alternative\n (((GrammarRequirementAlternative $candidate)\n (let $current\n (_fuzz-grammar-summary-alternatives\n $summary\n $target)\n (switch $current\n (((GrammarRequirementAlternatives\n $current-alternatives)\n (_fuzz-grammar-summary-merge-candidate\n $changed\n $candidate\n $current-alternatives\n $summary\n $target))\n ((FuzzGenerationError $code $details)\n $current)\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $current)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarRequirementAlternatives\n (Value $bad)))))))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarRequirementAlternative\n (Value $bad))))))\n\n(= (_fuzz-grammar-summary-merge-step\n $state\n $alternative\n $target)\n (switch $state\n (((FuzzGenerationError $code $details)\n $state)\n ((GrammarSummaryMergeState\n $changed\n $summary)\n (_fuzz-grammar-summary-merge-alternative\n $changed\n $alternative\n $summary\n $target))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarSummaryMergeState\n (Value $bad))))))\n\n(= (_fuzz-grammar-summary-merge\n $target\n $new-alternatives\n $summary)\n (foldl-atom\n $new-alternatives\n (GrammarSummaryMergeState\n False\n $summary)\n $state\n $alternative\n (_fuzz-grammar-summary-merge-step\n $state\n $alternative\n $target)))\n\n(= (_fuzz-grammar-template-requirements\n $template\n $summary)\n (let $analyzed\n (_fuzz-grammar-template-requirements-op\n $template\n $summary)\n (unify $analyzed\n (GrammarRequirementAlternatives $alternatives)\n $analyzed\n (unify $analyzed\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $analyzed))\n (unify $analyzed\n $bad\n (_fuzz-generation-error\n MalformedGrammarRequirementAlternatives\n (Value $bad))\n Empty)))))\n\n; The fixed point runs as a worklist: analyzing a production whose target's alternatives\n; changed enqueues exactly the productions that reference that target, so a chain of N\n; targets settles in O(N + references) analyses instead of O(N) full restarts. Merge is\n; monotone, so any fair processing order reaches the same least fixed point, and the\n; summary is validation-internal, so queue order is unobservable downstream.\n(= (_fuzz-productivity-done $state)\n (unify $state\n (FuzzProductivityQueue $productions (FuzzStack $index $rest) $summary)\n False\n True))\n\n(= (_fuzz-productivity-changed\n $productions\n $rest\n $target\n $next-summary)\n (let $dependents\n (_fuzz-grammar-dependents-of\n $productions\n (quote $target))\n (unify $dependents\n (GrammarDependents $indices)\n (let $next-queue (_fuzz-stack-push-all $rest $indices)\n (FuzzProductivityQueue\n $productions\n $next-queue\n $next-summary))\n (unify $dependents\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $dependents))\n (unify $dependents\n $bad\n (_fuzz-generation-error\n MalformedGrammarDependents\n (Value $bad))\n Empty)))))\n\n(= (_fuzz-productivity-analyze\n $productions\n $rest\n $summary\n $target\n $template)\n (let $requirements\n (_fuzz-grammar-template-requirements\n $template\n $summary)\n (unify $requirements\n (GrammarRequirementAlternatives $alternatives)\n (let $merged\n (_fuzz-grammar-summary-merge\n $target\n $alternatives\n $summary)\n (unify $merged\n (GrammarSummaryMergeState True $next-summary)\n (_fuzz-productivity-changed\n $productions\n $rest\n $target\n $next-summary)\n (unify $merged\n (GrammarSummaryMergeState False $next-summary)\n (FuzzProductivityQueue\n $productions\n $rest\n $next-summary)\n (unify $merged\n (FuzzGenerationError $code $details)\n $merged\n (unify $merged\n $bad\n (_fuzz-generation-error\n MalformedGrammarSummaryMergeState\n (Value $bad))\n Empty)))))\n (unify $requirements\n (FuzzGenerationError $code $details)\n $requirements\n (unify $requirements\n $bad\n (_fuzz-generation-error\n MalformedGrammarRequirementAlternatives\n (Value $bad))\n Empty)))))\n\n(= (_fuzz-productivity-step $state)\n (unify $state\n (FuzzProductivityQueue $productions (FuzzStack $index $rest) $summary)\n (let $production (index-atom $productions $index)\n (_fuzz-grammar-template-switch $production\n (((GrammarProduction\n $production-index\n $weight\n (quote $target)\n (quote $template))\n (_fuzz-productivity-analyze\n $productions\n $rest\n $summary\n $target\n $template))\n ($bad\n (_fuzz-generation-error\n MalformedNormalizedGrammarProduction\n (Production $bad))))))\n $state))\n\n(= (_fuzz-productivity-loop $state)\n (if (_fuzz-productivity-done $state)\n $state\n (_fuzz-productivity-loop\n (_fuzz-productivity-step $state))))\n\n(= (_fuzz-grammar-summary-has-target\n $target\n $summary)\n (let $found\n (_fuzz-grammar-summary-alternatives\n $summary\n $target)\n (switch $found\n (((GrammarRequirementAlternatives\n $alternatives)\n (> (length $alternatives) 0))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $found)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarRequirementAlternatives\n (Value $bad)))))))\n\n(= (_fuzz-grammar-summary-has-closed-target\n $target\n $summary)\n (let $found\n (_fuzz-grammar-summary-alternatives\n $summary\n $target)\n (switch $found\n (((GrammarRequirementAlternatives\n $alternatives)\n (let $present\n (_fuzz-exact-member\n (GrammarRequirementAlternative ())\n $alternatives)\n (switch $present\n (((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $present)))\n ($valid $valid)))))\n ((FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $found)))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarRequirementAlternatives\n (Value $bad)))))))\n\n(= (_fuzz-first-unsummarized-target-step\n $state\n $quoted\n $summary)\n (switch $state\n (((FuzzGenerationError $code $details)\n $state)\n ((GrammarMissingTarget (quote $missing))\n $state)\n ((GrammarMissingTarget None)\n (_fuzz-grammar-template-switch $quoted\n (((quote $target)\n (if (_fuzz-grammar-summary-has-target\n $target\n $summary)\n $state\n (GrammarMissingTarget\n (quote $target))))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTarget\n (Value $bad))))))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarMissingTargetState\n (Value $bad))))))\n\n(= (_fuzz-first-unsummarized-target\n $targets\n $summary)\n (let $folded\n (foldl-atom\n $targets\n (GrammarMissingTarget None)\n $state\n $quoted\n (_fuzz-first-unsummarized-target-step\n $state\n $quoted\n $summary))\n (switch $folded\n (((GrammarMissingTarget (quote $missing))\n (quote $missing))\n ((GrammarMissingTarget None)\n (_fuzz-generation-error\n MissingGrammarTarget\n (Targets $targets)))\n ((FuzzGenerationError $code $details)\n $folded)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarMissingTargetState\n (Value $bad)))))))\n\n(= (_fuzz-grammar-all-targets-summarized-step\n $state\n $quoted\n $summary)\n (switch $state\n (((FuzzGenerationError $code $details)\n $state)\n (False False)\n (True\n (_fuzz-grammar-template-switch $quoted\n (((quote $target)\n (_fuzz-grammar-summary-has-target\n $target\n $summary))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTarget\n (Value $bad))))))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarRequirementMembership\n (Value $bad))))))\n\n(= (_fuzz-grammar-all-targets-summarized\n $targets\n $summary)\n (foldl-atom\n $targets\n True\n $state\n $quoted\n (_fuzz-grammar-all-targets-summarized-step\n $state\n $quoted\n $summary)))\n\n(= (_fuzz-grammar-productivity-result\n $grammar\n $root\n $targets\n $summary)\n (let $all\n (_fuzz-grammar-all-targets-summarized\n $targets\n $summary)\n (switch $all\n ((True\n (let $closed\n (_fuzz-grammar-summary-has-closed-target\n $root\n $summary)\n (switch $closed\n ((True\n (ValidGrammarProductivity))\n (False\n (_fuzz-generation-error\n UnproductiveGrammarNonterminal\n (Grammar $grammar)\n (Nonterminal (quote $root))))\n ((FuzzGenerationError $code $details)\n $closed)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarRequirementMembership\n (Value $bad)))))))\n (False\n (let $missing\n (_fuzz-first-unsummarized-target\n $targets\n $summary)\n (_fuzz-generation-error\n UnproductiveGrammarNonterminal\n (Grammar $grammar)\n (Nonterminal $missing))))\n ((FuzzGenerationError $code $details)\n $all)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarRequirementMembership\n (Value $bad)))))))\n\n(= (_fuzz-grammar-productivity-fixedpoint\n $grammar\n $root\n $productions\n $targets\n $summary)\n (let $seed-queue (_fuzz-index-stack (length $productions))\n (let $settled\n (_fuzz-productivity-loop\n (FuzzProductivityQueue\n $productions\n $seed-queue\n $summary))\n (unify $settled\n (FuzzProductivityQueue\n $seen-productions\n $queue\n $next-summary)\n (_fuzz-grammar-productivity-result\n $grammar\n $root\n $targets\n $next-summary)\n (unify $settled\n (FuzzGenerationError $code $details)\n $settled\n (unify $settled\n $bad\n (_fuzz-generation-error\n MalformedGrammarProductivity\n (Grammar $grammar)\n (Value $bad))\n Empty))))))\n\n; The default validation path: the whole fixed point runs kernel-side; the exact error\n; shape stays here. The specification fixed point remains callable through\n; `_fuzz-validate-grammar-productivity-reference`.\n(= (_fuzz-validate-grammar-productivity\n $grammar\n $root\n $productions\n $targets)\n (let $verdict\n (_fuzz-grammar-productivity-op\n $productions\n (quote $root)\n $targets)\n (unify $verdict\n (ValidGrammarProductivity)\n (ValidGrammarProductivity)\n (unify $verdict\n (GrammarUnproductive (quote $nonterminal))\n (_fuzz-generation-error\n UnproductiveGrammarNonterminal\n (Grammar $grammar)\n (Nonterminal (quote $nonterminal)))\n (unify $verdict\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $verdict))\n (unify $verdict\n $bad\n (_fuzz-generation-error\n MalformedGrammarProductivity\n (Grammar $grammar)\n (Value $bad))\n Empty))))))\n\n(= (_fuzz-validate-grammar-productivity-reference\n $grammar\n $root\n $productions\n $targets)\n (_fuzz-grammar-productivity-fixedpoint\n $grammar\n $root\n $productions\n $targets\n ()))\n\n(= (_fuzz-validated-references\n $grammar\n $root\n $productions\n $minimum-next-id\n $targets)\n (let $checked\n (_fuzz-grammar-validate-references-op\n $productions\n $targets)\n (unify $checked\n (ValidGrammarReferences)\n (let $productivity\n (_fuzz-validate-grammar-productivity\n $grammar\n $root\n $productions\n $targets)\n (unify $productivity\n (ValidGrammarProductivity)\n (ValidatedGrammar\n (quote $grammar)\n (quote $root)\n $productions\n $minimum-next-id)\n (unify $productivity\n (FuzzGenerationError $code $details)\n $productivity\n (unify $productivity\n $bad\n (_fuzz-generation-error\n MalformedGrammarProductivity\n (Grammar $grammar)\n (Value $bad))\n Empty))))\n (unify $checked\n (GrammarMissingReference (quote $nonterminal))\n (_fuzz-generation-error\n MissingGrammarNonterminal\n (Grammar $grammar)\n (Nonterminal (quote $nonterminal)))\n (unify $checked\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $checked))\n (unify $checked\n $bad\n (_fuzz-generation-error\n MalformedGrammarReferenceValidation\n (Grammar $grammar)\n (Value $bad))\n Empty))))))\n\n(= (_fuzz-validate-normalized-grammar\n $grammar\n $root\n $productions\n $minimum-next-id)\n (let $targets-result\n (_fuzz-grammar-targets-op $productions)\n (unify $targets-result\n (GrammarTargets $targets)\n (if (_fuzz-grammar-target-member\n $root\n $targets)\n (_fuzz-validated-references\n $grammar\n $root\n $productions\n $minimum-next-id\n $targets)\n (_fuzz-generation-error\n MissingGrammarRoot\n (Grammar $grammar)\n (Root (quote $root))))\n (unify $targets-result\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $targets-result))\n (unify $targets-result\n $bad\n (_fuzz-generation-error\n MalformedGrammarTargets\n (Grammar $grammar)\n (Value $bad))\n Empty)))))\n\n(= (_fuzz-build-grammar\n $grammar\n $root\n $productions)\n (let $normalized\n (_fuzz-normalize-grammar-productions\n $grammar\n $productions)\n (switch $normalized\n (((ValidatedGrammarProductions\n $valid\n $minimum-next-id)\n (_fuzz-validate-normalized-grammar\n $grammar\n $root\n $valid\n $minimum-next-id))\n ((FuzzGenerationError $code $details)\n $normalized)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarNormalization\n (Grammar $grammar)\n (Value $bad)))))))\n\n(= (_fuzz-grammar-from-results\n $grammar\n $root\n $results)\n (switch $results\n ((()\n (_fuzz-generation-error\n MissingGrammar\n (Grammar $grammar)))\n (((quote $productions))\n (_fuzz-build-grammar\n $grammar\n $root\n $productions))\n ($many\n (_fuzz-generation-error\n AmbiguousGrammar\n (Grammar $grammar)\n (Results $many))))))\n\n(= (_fuzz-gen-grammar-root-ground\n (quote $grammar)\n (quote $root))\n (let $results\n (collapse\n (match &self\n (FuzzGrammar\n $grammar\n (Productions $productions))\n (quote $productions)))\n (let $validated\n (_fuzz-grammar-from-results\n $grammar\n $root\n $results)\n (switch $validated\n (((ValidatedGrammar\n (quote $name)\n (quote $target)\n $productions\n $minimum-next-id)\n (GenCustom\n _fuzz-grammar\n (GrammarRequest\n (StaticGrammar\n (quote $name)\n $productions)\n (quote $target)\n ()\n $minimum-next-id)))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedValidatedGrammar\n (Grammar $grammar)\n (Value $bad))))))))\n\n(= (gen-grammar-root $grammar $root)\n (if (_fuzz-atom-ground (quote $grammar))\n (if (_fuzz-atom-ground (quote $root))\n (_fuzz-gen-grammar-root-ground\n (quote $grammar)\n (quote $root))\n (_fuzz-generation-error\n NonGroundGrammarRoot\n (Grammar $grammar)\n (Root (quote $root))))\n (_fuzz-generation-error\n NonGroundGrammarName\n (Grammar (quote $grammar)))))\n\n(= (gen-grammar $grammar)\n (gen-grammar-root\n $grammar\n $grammar))\n\n; Scope bindings are ordered from nearest to farthest.\n(= (_fuzz-grammar-scope-has-id-step\n $state\n $binding\n $id)\n (switch $state\n ((True True)\n (False\n (_fuzz-grammar-template-switch $binding\n (((GrammarBinding (quote $sort) $candidate)\n (== $id $candidate))\n ($bad False))))\n ($bad False))))\n\n(= (_fuzz-grammar-scope-has-id\n $scope\n $id)\n (foldl-atom\n $scope\n False\n $state\n $binding\n (_fuzz-grammar-scope-has-id-step\n $state\n $binding\n $id)))\n\n(= (_fuzz-grammar-scopes-disjoint-step\n $state\n $binding\n $existing)\n (switch $state\n ((False False)\n (True\n (_fuzz-grammar-template-switch $binding\n (((GrammarBinding (quote $sort) $id)\n (== (_fuzz-grammar-scope-has-id\n $existing\n $id)\n False))\n ($bad False))))\n ($bad False))))\n\n(= (_fuzz-grammar-scopes-disjoint\n $added\n $existing)\n (foldl-atom\n $added\n True\n $state\n $binding\n (_fuzz-grammar-scopes-disjoint-step\n $state\n $binding\n $existing)))\n\n(= (_fuzz-static-productions-for-target-loop\n $remaining\n (quote $target)\n $selected)\n (if-decons-expr\n $remaining\n $production\n $tail\n (_fuzz-grammar-template-switch $production\n (((GrammarProduction\n $index\n $weight\n (quote $candidate)\n (quote $template))\n (let $next\n (if (noreduce-eq $target $candidate)\n (_fuzz-expression-append\n $selected\n $production)\n $selected)\n (_fuzz-static-productions-for-target-loop\n $tail\n (quote $target)\n $next)))\n ($bad\n (_fuzz-generation-error\n MalformedNormalizedGrammarProduction\n (Production $bad)))))\n (GrammarProductions $selected)))\n\n(= (_fuzz-source-productions\n (StaticGrammar (quote $grammar) $productions)\n (quote $target))\n (_fuzz-static-productions-for-target-loop\n $productions\n (quote $target)\n ()))\n\n(= (_fuzz-normalize-type-constructors-loop\n $schema\n $type\n $remaining\n $index\n $normalized\n $minimum-next-id)\n (if-decons-expr\n $remaining\n $constructor\n $tail\n (_fuzz-grammar-template-switch $constructor\n (((Constructor $weight $result-type $template)\n (if (_fuzz-atom-ground $result-type)\n (if (noreduce-eq $type $result-type)\n (if (_fuzz-is-integer $weight)\n (if (> $weight 0)\n (let $prepared\n (_fuzz-prepare-grammar-template\n $schema\n $template)\n (switch $prepared\n (((PreparedGrammarTemplate\n (quote $normalized-template)\n $references\n $template-minimum-next-id\n $nodes\n $depth)\n (let $next\n (_fuzz-expression-append\n $normalized\n (GrammarProduction\n $index\n $weight\n (quote $type)\n (quote\n $normalized-template)))\n (_fuzz-normalize-type-constructors-loop\n $schema\n $type\n $tail\n (+ $index 1)\n $next\n (max\n $minimum-next-id\n $template-minimum-next-id))))\n ((FuzzGenerationError $code $details)\n $prepared)\n ($bad\n (_fuzz-generation-error\n MalformedPreparedGrammarTemplate\n (Schema $schema)\n (Value $bad))))))\n (_fuzz-generation-error\n InvalidTypeConstructorWeight\n (Schema $schema)\n (Type (quote $type))\n (ConstructorIndex $index)\n (Weight $weight)))\n (_fuzz-expected-integer\n TypeConstructorWeight\n $weight))\n (_fuzz-generation-error\n TypeConstructorResultMismatch\n (Schema $schema)\n (RequestedType (quote $type))\n (ConstructorType (quote $result-type))\n (ConstructorIndex $index)))\n (_fuzz-generation-error\n NonGroundTypeConstructorResult\n (Schema $schema)\n (RequestedType (quote $type))\n (ConstructorType (quote $result-type))\n (ConstructorIndex $index))))\n ($bad\n (_fuzz-generation-error\n MalformedTypeConstructor\n (Schema $schema)\n (Type (quote $type))\n (ConstructorIndex $index)\n (Constructor (quote $bad))))))\n (unify\n $remaining\n ()\n (PreparedTypeConstructors\n $normalized\n $minimum-next-id)\n (_fuzz-generation-error\n MalformedTypeConstructors\n (Schema $schema)\n (Type (quote $type))\n (Constructors $remaining)))))\n\n(= (_fuzz-normalize-type-constructors\n $schema\n $type\n $constructors)\n (if-decons-expr\n $constructors\n $first\n $tail\n (_fuzz-normalize-type-constructors-loop\n $schema\n $type\n $constructors\n 0\n ()\n 0)\n (unify\n $constructors\n ()\n (_fuzz-generation-error\n EmptyTypeSchema\n (Schema $schema)\n (Type (quote $type)))\n (_fuzz-generation-error\n MalformedTypeConstructors\n (Schema $schema)\n (Type (quote $type))\n (Constructors $constructors)))))\n\n(= (_fuzz-type-schema-from-results\n $schema\n $type\n $results)\n (switch $results\n ((()\n (_fuzz-generation-error\n MissingTypeSchema\n (Schema $schema)\n (Type (quote $type))))\n (((quote $single))\n (_fuzz-grammar-template-switch $single\n (((FuzzTypeConstructors $constructors)\n (_fuzz-normalize-type-constructors\n $schema\n $type\n $constructors))\n ($bad\n (_fuzz-generation-error\n MalformedTypeSchema\n (Schema $schema)\n (Type (quote $type))\n (Value (quote $bad)))))))\n ($many\n (_fuzz-generation-error\n AmbiguousTypeSchema\n (Schema $schema)\n (Type (quote $type))\n (Results $many))))))\n\n(= (_fuzz-source-productions\n (DynamicTypeGrammar (quote $schema))\n (quote $type))\n (let $results\n (collapse\n (match &self\n (= (FuzzTypeSchema\n $schema\n $type)\n $constructors)\n (quote $constructors)))\n (_fuzz-type-schema-from-results\n $schema\n $type\n $results)))\n\n(= (_fuzz-source-productions\n (StaticTypeGrammar (quote $schema) $productions)\n (quote $type))\n (_fuzz-static-productions-for-target-loop\n $productions\n (quote $type)\n ()))\n\n(= (_fuzz-finalize-type-grammar\n $schema\n $root\n $productions\n $minimum-next-id)\n (let $validated\n (_fuzz-validate-normalized-grammar\n $schema\n $root\n $productions\n $minimum-next-id)\n (switch $validated\n (((ValidatedGrammar\n (quote $seen-schema)\n (quote $seen-root)\n $validated-productions\n $validated-minimum-next-id)\n (ValidatedTypeGrammar\n (quote $schema)\n (quote $root)\n $validated-productions\n $validated-minimum-next-id))\n ((FuzzGenerationError\n UnproductiveGrammarNonterminal\n (Details\n (Grammar $seen-schema)\n (Nonterminal (quote $type))))\n (_fuzz-generation-error\n UnproductiveTypeSchema\n (Schema $schema)\n (Type (quote $type))))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedTypeSchemaValidation\n (Schema $schema)\n (Type (quote $root))\n (Value $bad)))))))\n\n(= (_fuzz-build-type-grammar-prepared\n $schema\n $root\n $type\n $tail\n $seen\n $productions\n $minimum-next-id\n $remaining\n $constructors\n $constructor-minimum-next-id)\n (let $references\n (_fuzz-grammar-reference-targets\n $constructors)\n (switch $references\n (((FuzzGenerationError $code $details)\n $references)\n ($valid-references\n (let $next-pending\n (_fuzz-expression-concat\n $tail\n $valid-references)\n (let $next-seen\n (_fuzz-expression-append\n $seen\n (quote $type))\n (let $next-productions\n (_fuzz-expression-concat\n $productions\n $constructors)\n (_fuzz-build-type-grammar-loop\n $schema\n $root\n $next-pending\n $next-seen\n $next-productions\n (max\n $minimum-next-id\n $constructor-minimum-next-id)\n (- $remaining 1))))))))))\n\n(= (_fuzz-build-type-grammar-available\n $schema\n $root\n $type\n $tail\n $seen\n $productions\n $minimum-next-id\n $remaining\n $available)\n (switch $available\n (((PreparedTypeConstructors\n $constructors\n $constructor-minimum-next-id)\n (_fuzz-build-type-grammar-prepared\n $schema\n $root\n $type\n $tail\n $seen\n $productions\n $minimum-next-id\n $remaining\n $constructors\n $constructor-minimum-next-id))\n ((FuzzGenerationError $code $details)\n $available)\n ($bad\n (_fuzz-generation-error\n MalformedTypeSchemaValidation\n (Schema $schema)\n (Type (quote $type))\n (Value $bad))))))\n\n(= (_fuzz-build-type-grammar-type\n $schema\n $root\n $type\n $tail\n $seen\n $productions\n $minimum-next-id\n $remaining)\n (let $present\n (_fuzz-grammar-target-member\n $type\n $seen)\n (switch $present\n ((True\n (_fuzz-build-type-grammar-loop\n $schema\n $root\n $tail\n $seen\n $productions\n $minimum-next-id\n $remaining))\n (False\n (if (<= $remaining 0)\n (_fuzz-generation-error\n TypeSchemaExpansionLimitExceeded\n (Schema $schema)\n (Root (quote $root))\n (Limit 256))\n (_fuzz-build-type-grammar-available\n $schema\n $root\n $type\n $tail\n $seen\n $productions\n $minimum-next-id\n $remaining\n (_fuzz-source-productions\n (DynamicTypeGrammar\n (quote $schema))\n (quote $type)))))\n ((FuzzGenerationError $code $details)\n $present)\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTargetMembership\n (Type (quote $type))\n (Value $bad)))))))\n\n(= (_fuzz-build-type-grammar-loop\n $schema\n $root\n $pending\n $seen\n $productions\n $minimum-next-id\n $remaining)\n (if-decons-expr\n $pending\n $quoted\n $tail\n (_fuzz-grammar-template-switch $quoted\n (((quote $type)\n (_fuzz-build-type-grammar-type\n $schema\n $root\n $type\n $tail\n $seen\n $productions\n $minimum-next-id\n $remaining))\n ($bad\n (_fuzz-generation-error\n MalformedGrammarTarget\n (Value $bad)))))\n (_fuzz-finalize-type-grammar\n $schema\n $root\n $productions\n $minimum-next-id)))\n\n(= (_fuzz-build-type-grammar\n $schema\n $type)\n (_fuzz-build-type-grammar-loop\n $schema\n $type\n ((quote $type))\n ()\n ()\n 0\n 256))\n\n(= (_fuzz-gen-well-typed-ground\n (quote $schema)\n (quote $type))\n (let $validated\n (_fuzz-build-type-grammar\n $schema\n $type)\n (switch $validated\n (((ValidatedTypeGrammar\n (quote $seen-schema)\n (quote $seen-type)\n $constructors\n $minimum-next-id)\n (GenCustom\n _fuzz-grammar\n (GrammarRequest\n (StaticTypeGrammar\n (quote $schema)\n $constructors)\n (quote $type)\n ()\n $minimum-next-id)))\n ((FuzzGenerationError $code $details)\n $validated)\n ($bad\n (_fuzz-generation-error\n MalformedTypeSchemaValidation\n (Schema $schema)\n (Type (quote $type))\n (Value $bad)))))))\n\n(= (gen-well-typed $schema $type)\n (if (_fuzz-atom-ground (quote $schema))\n (if (_fuzz-atom-ground (quote $type))\n (_fuzz-gen-well-typed-ground\n (quote $schema)\n (quote $type))\n (_fuzz-generation-error\n NonGroundTypeSchemaRequest\n (Schema $schema)\n (Type (quote $type))))\n (_fuzz-generation-error\n NonGroundTypeSchemaName\n (Schema (quote $schema)))))\n\n; Eligibility is one grounded call: the fit semantics (Use needs its sort in scope, a\n; reference needs size > 0 and an eligible target at the split size, Scoped checks binding-id\n; disjointness) run kernel-side over raw template syntax, memoised per grammar. The MeTTa\n; side keeps the driver policy: which production a driver picks, and every wrapper shape.\n(= (_fuzz-eligible-productions\n $source\n (quote $target)\n $scope\n $size)\n (unify $source\n (StaticGrammar (quote $grammar) $productions)\n (_fuzz-eligible-productions-checked\n $productions\n (quote $target)\n $scope\n $size)\n (unify $source\n (StaticTypeGrammar (quote $schema) $productions)\n (_fuzz-eligible-productions-checked\n $productions\n (quote $target)\n $scope\n $size)\n (_fuzz-generation-error\n MalformedGrammarSource\n (Value $source)))))\n\n(= (_fuzz-eligible-productions-checked\n $productions\n (quote $target)\n $scope\n $size)\n (let $eligible\n (_fuzz-grammar-eligible-productions-op\n $productions\n (quote $target)\n $scope\n $size)\n (unify $eligible\n (EligibleGrammarProductions $selected)\n $eligible\n (unify $eligible\n (FitDuplicateGrammarBindingId (quote $bindings))\n (_fuzz-generation-error\n DuplicateGrammarBindingId\n (Bindings $bindings))\n (unify $eligible\n (FuzzKernelError $code $details)\n (_fuzz-generation-error\n KernelError\n (OperationResult $eligible))\n (unify $eligible\n $bad\n (_fuzz-generation-error\n MalformedEligibleGrammarProductions\n (Target (quote $target))\n (Value $bad))\n Empty))))))\n\n(= (_fuzz-grammar-weight-total\n $productions\n $total)\n (if (== $productions ())\n $total\n (let* ((($production $tail)\n (decons-atom $productions)))\n (switch $production\n (((GrammarProduction\n $index\n $weight\n (quote $target)\n (quote $template))\n (_fuzz-grammar-weight-total\n $tail\n (+ $total $weight)))\n ($bad $total))))))\n\n(= (_fuzz-grammar-ticket-index\n $productions\n $ticket\n $index)\n (let* ((($production $tail)\n (decons-atom $productions)))\n (switch $production\n (((GrammarProduction\n $production-index\n $weight\n (quote $target)\n (quote $template))\n (if (<= $ticket $weight)\n $index\n (_fuzz-grammar-ticket-index\n $tail\n (- $ticket $weight)\n (+ $index 1))))\n ($bad $index)))))\n\n(= (_fuzz-grammar-random-production-choice\n $rng\n $productions)\n (let* (($count (length $productions))\n ($total\n (_fuzz-grammar-weight-total\n $productions\n 0))\n ($draw\n (_fuzz-draw-int\n $rng\n 1\n $total)))\n (switch $draw\n (((FuzzDraw $ticket $next-rng)\n (let $index\n (_fuzz-grammar-ticket-index\n $productions\n $ticket\n 0)\n (DriverChoice\n $index\n (FuzzDriver Random $next-rng)\n (_fuzz-int-decision\n 0\n (- $count 1)\n 0\n $index))))\n ($bad\n (_fuzz-generation-error\n KernelError\n (OperationResult $bad)))))))\n\n(= (_fuzz-grammar-production-choice\n $driver\n $productions)\n (switch $driver\n (((FuzzDriver Random $rng)\n (_fuzz-grammar-random-production-choice\n $rng\n $productions))\n ((FuzzDriver Edge $index)\n (let* (($count\n (length $productions))\n ($position\n (% $index $count)))\n (DriverChoice\n $position\n (FuzzDriver Edge (+ $index 1))\n (_fuzz-int-decision\n 0\n (- $count 1)\n 0\n $position))))\n ($other\n (_fuzz-driver-int\n $other\n 0\n (- (length $productions) 1)\n 0)))))\n\n(= (_fuzz-grammar-reference-size\n $size\n $ordinal\n $total)\n (if (and\n (> $total 0)\n (and\n (<= 0 $ordinal)\n (< $ordinal $total)))\n (let* (($budget (max 0 (- $size 1)))\n ($base (/ $budget $total))\n ($remainder (% $budget $total)))\n (+ $base\n (if (< $ordinal $remainder)\n 1\n 0)))\n (_fuzz-generation-error\n MalformedIndexedGrammarReference\n (Ordinal $ordinal)\n (Total $total))))\n\n(= (_fuzz-grammar-scope-values\n $scope\n $sort\n $values)\n (if-decons-expr\n $scope\n $binding\n $tail\n (_fuzz-grammar-template-switch $binding\n (((GrammarBinding (quote $candidate) $id)\n (let $next-values\n (if (noreduce-eq $sort $candidate)\n (let $marker\n (_fuzz-variable-marker $id)\n (_fuzz-expression-append\n $values\n $marker))\n $values)\n (_fuzz-grammar-scope-values\n $tail\n $sort\n $next-values)))\n ($bad\n (_fuzz-grammar-scope-values\n $tail\n $sort\n $values))))\n $values))\n\n; ---- the generation machine ----\n; One bare-tail machine generates a nonterminal: flat instruction plans compiled per template\n; (kernel, memoised) execute against a frame chain and nested value/tree stacks, so neither\n; template depth nor width costs engine stack, and no frame holds a growing value. Frames:\n; (FPlan instrs len cursor size) one template's instructions in execution order\n; (FExpr arity vdepth tdepth) an open expression node (snapshot depths for discards)\n; (FRef (quote t)) wrap a completed reference\n; (FProd (quote t) index pos ctree) wrap a completed production\n; (FBind (quote s) id var) wrap a completed binder body\n; (FScoped added) wrap a completed scoped body\n; (FScope saved) restore the lexical scope\n; The running state is (FuzzGenRun source frames values vdepth trees tdepth scope next-id driver);\n; a discard unwinds as (FuzzGenCut source frames values vdepth trees tdepth reason tree driver),\n; wrapping the partial tree through each frame exactly as the recursive interpreter did; both\n; settle to (FuzzGenDone result).\n\n(= (_fuzz-gen-loop $state)\n (if (_fuzz-gen-finished $state)\n $state\n (_fuzz-gen-loop (_fuzz-gen-step $state))))\n\n(= (_fuzz-gen-finished $state)\n (unify $state\n (FuzzGenDone $result)\n True\n (unify $state\n (FuzzGenRun $source $frames $values $vd $trees $td $scope $next-id $driver)\n False\n (unify $state\n (FuzzGenCut $source $frames $values $vd $trees $td $reason $tree $driver)\n False\n True))))\n\n(= (_fuzz-gen-step $state)\n (unify $state\n (FuzzGenRun $source $frames $values $vd $trees $td $scope $next-id $driver)\n (_fuzz-gen-run-step\n $source $frames $values $vd $trees $td $scope $next-id $driver)\n (unify $state\n (FuzzGenCut $source $frames $values $vd $trees $td $reason $tree $driver)\n (_fuzz-gen-cut-step\n $source $frames $values $vd $trees $td $reason $tree $driver)\n $state)))\n\n; Push one generated value + decision tree.\n(= (_fuzz-gen-push\n $source $frames $values $vd $trees $td $scope $next-id $driver\n $value\n $tree)\n (FuzzGenRun\n $source\n $frames\n (FuzzStack $value $values)\n (+ $vd 1)\n (FuzzStack $tree $trees)\n (+ $td 1)\n $scope\n $next-id\n $driver))\n\n(= (_fuzz-gen-run-step\n $source $frames $values $vd $trees $td $scope $next-id $driver)\n (unify $frames\n (GF (FPlan $instrs $len $cursor $size) $parent)\n (if (== $cursor $len)\n (FuzzGenRun $source $parent $values $vd $trees $td $scope $next-id $driver)\n (let $instr (index-atom $instrs $cursor)\n (_fuzz-gen-instr\n $source\n (GF (FPlan $instrs $len (+ $cursor 1) $size) $parent)\n $values $vd $trees $td $scope $next-id $driver\n $instr\n $size)))\n (unify $frames\n (GF (FRef (quote $target)) $parent)\n (unify $values\n (FuzzStack $value $rest-values)\n (unify $trees\n (FuzzStack $tree $rest-trees)\n (_fuzz-gen-push\n $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver\n $value\n (Decision GrammarRef (Target (quote $target)) () ($tree)))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees))))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values))))\n (unify $frames\n (GF (FProd (quote $target) $production-index $position $choice-tree) $parent)\n (unify $values\n (FuzzStack $value $rest-values)\n (unify $trees\n (FuzzStack $tree $rest-trees)\n (let $children (_fuzz-two-children $choice-tree $tree)\n (_fuzz-gen-push\n $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver\n $value\n (Decision\n GrammarProduction\n (Target (quote $target))\n (ProductionIndex $production-index $position)\n $children)))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees))))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values))))\n (unify $frames\n (GF (FBind (quote $sort) $binding-id $variable) $parent)\n (unify $values\n (FuzzStack $body $rest-values)\n (unify $trees\n (FuzzStack $tree $rest-trees)\n (let $bound (_fuzz-expression-append ($variable) $body)\n (_fuzz-gen-push\n $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver\n $bound\n (Decision\n GrammarBind\n (Sort (quote $sort))\n (BindingId $binding-id)\n ($tree))))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees))))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values))))\n (unify $frames\n (GF (FScoped $added) $parent)\n (unify $values\n (FuzzStack $value $rest-values)\n (unify $trees\n (FuzzStack $tree $rest-trees)\n (_fuzz-gen-push\n $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver\n $value\n (Decision GrammarScoped (Bindings $added) () ($tree)))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees))))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values))))\n (unify $frames\n (GF (FScope $saved) $parent)\n (FuzzGenRun $source $parent $values $vd $trees $td $saved $next-id $driver)\n (unify $frames\n GFB\n (unify $values\n (FuzzStack $value FuzzStackBottom)\n (unify $trees\n (FuzzStack $tree FuzzStackBottom)\n (FuzzGenDone (GrammarResult $value $driver $next-id $tree))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees))))\n (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values))))\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarMachineState\n (Frames $frames)))))))))))\n\n(= (_fuzz-gen-instr\n $source $frames $values $vd $trees $td $scope $next-id $driver\n $instr\n $size)\n (_fuzz-grammar-template-switch $instr\n (((GILit (quote $value))\n (_fuzz-gen-push\n $source $frames $values $vd $trees $td $scope $next-id $driver\n $value\n (Decision GrammarLiteral () (Value (quote $value)) ())))\n ((GIField $generator)\n (let $sample (fuzz-generate $generator $driver $size)\n (_fuzz-gen-field\n $source $frames $values $vd $trees $td $scope $next-id $driver\n $generator\n $sample)))\n ((GIRef (quote $target) $ordinal $total)\n (if (> $size 0)\n (let $child-size\n (_fuzz-grammar-reference-size $size $ordinal $total)\n (unify $child-size\n (FuzzGenerationError $code $details)\n (FuzzGenDone $child-size)\n (_fuzz-gen-nonterminal\n $source\n (GF (FRef (quote $target)) $frames)\n $values $vd $trees $td $scope $next-id $driver\n (quote $target)\n $child-size)))\n (FuzzGenDone\n (_fuzz-generation-error\n GrammarDepthExhausted\n (Target (quote $target))\n (Size $size)))))\n ((GIFresh (quote $sort))\n (let $variable (_fuzz-variable-marker $next-id)\n (_fuzz-gen-push\n $source $frames $values $vd $trees $td $scope (+ $next-id 1) $driver\n $variable\n (Decision GrammarFresh (Sort (quote $sort)) (BindingId $next-id) ()))))\n ((GIUse (quote $sort))\n (let $choices (_fuzz-grammar-scope-values $scope $sort ())\n (if (> (length $choices) 0)\n (let $sample (fuzz-generate (gen-element $choices) $driver $size)\n (_fuzz-gen-use\n $source $frames $values $vd $trees $td $scope $next-id\n (quote $sort)\n $sample))\n (FuzzGenDone\n (_fuzz-generation-error\n UnboundGrammarUse\n (Sort (quote $sort)))))))\n ((GIBind (quote $sort) $body)\n (let $variable (_fuzz-variable-marker $next-id)\n (let $body-length (length $body)\n (let $bound-scope (cons-atom (GrammarBinding (quote $sort) $next-id) $scope)\n (FuzzGenRun\n $source\n (GF (FPlan $body $body-length 0 $size)\n (GF (FBind (quote $sort) $next-id $variable)\n (GF (FScope $scope) $frames)))\n $values $vd $trees $td\n $bound-scope\n (+ $next-id 1)\n $driver)))))\n ((GIScoped $added $minimum-next-id (quote $raw) $body)\n (if (_fuzz-grammar-scopes-disjoint $added $scope)\n (let $body-length (length $body)\n (let $bound-scope (_fuzz-expression-concat $added $scope)\n (FuzzGenRun\n $source\n (GF (FPlan $body $body-length 0 $size)\n (GF (FScoped $added)\n (GF (FScope $scope) $frames)))\n $values $vd $trees $td\n $bound-scope\n (max $next-id $minimum-next-id)\n $driver)))\n (FuzzGenDone\n (_fuzz-generation-error\n DuplicateGrammarBindingId\n (Bindings $raw)))))\n ((GIExprEnter $arity)\n (let $entered (_fuzz-gen-insert-expr $frames $arity $vd $td)\n (FuzzGenRun\n $source\n $entered\n $values $vd $trees $td $scope $next-id $driver)))\n ((GIExprBuild)\n (unify $frames\n (GF (FPlan $instrs $len $cursor $size2) (GF (FExpr $arity $svd $std) $parent))\n (let $taken-values (_fuzz-stack-take $values $arity)\n (unify $taken-values\n (FuzzStackTake $value-list $rest-values)\n (let $taken-trees (_fuzz-stack-take $trees $arity)\n (unify $taken-trees\n (FuzzStackTake $tree-list $rest-trees)\n (_fuzz-gen-push\n $source\n (GF (FPlan $instrs $len $cursor $size2) $parent)\n $rest-values (- $vd $arity) $rest-trees (- $td $arity) $scope $next-id $driver\n $value-list\n (Decision GrammarExpression (Arity $arity) () $tree-list))\n (FuzzGenDone\n (_fuzz-generation-error\n KernelError\n (OperationResult $taken-trees)))))\n (FuzzGenDone\n (_fuzz-generation-error\n KernelError\n (OperationResult $taken-values)))))\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarMachineState\n (Frames $frames)))))\n ($bad\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarInstruction\n (Value $bad)))))))\n\n; GIExprEnter runs from inside the plan frame, so the expression frame is inserted below it.\n(= (_fuzz-gen-insert-expr $frames $arity $vd $td)\n (unify $frames\n (GF $top $parent)\n (GF $top (GF (FExpr $arity $vd $td) $parent))\n $frames))\n\n(= (_fuzz-gen-field\n $source $frames $values $vd $trees $td $scope $next-id $driver\n $generator\n $sample)\n (unify $sample\n (FuzzSample $value $next-driver $tree)\n (if (_fuzz-contains-variable-marker $value)\n (FuzzGenDone\n (_fuzz-generation-error\n ForgedGrammarVariableMarker\n (Generator $generator)\n (Value $value)))\n (_fuzz-gen-push\n $source $frames $values $vd $trees $td $scope $next-id $next-driver\n $value\n (Decision GrammarField (Generator $generator) () ($tree))))\n (unify $sample\n (FuzzGenerationDiscard $reason $next-driver $tree)\n (FuzzGenCut\n $source $frames $values $vd $trees $td\n $reason\n (Decision GrammarField (Generator $generator) () ($tree))\n $next-driver)\n (unify $sample\n (FuzzGenerationError $code $details)\n (FuzzGenDone $sample)\n (unify $sample\n $bad\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarFieldResult\n (Generator $generator)\n (Value $bad)))\n Empty)))))\n\n(= (_fuzz-gen-use\n $source $frames $values $vd $trees $td $scope $next-id\n (quote $sort)\n $sample)\n (unify $sample\n (FuzzSample $value $next-driver $tree)\n (_fuzz-gen-push\n $source $frames $values $vd $trees $td $scope $next-id $next-driver\n $value\n (Decision GrammarUse (Sort (quote $sort)) () ($tree)))\n (unify $sample\n (FuzzGenerationError $code $details)\n (FuzzGenDone $sample)\n (unify $sample\n $bad\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarUseResult\n (Sort (quote $sort))\n (Value $bad)))\n Empty))))\n\n(= (_fuzz-gen-nonterminal\n $source $frames $values $vd $trees $td $scope $next-id $driver\n (quote $target)\n $size)\n (let $eligible\n (_fuzz-eligible-productions\n $source\n (quote $target)\n $scope\n $size)\n (unify $eligible\n (EligibleGrammarProductions $productions)\n (if (> (length $productions) 0)\n (let $choice (_fuzz-grammar-production-choice $driver $productions)\n (_fuzz-gen-choose\n $source $frames $values $vd $trees $td $scope $next-id\n (quote $target)\n $size\n $productions\n $choice))\n (FuzzGenCut\n $source $frames $values $vd $trees $td\n (NoEligibleGrammarProduction\n (Target (quote $target))\n (Size $size))\n (Decision\n GrammarUnavailable\n (Target (quote $target))\n (Size $size)\n ())\n $driver))\n (unify $eligible\n (FuzzGenerationError $code $details)\n (FuzzGenDone $eligible)\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedEligibleGrammarProductions\n (Target (quote $target))\n (Value $eligible)))))))\n\n(= (_fuzz-gen-choose\n $source $frames $values $vd $trees $td $scope $next-id\n (quote $target)\n $size\n $productions\n $choice)\n (unify $choice\n (DriverChoice $position $next-driver $choice-tree)\n (if (and (<= 0 $position) (< $position (length $productions)))\n (let $production (index-atom $productions $position)\n (_fuzz-grammar-template-switch $production\n (((GrammarProduction\n $production-index\n $weight\n (quote $seen-target)\n (quote $template))\n (let $planned (_fuzz-grammar-template-plan $template)\n (unify $planned\n (GrammarTemplatePlan $instrs)\n (let $plan-length (length $instrs)\n (FuzzGenRun\n $source\n (GF (FPlan $instrs $plan-length 0 $size)\n (GF (FProd (quote $target) $production-index $position $choice-tree)\n $frames))\n $values $vd $trees $td $scope $next-id $next-driver))\n (unify $planned\n (FuzzKernelError $code $details)\n (FuzzGenDone\n (_fuzz-generation-error\n KernelError\n (OperationResult $planned)))\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarTemplatePlan\n (Value $planned)))))))\n ($bad\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedSelectedGrammarProduction\n (Target (quote $target))\n (Production $bad)))))))\n (FuzzGenDone\n (_fuzz-generation-error\n GrammarProductionIndexOutOfBounds\n (Target (quote $target))\n (Position $position))))\n (unify $choice\n (FuzzGenerationError $code $details)\n (FuzzGenDone $choice)\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarProductionChoice\n (Target (quote $target))\n (Value $choice))))))\n\n(= (_fuzz-gen-cut-step\n $source $frames $values $vd $trees $td $reason $tree $driver)\n (unify $frames\n (GF (FPlan $instrs $len $cursor $size) $parent)\n (FuzzGenCut $source $parent $values $vd $trees $td $reason $tree $driver)\n (unify $frames\n (GF (FExpr $arity $svd $std) $parent)\n (let $generated (- $td $std)\n (let $taken-trees (_fuzz-stack-take $trees $generated)\n (unify $taken-trees\n (FuzzStackTake $tree-list $rest-trees)\n (let $taken-values (_fuzz-stack-take $values $generated)\n (unify $taken-values\n (FuzzStackTake $value-list $rest-values)\n (let $partial (_fuzz-expression-append $tree-list $tree)\n (FuzzGenCut\n $source $parent $rest-values $svd $rest-trees $std\n $reason\n (Decision\n GrammarExpression\n (Arity $arity)\n (Generated (+ $generated 1))\n $partial)\n $driver))\n (FuzzGenDone\n (_fuzz-generation-error\n KernelError\n (OperationResult $taken-values)))))\n (FuzzGenDone\n (_fuzz-generation-error\n KernelError\n (OperationResult $taken-trees))))))\n (unify $frames\n (GF (FRef (quote $target)) $parent)\n (FuzzGenCut\n $source $parent $values $vd $trees $td\n $reason\n (Decision GrammarRef (Target (quote $target)) () ($tree))\n $driver)\n (unify $frames\n (GF (FProd (quote $target) $production-index $position $choice-tree) $parent)\n (let $children (_fuzz-two-children $choice-tree $tree)\n (FuzzGenCut\n $source $parent $values $vd $trees $td\n $reason\n (Decision\n GrammarProduction\n (Target (quote $target))\n (ProductionIndex $production-index $position)\n $children)\n $driver))\n (unify $frames\n (GF (FBind (quote $sort) $binding-id $variable) $parent)\n (FuzzGenCut\n $source $parent $values $vd $trees $td\n $reason\n (Decision GrammarBind (Sort (quote $sort)) (BindingId $binding-id) ($tree))\n $driver)\n (unify $frames\n (GF (FScoped $added) $parent)\n (FuzzGenCut\n $source $parent $values $vd $trees $td\n $reason\n (Decision GrammarScoped (Bindings $added) () ($tree))\n $driver)\n (unify $frames\n (GF (FScope $saved) $parent)\n (FuzzGenCut $source $parent $values $vd $trees $td $reason $tree $driver)\n (unify $frames\n GFB\n (FuzzGenDone (FuzzGenerationDiscard $reason $driver $tree))\n (FuzzGenDone\n (_fuzz-generation-error\n MalformedGrammarMachineState\n (Frames $frames))))))))))))\n\n; The default generation path: start the kernel machine, and serve each of its effect\n; requests with `fuzz-generate`, so user Field callbacks, custom generators, and the whole\n; generator algebra stay ordinary MeTTa. The specification machine above remains callable\n; through `_fuzz-generate-grammar-nonterminal-reference`, and a differential test drives\n; both against identical drivers.\n(= (_fuzz-gen-trampoline $outcome)\n (unify $outcome\n (GrammarMachineDone $result)\n $result\n (unify $outcome\n (GrammarMachineNeed $suspended (EvaluateGenerator $generator $driver $sub-size))\n (let $descriptor $generator\n (let $sample (fuzz-generate $descriptor $driver $sub-size)\n (_fuzz-gen-trampoline\n (_fuzz-grammar-machine-op\n (GrammarMachineResume $suspended $sample)))))\n (unify $outcome\n $bad\n (_fuzz-generation-error\n MalformedGrammarMachineOutcome\n (Value $bad))\n Empty))))\n\n(= (_fuzz-generate-grammar-nonterminal\n $source\n (quote $target)\n $scope\n $next-id\n $driver\n $size)\n (_fuzz-gen-trampoline\n (_fuzz-grammar-machine-op\n (GrammarMachineStart\n $source\n (quote $target)\n $scope\n $next-id\n (WithDriver $driver $size)))))\n\n(= (_fuzz-generate-grammar-nonterminal-reference\n $source\n (quote $target)\n $scope\n $next-id\n $driver\n $size)\n (let $settled\n (_fuzz-gen-loop\n (_fuzz-gen-nonterminal\n $source\n GFB\n FuzzStackBottom\n 0\n FuzzStackBottom\n 0\n $scope\n $next-id\n $driver\n (quote $target)\n $size))\n (unify $settled\n (FuzzGenDone $result)\n $result\n (_fuzz-generation-error\n MalformedGrammarMachineState\n (Value $settled)))))\n\n(= (_fuzz-drive-grammar-result\n $result)\n (unify $result\n (GrammarResult $value $next-driver $next-id $tree)\n (FuzzSample $value $next-driver $tree)\n (unify $result\n (FuzzGenerationDiscard $reason $next-driver $tree)\n $result\n (unify $result\n (FuzzGenerationError $code $details)\n $result\n (unify $result\n $bad\n (_fuzz-generation-error\n MalformedGrammarGenerationResult\n (Value $bad))\n Empty)))))\n\n(= (CustomCapabilities\n _fuzz-grammar\n (GrammarRequest\n $source\n (quote $target)\n $scope\n $next-id))\n (FuzzCustomCapabilities\n (Modes\n (Random\n Edge\n Replay\n ShrinkReplay\n Exhaustive\n Bytes))))\n\n(= (DriveCustom\n _fuzz-grammar\n (GrammarRequest\n $source\n (quote $target)\n $scope\n $next-id)\n $driver\n $size)\n (_fuzz-drive-grammar-result\n (_fuzz-generate-grammar-nonterminal\n $source\n (quote $target)\n $scope\n $next-id\n $driver\n $size)))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n(= (_fuzz-case-observation $case)\n (switch $case\n (((FuzzCaseResult\n $status\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations\n (Results $results)\n $steps)\n (FuzzCaseObservation $status $tag $results))\n ($bad\n (FuzzCaseObservation\n Malformed\n MalformedCaseResult\n ($bad))))))\n\n(= (_fuzz-strict-replay-case\n $probe\n $generator\n $property\n $quantifier\n $decision\n $size\n $config)\n (let $replayed (fuzz-replay $generator $decision $size)\n (switch $replayed\n (((FuzzSample $value $driver $actual-tree)\n (let $case\n (_fuzz-evaluate-property\n $property\n $quantifier\n $value\n (_fuzz-config-get CaseSteps $config)\n (_fuzz-config-get CaseDepth $config)\n (_fuzz-config-get EffectPolicy $config))\n (FuzzReplayEvaluation\n $probe\n $value\n $actual-tree\n $case)))\n ((FuzzGenerationDiscard $reason $driver $actual-tree)\n (FuzzReplayProblem\n $probe\n GenerationDiscard\n (Reason $reason)\n (DecisionTree $actual-tree)))\n ((FuzzGenerationError $code $details)\n (FuzzReplayProblem\n $probe\n GenerationError\n (ErrorCode $code)\n $details))\n ($bad\n (FuzzReplayProblem\n $probe\n MalformedReplayResult\n (Value $bad)))))))\n\n(= (_fuzz-replay-matches\n $expected-value\n $expected-tree\n $expected-case\n $replayed)\n (switch $replayed\n (((FuzzReplayEvaluation\n $probe\n $actual-value\n $actual-tree\n $actual-case)\n (and\n (_fuzz-replay-equal $expected-value $actual-value)\n (and\n (_fuzz-replay-equal $expected-tree $actual-tree)\n (_fuzz-replay-equal\n (_fuzz-case-observation $expected-case)\n (_fuzz-case-observation $actual-case)))))\n ($bad False))))\n\n(= (_fuzz-stability-check\n $stage\n $generator\n $property\n $quantifier\n $value\n $decision\n $case\n $size\n $config)\n (let $first\n (_fuzz-strict-replay-case\n (Probe $stage 1)\n $generator\n $property\n $quantifier\n $decision\n $size\n $config)\n (let $second\n (_fuzz-strict-replay-case\n (Probe $stage 2)\n $generator\n $property\n $quantifier\n $decision\n $size\n $config)\n (if (and\n (_fuzz-replay-matches\n $value\n $decision\n $case\n $first)\n (_fuzz-replay-matches\n $value\n $decision\n $case\n $second))\n (FuzzStable $first $second)\n (FuzzUnstable\n (Stage $stage)\n (ExpectedValue $value)\n (ExpectedDecision $decision)\n (ExpectedCase\n (_fuzz-case-observation $case))\n (First $first)\n (Second $second))))))\n\n(= (_fuzz-shrink-case-acceptable\n $expected-signature\n $failure-mode\n $case)\n (switch $case\n (((FuzzCaseResult\n Fail\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations\n $results\n $steps)\n (if (== $failure-mode AnyFailure)\n True\n (if (== $failure-mode SameFailureTag)\n (==\n $expected-signature\n (_fuzz-failure-signature $tag))\n False)))\n ($bad False))))\n\n(= (_fuzz-shrink-add-visited $tree $visited)\n (let $combined\n (append $visited (cons-atom $tree ()))\n (_fuzz-deduplicate-replay $combined)))\n\n; The shrink order (mettascript-shrink-v1): shortlex over the flattened decision leaves — fewer\n; decisions first, then lexicographically smaller origin-distances. The runner accepts a reproducing\n; candidate only when its canonical tree is strictly smaller under this order, so no candidate\n; source (a built-in shrinker or a custom ShrinkChoices relation) can re-inflate an accepted\n; counterexample through the lenient shrink replay.\n(= (_fuzz-leaf-distance $leaf)\n (unify $leaf\n (Decision Int (Bounds $lower $upper) (Origin $origin) (Value $value) ())\n (abs-math (- $value $origin))\n 0))\n\n; Flat accumulator: a decision tree carries one leaf per drawn decision, so a large machine run\n; would nest an evaluator frame per leaf under recurse-then-cons.\n(= (_fuzz-leaf-distances $leaves)\n (_fuzz-leaf-distances-loop (FuzzLeafDistanceFold $leaves ())))\n\n(= (_fuzz-leaf-distances-loop $state)\n (if (_fuzz-leaf-distances-finished $state)\n $state\n (_fuzz-leaf-distances-loop (_fuzz-leaf-distances-step $state))))\n\n(= (_fuzz-leaf-distances-finished $state)\n (unify $state (FuzzLeafDistanceFold $leaves $reversed) False True))\n\n(= (_fuzz-leaf-distances-step $state)\n (unify $state\n (FuzzLeafDistanceFold $leaves $reversed)\n (if (== $leaves ())\n (reverse $reversed)\n (let ($head $tail) (decons-atom $leaves)\n (let $distance (_fuzz-leaf-distance $head)\n (let $next (cons-atom $distance $reversed)\n (FuzzLeafDistanceFold $tail $next)))))\n $state))\n\n(= (_fuzz-distances-less $first $second)\n (if (== $first ())\n False\n (let ($first-head $first-tail) (decons-atom $first)\n (let ($second-head $second-tail) (decons-atom $second)\n (if (< $first-head $second-head)\n True\n (if (> $first-head $second-head)\n False\n (_fuzz-distances-less $first-tail $second-tail)))))))\n\n(= (_fuzz-tree-strictly-smaller $candidate-tree $target-tree)\n (let $candidate-leaves (_fuzz-decision-leaves-op $candidate-tree)\n (let $target-leaves (_fuzz-decision-leaves-op $target-tree)\n (unify $candidate-leaves\n (FuzzDecisionLeaves $candidate-flat)\n (unify $target-leaves\n (FuzzDecisionLeaves $target-flat)\n (let $candidate-count (length $candidate-flat)\n (let $target-count (length $target-flat)\n (if (< $candidate-count $target-count)\n True\n (if (> $candidate-count $target-count)\n False\n (_fuzz-distances-less\n (_fuzz-leaf-distances $candidate-flat)\n (_fuzz-leaf-distances $target-flat))))))\n False)\n False))))\n\n(= (_fuzz-shrink-finish\n $status\n (FuzzShrinkTarget $value $tree $case)\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (FuzzShrinkResult\n $status\n $attempts\n $improvements\n $value\n $tree\n $case))\n\n(= (_fuzz-shrink-start\n $context\n (FuzzShrinkTarget $value $tree $case)\n $progress)\n (let $candidates (_fuzz-shrink-candidates $tree)\n (switch $candidates\n (((FuzzKernelError $code $details)\n (FuzzShrinkError\n CandidateGenerationFailed\n (ErrorCode $code)\n $details\n $progress))\n ($valid\n (_fuzz-shrink-search\n (Candidates $valid)\n $context\n (FuzzShrinkTarget $value $tree $case)\n $progress))))))\n\n(= (_fuzz-shrink-search\n (Candidates $remaining)\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $expected-signature)\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (if (== $remaining ())\n (_fuzz-shrink-finish\n LocallyMinimal\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (if (>=\n $attempts\n (_fuzz-config-get MaxShrinks $config))\n (_fuzz-shrink-finish\n MaxShrinksReached\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (if (>=\n $improvements\n (_fuzz-config-get\n MaxShrinkImprovements\n $config))\n (_fuzz-shrink-finish\n MaxShrinkImprovementsReached\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (let ($candidate $tail)\n (decons-atom $remaining)\n (_fuzz-shrink-consider\n $candidate\n $tail\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $expected-signature)\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited)))))))\n\n(= (_fuzz-shrink-consider\n $candidate\n $remaining\n $context\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (let $seen (_fuzz-replay-member $candidate $visited)\n (_fuzz-shrink-consider-seen\n $seen\n $candidate\n $remaining\n $context\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))))\n\n(= (_fuzz-shrink-consider-seen\n True\n $candidate\n $remaining\n $context\n $target\n $progress)\n (_fuzz-shrink-search\n (Candidates $remaining)\n $context\n $target\n $progress))\n\n(= (_fuzz-shrink-consider-seen\n False\n $candidate\n $remaining\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $expected-signature)\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (let $candidate-visited\n (_fuzz-shrink-add-visited $candidate $visited)\n (let $replayed\n (_fuzz-shrink-replay\n $generator\n $candidate\n $size)\n (_fuzz-shrink-consider-replay\n $replayed\n $remaining\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $expected-signature)\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $candidate-visited)\n $visited))))\n\n(= (_fuzz-shrink-consider-seen\n (FuzzKernelError $code $details)\n $candidate\n $remaining\n $context\n $target\n $progress)\n (FuzzShrinkError\n VisitedTreeLookupFailed\n (ErrorCode $code)\n $details\n $progress))\n\n(= (_fuzz-shrink-consider-replay\n (FuzzShrinkReplay $value $actual-tree)\n $remaining\n $context\n $target\n $progress\n $previously-visited)\n (_fuzz-shrink-consider-actual\n $value\n $actual-tree\n $remaining\n $context\n $target\n $progress\n $previously-visited))\n\n(= (_fuzz-shrink-consider-replay\n (FuzzShrinkDiscard $reason $actual-tree)\n $remaining\n $context\n $target\n $progress\n $previously-visited)\n (_fuzz-shrink-search\n (Candidates $remaining)\n $context\n $target\n $progress))\n\n(= (_fuzz-shrink-consider-replay\n (FuzzGenerationError $code $details)\n $remaining\n $context\n $target\n $progress\n $previously-visited)\n (_fuzz-shrink-search\n (Candidates $remaining)\n $context\n $target\n $progress))\n\n(= (_fuzz-shrink-consider-actual\n $value\n $actual-tree\n $remaining\n $context\n $target\n $progress\n $previously-visited)\n (let $seen\n (_fuzz-replay-member\n $actual-tree\n $previously-visited)\n (_fuzz-shrink-consider-actual-seen\n $seen\n $value\n $actual-tree\n $remaining\n $context\n $target\n $progress)))\n\n(= (_fuzz-shrink-consider-actual-seen\n True\n $value\n $actual-tree\n $remaining\n $context\n $target\n $progress)\n (_fuzz-shrink-search\n (Candidates $remaining)\n $context\n $target\n $progress))\n\n(= (_fuzz-shrink-consider-actual-seen\n False\n $value\n $actual-tree\n $remaining\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $expected-signature)\n $target\n (FuzzShrinkProgress\n $attempts\n $improvements\n $visited))\n (let $actual-visited\n (_fuzz-shrink-add-visited\n $actual-tree\n $visited)\n (let $case\n (_fuzz-evaluate-property\n $property\n $quantifier\n $value\n (_fuzz-config-get CaseSteps $config)\n (_fuzz-config-get CaseDepth $config)\n (_fuzz-config-get EffectPolicy $config))\n (let $next-progress\n (FuzzShrinkProgress\n (+ $attempts 1)\n $improvements\n $actual-visited)\n (if (and\n (_fuzz-shrink-case-acceptable\n $expected-signature\n (_fuzz-config-get FailureMode $config)\n $case)\n (unify $target\n (FuzzShrinkTarget $target-value $target-tree $target-case)\n (_fuzz-tree-strictly-smaller $actual-tree $target-tree)\n False))\n (_fuzz-shrink-start\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $expected-signature)\n (FuzzShrinkTarget\n $value\n $actual-tree\n $case)\n (FuzzShrinkProgress\n (+ $attempts 1)\n (+ $improvements 1)\n $actual-visited))\n (_fuzz-shrink-search\n (Candidates $remaining)\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $expected-signature)\n $target\n $next-progress))))))\n\n(= (_fuzz-shrink-consider-actual-seen\n (FuzzKernelError $code $details)\n $value\n $actual-tree\n $remaining\n $context\n $target\n $progress)\n (FuzzShrinkError\n VisitedTreeLookupFailed\n (ErrorCode $code)\n $details\n $progress))\n\n(= (_fuzz-run-shrinker\n $generator\n $property\n $quantifier\n $value\n $decision\n $case\n $size\n $config\n $signature)\n (_fuzz-shrink-start\n (FuzzShrinkContext\n $generator\n $property\n $quantifier\n $size\n $config\n $signature)\n (FuzzShrinkTarget $value $decision $case)\n (FuzzShrinkProgress\n 0\n 0\n (cons-atom $decision ()))))\n\n(= (_fuzz-shrink-claim $status $reason)\n (switch $status\n ((LocallyMinimal\n (LocallyMinimalUnder\n (Order mettascript-shrink-v1)))\n (Disabled\n (NotShrunk (Reason $reason)))\n ($stopped\n (SmallestFoundUnder\n (Order mettascript-shrink-v1)\n (StoppedBy $stopped))))))\n\n(= (_fuzz-replay-record\n $generator\n $origin\n $decision\n $value)\n (let $generator-key\n (_fuzz-atom-key Replay $generator)\n (switch $generator-key\n (((FuzzKernelError $code $details)\n (FuzzReplayUnavailable\n (Stage Generator)\n (Error $code $details)))\n ($key\n (let $encoded-decision\n (_fuzz-encode-atom $decision)\n (switch $encoded-decision\n (((FuzzKernelError $code $details)\n (FuzzReplayUnavailable\n (Stage DecisionTree)\n (Error $code $details)))\n ($decision-codec\n (let $encoded-value\n (_fuzz-encode-atom $value)\n (switch $encoded-value\n (((FuzzKernelError $code $details)\n (FuzzReplayUnavailable\n (Stage ConcreteValue)\n (Error $code $details)))\n ($value-codec\n (FuzzReplay\n (Format 2)\n (Origin $origin)\n (GeneratorKey $key)\n (DecisionTree $decision)\n (EncodedDecisionTree $decision-codec)\n (ConcreteValue $value)\n (EncodedValue $value-codec)))))))))))))))\n\n(= (_fuzz-build-failure\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $original-value\n $original-decision\n (FuzzCaseResult\n Fail\n $original-tag\n $original-details\n $original-labels\n $original-collected\n $original-coverage\n $original-annotations\n (Results $original-results)\n $original-steps)\n $config\n $state\n $original-signature)\n (FuzzShrinkTarget\n $smallest-value\n $smallest-decision\n (FuzzCaseResult\n Fail\n $smallest-tag\n $smallest-details\n $smallest-labels\n $smallest-collected\n $smallest-coverage\n $smallest-annotations\n (Results $smallest-results)\n $smallest-steps))\n (FuzzShrinkSummary\n $status\n $reason\n $attempts\n $accepted))\n (FuzzFailed\n (Property $property-id)\n (Phase $phase)\n (CaseIndex $case-index)\n (FailureTag $smallest-tag)\n (FailureSignature\n (_fuzz-failure-signature $smallest-tag))\n (OriginalFailureTag $original-tag)\n (OriginalFailureSignature $original-signature)\n (OriginalValue $original-value)\n (OriginalDecision $original-decision)\n (OriginalDetails $original-details)\n (OriginalLabels $original-labels)\n (OriginalCollected $original-collected)\n (OriginalCoverage $original-coverage)\n (OriginalAnnotations $original-annotations)\n (OriginalPropertyResults $original-results)\n (SmallestValue $smallest-value)\n (SmallestDecision $smallest-decision)\n (SmallestDetails $smallest-details)\n (SmallestLabels $smallest-labels)\n (SmallestCollected $smallest-collected)\n (SmallestCoverage $smallest-coverage)\n (SmallestAnnotations $smallest-annotations)\n (PropertyResults $smallest-results)\n (Replay\n (_fuzz-failure-replay-record\n $generator\n $origin\n $smallest-decision\n $smallest-value\n (FuzzCaseResult\n Fail\n $smallest-tag\n $smallest-details\n $smallest-labels\n $smallest-collected\n $smallest-coverage\n $smallest-annotations\n (Results $smallest-results)\n $smallest-steps)))\n (Shrink\n (Order mettascript-shrink-v1)\n (Status $status)\n (Reason $reason)\n (Attempts $attempts)\n (Accepted $accepted)\n (_fuzz-shrink-claim $status $reason))\n (_fuzz-run-statistics $state)))\n\n(= (_fuzz-build-flaky\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $original-value\n $original-decision\n $original-case\n $config\n $state\n $signature)\n $unstable\n (FuzzShrinkSummary\n $status\n $reason\n $attempts\n $accepted))\n (FuzzFlaky\n (Property $property-id)\n (Phase $phase)\n (CaseIndex $case-index)\n (Origin $origin)\n (OriginalValue $original-value)\n (OriginalDecision $original-decision)\n (OriginalCase\n (_fuzz-case-observation $original-case))\n $unstable\n (Shrink\n (Order mettascript-shrink-v1)\n (Status $status)\n (Reason $reason)\n (Attempts $attempts)\n (Accepted $accepted))\n (_fuzz-run-statistics $state)))\n\n(= (_fuzz-failure-replay-record\n $generator\n $origin\n $decision\n $value\n $case)\n (let $record\n (_fuzz-replay-record\n $generator\n $origin\n $decision\n $value)\n (switch $record\n (((FuzzReplayUnavailable $stage $error) $record)\n ($available\n (let $encoded-observation\n (_fuzz-encode-atom\n (_fuzz-case-observation $case))\n (switch $encoded-observation\n (((FuzzKernelError $code $details)\n (FuzzReplayUnavailable\n (Stage PropertyObservation)\n (Error $code $details)))\n ($encoded $record)))))))))\n\n(= (_fuzz-failure-replayability\n $generator\n $origin\n $decision\n $value\n $case)\n (let $record\n (_fuzz-failure-replay-record\n $generator\n $origin\n $decision\n $value\n $case)\n (switch $record\n (((FuzzReplayUnavailable $stage $error) $record)\n ($available (FuzzReplayReady))))))\n\n(= (_fuzz-failure-target\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature))\n (FuzzShrinkTarget $value $decision $case))\n\n(= (_fuzz-start-stability-check\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature))\n (let $stability\n (_fuzz-stability-check\n PreShrink\n $generator\n $property\n $quantifier\n $value\n $decision\n $case\n $size\n $config)\n (_fuzz-after-pre-stability\n $stability\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature))))\n\n(= (_fuzz-start-replayability\n (FuzzReplayUnavailable $stage $error)\n $context)\n (_fuzz-build-failure\n $context\n (_fuzz-failure-target $context)\n (FuzzShrinkSummary\n Disabled\n (ReplayUnavailable $stage $error)\n 0\n 0)))\n\n(= (_fuzz-start-replayability\n (FuzzReplayReady)\n $context)\n (_fuzz-start-stability-check $context))\n\n(= (_fuzz-start-failure-processing\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature))\n (if (== (_fuzz-config-get EffectPolicy $config)\n ExternalEffects)\n (_fuzz-build-failure\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature)\n (FuzzShrinkTarget $value $decision $case)\n (FuzzShrinkSummary\n Disabled\n ExternalEffectsWithoutReset\n 0\n 0))\n (if (== $decision None)\n (_fuzz-build-failure\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature)\n (FuzzShrinkTarget $value $decision $case)\n (FuzzShrinkSummary\n Disabled\n NoDecisionTree\n 0\n 0))\n (if (<= (_fuzz-config-get MaxShrinks $config) 0)\n (_fuzz-build-failure\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature)\n (FuzzShrinkTarget $value $decision $case)\n (FuzzShrinkSummary\n Disabled\n MaxShrinksZero\n 0\n 0))\n (_fuzz-start-replayability\n (_fuzz-failure-replayability\n $generator\n $origin\n $decision\n $value\n $case)\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature))))))\n\n(= (_fuzz-after-pre-stability\n (FuzzStable $first $second)\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature))\n (let $shrunk\n (_fuzz-run-shrinker\n $generator\n $property\n $quantifier\n $value\n $decision\n $case\n $size\n $config\n $signature)\n (_fuzz-after-shrink\n $shrunk\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n $case\n $config\n $state\n $signature))))\n\n(= (_fuzz-after-pre-stability\n (FuzzUnstable\n $stage\n $expected-value\n $expected-decision\n $expected-case\n $first\n $second)\n $context)\n (_fuzz-build-flaky\n $context\n (FuzzUnstable\n $stage\n $expected-value\n $expected-decision\n $expected-case\n $first\n $second)\n (FuzzShrinkSummary\n NotStarted\n PreShrinkReplayMismatch\n 0\n 0)))\n\n(= (_fuzz-after-shrink\n (FuzzShrinkResult\n $status\n $attempts\n $accepted\n $value\n $decision\n $case)\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $original-value\n $original-decision\n $original-case\n $config\n $state\n $signature))\n (let $stability\n (_fuzz-stability-check\n PostShrink\n $generator\n $property\n $quantifier\n $value\n $decision\n $case\n $size\n $config)\n (_fuzz-after-post-stability\n $stability\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $original-value\n $original-decision\n $original-case\n $config\n $state\n $signature)\n (FuzzShrinkTarget $value $decision $case)\n (FuzzShrinkSummary\n $status\n None\n $attempts\n $accepted))))\n\n(= (_fuzz-after-shrink\n (FuzzShrinkError\n $code\n $first\n $second\n (FuzzShrinkProgress\n $attempts\n $accepted\n $visited))\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $original-value\n $original-decision\n $original-case\n $config\n $state\n $signature))\n (_fuzz-build-failure\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $original-value\n $original-decision\n $original-case\n $config\n $state\n $signature)\n (FuzzShrinkTarget\n $original-value\n $original-decision\n $original-case)\n (FuzzShrinkSummary\n Error\n (ShrinkError $code $first $second)\n $attempts\n $accepted)))\n\n(= (_fuzz-after-post-stability\n (FuzzStable $first $second)\n $context\n $target\n $summary)\n (_fuzz-build-failure\n $context\n $target\n $summary))\n\n(= (_fuzz-after-post-stability\n (FuzzUnstable\n $stage\n $expected-value\n $expected-decision\n $expected-case\n $first\n $second)\n $context\n $target\n (FuzzShrinkSummary\n $status\n $reason\n $attempts\n $accepted))\n (_fuzz-build-flaky\n $context\n (FuzzUnstable\n $stage\n $expected-value\n $expected-decision\n $expected-case\n $first\n $second)\n (FuzzShrinkSummary\n $status\n PostShrinkReplayMismatch\n $attempts\n $accepted)))\n\n(= (_fuzz-finalize-failure\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n (FuzzCaseResult\n Fail\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations\n $results\n $steps)\n $config\n $state)\n (let $signature (_fuzz-failure-signature $tag)\n (_fuzz-start-failure-processing\n (FuzzFailureContext\n $property-id\n $generator\n $property\n $quantifier\n $phase\n $case-index\n $origin\n $size\n $value\n $decision\n (FuzzCaseResult\n Fail\n $tag\n $details\n $labels\n $collected\n $coverage\n $annotations\n $results\n $steps)\n $config\n $state\n $signature))))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Model-based state machines. A machine is declared as ordinary MeTTa data:\n;\n; (FuzzMachine Counter\n; (InitialModel (Count 0))\n; (InitializeReal counter-initialize)\n; (CommandGenerator counter-command-generator)\n; (Precondition counter-precondition)\n; (Execute counter-execute)\n; (NextModel counter-next-model)\n; (Postcondition counter-postcondition)\n; (Invariant counter-invariant)\n; (Cleanup counter-cleanup))\n;\n; Generation walks the abstract model only: `(CommandGenerator model)` returns a command\n; generator, each drawn command must satisfy `(Precondition model command)`, and\n; `(NextModel model command)` threads the model forward without touching the real system.\n; Execution happens in the `fuzz-machine-run` property: it builds the real system with\n; `(InitializeReal)`, checks `(Invariant model)` before the first command and after every\n; model update, rechecks each precondition, runs `(Execute real command)`, judges\n; `(Postcondition model command result)` against the pre-command model, and always calls\n; `(Cleanup real)`. `NextModel` stays a pure symbolic transition, so the model can never\n; absorb behavior from the system it is meant to predict. Cleanup's world effects roll back\n; with the rest of the run (the case sandbox restores the pre-run world), so cleanup matters\n; for genuinely external resources: host-effectful operations under the ExternalEffects\n; policy, whose effects live outside the world. A MeTTa cleanup relation cannot run after a\n; host-level abort either; an external system needs a host try/finally reset adapter around\n; the whole check.\n\n(= (_fuzz-machine-spec-results $name $results)\n (switch $results\n ((()\n (_fuzz-generation-error\n MissingFuzzMachine\n (Name $name)))\n (($spec)\n (ValidMachineSpec $spec))\n ($many\n (_fuzz-generation-error\n AmbiguousFuzzMachine\n (Name $name)\n (Results $many))))))\n\n(= (_fuzz-machine-spec $name)\n (let $results\n (collapse\n (match &self\n (FuzzMachine $name\n (InitialModel $initial)\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (MachineSpec\n (InitialModel (quote $initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))))\n (_fuzz-machine-spec-results $name $results)))\n\n; Cardinality-checked applications for the machine's user relations, sharing\n; `_fuzz-call-results-bind` and `_fuzz-bool-result` with the unary helper. Each collapse-bind\n; sits inside a function/chain context so the call reaches it raw; an evaluated argument would\n; branch first and a nondeterministic relation would slip through as parallel single results.\n(= (_fuzz-machine-call-zero $function $context)\n (function\n (chain (context-space) $space\n (chain (collapse-bind (metta ($function) %Undefined% $space)) $pairs\n (chain (eval (_fuzz-call-results-bind $pairs $context)) $out\n (return $out))))))\n\n(= (_fuzz-machine-call-two $function $first $second $context)\n (function\n (chain (context-space) $space\n (chain (collapse-bind (metta ($function $first $second) %Undefined% $space)) $pairs\n (chain (eval (_fuzz-call-results-bind $pairs $context)) $out\n (return $out))))))\n\n(= (_fuzz-machine-call-three $function $first $second $third $context)\n (function\n (chain (context-space) $space\n (chain (collapse-bind (metta ($function $first $second $third) %Undefined% $space)) $pairs\n (chain (eval (_fuzz-call-results-bind $pairs $context)) $out\n (return $out))))))\n\n(= (_fuzz-machine-bool-two $function $first $second $context)\n (_fuzz-bool-result\n (_fuzz-machine-call-two $function $first $second $context)\n $context))\n\n; One command for the current model: draw from the user generator and retry, up to a fixed\n; budget, until the precondition holds. Every attempt's decision tree is recorded in the\n; command's MachineCommand node (the same shape gen-filter uses), so replay repeats the\n; rejected draws deterministically and the whole sequence stays a pure function of its tree.\n(= (_fuzz-machine-command-descriptor $command-generator $model)\n (let $called\n (_fuzz-call-one\n $command-generator\n $model\n (MachineCommandGenerator (Model (quote $model))))\n (switch $called\n (((CallOne $descriptor) (CallOne $descriptor))\n ((FuzzGenerationError $code $details) $called)\n ($bad\n (_fuzz-generation-error\n MalformedMachineCommandGenerator\n (Value $bad)))))))\n\n(= (_fuzz-machine-draw-command\n $descriptor $precondition $model $driver $size $attempt $attempt-trees-reversed)\n (_fuzz-machine-draw-loop\n (MachineDraw\n $descriptor $precondition $model $driver $size\n $attempt $attempt-trees-reversed)))\n\n(= (_fuzz-machine-draw-loop $state)\n (if (_fuzz-machine-draw-finished $state)\n $state\n (_fuzz-machine-draw-loop (_fuzz-machine-draw-step $state))))\n\n(= (_fuzz-machine-draw-finished $state)\n (unify $state\n (MachineDraw\n $descriptor $precondition $model $driver $size\n $attempt $attempt-trees-reversed)\n False\n True))\n\n(= (_fuzz-machine-draw-step $state)\n (unify $state\n (MachineDraw\n $descriptor $precondition $model $driver $size\n $attempt $attempt-trees-reversed)\n (if (> $attempt 16)\n (let* (($children (reverse $attempt-trees-reversed))\n ($tree\n (Decision\n MachineCommand\n (MaximumAttempts 16)\n (Attempts 16)\n $children)))\n (FuzzGenerationDiscard\n (MachineCommandRetriesExhausted (Attempts 16))\n $driver\n $tree))\n (let $sample (fuzz-generate $descriptor $driver $size)\n (switch $sample\n (((FuzzSample $command $next-driver $draw-tree)\n (let $checked\n (_fuzz-machine-bool-two\n $precondition\n $model\n $command\n (MachinePrecondition\n (Attempt $attempt)\n (Command (quote $command))))\n (switch $checked\n (((CallBool True)\n (let* (($children\n (reverse\n (cons-atom $draw-tree $attempt-trees-reversed)))\n ($tree\n (Decision\n MachineCommand\n (MaximumAttempts 16)\n (Attempts $attempt)\n $children)))\n (MachineCommandDrawn $command $next-driver $tree)))\n ((CallBool False)\n (let $next-trees\n (cons-atom $draw-tree $attempt-trees-reversed)\n (MachineDraw\n $descriptor\n $precondition\n $model\n $next-driver\n $size\n (+ $attempt 1)\n $next-trees)))\n ((FuzzGenerationError $code $details) $checked)\n ($bad\n (_fuzz-generation-error\n MalformedMachinePrecondition\n (Value $bad)))))))\n ((FuzzGenerationDiscard $reason $next-driver $draw-tree)\n (let* (($children\n (reverse (cons-atom $draw-tree $attempt-trees-reversed)))\n ($tree\n (Decision\n MachineCommand\n (MaximumAttempts 16)\n (Attempts $attempt)\n $children)))\n (FuzzGenerationDiscard $reason $next-driver $tree)))\n ((FuzzGenerationError $code $details) $sample)\n ($bad\n (_fuzz-generation-error\n MalformedGenerationResult\n (Value $bad)))))))\n $state))\n\n(= (CustomCapabilities _fuzz-machine (MachineSequence $quoted-name $spec))\n (FuzzCustomCapabilities\n (Modes\n (Random\n Edge\n Replay\n ShrinkReplay\n Exhaustive\n Bytes))))\n\n; Sequence generation: one integer decision for the length in [0, size], then one\n; model-aware command per step. The value embeds the machine name and spec so the\n; executor property needs no space read.\n(= (DriveCustom _fuzz-machine (MachineSequence $quoted-name $spec) $driver $size)\n (unify $spec\n (MachineSpec\n (InitialModel (quote $initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (let $length-choice (_fuzz-driver-int $driver 0 $size 0)\n (switch $length-choice\n (((DriverChoice $count $next-driver $length-decision)\n (let $seed-trees (cons-atom $length-decision ())\n (_fuzz-machine-gen-loop\n (MachineGenRun\n $quoted-name\n $spec\n $initial\n $count\n $next-driver\n $size\n $seed-trees\n ()))))\n ((FuzzGenerationError $code $details) $length-choice)\n ($bad\n (_fuzz-generation-error\n MalformedDriverChoice\n (Value $bad))))))\n (_fuzz-generation-error MalformedMachineSpec (Value $spec))))\n\n(= (_fuzz-machine-gen-loop $state)\n (if (_fuzz-machine-gen-finished $state)\n $state\n (_fuzz-machine-gen-loop (_fuzz-machine-gen-step $state))))\n\n(= (_fuzz-machine-gen-finished $state)\n (unify $state\n (MachineGenRun\n $quoted-name $spec $model $remaining $driver $size\n $trees-reversed $commands-reversed)\n False\n True))\n\n(= (_fuzz-machine-gen-step $state)\n (unify $state\n (MachineGenRun\n $quoted-name $spec $model $remaining $driver $size\n $trees-reversed $commands-reversed)\n (if (== $remaining 0)\n (let* (($commands (reverse $commands-reversed))\n ($children (reverse $trees-reversed))\n ($count (length $commands))\n ($value (FuzzMachineRun $quoted-name $spec $commands))\n ($tree (Decision MachineSequence (Count $count) () $children)))\n (FuzzSample $value $driver $tree))\n (unify $spec\n (MachineSpec\n (InitialModel (quote $initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (let $described\n (_fuzz-machine-command-descriptor\n $command-generator\n $model)\n (switch $described\n (((FuzzGenerationError $code $details) $described)\n ((CallOne $descriptor)\n (let $sample\n (_fuzz-machine-draw-command\n $descriptor\n $precondition\n $model\n $driver\n $size\n 1\n ())\n (switch $sample\n (((MachineCommandDrawn $command $next-driver $tree)\n (let $stepped\n (_fuzz-machine-call-two\n $next-model\n $model\n $command\n (MachineNextModel\n (Model (quote $model))\n (Command (quote $command))))\n (switch $stepped\n (((CallOne $next-model-value)\n (let* (($next-trees\n (cons-atom $tree $trees-reversed))\n ($next-commands\n (cons-atom $command $commands-reversed)))\n (MachineGenRun\n $quoted-name\n $spec\n $next-model-value\n (- $remaining 1)\n $next-driver\n $size\n $next-trees\n $next-commands)))\n ((FuzzGenerationError $code $details) $stepped)\n ($bad\n (_fuzz-generation-error\n MalformedMachineModel\n (Value $bad)))))))\n ((FuzzGenerationDiscard $reason $next-driver $tree)\n (let* (($children\n (reverse (cons-atom $tree $trees-reversed)))\n ($count (length $commands-reversed))\n ($wrapped\n (Decision\n MachineSequence\n (Count $count)\n ()\n $children)))\n (FuzzGenerationDiscard\n $reason\n $next-driver\n $wrapped)))\n ((FuzzGenerationError $code $details) $sample)\n ($bad\n (_fuzz-generation-error\n MalformedGenerationResult\n (Value $bad))))))))))\n (_fuzz-generation-error MalformedMachineSpec (Value $spec))))\n $state))\n\n; Structural shrink candidates in the handoff's stable order: remove large command chunks\n; first, then smaller chunks by ascending start index. Individual command trees shrink\n; afterwards through the generic child descent. Every candidate replays from the initial\n; model, so a chunk whose suffix no longer satisfies its preconditions is discarded by the\n; filter during shrink replay and rejected.\n(= (ShrinkChoices _fuzz-machine (MachineSequence $quoted-name $spec) $decision)\n (let $candidates (_fuzz-machine-chunk-candidates $decision)\n (superpose $candidates)))\n\n(= (_fuzz-machine-chunk-candidates $decision)\n (switch $decision\n (((Decision Custom $metadata $selection ($sequence))\n (switch $sequence\n (((Decision MachineSequence $count-metadata $sequence-selection $children)\n (if-decons-expr\n $children\n $length-decision\n $command-trees\n (_fuzz-machine-chunk-sizes\n $decision\n $length-decision\n $command-trees\n (length $command-trees))\n ()))\n ($bad ()))))\n ($bad ()))))\n\n(= (_fuzz-machine-chunk-sizes $decision $length-decision $command-trees $chunk)\n (if (< $chunk 1)\n ()\n (let* (($here\n (_fuzz-machine-chunk-starts\n $decision\n $length-decision\n $command-trees\n $chunk\n 0))\n ($half (if (== $chunk 1) 0 (trunc-math (/ $chunk 2))))\n ($rest\n (_fuzz-machine-chunk-sizes\n $decision\n $length-decision\n $command-trees\n $half)))\n (append $here $rest))))\n\n(= (_fuzz-machine-chunk-starts $decision $length-decision $command-trees $chunk $start)\n (if (> (+ $start $chunk) (length $command-trees))\n ()\n (let* (($candidate\n (_fuzz-machine-remove-chunk\n $decision\n $length-decision\n $command-trees\n $chunk\n $start))\n ($rest\n (_fuzz-machine-chunk-starts\n $decision\n $length-decision\n $command-trees\n $chunk\n (+ $start 1))))\n (cons-atom $candidate $rest))))\n\n(= (_fuzz-machine-remove-chunk $decision $length-decision $command-trees $chunk $start)\n (switch $decision\n (((Decision Custom $metadata $selection ($sequence))\n (let* (($prefix (_fuzz-list-take $command-trees $start))\n ($suffix (_fuzz-list-drop $command-trees (+ $start $chunk)))\n ($kept (append $prefix $suffix))\n ($count (length $kept))\n ($shortened\n (_fuzz-machine-shorten-length $length-decision $count))\n ($rebuilt-children (cons-atom $shortened $kept))\n ($rebuilt\n (Decision\n MachineSequence\n (Count $count)\n ()\n $rebuilt-children))\n ($rebuilt-child (cons-atom $rebuilt ())))\n (Decision Custom $metadata $selection $rebuilt-child)))\n ($bad $bad))))\n\n(= (_fuzz-machine-shorten-length $length-decision $count)\n (switch $length-decision\n (((Decision Int (Bounds $lower $upper) (Origin $origin) (Value $value) ())\n (_fuzz-int-decision $lower $upper $origin $count))\n ($bad $bad))))\n\n; Public surface: `(gen-machine Name)` generates `(FuzzMachineRun (quote Name) spec\n; commands)` values, and `fuzz-machine-run` is the ordinary arity-one property that\n; executes them, so machines run under fuzz-check, fuzz-check-exhaustive, replay, and\n; shrinking without special cases.\n(= (gen-machine $name)\n (if (_fuzz-atom-ground $name)\n (let $validated (_fuzz-machine-spec $name)\n (switch $validated\n (((ValidMachineSpec $spec)\n (GenCustom _fuzz-machine (MachineSequence (quote $name) $spec)))\n ((FuzzGenerationError $code $details) $validated)\n ($bad\n (_fuzz-generation-error\n MalformedMachineSpec\n (Value $bad))))))\n (_fuzz-generation-error NonGroundMachineName (Name $name))))\n\n(: fuzz-machine-run (-> Atom FuzzProperty))\n(= (fuzz-machine-run $value)\n (unify $value\n (FuzzMachineRun $quoted-name $spec $commands)\n (unify $spec\n (MachineSpec\n (InitialModel (quote $initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (let $started\n (_fuzz-machine-call-zero\n $initialize\n (MachineInitializeReal $quoted-name))\n (switch $started\n (((CallOne $real)\n (let $verdict\n (_fuzz-machine-exec-start\n $spec\n $initial\n $real\n $commands)\n (_fuzz-machine-cleanup $cleanup $real $verdict)))\n ((FuzzGenerationError $code $details)\n (fuzz-fail MachineInitializeFailed (CausedBy $started)))\n ($bad\n (fuzz-fail MachineInitializeFailed (Value $bad))))))\n (fuzz-fail MalformedMachineSpec (Value (quote $spec))))\n (fuzz-fail MalformedMachineRun (Value (quote $value)))))\n\n(= (_fuzz-machine-exec-start $spec $initial $real $commands)\n (unify $spec\n (MachineSpec\n (InitialModel (quote $unused-initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (let $checked\n (_fuzz-call-bool\n $invariant\n $initial\n (MachineInvariant (Step 0) (Model (quote $initial))))\n (switch $checked\n (((CallBool True)\n (_fuzz-machine-exec-loop\n (MachineExecRun $spec $initial $real $commands 0)))\n ((CallBool False)\n (let $failed\n (fuzz-fail\n MachineInvariantViolated\n ((Step 0) (Model (quote $initial))))\n (MachineVerdict $failed)))\n ((FuzzGenerationError $code $details)\n (let $failed\n (fuzz-fail MachineInvariantError (CausedBy $checked))\n (MachineVerdict $failed)))\n ($bad\n (let $failed\n (fuzz-fail MachineInvariantError (Value $bad))\n (MachineVerdict $failed))))))\n (let $failed\n (fuzz-fail MalformedMachineSpec (Value (quote $spec)))\n (MachineVerdict $failed))))\n\n(= (_fuzz-machine-exec-loop $state)\n (if (_fuzz-machine-exec-finished $state)\n $state\n (_fuzz-machine-exec-loop (_fuzz-machine-exec-step $state))))\n\n(= (_fuzz-machine-exec-finished $state)\n (unify $state\n (MachineExecRun $spec $model $real $commands $index)\n False\n True))\n\n(= (_fuzz-machine-exec-step $state)\n (unify $state\n (MachineExecRun $spec $model $real $commands $index)\n (if (== $commands ())\n (let $pass (fuzz-pass)\n (MachineVerdict $pass))\n (unify $spec\n (MachineSpec\n (InitialModel (quote $unused-initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (let* ((($command $rest) (decons-atom $commands))\n ($pre\n (_fuzz-machine-bool-two\n $precondition\n $model\n $command\n (MachinePrecondition\n (Step $index)\n (Command (quote $command))))))\n (switch $pre\n (((CallBool False)\n (let $verdict\n (fuzz-discard\n (MachinePreconditionViolated\n (Step $index)\n (Command (quote $command))))\n (MachineVerdict $verdict)))\n ((CallBool True)\n (_fuzz-machine-exec-command\n $spec $model $real $command $rest $index))\n ((FuzzGenerationError $code $details)\n (let $failed\n (fuzz-fail MachinePreconditionError (CausedBy $pre))\n (MachineVerdict $failed)))\n ($bad\n (let $failed\n (fuzz-fail MachinePreconditionError (Value $bad))\n (MachineVerdict $failed))))))\n (let $failed\n (fuzz-fail MalformedMachineSpec (Value (quote $spec)))\n (MachineVerdict $failed))))\n $state))\n\n(= (_fuzz-machine-exec-command $spec $model $real $command $rest $index)\n (unify $spec\n (MachineSpec\n (InitialModel (quote $unused-initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (let $ran\n (_fuzz-machine-call-two\n $execute\n $real\n $command\n (MachineExecute (Step $index) (Command (quote $command))))\n (switch $ran\n (((CallOne $result)\n (let $post\n (_fuzz-bool-result\n (_fuzz-machine-call-three\n $postcondition\n $model\n $command\n $result\n (MachinePostcondition (Step $index)))\n (MachinePostcondition (Step $index)))\n (switch $post\n (((CallBool False)\n (let $failed\n (fuzz-fail\n MachinePostconditionFailed\n ((Step $index)\n (Command (quote $command))\n (Result (quote $result))\n (Model (quote $model))))\n (MachineVerdict $failed)))\n ((CallBool True)\n (_fuzz-machine-exec-advance\n $spec $model $real $command $result $rest $index))\n ((FuzzGenerationError $code $details)\n (let $failed\n (fuzz-fail MachinePostconditionError (CausedBy $post))\n (MachineVerdict $failed)))\n ($bad\n (let $failed\n (fuzz-fail MachinePostconditionError (Value $bad))\n (MachineVerdict $failed)))))))\n ((FuzzGenerationError $code $details)\n (let $failed\n (fuzz-fail MachineExecuteFailed (CausedBy $ran))\n (MachineVerdict $failed)))\n ($bad\n (let $failed\n (fuzz-fail MachineExecuteFailed (Value $bad))\n (MachineVerdict $failed))))))\n (let $failed\n (fuzz-fail MalformedMachineSpec (Value (quote $spec)))\n (MachineVerdict $failed))))\n\n(= (_fuzz-machine-exec-advance $spec $model $real $command $result $rest $index)\n (unify $spec\n (MachineSpec\n (InitialModel (quote $unused-initial))\n (InitializeReal $initialize)\n (CommandGenerator $command-generator)\n (Precondition $precondition)\n (Execute $execute)\n (NextModel $next-model)\n (Postcondition $postcondition)\n (Invariant $invariant)\n (Cleanup $cleanup))\n (let $stepped\n (_fuzz-machine-call-two\n $next-model\n $model\n $command\n (MachineNextModel\n (Model (quote $model))\n (Command (quote $command))))\n (switch $stepped\n (((CallOne $next)\n (let $checked\n (_fuzz-call-bool\n $invariant\n $next\n (MachineInvariant\n (Step (+ $index 1))\n (Model (quote $next))))\n (switch $checked\n (((CallBool True)\n (MachineExecRun $spec $next $real $rest (+ $index 1)))\n ((CallBool False)\n (let $failed\n (fuzz-fail\n MachineInvariantViolated\n ((Step (+ $index 1)) (Model (quote $next))))\n (MachineVerdict $failed)))\n ((FuzzGenerationError $code $details)\n (let $failed\n (fuzz-fail MachineInvariantError (CausedBy $checked))\n (MachineVerdict $failed)))\n ($bad\n (let $failed\n (fuzz-fail MachineInvariantError (Value $bad))\n (MachineVerdict $failed)))))))\n ((FuzzGenerationError $code $details)\n (let $failed\n (fuzz-fail MachineNextModelFailed (CausedBy $stepped))\n (MachineVerdict $failed)))\n ($bad\n (let $failed\n (fuzz-fail MachineNextModelFailed (Value $bad))\n (MachineVerdict $failed))))))\n (let $failed\n (fuzz-fail MalformedMachineSpec (Value (quote $spec)))\n (MachineVerdict $failed))))\n\n(= (_fuzz-machine-cleanup $cleanup $real $verdict)\n (let $cleaned\n (_fuzz-call-one\n $cleanup\n $real\n (MachineCleanup))\n (switch $cleaned\n (((CallOne $ignored)\n (unify $verdict\n (MachineVerdict $property)\n $property\n (fuzz-fail MalformedMachineVerdict (Value (quote $verdict)))))\n ((FuzzGenerationError $code $details)\n (unify $verdict\n (MachineVerdict $property)\n (_fuzz-machine-cleanup-verdict $property $cleaned)\n (fuzz-fail MalformedMachineVerdict (Value (quote $verdict)))))\n ($bad\n (fuzz-fail MachineCleanupFailed (Value $bad)))))))\n\n; A cleanup error surfaces only when the run itself passed; a real counterexample keeps\n; its own failure.\n(= (_fuzz-machine-cleanup-verdict $property $cleanup-error)\n (unify $property\n (Pass)\n (fuzz-fail MachineCleanupFailed (CausedBy $cleanup-error))\n $property))\n\n(= (fuzz-check-machine $name $config)\n (fuzz-check $name (gen-machine $name) fuzz-machine-run $config))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Bounded state reachability over a model transition relation, as deterministic level-order\n; breadth-first search:\n;\n; !(fuzz-reachable Counter (Count 0)\n; counter-enumerate counter-transition counter-target?\n; (reach-config (MaxDepth 20) (MaxStates 5000) (MaxTransitions 200000)))\n;\n; The command enumerator returns `(FiniteCommands c1 c2 ...)` or `(IncompleteCommands reason)`.\n; The transition relation may return several next states; the whole ordered result bag becomes\n; outgoing edges and each branch's index is recorded, so a witness names exactly one branch.\n; Breadth-first order makes the first witness shortest in transition count.\n;\n; `MaxDepth` bounds the depth of every state the search considers, so a reported witness is never\n; longer than `MaxDepth` commands. The boundary level is still enumerated, because a state with no\n; command at all ends the model while a state with commands continues past the bound, and that is what\n; separates exhaustion from a depth answer; no transition runs there, so no deeper state is built.\n;\n; The outcomes are kept apart on purpose. `FuzzReachable` carries a witness that was replayed from\n; the initial model before being reported. `FuzzUnreachableWithinDepth` says only that no target\n; occurred at or below the depth actually completed. `FuzzReachabilityExhausted` is reported only\n; when the frontier ran dry with every command enumeration complete and no limit fired: it means\n; unreachable in the declared finite model, never unreachable in an external system. Every limit,\n; incomplete enumeration, relation failure, or replay mismatch is a `FuzzReachabilityCutoff` and\n; never becomes exhaustion.\n;\n; State identity is exact structural equality by default. `(StateIdentity Alpha)` merges\n; alpha-variant states and is valid only when the transition and target relations are equivariant\n; under variable renaming, which the user states with `(FuzzReachEquivariant Name)`.\n;\n; Identity runs through `_fuzz-atom-key`, whose key is a length-prefixed structural serialization\n; (typed prefixes, explicit arities, canonically renumbered variables under Alpha), not a hash.\n; Distinct states cannot share a key, so key equality IS state identity under the selected mode and\n; no second confirmation pass is needed; `reachability.test.ts` pins that property from both sides.\n; A state whose grounded payload has no serialization is an explicit `UnkeyableState` invalid\n; result rather than a silently missed state.\n;\n; Visited states are held as a key list scanned by the grounded `_fuzz-exact-member`, so the search\n; is quadratic in visited states while each user relation call costs a full MeTTa interpretation.\n; `MaxStates` defaults to 5000, where the scan stays far below the relation cost.\n\n; ---------------------------------------------------------------------------\n; Configuration\n\n(= (_fuzz-reach-default-values)\n (ReachConfigValues\n (MaxDepth 20)\n (MaxStates 5000)\n (MaxTransitions 200000)\n (StateIdentity Exact)))\n\n(= (reach-config-defaults)\n (_fuzz-reach-default-values))\n\n; A bound is a nonnegative integer; zero selects the unlimited policy, as elsewhere in the library.\n(= (_fuzz-reach-bound-value $value)\n (if (== (get-metatype $value) Grounded)\n (and (>= $value 0) (== $value (trunc-math $value)))\n False))\n\n(= (_fuzz-reach-config-set $values $option)\n (unify $values\n (ReachConfigValues\n (MaxDepth $depth)\n (MaxStates $states)\n (MaxTransitions $transitions)\n (StateIdentity $identity))\n (switch $option\n (((MaxDepth $value)\n (if (_fuzz-reach-bound-value $value)\n (ReachConfigValues\n (MaxDepth $value)\n (MaxStates $states)\n (MaxTransitions $transitions)\n (StateIdentity $identity))\n (FuzzInvalid InvalidReachConfig (InvalidMaxDepth (MaxDepth $value)))))\n ((MaxStates $value)\n (if (_fuzz-reach-bound-value $value)\n (ReachConfigValues\n (MaxDepth $depth)\n (MaxStates $value)\n (MaxTransitions $transitions)\n (StateIdentity $identity))\n (FuzzInvalid InvalidReachConfig (InvalidMaxStates (MaxStates $value)))))\n ((MaxTransitions $value)\n (if (_fuzz-reach-bound-value $value)\n (ReachConfigValues\n (MaxDepth $depth)\n (MaxStates $states)\n (MaxTransitions $value)\n (StateIdentity $identity))\n (FuzzInvalid\n InvalidReachConfig\n (InvalidMaxTransitions (MaxTransitions $value)))))\n ((StateIdentity $value)\n (if (or (== $value Exact) (== $value Alpha))\n (ReachConfigValues\n (MaxDepth $depth)\n (MaxStates $states)\n (MaxTransitions $transitions)\n (StateIdentity $value))\n (FuzzInvalid\n InvalidReachConfig\n (InvalidStateIdentity (StateIdentity $value)))))\n ($unknown\n (FuzzInvalid InvalidReachConfig (UnknownReachOption $unknown)))))\n (FuzzInvalid InvalidReachConfig (MalformedReachConfigValues $values))))\n\n(= (_fuzz-reach-config-loop $state)\n (if (_fuzz-reach-config-finished $state)\n $state\n (_fuzz-reach-config-loop (_fuzz-reach-config-step $state))))\n\n(= (_fuzz-reach-config-finished $state)\n (unify $state (ReachConfigFold $values $options) False True))\n\n(= (_fuzz-reach-config-step $state)\n (unify $state\n (ReachConfigFold $values $options)\n (if (== $options ())\n $values\n (let ($option $rest) (decons-atom $options)\n (let $applied (_fuzz-reach-config-set $values $option)\n (switch $applied\n (((FuzzInvalid $code $details) $applied)\n ($updated (ReachConfigFold $updated $rest)))))))\n $state))\n\n(= (_fuzz-reach-config-values $config)\n (let $head (_fuzz-expression-head $config)\n (if (== $head reach-config)\n (let $options (cdr-atom $config)\n (let $defaults (_fuzz-reach-default-values)\n (_fuzz-reach-config-loop (ReachConfigFold $defaults $options))))\n (FuzzInvalid InvalidReachConfig (MalformedReachConfig (Value (quote $config)))))))\n\n; The head symbol of an expression, or Empty for anything else, so a malformed argument reports\n; itself instead of erroring inside car-atom.\n(= (_fuzz-expression-head $atom)\n (if (== (get-metatype $atom) Expression)\n (if-decons-expr $atom $head $tail $head Empty)\n Empty))\n\n(= (_fuzz-reach-config-get $name $values)\n (unify $values\n (ReachConfigValues\n (MaxDepth $depth)\n (MaxStates $states)\n (MaxTransitions $transitions)\n (StateIdentity $identity))\n (switch $name\n ((MaxDepth $depth)\n (MaxStates $states)\n (MaxTransitions $transitions)\n (StateIdentity $identity)))\n Empty))\n\n; ---------------------------------------------------------------------------\n; User relation calls\n;\n; The collapse-bind sits inside a function/chain context so its call reaches it raw; an evaluated\n; argument would branch first and a nondeterministic relation would slip through as parallel single\n; results. Unlike the single-result helpers this one keeps the whole ordered bag: a transition\n; relation is nondeterministic by design.\n\n(= (_fuzz-call-all-two $function $first $second $context)\n (function\n (chain (context-space) $space\n (chain (collapse-bind (metta ($function $first $second) %Undefined% $space)) $pairs\n (chain (eval (_fuzz-call-all-results $pairs $context)) $out\n (return $out))))))\n\n(= (_fuzz-call-all-results $pairs $context)\n (if (== $pairs ())\n (_fuzz-generation-error FunctionReturnedNoResults $context)\n (let $values (_fuzz-pair-values $pairs)\n (CallAll $values))))\n\n; ---------------------------------------------------------------------------\n; State identity\n\n(= (_fuzz-reach-state-key $identity $state)\n (let $key (_fuzz-atom-key $identity $state)\n (switch $key\n (((FuzzKernelError $code $details)\n (ReachUnkeyable (ErrorCode $code) $details))\n ($valid (ReachKey $valid))))))\n\n; ---------------------------------------------------------------------------\n; Command lists\n\n(= (_fuzz-reach-command-items $commands)\n (switch $commands\n (((IncompleteCommands $reason) (ReachIncomplete $reason))\n ($listed\n (let $head (_fuzz-expression-head $listed)\n (if (== $head FiniteCommands)\n (let $items (cdr-atom $listed) (ReachFinite $items))\n (ReachMalformed (Value $listed))))))))\n\n(= (_fuzz-reach-nth $values $index)\n (let $dropped (_fuzz-list-drop $values $index)\n (if-decons-expr $dropped $head $tail (ReachItem $head) ReachMissing)))\n\n; ---------------------------------------------------------------------------\n; Search\n;\n; One frontier node carries its own path from the initial model, so a witness needs no predecessor\n; table: `(ReachNode state path)` with path `((Step command-index command branch) ...)` in\n; transition order.\n\n(= (_fuzz-reach-loop $state)\n (if (_fuzz-reach-finished $state)\n $state\n (_fuzz-reach-loop (_fuzz-reach-step $state))))\n\n(= (_fuzz-reach-finished $state)\n (unify $state\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n False\n True))\n\n; MaxDepth bounds the depth of every state the search considers, so a witness is never longer than\n; MaxDepth commands and a depth answer means exactly \"every state at or below MaxDepth was generated\n; and judged against the target\". Zero is the unlimited policy, as with the other bounds.\n(= (_fuzz-reach-at-depth-limit $depth $values)\n (let $limit (_fuzz-reach-config-get MaxDepth $values)\n (and (> $limit 0) (>= $depth $limit))))\n\n; A step either advances the level or expands the first node of the current level. Advancing with an\n; empty next level is exhaustion; refusing to advance past MaxDepth is the depth answer, not a\n; cutoff, because every level at or below it was searched completely.\n(= (_fuzz-reach-step $state)\n (unify $state\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (if (== $frontier ())\n (if (== $next ())\n (ReachRun $spec () () $visited $counts $depth $values (ReachExhausted $depth))\n (if (_fuzz-reach-at-depth-limit $depth $values)\n (ReachRun\n $spec () () $visited $counts $depth $values\n (ReachUnreachableWithinDepth $depth))\n (let $level (reverse $next)\n (ReachRun\n $spec $level () $visited $counts (+ $depth 1) $values Searching))))\n (let ($node $rest) (decons-atom $frontier)\n (_fuzz-reach-expand\n (ReachRun $spec $rest $next $visited $counts $depth $values Searching)\n $node)))\n $state))\n\n(= (_fuzz-reach-cutoff $run $reason)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values $outcome)\n (ReachRun $spec $frontier $next $visited $counts $depth $values (ReachCutoff $reason))\n $run))\n\n(= (_fuzz-reach-expand $run $node)\n (unify $node\n (ReachNode $state-atom $path)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $enumerated\n (_fuzz-call-one $enumerate $state-atom (ReachEnumerate (Depth $depth)))\n (switch $enumerated\n (((CallOne $commands)\n (let $items (_fuzz-reach-command-items $commands)\n (switch $items\n (((ReachFinite $listed)\n (if (_fuzz-reach-at-depth-limit $depth $values)\n (_fuzz-reach-note-beyond-depth $run $listed)\n (_fuzz-reach-commands-loop (ReachCommands $run $node $listed 0))))\n ((ReachIncomplete $reason)\n (_fuzz-reach-cutoff $run (IncompleteCommandEnumeration $reason)))\n ((ReachMalformed $value)\n (_fuzz-reach-cutoff $run (MalformedCommandEnumeration $value)))))))\n ((FuzzGenerationError $code $details)\n (_fuzz-reach-cutoff $run (CommandEnumerationFailed (CausedBy $enumerated))))\n ($bad\n (_fuzz-reach-cutoff $run (MalformedCommandEnumeration (Value $bad)))))))\n (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec))))\n $run)\n $run))\n\n; At the boundary the enumerator still runs, because whether a state has any command at all is what\n; separates a model that ended from one that continues past the bound, and that distinction is the\n; difference between exhaustion and a depth answer. No transition runs there, so no state deeper than\n; MaxDepth is ever built, keyed, or judged. A state that does have commands leaves a marker in the\n; next level: the level is not empty, which is all the loop needs to know, and since the loop refuses\n; to advance into a level past the bound the marker is never expanded or reported.\n(= (_fuzz-reach-note-beyond-depth $run $listed)\n (if (== $listed ())\n $run\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (let $marked (cons-atom ReachBeyondDepth $next)\n (ReachRun $spec $frontier $marked $visited $counts $depth $values Searching))\n $run)))\n\n(= (_fuzz-reach-commands-loop $state)\n (if (_fuzz-reach-commands-finished $state)\n $state\n (_fuzz-reach-commands-loop (_fuzz-reach-commands-step $state))))\n\n(= (_fuzz-reach-commands-finished $state)\n (unify $state (ReachCommands $run $node $commands $index) False True))\n\n(= (_fuzz-reach-commands-step $state)\n (unify $state\n (ReachCommands $run $node $commands $index)\n (if (== $commands ())\n $run\n (let ($command $rest) (decons-atom $commands)\n (let $applied (_fuzz-reach-apply $run $node $command $index)\n (if (_fuzz-reach-searching $applied)\n (ReachCommands $applied $node $rest (+ $index 1))\n $applied))))\n $state))\n\n(= (_fuzz-reach-searching $run)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n True\n False))\n\n; Applying one command: the whole ordered result bag becomes outgoing edges.\n(= (_fuzz-reach-apply $run $node $command $command-index)\n (unify $node\n (ReachNode $state-atom $path)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $stepped\n (_fuzz-call-all-two\n $transition\n $state-atom\n $command\n (ReachTransition (Depth $depth) (Command (quote $command))))\n (switch $stepped\n (((CallAll $produced)\n (_fuzz-reach-branches-loop\n (ReachBranches $run $node $command $command-index $produced 0)))\n ((FuzzGenerationError $code $details)\n (_fuzz-reach-cutoff $run (TransitionFailed (CausedBy $stepped))))\n ($bad\n (_fuzz-reach-cutoff $run (MalformedTransition (Value $bad)))))))\n (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec))))\n $run)\n $run))\n\n(= (_fuzz-reach-branches-loop $state)\n (if (_fuzz-reach-branches-finished $state)\n $state\n (_fuzz-reach-branches-loop (_fuzz-reach-branches-step $state))))\n\n(= (_fuzz-reach-branches-finished $state)\n (unify $state\n (ReachBranches $run $node $command $command-index $produced $branch)\n False\n True))\n\n(= (_fuzz-reach-branches-step $state)\n (unify $state\n (ReachBranches $run $node $command $command-index $produced $branch)\n (if (== $produced ())\n $run\n (let ($state-atom $rest) (decons-atom $produced)\n (let $visited-run\n (_fuzz-reach-visit $run $node $command $command-index $branch $state-atom)\n (if (_fuzz-reach-searching $visited-run)\n (ReachBranches\n $visited-run $node $command $command-index $rest (+ $branch 1))\n $visited-run))))\n $state))\n\n; One produced state. The order here is the contract: the transition branch is counted before any\n; deduplication, the target is judged before MaxStates can cut, and MaxStates is checked against the\n; state this step would actually add.\n(= (_fuzz-reach-visit $run $node $command $command-index $branch $produced)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (unify $counts\n (ReachCounts $states $transitions)\n (let* (($next-transitions (+ $transitions 1))\n ($limit (_fuzz-reach-config-get MaxTransitions $values))\n ($counted (ReachCounts $states $next-transitions))\n ($advanced\n (ReachRun $spec $frontier $next $visited $counted $depth $values Searching)))\n (if (and (> $limit 0) (> $next-transitions $limit))\n (_fuzz-reach-cutoff\n $advanced\n (MaxTransitionsReached (MaxTransitions $limit)))\n (_fuzz-reach-judge\n $advanced\n $node\n (Step $command-index $command $branch)\n $produced)))\n $run)\n $run))\n\n(= (_fuzz-reach-judge $run $node $step $produced)\n (unify $node\n (ReachNode $parent $path)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $keyed (_fuzz-reach-state-key $identity $produced)\n (switch $keyed\n (((ReachUnkeyable $code $details)\n (_fuzz-reach-cutoff\n $run\n (UnkeyableState (State (quote $produced)) $code $details)))\n ((ReachKey $key)\n (_fuzz-reach-target $run $key $step $path $produced)))))\n (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec))))\n $run)\n $run))\n\n; The target is judged on the produced state before any deduplication or MaxStates check, so a\n; target that is only reachable as an already-visited state is still reported.\n(= (_fuzz-reach-target $run $key $step $path $produced)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $hit\n (_fuzz-call-bool\n $target\n $produced\n (ReachTarget (Depth $depth) (State (quote $produced))))\n (switch $hit\n (((CallBool True)\n (let $witness (append $path (cons-atom $step ()))\n (_fuzz-reach-confirm $run $witness $produced)))\n ((CallBool False)\n (_fuzz-reach-enqueue $run $key $step $path $produced))\n ((FuzzGenerationError $code $details)\n (_fuzz-reach-cutoff $run (TargetFailed (CausedBy $hit))))\n ($bad\n (_fuzz-reach-cutoff $run (MalformedTarget (Value $bad)))))))\n (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec))))\n $run))\n\n(= (_fuzz-reach-enqueue $run $key $step $path $produced)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (if (== (_fuzz-exact-member $key $visited) True)\n $run\n (unify $counts\n (ReachCounts $states $transitions)\n (let* (($next-states (+ $states 1))\n ($limit (_fuzz-reach-config-get MaxStates $values)))\n (if (and (> $limit 0) (> $next-states $limit))\n (_fuzz-reach-cutoff $run (MaxStatesReached (MaxStates $limit)))\n (let* (($seen (append $visited (cons-atom $key ())))\n ($witness (append $path (cons-atom $step ())))\n ($node (ReachNode $produced $witness))\n ($queued (cons-atom $node $next)))\n (ReachRun\n $spec\n $frontier\n $queued\n $seen\n (ReachCounts $next-states $transitions)\n $depth\n $values\n Searching))))\n $run))\n $run))\n\n; ---------------------------------------------------------------------------\n; Witness replay\n;\n; A found target is replayed from the initial model before it is reported: every step re-enumerates\n; the commands, requires the recorded command at its recorded index, takes the recorded branch\n; without deduplication, and the final state must satisfy the target. A mismatch means the\n; transition relation, the enumerator, or the target is not a function of the model state, so the\n; witness is not evidence and the result is a cutoff rather than a reachable claim.\n\n(= (_fuzz-reach-confirm $run $witness $produced)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values Searching)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $replayed (_fuzz-reach-replay $spec $witness)\n (switch $replayed\n (((ReachReplayed $final)\n (if (== (_fuzz-reach-same-state $identity $final $produced) True)\n (ReachRun\n $spec $frontier $next $visited $counts $depth $values\n (ReachFound $witness $produced))\n (_fuzz-reach-cutoff\n $run\n (WitnessReplayMismatch\n (Expected (quote $produced))\n (Actual (quote $final))))))\n ((ReachReplayFailed $reason)\n (_fuzz-reach-cutoff $run (WitnessReplayMismatch $reason)))\n ($bad\n (_fuzz-reach-cutoff $run (WitnessReplayMismatch (Value $bad)))))))\n (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec))))\n $run))\n\n(= (_fuzz-reach-same-state $identity $left $right)\n (let $left-key (_fuzz-reach-state-key $identity $left)\n (let $right-key (_fuzz-reach-state-key $identity $right)\n (unify $left-key\n (ReachKey $lk)\n (unify $right-key (ReachKey $rk) (== $lk $rk) False)\n False))))\n\n(= (_fuzz-reach-replay $spec $witness)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $walked (_fuzz-reach-replay-loop (ReachReplay $spec $initial $witness 0))\n (switch $walked\n (((ReachReplayed $final)\n (let $hit\n (_fuzz-call-bool\n $target\n $final\n (ReachReplayTarget (State (quote $final))))\n (switch $hit\n (((CallBool True) (ReachReplayed $final))\n ((CallBool False)\n (ReachReplayFailed (TargetFalseOnReplay (State (quote $final)))))\n ($bad (ReachReplayFailed (TargetUnreadableOnReplay (Value $bad))))))))\n ($failed $failed))))\n (ReachReplayFailed (MalformedReachSpec (Value $spec)))))\n\n(= (_fuzz-reach-replay-loop $state)\n (if (_fuzz-reach-replay-finished $state)\n $state\n (_fuzz-reach-replay-loop (_fuzz-reach-replay-step $state))))\n\n(= (_fuzz-reach-replay-finished $state)\n (unify $state (ReachReplay $spec $current $steps $index) False True))\n\n(= (_fuzz-reach-replay-step $state)\n (unify $state\n (ReachReplay $spec $current $steps $index)\n (if (== $steps ())\n (ReachReplayed $current)\n (let ($step $rest) (decons-atom $steps)\n (let $applied (_fuzz-reach-replay-apply $spec $current $step $index)\n (switch $applied\n (((ReachReplayState $produced)\n (ReachReplay $spec $produced $rest (+ $index 1)))\n ($failed $failed))))))\n $state))\n\n(= (_fuzz-reach-replay-apply $spec $current $step $index)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (unify $step\n (Step $command-index $command $branch)\n (let $enumerated\n (_fuzz-call-one $enumerate $current (ReachReplayEnumerate (Step $index)))\n (switch $enumerated\n (((CallOne $commands)\n (let $items (_fuzz-reach-command-items $commands)\n (switch $items\n (((ReachFinite $listed)\n (let $found (_fuzz-reach-nth $listed $command-index)\n (switch $found\n (((ReachItem $seen)\n (if (== (_fuzz-replay-equal $seen $command) True)\n (_fuzz-reach-replay-transition\n $spec $current $command $branch $index)\n (ReachReplayFailed\n (CommandChangedOnReplay\n (Step $index)\n (Expected (quote $command))\n (Actual (quote $seen))))))\n ($missing\n (ReachReplayFailed\n (CommandMissingOnReplay\n (Step $index)\n (CommandIndex $command-index))))))))\n ((ReachIncomplete $reason)\n (ReachReplayFailed\n (IncompleteCommandsOnReplay (Step $index) (Reason $reason))))\n ((ReachMalformed $value)\n (ReachReplayFailed\n (MalformedCommandsOnReplay (Step $index) $value)))))))\n ($bad\n (ReachReplayFailed (EnumerationFailedOnReplay (Step $index) (Value $bad)))))))\n (ReachReplayFailed (MalformedWitnessStep (Step $index) (Value (quote $step)))))\n (ReachReplayFailed (MalformedReachSpec (Value $spec)))))\n\n(= (_fuzz-reach-replay-transition $spec $current $command $branch $index)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $stepped\n (_fuzz-call-all-two\n $transition\n $current\n $command\n (ReachReplayTransition (Step $index)))\n (switch $stepped\n (((CallAll $produced)\n (let $selected (_fuzz-reach-nth $produced $branch)\n (switch $selected\n (((ReachItem $chosen) (ReachReplayState $chosen))\n ($missing\n (ReachReplayFailed\n (BranchMissingOnReplay (Step $index) (Branch $branch))))))))\n ($bad\n (ReachReplayFailed (TransitionFailedOnReplay (Step $index) (Value $bad)))))))\n (ReachReplayFailed (MalformedReachSpec (Value $spec)))))\n\n; ---------------------------------------------------------------------------\n; Public surface\n\n(= (fuzz-reachable $name $initial $enumerate $transition $target $config)\n (let $values (_fuzz-reach-config-values $config)\n (switch $values\n (((FuzzInvalid $code $details) $values)\n ($valid (_fuzz-reach-start $name $initial $enumerate $transition $target $valid))))))\n\n(= (_fuzz-reach-start $name $initial $enumerate $transition $target $values)\n (let $identity (_fuzz-reach-config-get StateIdentity $values)\n (if (== (_fuzz-reach-identity-permitted $name $identity) True)\n (let $keyed (_fuzz-reach-state-key $identity $initial)\n (switch $keyed\n (((ReachUnkeyable $code $details)\n (FuzzInvalid\n UnkeyableState\n (Property $name)\n (State (quote $initial))\n $code\n $details))\n ((ReachKey $key)\n (let $spec (ReachSpec $name $initial $enumerate $transition $target $identity)\n (_fuzz-reach-run $spec $key $values))))))\n (FuzzInvalid\n MissingEquivarianceDeclaration\n (Property $name)\n (StateIdentity $identity)))))\n\n; Alpha identity merges states that differ only by variable names, which is sound only when the\n; user's relations cannot tell those states apart. That is a claim about the model, so the user\n; states it explicitly and the search refuses the mode otherwise.\n(= (_fuzz-reach-identity-permitted $name $identity)\n (if (== $identity Alpha)\n (let $declared (collapse (match &self (FuzzReachEquivariant $name) Declared))\n (if (== $declared ()) False True))\n True))\n\n(= (_fuzz-reach-run $spec $key $values)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (let $hit\n (_fuzz-call-bool $target $initial (ReachTarget (Depth 0) (State (quote $initial))))\n (switch $hit\n (((CallBool True)\n (let* (($seen (cons-atom $key ()))\n ($counts (ReachCounts 1 0))\n ($found (ReachFound () $initial)))\n (_fuzz-reach-report\n (ReachRun $spec () () $seen $counts 0 $values $found))))\n ((CallBool False)\n (let* (($seen (cons-atom $key ()))\n ($counts (ReachCounts 1 0))\n ($root (ReachNode $initial ()))\n ($frontier (cons-atom $root ()))\n ($start (ReachRun $spec $frontier () $seen $counts 0 $values Searching))\n ($finished (_fuzz-reach-loop $start)))\n (_fuzz-reach-report $finished)))\n ((FuzzGenerationError $code $details)\n (FuzzInvalid TargetFailed (Property $name) (CausedBy $hit)))\n ($bad\n (FuzzInvalid MalformedTarget (Property $name) (Value $bad))))))\n (FuzzInvalid MalformedReachSpec (Value $spec))))\n\n(= (_fuzz-reach-report $run)\n (unify $run\n (ReachRun $spec $frontier $next $visited $counts $depth $values $outcome)\n (unify $spec\n (ReachSpec $name $initial $enumerate $transition $target $identity)\n (unify $counts\n (ReachCounts $states $transitions)\n (let $statistics\n (ReachStatistics\n (States $states)\n (Transitions $transitions)\n (Depth $depth))\n (switch $outcome\n (((ReachFound $witness $state)\n (let $commands (_fuzz-reach-witness-commands $witness)\n (FuzzReachable\n (Property $name)\n (Depth (length $witness))\n (Commands $commands)\n (Witness $witness)\n (Target (quote $state))\n $statistics)))\n ((ReachUnreachableWithinDepth $searched)\n (FuzzUnreachableWithinDepth (Property $name) (Depth $searched) $statistics))\n ((ReachExhausted $searched)\n (FuzzReachabilityExhausted\n (Property $name)\n (States $states)\n (Depth $searched)\n $statistics))\n ((ReachCutoff $reason)\n (FuzzReachabilityCutoff (Property $name) (Reason $reason) $statistics))\n ($bad\n (FuzzInvalid MalformedReachOutcome (Property $name) (Value $bad))))))\n (FuzzInvalid MalformedReachCounts (Value $counts)))\n (FuzzInvalid MalformedReachSpec (Value $spec)))\n (FuzzInvalid MalformedReachRun (Value $run))))\n\n; Flat accumulator, not recurse-then-cons: a witness is one step per transition and a long chain\n; would otherwise nest one evaluator frame per step.\n(= (_fuzz-reach-witness-commands $witness)\n (_fuzz-reach-witness-loop (ReachWitnessFold $witness ())))\n\n(= (_fuzz-reach-witness-loop $state)\n (if (_fuzz-reach-witness-finished $state)\n $state\n (_fuzz-reach-witness-loop (_fuzz-reach-witness-step $state))))\n\n(= (_fuzz-reach-witness-finished $state)\n (unify $state (ReachWitnessFold $steps $reversed) False True))\n\n(= (_fuzz-reach-witness-step $state)\n (unify $state\n (ReachWitnessFold $steps $reversed)\n (if (== $steps ())\n (reverse $reversed)\n (let ($step $rest) (decons-atom $steps)\n (unify $step\n (Step $command-index $command $branch)\n (let $next (cons-atom $command $reversed)\n (ReachWitnessFold $rest $next))\n (ReachWitnessFold $rest $reversed))))\n $state))\n\n; SPDX-FileCopyrightText: 2026 MesTTo\n;\n; SPDX-License-Identifier: MIT\n\n; Suite discovery. A file declares its tests as ordinary data rather than through a second host-side\n; test DSL:\n;\n; (: reverse-involution (-> Atom FuzzProperty))\n; (= (reverse-involution $xs) (expect-equal (reverse (reverse $xs)) $xs))\n; (FuzzTest reverse-involution (gen-list (gen-int -100 100) 0 40) reverse-involution\n; (fuzz-config (Runs 200)))\n;\n; `(fuzz-run-suite)` finds every `FuzzTest` fact and runs it through the ordinary `fuzz-check`, so a\n; suite is exactly what a hand-written `!(fuzz-check ...)` query would have been. The generator is\n; stored as syntax by the declaration and evaluated once per test when `fuzz-check` receives it,\n; which is what lets one declaration be replayed, shrunk, and enumerated like any other.\n;\n; The host may override configuration from the command line. Options are merged by REPLACEMENT rather\n; than appended, because a config carrying the same option twice is an explicit `DuplicateOption`\n; error; a test's own choices survive except where an override names the same option.\n\n(: FuzzTest (-> Atom Atom Atom Atom Atom))\n(: FuzzTestCase (-> Atom Atom Atom Atom Atom))\n(: FuzzSuiteRun (-> Atom Atom Atom Atom Atom))\n(: fuzz-run-suite (-> %Undefined%))\n(: fuzz-run-suite-with (-> Atom %Undefined%))\n(: fuzz-run-suite-exhaustive (-> Atom %Undefined%))\n(: fuzz-suite-tests (-> %Undefined%))\n(: _fuzz-suite-cases (-> %Undefined%))\n(: _fuzz-options-merged (-> Atom Atom Atom Atom %Undefined%))\n(: _fuzz-config-with-overrides (-> Atom Atom %Undefined%))\n(: _fuzz-reach-config-with-overrides (-> Atom Atom %Undefined%))\n(: _fuzz-override-names (-> Atom %Undefined%))\n(: _fuzz-options-without (-> Atom Atom %Undefined%))\n; The loop trio is deliberately UNDECLARED. An `Atom` parameter freezes its argument, and\n; `(_fuzz-suite-loop (_fuzz-suite-step $state))` passes a computed call: declaring it would freeze\n; the step, run exactly one iteration, and return the unevaluated call as the result.\n(: FuzzOverrideNames (-> Atom Atom Atom))\n(: FuzzOptionFilter (-> Atom Atom Atom Atom))\n\n; ---------------------------------------------------------------------------\n; Declared tests\n\n(= (_fuzz-suite-cases)\n (collapse\n (match &self\n (FuzzTest $id $generator $property $config)\n (FuzzTestCase $id $generator $property $config))))\n\n; The declared tests, for a host that wants to list a suite without running it.\n(= (fuzz-suite-tests)\n (let $cases (_fuzz-suite-cases) $cases))\n\n; ---------------------------------------------------------------------------\n; Configuration overrides\n;\n; Flat accumulator loops throughout: a suite may carry many options and a recurse-then-cons builder\n; costs an evaluator frame per element.\n;\n; An option is named by its head symbol rather than by `_fuzz-config-option-name`, whose switch is a\n; whitelist of the `fuzz-config` options and reports anything else as `InvalidOption`. Merging is\n; head-structural so it serves `reach-config` too; an option the target record does not accept is\n; still refused, by that record's own validation.\n\n(= (_fuzz-override-names $overrides)\n (_fuzz-override-names-loop (FuzzOverrideNames $overrides ())))\n\n(= (_fuzz-override-names-loop $state)\n (if (_fuzz-override-names-finished $state)\n $state\n (_fuzz-override-names-loop (_fuzz-override-names-step $state))))\n\n(= (_fuzz-override-names-finished $state)\n (unify $state (FuzzOverrideNames $options $reversed) False True))\n\n(= (_fuzz-override-names-step $state)\n (unify $state\n (FuzzOverrideNames $options $reversed)\n (if (== $options ())\n (reverse $reversed)\n (let ($option $rest) (decons-atom $options)\n (let $name (_fuzz-expression-head $option)\n (let $next (cons-atom $name $reversed)\n (FuzzOverrideNames $rest $next)))))\n $state))\n\n(= (_fuzz-options-without $options $names)\n (_fuzz-options-without-loop (FuzzOptionFilter $options $names ())))\n\n(= (_fuzz-options-without-loop $state)\n (if (_fuzz-options-without-finished $state)\n $state\n (_fuzz-options-without-loop (_fuzz-options-without-step $state))))\n\n(= (_fuzz-options-without-finished $state)\n (unify $state (FuzzOptionFilter $options $names $reversed) False True))\n\n(= (_fuzz-options-without-step $state)\n (unify $state\n (FuzzOptionFilter $options $names $reversed)\n (if (== $options ())\n (reverse $reversed)\n (let ($option $rest) (decons-atom $options)\n (let $name (_fuzz-expression-head $option)\n (if (is-member $name $names)\n (FuzzOptionFilter $rest $names $reversed)\n (let $next (cons-atom $option $reversed)\n (FuzzOptionFilter $rest $names $next))))))\n $state))\n\n; Merge overrides into an option record by replacement. An empty override list returns the record\n; unchanged, so the ordinary path allocates nothing. The expected head is a parameter because the two\n; record kinds differ only in that symbol: `fuzz-config` rejects a repeated option outright, while\n; `reach-config` folds last-wins, and replacement is right for both.\n(= (_fuzz-options-merged $head $record $overrides $code)\n (if (== $overrides ())\n $record\n (let $found (_fuzz-expression-head $record)\n (if (== $found $head)\n (let* (($options (cdr-atom $record))\n ($names (_fuzz-override-names $overrides))\n ($kept (_fuzz-options-without $options $names))\n ($merged (append $kept $overrides)))\n (cons-atom $head $merged))\n (FuzzInvalid $code (MalformedConfig (Value (quote $record))))))))\n\n(= (_fuzz-config-with-overrides $config $overrides)\n (_fuzz-options-merged fuzz-config $config $overrides InvalidConfig))\n\n(= (_fuzz-reach-config-with-overrides $config $overrides)\n (_fuzz-options-merged reach-config $config $overrides InvalidReachConfig))\n\n; ---------------------------------------------------------------------------\n; Running a suite\n;\n; Each result is paired with its test id so a host can report per-test without re-deriving identity\n; from the result atom.\n\n(= (fuzz-run-suite)\n (fuzz-run-suite-with ()))\n\n(= (fuzz-run-suite-with $overrides)\n (let $cases (_fuzz-suite-cases)\n (_fuzz-suite-loop (FuzzSuiteRun $cases $overrides Random ()))))\n\n(= (fuzz-run-suite-exhaustive $overrides)\n (let $cases (_fuzz-suite-cases)\n (_fuzz-suite-loop (FuzzSuiteRun $cases $overrides Exhaustive ()))))\n\n(= (_fuzz-suite-loop $state)\n (if (_fuzz-suite-finished $state)\n $state\n (_fuzz-suite-loop (_fuzz-suite-step $state))))\n\n(= (_fuzz-suite-finished $state)\n (unify $state (FuzzSuiteRun $cases $overrides $mode $reversed) False True))\n\n(= (_fuzz-suite-step $state)\n (unify $state\n (FuzzSuiteRun $cases $overrides $mode $reversed)\n (if (== $cases ())\n (reverse $reversed)\n (let ($case $rest) (decons-atom $cases)\n (let $result (_fuzz-suite-run-case $case $overrides $mode)\n (let $next (cons-atom $result $reversed)\n (FuzzSuiteRun $rest $overrides $mode $next)))))\n $state))\n\n(: _fuzz-suite-run-case (-> Atom Atom Atom %Undefined%))\n; The merged config is inspected with `unify`, not `switch`: switch evaluates its scrutinee, which\n; normalizes a `fuzz-config` expression into either a config record or a validation error, and an arm\n; matching that error would then report the pre-evaluation syntax instead of the error itself. unify\n; leaves the subject alone, so a merge that genuinely failed is caught here and an ordinary config\n; travels on to fuzz-check as syntax, which is what lets fuzz-check normalize and validate it.\n(= (_fuzz-suite-run-case $case $overrides $mode)\n (unify $case\n (FuzzTestCase $id $generator $property $config)\n (let $merged (_fuzz-config-with-overrides $config $overrides)\n (unify $merged\n (FuzzInvalid $code $details)\n (FuzzSuiteResult $id $merged)\n (let $result (_fuzz-suite-check $id $generator $property $merged $mode)\n (FuzzSuiteResult $id $result))))\n (FuzzSuiteResult Unknown (FuzzInvalid MalformedFuzzTest (Value (quote $case))))))\n\n; The generator reaches fuzz-check as syntax and is evaluated there, exactly as in a hand-written\n; query. Exhaustive mode swaps in fuzz-check-exhaustive and nothing else changes.\n(: _fuzz-suite-check (-> Atom Atom Atom Atom Atom %Undefined%))\n(= (_fuzz-suite-check $id $generator $property $config Random)\n (fuzz-check $id $generator $property $config))\n(= (_fuzz-suite-check $id $generator $property $config Exhaustive)\n (fuzz-check-exhaustive $id $generator $property $config))\n\n(: FuzzSuiteResult (-> Atom Atom Atom))\n\n; ---------------------------------------------------------------------------\n; Declared reachability searches\n;\n; The same data-declaration idea for bounded reachability:\n;\n; (FuzzReachTest counter (Count 0) counter-enumerate counter-transition counter-target\n; (reach-config (MaxDepth 20)))\n;\n; A search needs its own relations rather than a machine spec, because a transition that returns\n; several next states is the point of the search; a FuzzMachine's NextModel is single-valued.\n\n(: FuzzReachTest (-> Atom Atom Atom Atom Atom Atom Atom))\n(: FuzzReachCase (-> Atom Atom Atom Atom Atom Atom Atom))\n(: FuzzReachSuiteRun (-> Atom Atom Atom Atom))\n(: fuzz-run-reach-suite (-> %Undefined%))\n(: fuzz-run-reach-suite-with (-> Atom %Undefined%))\n(: fuzz-reach-suite-tests (-> %Undefined%))\n(: _fuzz-reach-suite-cases (-> %Undefined%))\n\n(= (_fuzz-reach-suite-cases)\n (collapse\n (match &self\n (FuzzReachTest $id $initial $enumerate $transition $target $config)\n (FuzzReachCase $id $initial $enumerate $transition $target $config))))\n\n(= (fuzz-reach-suite-tests)\n (let $cases (_fuzz-reach-suite-cases) $cases))\n\n(= (fuzz-run-reach-suite)\n (fuzz-run-reach-suite-with ()))\n\n(= (fuzz-run-reach-suite-with $overrides)\n (let $cases (_fuzz-reach-suite-cases)\n (_fuzz-reach-suite-loop (FuzzReachSuiteRun $cases $overrides ()))))\n\n(= (_fuzz-reach-suite-loop $state)\n (if (_fuzz-reach-suite-finished $state)\n $state\n (_fuzz-reach-suite-loop (_fuzz-reach-suite-step $state))))\n\n(= (_fuzz-reach-suite-finished $state)\n (unify $state (FuzzReachSuiteRun $cases $overrides $reversed) False True))\n\n(= (_fuzz-reach-suite-step $state)\n (unify $state\n (FuzzReachSuiteRun $cases $overrides $reversed)\n (if (== $cases ())\n (reverse $reversed)\n (let ($case $rest) (decons-atom $cases)\n (let $result (_fuzz-reach-suite-run-case $case $overrides)\n (let $next (cons-atom $result $reversed)\n (FuzzReachSuiteRun $rest $overrides $next)))))\n $state))\n\n; As in `_fuzz-suite-run-case`, the merged config is inspected with `unify` rather than `switch` so a\n; merge that failed is reported instead of being evaluated into something else.\n(: _fuzz-reach-suite-run-case (-> Atom Atom %Undefined%))\n(= (_fuzz-reach-suite-run-case $case $overrides)\n (unify $case\n (FuzzReachCase $id $initial $enumerate $transition $target $config)\n (let $merged (_fuzz-reach-config-with-overrides $config $overrides)\n (unify $merged\n (FuzzInvalid $code $details)\n (FuzzSuiteResult $id $merged)\n (let $result (fuzz-reachable $id $initial $enumerate $transition $target $merged)\n (FuzzSuiteResult $id $result))))\n (FuzzSuiteResult Unknown (FuzzInvalid MalformedFuzzReachTest (Value (quote $case))))))\n"; diff --git a/packages/fuzz/src/generator.test.ts b/packages/fuzz/src/generator.test.ts new file mode 100644 index 0000000..2054f8d --- /dev/null +++ b/packages/fuzz/src/generator.test.ts @@ -0,0 +1,665 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +describe("MeTTa fuzz generators", () => { + it("returns data errors for malformed constructor arguments", () => { + expect( + printed(` + !(gen-int 3 2) + !(gen-int 0.5 2) + !(gen-int-origin 0 3 1.5) + !(gen-element ()) + !(gen-frequency ((0 (gen-bool)))) + !(gen-list (gen-bool) 0.5 2) + !(gen-symbol-range 0 2) + !(gen-syntax-token-range 3 2) + !(gen-filter (gen-bool) is-even 1.5) + !(gen-resize 1.5 (gen-bool)) + `), + ).toEqual([ + ["()"], + ["(FuzzGenerationError InvalidIntegerBounds (Details (Bounds 3 2)))"], + ["(FuzzGenerationError ExpectedInteger (Details (Parameter LowerBound) (Value 0.5)))"], + ["(FuzzGenerationError ExpectedInteger (Details (Parameter Origin) (Value 1.5)))"], + ["(FuzzGenerationError EmptyElementSet (Details (Values ())))"], + ["(FuzzGenerationError InvalidFrequencyWeight (Details (Weight 0) (Generator (GenBool))))"], + ["(FuzzGenerationError ExpectedInteger (Details (Parameter MinimumLength) (Value 0.5)))"], + ["(FuzzGenerationError InvalidSymbolLengthBounds (Details (Minimum 0) (Maximum 2)))"], + ["(FuzzGenerationError InvalidTokenLengthBounds (Details (Minimum 3) (Maximum 2)))"], + ["(FuzzGenerationError ExpectedInteger (Details (Parameter MaximumAttempts) (Value 1.5)))"], + ["(FuzzGenerationError ExpectedInteger (Details (Parameter Size) (Value 1.5)))"], + ]); + }); + + it("freezes random samples and ordered edge candidates", () => { + const out = printed(` + !(fuzz-generate-random (gen-int -3 3) 42 5) + !(fuzz-generate-random (gen-int -3 3) 42 5) + !(fuzz-generate-edge (gen-int -3 3) 0 5) + !(fuzz-generate-edge (gen-int -3 3) 1 5) + !(fuzz-generate-edge (gen-int -3 3) 2 5) + !(fuzz-generate-edge (gen-int -3 3) 3 5) + !(fuzz-generate-edge (gen-int -3 3) 4 5) + !(fuzz-generate-edge (gen-int -3 3) 5 5) + `); + + expect(out[2]).toEqual(out[1]); + expect(out.slice(3).map((results) => results[0]!.split(" ")[1])).toEqual([ + "0", + "-3", + "3", + "-1", + "1", + "0", + ]); + }); + + it("uses enough input bytes to reach every integer offset", () => { + expect(printed("!(fuzz-generate-bytes (gen-int 0 70000) (1 2 3) 1)")[1]).toEqual([ + "(FuzzSample 66051 (FuzzDriver Bytes (BytesState (1 2 3) 3)) (Decision Int (Bounds 0 70000) (Origin 0) (Value 66051) ()))", + ]); + }); + + it("validates finite float bounds by exact IEEE-754 order", () => { + expect( + printed(` + !(gen-float) + !(gen-float-range -0.0 0.0) + !(gen-float-range 0.0 -0.0) + !(gen-float-range 1 2.0) + !(gen-float-range + (_fuzz-float64-from-bits 2146959360 23) + 2.0) + !(gen-float-range + (_fuzz-float64-from-bits 2146435072 0) + 2.0) + `).slice(1), + ).toEqual([ + ["(GenFloatRange -9218868437227405312 9218868437227405311 0)"], + ["(GenFloatRange -1 0 0)"], + ["(FuzzGenerationError InvalidFloatBounds (Details (Bounds 0.0 -0.0)))"], + ["(FuzzGenerationError ExpectedFloat (Details (Parameter LowerBound) (Value 1)))"], + ["(FuzzGenerationError NaNFloatBound (Details (Parameter LowerBound) (Value NaN)))"], + [ + "(FuzzGenerationError NonFiniteFloatBound (Details (Parameter LowerBound) (Value Infinity)))", + ], + ]); + }); + + it("enumerates both signed zeros in their IEEE-754 order", () => { + const results = printed(` + !(fuzz-enumerate + (gen-float-range -0.0 0.0) + 16 + 1) + `)[1]!; + expect(results).toHaveLength(1); + const enumeration = results[0]!; + expect(enumeration).toMatch( + /^\(FuzzEnumeration \(DomainCount 2\) \(Enumerated 2\) \(GenerationDiscards 0\)/, + ); + expect([...enumeration.matchAll(/\(FuzzSample (-?0\.0) /g)].map((match) => match[1])).toEqual([ + "-0.0", + "0.0", + ]); + expect(enumeration).toContain("(Decision Int (Bounds -1 0) (Origin 0) (Value -1) ())"); + expect(enumeration).toContain("(Decision Int (Bounds -1 0) (Origin 0) (Value 0) ())"); + }); + + it("covers declared IEEE-754 edge payloads for the full-bit generator", () => { + const expected = [ + [0, 0], + [2147483648, 0], + [1072693248, 0], + [3220176896, 0], + [0, 1], + [2147483648, 1], + [2146435071, 4294967295], + [4293918719, 4294967295], + [2146435072, 0], + [4293918720, 0], + [2146959360, 0], + [4294443008, 0], + [2146435072, 1], + [4293918720, 1], + [2146959360, 23], + [4294443008, 23], + [1048576, 0], + [2148532224, 0], + [1048575, 4294967295], + [2148532223, 4294967295], + ]; + const queries = expected + .map( + (_, index) => ` + !(let (FuzzSample $value $driver $tree) + (fuzz-generate-edge (gen-float-bits) ${index} 1) + (_fuzz-float64-bits $value))`, + ) + .join("\n"); + const results = printed(queries).slice(1); + expect(results).toEqual(expected.map(([high, low]) => [`(Float64Bits ${high} ${low})`])); + }); + + it("covers ordered finite-float boundaries before random generation", () => { + const expected = [ + [0, 0], + [4293918719, 4294967295], + [2146435071, 4294967295], + [2147483648, 0], + [0, 1], + [2147483648, 1], + [2148532223, 4294967295], + [2148532224, 0], + [1048575, 4294967295], + [1048576, 0], + [3220176896, 0], + [1072693248, 0], + ]; + const queries = expected + .map( + (_, index) => ` + !(let (FuzzSample $value $driver $tree) + (fuzz-generate-edge (gen-float) ${index} 1) + (_fuzz-float64-bits $value))`, + ) + .join("\n"); + const results = printed(queries).slice(1); + expect(results).toEqual(expected.map(([high, low]) => [`(Float64Bits ${high} ${low})`])); + }); + + it("replays arbitrary full-bit floats through integer decisions", () => { + expect( + printed(` + !(let $generated + (fuzz-generate-bytes + (gen-float-bits) + (127 248 0 0 0 0 0 23) + 1) + (switch $generated + (((FuzzSample $value $driver $tree) + (let $replayed + (fuzz-replay (gen-float-bits) $tree 1) + (switch $replayed + (((FuzzSample $replay-value $replay-driver $replay-tree) + (FloatReplay + (_fuzz-replay-equal $value $replay-value) + (_fuzz-replay-equal $tree $replay-tree) + (_fuzz-float64-bits $replay-value))) + ($bad $bad))))) + ($bad $bad)))) + `)[1], + ).toEqual(["(FloatReplay True True (Float64Bits 2146959360 23))"]); + }); + + it("generates explicit character classes, structural strings, and parser-safe symbols", () => { + const out = printed(` + !(fuzz-generate-edge (gen-char) 0 1) + !(fuzz-generate-edge (gen-char-ascii) 1 1) + !(fuzz-generate-edge (gen-char-unicode) 1 1) + !(fuzz-generate-bytes + (gen-string + (gen-element (a b)) + 2 + 2) + (0 1 0) + 2) + !(fuzz-generate-bytes + (gen-symbol-range 3 3) + (0 0 1 0) + 3) + !(fuzz-generate-bytes + (gen-syntax-token-range 3 3) + (0 0 1 2) + 3) + `); + + expect(out[1]![0]).toMatch(/^\(FuzzSample ( |~) /); + expect(out[2]![0]).toContain("(FuzzSample  "); + expect(out[3]![0]).toContain("(FuzzSample 􏿿 "); + expect(out[4]![0]).toContain('(FuzzSample "ba" '); + expect(out[5]![0]).toMatch(/^\(FuzzSample [a-z_][A-Za-z0-9_+*/<>=!?-]{2} /); + expect(out[6]![0]).toMatch(/^\(FuzzSample "[^()\\";\\s]{3}" /); + }); + + it("replays and shrinks string and symbol decisions through their source generators", () => { + const out = printed(` + !(let $generated + (fuzz-generate-random + (gen-unicode-string 0 8) + 971 + 8) + (switch $generated + (((FuzzSample $value $driver $tree) + (let $replayed + (fuzz-replay + (gen-unicode-string 0 8) + $tree + 8) + (switch $replayed + (((FuzzSample $replay-value $next $replay-tree) + (TextReplay + (_fuzz-replay-equal $value $replay-value) + (_fuzz-replay-equal $tree $replay-tree))) + ($bad $bad))))) + ($bad $bad)))) + !(_fuzz-shrink-replay + (gen-symbol-range 1 8) + (Decision Map (Function _fuzz-symbol-from-parts) () + ((Decision Tuple (Count 2) () + ((Decision Element (Count 27) (Index 13) + ((Decision Int (Bounds 0 26) (Origin 0) (Value 13) ()))) + (Decision List (Bounds 0 7) (Length 0) + ((Decision Int (Bounds 0 4) (Origin 0) (Value 0) ()))))))) + 8) + `); + + expect(out[1]).toEqual(["(TextReplay True True)"]); + expect(out[2]![0]).toMatch(/^\(FuzzShrinkReplay [a-z_] /); + }); + + it("enumerates the Cartesian decision domain in stable order", () => { + const results = printed("!(fuzz-enumerate (gen-tuple ((gen-int 0 1) (gen-bool))) 16 2)")[1]!; + expect(results).toHaveLength(1); + const enumeration = results[0]!; + expect(enumeration).toMatch( + /^\(FuzzEnumeration \(DomainCount 4\) \(Enumerated 4\) \(GenerationDiscards 0\)/, + ); + expect( + [...enumeration.matchAll(/\(FuzzSample (\([^)]*\)) /g)].map((match) => match[1]), + ).toEqual(["(0 False)", "(0 True)", "(1 False)", "(1 True)"]); + expect( + printed( + "!(fuzz-generate (gen-tuple ((gen-int 0 1) (gen-bool))) (fuzz-exhaustive-driver) 2)", + )[1], + ).toEqual([ + "(FuzzSample (0 False) (FuzzDriver Exhaustive (ExhaustiveCursor () 2 ((ExhaustiveFrame 0 2) (ExhaustiveFrame 0 2)))) (Decision Tuple (Count 2) () ((Decision Int (Bounds 0 1) (Origin 0) (Value 0) ()) (Decision Bool (Count 2) (Value False) ((Decision Int (Bounds 0 1) (Origin 0) (Value 0) ()))))))", + ]); + }); + + it("shares weighted and custom generation across drivers", () => { + const out = printed(` + (= (CustomCapabilities Tagged ($tag)) + (FuzzCustomCapabilities + (Modes + (Random + Edge + Replay + ShrinkReplay + Exhaustive + Bytes)))) + (= (DriveCustom Tagged ($tag) $driver $size) + (fuzz-generate + (gen-map add-tag (gen-int 2 2)) + $driver + $size)) + (= (add-tag $value) (tagged $value)) + !(fuzz-enumerate + (gen-frequency + ((1 (gen-const first)) + (2 (gen-const second)))) + 16 + 1) + !(fuzz-generate-edge (gen-custom Tagged (tag)) 0 1) + !(fuzz-generate-edge (gen-custom Missing ()) 0 1) + `); + + expect(out[1]).toHaveLength(1); + expect(out[1]![0]).toMatch( + /^\(FuzzEnumeration \(DomainCount 2\) \(Enumerated 2\) \(GenerationDiscards 0\)/, + ); + expect([...out[1]![0]!.matchAll(/\(FuzzSample ([^ ]+) /g)].map((match) => match[1])).toEqual([ + "first", + "second", + ]); + expect(out[2]![0]).toMatch(/^\(FuzzSample \(tagged 2\) /); + expect(out[3]).toEqual([ + "(FuzzGenerationError MissingCustomCapabilities (Details (Name Missing) (Arguments ())))", + ]); + }); + + it("validates custom capabilities and deterministic callback cardinality", () => { + expect( + printed(` + (= (CustomCapabilities RandomOnly ()) + (FuzzCustomCapabilities + (Modes (Random Replay ShrinkReplay)))) + (= (DriveCustom RandomOnly () $driver $size) + (fuzz-generate + (gen-const value) + $driver + $size)) + (= (CustomCapabilities BadModes ()) + (FuzzCustomCapabilities + (Modes (Random Replay Replay ShrinkReplay)))) + (= (CustomCapabilities Ambiguous ()) + (FuzzCustomCapabilities + (Modes (Random Replay ShrinkReplay)))) + (= (CustomCapabilities Ambiguous ()) + (FuzzCustomCapabilities + (Modes (Edge Replay ShrinkReplay)))) + (= (CustomCapabilities Many ()) + (FuzzCustomCapabilities + (Modes (Random Replay ShrinkReplay)))) + (= (DriveCustom Many () $driver $size) + (fuzz-generate + (gen-const first) + $driver + $size)) + (= (DriveCustom Many () $driver $size) + (fuzz-generate + (gen-const second) + $driver + $size)) + !(fuzz-generate-edge + (gen-custom RandomOnly ()) + 0 + 1) + !(fuzz-generate-random + (gen-custom BadModes ()) + 0 + 1) + !(fuzz-generate-random + (gen-custom Ambiguous ()) + 0 + 1) + !(fuzz-generate-random + (gen-custom Many ()) + 0 + 1) + `).slice(1), + ).toEqual([ + ["(FuzzGenerationError UnsupportedCustomDriver (Details (Name RandomOnly) (Mode Edge)))"], + [ + "(FuzzGenerationError InvalidCustomCapabilities (Details (Name BadModes) (Modes (Random Replay Replay ShrinkReplay))))", + ], + [ + "(FuzzGenerationError AmbiguousCustomCapabilities (Details (Name Ambiguous) (Results ((FuzzCustomCapabilities (Modes (Random Replay ShrinkReplay))) (FuzzCustomCapabilities (Modes (Edge Replay ShrinkReplay)))))))", + ], + [ + "(FuzzGenerationError AmbiguousCustomGenerator (Details (Name Many) (Mode Random) (Results ((FuzzSample first (FuzzDriver Random (FuzzRng xorshift128plus-v1 -1 -1 0 0)) (Decision Const () (Value first) ())) (FuzzSample second (FuzzDriver Random (FuzzRng xorshift128plus-v1 -1 -1 0 0)) (Decision Const () (Value second) ()))))))", + ], + ]); + }); + + it("replays declared custom edge choices before accepting them", () => { + const result = printed(` + (= (CustomCapabilities Seven ()) + (FuzzCustomCapabilities + (Modes + (Random + Edge + Replay + ShrinkReplay + Exhaustive + Bytes)))) + (= (DriveCustom Seven () $driver $size) + (fuzz-generate + (gen-int 0 10) + $driver + $size)) + (= (EdgeChoices Seven () $size) + (CustomEdgeChoices + ((Decision Int + (Bounds 0 10) + (Origin 0) + (Value 7) + ())))) + !(fuzz-generate-edge + (gen-custom Seven ()) + 0 + 1) + `)[1]![0]!; + + expect(result).toMatch(/^\(FuzzSample 7 \(FuzzDriver Edge 1\)/); + expect(result).toContain( + "(Decision Custom (CustomGenerator (Name Seven) (Arguments ())) () ((Decision Int (Bounds 0 10) (Origin 0) (Value 7) ())))", + ); + }); + + it("enumerates dependent generator domains exactly", () => { + const results = printed(` + (= (dependent-branch False) (gen-const only)) + (= (dependent-branch True) (gen-bool)) + !(fuzz-enumerate (gen-bind (gen-bool) dependent-branch) 16 1) + !(fuzz-enumerate (gen-const lone) 1 0) + `); + expect(results[1]).toHaveLength(1); + const enumeration = results[1]![0]!; + expect(enumeration).toMatch( + /^\(FuzzEnumeration \(DomainCount 3\) \(Enumerated 3\) \(GenerationDiscards 0\)/, + ); + expect([...enumeration.matchAll(/\(FuzzSample ([^ ]+) /g)].map((match) => match[1])).toEqual([ + "only", + "False", + "True", + ]); + expect(results[2]![0]).toMatch(/^\(FuzzEnumeration \(DomainCount 1\) \(Enumerated 1\)/); + }); + + it("counts filter discards and truncates at the enumeration limit", () => { + const results = printed(` + (= (even-only $x) (== (% $x 2) 0)) + !(fuzz-enumerate (gen-filter (gen-int 0 3) even-only 8) 16 1) + `)[1]!; + expect(results).toHaveLength(1); + expect(results[0]).toMatch( + /^\(FuzzEnumerationTruncated \(Enumerated 16\) \(DomainCount 12\) \(GenerationDiscards 4\)/, + ); + }); + + it("composes tuple, list, option, map, bind, and sized generators", () => { + expect( + printed(` + (= (inc $x) (+ $x 1)) + (= (dependent $x) (gen-int $x (+ $x 2))) + (= (at-size $size) (gen-int $size $size)) + !(fuzz-generate-bytes + (gen-tuple + ((gen-list (gen-int 0 2) 2 2) + (gen-option (gen-map inc (gen-int 0 2))) + (gen-bind (gen-int 1 1) dependent) + (gen-sized at-size))) + (0 0 1 1 0 0 2 0) + 6) + `)[1]![0], + ).toMatch(/^\(FuzzSample \(\(0 1\) \(Some 1\) 3 1\) /); + }); + + it("bounds filter retries and distinguishes discard from errors", () => { + expect( + printed(` + (= (never $value) False) + !(fuzz-generate-edge (gen-filter (gen-int 1 1) never 2) 0 3) + `)[1], + ).toEqual([ + "(FuzzGenerationDiscard (FilterExhausted (MaximumAttempts 2)) (FuzzDriver Edge 2) (Decision Filter (MaximumAttempts 2) (Attempts 2) ((Decision Int (Bounds 1 1) (Origin 1) (Value 1) ()) (Decision Int (Bounds 1 1) (Origin 1) (Value 1) ()))))", + ]); + }); + + it("strictly decreases recursive size and always reaches the base generator", () => { + const result = printed(` + (= (recur $self) $self) + !(fuzz-generate-edge + (gen-recursive (gen-const leaf) recur) + 0 + 3) + `)[1]![0]!; + + expect(result).toMatch(/^\(FuzzSample leaf /); + expect(result).toContain("(Decision Recursive (Size 3) (Branch Step)"); + expect(result).toContain("(Decision Recursive (Size 2) (Branch Step)"); + expect(result).toContain("(Decision Recursive (Size 1) (Branch Step)"); + expect(result).toContain("(Decision Recursive (Size 0) (Branch Base)"); + }); + + it("reports a recursive generator whose base is not a generator", () => { + expect( + printed(` + (= (recur $self) $self) + !(fuzz-generate-edge (gen-recursive missing recur) 0 0) + `)[1], + ).toEqual(["(FuzzGenerationError MalformedGenerator (Details (Generator missing)))"]); + }); + + it("rejects zero-result and nondeterministic generator callbacks", () => { + expect( + printed(` + (= (none $x) (empty)) + (= (many $x) $x) + (= (many $x) (+ $x 1)) + !(fuzz-generate-random (gen-map none (gen-const 1)) 0 1) + !(fuzz-generate-random (gen-map many (gen-const 1)) 0 1) + `).slice(1), + ).toEqual([ + ["(FuzzGenerationError FunctionReturnedNoResults (Details (MapFunction none)))"], + [ + "(FuzzGenerationError FunctionReturnedMultipleResults (Details (MapFunction many) (Results (1 2))))", + ], + ]); + }); + + it("replays a generated value and decision tree exactly", () => { + const result = printed(` + !(let $generated + (fuzz-generate-random + (gen-tuple ((gen-int -2 2) (gen-option (gen-bool)))) + 17 + 5) + (switch $generated + (((FuzzSample $value $driver $tree) + (let $replayed + (fuzz-replay + (gen-tuple ((gen-int -2 2) (gen-option (gen-bool)))) + $tree + 5) + (switch $replayed + (((FuzzSample $replay-value $replay-driver $replay-tree) + (ReplayIdentity + (== $value $replay-value) + (== $tree $replay-tree))) + ($bad $bad))))) + ($bad $bad)))) + `)[1]; + + expect(result).toEqual(["(ReplayIdentity True True)"]); + }); + + it("replays signed zero and NaN payloads without using language equality", () => { + expect( + printed(` + !(let $negative-zero (_fuzz-float64-from-bits 2147483648 0) + (let $generated + (fuzz-generate-random (gen-const $negative-zero) 7 1) + (switch $generated + (((FuzzSample $value $driver $tree) + (let $replayed (fuzz-replay (gen-const $negative-zero) $tree 1) + (switch $replayed + (((FuzzSample $replay-value $replay-driver $replay-tree) + (ReplayFloat + (_fuzz-replay-equal $value $replay-value) + (_fuzz-replay-equal $tree $replay-tree) + (_fuzz-float64-bits $replay-value))) + ($bad $bad))))) + ($bad $bad))))) + !(let $nan (_fuzz-float64-from-bits 2146959360 23) + (let $generated + (fuzz-generate-random (gen-const $nan) 7 1) + (switch $generated + (((FuzzSample $value $driver $tree) + (let $replayed (fuzz-replay (gen-const $nan) $tree 1) + (switch $replayed + (((FuzzSample $replay-value $replay-driver $replay-tree) + (ReplayFloat + (_fuzz-replay-equal $value $replay-value) + (_fuzz-replay-equal $tree $replay-tree) + (_fuzz-float64-bits $replay-value))) + ($bad $bad))))) + ($bad $bad))))) + `).slice(1), + ).toEqual([ + ["(ReplayFloat True True (Float64Bits 2147483648 0))"], + ["(ReplayFloat True True (Float64Bits 2146959360 23))"], + ]); + }); + + it("repairs missing and dependency-invalidated shrink decisions", () => { + expect( + printed(` + (= (dependent $source) + (gen-int $source (+ $source 2))) + !(_fuzz-shrink-replay + (gen-bind (gen-int 0 5) dependent) + (Decision Bind (Function dependent) () + ((Decision Int (Bounds 0 5) (Origin 0) (Value 0) ()) + (Decision Int (Bounds 5 7) (Origin 5) (Value 7) ()))) + 4) + !(_fuzz-shrink-replay + (gen-tuple ((gen-int 1 3) (gen-int -2 2))) + (Decision Tuple (Count 2) () + ((Decision Int (Bounds 1 3) (Origin 1) (Value 2) ()))) + 2) + `).slice(1), + ).toEqual([ + [ + "(FuzzShrinkReplay 0 (Decision Bind (Function dependent) () ((Decision Int (Bounds 0 5) (Origin 0) (Value 0) ()) (Decision Int (Bounds 0 2) (Origin 0) (Value 0) ()))))", + ], + [ + "(FuzzShrinkReplay (2 0) (Decision Tuple (Count 2) () ((Decision Int (Bounds 1 3) (Origin 1) (Value 2) ()) (Decision Int (Bounds -2 2) (Origin 0) (Value 0) ()))))", + ], + ]); + }); + + it("reports stale, trailing, malformed, and out-of-range replay decisions", () => { + expect( + printed(` + !(fuzz-replay + (gen-int 0 2) + (Decision Int (Bounds 0 3) (Origin 0) (Value 1) ()) + 1) + !(fuzz-replay + (gen-int 0 2) + (Decision Tuple (Count 2) () + ((Decision Int (Bounds 0 2) (Origin 0) (Value 1) ()) + (Decision Int (Bounds 0 1) (Origin 0) (Value 0) ()))) + 1) + !(fuzz-replay + (gen-int 0 2) + (Decision Int (Bounds 0 2) (Origin 0) (Value 3) ()) + 1) + !(fuzz-replay (gen-int 0 2) malformed 1) + `).slice(1), + ).toEqual([ + [ + "(FuzzGenerationError ReplayMismatch (Details (Path 0) (ExpectedBounds 0 2) (ActualBounds 0 3) (Origins 0 0)))", + ], + [ + "(FuzzGenerationError TrailingReplayDecisions (Details (Path 1) (Remaining ((Decision Int (Bounds 0 1) (Origin 0) (Value 0) ())))))", + ], + ["(FuzzGenerationError ReplayValueOutOfBounds (Details (Path 0) (Bounds 0 2) (Value 3)))"], + ["(FuzzGenerationError MalformedDecisionTree (Details (Decision malformed)))"], + ]); + }); + + // Collection generators must scale: a thousand-element list is an ordinary request of a fuzz + // library. This used to fail around 250 elements while allocating gigabytes, from two separate + // causes - _fuzz-repeat-generator built its list by recurse-then-cons, and the prelude's `let*` + // was wrongly admitted to automatic tabling, which made every accumulator step quadratic. Both + // are fixed; this pins the linear behaviour at the DEFAULT depth and step budgets. + it("generates and replays a thousand-element list", () => { + const out = printed(` + !(let $sample (fuzz-generate-random (gen-list (gen-const x) 1000 1000) 7 1000) + (unify $sample + (FuzzSample $value $driver $tree) + (Length (size-atom $value)) + (Failed $sample))) + `); + + expect(out.at(-1)![0]).toBe("(Length 1000)"); + }, 120_000); +}); diff --git a/packages/fuzz/src/grammar.test.ts b/packages/fuzz/src/grammar.test.ts new file mode 100644 index 0000000..d916572 --- /dev/null +++ b/packages/fuzz/src/grammar.test.ts @@ -0,0 +1,985 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +function sampleValue(result: string): string { + const match = /^\(FuzzSample ([^ ]+)/.exec(result); + if (match === null) throw new Error(`expected a FuzzSample: ${result}`); + return match[1]!; +} + +// Splits "(Head item ...)" into its balanced top-level items, string-aware. +function topLevelItems(expression: string): string[] { + if (!expression.startsWith("(") || !expression.endsWith(")")) + throw new Error(`expected a parenthesized expression: ${expression}`); + const inner = expression.slice(1, -1); + const items: string[] = []; + let depth = 0; + let start = 0; + let inString = false; + for (let i = 0; i < inner.length; i += 1) { + const ch = inner[i]!; + if (inString) { + if (ch === "\\") i += 1; + else if (ch === '"') inString = false; + continue; + } + if (ch === '"') inString = true; + else if (ch === "(") depth += 1; + else if (ch === ")") depth -= 1; + else if (ch === " " && depth === 0) { + if (i > start) items.push(inner.slice(start, i)); + start = i + 1; + } + } + if (depth !== 0) throw new Error(`unbalanced expression: ${expression}`); + if (start < inner.length) items.push(inner.slice(start)); + return items; +} + +function sampleTree(result: string): string { + const items = topLevelItems(result); + if (items[0] !== "FuzzSample" || items.length !== 4) + throw new Error(`expected a FuzzSample: ${result}`); + return items[3]!; +} + +describe("MeTTa grammar and type-directed generators", () => { + it("treats grammar templates and type constructors as syntax data", () => { + const out = printed(` + !(bind! &grammar-counter (new-state 0)) + (= (Ctor $x) + (let $seen (get-state &grammar-counter) + (let $changed + (change-state! &grammar-counter (+ $seen 1)) + (reduced $x)))) + (FuzzGrammar SyntaxData + (Productions + ((Production 1 SyntaxData (Ctor leaf))))) + !(get-state &grammar-counter) + !(gen-grammar SyntaxData) + !(get-state &grammar-counter) + !(fuzz-generate-edge + (gen-grammar SyntaxData) + 0 + 0) + !(get-state &grammar-counter) + (FuzzGrammar LiteralSyntaxData + (Productions + ((Production 1 LiteralSyntaxData + (Literal (Ctor leaf)))))) + !(gen-grammar LiteralSyntaxData) + !(get-state &grammar-counter) + (= (FuzzTypeSchema SyntaxType Num) + (FuzzTypeConstructors + ((Constructor 1 Num (Ctor leaf))))) + !(gen-well-typed SyntaxType Num) + !(get-state &grammar-counter) + !(fuzz-generate-edge + (gen-well-typed SyntaxType Num) + 0 + 0) + !(get-state &grammar-counter) + `); + + expect(out[2]).toEqual(["0"]); + expect(out[3]![0]).toContain("(GrammarProduction 0 1 (quote SyntaxData) (quote (Ctor leaf)))"); + expect(out[4]).toEqual(["0"]); + expect(out[5]![0]).toMatch(/^\(FuzzSample \(Ctor leaf\) /); + expect(out[6]).toEqual(["0"]); + expect(out[7]![0]).toContain( + "(GrammarProduction 0 1 (quote LiteralSyntaxData) (quote (Literal (Ctor leaf))))", + ); + expect(out[8]).toEqual(["0"]); + expect(out[9]![0]).toContain("(GrammarProduction 0 1 (quote Num) (quote (Ctor leaf)))"); + expect(out[10]).toEqual(["0"]); + expect(out[11]![0]).toMatch(/^\(FuzzSample \(Ctor leaf\) /); + expect(out[12]).toEqual(["0"]); + }); + + it("treats nonterminal names and type terms as syntax data", () => { + const out = printed(` + !(bind! &target-counter (new-state 0)) + (= (NT $x) + (let $seen (get-state &target-counter) + (let $changed + (change-state! &target-counter (+ $seen 1)) + (ReducedNT $x)))) + (FuzzGrammar TargetSyntax + (Productions + ((Production 1 (NT A) (Ref (NT B))) + (Production 1 (NT B) leaf)))) + !(get-state &target-counter) + !(gen-grammar-root TargetSyntax (NT A)) + !(get-state &target-counter) + !(fuzz-generate-edge + (gen-grammar-root TargetSyntax (NT A)) + 0 + 1) + !(get-state &target-counter) + !(bind! &type-counter (new-state 0)) + (= (Ty $x) + (let $seen (get-state &type-counter) + (let $changed + (change-state! &type-counter (+ $seen 1)) + (ReducedTy $x)))) + (= (FuzzTypeSchema TypeSyntax (Ty A)) + (FuzzTypeConstructors + ((Constructor 1 (Ty A) typed)))) + !(gen-well-typed TypeSyntax (Ty A)) + !(get-state &type-counter) + !(fuzz-generate-edge + (gen-well-typed TypeSyntax (Ty A)) + 0 + 0) + !(get-state &type-counter) + (= (FuzzTypeSchema WrongType Num) + (FuzzTypeConstructors + ((Constructor 1 (Ty B) nope)))) + !(gen-well-typed WrongType Num) + !(get-state &type-counter) + !(gen-grammar-root TargetSyntax $open-root) + !(gen-well-typed TypeSyntax $open-type) + (= (FuzzTypeSchema OpenResult Num) + (FuzzTypeConstructors + ((Constructor 1 $open-result nope)))) + !(gen-well-typed OpenResult Num) + `); + + expect(out[2]).toEqual(["0"]); + expect(out[3]![0]).toContain( + "(GrammarProduction 0 1 (quote (NT A)) (quote (_FuzzGrammarRef (NT B) 0 1)))", + ); + expect(out[4]).toEqual(["0"]); + expect(out[5]![0]).toMatch(/^\(FuzzSample leaf /); + expect(out[6]).toEqual(["0"]); + expect(out[8]![0]).toContain("(GrammarProduction 0 1 (quote (Ty A)) (quote typed))"); + expect(out[9]).toEqual(["0"]); + expect(out[10]![0]).toMatch(/^\(FuzzSample typed /); + expect(out[10]![0]).toContain("(Target (quote (Ty A)))"); + expect(out[11]).toEqual(["0"]); + expect(out[12]).toEqual([ + "(FuzzGenerationError TypeConstructorResultMismatch (Details (Schema WrongType) (RequestedType (quote Num)) (ConstructorType (quote (Ty B))) (ConstructorIndex 0)))", + ]); + expect(out[13]).toEqual(["0"]); + expect(out[14]![0]).toContain("NonGroundGrammarRoot"); + expect(out[15]![0]).toContain("NonGroundTypeSchemaRequest"); + expect(out[16]![0]).toContain("NonGroundTypeConstructorResult"); + }); + + it("preserves reducible scope metadata as syntax data", () => { + const out = printed(` + !(bind! &scope-counter (new-state 0)) + (= (SortCtor $x) + (let $seen (get-state &scope-counter) + (let $changed + (change-state! &scope-counter (+ $seen 1)) + (reduced $x)))) + (FuzzGrammar SortGrammar + (Productions + ((Production 1 SortGrammar + (Scoped + ((Binding (SortCtor Name) 0)) + (Use (SortCtor Name))))))) + !(gen-grammar SortGrammar) + !(get-state &scope-counter) + !(fuzz-generate-edge + (gen-grammar SortGrammar) + 0 + 0) + !(get-state &scope-counter) + `); + + expect(out[2]![0]).toContain("(Binding (SortCtor Name) 0)"); + expect(out[3]).toEqual(["0"]); + expect(out[4]![0]).toMatch(/^\(FuzzSample \$fuzz-0 /); + expect(out[4]![0]).toContain("(Sort (quote (SortCtor Name)))"); + expect(out[4]![0]).not.toContain("(reduced Name)"); + expect(out[5]).toEqual(["0"]); + }); + + it("collapses and freezes every Field descriptor exactly once", () => { + const out = printed(` + (= (ambiguous-field) (gen-int 0 1)) + (= (ambiguous-field) (gen-bool)) + (FuzzGrammar AmbiguousField + (Productions + ((Production 1 AmbiguousField + (Field (ambiguous-field)))))) + !(gen-grammar AmbiguousField) + (= (FuzzTypeSchema AmbiguousFieldType Num) + (FuzzTypeConstructors + ((Constructor 1 Num + (Field (ambiguous-field)))))) + !(gen-well-typed AmbiguousFieldType Num) + `); + + expect(out[1]).toEqual([ + "(FuzzGenerationError AmbiguousGrammarFieldGenerator (Details (Expression (quote (ambiguous-field))) (Results ((GenInt 0 1 0) (GenBool)))))", + ]); + expect(out[2]).toEqual(out[1]); + }); + + it("rejects grammar Field callbacks that change during replay", () => { + const out = printed(` + !(bind! &callback-counter (new-state 0)) + (= (tick $unit) + (let $seen (get-state &callback-counter) + (let $changed + (change-state! &callback-counter (+ $seen 1)) + $seen))) + (= (field-generator) + (gen-map tick (gen-const unit))) + (FuzzGrammar StatefulField + (Productions + ((Production 1 StatefulField + (Field (field-generator)))))) + !(fuzz-generate-edge + (gen-grammar StatefulField) + 0 + 0) + !(get-state &callback-counter) + `); + + expect(out[2]![0]).toContain("(FuzzGenerationError CustomReplayMismatch"); + expect(out[2]![0]).toContain("(Original (FuzzSample 0 "); + expect(out[2]![0]).toContain("(Replay (FuzzSample 1 "); + expect(out[3]).toEqual(["2"]); + }); + + it("rejects private variable markers forged by Field callbacks", () => { + const out = printed(` + (= (forge-marker $unit) + (pair safe (_fuzz-variable-marker 99))) + (= (forged-field) + (gen-map forge-marker (gen-const unit))) + (FuzzGrammar ForgedField + (Productions + ((Production 1 ForgedField + (Field (forged-field)))))) + !(fuzz-generate-edge + (gen-grammar ForgedField) + 0 + 0) + `); + + expect(out[1]![0]).toContain("(FuzzGenerationError ForgedGrammarVariableMarker"); + expect(out[1]![0]).toContain("(Generator (GenMap forge-marker"); + expect(out[1]![0]).not.toContain("(FuzzSample "); + }); + + it("validates grammar declarations before constructing a generator", () => { + const out = printed(` + !(gen-grammar Missing) + (FuzzGrammar Ambiguous + (Productions + ((Production 1 Ambiguous first)))) + (FuzzGrammar Ambiguous + (Productions + ((Production 1 Ambiguous second)))) + !(gen-grammar Ambiguous) + (FuzzGrammar BadWeight + (Productions + ((Production 0 BadWeight value)))) + !(gen-grammar BadWeight) + (FuzzGrammar MissingRef + (Productions + ((Production 1 MissingRef (Ref Else))))) + !(gen-grammar MissingRef) + (FuzzGrammar Loop + (Productions + ((Production 1 Loop (Ref Loop))))) + !(gen-grammar Loop) + (FuzzGrammar BadTemplate + (Productions + ((Production 1 BadTemplate (Field))))) + !(gen-grammar BadTemplate) + (FuzzGrammar BadScope + (Productions + ((Production 1 BadScope + (Scoped + ((Binding Name 0) + (Binding Name 0)) + (Use Name)))))) + !(gen-grammar BadScope) + (FuzzGrammar OtherRoot + (Productions + ((Production 1 Other value)))) + !(gen-grammar-root OtherRoot Root) + `); + + expect(out.slice(1)).toEqual([ + ["(FuzzGenerationError MissingGrammar (Details (Grammar Missing)))"], + [ + "(FuzzGenerationError AmbiguousGrammar (Details (Grammar Ambiguous) (Results ((quote ((Production 1 Ambiguous first))) (quote ((Production 1 Ambiguous second)))))))", + ], + [ + "(FuzzGenerationError InvalidGrammarProductionWeight (Details (Grammar BadWeight) (ProductionIndex 0) (Weight 0)))", + ], + [ + "(FuzzGenerationError MissingGrammarNonterminal (Details (Grammar MissingRef) (Nonterminal (quote Else))))", + ], + [ + "(FuzzGenerationError UnproductiveGrammarNonterminal (Details (Grammar Loop) (Nonterminal (quote Loop))))", + ], + [ + "(FuzzGenerationError MalformedGrammarTemplate (Details (Grammar BadTemplate) (Template (quote (Field)))))", + ], + ["(FuzzGenerationError DuplicateGrammarBindingId (Details (BindingId 0)))"], + [ + "(FuzzGenerationError MissingGrammarRoot (Details (Grammar OtherRoot) (Root (quote Root))))", + ], + ]); + }); + + it("checks productivity with lexical binder requirements", () => { + const out = printed(` + (FuzzGrammar LexicalLoop + (Productions + ((Production 1 LexicalLoop (Ref LexicalLoop)) + (Production 1 LexicalLoop (Use Name))))) + !(gen-grammar LexicalLoop) + (FuzzGrammar BoundBody + (Productions + ((Production 1 Root + (lambda (Bind Name (Ref Body)))) + (Production 1 Body (Use Type)) + (Production 1 Body (Use Name))))) + !(gen-grammar-root BoundBody Root) + !(fuzz-generate-edge + (gen-grammar-root BoundBody Root) + 0 + 1) + `); + + expect(out[1]).toEqual([ + "(FuzzGenerationError UnproductiveGrammarNonterminal (Details (Grammar LexicalLoop) (Nonterminal (quote LexicalLoop))))", + ]); + expect(out[2]![0]).toContain("(GrammarRequest"); + expect(out[3]![0]).toMatch(/^\(FuzzSample \(lambda \(\$fuzz-0 \$fuzz-0\)\) /); + }); + + it("normalizes multiple scoped bindings before recursive validation", () => { + const out = printed(` + (FuzzGrammar MultiScope + (Productions + ((Production 1 MultiScope + (Scoped + ((Binding Name 0) + (Binding Type 1)) + (pair (Use Name) (Use Type))))))) + !(_fuzz-validate-grammar-bindings + ((Binding Name 0) + (Binding Type 1))) + !(gen-grammar MultiScope) + !(fuzz-generate-edge + (gen-grammar MultiScope) + 0 + 0) + `); + + expect(out[1]![0]).toContain("(GrammarBinding (quote Name) 0) (GrammarBinding (quote Type) 1)"); + expect(out[2]![0]).toContain("(quote MultiScope) () 2"); + expect(out[3]![0]).toMatch(/^\(FuzzSample \(pair \$fuzz-0 \$fuzz-1\) /); + }); + + it("uses weights only for random selection and keeps one ordered exhaustive branch per production", () => { + const out = printed(` + (FuzzGrammar Weighted + (Productions + ((Production 9 Weighted heavy) + (Production 1 Weighted light)))) + !(fuzz-enumerate (gen-grammar Weighted) 16 0) + !(fuzz-generate-edge (gen-grammar Weighted) 0 0) + !(fuzz-generate-edge (gen-grammar Weighted) 1 0) + !(fuzz-generate-bytes (gen-grammar Weighted) (0) 0) + !(fuzz-generate-bytes (gen-grammar Weighted) (1) 0) + !(_fuzz-grammar-ticket-index + ((GrammarProduction 0 9 (quote Weighted) (quote heavy)) + (GrammarProduction 1 1 (quote Weighted) (quote light))) + 1 + 0) + !(_fuzz-grammar-ticket-index + ((GrammarProduction 0 9 (quote Weighted) (quote heavy)) + (GrammarProduction 1 1 (quote Weighted) (quote light))) + 9 + 0) + !(_fuzz-grammar-ticket-index + ((GrammarProduction 0 9 (quote Weighted) (quote heavy)) + (GrammarProduction 1 1 (quote Weighted) (quote light))) + 10 + 0) + `); + + expect(out[1]).toHaveLength(1); + expect(out[1]![0]).toMatch( + /^\(FuzzEnumeration \(DomainCount 2\) \(Enumerated 2\) \(GenerationDiscards 0\)/, + ); + expect([...out[1]![0]!.matchAll(/\(FuzzSample ([^ ]+) /g)].map((match) => match[1])).toEqual([ + "heavy", + "light", + ]); + expect(sampleValue(out[2]![0]!)).toBe("heavy"); + expect(sampleValue(out[3]![0]!)).toBe("light"); + expect(sampleValue(out[4]![0]!)).toBe("heavy"); + expect(sampleValue(out[5]![0]!)).toBe("light"); + expect(out.slice(6)).toEqual([["0"], ["0"], ["1"]]); + for (const result of out.slice(1, 6).flat()) { + expect(result).toContain("(Decision Int (Bounds 0 1) (Origin 0)"); + } + }); + + it("generates fields and aliases with strict replay identity", () => { + const out = printed(` + (FuzzGrammar Arith + (Productions + ((Production 1 Arith (Ref Literal)) + (Production 1 Literal + (Lit (Field (gen-int -2 2))))))) + !(fuzz-generate-edge (gen-grammar Arith) 0 0) + !(fuzz-generate-edge (gen-grammar Arith) 0 1) + !(let $generator (gen-grammar Arith) + (let $sample + (fuzz-generate-random $generator 42 1) + (switch $sample + (((FuzzSample $value $next $tree) + (fuzz-replay $generator $tree 1)) + ($bad $bad))))) + `); + + expect(out[1]![0]).toMatch( + /^\(FuzzGenerationDiscard \(NoEligibleGrammarProduction \(Target \(quote Arith\)\) \(Size 0\)\)/, + ); + expect(out[2]![0]).toMatch(/^\(FuzzSample \(Lit 2\) /); + expect(out[2]![0]).toContain("(Decision GrammarRef (Target (quote Literal))"); + expect(out[3]![0]).toMatch(/^\(FuzzSample \(Lit [-0-9]+\) \(FuzzDriver Replay /); + expect(out[3]![0]).toContain("(Decision GrammarRef (Target (quote Literal))"); + }); + + it("threads binder scope, stable fresh ids, and scope-preserving shrink replay", () => { + const out = printed(` + (FuzzGrammar Lambda + (Productions + ((Production 1 Expr (Use Name)) + (Production 1 Expr + (lambda (Bind Name (Ref Expr))))))) + !(fuzz-generate-edge + (gen-grammar-root Lambda Expr) + 0 + 2) + !(let $generator (gen-grammar-root Lambda Expr) + (let $sample + (fuzz-generate-edge $generator 0 2) + (switch $sample + (((FuzzSample $value $next $tree) + (let $candidate + (superpose + (_fuzz-shrink-candidates $tree)) + (_fuzz-shrink-replay + $generator + $candidate + 2))) + ($bad $bad))))) + (FuzzGrammar ExternalScope + (Productions + ((Production 1 ExternalScope + (Scoped + ((Binding Name 7)) + (Use Name)))))) + !(fuzz-generate-edge + (gen-grammar ExternalScope) + 0 + 0) + (FuzzGrammar FreshPair + (Productions + ((Production 1 FreshPair + (pair + (Fresh Name) + (Fresh Name)))))) + !(fuzz-generate-edge + (gen-grammar FreshPair) + 0 + 0) + (FuzzGrammar FreeUse + (Productions + ((Production 1 FreeUse (Use Name))))) + !(fuzz-generate-edge + (gen-grammar FreeUse) + 0 + 0) + (FuzzGrammar LiteralMarker + (Productions + ((Production 1 LiteralMarker + (Literal (GeneratedVariable 3)))))) + !(fuzz-generate-edge + (gen-grammar LiteralMarker) + 0 + 0) + `); + + expect(out[1]![0]).toMatch( + /^\(FuzzSample \(lambda \(\$fuzz-0 \(lambda \(\$fuzz-1 \$fuzz-0\)\)\)\) /, + ); + expect(out[2]).toHaveLength(2); + expect(out[2]![0]).toMatch(/^\(FuzzShrinkReplay \(lambda \(\$fuzz-0 \$fuzz-0\)\) /); + expect(out[2]![1]).toMatch( + /^\(FuzzShrinkReplay \(lambda \(\$fuzz-0 \(lambda \(\$fuzz-1 \$fuzz-1\)\)\)\) /, + ); + expect(out[3]![0]).toMatch(/^\(FuzzSample \$fuzz-7 /); + expect(out[4]![0]).toMatch(/^\(FuzzSample \(pair \$fuzz-0 \$fuzz-1\) /); + expect(out[5]).toEqual([ + "(FuzzGenerationError UnproductiveGrammarNonterminal (Details (Grammar FreeUse) (Nonterminal (quote FreeUse))))", + ]); + expect(out[6]![0]).toMatch(/^\(FuzzSample \(GeneratedVariable 3\) /); + for (const result of out.slice(1, 6).flat()) expect(result).not.toContain("GeneratedVariable"); + }); + + it("returns defined results for deep and wide templates", () => { + const depth = 1200; + let deepTemplate = "leaf"; + for (let level = 0; level < depth; level += 1) deepTemplate = `(f ${deepTemplate})`; + const width = 1500; + const wideTemplate = `(tuple ${Array.from({ length: width }, (_, index) => `w${index}`).join( + " ", + )})`; + + const out = printed(` + (FuzzGrammar DeepTemplate + (Productions + ((Production 1 DeepTemplate ${deepTemplate})))) + !(gen-grammar DeepTemplate) + !(fuzz-generate-edge (gen-grammar DeepTemplate) 0 0) + (FuzzGrammar WideTemplate + (Productions + ((Production 1 WideTemplate ${wideTemplate})))) + !(gen-grammar WideTemplate) + !(fuzz-generate-edge (gen-grammar WideTemplate) 0 0) + `); + + expect(out[1]![0]).toContain("(GrammarRequest"); + const deepSample = out[2]![0]!; + expect(deepSample.startsWith(`(FuzzSample ${deepTemplate} `)).toBe(true); + expect(out[3]![0]).toContain("(GrammarRequest"); + const wideSample = out[4]![0]!; + expect(wideSample.startsWith(`(FuzzSample ${wideTemplate} `)).toBe(true); + }, 120_000); + + it("generates through deep nonterminal reference chains", () => { + const depth = 600; + const productions = Array.from({ length: depth }, (_, level) => + level === depth - 1 + ? `(Production 1 (T ${level}) bottom)` + : `(Production 1 (T ${level}) (n ${level} (Ref (T ${level + 1}))))`, + ).join("\n "); + + const out = printed(` + (FuzzGrammar DeepChain + (Productions + (${productions}))) + !(gen-grammar-root DeepChain (T 0)) + !(fuzz-generate-edge (gen-grammar-root DeepChain (T 0)) 0 ${depth}) + `); + + expect(out[1]![0]).toContain("(GrammarRequest"); + const sample = out[2]![0]!; + expect(sample).toMatch(/^\(FuzzSample \(n 0 \(n 1 \(n 2 /); + expect(topLevelItems(sample)[1]).toContain("bottom"); + }, 120_000); + + it("keeps validation defined under hundreds of open requirement alternatives", () => { + const alternatives = 400; + const openUses = Array.from( + { length: alternatives }, + (_, index) => `(Production 1 Body (Use (S ${index})))`, + ).join("\n "); + + const out = printed(` + (FuzzGrammar ManyAlternatives + (Productions + ((Production 1 Root (lambda (Bind (S 0) (Ref Body)))) + ${openUses}))) + !(gen-grammar-root ManyAlternatives Root) + !(fuzz-generate-edge (gen-grammar-root ManyAlternatives Root) 0 1) + `); + + expect(out[1]![0]).toContain("(GrammarRequest"); + expect(out[2]![0]).toMatch(/^\(FuzzSample \(lambda \(\$fuzz-0 \$fuzz-0\)\) /); + }, 120_000); + + it("accepts marker-shaped source syntax and rejects only genuine markers", () => { + const out = printed(` + (FuzzGrammar MarkerShapes + (Productions + ((Production 1 MarkerShapes + (shapes + (Literal (_fuzz-variable-marker 99)) + (Fresh (_fuzz-variable-marker 7)) + (Scoped + ((Binding (_fuzz-variable-marker 5) 0)) + (Use (_fuzz-variable-marker 5))) + (lambda + (Bind (_fuzz-variable-marker 3) + (Literal held)))))))) + !(fuzz-generate-edge (gen-grammar MarkerShapes) 0 0) + (= (marker-const-field) + (gen-const (_fuzz-variable-marker 42))) + (FuzzGrammar GenuineMarker + (Productions + ((Production 1 GenuineMarker + (Field (marker-const-field)))))) + !(fuzz-generate-edge (gen-grammar GenuineMarker) 0 0) + `); + + const shaped = out[1]![0]!; + expect(shaped).toMatch( + /^\(FuzzSample \(shapes \(_fuzz-variable-marker 99\) \$fuzz-1 \$fuzz-0 \(lambda \(\$fuzz-2 held\)\)\) /, + ); + expect(shaped).not.toContain("ForgedGrammarVariableMarker"); + expect(out[2]![0]).toContain("(FuzzGenerationError ForgedGrammarVariableMarker"); + expect(out[2]![0]).not.toContain("(FuzzSample "); + }); + + it("freezes Field generators at construction against later relation changes", () => { + const out = printed(` + (= (freezing-field) (gen-int 0 1)) + (FuzzGrammar Freezing + (Productions + ((Production 1 Freezing + (Boxed (Field (freezing-field))))))) + !(let $generator (gen-grammar Freezing) + (let $first (fuzz-generate-edge $generator 0 0) + (let $added + (add-atom &self (= (freezing-field) (gen-bool))) + (let $second (fuzz-generate-edge $generator 0 0) + (Frozen $first $second))))) + !(gen-grammar Freezing) + `); + + const frozen = out[1]![0]!; + const items = topLevelItems(frozen); + expect(items[0]).toBe("Frozen"); + const first = items[1]!; + const second = items[2]!; + expect(first).toMatch(/^\(FuzzSample \(Boxed [01]\) /); + expect(topLevelItems(second)[1]).toBe(topLevelItems(first)[1]); + expect(out[2]![0]).toContain("(FuzzGenerationError AmbiguousGrammarFieldGenerator"); + }); + + it("rejects trailing, missing, and mutated replay decisions", () => { + const grammarSource = ` + (FuzzGrammar ReplayMutation + (Productions + ((Production 1 ReplayMutation + (Lit (Field (gen-int 0 3)))))))`; + const generated = printed(`${grammarSource} + !(fuzz-generate-edge (gen-grammar ReplayMutation) 0 0) + `); + const sample = generated[1]![0]!; + expect(sample).toMatch(/^\(FuzzSample \(Lit \d+\) /); + const tree = sampleTree(sample); + expect(tree).toContain("(Bounds 0 3)"); + + const trailing = `(Decision Wrapper () () (${tree} (Decision Int (Bounds 0 3) (Origin 0) (Value 1) ())))`; + const missing = "(Decision Wrapper () () ())"; + const mutatedBounds = tree.replace("(Bounds 0 3)", "(Bounds 0 5)"); + const valueMatches = [...tree.matchAll(/\(Value (\d+)\)/g)]; + const lastValue = valueMatches[valueMatches.length - 1]!; + const mutatedValue = + tree.slice(0, lastValue.index) + + "(Value 9)" + + tree.slice(lastValue.index + lastValue[0].length); + + const replayed = printed(`${grammarSource} + !(fuzz-replay (gen-grammar ReplayMutation) ${tree} 0) + !(fuzz-replay (gen-grammar ReplayMutation) ${trailing} 0) + !(fuzz-replay (gen-grammar ReplayMutation) ${missing} 0) + !(fuzz-replay (gen-grammar ReplayMutation) ${mutatedBounds} 0) + !(fuzz-replay (gen-grammar ReplayMutation) ${mutatedValue} 0) + `); + + expect(replayed[1]![0]).toMatch(/^\(FuzzSample \(Lit \d+\) \(FuzzDriver Replay /); + expect(replayed[2]![0]).toContain("(FuzzGenerationError TrailingReplayDecisions"); + expect(replayed[3]![0]).toContain("(FuzzGenerationError ReplayMismatch"); + expect(replayed[3]![0]).toContain("(Actual EndOfTrace)"); + expect(replayed[4]![0]).toContain("(FuzzGenerationError ReplayMismatch"); + expect(replayed[4]![0]).toContain("(ActualBounds 0 5)"); + expect(replayed[5]![0]).toContain("(FuzzGenerationError ReplayValueOutOfBounds"); + }); + + it("keeps generate and replay identical across many seeds", () => { + const seeds = Array.from({ length: 25 }, (_, seed) => seed).join(" "); + const out = printed(` + (FuzzGrammar Rich + (Productions + ((Production 2 Expr (Use Name)) + (Production 1 Expr + (lambda (Bind Name (Ref Expr)))) + (Production 1 Expr + (lit (Field (gen-int -3 3))))))) + (= (seed-check $generator $seed) + (let $sample (fuzz-generate-random $generator $seed 6) + (switch $sample + (((FuzzSample $value $next $tree) + (let $replayed (fuzz-replay $generator $tree 6) + (switch $replayed + (((FuzzSample $replay-value $replay-next $replay-tree) + (SeedCheck $seed (noreduce-eq $value $replay-value))) + ($bad (SeedCheck $seed (ReplayFailed $bad))))))) + ($bad (SeedCheck $seed (GenerateFailed $bad))))))) + !(let $generator (gen-grammar-root Rich Expr) + (map-atom (${seeds}) $seed (seed-check $generator $seed))) + `); + + const expected = `(${Array.from({ length: 25 }, (_, seed) => `(SeedCheck ${seed} True)`).join( + " ", + )})`; + expect(out[1]).toEqual([expected]); + }, 60_000); + + it("covers purely recursive, finitely recursive, and parametric list schemas", () => { + const out = printed(` + (= (FuzzTypeSchema OnlyRecursive Nat) + (FuzzTypeConstructors + ((Constructor 1 Nat (succ (Ref Nat)))))) + !(gen-well-typed OnlyRecursive Nat) + (= (FuzzTypeSchema Peano Nat) + (FuzzTypeConstructors + ((Constructor 1 Nat (z)) + (Constructor 1 Nat (succ (Ref Nat)))))) + !(fuzz-generate-edge (gen-well-typed Peano Nat) 0 3) + !(fuzz-generate-edge (gen-well-typed Peano Nat) 1 3) + (= (FuzzTypeSchema ListSchema (List $element)) + (FuzzTypeConstructors + ((Constructor 1 (List $element) (nil)) + (Constructor 1 (List $element) + (cons (Ref $element) (Ref (List $element))))))) + (= (FuzzTypeSchema ListSchema Num) + (FuzzTypeConstructors + ((Constructor 1 Num (num (Field (gen-int 0 1))))))) + !(fuzz-generate-edge (gen-well-typed ListSchema (List Num)) 1 4) + !(gen-well-typed ListSchema (List Bool)) + `); + + expect(out[1]![0]).toContain("(FuzzGenerationError"); + expect(out[1]![0]).toContain("OnlyRecursive"); + expect(out[2]![0]).toMatch(/^\(FuzzSample \(z\) /); + expect(out[3]![0]).toMatch(/^\(FuzzSample \(succ /); + expect(out[4]![0]).toMatch(/^\(FuzzSample \(cons \(num [01]\) /); + expect(out[5]![0]).toContain("(FuzzGenerationError"); + expect(out[5]![0]).toContain("Bool"); + }); + + it("scales to many distinct literal targets and dynamic type chains", () => { + const targets = 96; + const literalProductions = Array.from( + { length: targets }, + (_, index) => `(Production 1 (T ${index}) (leaf ${index}))`, + ).join("\n "); + const startedTargets = performance.now(); + const targetsOut = printed(` + (FuzzGrammar ManyTargets + (Productions + (${literalProductions}))) + !(gen-grammar-root ManyTargets (T 0)) + !(fuzz-generate-edge (gen-grammar-root ManyTargets (T 0)) 0 0) + `); + const targetsElapsed = performance.now() - startedTargets; + expect(targetsOut[1]![0]).toContain("(GrammarRequest"); + expect(targetsOut[2]![0]).toMatch(/^\(FuzzSample \(leaf 0\) /); + + const levels = 48; + const chainSchemas = Array.from({ length: levels }, (_, level) => + level === 0 + ? `(= (FuzzTypeSchema Chain (Level 0)) + (FuzzTypeConstructors + ((Constructor 1 (Level 0) (bottom)))))` + : `(= (FuzzTypeSchema Chain (Level ${level})) + (FuzzTypeConstructors + ((Constructor 1 (Level ${level}) + (down ${level} (Ref (Level ${level - 1})))))))`, + ).join("\n "); + const startedChain = performance.now(); + const chainOut = printed(` + ${chainSchemas} + !(fuzz-generate-edge + (gen-well-typed Chain (Level ${levels - 1})) + 0 + ${levels}) + `); + const chainElapsed = performance.now() - startedChain; + expect(chainOut[1]![0]).toMatch(/^\(FuzzSample \(down 47 \(down 46 \(down 45 /); + + // Scaling gate: both workloads were quadratic-or-worse before the + // immutable summary boundary (10.1s at 64 targets, 55.3s at 48 levels). + expect(targetsElapsed).toBeLessThan(10_000); + expect(chainElapsed).toBeLessThan(10_000); + }, 120_000); + + it("constructs terms from explicit parametric type schemas", () => { + const out = printed(` + (= (FuzzTypeSchema STLC Num) + (FuzzTypeConstructors + ((Constructor 1 Num + (var (Use Num))) + (Constructor 1 Num + (lit (Field (gen-int 0 2)))) + (Constructor 1 Num + (add (Ref Num) (Ref Num)))))) + (= (FuzzTypeSchema STLC (Arrow $input $output)) + (FuzzTypeConstructors + ((Constructor 1 + (Arrow $input $output) + (lambda + (Bind $input + (Ref $output))))))) + !(fuzz-generate-edge + (gen-well-typed STLC Num) + 0 + 0) + !(fuzz-generate-edge + (gen-well-typed STLC (Arrow Num Num)) + 1 + 1) + (: alleged-constructor Num) + !(gen-well-typed Inferred Num) + (= (FuzzTypeSchema Wrong Num) + (FuzzTypeConstructors + ((Constructor 1 Bool nope)))) + !(gen-well-typed Wrong Num) + (= (FuzzTypeSchema Ambiguous Num) + (FuzzTypeConstructors + ((Constructor 1 Num first)))) + (= (FuzzTypeSchema Ambiguous Num) + (FuzzTypeConstructors + ((Constructor 1 Num second)))) + !(gen-well-typed Ambiguous Num) + `); + + expect(out[1]![0]).toMatch(/^\(FuzzSample \(lit 2\) /); + expect(out[2]![0]).toMatch(/^\(FuzzSample \(lambda \(\$fuzz-0 \(var \$fuzz-0\)\)\) /); + expect(out[3]).toEqual([ + "(FuzzGenerationError MissingTypeSchema (Details (Schema Inferred) (Type (quote Num))))", + ]); + expect(out[4]).toEqual([ + "(FuzzGenerationError TypeConstructorResultMismatch (Details (Schema Wrong) (RequestedType (quote Num)) (ConstructorType (quote Bool)) (ConstructorIndex 0)))", + ]); + expect(out[5]).toEqual([ + "(FuzzGenerationError AmbiguousTypeSchema (Details (Schema Ambiguous) (Type (quote Num)) (Results ((quote (FuzzTypeConstructors ((Constructor 1 Num first)))) (quote (FuzzTypeConstructors ((Constructor 1 Num second))))))))", + ]); + }); + + it("keeps the kernel machine identical to the MeTTa specification machine", () => { + const out = printed(` + (FuzzGrammar DiffMachine + (Productions + ((Production 3 Expr (add (Ref Expr) (Ref Expr))) + (Production 2 Expr (lambda (Bind Name (Ref Expr)))) + (Production 1 Expr (Use Name)) + (Production 1 Expr (var (Fresh Name))) + (Production 1 Expr (lit (Field (gen-int 0 9)))) + (Production 1 Expr (Literal (closed leaf)))))) + (= (diff-request) + (let $descriptor (gen-grammar-root DiffMachine Expr) + (unify $descriptor + (GenCustom + _fuzz-grammar + (GrammarRequest $source $target $scope $next-id)) + (DiffRequest $source $target $scope $next-id) + (DiffBadDescriptor $descriptor)))) + (= (diff-both $driver $size) + (let $request (diff-request) + (unify $request + (DiffRequest $source $target $scope $next-id) + (DiffPair + (_fuzz-generate-grammar-nonterminal + $source $target $scope $next-id $driver $size) + (_fuzz-generate-grammar-nonterminal-reference + $source $target $scope $next-id $driver $size)) + $request))) + (= (diff-tree $seed $size) + (let $request (diff-request) + (unify $request + (DiffRequest $source $target $scope $next-id) + (let $driver (fuzz-random-driver $seed) + (let $first + (_fuzz-generate-grammar-nonterminal + $source $target $scope $next-id $driver $size) + (unify $first + (GrammarResult $value $spent $final-id $tree) + $tree + (DiffNoTree $first)))) + $request))) + (= (diff-replay-both $seed $size) + (let $tree (diff-tree $seed $size) + (let $driver (fuzz-replay-driver $tree) + (diff-both $driver $size)))) + (= (diff-shrink-both $seed $size) + (let $tree (diff-tree $seed $size) + (let $driver (_fuzz-shrink-replay-driver $tree) + (diff-both $driver $size)))) + !(diff-both (fuzz-random-driver (superpose (0 1 2 3 4 5 6 7))) 6) + !(diff-both (fuzz-random-driver (superpose (11 12 13))) 0) + !(diff-both (fuzz-random-driver (superpose (21 22 23))) 12) + !(diff-both (fuzz-edge-driver (superpose (0 1 2 3 4 5))) 4) + !(diff-replay-both (superpose (31 32 33)) 6) + !(diff-shrink-both (superpose (41 42 43)) 6) + !(diff-both (fuzz-exhaustive-driver) 1) + !(diff-both (_fuzz-exhaustive-resume-driver (1)) 1) + !(diff-both (_fuzz-exhaustive-resume-driver (2 1)) 2) + !(diff-both (_fuzz-exhaustive-resume-driver (3)) 2) + !(let $request (diff-request) + (unify $request + (DiffRequest (StaticGrammar (quote $g) $productions) $target $scope $next-id) + (let $targets (_fuzz-grammar-reference-targets $productions) + (DiffPair + (_fuzz-validate-grammar-productivity + $g Expr $productions $targets) + (_fuzz-validate-grammar-productivity-reference + $g Expr $productions $targets))) + $request)) + !(DiffPair + (_fuzz-validate-grammar-productivity Unprod Loop + ((GrammarProduction 0 1 (quote Loop) + (quote (n (_FuzzGrammarRef Loop 0 1))))) + ((quote Loop))) + (_fuzz-validate-grammar-productivity-reference Unprod Loop + ((GrammarProduction 0 1 (quote Loop) + (quote (n (_FuzzGrammarRef Loop 0 1))))) + ((quote Loop)))) + `); + + const diffPair = (row: string): [string, string] => { + const items = topLevelItems(row); + expect(items[0]).toBe("DiffPair"); + expect(items).toHaveLength(3); + return [items[1]!, items[2]!]; + }; + const expectIdenticalRows = (rows: readonly string[] | undefined, shape: RegExp): void => { + expect(rows).toBeDefined(); + expect(rows!.length).toBeGreaterThan(0); + for (const row of rows!) { + const [machine, reference] = diffPair(row); + expect(machine).toMatch(shape); + expect(reference).toBe(machine); + } + }; + + const sample = /^\(GrammarResult /; + expectIdenticalRows(out[1], sample); + expectIdenticalRows(out[2], sample); + expectIdenticalRows(out[3], sample); + expectIdenticalRows(out[4], sample); + expectIdenticalRows(out[5], sample); + expectIdenticalRows(out[6], sample); + expectIdenticalRows(out[7], sample); + expectIdenticalRows(out[8], sample); + expectIdenticalRows(out[9], sample); + expectIdenticalRows(out[10], sample); + expectIdenticalRows(out[11], /^\(ValidGrammarProductivity\)$/); + expectIdenticalRows(out[12], /^\(FuzzGenerationError UnproductiveGrammarNonterminal /); + }); +}); diff --git a/packages/fuzz/src/index.ts b/packages/fuzz/src/index.ts new file mode 100644 index 0000000..d84dcfb --- /dev/null +++ b/packages/fuzz/src/index.ts @@ -0,0 +1,53 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import { registerBuiltinModule } from "@mettascript/core"; +import { FUZZ_MODULE_SRC } from "./generated/module.js"; +import { registerFuzzKernel } from "./kernel.js"; + +let registered = false; + +/** Register the `fuzz` module and its private deterministic grounded operations. */ +export function registerFuzz(): void { + if (registered) return; + registerFuzzKernel(); + registerBuiltinModule("fuzz", FUZZ_MODULE_SRC); + registered = true; +} + +registerFuzz(); + +export { FUZZ_MODULE_SRC }; +export { + decodeFuzzOutcome, + exitCodeForOutcome, + exitCodeForOutcomes, + renderOutcomeLine, + FUZZ_EXIT_OK, + FUZZ_EXIT_PROPERTY_FAILURE, + FUZZ_EXIT_INVALID, + FUZZ_EXIT_INCOMPLETE, + type FuzzOutcome, + type FuzzExitCode, + type FuzzCounts, + type FuzzStatistics, + type ReachCounts, + type ReachStep, +} from "./decode.js"; +export { + corpusRegressionFact, + parseCorpusEntries, + renderCorpusEntry, + FUZZ_CORPUS_FORMAT, + type FuzzCorpusEntry, + type FuzzCorpusFailure, + type FuzzCorpusResult, +} from "./corpus.js"; +export { + FUZZ_ALPHA_REPLAY_KEY_ALGORITHM, + FUZZ_ATOM_CODEC_VERSION, + FUZZ_ATOM_KEY_ALGORITHM, + FUZZ_REPLAY_KEY_ALGORITHM, + FUZZ_RNG_ALGORITHM, +} from "./kernel.js"; diff --git a/packages/fuzz/src/kernel.test.ts b/packages/fuzz/src/kernel.test.ts new file mode 100644 index 0000000..2dbe847 --- /dev/null +++ b/packages/fuzz/src/kernel.test.ts @@ -0,0 +1,1033 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import fc from "fast-check"; +import { + type Atom, + type GroundFn, + alphaEq, + atomEq, + expr, + format, + gbool, + gfloat, + gint, + gnd, + gstr, + gunit, + parse, + registeredBuiltinGroundedOperations, + runProgram, + standardTokenizer, + sym, + variable, +} from "@mettascript/core"; +import { + FUZZ_ALPHA_REPLAY_KEY_ALGORITHM, + FUZZ_ATOM_CODEC_VERSION, + FUZZ_ATOM_KEY_ALGORITHM, + FUZZ_REPLAY_KEY_ALGORITHM, + FUZZ_RNG_ALGORITHM, + registerFuzzKernel, +} from "./kernel.js"; + +const FUZZ_OPERATIONS = [ + "_fuzz-rng-init", + "_fuzz-draw-int", + "_fuzz-atom-key", + "_fuzz-deduplicate-exact", + "_fuzz-deduplicate-replay", + "_fuzz-exact-member", + "_fuzz-replay-member", + "_fuzz-make-variable", + "_fuzz-variable-marker", + "_fuzz-contains-variable-marker", + "_fuzz-materialize-grammar-sample", + "_fuzz-expression-append", + "_fuzz-expression-concat", + "_fuzz-grammar-summary-alternatives", + "_fuzz-grammar-summary-replace", + "_fuzz-grammar-alternatives-add", + "_fuzz-grammar-productions-for-target", + "_fuzz-grammar-template-requirements-op", + "_fuzz-grammar-eligible-productions-op", + "_fuzz-grammar-machine-op", + "_fuzz-grammar-dependents-of", + "_fuzz-index-stack", + "_fuzz-grammar-template-plan", + "_fuzz-stack-take", + "_fuzz-stack-push-all", + "_fuzz-expression-view", + "_fuzz-grammar-field-expressions", + "_fuzz-grammar-replace-fields", + "_fuzz-grammar-index-references", + "_fuzz-grammar-template-profile", + "_fuzz-grammar-validation-plan", + "_fuzz-grammar-template-reference-plan", + "_fuzz-atom-ground", + "_fuzz-custom-replay-tree", + "_fuzz-custom-replay-equal", + "_fuzz-float64-bits", + "_fuzz-float64-from-bits", + "_fuzz-float64-index", + "_fuzz-float64-from-index", + "_fuzz-unicode-character", + "_fuzz-replay-equal", + "_fuzz-encode-atom", + "_fuzz-decode-atom", +] as const; + +function operation(name: (typeof FUZZ_OPERATIONS)[number]): GroundFn { + const found = registeredBuiltinGroundedOperations().find((entry) => entry.name === name); + if (found === undefined) throw new Error(`missing fuzz operation ${name}`); + return found.operation; +} + +function oneResult(op: GroundFn, args: readonly Atom[]): Atom { + const result = op(args); + if (result.tag !== "ok" || result.results.length !== 1) + throw new Error(`unexpected grounded result: ${result.tag}`); + return result.results[0]!; +} + +function atomKey(mode: "Exact" | "Alpha" | "Replay" | "AlphaReplay", atom: Atom): string { + const result = oneResult(operation("_fuzz-atom-key"), [sym(mode), atom]); + if (result.kind !== "gnd" || result.value.g !== "str") + throw new Error(`unexpected atom-key result: ${format(result)}`); + return result.value.s; +} + +function floatFromBits(bits: bigint): Atom { + return oneResult(operation("_fuzz-float64-from-bits"), [ + gint(bits >> 32n), + gint(bits & 0xffffffffn), + ]); +} + +const identifier = fc + .stringMatching(/^[a-z][a-z0-9-]{0,6}$/) + .filter((name) => name !== "True" && name !== "False"); + +const replayableAtom: fc.Arbitrary = fc.letrec<{ atom: Atom }>((tie) => ({ + atom: fc.oneof( + { depthSize: "small", withCrossShrink: true }, + identifier.map(sym), + identifier.map(variable), + fc + .bigInt({ + min: -(1n << 127n), + max: (1n << 127n) - 1n, + }) + .map(gint), + fc.integer({ min: -1_000_000, max: 1_000_000 }).map((value) => gfloat(value / 7)), + fc.bigInt({ min: 0n, max: 0xffffffffffffffffn }).map(floatFromBits), + fc.boolean().map(gbool), + fc.string({ maxLength: 12 }).map(gstr), + fc.constant(gunit), + fc.string({ maxLength: 12 }).map((message) => gnd({ g: "error", msg: message })), + fc.array(tie("atom"), { maxLength: 4 }).map(expr), + ), +})).atom; + +const printed = (source: string): string[][] => + runProgram(source).map((query) => query.results.map(format)); + +describe("deterministic fuzz kernel", () => { + it("registers each private operation once as Pure", () => { + registerFuzzKernel(); + registerFuzzKernel(); + for (const name of FUZZ_OPERATIONS) { + const entries = registeredBuiltinGroundedOperations().filter((entry) => entry.name === name); + expect(entries).toHaveLength(1); + expect(entries[0]!.effect).toBe("Pure"); + } + }); + + it("imports its signatures without exposing host state", () => { + expect( + printed(` + !(import! &self fuzz) + !(get-type _fuzz-rng-init) + !(get-type _fuzz-draw-int) + !(get-type _fuzz-atom-key) + !(get-type _fuzz-deduplicate-exact) + !(get-type _fuzz-deduplicate-replay) + !(get-type _fuzz-exact-member) + !(get-type _fuzz-replay-member) + !(get-type _fuzz-make-variable) + !(get-type _fuzz-variable-marker) + !(get-type _fuzz-materialize-grammar-sample) + !(get-type _fuzz-grammar-summary-alternatives) + !(get-type _fuzz-grammar-summary-replace) + !(get-type _fuzz-float64-bits) + !(get-type _fuzz-float64-from-bits) + !(get-type _fuzz-float64-index) + !(get-type _fuzz-float64-from-index) + !(get-type _fuzz-unicode-character) + !(get-type _fuzz-replay-equal) + !(get-type _fuzz-encode-atom) + !(get-type _fuzz-decode-atom) + `), + ).toEqual([ + ["()"], + ["(-> Number Atom)"], + ["(-> Atom Number Number Atom)"], + ["(-> Symbol Atom Atom)"], + ["(-> Expression Atom)"], + ["(-> Expression Atom)"], + ["(-> Atom Expression Atom)"], + ["(-> Atom Expression Atom)"], + ["(-> Number Variable)"], + ["(-> Number Atom)"], + ["(-> Atom Atom Atom %Undefined%)"], + ["(-> Expression Atom Atom)"], + ["(-> Expression Atom Expression Atom)"], + ["(-> Number Atom)"], + ["(-> Number Number Number)"], + ["(-> Number Atom)"], + ["(-> Number Number)"], + ["(-> Number Symbol)"], + ["(-> Atom Atom Bool)"], + ["(-> Atom Atom)"], + ["(-> Atom Atom)"], + ]); + }); + + it("freezes xorshift128plus-v1 initialization and draw vectors", () => { + expect(FUZZ_RNG_ALGORITHM).toBe("xorshift128plus-v1"); + expect( + printed(` + !(import! &self fuzz) + !(_fuzz-rng-init 0) + !(_fuzz-rng-init 42) + !(let* ( + ($r0 (_fuzz-rng-init 42)) + ((FuzzDraw $a $r1) (_fuzz-draw-int $r0 -10 10)) + ((FuzzDraw $b $r2) (_fuzz-draw-int $r1 -10 10)) + ((FuzzDraw $c $r3) (_fuzz-draw-int $r2 -10 10))) + ($a $b $c $r3)) + `), + ).toEqual([ + ["()"], + ["(FuzzRng xorshift128plus-v1 -1 -1 0 0)"], + ["(FuzzRng xorshift128plus-v1 -1 -43 42 0)"], + ["(-9 -3 -5 (FuzzRng xorshift128plus-v1 352322880 526288222 704468 -1339159583))"], + ]); + }); + + it("draws inclusive arbitrary-size integer ranges reproducibly", () => { + expect( + printed(` + !(import! &self fuzz) + !(let $r (_fuzz-rng-init -1) + (_fuzz-draw-int $r 0 18446744073709551616)) + !(let $r (_fuzz-rng-init 123456789012345678901234567890) + (_fuzz-draw-int + $r + -999999999999999999999999999999 + 999999999999999999999999999999)) + !(let $r (_fuzz-rng-init 7) (_fuzz-draw-int $r 19 19)) + !(let $r (_fuzz-rng-init 7) (_fuzz-draw-int $r 19 19)) + `), + ).toEqual([ + ["()"], + [ + "(FuzzDraw 9799762420418199040 (FuzzRng xorshift128plus-v1 -3932161 -130023936 -264117729 114703))", + ], + [ + "(FuzzDraw 620391704380418332280937861402 (FuzzRng xorshift128plus-v1 -1574075468 2135461863 1894888255 -92559962))", + ], + ["(FuzzDraw 19 (FuzzRng xorshift128plus-v1 7 0 7 1006632711))"], + ["(FuzzDraw 19 (FuzzRng xorshift128plus-v1 7 0 7 1006632711))"], + ]); + }); + + it("returns stable data errors for invalid kernel calls", () => { + expect( + printed(` + !(import! &self fuzz) + !(_fuzz-rng-init nope) + !(_fuzz-draw-int (FuzzRng stale 1 2 3 4) 0 1) + !(_fuzz-draw-int (FuzzRng xorshift128plus-v1 0 0 0 0) 0 1) + !(let $r (_fuzz-rng-init 0) (_fuzz-draw-int $r 2 1)) + !(_fuzz-atom-key Unknown a) + !(_fuzz-deduplicate-exact nope) + !(_fuzz-deduplicate-replay nope) + !(_fuzz-exact-member a nope) + !(_fuzz-replay-member a nope) + !(_fuzz-make-variable -1) + !(_fuzz-variable-marker -1) + !(_fuzz-float64-bits 1) + !(_fuzz-float64-from-bits -1 0) + !(_fuzz-float64-from-bits 0 4294967296) + !(_fuzz-float64-index 1) + !(_fuzz-float64-index (_fuzz-float64-from-bits 2146959360 1)) + !(_fuzz-float64-from-index -9218868437227405314) + !(_fuzz-float64-from-index 9218868437227405313) + !(_fuzz-unicode-character nope) + !(_fuzz-unicode-character -1) + !(_fuzz-unicode-character 1112062) + !(_fuzz-decode-atom malformed) + `), + ).toEqual([ + ["()"], + ["(FuzzKernelError InvalidSeed (Operation _fuzz-rng-init) ExpectedInteger)"], + ["(FuzzKernelError InvalidRngState (Operation _fuzz-draw-int) ExpectedFuzzRng)"], + ["(FuzzKernelError InvalidRngState (Operation _fuzz-draw-int) ExpectedFuzzRng)"], + ["(FuzzKernelError InvalidBounds (Operation _fuzz-draw-int) LowerExceedsUpper)"], + ["(FuzzKernelError InvalidKeyMode (Operation _fuzz-atom-key) ExpectedKeyMode)"], + [ + "(FuzzKernelError InvalidDeduplicationInput (Operation _fuzz-deduplicate-exact) ExpectedExpression)", + ], + [ + "(FuzzKernelError InvalidDeduplicationInput (Operation _fuzz-deduplicate-replay) ExpectedExpression)", + ], + [ + "(FuzzKernelError InvalidMembershipInput (Operation _fuzz-exact-member) ExpectedExpression)", + ], + [ + "(FuzzKernelError InvalidMembershipInput (Operation _fuzz-replay-member) ExpectedExpression)", + ], + [ + "(FuzzKernelError InvalidVariableIndex (Operation _fuzz-make-variable) ExpectedNonNegativeInteger)", + ], + [ + "(FuzzKernelError InvalidVariableIndex (Operation _fuzz-variable-marker) ExpectedNonNegativeInteger)", + ], + ["(FuzzKernelError InvalidFloat (Operation _fuzz-float64-bits) ExpectedFloat)"], + [ + "(FuzzKernelError InvalidFloatBits (Operation _fuzz-float64-from-bits) ExpectedUnsigned32Words)", + ], + [ + "(FuzzKernelError InvalidFloatBits (Operation _fuzz-float64-from-bits) ExpectedUnsigned32Words)", + ], + ["(FuzzKernelError InvalidFloat (Operation _fuzz-float64-index) ExpectedFloat)"], + ["(FuzzKernelError InvalidFloat (Operation _fuzz-float64-index) NaNHasNoOrderedIndex)"], + ["(FuzzKernelError InvalidFloatIndex (Operation _fuzz-float64-from-index) OutOfRange)"], + ["(FuzzKernelError InvalidFloatIndex (Operation _fuzz-float64-from-index) OutOfRange)"], + [ + "(FuzzKernelError InvalidCharacterIndex (Operation _fuzz-unicode-character) ExpectedInteger)", + ], + ["(FuzzKernelError InvalidCharacterIndex (Operation _fuzz-unicode-character) OutOfRange)"], + ["(FuzzKernelError InvalidCharacterIndex (Operation _fuzz-unicode-character) OutOfRange)"], + ["(FuzzKernelError InvalidEncodedAtom (Operation _fuzz-decode-atom) ExpectedVersion1)"], + ]); + }); + + it("uses kind-tagged length prefixes and canonical numeric buckets", () => { + expect(FUZZ_ATOM_KEY_ALGORITHM).toBe("mettascript-atom-key-v1"); + expect( + atomKey("Exact", expr([sym("a"), variable("x"), expr([sym("b"), gint(3), gfloat(3)])])), + ).toBe("mettascript-atom-key-v1;E3:S1:a;V1:x;E3:S1:b;N1:3;N1:3;"); + expect(atomKey("Exact", sym("ab"))).not.toBe(atomKey("Exact", expr([sym("a"), sym("b")]))); + expect(atomKey("Exact", gstr("a;S1:b"))).not.toBe(atomKey("Exact", expr([sym("a"), sym("b")]))); + expect(atomKey("Exact", gint(3))).toBe(atomKey("Exact", gfloat(3))); + expect(atomKey("Exact", gfloat(-0))).toBe(atomKey("Exact", gfloat(0))); + }); + + it("uses bit-faithful replay keys without changing Hyperon numeric equality keys", () => { + expect(FUZZ_REPLAY_KEY_ALGORITHM).toBe("mettascript-replay-key-v1"); + expect(atomKey("Replay", gint(3))).not.toBe(atomKey("Replay", gfloat(3))); + expect(atomKey("Replay", gfloat(-0))).not.toBe(atomKey("Replay", gfloat(0))); + expect(atomKey("Replay", gfloat(-0))).toBe("mettascript-replay-key-v1;F8000000000000000;"); + expect(atomKey("Replay", gfloat(0))).toBe("mettascript-replay-key-v1;F0000000000000000;"); + + const firstNaN = floatFromBits(0x7ff8000000000001n); + const secondNaN = floatFromBits(0x7ff8000000000002n); + expect(atomKey("Exact", firstNaN)).toBe(atomKey("Exact", secondNaN)); + expect(atomKey("Replay", firstNaN)).not.toBe(atomKey("Replay", secondNaN)); + }); + + it("combines alpha-canonical variables with bit-faithful grounded values", () => { + expect(FUZZ_ALPHA_REPLAY_KEY_ALGORITHM).toBe("mettascript-alpha-replay-key-v1"); + const firstNaN = floatFromBits(0x7ff8000000000017n); + const secondNaN = floatFromBits(0x7ff8000000000018n); + const left = expr([sym("tag"), variable("x"), variable("x"), firstNaN]); + const renamed = expr([sym("tag"), variable("other"), variable("other"), firstNaN]); + const differentVariables = expr([sym("tag"), variable("left"), variable("right"), firstNaN]); + const differentPayload = expr([sym("tag"), variable("x"), variable("x"), secondNaN]); + + expect(atomKey("AlphaReplay", left)).toBe(atomKey("AlphaReplay", renamed)); + expect(atomKey("AlphaReplay", left)).not.toBe(atomKey("AlphaReplay", differentVariables)); + expect(atomKey("AlphaReplay", left)).not.toBe(atomKey("AlphaReplay", differentPayload)); + }); + + it("bit-casts every IEEE-754 payload and indexes every non-NaN value", () => { + expect( + printed(` + !(let $value (_fuzz-float64-from-bits 0 0) + (_fuzz-float64-bits $value)) + !(let $value (_fuzz-float64-from-bits 2147483648 0) + (_fuzz-float64-bits $value)) + !(let $value (_fuzz-float64-from-bits 0 1) + (_fuzz-float64-index $value)) + !(let $value (_fuzz-float64-from-bits 2147483648 1) + (_fuzz-float64-index $value)) + !(let $value (_fuzz-float64-from-bits 2146435071 4294967295) + (_fuzz-float64-index $value)) + !(let $value (_fuzz-float64-from-bits 4293918719 4294967295) + (_fuzz-float64-index $value)) + !(let $value (_fuzz-float64-from-bits 2146435072 0) + (_fuzz-float64-index $value)) + !(let $value (_fuzz-float64-from-bits 4293918720 0) + (_fuzz-float64-index $value)) + !(let $value (_fuzz-float64-from-bits 2146959360 1) + (_fuzz-float64-bits $value)) + `), + ).toEqual([ + ["(Float64Bits 0 0)"], + ["(Float64Bits 2147483648 0)"], + ["(Float64Index 1)"], + ["(Float64Index -2)"], + ["(Float64Index 9218868437227405311)"], + ["(Float64Index -9218868437227405312)"], + ["(Float64Index 9218868437227405312)"], + ["(Float64Index -9218868437227405313)"], + ["(Float64Bits 2146959360 1)"], + ]); + + for (const index of [ + -9_218_868_437_227_405_313n, + -9_218_868_437_227_405_312n, + -2n, + -1n, + 0n, + 1n, + 9_218_868_437_227_405_311n, + 9_218_868_437_227_405_312n, + ]) { + const value = oneResult(operation("_fuzz-float64-from-index"), [gint(index)]); + expect(format(oneResult(operation("_fuzz-float64-index"), [value]))).toBe( + `(Float64Index ${index})`, + ); + } + }); + + it("round-trips arbitrary float payloads without numeric coercion", () => { + for (const bits of [ + 0x7ff0000000000001n, + 0xfff0000000000001n, + 0x7ff8000000000017n, + 0xfff8000000000017n, + ]) { + const value = floatFromBits(bits); + expect(format(oneResult(operation("_fuzz-float64-bits"), [value]))).toBe( + `(Float64Bits ${bits >> 32n} ${bits & 0xffffffffn})`, + ); + } + + fc.assert( + fc.property(fc.bigInt({ min: 0n, max: 0xffffffffffffffffn }), (bits) => { + const value = floatFromBits(bits); + expect(format(oneResult(operation("_fuzz-float64-bits"), [value]))).toBe( + `(Float64Bits ${bits >> 32n} ${bits & 0xffffffffn})`, + ); + }), + { numRuns: 2_000 }, + ); + }); + + it("round-trips every non-NaN payload through its ordered float index", () => { + fc.assert( + fc.property( + fc + .bigInt({ min: 0n, max: 0xffffffffffffffffn }) + .filter( + (bits) => + (bits & 0x7ff0000000000000n) !== 0x7ff0000000000000n || + (bits & 0x000fffffffffffffn) === 0n, + ), + (bits) => { + const value = floatFromBits(bits); + const indexed = oneResult(operation("_fuzz-float64-index"), [value]); + expect(indexed.kind).toBe("expr"); + if (indexed.kind !== "expr") return; + const index = indexed.items[1]; + expect(index).toBeDefined(); + const reconstructed = oneResult(operation("_fuzz-float64-from-index"), [index!]); + expect(format(oneResult(operation("_fuzz-float64-bits"), [reconstructed]))).toBe( + `(Float64Bits ${bits >> 32n} ${bits & 0xffffffffn})`, + ); + }, + ), + { numRuns: 2_000 }, + ); + }); + + it("maps the compact Unicode domain to scalar values without gaps or surrogates", () => { + const character = operation("_fuzz-unicode-character"); + expect(format(oneResult(character, [gint(0)]))).toBe("\u0000"); + expect(format(oneResult(character, [gint(55_295)]))).toBe("\ud7ff"); + expect(format(oneResult(character, [gint(55_296)]))).toBe("\ue000"); + expect(format(oneResult(character, [gint(63_485)]))).toBe("\ufffd"); + expect(format(oneResult(character, [gint(63_486)]))).toBe("𐀀"); + expect(format(oneResult(character, [gint(1_112_061)]))).toBe("􏿿"); + + fc.assert( + fc.property(fc.integer({ min: 0, max: 1_112_061 }), (index) => { + const atom = oneResult(character, [gint(index)]); + expect(atom.kind).toBe("sym"); + if (atom.kind !== "sym") return; + const codePoint = atom.name.codePointAt(0); + expect(codePoint).toBeDefined(); + expect(codePoint).not.toBeGreaterThan(0x10ffff); + expect(codePoint! < 0xd800 || codePoint! > 0xdfff).toBe(true); + expect(codePoint).not.toBe(0xfffe); + expect(codePoint).not.toBe(0xffff); + }), + { numRuns: 2_000 }, + ); + }); + + it("compares replay values by grounded kind and exact float payload", () => { + const equal = operation("_fuzz-replay-equal"); + const nan = (bits: bigint): Atom => floatFromBits(bits); + + expect(format(oneResult(equal, [gfloat(0), gfloat(0)]))).toBe("True"); + expect(format(oneResult(equal, [gfloat(-0), gfloat(0)]))).toBe("False"); + expect(format(oneResult(equal, [gint(3), gfloat(3)]))).toBe("False"); + expect(format(oneResult(equal, [nan(0x7ff8000000000001n), nan(0x7ff8000000000001n)]))).toBe( + "True", + ); + expect(format(oneResult(equal, [nan(0x7ff8000000000001n), nan(0x7ff8000000000002n)]))).toBe( + "False", + ); + expect( + format( + oneResult(equal, [ + expr([sym("value"), nan(0xfff8000000000017n)]), + expr([sym("value"), nan(0xfff8000000000017n)]), + ]), + ), + ).toBe("True"); + }); + + it("encodes replay atoms into source-stable data and decodes them exactly", () => { + expect(FUZZ_ATOM_CODEC_VERSION).toBe(1); + const nan = floatFromBits(0x7ff8000000000017n); + const original = expr([ + sym("root"), + variable("x"), + gint(3), + gfloat(-0), + nan, + gstr("quoted\ntext"), + gbool(false), + gunit, + expr([sym("child")]), + ]); + const encoded = oneResult(operation("_fuzz-encode-atom"), [original]); + expect(format(encoded)).toContain("(Float64Bits 2147483648 0)"); + expect(format(encoded)).toContain("(Float64Bits 2146959360 23)"); + const reparsed = parse(format(encoded), standardTokenizer()); + expect(reparsed).toBeDefined(); + const decoded = oneResult(operation("_fuzz-decode-atom"), [reparsed!]); + expect(format(oneResult(operation("_fuzz-replay-equal"), [original, decoded]))).toBe("True"); + }); + + it("rejects every malformed atom-codec payload with a stable data error", () => { + const decode = operation("_fuzz-decode-atom"); + const cases = [ + ['(FuzzEncodedAtom 2 (Symbol "a"))', "ExpectedVersion1"], + ["(FuzzEncodedAtom 1 malformed)", "MalformedPayload"], + ["(FuzzEncodedAtom 1 (Symbol 1))", "MalformedSymbol"], + ["(FuzzEncodedAtom 1 (Variable 1))", "MalformedVariable"], + ["(FuzzEncodedAtom 1 (Expression nope))", "MalformedExpression"], + ["(FuzzEncodedAtom 1 (Integer 1.0))", "MalformedInteger"], + ["(FuzzEncodedAtom 1 (Float64Bits 0 -1))", "MalformedFloat64Bits"], + ["(FuzzEncodedAtom 1 (String symbol))", "MalformedString"], + ["(FuzzEncodedAtom 1 (Boolean nope))", "MalformedBoolean"], + ["(FuzzEncodedAtom 1 (Unit extra))", "MalformedUnit"], + ["(FuzzEncodedAtom 1 (Error symbol))", "MalformedError"], + ["(FuzzEncodedAtom 1 (Unknown))", "UnknownPayloadTag"], + ] as const; + + for (const [source, detail] of cases) { + const encoded = parse(source, standardTokenizer()); + expect(encoded).toBeDefined(); + expect(format(oneResult(decode, [encoded!]))).toBe( + `(FuzzKernelError InvalidEncodedAtom (Operation _fuzz-decode-atom) ${detail})`, + ); + } + }); + + it("round-trips arbitrary nested replay atoms through printable codec data", () => { + fc.assert( + fc.property(replayableAtom, (original) => { + const encoded = oneResult(operation("_fuzz-encode-atom"), [original]); + const reparsed = parse(format(encoded), standardTokenizer()); + expect(reparsed).toBeDefined(); + const decoded = oneResult(operation("_fuzz-decode-atom"), [reparsed!]); + expect(format(oneResult(operation("_fuzz-replay-equal"), [original, decoded]))).toBe( + "True", + ); + }), + { numRuns: 1_000 }, + ); + }); + + it("canonicalizes variables by first occurrence for alpha keys", () => { + const left = expr([sym("pair"), variable("x"), variable("x"), variable("y")]); + const renamed = expr([sym("pair"), variable("a"), variable("a"), variable("b")]); + const different = expr([sym("pair"), variable("a"), variable("b"), variable("b")]); + + expect(atomKey("Exact", left)).not.toBe(atomKey("Exact", renamed)); + expect(atomKey("Alpha", left)).toBe(atomKey("Alpha", renamed)); + expect(atomKey("Alpha", left)).not.toBe(atomKey("Alpha", different)); + }); + + it("deduplicates exact atoms in stable order and confirms key collisions", () => { + expect( + printed(` + !(import! &self fuzz) + !(_fuzz-deduplicate-exact + (a b a $x $y $x 3 3.0 (pair a) (pair a))) + `), + ).toEqual([["()"], ["(a b $x $y 3 (pair a))"]]); + }); + + it("confirms exact membership after structural-key hits", () => { + const member = operation("_fuzz-exact-member"); + expect(format(oneResult(member, [variable("x"), expr([variable("y"), variable("x")])]))).toBe( + "True", + ); + expect(format(oneResult(member, [variable("z"), expr([variable("y"), variable("x")])]))).toBe( + "False", + ); + expect(format(oneResult(member, [gint(3), expr([gfloat(3)])]))).toBe("True"); + }); + + it("deduplicates and finds replay values by exact grounded kind and float payload", () => { + const firstNaN = floatFromBits(0x7ff8000000000017n); + const sameNaN = floatFromBits(0x7ff8000000000017n); + const secondNaN = floatFromBits(0x7ff8000000000018n); + const values = expr([firstNaN, sameNaN, secondNaN, gfloat(-0), gfloat(0), gint(3), gfloat(3)]); + const deduplicated = oneResult(operation("_fuzz-deduplicate-replay"), [values]); + expect(deduplicated.kind).toBe("expr"); + if (deduplicated.kind === "expr") expect(deduplicated.items).toHaveLength(6); + + const member = operation("_fuzz-replay-member"); + expect(format(oneResult(member, [sameNaN, deduplicated]))).toBe("True"); + expect(format(oneResult(member, [floatFromBits(0x7ff8000000000019n), deduplicated]))).toBe( + "False", + ); + expect(format(oneResult(member, [gfloat(-0), expr([gfloat(0)])]))).toBe("False"); + expect(format(oneResult(member, [gint(3), expr([gfloat(3)])]))).toBe("False"); + }); + + it("matches exact and alpha equality for replayable atoms", () => { + fc.assert( + fc.property(replayableAtom, replayableAtom, (left, right) => { + if (atomEq(left, right)) expect(atomKey("Exact", left)).toBe(atomKey("Exact", right)); + if (alphaEq(left, right)) expect(atomKey("Alpha", left)).toBe(atomKey("Alpha", right)); + }), + { numRuns: 1_000 }, + ); + }); + + it("compares custom replay values alpha-canonically and trees exactly", () => { + const equal = operation("_fuzz-custom-replay-equal"); + const sample = (value: Atom, tree: Atom): Atom => + expr([sym("FuzzSample"), value, expr([sym("FuzzDriver"), sym("Edge"), gint(1)]), tree]); + + const original = sample( + expr([sym("pair"), variable("left"), variable("left")]), + expr([sym("Decision"), sym("Same")]), + ); + const renamed = sample( + expr([sym("pair"), variable("right"), variable("right")]), + expr([sym("Decision"), sym("Same")]), + ); + const differentAliasing = sample( + expr([sym("pair"), variable("right"), variable("other")]), + expr([sym("Decision"), sym("Same")]), + ); + const differentTree = sample( + expr([sym("pair"), variable("right"), variable("right")]), + expr([sym("Decision"), sym("Changed")]), + ); + + expect(format(oneResult(equal, [original, renamed]))).toBe("True"); + expect(format(oneResult(equal, [original, differentAliasing]))).toBe("False"); + expect(format(oneResult(equal, [original, differentTree]))).toBe("False"); + }); + + it("updates grammar requirement summaries as immutable indexed data", () => { + const alternatives = operation("_fuzz-grammar-summary-alternatives"); + const replace = operation("_fuzz-grammar-summary-replace"); + const target = expr([sym("NT"), sym("A")]); + const closed = expr([sym("GrammarRequirementAlternative"), expr([])]); + const open = expr([ + sym("GrammarRequirementAlternative"), + expr([expr([sym("quote"), sym("Name")])]), + ]); + + const first = oneResult(replace, [expr([]), target, expr([closed])]); + const second = oneResult(replace, [first, sym("Other"), expr([open])]); + const replaced = oneResult(replace, [second, target, expr([open])]); + + expect(format(oneResult(alternatives, [first, target]))).toBe( + "(GrammarRequirementAlternatives ((GrammarRequirementAlternative ())))", + ); + expect(format(oneResult(alternatives, [first, sym("Missing")]))).toBe( + "(GrammarRequirementAlternatives ())", + ); + expect(format(oneResult(alternatives, [replaced, target]))).toBe( + "(GrammarRequirementAlternatives ((GrammarRequirementAlternative ((quote Name)))))", + ); + expect(format(replaced).match(/GrammarRequirementSummaryEntry/g)).toHaveLength(2); + expect(format(oneResult(alternatives, [expr([sym("malformed")]), target]))).toBe( + "(FuzzKernelError InvalidGrammarRequirementSummary (Operation _fuzz-grammar-summary-alternatives) MalformedEntry)", + ); + }); + + it("analyzes deep and wide templates without host recursion", () => { + const requirements = operation("_fuzz-grammar-template-requirements-op"); + const closed = "(GrammarRequirementAlternatives ((GrammarRequirementAlternative ())))"; + + let deep: Atom = expr([sym("Use"), sym("Name")]); + for (let depth = 0; depth < 20_000; depth += 1) deep = expr([sym("Bind"), sym("Name"), deep]); + expect(format(oneResult(requirements, [deep, expr([])]))).toBe(closed); + + const wide = expr([sym("tuple"), ...Array.from({ length: 20_000 }, () => sym("leaf"))]); + expect(format(oneResult(requirements, [wide, expr([])]))).toBe(closed); + }); + + it("builds stack-safe validation plans while preserving opaque marker payloads", () => { + const plan = operation("_fuzz-grammar-validation-plan"); + const planned = oneResult(plan, [ + expr([ + sym("tuple"), + expr([sym("Literal"), expr([sym("Ref"), sym("Missing")])]), + expr([sym("Field"), sym("generator")]), + expr([ + sym("Scoped"), + expr([expr([sym("Binding"), sym("Name"), gint(7)])]), + expr([sym("Use"), sym("Name")]), + ]), + expr([sym("Field")]), + ]), + ]); + + expect(format(planned)).toBe( + "(GrammarValidationPlan ((GrammarValidationField (quote generator)) (GrammarValidationScopedEnter (quote ((Binding Name 7)))) (GrammarValidationScopedExit) (GrammarValidationMalformed (quote (Field)))))", + ); + + const wide = expr([sym("tuple"), ...Array.from({ length: 20_000 }, () => sym("leaf"))]); + expect(format(oneResult(plan, [wide]))).toBe("(GrammarValidationPlan ())"); + }); + + it("extracts only semantic grammar references in source order", () => { + const references = operation("_fuzz-grammar-template-reference-plan"); + const planned = oneResult(references, [ + expr([ + sym("tuple"), + expr([sym("Literal"), expr([sym("Ref"), sym("Opaque")])]), + expr([sym("Ref"), sym("First")]), + expr([ + sym("Bind"), + expr([sym("Ref"), sym("OpaqueSort")]), + expr([sym("_FuzzGrammarRef"), sym("Second"), gint(0), gint(1)]), + ]), + expr([sym("Field"), expr([sym("gen-const"), expr([sym("Ref"), sym("Opaque")])])]), + ]), + ]); + + expect(format(planned)).toBe("(GrammarReferenceTargets ((quote First) (quote Second)))"); + }); + + it("reports grounded values that cannot be reconstructed from replay data", () => { + const external = gnd({ g: "ext", kind: "test", id: "opaque" }); + const executable = gnd({ g: "int", n: 1 }, sym("Number"), () => []); + const customType = gnd({ g: "str", s: "x" }, sym("Custom")); + + expect(format(oneResult(operation("_fuzz-atom-key"), [sym("Exact"), external]))).toBe( + "(FuzzKernelError NonReplayableGroundedValue ExternalGrounded)", + ); + expect(format(oneResult(operation("_fuzz-atom-key"), [sym("Exact"), executable]))).toBe( + "(FuzzKernelError NonReplayableGroundedValue ExecutableGrounded)", + ); + expect(format(oneResult(operation("_fuzz-atom-key"), [sym("Exact"), customType]))).toBe( + "(FuzzKernelError NonReplayableGroundedValue CustomGroundedType)", + ); + expect(format(oneResult(operation("_fuzz-encode-atom"), [external]))).toBe( + "(FuzzKernelError NonReplayableGroundedValue ExternalGrounded)", + ); + expect( + format(oneResult(operation("_fuzz-encode-atom"), [expr([sym("nested"), executable])])), + ).toBe("(FuzzKernelError NonReplayableGroundedValue ExecutableGrounded)"); + expect(format(oneResult(operation("_fuzz-encode-atom"), [customType]))).toBe( + "(FuzzKernelError NonReplayableGroundedValue CustomGroundedType)", + ); + }); + + it("encodes deep atoms without consuming the JavaScript call stack", () => { + let atom: Atom = sym("leaf"); + for (let depth = 0; depth < 20_000; depth += 1) atom = expr([sym("next"), atom]); + const key = atomKey("Exact", atom); + expect(key.startsWith("mettascript-atom-key-v1;E2:S4:next;")).toBe(true); + expect(key.endsWith("S4:leaf;")).toBe(true); + + const encoded = oneResult(operation("_fuzz-encode-atom"), [atom]); + const decoded = oneResult(operation("_fuzz-decode-atom"), [encoded]); + expect(format(oneResult(operation("_fuzz-replay-equal"), [atom, decoded]))).toBe("True"); + }); + + it("constructs stable generated variables in a reserved namespace", () => { + const make = operation("_fuzz-make-variable"); + expect(format(oneResult(make, [gint(0)]))).toBe("$fuzz-0"); + expect(format(oneResult(make, [gint(9_007_199_254_740_993n)]))).toBe("$fuzz-9007199254740993"); + expect(atomEq(oneResult(make, [gint(17)]), oneResult(make, [gint(17)]))).toBe(true); + }); + + it("materializes generated variable markers in a complete sample", () => { + const marker = operation("_fuzz-variable-marker"); + const containsMarker = operation("_fuzz-contains-variable-marker"); + const materialize = operation("_fuzz-materialize-grammar-sample"); + const sample = oneResult(materialize, [ + expr([ + sym("lambda"), + expr([ + oneResult(marker, [gint(0)]), + expr([sym("pair"), oneResult(marker, [gint(0)]), oneResult(marker, [gint(1)])]), + ]), + ]), + sym("driver"), + sym("tree"), + ]); + + expect(format(sample)).toBe( + "(FuzzSample (lambda ($fuzz-0 (pair $fuzz-0 $fuzz-1))) driver tree)", + ); + expect( + format( + oneResult(materialize, [ + gnd( + { g: "ext", kind: "mettascript-fuzz-variable-marker", id: "01" }, + sym("FuzzVariableMarker"), + ), + sym("driver"), + sym("tree"), + ]), + ), + ).toBe( + "(FuzzKernelError InvalidVariableMarker (Operation _fuzz-materialize-grammar-sample) ExpectedCanonicalNonNegativeInteger)", + ); + + let deep: Atom = oneResult(marker, [gint(9)]); + for (let depth = 0; depth < 20_000; depth += 1) deep = expr([sym("next"), deep]); + const deepSample = oneResult(materialize, [deep, sym("driver"), sym("tree")]); + let cursor = (deepSample as Extract).items[1]!; + for (let depth = 0; depth < 20_000; depth += 1) { + expect(cursor.kind).toBe("expr"); + cursor = (cursor as Extract).items[1]!; + } + expect(format(cursor)).toBe("$fuzz-9"); + expect(format(oneResult(containsMarker, [deep]))).toBe("True"); + expect( + format( + oneResult(containsMarker, [ + expr([sym("safe"), gnd({ g: "ext", kind: "other-marker", id: "9" })]), + ]), + ), + ).toBe("False"); + }); +}); + +describe("grammar machine kernel operations", () => { + const parsed = (source: string): Atom => { + const atom = parse(source, standardTokenizer()); + if (atom === undefined) throw new Error(`unparseable vector: ${source}`); + return atom; + }; + const golden = ( + name: (typeof FUZZ_OPERATIONS)[number], + args: readonly string[], + expected: string, + ): void => { + expect(format(oneResult(operation(name), args.map(parsed)))).toBe(expected); + }; + + it("adds requirement alternatives with dominance pruning", () => { + golden( + "_fuzz-grammar-alternatives-add", + ["()", "((quote A))"], + "(GrammarAlternativesAdd True ((GrammarRequirementAlternative ((quote A)))))", + ); + golden( + "_fuzz-grammar-alternatives-add", + ["((GrammarRequirementAlternative ()))", "((quote A))"], + "(GrammarAlternativesAdd False ((GrammarRequirementAlternative ())))", + ); + golden( + "_fuzz-grammar-alternatives-add", + ["((GrammarRequirementAlternative ((quote A) (quote B))))", "((quote A))"], + "(GrammarAlternativesAdd True ((GrammarRequirementAlternative ((quote A)))))", + ); + golden( + "_fuzz-grammar-alternatives-add", + ["((GrammarRequirementAlternative ((quote A))))", "((quote B))"], + "(GrammarAlternativesAdd True ((GrammarRequirementAlternative ((quote A))) (GrammarRequirementAlternative ((quote B)))))", + ); + golden( + "_fuzz-grammar-alternatives-add", + ["(broken)", "((quote A))"], + "(FuzzKernelError InvalidGrammarRequirementAlternatives (Operation _fuzz-grammar-alternatives-add) MalformedAlternative)", + ); + }); + + it("analyzes template requirements in one call", () => { + golden( + "_fuzz-grammar-template-requirements-op", + ["(pair (Literal x) (Field (GenBool)))", "()"], + "(GrammarRequirementAlternatives ((GrammarRequirementAlternative ())))", + ); + golden( + "_fuzz-grammar-template-requirements-op", + ["(pair (Use A) (Use B))", "()"], + "(GrammarRequirementAlternatives ((GrammarRequirementAlternative ((quote A) (quote B)))))", + ); + golden( + "_fuzz-grammar-template-requirements-op", + ["(Bind A (pair (Use A) (Use B)))", "()"], + "(GrammarRequirementAlternatives ((GrammarRequirementAlternative ((quote B)))))", + ); + golden( + "_fuzz-grammar-template-requirements-op", + [ + "(_FuzzGrammarRef T 0 1)", + "((GrammarRequirementSummaryEntry (quote T) ((GrammarRequirementAlternative ((quote S))))))", + ], + "(GrammarRequirementAlternatives ((GrammarRequirementAlternative ((quote S)))))", + ); + }); + + it("answers eligibility in one call", () => { + const productions = + "((GrammarProduction 0 1 (quote T) (quote (leaf))) (GrammarProduction 1 1 (quote T) (quote (Use S))) (GrammarProduction 2 1 (quote T) (quote (n (_FuzzGrammarRef T 0 1)))))"; + golden( + "_fuzz-grammar-eligible-productions-op", + [productions, "(quote T)", "()", "0"], + "(EligibleGrammarProductions ((GrammarProduction 0 1 (quote T) (quote (leaf)))))", + ); + golden( + "_fuzz-grammar-eligible-productions-op", + [productions, "(quote T)", "((GrammarBinding (quote S) 0))", "1"], + "(EligibleGrammarProductions ((GrammarProduction 0 1 (quote T) (quote (leaf))) (GrammarProduction 1 1 (quote T) (quote (Use S))) (GrammarProduction 2 1 (quote T) (quote (n (_FuzzGrammarRef T 0 1))))))", + ); + }); + + it("runs the grammar machine to done outcomes", () => { + const source = + "(StaticGrammar (quote G) ((GrammarProduction 0 1 (quote G) (quote (pair (Literal x) (Literal y))))))"; + golden( + "_fuzz-grammar-machine-op", + [`(GrammarMachineStart ${source} (quote G) () 0 (WithDriver (FuzzDriver Edge 0) 0))`], + "(GrammarMachineDone (GrammarResult (pair x y) (FuzzDriver Edge 1) 0 (Decision GrammarProduction (Target (quote G)) (ProductionIndex 0 0) ((Decision Int (Bounds 0 0) (Origin 0) (Value 0) ()) (Decision GrammarExpression (Arity 3) () ((Decision GrammarLiteral () (Value (quote pair)) ()) (Decision GrammarLiteral () (Value (quote x)) ()) (Decision GrammarLiteral () (Value (quote y)) ())))))))", + ); + golden( + "_fuzz-grammar-machine-op", + [ + `(GrammarMachineStart ${source} (quote G) () 0 (WithDriver (FuzzDriver Exhaustive (ExhaustiveCursor () 0 ())) 0))`, + ], + "(GrammarMachineDone (GrammarResult (pair x y) (FuzzDriver Exhaustive (ExhaustiveCursor () 1 ((ExhaustiveFrame 0 1)))) 0 (Decision GrammarProduction (Target (quote G)) (ProductionIndex 0 0) ((Decision Int (Bounds 0 0) (Origin 0) (Value 0) ()) (Decision GrammarExpression (Arity 3) () ((Decision GrammarLiteral () (Value (quote pair)) ()) (Decision GrammarLiteral () (Value (quote x)) ()) (Decision GrammarLiteral () (Value (quote y)) ())))))))", + ); + }); + + it("indexes productions by target", () => { + const productions = + "((GrammarProduction 0 1 (quote (T 0)) (quote leaf)) (GrammarProduction 1 2 (quote (T 1)) (quote (n (_FuzzGrammarRef (T 0) 0 1)))) (GrammarProduction 2 1 (quote (T 0)) (quote other)))"; + golden( + "_fuzz-grammar-productions-for-target", + [productions, "(quote (T 0))"], + "(GrammarProductions ((GrammarProduction 0 1 (quote (T 0)) (quote leaf)) (GrammarProduction 2 1 (quote (T 0)) (quote other))))", + ); + golden( + "_fuzz-grammar-productions-for-target", + [productions, "(quote Missing)"], + "(GrammarProductions ())", + ); + }); + + it("indexes referencing productions and seeds index stacks", () => { + const productions = + "((GrammarProduction 0 1 (quote (T 0)) (quote (n (_FuzzGrammarRef (T 1) 0 1)))) (GrammarProduction 1 1 (quote (T 1)) (quote (m (_FuzzGrammarRef (T 1) 0 2) (_FuzzGrammarRef (T 0) 1 2)))) (GrammarProduction 2 1 (quote (T 1)) (quote bottom)))"; + golden( + "_fuzz-grammar-dependents-of", + [productions, "(quote (T 1))"], + "(GrammarDependents (0 1))", + ); + golden( + "_fuzz-grammar-dependents-of", + [productions, "(quote (T 0))"], + "(GrammarDependents (1))", + ); + golden( + "_fuzz-grammar-dependents-of", + [productions, "(quote Missing)"], + "(GrammarDependents ())", + ); + golden("_fuzz-index-stack", ["3"], "(FuzzStack 0 (FuzzStack 1 (FuzzStack 2 FuzzStackBottom)))"); + golden("_fuzz-index-stack", ["0"], "FuzzStackBottom"); + }); + + it("compiles templates to postorder instruction plans", () => { + golden( + "_fuzz-grammar-template-plan", + ["(pair (Literal x) (Field (GenBool)))"], + "(GrammarTemplatePlan ((GIExprEnter 3) (GILit (quote pair)) (GILit (quote x)) (GIField (GenBool)) (GIExprBuild)))", + ); + golden( + "_fuzz-grammar-template-plan", + ["(lambda (Bind Name (Use Name)))"], + "(GrammarTemplatePlan ((GIExprEnter 2) (GILit (quote lambda)) (GIBind (quote Name) ((GIUse (quote Name)))) (GIExprBuild)))", + ); + golden( + "_fuzz-grammar-template-plan", + ["(Scoped ((Binding Name 2)) (pair (Use Name) (Fresh Name)))"], + "(GrammarTemplatePlan ((GIScoped ((GrammarBinding (quote Name) 2)) 3 (quote ((Binding Name 2))) ((GIExprEnter 3) (GILit (quote pair)) (GIUse (quote Name)) (GIFresh (quote Name)) (GIExprBuild)))))", + ); + golden( + "_fuzz-grammar-template-plan", + ["(_FuzzGrammarRef (T 4) 1 3)"], + "(GrammarTemplatePlan ((GIRef (quote (T 4)) 1 3)))", + ); + golden( + "_fuzz-grammar-template-plan", + ["()"], + "(GrammarTemplatePlan ((GIExprEnter 0) (GIExprBuild)))", + ); + golden("_fuzz-grammar-template-plan", ["leaf"], "(GrammarTemplatePlan ((GILit (quote leaf))))"); + + const template = parsed("(pair (Literal x) (Field (GenBool)))"); + const first = oneResult(operation("_fuzz-grammar-template-plan"), [template]); + const second = oneResult(operation("_fuzz-grammar-template-plan"), [template]); + expect(second).toBe(first); + }); + + it("takes machine stack segments in forward order", () => { + golden( + "_fuzz-stack-take", + ["(FuzzStack c (FuzzStack b (FuzzStack a FuzzStackBottom)))", "2"], + "(FuzzStackTake (b c) (FuzzStack a FuzzStackBottom))", + ); + golden( + "_fuzz-stack-take", + ["(FuzzStack a FuzzStackBottom)", "0"], + "(FuzzStackTake () (FuzzStack a FuzzStackBottom))", + ); + golden( + "_fuzz-stack-take", + ["(FuzzStack a FuzzStackBottom)", "2"], + "(FuzzKernelError InvalidStackTake (Operation _fuzz-stack-take) StackUnderflow)", + ); + golden( + "_fuzz-stack-push-all", + ["FuzzStackBottom", "(a b c)"], + "(FuzzStack a (FuzzStack b (FuzzStack c FuzzStackBottom)))", + ); + }); +}); diff --git a/packages/fuzz/src/kernel.ts b/packages/fuzz/src/kernel.ts new file mode 100644 index 0000000..2dc8364 --- /dev/null +++ b/packages/fuzz/src/kernel.ts @@ -0,0 +1,4212 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import { + type Atom, + type GroundFn, + type ReduceResult, + atomEq, + expr, + gbool, + gfloat, + gint, + gnd, + groundType, + gstr, + gunit, + registerBuiltinGroundedOperation, + sym, + variable, +} from "@mettascript/core"; +import { uniformBigInt } from "pure-rand/distribution/uniformBigInt"; +import { xorshift128plus, xorshift128plusFromState } from "pure-rand/generator/xorshift128plus"; + +export const FUZZ_RNG_ALGORITHM = "xorshift128plus-v1"; +export const FUZZ_ATOM_KEY_ALGORITHM = "mettascript-atom-key-v1"; +export const FUZZ_REPLAY_KEY_ALGORITHM = "mettascript-replay-key-v1"; +export const FUZZ_ALPHA_REPLAY_KEY_ALGORITHM = "mettascript-alpha-replay-key-v1"; +export const FUZZ_ATOM_CODEC_VERSION = 1; + +const RNG_HEAD = sym("FuzzRng"); +const RNG_ALGORITHM = sym(FUZZ_RNG_ALGORITHM); +const DRAW_HEAD = sym("FuzzDraw"); +const ERROR_HEAD = sym("FuzzKernelError"); +const FLOAT_BITS_HEAD = sym("Float64Bits"); +const FLOAT_INDEX_HEAD = sym("Float64Index"); +const ENCODED_ATOM_HEAD = sym("FuzzEncodedAtom"); +const ENCODED_SYMBOL = sym("Symbol"); +const ENCODED_VARIABLE = sym("Variable"); +const ENCODED_EXPRESSION = sym("Expression"); +const ENCODED_INTEGER = sym("Integer"); +const ENCODED_FLOAT = sym("Float64Bits"); +const ENCODED_STRING = sym("String"); +const ENCODED_BOOLEAN = sym("Boolean"); +const ENCODED_UNIT = sym("Unit"); +const ENCODED_ERROR = sym("Error"); +const FUZZ_SAMPLE_HEAD = sym("FuzzSample"); +const FUZZ_GENERATION_DISCARD_HEAD = sym("FuzzGenerationDiscard"); +const FUZZ_GENERATION_ERROR_HEAD = sym("FuzzGenerationError"); +const FUZZ_DRIVER_HEAD = sym("FuzzDriver"); +const CUSTOM_REPLAY_TREE_HEAD = sym("CustomReplayTree"); +const CUSTOM_REPLAY_SKIP_HEAD = sym("CustomReplaySkip"); +const CUSTOM_REPLAY_PROTOCOL_ERROR_HEAD = sym("CustomReplayProtocolError"); +const GRAMMAR_FIELD_EXPRESSIONS_HEAD = sym("GrammarFieldExpressions"); +const GRAMMAR_TEMPLATE_PROFILE_HEAD = sym("GrammarTemplateProfile"); +const GRAMMAR_REQUIREMENT_ALTERNATIVES_HEAD = sym("GrammarRequirementAlternatives"); +const GRAMMAR_REQUIREMENT_ALTERNATIVE_HEAD = sym("GrammarRequirementAlternative"); +const GRAMMAR_REQUIREMENT_SUMMARY_ENTRY_HEAD = sym("GrammarRequirementSummaryEntry"); +const GRAMMAR_VALIDATION_PLAN_HEAD = sym("GrammarValidationPlan"); +const GRAMMAR_VALIDATION_FIELD_HEAD = sym("GrammarValidationField"); +const GRAMMAR_VALIDATION_SCOPED_ENTER_HEAD = sym("GrammarValidationScopedEnter"); +const GRAMMAR_VALIDATION_SCOPED_EXIT_HEAD = sym("GrammarValidationScopedExit"); +const GRAMMAR_VALIDATION_MALFORMED_HEAD = sym("GrammarValidationMalformed"); +const GRAMMAR_REFERENCE_TARGETS_HEAD = sym("GrammarReferenceTargets"); +const GRAMMAR_INDEXED_REFERENCE_HEAD = sym("_FuzzGrammarRef"); +const GRAMMAR_ALTERNATIVES_ADD_HEAD = sym("GrammarAlternativesAdd"); +const GRAMMAR_PRODUCTIONS_HEAD = sym("GrammarProductions"); +const GRAMMAR_TEMPLATE_PLAN_HEAD = sym("GrammarTemplatePlan"); +const GI_LIT_HEAD = sym("GILit"); +const GI_FIELD_HEAD = sym("GIField"); +const GI_REF_HEAD = sym("GIRef"); +const GI_FRESH_HEAD = sym("GIFresh"); +const GI_USE_HEAD = sym("GIUse"); +const GI_BIND_HEAD = sym("GIBind"); +const GI_SCOPED_HEAD = sym("GIScoped"); +const GI_EXPR_ENTER_HEAD = sym("GIExprEnter"); +const GI_EXPR_BUILD_HEAD = sym("GIExprBuild"); +const FUZZ_STACK_HEAD = sym("FuzzStack"); +const FUZZ_STACK_TAKE_HEAD = sym("FuzzStackTake"); +const FUZZ_EXPRESSION_VIEW_HEAD = sym("FuzzExpressionView"); +const FUZZ_ATOM_LEAF_HEAD = sym("FuzzAtomLeaf"); +const QUOTE_HEAD = sym("quote"); +const FUZZ_VARIABLE_MARKER_TYPE = sym("FuzzVariableMarker"); +const FUZZ_VARIABLE_MARKER_KIND = "mettascript-fuzz-variable-marker"; +const UNICODE_SCALAR_COUNT = 1_112_062n; +const UNICODE_FIRST_GAP_INDEX = 55_296n; +const UNICODE_SECOND_GAP_INDEX = 63_486n; +const GRAMMAR_RESERVED_TEMPLATE_HEADS = new Set([ + "Literal", + "Field", + "Ref", + "Fresh", + "Use", + "Bind", + "Scoped", +]); +const MIN_I32 = -0x80000000; +const MAX_I32 = 0x7fffffff; +const F64_SIGN_BIT = 1n << 63n; +const F64_MAGNITUDE_MASK = F64_SIGN_BIT - 1n; +const F64_POSITIVE_INFINITY_BITS = 0x7ff0000000000000n; +const F64_MIN_INDEX = -F64_POSITIVE_INFINITY_BITS - 1n; +const F64_MAX_INDEX = F64_POSITIVE_INFINITY_BITS; +const floatBuffer = new ArrayBuffer(8); +const floatView = new DataView(floatBuffer); + +type RngState = readonly [number, number, number, number]; +type KeyMode = "Exact" | "Alpha" | "Replay" | "AlphaReplay"; +type KeyResult = + | { readonly ok: true; readonly key: string } + | { readonly ok: false; readonly reason: Atom }; +type DecodePayload = + | { readonly tag: "atom"; readonly atom: Atom } + | { readonly tag: "expression"; readonly children: readonly Atom[] } + | { readonly tag: "error"; readonly error: Atom }; + +const ok = (result: Atom): ReduceResult => ({ tag: "ok", results: [result] }); + +// Narrows the `parsed-list | kernel-error-atom` unions the parsing helpers return; +// `Array.isArray` alone does not narrow a readonly array out of such a union. +function isErrorAtom(value: readonly T[] | Atom): value is Atom { + return !Array.isArray(value); +} + +function kernelError(code: string, ...details: Atom[]): Atom { + return expr([ERROR_HEAD, sym(code), ...details]); +} + +function operationError(code: string, operation: string, detail: string): ReduceResult { + return ok(kernelError(code, expr([sym("Operation"), sym(operation)]), sym(detail))); +} + +function arityError(operation: string, expected: number, actual: number): ReduceResult { + return ok( + kernelError( + "InvalidArity", + expr([sym("Operation"), sym(operation)]), + expr([sym("Expected"), gint(expected)]), + expr([sym("Actual"), gint(actual)]), + ), + ); +} + +function exactIntegerValue(atom: Atom): bigint | undefined { + return atom.kind === "gnd" && atom.value.g === "int" ? BigInt(atom.value.n) : undefined; +} + +function integralNumberValue(atom: Atom): bigint | undefined { + const exact = exactIntegerValue(atom); + if (exact !== undefined) return exact; + if ( + atom.kind !== "gnd" || + atom.value.g !== "float" || + !Number.isFinite(atom.value.n) || + !Number.isInteger(atom.value.n) + ) + return undefined; + return BigInt(atom.value.n); +} + +function floatValue(atom: Atom): number | undefined { + return atom.kind === "gnd" && atom.value.g === "float" ? atom.value.n : undefined; +} + +function float64Bits(value: number): bigint { + floatView.setFloat64(0, value, false); + return (BigInt(floatView.getUint32(0, false)) << 32n) | BigInt(floatView.getUint32(4, false)); +} + +function float64FromBits(bits: bigint): number { + floatView.setUint32(0, Number(bits >> 32n), false); + floatView.setUint32(4, Number(bits & 0xffffffffn), false); + return floatView.getFloat64(0, false); +} + +function float64Words(value: number): readonly [bigint, bigint] { + const bits = float64Bits(value); + return [bits >> 32n, bits & 0xffffffffn]; +} + +function unsigned32Value(atom: Atom): bigint | undefined { + const value = exactIntegerValue(atom); + return value !== undefined && value >= 0n && value <= 0xffffffffn ? value : undefined; +} + +function float64FromWords(high: bigint, low: bigint): number { + return float64FromBits((high << 32n) | low); +} + +function float64Index(value: number): bigint | undefined { + if (Number.isNaN(value)) return undefined; + const bits = float64Bits(value); + const magnitude = bits & F64_MAGNITUDE_MASK; + return (bits & F64_SIGN_BIT) === 0n ? magnitude : -magnitude - 1n; +} + +function float64FromIndex(index: bigint): number | undefined { + if (index < F64_MIN_INDEX || index > F64_MAX_INDEX) return undefined; + const bits = index < 0n ? F64_SIGN_BIT | (-index - 1n) : index; + return float64FromBits(bits); +} + +function rngStateAtom(state: readonly number[]): Atom { + return expr([RNG_HEAD, RNG_ALGORITHM, ...state.map(gint)]); +} + +function parseRngState(atom: Atom): RngState | undefined { + if ( + atom.kind !== "expr" || + atom.items.length !== 6 || + !atomEq(atom.items[0]!, RNG_HEAD) || + !atomEq(atom.items[1]!, RNG_ALGORITHM) + ) { + return undefined; + } + const state: number[] = []; + for (const part of atom.items.slice(2)) { + const value = exactIntegerValue(part); + if (value === undefined || value < BigInt(MIN_I32) || value > BigInt(MAX_I32)) return undefined; + state.push(Number(value)); + } + if (state.every((value) => value === 0)) return undefined; + return [state[0]!, state[1]!, state[2]!, state[3]!]; +} + +const rngInit: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-rng-init", 1, args.length); + const seed = integralNumberValue(args[0]!); + if (seed === undefined) return operationError("InvalidSeed", "_fuzz-rng-init", "ExpectedInteger"); + const seed32 = Number(BigInt.asIntN(32, seed)); + return ok(rngStateAtom(xorshift128plus(seed32).getState())); +}; + +const drawInt: GroundFn = (args) => { + if (args.length !== 3) return arityError("_fuzz-draw-int", 3, args.length); + const state = parseRngState(args[0]!); + if (state === undefined) + return operationError("InvalidRngState", "_fuzz-draw-int", "ExpectedFuzzRng"); + const lower = integralNumberValue(args[1]!); + const upper = integralNumberValue(args[2]!); + if (lower === undefined || upper === undefined) + return operationError("InvalidBounds", "_fuzz-draw-int", "ExpectedIntegers"); + if (lower > upper) return operationError("InvalidBounds", "_fuzz-draw-int", "LowerExceedsUpper"); + + const rng = xorshift128plusFromState(state); + const value = uniformBigInt(rng, lower, upper); + return ok(expr([DRAW_HEAD, gint(value), rngStateAtom(rng.getState())])); +}; + +function lengthPrefixed(tag: string, value: string): string { + return `${tag}${value.length}:${value};`; +} + +function nonReplayable(reason: string): KeyResult { + return { + ok: false, + reason: kernelError("NonReplayableGroundedValue", sym(reason)), + }; +} + +function groundedKey(atom: Extract, mode: KeyMode): KeyResult { + if (atom.value.g === "ext") return nonReplayable("ExternalGrounded"); + if (atom.exec !== undefined) return nonReplayable("ExecutableGrounded"); + if (atom.match !== undefined) return nonReplayable("CustomMatcher"); + if (!atomEq(atom.typ, groundType(atom.value))) return nonReplayable("CustomGroundedType"); + + // The two switches below are deliberately parallel rather than factored together. They agree on the + // scalar kinds and differ on numbers, which is the whole point: a replay key must separate values a + // rerun has to reproduce exactly, so an integer keeps its own kind and a float keys on its bits, while + // an identity key must match core's numeric equality and keys both on the Number projection. Sharing + // the agreeing arms would save four lines and hide the one distinction a reader has to check. + if (mode === "Replay" || mode === "AlphaReplay") { + switch (atom.value.g) { + case "int": + return { ok: true, key: `I${atom.value.n};` }; + case "float": + return { ok: true, key: `F${float64Bits(atom.value.n).toString(16).padStart(16, "0")};` }; + case "str": + return { ok: true, key: lengthPrefixed("T", atom.value.s) }; + case "bool": + return { ok: true, key: atom.value.b ? "B1;" : "B0;" }; + case "unit": + return { ok: true, key: "U;" }; + case "error": + return { ok: true, key: lengthPrefixed("R", atom.value.msg) }; + } + } + + switch (atom.value.g) { + case "int": + case "float": + // Core numeric equality compares the Number projection across integer and float kinds. Matching + // that projection avoids false negatives; large integers can share a bucket, so consumers still + // confirm a key hit with exact atom equality. + return { ok: true, key: lengthPrefixed("N", String(Number(atom.value.n))) }; + case "str": + return { ok: true, key: lengthPrefixed("T", atom.value.s) }; + case "bool": + return { ok: true, key: atom.value.b ? "B1;" : "B0;" }; + case "unit": + return { ok: true, key: "U;" }; + case "error": + return { ok: true, key: lengthPrefixed("R", atom.value.msg) }; + } +} + +function structuralAtomKey(atom: Atom, mode: KeyMode): KeyResult { + const algorithm = + mode === "Replay" + ? FUZZ_REPLAY_KEY_ALGORITHM + : mode === "AlphaReplay" + ? FUZZ_ALPHA_REPLAY_KEY_ALGORITHM + : FUZZ_ATOM_KEY_ALGORITHM; + const output = [`${algorithm};`]; + const variables = new Map(); + const pending: Atom[] = [atom]; + + while (pending.length > 0) { + const current = pending.pop()!; + switch (current.kind) { + case "sym": + output.push(lengthPrefixed("S", current.name)); + break; + case "var": { + let name = current.name; + if (mode === "Alpha" || mode === "AlphaReplay") { + const known = variables.get(name); + if (known === undefined) { + name = `%${variables.size}`; + variables.set(current.name, name); + } else { + name = known; + } + } + output.push(lengthPrefixed("V", name)); + break; + } + case "expr": + output.push(`E${current.items.length}:`); + for (let index = current.items.length - 1; index >= 0; index -= 1) { + pending.push(current.items[index]!); + } + break; + case "gnd": { + const encoded = groundedKey(current, mode); + if (!encoded.ok) return encoded; + output.push(encoded.key); + break; + } + } + } + return { ok: true, key: output.join("") }; +} + +const atomKey: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-atom-key", 2, args.length); + const mode = args[0]!; + if ( + mode.kind !== "sym" || + (mode.name !== "Exact" && + mode.name !== "Alpha" && + mode.name !== "Replay" && + mode.name !== "AlphaReplay") + ) + return operationError("InvalidKeyMode", "_fuzz-atom-key", "ExpectedKeyMode"); + const result = structuralAtomKey(args[1]!, mode.name); + return ok(result.ok ? gstr(result.key) : result.reason); +}; + +function atomsEqualForKeyMode(left: Atom, right: Atom, mode: "Exact" | "Replay"): boolean { + return mode === "Replay" ? replayAtomEqual(left, right) : atomEq(left, right); +} + +function deduplicateAtoms( + args: readonly Atom[], + operation: "_fuzz-deduplicate-exact" | "_fuzz-deduplicate-replay", + mode: "Exact" | "Replay", +): ReduceResult { + if (args.length !== 1) return arityError(operation, 1, args.length); + const values = args[0]!; + if (values.kind !== "expr") + return operationError("InvalidDeduplicationInput", operation, "ExpectedExpression"); + + const buckets = new Map(); + const unique: Atom[] = []; + for (const value of values.items) { + const encoded = structuralAtomKey(value, mode); + if (!encoded.ok) return ok(encoded.reason); + const bucket = buckets.get(encoded.key); + if (bucket?.some((seen) => atomsEqualForKeyMode(seen, value, mode)) === true) continue; + if (bucket === undefined) buckets.set(encoded.key, [value]); + else bucket.push(value); + unique.push(value); + } + return ok(expr(unique)); +} + +const deduplicateExact: GroundFn = (args) => + deduplicateAtoms(args, "_fuzz-deduplicate-exact", "Exact"); + +const deduplicateReplay: GroundFn = (args) => + deduplicateAtoms(args, "_fuzz-deduplicate-replay", "Replay"); + +function memberAtom( + args: readonly Atom[], + operation: "_fuzz-exact-member" | "_fuzz-replay-member", + mode: "Exact" | "Replay", +): ReduceResult { + if (args.length !== 2) return arityError(operation, 2, args.length); + const values = args[1]!; + if (values.kind !== "expr") + return operationError("InvalidMembershipInput", operation, "ExpectedExpression"); + + const needle = args[0]!; + const needleKey = structuralAtomKey(needle, mode); + if (!needleKey.ok) return ok(needleKey.reason); + for (const value of values.items) { + const valueKey = structuralAtomKey(value, mode); + if (!valueKey.ok) return ok(valueKey.reason); + if (valueKey.key === needleKey.key && atomsEqualForKeyMode(value, needle, mode)) + return ok(gbool(true)); + } + return ok(gbool(false)); +} + +const exactMember: GroundFn = (args) => memberAtom(args, "_fuzz-exact-member", "Exact"); + +const replayMember: GroundFn = (args) => memberAtom(args, "_fuzz-replay-member", "Replay"); + +const makeVariable: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-make-variable", 1, args.length); + const index = integralNumberValue(args[0]!); + if (index === undefined || index < 0n) + return operationError( + "InvalidVariableIndex", + "_fuzz-make-variable", + "ExpectedNonNegativeInteger", + ); + return ok(variable(`fuzz-${index}`)); +}; + +const variableMarker: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-variable-marker", 1, args.length); + const index = integralNumberValue(args[0]!); + if (index === undefined || index < 0n) + return operationError( + "InvalidVariableIndex", + "_fuzz-variable-marker", + "ExpectedNonNegativeInteger", + ); + return ok( + gnd( + { g: "ext", kind: FUZZ_VARIABLE_MARKER_KIND, id: index.toString() }, + FUZZ_VARIABLE_MARKER_TYPE, + ), + ); +}; + +const containsVariableMarker: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-contains-variable-marker", 1, args.length); + const pending: Atom[] = [args[0]!]; + while (pending.length > 0) { + const atom = pending.pop()!; + if ( + atom.kind === "gnd" && + atom.value.g === "ext" && + atom.value.kind === FUZZ_VARIABLE_MARKER_KIND + ) { + return ok(gbool(true)); + } + if (atom.kind !== "expr") continue; + for (let index = atom.items.length - 1; index >= 0; index -= 1) + pending.push(atom.items[index]!); + } + return ok(gbool(false)); +}; + +type MaterializedAtom = + | { readonly ok: true; readonly atom: Atom } + | { readonly ok: false; readonly error: Atom }; + +function materializeGeneratedVariables(root: Atom): MaterializedAtom { + type Frame = { + readonly children: readonly Atom[]; + index: number; + readonly materialized: Atom[]; + }; + + const frames: Frame[] = []; + let current = root; + let completed: Atom | undefined; + + for (;;) { + if ( + current.kind === "gnd" && + current.value.g === "ext" && + current.value.kind === FUZZ_VARIABLE_MARKER_KIND + ) { + let index: bigint; + try { + index = BigInt(current.value.id); + } catch { + index = -1n; + } + if (index < 0n || index.toString() !== current.value.id) + return { + ok: false, + error: kernelError( + "InvalidVariableMarker", + expr([sym("Operation"), sym("_fuzz-materialize-grammar-sample")]), + sym("ExpectedCanonicalNonNegativeInteger"), + ), + }; + completed = variable(`fuzz-${index}`); + } else if (current.kind === "expr") { + if (current.items.length > 0) { + frames.push({ children: current.items, index: 1, materialized: [] }); + current = current.items[0]!; + continue; + } else { + completed = current; + } + } else { + completed = current; + } + + for (;;) { + const frame = frames.at(-1); + if (frame === undefined) return { ok: true, atom: completed }; + frame.materialized.push(completed); + if (frame.index < frame.children.length) { + current = frame.children[frame.index]!; + frame.index += 1; + break; + } + frames.pop(); + completed = expr(frame.materialized); + } + } +} + +const materializeGrammarSample: GroundFn = (args) => { + if (args.length !== 3) return arityError("_fuzz-materialize-grammar-sample", 3, args.length); + const materialized = materializeGeneratedVariables(args[0]!); + if (!materialized.ok) return ok(materialized.error); + return ok(expr([FUZZ_SAMPLE_HEAD, materialized.atom, args[1]!, args[2]!])); +}; + +const appendExpressionItem: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-expression-append", 2, args.length); + const values = args[0]!; + if (values.kind !== "expr") + return operationError( + "InvalidExpressionAppendInput", + "_fuzz-expression-append", + "ExpectedExpression", + ); + return ok(expr([...values.items, args[1]!])); +}; + +const concatenateExpressions: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-expression-concat", 2, args.length); + const [left, right] = args; + if (left!.kind !== "expr" || right!.kind !== "expr") + return operationError( + "InvalidExpressionConcatInput", + "_fuzz-expression-concat", + "ExpectedExpressions", + ); + return ok(expr([...left!.items, ...right!.items])); +}; + +type GrammarSummaryEntry = { + readonly target: Atom; + readonly alternatives: Extract; + readonly encoded: Atom; +}; + +function grammarSummaryEntries( + summary: Atom, + operation: string, +): readonly GrammarSummaryEntry[] | Atom { + if (summary.kind !== "expr") + return kernelError( + "InvalidGrammarRequirementSummary", + expr([sym("Operation"), sym(operation)]), + sym("ExpectedExpression"), + ); + + const entries: GrammarSummaryEntry[] = []; + for (const encoded of summary.items) { + if ( + encoded.kind !== "expr" || + encoded.items.length !== 3 || + encoded.items[0]!.kind !== "sym" || + encoded.items[0]!.name !== GRAMMAR_REQUIREMENT_SUMMARY_ENTRY_HEAD.name + ) { + return kernelError( + "InvalidGrammarRequirementSummary", + expr([sym("Operation"), sym(operation)]), + sym("MalformedEntry"), + ); + } + const quotedTarget = encoded.items[1]!; + const alternatives = encoded.items[2]!; + if ( + quotedTarget.kind !== "expr" || + quotedTarget.items.length !== 2 || + quotedTarget.items[0]!.kind !== "sym" || + quotedTarget.items[0]!.name !== QUOTE_HEAD.name || + alternatives.kind !== "expr" + ) { + return kernelError( + "InvalidGrammarRequirementSummary", + expr([sym("Operation"), sym(operation)]), + sym("MalformedEntry"), + ); + } + for (const alternative of alternatives.items) { + if ( + alternative.kind !== "expr" || + alternative.items.length !== 2 || + alternative.items[0]!.kind !== "sym" || + alternative.items[0]!.name !== GRAMMAR_REQUIREMENT_ALTERNATIVE_HEAD.name || + alternative.items[1]!.kind !== "expr" + ) { + return kernelError( + "InvalidGrammarRequirementSummary", + expr([sym("Operation"), sym(operation)]), + sym("MalformedAlternative"), + ); + } + } + entries.push({ + target: quotedTarget.items[1]!, + alternatives, + encoded, + }); + } + return entries; +} + +const grammarSummaryAlternatives: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-grammar-summary-alternatives", 2, args.length); + const entries = grammarSummaryEntries(args[0]!, "_fuzz-grammar-summary-alternatives"); + if (isErrorAtom(entries)) return ok(entries); + const found = entries.find((entry) => atomEq(entry.target, args[1]!)); + return ok(expr([GRAMMAR_REQUIREMENT_ALTERNATIVES_HEAD, found?.alternatives ?? expr([])])); +}; + +const grammarSummaryReplace: GroundFn = (args) => { + if (args.length !== 3) return arityError("_fuzz-grammar-summary-replace", 3, args.length); + const entries = grammarSummaryEntries(args[0]!, "_fuzz-grammar-summary-replace"); + if (isErrorAtom(entries)) return ok(entries); + const alternatives = args[2]!; + if (alternatives.kind !== "expr") + return operationError( + "InvalidGrammarRequirementSummary", + "_fuzz-grammar-summary-replace", + "ExpectedAlternativesExpression", + ); + for (const alternative of alternatives.items) { + if ( + alternative.kind !== "expr" || + alternative.items.length !== 2 || + alternative.items[0]!.kind !== "sym" || + alternative.items[0]!.name !== GRAMMAR_REQUIREMENT_ALTERNATIVE_HEAD.name || + alternative.items[1]!.kind !== "expr" + ) { + return operationError( + "InvalidGrammarRequirementSummary", + "_fuzz-grammar-summary-replace", + "MalformedAlternative", + ); + } + } + + const replacement = expr([ + GRAMMAR_REQUIREMENT_SUMMARY_ENTRY_HEAD, + expr([QUOTE_HEAD, args[1]!]), + alternatives, + ]); + const updated: Atom[] = []; + let replaced = false; + for (const entry of entries) { + if (atomEq(entry.target, args[1]!)) { + if (!replaced) updated.push(replacement); + replaced = true; + } else { + updated.push(entry.encoded); + } + } + if (!replaced) updated.push(replacement); + return ok(expr(updated)); +}; + +const expressionView: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-expression-view", 1, args.length); + const atom = args[0]!; + if (atom.kind !== "expr") return ok(expr([FUZZ_ATOM_LEAF_HEAD])); + const quoted = atom.items.map((item) => expr([QUOTE_HEAD, item])); + return ok( + expr([ + FUZZ_EXPRESSION_VIEW_HEAD, + expr([sym("Arity"), gint(atom.items.length)]), + expr([sym("Forward"), expr(quoted)]), + expr([sym("Reversed"), expr([...quoted].reverse())]), + ]), + ); +}; + +function grammarTemplateChildIndices(atom: Atom): readonly number[] { + if (atom.kind !== "expr" || atom.items.length === 0 || atom.items[0]!.kind !== "sym") return []; + const head = atom.items[0]!.name; + if ( + head === "Literal" || + head === "Field" || + head === "Ref" || + head === "Fresh" || + head === "Use" + ) + return []; + if (head === "Bind" && atom.items.length === 3) return [2]; + if (head === "Scoped" && atom.items.length === 3) return [2]; + return atom.items.map((_, index) => index); +} + +// Walks a template's relevant children without host recursion, visiting every two-item +// expression headed by `leafHead` and descending everywhere else. +function scanTemplateLeaves( + root: Atom, + leafHead: string, + visit: (leaf: Extract) => void, +): void { + const pending: Atom[] = [root]; + while (pending.length > 0) { + const atom = pending.pop()!; + if ( + atom.kind === "expr" && + atom.items.length === 2 && + atom.items[0]!.kind === "sym" && + atom.items[0]!.name === leafHead + ) { + visit(atom); + continue; + } + const indices = grammarTemplateChildIndices(atom); + for (let index = indices.length - 1; index >= 0; index -= 1) + pending.push((atom as Extract).items[indices[index]!]!); + } +} + +// Bottom-up template rewrite without host recursion: every two-item expression headed by +// `leafHead` is replaced with `rewrite(leaf)`, every other node is rebuilt around its +// template-relevant children. `rewrite` returning null aborts the walk and the caller reports +// its own error. +function rewriteTemplateLeaves( + root: Atom, + leafHead: string, + rewrite: (leaf: Extract) => Atom | null, +): Atom | null { + type Task = + | { readonly tag: "visit"; readonly atom: Atom } + | { + readonly tag: "build"; + readonly atom: Extract; + readonly indices: readonly number[]; + }; + const pending: Task[] = [{ tag: "visit", atom: root }]; + const completed: Atom[] = []; + while (pending.length > 0) { + const task = pending.pop()!; + if (task.tag === "build") { + const built = completed.splice(completed.length - task.indices.length, task.indices.length); + const items = [...task.atom.items]; + for (let index = 0; index < task.indices.length; index += 1) + items[task.indices[index]!] = built[index]!; + completed.push(expr(items)); + continue; + } + + const atom = task.atom; + if ( + atom.kind === "expr" && + atom.items.length === 2 && + atom.items[0]!.kind === "sym" && + atom.items[0]!.name === leafHead + ) { + const replaced = rewrite(atom); + if (replaced === null) return null; + completed.push(replaced); + continue; + } + + const indices = grammarTemplateChildIndices(atom); + if (indices.length === 0 || atom.kind !== "expr") { + completed.push(atom); + continue; + } + pending.push({ tag: "build", atom, indices }); + for (let index = indices.length - 1; index >= 0; index -= 1) + pending.push({ tag: "visit", atom: atom.items[indices[index]!]! }); + } + return completed[0]!; +} + +const grammarFieldExpressions: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-field-expressions", 1, args.length); + const fields: Atom[] = []; + scanTemplateLeaves(args[0]!, "Field", (field) => { + fields.push(expr([QUOTE_HEAD, field.items[1]!])); + }); + return ok(expr([GRAMMAR_FIELD_EXPRESSIONS_HEAD, expr(fields)])); +}; + +const replaceGrammarFields: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-grammar-replace-fields", 2, args.length); + const replacements = args[1]!; + if (replacements.kind !== "expr") + return operationError( + "InvalidGrammarFieldReplacements", + "_fuzz-grammar-replace-fields", + "ExpectedExpression", + ); + + let replacementIndex = 0; + const rebuilt = rewriteTemplateLeaves(args[0]!, "Field", (field) => { + const replacement = replacements.items[replacementIndex]; + if (replacement === undefined) return null; + replacementIndex += 1; + return expr([field.items[0]!, replacement]); + }); + if (rebuilt === null) + return operationError( + "InvalidGrammarFieldReplacements", + "_fuzz-grammar-replace-fields", + "MissingReplacement", + ); + if (replacementIndex !== replacements.items.length) + return operationError( + "InvalidGrammarFieldReplacements", + "_fuzz-grammar-replace-fields", + "TrailingReplacement", + ); + return ok(rebuilt); +}; + +const indexGrammarReferences: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-index-references", 1, args.length); + let total = 0; + scanTemplateLeaves(args[0]!, "Ref", () => { + total += 1; + }); + + let ordinal = 0; + const rebuilt = rewriteTemplateLeaves(args[0]!, "Ref", (reference) => { + const indexed = expr([ + GRAMMAR_INDEXED_REFERENCE_HEAD, + reference.items[1]!, + gint(ordinal), + gint(total), + ]); + ordinal += 1; + return indexed; + }); + return ok(rebuilt!); +}; + +const grammarTemplateProfile: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-template-profile", 1, args.length); + const root = args[0]!; + const pending: Array = [[root, 1]]; + let references = 0; + let minimumNextId = 0n; + let nodes = 0; + let maximumDepth = 0; + + while (pending.length > 0) { + const [atom, depth] = pending.pop()!; + nodes += 1; + maximumDepth = Math.max(maximumDepth, depth); + if (atom.kind === "expr" && atom.items.length > 0 && atom.items[0]!.kind === "sym") { + const head = atom.items[0]!.name; + if (head === "Ref" && atom.items.length === 2) references += 1; + if (head === "Scoped" && atom.items.length === 3) { + const bindings = atom.items[1]!; + if (bindings.kind === "expr") { + for (const binding of bindings.items) { + if ( + binding.kind === "expr" && + binding.items.length === 3 && + binding.items[0]!.kind === "sym" && + binding.items[0]!.name === "Binding" + ) { + const id = integralNumberValue(binding.items[2]!); + if (id !== undefined && id >= 0n) + minimumNextId = minimumNextId > id ? minimumNextId : id + 1n; + } + } + } + } + } + const indices = grammarTemplateChildIndices(atom); + for (let index = indices.length - 1; index >= 0; index -= 1) { + pending.push([ + (atom as Extract).items[indices[index]!]!, + depth + 1, + ]); + } + } + + return ok( + expr([ + GRAMMAR_TEMPLATE_PROFILE_HEAD, + expr([sym("Ground"), gbool(root.ground)]), + expr([sym("References"), gint(references)]), + expr([sym("MinimumNextId"), gint(minimumNextId)]), + expr([sym("Nodes"), gint(nodes)]), + expr([sym("Depth"), gint(maximumDepth)]), + ]), + ); +}; + +// ---- requirement-set and alternatives algebra ---- +// Pure set operations on the shapes the productivity analysis threads through its folds: +// a requirement list `((quote sort) ...)` and an alternatives list +// `((GrammarRequirementAlternative requirements) ...)`. The MeTTa side keeps the policy +// (event dispatch, fixed-point iteration, what counts as productive); these ops replace +// per-element MeTTa recursion whose cost made dominance pruning quadratic with a large +// constant. Equality is exact structural equality, the same relation as `noreduce-eq`. + +type ParsedAlternative = { + readonly encoded: Atom; + readonly requirements: readonly Atom[]; +}; + +function parseRequirementList(atom: Atom, operation: string): readonly Atom[] | Atom { + if (atom.kind !== "expr") + return kernelError( + "InvalidGrammarRequirement", + expr([sym("Operation"), sym(operation)]), + sym("ExpectedExpression"), + ); + const sorts: Atom[] = []; + for (const quoted of atom.items) { + if ( + quoted.kind !== "expr" || + quoted.items.length !== 2 || + quoted.items[0]!.kind !== "sym" || + quoted.items[0]!.name !== QUOTE_HEAD.name + ) + return kernelError( + "InvalidGrammarRequirement", + expr([sym("Operation"), sym(operation)]), + sym("MalformedRequirement"), + ); + sorts.push(quoted.items[1]!); + } + return sorts; +} + +function parseAlternativeList(atom: Atom, operation: string): readonly ParsedAlternative[] | Atom { + if (atom.kind !== "expr") + return kernelError( + "InvalidGrammarRequirementAlternatives", + expr([sym("Operation"), sym(operation)]), + sym("ExpectedExpression"), + ); + const parsed: ParsedAlternative[] = []; + for (const alternative of atom.items) { + if ( + alternative.kind !== "expr" || + alternative.items.length !== 2 || + alternative.items[0]!.kind !== "sym" || + alternative.items[0]!.name !== GRAMMAR_REQUIREMENT_ALTERNATIVE_HEAD.name + ) + return kernelError( + "InvalidGrammarRequirementAlternatives", + expr([sym("Operation"), sym(operation)]), + sym("MalformedAlternative"), + ); + const requirements = parseRequirementList(alternative.items[1]!, operation); + if (isErrorAtom(requirements)) return requirements; + parsed.push({ encoded: alternative, requirements }); + } + return parsed; +} + +function requirementMember(sort: Atom, requirements: readonly Atom[]): boolean { + return requirements.some((candidate) => atomEq(candidate, sort)); +} + +function requirementSubset(left: readonly Atom[], right: readonly Atom[]): boolean { + return left.every((sort) => requirementMember(sort, right)); +} + +function encodeRequirements(sorts: readonly Atom[]): Atom { + return expr(sorts.map((sort) => expr([QUOTE_HEAD, sort]))); +} + +function encodeAlternative(sorts: readonly Atom[]): Atom { + return expr([GRAMMAR_REQUIREMENT_ALTERNATIVE_HEAD, encodeRequirements(sorts)]); +} + +// Mirrors `add-requirement-alternative`: a candidate dominated by an existing entry is +// dropped; otherwise entries the candidate dominates are pruned and it is appended. +function alternativesAddCore( + alternatives: ParsedAlternative[], + candidate: readonly Atom[], +): boolean { + for (const existing of alternatives) + if (requirementSubset(existing.requirements, candidate)) return false; + const kept = alternatives.filter( + (existing) => !requirementSubset(candidate, existing.requirements), + ); + kept.push({ encoded: encodeAlternative(candidate), requirements: candidate }); + alternatives.length = 0; + alternatives.push(...kept); + return true; +} + +function encodeAlternatives(alternatives: readonly ParsedAlternative[]): Atom { + return expr(alternatives.map((alternative) => alternative.encoded)); +} + +const grammarAlternativesAdd: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-grammar-alternatives-add", 2, args.length); + const alternatives = parseAlternativeList(args[0]!, "_fuzz-grammar-alternatives-add"); + if (isErrorAtom(alternatives)) return ok(alternatives); + const candidate = parseRequirementList(args[1]!, "_fuzz-grammar-alternatives-add"); + if (isErrorAtom(candidate)) return ok(candidate); + const mutable = [...alternatives]; + const changed = alternativesAddCore(mutable, candidate); + return ok( + expr([ + GRAMMAR_ALTERNATIVES_ADD_HEAD, + gbool(changed), + changed ? encodeAlternatives(mutable) : args[0]!, + ]), + ); +}; + +// Mirrors `combine-requirement-alternatives`: left entries outer, right entries inner, +// each union (left sorts first, new right sorts in right order) added with pruning into +// one accumulator threaded across the whole cross product. + +function removeSortFromAlternatives( + alternatives: readonly ParsedAlternative[], + sort: Atom, +): ParsedAlternative[] { + const reduced: ParsedAlternative[] = []; + for (const alternative of alternatives) { + const kept = alternative.requirements.filter((candidate) => !atomEq(candidate, sort)); + alternativesAddCore(reduced, kept); + } + return reduced; +} + +// ---- production lookup ---- +// Both per-target lookups take `(productions (quote target))`; parse that shape once, with the +// caller's own error identity on a mismatch. +function parseProductionsTargetArgs( + args: readonly Atom[], + code: string, + operation: string, +): + | { readonly productions: Extract; readonly target: Atom } + | ReduceResult { + if (args.length !== 2) return arityError(operation, 2, args.length); + const productions = args[0]!; + const quotedTarget = args[1]!; + if ( + productions.kind !== "expr" || + quotedTarget.kind !== "expr" || + quotedTarget.items.length !== 2 || + quotedTarget.items[0]!.kind !== "sym" || + quotedTarget.items[0]!.name !== QUOTE_HEAD.name + ) + return operationError(code, operation, "ExpectedProductionsAndQuotedTarget"); + return { productions, target: quotedTarget.items[1]! }; +} + +// The per-target scan over every production ran per reference-eligibility check, once per +// nonterminal per level; indexed by the productions atom's identity it costs one scan per +// grammar per process. +const productionsForTargetCache = new WeakMap>(); + +const grammarProductionsForTarget: GroundFn = (args) => { + const parsed = parseProductionsTargetArgs( + args, + "InvalidGrammarProductionLookup", + "_fuzz-grammar-productions-for-target", + ); + if ("tag" in parsed) return parsed; + const { productions, target } = parsed; + const targetKey = structuralAtomKey(target, "Exact"); + if (!targetKey.ok) return ok(targetKey.reason); + + let byTarget = productionsForTargetCache.get(productions); + if (byTarget === undefined) { + byTarget = new Map(); + for (const production of productions.items) { + if ( + production.kind !== "expr" || + production.items.length !== 5 || + production.items[0]!.kind !== "sym" || + production.items[0]!.name !== "GrammarProduction" || + production.items[3]!.kind !== "expr" || + production.items[3]!.items.length !== 2 || + production.items[3]!.items[0]!.kind !== "sym" || + production.items[3]!.items[0]!.name !== QUOTE_HEAD.name + ) + return operationError( + "InvalidGrammarProductionLookup", + "_fuzz-grammar-productions-for-target", + "MalformedProduction", + ); + const candidateKey = structuralAtomKey(production.items[3]!.items[1]!, "Exact"); + if (!candidateKey.ok) return ok(candidateKey.reason); + const bucket = byTarget.get(candidateKey.key); + if (bucket === undefined) byTarget.set(candidateKey.key, expr([production])); + else + byTarget.set( + candidateKey.key, + expr([...(bucket as Extract).items, production]), + ); + } + productionsForTargetCache.set(productions, byTarget); + } + return ok(expr([GRAMMAR_PRODUCTIONS_HEAD, byTarget.get(targetKey.key) ?? expr([])])); +}; + +// ---- requirement analysis ---- +// The full binder-requirement analysis of one template against the current summary, as one pure +// call: template syntax in, `(GrammarRequirementAlternatives ...)` out. The event-stream fold this +// replaces ran ~30 interpreted steps per production; at one grounded call the worklist's per-analysis +// cost is the set algebra itself. Semantics per node: `Use s` contributes the singleton requirement +// {s}; a reference contributes the referenced target's current alternatives; an expression combines +// its dynamic children pairwise (union with dominance pruning); `Bind`/`Scoped` discharge their sorts +// from the body's alternatives; a template with no dynamic content is closed (one empty requirement). +function summaryAlternativesFor( + entries: readonly GrammarSummaryEntry[], + target: Atom, +): readonly ParsedAlternative[] | Atom { + const found = entries.find((entry) => atomEq(entry.target, target)); + if (found === undefined) return []; + return parseAlternativeList(found.alternatives, "_fuzz-grammar-template-requirements"); +} + +function combineAlternatives( + left: readonly ParsedAlternative[], + right: readonly ParsedAlternative[], +): ParsedAlternative[] { + const combined: ParsedAlternative[] = []; + for (const leftEntry of left) { + for (const rightEntry of right) { + const union = [...leftEntry.requirements]; + for (const sort of rightEntry.requirements) + if (!requirementMember(sort, union)) union.push(sort); + alternativesAddCore(combined, union); + } + } + return combined; +} + +type RequirementNode = { + readonly dynamic: boolean; + readonly alternatives: readonly ParsedAlternative[]; +}; + +// A worklist analysis presents the same summary atom to many productions before a merge +// replaces it; parsing it once per version (with a target index) keeps each analysis O(its +// own template) instead of O(summary). +type ParsedSummary = { + readonly entries: readonly GrammarSummaryEntry[]; + readonly byTarget: Map; +}; +const parsedSummaryCache = new WeakMap(); + +function parsedSummaryFor(summary: Atom): ParsedSummary | Atom { + const cached = parsedSummaryCache.get(summary); + if (cached !== undefined) return cached; + const entries = grammarSummaryEntries(summary, "_fuzz-grammar-template-requirements-op"); + const result: ParsedSummary | Atom = isErrorAtom(entries) + ? entries + : { entries, byTarget: new Map() }; + parsedSummaryCache.set(summary, result); + return result; +} + +function summaryAlternativesCached( + parsed: ParsedSummary, + target: Atom, +): readonly ParsedAlternative[] | Atom { + const key = structuralAtomKey(target, "Exact"); + if (!key.ok) return key.reason; + const cached = parsed.byTarget.get(key.key); + if (cached !== undefined) return cached; + const computed = summaryAlternativesFor(parsed.entries, target); + parsed.byTarget.set(key.key, computed); + return computed; +} + +type AlternativesLookup = (target: Atom) => readonly ParsedAlternative[] | Atom; + +const grammarTemplateRequirements: GroundFn = (args) => { + if (args.length !== 2) + return arityError("_fuzz-grammar-template-requirements-op", 2, args.length); + const parsedSummary = parsedSummaryFor(args[1]!); + if (!("entries" in (parsedSummary as object))) return ok(parsedSummary as Atom); + const summaryIndex = parsedSummary as ParsedSummary; + const analyzed = analyzeTemplateRequirements(args[0]!, (target) => + summaryAlternativesCached(summaryIndex, target), + ); + if (isErrorAtom(analyzed)) return ok(analyzed); + return ok(expr([GRAMMAR_REQUIREMENT_ALTERNATIVES_HEAD, encodeAlternatives(analyzed)])); +}; + +function analyzeTemplateRequirements( + template: Atom, + lookup: AlternativesLookup, +): ParsedAlternative[] | Atom { + type Task = + | { readonly tag: "visit"; readonly atom: Atom } + | { readonly tag: "discharge"; readonly sorts: readonly Atom[] } + | { readonly tag: "combine"; readonly childCount: number }; + const pending: Task[] = [{ tag: "visit", atom: template }]; + const results: RequirementNode[] = []; + const staticNode: RequirementNode = { dynamic: false, alternatives: [] }; + + while (pending.length > 0) { + const task = pending.pop()!; + if (task.tag === "discharge") { + const child = results.pop()!; + if (!child.dynamic) { + results.push(child); + continue; + } + let reduced = [...child.alternatives]; + for (const sort of task.sorts) reduced = removeSortFromAlternatives(reduced, sort); + results.push({ dynamic: true, alternatives: reduced }); + continue; + } + if (task.tag === "combine") { + const children = results.splice(results.length - task.childCount, task.childCount); + const dynamicChildren = children.filter((child) => child.dynamic); + if (dynamicChildren.length === 0) { + results.push(staticNode); + continue; + } + let alternatives = dynamicChildren[0]!.alternatives; + for (let index = 1; index < dynamicChildren.length; index += 1) + alternatives = combineAlternatives(alternatives, dynamicChildren[index]!.alternatives); + results.push({ dynamic: true, alternatives }); + continue; + } + + const atom = task.atom; + if (atom.kind === "expr" && atom.items.length > 0 && atom.items[0]!.kind === "sym") { + const head = atom.items[0]!.name; + if ((head === "Literal" || head === "Field" || head === "Fresh") && atom.items.length === 2) { + results.push(staticNode); + continue; + } + // marker: heads handled below + + if (head === "Use" && atom.items.length === 2) { + results.push({ + dynamic: true, + alternatives: [ + { + encoded: encodeAlternative([atom.items[1]!]), + requirements: [atom.items[1]!], + }, + ], + }); + continue; + } + if ( + (head === "Ref" && atom.items.length === 2) || + (head === GRAMMAR_INDEXED_REFERENCE_HEAD.name && atom.items.length === 4) + ) { + const referenced = lookup(atom.items[1]!); + if (isErrorAtom(referenced)) return referenced; + results.push({ dynamic: true, alternatives: referenced }); + continue; + } + if (head === "Bind" && atom.items.length === 3) { + pending.push({ tag: "discharge", sorts: [atom.items[1]!] }); + pending.push({ tag: "visit", atom: atom.items[2]! }); + continue; + } + if (head === "Scoped" && atom.items.length === 3) { + const bindings = atom.items[1]!; + if (bindings.kind !== "expr") + return kernelError( + "InvalidGrammarTemplate", + expr([sym("Operation"), sym("_fuzz-grammar-template-requirements-op")]), + sym("MalformedScopedBindings"), + ); + const sorts: Atom[] = []; + for (const binding of bindings.items) { + if ( + binding.kind !== "expr" || + binding.items.length !== 3 || + binding.items[0]!.kind !== "sym" || + binding.items[0]!.name !== "Binding" + ) + return kernelError( + "InvalidGrammarTemplate", + expr([sym("Operation"), sym("_fuzz-grammar-template-requirements-op")]), + sym("MalformedScopedBindings"), + ); + sorts.push(binding.items[1]!); + } + pending.push({ tag: "discharge", sorts }); + pending.push({ tag: "visit", atom: atom.items[2]! }); + continue; + } + } + if (atom.kind === "expr" && atom.items.length > 0) { + pending.push({ tag: "combine", childCount: atom.items.length }); + for (let index = atom.items.length - 1; index >= 0; index -= 1) + pending.push({ tag: "visit", atom: atom.items[index]! }); + continue; + } + results.push(staticNode); + } + + if (results.length !== 1) + return kernelError( + "InvalidGrammarTemplate", + expr([sym("Operation"), sym("_fuzz-grammar-template-requirements-op")]), + sym("InvalidTraversalResult"), + ); + const root = results[0]!; + return root.dynamic + ? [...root.alternatives] + : [{ encoded: encodeAlternative([]), requirements: [] as Atom[] }]; +} + +// The whole productivity fixed point in one call: an internal worklist over production +// indices, alternatives per target held as plain arrays, and dependents re-enqueued when a +// merge changes a target. Pure syntax analysis, so the fixed point is the same one the +// specification machine reaches; the caller shapes the final error. +const grammarProductivityOp: GroundFn = (args) => { + if (args.length !== 3) return arityError("_fuzz-grammar-productivity-op", 3, args.length); + const [productionsAtom, quotedRoot, targetsAtom] = args; + const root = quotedRoot === undefined ? undefined : unquote(quotedRoot); + if (productionsAtom!.kind !== "expr" || root === undefined || targetsAtom!.kind !== "expr") + return operationError( + "InvalidGrammarProductivity", + "_fuzz-grammar-productivity-op", + "ExpectedProductionsRootTargets", + ); + const productions = productionsAtom!.items; + + type Analysis = { + readonly targetKey: string; + readonly target: Atom; + readonly template: Atom; + }; + const analyses: Analysis[] = []; + for (const production of productions) { + if ( + production.kind !== "expr" || + production.items.length !== 5 || + production.items[3]!.kind !== "expr" || + production.items[3]!.items.length !== 2 || + production.items[4]!.kind !== "expr" || + production.items[4]!.items.length !== 2 + ) + return operationError( + "InvalidGrammarProductivity", + "_fuzz-grammar-productivity-op", + "MalformedProduction", + ); + const target = production.items[3]!.items[1]!; + const key = structuralAtomKey(target, "Exact"); + if (!key.ok) return ok(key.reason); + analyses.push({ targetKey: key.key, target, template: production.items[4]!.items[1]! }); + } + + const dependents = new Map(); + for (let index = 0; index < analyses.length; index += 1) { + for (const referenced of templateReferenceTargetAtoms(analyses[index]!.template)) { + const key = structuralAtomKey(referenced, "Exact"); + if (!key.ok) return ok(key.reason); + const bucket = dependents.get(key.key); + if (bucket === undefined) dependents.set(key.key, [index]); + else if (bucket[bucket.length - 1] !== index) bucket.push(index); + } + } + + const summary = new Map(); + const lookup: AlternativesLookup = (target) => { + const key = structuralAtomKey(target, "Exact"); + if (!key.ok) return key.reason; + return summary.get(key.key) ?? []; + }; + + const queue: number[] = []; + for (let index = analyses.length - 1; index >= 0; index -= 1) queue.push(index); + while (queue.length > 0) { + const index = queue.pop()!; + const analysis = analyses[index]!; + const alternatives = analyzeTemplateRequirements(analysis.template, lookup); + if (isErrorAtom(alternatives)) return ok(alternatives); + const current = summary.get(analysis.targetKey) ?? []; + let changed = false; + for (const alternative of alternatives) + if (alternativesAddCore(current, alternative.requirements)) changed = true; + if (!changed) continue; + summary.set(analysis.targetKey, current); + const affected = dependents.get(analysis.targetKey); + if (affected !== undefined) + for (let position = affected.length - 1; position >= 0; position -= 1) + queue.push(affected[position]!); + } + + for (const quotedTarget of targetsAtom!.items) { + const target = unquote(quotedTarget); + if (target === undefined) + return operationError( + "InvalidGrammarProductivity", + "_fuzz-grammar-productivity-op", + "MalformedTarget", + ); + const key = structuralAtomKey(target, "Exact"); + if (!key.ok) return ok(key.reason); + if ((summary.get(key.key) ?? []).length === 0) + return ok(expr([sym("GrammarUnproductive"), quoteAtom(target)])); + } + const rootKey = structuralAtomKey(root, "Exact"); + if (!rootKey.ok) return ok(rootKey.reason); + const rootClosed = (summary.get(rootKey.key) ?? []).some( + (alternative) => alternative.requirements.length === 0, + ); + if (!rootClosed) return ok(expr([sym("GrammarUnproductive"), quoteAtom(root)])); + return ok(expr([sym("ValidGrammarProductivity")])); +}; + +// ---- eligibility ---- +// Whether each production of a target can complete within a size budget under a lexical scope, +// exactly the recursive fit semantics: `Use` needs its sort in scope, a reference needs size > 0 +// and an eligible target at the deterministic split size, `Bind` extends the scope with a fit +// placeholder, `Scoped` validates disjoint binding ids and extends the scope, everything else +// walks its children. Pure and deterministic, memoised per productions atom by +// (target, size, scope) — reference sizes strictly decrease, so the recursion is well-founded. +type FitScopeEntry = { readonly sort: Atom; readonly id: Atom | undefined }; + +const eligibilityCache = new WeakMap>(); + +function scopeEntriesFrom(scope: Atom, operation: string): FitScopeEntry[] | Atom { + if (scope.kind !== "expr") + return kernelError( + "InvalidGrammarScope", + expr([sym("Operation"), sym(operation)]), + sym("ExpectedExpression"), + ); + const out: FitScopeEntry[] = []; + for (const binding of scope.items) { + if ( + binding.kind !== "expr" || + binding.items.length !== 3 || + binding.items[0]!.kind !== "sym" || + binding.items[0]!.name !== "GrammarBinding" || + binding.items[1]!.kind !== "expr" || + binding.items[1]!.items.length !== 2 || + binding.items[1]!.items[0]!.kind !== "sym" || + binding.items[1]!.items[0]!.name !== QUOTE_HEAD.name + ) + return kernelError( + "InvalidGrammarScope", + expr([sym("Operation"), sym(operation)]), + sym("MalformedBinding"), + ); + out.push({ sort: binding.items[1]!.items[1]!, id: binding.items[2]! }); + } + return out; +} + +function scopeCacheKey(entries: readonly FitScopeEntry[]): string | Atom { + const parts: string[] = []; + for (const entry of entries) { + const sortKey = structuralAtomKey(entry.sort, "Exact"); + if (!sortKey.ok) return sortKey.reason; + const idKey = entry.id === undefined ? "" : structuralAtomKey(entry.id, "Exact"); + if (typeof idKey !== "string" && !idKey.ok) return idKey.reason; + parts.push(`${sortKey.key}=${typeof idKey === "string" ? idKey : idKey.key}`); + } + return [...new Set(parts)].sort().join(" "); +} + +function referenceChildSize(size: bigint, ordinal: bigint, total: bigint): bigint { + const budget = size - 1n < 0n ? 0n : size - 1n; + const base = budget / total; + const remainder = budget % total; + return base + (ordinal < remainder ? 1n : 0n); +} + +type FitOutcome = boolean | { readonly error: Atom }; + +const grammarEligibleProductions: GroundFn = (args) => { + if (args.length !== 4) return arityError("_fuzz-grammar-eligible-productions-op", 4, args.length); + const [productionsAtom, quotedTarget, scopeAtom, sizeAtom] = args; + const size = integralNumberValue(sizeAtom!); + if (size === undefined) + return operationError( + "InvalidGrammarEligibility", + "_fuzz-grammar-eligible-productions-op", + "ExpectedIntegerSize", + ); + if ( + productionsAtom!.kind !== "expr" || + quotedTarget!.kind !== "expr" || + quotedTarget!.items.length !== 2 || + quotedTarget!.items[0]!.kind !== "sym" || + quotedTarget!.items[0]!.name !== QUOTE_HEAD.name + ) + return operationError( + "InvalidGrammarEligibility", + "_fuzz-grammar-eligible-productions-op", + "ExpectedProductionsAndQuotedTarget", + ); + const scopeEntries = scopeEntriesFrom(scopeAtom!, "_fuzz-grammar-eligible-productions-op"); + if (!Array.isArray(scopeEntries)) return ok(scopeEntries); + + let cache = eligibilityCache.get(productionsAtom!); + if (cache === undefined) { + cache = new Map(); + eligibilityCache.set(productionsAtom!, cache); + } + + const productionsFor = (target: Atom): readonly Atom[] | Atom => { + const looked = grammarProductionsForTarget([productionsAtom!, expr([QUOTE_HEAD, target])]); + if (looked.tag !== "ok" || looked.results.length !== 1) + return kernelError( + "InvalidGrammarEligibility", + expr([sym("Operation"), sym("_fuzz-grammar-eligible-productions-op")]), + sym("ProductionLookupFailed"), + ); + const result = looked.results[0]!; + if ( + result.kind !== "expr" || + result.items.length !== 2 || + result.items[0]!.kind !== "sym" || + result.items[0]!.name !== GRAMMAR_PRODUCTIONS_HEAD.name || + result.items[1]!.kind !== "expr" + ) + return result; + return result.items[1]!.items; + }; + + function fitsTemplate( + template: Atom, + scope: readonly FitScopeEntry[], + templateSize: bigint, + ): FitOutcome { + type FitTask = { readonly atom: Atom; readonly scope: readonly FitScopeEntry[] }; + const tasks: FitTask[] = [{ atom: template, scope }]; + while (tasks.length > 0) { + const task = tasks.pop()!; + const atom = task.atom; + if (atom.kind !== "expr" || atom.items.length === 0) continue; + const h = atom.items[0]!; + if (h.kind === "sym") { + const head = h.name; + if ((head === "Literal" || head === "Field" || head === "Fresh") && atom.items.length === 2) + continue; + if (head === "Use" && atom.items.length === 2) { + const sort = atom.items[1]!; + if (!task.scope.some((entry) => atomEq(entry.sort, sort))) return false; + continue; + } + if ( + (head === "Ref" && atom.items.length === 2) || + (head === GRAMMAR_INDEXED_REFERENCE_HEAD.name && atom.items.length === 4) + ) { + if (templateSize <= 0n) return false; + let ordinal = 0n; + let total = 1n; + if (atom.items.length === 4) { + const seenOrdinal = integralNumberValue(atom.items[2]!); + const seenTotal = integralNumberValue(atom.items[3]!); + if ( + seenOrdinal === undefined || + seenTotal === undefined || + seenTotal <= 0n || + seenOrdinal < 0n || + seenOrdinal >= seenTotal + ) + return { + error: kernelError( + "InvalidGrammarEligibility", + expr([sym("Operation"), sym("_fuzz-grammar-eligible-productions-op")]), + sym("MalformedIndexedReference"), + ), + }; + ordinal = seenOrdinal; + total = seenTotal; + } + const childSize = referenceChildSize(templateSize, ordinal, total); + const eligible = eligibleFor(atom.items[1]!, task.scope, childSize); + if (typeof eligible !== "boolean") return eligible; + if (!eligible) return false; + continue; + } + if (head === "Bind" && atom.items.length === 3) { + tasks.push({ + atom: atom.items[2]!, + scope: [{ sort: atom.items[1]!, id: undefined }, ...task.scope], + }); + continue; + } + if (head === "Scoped" && atom.items.length === 3) { + const bindings = atom.items[1]!; + if (bindings.kind !== "expr") + return { + error: kernelError( + "InvalidGrammarEligibility", + expr([sym("Operation"), sym("_fuzz-grammar-eligible-productions-op")]), + sym("MalformedScopedBindings"), + ), + }; + const added: FitScopeEntry[] = []; + for (const binding of bindings.items) { + if ( + binding.kind !== "expr" || + binding.items.length !== 3 || + binding.items[0]!.kind !== "sym" || + binding.items[0]!.name !== "Binding" + ) + return { + error: kernelError( + "InvalidGrammarEligibility", + expr([sym("Operation"), sym("_fuzz-grammar-eligible-productions-op")]), + sym("MalformedScopedBindings"), + ), + }; + added.push({ sort: binding.items[1]!, id: binding.items[2]! }); + } + for (const entry of added) + if ( + entry.id !== undefined && + task.scope.some( + (existing) => existing.id !== undefined && atomEq(existing.id, entry.id!), + ) + ) + return { + error: expr([sym("FitDuplicateGrammarBindingId"), expr([QUOTE_HEAD, bindings])]), + }; + tasks.push({ atom: atom.items[2]!, scope: [...added, ...task.scope] }); + continue; + } + } + for (let index = atom.items.length - 1; index >= 0; index -= 1) + tasks.push({ atom: atom.items[index]!, scope: task.scope }); + } + return true; + } + + function eligibleFor( + target: Atom, + scope: readonly FitScopeEntry[], + targetSize: bigint, + ): boolean | { readonly error: Atom } { + const list = eligibleListFor(target, scope, targetSize); + if (list.kind !== "expr") return { error: list }; + return list.items.length > 0; + } + + function eligibleListFor( + target: Atom, + scope: readonly FitScopeEntry[], + targetSize: bigint, + ): Atom { + const targetKey = structuralAtomKey(target, "Exact"); + if (!targetKey.ok) return targetKey.reason; + const scopeKey = scopeCacheKey(scope); + if (typeof scopeKey !== "string") return scopeKey; + const key = `${targetKey.key}#${targetSize}#${scopeKey}`; + const cached = cache!.get(key); + if (cached !== undefined) return cached; + const candidates = productionsFor(target); + if (isErrorAtom(candidates)) return candidates; + const eligible: Atom[] = []; + for (const production of candidates) { + if ( + production.kind !== "expr" || + production.items.length !== 5 || + production.items[4]!.kind !== "expr" || + production.items[4]!.items.length !== 2 + ) + return kernelError( + "InvalidGrammarEligibility", + expr([sym("Operation"), sym("_fuzz-grammar-eligible-productions-op")]), + sym("MalformedProduction"), + ); + const outcome = fitsTemplate(production.items[4]!.items[1]!, scope, targetSize); + if (typeof outcome !== "boolean") return outcome.error; + if (outcome) eligible.push(production); + } + const result = expr([sym("EligibleGrammarProductions"), expr(eligible)]); + cache!.set(key, result); + return result; + } + + return ok(eligibleListFor(quotedTarget!.items[1]!, scopeEntries, size)); +}; + +function rngStateOf(atom: Atom): RngState | undefined { + return parseRngState(atom); +} + +function rngAtomOf(state: RngState): Atom { + return rngStateAtom(state); +} + +function drawIntFromState(state: RngState, lower: bigint, upper: bigint): [bigint, RngState] { + const rng = xorshift128plusFromState(state); + const value = uniformBigInt(rng, lower, upper); + return [value, rng.getState() as RngState]; +} + +// Flattens a decision tree to its Int leaves in order — the replay drivers' input. The MeTTa +// flattener appended per node, which is quadratic in leaf count and drowned wide trees in +// garbage; one iterative pass is linear. Shapes are the drivers' own: a six-item Int decision +// is a leaf, any other five-item decision recurses into its children. +const decisionLeaves: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-decision-leaves-op", 1, args.length); + const leaves: Atom[] = []; + const pending: Atom[] = [args[0]!]; + while (pending.length > 0) { + const decision = pending.pop()!; + if ( + decision.kind === "expr" && + decision.items.length === 6 && + decision.items[0]!.kind === "sym" && + decision.items[0]!.name === DECISION_HEAD.name && + decision.items[1]!.kind === "sym" && + decision.items[1]!.name === "Int" && + decision.items[5]!.kind === "expr" && + decision.items[5]!.items.length === 0 + ) { + leaves.push(decision); + continue; + } + if ( + decision.kind === "expr" && + decision.items.length === 5 && + decision.items[0]!.kind === "sym" && + decision.items[0]!.name === DECISION_HEAD.name && + decision.items[4]!.kind === "expr" + ) { + const children = decision.items[4]!.items; + for (let index = children.length - 1; index >= 0; index -= 1) pending.push(children[index]!); + continue; + } + return ok( + expr([ + FUZZ_GENERATION_ERROR_HEAD, + sym("MalformedDecisionTree"), + expr([sym("Details"), expr([sym("Decision"), decision])]), + ]), + ); + } + return ok(expr([sym("FuzzDecisionLeaves"), expr(leaves)])); +}; + +// ---- the kernel grammar machine ---- +// The grammar machine's pure transitions run here; the MeTTa module keeps the same machine as +// an executable specification (`_fuzz-gen-*`), drives this one through a bare-tail trampoline, +// and supplies every effect: a `Field` or `Use` sub-generation suspends the machine with an +// `(EvaluateGenerator generator driver size)` request, and the trampoline answers it with +// `fuzz-generate` so user callbacks and custom generators stay ordinary MeTTa. Driver-integer +// transitions replicate 15-drivers.metta exactly (same candidate lists, same decision atoms, +// same error taxonomy); the engine's integer `/` truncates toward zero and `%` keeps the +// dividend's sign, which BigInt arithmetic reproduces bit for bit. Every driver mode is +// deterministic, including the exhaustive cursor, which reads its planned offset (or descends +// leftmost) and records one frame per decision. Suspended states round-trip as the +// specification machine's own state atoms, so replay determinism never depends on hidden host +// state. + +type MachineDriver = + | { readonly mode: "Random"; readonly rng: RngState } + | { readonly mode: "Edge"; readonly index: bigint } + | { readonly mode: "Replay"; readonly leaves: readonly Atom[]; readonly cursor: bigint } + | { + readonly mode: "ShrinkReplay"; + readonly leaves: readonly Atom[]; + readonly cursor: bigint; + } + | { + readonly mode: "Exhaustive"; + readonly choices: readonly bigint[]; + readonly cursor: bigint; + readonly frames: readonly Atom[]; + } + | { readonly mode: "Bytes"; readonly bytes: readonly Atom[]; readonly cursor: bigint }; + +type MachineFrame = + | { + readonly tag: "plan"; + readonly instrs: readonly Atom[]; + cursor: number; + readonly size: bigint; + } + | { readonly tag: "expr"; readonly arity: number; readonly depth: number } + | { readonly tag: "ref"; readonly target: Atom } + | { + readonly tag: "prod"; + readonly target: Atom; + readonly productionIndex: Atom; + readonly position: number; + readonly choiceTree: Atom; + } + | { + readonly tag: "bind"; + readonly sort: Atom; + readonly bindingId: bigint; + readonly variable: Atom; + } + | { readonly tag: "scoped"; readonly added: Atom } + | { readonly tag: "scope"; readonly saved: readonly Atom[] }; + +type MachineState = { + readonly source: Atom; + readonly productions: Atom; + frames: MachineFrame[]; + values: Atom[]; + trees: Atom[]; + scope: Atom[]; + nextId: bigint; + driver: MachineDriver; + cut: { readonly reason: Atom; tree: Atom } | undefined; +}; + +type MachineOutcome = + | { readonly tag: "done"; readonly result: Atom } + | { readonly tag: "need"; readonly state: Atom; readonly request: Atom }; + +const GEN_RUN_HEAD = sym("FuzzGenRun"); +const GEN_CUT_HEAD = sym("FuzzGenCut"); +const GF_HEAD = sym("GF"); +const GFB_SYM = sym("GFB"); +const FUZZ_STACK_BOTTOM_SYM = sym("FuzzStackBottom"); +const MACHINE_DONE_HEAD = sym("GrammarMachineDone"); +const MACHINE_NEED_HEAD = sym("GrammarMachineNeed"); +const MACHINE_START_HEAD = sym("GrammarMachineStart"); +const MACHINE_RESUME_HEAD = sym("GrammarMachineResume"); +const EVALUATE_GENERATOR_HEAD = sym("EvaluateGenerator"); +const DECISION_HEAD = sym("Decision"); + +function machineError(code: string, ...details: Atom[]): Atom { + return expr([FUZZ_GENERATION_ERROR_HEAD, sym(code), expr([sym("Details"), ...details])]); +} + +function quoteAtom(a: Atom): Atom { + return expr([QUOTE_HEAD, a]); +} + +function intDecisionAtom(lower: bigint, upper: bigint, origin: bigint, value: bigint): Atom { + return expr([ + DECISION_HEAD, + sym("Int"), + expr([sym("Bounds"), gint(lower), gint(upper)]), + expr([sym("Origin"), gint(origin)]), + expr([sym("Value"), gint(value)]), + expr([]), + ]); +} + +function decodeDriver(atom: Atom): MachineDriver | Atom { + if ( + atom.kind !== "expr" || + atom.items.length !== 3 || + atom.items[0]!.kind !== "sym" || + atom.items[0]!.name !== FUZZ_DRIVER_HEAD.name || + atom.items[1]!.kind !== "sym" + ) + return machineError("MalformedDriver", expr([sym("Driver"), atom])); + const mode = atom.items[1]!.name; + const payload = atom.items[2]!; + if (mode === "Random") { + const rng = rngStateOf(payload); + if (rng === undefined) return machineError("MalformedDriver", expr([sym("Driver"), atom])); + return { mode: "Random", rng }; + } + if (mode === "Edge") { + const index = integralNumberValue(payload); + if (index === undefined || index < 0n) + return machineError("MalformedDriver", expr([sym("Driver"), atom])); + return { mode: "Edge", index }; + } + if (mode === "Replay" || mode === "ShrinkReplay") { + const stateHead = mode === "Replay" ? "ReplayState" : "ShrinkReplayState"; + if ( + payload.kind !== "expr" || + payload.items.length !== 3 || + payload.items[0]!.kind !== "sym" || + payload.items[0]!.name !== stateHead || + payload.items[1]!.kind !== "expr" + ) + return machineError("MalformedDriver", expr([sym("Driver"), atom])); + const cursor = integralNumberValue(payload.items[2]!); + if (cursor === undefined) return machineError("MalformedDriver", expr([sym("Driver"), atom])); + return mode === "Replay" + ? { mode: "Replay", leaves: payload.items[1]!.items, cursor } + : { mode: "ShrinkReplay", leaves: payload.items[1]!.items, cursor }; + } + if (mode === "Exhaustive") { + if ( + payload.kind !== "expr" || + payload.items.length !== 4 || + payload.items[0]!.kind !== "sym" || + payload.items[0]!.name !== "ExhaustiveCursor" || + payload.items[1]!.kind !== "expr" || + payload.items[3]!.kind !== "expr" + ) + return machineError("MalformedExhaustiveState", expr([sym("State"), payload])); + const choices: bigint[] = []; + for (const item of payload.items[1]!.items) { + const choice = integralNumberValue(item); + if (choice === undefined) + return machineError("MalformedExhaustiveState", expr([sym("State"), payload])); + choices.push(choice); + } + const cursor = integralNumberValue(payload.items[2]!); + if (cursor === undefined || cursor < 0n) + return machineError("MalformedExhaustiveState", expr([sym("State"), payload])); + return { mode: "Exhaustive", choices, cursor, frames: payload.items[3]!.items }; + } + if (mode === "Bytes") { + if ( + payload.kind !== "expr" || + payload.items.length !== 3 || + payload.items[0]!.kind !== "sym" || + payload.items[0]!.name !== "BytesState" || + payload.items[1]!.kind !== "expr" + ) + return machineError("MalformedByteState", expr([sym("State"), payload])); + const cursor = integralNumberValue(payload.items[2]!); + if (cursor === undefined) + return machineError("MalformedByteState", expr([sym("State"), payload])); + return { mode: "Bytes", bytes: payload.items[1]!.items, cursor }; + } + return machineError("MalformedDriver", expr([sym("Driver"), atom])); +} + +function encodeDriver(driver: MachineDriver): Atom { + switch (driver.mode) { + case "Random": + return expr([FUZZ_DRIVER_HEAD, sym("Random"), rngAtomOf(driver.rng)]); + case "Edge": + return expr([FUZZ_DRIVER_HEAD, sym("Edge"), gint(driver.index)]); + case "Replay": + return expr([ + FUZZ_DRIVER_HEAD, + sym("Replay"), + expr([sym("ReplayState"), expr([...driver.leaves]), gint(driver.cursor)]), + ]); + case "ShrinkReplay": + return expr([ + FUZZ_DRIVER_HEAD, + sym("ShrinkReplay"), + expr([sym("ShrinkReplayState"), expr([...driver.leaves]), gint(driver.cursor)]), + ]); + case "Exhaustive": + return expr([ + FUZZ_DRIVER_HEAD, + sym("Exhaustive"), + expr([ + sym("ExhaustiveCursor"), + expr(driver.choices.map((choice) => gint(choice))), + gint(driver.cursor), + expr([...driver.frames]), + ]), + ]); + case "Bytes": + return expr([ + FUZZ_DRIVER_HEAD, + sym("Bytes"), + expr([sym("BytesState"), expr([...driver.bytes]), gint(driver.cursor)]), + ]); + } +} + +type IntChoice = + | { + readonly tag: "one"; + readonly value: bigint; + readonly driver: MachineDriver; + readonly decision: Atom; + } + | { readonly tag: "error"; readonly error: Atom }; + +function inspectIntLeaf( + leaf: Atom, + lower: bigint, + upper: bigint, + origin: bigint, +): + | { readonly tag: "compatible"; readonly value: bigint } + | { readonly tag: "out-of-bounds"; readonly value: bigint } + | { readonly tag: "metadata"; readonly bounds: readonly [Atom, Atom]; readonly origin: Atom } + | { readonly tag: "malformed" } { + if ( + leaf.kind !== "expr" || + leaf.items.length !== 6 || + leaf.items[0]!.kind !== "sym" || + leaf.items[0]!.name !== DECISION_HEAD.name || + leaf.items[1]!.kind !== "sym" || + leaf.items[1]!.name !== "Int" || + leaf.items[5]!.kind !== "expr" || + leaf.items[5]!.items.length !== 0 + ) + return { tag: "malformed" }; + const bounds = leaf.items[2]!; + const originAtom = leaf.items[3]!; + const valueAtom = leaf.items[4]!; + if ( + bounds.kind !== "expr" || + bounds.items.length !== 3 || + originAtom.kind !== "expr" || + originAtom.items.length !== 2 || + valueAtom.kind !== "expr" || + valueAtom.items.length !== 2 + ) + return { tag: "malformed" }; + const seenLower = integralNumberValue(bounds.items[1]!); + const seenUpper = integralNumberValue(bounds.items[2]!); + const seenOrigin = integralNumberValue(originAtom.items[1]!); + const value = integralNumberValue(valueAtom.items[1]!); + if ( + seenLower === undefined || + seenUpper === undefined || + seenOrigin === undefined || + value === undefined + ) + return { tag: "malformed" }; + if (seenLower !== lower || seenUpper !== upper || seenOrigin !== origin) + return { + tag: "metadata", + bounds: [bounds.items[1]!, bounds.items[2]!], + origin: originAtom.items[1]!, + }; + if (value < lower || value > upper) return { tag: "out-of-bounds", value }; + return { tag: "compatible", value }; +} + +function driverInt(driver: MachineDriver, lower: bigint, upper: bigint, origin: bigint): IntChoice { + if (lower > upper) + return { + tag: "error", + error: machineError("InvalidIntegerBounds", expr([sym("Bounds"), gint(lower), gint(upper)])), + }; + switch (driver.mode) { + case "Random": { + const [value, next] = drawIntFromState(driver.rng, lower, upper); + return { + tag: "one", + value, + driver: { mode: "Random", rng: next }, + decision: intDecisionAtom(lower, upper, origin, value), + }; + } + case "Edge": { + const candidates: bigint[] = []; + const add = (candidate: bigint): void => { + if (candidate < lower || candidate > upper) return; + if (!candidates.includes(candidate)) candidates.push(candidate); + }; + add(origin); + add(lower); + add(upper); + add(0n); + add(-1n); + add(1n); + add((lower + upper) / 2n); + const count = BigInt(candidates.length); + const position = driver.index % count; + const value = candidates[Number(position)]!; + return { + tag: "one", + value, + driver: { mode: "Edge", index: driver.index + 1n }, + decision: intDecisionAtom(lower, upper, origin, value), + }; + } + case "Replay": { + if (driver.leaves.length === 0) + return { + tag: "error", + error: machineError( + "ReplayMismatch", + expr([sym("Path"), gint(driver.cursor)]), + expr([ + sym("Expected"), + expr([ + DECISION_HEAD, + sym("Int"), + expr([sym("Bounds"), gint(lower), gint(upper)]), + expr([sym("Origin"), gint(origin)]), + expr([sym("Value"), sym("Any")]), + expr([]), + ]), + ]), + expr([sym("Actual"), sym("EndOfTrace")]), + ), + }; + const leaf = driver.leaves[0]!; + const inspected = inspectIntLeaf(leaf, lower, upper, origin); + if (inspected.tag === "compatible") + return { + tag: "one", + value: inspected.value, + driver: { mode: "Replay", leaves: driver.leaves.slice(1), cursor: driver.cursor + 1n }, + decision: leaf, + }; + if (inspected.tag === "out-of-bounds") + return { + tag: "error", + error: machineError( + "ReplayValueOutOfBounds", + expr([sym("Path"), gint(driver.cursor)]), + expr([sym("Bounds"), gint(lower), gint(upper)]), + expr([sym("Value"), gint(inspected.value)]), + ), + }; + if (inspected.tag === "metadata") + return { + tag: "error", + error: machineError( + "ReplayMismatch", + expr([sym("Path"), gint(driver.cursor)]), + expr([sym("ExpectedBounds"), gint(lower), gint(upper)]), + expr([sym("ActualBounds"), inspected.bounds[0], inspected.bounds[1]]), + expr([sym("Origins"), gint(origin), inspected.origin]), + ), + }; + return { + tag: "error", + error: machineError( + "ReplayMismatch", + expr([sym("Path"), gint(driver.cursor)]), + expr([sym("Expected"), sym("IntDecision")]), + expr([sym("Actual"), leaf]), + ), + }; + } + case "ShrinkReplay": { + let leaves = driver.leaves; + let cursor = driver.cursor; + while (leaves.length > 0) { + const leaf = leaves[0]!; + const rest = leaves.slice(1); + const nextCursor = cursor + 1n; + const inspected = inspectIntLeaf(leaf, lower, upper, origin); + if (inspected.tag === "compatible") + return { + tag: "one", + value: inspected.value, + driver: { mode: "ShrinkReplay", leaves: rest, cursor: nextCursor }, + decision: leaf, + }; + leaves = rest; + cursor = nextCursor; + } + const value = origin < lower ? lower : origin > upper ? upper : origin; + return { + tag: "one", + value, + driver: { mode: "ShrinkReplay", leaves: [], cursor }, + decision: intDecisionAtom(lower, upper, origin, value), + }; + } + case "Exhaustive": { + const span = upper - lower + 1n; + const offset = + driver.cursor < BigInt(driver.choices.length) ? driver.choices[Number(driver.cursor)]! : 0n; + if (offset < 0n || offset >= span) + return { + tag: "error", + error: machineError( + "ExhaustiveResumeMismatch", + expr([sym("Offset"), gint(offset)]), + expr([sym("Bounds"), gint(lower), gint(upper)]), + ), + }; + const value = lower + offset; + return { + tag: "one", + value, + driver: { + mode: "Exhaustive", + choices: driver.choices, + cursor: driver.cursor + 1n, + frames: [expr([sym("ExhaustiveFrame"), gint(offset), gint(span)]), ...driver.frames], + }, + decision: intDecisionAtom(lower, upper, origin, value), + }; + } + case "Bytes": { + const span = upper - lower + 1n; + let width = 1n; + let capacity = 256n; + while (capacity < span) { + capacity *= 256n; + width += 1n; + } + let raw = 0n; + let cursor = driver.cursor; + for (let remaining = width; remaining > 0n; remaining -= 1n) { + if (cursor >= BigInt(driver.bytes.length)) + return { + tag: "error", + error: machineError( + "BytesExhausted", + expr([sym("Cursor"), gint(cursor)]), + expr([sym("Remaining"), gint(remaining)]), + ), + }; + const byte = integralNumberValue(driver.bytes[Number(cursor)]!); + if (byte === undefined) + return { + tag: "error", + error: machineError( + "MalformedByteRead", + expr([sym("OperationResult"), driver.bytes[Number(cursor)]!]), + ), + }; + raw = raw * 256n + byte; + cursor += 1n; + } + const value = lower + (raw % span); + return { + tag: "one", + value, + driver: { mode: "Bytes", bytes: driver.bytes, cursor }, + decision: intDecisionAtom(lower, upper, origin, value), + }; + } + } +} + +function decodeFrames(atom: Atom): MachineFrame[] | Atom { + const frames: MachineFrame[] = []; + let cursor = atom; + for (;;) { + if (cursor.kind === "sym" && cursor.name === GFB_SYM.name) break; + if ( + cursor.kind !== "expr" || + cursor.items.length !== 3 || + cursor.items[0]!.kind !== "sym" || + cursor.items[0]!.name !== GF_HEAD.name + ) + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + const frame = cursor.items[1]!; + cursor = cursor.items[2]!; + if (frame.kind !== "expr" || frame.items.length === 0 || frame.items[0]!.kind !== "sym") + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + const head = frame.items[0]!.name; + if (head === "FPlan" && frame.items.length === 5 && frame.items[1]!.kind === "expr") { + const cursorValue = integralNumberValue(frame.items[3]!); + const size = integralNumberValue(frame.items[4]!); + if (cursorValue === undefined || size === undefined) + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + frames.push({ + tag: "plan", + instrs: frame.items[1]!.items, + cursor: Number(cursorValue), + size, + }); + continue; + } + if (head === "FExpr" && frame.items.length === 4) { + const arity = integralNumberValue(frame.items[1]!); + const depth = integralNumberValue(frame.items[3]!); + if (arity === undefined || depth === undefined) + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + frames.push({ tag: "expr", arity: Number(arity), depth: Number(depth) }); + continue; + } + if (head === "FRef" && frame.items.length === 2) { + const target = unquote(frame.items[1]!); + if (target === undefined) + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + frames.push({ tag: "ref", target }); + continue; + } + if (head === "FProd" && frame.items.length === 5) { + const target = unquote(frame.items[1]!); + const position = integralNumberValue(frame.items[3]!); + if (target === undefined || position === undefined) + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + frames.push({ + tag: "prod", + target, + productionIndex: frame.items[2]!, + position: Number(position), + choiceTree: frame.items[4]!, + }); + continue; + } + if (head === "FBind" && frame.items.length === 4) { + const sort = unquote(frame.items[1]!); + const bindingId = integralNumberValue(frame.items[2]!); + if (sort === undefined || bindingId === undefined) + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + frames.push({ tag: "bind", sort, bindingId, variable: frame.items[3]! }); + continue; + } + if (head === "FScoped" && frame.items.length === 2) { + frames.push({ tag: "scoped", added: frame.items[1]! }); + continue; + } + if (head === "FScope" && frame.items.length === 2 && frame.items[1]!.kind === "expr") { + frames.push({ tag: "scope", saved: frame.items[1]!.items }); + continue; + } + return machineError("MalformedGrammarMachineState", expr([sym("Frames"), atom])); + } + return frames; +} + +function unquote(atom: Atom): Atom | undefined { + if ( + atom.kind === "expr" && + atom.items.length === 2 && + atom.items[0]!.kind === "sym" && + atom.items[0]!.name === QUOTE_HEAD.name + ) + return atom.items[1]!; + return undefined; +} + +function encodeFrames(frames: readonly MachineFrame[]): Atom { + let out: Atom = GFB_SYM; + for (let index = frames.length - 1; index >= 0; index -= 1) { + const frame = frames[index]!; + let encoded: Atom; + switch (frame.tag) { + case "plan": + encoded = expr([ + sym("FPlan"), + expr([...frame.instrs]), + gint(BigInt(frame.instrs.length)), + gint(BigInt(frame.cursor)), + gint(frame.size), + ]); + break; + case "expr": + encoded = expr([ + sym("FExpr"), + gint(BigInt(frame.arity)), + gint(BigInt(frame.depth)), + gint(BigInt(frame.depth)), + ]); + break; + case "ref": + encoded = expr([sym("FRef"), quoteAtom(frame.target)]); + break; + case "prod": + encoded = expr([ + sym("FProd"), + quoteAtom(frame.target), + frame.productionIndex, + gint(BigInt(frame.position)), + frame.choiceTree, + ]); + break; + case "bind": + encoded = expr([ + sym("FBind"), + quoteAtom(frame.sort), + gint(frame.bindingId), + frame.variable, + ]); + break; + case "scoped": + encoded = expr([sym("FScoped"), frame.added]); + break; + case "scope": + encoded = expr([sym("FScope"), expr([...frame.saved])]); + break; + } + out = expr([GF_HEAD, encoded, out]); + } + return out; +} + +function decodeStack(atom: Atom): Atom[] | Atom { + const out: Atom[] = []; + let cursor = atom; + for (;;) { + if (cursor.kind === "sym" && cursor.name === FUZZ_STACK_BOTTOM_SYM.name) break; + if ( + cursor.kind !== "expr" || + cursor.items.length !== 3 || + cursor.items[0]!.kind !== "sym" || + cursor.items[0]!.name !== FUZZ_STACK_HEAD.name + ) + return machineError("MalformedGrammarMachineState", expr([sym("Stack"), atom])); + out.push(cursor.items[1]!); + cursor = cursor.items[2]!; + } + out.reverse(); + return out; +} + +function encodeStack(items: readonly Atom[]): Atom { + let out: Atom = FUZZ_STACK_BOTTOM_SYM; + for (const item of items) out = expr([FUZZ_STACK_HEAD, item, out]); + return out; +} + +function productionsOfSource(source: Atom): Atom | undefined { + if ( + source.kind === "expr" && + source.items.length === 3 && + source.items[0]!.kind === "sym" && + (source.items[0]!.name === "StaticGrammar" || source.items[0]!.name === "StaticTypeGrammar") && + source.items[2]!.kind === "expr" + ) + return source.items[2]!; + return undefined; +} + +function encodeMachineState(state: MachineState): Atom { + const shared = [ + state.source, + encodeFrames(state.frames), + encodeStack(state.values), + gint(BigInt(state.values.length)), + encodeStack(state.trees), + gint(BigInt(state.trees.length)), + ]; + if (state.cut === undefined) + return expr([ + GEN_RUN_HEAD, + ...shared, + expr([...state.scope]), + gint(state.nextId), + encodeDriver(state.driver), + ]); + return expr([ + GEN_CUT_HEAD, + ...shared, + state.cut.reason, + state.cut.tree, + encodeDriver(state.driver), + ]); +} + +function decodeMachineState(atom: Atom): MachineState | Atom { + if (atom.kind !== "expr" || atom.items.length === 0 || atom.items[0]!.kind !== "sym") + return machineError("MalformedGrammarMachineState", expr([sym("Value"), atom])); + const head = atom.items[0]!.name; + const running = head === GEN_RUN_HEAD.name; + if ((running && atom.items.length !== 10) || (!running && head !== GEN_CUT_HEAD.name)) + return machineError("MalformedGrammarMachineState", expr([sym("Value"), atom])); + if (!running && atom.items.length !== 10) + return machineError("MalformedGrammarMachineState", expr([sym("Value"), atom])); + const source = atom.items[1]!; + const productions = productionsOfSource(source); + if (productions === undefined) + return machineError("MalformedGrammarSource", expr([sym("Value"), source])); + const frames = decodeFrames(atom.items[2]!); + if (!Array.isArray(frames)) return frames; + const values = decodeStack(atom.items[3]!); + if (!Array.isArray(values)) return values; + const trees = decodeStack(atom.items[5]!); + if (!Array.isArray(trees)) return trees; + const driver = decodeDriver(atom.items[9]!); + if (!("mode" in driver)) return driver; + if (running) { + const scopeAtom = atom.items[7]!; + const nextId = integralNumberValue(atom.items[8]!); + if (scopeAtom.kind !== "expr" || nextId === undefined) + return machineError("MalformedGrammarMachineState", expr([sym("Value"), atom])); + return { + source, + productions, + frames, + values, + trees, + scope: [...scopeAtom.items], + nextId, + driver, + cut: undefined, + }; + } + return { + source, + productions, + frames, + values, + trees, + scope: [], + nextId: 0n, + driver, + cut: { reason: atom.items[7]!, tree: atom.items[8]! }, + }; +} + +type StepResult = + | { readonly tag: "continue" } + | { readonly tag: "outcome"; readonly outcome: MachineOutcome }; + +function doneOutcome(result: Atom): StepResult { + return { tag: "outcome", outcome: { tag: "done", result } }; +} + +function pushResult(state: MachineState, value: Atom, tree: Atom): void { + state.values.push(value); + state.trees.push(tree); +} + +function scopeValueMarkers(scope: readonly Atom[], sort: Atom): Atom[] | Atom { + const out: Atom[] = []; + for (const binding of scope) { + if ( + binding.kind !== "expr" || + binding.items.length !== 3 || + binding.items[0]!.kind !== "sym" || + binding.items[0]!.name !== "GrammarBinding" + ) + continue; + const boundSort = unquote(binding.items[1]!); + if (boundSort === undefined || !atomEq(boundSort, sort)) continue; + const id = integralNumberValue(binding.items[2]!); + if (id === undefined || id < 0n) + return machineError("MalformedGrammarMachineState", expr([sym("Scope"), binding])); + out.push( + gnd( + { g: "ext", kind: FUZZ_VARIABLE_MARKER_KIND, id: id.toString() }, + FUZZ_VARIABLE_MARKER_TYPE, + ), + ); + } + return out; +} + +function containsMarkerValue(root: Atom): boolean { + const pending: Atom[] = [root]; + while (pending.length > 0) { + const atom = pending.pop()!; + if ( + atom.kind === "gnd" && + atom.value.g === "ext" && + atom.value.kind === FUZZ_VARIABLE_MARKER_KIND + ) + return true; + if (atom.kind === "expr") + for (let index = atom.items.length - 1; index >= 0; index -= 1) + pending.push(atom.items[index]!); + } + return false; +} + +function fieldDecision(generator: Atom, child: Atom): Atom { + return expr([ + DECISION_HEAD, + sym("GrammarField"), + expr([sym("Generator"), generator]), + expr([]), + expr([child]), + ]); +} + +function suspend(state: MachineState, generator: Atom, size: bigint): StepResult { + const request = expr([ + EVALUATE_GENERATOR_HEAD, + generator, + encodeDriver(state.driver), + gint(size), + ]); + return { + tag: "outcome", + outcome: { tag: "need", state: encodeMachineState(state), request }, + }; +} + +// Applies one machine step in place. Mirrors the specification machine rule for rule. +function stepMachine(state: MachineState): StepResult { + if (state.cut !== undefined) { + const frame = state.frames.pop(); + if (frame === undefined) + return doneOutcome( + expr([ + FUZZ_GENERATION_DISCARD_HEAD, + state.cut.reason, + encodeDriver(state.driver), + state.cut.tree, + ]), + ); + switch (frame.tag) { + case "plan": + return { tag: "continue" }; + case "expr": { + const generated = state.trees.length - frame.depth; + const taken = state.trees.splice(frame.depth, generated); + state.values.splice(frame.depth, generated); + state.cut = { + reason: state.cut.reason, + tree: expr([ + DECISION_HEAD, + sym("GrammarExpression"), + expr([sym("Arity"), gint(BigInt(frame.arity))]), + expr([sym("Generated"), gint(BigInt(generated + 1))]), + expr([...taken, state.cut.tree]), + ]), + }; + return { tag: "continue" }; + } + case "ref": + state.cut = { + reason: state.cut.reason, + tree: expr([ + DECISION_HEAD, + sym("GrammarRef"), + expr([sym("Target"), quoteAtom(frame.target)]), + expr([]), + expr([state.cut.tree]), + ]), + }; + return { tag: "continue" }; + case "prod": + state.cut = { + reason: state.cut.reason, + tree: expr([ + DECISION_HEAD, + sym("GrammarProduction"), + expr([sym("Target"), quoteAtom(frame.target)]), + expr([sym("ProductionIndex"), frame.productionIndex, gint(BigInt(frame.position))]), + expr([frame.choiceTree, state.cut.tree]), + ]), + }; + return { tag: "continue" }; + case "bind": + state.cut = { + reason: state.cut.reason, + tree: expr([ + DECISION_HEAD, + sym("GrammarBind"), + expr([sym("Sort"), quoteAtom(frame.sort)]), + expr([sym("BindingId"), gint(frame.bindingId)]), + expr([state.cut.tree]), + ]), + }; + return { tag: "continue" }; + case "scoped": + state.cut = { + reason: state.cut.reason, + tree: expr([ + DECISION_HEAD, + sym("GrammarScoped"), + expr([sym("Bindings"), frame.added]), + expr([]), + expr([state.cut.tree]), + ]), + }; + return { tag: "continue" }; + case "scope": + return { tag: "continue" }; + } + } + + const frame = state.frames[state.frames.length - 1]; + if (frame === undefined) { + if (state.values.length !== 1 || state.trees.length !== 1) + return doneOutcome( + machineError("MalformedGrammarMachineState", expr([sym("State"), sym("stacks")])), + ); + return doneOutcome( + expr([ + sym("GrammarResult"), + state.values[0]!, + encodeDriver(state.driver), + gint(state.nextId), + state.trees[0]!, + ]), + ); + } + + if (frame.tag !== "plan") { + state.frames.pop(); + switch (frame.tag) { + case "scope": + state.scope = [...frame.saved]; + return { tag: "continue" }; + case "ref": { + const tree = state.trees.pop()!; + state.trees.push( + expr([ + DECISION_HEAD, + sym("GrammarRef"), + expr([sym("Target"), quoteAtom(frame.target)]), + expr([]), + expr([tree]), + ]), + ); + return { tag: "continue" }; + } + case "prod": { + const tree = state.trees.pop()!; + state.trees.push( + expr([ + DECISION_HEAD, + sym("GrammarProduction"), + expr([sym("Target"), quoteAtom(frame.target)]), + expr([sym("ProductionIndex"), frame.productionIndex, gint(BigInt(frame.position))]), + expr([frame.choiceTree, tree]), + ]), + ); + return { tag: "continue" }; + } + case "bind": { + const body = state.values.pop()!; + const tree = state.trees.pop()!; + state.values.push(expr([frame.variable, body])); + state.trees.push( + expr([ + DECISION_HEAD, + sym("GrammarBind"), + expr([sym("Sort"), quoteAtom(frame.sort)]), + expr([sym("BindingId"), gint(frame.bindingId)]), + expr([tree]), + ]), + ); + return { tag: "continue" }; + } + case "scoped": { + const tree = state.trees.pop()!; + state.trees.push( + expr([ + DECISION_HEAD, + sym("GrammarScoped"), + expr([sym("Bindings"), frame.added]), + expr([]), + expr([tree]), + ]), + ); + return { tag: "continue" }; + } + case "expr": + return doneOutcome( + machineError("MalformedGrammarMachineState", expr([sym("Frames"), sym("FExpr")])), + ); + } + } + + if (frame.cursor >= frame.instrs.length) { + state.frames.pop(); + return { tag: "continue" }; + } + const instr = frame.instrs[frame.cursor]!; + frame.cursor += 1; + const size = frame.size; + if (instr.kind !== "expr" || instr.items.length === 0 || instr.items[0]!.kind !== "sym") + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + const op = instr.items[0]!.name; + + if (op === "GILit" && instr.items.length === 2) { + const value = unquote(instr.items[1]!); + if (value === undefined) + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + pushResult( + state, + value, + expr([ + DECISION_HEAD, + sym("GrammarLiteral"), + expr([]), + expr([sym("Value"), quoteAtom(value)]), + expr([]), + ]), + ); + return { tag: "continue" }; + } + if (op === "GIField" && instr.items.length === 2) return suspend(state, instr.items[1]!, size); + if (op === "GIRef" && instr.items.length === 4) { + const target = unquote(instr.items[1]!); + const ordinal = integralNumberValue(instr.items[2]!); + const total = integralNumberValue(instr.items[3]!); + if (target === undefined || ordinal === undefined || total === undefined) + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + if (size <= 0n) + return doneOutcome( + machineError( + "GrammarDepthExhausted", + expr([sym("Target"), quoteAtom(target)]), + expr([sym("Size"), gint(size)]), + ), + ); + if (total <= 0n || ordinal < 0n || ordinal >= total) + return doneOutcome( + machineError( + "MalformedIndexedGrammarReference", + expr([sym("Ordinal"), gint(ordinal)]), + expr([sym("Total"), gint(total)]), + ), + ); + const childSize = referenceChildSize(size, ordinal, total); + state.frames.push({ tag: "ref", target }); + return enterNonterminal(state, target, childSize); + } + if (op === "GIFresh" && instr.items.length === 2) { + const sort = unquote(instr.items[1]!); + if (sort === undefined) + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + const marker = gnd( + { g: "ext", kind: FUZZ_VARIABLE_MARKER_KIND, id: state.nextId.toString() }, + FUZZ_VARIABLE_MARKER_TYPE, + ); + pushResult( + state, + marker, + expr([ + DECISION_HEAD, + sym("GrammarFresh"), + expr([sym("Sort"), quoteAtom(sort)]), + expr([sym("BindingId"), gint(state.nextId)]), + expr([]), + ]), + ); + state.nextId += 1n; + return { tag: "continue" }; + } + if (op === "GIUse" && instr.items.length === 2) { + const sort = unquote(instr.items[1]!); + if (sort === undefined) + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + const markers = scopeValueMarkers(state.scope, sort); + if (!Array.isArray(markers)) return doneOutcome(markers); + if (markers.length === 0) + return doneOutcome(machineError("UnboundGrammarUse", expr([sym("Sort"), quoteAtom(sort)]))); + return suspend(state, expr([sym("GenElement"), expr(markers)]), size); + } + if (op === "GIBind" && instr.items.length === 3 && instr.items[2]!.kind === "expr") { + const sort = unquote(instr.items[1]!); + if (sort === undefined) + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + const variable = gnd( + { g: "ext", kind: FUZZ_VARIABLE_MARKER_KIND, id: state.nextId.toString() }, + FUZZ_VARIABLE_MARKER_TYPE, + ); + state.frames.push({ tag: "scope", saved: [...state.scope] }); + state.frames.push({ tag: "bind", sort, bindingId: state.nextId, variable }); + state.frames.push({ tag: "plan", instrs: instr.items[2]!.items, cursor: 0, size }); + state.scope = [ + expr([sym("GrammarBinding"), quoteAtom(sort), gint(state.nextId)]), + ...state.scope, + ]; + state.nextId += 1n; + return { tag: "continue" }; + } + if ( + op === "GIScoped" && + instr.items.length === 5 && + instr.items[1]!.kind === "expr" && + instr.items[4]!.kind === "expr" + ) { + const added = instr.items[1]!; + const minimumNextId = integralNumberValue(instr.items[2]!); + const raw = unquote(instr.items[3]!); + if (minimumNextId === undefined || raw === undefined) + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + for (const binding of added.items) { + if (binding.kind !== "expr" || binding.items.length !== 3) continue; + const id = binding.items[2]!; + for (const existing of state.scope) + if ( + existing.kind === "expr" && + existing.items.length === 3 && + atomEq(existing.items[2]!, id) + ) + return doneOutcome( + machineError("DuplicateGrammarBindingId", expr([sym("Bindings"), raw])), + ); + } + state.frames.push({ tag: "scope", saved: [...state.scope] }); + state.frames.push({ tag: "scoped", added }); + state.frames.push({ tag: "plan", instrs: instr.items[4]!.items, cursor: 0, size }); + state.scope = [...added.items, ...state.scope]; + if (minimumNextId > state.nextId) state.nextId = minimumNextId; + return { tag: "continue" }; + } + if (op === "GIExprEnter" && instr.items.length === 2) { + const arity = integralNumberValue(instr.items[1]!); + if (arity === undefined) + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); + const plan = state.frames.pop()!; + state.frames.push({ tag: "expr", arity: Number(arity), depth: state.trees.length }); + state.frames.push(plan); + return { tag: "continue" }; + } + if (op === "GIExprBuild" && instr.items.length === 1) { + const plan = state.frames.pop()!; + const exprFrame = state.frames.pop(); + if (exprFrame === undefined || exprFrame.tag !== "expr") + return doneOutcome( + machineError("MalformedGrammarMachineState", expr([sym("Frames"), sym("GIExprBuild")])), + ); + state.frames.push(plan); + const values = state.values.splice(state.values.length - exprFrame.arity, exprFrame.arity); + const trees = state.trees.splice(state.trees.length - exprFrame.arity, exprFrame.arity); + pushResult( + state, + expr(values), + expr([ + DECISION_HEAD, + sym("GrammarExpression"), + expr([sym("Arity"), gint(BigInt(exprFrame.arity))]), + expr([]), + expr(trees), + ]), + ); + return { tag: "continue" }; + } + return doneOutcome(machineError("MalformedGrammarInstruction", expr([sym("Value"), instr]))); +} + +function enterNonterminal(state: MachineState, target: Atom, size: bigint): StepResult { + const eligibleAtom = eligibleListForMachine(state.productions, target, state.scope, size); + if ( + eligibleAtom.kind !== "expr" || + eligibleAtom.items.length !== 2 || + eligibleAtom.items[0]!.kind !== "sym" || + eligibleAtom.items[0]!.name !== "EligibleGrammarProductions" || + eligibleAtom.items[1]!.kind !== "expr" + ) { + if ( + eligibleAtom.kind === "expr" && + eligibleAtom.items.length === 2 && + eligibleAtom.items[0]!.kind === "sym" && + eligibleAtom.items[0]!.name === "FitDuplicateGrammarBindingId" + ) { + const raw = unquote(eligibleAtom.items[1]!); + return doneOutcome( + machineError( + "DuplicateGrammarBindingId", + expr([sym("Bindings"), raw ?? eligibleAtom.items[1]!]), + ), + ); + } + return doneOutcome(machineError("KernelError", expr([sym("OperationResult"), eligibleAtom]))); + } + const eligible = eligibleAtom.items[1]!.items; + if (eligible.length === 0) { + state.cut = { + reason: expr([ + sym("NoEligibleGrammarProduction"), + expr([sym("Target"), quoteAtom(target)]), + expr([sym("Size"), gint(size)]), + ]), + tree: expr([ + DECISION_HEAD, + sym("GrammarUnavailable"), + expr([sym("Target"), quoteAtom(target)]), + expr([sym("Size"), gint(size)]), + expr([]), + ]), + }; + return { tag: "continue" }; + } + + const count = BigInt(eligible.length); + let choice: IntChoice; + if (state.driver.mode === "Random") { + let total = 0n; + for (const production of eligible) { + const weight = integralNumberValue( + (production as Extract).items[2]!, + ); + total += weight ?? 0n; + } + const [ticket, nextRng] = drawIntFromState(state.driver.rng, 1n, total); + let remaining = ticket; + let position = 0n; + for (const production of eligible) { + const weight = + integralNumberValue((production as Extract).items[2]!) ?? + 0n; + if (remaining <= weight) break; + remaining -= weight; + position += 1n; + } + choice = { + tag: "one", + value: position, + driver: { mode: "Random", rng: nextRng }, + decision: intDecisionAtom(0n, count - 1n, 0n, position), + }; + } else if (state.driver.mode === "Edge") { + const position = state.driver.index % count; + choice = { + tag: "one", + value: position, + driver: { mode: "Edge", index: state.driver.index + 1n }, + decision: intDecisionAtom(0n, count - 1n, 0n, position), + }; + } else { + choice = driverInt(state.driver, 0n, count - 1n, 0n); + } + + if (choice.tag === "error") return doneOutcome(choice.error); + const applyChoice = ( + target2: MachineState, + branch: { value: bigint; driver: MachineDriver; decision: Atom }, + ): StepResult => { + target2.driver = branch.driver; + const production = eligible[Number(branch.value)]!; + if ( + production.kind !== "expr" || + production.items.length !== 5 || + production.items[4]!.kind !== "expr" || + production.items[4]!.items.length !== 2 + ) + return doneOutcome( + machineError( + "MalformedSelectedGrammarProduction", + expr([sym("Target"), quoteAtom(target)]), + expr([sym("Production"), production]), + ), + ); + const template = production.items[4]!.items[1]!; + const planned = compileTemplatePlanCached(template); + if (isErrorAtom(planned)) + return doneOutcome(machineError("KernelError", expr([sym("OperationResult"), planned]))); + target2.frames.push({ + tag: "prod", + target, + productionIndex: production.items[1]!, + position: Number(branch.value), + choiceTree: branch.decision, + }); + target2.frames.push({ tag: "plan", instrs: planned, cursor: 0, size }); + return { tag: "continue" }; + }; + + return applyChoice(state, choice); +} + +function compileTemplatePlanCached(template: Atom): readonly Atom[] | Atom { + const cached = templatePlanCache.get(template); + if (cached !== undefined) { + const body = (cached as Extract).items[1]!; + return (body as Extract).items; + } + const instructions = compileTemplatePlan(template); + if (!Array.isArray(instructions)) return instructions; + const plan = expr([GRAMMAR_TEMPLATE_PLAN_HEAD, expr(instructions)]); + templatePlanCache.set(template, plan); + return instructions; +} + +// Shared with the eligibility operation: identical fit semantics and memoisation. +function eligibleListForMachine( + productions: Atom, + target: Atom, + scope: readonly Atom[], + size: bigint, +): Atom { + const looked = grammarEligibleProductions([ + productions, + quoteAtom(target), + expr([...scope]), + gint(size), + ]); + if (looked.tag !== "ok" || looked.results.length !== 1) + return kernelError( + "InvalidGrammarEligibility", + expr([sym("Operation"), sym("_fuzz-grammar-machine-op")]), + sym("EligibilityFailed"), + ); + return looked.results[0]!; +} + +function runMachineToOutcome(state: MachineState): MachineOutcome { + for (;;) { + const stepped = stepMachine(state); + if (stepped.tag === "outcome") return stepped.outcome; + } +} + +const grammarMachineOp: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-machine-op", 1, args.length); + const input = args[0]!; + if (input.kind !== "expr" || input.items.length === 0 || input.items[0]!.kind !== "sym") + return operationError( + "InvalidGrammarMachineInput", + "_fuzz-grammar-machine-op", + "ExpectedExpression", + ); + const head = input.items[0]!.name; + + let state: MachineState; + if (head === MACHINE_START_HEAD.name && input.items.length === 6) { + const source = input.items[1]!; + const target = unquote(input.items[2]!); + const scopeAtom = input.items[3]!; + const nextId = integralNumberValue(input.items[4]!); + if (target === undefined || scopeAtom.kind !== "expr" || nextId === undefined) + return operationError( + "InvalidGrammarMachineInput", + "_fuzz-grammar-machine-op", + "MalformedStart", + ); + const request = input.items[5]!; + if ( + request.kind !== "expr" || + request.items.length !== 3 || + request.items[0]!.kind !== "sym" || + request.items[0]!.name !== "WithDriver" + ) + return operationError( + "InvalidGrammarMachineInput", + "_fuzz-grammar-machine-op", + "MalformedStart", + ); + const driver = decodeDriver(request.items[1]!); + if (!("mode" in driver)) return ok(expr([MACHINE_DONE_HEAD, driver])); + const size = integralNumberValue(request.items[2]!); + if (size === undefined) + return operationError( + "InvalidGrammarMachineInput", + "_fuzz-grammar-machine-op", + "MalformedStart", + ); + const productions = productionsOfSource(source); + if (productions === undefined) + return ok( + expr([ + MACHINE_DONE_HEAD, + machineError("MalformedGrammarSource", expr([sym("Value"), source])), + ]), + ); + state = { + source, + productions, + frames: [], + values: [], + trees: [], + scope: [...scopeAtom.items], + nextId, + driver, + cut: undefined, + }; + const entered = enterNonterminal(state, target, size); + if (entered.tag === "outcome") + return { + tag: "ok", + results: [outcomeAtom(entered.outcome)], + }; + } else if (head === MACHINE_RESUME_HEAD.name && input.items.length === 3) { + const decoded = decodeMachineState(input.items[1]!); + if (!("frames" in decoded)) return ok(expr([MACHINE_DONE_HEAD, decoded])); + state = decoded; + const sample = input.items[2]!; + const applied = applySubResult(state, sample); + if (applied !== undefined) return ok(expr([MACHINE_DONE_HEAD, applied])); + } else { + return operationError( + "InvalidGrammarMachineInput", + "_fuzz-grammar-machine-op", + "UnknownRequest", + ); + } + + return ok(outcomeAtom(runMachineToOutcome(state))); +}; + +function outcomeAtom(outcome: MachineOutcome): Atom { + if (outcome.tag === "done") return expr([MACHINE_DONE_HEAD, outcome.result]); + return expr([MACHINE_NEED_HEAD, outcome.state, outcome.request]); +} + +// Consumes the trampoline's answer to an `EvaluateGenerator` request: the sub-generation ran the +// suspended field or `Use` element choice, so its sample becomes the next pushed value (with the +// forged-marker check for fields) and its driver becomes the machine's driver. The suspension +// site is identified by the instruction just before the plan cursor. +function applySubResult(state: MachineState, sample: Atom): Atom | undefined { + const frame = state.frames[state.frames.length - 1]; + if (frame === undefined || frame.tag !== "plan" || frame.cursor === 0) + return machineError("MalformedGrammarMachineState", expr([sym("Resume"), sym("frame")])); + const instr = frame.instrs[frame.cursor - 1]!; + if (instr.kind !== "expr" || instr.items.length !== 2 || instr.items[0]!.kind !== "sym") + return machineError("MalformedGrammarMachineState", expr([sym("Resume"), sym("instruction")])); + const instrHead = instr.items[0]!.name; + const isField = instrHead === "GIField"; + const isUse = instrHead === "GIUse"; + if (!isField && !isUse) + return machineError("MalformedGrammarMachineState", expr([sym("Resume"), sym("instruction")])); + + if ( + sample.kind === "expr" && + sample.items.length === 4 && + sample.items[0]!.kind === "sym" && + sample.items[0]!.name === FUZZ_SAMPLE_HEAD.name + ) { + const value = sample.items[1]!; + const nextDriver = decodeDriver(sample.items[2]!); + if (!("mode" in nextDriver)) return nextDriver; + const tree = sample.items[3]!; + if (isField) { + const generator = instr.items[1]!; + if (containsMarkerValue(value)) + return machineError( + "ForgedGrammarVariableMarker", + expr([sym("Generator"), generator]), + expr([sym("Value"), value]), + ); + state.driver = nextDriver; + pushResult(state, value, fieldDecision(generator, tree)); + return undefined; + } + const sort = unquote(instr.items[1]!)!; + state.driver = nextDriver; + pushResult( + state, + value, + expr([ + DECISION_HEAD, + sym("GrammarUse"), + expr([sym("Sort"), quoteAtom(sort)]), + expr([]), + expr([tree]), + ]), + ); + return undefined; + } + if ( + sample.kind === "expr" && + sample.items.length === 4 && + sample.items[0]!.kind === "sym" && + sample.items[0]!.name === FUZZ_GENERATION_DISCARD_HEAD.name + ) { + if (!isField) + return machineError( + "MalformedGrammarUseResult", + expr([sym("Sort"), instr.items[1]!]), + expr([sym("Value"), sample]), + ); + const nextDriver = decodeDriver(sample.items[2]!); + if (!("mode" in nextDriver)) return nextDriver; + state.driver = nextDriver; + state.cut = { + reason: sample.items[1]!, + tree: fieldDecision(instr.items[1]!, sample.items[3]!), + }; + return undefined; + } + if ( + sample.kind === "expr" && + sample.items.length >= 1 && + sample.items[0]!.kind === "sym" && + sample.items[0]!.name === FUZZ_GENERATION_ERROR_HEAD.name + ) + return sample; + return isField + ? machineError( + "MalformedGrammarFieldResult", + expr([sym("Generator"), instr.items[1]!]), + expr([sym("Value"), sample]), + ) + : machineError( + "MalformedGrammarUseResult", + expr([sym("Sort"), instr.items[1]!]), + expr([sym("Value"), sample]), + ); +} + +// Distinct production targets in first-occurrence order, and reference validation against +// them — both one pass over raw syntax. +const grammarTargetsOp: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-targets-op", 1, args.length); + const productions = args[0]!; + if (productions.kind !== "expr") + return operationError( + "InvalidGrammarProductions", + "_fuzz-grammar-targets-op", + "ExpectedExpression", + ); + const seen = new Set(); + const out: Atom[] = []; + for (const production of productions.items) { + if ( + production.kind !== "expr" || + production.items.length !== 5 || + production.items[3]!.kind !== "expr" || + production.items[3]!.items.length !== 2 + ) + return operationError( + "InvalidGrammarProductions", + "_fuzz-grammar-targets-op", + "MalformedProduction", + ); + const target = production.items[3]!.items[1]!; + const key = structuralAtomKey(target, "Exact"); + if (!key.ok) return ok(key.reason); + if (seen.has(key.key)) continue; + seen.add(key.key); + out.push(quoteAtom(target)); + } + return ok(expr([sym("GrammarTargets"), expr(out)])); +}; + +const grammarValidateReferencesOp: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-grammar-validate-references-op", 2, args.length); + const [productions, targets] = args; + if (productions!.kind !== "expr" || targets!.kind !== "expr") + return operationError( + "InvalidGrammarReferences", + "_fuzz-grammar-validate-references-op", + "ExpectedExpressions", + ); + const known = new Set(); + for (const quoted of targets!.items) { + const target = unquote(quoted); + if (target === undefined) + return operationError( + "InvalidGrammarReferences", + "_fuzz-grammar-validate-references-op", + "MalformedTarget", + ); + const key = structuralAtomKey(target, "Exact"); + if (!key.ok) return ok(key.reason); + known.add(key.key); + } + for (const production of productions!.items) { + if ( + production.kind !== "expr" || + production.items.length !== 5 || + production.items[4]!.kind !== "expr" || + production.items[4]!.items.length !== 2 + ) + return operationError( + "InvalidGrammarReferences", + "_fuzz-grammar-validate-references-op", + "MalformedProduction", + ); + for (const referenced of templateReferenceTargetAtoms(production.items[4]!.items[1]!)) { + const key = structuralAtomKey(referenced, "Exact"); + if (!key.ok) return ok(key.reason); + if (!known.has(key.key)) + return ok(expr([sym("GrammarMissingReference"), quoteAtom(referenced)])); + } + } + return ok(expr([sym("ValidGrammarReferences")])); +}; + +// Flattens a nested FuzzStack (top = most recently pushed) into a flat expression in push +// order — the accumulator finisher for bare-tail loops that build lists. +const fuzzStackToExpression: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-stack-to-expression", 1, args.length); + const items = decodeStack(args[0]!); + if (isErrorAtom(items)) + return operationError("InvalidStackTake", "_fuzz-stack-to-expression", "MalformedStack"); + return ok(expr(items)); +}; + +// ---- productivity worklist support ---- +// Which productions reference a target: the worklist fixed point re-analyzes exactly the +// dependents of a target whose alternatives changed, instead of restarting a full walk. +// Indexed once per productions atom. +const productionDependentsCache = new WeakMap>(); + +function templateReferenceTargetAtoms(template: Atom): Atom[] { + const out: Atom[] = []; + const pending: Atom[] = [template]; + while (pending.length > 0) { + const atom = pending.pop()!; + if (atom.kind === "expr" && atom.items.length > 0 && atom.items[0]!.kind === "sym") { + const head = atom.items[0]!.name; + if (head === "Ref" && atom.items.length === 2) { + out.push(atom.items[1]!); + continue; + } + if (head === GRAMMAR_INDEXED_REFERENCE_HEAD.name && atom.items.length === 4) { + out.push(atom.items[1]!); + continue; + } + } + const indices = grammarTemplateChildIndices(atom); + for (let index = indices.length - 1; index >= 0; index -= 1) + pending.push((atom as Extract).items[indices[index]!]!); + } + return out; +} + +const grammarDependentsOf: GroundFn = (args) => { + const parsed = parseProductionsTargetArgs( + args, + "InvalidGrammarDependentsLookup", + "_fuzz-grammar-dependents-of", + ); + if ("tag" in parsed) return parsed; + const { productions, target } = parsed; + let byTarget = productionDependentsCache.get(productions); + if (byTarget === undefined) { + const collected = new Map(); + for (let index = 0; index < productions.items.length; index += 1) { + const production = productions.items[index]!; + if ( + production.kind !== "expr" || + production.items.length !== 5 || + production.items[4]!.kind !== "expr" || + production.items[4]!.items.length !== 2 + ) + return operationError( + "InvalidGrammarDependentsLookup", + "_fuzz-grammar-dependents-of", + "MalformedProduction", + ); + for (const target of templateReferenceTargetAtoms(production.items[4]!.items[1]!)) { + const key = structuralAtomKey(target, "Exact"); + if (!key.ok) return ok(key.reason); + const bucket = collected.get(key.key); + if (bucket === undefined) collected.set(key.key, [BigInt(index)]); + else if (bucket[bucket.length - 1] !== BigInt(index)) bucket.push(BigInt(index)); + } + } + byTarget = new Map(); + for (const [key, indices] of collected) + byTarget.set(key, expr(indices.map((value) => gint(value)))); + productionDependentsCache.set(productions, byTarget); + } + const targetKey = structuralAtomKey(target, "Exact"); + if (!targetKey.ok) return ok(targetKey.reason); + return ok(expr([sym("GrammarDependents"), byTarget.get(targetKey.key) ?? expr([])])); +}; + +// Seeds the worklist: a nested stack of production indices 0..count-1, popping in ascending order. +const fuzzIndexStack: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-index-stack", 1, args.length); + const count = integralNumberValue(args[0]!); + if (count === undefined || count < 0n) + return operationError("InvalidIndexStack", "_fuzz-index-stack", "ExpectedNonNegativeCount"); + let stack: Atom = sym("FuzzStackBottom"); + for (let index = Number(count) - 1; index >= 0; index -= 1) + stack = expr([FUZZ_STACK_HEAD, gint(BigInt(index)), stack]); + return ok(stack); +}; + +// ---- template instruction plans ---- +// Compiles a prepared template (fields resolved, refs indexed) into the flat postorder +// instruction list the grammar machine executes. Mirrors the recursive interpreter's +// template dispatch exactly: the reserved forms at their exact arities become dedicated +// instructions, every other expression generates all of its items (a non-reserved head +// included) as children, and every other atom is a literal leaf. Memoized by template +// identity: StaticGrammar templates are stable, so each compiles once per process. +const templatePlanCache = new WeakMap(); + +function compileTemplatePlan(template: Atom): Atom[] | Atom { + type Task = + | { readonly tag: "visit"; readonly atom: Atom; readonly out: Atom[] } + | { readonly tag: "emit-expr"; readonly out: Atom[] } + | { + readonly tag: "emit-bind"; + readonly sort: Atom; + readonly body: Atom[]; + readonly out: Atom[]; + } + | { + readonly tag: "emit-scoped"; + readonly normalized: Atom; + readonly minimumNextId: bigint; + readonly raw: Atom; + readonly body: Atom[]; + readonly out: Atom[]; + }; + const rootOut: Atom[] = []; + const pending: Task[] = [{ tag: "visit", atom: template, out: rootOut }]; + while (pending.length > 0) { + const task = pending.pop()!; + if (task.tag === "emit-expr") { + task.out.push(expr([GI_EXPR_BUILD_HEAD])); + continue; + } + if (task.tag === "emit-bind") { + task.out.push(expr([GI_BIND_HEAD, expr([QUOTE_HEAD, task.sort]), expr(task.body)])); + continue; + } + if (task.tag === "emit-scoped") { + task.out.push( + expr([ + GI_SCOPED_HEAD, + task.normalized, + gint(task.minimumNextId), + expr([QUOTE_HEAD, task.raw]), + expr(task.body), + ]), + ); + continue; + } + const { atom, out } = task; + if (atom.kind === "expr" && atom.items.length > 0 && atom.items[0]!.kind === "sym") { + const head = atom.items[0]!.name; + if (head === "Literal" && atom.items.length === 2) { + out.push(expr([GI_LIT_HEAD, expr([QUOTE_HEAD, atom.items[1]!])])); + continue; + } + if (head === "Field" && atom.items.length === 2) { + out.push(expr([GI_FIELD_HEAD, atom.items[1]!])); + continue; + } + if (head === "Ref" && atom.items.length === 2) { + out.push(expr([GI_REF_HEAD, expr([QUOTE_HEAD, atom.items[1]!]), gint(0), gint(1)])); + continue; + } + if (head === GRAMMAR_INDEXED_REFERENCE_HEAD.name && atom.items.length === 4) { + const ordinal = integralNumberValue(atom.items[2]!); + const total = integralNumberValue(atom.items[3]!); + if (ordinal === undefined || total === undefined) + return kernelError( + "InvalidGrammarTemplatePlan", + expr([sym("Operation"), sym("_fuzz-grammar-template-plan")]), + sym("MalformedIndexedReference"), + ); + out.push( + expr([GI_REF_HEAD, expr([QUOTE_HEAD, atom.items[1]!]), gint(ordinal), gint(total)]), + ); + continue; + } + if (head === "Fresh" && atom.items.length === 2) { + out.push(expr([GI_FRESH_HEAD, expr([QUOTE_HEAD, atom.items[1]!])])); + continue; + } + if (head === "Use" && atom.items.length === 2) { + out.push(expr([GI_USE_HEAD, expr([QUOTE_HEAD, atom.items[1]!])])); + continue; + } + if (head === "Bind" && atom.items.length === 3) { + const body: Atom[] = []; + pending.push({ tag: "emit-bind", sort: atom.items[1]!, body, out }); + pending.push({ tag: "visit", atom: atom.items[2]!, out: body }); + continue; + } + if (head === "Scoped" && atom.items.length === 3) { + const bindings = atom.items[1]!; + if (bindings.kind !== "expr") + return kernelError( + "InvalidGrammarTemplatePlan", + expr([sym("Operation"), sym("_fuzz-grammar-template-plan")]), + sym("MalformedScopedBindings"), + ); + const normalized: Atom[] = []; + const seen = new Set(); + let minimumNextId = 0n; + for (const binding of bindings.items) { + if ( + binding.kind !== "expr" || + binding.items.length !== 3 || + binding.items[0]!.kind !== "sym" || + binding.items[0]!.name !== "Binding" + ) + return kernelError( + "InvalidGrammarTemplatePlan", + expr([sym("Operation"), sym("_fuzz-grammar-template-plan")]), + sym("MalformedScopedBindings"), + ); + const id = integralNumberValue(binding.items[2]!); + if (id === undefined || id < 0n || seen.has(id.toString())) + return kernelError( + "InvalidGrammarTemplatePlan", + expr([sym("Operation"), sym("_fuzz-grammar-template-plan")]), + sym("MalformedScopedBindings"), + ); + seen.add(id.toString()); + normalized.push( + expr([sym("GrammarBinding"), expr([QUOTE_HEAD, binding.items[1]!]), binding.items[2]!]), + ); + if (id + 1n > minimumNextId) minimumNextId = id + 1n; + } + const body: Atom[] = []; + pending.push({ + tag: "emit-scoped", + normalized: expr(normalized), + minimumNextId, + raw: bindings, + body, + out, + }); + pending.push({ tag: "visit", atom: atom.items[2]!, out: body }); + continue; + } + } + if (atom.kind === "expr") { + out.push(expr([GI_EXPR_ENTER_HEAD, gint(atom.items.length)])); + pending.push({ tag: "emit-expr", out }); + for (let index = atom.items.length - 1; index >= 0; index -= 1) + pending.push({ tag: "visit", atom: atom.items[index]!, out }); + continue; + } + out.push(expr([GI_LIT_HEAD, expr([QUOTE_HEAD, atom])])); + } + return rootOut; +} + +const grammarTemplatePlan: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-template-plan", 1, args.length); + const template = args[0]!; + const cached = templatePlanCache.get(template); + if (cached !== undefined) return ok(cached); + const instructions = compileTemplatePlan(template); + if (isErrorAtom(instructions)) return ok(instructions); + const plan = expr([GRAMMAR_TEMPLATE_PLAN_HEAD, expr(instructions)]); + templatePlanCache.set(template, plan); + return ok(plan); +}; + +// ---- machine stacks and memo ---- + +// Pushes `items` so they pop in forward order: the fit walker expands an expression's +// children onto its task stack without the O(n) flat-list concat per pop. +const fuzzStackPushAll: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-stack-push-all", 2, args.length); + const items = args[1]!; + if (items.kind !== "expr") + return operationError("InvalidStackPush", "_fuzz-stack-push-all", "ExpectedExpression"); + let stack = args[0]!; + for (let index = items.items.length - 1; index >= 0; index -= 1) + stack = expr([FUZZ_STACK_HEAD, items.items[index]!, stack]); + return ok(stack); +}; + +const fuzzStackTake: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-stack-take", 2, args.length); + const count = integralNumberValue(args[1]!); + if (count === undefined || count < 0n) + return operationError("InvalidStackTake", "_fuzz-stack-take", "ExpectedNonNegativeCount"); + let rest = args[0]!; + const popped: Atom[] = []; + for (let taken = 0n; taken < count; taken += 1n) { + if ( + rest.kind !== "expr" || + rest.items.length !== 3 || + rest.items[0]!.kind !== "sym" || + rest.items[0]!.name !== FUZZ_STACK_HEAD.name + ) + return operationError("InvalidStackTake", "_fuzz-stack-take", "StackUnderflow"); + popped.push(rest.items[1]!); + rest = rest.items[2]!; + } + popped.reverse(); + return ok(expr([FUZZ_STACK_TAKE_HEAD, expr(popped), rest])); +}; + +const grammarValidationPlan: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-validation-plan", 1, args.length); + type Task = { readonly tag: "visit"; readonly atom: Atom } | { readonly tag: "scoped-exit" }; + + const pending: Task[] = [{ tag: "visit", atom: args[0]! }]; + const events: Atom[] = []; + while (pending.length > 0) { + const task = pending.pop()!; + if (task.tag === "scoped-exit") { + events.push(expr([GRAMMAR_VALIDATION_SCOPED_EXIT_HEAD])); + continue; + } + + const atom = task.atom; + if (atom.kind === "expr" && atom.items[0]?.kind === "sym") { + const head = atom.items[0].name; + if ( + ((head === "Literal" || head === "Ref" || head === "Fresh" || head === "Use") && + atom.items.length === 2) || + (head === "_FuzzGrammarRef" && atom.items.length === 4) + ) { + continue; + } + if (head === "Field" && atom.items.length === 2) { + events.push(expr([GRAMMAR_VALIDATION_FIELD_HEAD, expr([QUOTE_HEAD, atom.items[1]!])])); + continue; + } + if (head === "Bind" && atom.items.length === 3) { + pending.push({ tag: "visit", atom: atom.items[2]! }); + continue; + } + if (head === "Scoped" && atom.items.length === 3) { + events.push( + expr([GRAMMAR_VALIDATION_SCOPED_ENTER_HEAD, expr([QUOTE_HEAD, atom.items[1]!])]), + ); + pending.push({ tag: "scoped-exit" }); + pending.push({ tag: "visit", atom: atom.items[2]! }); + continue; + } + if (GRAMMAR_RESERVED_TEMPLATE_HEADS.has(head)) { + events.push(expr([GRAMMAR_VALIDATION_MALFORMED_HEAD, expr([QUOTE_HEAD, atom])])); + continue; + } + } + + if (atom.kind !== "expr") continue; + for (let index = atom.items.length - 1; index >= 0; index -= 1) + pending.push({ tag: "visit", atom: atom.items[index]! }); + } + + return ok(expr([GRAMMAR_VALIDATION_PLAN_HEAD, expr(events)])); +}; + +const grammarReferenceTargets: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-grammar-template-reference-plan", 1, args.length); + const pending: Atom[] = [args[0]!]; + const targets: Atom[] = []; + while (pending.length > 0) { + const atom = pending.pop()!; + if ( + atom.kind === "expr" && + atom.items[0]?.kind === "sym" && + ((atom.items[0].name === "Ref" && atom.items.length === 2) || + (atom.items[0].name === "_FuzzGrammarRef" && atom.items.length === 4)) + ) { + targets.push(expr([QUOTE_HEAD, atom.items[1]!])); + continue; + } + const indices = grammarTemplateChildIndices(atom); + for (let index = indices.length - 1; index >= 0; index -= 1) + pending.push((atom as Extract).items[indices[index]!]!); + } + return ok(expr([GRAMMAR_REFERENCE_TARGETS_HEAD, expr(targets)])); +}; + +const atomGround: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-atom-ground", 1, args.length); + return ok(gbool(args[0]!.ground)); +}; + +const customReplayTree: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-custom-replay-tree", 2, args.length); + const [result, expectedMode] = args; + if ( + result!.kind === "expr" && + result!.items.length === 3 && + atomEq(result!.items[0]!, FUZZ_GENERATION_ERROR_HEAD) + ) { + return ok(expr([CUSTOM_REPLAY_SKIP_HEAD])); + } + if ( + result!.kind !== "expr" || + result!.items.length !== 4 || + (!atomEq(result!.items[0]!, FUZZ_SAMPLE_HEAD) && + !atomEq(result!.items[0]!, FUZZ_GENERATION_DISCARD_HEAD)) + ) { + return ok( + expr([ + CUSTOM_REPLAY_PROTOCOL_ERROR_HEAD, + sym("MalformedGenerationResult"), + expr([sym("Details"), expr([sym("Value"), result!])]), + ]), + ); + } + + const driver = result!.items[2]!; + if ( + driver.kind !== "expr" || + driver.items.length !== 3 || + !atomEq(driver.items[0]!, FUZZ_DRIVER_HEAD) || + !atomEq(driver.items[1]!, expectedMode!) + ) { + return ok( + expr([ + CUSTOM_REPLAY_PROTOCOL_ERROR_HEAD, + sym("CustomDriverMismatch"), + expr([ + sym("Details"), + expr([sym("ExpectedMode"), expectedMode!]), + expr([sym("ActualDriver"), driver]), + ]), + ]), + ); + } + // A tree the replay key rejects (an external grounded value, an executable grounded, a + // custom matcher) cannot round-trip through replay at all, so self-replay validation is + // skipped and the runner's nonreplayable handling keeps the original failure evidence. + const treeKey = structuralAtomKey(result!.items[3]!, "Replay"); + if (!treeKey.ok) return ok(expr([CUSTOM_REPLAY_SKIP_HEAD])); + return ok(expr([CUSTOM_REPLAY_TREE_HEAD, result!.items[3]!])); +}; + +const customReplayEqual: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-custom-replay-equal", 2, args.length); + const [original, replayed] = args; + if ( + original!.kind !== "expr" || + replayed!.kind !== "expr" || + original!.items.length !== 4 || + replayed!.items.length !== 4 || + !atomEq(original!.items[0]!, replayed!.items[0]!) || + (!atomEq(original!.items[0]!, FUZZ_SAMPLE_HEAD) && + !atomEq(original!.items[0]!, FUZZ_GENERATION_DISCARD_HEAD)) + ) { + return ok(gbool(false)); + } + return ok( + gbool( + replayAtomEqual(original!.items[1]!, replayed!.items[1]!, true) && + atomsEqualForKeyMode(original!.items[3]!, replayed!.items[3]!, "Replay"), + ), + ); +}; + +const bitsOfFloat64: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-float64-bits", 1, args.length); + const value = floatValue(args[0]!); + if (value === undefined) + return operationError("InvalidFloat", "_fuzz-float64-bits", "ExpectedFloat"); + const [high, low] = float64Words(value); + return ok(expr([FLOAT_BITS_HEAD, gint(high), gint(low)])); +}; + +const float64OfBits: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-float64-from-bits", 2, args.length); + const high = unsigned32Value(args[0]!); + const low = unsigned32Value(args[1]!); + if (high === undefined || low === undefined) + return operationError("InvalidFloatBits", "_fuzz-float64-from-bits", "ExpectedUnsigned32Words"); + return ok(gfloat(float64FromWords(high, low))); +}; + +const indexOfFloat64: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-float64-index", 1, args.length); + const value = floatValue(args[0]!); + if (value === undefined) + return operationError("InvalidFloat", "_fuzz-float64-index", "ExpectedFloat"); + const index = float64Index(value); + if (index === undefined) + return operationError("InvalidFloat", "_fuzz-float64-index", "NaNHasNoOrderedIndex"); + return ok(expr([FLOAT_INDEX_HEAD, gint(index)])); +}; + +const float64OfIndex: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-float64-from-index", 1, args.length); + const index = integralNumberValue(args[0]!); + if (index === undefined) + return operationError("InvalidFloatIndex", "_fuzz-float64-from-index", "ExpectedInteger"); + const value = float64FromIndex(index); + if (value === undefined) + return operationError("InvalidFloatIndex", "_fuzz-float64-from-index", "OutOfRange"); + return ok(gfloat(value)); +}; + +function unicodeScalarAt(index: bigint): number | undefined { + if (index < 0n || index >= UNICODE_SCALAR_COUNT) return undefined; + if (index < UNICODE_FIRST_GAP_INDEX) return Number(index); + if (index < UNICODE_SECOND_GAP_INDEX) return Number(index + 2_048n); + return Number(index + 2_050n); +} + +const unicodeCharacterAt: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-unicode-character", 1, args.length); + const index = integralNumberValue(args[0]!); + if (index === undefined) + return operationError("InvalidCharacterIndex", "_fuzz-unicode-character", "ExpectedInteger"); + const scalar = unicodeScalarAt(index); + if (scalar === undefined) + return operationError("InvalidCharacterIndex", "_fuzz-unicode-character", "OutOfRange"); + return ok(sym(String.fromCodePoint(scalar))); +}; + +function replayGroundEqual( + left: Extract, + right: Extract, +): boolean { + if ( + left.exec !== undefined || + right.exec !== undefined || + left.match !== undefined || + right.match !== undefined || + !atomEq(left.typ, groundType(left.value)) || + !atomEq(right.typ, groundType(right.value)) || + left.value.g !== right.value.g + ) { + return false; + } + + switch (left.value.g) { + case "int": + return BigInt(left.value.n) === BigInt((right.value as typeof left.value).n); + case "float": + return float64Bits(left.value.n) === float64Bits((right.value as typeof left.value).n); + case "str": + return left.value.s === (right.value as typeof left.value).s; + case "bool": + return left.value.b === (right.value as typeof left.value).b; + case "unit": + return true; + case "error": + return left.value.msg === (right.value as typeof left.value).msg; + case "ext": + return false; + } +} + +function replayAtomEqual(left: Atom, right: Atom, alphaVariables = false): boolean { + const pending: Array = [[left, right]]; + const leftVariables = new Map(); + const rightVariables = new Map(); + while (pending.length > 0) { + const [currentLeft, currentRight] = pending.pop()!; + if (currentLeft.kind !== currentRight.kind) return false; + switch (currentLeft.kind) { + case "sym": + if (currentLeft.name !== currentRight.name) return false; + break; + case "var": { + if (currentRight.kind !== "var") return false; + if (!alphaVariables) { + if (currentLeft.name !== currentRight.name) return false; + break; + } + const mappedRight = leftVariables.get(currentLeft.name); + const mappedLeft = rightVariables.get(currentRight.name); + if (mappedRight === undefined && mappedLeft === undefined) { + leftVariables.set(currentLeft.name, currentRight.name); + rightVariables.set(currentRight.name, currentLeft.name); + } else if (mappedRight !== currentRight.name || mappedLeft !== currentLeft.name) { + return false; + } + break; + } + case "gnd": + if (currentRight.kind !== "gnd" || !replayGroundEqual(currentLeft, currentRight)) + return false; + break; + case "expr": + if (currentRight.kind !== "expr") return false; + if (currentLeft.items.length !== currentRight.items.length) return false; + for (let index = 0; index < currentLeft.items.length; index += 1) { + pending.push([currentLeft.items[index]!, currentRight.items[index]!]); + } + break; + } + } + return true; +} + +const replayEqual: GroundFn = (args) => { + if (args.length !== 2) return arityError("_fuzz-replay-equal", 2, args.length); + return ok(gbool(replayAtomEqual(args[0]!, args[1]!))); +}; + +function encodeGrounded(atom: Extract): Atom { + if (atom.value.g === "ext") + return kernelError("NonReplayableGroundedValue", sym("ExternalGrounded")); + if (atom.exec !== undefined) + return kernelError("NonReplayableGroundedValue", sym("ExecutableGrounded")); + if (atom.match !== undefined) + return kernelError("NonReplayableGroundedValue", sym("CustomMatcher")); + if (!atomEq(atom.typ, groundType(atom.value))) + return kernelError("NonReplayableGroundedValue", sym("CustomGroundedType")); + + switch (atom.value.g) { + case "int": + return expr([ENCODED_INTEGER, gint(atom.value.n)]); + case "float": + return expr([ENCODED_FLOAT, ...float64Words(atom.value.n).map(gint)]); + case "str": + return expr([ENCODED_STRING, gstr(atom.value.s)]); + case "bool": + return expr([ENCODED_BOOLEAN, gbool(atom.value.b)]); + case "unit": + return expr([ENCODED_UNIT]); + case "error": + return expr([ENCODED_ERROR, gstr(atom.value.msg)]); + } +} + +function isKernelErrorAtom(atom: Atom): boolean { + return atom.kind === "expr" && atom.items.length > 0 && atomEq(atom.items[0]!, ERROR_HEAD); +} + +function encodeReplayAtom(atom: Atom): Atom { + type Task = + | { readonly tag: "atom"; readonly atom: Atom } + | { readonly tag: "expression"; readonly count: number }; + const pending: Task[] = [{ tag: "atom", atom }]; + const encoded: Atom[] = []; + + while (pending.length > 0) { + const task = pending.pop()!; + if (task.tag === "expression") { + const children = encoded.splice(encoded.length - task.count, task.count); + const error = children.find(isKernelErrorAtom); + if (error !== undefined) return error; + encoded.push(expr([ENCODED_EXPRESSION, expr(children)])); + continue; + } + + const current = task.atom; + switch (current.kind) { + case "sym": + encoded.push(expr([ENCODED_SYMBOL, gstr(current.name)])); + break; + case "var": + encoded.push(expr([ENCODED_VARIABLE, gstr(current.name)])); + break; + case "gnd": + encoded.push(encodeGrounded(current)); + break; + case "expr": + pending.push({ tag: "expression", count: current.items.length }); + for (let index = current.items.length - 1; index >= 0; index -= 1) { + pending.push({ tag: "atom", atom: current.items[index]! }); + } + break; + } + } + + const payload = encoded[0]!; + return isKernelErrorAtom(payload) + ? payload + : expr([ENCODED_ATOM_HEAD, gint(FUZZ_ATOM_CODEC_VERSION), payload]); +} + +function codecError(detail: string): DecodePayload { + return { + tag: "error", + error: kernelError( + "InvalidEncodedAtom", + expr([sym("Operation"), sym("_fuzz-decode-atom")]), + sym(detail), + ), + }; +} + +function payloadString(payload: Atom, head: Atom): string | undefined { + if (payload.kind !== "expr" || payload.items.length !== 2 || !atomEq(payload.items[0]!, head)) { + return undefined; + } + const value = payload.items[1]!; + return value.kind === "gnd" && value.value.g === "str" ? value.value.s : undefined; +} + +function decodePayload(payload: Atom): DecodePayload { + if (payload.kind !== "expr" || payload.items.length === 0) return codecError("MalformedPayload"); + const head = payload.items[0]!; + + if (atomEq(head, ENCODED_SYMBOL)) { + const name = payloadString(payload, ENCODED_SYMBOL); + return name === undefined ? codecError("MalformedSymbol") : { tag: "atom", atom: sym(name) }; + } + if (atomEq(head, ENCODED_VARIABLE)) { + const name = payloadString(payload, ENCODED_VARIABLE); + return name === undefined + ? codecError("MalformedVariable") + : { tag: "atom", atom: variable(name) }; + } + if (atomEq(head, ENCODED_EXPRESSION)) { + if (payload.items.length !== 2 || payload.items[1]!.kind !== "expr") + return codecError("MalformedExpression"); + return { tag: "expression", children: payload.items[1]!.items }; + } + if (atomEq(head, ENCODED_INTEGER)) { + if (payload.items.length !== 2 || exactIntegerValue(payload.items[1]!) === undefined) + return codecError("MalformedInteger"); + return { tag: "atom", atom: gint(exactIntegerValue(payload.items[1]!)!) }; + } + if (atomEq(head, ENCODED_FLOAT)) { + if (payload.items.length !== 3) return codecError("MalformedFloat64Bits"); + const high = unsigned32Value(payload.items[1]!); + const low = unsigned32Value(payload.items[2]!); + if (high === undefined || low === undefined) return codecError("MalformedFloat64Bits"); + return { tag: "atom", atom: gfloat(float64FromWords(high, low)) }; + } + if (atomEq(head, ENCODED_STRING)) { + const value = payloadString(payload, ENCODED_STRING); + return value === undefined ? codecError("MalformedString") : { tag: "atom", atom: gstr(value) }; + } + if (atomEq(head, ENCODED_BOOLEAN)) { + if ( + payload.items.length !== 2 || + payload.items[1]!.kind !== "gnd" || + payload.items[1]!.value.g !== "bool" + ) { + return codecError("MalformedBoolean"); + } + return { tag: "atom", atom: gbool(payload.items[1]!.value.b) }; + } + if (atomEq(head, ENCODED_UNIT)) { + return payload.items.length === 1 ? { tag: "atom", atom: gunit } : codecError("MalformedUnit"); + } + if (atomEq(head, ENCODED_ERROR)) { + const message = payloadString(payload, ENCODED_ERROR); + return message === undefined + ? codecError("MalformedError") + : { tag: "atom", atom: gnd({ g: "error", msg: message }) }; + } + return codecError("UnknownPayloadTag"); +} + +function decodeReplayAtom(encoded: Atom): Atom { + if ( + encoded.kind !== "expr" || + encoded.items.length !== 3 || + !atomEq(encoded.items[0]!, ENCODED_ATOM_HEAD) || + exactIntegerValue(encoded.items[1]!) !== BigInt(FUZZ_ATOM_CODEC_VERSION) + ) { + return kernelError( + "InvalidEncodedAtom", + expr([sym("Operation"), sym("_fuzz-decode-atom")]), + sym("ExpectedVersion1"), + ); + } + + type Task = + | { readonly tag: "payload"; readonly payload: Atom } + | { readonly tag: "expression"; readonly count: number }; + const pending: Task[] = [{ tag: "payload", payload: encoded.items[2]! }]; + const decoded: Atom[] = []; + + while (pending.length > 0) { + const task = pending.pop()!; + if (task.tag === "expression") { + decoded.push(expr(decoded.splice(decoded.length - task.count, task.count))); + continue; + } + + const payload = decodePayload(task.payload); + if (payload.tag === "error") return payload.error; + if (payload.tag === "atom") { + decoded.push(payload.atom); + continue; + } + pending.push({ tag: "expression", count: payload.children.length }); + for (let index = payload.children.length - 1; index >= 0; index -= 1) { + pending.push({ tag: "payload", payload: payload.children[index]! }); + } + } + + return decoded[0]!; +} + +const encodeAtom: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-encode-atom", 1, args.length); + return ok(encodeReplayAtom(args[0]!)); +}; + +const decodeAtom: GroundFn = (args) => { + if (args.length !== 1) return arityError("_fuzz-decode-atom", 1, args.length); + return ok(decodeReplayAtom(args[0]!)); +}; + +// The same codec the `_fuzz-encode-atom` and `_fuzz-decode-atom` operations expose to MeTTa, for a +// host that has to write an atom somewhere text-only and read it back. Both return an `Error` atom +// rather than throwing: an atom carrying a grounded value with no encoding has no representation, and +// a stored payload can be corrupted. +export { encodeReplayAtom as encodeAtomForStorage, decodeReplayAtom as decodeAtomFromStorage }; + +const KERNEL_OPERATIONS = [ + ["_fuzz-rng-init", rngInit], + ["_fuzz-draw-int", drawInt], + ["_fuzz-atom-key", atomKey], + ["_fuzz-deduplicate-exact", deduplicateExact], + ["_fuzz-deduplicate-replay", deduplicateReplay], + ["_fuzz-exact-member", exactMember], + ["_fuzz-replay-member", replayMember], + ["_fuzz-make-variable", makeVariable], + ["_fuzz-variable-marker", variableMarker], + ["_fuzz-contains-variable-marker", containsVariableMarker], + ["_fuzz-materialize-grammar-sample", materializeGrammarSample], + ["_fuzz-expression-append", appendExpressionItem], + ["_fuzz-expression-concat", concatenateExpressions], + ["_fuzz-grammar-summary-alternatives", grammarSummaryAlternatives], + ["_fuzz-grammar-summary-replace", grammarSummaryReplace], + ["_fuzz-grammar-alternatives-add", grammarAlternativesAdd], + ["_fuzz-grammar-template-requirements-op", grammarTemplateRequirements], + ["_fuzz-grammar-productivity-op", grammarProductivityOp], + ["_fuzz-grammar-targets-op", grammarTargetsOp], + ["_fuzz-grammar-validate-references-op", grammarValidateReferencesOp], + ["_fuzz-stack-to-expression", fuzzStackToExpression], + ["_fuzz-grammar-eligible-productions-op", grammarEligibleProductions], + ["_fuzz-grammar-machine-op", grammarMachineOp], + ["_fuzz-decision-leaves-op", decisionLeaves], + ["_fuzz-grammar-productions-for-target", grammarProductionsForTarget], + ["_fuzz-grammar-dependents-of", grammarDependentsOf], + ["_fuzz-index-stack", fuzzIndexStack], + ["_fuzz-grammar-template-plan", grammarTemplatePlan], + ["_fuzz-stack-take", fuzzStackTake], + ["_fuzz-stack-push-all", fuzzStackPushAll], + ["_fuzz-expression-view", expressionView], + ["_fuzz-grammar-field-expressions", grammarFieldExpressions], + ["_fuzz-grammar-replace-fields", replaceGrammarFields], + ["_fuzz-grammar-index-references", indexGrammarReferences], + ["_fuzz-grammar-template-profile", grammarTemplateProfile], + ["_fuzz-grammar-validation-plan", grammarValidationPlan], + ["_fuzz-grammar-template-reference-plan", grammarReferenceTargets], + ["_fuzz-atom-ground", atomGround], + ["_fuzz-custom-replay-tree", customReplayTree], + ["_fuzz-custom-replay-equal", customReplayEqual], + ["_fuzz-float64-bits", bitsOfFloat64], + ["_fuzz-float64-from-bits", float64OfBits], + ["_fuzz-float64-index", indexOfFloat64], + ["_fuzz-float64-from-index", float64OfIndex], + ["_fuzz-unicode-character", unicodeCharacterAt], + ["_fuzz-replay-equal", replayEqual], + ["_fuzz-encode-atom", encodeAtom], + ["_fuzz-decode-atom", decodeAtom], +] as const; + +let registered = false; + +/** Install the deterministic state-in/state-out primitives used by the MeTTa fuzz module. */ +export function registerFuzzKernel(): void { + if (registered) return; + for (const [name, operation] of KERNEL_OPERATIONS) { + registerBuiltinGroundedOperation(name, operation, "Pure"); + } + registered = true; +} diff --git a/packages/fuzz/src/machine.test.ts b/packages/fuzz/src/machine.test.ts new file mode 100644 index 0000000..9e4ec73 --- /dev/null +++ b/packages/fuzz/src/machine.test.ts @@ -0,0 +1,289 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +// A model/real counter pair. The real side is a state cell; the model is (Count n). The capped +// variant silently loses increments past two, which the postcondition must catch. +const COUNTER_RELATIONS = ` + (= (counter-initialize) (new-state 0)) + (: counter-command-generator (-> Atom %Undefined%)) + (= (counter-command-generator $model) (gen-element (increment reset))) + (= (counter-precondition $model $command) True) + (= (counter-execute $real increment) + (let $seen (get-state $real) + (let $changed (change-state! $real (+ $seen 1)) + (+ $seen 1)))) + (= (counter-execute $real reset) + (let $changed (change-state! $real 0) 0)) + (= (counter-next-model (Count $n) increment) (Count (+ $n 1))) + (= (counter-next-model (Count $n) reset) (Count 0)) + (= (counter-postcondition (Count $n) increment $result) (== $result (+ $n 1))) + (= (counter-postcondition (Count $n) reset $result) (== $result 0)) + (= (counter-invariant (Count $n)) (>= $n 0)) + (= (counter-cleanup $real) Done) +`; + +const COUNTER_MACHINE = ` + (FuzzMachine Counter + (InitialModel (Count 0)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) +`; + +describe("MeTTa model-based state machines", () => { + it("verifies a real system against its model across command sequences", () => { + const result = printed(` + ${COUNTER_RELATIONS} + ${COUNTER_MACHINE} + !(fuzz-check-machine Counter (fuzz-config (Runs 6) (MaxSize 4) (EdgeCases 2))) + `).at(-1)![0]!; + expect(result).toMatch(/^\(FuzzPassed \(Property Counter\) /); + }); + + it("catches a divergent real system and shrinks the command sequence", () => { + const result = printed(` + ${COUNTER_RELATIONS} + (= (capped-initialize) (new-state 0)) + (= (capped-execute $real increment) + (let $seen (get-state $real) + (if (< $seen 2) + (let $changed (change-state! $real (+ $seen 1)) (+ $seen 1)) + $seen))) + (= (capped-execute $real reset) + (let $changed (change-state! $real 0) 0)) + (FuzzMachine Capped + (InitialModel (Count 0)) + (InitializeReal capped-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute capped-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) + !(fuzz-check-machine Capped (fuzz-config (Seed 3) (Runs 20) (MaxSize 6) (EdgeCases 2))) + `).at(-1)![0]!; + expect(result).toMatch(/^\(FuzzFailed \(Property Capped\) /); + expect(result).toContain("(FailureTag MachinePostconditionFailed)"); + // Three increments are the smallest sequence that crosses the cap at two. + expect(result).toContain("(SmallestValue (FuzzMachineRun (quote Capped)"); + const smallest = + /\(SmallestValue \(FuzzMachineRun \(quote Capped\) \(MachineSpec[^]*?\(Cleanup [^)]*\)\) (\([^()]*\))\)\)/.exec( + result, + ); + expect(smallest?.[1]).toBe("(increment increment increment)"); + }); + + it("reports invariant violations with the step and model", () => { + const result = printed(` + ${COUNTER_RELATIONS} + (= (leaky-next-model (Count $n) increment) (Count (- 0 1))) + (= (leaky-next-model (Count $n) reset) (Count 0)) + (FuzzMachine Leaky + (InitialModel (Count 0)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel leaky-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) + !(fuzz-check-machine Leaky (fuzz-config (Seed 1) (Runs 10) (MaxSize 4) (EdgeCases 0))) + `).at(-1)![0]!; + expect(result).toMatch(/^\(FuzzFailed \(Property Leaky\) /); + expect(result).toMatch(/MachinePostconditionFailed|MachineInvariantViolated/); + }); + + it("honors preconditions during generation and records retry attempts", () => { + const out = printed(` + (= (stack-initialize) (new-state ())) + (: stack-command-generator (-> Atom %Undefined%)) + (= (stack-command-generator $model) (gen-element (push pop))) + (= (stack-precondition (Depth $n) push) True) + (= (stack-precondition (Depth $n) pop) (> $n 0)) + (= (stack-execute $real push) + (let $seen (get-state $real) + (let $next (cons-atom x $seen) + (let $changed (change-state! $real $next) + (size-atom $next))))) + (= (stack-execute $real pop) + (let $seen (get-state $real) + (let $ht (decons-atom $seen) + (unify $ht + ($head $tail) + (let $changed (change-state! $real $tail) + (size-atom $tail)) + (Error $seen empty-pop))))) + (= (stack-next-model (Depth $n) push) (Depth (+ $n 1))) + (= (stack-next-model (Depth $n) pop) (Depth (- $n 1))) + (= (stack-postcondition (Depth $n) push $result) (== $result (+ $n 1))) + (= (stack-postcondition (Depth $n) pop $result) (== $result (- $n 1))) + (= (stack-invariant (Depth $n)) (>= $n 0)) + (= (stack-cleanup $real) Done) + (FuzzMachine Stack + (InitialModel (Depth 0)) + (InitializeReal stack-initialize) + (CommandGenerator stack-command-generator) + (Precondition stack-precondition) + (Execute stack-execute) + (NextModel stack-next-model) + (Postcondition stack-postcondition) + (Invariant stack-invariant) + (Cleanup stack-cleanup)) + !(fuzz-check-machine Stack (fuzz-config (Seed 7) (Runs 12) (MaxSize 5) (EdgeCases 2))) + !(fuzz-generate-random (gen-machine Stack) 11 4) + `); + expect(out.at(-2)![0]).toMatch(/^\(FuzzPassed \(Property Stack\) /); + const sample = out.at(-1)![0]!; + expect(sample).toMatch(/^\(FuzzSample \(FuzzMachineRun \(quote Stack\) /); + expect(sample).toContain("(Decision MachineCommand (MaximumAttempts 16)"); + }); + + // World effects of a property run (a cleanup's change-state! included) roll back with the + // sandbox, so cleanup is observed through its verdict contract instead: a broken cleanup fails + // an otherwise passing check, and a real counterexample keeps its own failure tag even when the + // cleanup also errors on that run. + it("runs cleanup after passing sequences: a broken cleanup fails the check", () => { + const result = printed(` + ${COUNTER_RELATIONS} + (= (forked-cleanup $real) FirstResult) + (= (forked-cleanup $real) SecondResult) + (FuzzMachine Tidy + (InitialModel (Count 0)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup forked-cleanup)) + !(fuzz-check-machine Tidy (fuzz-config (Runs 3) (MaxSize 2) (EdgeCases 1))) + `).at(-1)![0]!; + expect(result).toMatch(/^\(FuzzFailed \(Property Tidy\) /); + expect(result).toContain("MachineCleanupFailed"); + }); + + it("a cleanup error never masks the run's own counterexample", () => { + const result = printed(` + ${COUNTER_RELATIONS} + (= (capped-initialize) (new-state 0)) + (= (capped-execute $real increment) + (let $seen (get-state $real) + (if (< $seen 2) + (let $changed (change-state! $real (+ $seen 1)) (+ $seen 1)) + $seen))) + (= (capped-execute $real reset) + (let $changed (change-state! $real 0) 0)) + (= (forked-cleanup $real) FirstResult) + (= (forked-cleanup $real) SecondResult) + !(fuzz-machine-run + (FuzzMachineRun (quote Sloppy) + (MachineSpec + (InitialModel (quote (Count 0))) + (InitializeReal capped-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute capped-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup forked-cleanup)) + (increment increment increment))) + `).at(-1)![0]!; + expect(result).toMatch(/^\(Fail MachinePostconditionFailed /); + expect(result).not.toContain("MachineCleanupFailed"); + }); + + it("generates and replays machine sequences deterministically", () => { + const out = printed(` + ${COUNTER_RELATIONS} + ${COUNTER_MACHINE} + !(fuzz-generate-random (gen-machine Counter) 42 4) + !(fuzz-generate-random (gen-machine Counter) 42 4) + !(let $generated (fuzz-generate-random (gen-machine Counter) 42 4) + (unify $generated + (FuzzSample $value $driver $tree) + (let $replayed (fuzz-replay (gen-machine Counter) $tree 4) + (unify $replayed + (FuzzSample $replay-value $replay-driver $replay-tree) + (ReplayAgreement (== (quote $value) (quote $replay-value))) + (NoReplay $replayed))) + (NoSample $generated))) + `); + expect(out.at(-2)![0]).toBe(out.at(-3)![0]); + expect(out.at(-1)![0]).toBe("(ReplayAgreement True)"); + }); + + it("verifies a small machine domain exhaustively", () => { + const result = printed(` + ${COUNTER_RELATIONS} + ${COUNTER_MACHINE} + !(fuzz-check-exhaustive Counter (gen-machine Counter) fuzz-machine-run + (fuzz-config (MaxSize 2) (MaxEnumerated 200))) + `).at(-1)![0]!; + expect(result).toMatch( + /^\(FuzzExhaustivelyVerified \(Property Counter\) \(DomainCount 7\) \(Enumerated 7\)/, + ); + }); + + it("rejects missing, ambiguous, non-ground, and nondeterministic machines", () => { + const out = printed(` + ${COUNTER_RELATIONS} + ${COUNTER_MACHINE} + (FuzzMachine Twice + (InitialModel (Count 0)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) + (FuzzMachine Twice + (InitialModel (Count 1)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) + (= (forked-next-model (Count $n) $command) (Count (+ $n 1))) + (= (forked-next-model (Count $n) increment) (Count 1)) + (FuzzMachine Forked + (InitialModel (Count 0)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel forked-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) + !(gen-machine Missing) + !(gen-machine Twice) + !(gen-machine $open) + !(fuzz-generate-random (gen-machine Forked) 5 3) + `); + expect(out.at(-4)![0]).toContain("MissingFuzzMachine"); + expect(out.at(-3)![0]).toContain("AmbiguousFuzzMachine"); + expect(out.at(-2)![0]).toContain("NonGroundMachineName"); + expect(out.at(-1)![0]).toMatch( + /FunctionReturnedMultipleResults|MachineNextModelFailed|GenerationError/, + ); + }); +}); diff --git a/packages/fuzz/src/metta/00-types.metta b/packages/fuzz/src/metta/00-types.metta new file mode 100644 index 0000000..4e43c81 --- /dev/null +++ b/packages/fuzz/src/metta/00-types.metta @@ -0,0 +1,499 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Private grounded kernel data. +(: FuzzRng Type) +(: FuzzDraw Type) +(: FuzzKernelError Type) + +(: _fuzz-rng-init (-> Number Atom)) +(: _fuzz-draw-int (-> Atom Number Number Atom)) +(: _fuzz-atom-key (-> Symbol Atom Atom)) +(: _fuzz-deduplicate-exact (-> Expression Atom)) +(: _fuzz-deduplicate-replay (-> Expression Atom)) +(: _fuzz-exact-member (-> Atom Expression Atom)) +(: _fuzz-replay-member (-> Atom Expression Atom)) +(: _fuzz-make-variable (-> Number Variable)) +(: _fuzz-variable-marker (-> Number Atom)) +(: _fuzz-contains-variable-marker (-> Atom Bool)) +(: _fuzz-materialize-grammar-sample (-> Atom Atom Atom %Undefined%)) +(: _fuzz-expression-append (-> Expression Atom Atom)) +(: _fuzz-expression-concat (-> Expression Expression Expression)) +(: _fuzz-grammar-summary-alternatives (-> Expression Atom Atom)) +(: _fuzz-grammar-summary-replace (-> Expression Atom Expression Atom)) +(: _fuzz-expression-view (-> Atom Atom)) +(: _fuzz-grammar-field-expressions (-> Atom Atom)) +(: _fuzz-grammar-replace-fields (-> Atom Expression Atom)) +(: _fuzz-grammar-index-references (-> Atom Atom)) +(: _fuzz-grammar-template-profile (-> Atom Atom)) +(: _fuzz-grammar-validation-plan (-> Atom Atom)) +(: _fuzz-grammar-template-reference-plan (-> Atom Atom)) +(: _fuzz-atom-ground (-> Atom Bool)) +(: _fuzz-custom-replay-tree (-> Atom Atom Atom)) +(: _fuzz-custom-replay-equal (-> Atom Atom Bool)) +(: _fuzz-float64-bits (-> Number Atom)) +(: _fuzz-float64-from-bits (-> Number Number Number)) +(: _fuzz-float64-index (-> Number Atom)) +(: _fuzz-float64-from-index (-> Number Number)) +(: _fuzz-unicode-character (-> Number Symbol)) +(: _fuzz-replay-equal (-> Atom Atom Bool)) +(: _fuzz-encode-atom (-> Atom Atom)) +(: _fuzz-decode-atom (-> Atom Atom)) + +; Public generator, driver, sample, and property data. +(: FuzzGenerator Type) +(: FuzzDriver Type) +(: FuzzDecision Type) +(: FuzzSample Type) +(: FuzzProperty Type) +(: FuzzRunResult Type) +(: FuzzSample (-> Atom Atom Atom FuzzSample)) +(: CustomReplayTree (-> Atom Atom)) +(: CustomReplayProtocolError (-> Atom Expression Atom)) + +; Reified generator constructors. +(: gen-const (-> Atom %Undefined%)) +(: gen-bool (-> %Undefined%)) +(: gen-int (-> Number Number %Undefined%)) +(: gen-int-origin (-> Number Number Number %Undefined%)) +(: gen-sized-int (-> %Undefined%)) +(: gen-float (-> %Undefined%)) +(: gen-float-range (-> Number Number %Undefined%)) +(: gen-float-bits (-> %Undefined%)) +(: gen-char (-> %Undefined%)) +(: gen-char-ascii (-> %Undefined%)) +(: gen-char-unicode (-> %Undefined%)) +(: gen-string (-> %Undefined% Number Number %Undefined%)) +(: gen-ascii-string (-> Number Number %Undefined%)) +(: gen-unicode-string (-> Number Number %Undefined%)) +(: gen-symbol (-> %Undefined%)) +(: gen-symbol-range (-> Number Number %Undefined%)) +(: gen-syntax-token (-> %Undefined%)) +(: gen-syntax-token-range (-> Number Number %Undefined%)) +(: gen-element (-> Expression %Undefined%)) +(: gen-frequency (-> Expression %Undefined%)) +(: gen-one-of (-> Expression %Undefined%)) +(: gen-tuple (-> Expression %Undefined%)) +(: gen-list (-> %Undefined% Number Number %Undefined%)) +(: gen-option (-> %Undefined% %Undefined%)) +(: gen-map (-> Atom %Undefined% %Undefined%)) +(: gen-bind (-> Atom %Undefined% %Undefined%)) +(: gen-filter (-> %Undefined% Atom Number %Undefined%)) +(: gen-sized (-> Atom %Undefined%)) +(: gen-resize (-> Number %Undefined% %Undefined%)) +(: gen-recursive (-> %Undefined% Atom %Undefined%)) +(: gen-custom (-> Atom Expression %Undefined%)) +(: gen-grammar (-> Atom %Undefined%)) +(: gen-grammar-root (-> Atom Atom %Undefined%)) +(: gen-well-typed (-> Atom Atom %Undefined%)) + +; Grammar schemas are syntax data. Quoted carriers and Atom or Expression parameters keep templates, +; nonterminals, and binding sorts unreduced while MeTTa relations validate and interpret their markers. +(: FuzzTypeConstructors (-> Expression Atom)) +(: GrammarProduction (-> Number Number Atom Atom Atom)) +(: GrammarValidationTask (-> Atom Expression Atom)) +(: GrammarFitTask (-> Atom Expression Number Atom)) +(: GrammarRequest (-> Atom Atom Expression Number Atom)) +(: StaticGrammar (-> Atom Expression Atom)) +(: StaticTypeGrammar (-> Atom Expression Atom)) +(: DynamicTypeGrammar (-> Atom Atom)) +(: GrammarResult (-> Atom Atom Number Atom Atom)) +(: GrammarChildrenResult (-> Expression Atom Number Expression Number Atom)) +(: GrammarFieldExpressions (-> Expression Atom)) +(: FuzzExpressionView (-> Atom Expression Expression Atom)) +(: FuzzAtomLeaf (-> Atom)) +(: GrammarGeneratorValidationTask (-> Atom Atom)) +(: ResolvedGrammarField (-> Atom Atom)) +(: ResolvedGrammarFields (-> Expression Atom)) +(: NormalizedGrammarTemplate (-> Atom Atom)) +(: PreparedGrammarTemplate (-> Atom Number Number Number Number Atom)) +(: ValidatedGrammarProductions (-> Expression Number Atom)) +(: ValidatedGrammar (-> Atom Atom Expression Number Atom)) +(: PreparedTypeConstructors (-> Expression Number Atom)) +(: ValidatedTypeGrammar (-> Atom Atom Expression Number Atom)) +(: GrammarRequirementAlternative (-> Expression Atom)) +(: GrammarRequirementAlternatives (-> Expression Atom)) +(: GrammarRequirementSummaryEntry (-> Atom Expression Atom)) +(: GrammarSummaryMergeState (-> Bool Expression Atom)) +(: GrammarProductivityPassState (-> Bool Expression Atom)) +(: GrammarProductivityPass (-> Bool Expression Atom)) +(: GrammarMissingTarget (-> Atom Atom)) +(: GrammarRequirementStack (-> Expression Atom)) +(: GrammarValidationPlan (-> Expression Atom)) +(: GrammarValidationState (-> Expression Expression Atom)) +(: GrammarReferenceTargets (-> Expression Atom)) +(: GrammarBindingValidationState + (-> Expression Expression Number Atom)) +(: _fuzz-grammar-generator-validation-tasks + (-> Expression %Undefined% %Undefined%)) +(: _fuzz-grammar-generator-child-task (-> Atom %Undefined% %Undefined%)) +(: _fuzz-grammar-frequency-validation + (-> Expression %Undefined% Number %Undefined%)) +(: _fuzz-validate-grammar-field-generator (-> Atom %Undefined%)) +(: _fuzz-grammar-field-from-results (-> Atom Expression %Undefined%)) +(: _fuzz-resolve-grammar-field (-> Atom %Undefined%)) +(: _fuzz-resolve-grammar-fields-loop + (-> Expression %Undefined% %Undefined%)) +(: _fuzz-normalize-grammar-template-fields (-> Atom %Undefined%)) +(: _fuzz-prepare-grammar-template (-> Atom Atom %Undefined%)) +(: _fuzz-grammar-template-switch (-> Atom Expression %Undefined%)) +(: _fuzz-normalize-grammar-productions (-> Atom Expression %Undefined%)) +(: _fuzz-build-grammar (-> Atom Atom Expression %Undefined%)) +(: _fuzz-grammar-target-member (-> Atom Expression %Undefined%)) +(: _fuzz-grammar-add-target (-> Atom Expression %Undefined%)) +(: _fuzz-grammar-reference-targets-loop + (-> Expression Expression %Undefined%)) +(: _fuzz-grammar-reference-targets (-> Expression %Undefined%)) +(: _fuzz-validate-normalized-grammar + (-> Atom Atom Expression Number %Undefined%)) +(: _fuzz-grammar-from-results + (-> Atom Atom Expression %Undefined%)) +(: _fuzz-gen-grammar-root-ground + (-> Atom Atom %Undefined%)) +(: _fuzz-normalize-type-constructors-loop + (-> Atom Atom Expression Number %Undefined% Number %Undefined%)) +(: _fuzz-normalize-type-constructors (-> Atom Atom Expression %Undefined%)) +(: _fuzz-static-productions-for-target-loop + (-> Expression Atom Expression %Undefined%)) +(: _fuzz-source-productions (-> Atom Atom %Undefined%)) +(: _fuzz-type-schema-from-results + (-> Atom Atom Expression %Undefined%)) +(: _fuzz-finalize-type-grammar + (-> Atom Atom Expression Number %Undefined%)) +(: _fuzz-build-type-grammar-prepared + (-> Atom Atom Atom Expression Expression Expression Number Number Expression Number %Undefined%)) +(: _fuzz-build-type-grammar-available + (-> Atom Atom Atom Expression Expression Expression Number Number Atom %Undefined%)) +(: _fuzz-build-type-grammar-type + (-> Atom Atom Atom Expression Expression Expression Number Number %Undefined%)) +(: _fuzz-build-type-grammar-loop + (-> Atom Atom Expression Expression Expression Number Number %Undefined%)) +(: _fuzz-build-type-grammar + (-> Atom Atom %Undefined%)) +(: _fuzz-gen-well-typed-ground + (-> Atom Atom %Undefined%)) +(: _fuzz-validate-grammar-template (-> Atom Atom %Undefined%)) +(: _fuzz-validate-grammar-binding-step + (-> Atom Atom %Undefined%)) +(: _fuzz-validate-grammar-bindings (-> Expression %Undefined%)) +(: _fuzz-grammar-validation-enter-scope + (-> Atom Expression Expression Expression %Undefined%)) +(: _fuzz-grammar-validation-exit-scope + (-> Expression Expression %Undefined%)) +(: _fuzz-grammar-validation-event + (-> Atom Atom Atom %Undefined%)) +(: _fuzz-grammar-validation-from-fold + (-> Atom Atom %Undefined%)) +(: _fuzz-template-reference-targets (-> Atom %Undefined% %Undefined%)) +(: _fuzz-template-reference-target-step + (-> Expression Atom %Undefined%)) +(: _fuzz-grammar-summary-merge-alternative + (-> Bool Atom Expression Atom %Undefined%)) +(: _fuzz-grammar-summary-merge-step + (-> Atom Atom Atom %Undefined%)) +(: _fuzz-grammar-summary-merge + (-> Atom Expression Expression %Undefined%)) +(: _fuzz-grammar-template-requirements + (-> Atom Expression %Undefined%)) +(: _fuzz-grammar-summary-has-target + (-> Atom Expression %Undefined%)) +(: _fuzz-grammar-summary-has-closed-target + (-> Atom Expression %Undefined%)) +(: _fuzz-first-unsummarized-target-step + (-> Atom Atom Expression %Undefined%)) +(: _fuzz-first-unsummarized-target + (-> Expression Expression %Undefined%)) +(: _fuzz-grammar-all-targets-summarized-step + (-> Atom Atom Expression %Undefined%)) +(: _fuzz-grammar-all-targets-summarized + (-> Expression Expression %Undefined%)) +(: _fuzz-grammar-productivity-result + (-> Atom Atom Expression Expression %Undefined%)) +(: _fuzz-grammar-productivity-fixedpoint + (-> Atom Atom Expression Expression Expression %Undefined%)) +(: _fuzz-validate-grammar-productivity + (-> Atom Atom Expression Expression %Undefined%)) +(: _fuzz-grammar-scope-has-id-step + (-> Bool Atom Number Bool)) +(: _fuzz-grammar-scope-has-id (-> Expression Number Bool)) +(: _fuzz-grammar-scopes-disjoint-step + (-> Bool Atom Expression Bool)) +(: _fuzz-grammar-scopes-disjoint (-> Expression Expression Bool)) +(: _fuzz-grammar-scope-values + (-> Expression Atom Expression %Undefined%)) +(: _fuzz-eligible-productions + (-> Atom Atom Expression Number %Undefined%)) +(: _fuzz-generate-grammar-nonterminal + (-> Atom Atom Expression Number Atom Number %Undefined%)) + +; Driver constructors and one-sample entry points. +(: fuzz-random-driver (-> Number %Undefined%)) +(: fuzz-edge-driver (-> Number %Undefined%)) +(: fuzz-replay-driver (-> Atom %Undefined%)) +(: fuzz-exhaustive-driver (-> %Undefined%)) +(: _fuzz-exhaustive-resume-driver (-> Atom %Undefined%)) +(: _fuzz-exhaustive-next-plan (-> Atom %Undefined%)) +(: _fuzz-exhaustive-plan-prefix (-> Atom Atom %Undefined%)) +(: ExhaustiveCursor (-> Atom Number Atom Atom)) +(: ExhaustiveFrame (-> Number Number Atom)) +(: ExhaustivePlan (-> Atom Atom)) +(: fuzz-enumerate (-> %Undefined% Number Number %Undefined%)) +(: FrequencyIndexChoice (-> Number Atom Atom Atom Atom)) +(: FuzzEnumerateRun (-> Atom Number Number Atom Number Number Number Atom Atom)) +(: FuzzEnumeration (-> Atom Atom Atom Atom Atom)) +(: FuzzEnumerationTruncated (-> Atom Atom Atom Atom Atom)) +(: fuzz-bytes-driver (-> Expression %Undefined%)) +(: fuzz-generate (-> %Undefined% %Undefined% Number %Undefined%)) +(: fuzz-generate-random (-> %Undefined% Number Number %Undefined%)) +(: fuzz-generate-edge (-> %Undefined% Number Number %Undefined%)) +(: fuzz-generate-bytes (-> %Undefined% Expression Number %Undefined%)) +(: fuzz-replay (-> %Undefined% Atom Number %Undefined%)) +(: _fuzz-shrink-replay (-> %Undefined% Atom Number %Undefined%)) + +; Property outcomes and case classification. +(: _fuzz-eval-case (-> Atom Number Number Atom Atom)) +(: fuzz-pass (-> FuzzProperty)) +(: fuzz-fail (-> Atom Atom FuzzProperty)) +(: fuzz-discard (-> Atom FuzzProperty)) +(: expect-true (-> Bool Atom FuzzProperty)) +(: expect-false (-> Bool Atom FuzzProperty)) +(: expect-atom-equal (-> %Undefined% %Undefined% FuzzProperty)) +(: expect-alpha-equal (-> %Undefined% %Undefined% FuzzProperty)) +(: expect-results-exact (-> %Undefined% %Undefined% FuzzProperty)) +(: expect-results-alpha (-> %Undefined% %Undefined% FuzzProperty)) +(: expect-results-multiset (-> %Undefined% %Undefined% FuzzProperty)) +(: expect-results-set (-> %Undefined% %Undefined% FuzzProperty)) +(: implies (-> Bool Atom FuzzProperty)) +(: classify (-> Bool %Undefined% Atom FuzzProperty)) +(: collect (-> %Undefined% Atom FuzzProperty)) +(: cover (-> Number Bool %Undefined% Atom FuzzProperty)) +(: counterexample (-> %Undefined% Atom FuzzProperty)) +(: all-results (-> Atom Atom)) +(: any-result (-> Atom Atom)) +(: fuzz-equal (-> %Undefined% %Undefined% FuzzProperty)) +(: fuzz-alpha-equal (-> %Undefined% %Undefined% FuzzProperty)) +(: fuzz-implies (-> Bool Atom FuzzProperty)) +(: fuzz-annotate (-> %Undefined% Atom FuzzProperty)) +(: fuzz-classify (-> Bool %Undefined% Atom FuzzProperty)) +(: fuzz-collect (-> %Undefined% Atom FuzzProperty)) +(: fuzz-cover (-> Number %Undefined% Bool Atom FuzzProperty)) +(: _fuzz-normalize-property-result (-> Atom %Undefined%)) +(: _fuzz-evaluate-property (-> Atom Atom Atom Number Number Atom %Undefined%)) +(: fuzz-default-config (-> %Undefined%)) +(: fuzz-check (-> Atom %Undefined% Atom %Undefined% %Undefined%)) +(: fuzz-check-exhaustive (-> Atom %Undefined% Atom %Undefined% %Undefined%)) +(: _fuzz-check-with (-> Atom %Undefined% Atom %Undefined% Atom %Undefined%)) + +; Model-based state machines. +(: FuzzMachine Type) +(: gen-machine (-> Atom %Undefined%)) +(: fuzz-check-machine (-> Atom %Undefined% %Undefined%)) +(: _fuzz-machine-spec (-> Atom %Undefined%)) +(: _fuzz-machine-spec-results (-> Atom Expression %Undefined%)) +(: _fuzz-machine-call-zero (-> Atom Atom %Undefined%)) +(: _fuzz-machine-call-two (-> Atom Atom Atom Atom %Undefined%)) +(: _fuzz-machine-call-three (-> Atom Atom Atom Atom Atom %Undefined%)) +(: _fuzz-machine-bool-two (-> Atom Atom Atom Atom %Undefined%)) +(: _fuzz-machine-command-descriptor (-> Atom Atom %Undefined%)) +(: MachineDraw (-> Atom Atom Atom Atom Number Number Atom Atom)) +(: MachineCommandDrawn (-> Atom Atom Atom Atom)) +(: MachineSpec (-> Atom Atom Atom Atom Atom Atom Atom Atom Atom Atom)) +(: MachineSequence (-> Atom Atom Atom)) +(: ValidMachineSpec (-> Atom Atom)) +(: FuzzMachineRun (-> Atom Atom Atom Atom)) +(: MachineGenRun (-> Atom Atom Atom Number Atom Number Atom Atom Atom)) +(: MachineExecRun (-> Atom Atom Atom Atom Number Atom)) +(: MachineVerdict (-> Atom Atom)) +; Bounded state reachability. The search-state constructors take their payload as Atom so a state +; or command carried across a loop iteration is never re-evaluated. +(: fuzz-reachable (-> Atom %Undefined% Atom Atom Atom %Undefined% %Undefined%)) +(: reach-config-defaults (-> %Undefined%)) +(: FuzzReachEquivariant (-> Atom Atom)) +(: ReachSpec (-> Atom Atom Atom Atom Atom Atom Atom)) +(: ReachRun (-> Atom Atom Atom Atom Atom Number Atom Atom Atom)) +(: ReachNode (-> Atom Atom Atom)) +(: ReachCounts (-> Number Number Atom)) +(: ReachCommands (-> Atom Atom Atom Number Atom)) +(: ReachBranches (-> Atom Atom Atom Number Atom Number Atom)) +(: ReachReplay (-> Atom Atom Atom Number Atom)) +(: ReachConfigValues (-> Atom Atom Atom Atom Atom)) +(: ReachConfigFold (-> Atom Expression Atom)) +(: ReachKey (-> Atom Atom)) +(: ReachUnkeyable (-> Atom Atom Atom)) +(: ReachItem (-> Atom Atom)) +(: ReachFinite (-> Expression Atom)) +(: ReachIncomplete (-> Atom Atom)) +(: ReachMalformed (-> Atom Atom)) +(: ReachFound (-> Atom Atom Atom)) +(: ReachExhausted (-> Number Atom)) +(: ReachUnreachableWithinDepth (-> Number Atom)) +(: ReachCutoff (-> Atom Atom)) +(: ReachReplayState (-> Atom Atom)) +(: ReachReplayed (-> Atom Atom)) +(: ReachReplayFailed (-> Atom Atom)) +(: Step (-> Number Atom Number Atom)) +(: CallAll (-> Atom Atom)) +(: _fuzz-call-all-two (-> Atom Atom Atom Atom %Undefined%)) +(: _fuzz-call-all-results (-> %Undefined% Atom %Undefined%)) +(: _fuzz-pair-values (-> %Undefined% %Undefined%)) +(: _fuzz-expression-head (-> Atom %Undefined%)) +(: _fuzz-reach-bound-value (-> Atom Bool)) +(: _fuzz-reach-config-set (-> Atom Atom %Undefined%)) +(: _fuzz-reach-config-values (-> Atom %Undefined%)) +(: _fuzz-reach-config-get (-> Atom Atom %Undefined%)) +(: _fuzz-reach-state-key (-> Atom Atom %Undefined%)) +(: _fuzz-reach-command-items (-> Atom %Undefined%)) +(: _fuzz-reach-nth (-> Atom Number %Undefined%)) +(: _fuzz-reach-cutoff (-> Atom Atom %Undefined%)) +(: _fuzz-reach-searching (-> Atom Bool)) +(: _fuzz-reach-at-depth-limit (-> Number Atom Bool)) +(: _fuzz-reach-note-beyond-depth (-> Atom Atom %Undefined%)) +(: _fuzz-reach-expand (-> Atom Atom %Undefined%)) +(: _fuzz-reach-apply (-> Atom Atom Atom Number %Undefined%)) +(: _fuzz-reach-visit (-> Atom Atom Atom Number Number Atom %Undefined%)) +(: _fuzz-reach-judge (-> Atom Atom Atom Atom %Undefined%)) +(: _fuzz-reach-target (-> Atom Atom Atom Atom Atom %Undefined%)) +(: _fuzz-reach-enqueue (-> Atom Atom Atom Atom Atom %Undefined%)) +(: _fuzz-reach-confirm (-> Atom Atom Atom %Undefined%)) +(: _fuzz-reach-same-state (-> Atom Atom Atom Bool)) +(: _fuzz-reach-replay (-> Atom Atom %Undefined%)) +(: _fuzz-reach-replay-apply (-> Atom Atom Atom Number %Undefined%)) +(: _fuzz-reach-replay-transition (-> Atom Atom Atom Number Number %Undefined%)) +(: _fuzz-reach-identity-permitted (-> Atom Atom Bool)) +(: _fuzz-reach-start (-> Atom Atom Atom Atom Atom Atom %Undefined%)) +(: _fuzz-reach-run (-> Atom Atom Atom %Undefined%)) +(: _fuzz-reach-report (-> Atom %Undefined%)) +(: _fuzz-reach-witness-commands (-> Atom %Undefined%)) +(: ReachWitnessFold (-> Atom Atom Atom)) +(: FuzzPairValuesFold (-> Atom Atom Atom)) +(: FuzzLeafDistanceFold (-> Atom Atom Atom)) +(: FuzzRepeatFold (-> Atom Number Atom Atom)) + +(: FuzzExhaustiveRun (-> Atom Atom Atom Atom Atom Atom Number Number Atom Atom)) +(: FuzzExhaustivelyVerified (-> Atom Atom Atom Atom Atom)) +(: ExhaustiveStatistics (-> Atom Atom Atom Atom)) + +; Helpers that intentionally receive generated expressions as data. +(: _fuzz-if-generation-error (-> %Undefined% Atom %Undefined%)) +(: _fuzz-is-integer (-> Number Bool)) +(: _fuzz-expected-integer (-> Atom Number %Undefined%)) +(: _fuzz-call-results-bind (-> %Undefined% Atom %Undefined%)) +(: _fuzz-bool-result (-> Atom Atom %Undefined%)) +(: CallOne (-> Atom Atom)) +(: _fuzz-call-one (-> Atom Atom Atom %Undefined%)) +(: _fuzz-call-bool (-> Atom Atom Atom %Undefined%)) +(: _fuzz-driver-int (-> %Undefined% Number Number Number %Undefined%)) +(: _fuzz-byte-width (-> Number Number Number Number)) +(: _fuzz-read-bytes (-> Expression Number Number Number %Undefined%)) +(: _fuzz-generate-many (-> Expression %Undefined% Number Expression Expression %Undefined%)) +(: _fuzz-generate-filter (-> %Undefined% Atom Number Number %Undefined% Number Expression %Undefined%)) +(: _fuzz-wrap-sample (-> Atom Atom Atom %Undefined% %Undefined%)) +(: _fuzz-two-children (-> Atom Atom Expression)) +(: _fuzz-repeat-generator (-> Atom Number Expression)) +(: CustomCapabilities (-> Atom Expression %Undefined%)) +(: DriveCustom (-> Atom Expression Atom Number %Undefined%)) +(: EdgeChoices (-> Atom Expression Number %Undefined%)) +(: ShrinkChoices (-> Atom Expression Atom %Undefined%)) +(: FuzzTypeSchema (-> Atom Atom %Undefined%)) + +; ---- grammar machine ---- +; Constructors and relations of the generation machine and the productivity worklist. Every +; slot that carries raw template syntax or generated values is Atom-typed: an Atom parameter +; is not reduced at a call or construction, which is what keeps held user syntax unevaluated +; through the machine. +(: FuzzStack (-> Atom Atom Atom)) +(: FuzzStackTake (-> Expression Atom Atom)) +(: GF (-> Atom Atom Atom)) +(: FPlan (-> Expression Number Number Number Atom)) +(: FExpr (-> Number Number Number Atom)) +(: FRef (-> Atom Atom)) +(: FProd (-> Atom Number Number Atom Atom)) +(: FBind (-> Atom Number Atom Atom)) +(: FScoped (-> Expression Atom)) +(: FScope (-> Atom Atom)) +(: FuzzGenRun (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom)) +(: FuzzGenCut (-> Atom Atom Atom Number Atom Number Atom Atom Atom Atom)) +(: FuzzGenDone (-> Atom Atom)) +(: GILit (-> Atom Atom)) +(: GIField (-> Atom Atom)) +(: GIRef (-> Atom Number Number Atom)) +(: GIFresh (-> Atom Atom)) +(: GIUse (-> Atom Atom)) +(: GIBind (-> Atom Expression Atom)) +(: GIScoped (-> Expression Number Atom Expression Atom)) +(: GIExprEnter (-> Number Atom)) +(: GIExprBuild (-> Atom)) +(: GrammarTemplatePlan (-> Expression Atom)) +(: GrammarAlternativesAdd (-> Bool Expression Atom)) +(: GrammarProductions (-> Expression Atom)) +(: GrammarDependents (-> Expression Atom)) +(: EligibleGrammarProductions (-> Expression Atom)) +(: FitDuplicateGrammarBindingId (-> Atom Atom)) +(: FuzzProductivityQueue (-> Expression Atom Expression Atom)) +(: _fuzz-gen-loop (-> %Undefined% %Undefined%)) +(: _fuzz-gen-finished (-> %Undefined% Bool)) +(: _fuzz-gen-step (-> %Undefined% %Undefined%)) +(: _fuzz-gen-push + (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Atom %Undefined%)) +(: _fuzz-gen-run-step + (-> Atom Atom Atom Number Atom Number Atom Number Atom %Undefined%)) +(: _fuzz-gen-cut-step + (-> Atom Atom Atom Number Atom Number Atom Atom Atom %Undefined%)) +(: _fuzz-gen-instr + (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Number %Undefined%)) +(: _fuzz-gen-insert-expr (-> Atom Number Number Number Atom)) +(: _fuzz-gen-field + (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Atom %Undefined%)) +(: _fuzz-gen-use + (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom %Undefined%)) +(: _fuzz-gen-nonterminal + (-> Atom Atom Atom Number Atom Number Atom Number Atom Atom Number %Undefined%)) +(: _fuzz-gen-choose + (-> Atom Atom Atom Number Atom Number Atom Number Atom Number Expression Atom %Undefined%)) +(: _fuzz-eligible-productions (-> Atom Atom Expression Number %Undefined%)) +(: _fuzz-eligible-productions-checked (-> Expression Atom Expression Number %Undefined%)) +(: _fuzz-grammar-summary-merge-candidate + (-> Bool Expression Expression Expression Atom %Undefined%)) +(: _fuzz-productivity-done (-> %Undefined% Bool)) +(: _fuzz-productivity-changed (-> Expression Atom Atom Expression %Undefined%)) +(: _fuzz-productivity-analyze (-> Expression Atom Expression Atom Atom %Undefined%)) +(: _fuzz-productivity-step (-> %Undefined% %Undefined%)) +(: _fuzz-productivity-loop (-> %Undefined% %Undefined%)) +(: _fuzz-grammar-template-requirements-op (-> Atom Expression Atom)) +(: _fuzz-grammar-eligible-productions-op (-> Expression Atom Expression Number Atom)) +(: _fuzz-grammar-dependents-of (-> Expression Atom Atom)) +(: _fuzz-index-stack (-> Number Atom)) +(: _fuzz-stack-take (-> Atom Number Atom)) +(: _fuzz-stack-push-all (-> Atom Expression Atom)) +(: _fuzz-grammar-template-plan (-> Atom Atom)) +(: _fuzz-grammar-alternatives-add (-> Expression Expression Atom)) +(: GrammarMachineStart (-> Atom Atom Expression Number Atom Atom)) +(: GrammarMachineResume (-> Atom Atom Atom)) +(: GrammarMachineDone (-> Atom Atom)) +(: GrammarMachineNeed (-> Atom Atom Atom)) +(: EvaluateGenerator (-> Atom Atom Number Atom)) +(: WithDriver (-> Atom Number Atom)) +(: _fuzz-grammar-machine-op (-> Atom Atom)) +(: _fuzz-gen-trampoline (-> %Undefined% %Undefined%)) +(: _fuzz-generate-grammar-nonterminal-reference + (-> Atom Atom Expression Number Atom Number %Undefined%)) +(: FuzzDecisionLeaves (-> Expression Atom)) +(: _fuzz-decision-leaves-op (-> Atom Atom)) +(: GrammarUnproductive (-> Atom Atom)) +(: _fuzz-grammar-productivity-op (-> Expression Atom Expression Atom)) +(: _fuzz-validate-grammar-productivity-reference + (-> Atom Atom Expression Expression %Undefined%)) +(: GrammarTargets (-> Expression Atom)) +(: GrammarMissingReference (-> Atom Atom)) +(: FuzzNormalizeWalk (-> Atom Atom Number Atom Number Atom)) +(: _fuzz-grammar-targets-op (-> Expression Atom)) +(: _fuzz-grammar-validate-references-op (-> Expression Expression Atom)) +(: _fuzz-stack-to-expression (-> Atom Atom)) +(: _fuzz-normalize-walk-done (-> %Undefined% Bool)) +(: _fuzz-normalize-walk-step (-> %Undefined% %Undefined%)) +(: _fuzz-normalize-walk-loop (-> %Undefined% %Undefined%)) +(: _fuzz-normalize-walk-prepared + (-> Atom Atom Number Atom Number Number Atom Atom %Undefined%)) +(: _fuzz-validated-references + (-> Atom Atom Expression Number Expression %Undefined%)) diff --git a/packages/fuzz/src/metta/10-generators.metta b/packages/fuzz/src/metta/10-generators.metta new file mode 100644 index 0000000..dbda25f --- /dev/null +++ b/packages/fuzz/src/metta/10-generators.metta @@ -0,0 +1,387 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Constructor errors remain normal MeTTa data so callers can report them without a host exception. +(= (_fuzz-generation-error $code $details) + (FuzzGenerationError $code (Details $details))) + +(= (_fuzz-generation-error $code $first $second) + (FuzzGenerationError $code (Details $first $second))) + +(= (_fuzz-generation-error $code $first $second $third) + (FuzzGenerationError $code (Details $first $second $third))) + +(= (_fuzz-generation-error $code $first $second $third $fourth) + (FuzzGenerationError + $code + (Details $first $second $third $fourth))) + +(= (_fuzz-if-generation-error $candidate $otherwise) + (switch $candidate + (((FuzzGenerationError $code $details) $candidate) + ($valid $otherwise)))) + +(= (_fuzz-is-integer $value) + (and + (== (isnan-math $value) False) + (and + (== (isinf-math $value) False) + (== $value (trunc-math $value))))) + +(= (_fuzz-expected-integer $parameter $value) + (_fuzz-generation-error ExpectedInteger + (Parameter $parameter) + (Value $value))) + +(= (_fuzz-default-int-origin $lower $upper) + (if (and (<= $lower 0) (>= $upper 0)) + 0 + (if (> $lower 0) $lower $upper))) + +(= (_fuzz-default-float-origin $lower-index $upper-index) + (_fuzz-default-int-origin $lower-index $upper-index)) + +(= (_fuzz-validated-float-index $parameter $value) + (let $indexed (_fuzz-float64-index $value) + (switch $indexed + (((Float64Index $index) + (if (and + (<= -9218868437227405312 $index) + (<= $index 9218868437227405311)) + (ValidatedFloatIndex $index) + (_fuzz-generation-error + NonFiniteFloatBound + (Parameter $parameter) + (Value $value)))) + ((FuzzKernelError InvalidFloat $operation ExpectedFloat) + (_fuzz-generation-error + ExpectedFloat + (Parameter $parameter) + (Value $value))) + ((FuzzKernelError InvalidFloat $operation NaNHasNoOrderedIndex) + (_fuzz-generation-error + NaNFloatBound + (Parameter $parameter) + (Value $value))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $indexed))) + ($bad + (_fuzz-generation-error + MalformedFloatIndex + (OperationResult $bad))))))) + +(= (gen-const $value) + (GenConst $value)) + +(= (gen-bool) + (GenBool)) + +(= (gen-int $lower $upper) + (if (_fuzz-is-integer $lower) + (if (_fuzz-is-integer $upper) + (if (<= $lower $upper) + (GenInt $lower $upper (_fuzz-default-int-origin $lower $upper)) + (_fuzz-generation-error InvalidIntegerBounds (Bounds $lower $upper))) + (_fuzz-expected-integer UpperBound $upper)) + (_fuzz-expected-integer LowerBound $lower))) + +(= (gen-int-origin $lower $upper $origin) + (if (_fuzz-is-integer $lower) + (if (_fuzz-is-integer $upper) + (if (<= $lower $upper) + (if (_fuzz-is-integer $origin) + (if (and (<= $lower $origin) (<= $origin $upper)) + (GenInt $lower $upper $origin) + (_fuzz-generation-error InvalidIntegerOrigin + (Bounds $lower $upper) + (Origin $origin))) + (_fuzz-expected-integer Origin $origin)) + (_fuzz-generation-error InvalidIntegerBounds (Bounds $lower $upper))) + (_fuzz-expected-integer UpperBound $upper)) + (_fuzz-expected-integer LowerBound $lower))) + +(= (gen-sized-int) + (GenSized _fuzz-sized-int-generator)) + +(: _fuzz-sized-int-generator (-> Number %Undefined%)) +(= (_fuzz-sized-int-generator $size) + (gen-int (- 0 $size) $size)) + +(= (gen-float) + (GenFloatRange + -9218868437227405312 + 9218868437227405311 + 0)) + +(= (_fuzz-float-range-from-upper + $lower + $upper + $lower-index + $upper-result) + (switch $upper-result + (((FuzzGenerationError $code $details) $upper-result) + ((ValidatedFloatIndex $upper-index) + (if (<= $lower-index $upper-index) + (GenFloatRange + $lower-index + $upper-index + (_fuzz-default-float-origin + $lower-index + $upper-index)) + (_fuzz-generation-error + InvalidFloatBounds + (Bounds $lower $upper)))) + ($bad + (_fuzz-generation-error + MalformedFloatIndex + (OperationResult $bad)))))) + +(= (_fuzz-float-range-from-lower + $lower + $upper + $lower-result) + (switch $lower-result + (((FuzzGenerationError $code $details) $lower-result) + ((ValidatedFloatIndex $lower-index) + (_fuzz-float-range-from-upper + $lower + $upper + $lower-index + (_fuzz-validated-float-index UpperBound $upper))) + ($bad + (_fuzz-generation-error + MalformedFloatIndex + (OperationResult $bad)))))) + +(= (gen-float-range $lower $upper) + (_fuzz-float-range-from-lower + $lower + $upper + (_fuzz-validated-float-index LowerBound $lower))) + +(= (gen-float-bits) + (GenFloatBits)) + +(= (_fuzz-character-from-index $index) + (_fuzz-unicode-character $index)) + +(= (_fuzz-characters $characters) + (stringToChars $characters)) + +(= (gen-char) + (gen-map + _fuzz-character-from-index + (gen-int 32 126))) + +(= (gen-char-ascii) + (gen-map + _fuzz-character-from-index + (gen-int 0 127))) + +(= (gen-char-unicode) + (gen-map + _fuzz-character-from-index + (gen-int 0 1112061))) + +(= (_fuzz-characters-to-string $characters) + (charsToString $characters)) + +(= (gen-string $character-generator $minimum $maximum) + (gen-map + _fuzz-characters-to-string + (gen-list + $character-generator + $minimum + $maximum))) + +(= (gen-ascii-string $minimum $maximum) + (gen-string + (gen-char-ascii) + $minimum + $maximum)) + +(= (gen-unicode-string $minimum $maximum) + (gen-string + (gen-char-unicode) + $minimum + $maximum)) + +(= (_fuzz-parser-safe-first-characters) + (_fuzz-characters + "abcdefghijklmnopqrstuvwxyz_")) + +(= (_fuzz-parser-safe-rest-characters) + (_fuzz-characters + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_+-*/<>=!?")) + +(= (_fuzz-symbol-from-parts $parts) + (switch $parts + ((($first $rest) + (let $characters (cons-atom $first $rest) + (let $name (charsToString $characters) + (atom_concat $name)))) + ($bad + (_fuzz-generation-error + MalformedSymbolParts + (Value $bad)))))) + +(= (gen-symbol-range $minimum $maximum) + (if (_fuzz-is-integer $minimum) + (if (_fuzz-is-integer $maximum) + (if (and + (<= 1 $minimum) + (<= $minimum $maximum)) + (gen-map + _fuzz-symbol-from-parts + (gen-tuple + ((gen-element + (_fuzz-parser-safe-first-characters)) + (gen-list + (gen-element + (_fuzz-parser-safe-rest-characters)) + (- $minimum 1) + (- $maximum 1))))) + (_fuzz-generation-error + InvalidSymbolLengthBounds + (Minimum $minimum) + (Maximum $maximum))) + (_fuzz-expected-integer + MaximumLength + $maximum)) + (_fuzz-expected-integer + MinimumLength + $minimum))) + +(= (_fuzz-symbol-at-size $size) + (gen-symbol-range 1 (max 1 $size))) + +(= (gen-symbol) + (gen-sized _fuzz-symbol-at-size)) + +(= (_fuzz-syntax-token-characters) + (_fuzz-characters + "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_$!+-*/<>=?.,:@#%^&|~`'[]{}\\")) + +(= (gen-syntax-token-range $minimum $maximum) + (if (_fuzz-is-integer $minimum) + (if (_fuzz-is-integer $maximum) + (if (and + (<= 1 $minimum) + (<= $minimum $maximum)) + (gen-string + (gen-element + (_fuzz-syntax-token-characters)) + $minimum + $maximum) + (_fuzz-generation-error + InvalidTokenLengthBounds + (Minimum $minimum) + (Maximum $maximum))) + (_fuzz-expected-integer + MaximumLength + $maximum)) + (_fuzz-expected-integer + MinimumLength + $minimum))) + +(= (_fuzz-syntax-token-at-size $size) + (gen-syntax-token-range 1 (max 1 $size))) + +(= (gen-syntax-token) + (gen-sized _fuzz-syntax-token-at-size)) + +(= (gen-element $values) + (if (> (length $values) 0) + (GenElement $values) + (_fuzz-generation-error EmptyElementSet (Values $values)))) + +(= (_fuzz-frequency-total $entries $total) + (if (== $entries ()) + (if (> $total 0) + (FrequencyTotal $total) + (_fuzz-generation-error EmptyFrequency (Entries $entries))) + (let* ((($entry $tail) (decons-atom $entries))) + (switch $entry + ((($weight $generator) + (if (_fuzz-is-integer $weight) + (if (> $weight 0) + (_fuzz-frequency-total $tail (+ $total $weight)) + (_fuzz-generation-error InvalidFrequencyWeight + (Weight $weight) + (Generator $generator))) + (_fuzz-expected-integer FrequencyWeight $weight))) + ($bad + (_fuzz-generation-error MalformedFrequencyEntry (Entry $bad)))))))) + +(= (gen-frequency $entries) + (let $total (_fuzz-frequency-total $entries 0) + (switch $total + (((FuzzGenerationError $code $details) $total) + ((FrequencyTotal $weight) (GenFrequency $entries $weight)) + ($bad (_fuzz-generation-error MalformedFrequency (Value $bad))))))) + +(= (_fuzz-weight-one $generators) + (if (== $generators ()) + () + (let* ((($generator $tail) (decons-atom $generators)) + ($rest (_fuzz-weight-one $tail))) + (cons-atom (1 $generator) $rest)))) + +(= (gen-one-of $generators) + (gen-frequency (_fuzz-weight-one $generators))) + +(= (gen-tuple $generators) + (GenTuple $generators)) + +(= (gen-list $generator $minimum $maximum) + (_fuzz-if-generation-error + $generator + (if (_fuzz-is-integer $minimum) + (if (_fuzz-is-integer $maximum) + (if (and (<= 0 $minimum) (<= $minimum $maximum)) + (GenList $generator $minimum $maximum) + (_fuzz-generation-error InvalidListBounds + (Minimum $minimum) + (Maximum $maximum))) + (_fuzz-expected-integer MaximumLength $maximum)) + (_fuzz-expected-integer MinimumLength $minimum)))) + +(= (gen-option $generator) + (_fuzz-if-generation-error $generator (GenOption $generator))) + +(= (gen-map $function $generator) + (_fuzz-if-generation-error $generator (GenMap $function $generator))) + +(= (gen-bind $generator $function) + (_fuzz-if-generation-error $generator (GenBind $generator $function))) + +(= (gen-filter $generator $predicate $maximum-attempts) + (_fuzz-if-generation-error + $generator + (if (_fuzz-is-integer $maximum-attempts) + (if (> $maximum-attempts 0) + (GenFilter $generator $predicate $maximum-attempts) + (_fuzz-generation-error InvalidFilterAttempts + (MaximumAttempts $maximum-attempts))) + (_fuzz-expected-integer MaximumAttempts $maximum-attempts)))) + +(= (gen-sized $function) + (GenSized $function)) + +(= (gen-resize $size $generator) + (_fuzz-if-generation-error + $generator + (if (_fuzz-is-integer $size) + (if (>= $size 0) + (GenResize $size $generator) + (_fuzz-generation-error InvalidSize (Size $size))) + (_fuzz-expected-integer Size $size)))) + +(= (gen-recursive $base $step) + (_fuzz-if-generation-error $base (GenRecursive $base $step))) + +(= (gen-custom $name $arguments) + (GenCustom $name $arguments)) diff --git a/packages/fuzz/src/metta/11-custom-protocol.metta b/packages/fuzz/src/metta/11-custom-protocol.metta new file mode 100644 index 0000000..717d2bd --- /dev/null +++ b/packages/fuzz/src/metta/11-custom-protocol.metta @@ -0,0 +1,445 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Custom generators declare their supported drivers as normal MeTTa data. Replay and shrink replay are +; mandatory because the runner records and reduces derivation trees rather than opaque output values. +(= (_fuzz-custom-driver-mode $driver) + (switch $driver + (((FuzzDriver Random $state) Random) + ((FuzzDriver Edge $state) Edge) + ((FuzzDriver Replay $state) Replay) + ((FuzzDriver ShrinkReplay $state) ShrinkReplay) + ((FuzzDriver Exhaustive $state) Exhaustive) + ((FuzzDriver Bytes $state) Bytes) + ($bad + (_fuzz-generation-error + MalformedDriver + (Driver $bad)))))) + +(= (_fuzz-known-custom-mode $mode) + (switch $mode + ((Random True) + (Edge True) + (Replay True) + (ShrinkReplay True) + (Exhaustive True) + (Bytes True) + ($bad False)))) + +(= (_fuzz-valid-custom-modes-loop + $remaining + $seen) + (if (== $remaining ()) + True + (let* ((($mode $tail) + (decons-atom $remaining))) + (if (_fuzz-known-custom-mode $mode) + (if (is-member $mode $seen) + False + (_fuzz-valid-custom-modes-loop + $tail + (append $seen ($mode)))) + False)))) + +(= (_fuzz-valid-custom-modes $modes) + (if (== (get-metatype $modes) Expression) + (and + (_fuzz-valid-custom-modes-loop $modes ()) + (and + (is-member Replay $modes) + (is-member ShrinkReplay $modes))) + False)) + +(= (_fuzz-custom-capabilities-from-results + $name + $arguments + $results) + (switch $results + ((() + (_fuzz-generation-error + MissingCustomCapabilities + (Name $name) + (Arguments $arguments))) + (($single) + (switch $single + (((CustomCapabilities $seen-name $seen-arguments) + (_fuzz-generation-error + MissingCustomCapabilities + (Name $name) + (Arguments $arguments))) + ((FuzzCustomCapabilities (Modes $modes)) + (if (_fuzz-valid-custom-modes $modes) + (ValidCustomCapabilities $modes) + (_fuzz-generation-error + InvalidCustomCapabilities + (Name $name) + (Modes $modes)))) + ($bad + (_fuzz-generation-error + MalformedCustomCapabilities + (Name $name) + (Value $bad)))))) + ($many + (_fuzz-generation-error + AmbiguousCustomCapabilities + (Name $name) + (Results $many)))))) + +(= (_fuzz-custom-capabilities $name $arguments) + (let $results + (collapse + (CustomCapabilities + $name + $arguments)) + (_fuzz-custom-capabilities-from-results + $name + $arguments + $results))) + +(= (_fuzz-custom-wrap + $name + $arguments + $sample) + (switch $sample + (((FuzzSample $value $next-driver $tree) + (let $wrapped-tree + (Decision + Custom + (CustomGenerator + (Name $name) + (Arguments $arguments)) + () + ($tree)) + (if (== $name _fuzz-grammar) + (_fuzz-materialize-grammar-sample + $value + $next-driver + $wrapped-tree) + (FuzzSample + $value + $next-driver + $wrapped-tree)))) + ((FuzzGenerationDiscard + $reason + $next-driver + $tree) + (FuzzGenerationDiscard + $reason + $next-driver + (Decision + Custom + (CustomGenerator + (Name $name) + (Arguments $arguments)) + () + ($tree)))) + ((FuzzGenerationError $code $details) + $sample) + ($bad + (_fuzz-generation-error + MalformedGenerationResult + (Value $bad)))))) + +; Every driver mode is deterministic (the exhaustive cursor included), so DriveCustom must +; produce exactly one result in every mode. +(= (_fuzz-drive-custom-results + $name + $arguments + $mode + $results) + (switch $results + ((() + (_fuzz-generation-error + MissingCustomGenerator + (Name $name))) + (($sample) + (switch $sample + (((DriveCustom + $seen-name + $seen-arguments + $seen-driver + $seen-size) + (_fuzz-generation-error + MissingCustomGenerator + (Name $name))) + ($value + (_fuzz-custom-wrap + $name + $arguments + $value))))) + ($many + (_fuzz-generation-error + AmbiguousCustomGenerator + (Name $name) + (Mode $mode) + (Results $many)))))) + +(= (_fuzz-drive-custom + $name + $arguments + $driver + $size + $mode) + (let $results + (collapse + (DriveCustom + $name + $arguments + $driver + $size)) + (_fuzz-drive-custom-results + $name + $arguments + $mode + $results))) + +(= (_fuzz-drive-custom-validated + $name + $arguments + $driver + $size + $mode) + (let $original + (_fuzz-drive-custom + $name + $arguments + $driver + $size + $mode) + (if (== $mode Replay) + $original + (let $request + (_fuzz-custom-replay-tree + $original + $mode) + (switch $request + (((CustomReplayTree $tree) + (let $replayed + (fuzz-replay + (GenCustom $name $arguments) + $tree + $size) + (if (_fuzz-custom-replay-equal + $original + $replayed) + $original + (_fuzz-generation-error + CustomReplayMismatch + (Name $name) + (Mode $mode) + (Original $original) + (Replay $replayed))))) + ((CustomReplaySkip) + $original) + ((CustomReplayProtocolError + $code + $details) + (FuzzGenerationError + $code + $details)) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $request))) + ($bad-request + (_fuzz-generation-error + MalformedCustomReplayRequest + (Name $name) + (Value $bad-request))))))))) + +; An explicit edge hook supplies inner derivation trees. Each tree is replayed through DriveCustom before +; it can become a sample, so an edge hook cannot bypass the generator or invent an incompatible value. +(= (_fuzz-custom-edge-replayed + $name + $next-index + $result) + (switch $result + (((FuzzSample $value $replay-driver $tree) + (FuzzSample + $value + (FuzzDriver Edge $next-index) + $tree)) + ((FuzzGenerationDiscard + $reason + $replay-driver + $tree) + (FuzzGenerationDiscard + $reason + (FuzzDriver Edge $next-index) + $tree)) + ((FuzzGenerationError $code $details) $result) + ($bad + (_fuzz-generation-error + MalformedCustomEdgeReplay + (Name $name) + (Value $bad)))))) + +(= (_fuzz-custom-edge-from-choices + $name + $arguments + $size + $index + $choices) + (if (== $choices ()) + (_fuzz-generation-error + EmptyCustomEdgeChoices + (Name $name)) + (let* (($position + (% $index (length $choices))) + ($child-tree + (index-atom + $choices + $position)) + ($tree + (Decision + Custom + (CustomGenerator + (Name $name) + (Arguments $arguments)) + () + ($child-tree))) + ($replayed + (fuzz-replay + (GenCustom $name $arguments) + $tree + $size))) + (_fuzz-custom-edge-replayed + $name + (+ $index 1) + $replayed)))) + +(= (_fuzz-custom-edge-results + $name + $arguments + $size + $index + $results) + (switch $results + ((() + (NoCustomEdgeChoices)) + (($single) + (switch $single + (((EdgeChoices + $seen-name + $seen-arguments + $seen-size) + (NoCustomEdgeChoices)) + ((CustomEdgeChoices $choices) + (if (== (get-metatype $choices) Expression) + (_fuzz-custom-edge-from-choices + $name + $arguments + $size + $index + $choices) + (_fuzz-generation-error + MalformedCustomEdgeChoices + (Name $name) + (Value $choices)))) + ($bad + (_fuzz-generation-error + MalformedCustomEdgeChoices + (Name $name) + (Value $bad)))))) + ($many + (_fuzz-generation-error + AmbiguousCustomEdgeChoices + (Name $name) + (Results $many)))))) + +(= (_fuzz-custom-edge + $name + $arguments + $size + $index) + (let $results + (collapse + (EdgeChoices + $name + $arguments + $size)) + (_fuzz-custom-edge-results + $name + $arguments + $size + $index + $results))) + +(= (_fuzz-generate-custom-supported + $name + $arguments + $driver + $size + $mode) + (switch $driver + (((FuzzDriver Edge $index) + (let $edge + (_fuzz-custom-edge + $name + $arguments + $size + $index) + (switch $edge + (((NoCustomEdgeChoices) + (_fuzz-drive-custom-validated + $name + $arguments + $driver + $size + $mode)) + ($available $available))))) + ($other + (_fuzz-drive-custom-validated + $name + $arguments + $driver + $size + $mode))))) + +(= (_fuzz-generate-custom-for-mode + $name + $arguments + $driver + $size + $mode + $capabilities) + (switch $capabilities + (((ValidCustomCapabilities $modes) + (if (is-member $mode $modes) + (_fuzz-generate-custom-supported + $name + $arguments + $driver + $size + $mode) + (_fuzz-generation-error + UnsupportedCustomDriver + (Name $name) + (Mode $mode)))) + ((FuzzGenerationError $code $details) + $capabilities) + ($bad + (_fuzz-generation-error + MalformedCustomCapabilities + (Name $name) + (Value $bad)))))) + +(= (_fuzz-generate-custom-checked + $name + $arguments + $driver + $size) + (let $mode (_fuzz-custom-driver-mode $driver) + (switch $mode + (((FuzzGenerationError $code $details) $mode) + ($valid-mode + (_fuzz-generate-custom-for-mode + $name + $arguments + $driver + $size + $valid-mode + (_fuzz-custom-capabilities + $name + $arguments))))))) diff --git a/packages/fuzz/src/metta/12-interpreter.metta b/packages/fuzz/src/metta/12-interpreter.metta new file mode 100644 index 0000000..a8a53f0 --- /dev/null +++ b/packages/fuzz/src/metta/12-interpreter.metta @@ -0,0 +1,1145 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; A dynamic generator function must have one result. This prevents its nondeterminism from being +; confused with alternatives chosen by the active driver. The call runs under `collapse-bind` +; and the single result is extracted purely by unification: `collapse` would re-evaluate the +; collected results and grounded list operations resolve their arguments, either of which +; dereferences a live value such as a state handle. +; Flat accumulator, not recurse-then-cons: a relation may return hundreds of results and each +; recursive-then-cons step would cost an evaluator frame. +(= (_fuzz-pair-values $pairs) + (_fuzz-pair-values-loop (FuzzPairValuesFold $pairs ()))) + +(= (_fuzz-pair-values-loop $state) + (if (_fuzz-pair-values-finished $state) + $state + (_fuzz-pair-values-loop (_fuzz-pair-values-step $state)))) + +(= (_fuzz-pair-values-finished $state) + (unify $state (FuzzPairValuesFold $pairs $reversed) False True)) + +(= (_fuzz-pair-values-step $state) + (unify $state + (FuzzPairValuesFold $pairs $reversed) + (if (== $pairs ()) + (reverse $reversed) + (let ($head $tail) (decons-atom $pairs) + (let $value + (unify $head ($result $bindings) $result $head) + (let $next (cons-atom $value $reversed) + (FuzzPairValuesFold $tail $next))))) + $state)) + +(= (_fuzz-call-results-bind $pairs $context) + (unify $pairs + (($value $bindings)) + (CallOne $value) + (unify $pairs + () + (_fuzz-generation-error FunctionReturnedNoResults $context) + (let $values (_fuzz-pair-values $pairs) + (_fuzz-generation-error + FunctionReturnedMultipleResults + $context + (Results $values)))))) + +; The collapse-bind sits inside a function/chain context (the prelude's own `case` idiom) so its +; argument reaches it RAW. As an evaluated argument the call would branch first — Hyperon-verified: +; `(callrb (collapse-bind (f 1)) ctx)` with a two-rule f yields two singleton results in both +; engines — and a nondeterministic user relation would slip through the cardinality check as +; parallel single-result branches instead of being rejected. +(= (_fuzz-call-one $function $argument $context) + (function + (chain (context-space) $space + (chain (collapse-bind (metta ($function $argument) %Undefined% $space)) $pairs + (chain (eval (_fuzz-call-results-bind $pairs $context)) $out + (return $out)))))) + +(= (_fuzz-bool-result $called $context) + (switch $called + (((CallOne True) (CallBool True)) + ((CallOne False) (CallBool False)) + ((CallOne $bad) + (_fuzz-generation-error PredicateReturnedNonBoolean + $context + (Value $bad))) + ((FuzzGenerationError $code $details) $called) + ($bad + (_fuzz-generation-error MalformedFunctionResult + $context + (Value $bad)))))) + +(= (_fuzz-call-bool $function $argument $context) + (_fuzz-bool-result (_fuzz-call-one $function $argument $context) $context)) + +(= (_fuzz-wrap-sample $kind $metadata $selection $sample) + (switch $sample + (((FuzzSample $value $next-driver $tree) + (let $children (cons-atom $tree ()) + (FuzzSample + $value + $next-driver + (Decision $kind $metadata $selection $children)))) + ((FuzzGenerationDiscard $reason $next-driver $tree) + (let $children (cons-atom $tree ()) + (FuzzGenerationDiscard + $reason + $next-driver + (Decision $kind $metadata $selection $children)))) + ((FuzzGenerationError $code $details) $sample) + ($bad + (_fuzz-generation-error MalformedGenerationResult (Value $bad)))))) + +(= (_fuzz-two-children $first $second) + (let $tail (cons-atom $second ()) + (cons-atom $first $tail))) + +(= (_fuzz-choice-sample $choice) + (switch $choice + (((DriverChoice $value $next-driver $decision) + (FuzzSample $value $next-driver $decision)) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error MalformedDriverChoice (Value $bad)))))) + +(= (_fuzz-generate-bool $driver) + (let $choice (_fuzz-driver-int $driver 0 1 0) + (switch $choice + (((DriverChoice 0 $next-driver $decision) + (let $children (cons-atom $decision ()) + (FuzzSample + False + $next-driver + (Decision Bool (Count 2) (Value False) $children)))) + ((DriverChoice 1 $next-driver $decision) + (let $children (cons-atom $decision ()) + (FuzzSample + True + $next-driver + (Decision Bool (Count 2) (Value True) $children)))) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error MalformedBooleanChoice (Value $bad))))))) + +(= (_fuzz-float-range-from-value + $lower-index + $upper-index + $index + $next-driver + $decision + $value) + (switch $value + (((FuzzKernelError $code $operation $detail) + (_fuzz-generation-error + KernelError + (OperationResult $value))) + ($float + (let $children (cons-atom $decision ()) + (FuzzSample + $float + $next-driver + (Decision + FloatRange + (Indices $lower-index $upper-index) + (Index $index) + $children))))))) + +(= (_fuzz-float-range-sample + $lower-index + $upper-index + $origin-index + $choice) + (switch $choice + (((DriverChoice $index $next-driver $decision) + (_fuzz-float-range-from-value + $lower-index + $upper-index + $index + $next-driver + $decision + (_fuzz-float64-from-index $index))) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error + MalformedFloatChoice + (Value $bad)))))) + +(= (_fuzz-generate-float-range + $lower-index + $upper-index + $origin-index + $driver) + (switch $driver + (((FuzzDriver Edge $index) + (let* (($a + (_fuzz-edge-candidates + $lower-index + $upper-index + $origin-index)) + ($b + (_fuzz-edge-add + -2 + $lower-index + $upper-index + $a)) + ($c + (_fuzz-edge-add + -4503599627370496 + $lower-index + $upper-index + $b)) + ($d + (_fuzz-edge-add + -4503599627370497 + $lower-index + $upper-index + $c)) + ($e + (_fuzz-edge-add + 4503599627370495 + $lower-index + $upper-index + $d)) + ($f + (_fuzz-edge-add + 4503599627370496 + $lower-index + $upper-index + $e)) + ($g + (_fuzz-edge-add + -4607182418800017409 + $lower-index + $upper-index + $f)) + ($candidates + (_fuzz-edge-add + 4607182418800017408 + $lower-index + $upper-index + $g)) + ($position (% $index (length $candidates))) + ($selected + (index-atom $candidates $position))) + (_fuzz-float-range-sample + $lower-index + $upper-index + $origin-index + (DriverChoice + $selected + (FuzzDriver Edge (+ $index 1)) + (_fuzz-int-decision + $lower-index + $upper-index + $origin-index + $selected))))) + ($other + (_fuzz-float-range-sample + $lower-index + $upper-index + $origin-index + (_fuzz-driver-int + $other + $lower-index + $upper-index + $origin-index)))))) + +(= (_fuzz-float-bit-edge-pairs) + ((0 0) + (2147483648 0) + (1072693248 0) + (3220176896 0) + (0 1) + (2147483648 1) + (2146435071 4294967295) + (4293918719 4294967295) + (2146435072 0) + (4293918720 0) + (2146959360 0) + (4294443008 0) + (2146435072 1) + (4293918720 1) + (2146959360 23) + (4294443008 23) + (1048576 0) + (2148532224 0) + (1048575 4294967295) + (2148532223 4294967295))) + +(= (_fuzz-float-bits-sample + $high + $low + $next-driver + $high-decision + $low-decision) + (let $value (_fuzz-float64-from-bits $high $low) + (switch $value + (((FuzzKernelError $code $operation $detail) + (_fuzz-generation-error + KernelError + (OperationResult $value))) + ($float + (let $children + (_fuzz-two-children + $high-decision + $low-decision) + (FuzzSample + $float + $next-driver + (Decision + FloatBits + (Format IEEE754Binary64) + (Bits $high $low) + $children)))))))) + +(= (_fuzz-generate-float-bits-edge $index) + (let* (($pairs (_fuzz-float-bit-edge-pairs)) + ($position (% $index (length $pairs))) + ($pair (index-atom $pairs $position))) + (switch $pair + ((($high $low) + (_fuzz-float-bits-sample + $high + $low + (FuzzDriver Edge (+ $index 2)) + (_fuzz-int-decision 0 4294967295 0 $high) + (_fuzz-int-decision 0 4294967295 0 $low))) + ($bad + (_fuzz-generation-error + MalformedFloatEdge + (Value $bad))))))) + +(= (_fuzz-generate-float-bits-from-low + (DriverChoice $high $after-high $high-decision) + $low-choice) + (switch $low-choice + (((DriverChoice $low $next-driver $low-decision) + (_fuzz-float-bits-sample + $high + $low + $next-driver + $high-decision + $low-decision)) + ((FuzzGenerationError $code $details) $low-choice) + ($bad + (_fuzz-generation-error + MalformedFloatLowWordChoice + (Value $bad)))))) + +(= (_fuzz-generate-float-bits $driver) + (switch $driver + (((FuzzDriver Edge $index) + (_fuzz-generate-float-bits-edge $index)) + ($other + (let $high-choice + (_fuzz-driver-int $other 0 4294967295 0) + (switch $high-choice + (((DriverChoice $high $after-high $high-decision) + (_fuzz-generate-float-bits-from-low + $high-choice + (_fuzz-driver-int + $after-high + 0 + 4294967295 + 0))) + ((FuzzGenerationError $code $details) $high-choice) + ($bad + (_fuzz-generation-error + MalformedFloatHighWordChoice + (Value $bad)))))))))) + +(= (_fuzz-generate-element $values $driver) + (let* (($count (length $values)) + ($choice (_fuzz-driver-int $driver 0 (- $count 1) 0))) + (switch $choice + (((DriverChoice $index $next-driver $decision) + (let* (($value (index-atom $values $index)) + ($children (cons-atom $decision ()))) + (FuzzSample + $value + $next-driver + (Decision Element (Count $count) (Index $index) $children)))) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error MalformedElementChoice (Value $bad))))))) + +(= (_fuzz-frequency-select $entries $ticket $offset $index) + (if (== $entries ()) + (_fuzz-generation-error FrequencyTicketOutOfBounds + (Ticket $ticket) + (Offset $offset)) + (let* ((($entry $tail) (decons-atom $entries))) + (switch $entry + ((($weight $generator) + (let $next-offset (+ $offset $weight) + (if (<= $ticket $next-offset) + (FrequencySelection $index $generator) + (_fuzz-frequency-select + $tail + $ticket + $next-offset + (+ $index 1))))) + ($bad + (_fuzz-generation-error MalformedFrequencyEntry + (Entry $bad)))))))) + +; Weights bias only the Random ticket draw; every other driver and the recorded decision work +; in entry-index space [0, count-1]. Exhaustive enumeration therefore visits each entry once, +; and a replayed tree is weight-independent, exactly like grammar production choice. +(= (_fuzz-frequency-index-choice $entries $total $driver) + (switch $driver + (((FuzzDriver Random $rng) + (let $draw (_fuzz-draw-int $rng 1 $total) + (switch $draw + (((FuzzDraw $ticket $next-rng) + (let $selected (_fuzz-frequency-select $entries $ticket 0 0) + (switch $selected + (((FrequencySelection $index $generator) + (let* (($count (length $entries)) + ($decision (_fuzz-int-decision 0 (- $count 1) 0 $index))) + (FrequencyIndexChoice + $index + $generator + (FuzzDriver Random $next-rng) + $decision))) + ((FuzzGenerationError $code $details) $selected) + ($bad + (_fuzz-generation-error + MalformedFrequencySelection + (Value $bad))))))) + ($bad + (_fuzz-generation-error KernelError (OperationResult $bad))))))) + ($other + (let* (($count (length $entries)) + ($choice (_fuzz-driver-int $driver 0 (- $count 1) 0))) + (switch $choice + (((DriverChoice $index $next-driver $decision) + (let $entry (index-atom $entries $index) + (switch $entry + ((($weight $generator) + (FrequencyIndexChoice + $index + $generator + $next-driver + $decision)) + ($bad + (_fuzz-generation-error + MalformedFrequencyEntry + (Entry $bad))))))) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error + MalformedDriverChoice + (Value $bad)))))))))) + +(= (_fuzz-generate-frequency $entries $total $driver $size) + (let $choice (_fuzz-frequency-index-choice $entries $total $driver) + (switch $choice + (((FrequencyIndexChoice $index $generator $next-driver $decision) + (let $child + (fuzz-generate $generator $next-driver (max 0 (- $size 1))) + (switch $child + (((FuzzSample $value $final-driver $tree) + (let $children (_fuzz-two-children $decision $tree) + (FuzzSample + $value + $final-driver + (Decision + Frequency + (Total $total) + (Index $index) + $children)))) + ((FuzzGenerationDiscard $reason $final-driver $tree) + (let $children (_fuzz-two-children $decision $tree) + (FuzzGenerationDiscard + $reason + $final-driver + (Decision + Frequency + (Total $total) + (Index $index) + $children)))) + ((FuzzGenerationError $code $details) $child) + ($bad + (_fuzz-generation-error + MalformedGenerationResult + (Value $bad))))))) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error MalformedFrequencyChoice (Value $bad))))))) + +(= (_fuzz-generate-many $generators $driver $size $values-reversed $trees-reversed) + (if (== $generators ()) + (GeneratedMany + (reverse $values-reversed) + $driver + (reverse $trees-reversed)) + (let* ((($generator $tail) (decons-atom $generators)) + ($sample (fuzz-generate $generator $driver $size))) + (switch $sample + (((FuzzSample $value $next-driver $tree) + (let* (($next-values + (cons-atom $value $values-reversed)) + ($next-trees + (cons-atom $tree $trees-reversed))) + (_fuzz-generate-many + $tail + $next-driver + $size + $next-values + $next-trees))) + ((FuzzGenerationDiscard $reason $next-driver $tree) + (GeneratedManyDiscard + $reason + $next-driver + (reverse (cons-atom $tree $trees-reversed)))) + ((FuzzGenerationError $code $details) $sample) + ($bad + (_fuzz-generation-error + MalformedGenerationResult + (Value $bad)))))))) + +(= (_fuzz-generate-tuple $generators $driver $size) + (let* (($count (length $generators)) + ($child-size (if (> $count 0) (/ $size $count) 0)) + ($generated (_fuzz-generate-many $generators $driver $child-size () ()))) + (switch $generated + (((GeneratedMany $values $next-driver $trees) + (FuzzSample + $values + $next-driver + (Decision Tuple (Count $count) () $trees))) + ((GeneratedManyDiscard $reason $next-driver $trees) + (FuzzGenerationDiscard + $reason + $next-driver + (Decision Tuple (Count $count) () $trees))) + ((FuzzGenerationError $code $details) $generated) + ($bad + (_fuzz-generation-error MalformedTupleGeneration (Value $bad))))))) + +; Flat accumulator, not recurse-then-cons: a drawn list length may be in the thousands and each +; recursive-then-cons step would cost an evaluator frame. Every element is the same generator, so +; the accumulation order is not observable and no final reverse is needed. +(= (_fuzz-repeat-generator $generator $count) + (_fuzz-repeat-generator-loop (FuzzRepeatFold $generator $count ()))) + +(= (_fuzz-repeat-generator-loop $state) + (if (_fuzz-repeat-generator-finished $state) + $state + (_fuzz-repeat-generator-loop (_fuzz-repeat-generator-step $state)))) + +(= (_fuzz-repeat-generator-finished $state) + (unify $state (FuzzRepeatFold $generator $count $repeated) False True)) + +(= (_fuzz-repeat-generator-step $state) + (unify $state + (FuzzRepeatFold $generator $count $repeated) + (if (> $count 0) + (let $next (cons-atom $generator $repeated) + (FuzzRepeatFold $generator (- $count 1) $next)) + $repeated) + $state)) + +(= (_fuzz-generate-list $generator $minimum $maximum $driver $size) + (let* (($effective-maximum (min $maximum (+ $minimum $size))) + ($choice + (_fuzz-driver-int + $driver + $minimum + $effective-maximum + $minimum))) + (switch $choice + (((DriverChoice $length $next-driver $length-decision) + (let* (($child-size (if (> $length 0) (/ $size $length) 0)) + ($generators (_fuzz-repeat-generator $generator $length)) + ($generated + (_fuzz-generate-many + $generators + $next-driver + $child-size + () + ()))) + (switch $generated + (((GeneratedMany $values $final-driver $trees) + (let $children (cons-atom $length-decision $trees) + (FuzzSample + $values + $final-driver + (Decision + List + (Bounds $minimum $maximum) + (Length $length) + $children)))) + ((GeneratedManyDiscard $reason $final-driver $trees) + (let $children (cons-atom $length-decision $trees) + (FuzzGenerationDiscard + $reason + $final-driver + (Decision + List + (Bounds $minimum $maximum) + (Length $length) + $children)))) + ((FuzzGenerationError $code $details) $generated) + ($bad + (_fuzz-generation-error + MalformedListGeneration + (Value $bad))))))) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error MalformedListChoice (Value $bad))))))) + +(= (_fuzz-generate-option $generator $driver $size) + (let $choice (_fuzz-driver-int $driver 0 1 0) + (switch $choice + (((DriverChoice 0 $next-driver $decision) + (let $children (cons-atom $decision ()) + (FuzzSample + (None) + $next-driver + (Decision Option (Count 2) (Index 0) $children)))) + ((DriverChoice 1 $next-driver $decision) + (let $child + (fuzz-generate + $generator + $next-driver + (max 0 (- $size 1))) + (switch $child + (((FuzzSample $value $final-driver $tree) + (let $children (_fuzz-two-children $decision $tree) + (FuzzSample + (Some $value) + $final-driver + (Decision Option (Count 2) (Index 1) $children)))) + ((FuzzGenerationDiscard $reason $final-driver $tree) + (let $children (_fuzz-two-children $decision $tree) + (FuzzGenerationDiscard + $reason + $final-driver + (Decision Option (Count 2) (Index 1) $children)))) + ((FuzzGenerationError $code $details) $child) + ($bad + (_fuzz-generation-error + MalformedOptionGeneration + (Value $bad))))))) + ((FuzzGenerationError $code $details) $choice) + ($bad + (_fuzz-generation-error MalformedOptionChoice (Value $bad))))))) + +(= (_fuzz-generate-map $function $generator $driver $size) + (let $source (fuzz-generate $generator $driver $size) + (switch $source + (((FuzzSample $value $next-driver $tree) + (let $mapped + (_fuzz-call-one + $function + $value + (MapFunction $function)) + (switch $mapped + (((CallOne $mapped-value) + (let $children (cons-atom $tree ()) + (FuzzSample + $mapped-value + $next-driver + (Decision Map (Function $function) () $children)))) + ((FuzzGenerationError $code $details) $mapped) + ($bad + (_fuzz-generation-error MalformedMapResult (Value $bad))))))) + ((FuzzGenerationDiscard $reason $next-driver $tree) + (_fuzz-wrap-sample + Map + (Function $function) + () + $source)) + ((FuzzGenerationError $code $details) $source) + ($bad + (_fuzz-generation-error MalformedMapSource (Value $bad))))))) + +(= (_fuzz-generate-bind $source-generator $function $driver $size) + (let* (($source-size (/ $size 2)) + ($dependent-size (- $size $source-size)) + ($source + (fuzz-generate + $source-generator + $driver + $source-size))) + (switch $source + (((FuzzSample $source-value $next-driver $source-tree) + (let $called + (_fuzz-call-one + $function + $source-value + (BindFunction $function)) + (switch $called + (((CallOne $dependent-generator) + (let $dependent + (fuzz-generate + $dependent-generator + $next-driver + $dependent-size) + (switch $dependent + (((FuzzSample $value $final-driver $dependent-tree) + (let $children + (_fuzz-two-children $source-tree $dependent-tree) + (FuzzSample + $value + $final-driver + (Decision + Bind + (Function $function) + () + $children)))) + ((FuzzGenerationDiscard + $reason + $final-driver + $dependent-tree) + (let $children + (_fuzz-two-children $source-tree $dependent-tree) + (FuzzGenerationDiscard + $reason + $final-driver + (Decision + Bind + (Function $function) + () + $children)))) + ((FuzzGenerationError $code $details) $dependent) + ($bad + (_fuzz-generation-error + MalformedBindGeneration + (Value $bad))))))) + ((FuzzGenerationError $code $details) $called) + ($bad + (_fuzz-generation-error + MalformedBindFunctionResult + (Value $bad))))))) + ((FuzzGenerationDiscard $reason $next-driver $tree) + (_fuzz-wrap-sample + Bind + (Function $function) + () + $source)) + ((FuzzGenerationError $code $details) $source) + ($bad + (_fuzz-generation-error MalformedBindSource (Value $bad))))))) + +(= (_fuzz-filter-total $remaining $used) + (+ $remaining $used)) + +(= (_fuzz-filter-discard $remaining $used $driver $trees-reversed) + (let* (($total (_fuzz-filter-total $remaining $used)) + ($trees (reverse $trees-reversed))) + (FuzzGenerationDiscard + (FilterExhausted (MaximumAttempts $total)) + $driver + (Decision + Filter + (MaximumAttempts $total) + (Attempts $used) + $trees)))) + +(= (_fuzz-generate-filter + $generator + $predicate + $remaining + $used + $driver + $size + $trees-reversed) + (if (<= $remaining 0) + (_fuzz-filter-discard + $remaining + $used + $driver + $trees-reversed) + (let $sample (fuzz-generate $generator $driver $size) + (switch $sample + (((FuzzSample $value $next-driver $tree) + (let $accepted + (_fuzz-call-bool + $predicate + $value + (FilterPredicate $predicate)) + (switch $accepted + (((CallBool True) + (let* (($attempts (+ $used 1)) + ($total + (_fuzz-filter-total + $remaining + $used)) + ($trees + (reverse + (cons-atom $tree $trees-reversed)))) + (FuzzSample + $value + $next-driver + (Decision + Filter + (MaximumAttempts $total) + (Attempts $attempts) + $trees)))) + ((CallBool False) + (let $next-trees + (cons-atom $tree $trees-reversed) + (_fuzz-generate-filter + $generator + $predicate + (- $remaining 1) + (+ $used 1) + $next-driver + $size + $next-trees))) + ((FuzzGenerationError $code $details) $accepted) + ($bad + (_fuzz-generation-error + MalformedFilterPredicateResult + (Value $bad))))))) + ((FuzzGenerationDiscard $reason $next-driver $tree) + (let $next-trees + (cons-atom $tree $trees-reversed) + (_fuzz-generate-filter + $generator + $predicate + (- $remaining 1) + (+ $used 1) + $next-driver + $size + $next-trees))) + ((FuzzGenerationError $code $details) $sample) + ($bad + (_fuzz-generation-error + MalformedFilterGeneration + (Value $bad)))))))) + +(= (_fuzz-generate-sized $function $driver $size) + (let $called + (_fuzz-call-one + $function + $size + (SizedFunction $function)) + (switch $called + (((CallOne $generator) + (let $sample (fuzz-generate $generator $driver $size) + (_fuzz-wrap-sample + Sized + (Size $size) + () + $sample))) + ((FuzzGenerationError $code $details) $called) + ($bad + (_fuzz-generation-error + MalformedSizedFunctionResult + (Value $bad))))))) + +(= (_fuzz-generate-resize $new-size $generator $driver) + (let $sample (fuzz-generate $generator $driver $new-size) + (_fuzz-wrap-sample + Resize + (Size $new-size) + () + $sample))) + +(= (_fuzz-generate-recursive $base $step $driver $size) + (if (<= $size 0) + (let $sample (fuzz-generate $base $driver 0) + (_fuzz-wrap-sample + Recursive + (Size 0) + (Branch Base) + $sample)) + (let* (($child-size (- $size 1)) + ($self + (GenResize + $child-size + (GenRecursive $base $step))) + ($called + (_fuzz-call-one + $step + $self + (RecursiveStep $step)))) + (switch $called + (((CallOne $generator) + (let $sample + (fuzz-generate + $generator + $driver + $child-size) + (_fuzz-wrap-sample + Recursive + (Size $size) + (Branch Step) + $sample))) + ((FuzzGenerationError $code $details) $called) + ($bad + (_fuzz-generation-error + MalformedRecursiveStep + (Value $bad)))))))) + +(= (_fuzz-generate-custom $name $arguments $driver $size) + (_fuzz-generate-custom-checked + $name + $arguments + $driver + $size)) + +(= (fuzz-generate $generator $driver $size) + (if (_fuzz-is-integer $size) + (if (< $size 0) + (_fuzz-generation-error InvalidSize (Size $size)) + (switch $generator + (((FuzzGenerationError $code $details) $generator) + ((GenConst $value) + (FuzzSample + $value + $driver + (Decision Const () (Value $value) ()))) + ((GenBool) + (_fuzz-generate-bool $driver)) + ((GenInt $lower $upper $origin) + (_fuzz-choice-sample + (_fuzz-driver-int + $driver + $lower + $upper + $origin))) + ((GenFloatRange $lower-index $upper-index $origin-index) + (_fuzz-generate-float-range + $lower-index + $upper-index + $origin-index + $driver)) + ((GenFloatBits) + (_fuzz-generate-float-bits $driver)) + ((GenElement $values) + (_fuzz-generate-element $values $driver)) + ((GenFrequency $entries $total) + (_fuzz-generate-frequency + $entries + $total + $driver + $size)) + ((GenTuple $generators) + (_fuzz-generate-tuple + $generators + $driver + $size)) + ((GenList $child $minimum $maximum) + (_fuzz-generate-list + $child + $minimum + $maximum + $driver + $size)) + ((GenOption $child) + (_fuzz-generate-option $child $driver $size)) + ((GenMap $function $child) + (_fuzz-generate-map + $function + $child + $driver + $size)) + ((GenBind $child $function) + (_fuzz-generate-bind + $child + $function + $driver + $size)) + ((GenFilter $child $predicate $maximum-attempts) + (_fuzz-generate-filter + $child + $predicate + $maximum-attempts + 0 + $driver + $size + ())) + ((GenSized $function) + (_fuzz-generate-sized + $function + $driver + $size)) + ((GenResize $new-size $child) + (_fuzz-generate-resize + $new-size + $child + $driver)) + ((GenRecursive $base $step) + (_fuzz-generate-recursive + $base + $step + $driver + $size)) + ((GenCustom $name $arguments) + (_fuzz-generate-custom + $name + $arguments + $driver + $size)) + ($bad + (_fuzz-generation-error + MalformedGenerator + (Generator $bad)))))) + (_fuzz-expected-integer Size $size))) + +(= (fuzz-generate-random $generator $seed $size) + (let $driver (fuzz-random-driver $seed) + (switch $driver + (((FuzzGenerationError $code $details) $driver) + ($valid + (fuzz-generate $generator $valid $size)))))) + +(= (fuzz-generate-edge $generator $index $size) + (let $driver (fuzz-edge-driver $index) + (switch $driver + (((FuzzGenerationError $code $details) $driver) + ($valid + (fuzz-generate $generator $valid $size)))))) + +(= (fuzz-generate-bytes $generator $bytes $size) + (let $driver (fuzz-bytes-driver $bytes) + (switch $driver + (((FuzzGenerationError $code $details) $driver) + ($valid + (fuzz-generate $generator $valid $size)))))) + +(= (_fuzz-validate-finished-replay + $expected-tree + $actual-tree + $remaining + $cursor + $result) + (if (== $remaining ()) + (if (_fuzz-replay-equal $expected-tree $actual-tree) + $result + (_fuzz-generation-error + ReplayMismatch + (ExpectedTree $expected-tree) + (ActualTree $actual-tree))) + (_fuzz-generation-error + TrailingReplayDecisions + (Path $cursor) + (Remaining $remaining)))) + +(= (_fuzz-finish-replay $expected-tree $result) + (switch $result + (((FuzzSample + $value + (FuzzDriver Replay (ReplayState $remaining $cursor)) + $actual-tree) + (_fuzz-validate-finished-replay + $expected-tree + $actual-tree + $remaining + $cursor + $result)) + ((FuzzGenerationDiscard + $reason + (FuzzDriver Replay (ReplayState $remaining $cursor)) + $actual-tree) + (_fuzz-validate-finished-replay + $expected-tree + $actual-tree + $remaining + $cursor + $result)) + ((FuzzGenerationError $code $details) $result) + ($bad + (_fuzz-generation-error + MalformedReplayResult + (Value $bad)))))) + +(= (fuzz-replay $generator $decision-tree $size) + (let $driver (fuzz-replay-driver $decision-tree) + (switch $driver + (((FuzzGenerationError $code $details) $driver) + ($valid + (_fuzz-finish-replay + $decision-tree + (fuzz-generate $generator $valid $size))))))) + +; Enumerates the generator's whole decision domain at one size with the exhaustive cursor, +; in depth-first order. Generation discards count as enumerated attempts but not as domain +; members. Stops at $limit attempts with FuzzEnumerationTruncated; a completed walk returns +; (FuzzEnumeration (DomainCount n) (Enumerated m) (GenerationDiscards g) (Samples ...)). +(= (fuzz-enumerate $generator $limit $size) + (if (_fuzz-is-integer $limit) + (if (> $limit 0) + (_fuzz-enumerate-loop + (FuzzEnumerateRun $generator $size $limit () 0 0 0 ())) + (_fuzz-generation-error InvalidEnumerationLimit (Limit $limit))) + (_fuzz-expected-integer EnumerationLimit $limit))) + +(= (_fuzz-enumerate-loop $state) + (if (_fuzz-enumerate-finished $state) + $state + (_fuzz-enumerate-loop (_fuzz-enumerate-step $state)))) + +(= (_fuzz-enumerate-finished $state) + (unify $state + (FuzzEnumerateRun $generator $size $limit $plan $enumerated $accepted $discards $samples) + False + True)) + +(= (_fuzz-enumerate-step $state) + (unify $state + (FuzzEnumerateRun $generator $size $limit $plan $enumerated $accepted $discards $samples) + (if (>= $enumerated $limit) + (FuzzEnumerationTruncated + (Enumerated $enumerated) + (DomainCount $accepted) + (GenerationDiscards $discards) + (Samples $samples)) + (let $driver (_fuzz-exhaustive-resume-driver $plan) + (let $result (fuzz-generate $generator $driver $size) + (switch $result + (((FuzzSample $value (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames)) $tree) + (let $collected (_fuzz-expression-append $samples $result) + (_fuzz-enumerate-advance + $generator $size $limit $frames + (+ $enumerated 1) (+ $accepted 1) $discards $collected))) + ((FuzzGenerationDiscard $reason (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames)) $tree) + (_fuzz-enumerate-advance + $generator $size $limit $frames + (+ $enumerated 1) $accepted (+ $discards 1) $samples)) + ((FuzzGenerationError $code $details) $result) + ($bad + (_fuzz-generation-error MalformedExhaustiveOutcome (Value $bad)))))))) + (_fuzz-generation-error MalformedEnumerationState (State $state)))) + +(= (_fuzz-enumerate-advance $generator $size $limit $frames $enumerated $accepted $discards $samples) + (let $advanced (_fuzz-exhaustive-next-plan $frames) + (switch $advanced + (((ExhaustivePlan $plan) + (FuzzEnumerateRun $generator $size $limit $plan $enumerated $accepted $discards $samples)) + (ExhaustiveComplete + (FuzzEnumeration + (DomainCount $accepted) + (Enumerated $enumerated) + (GenerationDiscards $discards) + (Samples $samples))) + ((FuzzGenerationError $code $details) $advanced) + ($bad + (_fuzz-generation-error MalformedExhaustiveAdvance (Value $bad))))))) + +(= (_fuzz-finish-shrink-replay $result) + (switch $result + (((FuzzSample $value $driver $actual-tree) + (FuzzShrinkReplay $value $actual-tree)) + ((FuzzGenerationDiscard $reason $driver $actual-tree) + (FuzzShrinkDiscard $reason $actual-tree)) + ((FuzzGenerationError $code $details) $result) + ($bad + (_fuzz-generation-error + MalformedShrinkReplayResult + (Value $bad)))))) + +(= (_fuzz-shrink-replay $generator $decision-tree $size) + (let $driver (_fuzz-shrink-replay-driver $decision-tree) + (switch $driver + (((FuzzGenerationError $code $details) $driver) + ($valid + (_fuzz-finish-shrink-replay + (fuzz-generate $generator $valid $size))))))) diff --git a/packages/fuzz/src/metta/15-drivers.metta b/packages/fuzz/src/metta/15-drivers.metta new file mode 100644 index 0000000..39445f8 --- /dev/null +++ b/packages/fuzz/src/metta/15-drivers.metta @@ -0,0 +1,348 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +(= (_fuzz-int-decision $lower $upper $origin $value) + (Decision + Int + (Bounds $lower $upper) + (Origin $origin) + (Value $value) + ())) + +(= (fuzz-random-driver $seed) + (if (_fuzz-is-integer $seed) + (let $rng (_fuzz-rng-init $seed) + (switch $rng + (((FuzzRng $algorithm $s01 $s00 $s11 $s10) + (FuzzDriver Random $rng)) + ($bad + (_fuzz-generation-error KernelError (OperationResult $bad)))))) + (_fuzz-expected-integer Seed $seed))) + +(= (fuzz-edge-driver $index) + (if (_fuzz-is-integer $index) + (if (>= $index 0) + (FuzzDriver Edge $index) + (_fuzz-generation-error InvalidEdgeIndex (Index $index))) + (_fuzz-expected-integer EdgeIndex $index))) + +; One exhaustive run follows one choice vector: each integer decision reads its planned +; offset (or defaults to zero past the plan) and records an (ExhaustiveFrame offset count) +; newest-first. Enumeration is the odometer over recorded frames, driven by +; `_fuzz-exhaustive-next-plan`; a lone driver generates the leftmost path deterministically. +(= (fuzz-exhaustive-driver) + (FuzzDriver Exhaustive (ExhaustiveCursor () 0 ()))) + +(= (_fuzz-exhaustive-resume-driver $choices) + (FuzzDriver Exhaustive (ExhaustiveCursor $choices 0 ()))) + +; Odometer advance: increment the rightmost frame that has another branch and drop the +; suffix; later decisions are reconstructed by default-zero descent, which is what keeps +; enumeration exact for dependent generators. Frames arrive newest-first; the returned +; (ExhaustivePlan offsets) is oldest-first. ExhaustiveComplete means the domain is done. +(= (_fuzz-exhaustive-next-plan $frames-reversed) + (if-decons-expr + $frames-reversed + $frame + $earlier + (switch $frame + (((ExhaustiveFrame $offset $count) + (if (< (+ $offset 1) $count) + (let $bumped (+ $offset 1) + (let $plan (_fuzz-exhaustive-plan-prefix $earlier ($bumped)) + (ExhaustivePlan $plan))) + (_fuzz-exhaustive-next-plan $earlier))) + ($bad + (_fuzz-generation-error MalformedExhaustiveFrame (Frame $bad))))) + ExhaustiveComplete)) + +(= (_fuzz-exhaustive-plan-prefix $frames-reversed $accumulator) + (if-decons-expr + $frames-reversed + $frame + $earlier + (switch $frame + (((ExhaustiveFrame $offset $count) + (let $next (cons-atom $offset $accumulator) + (_fuzz-exhaustive-plan-prefix $earlier $next))) + ($bad + (_fuzz-generation-error MalformedExhaustiveFrame (Frame $bad))))) + $accumulator)) + +(= (_fuzz-valid-bytes $bytes) + (if (== $bytes ()) + True + (let* ((($byte $tail) (decons-atom $bytes))) + (if (and + (_fuzz-is-integer $byte) + (and (<= 0 $byte) (<= $byte 255))) + (_fuzz-valid-bytes $tail) + False)))) + +(= (fuzz-bytes-driver $bytes) + (if (_fuzz-valid-bytes $bytes) + (FuzzDriver Bytes (BytesState $bytes 0)) + (_fuzz-generation-error InvalidByteInput (Bytes $bytes)))) + +(= (_fuzz-edge-add $candidate $lower $upper $candidates) + (if (and (<= $lower $candidate) (<= $candidate $upper)) + (if (is-member $candidate $candidates) + $candidates + (append $candidates ($candidate))) + $candidates)) + +(= (_fuzz-edge-candidates $lower $upper $origin) + (let* (($a (_fuzz-edge-add $origin $lower $upper ())) + ($b (_fuzz-edge-add $lower $lower $upper $a)) + ($c (_fuzz-edge-add $upper $lower $upper $b)) + ($d (_fuzz-edge-add 0 $lower $upper $c)) + ($e (_fuzz-edge-add -1 $lower $upper $d)) + ($f (_fuzz-edge-add 1 $lower $upper $e)) + ($mid (/ (+ $lower $upper) 2))) + (_fuzz-edge-add $mid $lower $upper $f))) + +(= (_fuzz-driver-int-random $rng $lower $upper $origin) + (let $draw (_fuzz-draw-int $rng $lower $upper) + (switch $draw + (((FuzzDraw $value $next-rng) + (DriverChoice + $value + (FuzzDriver Random $next-rng) + (_fuzz-int-decision $lower $upper $origin $value))) + ($bad + (_fuzz-generation-error KernelError (OperationResult $bad))))))) + +(= (_fuzz-driver-int-edge $index $lower $upper $origin) + (let* (($candidates (_fuzz-edge-candidates $lower $upper $origin)) + ($count (length $candidates)) + ($position (% $index $count)) + ($value (index-atom $candidates $position))) + (DriverChoice + $value + (FuzzDriver Edge (+ $index 1)) + (_fuzz-int-decision $lower $upper $origin $value)))) + +(= (_fuzz-inspect-int-decision $decision $lower $upper $origin) + (switch $decision + (((Decision + Int + (Bounds $seen-lower $seen-upper) + (Origin $seen-origin) + (Value $value) + ()) + (if (and + (== $lower $seen-lower) + (and + (== $upper $seen-upper) + (== $origin $seen-origin))) + (if (and (<= $lower $value) (<= $value $upper)) + (CompatibleIntDecision $value) + (IntDecisionValueOutOfBounds $value)) + (IntDecisionMetadataMismatch + (Bounds $seen-lower $seen-upper) + (Origin $seen-origin)))) + ($bad (MalformedIntDecision $bad))))) + +(= (_fuzz-driver-int-replay $state $lower $upper $origin) + (switch $state + (((ReplayState $decisions $cursor) + (if (== $decisions ()) + (_fuzz-generation-error ReplayMismatch + (Path $cursor) + (Expected + (Decision + Int + (Bounds $lower $upper) + (Origin $origin) + (Value Any) + ())) + (Actual EndOfTrace)) + (let ($decision $tail) (decons-atom $decisions) + (let $inspected + (_fuzz-inspect-int-decision + $decision + $lower + $upper + $origin) + (switch $inspected + (((CompatibleIntDecision $value) + (DriverChoice + $value + (FuzzDriver Replay (ReplayState $tail (+ $cursor 1))) + $decision)) + ((IntDecisionValueOutOfBounds $value) + (_fuzz-generation-error ReplayValueOutOfBounds + (Path $cursor) + (Bounds $lower $upper) + (Value $value))) + ((IntDecisionMetadataMismatch + (Bounds $seen-lower $seen-upper) + (Origin $seen-origin)) + (_fuzz-generation-error ReplayMismatch + (Path $cursor) + (ExpectedBounds $lower $upper) + (ActualBounds $seen-lower $seen-upper) + (Origins $origin $seen-origin))) + ((MalformedIntDecision $bad) + (_fuzz-generation-error ReplayMismatch + (Path $cursor) + (Expected IntDecision) + (Actual $bad))))))))) + ($bad-state + (_fuzz-generation-error MalformedReplayState (State $bad-state)))))) + +(= (_fuzz-shrink-replay-default-int + $decisions + $cursor + $lower + $upper + $origin) + (let $value (max $lower (min $upper $origin)) + (DriverChoice + $value + (FuzzDriver + ShrinkReplay + (ShrinkReplayState $decisions $cursor)) + (_fuzz-int-decision $lower $upper $origin $value)))) + +(= (_fuzz-driver-int-shrink-replay-loop + $decisions + $cursor + $lower + $upper + $origin) + (if (== $decisions ()) + (_fuzz-shrink-replay-default-int + () + $cursor + $lower + $upper + $origin) + (let ($decision $tail) (decons-atom $decisions) + (let $next-cursor (+ $cursor 1) + (let $inspected + (_fuzz-inspect-int-decision + $decision + $lower + $upper + $origin) + (switch $inspected + (((CompatibleIntDecision $value) + (DriverChoice + $value + (FuzzDriver + ShrinkReplay + (ShrinkReplayState $tail $next-cursor)) + $decision)) + ($incompatible + (_fuzz-driver-int-shrink-replay-loop + $tail + $next-cursor + $lower + $upper + $origin))))))))) + +(= (_fuzz-driver-int-shrink-replay $state $lower $upper $origin) + (switch $state + (((ShrinkReplayState $decisions $cursor) + (_fuzz-driver-int-shrink-replay-loop + $decisions + $cursor + $lower + $upper + $origin)) + ($bad-state + (_fuzz-generation-error + MalformedShrinkReplayState + (State $bad-state)))))) + +(= (_fuzz-driver-int-exhaustive $state $lower $upper $origin) + (switch $state + (((ExhaustiveCursor $choices $cursor $frames) + (let* (($count (+ (- $upper $lower) 1)) + ($offset + (if (< $cursor (length $choices)) + (index-atom $choices $cursor) + 0))) + (if (and (<= 0 $offset) (< $offset $count)) + (let* (($value (+ $lower $offset)) + ($frame (ExhaustiveFrame $offset $count)) + ($next-frames (cons-atom $frame $frames))) + (DriverChoice + $value + (FuzzDriver + Exhaustive + (ExhaustiveCursor $choices (+ $cursor 1) $next-frames)) + (_fuzz-int-decision $lower $upper $origin $value))) + (_fuzz-generation-error ExhaustiveResumeMismatch + (Offset $offset) + (Bounds $lower $upper))))) + ($bad-state + (_fuzz-generation-error + MalformedExhaustiveState + (State $bad-state)))))) + +(= (_fuzz-byte-width $span $capacity $width) + (if (>= $capacity $span) + $width + (_fuzz-byte-width $span (* $capacity 256) (+ $width 1)))) + +(= (_fuzz-read-bytes $bytes $cursor $remaining $accumulator) + (if (<= $remaining 0) + (ByteRead $accumulator $cursor) + (if (< $cursor (length $bytes)) + (let* (($byte (index-atom $bytes $cursor)) + ($next (+ (* $accumulator 256) $byte))) + (_fuzz-read-bytes + $bytes + (+ $cursor 1) + (- $remaining 1) + $next)) + (_fuzz-generation-error BytesExhausted + (Cursor $cursor) + (Remaining $remaining))))) + +(= (_fuzz-driver-int-bytes $state $lower $upper $origin) + (switch $state + (((BytesState $bytes $cursor) + (let* (($span (+ (- $upper $lower) 1)) + ($width (_fuzz-byte-width $span 256 1)) + ($read (_fuzz-read-bytes $bytes $cursor $width 0))) + (switch $read + (((ByteRead $raw $next-cursor) + (let $value (+ $lower (% $raw $span)) + (DriverChoice + $value + (FuzzDriver Bytes (BytesState $bytes $next-cursor)) + (_fuzz-int-decision $lower $upper $origin $value)))) + ((FuzzGenerationError $code $details) $read) + ($bad + (_fuzz-generation-error + MalformedByteRead + (OperationResult $bad))))))) + ($bad-state + (_fuzz-generation-error MalformedByteState (State $bad-state)))))) + +(= (_fuzz-driver-int $driver $lower $upper $origin) + (if (> $lower $upper) + (_fuzz-generation-error InvalidIntegerBounds (Bounds $lower $upper)) + (switch $driver + (((FuzzDriver Random $rng) + (_fuzz-driver-int-random $rng $lower $upper $origin)) + ((FuzzDriver Edge $index) + (_fuzz-driver-int-edge $index $lower $upper $origin)) + ((FuzzDriver Replay $state) + (_fuzz-driver-int-replay $state $lower $upper $origin)) + ((FuzzDriver ShrinkReplay $state) + (_fuzz-driver-int-shrink-replay + $state + $lower + $upper + $origin)) + ((FuzzDriver Exhaustive $state) + (_fuzz-driver-int-exhaustive $state $lower $upper $origin)) + ((FuzzDriver Bytes $state) + (_fuzz-driver-int-bytes $state $lower $upper $origin)) + ($bad + (_fuzz-generation-error MalformedDriver (Driver $bad))))))) diff --git a/packages/fuzz/src/metta/20-decisions.metta b/packages/fuzz/src/metta/20-decisions.metta new file mode 100644 index 0000000..c2ad7bb --- /dev/null +++ b/packages/fuzz/src/metta/20-decisions.metta @@ -0,0 +1,33 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Decision trees flatten to their Int leaves kernel-side (one linear pass); the drivers +; only consume the resulting leaf list. +(= (fuzz-replay-driver $decision-tree) + (let $leaves (_fuzz-decision-leaves-op $decision-tree) + (unify $leaves + (FuzzDecisionLeaves $flat) + (FuzzDriver Replay (ReplayState $flat 0)) + (unify $leaves + (FuzzGenerationError $code $details) + $leaves + (unify $leaves + $bad + (_fuzz-generation-error MalformedDecisionTree (Decision $bad)) + Empty))))) + +(= (_fuzz-shrink-replay-driver $decision-tree) + (let $leaves (_fuzz-decision-leaves-op $decision-tree) + (unify $leaves + (FuzzDecisionLeaves $flat) + (FuzzDriver + ShrinkReplay + (ShrinkReplayState $flat 0)) + (unify $leaves + (FuzzGenerationError $code $details) + $leaves + (unify $leaves + $bad + (_fuzz-generation-error MalformedDecisionTree (Decision $bad)) + Empty))))) diff --git a/packages/fuzz/src/metta/30-properties.metta b/packages/fuzz/src/metta/30-properties.metta new file mode 100644 index 0000000..5fe41be --- /dev/null +++ b/packages/fuzz/src/metta/30-properties.metta @@ -0,0 +1,972 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Canonical property outcomes. +(= (fuzz-pass) + (Pass)) + +(= (fuzz-fail $tag $details) + (Fail $tag $details)) + +(= (fuzz-discard $reason) + (Discard $reason)) + +(= (expect-true $condition $details) + (if $condition + (Pass) + (Fail ExpectedTrue $details))) + +(= (expect-false $condition $details) + (if $condition + (Fail ExpectedFalse $details) + (Pass))) + +(= (expect-atom-equal $actual $expected) + (if (== $actual $expected) + (Pass) + (Fail + NotEqual + ((Actual $actual) (Expected $expected))))) + +(= (expect-alpha-equal $actual $expected) + (if (=alpha $actual $expected) + (Pass) + (Fail + NotAlphaEqual + ((Actual $actual) (Expected $expected))))) + +(= (expect-results-exact $actual $expected) + (if (== $actual $expected) + (Pass) + (Fail + ResultsNotExact + ((Actual $actual) (Expected $expected))))) + +(= (expect-results-alpha $actual $expected) + (if (=alpha $actual $expected) + (Pass) + (Fail + ResultsNotAlphaEqual + ((Actual $actual) (Expected $expected))))) + +(= (_fuzz-remove-exact-loop $target $remaining $prefix) + (if (== $remaining ()) + NotFound + (let* ((($value $tail) (decons-atom $remaining))) + (if (== $target $value) + (Removed (append $prefix $tail)) + (_fuzz-remove-exact-loop + $target + $tail + (append $prefix (cons-atom $value ()))))))) + +(= (_fuzz-remove-exact $target $values) + (_fuzz-remove-exact-loop $target $values ())) + +(= (_fuzz-results-multiset-equal $left $right) + (if (== $left ()) + (== $right ()) + (let* ((($value $tail) (decons-atom $left)) + ($removed (_fuzz-remove-exact $value $right))) + (switch $removed + (((Removed $remaining) + (_fuzz-results-multiset-equal $tail $remaining)) + (NotFound False) + ($bad False)))))) + +(= (_fuzz-every-member-exact $values $other) + (if (== $values ()) + True + (let* ((($value $tail) (decons-atom $values))) + (if (is-member $value $other) + (_fuzz-every-member-exact $tail $other) + False)))) + +(= (_fuzz-results-set-equal $left $right) + (and + (_fuzz-every-member-exact $left $right) + (_fuzz-every-member-exact $right $left))) + +(= (expect-results-multiset $actual $expected) + (if (_fuzz-results-multiset-equal $actual $expected) + (Pass) + (Fail + ResultsNotMultisetEqual + ((Actual $actual) (Expected $expected))))) + +(= (expect-results-set $actual $expected) + (if (_fuzz-results-set-equal $actual $expected) + (Pass) + (Fail + ResultsNotSetEqual + ((Actual $actual) (Expected $expected))))) + +; The property argument stays lazy so a false precondition cannot run it. +(= (implies $condition $property) + (if $condition + $property + (Discard ImplicationFalse))) + +(= (classify $condition $label $property) + (if $condition + (FuzzClassified $label $property) + $property)) + +(= (collect $value $property) + (FuzzCollected $value $property)) + +(= (cover $minimum-percent $condition $label $property) + (if (and + (<= 0 $minimum-percent) + (<= $minimum-percent 100)) + (FuzzCovered + $minimum-percent + $label + $condition + $property) + (FuzzInvalidProperty + InvalidCoveragePercentage + (MinimumPercent $minimum-percent)))) + +(= (counterexample $note $property) + (FuzzAnnotated $note $property)) + +; Compatibility aliases use the canonical outcomes. +(= (fuzz-equal $actual $expected) + (expect-atom-equal $actual $expected)) + +(= (fuzz-alpha-equal $actual $expected) + (expect-alpha-equal $actual $expected)) + +(= (fuzz-implies $condition $property) + (implies $condition $property)) + +(= (fuzz-annotate $note $property) + (counterexample $note $property)) + +(= (fuzz-classify $condition $label $property) + (classify $condition $label $property)) + +(= (fuzz-collect $value $property) + (collect $value $property)) + +(= (fuzz-cover $minimum-percent $label $condition $property) + (cover $minimum-percent $condition $label $property)) + +; Quantifier wrappers are passed as the property-function argument to fuzz-check. +(= (all-results $property) + (FuzzPropertyFunction All $property)) + +(= (any-result $property) + (FuzzPropertyFunction Any $property)) + +(= (_fuzz-normalized-add-annotation $annotation $normalized) + (switch $normalized + (((NormalizedProperty + $status + $tag + $details + $labels + $collected + $coverage + $annotations) + (NormalizedProperty + $status + $tag + $details + $labels + $collected + $coverage + (append $annotations (cons-atom $annotation ())))) + ($bad + (NormalizedProperty + Invalid + InvalidPropertyWrapper + (Value $bad) + () + () + () + ()))))) + +(= (_fuzz-normalized-add-label $label $normalized) + (switch $normalized + (((NormalizedProperty + $status + $tag + $details + $labels + $collected + $coverage + $annotations) + (NormalizedProperty + $status + $tag + $details + (append $labels (cons-atom $label ())) + $collected + $coverage + $annotations)) + ($bad + (NormalizedProperty + Invalid + InvalidPropertyWrapper + (Value $bad) + () + () + () + ()))))) + +(= (_fuzz-normalized-add-collected $value $normalized) + (switch $normalized + (((NormalizedProperty + $status + $tag + $details + $labels + $collected + $coverage + $annotations) + (NormalizedProperty + $status + $tag + $details + $labels + (append $collected (cons-atom $value ())) + $coverage + $annotations)) + ($bad + (NormalizedProperty + Invalid + InvalidPropertyWrapper + (Value $bad) + () + () + () + ()))))) + +(= (_fuzz-normalized-add-coverage + $minimum-percent + $label + $hit + $normalized) + (switch $normalized + (((NormalizedProperty + $status + $tag + $details + $labels + $collected + $coverage + $annotations) + (let $observation + (CoverageObservation $minimum-percent $label $hit) + (NormalizedProperty + $status + $tag + $details + $labels + $collected + (append $coverage (cons-atom $observation ())) + $annotations))) + ($bad + (NormalizedProperty + Invalid + InvalidPropertyWrapper + (Value $bad) + () + () + () + ()))))) + +(= (_fuzz-normalize-property-result $result) + (switch $result + (((Pass) + (NormalizedProperty Pass None () () () () ())) + (True + (NormalizedProperty Pass None () () () () ())) + (False + (NormalizedProperty Fail BooleanFalse () () () () ())) + ((Fail $tag $details) + (NormalizedProperty Fail $tag $details () () () ())) + ((Discard $reason) + (NormalizedProperty Discard Discarded $reason () () () ())) + ((FuzzAnnotated $annotation $outcome) + (_fuzz-normalized-add-annotation + $annotation + (_fuzz-normalize-property-result $outcome))) + ((FuzzClassified $label $outcome) + (_fuzz-normalized-add-label + $label + (_fuzz-normalize-property-result $outcome))) + ((FuzzCollected $value $outcome) + (_fuzz-normalized-add-collected + $value + (_fuzz-normalize-property-result $outcome))) + ((FuzzCovered $minimum-percent $label $hit $outcome) + (_fuzz-normalized-add-coverage + $minimum-percent + $label + $hit + (_fuzz-normalize-property-result $outcome))) + ((FuzzInvalidProperty $code $details) + (NormalizedProperty Invalid $code $details () () () ())) + ((Error $subject ResourceLimit) + (NormalizedProperty + Cutoff + ResourceLimit + (Error $subject ResourceLimit) + () + () + () + ())) + ((Error $subject StackOverflow) + (NormalizedProperty + Cutoff + StackOverflow + (Error $subject StackOverflow) + () + () + () + ())) + ((Error $subject TableResourceLimit) + (NormalizedProperty + Cutoff + TableResourceLimit + (Error $subject TableResourceLimit) + () + () + () + ())) + ((Error $subject $reason) + (NormalizedProperty + Fail + LanguageError + (Error $subject $reason) + () + () + () + ())) + ($bad + (NormalizedProperty + Invalid + MalformedPropertyResult + (Value $bad) + () + () + () + ()))))) + +(= (_fuzz-first-result $current $candidate) + (switch $current + ((None (Some $candidate)) + ((Some $value) $current) + ($bad (Some $candidate))))) + +(= (_fuzz-classification-add $normalized $state) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (switch $normalized + (((NormalizedProperty + $status + $tag + $details + $new-labels + $new-collected + $new-coverage + $new-annotations) + (let* (($next-pass-count + (if (== $status Pass) + (+ $pass-count 1) + $pass-count)) + ($next-fail + (if (== $status Fail) + (_fuzz-first-result $first-fail $normalized) + $first-fail)) + ($next-discard + (if (== $status Discard) + (_fuzz-first-result $first-discard $normalized) + $first-discard)) + ($next-cutoff + (if (== $status Cutoff) + (_fuzz-first-result $first-cutoff $normalized) + $first-cutoff)) + ($next-invalid + (if (== $status Invalid) + (_fuzz-first-result $first-invalid $normalized) + $first-invalid))) + (PropertyClassification + $next-pass-count + $next-fail + $next-discard + $next-cutoff + $next-invalid + (append $labels $new-labels) + (append $collected $new-collected) + (append $coverage $new-coverage) + (append $annotations $new-annotations)))) + ($bad + (PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + (Some + (NormalizedProperty + Invalid + InvalidNormalizedProperty + (Value $bad) + () + () + () + ())) + $labels + $collected + $coverage + $annotations))))) + ($bad-state $bad-state)))) + +(= (_fuzz-classify-results-loop $remaining $state) + (if (== $remaining ()) + $state + (let* ((($result $tail) (decons-atom $remaining)) + ($normalized + (_fuzz-normalize-property-result $result)) + ($next + (_fuzz-classification-add $normalized $state))) + (_fuzz-classify-results-loop $tail $next)))) + +(= (_fuzz-case-from-normalized + $normalized + $state + $results + $steps) + (switch $normalized + (((NormalizedProperty + $status + $tag + $details + $ignored-labels + $ignored-collected + $ignored-coverage + $ignored-annotations) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (FuzzCaseResult + $status + $tag + (Details $details) + (Labels $labels) + (Collected $collected) + (Coverage $coverage) + (Annotations $annotations) + (Results $results) + (Steps $steps))) + ($bad-state + (FuzzCaseResult + Invalid + InvalidClassificationState + (Details (Value $bad-state)) + (Labels ()) + (Collected ()) + (Coverage ()) + (Annotations ()) + (Results $results) + (Steps $steps)))))) + ($bad + (FuzzCaseResult + Invalid + InvalidNormalizedProperty + (Details (Value $bad)) + (Labels ()) + (Collected ()) + (Coverage ()) + (Annotations ()) + (Results $results) + (Steps $steps)))))) + +(= (_fuzz-synthetic-case $status $tag $details $state $results $steps) + (_fuzz-case-from-normalized + (NormalizedProperty $status $tag $details () () () ()) + $state + $results + $steps)) + +(= (_fuzz-case-from-option + $option + $fallback-status + $fallback-tag + $state + $results + $steps) + (switch $option + (((Some $normalized) + (_fuzz-case-from-normalized + $normalized + $state + $results + $steps)) + (None + (_fuzz-synthetic-case + $fallback-status + $fallback-tag + () + $state + $results + $steps)) + ($bad + (_fuzz-synthetic-case + Invalid + InvalidClassificationOption + (Value $bad) + $state + $results + $steps))))) + +(= (_fuzz-finish-default-after-fail $state $results $steps) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (switch $first-cutoff + (((Some $cutoff) + (_fuzz-case-from-normalized + $cutoff + $state + $results + $steps)) + (None + (if (> $pass-count 0) + (_fuzz-synthetic-case + Pass + None + () + $state + $results + $steps) + (_fuzz-case-from-option + $first-discard + Invalid + NoPropertyResult + $state + $results + $steps)))))) + ($bad-state + (_fuzz-synthetic-case + Invalid + InvalidClassificationState + (Value $bad-state) + $state + $results + $steps))))) + +(= (_fuzz-finish-default $state $results $steps) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (switch $first-fail + (((Some $failure) + (_fuzz-case-from-normalized + $failure + $state + $results + $steps)) + (None + (_fuzz-finish-default-after-fail + $state + $results + $steps))))) + ($bad-state + (_fuzz-synthetic-case + Invalid + InvalidClassificationState + (Value $bad-state) + $state + $results + $steps))))) + +(= (_fuzz-finish-all-after-fail $state $results $steps) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (switch $first-cutoff + (((Some $cutoff) + (_fuzz-case-from-normalized + $cutoff + $state + $results + $steps)) + (None + (switch $first-discard + (((Some $discard) + (_fuzz-case-from-normalized + $discard + $state + $results + $steps)) + (None + (if (> $pass-count 0) + (_fuzz-synthetic-case + Pass + None + () + $state + $results + $steps) + (_fuzz-synthetic-case + Invalid + NoPropertyResult + () + $state + $results + $steps))))))))) + ($bad-state + (_fuzz-synthetic-case + Invalid + InvalidClassificationState + (Value $bad-state) + $state + $results + $steps))))) + +(= (_fuzz-finish-all $state $results $steps) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (switch $first-fail + (((Some $failure) + (_fuzz-case-from-normalized + $failure + $state + $results + $steps)) + (None + (_fuzz-finish-all-after-fail + $state + $results + $steps))))) + ($bad-state + (_fuzz-synthetic-case + Invalid + InvalidClassificationState + (Value $bad-state) + $state + $results + $steps))))) + +(= (_fuzz-finish-any-after-pass $state $results $steps) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (switch $first-fail + (((Some $failure) + (_fuzz-case-from-normalized + $failure + $state + $results + $steps)) + (None + (switch $first-cutoff + (((Some $cutoff) + (_fuzz-case-from-normalized + $cutoff + $state + $results + $steps)) + (None + (_fuzz-case-from-option + $first-discard + Invalid + NoPropertyResult + $state + $results + $steps)))))))) + ($bad-state + (_fuzz-synthetic-case + Invalid + InvalidClassificationState + (Value $bad-state) + $state + $results + $steps))))) + +(= (_fuzz-finish-any $state $results $steps) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (if (> $pass-count 0) + (_fuzz-synthetic-case + Pass + None + () + $state + $results + $steps) + (_fuzz-finish-any-after-pass + $state + $results + $steps))) + ($bad-state + (_fuzz-synthetic-case + Invalid + InvalidClassificationState + (Value $bad-state) + $state + $results + $steps))))) + +(= (_fuzz-finish-valid-classification + $quantifier + $state + $results + $steps) + (if (== $quantifier Default) + (_fuzz-finish-default $state $results $steps) + (if (== $quantifier All) + (_fuzz-finish-all $state $results $steps) + (if (== $quantifier Any) + (_fuzz-finish-any $state $results $steps) + (_fuzz-synthetic-case + Invalid + InvalidQuantifier + (Quantifier $quantifier) + $state + $results + $steps))))) + +(= (_fuzz-finish-property-classification + $quantifier + $state + $results + $steps) + (switch $state + (((PropertyClassification + $pass-count + $first-fail + $first-discard + $first-cutoff + $first-invalid + $labels + $collected + $coverage + $annotations) + (switch $first-invalid + (((Some $invalid) + (_fuzz-case-from-normalized + $invalid + $state + $results + $steps)) + (None + (_fuzz-finish-valid-classification + $quantifier + $state + $results + $steps))))) + ($bad-state + (_fuzz-synthetic-case + Invalid + InvalidClassificationState + (Value $bad-state) + $state + $results + $steps))))) + +(= (_fuzz-initial-classification $outcome-status) + (if (== $outcome-status Completed) + (PropertyClassification + 0 None None None None () () () ()) + (if (== $outcome-status ResourceLimit) + (PropertyClassification + 0 + None + None + (Some + (NormalizedProperty + Cutoff ResourceLimit () () () () ())) + None + () + () + () + ()) + (if (== $outcome-status StackOverflow) + (PropertyClassification + 0 + None + None + (Some + (NormalizedProperty + Cutoff StackOverflow () () () () ())) + None + () + () + () + ()) + (PropertyClassification + 0 + None + None + None + (Some + (NormalizedProperty + Invalid + InvalidEvaluatorStatus + (Status $outcome-status) + () + () + () + ())) + () + () + () + ()))))) + +(= (_fuzz-classify-property-results + $quantifier + $results + $steps + $outcome-status) + (if (== $results ()) + (let $state (_fuzz-initial-classification $outcome-status) + (_fuzz-synthetic-case + Invalid + NoPropertyResult + () + $state + $results + $steps)) + (let* (($initial + (_fuzz-initial-classification $outcome-status)) + ($classified + (_fuzz-classify-results-loop + $results + $initial))) + (_fuzz-finish-property-classification + $quantifier + $classified + $results + $steps)))) + +(= (_fuzz-evaluate-property + $property + $quantifier + $value + $maximum-steps + $maximum-depth + $effect-policy) + (let $resolved-policy $effect-policy + (let $outcome + (_fuzz-eval-case + ($property $value) + $maximum-steps + $maximum-depth + $resolved-policy) + (switch $outcome + (((FuzzCaseOutcome Completed $results $steps) + (_fuzz-classify-property-results + $quantifier + $results + $steps + Completed)) + ((FuzzCaseOutcome ResourceLimit $results $steps) + (_fuzz-classify-property-results + $quantifier + $results + $steps + ResourceLimit)) + ((FuzzCaseOutcome StackOverflow $results $steps) + (_fuzz-classify-property-results + $quantifier + $results + $steps + StackOverflow)) + ((FuzzCaseOutcome + (EffectDenied $effect $operation) + $results + $steps) + (let $state + (PropertyClassification + 0 None None None None () () () ()) + (_fuzz-synthetic-case + HostFault + EffectDenied + ((Effect $effect) (Operation $operation)) + $state + $results + $steps))) + ($bad + (let $state + (PropertyClassification + 0 None None None None () () () ()) + (_fuzz-synthetic-case + Invalid + InvalidEvaluatorOutcome + (Value $bad) + $state + () + 0)))))))) diff --git a/packages/fuzz/src/metta/40-runner.metta b/packages/fuzz/src/metta/40-runner.metta new file mode 100644 index 0000000..cfc48ef --- /dev/null +++ b/packages/fuzz/src/metta/40-runner.metta @@ -0,0 +1,1750 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +(= (_fuzz-default-config-data) + (FuzzConfig + (Runs 100) + (Seed 0) + (MaxSize 100) + (MaxDiscards 1000) + (MaxShrinks 1000) + (MaxShrinkImprovements 1000) + (CaseSteps 100000) + (CaseDepth 1000) + (EffectPolicy Sandboxed) + (EdgeCases 16) + ; A safety bound on exhaustive mode, sized against what a case actually costs. One case is + ; milliseconds of interpretation here, measured at roughly 7ms for a scalar generator and 18ms for a + ; list of forty, so a bound of 10000 meant a domain that cannot fit ground for three minutes before + ; saying so. A thousand keeps that under half a minute. A domain larger than this is still coverable, + ; by asking for it: the run reports EnumerationLimit rather than pretending to have covered it. + (MaxEnumerated 1000) + (FailureMode SameFailureTag))) + +(= (fuzz-default-config) + (_fuzz-default-config-data)) + +(= (_fuzz-config-option-name $option) + (switch $option + (((Runs $value) Runs) + ((Seed $value) Seed) + ((MaxSize $value) MaxSize) + ((MaxDiscards $value) MaxDiscards) + ((MaxShrinks $value) MaxShrinks) + ((MaxShrinkImprovements $value) MaxShrinkImprovements) + ((CaseSteps $value) CaseSteps) + ((CaseDepth $value) CaseDepth) + ((EffectPolicy $value) EffectPolicy) + ((EdgeCases $value) EdgeCases) + ((MaxEnumerated $value) MaxEnumerated) + ((FailureMode $value) FailureMode) + ($bad (InvalidOption $bad))))) + +(= (_fuzz-valid-nonnegative-integer $value) + (and (_fuzz-is-integer $value) (>= $value 0))) + +(= (_fuzz-valid-positive-integer $value) + (and (_fuzz-is-integer $value) (> $value 0))) + +(= (_fuzz-config-values $config) + (switch $config + (((FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzConfigValues + $runs + $seed + $maximum-size + $maximum-discards + $maximum-shrinks + $maximum-improvements + $case-steps + $case-depth + $effect-policy + $edge-cases + $maximum-enumerated + $failure-mode)) + ($bad + (FuzzInvalid InvalidConfig (MalformedConfig $bad)))))) + +(= (_fuzz-config-set $option $config) + (let $values (_fuzz-config-values $config) + (switch $values + (((FuzzConfigValues + $runs + $seed + $maximum-size + $maximum-discards + $maximum-shrinks + $maximum-improvements + $case-steps + $case-depth + $effect-policy + $edge-cases + $maximum-enumerated + $failure-mode) + (switch $option + (((Runs $value) + (if (_fuzz-valid-positive-integer $value) + (FuzzConfig + (Runs $value) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidRuns (Runs $value))))) + ((Seed $value) + (if (_fuzz-is-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $value) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidSeed (Seed $value))))) + ((MaxSize $value) + (if (_fuzz-valid-nonnegative-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $value) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidMaxSize (MaxSize $value))))) + ((MaxDiscards $value) + (if (_fuzz-valid-nonnegative-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $value) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidMaxDiscards (MaxDiscards $value))))) + ((MaxShrinks $value) + (if (_fuzz-valid-nonnegative-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $value) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidMaxShrinks (MaxShrinks $value))))) + ((MaxShrinkImprovements $value) + (if (_fuzz-valid-nonnegative-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $value) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidMaxShrinkImprovements + (MaxShrinkImprovements $value))))) + ((CaseSteps $value) + (if (_fuzz-valid-nonnegative-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $value) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidCaseSteps (CaseSteps $value))))) + ((CaseDepth $value) + (if (_fuzz-valid-nonnegative-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $value) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidCaseDepth (CaseDepth $value))))) + ((EffectPolicy $value) + (if (or + (== $value Sandboxed) + (== $value ExternalEffects)) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $value) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidEffectPolicy (EffectPolicy $value))))) + ((EdgeCases $value) + (if (_fuzz-valid-nonnegative-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $value) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidEdgeCases (EdgeCases $value))))) + ((MaxEnumerated $value) + (if (_fuzz-valid-positive-integer $value) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $value) + (FailureMode $failure-mode)) + (FuzzInvalid + InvalidConfig + (InvalidMaxEnumerated (MaxEnumerated $value))))) + ((FailureMode $value) + (if (or + (== $value SameFailureTag) + (== $value AnyFailure)) + (FuzzConfig + (Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $value)) + (FuzzInvalid + InvalidConfig + (InvalidFailureMode (FailureMode $value))))) + ($bad + (FuzzInvalid InvalidConfig (UnknownOption $bad)))))) + ((FuzzInvalid $code $details) $values) + ($bad + (FuzzInvalid InvalidConfig (MalformedConfigValues $bad))))))) + +(= (_fuzz-config-options $options $config $seen) + (if (== $options ()) + $config + (let* ((($option $tail) (decons-atom $options)) + ($name (_fuzz-config-option-name $option))) + (switch $name + (((InvalidOption $bad) + (FuzzInvalid InvalidConfig (UnknownOption $bad))) + ($valid-name + (if (is-member $valid-name $seen) + (FuzzInvalid InvalidConfig (DuplicateOption $valid-name)) + (let $next (_fuzz-config-set $option $config) + (switch $next + (((FuzzInvalid $code $details) $next) + ($valid-config + (_fuzz-config-options + $tail + $valid-config + (append + $seen + (cons-atom $valid-name ())))))))))))))) + +(= (_fuzz-build-config $options) + (_fuzz-config-options + $options + (_fuzz-default-config-data) + ())) + +(= (fuzz-config) + (_fuzz-build-config ())) + +(= (fuzz-config $a) + (_fuzz-build-config ($a))) + +(= (fuzz-config $a $b) + (_fuzz-build-config ($a $b))) + +(= (fuzz-config $a $b $c) + (_fuzz-build-config ($a $b $c))) + +(= (fuzz-config $a $b $c $d) + (_fuzz-build-config ($a $b $c $d))) + +(= (fuzz-config $a $b $c $d $e) + (_fuzz-build-config ($a $b $c $d $e))) + +(= (fuzz-config $a $b $c $d $e $f) + (_fuzz-build-config ($a $b $c $d $e $f))) + +(= (fuzz-config $a $b $c $d $e $f $g) + (_fuzz-build-config ($a $b $c $d $e $f $g))) + +(= (fuzz-config $a $b $c $d $e $f $g $h) + (_fuzz-build-config ($a $b $c $d $e $f $g $h))) + +(= (fuzz-config $a $b $c $d $e $f $g $h $i) + (_fuzz-build-config ($a $b $c $d $e $f $g $h $i))) + +(= (fuzz-config $a $b $c $d $e $f $g $h $i $j) + (_fuzz-build-config ($a $b $c $d $e $f $g $h $i $j))) + +(= (fuzz-config $a $b $c $d $e $f $g $h $i $j $k) + (_fuzz-build-config ($a $b $c $d $e $f $g $h $i $j $k))) + +(= (fuzz-config $a $b $c $d $e $f $g $h $i $j $k $l) + (_fuzz-build-config ($a $b $c $d $e $f $g $h $i $j $k $l))) + +(= (_fuzz-config-get $name $config) + (let $values (_fuzz-config-values $config) + (switch $values + (((FuzzConfigValues + $runs + $seed + $maximum-size + $maximum-discards + $maximum-shrinks + $maximum-improvements + $case-steps + $case-depth + $effect-policy + $edge-cases + $maximum-enumerated + $failure-mode) + (switch $name + ((Runs $runs) + (Seed $seed) + (MaxSize $maximum-size) + (MaxDiscards $maximum-discards) + (MaxShrinks $maximum-shrinks) + (MaxShrinkImprovements $maximum-improvements) + (CaseSteps $case-steps) + (CaseDepth $case-depth) + (EffectPolicy $effect-policy) + (EdgeCases $edge-cases) + (MaxEnumerated $maximum-enumerated) + (FailureMode $failure-mode) + ($bad (FuzzInvalid InvalidConfig (UnknownConfigField $bad)))))) + ((FuzzInvalid $code $details) $values) + ($bad + (FuzzInvalid InvalidConfig (MalformedConfigValues $bad))))))) + +(= (_fuzz-validate-config $config) + (let $values (_fuzz-config-values $config) + (switch $values + (((FuzzConfigValues + $runs + $seed + $maximum-size + $maximum-discards + $maximum-shrinks + $maximum-improvements + $case-steps + $case-depth + $effect-policy + $edge-cases + $maximum-enumerated + $failure-mode) + $config) + ((FuzzInvalid $code $details) $values) + ($bad + (FuzzInvalid InvalidConfig (MalformedConfigValues $bad))))))) + +(= (_fuzz-resolve-property-function $property) + (switch $property + (((FuzzPropertyFunction All $function) + (ResolvedProperty All $function)) + ((FuzzPropertyFunction Any $function) + (ResolvedProperty Any $function)) + ((FuzzPropertyFunction Default $function) + (ResolvedProperty Default $function)) + ($function + (ResolvedProperty Default $function))))) + +(= (_fuzz-validate-property-signature $property) + (let $type (get-type $property) + (if (== $type (-> Atom FuzzProperty)) + ValidPropertySignature + (FuzzInvalid + MissingPropertySignature + (Property $property) + (Expected (-> Atom FuzzProperty)))))) + +(= (_fuzz-count-one $item $counts) + (if (== $counts ()) + (cons-atom (FuzzCount $item 1) ()) + (let* ((($entry $tail) (decons-atom $counts))) + (switch $entry + (((FuzzCount $seen $count) + (if (== $item $seen) + (cons-atom + (FuzzCount $seen (+ $count 1)) + $tail) + (cons-atom + $entry + (_fuzz-count-one $item $tail)))) + ($bad + (cons-atom + $entry + (_fuzz-count-one $item $tail)))))))) + +(= (_fuzz-count-all $items $counts) + (if (== $items ()) + $counts + (let* ((($item $tail) (decons-atom $items)) + ($next (_fuzz-count-one $item $counts))) + (_fuzz-count-all $tail $next)))) + +(= (_fuzz-coverage-one + $minimum-percent + $label + $hit + $counts) + (if (== $counts ()) + (let $hits (if $hit 1 0) + (cons-atom + (CoverageCount $minimum-percent $label $hits 1) + ())) + (let* ((($entry $tail) (decons-atom $counts))) + (switch $entry + (((CoverageCount + $seen-minimum + $seen-label + $hits + $total) + (if (== $label $seen-label) + (let* (($next-minimum + (max $minimum-percent $seen-minimum)) + ($next-hits + (if $hit (+ $hits 1) $hits))) + (cons-atom + (CoverageCount + $next-minimum + $seen-label + $next-hits + (+ $total 1)) + $tail)) + (cons-atom + $entry + (_fuzz-coverage-one + $minimum-percent + $label + $hit + $tail)))) + ($bad + (cons-atom + $entry + (_fuzz-coverage-one + $minimum-percent + $label + $hit + $tail)))))))) + +(= (_fuzz-coverage-all $observations $counts) + (if (== $observations ()) + $counts + (let* ((($observation $tail) + (decons-atom $observations))) + (switch $observation + (((CoverageObservation + $minimum-percent + $label + $hit) + (_fuzz-coverage-all + $tail + (_fuzz-coverage-one + $minimum-percent + $label + $hit + $counts))) + ($bad + (_fuzz-coverage-all $tail $counts))))))) + +(= (_fuzz-initial-run-state) + (FuzzRunState + 0 0 0 0 0 0 0 () () ())) + +(= (_fuzz-state-attempt $phase $state) + (switch $state + (((FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (FuzzRunState + $passed + $property-discards + $generation-discards + (if (== $phase Regression) + (+ $regressions 1) + $regressions) + (if (== $phase Example) + (+ $examples 1) + $examples) + (if (== $phase Edge) + (+ $edges 1) + $edges) + (if (== $phase Random) + (+ $random 1) + $random) + $labels + $collected + $coverage)) + ($bad $bad)))) + +(= (_fuzz-state-pass $case $state) + (switch $case + (((FuzzCaseResult + Pass + $tag + $details + (Labels $new-labels) + (Collected $new-collected) + (Coverage $new-coverage) + $annotations + $results + $steps) + (switch $state + (((FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (FuzzRunState + (+ $passed 1) + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + (_fuzz-count-all $new-labels $labels) + (_fuzz-count-all $new-collected $collected) + (_fuzz-coverage-all $new-coverage $coverage))) + ($bad-state $bad-state)))) + ($bad-case $state)))) + +(= (_fuzz-state-property-discard $state) + (switch $state + (((FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (FuzzRunState + $passed + (+ $property-discards 1) + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage)) + ($bad $bad)))) + +(= (_fuzz-state-generation-discard $state) + (switch $state + (((FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (FuzzRunState + $passed + $property-discards + (+ $generation-discards 1) + $regressions + $examples + $edges + $random + $labels + $collected + $coverage)) + ($bad $bad)))) + +(= (_fuzz-run-statistics $state) + (switch $state + (((FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (FuzzStatistics + (Counts + (Passed $passed) + (PropertyDiscards $property-discards) + (GenerationDiscards $generation-discards) + (Regressions $regressions) + (Examples $examples) + (Edges $edges) + (Random $random)) + (Labels $labels) + (Collected $collected) + (Coverage $coverage))) + ($bad + (FuzzStatistics + (InvalidRunState $bad) + (Labels ()) + (Collected ()) + (Coverage ())))))) + +(= (_fuzz-discard-limit-exceeded $config $state) + (switch $state + (((FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (let $limit (_fuzz-config-get MaxDiscards $config) + (> (+ $property-discards $generation-discards) $limit))) + ($bad True)))) + +(= (_fuzz-first-insufficient-coverage $coverage) + (if (== $coverage ()) + None + (let* ((($entry $tail) (decons-atom $coverage))) + (switch $entry + (((CoverageCount + $minimum-percent + $label + $hits + $total) + (if (< (* $hits 100) (* $minimum-percent $total)) + (Some $entry) + (_fuzz-first-insufficient-coverage $tail))) + ($bad + (_fuzz-first-insufficient-coverage $tail))))))) + +(= (_fuzz-finish-run $property-id $config $state) + (switch $state + (((FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (let $insufficient + (_fuzz-first-insufficient-coverage $coverage) + (switch $insufficient + (((Some + (CoverageCount + $minimum-percent + $label + $hits + $total)) + (FuzzInsufficientCoverage + (Property $property-id) + (Requirement + $label + (MinimumPercent $minimum-percent) + (Hits $hits) + (Total $total)) + (_fuzz-run-statistics $state))) + (None + (FuzzPassed + (Property $property-id) + (Seed (_fuzz-config-get Seed $config)) + (_fuzz-run-statistics $state))))))) + ($bad + (FuzzInvalid InvalidRunState (State $bad)))))) + +(= (_fuzz-failure-signature $tag) + (_fuzz-atom-key AlphaReplay (PropertyFailure $tag))) + +(= (_fuzz-failed + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state) + (_fuzz-finalize-failure + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state)) + +(= (_fuzz-invalid-case + $property-id + $phase + $case-index + $case + $state) + (switch $case + (((FuzzCaseResult + Invalid + $tag + $details + $labels + $collected + $coverage + $annotations + $results + $steps) + (FuzzInvalid + $tag + (Property $property-id) + (Phase $phase) + (CaseIndex $case-index) + $details + $results + (_fuzz-run-statistics $state))) + ($bad + (FuzzInvalid + InvalidCase + (Property $property-id) + (Case $bad)))))) + +(= (_fuzz-cutoff + $property-id + $phase + $case-index + $case + $state) + (switch $case + (((FuzzCaseResult + Cutoff + $tag + $details + $labels + $collected + $coverage + $annotations + $results + $steps) + (FuzzCutoff + (Property $property-id) + (Phase $phase) + (CaseIndex $case-index) + (CutoffTag $tag) + $details + $results + (_fuzz-run-statistics $state))) + ($bad + (FuzzInvalid + InvalidCutoffCase + (Property $property-id) + (Case $bad)))))) + +(= (_fuzz-host-fault + $property-id + $phase + $case-index + $case + $state) + (switch $case + (((FuzzCaseResult + HostFault + $tag + $details + $labels + $collected + $coverage + $annotations + $results + $steps) + (FuzzHostFault + (Property $property-id) + (Phase $phase) + (CaseIndex $case-index) + (FaultTag $tag) + $details + $results + (_fuzz-run-statistics $state))) + ($bad + (FuzzInvalid + InvalidHostFaultCase + (Property $property-id) + (Case $bad)))))) + +(= (_fuzz-handle-case + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $discard-policy) + (switch $case + (((FuzzCaseResult Pass $tag $details $labels $collected $coverage $annotations $results $steps) + (FuzzContinue Pass (_fuzz-state-pass $case $state))) + ((FuzzCaseResult Discard $tag $details $labels $collected $coverage $annotations $results $steps) + (if (== $discard-policy Reject) + (FuzzInvalid + ConcreteCaseDiscarded + (Property $property-id) + (Phase $phase) + (CaseIndex $case-index) + $details) + (let $next (_fuzz-state-property-discard $state) + (if (_fuzz-discard-limit-exceeded $config $next) + (FuzzGaveUp + (Property $property-id) + PropertyDiscards + (_fuzz-run-statistics $next)) + (FuzzContinue Discard $next))))) + ((FuzzCaseResult Fail $tag $details $labels $collected $coverage $annotations $results $steps) + (_fuzz-failed + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state)) + ((FuzzCaseResult Invalid $tag $details $labels $collected $coverage $annotations $results $steps) + (_fuzz-invalid-case + $property-id $phase $case-index $case $state)) + ((FuzzCaseResult Cutoff $tag $details $labels $collected $coverage $annotations $results $steps) + (_fuzz-cutoff + $property-id $phase $case-index $case $state)) + ((FuzzCaseResult HostFault $tag $details $labels $collected $coverage $annotations $results $steps) + (_fuzz-host-fault + $property-id $phase $case-index $case $state)) + ($bad + (FuzzInvalid + MalformedCaseResult + (Property $property-id) + (Case $bad)))))) + +(= (_fuzz-map-regressions $entries $index) + (if (== $entries ()) + () + (let* ((($entry $tail) (decons-atom $entries)) + ($rest + (_fuzz-map-regressions + $tail + (+ $index 1)))) + (switch $entry + (((FuzzRegression $value $replay) + (cons-atom + (FuzzConcrete + Regression + $index + $value + $replay) + $rest)) + ($bad + (cons-atom + (FuzzConcrete + Regression + $index + (MalformedRegression $bad) + None) + $rest))))))) + +(= (_fuzz-map-examples $entries $index) + (if (== $entries ()) + () + (let* ((($entry $tail) (decons-atom $entries)) + ($rest + (_fuzz-map-examples + $tail + (+ $index 1)))) + (switch $entry + (((FuzzExample $value) + (cons-atom + (FuzzConcrete Example $index $value None) + $rest)) + ($bad + (cons-atom + (FuzzConcrete + Example + $index + (MalformedExample $bad) + None) + $rest))))))) + +(= (_fuzz-run-concrete + $remaining + $property-id + $generator + $property + $quantifier + $config + $state) + (if (== $remaining ()) + (_fuzz-run-edges + 0 + (_fuzz-config-get EdgeCases $config) + () + $property-id + $generator + $property + $quantifier + $config + $state) + (let* ((($entry $tail) (decons-atom $remaining))) + (switch $entry + (((FuzzConcrete + $phase + $index + $value + $replay) + (let* (($attempted + (_fuzz-state-attempt $phase $state)) + ($case + (_fuzz-evaluate-property + $property + $quantifier + $value + (_fuzz-config-get CaseSteps $config) + (_fuzz-config-get CaseDepth $config) + (_fuzz-config-get + EffectPolicy + $config))) + ($handled + (_fuzz-handle-case + $property-id + $generator + $property + $quantifier + $phase + $index + (Concrete (Replay $replay)) + 0 + $value + None + $case + $config + $attempted + Reject))) + (switch $handled + (((FuzzContinue Pass $next-state) + (_fuzz-run-concrete + $tail + $property-id + $generator + $property + $quantifier + $config + $next-state)) + ($result $result))))) + ($bad + (FuzzInvalid + MalformedConcreteCase + (Property $property-id) + (Case $bad)))))))) + +(= (_fuzz-generation-discard + $property-id + $config + $state) + (let $next (_fuzz-state-generation-discard $state) + (if (_fuzz-discard-limit-exceeded $config $next) + (FuzzGaveUp + (Property $property-id) + GenerationDiscards + (_fuzz-run-statistics $next)) + (FuzzContinue GenerationDiscard $next)))) + +(= (_fuzz-run-edge-with-valid-key + $key + $value + $tree + $raw-index + $remaining + $seen + $property-id + $generator + $property + $quantifier + $config + $state) + (if (is-member $key $seen) + (_fuzz-run-edges + (+ $raw-index 1) + (- $remaining 1) + $seen + $property-id + $generator + $property + $quantifier + $config + $state) + (let* (($attempted + (_fuzz-state-attempt Edge $state)) + ($case + (_fuzz-evaluate-property + $property + $quantifier + $value + (_fuzz-config-get CaseSteps $config) + (_fuzz-config-get CaseDepth $config) + (_fuzz-config-get + EffectPolicy + $config))) + ($handled + (_fuzz-handle-case + $property-id + $generator + $property + $quantifier + Edge + $raw-index + (Edge (Index $raw-index)) + (_fuzz-config-get MaxSize $config) + $value + $tree + $case + $config + $attempted + Count))) + (switch $handled + (((FuzzContinue $status $next-state) + (_fuzz-run-edges + (+ $raw-index 1) + (- $remaining 1) + (append + $seen + (cons-atom $key ())) + $property-id + $generator + $property + $quantifier + $config + $next-state)) + ($result $result)))))) + +(= (_fuzz-run-edge-with-key + $key + $value + $tree + $raw-index + $remaining + $seen + $property-id + $generator + $property + $quantifier + $config + $state) + (switch $key + (((FuzzKernelError $code $details) + (FuzzInvalid + NonReplayableEdgeDecision + (Property $property-id) + (Phase Edge) + (ErrorCode $code) + $details)) + ($valid + (_fuzz-run-edge-with-valid-key + $valid + $value + $tree + $raw-index + $remaining + $seen + $property-id + $generator + $property + $quantifier + $config + $state))))) + +(= (_fuzz-run-edges + $raw-index + $remaining + $seen + $property-id + $generator + $property + $quantifier + $config + $state) + (if (<= $remaining 0) + (_fuzz-run-random + 0 + 0 + $property-id + $generator + $property + $quantifier + $config + $state) + (let $generated + (fuzz-generate-edge + $generator + $raw-index + (_fuzz-config-get MaxSize $config)) + (switch $generated + (((FuzzSample $value $driver $tree) + (let $key (_fuzz-atom-key Replay $tree) + (_fuzz-run-edge-with-key + $key + $value + $tree + $raw-index + $remaining + $seen + $property-id + $generator + $property + $quantifier + $config + $state))) + ((FuzzGenerationDiscard $reason $driver $tree) + (let* (($attempted + (_fuzz-state-attempt Edge $state)) + ($handled + (_fuzz-generation-discard + $property-id + $config + $attempted))) + (switch $handled + (((FuzzContinue + GenerationDiscard + $next-state) + (_fuzz-run-edges + (+ $raw-index 1) + (- $remaining 1) + $seen + $property-id + $generator + $property + $quantifier + $config + $next-state)) + ($result $result))))) + ((FuzzGenerationError $code $details) + (FuzzInvalid + GenerationError + (Property $property-id) + (Phase Edge) + (ErrorCode $code) + $details)) + ($bad + (FuzzInvalid + MalformedGenerationResult + (Property $property-id) + (Phase Edge) + (Value $bad)))))))) + +(= (_fuzz-size-for-case $case-index $maximum-size) + (% $case-index (+ $maximum-size 1))) + +(= (_fuzz-run-random + $attempt-index + $successful-random + $property-id + $generator + $property + $quantifier + $config + $state) + (if (>= $successful-random (_fuzz-config-get Runs $config)) + (_fuzz-finish-run $property-id $config $state) + (let* (($size + (_fuzz-size-for-case + $successful-random + (_fuzz-config-get MaxSize $config))) + ($seed + (+ (_fuzz-config-get Seed $config) + $attempt-index)) + ($generated + (fuzz-generate-random + $generator + $seed + $size))) + (switch $generated + (((FuzzSample $value $driver $tree) + (let* (($attempted + (_fuzz-state-attempt Random $state)) + ($case + (_fuzz-evaluate-property + $property + $quantifier + $value + (_fuzz-config-get CaseSteps $config) + (_fuzz-config-get CaseDepth $config) + (_fuzz-config-get + EffectPolicy + $config))) + ($handled + (_fuzz-handle-case + $property-id + $generator + $property + $quantifier + Random + $attempt-index + (Random + (Rng xorshift128plus-v1) + (Seed (_fuzz-config-get Seed $config)) + (Case $attempt-index) + (Size $size)) + $size + $value + $tree + $case + $config + $attempted + Count))) + (switch $handled + (((FuzzContinue Pass $next-state) + (_fuzz-run-random + (+ $attempt-index 1) + (+ $successful-random 1) + $property-id + $generator + $property + $quantifier + $config + $next-state)) + ((FuzzContinue Discard $next-state) + (_fuzz-run-random + (+ $attempt-index 1) + $successful-random + $property-id + $generator + $property + $quantifier + $config + $next-state)) + ($result $result))))) + ((FuzzGenerationDiscard $reason $driver $tree) + (let* (($attempted + (_fuzz-state-attempt Random $state)) + ($handled + (_fuzz-generation-discard + $property-id + $config + $attempted))) + (switch $handled + (((FuzzContinue + GenerationDiscard + $next-state) + (_fuzz-run-random + (+ $attempt-index 1) + $successful-random + $property-id + $generator + $property + $quantifier + $config + $next-state)) + ($result $result))))) + ((FuzzGenerationError $code $details) + (FuzzInvalid + GenerationError + (Property $property-id) + (Phase Random) + (ErrorCode $code) + $details)) + ($bad + (FuzzInvalid + MalformedGenerationResult + (Property $property-id) + (Phase Random) + (Value $bad)))))))) + +(= (_fuzz-start-run + $property-id + $generator + $property + $quantifier + $config) + (let* (($regressions + (collapse + (match &self + (FuzzRegression + $property-id + $value + $replay) + (FuzzRegression $value $replay)))) + ($examples + (collapse + (match &self + (FuzzExample $property-id $value) + (FuzzExample $value)))) + ($concrete + (append + (_fuzz-map-regressions $regressions 0) + (_fuzz-map-examples $examples 0)))) + (_fuzz-run-concrete + $concrete + $property-id + $generator + $property + $quantifier + $config + (_fuzz-initial-run-state)))) + +(= (fuzz-check $property-id $generator $property-function $config) + (_fuzz-check-with + $property-id + $generator + $property-function + $config + RandomPhases)) + +; Exhaustive mode makes a stronger claim than fuzz-check: every decision tree the generator +; accepts at size MaxSize passes the property. It walks the whole domain with the exhaustive +; cursor and skips the regression, example, edge, and random phases; pinned concrete cases +; belong to fuzz-check. +(= (fuzz-check-exhaustive $property-id $generator $property-function $config) + (_fuzz-check-with + $property-id + $generator + $property-function + $config + ExhaustiveDomain)) + +(= (_fuzz-check-with $property-id $generator $property-function $config $mode) + (switch $generator + (((FuzzGenerationError $code $details) + (FuzzInvalid + InvalidGenerator + (Property $property-id) + (ErrorCode $code) + $details)) + ($valid-generator + (let $validated-config (_fuzz-validate-config $config) + (switch $validated-config + (((FuzzInvalid $code $details) $validated-config) + ((FuzzInvalid $code $first $second) $validated-config) + ($valid-config + (let $resolved + (_fuzz-resolve-property-function + $property-function) + (switch $resolved + (((ResolvedProperty + $quantifier + $property) + (let $signature + (_fuzz-validate-property-signature + $property) + (switch $signature + ((ValidPropertySignature + (if (== $mode ExhaustiveDomain) + (_fuzz-start-exhaustive + $property-id + $valid-generator + $property + $quantifier + $valid-config) + (_fuzz-start-run + $property-id + $valid-generator + $property + $quantifier + $valid-config))) + ((FuzzInvalid $code $first $second) + $signature) + ((FuzzInvalid $code $details) + $signature) + ($bad-signature + (FuzzInvalid + InvalidPropertySignatureResult + (Property $property) + (Value $bad-signature))))))) + ($bad + (FuzzInvalid + InvalidPropertyFunction + (Property $property-id) + (Value $bad)))))))))))))) + +(= (_fuzz-start-exhaustive + $property-id + $generator + $property + $quantifier + $config) + (let $initial (_fuzz-initial-run-state) + (_fuzz-exhaustive-check-loop + (FuzzExhaustiveRun + $property-id + $generator + $property + $quantifier + $config + () + 0 + 0 + $initial)))) + +(= (_fuzz-exhaustive-check-loop $state) + (if (_fuzz-exhaustive-check-finished $state) + $state + (_fuzz-exhaustive-check-loop + (_fuzz-exhaustive-check-step $state)))) + +(= (_fuzz-exhaustive-check-finished $state) + (unify $state + (FuzzExhaustiveRun + $property-id $generator $property $quantifier $config + $plan $enumerated $accepted $run-state) + False + True)) + +; One cursor run per step. Generation discards are legitimate domain holes, so MaxDiscards +; does not apply to them here; MaxEnumerated caps every terminal attempt instead. +(= (_fuzz-exhaustive-check-step $state) + (unify $state + (FuzzExhaustiveRun + $property-id $generator $property $quantifier $config + $plan $enumerated $accepted $run-state) + (if (>= $enumerated (_fuzz-config-get MaxEnumerated $config)) + (FuzzGaveUp + (Property $property-id) + EnumerationLimit + (_fuzz-exhaustive-statistics $enumerated $accepted $run-state)) + (let* (($size (_fuzz-config-get MaxSize $config)) + ($driver (_fuzz-exhaustive-resume-driver $plan)) + ($generated (fuzz-generate $generator $driver $size))) + (switch $generated + (((FuzzSample + $value + (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames)) + $tree) + (_fuzz-exhaustive-check-case + $property-id $generator $property $quantifier $config + $frames $enumerated $accepted $run-state $value $tree $size)) + ((FuzzGenerationDiscard + $reason + (FuzzDriver Exhaustive (ExhaustiveCursor $choices $cursor $frames)) + $tree) + (_fuzz-exhaustive-check-advance + $property-id $generator $property $quantifier $config + $frames + (+ $enumerated 1) + $accepted + (_fuzz-state-generation-discard $run-state))) + ((FuzzGenerationError $code $details) + (FuzzInvalid + GenerationError + (Property $property-id) + (Phase Exhaustive) + (ErrorCode $code) + $details)) + ($bad + (FuzzInvalid + MalformedGenerationResult + (Property $property-id) + (Phase Exhaustive) + (Value $bad))))))) + (FuzzInvalid MalformedExhaustiveRunState (Value $state)))) + +; Every accepted tree is replayed before its property case counts: the tree must rebuild the +; same value through the replay driver, which is what licenses the final verified claim. +(= (_fuzz-exhaustive-check-case + $property-id $generator $property $quantifier $config + $frames $enumerated $accepted $run-state $value $tree $size) + (let $replayed (fuzz-replay $generator $tree $size) + (switch $replayed + (((FuzzSample $replay-value $replay-driver $replay-tree) + (if (_fuzz-replay-equal $value $replay-value) + (let* (($coordinates + (_fuzz-exhaustive-plan-prefix $frames ())) + ($attempted + (_fuzz-state-attempt Exhaustive $run-state)) + ($case + (_fuzz-evaluate-property + $property + $quantifier + $value + (_fuzz-config-get CaseSteps $config) + (_fuzz-config-get CaseDepth $config) + (_fuzz-config-get EffectPolicy $config))) + ($handled + (_fuzz-handle-case + $property-id + $generator + $property + $quantifier + Exhaustive + $enumerated + (Exhaustive + (Choices $coordinates) + (Case $enumerated) + (Size $size)) + $size + $value + $tree + $case + $config + $attempted + Count))) + (switch $handled + (((FuzzContinue Pass $next-state) + (_fuzz-exhaustive-check-advance + $property-id $generator $property $quantifier $config + $frames + (+ $enumerated 1) + (+ $accepted 1) + $next-state)) + ((FuzzContinue Discard $next-state) + (_fuzz-exhaustive-check-advance + $property-id $generator $property $quantifier $config + $frames + (+ $enumerated 1) + (+ $accepted 1) + $next-state)) + ($result $result)))) + (FuzzInvalid + ExhaustiveReplayMismatch + (Property $property-id) + (Value $value) + (ReplayedValue $replay-value)))) + ((FuzzGenerationError $code $details) + (FuzzInvalid + ExhaustiveReplayFailure + (Property $property-id) + (ErrorCode $code) + $details)) + ((FuzzGenerationDiscard $replay-reason $replay-driver $replay-tree) + (FuzzInvalid + ExhaustiveReplayDiscarded + (Property $property-id) + (Reason $replay-reason))) + ($bad + (FuzzInvalid + MalformedReplayResult + (Property $property-id) + (Value $bad))))))) + +(= (_fuzz-exhaustive-check-advance + $property-id $generator $property $quantifier $config + $frames $enumerated $accepted $run-state) + (let $advanced (_fuzz-exhaustive-next-plan $frames) + (switch $advanced + (((ExhaustivePlan $plan) + (FuzzExhaustiveRun + $property-id $generator $property $quantifier $config + $plan $enumerated $accepted $run-state)) + (ExhaustiveComplete + (_fuzz-finish-exhaustive + $property-id $enumerated $accepted $run-state)) + ($bad + (FuzzInvalid + ExhaustiveAdvanceFailure + (Property $property-id) + (Value $bad))))))) + +; Verified demands the full walk: a non-empty accepted domain, no property discards (those +; cases were never checked), and satisfied coverage requirements. Anything less is an +; explicit invalid or gave-up result, never a pass. +(= (_fuzz-finish-exhaustive $property-id $enumerated $accepted $run-state) + (if (== $accepted 0) + (let $statistics + (_fuzz-exhaustive-statistics $enumerated $accepted $run-state) + (FuzzInvalid + EmptyExhaustiveDomain + (Property $property-id) + $statistics)) + (unify $run-state + (FuzzRunState + $passed + $property-discards + $generation-discards + $regressions + $examples + $edges + $random + $labels + $collected + $coverage) + (let $statistics + (_fuzz-exhaustive-statistics $enumerated $accepted $run-state) + (if (> $property-discards 0) + (FuzzGaveUp + (Property $property-id) + ExhaustivePropertyDiscards + $statistics) + (let $insufficient + (_fuzz-first-insufficient-coverage $coverage) + (switch $insufficient + (((Some + (CoverageCount + $minimum-percent + $label + $hits + $total)) + (FuzzInsufficientCoverage + (Property $property-id) + (Requirement + $label + (MinimumPercent $minimum-percent) + (Hits $hits) + (Total $total)) + $statistics)) + (None + (FuzzExhaustivelyVerified + (Property $property-id) + (DomainCount $accepted) + (Enumerated $enumerated) + $statistics))))))) + (FuzzInvalid InvalidRunState (State $run-state))))) + +(= (_fuzz-exhaustive-statistics $enumerated $accepted $run-state) + (let $statistics (_fuzz-run-statistics $run-state) + (ExhaustiveStatistics + (Enumerated $enumerated) + (DomainCount $accepted) + $statistics))) diff --git a/packages/fuzz/src/metta/50-shrink.metta b/packages/fuzz/src/metta/50-shrink.metta new file mode 100644 index 0000000..7ecda01 --- /dev/null +++ b/packages/fuzz/src/metta/50-shrink.metta @@ -0,0 +1,619 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; List edits used by collection and child shrink passes. +(= (_fuzz-list-take-loop $values $remaining $reversed) + (if (or (<= $remaining 0) (== $values ())) + (reverse $reversed) + (let* ((($value $tail) (decons-atom $values))) + (_fuzz-list-take-loop + $tail + (- $remaining 1) + (cons-atom $value $reversed))))) + +(= (_fuzz-list-take $values $count) + (_fuzz-list-take-loop $values $count ())) + +(= (_fuzz-list-drop $values $count) + (if (or (<= $count 0) (== $values ())) + $values + (let* ((($value $tail) (decons-atom $values))) + (_fuzz-list-drop $tail (- $count 1))))) + +(= (_fuzz-list-remove-range $values $start $count) + (append + (_fuzz-list-take $values $start) + (_fuzz-list-drop $values (+ $start $count)))) + +(= (_fuzz-add-shrink-value $candidate $current $values) + (if (or + (== $candidate $current) + (is-member $candidate $values)) + $values + (append $values (cons-atom $candidate ())))) + +(= (_fuzz-halves $value) + (if (<= $value 0) + () + (let $next (trunc-math (/ $value 2)) + (cons-atom $value (_fuzz-halves $next))))) + +(= (_fuzz-int-midpoint-values + $current + $direction + $halves + $values) + (if (== $halves ()) + $values + (let* ((($half $tail) (decons-atom $halves)) + ($candidate + (- $current (* $direction $half))) + ($next + (_fuzz-add-shrink-value + $candidate + $current + $values))) + (_fuzz-int-midpoint-values + $current + $direction + $tail + $next)))) + +; A bound is a shrink candidate only when it sits strictly closer to the origin than the current +; value. The far-side bound is an anti-shrink: on the machine length decision it re-inflated an +; accepted (increment increment increment) counterexample back to six commands, because the lenient +; shrink replay filled the missing draws from each decision's origin and the longer run still failed. +(= (_fuzz-int-bound-candidate $bound $current $distance $origin $values) + (if (< (abs-math (- $bound $origin)) $distance) + (_fuzz-add-shrink-value $bound $current $values) + $values)) + +(= (_fuzz-int-value-candidates $current $lower $upper $origin) + (if (== $current $origin) + () + (let* (($distance (abs-math (- $current $origin))) + ($direction (if (> $current $origin) 1 -1)) + ($first-half (trunc-math (/ $distance 2))) + ($with-origin + (_fuzz-add-shrink-value + $origin + $current + ())) + ($with-midpoints + (_fuzz-int-midpoint-values + $current + $direction + (_fuzz-halves $first-half) + $with-origin)) + ($with-lower + (_fuzz-int-bound-candidate + $lower + $current + $distance + $origin + $with-midpoints))) + (_fuzz-int-bound-candidate + $upper + $current + $distance + $origin + $with-lower)))) + +(= (_fuzz-int-decision-candidates-loop + $values + $lower + $upper + $origin + $reversed) + (if (== $values ()) + (reverse $reversed) + (let* ((($value $tail) (decons-atom $values))) + (_fuzz-int-decision-candidates-loop + $tail + $lower + $upper + $origin + (cons-atom + (_fuzz-int-decision + $lower + $upper + $origin + $value) + $reversed))))) + +(= (_fuzz-int-decision-candidates $decision) + (switch $decision + (((Decision + Int + (Bounds $lower $upper) + (Origin $origin) + (Value $current) + ()) + (_fuzz-int-decision-candidates-loop + (_fuzz-int-value-candidates + $current + $lower + $upper + $origin) + $lower + $upper + $origin + ())) + ($bad ())))) + +(= (_fuzz-wrap-first-child-candidates + $kind + $metadata + $selection + $candidates + $tail + $reversed) + (if (== $candidates ()) + (reverse $reversed) + (let* ((($candidate $rest) (decons-atom $candidates)) + ($children (cons-atom $candidate $tail))) + (_fuzz-wrap-first-child-candidates + $kind + $metadata + $selection + $rest + $tail + (cons-atom + (Decision + $kind + $metadata + $selection + $children) + $reversed))))) + +(= (_fuzz-choice-root-candidates $decision) + (switch $decision + (((Decision $kind $metadata $selection $children) + (if (or + (== $kind Bool) + (or + (== $kind Element) + (or + (== $kind Frequency) + (== $kind Option)))) + (if (== $children ()) + () + (let* ((($choice $tail) (decons-atom $children))) + (_fuzz-wrap-first-child-candidates + $kind + $metadata + $selection + (_fuzz-int-decision-candidates $choice) + $tail + ()))) + ())) + ($bad ())))) + +; Lists remove the largest legal chunks first, then smaller chunks. +(= (_fuzz-list-removal-candidates-at + $minimum + $maximum + $length + $length-lower + $length-upper + $length-origin + $items + $chunk + $start + $reversed) + (if (>= $start $length) + (reverse $reversed) + (let* (($available (- $length $start)) + ($removed (min $chunk $available)) + ($new-length (- $length $removed)) + ($remaining + (_fuzz-list-remove-range + $items + $start + $removed)) + ($next-start (+ $start $chunk))) + (if (< $new-length $minimum) + (_fuzz-list-removal-candidates-at + $minimum + $maximum + $length + $length-lower + $length-upper + $length-origin + $items + $chunk + $next-start + $reversed) + (let* (($length-decision + (_fuzz-int-decision + $length-lower + $length-upper + $length-origin + $new-length)) + ($children + (cons-atom + $length-decision + $remaining)) + ($candidate + (Decision + List + (Bounds $minimum $maximum) + (Length $new-length) + $children))) + (_fuzz-list-removal-candidates-at + $minimum + $maximum + $length + $length-lower + $length-upper + $length-origin + $items + $chunk + $next-start + (cons-atom $candidate $reversed))))))) + +(= (_fuzz-list-removal-candidates-sizes + $minimum + $maximum + $length + $length-lower + $length-upper + $length-origin + $items + $sizes + $candidates) + (if (== $sizes ()) + $candidates + (let* ((($chunk $tail) (decons-atom $sizes)) + ($for-size + (_fuzz-list-removal-candidates-at + $minimum + $maximum + $length + $length-lower + $length-upper + $length-origin + $items + $chunk + 0 + ()))) + (_fuzz-list-removal-candidates-sizes + $minimum + $maximum + $length + $length-lower + $length-upper + $length-origin + $items + $tail + (append $candidates $for-size))))) + +(= (_fuzz-list-root-candidates $decision) + (switch $decision + (((Decision + List + (Bounds $minimum $maximum) + (Length $length) + $children) + (if (== $children ()) + () + (let* ((($length-decision $items) + (decons-atom $children))) + (switch $length-decision + (((Decision + Int + (Bounds $length-lower $length-upper) + (Origin $length-origin) + (Value $seen-length) + ()) + (if (and + (== $length $seen-length) + (> $length $minimum)) + (_fuzz-list-removal-candidates-sizes + $minimum + $maximum + $length + $length-lower + $length-upper + $length-origin + $items + (_fuzz-halves (- $length $minimum)) + ()) + ())) + ($bad ())))))) + ($bad ())))) + +(= (_fuzz-generic-removal-candidates-at + $kind + $metadata + $selection + $children + $length + $chunk + $start + $reversed) + (if (>= $start $length) + (reverse $reversed) + (let* (($available (- $length $start)) + ($removed (min $chunk $available)) + ($remaining + (_fuzz-list-remove-range + $children + $start + $removed)) + ($candidate + (Decision + $kind + $metadata + $selection + $remaining))) + (_fuzz-generic-removal-candidates-at + $kind + $metadata + $selection + $children + $length + $chunk + (+ $start $chunk) + (cons-atom $candidate $reversed))))) + +(= (_fuzz-generic-removal-candidates-sizes + $kind + $metadata + $selection + $children + $length + $sizes + $candidates) + (if (== $sizes ()) + $candidates + (let* ((($chunk $tail) (decons-atom $sizes)) + ($for-size + (_fuzz-generic-removal-candidates-at + $kind + $metadata + $selection + $children + $length + $chunk + 0 + ()))) + (_fuzz-generic-removal-candidates-sizes + $kind + $metadata + $selection + $children + $length + $tail + (append $candidates $for-size))))) + +(= (_fuzz-collection-root-candidates $decision) + (let $lists (_fuzz-list-root-candidates $decision) + (if (== $lists ()) + (switch $decision + (((Decision + Filter + $metadata + $selection + $children) + (let $count (length $children) + (if (> $count 0) + (_fuzz-generic-removal-candidates-sizes + Filter + $metadata + $selection + $children + $count + (_fuzz-halves $count) + ()) + ()))) + ((Decision + Recursive + $metadata + $selection + $children) + (if (> (length $children) 0) + (cons-atom + (Decision + Recursive + $metadata + $selection + ()) + ()) + ())) + ($bad ()))) + $lists))) + +(= (_fuzz-numeric-root-candidates $decision) + (_fuzz-int-decision-candidates $decision)) + +(= (_fuzz-wrap-child-candidates + $kind + $metadata + $selection + $prefix + $tail + $candidates + $reversed) + (if (== $candidates ()) + (reverse $reversed) + (let* ((($candidate $rest) + (decons-atom $candidates)) + ($children + (append + $prefix + (cons-atom $candidate $tail)))) + (_fuzz-wrap-child-candidates + $kind + $metadata + $selection + $prefix + $tail + $rest + (cons-atom + (Decision + $kind + $metadata + $selection + $children) + $reversed))))) + +(= (_fuzz-child-shrink-candidates-loop + $kind + $metadata + $selection + $remaining + $prefix + $candidates) + (if (== $remaining ()) + $candidates + (let ($child $tail) (decons-atom $remaining) + (let $root-candidates + (_fuzz-built-in-root-candidates $child) + (let $nested-candidates + (switch $child + (((Decision + $child-kind + $child-metadata + $child-selection + $child-children) + (_fuzz-child-shrink-candidates-loop + $child-kind + $child-metadata + $child-selection + $child-children + () + ())) + ($bad ()))) + (let $custom-candidates + (_fuzz-custom-root-candidates $child) + (let $child-candidates + (_fuzz-deduplicate-trees + (append + $root-candidates + (append + $custom-candidates + $nested-candidates))) + (let $wrapped + (_fuzz-wrap-child-candidates + $kind + $metadata + $selection + $prefix + $tail + $child-candidates + ()) + (_fuzz-child-shrink-candidates-loop + $kind + $metadata + $selection + $tail + (append + $prefix + (cons-atom $child ())) + (append $candidates $wrapped)))))))))) + +(= (_fuzz-child-shrink-candidates $decision) + (switch $decision + (((Decision $kind $metadata $selection $children) + (_fuzz-child-shrink-candidates-loop + $kind + $metadata + $selection + $children + () + ())) + ($bad ())))) + +(= (_fuzz-valid-custom-shrink-candidates + $results + $name + $arguments + $candidates) + (if (== $results ()) + $candidates + (let* ((($result $tail) (decons-atom $results)) + ($next + (switch $result + (((Decision + Custom + (CustomGenerator + (Name $name) + (Arguments $arguments)) + $selection + $children) + (append + $candidates + (cons-atom $result ()))) + ($bad $candidates))))) + (_fuzz-valid-custom-shrink-candidates + $tail + $name + $arguments + $next)))) + +(= (_fuzz-custom-root-candidates $decision) + (switch $decision + (((Decision + Custom + (CustomGenerator + (Name $name) + (Arguments $arguments)) + $selection + $children) + (let $results + (collapse + (ShrinkChoices + $name + $arguments + $decision)) + (_fuzz-valid-custom-shrink-candidates + $results + $name + $arguments + ()))) + ($bad ())))) + +(= (_fuzz-deduplicate-trees $trees) + (_fuzz-deduplicate-replay $trees)) + +(= (_fuzz-built-in-root-candidates $decision) + (let $collections + (_fuzz-collection-root-candidates $decision) + (let $choices + (_fuzz-choice-root-candidates $decision) + (let $numeric + (_fuzz-numeric-root-candidates $decision) + (append + $collections + (append $choices $numeric)))))) + +; The output order is the public shrink relation. +(= (_fuzz-shrink-candidates $decision) + (switch $decision + (((Decision + Int + (Bounds $lower $upper) + (Origin $origin) + (Value $value) + ()) + (_fuzz-deduplicate-trees + (_fuzz-int-decision-candidates $decision))) + ((Decision $kind $metadata $selection $children) + (let $root-candidates + (_fuzz-built-in-root-candidates $decision) + (let $custom-candidates + (_fuzz-custom-root-candidates $decision) + (let $child-candidates + (_fuzz-child-shrink-candidates $decision) + ; Custom root candidates come before child descent: a custom hook's structural + ; reductions (removing machine commands, dropping branches) shrink faster than + ; simplifying values inside a structure that is about to disappear. + (_fuzz-deduplicate-trees + (append + $root-candidates + (append + $custom-candidates + $child-candidates))))))) + ($bad ())))) diff --git a/packages/fuzz/src/metta/60-grammar.metta b/packages/fuzz/src/metta/60-grammar.metta new file mode 100644 index 0000000..dfb10e5 --- /dev/null +++ b/packages/fuzz/src/metta/60-grammar.metta @@ -0,0 +1,3180 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; A grammar is an ordinary atom in &self: +; (FuzzGrammar name (Productions ((Production weight target template) ...))) + +; `switch` evaluates its subject. Grammar templates are source atoms, so use `unify` to inspect them +; without firing user rules whose heads happen to occur in generated syntax. +(= (_fuzz-grammar-template-switch + $atom + $cases) + (if-decons-expr + $cases + $case + $tail + (unify + $case + ($pattern $template) + (unify + $atom + $pattern + $template + (_fuzz-grammar-template-switch + $atom + $tail)) + (_fuzz-generation-error + MalformedGrammarTemplateCase + (Case $case))) + Empty)) + +(= (_fuzz-grammar-generator-validation-tasks + $remaining + $tasks) + (if (== $remaining ()) + $tasks + (let* ((($generator $tail) + (decons-atom $remaining)) + ($next + (cons-atom + (GrammarGeneratorValidationTask + $generator) + $tasks))) + (_fuzz-grammar-generator-validation-tasks + $tail + $next)))) + +(= (_fuzz-grammar-generator-child-task + $child + $tasks) + (cons-atom + (GrammarGeneratorValidationTask $child) + $tasks)) + +(= (_fuzz-grammar-frequency-validation + $remaining + $tasks + $total) + (if (== $remaining ()) + (ValidatedGrammarFrequency + $tasks + $total) + (let* ((($entry $tail) + (decons-atom $remaining))) + (_fuzz-grammar-template-switch $entry + ((($weight $generator) + (if (_fuzz-is-integer $weight) + (if (> $weight 0) + (_fuzz-grammar-frequency-validation + $tail + (_fuzz-grammar-generator-child-task + $generator + $tasks) + (+ $total $weight)) + (_fuzz-generation-error + InvalidFrequencyWeight + (Weight $weight) + (Generator $generator))) + (_fuzz-expected-integer + FrequencyWeight + $weight))) + ($bad + (_fuzz-generation-error + MalformedFrequencyEntry + (Entry $bad)))))))) + +(= (_fuzz-grammar-validate-int-generator + $lower + $upper + $origin + $tasks) + (let $validated + (gen-int-origin + $lower + $upper + $origin) + (switch $validated + (((GenInt + $seen-lower + $seen-upper + $seen-origin) + (_fuzz-validate-grammar-field-generator-loop + $tasks)) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldGenerator + (Generator + (GenInt + $lower + $upper + $origin)))))))) + +(= (_fuzz-grammar-validate-float-generator + $lower + $upper + $origin + $tasks) + (if (_fuzz-is-integer $lower) + (if (_fuzz-is-integer $upper) + (if (_fuzz-is-integer $origin) + (if (and + (<= -9218868437227405312 $lower) + (and + (<= $lower $origin) + (and + (<= $origin $upper) + (<= $upper + 9218868437227405311)))) + (_fuzz-validate-grammar-field-generator-loop + $tasks) + (_fuzz-generation-error + InvalidFloatBounds + (IndexBounds + $lower + $upper + $origin))) + (_fuzz-expected-integer + FloatOriginIndex + $origin)) + (_fuzz-expected-integer + FloatUpperIndex + $upper)) + (_fuzz-expected-integer + FloatLowerIndex + $lower))) + +(= (_fuzz-grammar-validate-list-generator + $child + $minimum + $maximum + $tasks) + (let $validated + (gen-list + $child + $minimum + $maximum) + (switch $validated + (((GenList + $seen-child + $seen-minimum + $seen-maximum) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-child-task + $child + $tasks))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldGenerator + (Generator + (GenList + $child + $minimum + $maximum)))))))) + +(= (_fuzz-grammar-validate-filter-generator + $child + $predicate + $maximum-attempts + $tasks) + (let $validated + (gen-filter + $child + $predicate + $maximum-attempts) + (switch $validated + (((GenFilter + $seen-child + $seen-predicate + $seen-maximum-attempts) + (if (_fuzz-atom-ground $predicate) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-child-task + $child + $tasks)) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator + (GenFilter + $child + $predicate + $maximum-attempts))))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldGenerator + (Generator + (GenFilter + $child + $predicate + $maximum-attempts)))))))) + +(= (_fuzz-grammar-validate-resize-generator + $size + $child + $tasks) + (let $validated + (gen-resize $size $child) + (switch $validated + (((GenResize $seen-size $seen-child) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-child-task + $child + $tasks))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldGenerator + (Generator + (GenResize $size $child)))))))) + +(= (_fuzz-validate-grammar-field-generator-loop + $tasks) + (if (== $tasks ()) + (ValidGrammarFieldGenerator) + (let* ((($task $tail) + (decons-atom $tasks))) + (switch $task + (((GrammarGeneratorValidationTask + $generator) + (switch $generator + (((FuzzGenerationError + $code + $details) + $generator) + ((GenConst $value) + (if (_fuzz-atom-ground $value) + (_fuzz-validate-grammar-field-generator-loop + $tail) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator $generator)))) + ((GenBool) + (_fuzz-validate-grammar-field-generator-loop + $tail)) + ((GenInt $lower $upper $origin) + (_fuzz-grammar-validate-int-generator + $lower + $upper + $origin + $tail)) + ((GenFloatRange + $lower-index + $upper-index + $origin-index) + (_fuzz-grammar-validate-float-generator + $lower-index + $upper-index + $origin-index + $tail)) + ((GenFloatBits) + (_fuzz-validate-grammar-field-generator-loop + $tail)) + ((GenElement $values) + (if (and + (== (get-metatype $values) + Expression) + (> (length $values) 0)) + (if (_fuzz-atom-ground $values) + (_fuzz-validate-grammar-field-generator-loop + $tail) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator $generator))) + (_fuzz-generation-error + EmptyElementSet + (Values $values)))) + ((GenFrequency $entries $total) + (let $validated + (_fuzz-grammar-frequency-validation + $entries + $tail + 0) + (switch $validated + (((ValidatedGrammarFrequency + $next-tasks + $calculated-total) + (if (== $total $calculated-total) + (_fuzz-validate-grammar-field-generator-loop + $next-tasks) + (_fuzz-generation-error + InvalidFrequencyTotal + (Expected $calculated-total) + (Actual $total)))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldGenerator + (Generator $generator))))))) + ((GenTuple $generators) + (if (== (get-metatype $generators) + Expression) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-validation-tasks + $generators + $tail)) + (_fuzz-generation-error + MalformedGrammarFieldGenerator + (Generator $generator)))) + ((GenList $child $minimum $maximum) + (_fuzz-grammar-validate-list-generator + $child + $minimum + $maximum + $tail)) + ((GenOption $child) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-child-task + $child + $tail))) + ((GenMap $function $child) + (if (_fuzz-atom-ground $function) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-child-task + $child + $tail)) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator $generator)))) + ((GenBind $child $function) + (if (_fuzz-atom-ground $function) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-child-task + $child + $tail)) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator $generator)))) + ((GenFilter + $child + $predicate + $maximum-attempts) + (_fuzz-grammar-validate-filter-generator + $child + $predicate + $maximum-attempts + $tail)) + ((GenSized $function) + (if (_fuzz-atom-ground $function) + (_fuzz-validate-grammar-field-generator-loop + $tail) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator $generator)))) + ((GenResize $size $child) + (_fuzz-grammar-validate-resize-generator + $size + $child + $tail)) + ((GenRecursive $base $step) + (if (_fuzz-atom-ground $step) + (_fuzz-validate-grammar-field-generator-loop + (_fuzz-grammar-generator-child-task + $base + $tail)) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator $generator)))) + ((GenCustom $name $arguments) + (if (and + (_fuzz-atom-ground $name) + (_fuzz-atom-ground $arguments)) + (_fuzz-validate-grammar-field-generator-loop + $tail) + (_fuzz-generation-error + NonGroundGrammarFieldGenerator + (Generator $generator)))) + ($bad-generator + (_fuzz-generation-error + MalformedGrammarFieldGenerator + (Generator $bad-generator)))))) + ($bad-task + (_fuzz-generation-error + MalformedGrammarGeneratorValidationTask + (Value $bad-task)))))))) + +(= (_fuzz-validate-grammar-field-generator + $generator) + (_fuzz-validate-grammar-field-generator-loop + ((GrammarGeneratorValidationTask + $generator)))) + +(= (_fuzz-grammar-field-from-results + $quoted-expression + $results) + (switch $results + ((() + (_fuzz-generation-error + MissingGrammarFieldGenerator + (Expression $quoted-expression))) + (($generator) + (let $validated + (_fuzz-validate-grammar-field-generator + $generator) + (switch $validated + (((ValidGrammarFieldGenerator) + (ResolvedGrammarField $generator)) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldValidation + (Value $bad))))))) + ($many + (_fuzz-generation-error + AmbiguousGrammarFieldGenerator + (Expression $quoted-expression) + (Results $many)))))) + +(= (_fuzz-resolve-grammar-field + $expression) + (_fuzz-grammar-field-from-results + (quote $expression) + (collapse $expression))) + +(= (_fuzz-resolve-grammar-fields-loop + $remaining + $resolved) + (if (== $remaining ()) + (ResolvedGrammarFields $resolved) + (let* ((($quoted-expression $tail) + (decons-atom $remaining))) + (_fuzz-grammar-template-switch $quoted-expression + (((quote $expression) + (let $field + (_fuzz-resolve-grammar-field + $expression) + (switch $field + (((ResolvedGrammarField $generator) + (let $next + (_fuzz-expression-append + $resolved + $generator) + (_fuzz-resolve-grammar-fields-loop + $tail + $next))) + ((FuzzGenerationError $code $details) + $field) + ($bad + (_fuzz-generation-error + MalformedResolvedGrammarField + (Value $bad))))))) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldExpression + (Value $bad)))))))) + +(= (_fuzz-normalize-grammar-template-fields + $template) + (let $fields + (_fuzz-grammar-field-expressions + $template) + (switch $fields + (((GrammarFieldExpressions $expressions) + (let $resolved + (_fuzz-resolve-grammar-fields-loop + $expressions + ()) + (switch $resolved + (((ResolvedGrammarFields $generators) + (let $normalized-template + (_fuzz-grammar-replace-fields + $template + $generators) + (NormalizedGrammarTemplate + (quote $normalized-template)))) + ((FuzzGenerationError $code $details) + $resolved) + ($bad + (_fuzz-generation-error + MalformedResolvedGrammarFields + (Value $bad))))))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $fields))) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldExpressions + (Value $bad))))))) + +(= (_fuzz-prepare-grammar-template + $grammar + $template) + (let $profile + (_fuzz-grammar-template-profile + $template) + (switch $profile + (((GrammarTemplateProfile + (Ground True) + (References $references) + (MinimumNextId $minimum-next-id) + (Nodes $nodes) + (Depth $depth)) + (let $normalized + (_fuzz-normalize-grammar-template-fields + $template) + (switch $normalized + (((NormalizedGrammarTemplate + (quote $normalized-template)) + (let $validated + (_fuzz-validate-grammar-template + $grammar + $normalized-template) + (switch $validated + (((ValidGrammarTemplate) + (let $indexed-template + (_fuzz-grammar-index-references + $normalized-template) + (PreparedGrammarTemplate + (quote $indexed-template) + $references + $minimum-next-id + $nodes + $depth))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarTemplateValidation + (Grammar $grammar) + (Value $bad))))))) + ((FuzzGenerationError $code $details) + $normalized) + ($bad + (_fuzz-generation-error + MalformedGrammarTemplateNormalization + (Grammar $grammar) + (Value $bad))))))) + ((GrammarTemplateProfile + (Ground False) + (References $references) + (MinimumNextId $minimum-next-id) + (Nodes $nodes) + (Depth $depth)) + (_fuzz-generation-error + NonGroundGrammarTemplate + (Grammar $grammar) + (Template $template))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $profile))) + ($bad + (_fuzz-generation-error + MalformedGrammarTemplateProfile + (Grammar $grammar) + (Value $bad))))))) + +(= (_fuzz-validate-grammar-binding-step + $state + $binding) + (switch $state + (((FuzzGenerationError $code $details) + $state) + ((GrammarBindingValidationState + $seen + $normalized + $next-id) + (_fuzz-grammar-template-switch $binding + (((Binding $sort $id) + (if (_fuzz-is-integer $id) + (if (>= $id 0) + (let $present + (_fuzz-exact-member + $id + $seen) + (switch $present + ((True + (_fuzz-generation-error + DuplicateGrammarBindingId + (BindingId $id))) + (False + (let $next-seen + (_fuzz-expression-append + $seen + $id) + (let $next-normalized + (_fuzz-expression-append + $normalized + (GrammarBinding + (quote $sort) + $id)) + (GrammarBindingValidationState + $next-seen + $next-normalized + (max $next-id (+ $id 1)))))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $present))) + ($bad + (_fuzz-generation-error + MalformedGrammarBindingMembership + (Value $bad)))))) + (_fuzz-generation-error + InvalidGrammarBindingId + (BindingId $id))) + (_fuzz-expected-integer + GrammarBindingId + $id))) + ($bad + (_fuzz-generation-error + MalformedGrammarBinding + (Binding $bad)))))) + ($bad + (_fuzz-generation-error + MalformedGrammarBindingValidationState + (Value $bad)))))) + +(= (_fuzz-validate-grammar-bindings $bindings) + (let $view + (_fuzz-expression-view $bindings) + (switch $view + (((FuzzExpressionView + $arity + $forward + $reversed) + (let $folded + (foldl-atom + $bindings + (GrammarBindingValidationState + () + () + 0) + $state + $binding + (_fuzz-validate-grammar-binding-step + $state + $binding)) + (switch $folded + (((GrammarBindingValidationState + $seen + $normalized + $next-id) + (ValidGrammarBindings + $normalized + $next-id)) + ((FuzzGenerationError $code $details) + $folded) + ($bad + (_fuzz-generation-error + MalformedGrammarBindingValidationState + (Value $bad))))))) + ((FuzzAtomLeaf) + (_fuzz-generation-error + MalformedGrammarBindings + (Bindings $bindings))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $view))) + ($bad + (_fuzz-generation-error + MalformedGrammarBindingView + (Value $bad))))))) + +(= (_fuzz-grammar-validation-enter-scope + $grammar + $bindings + $scopes + $used) + (if-decons-expr + $scopes + $scope + $parents + (let $validated + (_fuzz-validate-grammar-bindings + $bindings) + (switch $validated + (((ValidGrammarBindings + $normalized + $next-id) + (if (_fuzz-grammar-scopes-disjoint + $normalized + $used) + (let $bound-scope + (_fuzz-expression-concat + $normalized + $scope) + (let $next-scopes + (cons-atom + $bound-scope + $scopes) + (let $next-used + (_fuzz-expression-concat + $normalized + $used) + (GrammarValidationState + $next-scopes + $next-used)))) + (_fuzz-generation-error + DuplicateGrammarBindingId + (Bindings $bindings)))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarBindingValidation + (Grammar $grammar) + (Value $bad)))))) + (_fuzz-generation-error + MalformedGrammarValidationScopes + (Scopes $scopes)))) + +(= (_fuzz-grammar-validation-exit-scope + $scopes + $used) + (if-decons-expr + $scopes + $scope + $parents + (if-decons-expr + $parents + $parent + $rest + (GrammarValidationState + $parents + $used) + (_fuzz-generation-error + UnbalancedGrammarValidationScope + (Scopes $scopes))) + (_fuzz-generation-error + UnbalancedGrammarValidationScope + (Scopes $scopes)))) + +(= (_fuzz-grammar-validation-event + $state + $event + $grammar) + (switch $state + (((GrammarValidationState + $scopes + $used) + (_fuzz-grammar-template-switch $event + (((GrammarValidationField + (quote $generator)) + (let $validated + (_fuzz-validate-grammar-field-generator + $generator) + (switch $validated + (((ValidGrammarFieldGenerator) + $state) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedGrammarFieldValidation + (Grammar $grammar) + (Value $bad))))))) + ((GrammarValidationScopedEnter + (quote $bindings)) + (_fuzz-grammar-validation-enter-scope + $grammar + $bindings + $scopes + $used)) + ((GrammarValidationScopedExit) + (_fuzz-grammar-validation-exit-scope + $scopes + $used)) + ((GrammarValidationMalformed + (quote $template)) + (_fuzz-generation-error + MalformedGrammarTemplate + (Grammar $grammar) + (Template (quote $template)))) + ($bad + (_fuzz-generation-error + MalformedGrammarValidationEvent + (Grammar $grammar) + (Value $bad)))))) + ((FuzzGenerationError $code $details) + $state) + ($bad + (_fuzz-generation-error + MalformedGrammarValidationState + (Grammar $grammar) + (Value $bad)))))) + +(= (_fuzz-grammar-validation-from-fold + $grammar + $folded) + (switch $folded + (((GrammarValidationState + (()) + $used) + (ValidGrammarTemplate)) + ((GrammarValidationState + $scopes + $used) + (_fuzz-generation-error + UnbalancedGrammarValidationScope + (Grammar $grammar) + (Scopes $scopes))) + ((FuzzGenerationError $code $details) + $folded) + ($bad + (_fuzz-generation-error + MalformedGrammarValidationState + (Grammar $grammar) + (Value $bad)))))) + +(= (_fuzz-validate-grammar-template + $grammar + $template) + (let $planned + (_fuzz-grammar-validation-plan + $template) + (switch $planned + (((GrammarValidationPlan $events) + (_fuzz-grammar-validation-from-fold + $grammar + (foldl-atom + $events + (GrammarValidationState + (()) + ()) + $state + $event + (_fuzz-grammar-validation-event + $state + $event + $grammar)))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $planned))) + ($bad + (_fuzz-generation-error + MalformedGrammarValidationPlan + (Grammar $grammar) + (Value $bad))))))) + +; Normalization walks productions as a bare-tail machine: field resolution inside +; `_fuzz-prepare-grammar-template` evaluates user Field expressions, so the per-production +; work stays MeTTa; the walk itself must not pay stack depth or quadratic accumulation, so +; the accumulator is a nested stack flattened once at the end. +(= (_fuzz-normalize-walk-done $state) + (unify $state + (FuzzNormalizeWalk $grammar $remaining $index $accumulated $minimum-next-id) + (unify $remaining () True False) + True)) + +(= (_fuzz-normalize-walk-prepared + $grammar + $tail + $index + $accumulated + $minimum-next-id + $weight + $target + $prepared) + (unify $prepared + (PreparedGrammarTemplate + (quote $normalized-template) + $references + $template-minimum-next-id + $nodes + $depth) + (FuzzNormalizeWalk + $grammar + $tail + (+ $index 1) + (FuzzStack + (GrammarProduction + $index + $weight + (quote $target) + (quote $normalized-template)) + $accumulated) + (max $minimum-next-id $template-minimum-next-id)) + (unify $prepared + (FuzzGenerationError $code $details) + $prepared + (unify $prepared + $bad + (_fuzz-generation-error + MalformedPreparedGrammarTemplate + (Grammar $grammar) + (Value $bad)) + Empty)))) + +(= (_fuzz-normalize-walk-step $state) + (unify $state + (FuzzNormalizeWalk $grammar $remaining $index $accumulated $minimum-next-id) + (if-decons-expr + $remaining + $production + $tail + (_fuzz-grammar-template-switch $production + (((Production $weight $target $template) + (if (_fuzz-is-integer $weight) + (if (> $weight 0) + (if (_fuzz-atom-ground $target) + (let $prepared + (_fuzz-prepare-grammar-template + $grammar + $template) + (_fuzz-normalize-walk-prepared + $grammar + $tail + $index + $accumulated + $minimum-next-id + $weight + $target + $prepared)) + (_fuzz-generation-error + NonGroundGrammarProductionTarget + (Grammar $grammar) + (ProductionIndex $index) + (Target (quote $target)))) + (_fuzz-generation-error + InvalidGrammarProductionWeight + (Grammar $grammar) + (ProductionIndex $index) + (Weight $weight))) + (_fuzz-expected-integer + GrammarProductionWeight + $weight))) + ($bad + (_fuzz-generation-error + MalformedGrammarProduction + (Grammar $grammar) + (ProductionIndex $index) + (Production $bad))))) + (_fuzz-generation-error + MalformedGrammarProductions + (Grammar $grammar) + (Productions $remaining))) + $state)) + +(= (_fuzz-normalize-walk-loop $state) + (if (_fuzz-normalize-walk-done $state) + $state + (_fuzz-normalize-walk-loop + (_fuzz-normalize-walk-step $state)))) + +(= (_fuzz-normalize-grammar-productions + $grammar + $productions) + (if-decons-expr + $productions + $first + $tail + (let $settled + (_fuzz-normalize-walk-loop + (FuzzNormalizeWalk + $grammar + $productions + 0 + FuzzStackBottom + 0)) + (unify $settled + (FuzzNormalizeWalk $seen-grammar $remaining $count $accumulated $minimum-next-id) + (let $flattened (_fuzz-stack-to-expression $accumulated) + (unify $flattened + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $flattened)) + (unify $flattened + $normalized + (ValidatedGrammarProductions + $normalized + $minimum-next-id) + Empty))) + (unify $settled + (FuzzGenerationError $code $details) + $settled + (unify $settled + $bad + (_fuzz-generation-error + MalformedGrammarNormalization + (Grammar $grammar) + (Value $bad)) + Empty)))) + (unify + $productions + () + (_fuzz-generation-error + EmptyGrammar + (Grammar $grammar)) + (_fuzz-generation-error + MalformedGrammarProductions + (Grammar $grammar) + (Productions $productions))))) + +(= (_fuzz-grammar-target-member + $target + $targets) + (if-decons-expr + $targets + $quoted + $tail + (_fuzz-grammar-template-switch $quoted + (((quote $candidate) + (if (noreduce-eq $target $candidate) + True + (_fuzz-grammar-target-member + $target + $tail))) + ($bad + (_fuzz-generation-error + MalformedGrammarTarget + (Value $bad))))) + False)) + +(= (_fuzz-grammar-add-target + $target + $targets) + (if (_fuzz-grammar-target-member + $target + $targets) + $targets + (_fuzz-expression-append + $targets + (quote $target)))) + +(= (_fuzz-template-reference-target-step + $targets + $quoted) + (_fuzz-grammar-template-switch $quoted + (((quote $target) + (_fuzz-grammar-add-target + $target + $targets)) + ($bad + (_fuzz-generation-error + MalformedGrammarTarget + (Value $bad)))))) + +(= (_fuzz-template-reference-targets + $template + $targets) + (let $planned + (_fuzz-grammar-template-reference-plan + $template) + (switch $planned + (((GrammarReferenceTargets $references) + (foldl-atom + $references + $targets + $seen + $quoted + (_fuzz-template-reference-target-step + $seen + $quoted))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $planned))) + ($bad + (_fuzz-generation-error + MalformedGrammarReferencePlan + (Value $bad))))))) + +(= (_fuzz-grammar-reference-targets-loop + $productions + $targets) + (if-decons-expr + $productions + $production + $tail + (_fuzz-grammar-template-switch $production + (((GrammarProduction + $index + $weight + (quote $target) + (quote $template)) + (_fuzz-grammar-reference-targets-loop + $tail + (_fuzz-template-reference-targets + $template + $targets))) + ($bad + (_fuzz-generation-error + MalformedNormalizedGrammarProduction + (Production $bad))))) + $targets)) + +(= (_fuzz-grammar-reference-targets + $productions) + (_fuzz-grammar-reference-targets-loop + $productions + ())) + +(= (_fuzz-grammar-summary-merge-candidate + $changed + $candidate + $current-alternatives + $summary + $target) + (let $added + (_fuzz-grammar-alternatives-add + $current-alternatives + $candidate) + (unify $added + (GrammarAlternativesAdd False $same) + (GrammarSummaryMergeState + $changed + $summary) + (unify $added + (GrammarAlternativesAdd True $next) + (let $replaced + (_fuzz-grammar-summary-replace + $summary + $target + $next) + (unify $replaced + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $replaced)) + (unify $replaced + $next-summary + (GrammarSummaryMergeState + True + $next-summary) + Empty))) + (unify $added + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $added)) + (unify $added + $bad + (_fuzz-generation-error + MalformedGrammarRequirementDominance + (Value $bad)) + Empty)))))) + +(= (_fuzz-grammar-summary-merge-alternative + $changed + $alternative + $summary + $target) + (_fuzz-grammar-template-switch $alternative + (((GrammarRequirementAlternative $candidate) + (let $current + (_fuzz-grammar-summary-alternatives + $summary + $target) + (switch $current + (((GrammarRequirementAlternatives + $current-alternatives) + (_fuzz-grammar-summary-merge-candidate + $changed + $candidate + $current-alternatives + $summary + $target)) + ((FuzzGenerationError $code $details) + $current) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $current))) + ($bad + (_fuzz-generation-error + MalformedGrammarRequirementAlternatives + (Value $bad))))))) + ($bad + (_fuzz-generation-error + MalformedGrammarRequirementAlternative + (Value $bad)))))) + +(= (_fuzz-grammar-summary-merge-step + $state + $alternative + $target) + (switch $state + (((FuzzGenerationError $code $details) + $state) + ((GrammarSummaryMergeState + $changed + $summary) + (_fuzz-grammar-summary-merge-alternative + $changed + $alternative + $summary + $target)) + ($bad + (_fuzz-generation-error + MalformedGrammarSummaryMergeState + (Value $bad)))))) + +(= (_fuzz-grammar-summary-merge + $target + $new-alternatives + $summary) + (foldl-atom + $new-alternatives + (GrammarSummaryMergeState + False + $summary) + $state + $alternative + (_fuzz-grammar-summary-merge-step + $state + $alternative + $target))) + +(= (_fuzz-grammar-template-requirements + $template + $summary) + (let $analyzed + (_fuzz-grammar-template-requirements-op + $template + $summary) + (unify $analyzed + (GrammarRequirementAlternatives $alternatives) + $analyzed + (unify $analyzed + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $analyzed)) + (unify $analyzed + $bad + (_fuzz-generation-error + MalformedGrammarRequirementAlternatives + (Value $bad)) + Empty))))) + +; The fixed point runs as a worklist: analyzing a production whose target's alternatives +; changed enqueues exactly the productions that reference that target, so a chain of N +; targets settles in O(N + references) analyses instead of O(N) full restarts. Merge is +; monotone, so any fair processing order reaches the same least fixed point, and the +; summary is validation-internal, so queue order is unobservable downstream. +(= (_fuzz-productivity-done $state) + (unify $state + (FuzzProductivityQueue $productions (FuzzStack $index $rest) $summary) + False + True)) + +(= (_fuzz-productivity-changed + $productions + $rest + $target + $next-summary) + (let $dependents + (_fuzz-grammar-dependents-of + $productions + (quote $target)) + (unify $dependents + (GrammarDependents $indices) + (let $next-queue (_fuzz-stack-push-all $rest $indices) + (FuzzProductivityQueue + $productions + $next-queue + $next-summary)) + (unify $dependents + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $dependents)) + (unify $dependents + $bad + (_fuzz-generation-error + MalformedGrammarDependents + (Value $bad)) + Empty))))) + +(= (_fuzz-productivity-analyze + $productions + $rest + $summary + $target + $template) + (let $requirements + (_fuzz-grammar-template-requirements + $template + $summary) + (unify $requirements + (GrammarRequirementAlternatives $alternatives) + (let $merged + (_fuzz-grammar-summary-merge + $target + $alternatives + $summary) + (unify $merged + (GrammarSummaryMergeState True $next-summary) + (_fuzz-productivity-changed + $productions + $rest + $target + $next-summary) + (unify $merged + (GrammarSummaryMergeState False $next-summary) + (FuzzProductivityQueue + $productions + $rest + $next-summary) + (unify $merged + (FuzzGenerationError $code $details) + $merged + (unify $merged + $bad + (_fuzz-generation-error + MalformedGrammarSummaryMergeState + (Value $bad)) + Empty))))) + (unify $requirements + (FuzzGenerationError $code $details) + $requirements + (unify $requirements + $bad + (_fuzz-generation-error + MalformedGrammarRequirementAlternatives + (Value $bad)) + Empty))))) + +(= (_fuzz-productivity-step $state) + (unify $state + (FuzzProductivityQueue $productions (FuzzStack $index $rest) $summary) + (let $production (index-atom $productions $index) + (_fuzz-grammar-template-switch $production + (((GrammarProduction + $production-index + $weight + (quote $target) + (quote $template)) + (_fuzz-productivity-analyze + $productions + $rest + $summary + $target + $template)) + ($bad + (_fuzz-generation-error + MalformedNormalizedGrammarProduction + (Production $bad)))))) + $state)) + +(= (_fuzz-productivity-loop $state) + (if (_fuzz-productivity-done $state) + $state + (_fuzz-productivity-loop + (_fuzz-productivity-step $state)))) + +(= (_fuzz-grammar-summary-has-target + $target + $summary) + (let $found + (_fuzz-grammar-summary-alternatives + $summary + $target) + (switch $found + (((GrammarRequirementAlternatives + $alternatives) + (> (length $alternatives) 0)) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $found))) + ($bad + (_fuzz-generation-error + MalformedGrammarRequirementAlternatives + (Value $bad))))))) + +(= (_fuzz-grammar-summary-has-closed-target + $target + $summary) + (let $found + (_fuzz-grammar-summary-alternatives + $summary + $target) + (switch $found + (((GrammarRequirementAlternatives + $alternatives) + (let $present + (_fuzz-exact-member + (GrammarRequirementAlternative ()) + $alternatives) + (switch $present + (((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $present))) + ($valid $valid))))) + ((FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $found))) + ($bad + (_fuzz-generation-error + MalformedGrammarRequirementAlternatives + (Value $bad))))))) + +(= (_fuzz-first-unsummarized-target-step + $state + $quoted + $summary) + (switch $state + (((FuzzGenerationError $code $details) + $state) + ((GrammarMissingTarget (quote $missing)) + $state) + ((GrammarMissingTarget None) + (_fuzz-grammar-template-switch $quoted + (((quote $target) + (if (_fuzz-grammar-summary-has-target + $target + $summary) + $state + (GrammarMissingTarget + (quote $target)))) + ($bad + (_fuzz-generation-error + MalformedGrammarTarget + (Value $bad)))))) + ($bad + (_fuzz-generation-error + MalformedGrammarMissingTargetState + (Value $bad)))))) + +(= (_fuzz-first-unsummarized-target + $targets + $summary) + (let $folded + (foldl-atom + $targets + (GrammarMissingTarget None) + $state + $quoted + (_fuzz-first-unsummarized-target-step + $state + $quoted + $summary)) + (switch $folded + (((GrammarMissingTarget (quote $missing)) + (quote $missing)) + ((GrammarMissingTarget None) + (_fuzz-generation-error + MissingGrammarTarget + (Targets $targets))) + ((FuzzGenerationError $code $details) + $folded) + ($bad + (_fuzz-generation-error + MalformedGrammarMissingTargetState + (Value $bad))))))) + +(= (_fuzz-grammar-all-targets-summarized-step + $state + $quoted + $summary) + (switch $state + (((FuzzGenerationError $code $details) + $state) + (False False) + (True + (_fuzz-grammar-template-switch $quoted + (((quote $target) + (_fuzz-grammar-summary-has-target + $target + $summary)) + ($bad + (_fuzz-generation-error + MalformedGrammarTarget + (Value $bad)))))) + ($bad + (_fuzz-generation-error + MalformedGrammarRequirementMembership + (Value $bad)))))) + +(= (_fuzz-grammar-all-targets-summarized + $targets + $summary) + (foldl-atom + $targets + True + $state + $quoted + (_fuzz-grammar-all-targets-summarized-step + $state + $quoted + $summary))) + +(= (_fuzz-grammar-productivity-result + $grammar + $root + $targets + $summary) + (let $all + (_fuzz-grammar-all-targets-summarized + $targets + $summary) + (switch $all + ((True + (let $closed + (_fuzz-grammar-summary-has-closed-target + $root + $summary) + (switch $closed + ((True + (ValidGrammarProductivity)) + (False + (_fuzz-generation-error + UnproductiveGrammarNonterminal + (Grammar $grammar) + (Nonterminal (quote $root)))) + ((FuzzGenerationError $code $details) + $closed) + ($bad + (_fuzz-generation-error + MalformedGrammarRequirementMembership + (Value $bad))))))) + (False + (let $missing + (_fuzz-first-unsummarized-target + $targets + $summary) + (_fuzz-generation-error + UnproductiveGrammarNonterminal + (Grammar $grammar) + (Nonterminal $missing)))) + ((FuzzGenerationError $code $details) + $all) + ($bad + (_fuzz-generation-error + MalformedGrammarRequirementMembership + (Value $bad))))))) + +(= (_fuzz-grammar-productivity-fixedpoint + $grammar + $root + $productions + $targets + $summary) + (let $seed-queue (_fuzz-index-stack (length $productions)) + (let $settled + (_fuzz-productivity-loop + (FuzzProductivityQueue + $productions + $seed-queue + $summary)) + (unify $settled + (FuzzProductivityQueue + $seen-productions + $queue + $next-summary) + (_fuzz-grammar-productivity-result + $grammar + $root + $targets + $next-summary) + (unify $settled + (FuzzGenerationError $code $details) + $settled + (unify $settled + $bad + (_fuzz-generation-error + MalformedGrammarProductivity + (Grammar $grammar) + (Value $bad)) + Empty)))))) + +; The default validation path: the whole fixed point runs kernel-side; the exact error +; shape stays here. The specification fixed point remains callable through +; `_fuzz-validate-grammar-productivity-reference`. +(= (_fuzz-validate-grammar-productivity + $grammar + $root + $productions + $targets) + (let $verdict + (_fuzz-grammar-productivity-op + $productions + (quote $root) + $targets) + (unify $verdict + (ValidGrammarProductivity) + (ValidGrammarProductivity) + (unify $verdict + (GrammarUnproductive (quote $nonterminal)) + (_fuzz-generation-error + UnproductiveGrammarNonterminal + (Grammar $grammar) + (Nonterminal (quote $nonterminal))) + (unify $verdict + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $verdict)) + (unify $verdict + $bad + (_fuzz-generation-error + MalformedGrammarProductivity + (Grammar $grammar) + (Value $bad)) + Empty)))))) + +(= (_fuzz-validate-grammar-productivity-reference + $grammar + $root + $productions + $targets) + (_fuzz-grammar-productivity-fixedpoint + $grammar + $root + $productions + $targets + ())) + +(= (_fuzz-validated-references + $grammar + $root + $productions + $minimum-next-id + $targets) + (let $checked + (_fuzz-grammar-validate-references-op + $productions + $targets) + (unify $checked + (ValidGrammarReferences) + (let $productivity + (_fuzz-validate-grammar-productivity + $grammar + $root + $productions + $targets) + (unify $productivity + (ValidGrammarProductivity) + (ValidatedGrammar + (quote $grammar) + (quote $root) + $productions + $minimum-next-id) + (unify $productivity + (FuzzGenerationError $code $details) + $productivity + (unify $productivity + $bad + (_fuzz-generation-error + MalformedGrammarProductivity + (Grammar $grammar) + (Value $bad)) + Empty)))) + (unify $checked + (GrammarMissingReference (quote $nonterminal)) + (_fuzz-generation-error + MissingGrammarNonterminal + (Grammar $grammar) + (Nonterminal (quote $nonterminal))) + (unify $checked + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $checked)) + (unify $checked + $bad + (_fuzz-generation-error + MalformedGrammarReferenceValidation + (Grammar $grammar) + (Value $bad)) + Empty)))))) + +(= (_fuzz-validate-normalized-grammar + $grammar + $root + $productions + $minimum-next-id) + (let $targets-result + (_fuzz-grammar-targets-op $productions) + (unify $targets-result + (GrammarTargets $targets) + (if (_fuzz-grammar-target-member + $root + $targets) + (_fuzz-validated-references + $grammar + $root + $productions + $minimum-next-id + $targets) + (_fuzz-generation-error + MissingGrammarRoot + (Grammar $grammar) + (Root (quote $root)))) + (unify $targets-result + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $targets-result)) + (unify $targets-result + $bad + (_fuzz-generation-error + MalformedGrammarTargets + (Grammar $grammar) + (Value $bad)) + Empty))))) + +(= (_fuzz-build-grammar + $grammar + $root + $productions) + (let $normalized + (_fuzz-normalize-grammar-productions + $grammar + $productions) + (switch $normalized + (((ValidatedGrammarProductions + $valid + $minimum-next-id) + (_fuzz-validate-normalized-grammar + $grammar + $root + $valid + $minimum-next-id)) + ((FuzzGenerationError $code $details) + $normalized) + ($bad + (_fuzz-generation-error + MalformedGrammarNormalization + (Grammar $grammar) + (Value $bad))))))) + +(= (_fuzz-grammar-from-results + $grammar + $root + $results) + (switch $results + ((() + (_fuzz-generation-error + MissingGrammar + (Grammar $grammar))) + (((quote $productions)) + (_fuzz-build-grammar + $grammar + $root + $productions)) + ($many + (_fuzz-generation-error + AmbiguousGrammar + (Grammar $grammar) + (Results $many)))))) + +(= (_fuzz-gen-grammar-root-ground + (quote $grammar) + (quote $root)) + (let $results + (collapse + (match &self + (FuzzGrammar + $grammar + (Productions $productions)) + (quote $productions))) + (let $validated + (_fuzz-grammar-from-results + $grammar + $root + $results) + (switch $validated + (((ValidatedGrammar + (quote $name) + (quote $target) + $productions + $minimum-next-id) + (GenCustom + _fuzz-grammar + (GrammarRequest + (StaticGrammar + (quote $name) + $productions) + (quote $target) + () + $minimum-next-id))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedValidatedGrammar + (Grammar $grammar) + (Value $bad)))))))) + +(= (gen-grammar-root $grammar $root) + (if (_fuzz-atom-ground (quote $grammar)) + (if (_fuzz-atom-ground (quote $root)) + (_fuzz-gen-grammar-root-ground + (quote $grammar) + (quote $root)) + (_fuzz-generation-error + NonGroundGrammarRoot + (Grammar $grammar) + (Root (quote $root)))) + (_fuzz-generation-error + NonGroundGrammarName + (Grammar (quote $grammar))))) + +(= (gen-grammar $grammar) + (gen-grammar-root + $grammar + $grammar)) + +; Scope bindings are ordered from nearest to farthest. +(= (_fuzz-grammar-scope-has-id-step + $state + $binding + $id) + (switch $state + ((True True) + (False + (_fuzz-grammar-template-switch $binding + (((GrammarBinding (quote $sort) $candidate) + (== $id $candidate)) + ($bad False)))) + ($bad False)))) + +(= (_fuzz-grammar-scope-has-id + $scope + $id) + (foldl-atom + $scope + False + $state + $binding + (_fuzz-grammar-scope-has-id-step + $state + $binding + $id))) + +(= (_fuzz-grammar-scopes-disjoint-step + $state + $binding + $existing) + (switch $state + ((False False) + (True + (_fuzz-grammar-template-switch $binding + (((GrammarBinding (quote $sort) $id) + (== (_fuzz-grammar-scope-has-id + $existing + $id) + False)) + ($bad False)))) + ($bad False)))) + +(= (_fuzz-grammar-scopes-disjoint + $added + $existing) + (foldl-atom + $added + True + $state + $binding + (_fuzz-grammar-scopes-disjoint-step + $state + $binding + $existing))) + +(= (_fuzz-static-productions-for-target-loop + $remaining + (quote $target) + $selected) + (if-decons-expr + $remaining + $production + $tail + (_fuzz-grammar-template-switch $production + (((GrammarProduction + $index + $weight + (quote $candidate) + (quote $template)) + (let $next + (if (noreduce-eq $target $candidate) + (_fuzz-expression-append + $selected + $production) + $selected) + (_fuzz-static-productions-for-target-loop + $tail + (quote $target) + $next))) + ($bad + (_fuzz-generation-error + MalformedNormalizedGrammarProduction + (Production $bad))))) + (GrammarProductions $selected))) + +(= (_fuzz-source-productions + (StaticGrammar (quote $grammar) $productions) + (quote $target)) + (_fuzz-static-productions-for-target-loop + $productions + (quote $target) + ())) + +(= (_fuzz-normalize-type-constructors-loop + $schema + $type + $remaining + $index + $normalized + $minimum-next-id) + (if-decons-expr + $remaining + $constructor + $tail + (_fuzz-grammar-template-switch $constructor + (((Constructor $weight $result-type $template) + (if (_fuzz-atom-ground $result-type) + (if (noreduce-eq $type $result-type) + (if (_fuzz-is-integer $weight) + (if (> $weight 0) + (let $prepared + (_fuzz-prepare-grammar-template + $schema + $template) + (switch $prepared + (((PreparedGrammarTemplate + (quote $normalized-template) + $references + $template-minimum-next-id + $nodes + $depth) + (let $next + (_fuzz-expression-append + $normalized + (GrammarProduction + $index + $weight + (quote $type) + (quote + $normalized-template))) + (_fuzz-normalize-type-constructors-loop + $schema + $type + $tail + (+ $index 1) + $next + (max + $minimum-next-id + $template-minimum-next-id)))) + ((FuzzGenerationError $code $details) + $prepared) + ($bad + (_fuzz-generation-error + MalformedPreparedGrammarTemplate + (Schema $schema) + (Value $bad)))))) + (_fuzz-generation-error + InvalidTypeConstructorWeight + (Schema $schema) + (Type (quote $type)) + (ConstructorIndex $index) + (Weight $weight))) + (_fuzz-expected-integer + TypeConstructorWeight + $weight)) + (_fuzz-generation-error + TypeConstructorResultMismatch + (Schema $schema) + (RequestedType (quote $type)) + (ConstructorType (quote $result-type)) + (ConstructorIndex $index))) + (_fuzz-generation-error + NonGroundTypeConstructorResult + (Schema $schema) + (RequestedType (quote $type)) + (ConstructorType (quote $result-type)) + (ConstructorIndex $index)))) + ($bad + (_fuzz-generation-error + MalformedTypeConstructor + (Schema $schema) + (Type (quote $type)) + (ConstructorIndex $index) + (Constructor (quote $bad)))))) + (unify + $remaining + () + (PreparedTypeConstructors + $normalized + $minimum-next-id) + (_fuzz-generation-error + MalformedTypeConstructors + (Schema $schema) + (Type (quote $type)) + (Constructors $remaining))))) + +(= (_fuzz-normalize-type-constructors + $schema + $type + $constructors) + (if-decons-expr + $constructors + $first + $tail + (_fuzz-normalize-type-constructors-loop + $schema + $type + $constructors + 0 + () + 0) + (unify + $constructors + () + (_fuzz-generation-error + EmptyTypeSchema + (Schema $schema) + (Type (quote $type))) + (_fuzz-generation-error + MalformedTypeConstructors + (Schema $schema) + (Type (quote $type)) + (Constructors $constructors))))) + +(= (_fuzz-type-schema-from-results + $schema + $type + $results) + (switch $results + ((() + (_fuzz-generation-error + MissingTypeSchema + (Schema $schema) + (Type (quote $type)))) + (((quote $single)) + (_fuzz-grammar-template-switch $single + (((FuzzTypeConstructors $constructors) + (_fuzz-normalize-type-constructors + $schema + $type + $constructors)) + ($bad + (_fuzz-generation-error + MalformedTypeSchema + (Schema $schema) + (Type (quote $type)) + (Value (quote $bad))))))) + ($many + (_fuzz-generation-error + AmbiguousTypeSchema + (Schema $schema) + (Type (quote $type)) + (Results $many)))))) + +(= (_fuzz-source-productions + (DynamicTypeGrammar (quote $schema)) + (quote $type)) + (let $results + (collapse + (match &self + (= (FuzzTypeSchema + $schema + $type) + $constructors) + (quote $constructors))) + (_fuzz-type-schema-from-results + $schema + $type + $results))) + +(= (_fuzz-source-productions + (StaticTypeGrammar (quote $schema) $productions) + (quote $type)) + (_fuzz-static-productions-for-target-loop + $productions + (quote $type) + ())) + +(= (_fuzz-finalize-type-grammar + $schema + $root + $productions + $minimum-next-id) + (let $validated + (_fuzz-validate-normalized-grammar + $schema + $root + $productions + $minimum-next-id) + (switch $validated + (((ValidatedGrammar + (quote $seen-schema) + (quote $seen-root) + $validated-productions + $validated-minimum-next-id) + (ValidatedTypeGrammar + (quote $schema) + (quote $root) + $validated-productions + $validated-minimum-next-id)) + ((FuzzGenerationError + UnproductiveGrammarNonterminal + (Details + (Grammar $seen-schema) + (Nonterminal (quote $type)))) + (_fuzz-generation-error + UnproductiveTypeSchema + (Schema $schema) + (Type (quote $type)))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedTypeSchemaValidation + (Schema $schema) + (Type (quote $root)) + (Value $bad))))))) + +(= (_fuzz-build-type-grammar-prepared + $schema + $root + $type + $tail + $seen + $productions + $minimum-next-id + $remaining + $constructors + $constructor-minimum-next-id) + (let $references + (_fuzz-grammar-reference-targets + $constructors) + (switch $references + (((FuzzGenerationError $code $details) + $references) + ($valid-references + (let $next-pending + (_fuzz-expression-concat + $tail + $valid-references) + (let $next-seen + (_fuzz-expression-append + $seen + (quote $type)) + (let $next-productions + (_fuzz-expression-concat + $productions + $constructors) + (_fuzz-build-type-grammar-loop + $schema + $root + $next-pending + $next-seen + $next-productions + (max + $minimum-next-id + $constructor-minimum-next-id) + (- $remaining 1)))))))))) + +(= (_fuzz-build-type-grammar-available + $schema + $root + $type + $tail + $seen + $productions + $minimum-next-id + $remaining + $available) + (switch $available + (((PreparedTypeConstructors + $constructors + $constructor-minimum-next-id) + (_fuzz-build-type-grammar-prepared + $schema + $root + $type + $tail + $seen + $productions + $minimum-next-id + $remaining + $constructors + $constructor-minimum-next-id)) + ((FuzzGenerationError $code $details) + $available) + ($bad + (_fuzz-generation-error + MalformedTypeSchemaValidation + (Schema $schema) + (Type (quote $type)) + (Value $bad)))))) + +(= (_fuzz-build-type-grammar-type + $schema + $root + $type + $tail + $seen + $productions + $minimum-next-id + $remaining) + (let $present + (_fuzz-grammar-target-member + $type + $seen) + (switch $present + ((True + (_fuzz-build-type-grammar-loop + $schema + $root + $tail + $seen + $productions + $minimum-next-id + $remaining)) + (False + (if (<= $remaining 0) + (_fuzz-generation-error + TypeSchemaExpansionLimitExceeded + (Schema $schema) + (Root (quote $root)) + (Limit 256)) + (_fuzz-build-type-grammar-available + $schema + $root + $type + $tail + $seen + $productions + $minimum-next-id + $remaining + (_fuzz-source-productions + (DynamicTypeGrammar + (quote $schema)) + (quote $type))))) + ((FuzzGenerationError $code $details) + $present) + ($bad + (_fuzz-generation-error + MalformedGrammarTargetMembership + (Type (quote $type)) + (Value $bad))))))) + +(= (_fuzz-build-type-grammar-loop + $schema + $root + $pending + $seen + $productions + $minimum-next-id + $remaining) + (if-decons-expr + $pending + $quoted + $tail + (_fuzz-grammar-template-switch $quoted + (((quote $type) + (_fuzz-build-type-grammar-type + $schema + $root + $type + $tail + $seen + $productions + $minimum-next-id + $remaining)) + ($bad + (_fuzz-generation-error + MalformedGrammarTarget + (Value $bad))))) + (_fuzz-finalize-type-grammar + $schema + $root + $productions + $minimum-next-id))) + +(= (_fuzz-build-type-grammar + $schema + $type) + (_fuzz-build-type-grammar-loop + $schema + $type + ((quote $type)) + () + () + 0 + 256)) + +(= (_fuzz-gen-well-typed-ground + (quote $schema) + (quote $type)) + (let $validated + (_fuzz-build-type-grammar + $schema + $type) + (switch $validated + (((ValidatedTypeGrammar + (quote $seen-schema) + (quote $seen-type) + $constructors + $minimum-next-id) + (GenCustom + _fuzz-grammar + (GrammarRequest + (StaticTypeGrammar + (quote $schema) + $constructors) + (quote $type) + () + $minimum-next-id))) + ((FuzzGenerationError $code $details) + $validated) + ($bad + (_fuzz-generation-error + MalformedTypeSchemaValidation + (Schema $schema) + (Type (quote $type)) + (Value $bad))))))) + +(= (gen-well-typed $schema $type) + (if (_fuzz-atom-ground (quote $schema)) + (if (_fuzz-atom-ground (quote $type)) + (_fuzz-gen-well-typed-ground + (quote $schema) + (quote $type)) + (_fuzz-generation-error + NonGroundTypeSchemaRequest + (Schema $schema) + (Type (quote $type)))) + (_fuzz-generation-error + NonGroundTypeSchemaName + (Schema (quote $schema))))) + +; Eligibility is one grounded call: the fit semantics (Use needs its sort in scope, a +; reference needs size > 0 and an eligible target at the split size, Scoped checks binding-id +; disjointness) run kernel-side over raw template syntax, memoised per grammar. The MeTTa +; side keeps the driver policy: which production a driver picks, and every wrapper shape. +(= (_fuzz-eligible-productions + $source + (quote $target) + $scope + $size) + (unify $source + (StaticGrammar (quote $grammar) $productions) + (_fuzz-eligible-productions-checked + $productions + (quote $target) + $scope + $size) + (unify $source + (StaticTypeGrammar (quote $schema) $productions) + (_fuzz-eligible-productions-checked + $productions + (quote $target) + $scope + $size) + (_fuzz-generation-error + MalformedGrammarSource + (Value $source))))) + +(= (_fuzz-eligible-productions-checked + $productions + (quote $target) + $scope + $size) + (let $eligible + (_fuzz-grammar-eligible-productions-op + $productions + (quote $target) + $scope + $size) + (unify $eligible + (EligibleGrammarProductions $selected) + $eligible + (unify $eligible + (FitDuplicateGrammarBindingId (quote $bindings)) + (_fuzz-generation-error + DuplicateGrammarBindingId + (Bindings $bindings)) + (unify $eligible + (FuzzKernelError $code $details) + (_fuzz-generation-error + KernelError + (OperationResult $eligible)) + (unify $eligible + $bad + (_fuzz-generation-error + MalformedEligibleGrammarProductions + (Target (quote $target)) + (Value $bad)) + Empty)))))) + +(= (_fuzz-grammar-weight-total + $productions + $total) + (if (== $productions ()) + $total + (let* ((($production $tail) + (decons-atom $productions))) + (switch $production + (((GrammarProduction + $index + $weight + (quote $target) + (quote $template)) + (_fuzz-grammar-weight-total + $tail + (+ $total $weight))) + ($bad $total)))))) + +(= (_fuzz-grammar-ticket-index + $productions + $ticket + $index) + (let* ((($production $tail) + (decons-atom $productions))) + (switch $production + (((GrammarProduction + $production-index + $weight + (quote $target) + (quote $template)) + (if (<= $ticket $weight) + $index + (_fuzz-grammar-ticket-index + $tail + (- $ticket $weight) + (+ $index 1)))) + ($bad $index))))) + +(= (_fuzz-grammar-random-production-choice + $rng + $productions) + (let* (($count (length $productions)) + ($total + (_fuzz-grammar-weight-total + $productions + 0)) + ($draw + (_fuzz-draw-int + $rng + 1 + $total))) + (switch $draw + (((FuzzDraw $ticket $next-rng) + (let $index + (_fuzz-grammar-ticket-index + $productions + $ticket + 0) + (DriverChoice + $index + (FuzzDriver Random $next-rng) + (_fuzz-int-decision + 0 + (- $count 1) + 0 + $index)))) + ($bad + (_fuzz-generation-error + KernelError + (OperationResult $bad))))))) + +(= (_fuzz-grammar-production-choice + $driver + $productions) + (switch $driver + (((FuzzDriver Random $rng) + (_fuzz-grammar-random-production-choice + $rng + $productions)) + ((FuzzDriver Edge $index) + (let* (($count + (length $productions)) + ($position + (% $index $count))) + (DriverChoice + $position + (FuzzDriver Edge (+ $index 1)) + (_fuzz-int-decision + 0 + (- $count 1) + 0 + $position)))) + ($other + (_fuzz-driver-int + $other + 0 + (- (length $productions) 1) + 0))))) + +(= (_fuzz-grammar-reference-size + $size + $ordinal + $total) + (if (and + (> $total 0) + (and + (<= 0 $ordinal) + (< $ordinal $total))) + (let* (($budget (max 0 (- $size 1))) + ($base (/ $budget $total)) + ($remainder (% $budget $total))) + (+ $base + (if (< $ordinal $remainder) + 1 + 0))) + (_fuzz-generation-error + MalformedIndexedGrammarReference + (Ordinal $ordinal) + (Total $total)))) + +(= (_fuzz-grammar-scope-values + $scope + $sort + $values) + (if-decons-expr + $scope + $binding + $tail + (_fuzz-grammar-template-switch $binding + (((GrammarBinding (quote $candidate) $id) + (let $next-values + (if (noreduce-eq $sort $candidate) + (let $marker + (_fuzz-variable-marker $id) + (_fuzz-expression-append + $values + $marker)) + $values) + (_fuzz-grammar-scope-values + $tail + $sort + $next-values))) + ($bad + (_fuzz-grammar-scope-values + $tail + $sort + $values)))) + $values)) + +; ---- the generation machine ---- +; One bare-tail machine generates a nonterminal: flat instruction plans compiled per template +; (kernel, memoised) execute against a frame chain and nested value/tree stacks, so neither +; template depth nor width costs engine stack, and no frame holds a growing value. Frames: +; (FPlan instrs len cursor size) one template's instructions in execution order +; (FExpr arity vdepth tdepth) an open expression node (snapshot depths for discards) +; (FRef (quote t)) wrap a completed reference +; (FProd (quote t) index pos ctree) wrap a completed production +; (FBind (quote s) id var) wrap a completed binder body +; (FScoped added) wrap a completed scoped body +; (FScope saved) restore the lexical scope +; The running state is (FuzzGenRun source frames values vdepth trees tdepth scope next-id driver); +; a discard unwinds as (FuzzGenCut source frames values vdepth trees tdepth reason tree driver), +; wrapping the partial tree through each frame exactly as the recursive interpreter did; both +; settle to (FuzzGenDone result). + +(= (_fuzz-gen-loop $state) + (if (_fuzz-gen-finished $state) + $state + (_fuzz-gen-loop (_fuzz-gen-step $state)))) + +(= (_fuzz-gen-finished $state) + (unify $state + (FuzzGenDone $result) + True + (unify $state + (FuzzGenRun $source $frames $values $vd $trees $td $scope $next-id $driver) + False + (unify $state + (FuzzGenCut $source $frames $values $vd $trees $td $reason $tree $driver) + False + True)))) + +(= (_fuzz-gen-step $state) + (unify $state + (FuzzGenRun $source $frames $values $vd $trees $td $scope $next-id $driver) + (_fuzz-gen-run-step + $source $frames $values $vd $trees $td $scope $next-id $driver) + (unify $state + (FuzzGenCut $source $frames $values $vd $trees $td $reason $tree $driver) + (_fuzz-gen-cut-step + $source $frames $values $vd $trees $td $reason $tree $driver) + $state))) + +; Push one generated value + decision tree. +(= (_fuzz-gen-push + $source $frames $values $vd $trees $td $scope $next-id $driver + $value + $tree) + (FuzzGenRun + $source + $frames + (FuzzStack $value $values) + (+ $vd 1) + (FuzzStack $tree $trees) + (+ $td 1) + $scope + $next-id + $driver)) + +(= (_fuzz-gen-run-step + $source $frames $values $vd $trees $td $scope $next-id $driver) + (unify $frames + (GF (FPlan $instrs $len $cursor $size) $parent) + (if (== $cursor $len) + (FuzzGenRun $source $parent $values $vd $trees $td $scope $next-id $driver) + (let $instr (index-atom $instrs $cursor) + (_fuzz-gen-instr + $source + (GF (FPlan $instrs $len (+ $cursor 1) $size) $parent) + $values $vd $trees $td $scope $next-id $driver + $instr + $size))) + (unify $frames + (GF (FRef (quote $target)) $parent) + (unify $values + (FuzzStack $value $rest-values) + (unify $trees + (FuzzStack $tree $rest-trees) + (_fuzz-gen-push + $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver + $value + (Decision GrammarRef (Target (quote $target)) () ($tree))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees)))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values)))) + (unify $frames + (GF (FProd (quote $target) $production-index $position $choice-tree) $parent) + (unify $values + (FuzzStack $value $rest-values) + (unify $trees + (FuzzStack $tree $rest-trees) + (let $children (_fuzz-two-children $choice-tree $tree) + (_fuzz-gen-push + $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver + $value + (Decision + GrammarProduction + (Target (quote $target)) + (ProductionIndex $production-index $position) + $children))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees)))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values)))) + (unify $frames + (GF (FBind (quote $sort) $binding-id $variable) $parent) + (unify $values + (FuzzStack $body $rest-values) + (unify $trees + (FuzzStack $tree $rest-trees) + (let $bound (_fuzz-expression-append ($variable) $body) + (_fuzz-gen-push + $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver + $bound + (Decision + GrammarBind + (Sort (quote $sort)) + (BindingId $binding-id) + ($tree)))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees)))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values)))) + (unify $frames + (GF (FScoped $added) $parent) + (unify $values + (FuzzStack $value $rest-values) + (unify $trees + (FuzzStack $tree $rest-trees) + (_fuzz-gen-push + $source $parent $rest-values (- $vd 1) $rest-trees (- $td 1) $scope $next-id $driver + $value + (Decision GrammarScoped (Bindings $added) () ($tree))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees)))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values)))) + (unify $frames + (GF (FScope $saved) $parent) + (FuzzGenRun $source $parent $values $vd $trees $td $saved $next-id $driver) + (unify $frames + GFB + (unify $values + (FuzzStack $value FuzzStackBottom) + (unify $trees + (FuzzStack $tree FuzzStackBottom) + (FuzzGenDone (GrammarResult $value $driver $next-id $tree)) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State trees)))) + (FuzzGenDone (_fuzz-generation-error MalformedGrammarMachineState (State values)))) + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarMachineState + (Frames $frames))))))))))) + +(= (_fuzz-gen-instr + $source $frames $values $vd $trees $td $scope $next-id $driver + $instr + $size) + (_fuzz-grammar-template-switch $instr + (((GILit (quote $value)) + (_fuzz-gen-push + $source $frames $values $vd $trees $td $scope $next-id $driver + $value + (Decision GrammarLiteral () (Value (quote $value)) ()))) + ((GIField $generator) + (let $sample (fuzz-generate $generator $driver $size) + (_fuzz-gen-field + $source $frames $values $vd $trees $td $scope $next-id $driver + $generator + $sample))) + ((GIRef (quote $target) $ordinal $total) + (if (> $size 0) + (let $child-size + (_fuzz-grammar-reference-size $size $ordinal $total) + (unify $child-size + (FuzzGenerationError $code $details) + (FuzzGenDone $child-size) + (_fuzz-gen-nonterminal + $source + (GF (FRef (quote $target)) $frames) + $values $vd $trees $td $scope $next-id $driver + (quote $target) + $child-size))) + (FuzzGenDone + (_fuzz-generation-error + GrammarDepthExhausted + (Target (quote $target)) + (Size $size))))) + ((GIFresh (quote $sort)) + (let $variable (_fuzz-variable-marker $next-id) + (_fuzz-gen-push + $source $frames $values $vd $trees $td $scope (+ $next-id 1) $driver + $variable + (Decision GrammarFresh (Sort (quote $sort)) (BindingId $next-id) ())))) + ((GIUse (quote $sort)) + (let $choices (_fuzz-grammar-scope-values $scope $sort ()) + (if (> (length $choices) 0) + (let $sample (fuzz-generate (gen-element $choices) $driver $size) + (_fuzz-gen-use + $source $frames $values $vd $trees $td $scope $next-id + (quote $sort) + $sample)) + (FuzzGenDone + (_fuzz-generation-error + UnboundGrammarUse + (Sort (quote $sort))))))) + ((GIBind (quote $sort) $body) + (let $variable (_fuzz-variable-marker $next-id) + (let $body-length (length $body) + (let $bound-scope (cons-atom (GrammarBinding (quote $sort) $next-id) $scope) + (FuzzGenRun + $source + (GF (FPlan $body $body-length 0 $size) + (GF (FBind (quote $sort) $next-id $variable) + (GF (FScope $scope) $frames))) + $values $vd $trees $td + $bound-scope + (+ $next-id 1) + $driver))))) + ((GIScoped $added $minimum-next-id (quote $raw) $body) + (if (_fuzz-grammar-scopes-disjoint $added $scope) + (let $body-length (length $body) + (let $bound-scope (_fuzz-expression-concat $added $scope) + (FuzzGenRun + $source + (GF (FPlan $body $body-length 0 $size) + (GF (FScoped $added) + (GF (FScope $scope) $frames))) + $values $vd $trees $td + $bound-scope + (max $next-id $minimum-next-id) + $driver))) + (FuzzGenDone + (_fuzz-generation-error + DuplicateGrammarBindingId + (Bindings $raw))))) + ((GIExprEnter $arity) + (let $entered (_fuzz-gen-insert-expr $frames $arity $vd $td) + (FuzzGenRun + $source + $entered + $values $vd $trees $td $scope $next-id $driver))) + ((GIExprBuild) + (unify $frames + (GF (FPlan $instrs $len $cursor $size2) (GF (FExpr $arity $svd $std) $parent)) + (let $taken-values (_fuzz-stack-take $values $arity) + (unify $taken-values + (FuzzStackTake $value-list $rest-values) + (let $taken-trees (_fuzz-stack-take $trees $arity) + (unify $taken-trees + (FuzzStackTake $tree-list $rest-trees) + (_fuzz-gen-push + $source + (GF (FPlan $instrs $len $cursor $size2) $parent) + $rest-values (- $vd $arity) $rest-trees (- $td $arity) $scope $next-id $driver + $value-list + (Decision GrammarExpression (Arity $arity) () $tree-list)) + (FuzzGenDone + (_fuzz-generation-error + KernelError + (OperationResult $taken-trees))))) + (FuzzGenDone + (_fuzz-generation-error + KernelError + (OperationResult $taken-values))))) + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarMachineState + (Frames $frames))))) + ($bad + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarInstruction + (Value $bad))))))) + +; GIExprEnter runs from inside the plan frame, so the expression frame is inserted below it. +(= (_fuzz-gen-insert-expr $frames $arity $vd $td) + (unify $frames + (GF $top $parent) + (GF $top (GF (FExpr $arity $vd $td) $parent)) + $frames)) + +(= (_fuzz-gen-field + $source $frames $values $vd $trees $td $scope $next-id $driver + $generator + $sample) + (unify $sample + (FuzzSample $value $next-driver $tree) + (if (_fuzz-contains-variable-marker $value) + (FuzzGenDone + (_fuzz-generation-error + ForgedGrammarVariableMarker + (Generator $generator) + (Value $value))) + (_fuzz-gen-push + $source $frames $values $vd $trees $td $scope $next-id $next-driver + $value + (Decision GrammarField (Generator $generator) () ($tree)))) + (unify $sample + (FuzzGenerationDiscard $reason $next-driver $tree) + (FuzzGenCut + $source $frames $values $vd $trees $td + $reason + (Decision GrammarField (Generator $generator) () ($tree)) + $next-driver) + (unify $sample + (FuzzGenerationError $code $details) + (FuzzGenDone $sample) + (unify $sample + $bad + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarFieldResult + (Generator $generator) + (Value $bad))) + Empty))))) + +(= (_fuzz-gen-use + $source $frames $values $vd $trees $td $scope $next-id + (quote $sort) + $sample) + (unify $sample + (FuzzSample $value $next-driver $tree) + (_fuzz-gen-push + $source $frames $values $vd $trees $td $scope $next-id $next-driver + $value + (Decision GrammarUse (Sort (quote $sort)) () ($tree))) + (unify $sample + (FuzzGenerationError $code $details) + (FuzzGenDone $sample) + (unify $sample + $bad + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarUseResult + (Sort (quote $sort)) + (Value $bad))) + Empty)))) + +(= (_fuzz-gen-nonterminal + $source $frames $values $vd $trees $td $scope $next-id $driver + (quote $target) + $size) + (let $eligible + (_fuzz-eligible-productions + $source + (quote $target) + $scope + $size) + (unify $eligible + (EligibleGrammarProductions $productions) + (if (> (length $productions) 0) + (let $choice (_fuzz-grammar-production-choice $driver $productions) + (_fuzz-gen-choose + $source $frames $values $vd $trees $td $scope $next-id + (quote $target) + $size + $productions + $choice)) + (FuzzGenCut + $source $frames $values $vd $trees $td + (NoEligibleGrammarProduction + (Target (quote $target)) + (Size $size)) + (Decision + GrammarUnavailable + (Target (quote $target)) + (Size $size) + ()) + $driver)) + (unify $eligible + (FuzzGenerationError $code $details) + (FuzzGenDone $eligible) + (FuzzGenDone + (_fuzz-generation-error + MalformedEligibleGrammarProductions + (Target (quote $target)) + (Value $eligible))))))) + +(= (_fuzz-gen-choose + $source $frames $values $vd $trees $td $scope $next-id + (quote $target) + $size + $productions + $choice) + (unify $choice + (DriverChoice $position $next-driver $choice-tree) + (if (and (<= 0 $position) (< $position (length $productions))) + (let $production (index-atom $productions $position) + (_fuzz-grammar-template-switch $production + (((GrammarProduction + $production-index + $weight + (quote $seen-target) + (quote $template)) + (let $planned (_fuzz-grammar-template-plan $template) + (unify $planned + (GrammarTemplatePlan $instrs) + (let $plan-length (length $instrs) + (FuzzGenRun + $source + (GF (FPlan $instrs $plan-length 0 $size) + (GF (FProd (quote $target) $production-index $position $choice-tree) + $frames)) + $values $vd $trees $td $scope $next-id $next-driver)) + (unify $planned + (FuzzKernelError $code $details) + (FuzzGenDone + (_fuzz-generation-error + KernelError + (OperationResult $planned))) + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarTemplatePlan + (Value $planned))))))) + ($bad + (FuzzGenDone + (_fuzz-generation-error + MalformedSelectedGrammarProduction + (Target (quote $target)) + (Production $bad))))))) + (FuzzGenDone + (_fuzz-generation-error + GrammarProductionIndexOutOfBounds + (Target (quote $target)) + (Position $position)))) + (unify $choice + (FuzzGenerationError $code $details) + (FuzzGenDone $choice) + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarProductionChoice + (Target (quote $target)) + (Value $choice)))))) + +(= (_fuzz-gen-cut-step + $source $frames $values $vd $trees $td $reason $tree $driver) + (unify $frames + (GF (FPlan $instrs $len $cursor $size) $parent) + (FuzzGenCut $source $parent $values $vd $trees $td $reason $tree $driver) + (unify $frames + (GF (FExpr $arity $svd $std) $parent) + (let $generated (- $td $std) + (let $taken-trees (_fuzz-stack-take $trees $generated) + (unify $taken-trees + (FuzzStackTake $tree-list $rest-trees) + (let $taken-values (_fuzz-stack-take $values $generated) + (unify $taken-values + (FuzzStackTake $value-list $rest-values) + (let $partial (_fuzz-expression-append $tree-list $tree) + (FuzzGenCut + $source $parent $rest-values $svd $rest-trees $std + $reason + (Decision + GrammarExpression + (Arity $arity) + (Generated (+ $generated 1)) + $partial) + $driver)) + (FuzzGenDone + (_fuzz-generation-error + KernelError + (OperationResult $taken-values))))) + (FuzzGenDone + (_fuzz-generation-error + KernelError + (OperationResult $taken-trees)))))) + (unify $frames + (GF (FRef (quote $target)) $parent) + (FuzzGenCut + $source $parent $values $vd $trees $td + $reason + (Decision GrammarRef (Target (quote $target)) () ($tree)) + $driver) + (unify $frames + (GF (FProd (quote $target) $production-index $position $choice-tree) $parent) + (let $children (_fuzz-two-children $choice-tree $tree) + (FuzzGenCut + $source $parent $values $vd $trees $td + $reason + (Decision + GrammarProduction + (Target (quote $target)) + (ProductionIndex $production-index $position) + $children) + $driver)) + (unify $frames + (GF (FBind (quote $sort) $binding-id $variable) $parent) + (FuzzGenCut + $source $parent $values $vd $trees $td + $reason + (Decision GrammarBind (Sort (quote $sort)) (BindingId $binding-id) ($tree)) + $driver) + (unify $frames + (GF (FScoped $added) $parent) + (FuzzGenCut + $source $parent $values $vd $trees $td + $reason + (Decision GrammarScoped (Bindings $added) () ($tree)) + $driver) + (unify $frames + (GF (FScope $saved) $parent) + (FuzzGenCut $source $parent $values $vd $trees $td $reason $tree $driver) + (unify $frames + GFB + (FuzzGenDone (FuzzGenerationDiscard $reason $driver $tree)) + (FuzzGenDone + (_fuzz-generation-error + MalformedGrammarMachineState + (Frames $frames)))))))))))) + +; The default generation path: start the kernel machine, and serve each of its effect +; requests with `fuzz-generate`, so user Field callbacks, custom generators, and the whole +; generator algebra stay ordinary MeTTa. The specification machine above remains callable +; through `_fuzz-generate-grammar-nonterminal-reference`, and a differential test drives +; both against identical drivers. +(= (_fuzz-gen-trampoline $outcome) + (unify $outcome + (GrammarMachineDone $result) + $result + (unify $outcome + (GrammarMachineNeed $suspended (EvaluateGenerator $generator $driver $sub-size)) + (let $descriptor $generator + (let $sample (fuzz-generate $descriptor $driver $sub-size) + (_fuzz-gen-trampoline + (_fuzz-grammar-machine-op + (GrammarMachineResume $suspended $sample))))) + (unify $outcome + $bad + (_fuzz-generation-error + MalformedGrammarMachineOutcome + (Value $bad)) + Empty)))) + +(= (_fuzz-generate-grammar-nonterminal + $source + (quote $target) + $scope + $next-id + $driver + $size) + (_fuzz-gen-trampoline + (_fuzz-grammar-machine-op + (GrammarMachineStart + $source + (quote $target) + $scope + $next-id + (WithDriver $driver $size))))) + +(= (_fuzz-generate-grammar-nonterminal-reference + $source + (quote $target) + $scope + $next-id + $driver + $size) + (let $settled + (_fuzz-gen-loop + (_fuzz-gen-nonterminal + $source + GFB + FuzzStackBottom + 0 + FuzzStackBottom + 0 + $scope + $next-id + $driver + (quote $target) + $size)) + (unify $settled + (FuzzGenDone $result) + $result + (_fuzz-generation-error + MalformedGrammarMachineState + (Value $settled))))) + +(= (_fuzz-drive-grammar-result + $result) + (unify $result + (GrammarResult $value $next-driver $next-id $tree) + (FuzzSample $value $next-driver $tree) + (unify $result + (FuzzGenerationDiscard $reason $next-driver $tree) + $result + (unify $result + (FuzzGenerationError $code $details) + $result + (unify $result + $bad + (_fuzz-generation-error + MalformedGrammarGenerationResult + (Value $bad)) + Empty))))) + +(= (CustomCapabilities + _fuzz-grammar + (GrammarRequest + $source + (quote $target) + $scope + $next-id)) + (FuzzCustomCapabilities + (Modes + (Random + Edge + Replay + ShrinkReplay + Exhaustive + Bytes)))) + +(= (DriveCustom + _fuzz-grammar + (GrammarRequest + $source + (quote $target) + $scope + $next-id) + $driver + $size) + (_fuzz-drive-grammar-result + (_fuzz-generate-grammar-nonterminal + $source + (quote $target) + $scope + $next-id + $driver + $size))) diff --git a/packages/fuzz/src/metta/60-shrink-runner.metta b/packages/fuzz/src/metta/60-shrink-runner.metta new file mode 100644 index 0000000..302f76a --- /dev/null +++ b/packages/fuzz/src/metta/60-shrink-runner.metta @@ -0,0 +1,1278 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +(= (_fuzz-case-observation $case) + (switch $case + (((FuzzCaseResult + $status + $tag + $details + $labels + $collected + $coverage + $annotations + (Results $results) + $steps) + (FuzzCaseObservation $status $tag $results)) + ($bad + (FuzzCaseObservation + Malformed + MalformedCaseResult + ($bad)))))) + +(= (_fuzz-strict-replay-case + $probe + $generator + $property + $quantifier + $decision + $size + $config) + (let $replayed (fuzz-replay $generator $decision $size) + (switch $replayed + (((FuzzSample $value $driver $actual-tree) + (let $case + (_fuzz-evaluate-property + $property + $quantifier + $value + (_fuzz-config-get CaseSteps $config) + (_fuzz-config-get CaseDepth $config) + (_fuzz-config-get EffectPolicy $config)) + (FuzzReplayEvaluation + $probe + $value + $actual-tree + $case))) + ((FuzzGenerationDiscard $reason $driver $actual-tree) + (FuzzReplayProblem + $probe + GenerationDiscard + (Reason $reason) + (DecisionTree $actual-tree))) + ((FuzzGenerationError $code $details) + (FuzzReplayProblem + $probe + GenerationError + (ErrorCode $code) + $details)) + ($bad + (FuzzReplayProblem + $probe + MalformedReplayResult + (Value $bad))))))) + +(= (_fuzz-replay-matches + $expected-value + $expected-tree + $expected-case + $replayed) + (switch $replayed + (((FuzzReplayEvaluation + $probe + $actual-value + $actual-tree + $actual-case) + (and + (_fuzz-replay-equal $expected-value $actual-value) + (and + (_fuzz-replay-equal $expected-tree $actual-tree) + (_fuzz-replay-equal + (_fuzz-case-observation $expected-case) + (_fuzz-case-observation $actual-case))))) + ($bad False)))) + +(= (_fuzz-stability-check + $stage + $generator + $property + $quantifier + $value + $decision + $case + $size + $config) + (let $first + (_fuzz-strict-replay-case + (Probe $stage 1) + $generator + $property + $quantifier + $decision + $size + $config) + (let $second + (_fuzz-strict-replay-case + (Probe $stage 2) + $generator + $property + $quantifier + $decision + $size + $config) + (if (and + (_fuzz-replay-matches + $value + $decision + $case + $first) + (_fuzz-replay-matches + $value + $decision + $case + $second)) + (FuzzStable $first $second) + (FuzzUnstable + (Stage $stage) + (ExpectedValue $value) + (ExpectedDecision $decision) + (ExpectedCase + (_fuzz-case-observation $case)) + (First $first) + (Second $second)))))) + +(= (_fuzz-shrink-case-acceptable + $expected-signature + $failure-mode + $case) + (switch $case + (((FuzzCaseResult + Fail + $tag + $details + $labels + $collected + $coverage + $annotations + $results + $steps) + (if (== $failure-mode AnyFailure) + True + (if (== $failure-mode SameFailureTag) + (== + $expected-signature + (_fuzz-failure-signature $tag)) + False))) + ($bad False)))) + +(= (_fuzz-shrink-add-visited $tree $visited) + (let $combined + (append $visited (cons-atom $tree ())) + (_fuzz-deduplicate-replay $combined))) + +; The shrink order (mettascript-shrink-v1): shortlex over the flattened decision leaves — fewer +; decisions first, then lexicographically smaller origin-distances. The runner accepts a reproducing +; candidate only when its canonical tree is strictly smaller under this order, so no candidate +; source (a built-in shrinker or a custom ShrinkChoices relation) can re-inflate an accepted +; counterexample through the lenient shrink replay. +(= (_fuzz-leaf-distance $leaf) + (unify $leaf + (Decision Int (Bounds $lower $upper) (Origin $origin) (Value $value) ()) + (abs-math (- $value $origin)) + 0)) + +; Flat accumulator: a decision tree carries one leaf per drawn decision, so a large machine run +; would nest an evaluator frame per leaf under recurse-then-cons. +(= (_fuzz-leaf-distances $leaves) + (_fuzz-leaf-distances-loop (FuzzLeafDistanceFold $leaves ()))) + +(= (_fuzz-leaf-distances-loop $state) + (if (_fuzz-leaf-distances-finished $state) + $state + (_fuzz-leaf-distances-loop (_fuzz-leaf-distances-step $state)))) + +(= (_fuzz-leaf-distances-finished $state) + (unify $state (FuzzLeafDistanceFold $leaves $reversed) False True)) + +(= (_fuzz-leaf-distances-step $state) + (unify $state + (FuzzLeafDistanceFold $leaves $reversed) + (if (== $leaves ()) + (reverse $reversed) + (let ($head $tail) (decons-atom $leaves) + (let $distance (_fuzz-leaf-distance $head) + (let $next (cons-atom $distance $reversed) + (FuzzLeafDistanceFold $tail $next))))) + $state)) + +(= (_fuzz-distances-less $first $second) + (if (== $first ()) + False + (let ($first-head $first-tail) (decons-atom $first) + (let ($second-head $second-tail) (decons-atom $second) + (if (< $first-head $second-head) + True + (if (> $first-head $second-head) + False + (_fuzz-distances-less $first-tail $second-tail))))))) + +(= (_fuzz-tree-strictly-smaller $candidate-tree $target-tree) + (let $candidate-leaves (_fuzz-decision-leaves-op $candidate-tree) + (let $target-leaves (_fuzz-decision-leaves-op $target-tree) + (unify $candidate-leaves + (FuzzDecisionLeaves $candidate-flat) + (unify $target-leaves + (FuzzDecisionLeaves $target-flat) + (let $candidate-count (length $candidate-flat) + (let $target-count (length $target-flat) + (if (< $candidate-count $target-count) + True + (if (> $candidate-count $target-count) + False + (_fuzz-distances-less + (_fuzz-leaf-distances $candidate-flat) + (_fuzz-leaf-distances $target-flat)))))) + False) + False)))) + +(= (_fuzz-shrink-finish + $status + (FuzzShrinkTarget $value $tree $case) + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (FuzzShrinkResult + $status + $attempts + $improvements + $value + $tree + $case)) + +(= (_fuzz-shrink-start + $context + (FuzzShrinkTarget $value $tree $case) + $progress) + (let $candidates (_fuzz-shrink-candidates $tree) + (switch $candidates + (((FuzzKernelError $code $details) + (FuzzShrinkError + CandidateGenerationFailed + (ErrorCode $code) + $details + $progress)) + ($valid + (_fuzz-shrink-search + (Candidates $valid) + $context + (FuzzShrinkTarget $value $tree $case) + $progress)))))) + +(= (_fuzz-shrink-search + (Candidates $remaining) + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $expected-signature) + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (if (== $remaining ()) + (_fuzz-shrink-finish + LocallyMinimal + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (if (>= + $attempts + (_fuzz-config-get MaxShrinks $config)) + (_fuzz-shrink-finish + MaxShrinksReached + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (if (>= + $improvements + (_fuzz-config-get + MaxShrinkImprovements + $config)) + (_fuzz-shrink-finish + MaxShrinkImprovementsReached + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (let ($candidate $tail) + (decons-atom $remaining) + (_fuzz-shrink-consider + $candidate + $tail + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $expected-signature) + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited))))))) + +(= (_fuzz-shrink-consider + $candidate + $remaining + $context + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (let $seen (_fuzz-replay-member $candidate $visited) + (_fuzz-shrink-consider-seen + $seen + $candidate + $remaining + $context + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)))) + +(= (_fuzz-shrink-consider-seen + True + $candidate + $remaining + $context + $target + $progress) + (_fuzz-shrink-search + (Candidates $remaining) + $context + $target + $progress)) + +(= (_fuzz-shrink-consider-seen + False + $candidate + $remaining + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $expected-signature) + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (let $candidate-visited + (_fuzz-shrink-add-visited $candidate $visited) + (let $replayed + (_fuzz-shrink-replay + $generator + $candidate + $size) + (_fuzz-shrink-consider-replay + $replayed + $remaining + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $expected-signature) + $target + (FuzzShrinkProgress + $attempts + $improvements + $candidate-visited) + $visited)))) + +(= (_fuzz-shrink-consider-seen + (FuzzKernelError $code $details) + $candidate + $remaining + $context + $target + $progress) + (FuzzShrinkError + VisitedTreeLookupFailed + (ErrorCode $code) + $details + $progress)) + +(= (_fuzz-shrink-consider-replay + (FuzzShrinkReplay $value $actual-tree) + $remaining + $context + $target + $progress + $previously-visited) + (_fuzz-shrink-consider-actual + $value + $actual-tree + $remaining + $context + $target + $progress + $previously-visited)) + +(= (_fuzz-shrink-consider-replay + (FuzzShrinkDiscard $reason $actual-tree) + $remaining + $context + $target + $progress + $previously-visited) + (_fuzz-shrink-search + (Candidates $remaining) + $context + $target + $progress)) + +(= (_fuzz-shrink-consider-replay + (FuzzGenerationError $code $details) + $remaining + $context + $target + $progress + $previously-visited) + (_fuzz-shrink-search + (Candidates $remaining) + $context + $target + $progress)) + +(= (_fuzz-shrink-consider-actual + $value + $actual-tree + $remaining + $context + $target + $progress + $previously-visited) + (let $seen + (_fuzz-replay-member + $actual-tree + $previously-visited) + (_fuzz-shrink-consider-actual-seen + $seen + $value + $actual-tree + $remaining + $context + $target + $progress))) + +(= (_fuzz-shrink-consider-actual-seen + True + $value + $actual-tree + $remaining + $context + $target + $progress) + (_fuzz-shrink-search + (Candidates $remaining) + $context + $target + $progress)) + +(= (_fuzz-shrink-consider-actual-seen + False + $value + $actual-tree + $remaining + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $expected-signature) + $target + (FuzzShrinkProgress + $attempts + $improvements + $visited)) + (let $actual-visited + (_fuzz-shrink-add-visited + $actual-tree + $visited) + (let $case + (_fuzz-evaluate-property + $property + $quantifier + $value + (_fuzz-config-get CaseSteps $config) + (_fuzz-config-get CaseDepth $config) + (_fuzz-config-get EffectPolicy $config)) + (let $next-progress + (FuzzShrinkProgress + (+ $attempts 1) + $improvements + $actual-visited) + (if (and + (_fuzz-shrink-case-acceptable + $expected-signature + (_fuzz-config-get FailureMode $config) + $case) + (unify $target + (FuzzShrinkTarget $target-value $target-tree $target-case) + (_fuzz-tree-strictly-smaller $actual-tree $target-tree) + False)) + (_fuzz-shrink-start + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $expected-signature) + (FuzzShrinkTarget + $value + $actual-tree + $case) + (FuzzShrinkProgress + (+ $attempts 1) + (+ $improvements 1) + $actual-visited)) + (_fuzz-shrink-search + (Candidates $remaining) + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $expected-signature) + $target + $next-progress)))))) + +(= (_fuzz-shrink-consider-actual-seen + (FuzzKernelError $code $details) + $value + $actual-tree + $remaining + $context + $target + $progress) + (FuzzShrinkError + VisitedTreeLookupFailed + (ErrorCode $code) + $details + $progress)) + +(= (_fuzz-run-shrinker + $generator + $property + $quantifier + $value + $decision + $case + $size + $config + $signature) + (_fuzz-shrink-start + (FuzzShrinkContext + $generator + $property + $quantifier + $size + $config + $signature) + (FuzzShrinkTarget $value $decision $case) + (FuzzShrinkProgress + 0 + 0 + (cons-atom $decision ())))) + +(= (_fuzz-shrink-claim $status $reason) + (switch $status + ((LocallyMinimal + (LocallyMinimalUnder + (Order mettascript-shrink-v1))) + (Disabled + (NotShrunk (Reason $reason))) + ($stopped + (SmallestFoundUnder + (Order mettascript-shrink-v1) + (StoppedBy $stopped)))))) + +(= (_fuzz-replay-record + $generator + $origin + $decision + $value) + (let $generator-key + (_fuzz-atom-key Replay $generator) + (switch $generator-key + (((FuzzKernelError $code $details) + (FuzzReplayUnavailable + (Stage Generator) + (Error $code $details))) + ($key + (let $encoded-decision + (_fuzz-encode-atom $decision) + (switch $encoded-decision + (((FuzzKernelError $code $details) + (FuzzReplayUnavailable + (Stage DecisionTree) + (Error $code $details))) + ($decision-codec + (let $encoded-value + (_fuzz-encode-atom $value) + (switch $encoded-value + (((FuzzKernelError $code $details) + (FuzzReplayUnavailable + (Stage ConcreteValue) + (Error $code $details))) + ($value-codec + (FuzzReplay + (Format 2) + (Origin $origin) + (GeneratorKey $key) + (DecisionTree $decision) + (EncodedDecisionTree $decision-codec) + (ConcreteValue $value) + (EncodedValue $value-codec))))))))))))))) + +(= (_fuzz-build-failure + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $original-value + $original-decision + (FuzzCaseResult + Fail + $original-tag + $original-details + $original-labels + $original-collected + $original-coverage + $original-annotations + (Results $original-results) + $original-steps) + $config + $state + $original-signature) + (FuzzShrinkTarget + $smallest-value + $smallest-decision + (FuzzCaseResult + Fail + $smallest-tag + $smallest-details + $smallest-labels + $smallest-collected + $smallest-coverage + $smallest-annotations + (Results $smallest-results) + $smallest-steps)) + (FuzzShrinkSummary + $status + $reason + $attempts + $accepted)) + (FuzzFailed + (Property $property-id) + (Phase $phase) + (CaseIndex $case-index) + (FailureTag $smallest-tag) + (FailureSignature + (_fuzz-failure-signature $smallest-tag)) + (OriginalFailureTag $original-tag) + (OriginalFailureSignature $original-signature) + (OriginalValue $original-value) + (OriginalDecision $original-decision) + (OriginalDetails $original-details) + (OriginalLabels $original-labels) + (OriginalCollected $original-collected) + (OriginalCoverage $original-coverage) + (OriginalAnnotations $original-annotations) + (OriginalPropertyResults $original-results) + (SmallestValue $smallest-value) + (SmallestDecision $smallest-decision) + (SmallestDetails $smallest-details) + (SmallestLabels $smallest-labels) + (SmallestCollected $smallest-collected) + (SmallestCoverage $smallest-coverage) + (SmallestAnnotations $smallest-annotations) + (PropertyResults $smallest-results) + (Replay + (_fuzz-failure-replay-record + $generator + $origin + $smallest-decision + $smallest-value + (FuzzCaseResult + Fail + $smallest-tag + $smallest-details + $smallest-labels + $smallest-collected + $smallest-coverage + $smallest-annotations + (Results $smallest-results) + $smallest-steps))) + (Shrink + (Order mettascript-shrink-v1) + (Status $status) + (Reason $reason) + (Attempts $attempts) + (Accepted $accepted) + (_fuzz-shrink-claim $status $reason)) + (_fuzz-run-statistics $state))) + +(= (_fuzz-build-flaky + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $original-value + $original-decision + $original-case + $config + $state + $signature) + $unstable + (FuzzShrinkSummary + $status + $reason + $attempts + $accepted)) + (FuzzFlaky + (Property $property-id) + (Phase $phase) + (CaseIndex $case-index) + (Origin $origin) + (OriginalValue $original-value) + (OriginalDecision $original-decision) + (OriginalCase + (_fuzz-case-observation $original-case)) + $unstable + (Shrink + (Order mettascript-shrink-v1) + (Status $status) + (Reason $reason) + (Attempts $attempts) + (Accepted $accepted)) + (_fuzz-run-statistics $state))) + +(= (_fuzz-failure-replay-record + $generator + $origin + $decision + $value + $case) + (let $record + (_fuzz-replay-record + $generator + $origin + $decision + $value) + (switch $record + (((FuzzReplayUnavailable $stage $error) $record) + ($available + (let $encoded-observation + (_fuzz-encode-atom + (_fuzz-case-observation $case)) + (switch $encoded-observation + (((FuzzKernelError $code $details) + (FuzzReplayUnavailable + (Stage PropertyObservation) + (Error $code $details))) + ($encoded $record))))))))) + +(= (_fuzz-failure-replayability + $generator + $origin + $decision + $value + $case) + (let $record + (_fuzz-failure-replay-record + $generator + $origin + $decision + $value + $case) + (switch $record + (((FuzzReplayUnavailable $stage $error) $record) + ($available (FuzzReplayReady)))))) + +(= (_fuzz-failure-target + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature)) + (FuzzShrinkTarget $value $decision $case)) + +(= (_fuzz-start-stability-check + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature)) + (let $stability + (_fuzz-stability-check + PreShrink + $generator + $property + $quantifier + $value + $decision + $case + $size + $config) + (_fuzz-after-pre-stability + $stability + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature)))) + +(= (_fuzz-start-replayability + (FuzzReplayUnavailable $stage $error) + $context) + (_fuzz-build-failure + $context + (_fuzz-failure-target $context) + (FuzzShrinkSummary + Disabled + (ReplayUnavailable $stage $error) + 0 + 0))) + +(= (_fuzz-start-replayability + (FuzzReplayReady) + $context) + (_fuzz-start-stability-check $context)) + +(= (_fuzz-start-failure-processing + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature)) + (if (== (_fuzz-config-get EffectPolicy $config) + ExternalEffects) + (_fuzz-build-failure + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature) + (FuzzShrinkTarget $value $decision $case) + (FuzzShrinkSummary + Disabled + ExternalEffectsWithoutReset + 0 + 0)) + (if (== $decision None) + (_fuzz-build-failure + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature) + (FuzzShrinkTarget $value $decision $case) + (FuzzShrinkSummary + Disabled + NoDecisionTree + 0 + 0)) + (if (<= (_fuzz-config-get MaxShrinks $config) 0) + (_fuzz-build-failure + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature) + (FuzzShrinkTarget $value $decision $case) + (FuzzShrinkSummary + Disabled + MaxShrinksZero + 0 + 0)) + (_fuzz-start-replayability + (_fuzz-failure-replayability + $generator + $origin + $decision + $value + $case) + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature)))))) + +(= (_fuzz-after-pre-stability + (FuzzStable $first $second) + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature)) + (let $shrunk + (_fuzz-run-shrinker + $generator + $property + $quantifier + $value + $decision + $case + $size + $config + $signature) + (_fuzz-after-shrink + $shrunk + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + $case + $config + $state + $signature)))) + +(= (_fuzz-after-pre-stability + (FuzzUnstable + $stage + $expected-value + $expected-decision + $expected-case + $first + $second) + $context) + (_fuzz-build-flaky + $context + (FuzzUnstable + $stage + $expected-value + $expected-decision + $expected-case + $first + $second) + (FuzzShrinkSummary + NotStarted + PreShrinkReplayMismatch + 0 + 0))) + +(= (_fuzz-after-shrink + (FuzzShrinkResult + $status + $attempts + $accepted + $value + $decision + $case) + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $original-value + $original-decision + $original-case + $config + $state + $signature)) + (let $stability + (_fuzz-stability-check + PostShrink + $generator + $property + $quantifier + $value + $decision + $case + $size + $config) + (_fuzz-after-post-stability + $stability + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $original-value + $original-decision + $original-case + $config + $state + $signature) + (FuzzShrinkTarget $value $decision $case) + (FuzzShrinkSummary + $status + None + $attempts + $accepted)))) + +(= (_fuzz-after-shrink + (FuzzShrinkError + $code + $first + $second + (FuzzShrinkProgress + $attempts + $accepted + $visited)) + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $original-value + $original-decision + $original-case + $config + $state + $signature)) + (_fuzz-build-failure + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $original-value + $original-decision + $original-case + $config + $state + $signature) + (FuzzShrinkTarget + $original-value + $original-decision + $original-case) + (FuzzShrinkSummary + Error + (ShrinkError $code $first $second) + $attempts + $accepted))) + +(= (_fuzz-after-post-stability + (FuzzStable $first $second) + $context + $target + $summary) + (_fuzz-build-failure + $context + $target + $summary)) + +(= (_fuzz-after-post-stability + (FuzzUnstable + $stage + $expected-value + $expected-decision + $expected-case + $first + $second) + $context + $target + (FuzzShrinkSummary + $status + $reason + $attempts + $accepted)) + (_fuzz-build-flaky + $context + (FuzzUnstable + $stage + $expected-value + $expected-decision + $expected-case + $first + $second) + (FuzzShrinkSummary + $status + PostShrinkReplayMismatch + $attempts + $accepted))) + +(= (_fuzz-finalize-failure + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + (FuzzCaseResult + Fail + $tag + $details + $labels + $collected + $coverage + $annotations + $results + $steps) + $config + $state) + (let $signature (_fuzz-failure-signature $tag) + (_fuzz-start-failure-processing + (FuzzFailureContext + $property-id + $generator + $property + $quantifier + $phase + $case-index + $origin + $size + $value + $decision + (FuzzCaseResult + Fail + $tag + $details + $labels + $collected + $coverage + $annotations + $results + $steps) + $config + $state + $signature)))) diff --git a/packages/fuzz/src/metta/65-machines.metta b/packages/fuzz/src/metta/65-machines.metta new file mode 100644 index 0000000..506553d --- /dev/null +++ b/packages/fuzz/src/metta/65-machines.metta @@ -0,0 +1,756 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Model-based state machines. A machine is declared as ordinary MeTTa data: +; +; (FuzzMachine Counter +; (InitialModel (Count 0)) +; (InitializeReal counter-initialize) +; (CommandGenerator counter-command-generator) +; (Precondition counter-precondition) +; (Execute counter-execute) +; (NextModel counter-next-model) +; (Postcondition counter-postcondition) +; (Invariant counter-invariant) +; (Cleanup counter-cleanup)) +; +; Generation walks the abstract model only: `(CommandGenerator model)` returns a command +; generator, each drawn command must satisfy `(Precondition model command)`, and +; `(NextModel model command)` threads the model forward without touching the real system. +; Execution happens in the `fuzz-machine-run` property: it builds the real system with +; `(InitializeReal)`, checks `(Invariant model)` before the first command and after every +; model update, rechecks each precondition, runs `(Execute real command)`, judges +; `(Postcondition model command result)` against the pre-command model, and always calls +; `(Cleanup real)`. `NextModel` stays a pure symbolic transition, so the model can never +; absorb behavior from the system it is meant to predict. Cleanup's world effects roll back +; with the rest of the run (the case sandbox restores the pre-run world), so cleanup matters +; for genuinely external resources: host-effectful operations under the ExternalEffects +; policy, whose effects live outside the world. A MeTTa cleanup relation cannot run after a +; host-level abort either; an external system needs a host try/finally reset adapter around +; the whole check. + +(= (_fuzz-machine-spec-results $name $results) + (switch $results + ((() + (_fuzz-generation-error + MissingFuzzMachine + (Name $name))) + (($spec) + (ValidMachineSpec $spec)) + ($many + (_fuzz-generation-error + AmbiguousFuzzMachine + (Name $name) + (Results $many)))))) + +(= (_fuzz-machine-spec $name) + (let $results + (collapse + (match &self + (FuzzMachine $name + (InitialModel $initial) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (MachineSpec + (InitialModel (quote $initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)))) + (_fuzz-machine-spec-results $name $results))) + +; Cardinality-checked applications for the machine's user relations, sharing +; `_fuzz-call-results-bind` and `_fuzz-bool-result` with the unary helper. Each collapse-bind +; sits inside a function/chain context so the call reaches it raw; an evaluated argument would +; branch first and a nondeterministic relation would slip through as parallel single results. +(= (_fuzz-machine-call-zero $function $context) + (function + (chain (context-space) $space + (chain (collapse-bind (metta ($function) %Undefined% $space)) $pairs + (chain (eval (_fuzz-call-results-bind $pairs $context)) $out + (return $out)))))) + +(= (_fuzz-machine-call-two $function $first $second $context) + (function + (chain (context-space) $space + (chain (collapse-bind (metta ($function $first $second) %Undefined% $space)) $pairs + (chain (eval (_fuzz-call-results-bind $pairs $context)) $out + (return $out)))))) + +(= (_fuzz-machine-call-three $function $first $second $third $context) + (function + (chain (context-space) $space + (chain (collapse-bind (metta ($function $first $second $third) %Undefined% $space)) $pairs + (chain (eval (_fuzz-call-results-bind $pairs $context)) $out + (return $out)))))) + +(= (_fuzz-machine-bool-two $function $first $second $context) + (_fuzz-bool-result + (_fuzz-machine-call-two $function $first $second $context) + $context)) + +; One command for the current model: draw from the user generator and retry, up to a fixed +; budget, until the precondition holds. Every attempt's decision tree is recorded in the +; command's MachineCommand node (the same shape gen-filter uses), so replay repeats the +; rejected draws deterministically and the whole sequence stays a pure function of its tree. +(= (_fuzz-machine-command-descriptor $command-generator $model) + (let $called + (_fuzz-call-one + $command-generator + $model + (MachineCommandGenerator (Model (quote $model)))) + (switch $called + (((CallOne $descriptor) (CallOne $descriptor)) + ((FuzzGenerationError $code $details) $called) + ($bad + (_fuzz-generation-error + MalformedMachineCommandGenerator + (Value $bad))))))) + +(= (_fuzz-machine-draw-command + $descriptor $precondition $model $driver $size $attempt $attempt-trees-reversed) + (_fuzz-machine-draw-loop + (MachineDraw + $descriptor $precondition $model $driver $size + $attempt $attempt-trees-reversed))) + +(= (_fuzz-machine-draw-loop $state) + (if (_fuzz-machine-draw-finished $state) + $state + (_fuzz-machine-draw-loop (_fuzz-machine-draw-step $state)))) + +(= (_fuzz-machine-draw-finished $state) + (unify $state + (MachineDraw + $descriptor $precondition $model $driver $size + $attempt $attempt-trees-reversed) + False + True)) + +(= (_fuzz-machine-draw-step $state) + (unify $state + (MachineDraw + $descriptor $precondition $model $driver $size + $attempt $attempt-trees-reversed) + (if (> $attempt 16) + (let* (($children (reverse $attempt-trees-reversed)) + ($tree + (Decision + MachineCommand + (MaximumAttempts 16) + (Attempts 16) + $children))) + (FuzzGenerationDiscard + (MachineCommandRetriesExhausted (Attempts 16)) + $driver + $tree)) + (let $sample (fuzz-generate $descriptor $driver $size) + (switch $sample + (((FuzzSample $command $next-driver $draw-tree) + (let $checked + (_fuzz-machine-bool-two + $precondition + $model + $command + (MachinePrecondition + (Attempt $attempt) + (Command (quote $command)))) + (switch $checked + (((CallBool True) + (let* (($children + (reverse + (cons-atom $draw-tree $attempt-trees-reversed))) + ($tree + (Decision + MachineCommand + (MaximumAttempts 16) + (Attempts $attempt) + $children))) + (MachineCommandDrawn $command $next-driver $tree))) + ((CallBool False) + (let $next-trees + (cons-atom $draw-tree $attempt-trees-reversed) + (MachineDraw + $descriptor + $precondition + $model + $next-driver + $size + (+ $attempt 1) + $next-trees))) + ((FuzzGenerationError $code $details) $checked) + ($bad + (_fuzz-generation-error + MalformedMachinePrecondition + (Value $bad))))))) + ((FuzzGenerationDiscard $reason $next-driver $draw-tree) + (let* (($children + (reverse (cons-atom $draw-tree $attempt-trees-reversed))) + ($tree + (Decision + MachineCommand + (MaximumAttempts 16) + (Attempts $attempt) + $children))) + (FuzzGenerationDiscard $reason $next-driver $tree))) + ((FuzzGenerationError $code $details) $sample) + ($bad + (_fuzz-generation-error + MalformedGenerationResult + (Value $bad))))))) + $state)) + +(= (CustomCapabilities _fuzz-machine (MachineSequence $quoted-name $spec)) + (FuzzCustomCapabilities + (Modes + (Random + Edge + Replay + ShrinkReplay + Exhaustive + Bytes)))) + +; Sequence generation: one integer decision for the length in [0, size], then one +; model-aware command per step. The value embeds the machine name and spec so the +; executor property needs no space read. +(= (DriveCustom _fuzz-machine (MachineSequence $quoted-name $spec) $driver $size) + (unify $spec + (MachineSpec + (InitialModel (quote $initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (let $length-choice (_fuzz-driver-int $driver 0 $size 0) + (switch $length-choice + (((DriverChoice $count $next-driver $length-decision) + (let $seed-trees (cons-atom $length-decision ()) + (_fuzz-machine-gen-loop + (MachineGenRun + $quoted-name + $spec + $initial + $count + $next-driver + $size + $seed-trees + ())))) + ((FuzzGenerationError $code $details) $length-choice) + ($bad + (_fuzz-generation-error + MalformedDriverChoice + (Value $bad)))))) + (_fuzz-generation-error MalformedMachineSpec (Value $spec)))) + +(= (_fuzz-machine-gen-loop $state) + (if (_fuzz-machine-gen-finished $state) + $state + (_fuzz-machine-gen-loop (_fuzz-machine-gen-step $state)))) + +(= (_fuzz-machine-gen-finished $state) + (unify $state + (MachineGenRun + $quoted-name $spec $model $remaining $driver $size + $trees-reversed $commands-reversed) + False + True)) + +(= (_fuzz-machine-gen-step $state) + (unify $state + (MachineGenRun + $quoted-name $spec $model $remaining $driver $size + $trees-reversed $commands-reversed) + (if (== $remaining 0) + (let* (($commands (reverse $commands-reversed)) + ($children (reverse $trees-reversed)) + ($count (length $commands)) + ($value (FuzzMachineRun $quoted-name $spec $commands)) + ($tree (Decision MachineSequence (Count $count) () $children))) + (FuzzSample $value $driver $tree)) + (unify $spec + (MachineSpec + (InitialModel (quote $initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (let $described + (_fuzz-machine-command-descriptor + $command-generator + $model) + (switch $described + (((FuzzGenerationError $code $details) $described) + ((CallOne $descriptor) + (let $sample + (_fuzz-machine-draw-command + $descriptor + $precondition + $model + $driver + $size + 1 + ()) + (switch $sample + (((MachineCommandDrawn $command $next-driver $tree) + (let $stepped + (_fuzz-machine-call-two + $next-model + $model + $command + (MachineNextModel + (Model (quote $model)) + (Command (quote $command)))) + (switch $stepped + (((CallOne $next-model-value) + (let* (($next-trees + (cons-atom $tree $trees-reversed)) + ($next-commands + (cons-atom $command $commands-reversed))) + (MachineGenRun + $quoted-name + $spec + $next-model-value + (- $remaining 1) + $next-driver + $size + $next-trees + $next-commands))) + ((FuzzGenerationError $code $details) $stepped) + ($bad + (_fuzz-generation-error + MalformedMachineModel + (Value $bad))))))) + ((FuzzGenerationDiscard $reason $next-driver $tree) + (let* (($children + (reverse (cons-atom $tree $trees-reversed))) + ($count (length $commands-reversed)) + ($wrapped + (Decision + MachineSequence + (Count $count) + () + $children))) + (FuzzGenerationDiscard + $reason + $next-driver + $wrapped))) + ((FuzzGenerationError $code $details) $sample) + ($bad + (_fuzz-generation-error + MalformedGenerationResult + (Value $bad)))))))))) + (_fuzz-generation-error MalformedMachineSpec (Value $spec)))) + $state)) + +; Structural shrink candidates in the handoff's stable order: remove large command chunks +; first, then smaller chunks by ascending start index. Individual command trees shrink +; afterwards through the generic child descent. Every candidate replays from the initial +; model, so a chunk whose suffix no longer satisfies its preconditions is discarded by the +; filter during shrink replay and rejected. +(= (ShrinkChoices _fuzz-machine (MachineSequence $quoted-name $spec) $decision) + (let $candidates (_fuzz-machine-chunk-candidates $decision) + (superpose $candidates))) + +(= (_fuzz-machine-chunk-candidates $decision) + (switch $decision + (((Decision Custom $metadata $selection ($sequence)) + (switch $sequence + (((Decision MachineSequence $count-metadata $sequence-selection $children) + (if-decons-expr + $children + $length-decision + $command-trees + (_fuzz-machine-chunk-sizes + $decision + $length-decision + $command-trees + (length $command-trees)) + ())) + ($bad ())))) + ($bad ())))) + +(= (_fuzz-machine-chunk-sizes $decision $length-decision $command-trees $chunk) + (if (< $chunk 1) + () + (let* (($here + (_fuzz-machine-chunk-starts + $decision + $length-decision + $command-trees + $chunk + 0)) + ($half (if (== $chunk 1) 0 (trunc-math (/ $chunk 2)))) + ($rest + (_fuzz-machine-chunk-sizes + $decision + $length-decision + $command-trees + $half))) + (append $here $rest)))) + +(= (_fuzz-machine-chunk-starts $decision $length-decision $command-trees $chunk $start) + (if (> (+ $start $chunk) (length $command-trees)) + () + (let* (($candidate + (_fuzz-machine-remove-chunk + $decision + $length-decision + $command-trees + $chunk + $start)) + ($rest + (_fuzz-machine-chunk-starts + $decision + $length-decision + $command-trees + $chunk + (+ $start 1)))) + (cons-atom $candidate $rest)))) + +(= (_fuzz-machine-remove-chunk $decision $length-decision $command-trees $chunk $start) + (switch $decision + (((Decision Custom $metadata $selection ($sequence)) + (let* (($prefix (_fuzz-list-take $command-trees $start)) + ($suffix (_fuzz-list-drop $command-trees (+ $start $chunk))) + ($kept (append $prefix $suffix)) + ($count (length $kept)) + ($shortened + (_fuzz-machine-shorten-length $length-decision $count)) + ($rebuilt-children (cons-atom $shortened $kept)) + ($rebuilt + (Decision + MachineSequence + (Count $count) + () + $rebuilt-children)) + ($rebuilt-child (cons-atom $rebuilt ()))) + (Decision Custom $metadata $selection $rebuilt-child))) + ($bad $bad)))) + +(= (_fuzz-machine-shorten-length $length-decision $count) + (switch $length-decision + (((Decision Int (Bounds $lower $upper) (Origin $origin) (Value $value) ()) + (_fuzz-int-decision $lower $upper $origin $count)) + ($bad $bad)))) + +; Public surface: `(gen-machine Name)` generates `(FuzzMachineRun (quote Name) spec +; commands)` values, and `fuzz-machine-run` is the ordinary arity-one property that +; executes them, so machines run under fuzz-check, fuzz-check-exhaustive, replay, and +; shrinking without special cases. +(= (gen-machine $name) + (if (_fuzz-atom-ground $name) + (let $validated (_fuzz-machine-spec $name) + (switch $validated + (((ValidMachineSpec $spec) + (GenCustom _fuzz-machine (MachineSequence (quote $name) $spec))) + ((FuzzGenerationError $code $details) $validated) + ($bad + (_fuzz-generation-error + MalformedMachineSpec + (Value $bad)))))) + (_fuzz-generation-error NonGroundMachineName (Name $name)))) + +(: fuzz-machine-run (-> Atom FuzzProperty)) +(= (fuzz-machine-run $value) + (unify $value + (FuzzMachineRun $quoted-name $spec $commands) + (unify $spec + (MachineSpec + (InitialModel (quote $initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (let $started + (_fuzz-machine-call-zero + $initialize + (MachineInitializeReal $quoted-name)) + (switch $started + (((CallOne $real) + (let $verdict + (_fuzz-machine-exec-start + $spec + $initial + $real + $commands) + (_fuzz-machine-cleanup $cleanup $real $verdict))) + ((FuzzGenerationError $code $details) + (fuzz-fail MachineInitializeFailed (CausedBy $started))) + ($bad + (fuzz-fail MachineInitializeFailed (Value $bad)))))) + (fuzz-fail MalformedMachineSpec (Value (quote $spec)))) + (fuzz-fail MalformedMachineRun (Value (quote $value))))) + +(= (_fuzz-machine-exec-start $spec $initial $real $commands) + (unify $spec + (MachineSpec + (InitialModel (quote $unused-initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (let $checked + (_fuzz-call-bool + $invariant + $initial + (MachineInvariant (Step 0) (Model (quote $initial)))) + (switch $checked + (((CallBool True) + (_fuzz-machine-exec-loop + (MachineExecRun $spec $initial $real $commands 0))) + ((CallBool False) + (let $failed + (fuzz-fail + MachineInvariantViolated + ((Step 0) (Model (quote $initial)))) + (MachineVerdict $failed))) + ((FuzzGenerationError $code $details) + (let $failed + (fuzz-fail MachineInvariantError (CausedBy $checked)) + (MachineVerdict $failed))) + ($bad + (let $failed + (fuzz-fail MachineInvariantError (Value $bad)) + (MachineVerdict $failed)))))) + (let $failed + (fuzz-fail MalformedMachineSpec (Value (quote $spec))) + (MachineVerdict $failed)))) + +(= (_fuzz-machine-exec-loop $state) + (if (_fuzz-machine-exec-finished $state) + $state + (_fuzz-machine-exec-loop (_fuzz-machine-exec-step $state)))) + +(= (_fuzz-machine-exec-finished $state) + (unify $state + (MachineExecRun $spec $model $real $commands $index) + False + True)) + +(= (_fuzz-machine-exec-step $state) + (unify $state + (MachineExecRun $spec $model $real $commands $index) + (if (== $commands ()) + (let $pass (fuzz-pass) + (MachineVerdict $pass)) + (unify $spec + (MachineSpec + (InitialModel (quote $unused-initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (let* ((($command $rest) (decons-atom $commands)) + ($pre + (_fuzz-machine-bool-two + $precondition + $model + $command + (MachinePrecondition + (Step $index) + (Command (quote $command)))))) + (switch $pre + (((CallBool False) + (let $verdict + (fuzz-discard + (MachinePreconditionViolated + (Step $index) + (Command (quote $command)))) + (MachineVerdict $verdict))) + ((CallBool True) + (_fuzz-machine-exec-command + $spec $model $real $command $rest $index)) + ((FuzzGenerationError $code $details) + (let $failed + (fuzz-fail MachinePreconditionError (CausedBy $pre)) + (MachineVerdict $failed))) + ($bad + (let $failed + (fuzz-fail MachinePreconditionError (Value $bad)) + (MachineVerdict $failed)))))) + (let $failed + (fuzz-fail MalformedMachineSpec (Value (quote $spec))) + (MachineVerdict $failed)))) + $state)) + +(= (_fuzz-machine-exec-command $spec $model $real $command $rest $index) + (unify $spec + (MachineSpec + (InitialModel (quote $unused-initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (let $ran + (_fuzz-machine-call-two + $execute + $real + $command + (MachineExecute (Step $index) (Command (quote $command)))) + (switch $ran + (((CallOne $result) + (let $post + (_fuzz-bool-result + (_fuzz-machine-call-three + $postcondition + $model + $command + $result + (MachinePostcondition (Step $index))) + (MachinePostcondition (Step $index))) + (switch $post + (((CallBool False) + (let $failed + (fuzz-fail + MachinePostconditionFailed + ((Step $index) + (Command (quote $command)) + (Result (quote $result)) + (Model (quote $model)))) + (MachineVerdict $failed))) + ((CallBool True) + (_fuzz-machine-exec-advance + $spec $model $real $command $result $rest $index)) + ((FuzzGenerationError $code $details) + (let $failed + (fuzz-fail MachinePostconditionError (CausedBy $post)) + (MachineVerdict $failed))) + ($bad + (let $failed + (fuzz-fail MachinePostconditionError (Value $bad)) + (MachineVerdict $failed))))))) + ((FuzzGenerationError $code $details) + (let $failed + (fuzz-fail MachineExecuteFailed (CausedBy $ran)) + (MachineVerdict $failed))) + ($bad + (let $failed + (fuzz-fail MachineExecuteFailed (Value $bad)) + (MachineVerdict $failed)))))) + (let $failed + (fuzz-fail MalformedMachineSpec (Value (quote $spec))) + (MachineVerdict $failed)))) + +(= (_fuzz-machine-exec-advance $spec $model $real $command $result $rest $index) + (unify $spec + (MachineSpec + (InitialModel (quote $unused-initial)) + (InitializeReal $initialize) + (CommandGenerator $command-generator) + (Precondition $precondition) + (Execute $execute) + (NextModel $next-model) + (Postcondition $postcondition) + (Invariant $invariant) + (Cleanup $cleanup)) + (let $stepped + (_fuzz-machine-call-two + $next-model + $model + $command + (MachineNextModel + (Model (quote $model)) + (Command (quote $command)))) + (switch $stepped + (((CallOne $next) + (let $checked + (_fuzz-call-bool + $invariant + $next + (MachineInvariant + (Step (+ $index 1)) + (Model (quote $next)))) + (switch $checked + (((CallBool True) + (MachineExecRun $spec $next $real $rest (+ $index 1))) + ((CallBool False) + (let $failed + (fuzz-fail + MachineInvariantViolated + ((Step (+ $index 1)) (Model (quote $next)))) + (MachineVerdict $failed))) + ((FuzzGenerationError $code $details) + (let $failed + (fuzz-fail MachineInvariantError (CausedBy $checked)) + (MachineVerdict $failed))) + ($bad + (let $failed + (fuzz-fail MachineInvariantError (Value $bad)) + (MachineVerdict $failed))))))) + ((FuzzGenerationError $code $details) + (let $failed + (fuzz-fail MachineNextModelFailed (CausedBy $stepped)) + (MachineVerdict $failed))) + ($bad + (let $failed + (fuzz-fail MachineNextModelFailed (Value $bad)) + (MachineVerdict $failed)))))) + (let $failed + (fuzz-fail MalformedMachineSpec (Value (quote $spec))) + (MachineVerdict $failed)))) + +(= (_fuzz-machine-cleanup $cleanup $real $verdict) + (let $cleaned + (_fuzz-call-one + $cleanup + $real + (MachineCleanup)) + (switch $cleaned + (((CallOne $ignored) + (unify $verdict + (MachineVerdict $property) + $property + (fuzz-fail MalformedMachineVerdict (Value (quote $verdict))))) + ((FuzzGenerationError $code $details) + (unify $verdict + (MachineVerdict $property) + (_fuzz-machine-cleanup-verdict $property $cleaned) + (fuzz-fail MalformedMachineVerdict (Value (quote $verdict))))) + ($bad + (fuzz-fail MachineCleanupFailed (Value $bad))))))) + +; A cleanup error surfaces only when the run itself passed; a real counterexample keeps +; its own failure. +(= (_fuzz-machine-cleanup-verdict $property $cleanup-error) + (unify $property + (Pass) + (fuzz-fail MachineCleanupFailed (CausedBy $cleanup-error)) + $property)) + +(= (fuzz-check-machine $name $config) + (fuzz-check $name (gen-machine $name) fuzz-machine-run $config)) diff --git a/packages/fuzz/src/metta/70-reachability.metta b/packages/fuzz/src/metta/70-reachability.metta new file mode 100644 index 0000000..917755f --- /dev/null +++ b/packages/fuzz/src/metta/70-reachability.metta @@ -0,0 +1,745 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Bounded state reachability over a model transition relation, as deterministic level-order +; breadth-first search: +; +; !(fuzz-reachable Counter (Count 0) +; counter-enumerate counter-transition counter-target? +; (reach-config (MaxDepth 20) (MaxStates 5000) (MaxTransitions 200000))) +; +; The command enumerator returns `(FiniteCommands c1 c2 ...)` or `(IncompleteCommands reason)`. +; The transition relation may return several next states; the whole ordered result bag becomes +; outgoing edges and each branch's index is recorded, so a witness names exactly one branch. +; Breadth-first order makes the first witness shortest in transition count. +; +; `MaxDepth` bounds the depth of every state the search considers, so a reported witness is never +; longer than `MaxDepth` commands. The boundary level is still enumerated, because a state with no +; command at all ends the model while a state with commands continues past the bound, and that is what +; separates exhaustion from a depth answer; no transition runs there, so no deeper state is built. +; +; The outcomes are kept apart on purpose. `FuzzReachable` carries a witness that was replayed from +; the initial model before being reported. `FuzzUnreachableWithinDepth` says only that no target +; occurred at or below the depth actually completed. `FuzzReachabilityExhausted` is reported only +; when the frontier ran dry with every command enumeration complete and no limit fired: it means +; unreachable in the declared finite model, never unreachable in an external system. Every limit, +; incomplete enumeration, relation failure, or replay mismatch is a `FuzzReachabilityCutoff` and +; never becomes exhaustion. +; +; State identity is exact structural equality by default. `(StateIdentity Alpha)` merges +; alpha-variant states and is valid only when the transition and target relations are equivariant +; under variable renaming, which the user states with `(FuzzReachEquivariant Name)`. +; +; Identity runs through `_fuzz-atom-key`, whose key is a length-prefixed structural serialization +; (typed prefixes, explicit arities, canonically renumbered variables under Alpha), not a hash. +; Distinct states cannot share a key, so key equality IS state identity under the selected mode and +; no second confirmation pass is needed; `reachability.test.ts` pins that property from both sides. +; A state whose grounded payload has no serialization is an explicit `UnkeyableState` invalid +; result rather than a silently missed state. +; +; Visited states are held as a key list scanned by the grounded `_fuzz-exact-member`, so the search +; is quadratic in visited states while each user relation call costs a full MeTTa interpretation. +; `MaxStates` defaults to 5000, where the scan stays far below the relation cost. + +; --------------------------------------------------------------------------- +; Configuration + +(= (_fuzz-reach-default-values) + (ReachConfigValues + (MaxDepth 20) + (MaxStates 5000) + (MaxTransitions 200000) + (StateIdentity Exact))) + +(= (reach-config-defaults) + (_fuzz-reach-default-values)) + +; A bound is a nonnegative integer; zero selects the unlimited policy, as elsewhere in the library. +(= (_fuzz-reach-bound-value $value) + (if (== (get-metatype $value) Grounded) + (and (>= $value 0) (== $value (trunc-math $value))) + False)) + +(= (_fuzz-reach-config-set $values $option) + (unify $values + (ReachConfigValues + (MaxDepth $depth) + (MaxStates $states) + (MaxTransitions $transitions) + (StateIdentity $identity)) + (switch $option + (((MaxDepth $value) + (if (_fuzz-reach-bound-value $value) + (ReachConfigValues + (MaxDepth $value) + (MaxStates $states) + (MaxTransitions $transitions) + (StateIdentity $identity)) + (FuzzInvalid InvalidReachConfig (InvalidMaxDepth (MaxDepth $value))))) + ((MaxStates $value) + (if (_fuzz-reach-bound-value $value) + (ReachConfigValues + (MaxDepth $depth) + (MaxStates $value) + (MaxTransitions $transitions) + (StateIdentity $identity)) + (FuzzInvalid InvalidReachConfig (InvalidMaxStates (MaxStates $value))))) + ((MaxTransitions $value) + (if (_fuzz-reach-bound-value $value) + (ReachConfigValues + (MaxDepth $depth) + (MaxStates $states) + (MaxTransitions $value) + (StateIdentity $identity)) + (FuzzInvalid + InvalidReachConfig + (InvalidMaxTransitions (MaxTransitions $value))))) + ((StateIdentity $value) + (if (or (== $value Exact) (== $value Alpha)) + (ReachConfigValues + (MaxDepth $depth) + (MaxStates $states) + (MaxTransitions $transitions) + (StateIdentity $value)) + (FuzzInvalid + InvalidReachConfig + (InvalidStateIdentity (StateIdentity $value))))) + ($unknown + (FuzzInvalid InvalidReachConfig (UnknownReachOption $unknown))))) + (FuzzInvalid InvalidReachConfig (MalformedReachConfigValues $values)))) + +(= (_fuzz-reach-config-loop $state) + (if (_fuzz-reach-config-finished $state) + $state + (_fuzz-reach-config-loop (_fuzz-reach-config-step $state)))) + +(= (_fuzz-reach-config-finished $state) + (unify $state (ReachConfigFold $values $options) False True)) + +(= (_fuzz-reach-config-step $state) + (unify $state + (ReachConfigFold $values $options) + (if (== $options ()) + $values + (let ($option $rest) (decons-atom $options) + (let $applied (_fuzz-reach-config-set $values $option) + (switch $applied + (((FuzzInvalid $code $details) $applied) + ($updated (ReachConfigFold $updated $rest))))))) + $state)) + +(= (_fuzz-reach-config-values $config) + (let $head (_fuzz-expression-head $config) + (if (== $head reach-config) + (let $options (cdr-atom $config) + (let $defaults (_fuzz-reach-default-values) + (_fuzz-reach-config-loop (ReachConfigFold $defaults $options)))) + (FuzzInvalid InvalidReachConfig (MalformedReachConfig (Value (quote $config))))))) + +; The head symbol of an expression, or Empty for anything else, so a malformed argument reports +; itself instead of erroring inside car-atom. +(= (_fuzz-expression-head $atom) + (if (== (get-metatype $atom) Expression) + (if-decons-expr $atom $head $tail $head Empty) + Empty)) + +(= (_fuzz-reach-config-get $name $values) + (unify $values + (ReachConfigValues + (MaxDepth $depth) + (MaxStates $states) + (MaxTransitions $transitions) + (StateIdentity $identity)) + (switch $name + ((MaxDepth $depth) + (MaxStates $states) + (MaxTransitions $transitions) + (StateIdentity $identity))) + Empty)) + +; --------------------------------------------------------------------------- +; User relation calls +; +; The collapse-bind sits inside a function/chain context so its call reaches it raw; an evaluated +; argument would branch first and a nondeterministic relation would slip through as parallel single +; results. Unlike the single-result helpers this one keeps the whole ordered bag: a transition +; relation is nondeterministic by design. + +(= (_fuzz-call-all-two $function $first $second $context) + (function + (chain (context-space) $space + (chain (collapse-bind (metta ($function $first $second) %Undefined% $space)) $pairs + (chain (eval (_fuzz-call-all-results $pairs $context)) $out + (return $out)))))) + +(= (_fuzz-call-all-results $pairs $context) + (if (== $pairs ()) + (_fuzz-generation-error FunctionReturnedNoResults $context) + (let $values (_fuzz-pair-values $pairs) + (CallAll $values)))) + +; --------------------------------------------------------------------------- +; State identity + +(= (_fuzz-reach-state-key $identity $state) + (let $key (_fuzz-atom-key $identity $state) + (switch $key + (((FuzzKernelError $code $details) + (ReachUnkeyable (ErrorCode $code) $details)) + ($valid (ReachKey $valid)))))) + +; --------------------------------------------------------------------------- +; Command lists + +(= (_fuzz-reach-command-items $commands) + (switch $commands + (((IncompleteCommands $reason) (ReachIncomplete $reason)) + ($listed + (let $head (_fuzz-expression-head $listed) + (if (== $head FiniteCommands) + (let $items (cdr-atom $listed) (ReachFinite $items)) + (ReachMalformed (Value $listed)))))))) + +(= (_fuzz-reach-nth $values $index) + (let $dropped (_fuzz-list-drop $values $index) + (if-decons-expr $dropped $head $tail (ReachItem $head) ReachMissing))) + +; --------------------------------------------------------------------------- +; Search +; +; One frontier node carries its own path from the initial model, so a witness needs no predecessor +; table: `(ReachNode state path)` with path `((Step command-index command branch) ...)` in +; transition order. + +(= (_fuzz-reach-loop $state) + (if (_fuzz-reach-finished $state) + $state + (_fuzz-reach-loop (_fuzz-reach-step $state)))) + +(= (_fuzz-reach-finished $state) + (unify $state + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + False + True)) + +; MaxDepth bounds the depth of every state the search considers, so a witness is never longer than +; MaxDepth commands and a depth answer means exactly "every state at or below MaxDepth was generated +; and judged against the target". Zero is the unlimited policy, as with the other bounds. +(= (_fuzz-reach-at-depth-limit $depth $values) + (let $limit (_fuzz-reach-config-get MaxDepth $values) + (and (> $limit 0) (>= $depth $limit)))) + +; A step either advances the level or expands the first node of the current level. Advancing with an +; empty next level is exhaustion; refusing to advance past MaxDepth is the depth answer, not a +; cutoff, because every level at or below it was searched completely. +(= (_fuzz-reach-step $state) + (unify $state + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (if (== $frontier ()) + (if (== $next ()) + (ReachRun $spec () () $visited $counts $depth $values (ReachExhausted $depth)) + (if (_fuzz-reach-at-depth-limit $depth $values) + (ReachRun + $spec () () $visited $counts $depth $values + (ReachUnreachableWithinDepth $depth)) + (let $level (reverse $next) + (ReachRun + $spec $level () $visited $counts (+ $depth 1) $values Searching)))) + (let ($node $rest) (decons-atom $frontier) + (_fuzz-reach-expand + (ReachRun $spec $rest $next $visited $counts $depth $values Searching) + $node))) + $state)) + +(= (_fuzz-reach-cutoff $run $reason) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values $outcome) + (ReachRun $spec $frontier $next $visited $counts $depth $values (ReachCutoff $reason)) + $run)) + +(= (_fuzz-reach-expand $run $node) + (unify $node + (ReachNode $state-atom $path) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $enumerated + (_fuzz-call-one $enumerate $state-atom (ReachEnumerate (Depth $depth))) + (switch $enumerated + (((CallOne $commands) + (let $items (_fuzz-reach-command-items $commands) + (switch $items + (((ReachFinite $listed) + (if (_fuzz-reach-at-depth-limit $depth $values) + (_fuzz-reach-note-beyond-depth $run $listed) + (_fuzz-reach-commands-loop (ReachCommands $run $node $listed 0)))) + ((ReachIncomplete $reason) + (_fuzz-reach-cutoff $run (IncompleteCommandEnumeration $reason))) + ((ReachMalformed $value) + (_fuzz-reach-cutoff $run (MalformedCommandEnumeration $value))))))) + ((FuzzGenerationError $code $details) + (_fuzz-reach-cutoff $run (CommandEnumerationFailed (CausedBy $enumerated)))) + ($bad + (_fuzz-reach-cutoff $run (MalformedCommandEnumeration (Value $bad))))))) + (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec)))) + $run) + $run)) + +; At the boundary the enumerator still runs, because whether a state has any command at all is what +; separates a model that ended from one that continues past the bound, and that distinction is the +; difference between exhaustion and a depth answer. No transition runs there, so no state deeper than +; MaxDepth is ever built, keyed, or judged. A state that does have commands leaves a marker in the +; next level: the level is not empty, which is all the loop needs to know, and since the loop refuses +; to advance into a level past the bound the marker is never expanded or reported. +(= (_fuzz-reach-note-beyond-depth $run $listed) + (if (== $listed ()) + $run + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (let $marked (cons-atom ReachBeyondDepth $next) + (ReachRun $spec $frontier $marked $visited $counts $depth $values Searching)) + $run))) + +(= (_fuzz-reach-commands-loop $state) + (if (_fuzz-reach-commands-finished $state) + $state + (_fuzz-reach-commands-loop (_fuzz-reach-commands-step $state)))) + +(= (_fuzz-reach-commands-finished $state) + (unify $state (ReachCommands $run $node $commands $index) False True)) + +(= (_fuzz-reach-commands-step $state) + (unify $state + (ReachCommands $run $node $commands $index) + (if (== $commands ()) + $run + (let ($command $rest) (decons-atom $commands) + (let $applied (_fuzz-reach-apply $run $node $command $index) + (if (_fuzz-reach-searching $applied) + (ReachCommands $applied $node $rest (+ $index 1)) + $applied)))) + $state)) + +(= (_fuzz-reach-searching $run) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + True + False)) + +; Applying one command: the whole ordered result bag becomes outgoing edges. +(= (_fuzz-reach-apply $run $node $command $command-index) + (unify $node + (ReachNode $state-atom $path) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $stepped + (_fuzz-call-all-two + $transition + $state-atom + $command + (ReachTransition (Depth $depth) (Command (quote $command)))) + (switch $stepped + (((CallAll $produced) + (_fuzz-reach-branches-loop + (ReachBranches $run $node $command $command-index $produced 0))) + ((FuzzGenerationError $code $details) + (_fuzz-reach-cutoff $run (TransitionFailed (CausedBy $stepped)))) + ($bad + (_fuzz-reach-cutoff $run (MalformedTransition (Value $bad))))))) + (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec)))) + $run) + $run)) + +(= (_fuzz-reach-branches-loop $state) + (if (_fuzz-reach-branches-finished $state) + $state + (_fuzz-reach-branches-loop (_fuzz-reach-branches-step $state)))) + +(= (_fuzz-reach-branches-finished $state) + (unify $state + (ReachBranches $run $node $command $command-index $produced $branch) + False + True)) + +(= (_fuzz-reach-branches-step $state) + (unify $state + (ReachBranches $run $node $command $command-index $produced $branch) + (if (== $produced ()) + $run + (let ($state-atom $rest) (decons-atom $produced) + (let $visited-run + (_fuzz-reach-visit $run $node $command $command-index $branch $state-atom) + (if (_fuzz-reach-searching $visited-run) + (ReachBranches + $visited-run $node $command $command-index $rest (+ $branch 1)) + $visited-run)))) + $state)) + +; One produced state. The order here is the contract: the transition branch is counted before any +; deduplication, the target is judged before MaxStates can cut, and MaxStates is checked against the +; state this step would actually add. +(= (_fuzz-reach-visit $run $node $command $command-index $branch $produced) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (unify $counts + (ReachCounts $states $transitions) + (let* (($next-transitions (+ $transitions 1)) + ($limit (_fuzz-reach-config-get MaxTransitions $values)) + ($counted (ReachCounts $states $next-transitions)) + ($advanced + (ReachRun $spec $frontier $next $visited $counted $depth $values Searching))) + (if (and (> $limit 0) (> $next-transitions $limit)) + (_fuzz-reach-cutoff + $advanced + (MaxTransitionsReached (MaxTransitions $limit))) + (_fuzz-reach-judge + $advanced + $node + (Step $command-index $command $branch) + $produced))) + $run) + $run)) + +(= (_fuzz-reach-judge $run $node $step $produced) + (unify $node + (ReachNode $parent $path) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $keyed (_fuzz-reach-state-key $identity $produced) + (switch $keyed + (((ReachUnkeyable $code $details) + (_fuzz-reach-cutoff + $run + (UnkeyableState (State (quote $produced)) $code $details))) + ((ReachKey $key) + (_fuzz-reach-target $run $key $step $path $produced))))) + (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec)))) + $run) + $run)) + +; The target is judged on the produced state before any deduplication or MaxStates check, so a +; target that is only reachable as an already-visited state is still reported. +(= (_fuzz-reach-target $run $key $step $path $produced) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $hit + (_fuzz-call-bool + $target + $produced + (ReachTarget (Depth $depth) (State (quote $produced)))) + (switch $hit + (((CallBool True) + (let $witness (append $path (cons-atom $step ())) + (_fuzz-reach-confirm $run $witness $produced))) + ((CallBool False) + (_fuzz-reach-enqueue $run $key $step $path $produced)) + ((FuzzGenerationError $code $details) + (_fuzz-reach-cutoff $run (TargetFailed (CausedBy $hit)))) + ($bad + (_fuzz-reach-cutoff $run (MalformedTarget (Value $bad))))))) + (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec)))) + $run)) + +(= (_fuzz-reach-enqueue $run $key $step $path $produced) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (if (== (_fuzz-exact-member $key $visited) True) + $run + (unify $counts + (ReachCounts $states $transitions) + (let* (($next-states (+ $states 1)) + ($limit (_fuzz-reach-config-get MaxStates $values))) + (if (and (> $limit 0) (> $next-states $limit)) + (_fuzz-reach-cutoff $run (MaxStatesReached (MaxStates $limit))) + (let* (($seen (append $visited (cons-atom $key ()))) + ($witness (append $path (cons-atom $step ()))) + ($node (ReachNode $produced $witness)) + ($queued (cons-atom $node $next))) + (ReachRun + $spec + $frontier + $queued + $seen + (ReachCounts $next-states $transitions) + $depth + $values + Searching)))) + $run)) + $run)) + +; --------------------------------------------------------------------------- +; Witness replay +; +; A found target is replayed from the initial model before it is reported: every step re-enumerates +; the commands, requires the recorded command at its recorded index, takes the recorded branch +; without deduplication, and the final state must satisfy the target. A mismatch means the +; transition relation, the enumerator, or the target is not a function of the model state, so the +; witness is not evidence and the result is a cutoff rather than a reachable claim. + +(= (_fuzz-reach-confirm $run $witness $produced) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values Searching) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $replayed (_fuzz-reach-replay $spec $witness) + (switch $replayed + (((ReachReplayed $final) + (if (== (_fuzz-reach-same-state $identity $final $produced) True) + (ReachRun + $spec $frontier $next $visited $counts $depth $values + (ReachFound $witness $produced)) + (_fuzz-reach-cutoff + $run + (WitnessReplayMismatch + (Expected (quote $produced)) + (Actual (quote $final)))))) + ((ReachReplayFailed $reason) + (_fuzz-reach-cutoff $run (WitnessReplayMismatch $reason))) + ($bad + (_fuzz-reach-cutoff $run (WitnessReplayMismatch (Value $bad))))))) + (_fuzz-reach-cutoff $run (MalformedReachSpec (Value $spec)))) + $run)) + +(= (_fuzz-reach-same-state $identity $left $right) + (let $left-key (_fuzz-reach-state-key $identity $left) + (let $right-key (_fuzz-reach-state-key $identity $right) + (unify $left-key + (ReachKey $lk) + (unify $right-key (ReachKey $rk) (== $lk $rk) False) + False)))) + +(= (_fuzz-reach-replay $spec $witness) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $walked (_fuzz-reach-replay-loop (ReachReplay $spec $initial $witness 0)) + (switch $walked + (((ReachReplayed $final) + (let $hit + (_fuzz-call-bool + $target + $final + (ReachReplayTarget (State (quote $final)))) + (switch $hit + (((CallBool True) (ReachReplayed $final)) + ((CallBool False) + (ReachReplayFailed (TargetFalseOnReplay (State (quote $final))))) + ($bad (ReachReplayFailed (TargetUnreadableOnReplay (Value $bad)))))))) + ($failed $failed)))) + (ReachReplayFailed (MalformedReachSpec (Value $spec))))) + +(= (_fuzz-reach-replay-loop $state) + (if (_fuzz-reach-replay-finished $state) + $state + (_fuzz-reach-replay-loop (_fuzz-reach-replay-step $state)))) + +(= (_fuzz-reach-replay-finished $state) + (unify $state (ReachReplay $spec $current $steps $index) False True)) + +(= (_fuzz-reach-replay-step $state) + (unify $state + (ReachReplay $spec $current $steps $index) + (if (== $steps ()) + (ReachReplayed $current) + (let ($step $rest) (decons-atom $steps) + (let $applied (_fuzz-reach-replay-apply $spec $current $step $index) + (switch $applied + (((ReachReplayState $produced) + (ReachReplay $spec $produced $rest (+ $index 1))) + ($failed $failed)))))) + $state)) + +(= (_fuzz-reach-replay-apply $spec $current $step $index) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (unify $step + (Step $command-index $command $branch) + (let $enumerated + (_fuzz-call-one $enumerate $current (ReachReplayEnumerate (Step $index))) + (switch $enumerated + (((CallOne $commands) + (let $items (_fuzz-reach-command-items $commands) + (switch $items + (((ReachFinite $listed) + (let $found (_fuzz-reach-nth $listed $command-index) + (switch $found + (((ReachItem $seen) + (if (== (_fuzz-replay-equal $seen $command) True) + (_fuzz-reach-replay-transition + $spec $current $command $branch $index) + (ReachReplayFailed + (CommandChangedOnReplay + (Step $index) + (Expected (quote $command)) + (Actual (quote $seen)))))) + ($missing + (ReachReplayFailed + (CommandMissingOnReplay + (Step $index) + (CommandIndex $command-index)))))))) + ((ReachIncomplete $reason) + (ReachReplayFailed + (IncompleteCommandsOnReplay (Step $index) (Reason $reason)))) + ((ReachMalformed $value) + (ReachReplayFailed + (MalformedCommandsOnReplay (Step $index) $value))))))) + ($bad + (ReachReplayFailed (EnumerationFailedOnReplay (Step $index) (Value $bad))))))) + (ReachReplayFailed (MalformedWitnessStep (Step $index) (Value (quote $step))))) + (ReachReplayFailed (MalformedReachSpec (Value $spec))))) + +(= (_fuzz-reach-replay-transition $spec $current $command $branch $index) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $stepped + (_fuzz-call-all-two + $transition + $current + $command + (ReachReplayTransition (Step $index))) + (switch $stepped + (((CallAll $produced) + (let $selected (_fuzz-reach-nth $produced $branch) + (switch $selected + (((ReachItem $chosen) (ReachReplayState $chosen)) + ($missing + (ReachReplayFailed + (BranchMissingOnReplay (Step $index) (Branch $branch)))))))) + ($bad + (ReachReplayFailed (TransitionFailedOnReplay (Step $index) (Value $bad))))))) + (ReachReplayFailed (MalformedReachSpec (Value $spec))))) + +; --------------------------------------------------------------------------- +; Public surface + +(= (fuzz-reachable $name $initial $enumerate $transition $target $config) + (let $values (_fuzz-reach-config-values $config) + (switch $values + (((FuzzInvalid $code $details) $values) + ($valid (_fuzz-reach-start $name $initial $enumerate $transition $target $valid)))))) + +(= (_fuzz-reach-start $name $initial $enumerate $transition $target $values) + (let $identity (_fuzz-reach-config-get StateIdentity $values) + (if (== (_fuzz-reach-identity-permitted $name $identity) True) + (let $keyed (_fuzz-reach-state-key $identity $initial) + (switch $keyed + (((ReachUnkeyable $code $details) + (FuzzInvalid + UnkeyableState + (Property $name) + (State (quote $initial)) + $code + $details)) + ((ReachKey $key) + (let $spec (ReachSpec $name $initial $enumerate $transition $target $identity) + (_fuzz-reach-run $spec $key $values)))))) + (FuzzInvalid + MissingEquivarianceDeclaration + (Property $name) + (StateIdentity $identity))))) + +; Alpha identity merges states that differ only by variable names, which is sound only when the +; user's relations cannot tell those states apart. That is a claim about the model, so the user +; states it explicitly and the search refuses the mode otherwise. +(= (_fuzz-reach-identity-permitted $name $identity) + (if (== $identity Alpha) + (let $declared (collapse (match &self (FuzzReachEquivariant $name) Declared)) + (if (== $declared ()) False True)) + True)) + +(= (_fuzz-reach-run $spec $key $values) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (let $hit + (_fuzz-call-bool $target $initial (ReachTarget (Depth 0) (State (quote $initial)))) + (switch $hit + (((CallBool True) + (let* (($seen (cons-atom $key ())) + ($counts (ReachCounts 1 0)) + ($found (ReachFound () $initial))) + (_fuzz-reach-report + (ReachRun $spec () () $seen $counts 0 $values $found)))) + ((CallBool False) + (let* (($seen (cons-atom $key ())) + ($counts (ReachCounts 1 0)) + ($root (ReachNode $initial ())) + ($frontier (cons-atom $root ())) + ($start (ReachRun $spec $frontier () $seen $counts 0 $values Searching)) + ($finished (_fuzz-reach-loop $start))) + (_fuzz-reach-report $finished))) + ((FuzzGenerationError $code $details) + (FuzzInvalid TargetFailed (Property $name) (CausedBy $hit))) + ($bad + (FuzzInvalid MalformedTarget (Property $name) (Value $bad)))))) + (FuzzInvalid MalformedReachSpec (Value $spec)))) + +(= (_fuzz-reach-report $run) + (unify $run + (ReachRun $spec $frontier $next $visited $counts $depth $values $outcome) + (unify $spec + (ReachSpec $name $initial $enumerate $transition $target $identity) + (unify $counts + (ReachCounts $states $transitions) + (let $statistics + (ReachStatistics + (States $states) + (Transitions $transitions) + (Depth $depth)) + (switch $outcome + (((ReachFound $witness $state) + (let $commands (_fuzz-reach-witness-commands $witness) + (FuzzReachable + (Property $name) + (Depth (length $witness)) + (Commands $commands) + (Witness $witness) + (Target (quote $state)) + $statistics))) + ((ReachUnreachableWithinDepth $searched) + (FuzzUnreachableWithinDepth (Property $name) (Depth $searched) $statistics)) + ((ReachExhausted $searched) + (FuzzReachabilityExhausted + (Property $name) + (States $states) + (Depth $searched) + $statistics)) + ((ReachCutoff $reason) + (FuzzReachabilityCutoff (Property $name) (Reason $reason) $statistics)) + ($bad + (FuzzInvalid MalformedReachOutcome (Property $name) (Value $bad)))))) + (FuzzInvalid MalformedReachCounts (Value $counts))) + (FuzzInvalid MalformedReachSpec (Value $spec))) + (FuzzInvalid MalformedReachRun (Value $run)))) + +; Flat accumulator, not recurse-then-cons: a witness is one step per transition and a long chain +; would otherwise nest one evaluator frame per step. +(= (_fuzz-reach-witness-commands $witness) + (_fuzz-reach-witness-loop (ReachWitnessFold $witness ()))) + +(= (_fuzz-reach-witness-loop $state) + (if (_fuzz-reach-witness-finished $state) + $state + (_fuzz-reach-witness-loop (_fuzz-reach-witness-step $state)))) + +(= (_fuzz-reach-witness-finished $state) + (unify $state (ReachWitnessFold $steps $reversed) False True)) + +(= (_fuzz-reach-witness-step $state) + (unify $state + (ReachWitnessFold $steps $reversed) + (if (== $steps ()) + (reverse $reversed) + (let ($step $rest) (decons-atom $steps) + (unify $step + (Step $command-index $command $branch) + (let $next (cons-atom $command $reversed) + (ReachWitnessFold $rest $next)) + (ReachWitnessFold $rest $reversed)))) + $state)) diff --git a/packages/fuzz/src/metta/80-suite.metta b/packages/fuzz/src/metta/80-suite.metta new file mode 100644 index 0000000..a354a05 --- /dev/null +++ b/packages/fuzz/src/metta/80-suite.metta @@ -0,0 +1,262 @@ +; SPDX-FileCopyrightText: 2026 MesTTo +; +; SPDX-License-Identifier: MIT + +; Suite discovery. A file declares its tests as ordinary data rather than through a second host-side +; test DSL: +; +; (: reverse-involution (-> Atom FuzzProperty)) +; (= (reverse-involution $xs) (expect-equal (reverse (reverse $xs)) $xs)) +; (FuzzTest reverse-involution (gen-list (gen-int -100 100) 0 40) reverse-involution +; (fuzz-config (Runs 200))) +; +; `(fuzz-run-suite)` finds every `FuzzTest` fact and runs it through the ordinary `fuzz-check`, so a +; suite is exactly what a hand-written `!(fuzz-check ...)` query would have been. The generator is +; stored as syntax by the declaration and evaluated once per test when `fuzz-check` receives it, +; which is what lets one declaration be replayed, shrunk, and enumerated like any other. +; +; The host may override configuration from the command line. Options are merged by REPLACEMENT rather +; than appended, because a config carrying the same option twice is an explicit `DuplicateOption` +; error; a test's own choices survive except where an override names the same option. + +(: FuzzTest (-> Atom Atom Atom Atom Atom)) +(: FuzzTestCase (-> Atom Atom Atom Atom Atom)) +(: FuzzSuiteRun (-> Atom Atom Atom Atom Atom)) +(: fuzz-run-suite (-> %Undefined%)) +(: fuzz-run-suite-with (-> Atom %Undefined%)) +(: fuzz-run-suite-exhaustive (-> Atom %Undefined%)) +(: fuzz-suite-tests (-> %Undefined%)) +(: _fuzz-suite-cases (-> %Undefined%)) +(: _fuzz-options-merged (-> Atom Atom Atom Atom %Undefined%)) +(: _fuzz-config-with-overrides (-> Atom Atom %Undefined%)) +(: _fuzz-reach-config-with-overrides (-> Atom Atom %Undefined%)) +(: _fuzz-override-names (-> Atom %Undefined%)) +(: _fuzz-options-without (-> Atom Atom %Undefined%)) +; The loop trio is deliberately UNDECLARED. An `Atom` parameter freezes its argument, and +; `(_fuzz-suite-loop (_fuzz-suite-step $state))` passes a computed call: declaring it would freeze +; the step, run exactly one iteration, and return the unevaluated call as the result. +(: FuzzOverrideNames (-> Atom Atom Atom)) +(: FuzzOptionFilter (-> Atom Atom Atom Atom)) + +; --------------------------------------------------------------------------- +; Declared tests + +(= (_fuzz-suite-cases) + (collapse + (match &self + (FuzzTest $id $generator $property $config) + (FuzzTestCase $id $generator $property $config)))) + +; The declared tests, for a host that wants to list a suite without running it. +(= (fuzz-suite-tests) + (let $cases (_fuzz-suite-cases) $cases)) + +; --------------------------------------------------------------------------- +; Configuration overrides +; +; Flat accumulator loops throughout: a suite may carry many options and a recurse-then-cons builder +; costs an evaluator frame per element. +; +; An option is named by its head symbol rather than by `_fuzz-config-option-name`, whose switch is a +; whitelist of the `fuzz-config` options and reports anything else as `InvalidOption`. Merging is +; head-structural so it serves `reach-config` too; an option the target record does not accept is +; still refused, by that record's own validation. + +(= (_fuzz-override-names $overrides) + (_fuzz-override-names-loop (FuzzOverrideNames $overrides ()))) + +(= (_fuzz-override-names-loop $state) + (if (_fuzz-override-names-finished $state) + $state + (_fuzz-override-names-loop (_fuzz-override-names-step $state)))) + +(= (_fuzz-override-names-finished $state) + (unify $state (FuzzOverrideNames $options $reversed) False True)) + +(= (_fuzz-override-names-step $state) + (unify $state + (FuzzOverrideNames $options $reversed) + (if (== $options ()) + (reverse $reversed) + (let ($option $rest) (decons-atom $options) + (let $name (_fuzz-expression-head $option) + (let $next (cons-atom $name $reversed) + (FuzzOverrideNames $rest $next))))) + $state)) + +(= (_fuzz-options-without $options $names) + (_fuzz-options-without-loop (FuzzOptionFilter $options $names ()))) + +(= (_fuzz-options-without-loop $state) + (if (_fuzz-options-without-finished $state) + $state + (_fuzz-options-without-loop (_fuzz-options-without-step $state)))) + +(= (_fuzz-options-without-finished $state) + (unify $state (FuzzOptionFilter $options $names $reversed) False True)) + +(= (_fuzz-options-without-step $state) + (unify $state + (FuzzOptionFilter $options $names $reversed) + (if (== $options ()) + (reverse $reversed) + (let ($option $rest) (decons-atom $options) + (let $name (_fuzz-expression-head $option) + (if (is-member $name $names) + (FuzzOptionFilter $rest $names $reversed) + (let $next (cons-atom $option $reversed) + (FuzzOptionFilter $rest $names $next)))))) + $state)) + +; Merge overrides into an option record by replacement. An empty override list returns the record +; unchanged, so the ordinary path allocates nothing. The expected head is a parameter because the two +; record kinds differ only in that symbol: `fuzz-config` rejects a repeated option outright, while +; `reach-config` folds last-wins, and replacement is right for both. +(= (_fuzz-options-merged $head $record $overrides $code) + (if (== $overrides ()) + $record + (let $found (_fuzz-expression-head $record) + (if (== $found $head) + (let* (($options (cdr-atom $record)) + ($names (_fuzz-override-names $overrides)) + ($kept (_fuzz-options-without $options $names)) + ($merged (append $kept $overrides))) + (cons-atom $head $merged)) + (FuzzInvalid $code (MalformedConfig (Value (quote $record)))))))) + +(= (_fuzz-config-with-overrides $config $overrides) + (_fuzz-options-merged fuzz-config $config $overrides InvalidConfig)) + +(= (_fuzz-reach-config-with-overrides $config $overrides) + (_fuzz-options-merged reach-config $config $overrides InvalidReachConfig)) + +; --------------------------------------------------------------------------- +; Running a suite +; +; Each result is paired with its test id so a host can report per-test without re-deriving identity +; from the result atom. + +(= (fuzz-run-suite) + (fuzz-run-suite-with ())) + +(= (fuzz-run-suite-with $overrides) + (let $cases (_fuzz-suite-cases) + (_fuzz-suite-loop (FuzzSuiteRun $cases $overrides Random ())))) + +(= (fuzz-run-suite-exhaustive $overrides) + (let $cases (_fuzz-suite-cases) + (_fuzz-suite-loop (FuzzSuiteRun $cases $overrides Exhaustive ())))) + +(= (_fuzz-suite-loop $state) + (if (_fuzz-suite-finished $state) + $state + (_fuzz-suite-loop (_fuzz-suite-step $state)))) + +(= (_fuzz-suite-finished $state) + (unify $state (FuzzSuiteRun $cases $overrides $mode $reversed) False True)) + +(= (_fuzz-suite-step $state) + (unify $state + (FuzzSuiteRun $cases $overrides $mode $reversed) + (if (== $cases ()) + (reverse $reversed) + (let ($case $rest) (decons-atom $cases) + (let $result (_fuzz-suite-run-case $case $overrides $mode) + (let $next (cons-atom $result $reversed) + (FuzzSuiteRun $rest $overrides $mode $next))))) + $state)) + +(: _fuzz-suite-run-case (-> Atom Atom Atom %Undefined%)) +; The merged config is inspected with `unify`, not `switch`: switch evaluates its scrutinee, which +; normalizes a `fuzz-config` expression into either a config record or a validation error, and an arm +; matching that error would then report the pre-evaluation syntax instead of the error itself. unify +; leaves the subject alone, so a merge that genuinely failed is caught here and an ordinary config +; travels on to fuzz-check as syntax, which is what lets fuzz-check normalize and validate it. +(= (_fuzz-suite-run-case $case $overrides $mode) + (unify $case + (FuzzTestCase $id $generator $property $config) + (let $merged (_fuzz-config-with-overrides $config $overrides) + (unify $merged + (FuzzInvalid $code $details) + (FuzzSuiteResult $id $merged) + (let $result (_fuzz-suite-check $id $generator $property $merged $mode) + (FuzzSuiteResult $id $result)))) + (FuzzSuiteResult Unknown (FuzzInvalid MalformedFuzzTest (Value (quote $case)))))) + +; The generator reaches fuzz-check as syntax and is evaluated there, exactly as in a hand-written +; query. Exhaustive mode swaps in fuzz-check-exhaustive and nothing else changes. +(: _fuzz-suite-check (-> Atom Atom Atom Atom Atom %Undefined%)) +(= (_fuzz-suite-check $id $generator $property $config Random) + (fuzz-check $id $generator $property $config)) +(= (_fuzz-suite-check $id $generator $property $config Exhaustive) + (fuzz-check-exhaustive $id $generator $property $config)) + +(: FuzzSuiteResult (-> Atom Atom Atom)) + +; --------------------------------------------------------------------------- +; Declared reachability searches +; +; The same data-declaration idea for bounded reachability: +; +; (FuzzReachTest counter (Count 0) counter-enumerate counter-transition counter-target +; (reach-config (MaxDepth 20))) +; +; A search needs its own relations rather than a machine spec, because a transition that returns +; several next states is the point of the search; a FuzzMachine's NextModel is single-valued. + +(: FuzzReachTest (-> Atom Atom Atom Atom Atom Atom Atom)) +(: FuzzReachCase (-> Atom Atom Atom Atom Atom Atom Atom)) +(: FuzzReachSuiteRun (-> Atom Atom Atom Atom)) +(: fuzz-run-reach-suite (-> %Undefined%)) +(: fuzz-run-reach-suite-with (-> Atom %Undefined%)) +(: fuzz-reach-suite-tests (-> %Undefined%)) +(: _fuzz-reach-suite-cases (-> %Undefined%)) + +(= (_fuzz-reach-suite-cases) + (collapse + (match &self + (FuzzReachTest $id $initial $enumerate $transition $target $config) + (FuzzReachCase $id $initial $enumerate $transition $target $config)))) + +(= (fuzz-reach-suite-tests) + (let $cases (_fuzz-reach-suite-cases) $cases)) + +(= (fuzz-run-reach-suite) + (fuzz-run-reach-suite-with ())) + +(= (fuzz-run-reach-suite-with $overrides) + (let $cases (_fuzz-reach-suite-cases) + (_fuzz-reach-suite-loop (FuzzReachSuiteRun $cases $overrides ())))) + +(= (_fuzz-reach-suite-loop $state) + (if (_fuzz-reach-suite-finished $state) + $state + (_fuzz-reach-suite-loop (_fuzz-reach-suite-step $state)))) + +(= (_fuzz-reach-suite-finished $state) + (unify $state (FuzzReachSuiteRun $cases $overrides $reversed) False True)) + +(= (_fuzz-reach-suite-step $state) + (unify $state + (FuzzReachSuiteRun $cases $overrides $reversed) + (if (== $cases ()) + (reverse $reversed) + (let ($case $rest) (decons-atom $cases) + (let $result (_fuzz-reach-suite-run-case $case $overrides) + (let $next (cons-atom $result $reversed) + (FuzzReachSuiteRun $rest $overrides $next))))) + $state)) + +; As in `_fuzz-suite-run-case`, the merged config is inspected with `unify` rather than `switch` so a +; merge that failed is reported instead of being evaluated into something else. +(: _fuzz-reach-suite-run-case (-> Atom Atom %Undefined%)) +(= (_fuzz-reach-suite-run-case $case $overrides) + (unify $case + (FuzzReachCase $id $initial $enumerate $transition $target $config) + (let $merged (_fuzz-reach-config-with-overrides $config $overrides) + (unify $merged + (FuzzInvalid $code $details) + (FuzzSuiteResult $id $merged) + (let $result (fuzz-reachable $id $initial $enumerate $transition $target $merged) + (FuzzSuiteResult $id $result)))) + (FuzzSuiteResult Unknown (FuzzInvalid MalformedFuzzReachTest (Value (quote $case)))))) diff --git a/packages/fuzz/src/property.test.ts b/packages/fuzz/src/property.test.ts new file mode 100644 index 0000000..91166c3 --- /dev/null +++ b/packages/fuzz/src/property.test.ts @@ -0,0 +1,166 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +describe("MeTTa fuzz property outcomes", () => { + it("constructs canonical outcomes and keeps implication lazy", () => { + expect( + printed(` + (= (must-not-run) (Error eager implication-body-evaluated)) + !(fuzz-pass) + !(fuzz-fail Broken (At input)) + !(fuzz-discard Unsupported) + !(expect-true True ok) + !(expect-false False ok) + !(expect-atom-equal (a 1) (a 2)) + !(implies False (must-not-run)) + `).slice(1), + ).toEqual([ + ["(Pass)"], + ["(Fail Broken (At input))"], + ["(Discard Unsupported)"], + ["(Pass)"], + ["(Pass)"], + ["(Fail NotEqual ((Actual (a 1)) (Expected (a 2))))"], + ["(Discard ImplicationFalse)"], + ]); + }); + + it("provides exact, alpha, multiset, and set result comparators", () => { + expect( + printed(` + !(expect-results-exact (a b a) (a b a)) + !(expect-results-exact (a b a) (a a b)) + !(expect-results-alpha (($x $x) ($y)) (($a $a) ($b))) + !(expect-results-multiset (a b a) (b a a)) + !(expect-results-multiset (a b a) (a b)) + !(expect-results-set (a b a) (b a)) + `).slice(1), + ).toEqual([ + ["(Pass)"], + ["(Fail ResultsNotExact ((Actual (a b a)) (Expected (a a b))))"], + ["(Pass)"], + ["(Pass)"], + ["(Fail ResultsNotMultisetEqual ((Actual (a b a)) (Expected (a b))))"], + ["(Pass)"], + ]); + }); + + it("preserves result order and duplicate multiplicity in case evidence", () => { + const out = printed(` + (= (mixed $value) (fuzz-pass)) + (= (mixed $value) (fuzz-fail Broken (At $value))) + (= (mixed $value) (fuzz-pass)) + !(_fuzz-evaluate-property mixed Default item 10000 100 Sandboxed) + !(_fuzz-evaluate-property mixed Any item 10000 100 Sandboxed) + `); + + expect(out[1]![0]).toMatch( + /^\(FuzzCaseResult Fail Broken \(Details \(At item\)\).* \(Results \(\(Pass\) \(Fail Broken \(At item\)\) \(Pass\)\)\) \(Steps [0-9]+\)\)$/, + ); + expect(out[2]![0]).toMatch( + /^\(FuzzCaseResult Pass None \(Details \(\)\).* \(Results \(\(Pass\) \(Fail Broken \(At item\)\) \(Pass\)\)\) \(Steps [0-9]+\)\)$/, + ); + }); + + it("uses discard as a neutral branch by default and exposes strict all", () => { + const out = printed(` + (= (pass-discard $value) (fuzz-pass)) + (= (pass-discard $value) (fuzz-discard NotApplicable)) + !(_fuzz-evaluate-property + pass-discard Default item 10000 100 Sandboxed) + !(_fuzz-evaluate-property + pass-discard All item 10000 100 Sandboxed) + `); + + expect(out[1]![0]).toMatch(/^\(FuzzCaseResult Pass /); + expect(out[2]![0]).toMatch(/^\(FuzzCaseResult Discard /); + }); + + it("does not reinterpret an empty result bag as a passing property", () => { + expect( + printed(` + (= (empty-property $value) (empty)) + !(_fuzz-evaluate-property + empty-property + Default + item + 10000 + 100 + Sandboxed) + `)[1]![0], + ).toMatch( + /^\(FuzzCaseResult Invalid NoPropertyResult \(Details \(\)\).* \(Results \(\)\) \(Steps [0-9]+\)\)$/, + ); + }); + + it("treats language errors as failures and keeps failure ahead of a cutoff", () => { + const out = printed(` + (= (error-and-pass $value) (fuzz-pass)) + (= (error-and-pass $value) (Error subject reason)) + (= (fail-and-cutoff $value) (fuzz-fail FirstFailure details)) + (= (fail-and-cutoff $value) (Error later ResourceLimit)) + !(_fuzz-evaluate-property + error-and-pass Default item 10000 100 Sandboxed) + !(_fuzz-evaluate-property + fail-and-cutoff Default item 10000 100 Sandboxed) + `); + + expect(out[1]![0]).toMatch( + /^\(FuzzCaseResult Fail LanguageError \(Details \(Error subject reason\)\)/, + ); + expect(out[2]![0]).toMatch(/^\(FuzzCaseResult Fail FirstFailure /); + }); + + it("retains labels, collected values, coverage observations, and notes", () => { + expect( + printed(` + (= (metadata $value) + (cover + 50 + True + Even + (classify + True + Positive + (collect + $value + (counterexample note (fuzz-pass)))))) + !(_fuzz-evaluate-property metadata Default 4 10000 100 Sandboxed) + `)[1]![0], + ).toMatch( + /^\(FuzzCaseResult Pass None \(Details \(\)\) \(Labels \(Positive\)\) \(Collected \(4\)\) \(Coverage \(\(CoverageObservation 50 Even True\)\)\) \(Annotations \(note\)\)/, + ); + }); + + it("reports host faults and evaluator cutoffs as distinct case outcomes", () => { + const out = printed(` + (= (host-effect $value) (println! forbidden)) + (= (too-much-work $value) (collapse (match &self $x $x))) + !(_fuzz-evaluate-property host-effect Default item 10000 100 Sandboxed) + !(_fuzz-evaluate-property too-much-work Default item 1 100 Sandboxed) + `); + + expect(out[1]![0]).toMatch( + /^\(FuzzCaseResult HostFault EffectDenied \(Details \(\(Effect Host\) \(Operation println!\)\)\)/, + ); + expect(out[2]![0]).toMatch(/^\(FuzzCaseResult Cutoff ResourceLimit /); + }); + + it("rolls world changes back before returning the classified case", () => { + const out = printed(` + (= (mutating $value) + (let $_ (add-atom &self (leaked $value)) + (fuzz-pass))) + !(_fuzz-evaluate-property mutating Default item 10000 100 Sandboxed) + !(collapse (match &self (leaked $value) $value)) + `); + + expect(out[1]![0]).toMatch(/^\(FuzzCaseResult Pass /); + expect(out[2]).toEqual(["()"]); + }); +}); diff --git a/packages/fuzz/src/reachability.test.ts b/packages/fuzz/src/reachability.test.ts new file mode 100644 index 0000000..213e343 --- /dev/null +++ b/packages/fuzz/src/reachability.test.ts @@ -0,0 +1,337 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +// A bounded counter. `up` is deterministic, `split` is genuinely nondeterministic (two next states +// in a fixed order), so branch indices are observable in a witness. The counter stops at four, which +// makes the model finite and lets the search reach exhaustion. +const COUNTER = ` + (= (counter-enumerate (Count $n)) + (if (< $n 4) (FiniteCommands up split) (FiniteCommands))) + (= (counter-transition (Count $n) up) (Count (+ $n 1))) + (= (counter-transition (Count $n) split) (superpose ((Count (+ $n 1)) (Count (+ $n 2))))) + (= (counter-target (Count $n)) (== $n 3)) +`; + +describe("MeTTa bounded reachability", () => { + it("finds the shortest witness and replays it before reporting", () => { + const result = printed(` + ${COUNTER} + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth 10))) + `).at(-1)![0]!; + + expect(result).toMatch(/^\(FuzzReachable \(Property Counter\) /); + // Two transitions is shortest, and (Count 3) has two of them: up then split, or split then up. + // Command enumeration order breaks the tie deterministically — `up` is enumerated first, so + // (Count 1) is expanded before (Count 2) and its witness is the one reported. + expect(result).toContain("(Depth 2)"); + expect(result).toContain("(Target (quote (Count 3)))"); + const commands = /\(Commands (\([^()]*\))\)/.exec(result); + expect(commands?.[1]).toBe("(up split)"); + }); + + it("records the transition branch a witness took", () => { + const result = printed(` + ${COUNTER} + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth 10))) + `).at(-1)![0]!; + + // (Step command-index command branch): up is command 0 with a single branch, then split is + // command 1 and only its SECOND result, branch 1, lands on (Count 3). Recording the branch is + // what makes the witness replayable through a nondeterministic transition. + const witness = /\(Witness (\(.*?\))\) \(Target/.exec(result); + expect(witness?.[1]).toBe("((Step 0 up 0) (Step 1 split 1))"); + }); + + it("reports the initial state itself with an empty witness", () => { + const result = printed(` + ${COUNTER} + !(fuzz-reachable Counter (Count 3) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth 10))) + `).at(-1)![0]!; + + expect(result).toMatch(/^\(FuzzReachable \(Property Counter\) \(Depth 0\)/); + expect(result).toContain("(Witness ())"); + }); + + it("exhausts a finite model when the target never occurs", () => { + const result = printed(` + ${COUNTER} + (= (unreachable-target (Count $n)) (== $n 99)) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition unreachable-target + (reach-config (MaxDepth 20))) + `).at(-1)![0]!; + + // States 0..5 are all reachable: 4 and 5 have no outgoing commands, so the frontier runs dry. + expect(result).toMatch(/^\(FuzzReachabilityExhausted \(Property Counter\) \(States 6\)/); + }); + + it("separates a depth answer from a resource cutoff", () => { + const out = printed(` + ${COUNTER} + (= (deep-target (Count $n)) (== $n 5)) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition deep-target + (reach-config (MaxDepth 1))) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition deep-target + (reach-config (MaxStates 2))) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition deep-target + (reach-config (MaxTransitions 1))) + `); + + expect(out.at(-3)![0]).toMatch( + /^\(FuzzUnreachableWithinDepth \(Property Counter\) \(Depth 1\)/, + ); + expect(out.at(-2)![0]).toMatch(/^\(FuzzReachabilityCutoff /); + expect(out.at(-2)![0]).toContain("(Reason (MaxStatesReached (MaxStates 2)))"); + expect(out.at(-1)![0]).toContain("(Reason (MaxTransitionsReached (MaxTransitions 1)))"); + }); + + it("never reports a witness longer than MaxDepth", () => { + const out = printed(` + ${COUNTER} + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth 2))) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth 1))) + `); + + // (Count 3) sits at depth 2, so depth 2 finds it and depth 1 must not: the state one level past + // the bound is never built, let alone judged against the target. + expect(out.at(-2)![0]).toMatch(/^\(FuzzReachable \(Property Counter\) \(Depth 2\)/); + expect(out.at(-1)![0]).toMatch( + /^\(FuzzUnreachableWithinDepth \(Property Counter\) \(Depth 1\)/, + ); + }); + + it("still exhausts a model that ends exactly at MaxDepth", () => { + const out = printed(` + ${COUNTER} + (= (unreachable-target (Count $n)) (== $n 99)) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition unreachable-target + (reach-config (MaxDepth 3))) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition unreachable-target + (reach-config (MaxDepth 2))) + `); + + // The deepest state, (Count 5), is found at depth 3 and has no commands, so at MaxDepth 3 the + // boundary level is enumerated, nothing continues past it, and the answer is exhaustion rather + // than a weaker depth answer. At MaxDepth 2 the boundary states do have commands, so the model + // demonstrably continues and the answer is bounded. + expect(out.at(-2)![0]).toMatch( + /^\(FuzzReachabilityExhausted \(Property Counter\) \(States 6\)/, + ); + expect(out.at(-1)![0]).toMatch( + /^\(FuzzUnreachableWithinDepth \(Property Counter\) \(Depth 2\)/, + ); + }); + + it("counts no transition for the boundary level it refuses to cross", () => { + const out = printed(` + (= (endless-enumerate $state) (FiniteCommands up)) + (= (endless-transition (Count $n) up) (Count (+ $n 1))) + (= (never-target (Count $n)) (== $n 99)) + !(fuzz-reachable Endless (Count 0) + endless-enumerate endless-transition never-target + (reach-config (MaxDepth 3))) + `); + + // Four states are visited, (Count 0) through (Count 3), and three transitions produced them. The + // boundary state (Count 3) is enumerated but never stepped, so no fourth transition is charged + // and no (Count 4) is created. + expect(out.at(-1)![0]).toContain("(ReachStatistics (States 4) (Transitions 3) (Depth 3))"); + }); + + it("never turns an incomplete command enumeration into exhaustion", () => { + const result = printed(` + ${COUNTER} + (= (partial-enumerate (Count $n)) + (if (< $n 2) (FiniteCommands up) (IncompleteCommands TooManyCommands))) + (= (never-target (Count $n)) (== $n 99)) + !(fuzz-reachable Counter (Count 0) + partial-enumerate counter-transition never-target + (reach-config (MaxDepth 10))) + `).at(-1)![0]!; + + expect(result).toMatch(/^\(FuzzReachabilityCutoff /); + expect(result).toContain("(IncompleteCommandEnumeration TooManyCommands)"); + expect(result).not.toContain("FuzzReachabilityExhausted"); + }); + + it("refuses a witness whose replay does not reproduce the state", () => { + // The transition consults a state cell, so the second traversal of the same edge disagrees with + // the first: the witness is not evidence and the search must say so rather than claim reachable. + const result = printed(` + !(bind! &drift (new-state 0)) + (= (drift-enumerate $state) (FiniteCommands up)) + (= (drift-transition $state up) + (let $seen (get-state &drift) + (let $bumped (change-state! &drift (+ $seen 1)) + (Count (+ $seen 1))))) + (= (drift-target (Count $n)) (== $n 1)) + !(fuzz-reachable Drift (Count 0) + drift-enumerate drift-transition drift-target + (reach-config (MaxDepth 4))) + `).at(-1)![0]!; + + expect(result).toMatch(/^\(FuzzReachabilityCutoff \(Property Drift\) /); + expect(result).toContain("WitnessReplayMismatch"); + }); + + it("keeps alpha identity opt-in and gated on a declared equivariance", () => { + const model = ` + (= (var-enumerate $state) (FiniteCommands rename)) + (= (var-transition (Holds $x) rename) (Holds $y)) + (= (var-target (Holds $x)) False) + `; + const out = printed(` + ${model} + !(fuzz-reachable Renamer (Holds $a) + var-enumerate var-transition var-target + (reach-config (MaxDepth 3) (StateIdentity Alpha))) + (FuzzReachEquivariant Declared) + !(fuzz-reachable Declared (Holds $a) + var-enumerate var-transition var-target + (reach-config (MaxDepth 3) (StateIdentity Alpha))) + !(fuzz-reachable Exactly (Holds $a) + var-enumerate var-transition var-target + (reach-config (MaxDepth 3) (StateIdentity Exact))) + `); + + // Undeclared alpha identity is invalid, not silently downgraded to exact. + expect(out.at(-3)![0]).toMatch(/^\(FuzzInvalid MissingEquivarianceDeclaration /); + // Declared: every renaming collapses onto the initial state, so the model is finite. + expect(out.at(-2)![0]).toMatch( + /^\(FuzzReachabilityExhausted \(Property Declared\) \(States 1\)/, + ); + // Exact identity treats each fresh variable as a new state, so the depth bound is what stops it. + expect(out.at(-1)![0]).toMatch( + /^\(FuzzUnreachableWithinDepth \(Property Exactly\) \(Depth 3\)/, + ); + }); + + it("distinguishes states that differ only outside the compared prefix", () => { + // Guards the keyed visited set: the key is a length-prefixed serialization, so states sharing a + // prefix are still distinct and none is skipped as already-visited. + const result = printed(` + (= (pair-enumerate ($a $b)) (if (< $a 2) (FiniteCommands left right) (FiniteCommands))) + (= (pair-transition ($a $b) left) ((+ $a 1) $b)) + (= (pair-transition ($a $b) right) ($a (+ $b 1))) + (= (pair-target ($a $b)) (and (== $a 2) (== $b 2))) + !(fuzz-reachable Pairs (0 0) + pair-enumerate pair-transition pair-target + (reach-config (MaxDepth 8))) + `).at(-1)![0]!; + + expect(result).toMatch(/^\(FuzzReachable \(Property Pairs\) \(Depth 4\)/); + }); + + it("rejects malformed configuration and unknown options", () => { + const out = printed(` + ${COUNTER} + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth -1))) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (Runs 10))) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (StateIdentity Fuzzy))) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (not-a-config)) + `); + + expect(out.at(-4)![0]).toContain("(InvalidMaxDepth (MaxDepth -1))"); + expect(out.at(-3)![0]).toContain("(UnknownReachOption (Runs 10))"); + expect(out.at(-2)![0]).toContain("(InvalidStateIdentity (StateIdentity Fuzzy))"); + expect(out.at(-1)![0]).toContain("MalformedReachConfig"); + }); + + it("reports a failing user relation as a cutoff, never as a result", () => { + const out = printed(` + ${COUNTER} + (= (forked-transition (Count $n) up) (Count 1)) + (= (forked-transition (Count $n) up) (Count 2)) + (= (up-only (Count $n)) (FiniteCommands up)) + (= (forked-enumerate $state) (FiniteCommands up)) + (= (forked-enumerate $state) (FiniteCommands split)) + !(fuzz-reachable Forked (Count 0) + forked-enumerate counter-transition counter-target + (reach-config (MaxDepth 3))) + `); + + // A nondeterministic enumerator is a malformed model: the search reports it instead of picking + // one branch and continuing. + expect(out.at(-1)![0]).toMatch(/^\(FuzzReachabilityCutoff \(Property Forked\) /); + expect(out.at(-1)![0]).toContain("CommandEnumerationFailed"); + }); + + it("treats a zero bound as unlimited", () => { + const result = printed(` + ${COUNTER} + (= (never-target (Count $n)) (== $n 99)) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition never-target + (reach-config (MaxDepth 0) (MaxStates 0) (MaxTransitions 0))) + `).at(-1)![0]!; + + // With every bound unlimited the finite model runs to exhaustion instead of cutting at depth 0. + expect(result).toMatch(/^\(FuzzReachabilityExhausted \(Property Counter\) \(States 6\)/); + }); + + it("walks a long chain without exhausting the host stack", () => { + // A 400-state linear chain: the frontier, command, branch, and replay loops each iterate once + // per state, so this only completes if all of them are depth-flat. The witness is 400 steps and + // is replayed in full before the result is reported. + const result = printed(` + (= (chain-enumerate (At $n)) (if (< $n 400) (FiniteCommands forward) (FiniteCommands))) + (= (chain-transition (At $n) forward) (At (+ $n 1))) + (= (chain-target (At $n)) (== $n 400)) + !(fuzz-reachable Chain (At 0) + chain-enumerate chain-transition chain-target + (reach-config (MaxDepth 0) (MaxStates 0) (MaxTransitions 0))) + `).at(-1)![0]!; + + expect(result).toMatch(/^\(FuzzReachable \(Property Chain\) \(Depth 400\)/); + expect(result).toContain("(Target (quote (At 400)))"); + }, 120_000); + + it("counts transition branches before deduplication", () => { + // (Count 1) is produced twice at depth one (up from 0, and split branch 0), so the transition + // count exceeds the state count. + const result = printed(` + ${COUNTER} + (= (never-target (Count $n)) (== $n 99)) + !(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition never-target + (reach-config (MaxDepth 20))) + `).at(-1)![0]!; + + const stats = /\(ReachStatistics \(States (\d+)\) \(Transitions (\d+)\) \(Depth (\d+)\)\)/.exec( + result, + ); + expect(stats).not.toBeNull(); + const states = Number(stats![1]); + const transitions = Number(stats![2]); + expect(states).toBe(6); + expect(transitions).toBeGreaterThan(states); + }); +}); diff --git a/packages/fuzz/src/readme.test.ts b/packages/fuzz/src/readme.test.ts new file mode 100644 index 0000000..aa210e6 --- /dev/null +++ b/packages/fuzz/src/readme.test.ts @@ -0,0 +1,72 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// The README's examples, run. It reads the file, runs every `metta` block in order against one +// accumulating program, and checks each result is the outcome the prose claims. The blocks are +// cumulative on purpose, so an example that needs relations shows them. + +import "./index.js"; +import { readFileSync } from "node:fs"; +import { dirname, resolve } from "node:path"; +import { fileURLToPath } from "node:url"; +import { describe, expect, it } from "vitest"; +import { + documentedFields, + markdownBlocks, + printedWithFuzz as printed, + undefinedDocumentedNames, +} from "./test-utils.js"; + +const README = resolve(dirname(fileURLToPath(import.meta.url)), "..", "README.md"); +const text = readFileSync(README, "utf8"); +const metta = markdownBlocks(text, "metta"); + +describe("the README's examples", () => { + it("has the blocks this test expects to find", () => { + // A renamed heading or a dropped fence would otherwise make the checks below silently vacuous. + expect(metta).toHaveLength(5); + }); + + it("runs every metta block and reports what the prose says it does", () => { + // One program: the declarations of each block are in scope for the ones after it. + const outcomes = printed(metta.join("\n")).map((result) => result[0] ?? ""); + + // Generated lists, reversed twice, all equal to themselves. + expect( + outcomes.find((line) => line.startsWith("(FuzzPassed (Property reverse-involution)")), + ).toBeDefined(); + + // Every count the README prints is read out of the document and checked against the run, so the two + // cannot drift. + const fields = documentedFields(text); + expect(fields).toContain("(Random 200)"); + const all = outcomes.join("\n"); + for (const field of fields) expect(all, `the README prints ${field}`).toContain(field); + + // Exhaustive: both booleans, so the domain is covered rather than sampled. + const exhaustive = outcomes.find((line) => line.startsWith("(FuzzExhaustivelyVerified")); + expect(exhaustive).toContain("(Property small) (DomainCount 2)"); + + // The machine agrees with its model over every generated command sequence. + expect( + outcomes.find((line) => line.startsWith("(FuzzPassed (Property Counter)")), + ).toBeDefined(); + + // Reachability: (Count 3) is two transitions away, and the witness was replayed before reporting. + const reachable = outcomes.find((line) => line.startsWith("(FuzzReachable (Property Counter)")); + expect(reachable).toContain("(Depth 2)"); + expect(reachable).toContain("(Target (quote (Count 3)))"); + + // Nothing in the README errors out or comes back undecided. + for (const line of outcomes) { + expect(line).not.toContain("FuzzInvalid"); + expect(line).not.toContain("FuzzKernelError"); + expect(line).not.toMatch(/^\(Error /); + } + }); + + it("names only operations the library actually has", () => { + expect(undefinedDocumentedNames(text, metta)).toEqual([]); + }); +}); diff --git a/packages/fuzz/src/runner.test.ts b/packages/fuzz/src/runner.test.ts new file mode 100644 index 0000000..2c78e3c --- /dev/null +++ b/packages/fuzz/src/runner.test.ts @@ -0,0 +1,706 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { + expr, + gint, + gnd, + registerBuiltinGroundedOperation, + sym, + type GroundFn, +} from "@mettascript/core"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +let flakyTick = 0; +const flakyPropertyResult: GroundFn = () => ({ + tag: "ok", + results: [expr([sym("Fail"), sym("UnstableResult"), expr([sym("Tick"), gint(flakyTick++)])])], +}); +registerBuiltinGroundedOperation("_fuzz-test-flaky-property-result", flakyPropertyResult, "Pure"); + +let postShrinkFlakyTick = 0; +const postShrinkFlakyPropertyResult: GroundFn = (args) => { + const value = args[0] ?? sym("MissingValue"); + const tick = postShrinkFlakyTick++; + return { + tag: "ok", + results: + tick === 9 + ? [expr([sym("Pass")])] + : [expr([sym("Fail"), sym("TooLarge"), expr([sym("Value"), value])])], + }; +}; +registerBuiltinGroundedOperation( + "_fuzz-test-post-shrink-flaky-property-result", + postShrinkFlakyPropertyResult, + "Pure", +); + +const externalValue: GroundFn = () => ({ + tag: "ok", + results: [gnd({ g: "ext", kind: "fuzz-test", id: "opaque-fuzz-value" })], +}); +registerBuiltinGroundedOperation("_fuzz-test-external-value", externalValue, "Pure"); + +describe("MeTTa fuzz runner", () => { + it("normalizes option-based configuration and rejects invalid options", () => { + expect( + printed(` + !(fuzz-config) + !(fuzz-config (Runs 0)) + !(fuzz-config (MaxSize -1)) + !(fuzz-config (EffectPolicy Unknown)) + !(fuzz-config (Runs 10) (Runs 20)) + !(fuzz-config (UnknownOption 1)) + `).slice(1), + ).toEqual([ + [ + "(FuzzConfig (Runs 100) (Seed 0) (MaxSize 100) (MaxDiscards 1000) (MaxShrinks 1000) (MaxShrinkImprovements 1000) (CaseSteps 100000) (CaseDepth 1000) (EffectPolicy Sandboxed) (EdgeCases 16) (MaxEnumerated 1000) (FailureMode SameFailureTag))", + ], + ["(FuzzInvalid InvalidConfig (InvalidRuns (Runs 0)))"], + ["(FuzzInvalid InvalidConfig (InvalidMaxSize (MaxSize -1)))"], + ["(FuzzInvalid InvalidConfig (InvalidEffectPolicy (EffectPolicy Unknown)))"], + ["(FuzzInvalid InvalidConfig (DuplicateOption Runs))"], + ["(FuzzInvalid InvalidConfig (UnknownOption (UnknownOption 1)))"], + ]); + }); + + it("requires the documented Atom to FuzzProperty signature", () => { + expect( + printed(` + (= (unsigned $value) (fuzz-pass)) + !(fuzz-check + unsigned-property + (gen-const value) + unsigned + (fuzz-config (Runs 1) (EdgeCases 0))) + `)[1], + ).toEqual([ + "(FuzzInvalid MissingPropertySignature (Property unsigned) (Expected (-> Atom FuzzProperty)))", + ]); + }); + + it("rejects malformed configuration before running a property", () => { + expect( + printed(` + (: signed (-> Atom FuzzProperty)) + (= (signed $value) (fuzz-pass)) + !(fuzz-check malformed-config (gen-const value) signed NotAConfig) + `)[1], + ).toEqual(["(FuzzInvalid InvalidConfig (MalformedConfig NotAConfig))"]); + }); + + it("runs regressions, examples, unique edges, then random cases", () => { + const result = printed(` + (: always (-> Atom FuzzProperty)) + (= (always $value) (classify True Seen (fuzz-pass))) + (FuzzRegression ordered-property 2 None) + (FuzzExample ordered-property 3) + !(fuzz-check + ordered-property + (gen-int 0 3) + always + (fuzz-config + (Seed 7) + (Runs 3) + (MaxSize 3) + (MaxDiscards 10) + (MaxShrinks 0) + (CaseSteps 10000) + (CaseDepth 100) + (EdgeCases 2))) + `)[1]![0]!; + + expect(result).toMatch(/^\(FuzzPassed \(Property ordered-property\) \(Seed 7\)/); + expect(result).toContain( + "(Counts (Passed 7) (PropertyDiscards 0) (GenerationDiscards 0) (Regressions 1) (Examples 1) (Edges 2) (Random 3))", + ); + expect(result).toContain("(Labels ((FuzzCount Seen 7)))"); + }); + + it("stops at the first failing phase in replay-first order", () => { + const result = printed(` + (: fails-bad (-> Atom FuzzProperty)) + (= (fails-bad $value) + (if (== $value bad) + (fuzz-fail BadValue (Value $value)) + (fuzz-pass))) + (FuzzRegression phase-order bad None) + (FuzzExample phase-order bad) + !(fuzz-check + phase-order + (gen-const good) + fails-bad + (fuzz-config + (Runs 1) + (MaxShrinks 0) + (EdgeCases 1))) + `)[1]![0]!; + + expect(result).toMatch( + /^\(FuzzFailed \(Property phase-order\) \(Phase Regression\) \(CaseIndex 0\)/, + ); + expect(result).toContain("(OriginalValue bad)"); + expect(result).toContain("(FailureTag BadValue)"); + }); + + it("distinguishes generation exhaustion from property discards", () => { + const out = printed(` + (= (never $value) False) + (: discard-property (-> Atom FuzzProperty)) + (= (discard-property $value) (fuzz-discard NotApplicable)) + !(fuzz-check + generation-discard + (gen-filter (gen-const value) never 1) + discard-property + (fuzz-config + (Runs 1) + (MaxDiscards 1) + (EdgeCases 0))) + !(fuzz-check + property-discard + (gen-const value) + discard-property + (fuzz-config + (Runs 1) + (MaxDiscards 1) + (EdgeCases 0))) + `); + + expect(out[1]![0]).toMatch( + /^\(FuzzGaveUp \(Property generation-discard\) GenerationDiscards .* \(GenerationDiscards 2\)/, + ); + expect(out[2]![0]).toMatch( + /^\(FuzzGaveUp \(Property property-discard\) PropertyDiscards .* \(PropertyDiscards 2\)/, + ); + }); + + it("surfaces invalid property results and evaluator cutoffs", () => { + const out = printed(` + (: empty-property (-> Atom FuzzProperty)) + (= (empty-property $value) (empty)) + (: expensive (-> Atom FuzzProperty)) + (= (expensive $value) (collapse (match &self $x $x))) + !(fuzz-check + empty-result + (gen-const value) + empty-property + (fuzz-config (Runs 1) (EdgeCases 0))) + !(fuzz-check + cutoff + (gen-const value) + expensive + (fuzz-config + (Runs 1) + (CaseSteps 1) + (EdgeCases 0))) + `); + + expect(out[1]![0]).toMatch( + /^\(FuzzInvalid NoPropertyResult \(Property empty-result\) \(Phase Random\)/, + ); + expect(out[2]![0]).toMatch( + /^\(FuzzCutoff \(Property cutoff\) \(Phase Random\).* \(CutoffTag ResourceLimit\)/, + ); + }); + + it("returns deterministic replay metadata and a stable failure signature", () => { + const source = ` + (: less-than-two (-> Atom FuzzProperty)) + (= (less-than-two $value) + (if (< $value 2) + (fuzz-pass) + (fuzz-fail TooLarge (Value $value)))) + !(fuzz-check + deterministic-failure + (gen-int 2 5) + less-than-two + (fuzz-config + (Seed 19) + (Runs 1) + (MaxSize 4) + (MaxShrinks 0) + (EdgeCases 0))) + `; + const first = printed(source)[1]![0]!; + const second = printed(source)[1]![0]!; + + expect(second).toBe(first); + expect(first).toMatch(/^\(FuzzFailed \(Property deterministic-failure\) \(Phase Random\)/); + expect(first).toContain("(FailureTag TooLarge)"); + expect(first).toContain("(OriginalValue "); + expect(first).toContain("(OriginalDecision (Decision Int "); + expect(first).toContain('(FailureSignature "mettascript-alpha-replay-key-v1;'); + expect(first).toContain( + "(FuzzReplay (Format 2) (Origin (Random (Rng xorshift128plus-v1) (Seed 19) (Case 0) (Size 0)))", + ); + expect(first).toContain("(EncodedDecisionTree (FuzzEncodedAtom 1 "); + expect(first).toContain("(EncodedValue (FuzzEncodedAtom 1 "); + }); + + it("shrinks the first generated failure and reports a replayable local minimum", () => { + const result = printed(` + (: greater-than-five (-> Atom FuzzProperty)) + (= (greater-than-five $value) + (if (> $value 5) + (fuzz-fail TooLarge (Value $value)) + (fuzz-pass))) + !(fuzz-check + integer-minimum + (gen-int 0 100) + greater-than-five + (fuzz-config + (Runs 1) + (MaxSize 100) + (MaxShrinks 100) + (MaxShrinkImprovements 100) + (CaseSteps 10000) + (CaseDepth 100) + (EdgeCases 2))) + `)[1]![0]!; + + expect(result).toContain("(OriginalValue 100)"); + expect(result).toContain("(SmallestValue 6)"); + expect(result).toContain( + "(SmallestDecision (Decision Int (Bounds 0 100) (Origin 0) (Value 6) ()))", + ); + expect(result).toContain( + "(Shrink (Order mettascript-shrink-v1) (Status LocallyMinimal) (Reason None) (Attempts 9) (Accepted 5) (LocallyMinimalUnder (Order mettascript-shrink-v1)))", + ); + expect(result).toContain("(Replay (FuzzReplay (Format 2) (Origin (Edge (Index 1)))"); + expect(result).toContain("(ConcreteValue 6)"); + }); + + it("keeps NaN failures stable and records their exact payload", () => { + const result = printed(` + (: fail-nan (-> Atom FuzzProperty)) + (= (fail-nan $value) + (fuzz-fail SawNaN (Value $value))) + !(let $nan (_fuzz-float64-from-bits 2146959360 23) + (fuzz-check + nan-replay + (gen-const $nan) + fail-nan + (fuzz-config + (Runs 1) + (MaxShrinks 1) + (EdgeCases 0)))) + `)[1]![0]!; + + expect(result).toMatch(/^\(FuzzFailed \(Property nan-replay\)/); + expect(result).not.toContain("FuzzFlaky"); + expect(result).toContain("(ConcreteValue NaN)"); + expect(result).toContain("(EncodedValue (FuzzEncodedAtom 1 (Float64Bits 2146959360 23)))"); + }); + + it("keeps alpha-equivalent failure tags while distinguishing NaN payloads", () => { + expect( + printed(` + !(let* ( + ($first (_fuzz-float64-from-bits 2146959360 23)) + ($second (_fuzz-float64-from-bits 2146959360 24)) + ($first-signature + (_fuzz-failure-signature (Saw $x $first))) + ($renamed-signature + (_fuzz-failure-signature (Saw $renamed $first))) + ($second-signature + (_fuzz-failure-signature (Saw $x $second)))) + (FailureSignatureIdentity + (== $first-signature $renamed-signature) + (== $first-signature $second-signature))) + `)[1], + ).toEqual(["(FailureSignatureIdentity True False)"]); + }); + + it("reports nonreplayable failures without misclassifying them as flaky", () => { + const results = printed(` + (: always-fails (-> Atom FuzzProperty)) + (= (always-fails $value) + (fuzz-fail Failed (Value $value))) + (= (CustomCapabilities ExternalTree ()) + (FuzzCustomCapabilities + (Modes (Random Replay ShrinkReplay)))) + (= (to-external $value) + (_fuzz-test-external-value)) + (= (DriveCustom ExternalTree () $driver $size) + (let $external (_fuzz-test-external-value) + (FuzzSample + stable + $driver + (Decision Const (Opaque $external) (Value stable) ())))) + (: external-observation (-> Atom FuzzProperty)) + (= (external-observation $value) + (fuzz-fail Failed + (Observed (_fuzz-test-external-value)))) + !(fuzz-check + external-generator + (gen-const (_fuzz-test-external-value)) + always-fails + (fuzz-config (Runs 1) (EdgeCases 0) (MaxShrinks 1))) + !(fuzz-check + external-value + (gen-map to-external (gen-const input)) + always-fails + (fuzz-config (Runs 1) (EdgeCases 0) (MaxShrinks 1))) + !(fuzz-check + external-decision + (gen-custom ExternalTree ()) + always-fails + (fuzz-config (Runs 1) (EdgeCases 0) (MaxShrinks 1))) + !(fuzz-check + external-observation + (gen-const input) + external-observation + (fuzz-config (Runs 1) (EdgeCases 0) (MaxShrinks 1))) + `).slice(1); + + const stages = ["Generator", "ConcreteValue", "DecisionTree", "PropertyObservation"]; + expect(results).toHaveLength(stages.length); + for (const [index, stage] of stages.entries()) { + const result = results[index]![0]!; + expect(result).toMatch(/^\(FuzzFailed /); + expect(result).not.toContain("FuzzFlaky"); + expect(result).toContain( + `(Replay (FuzzReplayUnavailable (Stage ${stage}) (Error NonReplayableGroundedValue ExternalGrounded)))`, + ); + expect(result).toContain( + `(Reason (ReplayUnavailable (Stage ${stage}) (Error NonReplayableGroundedValue ExternalGrounded)))`, + ); + } + }); + + it("rejects a nonreplayable edge decision before deduplication", () => { + expect( + printed(` + (: passes (-> Atom FuzzProperty)) + (= (passes $value) (fuzz-pass)) + !(fuzz-check + external-edge + (gen-const (_fuzz-test-external-value)) + passes + (fuzz-config (Runs 1) (EdgeCases 1))) + `)[1], + ).toEqual([ + "(FuzzInvalid NonReplayableEdgeDecision (Property external-edge) (Phase Edge) (ErrorCode NonReplayableGroundedValue) ExternalGrounded)", + ]); + }); + + it("preserves the failure tag by default and can accept any failure", () => { + const out = printed(` + (: two-failures (-> Atom FuzzProperty)) + (= (two-failures $value) + (if (> $value 50) + (fuzz-fail Large (Value $value)) + (if (> $value 0) + (fuzz-fail Small (Value $value)) + (fuzz-pass)))) + !(fuzz-check + same-tag + (gen-int 0 100) + two-failures + (fuzz-config + (Runs 1) + (MaxSize 100) + (MaxShrinks 100) + (MaxShrinkImprovements 100) + (FailureMode SameFailureTag) + (EdgeCases 2))) + !(fuzz-check + any-tag + (gen-int 0 100) + two-failures + (fuzz-config + (Runs 1) + (MaxSize 100) + (MaxShrinks 100) + (MaxShrinkImprovements 100) + (FailureMode AnyFailure) + (EdgeCases 2))) + `); + + expect(out[1]![0]).toContain("(OriginalFailureTag Large)"); + expect(out[1]![0]).toContain("(FailureTag Large)"); + expect(out[1]![0]).toContain("(SmallestValue 51)"); + expect(out[2]![0]).toContain("(OriginalFailureTag Large)"); + expect(out[2]![0]).toContain("(FailureTag Small)"); + expect(out[2]![0]).toContain("(SmallestValue 1)"); + }); + + it("counts property evaluations and accepted improvements separately", () => { + const out = printed(` + (: greater-than-five (-> Atom FuzzProperty)) + (= (greater-than-five $value) + (if (> $value 5) + (fuzz-fail TooLarge (Value $value)) + (fuzz-pass))) + !(fuzz-check + one-attempt + (gen-int 0 100) + greater-than-five + (fuzz-config + (Runs 1) + (MaxSize 100) + (MaxShrinks 1) + (MaxShrinkImprovements 100) + (EdgeCases 2))) + !(fuzz-check + one-improvement + (gen-int 0 100) + greater-than-five + (fuzz-config + (Runs 1) + (MaxSize 100) + (MaxShrinks 100) + (MaxShrinkImprovements 1) + (EdgeCases 2))) + `); + + expect(out[1]![0]).toContain("(SmallestValue 100)"); + expect(out[1]![0]).toContain( + "(Status MaxShrinksReached) (Reason None) (Attempts 1) (Accepted 0)", + ); + expect(out[2]![0]).toContain("(SmallestValue 50)"); + expect(out[2]![0]).toContain( + "(Status MaxShrinkImprovementsReached) (Reason None) (Attempts 2) (Accepted 1)", + ); + }); + + it("does not replay external effects without a reset adapter", () => { + const result = printed(` + (: external-property (-> Atom FuzzProperty)) + (= (external-property $value) + (fuzz-fail ExternalFailure (Value $value))) + !(fuzz-check + external + (gen-int 0 10) + external-property + (fuzz-config + (Runs 1) + (MaxShrinks 100) + (EffectPolicy ExternalEffects) + (EdgeCases 1))) + `)[1]![0]!; + + expect(result).toContain( + "(Status Disabled) (Reason ExternalEffectsWithoutReset) (Attempts 0) (Accepted 0)", + ); + expect(result).toContain("(NotShrunk (Reason ExternalEffectsWithoutReset))"); + expect(result).not.toContain("SmallestFoundUnder"); + expect(result).toContain("(OriginalValue 0)"); + expect(result).toContain("(SmallestValue 0)"); + }); + + it("retains failing-case labels, collected values, coverage, and notes", () => { + const result = printed(` + (: reported-failure (-> Atom FuzzProperty)) + (= (reported-failure $value) + (if (> $value 5) + (counterexample + (Input $value) + (collect + $value + (classify + True + FailureCase + (cover + 10 + True + FailureCovered + (fuzz-fail TooLarge (Value $value)))))) + (fuzz-pass))) + !(fuzz-check + reported-failure + (gen-int 0 100) + reported-failure + (fuzz-config + (Runs 1) + (MaxSize 100) + (MaxShrinks 100) + (MaxShrinkImprovements 100) + (EdgeCases 2))) + `)[1]![0]!; + + expect(result).toContain("(OriginalLabels (Labels (FailureCase)))"); + expect(result).toContain("(OriginalCollected (Collected (100)))"); + expect(result).toContain( + "(OriginalCoverage (Coverage ((CoverageObservation 10 FailureCovered True))))", + ); + expect(result).toContain("(OriginalAnnotations (Annotations ((Input 100))))"); + expect(result).toContain("(SmallestLabels (Labels (FailureCase)))"); + expect(result).toContain("(SmallestCollected (Collected (6)))"); + expect(result).toContain( + "(SmallestCoverage (Coverage ((CoverageObservation 10 FailureCovered True))))", + ); + expect(result).toContain("(SmallestAnnotations (Annotations ((Input 6))))"); + }); + + it("reports pre-shrink result-bag instability as flaky", () => { + flakyTick = 0; + const result = printed(` + (: unstable-property (-> Atom FuzzProperty)) + (= (unstable-property $value) + (_fuzz-test-flaky-property-result)) + !(fuzz-check + unstable + (gen-int 1 1) + unstable-property + (fuzz-config + (Runs 1) + (MaxShrinks 10) + (EdgeCases 1))) + `)[1]![0]!; + + expect(result).toMatch(/^\(FuzzFlaky \(Property unstable\) \(Phase Edge\) \(CaseIndex 0\)/); + expect(result).toContain("(Stage PreShrink)"); + expect(result).toContain("(ExpectedCase (FuzzCaseObservation Fail UnstableResult"); + expect(result).toContain("(Reason PreShrinkReplayMismatch)"); + }); + + it("checks the minimized failure twice before claiming local minimality", () => { + postShrinkFlakyTick = 0; + const result = printed(` + (: post-shrink-unstable (-> Atom FuzzProperty)) + (= (post-shrink-unstable $value) + (if (> $value 5) + (_fuzz-test-post-shrink-flaky-property-result $value) + (fuzz-pass))) + !(fuzz-check + post-shrink-unstable + (gen-int 0 100) + post-shrink-unstable + (fuzz-config + (Runs 1) + (MaxSize 100) + (MaxShrinks 100) + (MaxShrinkImprovements 100) + (EdgeCases 2))) + `)[1]![0]!; + + expect(result).toMatch( + /^\(FuzzFlaky \(Property post-shrink-unstable\) \(Phase Edge\) \(CaseIndex 1\)/, + ); + expect(result).toContain("(Stage PostShrink)"); + expect(result).toContain("(ExpectedValue 6)"); + expect(result).toContain( + "(Status LocallyMinimal) (Reason PostShrinkReplayMismatch) (Attempts 9) (Accepted 5)", + ); + }); + + it("verifies a full decision domain exhaustively with per-tree replay", () => { + const result = printed(` + (: small-pass (-> Atom FuzzProperty)) + (= (small-pass $value) (fuzz-pass)) + !(fuzz-check-exhaustive + verified-domain + (gen-int 0 3) + small-pass + (fuzz-config (MaxSize 1))) + `)[1]![0]!; + expect(result).toMatch( + /^\(FuzzExhaustivelyVerified \(Property verified-domain\) \(DomainCount 4\) \(Enumerated 4\) \(ExhaustiveStatistics /, + ); + expect(result).toContain("(Passed 4)"); + }); + + it("reports the depth-first counterexample with exhaustive replay coordinates", () => { + const result = printed(` + (: no-three (-> Atom FuzzProperty)) + (= (no-three $value) (expect-true (< $value 3) (SawThree $value))) + !(fuzz-check-exhaustive + exhaustive-counterexample + (gen-int 0 3) + no-three + (fuzz-config (MaxSize 1))) + `)[1]![0]!; + expect(result).toMatch( + /^\(FuzzFailed \(Property exhaustive-counterexample\) \(Phase Exhaustive\) \(CaseIndex 3\)/, + ); + expect(result).toContain("(OriginalValue 3)"); + expect(result).toContain("(Origin (Exhaustive (Choices (3)) (Case 3) (Size 1)))"); + expect(result).toContain("(Status LocallyMinimal)"); + }); + + it("enumerates dependent domains exactly during exhaustive checking", () => { + const result = printed(` + (= (dependent-branch False) (gen-const only)) + (= (dependent-branch True) (gen-bool)) + (: any-value (-> Atom FuzzProperty)) + (= (any-value $value) (fuzz-pass)) + !(fuzz-check-exhaustive + dependent-domain + (gen-bind (gen-bool) dependent-branch) + any-value + (fuzz-config (MaxSize 1))) + `)[1]![0]!; + expect(result).toMatch( + /^\(FuzzExhaustivelyVerified \(Property dependent-domain\) \(DomainCount 3\) \(Enumerated 3\)/, + ); + }); + + it("gives up as inconclusive at the enumeration limit", () => { + const result = printed(` + (: small-pass (-> Atom FuzzProperty)) + (= (small-pass $value) (fuzz-pass)) + !(fuzz-check-exhaustive + capped-domain + (gen-int 0 3) + small-pass + (fuzz-config (MaxSize 1) (MaxEnumerated 2))) + `)[1]![0]!; + expect(result).toMatch( + /^\(FuzzGaveUp \(Property capped-domain\) EnumerationLimit \(ExhaustiveStatistics \(Enumerated 2\) \(DomainCount 2\)/, + ); + }); + + it("treats property discards as inconclusive, never as exhaustive passes", () => { + const result = printed(` + (: discard-two (-> Atom FuzzProperty)) + (= (discard-two $value) + (if (== $value 2) (fuzz-discard SkipsTwo) (fuzz-pass))) + !(fuzz-check-exhaustive + discarded-domain + (gen-int 0 3) + discard-two + (fuzz-config (MaxSize 1))) + `)[1]![0]!; + expect(result).toMatch( + /^\(FuzzGaveUp \(Property discarded-domain\) ExhaustivePropertyDiscards \(ExhaustiveStatistics \(Enumerated 4\) \(DomainCount 4\)/, + ); + expect(result).toContain("(PropertyDiscards 1)"); + }); + + it("reports an empty accepted domain as invalid", () => { + const result = printed(` + (= (never $x) False) + (: small-pass (-> Atom FuzzProperty)) + (= (small-pass $value) (fuzz-pass)) + !(fuzz-check-exhaustive + empty-domain + (gen-filter (gen-int 0 1) never 2) + small-pass + (fuzz-config (MaxSize 1) (MaxEnumerated 20))) + `)[1]![0]!; + expect(result).toMatch( + /^\(FuzzInvalid EmptyExhaustiveDomain \(Property empty-domain\) \(ExhaustiveStatistics \(Enumerated 4\) \(DomainCount 0\)/, + ); + expect(result).toContain("(GenerationDiscards 4)"); + }); + + it("checks coverage requirements against the exact domain", () => { + const result = printed(` + (: covered (-> Atom FuzzProperty)) + (= (covered $value) (fuzz-cover 90 High (> $value 2) (fuzz-pass))) + !(fuzz-check-exhaustive + covered-domain + (gen-int 0 3) + covered + (fuzz-config (MaxSize 1))) + `)[1]![0]!; + expect(result).toMatch( + /^\(FuzzInsufficientCoverage \(Property covered-domain\) \(Requirement High \(MinimumPercent 90\) \(Hits 1\) \(Total 4\)\)/, + ); + }); +}); diff --git a/packages/fuzz/src/shrink.test.ts b/packages/fuzz/src/shrink.test.ts new file mode 100644 index 0000000..76a716e --- /dev/null +++ b/packages/fuzz/src/shrink.test.ts @@ -0,0 +1,159 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +describe("MeTTa fuzz shrink relation", () => { + it("shrinks integers toward their origin before intermediate values", () => { + expect( + printed(` + !(_fuzz-int-value-candidates 100 0 100 0) + !(_fuzz-int-value-candidates 7 0 10 5) + !(_fuzz-shrink-candidates + (Decision Int (Bounds 0 100) (Origin 0) (Value 100) ())) + `).slice(1), + ).toEqual([ + ["(0 50 75 88 94 97 99)"], + // Bounds join the ladder only when strictly closer to the origin than the current value: + // for value 7 with origin 5, both 0 and 10 sit farther out and would re-inflate an accepted + // counterexample through the lenient shrink replay. + ["(5 6)"], + [ + "((Decision Int (Bounds 0 100) (Origin 0) (Value 0) ()) (Decision Int (Bounds 0 100) (Origin 0) (Value 50) ()) (Decision Int (Bounds 0 100) (Origin 0) (Value 75) ()) (Decision Int (Bounds 0 100) (Origin 0) (Value 88) ()) (Decision Int (Bounds 0 100) (Origin 0) (Value 94) ()) (Decision Int (Bounds 0 100) (Origin 0) (Value 97) ()) (Decision Int (Bounds 0 100) (Origin 0) (Value 99) ()))", + ], + ]); + }); + + it("removes the largest legal list chunks first", () => { + const candidates = printed(` + !(_fuzz-shrink-candidates + (Decision List (Bounds 0 4) (Length 4) + ((Decision Int (Bounds 0 4) (Origin 0) (Value 4) ()) + (Decision Int (Bounds 0 9) (Origin 0) (Value 1) ()) + (Decision Int (Bounds 0 9) (Origin 0) (Value 2) ()) + (Decision Int (Bounds 0 9) (Origin 0) (Value 3) ()) + (Decision Int (Bounds 0 9) (Origin 0) (Value 4) ())))) + `)[1]![0]!; + expect(candidates).toMatch(/^\(\(Decision List \(Bounds 0 4\) \(Length 0\)/); + expect(candidates).toContain("(Decision List (Bounds 0 4) (Length 2)"); + expect(candidates).toContain("(Decision List (Bounds 0 4) (Length 3)"); + }); + + it("shrinks nested children from left to right", () => { + const candidates = printed(` + !(_fuzz-shrink-candidates + (Decision Tuple (Count 2) () + ((Decision Int (Bounds 0 10) (Origin 0) (Value 8) ()) + (Decision Int (Bounds 0 10) (Origin 0) (Value 6) ())))) + `)[1]![0]!; + + const firstLeft = candidates.indexOf( + "(Decision Int (Bounds 0 10) (Origin 0) (Value 0) ()) (Decision Int (Bounds 0 10) (Origin 0) (Value 6) ())", + ); + const firstRight = candidates.indexOf( + "(Decision Int (Bounds 0 10) (Origin 0) (Value 8) ()) (Decision Int (Bounds 0 10) (Origin 0) (Value 0) ())", + ); + + expect(firstLeft).toBeGreaterThanOrEqual(0); + expect(firstRight).toBeGreaterThan(firstLeft); + }); + + it("shrinks float decisions through their integer trace while preserving replay identity", () => { + const candidates = printed(` + !(_fuzz-shrink-candidates + (Decision FloatRange (Indices -1 1) (Index 1) + ((Decision Int (Bounds -1 1) (Origin 0) (Value 1) ())))) + !(_fuzz-shrink-replay + (gen-float-range -0.0 0.0) + (Decision FloatRange (Indices -1 0) (Index -1) + ((Decision Int (Bounds -1 0) (Origin 0) (Value -1) ()))) + 1) + !(_fuzz-shrink-replay + (gen-float-range -0.0 0.0) + (Decision FloatRange (Indices -1 0) (Index -1) + ((Decision Int (Bounds -1 0) (Origin 0) (Value 0) ()))) + 1) + !(let $replayed + (_fuzz-shrink-replay + (gen-float-bits) + (Decision FloatBits (Format IEEE754Binary64) + (Bits 2146959360 23) + ((Decision Int + (Bounds 0 4294967295) + (Origin 0) + (Value 2146959360) + ()) + (Decision Int + (Bounds 0 4294967295) + (Origin 0) + (Value 24) + ()))) + 1) + (switch $replayed + (((FuzzShrinkReplay $value $tree) + (FloatBitsShrinkReplay + (_fuzz-float64-bits $value) + $tree)) + ($bad $bad)))) + `).slice(1); + + expect(candidates[0]![0]).toContain( + "(Decision FloatRange (Indices -1 1) (Index 1) ((Decision Int (Bounds -1 1) (Origin 0) (Value 0) ())))", + ); + // The far bound -1 is no candidate: it sits at the same origin distance as the current value, + // a lateral move the shrink order could never accept. + expect(candidates[0]![0]).not.toContain( + "(Decision FloatRange (Indices -1 1) (Index 1) ((Decision Int (Bounds -1 1) (Origin 0) (Value -1) ())))", + ); + expect(candidates[1]![0]).toContain( + "(FuzzShrinkReplay -0.0 (Decision FloatRange (Indices -1 0) (Index -1)", + ); + expect(candidates[2]![0]).toContain( + "(FuzzShrinkReplay 0.0 (Decision FloatRange (Indices -1 0) (Index 0)", + ); + expect(candidates[3]).toEqual([ + "(FloatBitsShrinkReplay (Float64Bits 2146959360 24) (Decision FloatBits (Format IEEE754Binary64) (Bits 2146959360 24) ((Decision Int (Bounds 0 4294967295) (Origin 0) (Value 2146959360) ()) (Decision Int (Bounds 0 4294967295) (Origin 0) (Value 24) ()))))", + ]); + }); + + it("deduplicates NaN-bearing decision trees by replay payload", () => { + expect( + printed(` + !(let $nan (_fuzz-float64-from-bits 2146959360 23) + (_fuzz-deduplicate-trees + ((Decision Const () (Value $nan) ()) + (Decision Const () (Value $nan) ())))) + `)[1], + ).toEqual(["((Decision Const () (Value NaN) ()))"]); + }); + + it("tries validated custom shrink choices before child descent", () => { + expect( + printed(` + (= (CustomCapabilities Tagged ($tag)) + (FuzzCustomCapabilities + (Modes (Random Edge Replay ShrinkReplay)))) + (= (ShrinkChoices Tagged ($tag) $tree) + (Decision Custom + (CustomGenerator (Name Tagged) (Arguments ($tag))) + () + ((Decision Int (Bounds 0 3) (Origin 0) (Value 0) ())))) + (= (ShrinkChoices Tagged ($tag) $tree) + (Decision Custom + (CustomGenerator (Name Other) (Arguments ())) + () + ((Decision Int (Bounds 0 3) (Origin 0) (Value 0) ())))) + !(_fuzz-shrink-candidates + (Decision Custom + (CustomGenerator (Name Tagged) (Arguments (tag))) + () + ((Decision Int (Bounds 0 3) (Origin 0) (Value 3) ())))) + `)[1]![0], + ).toContain( + "(Decision Custom (CustomGenerator (Name Tagged) (Arguments (tag))) () ((Decision Int (Bounds 0 3) (Origin 0) (Value 0) ())))", + ); + }); +}); diff --git a/packages/fuzz/src/suite.test.ts b/packages/fuzz/src/suite.test.ts new file mode 100644 index 0000000..b5b40ec --- /dev/null +++ b/packages/fuzz/src/suite.test.ts @@ -0,0 +1,199 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import "./index.js"; +import { describe, expect, it } from "vitest"; +import { printedWithFuzz as printed } from "./test-utils.js"; + +const TESTS = ` + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + (: never (-> Atom FuzzProperty)) + (= (never $value) (fuzz-fail Wrong (Saw $value))) + (FuzzTest ok-one (gen-int 0 3) always (fuzz-config (Seed 1) (Runs 2) (EdgeCases 0))) + (FuzzTest ok-two (gen-bool) always (fuzz-config (Seed 2) (Runs 2) (EdgeCases 0))) +`; + +describe("MeTTa suite discovery", () => { + it("finds declared tests and pairs each result with its id", () => { + const results = printed(` + ${TESTS} + !(fuzz-run-suite) + `).at(-1)![0]!; + + // One (FuzzSuiteResult id result) per declaration, in declaration order. + expect(results).toMatch(/^\(\(FuzzSuiteResult ok-one \(FuzzPassed \(Property ok-one\)/); + expect(results).toContain("(FuzzSuiteResult ok-two (FuzzPassed (Property ok-two)"); + }); + + it("lists declared tests without running them", () => { + const listed = printed(` + ${TESTS} + !(fuzz-suite-tests) + `).at(-1)![0]!; + + // The generator stays syntax in the declaration, which is what lets fuzz-check evaluate it once + // per run rather than at discovery. + expect(listed).toContain("(FuzzTestCase ok-one (gen-int 0 3) always"); + expect(listed).toContain("(FuzzTestCase ok-two (gen-bool) always"); + }); + + it("runs a failing declaration and reports it under its own id", () => { + const results = printed(` + (: never (-> Atom FuzzProperty)) + (= (never $value) (fuzz-fail Wrong (Saw $value))) + (FuzzTest bad (gen-int 0 9) never (fuzz-config (Seed 1) (Runs 3))) + !(fuzz-run-suite) + `).at(-1)![0]!; + + expect(results).toContain("(FuzzSuiteResult bad (FuzzFailed (Property bad)"); + expect(results).toContain("(FailureTag Wrong)"); + }); + + it("merges overrides by replacement, keeping the test's other choices", () => { + const out = printed(` + ${TESTS} + !(let $c (_fuzz-config-with-overrides + (fuzz-config (Seed 1) (Runs 2) (EdgeCases 0)) ((Runs 9))) + (quote $c)) + !(_fuzz-config-get Runs (_fuzz-config-with-overrides (fuzz-config (Seed 1) (Runs 2)) ())) + !(_fuzz-config-get Runs + (_fuzz-config-with-overrides (fuzz-config (Seed 1) (Runs 2) (EdgeCases 0)) ((Runs 9)))) + !(_fuzz-config-get EdgeCases + (_fuzz-config-with-overrides (fuzz-config (Seed 1) (Runs 2) (EdgeCases 0)) ((Runs 9)))) + `); + + // Runs is replaced and moved to the end; Seed and EdgeCases survive. Appending the override + // instead of replacing would make this a DuplicateOption error. + expect(out.at(-4)![0]).toBe("(quote (fuzz-config (Seed 1) (EdgeCases 0) (Runs 9)))"); + // No overrides returns the config untouched, so its own options still normalize. + expect(out.at(-3)![0]).toBe("2"); + // And the merged config still normalizes, with the override winning. + expect(out.at(-2)![0]).toBe("9"); + expect(out.at(-1)![0]).toBe("0"); + }); + + it("applies overrides to every test in a run", () => { + const results = printed(` + ${TESTS} + !(fuzz-run-suite-with ((Runs 5) (Seed 42))) + `).at(-1)![0]!; + + // Both declarations now report the overriding seed rather than their own. + expect(results).toContain("(FuzzPassed (Property ok-one) (Seed 42)"); + expect(results).toContain("(FuzzPassed (Property ok-two) (Seed 42)"); + }); + + it("runs a suite exhaustively when asked", () => { + const results = printed(` + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + (FuzzTest small (gen-bool) always (fuzz-config (MaxEnumerated 10))) + !(fuzz-run-suite-exhaustive ()) + `).at(-1)![0]!; + + expect(results).toContain("(FuzzExhaustivelyVerified (Property small) (DomainCount 2)"); + }); + + it("reports an empty suite as an empty result list", () => { + expect(printed(`!(fuzz-run-suite)`).at(-1)![0]).toBe("()"); + }); + + it("reports a malformed declaration instead of skipping it", () => { + const results = printed(` + (FuzzTest only-two-fields (gen-bool)) + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + (FuzzTest fine (gen-bool) always (fuzz-config (Runs 1) (EdgeCases 0))) + !(fuzz-run-suite) + `).at(-1)![0]!; + + // The 3-field declaration does not match the 4-field FuzzTest pattern, so discovery never sees + // it; the well-formed one still runs. A silently-dropped declaration is the risk here, so the + // test pins that the good one is present and the suite did not error out. + expect(results).toContain("(FuzzSuiteResult fine (FuzzPassed (Property fine)"); + }); + + it("rejects an override list that names an unknown option", () => { + const results = printed(` + ${TESTS} + !(fuzz-run-suite-with ((NotAnOption 3))) + `).at(-1)![0]!; + + expect(results).toContain("InvalidConfig"); + }); +}); + +// A reachability search is declared the same way, but with its own relations rather than one +// generator, because a transition returning several next states is the point of the search. +const REACH = ` + (= (endless-enumerate $state) (FiniteCommands up)) + (= (endless-transition (Count $n) up) (Count (+ $n 1))) + (= (at-three (Count $n)) (== $n 3)) + (FuzzReachTest climb (Count 0) endless-enumerate endless-transition at-three + (reach-config (MaxDepth 10))) +`; + +describe("MeTTa reachability suite discovery", () => { + it("finds declared searches and pairs each result with its id", () => { + const results = printed(` + ${REACH} + !(fuzz-run-reach-suite) + `).at(-1)![0]!; + + expect(results).toContain("(FuzzSuiteResult climb (FuzzReachable (Property climb) (Depth 3)"); + }); + + it("lists declared searches without running them", () => { + const listed = printed(` + ${REACH} + !(fuzz-reach-suite-tests) + `).at(-1)![0]!; + + expect(listed).toContain("(FuzzReachCase climb (Count 0) endless-enumerate"); + }); + + it("applies reach overrides, so a shallow depth turns the answer into a bounded negative", () => { + const bounded = printed(` + ${REACH} + !(fuzz-run-reach-suite-with ((MaxDepth 2))) + `).at(-1)![0]!; + + // The declaration asked for depth 10 and would have found the target; the override replaces it. + // A bounded negative must never be reported as exhaustion of the model. + expect(bounded).toContain("(FuzzUnreachableWithinDepth (Property climb) (Depth 2)"); + expect(bounded).not.toContain("FuzzReachabilityExhausted"); + }); + + it("merges reach overrides by replacement under the reach-config head", () => { + // Let-bound before quoting: `quote` freezes its argument, so quoting the call directly would + // report the call rather than the merge. + const out = printed(` + !(let $c (_fuzz-reach-config-with-overrides + (reach-config (MaxDepth 10) (StateIdentity Exact)) ((MaxDepth 2))) + (quote $c)) + !(let $c (_fuzz-reach-config-with-overrides (reach-config (MaxDepth 10)) ()) (quote $c)) + !(_fuzz-reach-config-with-overrides (fuzz-config (Runs 2)) ((MaxDepth 2))) + `); + + expect(out.at(-3)![0]).toBe("(quote (reach-config (StateIdentity Exact) (MaxDepth 2)))"); + expect(out.at(-2)![0]).toBe("(quote (reach-config (MaxDepth 10)))"); + // A record under the wrong head is refused rather than rewritten into the expected one. + expect(out.at(-1)![0]).toContain("InvalidReachConfig"); + }); + + it("reports a malformed reach declaration instead of skipping it", () => { + const results = printed(` + (FuzzReachTest too-few (Count 0) endless-enumerate) + ${REACH} + !(fuzz-run-reach-suite) + `).at(-1)![0]!; + + expect(results).toContain("(FuzzSuiteResult climb (FuzzReachable"); + }); + + it("reports an empty reach suite as an empty result list", () => { + expect(printed(`!(fuzz-run-reach-suite)`).at(-1)![0]).toBe("()"); + }); +}); diff --git a/packages/fuzz/src/test-utils.ts b/packages/fuzz/src/test-utils.ts new file mode 100644 index 0000000..b614b92 --- /dev/null +++ b/packages/fuzz/src/test-utils.ts @@ -0,0 +1,97 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +import { readFileSync, readdirSync } from "node:fs"; +import { dirname, resolve } from "node:path"; +import { fileURLToPath } from "node:url"; +import { format, runProgram } from "@mettascript/core"; + +export const printedWithFuzz = (body: string): string[][] => + runProgram(`!(import! &self fuzz)\n${body}`, 10_000_000).map((query) => + query.results.map(format), + ); + +// Documentation checks. A documented example that no longer runs is worse than no example, so the +// README and the website page are executed rather than trusted, and both use these. + +/** The fenced blocks of one language in a Markdown document, in order. */ +export function markdownBlocks(text: string, language: string): string[] { + const found: string[] = []; + const fence = new RegExp(`^\`\`\`${language}\\n([\\s\\S]*?)^\`\`\``, "gm"); + for (let match = fence.exec(text); match !== null; match = fence.exec(text)) + found.push(match[1]!); + return found; +} + +/** Every MeTTa source of the library, concatenated, for checking that a documented name exists. */ +export function libraryMettaSource(): string { + const dir = resolve(dirname(fileURLToPath(import.meta.url)), "metta"); + return readdirSync(dir) + .filter((name) => name.endsWith(".metta")) + .map((name) => readFileSync(resolve(dir, name), "utf8")) + .join("\n"); +} + +// The result fields a document prints and a run can be checked against. Kept to fields whose value is a +// claim about behaviour: a count, a shrunk value, a witness. `(Seed 0)` and friends are configuration +// echoed back and prove nothing. +const CHECKED_FIELDS = [ + "Passed", + "Edges", + "Random", + "DomainCount", + "Depth", + "FailureTag", + "OriginalValue", + "SmallestValue", + "Commands", + "Witness", + "Target", + "States", +] as const; + +/** + * Every `(Field ...)` group a document's `text` blocks print, as literal text, for the fields worth + * checking. Groups are read with balanced parentheses so a nested value comes out whole, and a group + * holding an elision is skipped because the document did not claim the whole of it. + */ +export function documentedFields(text: string): string[] { + const found: string[] = []; + for (const block of markdownBlocks(text, "text")) { + for (const field of CHECKED_FIELDS) { + const opener = new RegExp(`\\(${field}[\\s)]`, "g"); + for (let at = opener.exec(block); at !== null; at = opener.exec(block)) { + let depth = 0; + let end = at.index; + for (; end < block.length; end += 1) { + if (block[end] === "(") depth += 1; + else if (block[end] === ")" && --depth === 0) break; + } + if (depth !== 0) continue; + const group = block.slice(at.index, end + 1); + if (!group.includes("...")) found.push(group); + } + } + } + return found; +} + +/** + * The `gen-`, `expect-`, `fuzz-` and `reach-` names a document mentions that the library does not have. + * Matching is whole-token on purpose: a loose match would accept `fuzz-machine` because + * `_fuzz-machine-spec` contains it, and that near-miss is exactly what a name written from memory looks + * like. Names the document defines itself are excluded, since a tutorial defines its own relations. + */ +export function undefinedDocumentedNames(text: string, blocks: readonly string[]): string[] { + const library = libraryMettaSource(); + const defined = new Set( + [...blocks.join("\n").matchAll(/^\s*\(=\s+\(([\w-]+)/gm)].map((match) => match[1]!), + ); + const mentioned = new Set( + [...text.matchAll(/(?:^|[\s(`])((?:gen|expect|fuzz|reach)-[a-z][a-z-]*)/gm)].map((m) => m[1]!), + ); + return [...mentioned].filter( + (name) => !defined.has(name) && !new RegExp(`(? { + const whole = existsSync(page) ? readFileSync(page, "utf8") : ""; + const text = firstSectionOnly ? currentSection(whole) : whole; + const metta = markdownBlocks(text, "metta"); + + it("exists and carries examples", () => { + expect(existsSync(page), page).toBe(true); + expect(metta.length).toBeGreaterThan(0); + }); + + it("runs every example without an error or an invalid result", () => { + const outcomes = printed(metta.join("\n")).map((result) => result[0] ?? ""); + + for (const line of outcomes) { + expect(line).not.toContain("FuzzInvalid"); + expect(line).not.toContain("FuzzKernelError"); + expect(line).not.toContain("MalformedProperty"); + expect(line).not.toMatch(/^\(Error /); + } + // Documented output is a claim about behaviour, so it is checked rather than trusted: every outcome + // kind the page prints has to be one the run produced, and every count, shrunk value and witness it + // prints has to appear verbatim in the results. + const printedHeads = new Set( + markdownBlocks(text, "text").flatMap((block) => + [...block.matchAll(/\((Fuzz[A-Za-z]+) \(Property ([\w-]+)\)/g)].map( + (match) => `${match[1]!} ${match[2]!}`, + ), + ), + ); + for (const head of printedHeads) { + const [kind, property] = head.split(" "); + expect( + outcomes.some((line) => line.startsWith(`(${kind} (Property ${property})`)), + `the page prints ${head}`, + ).toBe(true); + } + + const all = outcomes.join("\n"); + for (const field of documentedFields(text)) + expect(all, `the page prints ${field}`).toContain(field); + }); + + it("names only operations the library actually has", () => { + expect(undefinedDocumentedNames(text, metta)).toEqual([]); + }); + + it("documents the defaults the library actually uses", () => { + // Six of the twelve were wrong when this page was first written, all of them plausible. A table of + // defaults is a claim about behaviour like any other, so it is read out of the page and compared with + // what the library reports. + const rows = [...text.matchAll(/^\| `(\w+)` \| `?([\w.]+)`? \|/gm)]; + if (rows.length === 0) return; + + const config = printed("!(fuzz-default-config)").at(-1)![0]!; + const reach = printed("!(reach-config-defaults)").at(-1)![0]!; + const documented = rows.filter(([, name]) => new RegExp(`\\(${name!} `).test(config + reach)); + expect(documented.length).toBeGreaterThan(10); + for (const [, name, value] of documented) { + expect(`${config}\n${reach}`, `the page says ${name} defaults to ${value}`).toContain( + `(${name!} ${value!})`, + ); + } + }); +}); diff --git a/packages/fuzz/tsconfig.json b/packages/fuzz/tsconfig.json new file mode 100644 index 0000000..ca4f265 --- /dev/null +++ b/packages/fuzz/tsconfig.json @@ -0,0 +1,9 @@ +{ + "extends": "../../tsconfig.base.json", + "include": ["src"], + "compilerOptions": { + "outDir": "dist", + "rootDir": "src", + "types": ["node"] + } +} diff --git a/packages/grapher/package.json b/packages/grapher/package.json index d29a8b1..cf7e479 100644 --- a/packages/grapher/package.json +++ b/packages/grapher/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/grapher", - "version": "2.7.0", + "version": "2.8.0", "author": "MesTTo", "license": "MIT", "description": "MeTTa visual editor and reduction renderer for browser and Node.js, with node-graph and nested-block views.", diff --git a/packages/grapher/src/node.test.ts b/packages/grapher/src/node.test.ts index 73534eb..a0ee570 100644 --- a/packages/grapher/src/node.test.ts +++ b/packages/grapher/src/node.test.ts @@ -60,6 +60,19 @@ describe("Node reduction GIFs", () => { expect((await gifMetadata(bytes)).pages).toBe(3); }); + it.each(["blocks", "graph", "side-by-side"])( + "renders a plain-expression collapse result in the %s animation", + async (view) => { + const bytes = await renderReductionGif("(collapse (superpose (1 2 2)))", { + ...QUICK, + view, + }); + const metadata = await gifMetadata(bytes); + expect(metadata.format).toBe("gif"); + expect(metadata.pages).toBeGreaterThan(1); + }, + ); + it("preserves the first and final SVG frames through rasterization and GIF encoding", async () => { const query = parseProgram("(+ 10 (* 25 2))")[0]!; const animation = blockReductionSvgs(reduceTrace(query, new MeTTa()), QUICK); diff --git a/packages/grapher/src/reduce.test.ts b/packages/grapher/src/reduce.test.ts index 091c280..376d8b0 100644 --- a/packages/grapher/src/reduce.test.ts +++ b/packages/grapher/src/reduce.test.ts @@ -36,6 +36,15 @@ describe("reduce", () => { expect(trace[1]!.map(String).sort()).toEqual(["Heads", "Tails"]); }); + it("keeps a collapsed result bag as one expression in the final animation frontier", () => { + const m = new MeTTa(); + const query = parse("(collapse (superpose (1 2 2)))"); + const trace = reduceTrace(query, m); + expect(trace.length).toBeGreaterThan(1); + expect(trace.at(-1)!.map(String)).toEqual(["(1 2 2)"]); + expect(trace.at(-1)!.map(String)).toEqual(m.evaluateAtom(query).map(String)); + }); + it("does not force the untaken branch of if (laziness via types)", () => { const m = new MeTTa(); // both branches would loop if evaluated; only the taken one is reduced diff --git a/packages/hyperon/package.json b/packages/hyperon/package.json index cc3f86c..b4940bf 100644 --- a/packages/hyperon/package.json +++ b/packages/hyperon/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/hyperon", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", @@ -21,6 +21,7 @@ }, "dependencies": { "@mettascript/core": "workspace:*", + "@mettascript/fuzz": "workspace:*", "@mettascript/libraries": "workspace:*" }, "author": "MesTTo", diff --git a/packages/hyperon/src/base.ts b/packages/hyperon/src/base.ts index f483cf0..c0e71c1 100644 --- a/packages/hyperon/src/base.ts +++ b/packages/hyperon/src/base.ts @@ -7,6 +7,7 @@ * `hyperon.runner`. TypeScript surface over `@metta-ts/core`. */ import "@mettascript/libraries"; +import "@mettascript/fuzz"; import * as core from "@mettascript/core"; import { Atom } from "./atoms"; import { Bindings, BindingsSet } from "./bindings"; @@ -258,16 +259,26 @@ export class MeTTa { /** Register an async grounded operation callable from MeTTa source by `name` (resolved by the async * runner). The function receives argument atoms and resolves to result atoms, optionally with * evaluator-applied effects such as adding/removing atoms or binding a token. A rejection becomes a - * MeTTa `(Error ...)` atom. Use it for I/O: fetch, a DAS query, a timer. */ - registerAsyncOperation(name: string, op: (args: Atom[]) => Promise): void { - core.registerAsyncGroundedOperation(this.env, name, async (args) => { - try { - const raw = await op(args.map(Atom.fromCAtom)); - return asyncOperationReturnToReduceResult(raw); - } catch (e) { - return { tag: "runtimeError", msg: e instanceof Error ? e.message : String(e) }; - } - }); + * MeTTa `(Error ...)` atom. The effect defaults to `AsyncHost`; only declare a narrower effect when the + * handler satisfies that contract. Use it for I/O: fetch, a DAS query, a timer. */ + registerAsyncOperation( + name: string, + op: (args: Atom[]) => Promise, + effect: core.GroundedOperationEffect = "AsyncHost", + ): void { + core.registerAsyncGroundedOperation( + this.env, + name, + async (args) => { + try { + const raw = await op(args.map(Atom.fromCAtom)); + return asyncOperationReturnToReduceResult(raw); + } catch (e) { + return { tag: "runtimeError", msg: e instanceof Error ? e.message : String(e) }; + } + }, + effect, + ); } /** Parse every top-level atom of a program. */ @@ -327,16 +338,26 @@ export class MeTTa { /** Register a grounded operation callable from MeTTa source by `name`. The function receives argument * atoms and returns result atoms. A thrown error becomes a MeTTa `(Error ...)` atom instead of * crashing the run. Throw {@link IncorrectArgumentError} to leave the expression unevaluated so other - * rewrite rules can try (MeTTa's multiple dispatch on a type mismatch). */ - registerOperation(name: string, op: (args: Atom[]) => Atom[]): void { - core.registerGroundedOperation(this.env, name, (args) => { - try { - return { tag: "ok", results: op(args.map(Atom.fromCAtom)).map((a) => a.catom) }; - } catch (e) { - if (e instanceof IncorrectArgumentError) return { tag: "noReduce" }; - return { tag: "runtimeError", msg: e instanceof Error ? e.message : String(e) }; - } - }); + * rewrite rules can try (MeTTa's multiple dispatch on a type mismatch). The effect defaults to `Host`; + * a `Pure` or `World` declaration opts the handler into fuzz-sandbox execution. */ + registerOperation( + name: string, + op: (args: Atom[]) => Atom[], + effect: core.GroundedOperationEffect = "Host", + ): void { + core.registerGroundedOperation( + this.env, + name, + (args) => { + try { + return { tag: "ok", results: op(args.map(Atom.fromCAtom)).map((a) => a.catom) }; + } catch (e) { + if (e instanceof IncorrectArgumentError) return { tag: "noReduce" }; + return { tag: "runtimeError", msg: e instanceof Error ? e.message : String(e) }; + } + }, + effect, + ); } /** Every type the runner infers for an atom (Hyperon `get_atom_types`). */ diff --git a/packages/hyperon/src/hyperon.test.ts b/packages/hyperon/src/hyperon.test.ts index dd6f597..2b22078 100644 --- a/packages/hyperon/src/hyperon.test.ts +++ b/packages/hyperon/src/hyperon.test.ts @@ -162,6 +162,31 @@ describe("parser", () => { }); describe("MeTTa runner", () => { + it("auto-registers the deterministic fuzz module", () => { + const m = new MeTTa(); + const out = m.run(` + !(import! &self fuzz) + !(_fuzz-make-variable 17) + `); + expect(out[0]!.map((a) => a.toString())).toEqual(["()"]); + expect(out[1]!.map((a) => a.toString())).toEqual(["$fuzz-17"]); + }); + + it("runs a whole property test through the module, not only its kernel", () => { + // Registering the grounded operations is not the same as the MeTTa module being usable, so this + // checks the thing a user actually calls. + const m = new MeTTa(); + const out = m.run(` + !(import! &self fuzz) + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + !(fuzz-check smoke (gen-int 0 9) always (fuzz-config (Runs 3) (EdgeCases 0))) + `); + expect(out.at(-1)!.map((a) => a.toString())[0]).toContain( + "(FuzzPassed (Property smoke) (Seed 0)", + ); + }); + it("evaluates arithmetic", () => { const m = new MeTTa(); const out = m.run("!(+ 1 2)"); @@ -197,6 +222,17 @@ describe("MeTTa runner", () => { expect(out[0]!.map((a) => a.toString())).toEqual(["42"]); }); + it("passes explicit operation effects to the fuzz sandbox", () => { + const m = new MeTTa(); + m.registerOperation("pure-seven", () => [ValueAtom(7)], "Pure"); + const out = m.run(` + (: _fuzz-eval-case (-> Atom Number Number Atom Atom)) + (: pure-seven (-> Number)) + !(_fuzz-eval-case (pure-seven) 1000 100 Sandboxed) + `); + expect(out[0]![0]!.toString()).toMatch(/^\(FuzzCaseOutcome Completed \(7\) [0-9]+\)$/); + }); + it("registers an async operation with evaluator-applied effects", async () => { const m = new MeTTa(); m.registerAsyncOperation("install-async-rule", async () => ({ diff --git a/packages/libraries/package.json b/packages/libraries/package.json index 3707618..96dca5c 100644 --- a/packages/libraries/package.json +++ b/packages/libraries/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/libraries", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/packages/libraries/src/datastructures/datastructures.metta b/packages/libraries/src/datastructures/datastructures.metta index b0e0786..a243912 100644 --- a/packages/libraries/src/datastructures/datastructures.metta +++ b/packages/libraries/src/datastructures/datastructures.metta @@ -38,6 +38,6 @@ (@return "The add-atom result when newly inserted, or no result when the key already exists")) (= (add-unique-or-fail $space $expression) (let $st (s (repr $expression)) - (if (== (,) (collapse (once (match $space $st True)))) + (if (== () (collapse (once (match $space $st True)))) (add-atom $space $st) (empty)))) diff --git a/packages/libraries/src/generated/sources.ts b/packages/libraries/src/generated/sources.ts index 4d68ead..8f20011 100644 --- a/packages/libraries/src/generated/sources.ts +++ b/packages/libraries/src/generated/sources.ts @@ -13,9 +13,9 @@ export const LIBRARY_MODULE_SRCS: Readonly> = { patrick: '\n (: compose (-> Expression Atom %Undefined%))\n\n (@doc compose\n (@desc "Compose a list of single-argument functions, applied right to left, over an argument tuple")\n (@params ((@param "List of function symbols, innermost last") (@param "Argument tuple passed to the innermost function")))\n (@return "The result of the composed application"))\n (= (compose $fs $args)\n (let* ((($f $rest) (decons-atom $fs)))\n (if (== $rest ())\n (if (== (length $args) 1)\n (let ($arg) $args ($f $arg))\n (let $func (cons-atom $f $args) (reduce $func)))\n ($f (compose $rest $args)))))\n', datastructures: - '\n (: empty-queue (-> Expression))\n (: enqueue (-> Atom Expression Expression))\n (: dequeue (-> Expression Expression))\n (: add-unique-or-fail (-> Grounded Atom %Undefined%))\n\n (@doc empty-queue\n (@desc "The empty queue: two empty stacks and a zero count")\n (@params ())\n (@return "A queue (queue () () 0) holding no elements"))\n (= (empty-queue) (queue () () 0))\n\n (@doc enqueue\n (@desc "Add an element to the back of the queue in amortized O(1) by pushing it onto the in-stack")\n (@params ((@param "Element to add") (@param "Queue")))\n (@return "The queue with the element appended at the back"))\n (= (enqueue $e $q)\n (let (queue $in $out $n) $q\n (queue (cons-atom $e $in) $out (+ $n 1))))\n\n (@doc dequeue\n (@desc "Remove the front element and return it paired with the rest of the queue. When the out-stack is empty it first reverses the in-stack onto the out-stack, the amortized step. Yields nothing on an empty queue")\n (@params ((@param "Queue")))\n (@return "(Pair ), or no result when the queue is empty"))\n (= (dequeue $q)\n (let (queue $in $out $n) $q\n (if (== $out ())\n (if (== $in ())\n (empty)\n (let* (($rev (reverse $in)) (($h $t) (decons-atom $rev)))\n (Pair $h (queue () $t (- $n 1)))))\n (let* ((($h $t) (decons-atom $out)))\n (Pair $h (queue $in $t (- $n 1)))))))\n\n (@doc add-unique-or-fail\n (@desc "Intern (s ) into the space only if no equal key is already present, otherwise yield nothing. A fast set insertion keyed on the atom\'s textual form")\n (@params ((@param "Space") (@param "Expression to intern as a key")))\n (@return "The add-atom result when newly inserted, or no result when the key already exists"))\n (= (add-unique-or-fail $space $expression)\n (let $st (s (repr $expression))\n (if (== (,) (collapse (once (match $space $st True))))\n (add-atom $space $st)\n (empty))))\n', + '\n (: empty-queue (-> Expression))\n (: enqueue (-> Atom Expression Expression))\n (: dequeue (-> Expression Expression))\n (: add-unique-or-fail (-> Grounded Atom %Undefined%))\n\n (@doc empty-queue\n (@desc "The empty queue: two empty stacks and a zero count")\n (@params ())\n (@return "A queue (queue () () 0) holding no elements"))\n (= (empty-queue) (queue () () 0))\n\n (@doc enqueue\n (@desc "Add an element to the back of the queue in amortized O(1) by pushing it onto the in-stack")\n (@params ((@param "Element to add") (@param "Queue")))\n (@return "The queue with the element appended at the back"))\n (= (enqueue $e $q)\n (let (queue $in $out $n) $q\n (queue (cons-atom $e $in) $out (+ $n 1))))\n\n (@doc dequeue\n (@desc "Remove the front element and return it paired with the rest of the queue. When the out-stack is empty it first reverses the in-stack onto the out-stack, the amortized step. Yields nothing on an empty queue")\n (@params ((@param "Queue")))\n (@return "(Pair ), or no result when the queue is empty"))\n (= (dequeue $q)\n (let (queue $in $out $n) $q\n (if (== $out ())\n (if (== $in ())\n (empty)\n (let* (($rev (reverse $in)) (($h $t) (decons-atom $rev)))\n (Pair $h (queue () $t (- $n 1)))))\n (let* ((($h $t) (decons-atom $out)))\n (Pair $h (queue $in $t (- $n 1)))))))\n\n (@doc add-unique-or-fail\n (@desc "Intern (s ) into the space only if no equal key is already present, otherwise yield nothing. A fast set insertion keyed on the atom\'s textual form")\n (@params ((@param "Space") (@param "Expression to intern as a key")))\n (@return "The add-atom result when newly inserted, or no result when the key already exists"))\n (= (add-unique-or-fail $space $expression)\n (let $st (s (repr $expression))\n (if (== () (collapse (once (match $space $st True))))\n (add-atom $space $st)\n (empty))))\n', spaces: '\n (: migrateAtoms (-> Grounded Grounded Atom %Undefined%))\n (: remove-all-atoms (-> Grounded %Undefined%))\n\n (@doc migrateAtoms\n (@desc "Move every atom matching the pattern from one space to another: add each match to the target space, then remove it from the source space")\n (@params ((@param "Source space") (@param "Target space") (@param "Pattern to match and move")))\n (@return "The per-atom results of the move"))\n (= (migrateAtoms $FromSpace $ToSpace $Pattern)\n (match $FromSpace $Pattern\n (let $moved (add-atom $ToSpace $Pattern)\n (remove-atom $FromSpace $Pattern))))\n\n (@doc remove-all-atoms\n (@desc "Remove every atom from the space by matching each one and removing it")\n (@params ((@param "Space")))\n (@return "The collapsed results of removing each atom"))\n (= (remove-all-atoms $space)\n (collapse (match $space $x (remove-atom $space $x))))\n', - nars: '\n ; ---------- Truth values ----------\n (: Truth_c2w (-> Number Number))\n (@doc Truth_c2w\n (@desc "Convert NARS confidence to evidence weight")\n (@params ((@param "Confidence c")))\n (@return "Evidence weight c / (1 - c)"))\n (= (Truth_c2w $c)\n (/ $c (- 1 $c)))\n\n (: Truth_w2c (-> Number Number))\n (@doc Truth_w2c\n (@desc "Convert evidence weight to NARS confidence")\n (@params ((@param "Evidence weight w")))\n (@return "Confidence w / (w + 1)"))\n (= (Truth_w2c $w)\n (/ $w (+ $w 1)))\n\n (: Truth_Deduction (-> Expression Expression Expression))\n (@doc Truth_Deduction\n (@desc "NAL deduction truth function over two simple truth values")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "(stv (* f1 f2) (* f1 f2 c1 c2))"))\n (= (Truth_Deduction (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* (* $f1 $f2) (* $c1 $c2))))\n\n (: Truth_Abduction (-> Expression Expression Expression))\n (@doc Truth_Abduction\n (@desc "NAL abduction truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Abductive simple truth value"))\n (= (Truth_Abduction (stv $f1 $c1)\n (stv $f2 $c2))\n (stv $f2 (Truth_w2c (* (* $f1 $c1) $c2))))\n\n (: Truth_Induction (-> Expression Expression Expression))\n (@doc Truth_Induction\n (@desc "NAL induction, defined as reversed abduction")\n (@params ((@param "First truth value") (@param "Second truth value")))\n (@return "Inductive simple truth value"))\n (= (Truth_Induction $T1 $T2)\n (Truth_Abduction $T2 $T1))\n\n (: Truth_Exemplification (-> Expression Expression Expression))\n (@doc Truth_Exemplification\n (@desc "NAL exemplification truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Exemplification simple truth value"))\n (= (Truth_Exemplification (stv $f1 $c1)\n (stv $f2 $c2))\n (stv 1.0 (Truth_w2c (* (* $f1 $f2) (* $c1 $c2)))))\n\n (: Truth_StructuralDeduction (-> Expression Expression))\n (@doc Truth_StructuralDeduction\n (@desc "Structural deduction against the fixed NARS truth value (stv 1.0 0.9)")\n (@params ((@param "Input truth value")))\n (@return "Structurally deduced truth value"))\n (= (Truth_StructuralDeduction $T)\n (Truth_Deduction $T (stv 1.0 0.9)))\n\n (: Truth_Negation (-> Expression Expression))\n (@doc Truth_Negation\n (@desc "Negate the frequency of a simple truth value while preserving confidence")\n (@params ((@param "Truth value (stv f c)")))\n (@return "(stv (1 - f) c)"))\n (= (Truth_Negation (stv $f $c))\n (stv (- 1 $f) $c))\n\n (: Truth_StructuralDeductionNegated (-> Expression Expression))\n (@doc Truth_StructuralDeductionNegated\n (@desc "Structural deduction followed by truth negation")\n (@params ((@param "Input truth value")))\n (@return "Negated structural deduction truth value"))\n (= (Truth_StructuralDeductionNegated $T)\n (Truth_Negation (Truth_StructuralDeduction $T)))\n\n (: Truth_Intersection (-> Expression Expression Expression))\n (@doc Truth_Intersection\n (@desc "Truth function for intersection")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "(stv (* f1 f2) (* c1 c2))"))\n (= (Truth_Intersection (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* $c1 $c2)))\n\n (: Truth_StructuralIntersection (-> Expression Expression))\n (@doc Truth_StructuralIntersection\n (@desc "Structural intersection against the fixed NARS truth value (stv 1.0 0.9)")\n (@params ((@param "Input truth value")))\n (@return "Structurally intersected truth value"))\n (= (Truth_StructuralIntersection $T)\n (Truth_Intersection $T (stv 1.0 0.9)))\n\n (: Truth_or (-> Number Number Number))\n (@doc Truth_or\n (@desc "Probabilistic OR over two frequencies")\n (@params ((@param "First frequency") (@param "Second frequency")))\n (@return "1 - (1 - a) * (1 - b)"))\n (= (Truth_or $a $b)\n (- 1 (* (- 1 $a) (- 1 $b))))\n\n (: Truth_Comparison (-> Expression Expression Expression))\n (@doc Truth_Comparison\n (@desc "NAL comparison truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Comparison simple truth value"))\n (= (Truth_Comparison (stv $f1 $c1)\n (stv $f2 $c2))\n (let $f0 (Truth_or $f1 $f2)\n (stv (if (== $f0 0.0)\n 0.0\n (/ (* $f1 $f2) $f0))\n (Truth_w2c (* $f0 (* $c1 $c2))))))\n\n (: Truth_Analogy (-> Expression Expression Expression))\n (@doc Truth_Analogy\n (@desc "NAL analogy truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Analogy simple truth value"))\n (= (Truth_Analogy (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* (* $c1 $c2) $f2)))\n\n (: Truth_Resemblance (-> Expression Expression Expression))\n (@doc Truth_Resemblance\n (@desc "NAL resemblance truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Resemblance simple truth value"))\n (= (Truth_Resemblance (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* (* $c1 $c2) (Truth_or $f1 $f2))))\n\n (: Truth_Union (-> Expression Expression Expression))\n (@doc Truth_Union\n (@desc "PeTTa lib_nars union truth function; the upstream body returns a two-element expression, not an stv-headed value")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "A two-element expression matching PeTTa\'s source"))\n (= (Truth_Union (stv $f1 $c1)\n (stv $f2 $c2))\n ((Truth_or $f1 $f2) (* $c1 $c2)))\n\n (: Truth_Difference (-> Expression Expression Expression))\n (@doc Truth_Difference\n (@desc "NAL difference truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Difference simple truth value"))\n (= (Truth_Difference (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 (- 1 $f2)) (* $c1 $c2)))\n\n (: Truth_DecomposePNN (-> Expression Expression Expression))\n (@doc Truth_DecomposePNN\n (@desc "NAL decomposition truth function for positive-negative-negative decomposition")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposePNN (stv $f1 $c1)\n (stv $f2 $c2))\n (let $fn (* $f1 (- 1 $f2))\n (stv (- 1 $fn) (* $fn (* $c1 $c2)))))\n\n (: Truth_DecomposeNPP (-> Expression Expression Expression))\n (@doc Truth_DecomposeNPP\n (@desc "NAL decomposition truth function for negative-positive-positive decomposition")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposeNPP (stv $f1 $c1)\n (stv $f2 $c2))\n (let $f (* (- 1 $f1) $f2)\n (stv $f (* $f (* $c1 $c2)))))\n\n (: Truth_DecomposePNP (-> Expression Expression Expression))\n (@doc Truth_DecomposePNP\n (@desc "NAL decomposition truth function for positive-negative-positive decomposition")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposePNP (stv $f1 $c1)\n (stv $f2 $c2))\n (let $f (* $f1 (- 1 $f2))\n (stv $f (* $f (* $c1 $c2)))))\n\n (: Truth_DecomposePPP (-> Expression Expression Expression))\n (@doc Truth_DecomposePPP\n (@desc "NAL decomposition truth function for positive-positive-positive decomposition")\n (@params ((@param "First truth value") (@param "Second truth value")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposePPP $v1 $v2)\n (Truth_DecomposeNPP (Truth_Negation $v1) $v2))\n\n (: Truth_DecomposeNNN (-> Expression Expression Expression))\n (@doc Truth_DecomposeNNN\n (@desc "PeTTa lib_nars decomposition for negative-negative-negative; the upstream body returns a two-element expression, not an stv-headed value")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "A two-element expression matching PeTTa\'s source"))\n (= (Truth_DecomposeNNN (stv $f1 $c1)\n (stv $f2 $c2))\n (let $fn (* (- 1 $f1) (- 1 $f2))\n ((- 1 $fn) (* $fn (* $c1 $c2)))))\n\n (: Truth_Eternalize (-> Expression Expression))\n (@doc Truth_Eternalize\n (@desc "Eternalize a simple truth value by converting its confidence as a weight")\n (@params ((@param "Truth value (stv f c)")))\n (@return "Eternalized simple truth value"))\n (= (Truth_Eternalize (stv $f $c))\n (stv $f (Truth_w2c $c)))\n\n (: Truth_Revision (-> Expression Expression Expression))\n (@doc Truth_Revision\n (@desc "Revise two independent simple truth values by combining their evidence weights")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Revised simple truth value"))\n (= (Truth_Revision (stv $f1 $c1)\n (stv $f2 $c2))\n (let* (($w1 (Truth_c2w $c1))\n ($w2 (Truth_c2w $c2))\n ($w (+ $w1 $w2))\n ($f (/ (+ (* $w1 $f1) (* $w2 $f2)) $w))\n ($c (Truth_w2c $w)))\n (stv (min 1.00 $f) (min 0.99 (max (max $c $c1) $c2)))))\n\n (: Truth_Expectation (-> Expression Number))\n (@doc Truth_Expectation\n (@desc "Expectation of a simple truth value")\n (@params ((@param "Truth value (stv f c)")))\n (@return "c * (f - 0.5) + 0.5"))\n (= (Truth_Expectation (stv $f $c))\n (+ (* $c (- $f 0.5)) 0.5))\n\n ; ---------- Inference rules ----------\n (@doc |-\n (@desc "PeTTa lib_nars NAL inference rules. Binary forms combine two judgements; unary forms decompose one judgement")\n (@params ((@param "One or two NARS judgements, each written as ( )")))\n (@return "A derived judgement ( )"))\n\n ; NAL-1: revision and inheritance syllogisms.\n (= (|- ($T $T1) ($T $T2)) ($T (Truth_Revision $T1 $T2)))\n (= (|- ((--> $a $b) $T1) ((--> $b $c) $T2)) ((--> $a $c) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> $a $b) $T1) ((--> $a $c) $T2)) ((--> $c $b) (Truth_Induction $T1 $T2)))\n (= (|- ((--> $a $c) $T1) ((--> $b $c) $T2)) ((--> $b $a) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> $a $b) $T1) ((--> $b $c) $T2)) ((--> $c $a) (Truth_Exemplification $T1 $T2)))\n\n ; PeTTa\'s lib_nars source has no NAL-2 block.\n\n ; NAL-3: sets and extensional/intensional decomposition.\n (= (|- ((--> ({} $A $B) $M) $T)) ((--> ({} $A) $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> ({} $A $B) $M) $T)) ((--> ({} $B) $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M ([] $A $B)) $T)) ((--> $M ([] $A)) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M ([] $A $B)) $T)) ((--> $M ([] $B)) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (∪ $S $P) $M) $T)) ((--> $S $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M (∩ $S $P)) $T)) ((--> $M $S) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (∪ $S $P) $M) $T)) ((--> $P $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M (∩ $S $P)) $T)) ((--> $M $P) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (~ $A $S) $M) $T)) ((--> $A $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M (− $B $S)) $T)) ((--> $M $B) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (~ $A $S) $M) $T)) ((--> $S $M) (Truth_StructuralDeductionNegated $T)))\n (= (|- ((--> $M (− $B $S)) $T)) ((--> $M $S) (Truth_StructuralDeductionNegated $T)))\n (= (|- ((--> $S $M) $T1) ((--> (∪ $S $P) $M) $T2)) ((--> $P $M) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $P $M) $T1) ((--> (∪ $S $P) $M) $T2)) ((--> $S $M) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $S $M) $T1) ((--> (∩ $S $P) $M) $T2)) ((--> $P $M) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $P $M) $T1) ((--> (∩ $S $P) $M) $T2)) ((--> $S $M) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $S $M) $T1) ((--> (~ $S $P) $M) $T2)) ((--> $P $M) (Truth_DecomposePNP $T1 $T2)))\n (= (|- ((--> $S $M) $T1) ((--> (~ $P $S) $M) $T2)) ((--> $P $M) (Truth_DecomposeNNN $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (∩ $S $P)) $T2)) ((--> $M $P) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $M $P) $T1) ((--> $M (∩ $S $P)) $T2)) ((--> $M $S) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (∪ $S $P)) $T2)) ((--> $M $P) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $M $P) $T1) ((--> $M (∪ $S $P)) $T2)) ((--> $M $S) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (− $S $P)) $T2)) ((--> $M $P) (Truth_DecomposePNP $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (− $P $S)) $T2)) ((--> $M $P) (Truth_DecomposeNNN $T1 $T2)))\n\n ; NAL-4: relation component rules.\n (= (|- ((--> (× $A $B) $R) $T1) ((--> (× $C $B) $R) $T2)) ((--> $C $A) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> (× $A $C) $R) $T2)) ((--> $C $B) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $R (× $C $B)) $T2)) ((--> $C $A) (Truth_Induction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $R (× $A $C)) $T2)) ((--> $C $B) (Truth_Induction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $C $A) $T2)) ((--> (× $C $B) $R) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $A $C) $T2)) ((--> (× $C $B) $R) (Truth_Induction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $C $B) $T2)) ((--> (× $A $C) $R) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $B $C) $T2)) ((--> (× $A $C) $R) (Truth_Induction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $A $C) $T2)) ((--> $R (× $C $B)) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $C $A) $T2)) ((--> $R (× $C $B)) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $B $C) $T2)) ((--> $R (× $A $C)) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $C $B) $T2)) ((--> $R (× $A $C)) (Truth_Abduction $T1 $T2)))\n\n ; NAL-5: negation, conjunction, disjunction, and higher-order decomposition.\n (= (|- ((¬ $A) $T)) ($A (Truth_Negation $T)))\n (= (|- ((∧ $A $B) $T)) ($A (Truth_StructuralDeduction $T)))\n (= (|- ((∧ $A $B) $T)) ($B (Truth_StructuralDeduction $T)))\n (= (|- ($S $T1) ((∧ $S $A) $T2)) ($A (Truth_DecomposePNN $T1 $T2)))\n (= (|- ($S $T1) ((∨ $S $A) $T2)) ($A (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ($S $T1) ((∧ (¬ $S) $A) $T2)) ($A (Truth_DecomposeNNN $T1 $T2)))\n (= (|- ($S $T1) ((∨ (¬ $S) $A) $T2)) ($A (Truth_DecomposePPP $T1 $T2)))\n (= (|- ($A $T1) ((==> $A $B) $T2)) ($B (Truth_Deduction $T1 $T2)))\n (= (|- ($A $T1) ((==> (∧ $A $B) $C) $T2)) ((==> $B $C) (Truth_Deduction $T1 $T2)))\n (= (|- ($B $T1) ((==> $A $B) $T2)) ($A (Truth_Abduction $T1 $T2)))\n\n ; ---------- Derivation and query engine ----------\n (: NARS.Config.MaxSteps (-> Number))\n (@doc NARS.Config.MaxSteps\n (@desc "Default maximum number of derivation task selections")\n (@params ())\n (@return "100"))\n (= (NARS.Config.MaxSteps) 100)\n\n (: NARS.Config.TaskQueueSize (-> Number))\n (@doc NARS.Config.TaskQueueSize\n (@desc "Default active task queue bound")\n (@params ())\n (@return "10"))\n (= (NARS.Config.TaskQueueSize) 10)\n\n (: NARS.Config.BeliefQueueSize (-> Number))\n (@doc NARS.Config.BeliefQueueSize\n (@desc "Default belief buffer bound")\n (@params ())\n (@return "100"))\n (= (NARS.Config.BeliefQueueSize) 100)\n\n (: NARS.CollapseToList (-> Atom Expression))\n (@doc NARS.CollapseToList\n (@desc "Collect nondeterministic results and convert this engine\'s comma-headed collapse tuple into a plain expression list")\n (@params ((@param "Nondeterministic query to collapse")))\n (@return "A plain expression list of the collapsed results"))\n (= (NARS.CollapseToList $query)\n (let* (($collapsed (collapse $query))\n ($plain (cdr-atom $collapsed)))\n (exclude-item Empty $plain)))\n\n (: StampDisjoint (-> Expression Expression Bool))\n (@doc StampDisjoint\n (@desc "True when two evidence stamps share no evidence item")\n (@params ((@param "First evidence stamp list") (@param "Second evidence stamp list")))\n (@return "Bool indicating whether the stamps are disjoint"))\n (= (StampDisjoint $Ev1 $Ev2)\n (== () (intersection-atom $Ev1 $Ev2)))\n\n (: StampConcat (-> Expression Expression Expression))\n (@doc StampConcat\n (@desc "Concatenate a stamp with new evidence and sort it, preserving PeTTa lib_nars\' stamp-combination shape")\n (@params ((@param "Base evidence stamp") (@param "Evidence stamp to add")))\n (@return "Sorted combined evidence stamp"))\n (= (StampConcat $stamp $addition)\n (if (== $addition ())\n $stamp\n (sort (append $stamp $addition))))\n\n (: BestCandidate (-> Atom %Undefined% Expression %Undefined%))\n (@doc BestCandidate\n (@desc "Return the item in a candidate list with the highest score under an evaluator function")\n (@params ((@param "Unary evaluator function") (@param "Current best candidate") (@param "Candidate list")))\n (@return "The best candidate, or the initial best candidate when the list is empty"))\n (= (BestCandidate $evaluateCandidateFunction $bestCandidate $tuple)\n (max-by-atom $evaluateCandidateFunction $bestCandidate $tuple))\n\n (: PriorityRank (-> Expression Number))\n (@doc PriorityRank\n (@desc "Task priority score: the confidence of a sentence, with a low sentinel for the empty candidate")\n (@params ((@param "A Sentence candidate or ()")))\n (@return "Priority score"))\n (= (PriorityRank (Sentence ($x (stv $f $c)) $Ev1)) $c)\n (= (PriorityRank ()) -99999.0)\n\n (: PriorityRankNeg (-> Expression Number))\n (@doc PriorityRankNeg\n (@desc "Negated task priority score, used to find the lowest-priority queue item")\n (@params ((@param "A Sentence candidate or ()")))\n (@return "Negated priority score"))\n (= (PriorityRankNeg (Sentence ($x (stv $f $c)) $Ev1)) (- 0.0 $c))\n (= (PriorityRankNeg ()) -99999.0)\n\n (: LimitSize (-> Expression Number Expression))\n (@doc LimitSize\n (@desc "Bound a priority queue to fewer than the size limit by dropping the lowest-priority items")\n (@params ((@param "Candidate list") (@param "Size bound")))\n (@return "Bounded candidate list"))\n (= (LimitSize $L $size)\n (top-k-by-atom PriorityRank $size $L))\n\n (: NARS.PairInference (-> Expression Expression Expression))\n (@doc NARS.PairInference\n (@desc "Apply the binary inference rules in both premise orders")\n (@params ((@param "First judgement") (@param "Second judgement")))\n (@return "A derived judgement"))\n (= (NARS.PairInference $x $y) (|- $x $y))\n (= (NARS.PairInference $x $y) (|- $y $x))\n\n (: NARS.BinaryDerivation (-> Expression Expression Expression Expression))\n (@doc NARS.BinaryDerivation\n (@desc "Derive sentences from one selected task and one belief when their stamps are disjoint")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp") (@param "Belief sentence")))\n (@return "A derived Sentence, or no result when stamps overlap or no rule applies"))\n (= (NARS.BinaryDerivation $x $Ev1 (Sentence $y $Ev2))\n (if (StampDisjoint $Ev1 $Ev2)\n (let $stamp (StampConcat $Ev1 $Ev2)\n (case (NARS.PairInference $x $y)\n ((($T $TV) (Sentence ($T $TV) $stamp)))))\n (empty)))\n\n (: NARS.UnaryDerivation (-> Expression Expression Expression))\n (@doc NARS.UnaryDerivation\n (@desc "Derive sentences from one selected task using unary inference rules")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp")))\n (@return "A derived Sentence, or no result when no unary rule applies"))\n (= (NARS.UnaryDerivation $x $Ev1)\n (case (|- $x)\n ((($T (stv $f $c)) (Sentence ($T (stv $f $c)) $Ev1)))))\n\n (@doc NARS.Derive\n (@desc "Priority-queue forward derivation over tasks and beliefs")\n (@params ((@param "Task list") (@param "Belief list") (@param "Optional step and queue bounds")))\n (@return "A pair (tasks beliefs) after bounded derivation"))\n (= (NARS.Derive $Tasks $Beliefs $steps $maxsteps $taskqueuesize $beliefqueuesize)\n (if (or (> $steps $maxsteps) (== $Tasks ()))\n ($Tasks $Beliefs)\n (let $selected (BestCandidate PriorityRank () $Tasks)\n (let (Sentence $x $Ev1) $selected\n (let $fromBeliefs (NARS.CollapseToList\n (let $belief (superpose $Beliefs)\n (NARS.BinaryDerivation $x $Ev1 $belief)))\n (let $fromTask (NARS.CollapseToList\n (NARS.UnaryDerivation $x $Ev1))\n (let $derivations (append $fromBeliefs $fromTask)\n (let $_ (trace! (SELECTED $steps (Sentence $x $Ev1)) 42)\n (let $taskCandidates (unique-atom (append $Tasks $derivations))\n (let $withoutSelected (exclude-item $selected $taskCandidates)\n (let $newTasks (LimitSize $withoutSelected $taskqueuesize)\n (let $beliefCandidates (unique-atom (append $Beliefs $derivations))\n (let $newBeliefs (LimitSize $beliefCandidates $beliefqueuesize)\n (NARS.Derive $newTasks\n $newBeliefs\n (+ $steps 1)\n $maxsteps\n $taskqueuesize\n $beliefqueuesize))))))))))))))\n\n (= (NARS.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize)\n (NARS.Derive $Tasks $Beliefs 1 $maxsteps $taskqueuesize $beliefqueuesize))\n\n (= (NARS.Derive $Tasks $Beliefs $maxsteps)\n (NARS.Derive $Tasks $Beliefs $maxsteps (NARS.Config.TaskQueueSize) (NARS.Config.BeliefQueueSize)))\n\n (= (NARS.Derive $Tasks $Beliefs)\n (NARS.Derive $Tasks $Beliefs (NARS.Config.MaxSteps)))\n\n (: ConfidenceRank (-> Expression Number))\n (@doc ConfidenceRank\n (@desc "Query-answer score: the confidence of a (truth evidence) pair, with zero for the empty candidate")\n (@params ((@param "A query answer ((stv f c) evidence) or ()")))\n (@return "Confidence score"))\n (= (ConfidenceRank ((stv $f $c) $Ev)) $c)\n (= (ConfidenceRank ()) 0)\n\n (@doc NARS.Query\n (@desc "Query a term against a NARS knowledge base after bounded forward derivation")\n (@params ((@param "Task list or knowledge base") (@param "Belief list or term") (@param "Term and optional bounds")))\n (@return "The highest-confidence answer as ((stv f c) evidence), or () when no belief matches"))\n ; let-force the candidate list: imported into &self, BestCandidate\'s Expression-typed argument is not\n ; re-evaluated if it already looks like an Expression, so evaluate NARS.CollapseToList explicitly first.\n (= (NARS.Query $Tasks $Beliefs $term $maxsteps $taskqueuesize $beliefqueuesize)\n (let $candidates\n (NARS.CollapseToList\n (let ($TasksRet $BeliefsRet) (NARS.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize)\n (case (superpose $BeliefsRet)\n (((Sentence ($Term $TV) $Ev)\n (case (== $Term $term)\n ((True ($TV $Ev)))))))))\n (BestCandidate ConfidenceRank () $candidates)))\n\n (= (NARS.Query $kb $term $maxsteps $taskqueuesize $beliefqueuesize)\n (NARS.Query $kb $kb $term $maxsteps $taskqueuesize $beliefqueuesize))\n\n (= (NARS.Query $kb $term $maxsteps)\n (NARS.Query $kb $term $maxsteps (NARS.Config.TaskQueueSize) (NARS.Config.BeliefQueueSize)))\n\n (= (NARS.Query $kb $term)\n (NARS.Query $kb $term (NARS.Config.MaxSteps)))\n', - pln: '\n ; ---------- Tuple helpers ----------\n (@doc PLN.Force\n (@desc "Evaluate a raw expression call while preserving already-data expression lists")\n (@params ((@param "Atom to force")))\n (@return "The evaluated atom, or the original atom when eval leaves it unreduced"))\n (= (PLN.Force $atom)\n (let $forced (eval $atom)\n (case $forced\n (((eval $raw) $atom)\n ($_ $forced)))))\n\n (: clamp (-> Number Number Number Number))\n (@doc clamp\n (@desc "Clamp a number to the inclusive range [min, max]")\n (@params ((@param "Value") (@param "Minimum") (@param "Maximum")))\n (@return "The value bounded by the range"))\n (= (clamp $v $min $max)\n (min $max (max $v $min)))\n\n (: TupleConcat (-> Expression Expression Expression))\n (@doc TupleConcat\n (@desc "Concatenate two tuple lists represented as Hyperon expression lists")\n (@params ((@param "First tuple list") (@param "Second tuple list")))\n (@return "The concatenated tuple list"))\n (= (TupleConcat $Ev1 $Ev2)\n (append $Ev1 $Ev2))\n\n (: TupleCount (-> Expression Number))\n (@doc TupleCount\n (@desc "Count items in a tuple list")\n (@params ((@param "Tuple list")))\n (@return "The item count"))\n (= (TupleCount $tuple)\n (size-atom $tuple))\n\n (: and5 (-> Bool Bool Bool Bool Bool Bool))\n (@doc and5\n (@desc "Five-argument boolean conjunction")\n (@params ((@param "First boolean") (@param "Second boolean") (@param "Third boolean") (@param "Fourth boolean") (@param "Fifth boolean")))\n (@return "True when all five inputs are true"))\n (= (and5 $0 $1 $2 $3 $4)\n (and $0 (and $1 (and $2 (and $3 $4)))))\n\n (: min5 (-> Number Number Number Number Number Number))\n (@doc min5\n (@desc "Minimum of five numbers")\n (@params ((@param "First number") (@param "Second number") (@param "Third number") (@param "Fourth number") (@param "Fifth number")))\n (@return "The smallest input"))\n (= (min5 $0 $1 $2 $3 $4)\n (min $0 (min $1 (min $2 (min $3 $4)))))\n\n (: /safe (-> Number Number Number))\n (@doc /safe\n (@desc "Division guarded like PeTTa lib_pln: divide only when the denominator is positive")\n (@params ((@param "Numerator") (@param "Denominator")))\n (@return "The quotient, or no result when the denominator is not positive"))\n (= (/safe $A $B)\n (if (> $B 0.0)\n (/ $A $B)\n (empty)))\n\n (: negate (-> Number Number))\n (@doc negate\n (@desc "Return 1 minus the argument")\n (@params ((@param "Number")))\n (@return "1 - x"))\n (= (negate $arg)\n (- 1.0 $arg))\n\n (: invert (-> Number Number))\n (@doc invert\n (@desc "Return the reciprocal through /safe")\n (@params ((@param "Number")))\n (@return "1 / x, or no result when x is not positive"))\n (= (invert $arg)\n (/safe 1.0 $arg))\n\n (: InsertSorted (-> Number Expression Expression))\n (@doc InsertSorted\n (@desc "Insert a numeric item into a sorted tuple list")\n (@params ((@param "Item") (@param "Sorted tuple list")))\n (@return "The sorted tuple list with the item inserted"))\n (= (InsertSorted $x $L)\n (if (== $L ())\n ($x)\n (let* ((($head $tail) (decons-atom $L)))\n (if (< $x $head)\n (TupleConcat ($x $head) $tail)\n (let $inserted (InsertSorted $x $tail)\n (TupleConcat ($head) $inserted))))))\n\n (: InsertionSort (-> Expression Expression Expression))\n (@doc InsertionSort\n (@desc "Sort a tuple list. The second argument is preserved for PeTTa lib_pln call compatibility and is ignored by the upstream implementation")\n (@params ((@param "Tuple list") (@param "Ignored accumulator")))\n (@return "Sorted tuple list"))\n (= (InsertionSort $L $Ret)\n (let $items (PLN.Force $L)\n (if (== $items ())\n $Ret\n (let* ((($x $rest) (decons-atom $items))\n ($newRet (InsertSorted $x $Ret)))\n (InsertionSort $rest $newRet)))))\n\n (: Without (-> Expression %Undefined% Expression))\n (@doc Without\n (@desc "Remove an item from a tuple list")\n (@params ((@param "Tuple list") (@param "Item to remove")))\n (@return "Tuple list without the item"))\n (= (Without $Tuple $a)\n (exclude-item $a $Tuple))\n\n (: ElementOf (-> %Undefined% Expression Bool))\n (@doc ElementOf\n (@desc "Check whether an item is a member of a tuple list")\n (@params ((@param "Item") (@param "Tuple list")))\n (@return "Bool membership result"))\n (= (ElementOf $a $Tuple)\n (is-member $a $Tuple))\n\n (: Unique (-> Expression Expression Expression))\n (@doc Unique\n (@desc "Deduplicate a tuple list. The second argument is preserved for PeTTa lib_pln call compatibility and is ignored by the upstream implementation")\n (@params ((@param "Tuple list") (@param "Ignored accumulator")))\n (@return "Deduplicated tuple list"))\n (= (Unique $L $Ret)\n (unique-atom $L))\n\n ; ---------- Consistency helpers ----------\n (: smallest-intersection-probability (-> Number Number Number))\n (@doc smallest-intersection-probability\n (@desc "Lower bound for a conditional intersection probability")\n (@params ((@param "Strength of A") (@param "Strength of B")))\n (@return "Clamped lower probability bound"))\n (= (smallest-intersection-probability $As $Bs)\n (clamp (/ (- (+ $As $Bs) 1) $As) 0 1))\n\n (: largest-intersection-probability (-> Number Number Number))\n (@doc largest-intersection-probability\n (@desc "Upper bound for a conditional intersection probability")\n (@params ((@param "Strength of A") (@param "Strength of B")))\n (@return "Clamped upper probability bound"))\n (= (largest-intersection-probability $As $Bs)\n (clamp (/ $Bs $As) 0 1))\n\n (: conditional-probability-consistency (-> Number Number Number Bool))\n (@doc conditional-probability-consistency\n (@desc "Check PeTTa lib_pln conditional probability bounds")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of A implies B")))\n (@return "True when the conditional probability is inside the PLN bounds"))\n (= (conditional-probability-consistency $As $Bs $ABs)\n (and (< 0 $As)\n (and (<= (smallest-intersection-probability $As $Bs) $ABs)\n (<= $ABs (largest-intersection-probability $As $Bs)))))\n\n (: Consistency_ImplicationImplicantConjunction (-> Number Number Number Number Number Bool))\n (@doc Consistency_ImplicationImplicantConjunction\n (@desc "Check PeTTa lib_pln implication and implicant conjunction consistency")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of C") (@param "Strength of A implies C") (@param "Strength of B implies C")))\n (@return "Bool consistency result"))\n (= (Consistency_ImplicationImplicantConjunction $As $Bs $Cs $ACs $BCs)\n (and5 (> $As 0) (> $Bs 0) (> $Cs 0)\n (<= $ACs (/ $Cs $As))\n (<= $BCs (/ $Cs $Bs))))\n\n ; ---------- Truth functions ----------\n ; PeTTa lib_pln leaves STV as a stub so callers can define node truth values.\n (= (STV $stv) (empty))\n\n (: Truth_c2w (-> Number Number))\n (@doc Truth_c2w\n (@desc "Convert PLN confidence to evidence weight")\n (@params ((@param "Confidence c")))\n (@return "Evidence weight c / (1 - c), or no result when c is 1"))\n (= (Truth_c2w $c)\n (/safe $c (- 1 $c)))\n\n (: Truth_w2c (-> Number Number))\n (@doc Truth_w2c\n (@desc "Convert evidence weight to PLN confidence")\n (@params ((@param "Evidence weight w")))\n (@return "Confidence w / (w + 1)"))\n (= (Truth_w2c $w)\n (/safe $w (+ $w 1)))\n\n (: Truth_Deduction (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_Deduction\n (@desc "PeTTa lib_pln five-argument PLN deduction truth function")\n (@params ((@param "Truth of P") (@param "Truth of Q") (@param "Truth of R") (@param "Truth of P implies Q") (@param "Truth of Q implies R")))\n (@return "Deductive simple truth value"))\n (= (Truth_Deduction (stv $Ps $Pc)\n (stv $Qs $Qc)\n (stv $Rs $Rc)\n (stv $PQs $PQc)\n (stv $QRs $QRc))\n (if (and (conditional-probability-consistency $Ps $Qs $PQs)\n (conditional-probability-consistency $Qs $Rs $QRs))\n (stv (if (< 0.9999 $Qs)\n $Rs\n (+ (* $PQs $QRs)\n (/safe (* (- 1 $PQs) (- $Rs (* $Qs $QRs))) (- 1 $Qs))))\n (min $Pc (min $Qc (min $Rc (min $PQc $QRc)))))\n (stv 1 0)))\n\n (: Truth_Induction (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_Induction\n (@desc "PeTTa lib_pln five-argument PLN induction truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of B implies A") (@param "Truth of B implies C")))\n (@return "Inductive simple truth value"))\n (= (Truth_Induction (stv $sA $cA)\n (stv $sB $cB)\n (stv $sC $cC)\n (stv $sBA $cBA)\n (stv $sBC $cBC))\n (stv (+ (/safe (* (* $sBA $sBC) $sB) $sA)\n (* (- 1 (/safe (* $sBA $sB) $sA))\n (/safe (- $sC (* $sB $sBC)) (- 1 $sB))))\n (Truth_w2c (min $cBA $cBC))))\n\n (: Truth_Abduction (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_Abduction\n (@desc "PeTTa lib_pln five-argument PLN abduction truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of A implies B") (@param "Truth of C implies B")))\n (@return "Abductive simple truth value"))\n (= (Truth_Abduction (stv $sA $cA)\n (stv $sB $cB)\n (stv $sC $cC)\n (stv $sAB $cAB)\n (stv $sCB $cCB))\n (stv (+ (/safe (* (* $sAB $sCB) $sC)\n $sB)\n (/safe (* $sC (* (- 1 $sAB) (- 1 $sCB)))\n (- 1 $sB)))\n (Truth_w2c (min $cAB $cCB))))\n\n (: Truth_ModusPonens (-> Expression Expression Expression))\n (@doc Truth_ModusPonens\n (@desc "PeTTa lib_pln modus ponens truth function")\n (@params ((@param "Antecedent truth value") (@param "Implication truth value")))\n (@return "Conclusion truth value"))\n (= (Truth_ModusPonens (stv $f1 $c1) (stv $f2 $c2))\n (stv (+ (* $f1 $f2) (* 0.02 (- 1 $f1)))\n (* $c1 $c2)))\n\n (: Truth_SymmetricModusPonens (-> Expression Expression Expression))\n (@doc Truth_SymmetricModusPonens\n (@desc "PeTTa lib_pln symmetric modus ponens truth function")\n (@params ((@param "Source truth value") (@param "Similarity truth value")))\n (@return "Conclusion truth value"))\n (= (Truth_SymmetricModusPonens (stv $sA $cA) (stv $sAB $cAB))\n (let* (($snotAB 0.2)\n ($cnotAB 1.0))\n (stv (+ (* $sA $sAB) (* (* $snotAB (negate $sA)) (+ 1.0 $sAB)))\n (min (min $cAB $cnotAB) $cA))))\n\n (: Truth_Revision (-> Expression Expression Expression))\n (@doc Truth_Revision\n (@desc "PeTTa lib_pln heuristic revision of two simple truth values")\n (@params ((@param "First truth value") (@param "Second truth value")))\n (@return "Revised truth value"))\n (= (Truth_Revision (stv $f1 $c1) (stv $f2 $c2))\n (let* (($w1 (Truth_c2w $c1))\n ($w2 (Truth_c2w $c2))\n ($w (+ $w1 $w2))\n ($f (/safe (+ (* $w1 $f1) (* $w2 $f2)) $w))\n ($c (Truth_w2c $w)))\n (stv (min 1.0 $f)\n (min 1.0 (max (max $c $c1) $c2)))))\n\n (: Truth_Negation (-> Expression Expression))\n (@doc Truth_Negation\n (@desc "Negate the strength of a simple truth value while preserving confidence")\n (@params ((@param "Truth value")))\n (@return "Negated truth value"))\n (= (Truth_Negation (stv $s $c))\n (stv (- 1.0 $s) $c))\n\n (: Truth_inversion (-> Expression Expression Expression))\n (@doc Truth_inversion\n (@desc "PeTTa lib_pln inversion truth function")\n (@params ((@param "Target node truth value") (@param "Link truth value")))\n (@return "Inverted truth value"))\n (= (Truth_inversion (stv $Bs $Bc) (stv $ABs $ABc))\n (stv $ABs (* $Bc (* $ABc 0.6))))\n\n (: Truth_equivalenceToImplication (-> Expression Expression Expression Expression))\n (@doc Truth_equivalenceToImplication\n (@desc "Convert an equivalence truth value into an implication truth value")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of equivalence A B")))\n (@return "Implication truth value"))\n (= (Truth_equivalenceToImplication (stv $As $Ac) (stv $Bs $Bc) (stv $ABs $ABc))\n (let* (($ConclS (if (< 0.99 (* $ABs $ABc))\n $ABs\n (/safe (* (+ 1.0 (/safe $Bs $As)) $ABs) (+ 1.0 $ABs)))))\n (stv $ConclS $ABc)))\n\n (: TransitiveSimilarityStrength (-> Number Number Number Number Number Number))\n (@doc TransitiveSimilarityStrength\n (@desc "PeTTa lib_pln transitive similarity strength helper")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of C") (@param "Strength of A similar B") (@param "Strength of B similar C")))\n (@return "Transitive similarity strength"))\n (= (TransitiveSimilarityStrength $sA $sB $sC $sAB $sBC)\n (let* (($T1 (/ (* (+ 1.0 (/ $sB $sA)) $sAB) (+ 1.0 $sAB)))\n ($T2 (/ (* (+ 1.0 (/ $sC $sB)) $sBC) (+ 1.0 $sBC)))\n ($T3 (/ (* (+ 1.0 (/ $sB $sC)) $sBC) (+ 1.0 $sBC)))\n ($T4 (/ (* (+ 1.0 (/ $sA $sB)) $sAB) (+ 1.0 $sAB))))\n (invert (- (+ (invert (+ (* $T1 $T2)\n (* (negate $T1)\n (/safe (- $sC (* $sB $T2)) (negate $sB)))))\n (invert (+ (* $T3 $T4)\n (* (negate $T3)\n (/safe (- $sC (* $sB $T4)) (negate $sB))))))\n 1.0))))\n\n (: Truth_transitiveSimilarity (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_transitiveSimilarity\n (@desc "PeTTa lib_pln transitive similarity truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of A similar B") (@param "Truth of B similar C")))\n (@return "Transitive similarity truth value"))\n (= (Truth_transitiveSimilarity (stv $As $Ac)\n (stv $Bs $Bc)\n (stv $Cs $Cc)\n (stv $ABs $ABc)\n (stv $BCs $BCc))\n (let* (($ConclS (TransitiveSimilarityStrength $As $Bs $Cs $ABs $BCs))\n ($ConclC (min $ABc $BCc)))\n (stv $ConclS $ConclC)))\n\n (: simpleDeductionStrength (-> Number Number Number Number Number Number))\n (@doc simpleDeductionStrength\n (@desc "PeTTa lib_pln simple deduction strength helper")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of C") (@param "Strength of A implies B") (@param "Strength of B implies C")))\n (@return "Deduction strength, or no result when consistency checks fail"))\n (= (simpleDeductionStrength $sA $sB $sC $sAB $sBC)\n (if (and (conditional-probability-consistency $sA $sB $sAB)\n (conditional-probability-consistency $sB $sC $sBC))\n (if (< 0.99 $sB)\n $sC\n (+ (* $sAB $sBC)\n (/safe (* (- 1.0 $sAB) (- $sC (* $sB $sBC))) (- 1.0 $sB))))\n (empty)))\n\n (: Truth_evaluationImplication (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_evaluationImplication\n (@desc "PeTTa lib_pln evaluation implication truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of A implies B") (@param "Truth of A implies C")))\n (@return "Evaluation implication truth value"))\n (= (Truth_evaluationImplication (stv $As $Ac)\n (stv $Bs $Bc)\n (stv $Cs $Cc)\n (stv $ABs $ABc)\n (stv $ACs $ACc))\n (let* (($ConclS (simpleDeductionStrength $Bs $As $Cs $ABs $ACs))\n ($ConclC (* (* 0.9 0.9)\n (min5 $Bc $Ac $Cc $ACc (* 0.9 $ABc)))))\n (stv $ConclS $ConclC)))\n\n ; ---------- Inference rules ----------\n (@doc |-\n (@desc "PeTTa lib_pln PLN inference rules")\n (@params ((@param "One or two PLN sentences written as ( )")))\n (@return "A derived sentence written as ( )"))\n\n ; Revision.\n (= (|- ($T $T1)\n ($T $T2))\n (let $TV (Truth_Revision $T1 $T2)\n ($T $TV)))\n\n ; Modus ponens.\n (= (|- ($A $T1)\n ((Implication $A $B) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ($B $TV)))\n\n ; Guards for link-specific rules. Missing guard facts intentionally leave the rule unreduced.\n (= (SymmetricModusPonensRuleGuard Similarity) True)\n (= (SymmetricModusPonensRuleGuard IntentionalSimilarity) True)\n (= (SymmetricModusPonensRuleGuard ExtensionalSimilarity) True)\n\n (= (|- ($A $TruthA)\n (($LinkType $A $B) $TruthAB))\n (if (SymmetricModusPonensRuleGuard $LinkType)\n (let $TV (Truth_SymmetricModusPonens $TruthA $TruthAB)\n ($B $TV))\n (empty)))\n\n (= (SyllogisticRuleGuard Inheritance) True)\n (= (SyllogisticRuleGuard Implication) True)\n\n (= (|- (($LinkType $A $B) $T1)\n (($LinkType $B $C) $T2))\n (if (SyllogisticRuleGuard $LinkType)\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Deduction $TruthA $TruthB $TruthC $T1 $T2)))\n (($LinkType $A $C) $TV))\n (empty)))\n\n (= (|- (($LinkType $C $A) $T1)\n (($LinkType $C $B) $T2))\n (if (SyllogisticRuleGuard $LinkType)\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Induction $TruthA $TruthB $TruthC $T1 $T2)))\n (($LinkType $A $B) $TV))\n (empty)))\n\n (= (|- (($LinkType $A $C) $T1)\n (($LinkType $B $C) $T2))\n (if (SyllogisticRuleGuard $LinkType)\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Abduction $TruthA $TruthB $TruthC $T1 $T2)))\n (($LinkType $A $B) $TV))\n (empty)))\n\n ; Usage of inheritance for predicates.\n (= (|- ((Evaluation (Predicate $x)\n (List (Concept $C))) $T1)\n ((Inheritance (Concept $S) (Concept $C)) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ((Evaluation (Predicate $x)\n (List (Concept $S)))\n $TV)))\n\n (= (|- ((Evaluation (Predicate $x)\n (List (Concept $C1) (Concept $C2))) $T1)\n ((Inheritance (Concept $S) (Concept $C1)) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ((Evaluation (Predicate $x)\n (List (Concept $S) (Concept $C2)))\n $TV)))\n\n (= (|- ((Evaluation (Predicate $x)\n (List (Concept $C1) (Concept $C2))) $T1)\n ((Inheritance (Concept $S) (Concept $C2)) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ((Evaluation (Predicate $x)\n (List (Concept $C1) (Concept $S)))\n $TV)))\n\n (= (|- ((Not $A) $T))\n (let $TV (Truth_Negation $T)\n ($A $TV)))\n\n (= (|- ((Inheritance $A $B) $Truth))\n (let* (($TruthB (STV $B))\n ($TV (Truth_inversion $TruthB $Truth)))\n ((Inheritance $B $A) $TV)))\n\n (= (|- ((Implication $A $B) $Truth))\n (let* (($TruthB (STV $B))\n ($TV (Truth_inversion $TruthB $Truth)))\n ((Implication $B $A) $TV)))\n\n (= (|- ((Equivalence $A $B) $Truth))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TV (Truth_equivalenceToImplication $TruthA $TruthB $Truth)))\n ((Implication $A $B) $TV)))\n\n (= (|- ((Equivalence $A $B) $Truth))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TV (Truth_equivalenceToImplication $TruthA $TruthB $Truth)))\n ((Implication $B $A) $TV)))\n\n (= (|- ((Similarity $A $B) $T1)\n ((Similarity $B $C) $T2))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_transitiveSimilarity $TruthA $TruthB $TruthC $T1 $T2)))\n ((Similarity $A $C) $TV)))\n\n (= (|- ((Evaluation $A $B) $TruthAB)\n ((Implication $A $C) $TruthAC))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_evaluationImplication $TruthA $TruthB $TruthC $TruthAB $TruthAC)))\n ((Evaluation $C $B) $TV)))\n\n (= (|- ((Member $A $B) $T1)\n ((Inheritance $B $C) $T2))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Deduction $TruthA $TruthB $TruthC $T1 $T2)))\n ((Member $A $C) $TV)))\n\n ; ---------- Derivation and query engine ----------\n (: PLN.Config.MaxSteps (-> Number))\n (@doc PLN.Config.MaxSteps\n (@desc "Default maximum number of derivation task selections")\n (@params ())\n (@return "100"))\n (= (PLN.Config.MaxSteps) 100)\n\n (: PLN.Config.TaskQueueSize (-> Number))\n (@doc PLN.Config.TaskQueueSize\n (@desc "Default active task queue bound")\n (@params ())\n (@return "10"))\n (= (PLN.Config.TaskQueueSize) 10)\n\n (: PLN.Config.BeliefQueueSize (-> Number))\n (@doc PLN.Config.BeliefQueueSize\n (@desc "Default belief buffer bound")\n (@params ())\n (@return "100"))\n (= (PLN.Config.BeliefQueueSize) 100)\n\n (: PLN.CollapseToList (-> Atom Expression))\n (@doc PLN.CollapseToList\n (@desc "Collect nondeterministic results and convert this engine\'s comma-headed collapse tuple into a plain expression list")\n (@params ((@param "Nondeterministic query to collapse")))\n (@return "A plain expression list of collapsed results"))\n (= (PLN.CollapseToList $query)\n (let* (($collapsed (collapse $query))\n ($plain (cdr-atom $collapsed)))\n (exclude-item Empty $plain)))\n\n (: StampDisjoint (-> Expression Expression Bool))\n (@doc StampDisjoint\n (@desc "True when two evidence stamps share no evidence item")\n (@params ((@param "First evidence stamp") (@param "Second evidence stamp")))\n (@return "Bool indicating whether the stamps are disjoint"))\n (= (StampDisjoint $Ev1 $Ev2)\n (== () (intersection-atom $Ev1 $Ev2)))\n\n (: StampConcat (-> Expression Expression Expression))\n (@doc StampConcat\n (@desc "Concatenate a stamp with new evidence and sort it")\n (@params ((@param "Base evidence stamp") (@param "Evidence stamp to add")))\n (@return "Sorted combined evidence stamp"))\n (= (StampConcat $stamp $addition)\n (if (== $addition ())\n $stamp\n (let $combined (TupleConcat $stamp $addition)\n (InsertionSort $combined ()))))\n\n (: BestCandidate (-> Atom %Undefined% Expression %Undefined%))\n (@doc BestCandidate\n (@desc "Return the candidate with the highest score under an evaluator function")\n (@params ((@param "Unary evaluator function") (@param "Current best candidate") (@param "Candidate list")))\n (@return "The best candidate, or the initial best candidate when the list is empty"))\n (= (BestCandidate $evaluateCandidateFunction $bestCandidate $tuple)\n (max-by-atom $evaluateCandidateFunction $bestCandidate $tuple))\n\n (: PriorityRank (-> Expression Number))\n (@doc PriorityRank\n (@desc "Task priority score: the confidence of a Sentence candidate")\n (@params ((@param "Sentence candidate or empty sentinel")))\n (@return "Priority score"))\n (= (PriorityRank (Sentence ($x (stv $f $c)) $Ev1)) $c)\n (= (PriorityRank ()) -99999.0)\n\n (: PriorityRankNeg (-> Expression Number))\n (@doc PriorityRankNeg\n (@desc "Negated task priority score, used to find the lowest-priority queue item")\n (@params ((@param "Sentence candidate or empty sentinel")))\n (@return "Negated priority score"))\n (= (PriorityRankNeg (Sentence ($x (stv $f $c)) $Ev1)) (- 0.0 $c))\n (= (PriorityRankNeg ()) -99999.0)\n\n (: LimitSize (-> Expression Number Expression))\n (@doc LimitSize\n (@desc "Limit a priority queue by removing the lowest-priority item when the accumulator reaches the size bound")\n (@params ((@param "Candidate list") (@param "Size bound")))\n (@return "Bounded candidate list"))\n (= (LimitSize $L $size)\n (top-k-by-atom PriorityRank $size $L))\n\n (: PLN.PairInference (-> Expression Expression Expression))\n (@doc PLN.PairInference\n (@desc "Apply binary inference rules in both premise orders")\n (@params ((@param "First judgement") (@param "Second judgement")))\n (@return "A derived judgement"))\n (= (PLN.PairInference $x $y) (|- $x $y))\n (= (PLN.PairInference $x $y) (|- $y $x))\n\n (: PLN.BinaryDerivation (-> Expression Expression Expression Expression))\n (@doc PLN.BinaryDerivation\n (@desc "Derive sentences from one selected task and one belief when their stamps are disjoint")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp") (@param "Belief sentence")))\n (@return "A derived Sentence, or no result"))\n (= (PLN.BinaryDerivation $x $Ev1 (Sentence $y $Ev2))\n (if (StampDisjoint $Ev1 $Ev2)\n (let $stamp (StampConcat $Ev1 $Ev2)\n (case (PLN.PairInference $x $y)\n ((($T $TV) (let $forcedTV $TV\n (Sentence ($T $forcedTV) $stamp))))))\n (empty)))\n\n (: PLN.UnaryDerivation (-> Expression Expression Expression))\n (@doc PLN.UnaryDerivation\n (@desc "Derive sentences from one selected task using unary inference rules")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp")))\n (@return "A derived Sentence, or no result"))\n (= (PLN.UnaryDerivation $x $Ev1)\n (case (|- $x)\n ((($T $TV) (let $forcedTV $TV\n (Sentence ($T $forcedTV) $Ev1))))))\n\n (@doc PLN.Derive\n (@desc "Priority-queue forward derivation over tasks and beliefs")\n (@params ((@param "Task list") (@param "Belief list") (@param "Optional step and queue bounds")))\n (@return "A pair (tasks beliefs) after bounded derivation"))\n (= (PLN.Derive $Tasks $Beliefs $steps $maxsteps $taskqueuesize $beliefqueuesize)\n (if (or (> $steps $maxsteps) (== $Tasks ()))\n ($Tasks $Beliefs)\n (let $selected (BestCandidate PriorityRank () $Tasks)\n (let (Sentence $x $Ev1) $selected\n (let $fromBeliefs (PLN.CollapseToList\n (let $belief (superpose $Beliefs)\n (PLN.BinaryDerivation $x $Ev1 $belief)))\n (let $fromTask (PLN.CollapseToList\n (PLN.UnaryDerivation $x $Ev1))\n (let $derivations (TupleConcat $fromBeliefs $fromTask)\n (let $_ (trace! (SELECTED $steps (Sentence $x $Ev1)) 42)\n (let $taskCandidates (TupleConcat $Tasks $derivations)\n (let $uniqueTasks (Unique $taskCandidates ())\n (let $withoutSelected (Without $uniqueTasks $selected)\n (let $newTasks (LimitSize $withoutSelected $taskqueuesize)\n (let $beliefCandidates (TupleConcat $Beliefs $derivations)\n (let $uniqueBeliefs (Unique $beliefCandidates ())\n (let $newBeliefs (LimitSize $uniqueBeliefs $beliefqueuesize)\n (PLN.Derive $newTasks\n $newBeliefs\n (+ $steps 1)\n $maxsteps\n $taskqueuesize\n $beliefqueuesize))))))))))))))))\n\n (= (PLN.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize)\n (PLN.Derive $Tasks $Beliefs 1 $maxsteps $taskqueuesize $beliefqueuesize))\n\n (= (PLN.Derive $Tasks $Beliefs $maxsteps)\n (PLN.Derive $Tasks\n $Beliefs\n $maxsteps\n (PLN.Config.TaskQueueSize)\n (PLN.Config.BeliefQueueSize)))\n\n (= (PLN.Derive $Tasks $Beliefs)\n (PLN.Derive $Tasks $Beliefs (PLN.Config.MaxSteps)))\n\n (: ConfidenceRank (-> Expression Number))\n (@doc ConfidenceRank\n (@desc "Query-answer score: the confidence of a (truth evidence) pair")\n (@params ((@param "Query answer or empty sentinel")))\n (@return "Confidence score"))\n (= (ConfidenceRank ((stv $f $c) $Ev)) $c)\n (= (ConfidenceRank ()) 0)\n\n (: PLN.QueryCandidate (-> %Undefined% Expression Expression))\n (@doc PLN.QueryCandidate\n (@desc "Return a query answer when a belief Sentence has the requested term")\n (@params ((@param "Requested term") (@param "Belief sentence")))\n (@return "A (truth evidence) pair, or no result when the term differs"))\n (= (PLN.QueryCandidate $term (Sentence ($term $TV) $Ev))\n ($TV $Ev))\n (= (PLN.QueryCandidate $term $sentence)\n (empty))\n\n (@doc PLN.QueryCandidates\n (@desc "Collect all belief truth/evidence pairs whose term matches a query after bounded derivation")\n (@params ((@param "Task list") (@param "Belief list") (@param "Term") (@param "Step and queue bounds")))\n (@return "A plain expression list of query candidates"))\n (= (PLN.QueryCandidates $qcTasks $qcBeliefs $qcTerm $qcMaxSteps $qcTaskQueueSize $qcBeliefQueueSize)\n (let $TasksEval (PLN.Force $qcTasks)\n (let $BeliefsEval (PLN.Force $qcBeliefs)\n (let* (($maxstepsEval (+ 0 $qcMaxSteps))\n ($taskqueuesizeEval (+ 0 $qcTaskQueueSize))\n ($beliefqueuesizeEval (+ 0 $qcBeliefQueueSize)))\n (let ($TasksRet $BeliefsRet)\n (PLN.Derive $TasksEval $BeliefsEval 1 $maxstepsEval $taskqueuesizeEval $beliefqueuesizeEval)\n (PLN.CollapseToList\n (let $belief (superpose $BeliefsRet)\n (PLN.QueryCandidate $qcTerm $belief))))))))\n\n (@doc PLN.Query\n (@desc "Query a term against a PLN knowledge base after bounded forward derivation")\n (@params ((@param "Task list or knowledge base") (@param "Belief list or term") (@param "Term and optional bounds")))\n (@return "The highest-confidence answer as ((stv f c) evidence), or () when no belief matches"))\n (= (PLN.Query $ts $bs $term $m $t $b)\n (let* (($TasksClone (filter-atom $ts $taskItem True))\n ($BeliefsClone (filter-atom $bs $beliefItem True)))\n (BestCandidate ConfidenceRank ()\n (PLN.QueryCandidates $TasksClone\n $BeliefsClone\n $term\n $m\n $t\n $b))))\n\n (= (PLN.Query $k $term $m $t $b)\n (let $kbClone (filter-atom $k $kbItem True)\n (BestCandidate ConfidenceRank ()\n (PLN.QueryCandidates $kbClone\n $kbClone\n $term\n $m\n $t\n $b))))\n\n (= (PLN.Query $k $term $m)\n (PLN.Query $k $term $m (PLN.Config.TaskQueueSize) (PLN.Config.BeliefQueueSize)))\n\n (= (PLN.Query $k $term)\n (PLN.Query $k $term (PLN.Config.MaxSteps)))\n', + nars: '\n ; ---------- Truth values ----------\n (: Truth_c2w (-> Number Number))\n (@doc Truth_c2w\n (@desc "Convert NARS confidence to evidence weight")\n (@params ((@param "Confidence c")))\n (@return "Evidence weight c / (1 - c)"))\n (= (Truth_c2w $c)\n (/ $c (- 1 $c)))\n\n (: Truth_w2c (-> Number Number))\n (@doc Truth_w2c\n (@desc "Convert evidence weight to NARS confidence")\n (@params ((@param "Evidence weight w")))\n (@return "Confidence w / (w + 1)"))\n (= (Truth_w2c $w)\n (/ $w (+ $w 1)))\n\n (: Truth_Deduction (-> Expression Expression Expression))\n (@doc Truth_Deduction\n (@desc "NAL deduction truth function over two simple truth values")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "(stv (* f1 f2) (* f1 f2 c1 c2))"))\n (= (Truth_Deduction (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* (* $f1 $f2) (* $c1 $c2))))\n\n (: Truth_Abduction (-> Expression Expression Expression))\n (@doc Truth_Abduction\n (@desc "NAL abduction truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Abductive simple truth value"))\n (= (Truth_Abduction (stv $f1 $c1)\n (stv $f2 $c2))\n (stv $f2 (Truth_w2c (* (* $f1 $c1) $c2))))\n\n (: Truth_Induction (-> Expression Expression Expression))\n (@doc Truth_Induction\n (@desc "NAL induction, defined as reversed abduction")\n (@params ((@param "First truth value") (@param "Second truth value")))\n (@return "Inductive simple truth value"))\n (= (Truth_Induction $T1 $T2)\n (Truth_Abduction $T2 $T1))\n\n (: Truth_Exemplification (-> Expression Expression Expression))\n (@doc Truth_Exemplification\n (@desc "NAL exemplification truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Exemplification simple truth value"))\n (= (Truth_Exemplification (stv $f1 $c1)\n (stv $f2 $c2))\n (stv 1.0 (Truth_w2c (* (* $f1 $f2) (* $c1 $c2)))))\n\n (: Truth_StructuralDeduction (-> Expression Expression))\n (@doc Truth_StructuralDeduction\n (@desc "Structural deduction against the fixed NARS truth value (stv 1.0 0.9)")\n (@params ((@param "Input truth value")))\n (@return "Structurally deduced truth value"))\n (= (Truth_StructuralDeduction $T)\n (Truth_Deduction $T (stv 1.0 0.9)))\n\n (: Truth_Negation (-> Expression Expression))\n (@doc Truth_Negation\n (@desc "Negate the frequency of a simple truth value while preserving confidence")\n (@params ((@param "Truth value (stv f c)")))\n (@return "(stv (1 - f) c)"))\n (= (Truth_Negation (stv $f $c))\n (stv (- 1 $f) $c))\n\n (: Truth_StructuralDeductionNegated (-> Expression Expression))\n (@doc Truth_StructuralDeductionNegated\n (@desc "Structural deduction followed by truth negation")\n (@params ((@param "Input truth value")))\n (@return "Negated structural deduction truth value"))\n (= (Truth_StructuralDeductionNegated $T)\n (Truth_Negation (Truth_StructuralDeduction $T)))\n\n (: Truth_Intersection (-> Expression Expression Expression))\n (@doc Truth_Intersection\n (@desc "Truth function for intersection")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "(stv (* f1 f2) (* c1 c2))"))\n (= (Truth_Intersection (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* $c1 $c2)))\n\n (: Truth_StructuralIntersection (-> Expression Expression))\n (@doc Truth_StructuralIntersection\n (@desc "Structural intersection against the fixed NARS truth value (stv 1.0 0.9)")\n (@params ((@param "Input truth value")))\n (@return "Structurally intersected truth value"))\n (= (Truth_StructuralIntersection $T)\n (Truth_Intersection $T (stv 1.0 0.9)))\n\n (: Truth_or (-> Number Number Number))\n (@doc Truth_or\n (@desc "Probabilistic OR over two frequencies")\n (@params ((@param "First frequency") (@param "Second frequency")))\n (@return "1 - (1 - a) * (1 - b)"))\n (= (Truth_or $a $b)\n (- 1 (* (- 1 $a) (- 1 $b))))\n\n (: Truth_Comparison (-> Expression Expression Expression))\n (@doc Truth_Comparison\n (@desc "NAL comparison truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Comparison simple truth value"))\n (= (Truth_Comparison (stv $f1 $c1)\n (stv $f2 $c2))\n (let $f0 (Truth_or $f1 $f2)\n (stv (if (== $f0 0.0)\n 0.0\n (/ (* $f1 $f2) $f0))\n (Truth_w2c (* $f0 (* $c1 $c2))))))\n\n (: Truth_Analogy (-> Expression Expression Expression))\n (@doc Truth_Analogy\n (@desc "NAL analogy truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Analogy simple truth value"))\n (= (Truth_Analogy (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* (* $c1 $c2) $f2)))\n\n (: Truth_Resemblance (-> Expression Expression Expression))\n (@doc Truth_Resemblance\n (@desc "NAL resemblance truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Resemblance simple truth value"))\n (= (Truth_Resemblance (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 $f2) (* (* $c1 $c2) (Truth_or $f1 $f2))))\n\n (: Truth_Union (-> Expression Expression Expression))\n (@doc Truth_Union\n (@desc "PeTTa lib_nars union truth function; the upstream body returns a two-element expression, not an stv-headed value")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "A two-element expression matching PeTTa\'s source"))\n (= (Truth_Union (stv $f1 $c1)\n (stv $f2 $c2))\n ((Truth_or $f1 $f2) (* $c1 $c2)))\n\n (: Truth_Difference (-> Expression Expression Expression))\n (@doc Truth_Difference\n (@desc "NAL difference truth function")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Difference simple truth value"))\n (= (Truth_Difference (stv $f1 $c1)\n (stv $f2 $c2))\n (stv (* $f1 (- 1 $f2)) (* $c1 $c2)))\n\n (: Truth_DecomposePNN (-> Expression Expression Expression))\n (@doc Truth_DecomposePNN\n (@desc "NAL decomposition truth function for positive-negative-negative decomposition")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposePNN (stv $f1 $c1)\n (stv $f2 $c2))\n (let $fn (* $f1 (- 1 $f2))\n (stv (- 1 $fn) (* $fn (* $c1 $c2)))))\n\n (: Truth_DecomposeNPP (-> Expression Expression Expression))\n (@doc Truth_DecomposeNPP\n (@desc "NAL decomposition truth function for negative-positive-positive decomposition")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposeNPP (stv $f1 $c1)\n (stv $f2 $c2))\n (let $f (* (- 1 $f1) $f2)\n (stv $f (* $f (* $c1 $c2)))))\n\n (: Truth_DecomposePNP (-> Expression Expression Expression))\n (@doc Truth_DecomposePNP\n (@desc "NAL decomposition truth function for positive-negative-positive decomposition")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposePNP (stv $f1 $c1)\n (stv $f2 $c2))\n (let $f (* $f1 (- 1 $f2))\n (stv $f (* $f (* $c1 $c2)))))\n\n (: Truth_DecomposePPP (-> Expression Expression Expression))\n (@doc Truth_DecomposePPP\n (@desc "NAL decomposition truth function for positive-positive-positive decomposition")\n (@params ((@param "First truth value") (@param "Second truth value")))\n (@return "Decomposition simple truth value"))\n (= (Truth_DecomposePPP $v1 $v2)\n (Truth_DecomposeNPP (Truth_Negation $v1) $v2))\n\n (: Truth_DecomposeNNN (-> Expression Expression Expression))\n (@doc Truth_DecomposeNNN\n (@desc "PeTTa lib_nars decomposition for negative-negative-negative; the upstream body returns a two-element expression, not an stv-headed value")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "A two-element expression matching PeTTa\'s source"))\n (= (Truth_DecomposeNNN (stv $f1 $c1)\n (stv $f2 $c2))\n (let $fn (* (- 1 $f1) (- 1 $f2))\n ((- 1 $fn) (* $fn (* $c1 $c2)))))\n\n (: Truth_Eternalize (-> Expression Expression))\n (@doc Truth_Eternalize\n (@desc "Eternalize a simple truth value by converting its confidence as a weight")\n (@params ((@param "Truth value (stv f c)")))\n (@return "Eternalized simple truth value"))\n (= (Truth_Eternalize (stv $f $c))\n (stv $f (Truth_w2c $c)))\n\n (: Truth_Revision (-> Expression Expression Expression))\n (@doc Truth_Revision\n (@desc "Revise two independent simple truth values by combining their evidence weights")\n (@params ((@param "First truth value (stv f c)") (@param "Second truth value (stv f c)")))\n (@return "Revised simple truth value"))\n (= (Truth_Revision (stv $f1 $c1)\n (stv $f2 $c2))\n (let* (($w1 (Truth_c2w $c1))\n ($w2 (Truth_c2w $c2))\n ($w (+ $w1 $w2))\n ($f (/ (+ (* $w1 $f1) (* $w2 $f2)) $w))\n ($c (Truth_w2c $w)))\n (stv (min 1.00 $f) (min 0.99 (max (max $c $c1) $c2)))))\n\n (: Truth_Expectation (-> Expression Number))\n (@doc Truth_Expectation\n (@desc "Expectation of a simple truth value")\n (@params ((@param "Truth value (stv f c)")))\n (@return "c * (f - 0.5) + 0.5"))\n (= (Truth_Expectation (stv $f $c))\n (+ (* $c (- $f 0.5)) 0.5))\n\n ; ---------- Inference rules ----------\n (@doc |-\n (@desc "PeTTa lib_nars NAL inference rules. Binary forms combine two judgements; unary forms decompose one judgement")\n (@params ((@param "One or two NARS judgements, each written as ( )")))\n (@return "A derived judgement ( )"))\n\n ; NAL-1: revision and inheritance syllogisms.\n (= (|- ($T $T1) ($T $T2)) ($T (Truth_Revision $T1 $T2)))\n (= (|- ((--> $a $b) $T1) ((--> $b $c) $T2)) ((--> $a $c) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> $a $b) $T1) ((--> $a $c) $T2)) ((--> $c $b) (Truth_Induction $T1 $T2)))\n (= (|- ((--> $a $c) $T1) ((--> $b $c) $T2)) ((--> $b $a) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> $a $b) $T1) ((--> $b $c) $T2)) ((--> $c $a) (Truth_Exemplification $T1 $T2)))\n\n ; PeTTa\'s lib_nars source has no NAL-2 block.\n\n ; NAL-3: sets and extensional/intensional decomposition.\n (= (|- ((--> ({} $A $B) $M) $T)) ((--> ({} $A) $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> ({} $A $B) $M) $T)) ((--> ({} $B) $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M ([] $A $B)) $T)) ((--> $M ([] $A)) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M ([] $A $B)) $T)) ((--> $M ([] $B)) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (∪ $S $P) $M) $T)) ((--> $S $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M (∩ $S $P)) $T)) ((--> $M $S) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (∪ $S $P) $M) $T)) ((--> $P $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M (∩ $S $P)) $T)) ((--> $M $P) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (~ $A $S) $M) $T)) ((--> $A $M) (Truth_StructuralDeduction $T)))\n (= (|- ((--> $M (− $B $S)) $T)) ((--> $M $B) (Truth_StructuralDeduction $T)))\n (= (|- ((--> (~ $A $S) $M) $T)) ((--> $S $M) (Truth_StructuralDeductionNegated $T)))\n (= (|- ((--> $M (− $B $S)) $T)) ((--> $M $S) (Truth_StructuralDeductionNegated $T)))\n (= (|- ((--> $S $M) $T1) ((--> (∪ $S $P) $M) $T2)) ((--> $P $M) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $P $M) $T1) ((--> (∪ $S $P) $M) $T2)) ((--> $S $M) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $S $M) $T1) ((--> (∩ $S $P) $M) $T2)) ((--> $P $M) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $P $M) $T1) ((--> (∩ $S $P) $M) $T2)) ((--> $S $M) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $S $M) $T1) ((--> (~ $S $P) $M) $T2)) ((--> $P $M) (Truth_DecomposePNP $T1 $T2)))\n (= (|- ((--> $S $M) $T1) ((--> (~ $P $S) $M) $T2)) ((--> $P $M) (Truth_DecomposeNNN $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (∩ $S $P)) $T2)) ((--> $M $P) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $M $P) $T1) ((--> $M (∩ $S $P)) $T2)) ((--> $M $S) (Truth_DecomposePNN $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (∪ $S $P)) $T2)) ((--> $M $P) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $M $P) $T1) ((--> $M (∪ $S $P)) $T2)) ((--> $M $S) (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (− $S $P)) $T2)) ((--> $M $P) (Truth_DecomposePNP $T1 $T2)))\n (= (|- ((--> $M $S) $T1) ((--> $M (− $P $S)) $T2)) ((--> $M $P) (Truth_DecomposeNNN $T1 $T2)))\n\n ; NAL-4: relation component rules.\n (= (|- ((--> (× $A $B) $R) $T1) ((--> (× $C $B) $R) $T2)) ((--> $C $A) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> (× $A $C) $R) $T2)) ((--> $C $B) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $R (× $C $B)) $T2)) ((--> $C $A) (Truth_Induction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $R (× $A $C)) $T2)) ((--> $C $B) (Truth_Induction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $C $A) $T2)) ((--> (× $C $B) $R) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $A $C) $T2)) ((--> (× $C $B) $R) (Truth_Induction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $C $B) $T2)) ((--> (× $A $C) $R) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> (× $A $B) $R) $T1) ((--> $B $C) $T2)) ((--> (× $A $C) $R) (Truth_Induction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $A $C) $T2)) ((--> $R (× $C $B)) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $C $A) $T2)) ((--> $R (× $C $B)) (Truth_Abduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $B $C) $T2)) ((--> $R (× $A $C)) (Truth_Deduction $T1 $T2)))\n (= (|- ((--> $R (× $A $B)) $T1) ((--> $C $B) $T2)) ((--> $R (× $A $C)) (Truth_Abduction $T1 $T2)))\n\n ; NAL-5: negation, conjunction, disjunction, and higher-order decomposition.\n (= (|- ((¬ $A) $T)) ($A (Truth_Negation $T)))\n (= (|- ((∧ $A $B) $T)) ($A (Truth_StructuralDeduction $T)))\n (= (|- ((∧ $A $B) $T)) ($B (Truth_StructuralDeduction $T)))\n (= (|- ($S $T1) ((∧ $S $A) $T2)) ($A (Truth_DecomposePNN $T1 $T2)))\n (= (|- ($S $T1) ((∨ $S $A) $T2)) ($A (Truth_DecomposeNPP $T1 $T2)))\n (= (|- ($S $T1) ((∧ (¬ $S) $A) $T2)) ($A (Truth_DecomposeNNN $T1 $T2)))\n (= (|- ($S $T1) ((∨ (¬ $S) $A) $T2)) ($A (Truth_DecomposePPP $T1 $T2)))\n (= (|- ($A $T1) ((==> $A $B) $T2)) ($B (Truth_Deduction $T1 $T2)))\n (= (|- ($A $T1) ((==> (∧ $A $B) $C) $T2)) ((==> $B $C) (Truth_Deduction $T1 $T2)))\n (= (|- ($B $T1) ((==> $A $B) $T2)) ($A (Truth_Abduction $T1 $T2)))\n\n ; ---------- Derivation and query engine ----------\n (: NARS.Config.MaxSteps (-> Number))\n (@doc NARS.Config.MaxSteps\n (@desc "Default maximum number of derivation task selections")\n (@params ())\n (@return "100"))\n (= (NARS.Config.MaxSteps) 100)\n\n (: NARS.Config.TaskQueueSize (-> Number))\n (@doc NARS.Config.TaskQueueSize\n (@desc "Default active task queue bound")\n (@params ())\n (@return "10"))\n (= (NARS.Config.TaskQueueSize) 10)\n\n (: NARS.Config.BeliefQueueSize (-> Number))\n (@doc NARS.Config.BeliefQueueSize\n (@desc "Default belief buffer bound")\n (@params ())\n (@return "100"))\n (= (NARS.Config.BeliefQueueSize) 100)\n\n (: NARS.CollapseToList (-> Atom Expression))\n (@doc NARS.CollapseToList\n (@desc "Collect nondeterministic results as a plain expression list and remove Empty sentinels")\n (@params ((@param "Nondeterministic query to collapse")))\n (@return "A plain expression list of the collapsed results"))\n (= (NARS.CollapseToList $query)\n (let $plain (collapse $query)\n (exclude-item Empty $plain)))\n\n (: StampDisjoint (-> Expression Expression Bool))\n (@doc StampDisjoint\n (@desc "True when two evidence stamps share no evidence item")\n (@params ((@param "First evidence stamp list") (@param "Second evidence stamp list")))\n (@return "Bool indicating whether the stamps are disjoint"))\n (= (StampDisjoint $Ev1 $Ev2)\n (== () (intersection-atom $Ev1 $Ev2)))\n\n (: StampConcat (-> Expression Expression Expression))\n (@doc StampConcat\n (@desc "Concatenate a stamp with new evidence and sort it, preserving PeTTa lib_nars\' stamp-combination shape")\n (@params ((@param "Base evidence stamp") (@param "Evidence stamp to add")))\n (@return "Sorted combined evidence stamp"))\n (= (StampConcat $stamp $addition)\n (if (== $addition ())\n $stamp\n (sort (append $stamp $addition))))\n\n (: BestCandidate (-> Atom %Undefined% Expression %Undefined%))\n (@doc BestCandidate\n (@desc "Return the item in a candidate list with the highest score under an evaluator function")\n (@params ((@param "Unary evaluator function") (@param "Current best candidate") (@param "Candidate list")))\n (@return "The best candidate, or the initial best candidate when the list is empty"))\n (= (BestCandidate $evaluateCandidateFunction $bestCandidate $tuple)\n (max-by-atom $evaluateCandidateFunction $bestCandidate $tuple))\n\n (: PriorityRank (-> Expression Number))\n (@doc PriorityRank\n (@desc "Task priority score: the confidence of a sentence, with a low sentinel for the empty candidate")\n (@params ((@param "A Sentence candidate or ()")))\n (@return "Priority score"))\n (= (PriorityRank (Sentence ($x (stv $f $c)) $Ev1)) $c)\n (= (PriorityRank ()) -99999.0)\n\n (: PriorityRankNeg (-> Expression Number))\n (@doc PriorityRankNeg\n (@desc "Negated task priority score, used to find the lowest-priority queue item")\n (@params ((@param "A Sentence candidate or ()")))\n (@return "Negated priority score"))\n (= (PriorityRankNeg (Sentence ($x (stv $f $c)) $Ev1)) (- 0.0 $c))\n (= (PriorityRankNeg ()) -99999.0)\n\n (: LimitSize (-> Expression Number Expression))\n (@doc LimitSize\n (@desc "Bound a priority queue to fewer than the size limit by dropping the lowest-priority items")\n (@params ((@param "Candidate list") (@param "Size bound")))\n (@return "Bounded candidate list"))\n (= (LimitSize $L $size)\n (top-k-by-atom PriorityRank $size $L))\n\n (: NARS.PairInference (-> Expression Expression Expression))\n (@doc NARS.PairInference\n (@desc "Apply the binary inference rules in both premise orders")\n (@params ((@param "First judgement") (@param "Second judgement")))\n (@return "A derived judgement"))\n (= (NARS.PairInference $x $y) (|- $x $y))\n (= (NARS.PairInference $x $y) (|- $y $x))\n\n (: NARS.BinaryDerivation (-> Expression Expression Expression Expression))\n (@doc NARS.BinaryDerivation\n (@desc "Derive sentences from one selected task and one belief when their stamps are disjoint")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp") (@param "Belief sentence")))\n (@return "A derived Sentence, or no result when stamps overlap or no rule applies"))\n (= (NARS.BinaryDerivation $x $Ev1 (Sentence $y $Ev2))\n (if (StampDisjoint $Ev1 $Ev2)\n (let $stamp (StampConcat $Ev1 $Ev2)\n (case (NARS.PairInference $x $y)\n ((($T $TV) (Sentence ($T $TV) $stamp)))))\n (empty)))\n\n (: NARS.UnaryDerivation (-> Expression Expression Expression))\n (@doc NARS.UnaryDerivation\n (@desc "Derive sentences from one selected task using unary inference rules")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp")))\n (@return "A derived Sentence, or no result when no unary rule applies"))\n (= (NARS.UnaryDerivation $x $Ev1)\n (case (|- $x)\n ((($T (stv $f $c)) (Sentence ($T (stv $f $c)) $Ev1)))))\n\n (@doc NARS.Derive\n (@desc "Priority-queue forward derivation over tasks and beliefs")\n (@params ((@param "Task list") (@param "Belief list") (@param "Optional step and queue bounds")))\n (@return "A pair (tasks beliefs) after bounded derivation"))\n (= (NARS.Derive $Tasks $Beliefs $steps $maxsteps $taskqueuesize $beliefqueuesize)\n (if (or (> $steps $maxsteps) (== $Tasks ()))\n ($Tasks $Beliefs)\n (let $selected (BestCandidate PriorityRank () $Tasks)\n (let (Sentence $x $Ev1) $selected\n (let $fromBeliefs (NARS.CollapseToList\n (let $belief (superpose $Beliefs)\n (NARS.BinaryDerivation $x $Ev1 $belief)))\n (let $fromTask (NARS.CollapseToList\n (NARS.UnaryDerivation $x $Ev1))\n (let $derivations (append $fromBeliefs $fromTask)\n (let $_ (trace! (SELECTED $steps (Sentence $x $Ev1)) 42)\n (let $taskCandidates (unique-atom (append $Tasks $derivations))\n (let $withoutSelected (exclude-item $selected $taskCandidates)\n (let $newTasks (LimitSize $withoutSelected $taskqueuesize)\n (let $beliefCandidates (unique-atom (append $Beliefs $derivations))\n (let $newBeliefs (LimitSize $beliefCandidates $beliefqueuesize)\n (NARS.Derive $newTasks\n $newBeliefs\n (+ $steps 1)\n $maxsteps\n $taskqueuesize\n $beliefqueuesize))))))))))))))\n\n (= (NARS.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize)\n (NARS.Derive $Tasks $Beliefs 1 $maxsteps $taskqueuesize $beliefqueuesize))\n\n (= (NARS.Derive $Tasks $Beliefs $maxsteps)\n (NARS.Derive $Tasks $Beliefs $maxsteps (NARS.Config.TaskQueueSize) (NARS.Config.BeliefQueueSize)))\n\n (= (NARS.Derive $Tasks $Beliefs)\n (NARS.Derive $Tasks $Beliefs (NARS.Config.MaxSteps)))\n\n (: ConfidenceRank (-> Expression Number))\n (@doc ConfidenceRank\n (@desc "Query-answer score: the confidence of a (truth evidence) pair, with zero for the empty candidate")\n (@params ((@param "A query answer ((stv f c) evidence) or ()")))\n (@return "Confidence score"))\n (= (ConfidenceRank ((stv $f $c) $Ev)) $c)\n (= (ConfidenceRank ()) 0)\n\n (@doc NARS.Query\n (@desc "Query a term against a NARS knowledge base after bounded forward derivation")\n (@params ((@param "Task list or knowledge base") (@param "Belief list or term") (@param "Term and optional bounds")))\n (@return "The highest-confidence answer as ((stv f c) evidence), or () when no belief matches"))\n ; let-force the candidate list: imported into &self, BestCandidate\'s Expression-typed argument is not\n ; re-evaluated if it already looks like an Expression, so evaluate NARS.CollapseToList explicitly first.\n (= (NARS.Query $Tasks $Beliefs $term $maxsteps $taskqueuesize $beliefqueuesize)\n (let $candidates\n (NARS.CollapseToList\n (let ($TasksRet $BeliefsRet) (NARS.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize)\n (case (superpose $BeliefsRet)\n (((Sentence ($Term $TV) $Ev)\n (case (== $Term $term)\n ((True ($TV $Ev)))))))))\n (BestCandidate ConfidenceRank () $candidates)))\n\n (= (NARS.Query $kb $term $maxsteps $taskqueuesize $beliefqueuesize)\n (NARS.Query $kb $kb $term $maxsteps $taskqueuesize $beliefqueuesize))\n\n (= (NARS.Query $kb $term $maxsteps)\n (NARS.Query $kb $term $maxsteps (NARS.Config.TaskQueueSize) (NARS.Config.BeliefQueueSize)))\n\n (= (NARS.Query $kb $term)\n (NARS.Query $kb $term (NARS.Config.MaxSteps)))\n', + pln: '\n ; ---------- Tuple helpers ----------\n (@doc PLN.Force\n (@desc "Evaluate a raw expression call while preserving already-data expression lists")\n (@params ((@param "Atom to force")))\n (@return "The evaluated atom, or the original atom when eval leaves it unreduced"))\n (= (PLN.Force $atom)\n (let $forced (eval $atom)\n (case $forced\n (((eval $raw) $atom)\n ($_ $forced)))))\n\n (: clamp (-> Number Number Number Number))\n (@doc clamp\n (@desc "Clamp a number to the inclusive range [min, max]")\n (@params ((@param "Value") (@param "Minimum") (@param "Maximum")))\n (@return "The value bounded by the range"))\n (= (clamp $v $min $max)\n (min $max (max $v $min)))\n\n (: TupleConcat (-> Expression Expression Expression))\n (@doc TupleConcat\n (@desc "Concatenate two tuple lists represented as Hyperon expression lists")\n (@params ((@param "First tuple list") (@param "Second tuple list")))\n (@return "The concatenated tuple list"))\n (= (TupleConcat $Ev1 $Ev2)\n (append $Ev1 $Ev2))\n\n (: TupleCount (-> Expression Number))\n (@doc TupleCount\n (@desc "Count items in a tuple list")\n (@params ((@param "Tuple list")))\n (@return "The item count"))\n (= (TupleCount $tuple)\n (size-atom $tuple))\n\n (: and5 (-> Bool Bool Bool Bool Bool Bool))\n (@doc and5\n (@desc "Five-argument boolean conjunction")\n (@params ((@param "First boolean") (@param "Second boolean") (@param "Third boolean") (@param "Fourth boolean") (@param "Fifth boolean")))\n (@return "True when all five inputs are true"))\n (= (and5 $0 $1 $2 $3 $4)\n (and $0 (and $1 (and $2 (and $3 $4)))))\n\n (: min5 (-> Number Number Number Number Number Number))\n (@doc min5\n (@desc "Minimum of five numbers")\n (@params ((@param "First number") (@param "Second number") (@param "Third number") (@param "Fourth number") (@param "Fifth number")))\n (@return "The smallest input"))\n (= (min5 $0 $1 $2 $3 $4)\n (min $0 (min $1 (min $2 (min $3 $4)))))\n\n (: /safe (-> Number Number Number))\n (@doc /safe\n (@desc "Division guarded like PeTTa lib_pln: divide only when the denominator is positive")\n (@params ((@param "Numerator") (@param "Denominator")))\n (@return "The quotient, or no result when the denominator is not positive"))\n (= (/safe $A $B)\n (if (> $B 0.0)\n (/ $A $B)\n (empty)))\n\n (: negate (-> Number Number))\n (@doc negate\n (@desc "Return 1 minus the argument")\n (@params ((@param "Number")))\n (@return "1 - x"))\n (= (negate $arg)\n (- 1.0 $arg))\n\n (: invert (-> Number Number))\n (@doc invert\n (@desc "Return the reciprocal through /safe")\n (@params ((@param "Number")))\n (@return "1 / x, or no result when x is not positive"))\n (= (invert $arg)\n (/safe 1.0 $arg))\n\n (: InsertSorted (-> Number Expression Expression))\n (@doc InsertSorted\n (@desc "Insert a numeric item into a sorted tuple list")\n (@params ((@param "Item") (@param "Sorted tuple list")))\n (@return "The sorted tuple list with the item inserted"))\n (= (InsertSorted $x $L)\n (if (== $L ())\n ($x)\n (let* ((($head $tail) (decons-atom $L)))\n (if (< $x $head)\n (TupleConcat ($x $head) $tail)\n (let $inserted (InsertSorted $x $tail)\n (TupleConcat ($head) $inserted))))))\n\n (: InsertionSort (-> Expression Expression Expression))\n (@doc InsertionSort\n (@desc "Sort a tuple list. The second argument is preserved for PeTTa lib_pln call compatibility and is ignored by the upstream implementation")\n (@params ((@param "Tuple list") (@param "Ignored accumulator")))\n (@return "Sorted tuple list"))\n (= (InsertionSort $L $Ret)\n (let $items (PLN.Force $L)\n (if (== $items ())\n $Ret\n (let* ((($x $rest) (decons-atom $items))\n ($newRet (InsertSorted $x $Ret)))\n (InsertionSort $rest $newRet)))))\n\n (: Without (-> Expression %Undefined% Expression))\n (@doc Without\n (@desc "Remove an item from a tuple list")\n (@params ((@param "Tuple list") (@param "Item to remove")))\n (@return "Tuple list without the item"))\n (= (Without $Tuple $a)\n (exclude-item $a $Tuple))\n\n (: ElementOf (-> %Undefined% Expression Bool))\n (@doc ElementOf\n (@desc "Check whether an item is a member of a tuple list")\n (@params ((@param "Item") (@param "Tuple list")))\n (@return "Bool membership result"))\n (= (ElementOf $a $Tuple)\n (is-member $a $Tuple))\n\n (: Unique (-> Expression Expression Expression))\n (@doc Unique\n (@desc "Deduplicate a tuple list. The second argument is preserved for PeTTa lib_pln call compatibility and is ignored by the upstream implementation")\n (@params ((@param "Tuple list") (@param "Ignored accumulator")))\n (@return "Deduplicated tuple list"))\n (= (Unique $L $Ret)\n (unique-atom $L))\n\n ; ---------- Consistency helpers ----------\n (: smallest-intersection-probability (-> Number Number Number))\n (@doc smallest-intersection-probability\n (@desc "Lower bound for a conditional intersection probability")\n (@params ((@param "Strength of A") (@param "Strength of B")))\n (@return "Clamped lower probability bound"))\n (= (smallest-intersection-probability $As $Bs)\n (clamp (/ (- (+ $As $Bs) 1) $As) 0 1))\n\n (: largest-intersection-probability (-> Number Number Number))\n (@doc largest-intersection-probability\n (@desc "Upper bound for a conditional intersection probability")\n (@params ((@param "Strength of A") (@param "Strength of B")))\n (@return "Clamped upper probability bound"))\n (= (largest-intersection-probability $As $Bs)\n (clamp (/ $Bs $As) 0 1))\n\n (: conditional-probability-consistency (-> Number Number Number Bool))\n (@doc conditional-probability-consistency\n (@desc "Check PeTTa lib_pln conditional probability bounds")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of A implies B")))\n (@return "True when the conditional probability is inside the PLN bounds"))\n (= (conditional-probability-consistency $As $Bs $ABs)\n (and (< 0 $As)\n (and (<= (smallest-intersection-probability $As $Bs) $ABs)\n (<= $ABs (largest-intersection-probability $As $Bs)))))\n\n (: Consistency_ImplicationImplicantConjunction (-> Number Number Number Number Number Bool))\n (@doc Consistency_ImplicationImplicantConjunction\n (@desc "Check PeTTa lib_pln implication and implicant conjunction consistency")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of C") (@param "Strength of A implies C") (@param "Strength of B implies C")))\n (@return "Bool consistency result"))\n (= (Consistency_ImplicationImplicantConjunction $As $Bs $Cs $ACs $BCs)\n (and5 (> $As 0) (> $Bs 0) (> $Cs 0)\n (<= $ACs (/ $Cs $As))\n (<= $BCs (/ $Cs $Bs))))\n\n ; ---------- Truth functions ----------\n ; PeTTa lib_pln leaves STV as a stub so callers can define node truth values.\n (= (STV $stv) (empty))\n\n (: Truth_c2w (-> Number Number))\n (@doc Truth_c2w\n (@desc "Convert PLN confidence to evidence weight")\n (@params ((@param "Confidence c")))\n (@return "Evidence weight c / (1 - c), or no result when c is 1"))\n (= (Truth_c2w $c)\n (/safe $c (- 1 $c)))\n\n (: Truth_w2c (-> Number Number))\n (@doc Truth_w2c\n (@desc "Convert evidence weight to PLN confidence")\n (@params ((@param "Evidence weight w")))\n (@return "Confidence w / (w + 1)"))\n (= (Truth_w2c $w)\n (/safe $w (+ $w 1)))\n\n (: Truth_Deduction (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_Deduction\n (@desc "PeTTa lib_pln five-argument PLN deduction truth function")\n (@params ((@param "Truth of P") (@param "Truth of Q") (@param "Truth of R") (@param "Truth of P implies Q") (@param "Truth of Q implies R")))\n (@return "Deductive simple truth value"))\n (= (Truth_Deduction (stv $Ps $Pc)\n (stv $Qs $Qc)\n (stv $Rs $Rc)\n (stv $PQs $PQc)\n (stv $QRs $QRc))\n (if (and (conditional-probability-consistency $Ps $Qs $PQs)\n (conditional-probability-consistency $Qs $Rs $QRs))\n (stv (if (< 0.9999 $Qs)\n $Rs\n (+ (* $PQs $QRs)\n (/safe (* (- 1 $PQs) (- $Rs (* $Qs $QRs))) (- 1 $Qs))))\n (min $Pc (min $Qc (min $Rc (min $PQc $QRc)))))\n (stv 1 0)))\n\n (: Truth_Induction (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_Induction\n (@desc "PeTTa lib_pln five-argument PLN induction truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of B implies A") (@param "Truth of B implies C")))\n (@return "Inductive simple truth value"))\n (= (Truth_Induction (stv $sA $cA)\n (stv $sB $cB)\n (stv $sC $cC)\n (stv $sBA $cBA)\n (stv $sBC $cBC))\n (stv (+ (/safe (* (* $sBA $sBC) $sB) $sA)\n (* (- 1 (/safe (* $sBA $sB) $sA))\n (/safe (- $sC (* $sB $sBC)) (- 1 $sB))))\n (Truth_w2c (min $cBA $cBC))))\n\n (: Truth_Abduction (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_Abduction\n (@desc "PeTTa lib_pln five-argument PLN abduction truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of A implies B") (@param "Truth of C implies B")))\n (@return "Abductive simple truth value"))\n (= (Truth_Abduction (stv $sA $cA)\n (stv $sB $cB)\n (stv $sC $cC)\n (stv $sAB $cAB)\n (stv $sCB $cCB))\n (stv (+ (/safe (* (* $sAB $sCB) $sC)\n $sB)\n (/safe (* $sC (* (- 1 $sAB) (- 1 $sCB)))\n (- 1 $sB)))\n (Truth_w2c (min $cAB $cCB))))\n\n (: Truth_ModusPonens (-> Expression Expression Expression))\n (@doc Truth_ModusPonens\n (@desc "PeTTa lib_pln modus ponens truth function")\n (@params ((@param "Antecedent truth value") (@param "Implication truth value")))\n (@return "Conclusion truth value"))\n (= (Truth_ModusPonens (stv $f1 $c1) (stv $f2 $c2))\n (stv (+ (* $f1 $f2) (* 0.02 (- 1 $f1)))\n (* $c1 $c2)))\n\n (: Truth_SymmetricModusPonens (-> Expression Expression Expression))\n (@doc Truth_SymmetricModusPonens\n (@desc "PeTTa lib_pln symmetric modus ponens truth function")\n (@params ((@param "Source truth value") (@param "Similarity truth value")))\n (@return "Conclusion truth value"))\n (= (Truth_SymmetricModusPonens (stv $sA $cA) (stv $sAB $cAB))\n (let* (($snotAB 0.2)\n ($cnotAB 1.0))\n (stv (+ (* $sA $sAB) (* (* $snotAB (negate $sA)) (+ 1.0 $sAB)))\n (min (min $cAB $cnotAB) $cA))))\n\n (: Truth_Revision (-> Expression Expression Expression))\n (@doc Truth_Revision\n (@desc "PeTTa lib_pln heuristic revision of two simple truth values")\n (@params ((@param "First truth value") (@param "Second truth value")))\n (@return "Revised truth value"))\n (= (Truth_Revision (stv $f1 $c1) (stv $f2 $c2))\n (let* (($w1 (Truth_c2w $c1))\n ($w2 (Truth_c2w $c2))\n ($w (+ $w1 $w2))\n ($f (/safe (+ (* $w1 $f1) (* $w2 $f2)) $w))\n ($c (Truth_w2c $w)))\n (stv (min 1.0 $f)\n (min 1.0 (max (max $c $c1) $c2)))))\n\n (: Truth_Negation (-> Expression Expression))\n (@doc Truth_Negation\n (@desc "Negate the strength of a simple truth value while preserving confidence")\n (@params ((@param "Truth value")))\n (@return "Negated truth value"))\n (= (Truth_Negation (stv $s $c))\n (stv (- 1.0 $s) $c))\n\n (: Truth_inversion (-> Expression Expression Expression))\n (@doc Truth_inversion\n (@desc "PeTTa lib_pln inversion truth function")\n (@params ((@param "Target node truth value") (@param "Link truth value")))\n (@return "Inverted truth value"))\n (= (Truth_inversion (stv $Bs $Bc) (stv $ABs $ABc))\n (stv $ABs (* $Bc (* $ABc 0.6))))\n\n (: Truth_equivalenceToImplication (-> Expression Expression Expression Expression))\n (@doc Truth_equivalenceToImplication\n (@desc "Convert an equivalence truth value into an implication truth value")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of equivalence A B")))\n (@return "Implication truth value"))\n (= (Truth_equivalenceToImplication (stv $As $Ac) (stv $Bs $Bc) (stv $ABs $ABc))\n (let* (($ConclS (if (< 0.99 (* $ABs $ABc))\n $ABs\n (/safe (* (+ 1.0 (/safe $Bs $As)) $ABs) (+ 1.0 $ABs)))))\n (stv $ConclS $ABc)))\n\n (: TransitiveSimilarityStrength (-> Number Number Number Number Number Number))\n (@doc TransitiveSimilarityStrength\n (@desc "PeTTa lib_pln transitive similarity strength helper")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of C") (@param "Strength of A similar B") (@param "Strength of B similar C")))\n (@return "Transitive similarity strength"))\n (= (TransitiveSimilarityStrength $sA $sB $sC $sAB $sBC)\n (let* (($T1 (/ (* (+ 1.0 (/ $sB $sA)) $sAB) (+ 1.0 $sAB)))\n ($T2 (/ (* (+ 1.0 (/ $sC $sB)) $sBC) (+ 1.0 $sBC)))\n ($T3 (/ (* (+ 1.0 (/ $sB $sC)) $sBC) (+ 1.0 $sBC)))\n ($T4 (/ (* (+ 1.0 (/ $sA $sB)) $sAB) (+ 1.0 $sAB))))\n (invert (- (+ (invert (+ (* $T1 $T2)\n (* (negate $T1)\n (/safe (- $sC (* $sB $T2)) (negate $sB)))))\n (invert (+ (* $T3 $T4)\n (* (negate $T3)\n (/safe (- $sC (* $sB $T4)) (negate $sB))))))\n 1.0))))\n\n (: Truth_transitiveSimilarity (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_transitiveSimilarity\n (@desc "PeTTa lib_pln transitive similarity truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of A similar B") (@param "Truth of B similar C")))\n (@return "Transitive similarity truth value"))\n (= (Truth_transitiveSimilarity (stv $As $Ac)\n (stv $Bs $Bc)\n (stv $Cs $Cc)\n (stv $ABs $ABc)\n (stv $BCs $BCc))\n (let* (($ConclS (TransitiveSimilarityStrength $As $Bs $Cs $ABs $BCs))\n ($ConclC (min $ABc $BCc)))\n (stv $ConclS $ConclC)))\n\n (: simpleDeductionStrength (-> Number Number Number Number Number Number))\n (@doc simpleDeductionStrength\n (@desc "PeTTa lib_pln simple deduction strength helper")\n (@params ((@param "Strength of A") (@param "Strength of B") (@param "Strength of C") (@param "Strength of A implies B") (@param "Strength of B implies C")))\n (@return "Deduction strength, or no result when consistency checks fail"))\n (= (simpleDeductionStrength $sA $sB $sC $sAB $sBC)\n (if (and (conditional-probability-consistency $sA $sB $sAB)\n (conditional-probability-consistency $sB $sC $sBC))\n (if (< 0.99 $sB)\n $sC\n (+ (* $sAB $sBC)\n (/safe (* (- 1.0 $sAB) (- $sC (* $sB $sBC))) (- 1.0 $sB))))\n (empty)))\n\n (: Truth_evaluationImplication (-> Expression Expression Expression Expression Expression Expression))\n (@doc Truth_evaluationImplication\n (@desc "PeTTa lib_pln evaluation implication truth function")\n (@params ((@param "Truth of A") (@param "Truth of B") (@param "Truth of C") (@param "Truth of A implies B") (@param "Truth of A implies C")))\n (@return "Evaluation implication truth value"))\n (= (Truth_evaluationImplication (stv $As $Ac)\n (stv $Bs $Bc)\n (stv $Cs $Cc)\n (stv $ABs $ABc)\n (stv $ACs $ACc))\n (let* (($ConclS (simpleDeductionStrength $Bs $As $Cs $ABs $ACs))\n ($ConclC (* (* 0.9 0.9)\n (min5 $Bc $Ac $Cc $ACc (* 0.9 $ABc)))))\n (stv $ConclS $ConclC)))\n\n ; ---------- Inference rules ----------\n (@doc |-\n (@desc "PeTTa lib_pln PLN inference rules")\n (@params ((@param "One or two PLN sentences written as ( )")))\n (@return "A derived sentence written as ( )"))\n\n ; Revision.\n (= (|- ($T $T1)\n ($T $T2))\n (let $TV (Truth_Revision $T1 $T2)\n ($T $TV)))\n\n ; Modus ponens.\n (= (|- ($A $T1)\n ((Implication $A $B) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ($B $TV)))\n\n ; Guards for link-specific rules. Missing guard facts intentionally leave the rule unreduced.\n (= (SymmetricModusPonensRuleGuard Similarity) True)\n (= (SymmetricModusPonensRuleGuard IntentionalSimilarity) True)\n (= (SymmetricModusPonensRuleGuard ExtensionalSimilarity) True)\n\n (= (|- ($A $TruthA)\n (($LinkType $A $B) $TruthAB))\n (if (SymmetricModusPonensRuleGuard $LinkType)\n (let $TV (Truth_SymmetricModusPonens $TruthA $TruthAB)\n ($B $TV))\n (empty)))\n\n (= (SyllogisticRuleGuard Inheritance) True)\n (= (SyllogisticRuleGuard Implication) True)\n\n (= (|- (($LinkType $A $B) $T1)\n (($LinkType $B $C) $T2))\n (if (SyllogisticRuleGuard $LinkType)\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Deduction $TruthA $TruthB $TruthC $T1 $T2)))\n (($LinkType $A $C) $TV))\n (empty)))\n\n (= (|- (($LinkType $C $A) $T1)\n (($LinkType $C $B) $T2))\n (if (SyllogisticRuleGuard $LinkType)\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Induction $TruthA $TruthB $TruthC $T1 $T2)))\n (($LinkType $A $B) $TV))\n (empty)))\n\n (= (|- (($LinkType $A $C) $T1)\n (($LinkType $B $C) $T2))\n (if (SyllogisticRuleGuard $LinkType)\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Abduction $TruthA $TruthB $TruthC $T1 $T2)))\n (($LinkType $A $B) $TV))\n (empty)))\n\n ; Usage of inheritance for predicates.\n (= (|- ((Evaluation (Predicate $x)\n (List (Concept $C))) $T1)\n ((Inheritance (Concept $S) (Concept $C)) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ((Evaluation (Predicate $x)\n (List (Concept $S)))\n $TV)))\n\n (= (|- ((Evaluation (Predicate $x)\n (List (Concept $C1) (Concept $C2))) $T1)\n ((Inheritance (Concept $S) (Concept $C1)) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ((Evaluation (Predicate $x)\n (List (Concept $S) (Concept $C2)))\n $TV)))\n\n (= (|- ((Evaluation (Predicate $x)\n (List (Concept $C1) (Concept $C2))) $T1)\n ((Inheritance (Concept $S) (Concept $C2)) $T2))\n (let $TV (Truth_ModusPonens $T1 $T2)\n ((Evaluation (Predicate $x)\n (List (Concept $C1) (Concept $S)))\n $TV)))\n\n (= (|- ((Not $A) $T))\n (let $TV (Truth_Negation $T)\n ($A $TV)))\n\n (= (|- ((Inheritance $A $B) $Truth))\n (let* (($TruthB (STV $B))\n ($TV (Truth_inversion $TruthB $Truth)))\n ((Inheritance $B $A) $TV)))\n\n (= (|- ((Implication $A $B) $Truth))\n (let* (($TruthB (STV $B))\n ($TV (Truth_inversion $TruthB $Truth)))\n ((Implication $B $A) $TV)))\n\n (= (|- ((Equivalence $A $B) $Truth))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TV (Truth_equivalenceToImplication $TruthA $TruthB $Truth)))\n ((Implication $A $B) $TV)))\n\n (= (|- ((Equivalence $A $B) $Truth))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TV (Truth_equivalenceToImplication $TruthA $TruthB $Truth)))\n ((Implication $B $A) $TV)))\n\n (= (|- ((Similarity $A $B) $T1)\n ((Similarity $B $C) $T2))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_transitiveSimilarity $TruthA $TruthB $TruthC $T1 $T2)))\n ((Similarity $A $C) $TV)))\n\n (= (|- ((Evaluation $A $B) $TruthAB)\n ((Implication $A $C) $TruthAC))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_evaluationImplication $TruthA $TruthB $TruthC $TruthAB $TruthAC)))\n ((Evaluation $C $B) $TV)))\n\n (= (|- ((Member $A $B) $T1)\n ((Inheritance $B $C) $T2))\n (let* (($TruthA (STV $A))\n ($TruthB (STV $B))\n ($TruthC (STV $C))\n ($TV (Truth_Deduction $TruthA $TruthB $TruthC $T1 $T2)))\n ((Member $A $C) $TV)))\n\n ; ---------- Derivation and query engine ----------\n (: PLN.Config.MaxSteps (-> Number))\n (@doc PLN.Config.MaxSteps\n (@desc "Default maximum number of derivation task selections")\n (@params ())\n (@return "100"))\n (= (PLN.Config.MaxSteps) 100)\n\n (: PLN.Config.TaskQueueSize (-> Number))\n (@doc PLN.Config.TaskQueueSize\n (@desc "Default active task queue bound")\n (@params ())\n (@return "10"))\n (= (PLN.Config.TaskQueueSize) 10)\n\n (: PLN.Config.BeliefQueueSize (-> Number))\n (@doc PLN.Config.BeliefQueueSize\n (@desc "Default belief buffer bound")\n (@params ())\n (@return "100"))\n (= (PLN.Config.BeliefQueueSize) 100)\n\n (: PLN.CollapseToList (-> Atom Expression))\n (@doc PLN.CollapseToList\n (@desc "Collect nondeterministic results as a plain expression list and remove Empty sentinels")\n (@params ((@param "Nondeterministic query to collapse")))\n (@return "A plain expression list of collapsed results"))\n (= (PLN.CollapseToList $query)\n (let $plain (collapse $query)\n (exclude-item Empty $plain)))\n\n (: StampDisjoint (-> Expression Expression Bool))\n (@doc StampDisjoint\n (@desc "True when two evidence stamps share no evidence item")\n (@params ((@param "First evidence stamp") (@param "Second evidence stamp")))\n (@return "Bool indicating whether the stamps are disjoint"))\n (= (StampDisjoint $Ev1 $Ev2)\n (== () (intersection-atom $Ev1 $Ev2)))\n\n (: StampConcat (-> Expression Expression Expression))\n (@doc StampConcat\n (@desc "Concatenate a stamp with new evidence and sort it")\n (@params ((@param "Base evidence stamp") (@param "Evidence stamp to add")))\n (@return "Sorted combined evidence stamp"))\n (= (StampConcat $stamp $addition)\n (if (== $addition ())\n $stamp\n (let $combined (TupleConcat $stamp $addition)\n (InsertionSort $combined ()))))\n\n (: BestCandidate (-> Atom %Undefined% Expression %Undefined%))\n (@doc BestCandidate\n (@desc "Return the candidate with the highest score under an evaluator function")\n (@params ((@param "Unary evaluator function") (@param "Current best candidate") (@param "Candidate list")))\n (@return "The best candidate, or the initial best candidate when the list is empty"))\n (= (BestCandidate $evaluateCandidateFunction $bestCandidate $tuple)\n (max-by-atom $evaluateCandidateFunction $bestCandidate $tuple))\n\n (: PriorityRank (-> Expression Number))\n (@doc PriorityRank\n (@desc "Task priority score: the confidence of a Sentence candidate")\n (@params ((@param "Sentence candidate or empty sentinel")))\n (@return "Priority score"))\n (= (PriorityRank (Sentence ($x (stv $f $c)) $Ev1)) $c)\n (= (PriorityRank ()) -99999.0)\n\n (: PriorityRankNeg (-> Expression Number))\n (@doc PriorityRankNeg\n (@desc "Negated task priority score, used to find the lowest-priority queue item")\n (@params ((@param "Sentence candidate or empty sentinel")))\n (@return "Negated priority score"))\n (= (PriorityRankNeg (Sentence ($x (stv $f $c)) $Ev1)) (- 0.0 $c))\n (= (PriorityRankNeg ()) -99999.0)\n\n (: LimitSize (-> Expression Number Expression))\n (@doc LimitSize\n (@desc "Limit a priority queue by removing the lowest-priority item when the accumulator reaches the size bound")\n (@params ((@param "Candidate list") (@param "Size bound")))\n (@return "Bounded candidate list"))\n (= (LimitSize $L $size)\n (top-k-by-atom PriorityRank $size $L))\n\n (: PLN.PairInference (-> Expression Expression Expression))\n (@doc PLN.PairInference\n (@desc "Apply binary inference rules in both premise orders")\n (@params ((@param "First judgement") (@param "Second judgement")))\n (@return "A derived judgement"))\n (= (PLN.PairInference $x $y) (|- $x $y))\n (= (PLN.PairInference $x $y) (|- $y $x))\n\n (: PLN.BinaryDerivation (-> Expression Expression Expression Expression))\n (@doc PLN.BinaryDerivation\n (@desc "Derive sentences from one selected task and one belief when their stamps are disjoint")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp") (@param "Belief sentence")))\n (@return "A derived Sentence, or no result"))\n (= (PLN.BinaryDerivation $x $Ev1 (Sentence $y $Ev2))\n (if (StampDisjoint $Ev1 $Ev2)\n (let $stamp (StampConcat $Ev1 $Ev2)\n (case (PLN.PairInference $x $y)\n ((($T $TV) (let $forcedTV $TV\n (Sentence ($T $forcedTV) $stamp))))))\n (empty)))\n\n (: PLN.UnaryDerivation (-> Expression Expression Expression))\n (@doc PLN.UnaryDerivation\n (@desc "Derive sentences from one selected task using unary inference rules")\n (@params ((@param "Selected task judgement") (@param "Selected task evidence stamp")))\n (@return "A derived Sentence, or no result"))\n (= (PLN.UnaryDerivation $x $Ev1)\n (case (|- $x)\n ((($T $TV) (let $forcedTV $TV\n (Sentence ($T $forcedTV) $Ev1))))))\n\n (@doc PLN.Derive\n (@desc "Priority-queue forward derivation over tasks and beliefs")\n (@params ((@param "Task list") (@param "Belief list") (@param "Optional step and queue bounds")))\n (@return "A pair (tasks beliefs) after bounded derivation"))\n (= (PLN.Derive $Tasks $Beliefs $steps $maxsteps $taskqueuesize $beliefqueuesize)\n (if (or (> $steps $maxsteps) (== $Tasks ()))\n ($Tasks $Beliefs)\n (let $selected (BestCandidate PriorityRank () $Tasks)\n (let (Sentence $x $Ev1) $selected\n (let $fromBeliefs (PLN.CollapseToList\n (let $belief (superpose $Beliefs)\n (PLN.BinaryDerivation $x $Ev1 $belief)))\n (let $fromTask (PLN.CollapseToList\n (PLN.UnaryDerivation $x $Ev1))\n (let $derivations (TupleConcat $fromBeliefs $fromTask)\n (let $_ (trace! (SELECTED $steps (Sentence $x $Ev1)) 42)\n (let $taskCandidates (TupleConcat $Tasks $derivations)\n (let $uniqueTasks (Unique $taskCandidates ())\n (let $withoutSelected (Without $uniqueTasks $selected)\n (let $newTasks (LimitSize $withoutSelected $taskqueuesize)\n (let $beliefCandidates (TupleConcat $Beliefs $derivations)\n (let $uniqueBeliefs (Unique $beliefCandidates ())\n (let $newBeliefs (LimitSize $uniqueBeliefs $beliefqueuesize)\n (PLN.Derive $newTasks\n $newBeliefs\n (+ $steps 1)\n $maxsteps\n $taskqueuesize\n $beliefqueuesize))))))))))))))))\n\n (= (PLN.Derive $Tasks $Beliefs $maxsteps $taskqueuesize $beliefqueuesize)\n (PLN.Derive $Tasks $Beliefs 1 $maxsteps $taskqueuesize $beliefqueuesize))\n\n (= (PLN.Derive $Tasks $Beliefs $maxsteps)\n (PLN.Derive $Tasks\n $Beliefs\n $maxsteps\n (PLN.Config.TaskQueueSize)\n (PLN.Config.BeliefQueueSize)))\n\n (= (PLN.Derive $Tasks $Beliefs)\n (PLN.Derive $Tasks $Beliefs (PLN.Config.MaxSteps)))\n\n (: ConfidenceRank (-> Expression Number))\n (@doc ConfidenceRank\n (@desc "Query-answer score: the confidence of a (truth evidence) pair")\n (@params ((@param "Query answer or empty sentinel")))\n (@return "Confidence score"))\n (= (ConfidenceRank ((stv $f $c) $Ev)) $c)\n (= (ConfidenceRank ()) 0)\n\n (: PLN.QueryCandidate (-> %Undefined% Expression Expression))\n (@doc PLN.QueryCandidate\n (@desc "Return a query answer when a belief Sentence has the requested term")\n (@params ((@param "Requested term") (@param "Belief sentence")))\n (@return "A (truth evidence) pair, or no result when the term differs"))\n (= (PLN.QueryCandidate $term (Sentence ($term $TV) $Ev))\n ($TV $Ev))\n (= (PLN.QueryCandidate $term $sentence)\n (empty))\n\n (@doc PLN.QueryCandidates\n (@desc "Collect all belief truth/evidence pairs whose term matches a query after bounded derivation")\n (@params ((@param "Task list") (@param "Belief list") (@param "Term") (@param "Step and queue bounds")))\n (@return "A plain expression list of query candidates"))\n (= (PLN.QueryCandidates $qcTasks $qcBeliefs $qcTerm $qcMaxSteps $qcTaskQueueSize $qcBeliefQueueSize)\n (let $TasksEval (PLN.Force $qcTasks)\n (let $BeliefsEval (PLN.Force $qcBeliefs)\n (let* (($maxstepsEval (+ 0 $qcMaxSteps))\n ($taskqueuesizeEval (+ 0 $qcTaskQueueSize))\n ($beliefqueuesizeEval (+ 0 $qcBeliefQueueSize)))\n (let ($TasksRet $BeliefsRet)\n (PLN.Derive $TasksEval $BeliefsEval 1 $maxstepsEval $taskqueuesizeEval $beliefqueuesizeEval)\n (PLN.CollapseToList\n (let $belief (superpose $BeliefsRet)\n (PLN.QueryCandidate $qcTerm $belief))))))))\n\n (@doc PLN.Query\n (@desc "Query a term against a PLN knowledge base after bounded forward derivation")\n (@params ((@param "Task list or knowledge base") (@param "Belief list or term") (@param "Term and optional bounds")))\n (@return "The highest-confidence answer as ((stv f c) evidence), or () when no belief matches"))\n (= (PLN.Query $ts $bs $term $m $t $b)\n (let* (($TasksClone (filter-atom $ts $taskItem True))\n ($BeliefsClone (filter-atom $bs $beliefItem True)))\n (BestCandidate ConfidenceRank ()\n (PLN.QueryCandidates $TasksClone\n $BeliefsClone\n $term\n $m\n $t\n $b))))\n\n (= (PLN.Query $k $term $m $t $b)\n (let $kbClone (filter-atom $k $kbItem True)\n (BestCandidate ConfidenceRank ()\n (PLN.QueryCandidates $kbClone\n $kbClone\n $term\n $m\n $t\n $b))))\n\n (= (PLN.Query $k $term $m)\n (PLN.Query $k $term $m (PLN.Config.TaskQueueSize) (PLN.Config.BeliefQueueSize)))\n\n (= (PLN.Query $k $term)\n (PLN.Query $k $term (PLN.Config.MaxSteps)))\n', }; diff --git a/packages/libraries/src/libraries.test.ts b/packages/libraries/src/libraries.test.ts index 27b9e26..c90e4e2 100644 --- a/packages/libraries/src/libraries.test.ts +++ b/packages/libraries/src/libraries.test.ts @@ -132,10 +132,10 @@ describe("combinatorics library", () => { !(choose2l (a b c)) !(collapse (chooseK (a b c) 2)) `); - expect(out[1]).toEqual(["(, 0 1 2 3)"]); - expect(out[2]).toEqual(["(,)"]); // empty range - expect(out[3]).toEqual(["(, (a b) (a c) (b c))"]); - expect(out[4]).toEqual(["(, (a b) (a c) (b c))"]); + expect(out[1]).toEqual(["(0 1 2 3)"]); + expect(out[2]).toEqual(["()"]); // empty range + expect(out[3]).toEqual(["((a b) (a c) (b c))"]); + expect(out[4]).toEqual(["((a b) (a c) (b c))"]); }); it("chooseKl covers k=0, k, and over-k; takeK truncates", () => { @@ -152,7 +152,7 @@ describe("combinatorics library", () => { expect(out[1]).toEqual(["(())"]); // one subset: the empty one expect(out[2]).toEqual(["((a b) (a c) (b c))"]); expect(out[3]).toEqual(["((a b c))"]); - expect(out[4]).toEqual(["(,)"]); // no 4-subset of a 3-list + expect(out[4]).toEqual(["()"]); // no 4-subset of a 3-list expect(out[5]).toEqual(["(a b)"]); expect(out[6]).toEqual(["(a b c)"]); // fewer than k expect(out[7]).toEqual(["()"]); @@ -210,7 +210,7 @@ describe("datastructures library", () => { `); expect(out[1]).toEqual(["()"]); // first insert succeeds expect(out[2]).toEqual([]); // duplicate is pruned - expect(out[3]).toEqual(['(, (s "(a b)"))']); // exactly one copy stored + expect(out[3]).toEqual(['((s "(a b)"))']); // exactly one copy stored }); }); @@ -225,8 +225,8 @@ describe("spaces library", () => { !(collapse (match &sto $t $t)) !(collapse (match &sfrom $f $f)) `); - expect(out[5]).toEqual(["(, (edge a b) (edge b c))"]); // edges moved to the target - expect(out[6]).toEqual(["(, (other z))"]); // non-matching atom stays in the source + expect(out[5]).toEqual(["((edge a b) (edge b c))"]); // edges moved to the target + expect(out[6]).toEqual(["((other z))"]); // non-matching atom stays in the source }); it("removes every atom from a space", () => { @@ -237,7 +237,7 @@ describe("spaces library", () => { !(remove-all-atoms &sr) !(collapse (match &sr $x $x)) `); - expect(out[4]).toEqual(["(,)"]); // the space is empty + expect(out[4]).toEqual(["()"]); // the space is empty }); }); diff --git a/packages/libraries/src/nars/nars.metta b/packages/libraries/src/nars/nars.metta index b33a02f..af70bd7 100644 --- a/packages/libraries/src/nars/nars.metta +++ b/packages/libraries/src/nars/nars.metta @@ -318,12 +318,11 @@ (: NARS.CollapseToList (-> Atom Expression)) (@doc NARS.CollapseToList - (@desc "Collect nondeterministic results and convert this engine's comma-headed collapse tuple into a plain expression list") + (@desc "Collect nondeterministic results as a plain expression list and remove Empty sentinels") (@params ((@param "Nondeterministic query to collapse"))) (@return "A plain expression list of the collapsed results")) (= (NARS.CollapseToList $query) - (let* (($collapsed (collapse $query)) - ($plain (cdr-atom $collapsed))) + (let $plain (collapse $query) (exclude-item Empty $plain))) (: StampDisjoint (-> Expression Expression Bool)) diff --git a/packages/libraries/src/pln/pln.metta b/packages/libraries/src/pln/pln.metta index 3034a89..34cf1ec 100644 --- a/packages/libraries/src/pln/pln.metta +++ b/packages/libraries/src/pln/pln.metta @@ -518,12 +518,11 @@ (: PLN.CollapseToList (-> Atom Expression)) (@doc PLN.CollapseToList - (@desc "Collect nondeterministic results and convert this engine's comma-headed collapse tuple into a plain expression list") + (@desc "Collect nondeterministic results as a plain expression list and remove Empty sentinels") (@params ((@param "Nondeterministic query to collapse"))) (@return "A plain expression list of collapsed results")) (= (PLN.CollapseToList $query) - (let* (($collapsed (collapse $query)) - ($plain (cdr-atom $collapsed))) + (let $plain (collapse $query) (exclude-item Empty $plain))) (: StampDisjoint (-> Expression Expression Bool)) diff --git a/packages/node/bench/LEATTA-NOTES.md b/packages/node/bench/LEATTA-NOTES.md index 66ceec1..9dcd8b7 100644 --- a/packages/node/bench/LEATTA-NOTES.md +++ b/packages/node/bench/LEATTA-NOTES.md @@ -7,15 +7,13 @@ SPDX-License-Identifier: MIT LeaTTa (`/home/user/Dev/LeaTTa`, the user's own Lean 4 formalization of MeTTa, version 1.0.6) is a total, machine-checked `MettaHyperonFull` semantics that passes Hyperon's own 270-assertion oracle. -We use its binary as the core differential oracle when settling evaluator behavior, for example -whether `superpose` evaluates its tuple argument as a cross-product and how empty collapsed bags are -represented. +We use its binary as a differential oracle when settling evaluator behavior. Current Hyperon remains +the authority for core operation semantics when the two runtimes disagree. -Priority order for this branch is LeaTTa first, LeaTTa source second, Hyperon Experimental and the -conformance corpus as regression evidence third, and PeTTa for compatibility and optimization ideas. -PeTTa is not a semantic authority. This file records the decisions we have checked against LeaTTa, the -open MeTTaScript gaps that still need alignment, and how LeaTTa's "Improvements over Hyperon" list maps -onto MeTTaScript. +Priority order for this branch is current Hyperon source and its conformance corpus first, then LeaTTa +as a checked differential model, and PeTTa for compatibility and optimization ideas. PeTTa is not a +semantic authority. This file records the decisions checked against LeaTTa, the open MeTTaScript gaps, +and how LeaTTa's "Improvements over Hyperon" list maps onto MeTTaScript. ## Running the binary @@ -38,10 +36,9 @@ reduces a MeTTaIL term. Two usage notes: - Results are wrapped in `[...]`; multiple nondeterministic results are comma-joined inside, e.g. `!(superpose (1 2 3))` prints `[1, 2, 3]`. -- A collapsed / tuple Expression is printed with a leading `,`: `!(collapse (match &self (foo $x) $x))` - prints `[(, 1 2 3 1)]`. MeTTaScript now uses the same visible comma-tuple convention for collapsed - nondeterministic bags. -- The empty collapsed bag prints as `(,)`. The unit atom still prints as `()`. +- Current Hyperon and MeTTaScript print a collapsed result as a plain expression: + `!(collapse (match &self (foo $x) $x))` prints `[(1 2 3 1)]`. +- An empty collapsed result prints as `()`. The same syntax is also the unit atom, as in Hyperon. ## Open semantic target: arity no-reduce diff --git a/packages/node/bench/TODO-parity.md b/packages/node/bench/TODO-parity.md index d4ebd35..3e78d71 100644 --- a/packages/node/bench/TODO-parity.md +++ b/packages/node/bench/TODO-parity.md @@ -112,8 +112,8 @@ no-barrier files. The Hyperon-valid workload is `matespacefast`. ## Corpus adaptation conventions - `assertEqual`/`assert*` return `()` on pass (PeTTa returns True). `assertEqualToResult`'s second argument - is the expected result set as an unevaluated comma tuple; collapse of one result `r` is `(, r)`. -- Bool literals `True`/`False`; collapse is a comma tuple; floats render full IEEE. + is the expected result set as an unevaluated expression; collapse of one result `r` is `(r)`. +- Bool literals use `True`/`False`; collapse is a plain expression; floats render full IEEE. - Math returns Float: pow/sqrt/log/min-atom/max-atom, and trunc/ceil/floor/round on float input. - `==` is `(-> $t $t Bool)`; Hyperon has no `!=`. - Keep MeTTaScript LeaTTa-correct; never bend the engine to a PeTTa-ism. diff --git a/packages/node/bench/corpus-mettats/case2.metta b/packages/node/bench/corpus-mettats/case2.metta index 84a225e..9e470fd 100644 --- a/packages/node/bench/corpus-mettats/case2.metta +++ b/packages/node/bench/corpus-mettats/case2.metta @@ -10,4 +10,4 @@ (($stmt (superpose (what what2)))))) !(test (collapse (compile wat)) - (, what what2)) + (what what2)) diff --git a/packages/node/bench/corpus-mettats/collapse.metta b/packages/node/bench/corpus-mettats/collapse.metta index 7c277a0..7641145 100644 --- a/packages/node/bench/corpus-mettats/collapse.metta +++ b/packages/node/bench/corpus-mettats/collapse.metta @@ -3,7 +3,7 @@ ; ; SPDX-License-Identifier: MIT ; -; Adapted from PeTTa examples/collapse.metta for MeTTa-TS (LeaTTa) conventions. +; Adapted from PeTTa examples/collapse.metta for MeTTa-TS (Hyperon) conventions. !(test (collapse (1 2 3)) - (, (1 2 3))) + ((1 2 3))) diff --git a/packages/node/bench/corpus-mettats/cut.metta b/packages/node/bench/corpus-mettats/cut.metta index 968b1ad..e252eff 100644 --- a/packages/node/bench/corpus-mettats/cut.metta +++ b/packages/node/bench/corpus-mettats/cut.metta @@ -17,4 +17,4 @@ !(let $x (match-single &self (foo $1) $1) (add-atom &self (bar $x))) !(test (collapse (match &self (bar $1) (bar $1))) - (, (bar 1))) + ((bar 1))) diff --git a/packages/node/bench/corpus-mettats/empty.metta b/packages/node/bench/corpus-mettats/empty.metta index ae3cdbf..100d047 100644 --- a/packages/node/bench/corpus-mettats/empty.metta +++ b/packages/node/bench/corpus-mettats/empty.metta @@ -8,4 +8,4 @@ (= (y) (empty)) !(test (collapse (y)) - (,)) + ()) diff --git a/packages/node/bench/corpus-mettats/he_assert.metta b/packages/node/bench/corpus-mettats/he_assert.metta index 4b966d2..c4703c4 100644 --- a/packages/node/bench/corpus-mettats/he_assert.metta +++ b/packages/node/bench/corpus-mettats/he_assert.metta @@ -3,7 +3,7 @@ ; ; SPDX-License-Identifier: MIT ; -; Adapted from PeTTa examples/he_assert.metta for MeTTa-TS (LeaTTa) conventions. +; Adapted from PeTTa examples/he_assert.metta for MeTTa-TS (Hyperon) conventions. ; In Hyperon an `assert*` returns the unit atom `()` on success (PeTTa returns True), so the expected ; value of the wrapping `test` is `()`. A failing assert returns an `(Error ...)`, which the test catches. @@ -12,7 +12,7 @@ !(test (assertAlphaEqual (quote (+ $x $y)) (quote (+ $a $b))) ()) ; assertEqualToResult's second argument is the expected result set, not a bare value, and it -; is not evaluated. Collapse of a single result `r` is the comma tuple `(, r)`. -!(test (assertEqualToResult (+ 1 2) (, 3)) ()) +; is not evaluated. Collapse of a single result `r` is the expression `(r)`. +!(test (assertEqualToResult (+ 1 2) (3)) ()) (= (adder) ($x)) -!(test (assertAlphaEqualToResult (adder) (, ($y))) ()) +!(test (assertAlphaEqualToResult (adder) (($y))) ()) diff --git a/packages/node/bench/corpus-mettats/hyperpose_primes.metta b/packages/node/bench/corpus-mettats/hyperpose_primes.metta index fd9e03a..f10287b 100644 --- a/packages/node/bench/corpus-mettats/hyperpose_primes.metta +++ b/packages/node/bench/corpus-mettats/hyperpose_primes.metta @@ -18,14 +18,14 @@ ; hyperpose should work with a list passed through a variable !(test (collapse (let $xs (3 1 2) (hyperpose $xs))) - (, 3 1 2)) + (3 1 2)) ;multi-threaded concurrency running each option till the bitter end: !(test (collapse (hyperpose ((prime? 5353725700019) ;cheap (prime? 5378181100003) ;cheap (prime? 5421844300001) ;cheap (prime? 5473443100001)))) ;cheap => cheap overall - (, True True True True)) + (True True True True)) ;multi-threaded concurrency running only until the first one succeeds: !(test (once (hyperpose ((prime? 535372570000000063) ;expensive diff --git a/packages/node/bench/corpus-mettats/ifcasenondet.metta b/packages/node/bench/corpus-mettats/ifcasenondet.metta index e3c273b..72a082f 100644 --- a/packages/node/bench/corpus-mettats/ifcasenondet.metta +++ b/packages/node/bench/corpus-mettats/ifcasenondet.metta @@ -13,6 +13,6 @@ ((True a) (False b)))) -!(test (collapse (if-nondet (True False True))) (, a b a)) +!(test (collapse (if-nondet (True False True))) (a b a)) -!(test (collapse (case-nondet (True False True))) (, a b a)) +!(test (collapse (case-nondet (True False True))) (a b a)) diff --git a/packages/node/bench/corpus-mettats/let_superpose_if_case.metta b/packages/node/bench/corpus-mettats/let_superpose_if_case.metta index 96438ee..f8c2ca4 100644 --- a/packages/node/bench/corpus-mettats/let_superpose_if_case.metta +++ b/packages/node/bench/corpus-mettats/let_superpose_if_case.metta @@ -16,4 +16,4 @@ answertoeverything))) !(test (collapse (progme)) - (, answertoeverything 42 (42 42) (42 42 42))) + (answertoeverything 42 (42 42) (42 42 42))) diff --git a/packages/node/bench/corpus-mettats/logicprog.metta b/packages/node/bench/corpus-mettats/logicprog.metta index dace9fa..1cd1171 100644 --- a/packages/node/bench/corpus-mettats/logicprog.metta +++ b/packages/node/bench/corpus-mettats/logicprog.metta @@ -24,4 +24,4 @@ ; (later-in-alphabet $Z $Y))) !(test (collapse ((later-in-alphabet d $1) $1)) - (, (True c) (True b) (True a))) + ((True c) (True b) (True a))) diff --git a/packages/node/bench/corpus-mettats/matchnested.metta b/packages/node/bench/corpus-mettats/matchnested.metta index c80100a..bf8de5d 100644 --- a/packages/node/bench/corpus-mettats/matchnested.metta +++ b/packages/node/bench/corpus-mettats/matchnested.metta @@ -19,5 +19,5 @@ (remove-atom &self (friend $2 $3)))))) !(test (collapse (match &self (transitive $1 $2 $3) (transitive $1 $2 $3))) - (, (transitive tim tom tam) (transitive sim som sam))) + ((transitive tim tom tam) (transitive sim som sam))) diff --git a/packages/node/bench/corpus-mettats/matchnested2.metta b/packages/node/bench/corpus-mettats/matchnested2.metta index 7d112e4..a0bf68d 100644 --- a/packages/node/bench/corpus-mettats/matchnested2.metta +++ b/packages/node/bench/corpus-mettats/matchnested2.metta @@ -18,5 +18,5 @@ (remove-atom &self (friend $2 $3))))) !(test (collapse (match &self (transitive $1 $2 $3) (transitive $1 $2 $3))) - (, (transitive tim tom tam) (transitive sim som sam))) + ((transitive tim tom tam) (transitive sim som sam))) diff --git a/packages/node/bench/corpus-mettats/matchsingle.metta b/packages/node/bench/corpus-mettats/matchsingle.metta index fdaffeb..a40d220 100644 --- a/packages/node/bench/corpus-mettats/matchsingle.metta +++ b/packages/node/bench/corpus-mettats/matchsingle.metta @@ -13,4 +13,4 @@ (= (match-single-via-once $space $pattern $outPattern) (once (match $space $pattern $outPattern))) -!(test (collapse (match-single-via-once &self (a $x) (a $x))) (, (a b))) +!(test (collapse (match-single-via-once &self (a $x) (a $x))) ((a b))) diff --git a/packages/node/bench/corpus-mettats/matespace.metta b/packages/node/bench/corpus-mettats/matespace.metta index 233aed4..d02f9a4 100644 --- a/packages/node/bench/corpus-mettats/matespace.metta +++ b/packages/node/bench/corpus-mettats/matespace.metta @@ -6,7 +6,7 @@ ; Adapted from PeTTa examples/matespace.metta for MeTTa-TS (Hyperon) conventions. (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) diff --git a/packages/node/bench/corpus-mettats/matespace2.metta b/packages/node/bench/corpus-mettats/matespace2.metta index d83fd69..1889a06 100644 --- a/packages/node/bench/corpus-mettats/matespace2.metta +++ b/packages/node/bench/corpus-mettats/matespace2.metta @@ -6,18 +6,18 @@ ; Adapted from PeTTa examples/matespace2.metta for MeTTa-TS (Hyperon) conventions. (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) ;Rewrite rules: (= (expand) - (case (superpose (cdr-atom (collapse (match &self (num $t) $t)))) + (case (superpose (collapse (match &self (num $t) $t))) (($t ((add-atom-no-duplicate &self (num (M $t))) (add-atom-no-duplicate &self (num (W $t)))))))) (= (mate) - (case (superpose (cdr-atom (collapse (match &self (num (M $t)) $t)))) + (case (superpose (collapse (match &self (num (M $t)) $t))) (($t (case (once (match &self (num (W $t)) $t)) (($t (add-atom-no-duplicate &self (num (C $t)))))))))) diff --git a/packages/node/bench/corpus-mettats/metta4_streams.metta b/packages/node/bench/corpus-mettats/metta4_streams.metta index b0ac505..39525f5 100644 --- a/packages/node/bench/corpus-mettats/metta4_streams.metta +++ b/packages/node/bench/corpus-mettats/metta4_streams.metta @@ -21,10 +21,10 @@ (add-atom &s2 (num $x))) !(test (collapse (get-atoms &s1)) - (, (num 1) (num 2) (num 3) (num 4))) + ((num 1) (num 2) (num 3) (num 4))) !(test (collapse (get-atoms &s2)) - (, (num 1))) + ((num 1))) (= (gen) 1) (= (gen) 2) diff --git a/packages/node/bench/corpus-mettats/mettaset.metta b/packages/node/bench/corpus-mettats/mettaset.metta index 2b3d75d..1498252 100644 --- a/packages/node/bench/corpus-mettats/mettaset.metta +++ b/packages/node/bench/corpus-mettats/mettaset.metta @@ -11,4 +11,4 @@ (add-atom &self $x)) !(test (collapse (match &self (set $x $y) (set $x $y))) - (, (set 1 a) (set 1 b) (set 1 c) (set 2 d) (set 2 e) (set 2 f) (set 3 a) (set 3 b))) + ((set 1 a) (set 1 b) (set 1 c) (set 2 d) (set 2 e) (set 2 f) (set 3 a) (set 3 b))) diff --git a/packages/node/bench/corpus-mettats/multicall.metta b/packages/node/bench/corpus-mettats/multicall.metta index 73957cf..0788b6e 100644 --- a/packages/node/bench/corpus-mettats/multicall.metta +++ b/packages/node/bench/corpus-mettats/multicall.metta @@ -12,4 +12,4 @@ (- $x $y)) !(test (collapse (mycalc 1 2)) - (, 3 -1)) + (3 -1)) diff --git a/packages/node/bench/corpus-mettats/mutex_and_transaction.metta b/packages/node/bench/corpus-mettats/mutex_and_transaction.metta index 585e7cd..29dee9a 100644 --- a/packages/node/bench/corpus-mettats/mutex_and_transaction.metta +++ b/packages/node/bench/corpus-mettats/mutex_and_transaction.metta @@ -43,8 +43,8 @@ ;while this is fine as all places modifying the (cnt $n) relation simultaneously (mutexinc only in this case) use the same mutex: !(hyperpose ((mutexinc) (mutexinc) (mutexinc) (mutexinc) (mutexinc))) -!(test (collapse (get-atoms &temp)) (, (cnt 42))) +!(test (collapse (get-atoms &temp)) ((cnt 42))) ;This won't affect the cnt since the transaction is setup to fail: !(Transaction_rollback_fail_to_inc) -!(test (collapse (get-atoms &temp)) (, (cnt 42))) +!(test (collapse (get-atoms &temp)) ((cnt 42))) diff --git a/packages/node/bench/corpus-mettats/once.metta b/packages/node/bench/corpus-mettats/once.metta index 67a4550..8a64eee 100644 --- a/packages/node/bench/corpus-mettats/once.metta +++ b/packages/node/bench/corpus-mettats/once.metta @@ -14,4 +14,4 @@ !(let $x (match-single &self (foo $1) $1) (add-atom &self (bar $x))) !(test (collapse (match &self (bar $1) (bar $1))) - (, (bar 1))) + ((bar 1))) diff --git a/packages/node/bench/corpus-mettats/patrick_test.metta b/packages/node/bench/corpus-mettats/patrick_test.metta index dd77b61..1b027a6 100644 --- a/packages/node/bench/corpus-mettats/patrick_test.metta +++ b/packages/node/bench/corpus-mettats/patrick_test.metta @@ -14,7 +14,7 @@ !(test (collapse (for $x (1 2 3 4 5 6) (if (> $x 3) $x))) - (, 4 5 6)) + (4 5 6)) !(test (iterate 0 10 1 (|-> ($i $x) diff --git a/packages/node/bench/corpus-mettats/peano.metta b/packages/node/bench/corpus-mettats/peano.metta index 951a436..052e2b2 100644 --- a/packages/node/bench/corpus-mettats/peano.metta +++ b/packages/node/bench/corpus-mettats/peano.metta @@ -6,7 +6,7 @@ ; Adapted from PeTTa examples/peano.metta for MeTTa-TS (Hyperon) conventions. (= (add-atom-no-duplicate $Space $Atom) - (if (== (,) (collapse (once (match $Space $Atom $Atom)))) + (if (== () (collapse (once (match $Space $Atom $Atom)))) (add-atom $Space $Atom) (empty))) diff --git a/packages/node/bench/corpus-mettats/recursive_types.metta b/packages/node/bench/corpus-mettats/recursive_types.metta index ec86a5f..6ade293 100644 --- a/packages/node/bench/corpus-mettats/recursive_types.metta +++ b/packages/node/bench/corpus-mettats/recursive_types.metta @@ -11,6 +11,6 @@ (: gold Metal) !(test (get-type iron) Metal) -!(test (collapse (get-type blacksmith)) (, (-> Metal Sword) (-> Metal Paperclip))) -!(test (collapse (get-type (blacksmith iron))) (, Sword Paperclip)) -!(test (collapse (get-type (iron blacksmith))) (, (Metal (-> Metal Sword)) (Metal (-> Metal Paperclip)))) +!(test (collapse (get-type blacksmith)) ((-> Metal Sword) (-> Metal Paperclip))) +!(test (collapse (get-type (blacksmith iron))) (Sword Paperclip)) +!(test (collapse (get-type (iron blacksmith))) ((Metal (-> Metal Sword)) (Metal (-> Metal Paperclip)))) diff --git a/packages/node/bench/corpus-mettats/spacefunction.metta b/packages/node/bench/corpus-mettats/spacefunction.metta index b36c70b..6b7cae9 100644 --- a/packages/node/bench/corpus-mettats/spacefunction.metta +++ b/packages/node/bench/corpus-mettats/spacefunction.metta @@ -13,4 +13,4 @@ !(add-atom &self (my test)) !(remove-atom &self (my test)) -!(test (collapse (match &self (my test) (my test))) (,)) +!(test (collapse (match &self (my test) (my test))) ()) diff --git a/packages/node/bench/corpus-mettats/spaces.metta b/packages/node/bench/corpus-mettats/spaces.metta index 904042a..eb1d2d2 100644 --- a/packages/node/bench/corpus-mettats/spaces.metta +++ b/packages/node/bench/corpus-mettats/spaces.metta @@ -11,4 +11,4 @@ (match &self (foo $1) (bar $1)))) !(test (collapse (matchtrickery)) - (, (bar a) (bar b))) + ((bar a) (bar b))) diff --git a/packages/node/bench/corpus-mettats/spaces2.metta b/packages/node/bench/corpus-mettats/spaces2.metta index 874709e..35f7838 100644 --- a/packages/node/bench/corpus-mettats/spaces2.metta +++ b/packages/node/bench/corpus-mettats/spaces2.metta @@ -17,9 +17,9 @@ ; `(superpose (E1 E2 E3))` evaluates its tuple as a CROSS-PRODUCT of the elements' results (Hyperon ; semantics, verified against the LeaTTa binary), so a tuple element that yields NOTHING, here the -; `(bar $1)` match, since no `bar` atom exists, makes the whole product empty. `collapse` represents the -; empty result bag as `(,)`. PeTTa instead unions the three matches. +; `(bar $1)` match, since no `bar` atom exists, makes the whole product empty. PeTTa instead unions the +; three matches. !(test (space (msort (collapse (superpose ((match &self (foo $1) (foo $1)) (match &self (foo $1 $2) (foo $1 $2)) (match &self (bar $1) (bar $1)))))) (answer)) - (space (,) 42)) + (space () 42)) diff --git a/packages/node/bench/corpus-mettats/spaces3.metta b/packages/node/bench/corpus-mettats/spaces3.metta index 06b7095..5dfd880 100644 --- a/packages/node/bench/corpus-mettats/spaces3.metta +++ b/packages/node/bench/corpus-mettats/spaces3.metta @@ -8,8 +8,8 @@ !(add-atom &wuspace (wu)) !(add-atom &wuspace (wu 42)) -!(test (collapse (match &wuspace ($1) ($1))) (, (wu))) -!(test (collapse (match &wuspace ($1) (hu $1))) (, (hu wu))) -!(test (collapse (match &wuspace ($1) $1)) (, wu)) +!(test (collapse (match &wuspace ($1) ($1))) ((wu))) +!(test (collapse (match &wuspace ($1) (hu $1))) ((hu wu))) +!(test (collapse (match &wuspace ($1) $1)) (wu)) !(test (msort (collapse (match &wuspace $1 $1))) (msort (collapse (get-atoms &wuspace)))) -!(test (msort (collapse (match &wuspace $1 (wu $1)))) (, (wu (wu)) (wu (wu 42)))) +!(test (msort (collapse (match &wuspace $1 (wu $1)))) ((wu (wu)) (wu (wu 42)))) diff --git a/packages/node/bench/corpus-mettats/spaces_removeallatoms.metta b/packages/node/bench/corpus-mettats/spaces_removeallatoms.metta index 92ce0a1..7508d20 100644 --- a/packages/node/bench/corpus-mettats/spaces_removeallatoms.metta +++ b/packages/node/bench/corpus-mettats/spaces_removeallatoms.metta @@ -20,4 +20,4 @@ "(f 42)") !(test (collapse (get-atoms &self)) - (,)) + ()) diff --git a/packages/node/bench/corpus-mettats/streamops.metta b/packages/node/bench/corpus-mettats/streamops.metta index 8607789..c64af30 100644 --- a/packages/node/bench/corpus-mettats/streamops.metta +++ b/packages/node/bench/corpus-mettats/streamops.metta @@ -5,10 +5,10 @@ ; ; Adapted from PeTTa examples/streamops.metta for MeTTa-TS (Hyperon) conventions. -!(test (collapse (unique (superpose (a b c d d)))) (, a b c d)) +!(test (collapse (unique (superpose (a b c d d)))) (a b c d)) -!(test (collapse (union (superpose (a b b c)) (superpose (b c c d)))) (, a b b c b c c d)) +!(test (collapse (union (superpose (a b b c)) (superpose (b c c d)))) (a b b c b c c d)) -!(test (collapse (intersection (superpose (a b c c)) (superpose (b c c c d)))) (, b c c)) +!(test (collapse (intersection (superpose (a b c c)) (superpose (b c c c d)))) (b c c)) -!(test (collapse (subtraction (superpose (a b b c)) (superpose (b c c d)))) (, a b)) +!(test (collapse (subtraction (superpose (a b b c)) (superpose (b c c d)))) (a b)) diff --git a/packages/node/bench/corpus-mettats/supercollapse.metta b/packages/node/bench/corpus-mettats/supercollapse.metta index de642ee..f839a56 100644 --- a/packages/node/bench/corpus-mettats/supercollapse.metta +++ b/packages/node/bench/corpus-mettats/supercollapse.metta @@ -12,8 +12,7 @@ (TupleConcat ($K) (range (+ $K 1) $N)) ())) -; PeTTa's TupleConcat relies on a nested superpose treating an empty branch as identity, so the recursion -; accumulates 1..9. In Hyperon semantics a tuple element that is itself empty (the base case's -; (superpose ()) ) makes the whole cross-product empty, and that emptiness propagates back up. `collapse` -; represents that empty result bag as `(,)`. -!(test (range 1 10) (,)) +; PeTTa's TupleConcat treats an empty branch as identity, so the recursion accumulates 1..9. +; MeTTaScript evaluates a well-typed computed `superpose` argument before splitting it. The empty base +; case therefore empties the cross-product and propagates back through this program. +!(test (range 1 10) ()) diff --git a/packages/node/bench/corpus-mettats/superpose_nested.metta b/packages/node/bench/corpus-mettats/superpose_nested.metta index 6b35175..72c88a3 100644 --- a/packages/node/bench/corpus-mettats/superpose_nested.metta +++ b/packages/node/bench/corpus-mettats/superpose_nested.metta @@ -16,7 +16,7 @@ ; yields a×x, a×y, … not the union a b c x y z. This is the Hyperon semantics, verified byte-for-byte ; against the LeaTTa reference binary; PeTTa instead flattens nested superposes into a union. !(test (progme) - ((, a x a y a z b x b y b z c x c y c z) - (, a b c) - (, a b c) - (, a x y z b x y z c x y z))) + ((a x a y a z b x b y b z c x c y c z) + (a b c) + (a b c) + (a x y z b x y z c x y z))) diff --git a/packages/node/bench/corpus-mettats/tests.metta b/packages/node/bench/corpus-mettats/tests.metta index 3c04a06..6710702 100644 --- a/packages/node/bench/corpus-mettats/tests.metta +++ b/packages/node/bench/corpus-mettats/tests.metta @@ -14,4 +14,4 @@ (= (program4) (collapse ((program1 42) (program2 42) (program3 2)))) !(test (program4) - (, ((, 12 46) 1 (42 43)) ((, 12 46) 2 (42 43)) ((, 12 46) 3 (42 43)))) + (((12 46) 1 (42 43)) ((12 46) 2 (42 43)) ((12 46) 3 (42 43)))) diff --git a/packages/node/bench/corpus-mettats/types.metta b/packages/node/bench/corpus-mettats/types.metta index 7079d75..e71963b 100644 --- a/packages/node/bench/corpus-mettats/types.metta +++ b/packages/node/bench/corpus-mettats/types.metta @@ -25,7 +25,7 @@ !(test (get-type 42) Number) !(test (get-type "42") String) -!(test (collapse (get-type x)) (, Letter Buchstabe)) +!(test (collapse (get-type x)) (Letter Buchstabe)) ;Function Types @@ -48,4 +48,3 @@ (= (testf at) t) !(test (testf at) t) - diff --git a/packages/node/bench/lib/lib_datastructures.metta b/packages/node/bench/lib/lib_datastructures.metta index 9e3a7f1..aed5dbc 100644 --- a/packages/node/bench/lib/lib_datastructures.metta +++ b/packages/node/bench/lib/lib_datastructures.metta @@ -26,6 +26,6 @@ ;Fast Hashmap-like existence check via repra: (= (add-unique-or-fail $space $Expression) (let $st (s (repra $Expression)) - (if (== (,) (collapse (once (match $space $st True)))) + (if (== () (collapse (once (match $space $st True)))) (add-atom $space $st) (empty)))) diff --git a/packages/node/bench/scale-proof.mjs b/packages/node/bench/scale-proof.mjs index b934d63..9837d59 100644 --- a/packages/node/bench/scale-proof.mjs +++ b/packages/node/bench/scale-proof.mjs @@ -53,9 +53,8 @@ function runCorpusCase(file, expected, limitMs) { function bagPayload(out, name) { const results = out.at(-1)?.results ?? []; const bag = results.length === 1 ? results[0] : undefined; - if (bag?.kind !== "expr" || bag.items[0]?.kind !== "sym" || bag.items[0].name !== ",") - throw new Error(`${name}: expected one collapsed result bag`); - return bag.items.slice(1); + if (bag?.kind !== "expr") throw new Error(`${name}: expected one collapsed result expression`); + return bag.items; } function runBagCountCase(name, src, expectedCount, limitMs) { @@ -174,17 +173,17 @@ const staticSpace = facts(SIZE, (i) => `(edge ${i} ${i + 1})`) + `!(collapse (match &self (edge ${mid} $y) $y))\n` + `!(collapse (match &self (edge $x ${mid}) $x))`; -runCase("static arg-index", staticSpace, [`(, ${mid - 1})`], 8_000); +runCase("static arg-index", staticSpace, [`(${mid - 1})`], 8_000); const nestedStaticSpace = facts(SIZE, (i) => `(nested-static (${i === mid ? "M" : "W"} ${i}))`) + `!(collapse (match &self (nested-static (M $x)) $x))`; -runCase("static nested-head-index", nestedStaticSpace, [`(, ${mid})`], 8_000); +runCase("static nested-head-index", nestedStaticSpace, [`(${mid})`], 8_000); const runtimeSpace = facts(SIZE, (i) => `!(add-atom &self (rt ${i} ${i + 1}))`) + `!(collapse (match &self (rt ${mid} $y) $y))`; -runCase("runtime arg-index", runtimeSpace, [`(, ${mid + 1})`], 12_000); +runCase("runtime arg-index", runtimeSpace, [`(${mid + 1})`], 12_000); // The result is consumed, so this measures nested-head candidate selection rather than dead-result removal. const nestedRuntimeSpace = @@ -201,7 +200,7 @@ const namedSpace = `!(bind! &s (new-space))\n` + facts(SIZE, (i) => `!(add-atom &s (seen ${i}))`) + `!(collapse (match &s (seen ${mid}) ok))`; -runCase("named exact-space", namedSpace, ["(, ok)"], 12_000); +runCase("named exact-space", namedSpace, ["(ok)"], 12_000); const tri = Math.min(180, Math.max(60, Math.floor(SIZE / 200))); const triangles = @@ -212,8 +211,8 @@ runCase("conjunctive count", triangles, [String(tri * 3)], 8_000); const staticRemoval = facts(SIZE, (i) => `(gone ${i} ${i + 1})`) + `!(remove-atom &self (gone ${mid} ${mid + 1}))\n` + - `!(test (collapse (match &self (gone ${mid} $y) $y)) (,))\n` + - `!(test (collapse (match &self (gone ${mid - 1} $y) $y)) (, ${mid}))`; + `!(test (collapse (match &self (gone ${mid} $y) $y)) ())\n` + + `!(test (collapse (match &self (gone ${mid - 1} $y) $y)) (${mid}))`; runCase("static removal-index", staticRemoval, ["()"], 8_000); const runtimeRemoval = @@ -222,7 +221,7 @@ const runtimeRemoval = `!(remove-atom &self (= (dyn) old))\n` + `!(test (dyn) (dyn))\n` + `!(collapse (match &self (keep ${mid} $y) $y))`; -runCase("runtime removal-index", runtimeRemoval, [`(, ${mid + 1})`], 15_000); +runCase("runtime removal-index", runtimeRemoval, [`(${mid + 1})`], 15_000); // List-op scaling: `size-atom`, `map-atom`, `filter-atom`, `foldl-atom` over an N-element literal list must stay O(N). // Before the grounded `size-atom` short-circuit and grounded `map-atom`/`filter-atom`/`foldl-atom`, these were diff --git a/packages/node/package.json b/packages/node/package.json index d7d2338..b9f29ad 100644 --- a/packages/node/package.json +++ b/packages/node/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/node", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", @@ -30,6 +30,7 @@ "dependencies": { "@mettascript/core": "workspace:*", "@mettascript/debug": "workspace:*", + "@mettascript/fuzz": "workspace:*", "@mettascript/libraries": "workspace:*", "@mettascript/prolog": "workspace:*", "@mettascript/py": "workspace:*" diff --git a/packages/node/src/fuzz-corpus.ts b/packages/node/src/fuzz-corpus.ts new file mode 100644 index 0000000..3f64a95 --- /dev/null +++ b/packages/node/src/fuzz-corpus.ts @@ -0,0 +1,123 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// The filesystem half of the regression corpus. `@mettascript/fuzz` decides what an entry is and how a +// value is encoded; this decides where entries live and how they are written. +// +// One file per counterexample, named for the digest of its own text. Content addressing is what makes +// the two hard parts easy: recording a counterexample that is already stored writes the name that is +// already there, so deduplication is structural rather than a comparison pass, and a write is a create +// that never has to consider replacing another entry. New files land through a temporary name in the +// same directory followed by a rename, so a reader never sees a half-written entry. +// +// A file that cannot be read is an error, never a skip. Silently ignoring a corrupt entry would drop a +// known failure from the run while still reporting the run as complete. + +import { createHash } from "node:crypto"; +import { + existsSync, + mkdirSync, + readFileSync, + readdirSync, + renameSync, + writeFileSync, +} from "node:fs"; +import { join } from "node:path"; +import { + corpusRegressionFact, + parseCorpusEntries, + renderCorpusEntry, + type FuzzCorpusEntry, +} from "@mettascript/fuzz"; +import type { TopAtom } from "@mettascript/core"; + +const ENTRY_SUFFIX = ".metta"; +/** Enough digest to make a collision irrelevant while keeping the name readable. */ +const DIGEST_LENGTH = 16; +const LABEL_LENGTH = 32; + +export interface CorpusLoad { + /** Declarations to put in front of a run, one per stored counterexample. */ + readonly facts: readonly TopAtom[]; + readonly count: number; +} + +export type CorpusReadResult = + | { readonly ok: true; readonly load: CorpusLoad } + | { readonly ok: false; readonly reason: string }; + +/** What recording an entry did, or why it could not be recorded. */ +export type CorpusWriteResult = + | { readonly ok: true; readonly recorded: boolean; readonly path: string } + | { readonly ok: false; readonly reason: string }; + +function digestOf(text: string): string { + return createHash("sha256").update(text).digest("hex").slice(0, DIGEST_LENGTH); +} + +// The property id leads the name so a directory can be read at a glance. It is a MeTTa symbol and may +// hold anything, so only characters that are safe in a filename on every platform survive; the digest +// carries identity, and a name that sanitizes away to nothing is just the digest. +function entryName(property: string, text: string): string { + const label = property.replace(/[^A-Za-z0-9_.-]/g, "-").slice(0, LABEL_LENGTH); + const prefix = /[A-Za-z0-9]/.test(label) ? `${label}-` : ""; + return `${prefix}${digestOf(text)}${ENTRY_SUFFIX}`; +} + +/** + * Every entry in a corpus directory, as declarations. A directory that does not exist is an empty + * corpus, which is the ordinary first run. + */ +export function readCorpus(dir: string): CorpusReadResult { + if (!existsSync(dir)) return { ok: true, load: { facts: [], count: 0 } }; + + let names: string[]; + try { + names = readdirSync(dir).filter((name) => name.endsWith(ENTRY_SUFFIX)); + } catch (error) { + return { ok: false, reason: `cannot read corpus ${dir}: ${messageOf(error)}` }; + } + names.sort(); + + const facts: TopAtom[] = []; + for (const name of names) { + const path = join(dir, name); + let text: string; + try { + text = readFileSync(path, "utf8"); + } catch (error) { + return { ok: false, reason: `cannot read ${path}: ${messageOf(error)}` }; + } + const parsed = parseCorpusEntries(text); + if (!parsed.ok) return { ok: false, reason: `${path}: ${parsed.reason}` }; + for (const entry of parsed.value) + facts.push({ atom: corpusRegressionFact(entry), bang: false }); + } + return { ok: true, load: { facts, count: facts.length } }; +} + +/** Store one counterexample. An entry already present is left alone and reported as not recorded. */ +export function recordCorpusEntry(dir: string, entry: FuzzCorpusEntry): CorpusWriteResult { + const rendered = renderCorpusEntry(entry); + if (!rendered.ok) return { ok: false, reason: rendered.reason }; + + const path = join(dir, entryName(entry.property, rendered.value)); + if (existsSync(path)) return { ok: true, recorded: false, path }; + + // The temporary name is unique per attempt so two runs recording at once cannot land on the same + // partial file, and it sits in the destination directory so the rename stays within one filesystem. + const temporary = `${path}.${process.pid}-${digestOf(`${path}${rendered.value}`)}.tmp`; + try { + mkdirSync(dir, { recursive: true }); + writeFileSync(temporary, rendered.value, { encoding: "utf8", flag: "wx" }); + renameSync(temporary, path); + } catch (error) { + return { ok: false, reason: `cannot record into ${dir}: ${messageOf(error)}` }; + } + return { ok: true, recorded: true, path }; +} + +function messageOf(error: unknown): string { + return error instanceof Error ? error.message : String(error); +} diff --git a/packages/node/src/fuzz-main.test.ts b/packages/node/src/fuzz-main.test.ts new file mode 100644 index 0000000..fe97ea1 --- /dev/null +++ b/packages/node/src/fuzz-main.test.ts @@ -0,0 +1,496 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// `metta fuzz` and `metta reach`. Spawns the built bin like the other CLI tests, because the exit code +// is half of the contract: 0 pass or definitive answer, 1 property failure, 2 invalid input, 3 +// incomplete run. + +import { describe, expect, it } from "vitest"; +import { spawnSync } from "node:child_process"; +import { + existsSync, + mkdirSync, + mkdtempSync, + readFileSync, + readdirSync, + rmSync, + writeFileSync, +} from "node:fs"; +import { tmpdir } from "node:os"; +import { dirname, join, resolve } from "node:path"; +import { fileURLToPath } from "node:url"; +import { parseFuzzArgs } from "./fuzz-main"; + +const METTA = join(dirname(fileURLToPath(import.meta.url)), "..", "dist", "metta-cli.js"); + +interface Run { + readonly code: number; + readonly out: string; + readonly err: string; +} + +function metta(args: readonly string[]): Run { + const done = spawnSync(process.execPath, [METTA, ...args], { + encoding: "utf8", + timeout: 240_000, + }); + return { code: done.status ?? -1, out: done.stdout ?? "", err: done.stderr ?? "" }; +} + +/** Write files into one fresh directory and return the path of the first. */ +function fixture(files: Readonly>): string { + const dir = mkdtempSync(join(tmpdir(), "metta-fuzz-cli-")); + const paths = Object.entries(files).map(([name, content]) => { + const path = join(dir, name); + writeFileSync(path, content); + return path; + }); + return paths[0]!; +} + +// One passing declaration and one failing one. `always-small` fails for every value at or above five, +// so shrinking must land on exactly five. +const SUITE = ` +(: reverse-involution (-> Atom FuzzProperty)) +(= (reverse-involution $xs) (expect-atom-equal (reverse (reverse $xs)) $xs)) +(: always-small (-> Atom FuzzProperty)) +(= (always-small $n) (expect-true (< $n 5) (Saw $n))) + +(FuzzTest involution (gen-list (gen-int -20 20) 0 6) reverse-involution + (fuzz-config (Runs 20) (EdgeCases 2))) +(FuzzTest bounded (gen-int 0 9) always-small (fuzz-config (Seed 3) (Runs 30))) + +!(println! "DIRECTIVE-RAN") +`; + +const PASSING = ` +(: always (-> Atom FuzzProperty)) +(= (always $value) (fuzz-pass)) +(FuzzTest fine (gen-int 0 9) always (fuzz-config (Runs 5) (EdgeCases 1))) +`; + +const COUNTER = ` +(= (counter-enumerate (Count $n)) (FiniteCommands up)) +(= (counter-transition (Count $n) up) (Count (+ $n 1))) +(= (at-three (Count $n)) (== $n 3)) +(= (at-ninety (Count $n)) (== $n 90)) +(FuzzReachTest climb (Count 0) counter-enumerate counter-transition at-three + (reach-config (MaxDepth 10))) +(FuzzReachTest far (Count 0) counter-enumerate counter-transition at-ninety + (reach-config (MaxDepth 5))) +!(println! "DIRECTIVE-RAN") +`; + +describe("metta fuzz", () => { + it("runs every declaration and exits 1 on a property failure", () => { + const run = metta(["fuzz", fixture({ "p.metta": SUITE })]); + + expect(run.out).toContain("ok involution"); + // The counterexample is shrunk before it is reported, so the smallest failing value is shown. + expect(run.out).toContain("FAILED bounded ExpectedTrue 5"); + expect(run.code).toBe(1); + }); + + it("does not execute the file's own directives", () => { + // Reading a suite must not be a side channel for running whatever else the file would have run. + const run = metta(["fuzz", fixture({ "p.metta": SUITE })]); + + expect(run.out).not.toContain("DIRECTIVE-RAN"); + }); + + it("exits 0 when every declaration passes", () => { + const run = metta(["fuzz", fixture({ "p.metta": PASSING })]); + + expect(run.out).toBe("ok fine 6 cases, seed 0\n"); + expect(run.code).toBe(0); + }); + + it("lists declarations without running them", () => { + const run = metta(["fuzz", "--list", fixture({ "p.metta": SUITE })]); + + expect(run.out).toContain("(FuzzTestCase involution (gen-list (gen-int -20 20) 0 6)"); + expect(run.out).not.toContain("FAILED"); + expect(run.code).toBe(0); + }); + + it("applies command-line settings over each declaration's own config", () => { + const file = fixture({ "p.metta": PASSING }); + + expect(metta(["fuzz", file]).out).toContain("6 cases, seed 0"); + // Runs counts the random cases, on top of the declaration's one edge case. + expect(metta(["fuzz", "--seed", "42", "--runs", "3", file]).out).toContain("4 cases, seed 42"); + }); + + it("prints result atoms as JSON when asked", () => { + const run = metta(["fuzz", "--json", fixture({ "p.metta": SUITE })]); + const parsed = JSON.parse(run.out) as { id: string; kind: string; result: string }[]; + + expect(parsed.map((entry) => [entry.id, entry.kind])).toEqual([ + ["involution", "passed"], + ["bounded", "failed"], + ]); + // The whole result atom travels with it, so a harness can read the replay key or the statistics. + expect(parsed[1]!.result).toContain("(SmallestValue 5)"); + expect(run.code).toBe(1); + }); + + it("enumerates a whole domain and reports a bounded one as incomplete", () => { + const file = fixture({ + "p.metta": ` + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + (FuzzTest tiny (gen-bool) always (fuzz-config (MaxEnumerated 10))) + (FuzzTest wide (gen-int 0 100) always (fuzz-config (MaxEnumerated 4))) + `, + }); + const run = metta(["fuzz", "--exhaustive", file]); + + expect(run.out).toContain("ok tiny exhaustive, 2 trees"); + // 101 values do not fit in four, so the domain was not covered and the run is incomplete. + expect(run.out).toContain("gave up wide EnumerationLimit"); + expect(run.code).toBe(3); + }); + + it("reports a file with no declarations rather than saying nothing", () => { + const file = fixture({ "p.metta": "!(+ 1 2)\n" }); + const run = metta(["fuzz", file]); + + // A diagnostic, so it goes to stderr and leaves stdout to the results. + expect(run.err).toContain("no (FuzzTest ...) declarations"); + expect(run.out).toBe(""); + expect(run.code).toBe(0); + // Under --json an empty run is still a document a caller can parse. + expect(JSON.parse(metta(["fuzz", "--json", file]).out)).toEqual([]); + }); + + it("resolves the imports a suite file declares", () => { + const file = fixture({ + "p.metta": ` + !(import! &self props) + (FuzzTest imported (gen-int 0 9) always (fuzz-config (Runs 2) (EdgeCases 0))) + `, + "props.metta": ` + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + `, + }); + const run = metta(["fuzz", file]); + + // The import is a directive too, but it is kept: dropping it would make the property undefined. + expect(run.out).toContain("ok imported"); + expect(run.code).toBe(0); + }); + + it("refuses bad arguments with exit 2", () => { + const file = fixture({ "p.metta": PASSING }); + + expect(metta(["fuzz", "--nope", file]).code).toBe(2); + expect(metta(["fuzz", "--nope", file]).err).toContain("unknown option --nope"); + expect(metta(["fuzz", "--runs", file]).code).toBe(2); + expect(metta(["fuzz", "--runs", "many", file]).code).toBe(2); + expect(metta(["fuzz", file, file]).code).toBe(2); + expect(metta(["fuzz", join(dirname(file), "missing.metta")]).code).toBe(2); + expect(metta(["fuzz"]).code).toBe(0); + expect(metta(["fuzz"]).out).toContain("usage"); + }); + + it("reports an undecodable result as invalid rather than as a pass", () => { + const file = fixture({ + "p.metta": ` + (: wrong (-> Atom FuzzProperty)) + (= (wrong $value) NotAPropertyResult) + (FuzzTest broken (gen-bool) wrong (fuzz-config (Runs 1) (EdgeCases 0))) + `, + }); + const run = metta(["fuzz", file]); + + expect(run.out).toContain("invalid MalformedPropertyResult"); + expect(run.code).toBe(2); + }); +}); + +describe("metta reach", () => { + it("runs every declared search and reports the witness", () => { + const run = metta(["reach", fixture({ "p.metta": COUNTER })]); + + expect(run.out).toContain("reached climb in 3 steps: up up up"); + // Depth 5 cannot see (Count 90), and a bounded negative is an incomplete answer. + expect(run.out).toContain("bounded far no target at or below depth 5"); + expect(run.out).not.toContain("DIRECTIVE-RAN"); + expect(run.code).toBe(3); + }); + + it("restricts the run to one declaration by id", () => { + const run = metta(["reach", fixture({ "p.metta": COUNTER }), "climb"]); + + expect(run.out).toBe("reached climb in 3 steps: up up up\n"); + expect(run.code).toBe(0); + }); + + it("applies reach settings over each declaration's own config", () => { + const file = fixture({ "p.metta": COUNTER }); + + // The declaration asked for depth 5; raising the bound reaches the target, and a long witness is + // elided with its true length rather than printed in full. + const raised = metta(["reach", "--max-depth", "120", file, "far"]); + expect(raised.out).toContain("reached far in 90 steps: up up up up up up up up ..."); + expect(raised.out).toContain("(90 commands)"); + expect(raised.code).toBe(0); + + // A state bound is a cutoff, not a depth answer, and stays incomplete. + const capped = metta(["reach", "--max-depth", "120", "--max-states", "4", file, "far"]); + expect(capped.out).toContain("cutoff far (MaxStatesReached (MaxStates 4))"); + expect(capped.code).toBe(3); + }); + + it("lists declared searches and rejects an unknown id", () => { + const file = fixture({ "p.metta": COUNTER }); + + expect(metta(["reach", "--list", file]).out).toContain("(FuzzReachCase climb (Count 0)"); + expect(metta(["reach", "--list", file]).code).toBe(0); + expect(metta(["reach", file, "nope"]).code).toBe(2); + expect(metta(["reach", file, "nope"]).err).toContain("no declaration named nope"); + }); +}); + +// The corpus is the counterexamples a run already found. A property that only fails on the boundary of +// its domain is the case worth pinning: an edge-case pass finds it once, and a later random-only run +// would miss it if the corpus did not replay it first. +const BOUNDARY = ` +(: under-limit (-> Atom FuzzProperty)) +(= (under-limit $n) (expect-true (< $n 1000000) (Saw $n))) +`; +const FINDS = `${BOUNDARY} +(FuzzTest boundary (gen-int 0 1000000) under-limit (fuzz-config (Seed 1) (Runs 2) (EdgeCases 3))) +`; +const MISSES = `${BOUNDARY} +(FuzzTest boundary (gen-int 0 1000000) under-limit (fuzz-config (Seed 7) (Runs 3) (EdgeCases 0))) +`; + +describe("metta fuzz --corpus", () => { + it("records a counterexample and replays it in a run that would otherwise miss it", () => { + const finds = fixture({ "p.metta": FINDS }); + const corpus = join(dirname(finds), "corpus"); + const misses = fixture({ "p.metta": MISSES }); + + // Without a corpus, the random-only declaration passes: one value in a million is not found. + const clean = metta(["fuzz", misses]); + expect(clean.out).toContain("ok boundary"); + expect(clean.code).toBe(0); + + // The edge-case declaration finds the boundary and records it. + const found = metta(["fuzz", "--corpus", corpus, finds]); + expect(found.out).toContain("FAILED boundary ExpectedTrue 1000000"); + expect(found.err).toContain("1 recorded"); + expect(found.code).toBe(1); + + // Now the same property fails in the run that could not find it on its own. + const replayed = metta(["fuzz", "--corpus", corpus, misses]); + expect(replayed.out).toContain("FAILED boundary ExpectedTrue 1000000"); + expect(replayed.err).toContain("1 replayed"); + expect(replayed.code).toBe(1); + }); + + it("stores a counterexample once, however many times it is recorded", () => { + const file = fixture({ "p.metta": FINDS }); + const corpus = join(dirname(file), "corpus"); + + metta(["fuzz", "--corpus", corpus, file]); + const entries = readdirSync(corpus); + const again = metta(["fuzz", "--corpus", corpus, file]); + + // Content-addressed names: the second recording writes the name that is already there. + expect(entries).toHaveLength(1); + expect(readdirSync(corpus)).toEqual(entries); + expect(again.err).toContain("1 replayed, 0 recorded"); + // The entry names its property and carries the value through the versioned codec. + expect(entries[0]).toMatch(/^boundary-[0-9a-f]{16}\.metta$/); + const text = readFileSync(join(corpus, entries[0]!), "utf8"); + expect(text).toContain("(FuzzCorpusEntry 1 boundary (FuzzEncodedAtom 1 (Integer 1000000)))"); + expect(text).toContain("; Commit this file"); + }); + + it("reads a corpus without writing to it when asked", () => { + const file = fixture({ "p.metta": FINDS }); + const corpus = join(dirname(file), "corpus"); + const run = metta(["fuzz", "--corpus", corpus, "--no-record", file]); + + expect(run.out).toContain("FAILED boundary"); + expect(run.err).toContain("0 replayed, 1 not recorded (--no-record)"); + expect(existsSync(corpus)).toBe(false); + expect(run.code).toBe(1); + }); + + it("keeps --json output parseable with a corpus in play", () => { + const file = fixture({ "p.metta": FINDS }); + const corpus = join(dirname(file), "corpus"); + const run = metta(["fuzz", "--corpus", corpus, "--json", file]); + + // The corpus summary is a diagnostic, so stdout stays exactly one document. + expect(JSON.parse(run.out)).toHaveLength(1); + expect(run.err).toContain("recorded"); + }); + + it("refuses malformed persisted data instead of ignoring it", () => { + const file = fixture({ "p.metta": FINDS }); + const corpus = join(dirname(file), "corpus"); + mkdirSync(corpus, { recursive: true }); + + const cases: readonly [string, string][] = [ + ["wrong-shape", "(NotAnEntry 1 boundary 5)"], + ["wrong-version", "(FuzzCorpusEntry 2 boundary (FuzzEncodedAtom 1 (Integer 5)))"], + ["bad-payload", "(FuzzCorpusEntry 1 boundary (FuzzEncodedAtom 1 (Nonsense 5)))"], + ["a-query", '!(println! "ran")'], + ["unparseable", "(FuzzCorpusEntry 1 boundary"], + ["empty", "; only a comment\n"], + ]; + for (const [name, content] of cases) { + const entry = join(corpus, `${name}.metta`); + writeFileSync(entry, content); + const run = metta(["fuzz", "--corpus", corpus, file]); + expect(run.code, name).toBe(2); + expect(run.err, name).toContain(entry); + // A corrupt corpus stops the run rather than quietly dropping a known failure. + expect(run.out, name).toBe(""); + rmSync(entry); + } + }); + + it("round-trips values that have no source syntax", () => { + // A float is stored as its two 32-bit words, so a counterexample of NaN survives exactly. Written + // as a corpus entry by hand and replayed: `(< nan 1000000)` is False, so the property fails on it. + const file = fixture({ "p.metta": MISSES }); + const corpus = join(dirname(file), "corpus"); + mkdirSync(corpus, { recursive: true }); + writeFileSync( + join(corpus, "nan.metta"), + "(FuzzCorpusEntry 1 boundary (FuzzEncodedAtom 1 (Float64Bits 2146959360 0)))\n", + ); + const run = metta(["fuzz", "--corpus", corpus, "--json", file]); + + expect(run.code).toBe(1); + const [result] = JSON.parse(run.out) as { result: string }[]; + expect(result!.result).toContain("(Phase Regression)"); + expect(result!.result).toContain("(SmallestValue NaN)"); + expect(result!.result).toContain( + "(EncodedValue (FuzzEncodedAtom 1 (Float64Bits 2146959360 0)))", + ); + // A stored entry carries no decision tree, so it is replayed as it was stored rather than shrunk + // again. It is already the smallest value the run that found it could reach. + expect(result!.result).toContain("(NotShrunk (Reason NoDecisionTree))"); + }); +}); + +const REPO = resolve(dirname(fileURLToPath(import.meta.url)), "..", "..", ".."); + +// The repository's own example suite, run through the CLI it documents. An example that quietly stops +// working is the worst kind of documentation, and this is the file a reader copies first. +describe("the property-testing example", () => { + const suite = resolve(REPO, "examples", "property-testing.metta"); + + it("runs, fails on the declaration meant to fail, and leaves the file's query alone", () => { + const run = metta(["fuzz", suite]); + + expect(run.out).toContain("ok involution"); + expect(run.out).toContain("FAILED sum ExpectedTrue (-1)"); + expect(run.out).toContain("ok booleans"); + expect(run.out).not.toContain("metta run executes this"); + expect(run.code).toBe(1); + }); + + it("enumerates what fits and says so about what does not", () => { + // The bound is set low here only to keep the test quick: walking a domain to the default bound is + // seconds of work, and what is being pinned is which answer each declaration gets, not the bound. + const run = metta(["fuzz", "--exhaustive", "--max-enumerated", "50", suite]); + + expect(run.out).toContain("ok booleans exhaustive, 2 trees"); + // Lists of up to forty integers do not fit any bound, so the run is incomplete, not verified. + expect(run.out).toContain("gave up involution EnumerationLimit"); + expect(run.code).toBe(1); + }); + + it("searches the declared model both ways", () => { + const run = metta(["reach", suite]); + + expect(run.out).toContain("reached reaches-three in 2 steps: up split"); + // The counter stops at four, so the frontier runs dry and the negative is exhaustion, not a bound. + expect(run.out).toContain("ok never-ninety unreachable in 6 states"); + expect(run.code).toBe(0); + }); +}); + +// The CLI's own usage text and the website's CLI page both list the options. Either can drift from the +// parser, and a documented flag that is silently ignored is worse than one that is missing, so the flags +// are compared in both directions against what the parser actually accepts. +describe("documented options", () => { + const DOCS = resolve(REPO, "website", "tools", "cli.md"); + + /** The long options a text mentions, from the `metta fuzz` section onward. */ + const optionsIn = (text: string): Set => + new Set([...text.matchAll(/`?(--[a-z][a-z-]+)/g)].map((match) => match[1]!)); + + const accepted = (flag: string, mode: "fuzz" | "reach"): boolean => { + // A value-taking flag is accepted with a value; a boolean one on its own. Either way the parse must + // not come back with "unknown option". + for (const args of [ + [flag, "1", "p.metta"], + [flag, "p.metta"], + ]) { + const parsed = parseFuzzArgs(args, mode); + if (parsed.ok || !parsed.message.startsWith("unknown option")) return true; + } + return false; + }; + + it("accepts every option its own usage text lists", () => { + const usage = metta(["fuzz"]).out; + for (const flag of optionsIn(usage)) { + expect(accepted(flag, "fuzz") || accepted(flag, "reach"), flag).toBe(true); + } + // The usage text has to actually list options, or the loop above proves nothing. + expect(optionsIn(usage).size).toBeGreaterThan(8); + }); + + it("accepts every option the CLI documentation page lists", () => { + const page = readFileSync(DOCS, "utf8"); + const section = page.slice(page.indexOf("## Run property tests"), page.indexOf("## Render")); + const documented = optionsIn(section); + + expect(documented.size).toBeGreaterThan(8); + for (const flag of documented) { + expect(accepted(flag, "fuzz") || accepted(flag, "reach"), flag).toBe(true); + } + // And the other direction: every option the CLI offers is documented on the page. + for (const flag of optionsIn(metta(["fuzz"]).out)) { + expect(documented.has(flag), `${flag} is documented`).toBe(true); + } + }); +}); + +describe("fuzz argument parsing", () => { + it("keeps each subcommand's own options apart", () => { + // A fuzz setting is not a reach setting: accepting it silently and then ignoring it would be + // worse than refusing it. + expect(parseFuzzArgs(["--max-depth", "3", "p.metta"], "reach").ok).toBe(true); + expect(parseFuzzArgs(["--max-depth", "3", "p.metta"], "fuzz").ok).toBe(false); + expect(parseFuzzArgs(["--runs", "3", "p.metta"], "fuzz").ok).toBe(true); + expect(parseFuzzArgs(["--runs", "3", "p.metta"], "reach").ok).toBe(false); + expect(parseFuzzArgs(["--exhaustive", "p.metta"], "reach").ok).toBe(false); + }); + + it("normalizes settings into MeTTa config options", () => { + const parsed = parseFuzzArgs(["--seed", "7", "--runs", "9", "p.metta"], "fuzz"); + + expect(parsed.ok && parsed.request.overrides).toEqual(["(Seed 7)", "(Runs 9)"]); + expect(parsed.ok && parsed.request.file).toBe("p.metta"); + }); + + it("takes a second positional only for reach", () => { + expect(parseFuzzArgs(["p.metta", "climb"], "reach")).toMatchObject({ + ok: true, + request: { only: "climb" }, + }); + expect(parseFuzzArgs(["p.metta", "climb"], "fuzz").ok).toBe(false); + }); +}); diff --git a/packages/node/src/fuzz-main.ts b/packages/node/src/fuzz-main.ts new file mode 100644 index 0000000..f3389e5 --- /dev/null +++ b/packages/node/src/fuzz-main.ts @@ -0,0 +1,331 @@ +// SPDX-FileCopyrightText: 2026 MesTTo +// +// SPDX-License-Identifier: MIT + +// `metta fuzz` and `metta reach`: run the declarations a file carries, not the file's own queries. +// +// A suite file declares tests as data (`FuzzTest`, `FuzzReachTest`). The CLI loads the file's +// declarations, drops its `!` directives, and evaluates its own query instead. Dropping them is the +// point: reading a suite must not execute whatever else the file would have run, so discovery cannot +// be a side channel for arbitrary evaluation. `import!` and `register-module!` are the exception, +// because a property defined in an imported file is undefined without them. +// +// Command-line settings become normalized MeTTa config options and are merged into each declaration's +// own config by replacement, so `--seed 7` overrides one option and leaves the rest of the +// declaration intact. + +import { readFileSync, existsSync } from "node:fs"; +import { dirname, resolve } from "node:path"; +import { + DEFAULT_FUEL, + evalSequential, + format, + parseAll, + standardTokenizer, + type Atom, + type QueryResult, + type TopAtom, +} from "@mettascript/core"; +import { + decodeFuzzOutcome, + exitCodeForOutcomes, + renderOutcomeLine, + FUZZ_EXIT_INVALID, + type FuzzExitCode, + type FuzzOutcome, +} from "@mettascript/fuzz"; +import { readCorpus, recordCorpusEntry } from "./fuzz-corpus"; +import { readImports } from "./file-imports"; + +const USAGE = `usage: + metta fuzz [options] run every (FuzzTest ...) declaration + metta fuzz --exhaustive enumerate each declaration's whole domain + metta reach [id] run every (FuzzReachTest ...) declaration, or one by id + +options: + --seed --runs --max-size + --max-discards --max-shrinks --case-steps + --case-depth --max-enumerated --max-depth + --max-states --max-transitions + --corpus replay the counterexamples stored there, and record new ones + --no-record read the corpus without writing to it + --json print the full result atoms as JSON + --list list declared tests without running them + +exit codes: + 0 pass or definitive answer 1 property failure + 2 invalid input or data 3 incomplete run (gave up, bounded, or cut off)`; + +/** A CLI flag and the MeTTa config option it sets. */ +const FUZZ_OPTIONS: ReadonlyMap = new Map([ + ["--seed", "Seed"], + ["--runs", "Runs"], + ["--max-size", "MaxSize"], + ["--max-discards", "MaxDiscards"], + ["--max-shrinks", "MaxShrinks"], + ["--case-steps", "CaseSteps"], + ["--case-depth", "CaseDepth"], + ["--max-enumerated", "MaxEnumerated"], +]); + +const REACH_OPTIONS: ReadonlyMap = new Map([ + ["--max-depth", "MaxDepth"], + ["--max-states", "MaxStates"], + ["--max-transitions", "MaxTransitions"], +]); + +export interface FuzzCliRequest { + readonly file: string; + readonly overrides: readonly string[]; + readonly exhaustive: boolean; + readonly json: boolean; + readonly list: boolean; + /** `metta reach ` restricts the run to one declaration. */ + readonly only: string | undefined; + /** Where stored counterexamples live, when a corpus was asked for. */ + readonly corpus: string | undefined; + readonly record: boolean; +} + +export type FuzzCliParse = + | { readonly ok: true; readonly request: FuzzCliRequest } + | { readonly ok: false; readonly message: string }; + +/** Parse arguments for one of the two subcommands. Unknown flags are refused rather than ignored. */ +export function parseFuzzArgs(args: readonly string[], mode: "fuzz" | "reach"): FuzzCliParse { + const known = mode === "reach" ? REACH_OPTIONS : FUZZ_OPTIONS; + const overrides: string[] = []; + let file: string | undefined; + let only: string | undefined; + let exhaustive = false; + let json = false; + let list = false; + let corpus: string | undefined; + let record = true; + + for (let i = 0; i < args.length; i++) { + const arg = args[i]!; + if (arg === "--exhaustive") { + if (mode === "reach") return { ok: false, message: "--exhaustive applies to metta fuzz" }; + exhaustive = true; + } else if (arg === "--json") { + json = true; + } else if (arg === "--list") { + list = true; + } else if (arg === "--corpus") { + // A corpus holds counterexamples for properties. A reachability search has none: its answer is a + // witness for a declared model, not an input to try again. + if (mode === "reach") return { ok: false, message: "--corpus applies to metta fuzz" }; + const raw = args[i + 1]; + if (raw === undefined || raw.startsWith("-")) + return { ok: false, message: "--corpus needs a directory" }; + corpus = raw; + i += 1; + } else if (arg === "--no-record") { + record = false; + } else if (known.has(arg)) { + const raw = args[i + 1]; + if (raw === undefined) return { ok: false, message: `${arg} needs a value` }; + if (!/^\d+$/.test(raw)) return { ok: false, message: `${arg} needs a nonnegative integer` }; + overrides.push(`(${known.get(arg)!} ${raw})`); + i += 1; + } else if (arg.startsWith("-")) { + return { ok: false, message: `unknown option ${arg}` }; + } else if (file === undefined) { + file = arg; + } else if (mode === "reach" && only === undefined) { + only = arg; + } else { + return { ok: false, message: `unexpected argument ${arg}` }; + } + } + + if (file === undefined) return { ok: false, message: "a .metta file is required" }; + if (corpus === undefined && !record) + return { ok: false, message: "--no-record applies to --corpus " }; + return { ok: true, request: { file, overrides, exhaustive, json, list, only, corpus, record } }; +} + +// Loading a module is part of declaring a suite, so these directives are kept while every other one +// is dropped. A property defined in an imported file is undefined without them. +const MODULE_DIRECTIVES: ReadonlySet = new Set(["import!", "register-module!"]); + +function isModuleDirective(atom: Atom): boolean { + if (atom.kind !== "expr") return false; + const head = atom.items[0]; + return head?.kind === "sym" && MODULE_DIRECTIVES.has(head.name); +} + +/** The declarations of a source file, with every `!` directive except module loading removed. */ +function declarationsOf(src: string): TopAtom[] { + return parseAll(src, standardTokenizer()).filter( + (top) => !top.bang || isModuleDirective(top.atom), + ); +} + +/** Results of evaluating one appended query against a file's declarations and any stored regressions. */ +function evaluate( + src: string, + file: string, + query: string, + regressions: readonly TopAtom[] = [], +): QueryResult[] { + const fileDir = dirname(resolve(file)); + const imports = readImports(src, fileDir, dirname(fileDir)); + // `import! &self fuzz` is appended rather than required in the file, so a suite file needs no + // ceremony; importing twice is a no-op. + const appended = parseAll(`!(import! &self fuzz)\n!${query}`, standardTokenizer()); + const program = [...declarationsOf(src), ...regressions, ...appended]; + return evalSequential(program, DEFAULT_FUEL, imports, { tabling: true }); +} + +/** Each `(FuzzSuiteResult id result)` pair of a suite run, in declaration order. */ +function suiteResults(atom: Atom): readonly { readonly id: string; readonly result: Atom }[] { + if (atom.kind !== "expr") return []; + const pairs: { id: string; result: Atom }[] = []; + for (const item of atom.items) { + if ( + item.kind !== "expr" || + item.items.length !== 3 || + item.items[0]?.kind !== "sym" || + (item.items[0] as { name: string }).name !== "FuzzSuiteResult" + ) + continue; + const id = item.items[1]!; + pairs.push({ id: id.kind === "sym" ? id.name : format(id), result: item.items[2]! }); + } + return pairs; +} + +export interface FuzzCliOutcome { + readonly code: FuzzCliExit; + /** Results, on stdout. Under `--json` this is exactly one JSON document and nothing else. */ + readonly lines: readonly string[]; + /** Diagnostics, on stderr, so a caller can pipe the results without filtering them out. */ + readonly notes: readonly string[]; +} + +type FuzzCliExit = FuzzExitCode; + +/** Run one request and return what to print plus the exit code, without touching the process. */ +export function runFuzzRequest(request: FuzzCliRequest, mode: "fuzz" | "reach"): FuzzCliOutcome { + if (!existsSync(request.file)) + return { code: FUZZ_EXIT_INVALID, lines: [], notes: [`no such file: ${request.file}`] }; + const src = readFileSync(request.file, "utf8"); + + const overrides = `(${request.overrides.join(" ")})`; + const query = request.list + ? mode === "reach" + ? "(fuzz-reach-suite-tests)" + : "(fuzz-suite-tests)" + : mode === "reach" + ? `(fuzz-run-reach-suite-with ${overrides})` + : request.exhaustive + ? `(fuzz-run-suite-exhaustive ${overrides})` + : `(fuzz-run-suite-with ${overrides})`; + + // A listing does not run anything, so it does not need the corpus loaded. + const loaded = + request.corpus === undefined || request.list ? undefined : readCorpus(request.corpus); + if (loaded !== undefined && !loaded.ok) + return { code: FUZZ_EXIT_INVALID, lines: [], notes: [loaded.reason] }; + + const results = evaluate(src, request.file, query, loaded?.load.facts); + const last = results.at(-1); + if (last === undefined || last.results.length !== 1) + return { + code: FUZZ_EXIT_INVALID, + lines: [], + notes: [`the suite query produced ${last?.results.length ?? 0} results, expected one`], + }; + const value = last.results[0]!; + + if (request.list) { + const listed = + value.kind === "expr" ? value.items.map((item) => format(item)) : [format(value)]; + return { code: 0, lines: request.json ? [JSON.stringify(listed)] : listed, notes: [] }; + } + + const pairs = suiteResults(value); + if (pairs.length === 0) { + const what = mode === "reach" ? "(FuzzReachTest ...)" : "(FuzzTest ...)"; + // Under --json an empty run is still a JSON document, so a caller parses stdout unconditionally. + return { + code: 0, + lines: request.json ? ["[]"] : [], + notes: [`no ${what} declarations in ${request.file}`], + }; + } + + const selected = + request.only === undefined ? pairs : pairs.filter((pair) => pair.id === request.only); + if (selected.length === 0) + return { code: FUZZ_EXIT_INVALID, lines: [], notes: [`no declaration named ${request.only!}`] }; + + const outcomes: FuzzOutcome[] = selected.map((pair) => decodeFuzzOutcome(pair.result)); + const lines = request.json + ? [ + JSON.stringify( + selected.map((pair, i) => ({ + id: pair.id, + kind: outcomes[i]!.kind, + result: format(pair.result), + })), + ), + ] + : outcomes.map(renderOutcomeLine); + + const corpusLines = + request.corpus === undefined + ? [] + : corpusReport(request.corpus, request.record, loaded?.load.count ?? 0, selected, outcomes); + return { code: exitCodeForOutcomes(outcomes), lines, notes: corpusLines }; +} + +// Recording happens after the run and reports what it did. A counterexample that cannot be stored is +// said so plainly rather than dropped: the failure was still reported, but the corpus does not have it. +function corpusReport( + dir: string, + record: boolean, + loaded: number, + selected: readonly { readonly id: string }[], + outcomes: readonly FuzzOutcome[], +): string[] { + const failures = outcomes.flatMap((outcome, index) => + outcome.kind === "failed" && outcome.smallestValue !== undefined + ? [{ property: selected[index]!.id, value: outcome.smallestValue }] + : [], + ); + + const problems: string[] = []; + let written = 0; + if (record) { + for (const entry of failures) { + const stored = recordCorpusEntry(dir, entry); + if (!stored.ok) problems.push(`corpus ${entry.property}: ${stored.reason}`); + else if (stored.recorded) written += 1; + } + } + + const parts = [`${loaded} replayed`]; + if (record) parts.push(`${written} recorded`); + else if (failures.length > 0) parts.push(`${failures.length} not recorded (--no-record)`); + return [`corpus ${dir}: ${parts.join(", ")}`, ...problems]; +} + +/** CLI entry. Writes to stdout/stderr and returns the exit code. */ +export function runFuzzMain(args: readonly string[], mode: "fuzz" | "reach"): FuzzCliExit { + if (args.length === 0 || args[0] === "--help" || args[0] === "-h") { + process.stdout.write(`${USAGE}\n`); + return 0; + } + const parsed = parseFuzzArgs(args, mode); + if (!parsed.ok) { + process.stderr.write(`${parsed.message}\n\n${USAGE}\n`); + return FUZZ_EXIT_INVALID; + } + const outcome = runFuzzRequest(parsed.request, mode); + for (const line of outcome.lines) process.stdout.write(`${line}\n`); + for (const note of outcome.notes) process.stderr.write(`${note}\n`); + return outcome.code; +} diff --git a/packages/node/src/metta-cli.ts b/packages/node/src/metta-cli.ts index 1c960e6..af21a82 100644 --- a/packages/node/src/metta-cli.ts +++ b/packages/node/src/metta-cli.ts @@ -24,6 +24,8 @@ usage: metta check [options] statically analyze a program (--json, --undefined-symbols) metta debug (--file

| --source '') [--llm] debug the engine metta graph [-o out.gif] [--view blocks|graph|side-by-side] render a reduction GIF + metta fuzz [--exhaustive] [--json] run declared (FuzzTest ...) properties + metta reach [id] run declared (FuzzReachTest ...) searches metta --version | --help Run "metta run --help" style is not needed; each subcommand prints its own usage on a missing argument. @@ -64,6 +66,13 @@ async function main(): Promise { await runGraphMain(rest); return; } + case "fuzz": + case "reach": { + const { runFuzzMain } = await import("./fuzz-main"); + const code = runFuzzMain(rest, first); + if (code !== 0) process.exit(code); + return; + } default: { // Shorthand: `metta ` runs the file, and any leading flag (e.g. `metta --check x.metta`) // falls through to the runner, matching `metta-ts`'s single-command behavior. diff --git a/packages/node/src/source.test.ts b/packages/node/src/source.test.ts index ded6597..65d6ae5 100644 --- a/packages/node/src/source.test.ts +++ b/packages/node/src/source.test.ts @@ -16,6 +16,26 @@ const lastResults = (rs: ReturnType): string[] => rs.at(-1)?.results.map(format) ?? []; describe("Node source runners", () => { + it("auto-registers the deterministic fuzz module", () => { + const rs = runSource(` + !(import! &self fuzz) + !(_fuzz-rng-init 42) + `); + expect(lastResults(rs)).toEqual(["(FuzzRng xorshift128plus-v1 -1 -43 42 0)"]); + }); + + it("runs a whole property test through the module, not only its kernel", () => { + // Registering the grounded operations is not the same as the MeTTa module being usable, so this + // checks the thing a user actually calls. + const rs = runSource(` + !(import! &self fuzz) + (: always (-> Atom FuzzProperty)) + (= (always $value) (fuzz-pass)) + !(fuzz-check smoke (gen-int 0 9) always (fuzz-config (Runs 3) (EdgeCases 0))) + `); + expect(lastResults(rs)[0]).toContain("(FuzzPassed (Property smoke) (Seed 0)"); + }); + it("runs a source string with in-memory imports", () => { const imports = new Map([ [ diff --git a/packages/node/src/source.ts b/packages/node/src/source.ts index d7dc29c..7db725e 100644 --- a/packages/node/src/source.ts +++ b/packages/node/src/source.ts @@ -5,6 +5,7 @@ // In-memory Node source runners. Unlike the package root, this file never imports node:fs; embedders that // already resolved imports can use it without adding file-backed capabilities to the process. import "@mettascript/libraries"; +import "@mettascript/fuzz"; import { DEFAULT_FUEL, evalSequential, diff --git a/packages/prolog/package.json b/packages/prolog/package.json index 017000f..eda30a5 100644 --- a/packages/prolog/package.json +++ b/packages/prolog/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/prolog", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/packages/py/package.json b/packages/py/package.json index f3c4df0..6a95883 100644 --- a/packages/py/package.json +++ b/packages/py/package.json @@ -1,6 +1,6 @@ { "name": "@mettascript/py", - "version": "2.7.0", + "version": "2.8.0", "license": "MIT", "type": "module", "main": "./dist/index.js", diff --git a/pnpm-lock.yaml b/pnpm-lock.yaml index 5d4fc7d..d51bbda 100644 --- a/pnpm-lock.yaml +++ b/pnpm-lock.yaml @@ -84,6 +84,12 @@ importers: specifier: workspace:* version: link:../../packages/edsl + compat/fuzz: + dependencies: + '@mettascript/fuzz': + specifier: workspace:* + version: link:../../packages/fuzz + compat/grapher: dependencies: '@mettascript/grapher': @@ -131,6 +137,9 @@ importers: '@mettascript/edsl': specifier: workspace:* version: link:../packages/edsl + '@mettascript/fuzz': + specifier: workspace:* + version: link:../packages/fuzz '@mettascript/grapher': specifier: workspace:* version: link:../packages/grapher @@ -180,6 +189,9 @@ importers: '@mettascript/core': specifier: workspace:* version: link:../core + '@mettascript/fuzz': + specifier: workspace:* + version: link:../fuzz '@mettascript/libraries': specifier: workspace:* version: link:../libraries @@ -224,6 +236,15 @@ importers: specifier: workspace:* version: link:../hyperon + packages/fuzz: + dependencies: + '@mettascript/core': + specifier: workspace:* + version: link:../core + pure-rand: + specifier: 8.4.2 + version: 8.4.2 + packages/grapher: dependencies: '@mettascript/hyperon': @@ -242,6 +263,9 @@ importers: '@mettascript/core': specifier: workspace:* version: link:../core + '@mettascript/fuzz': + specifier: workspace:* + version: link:../fuzz '@mettascript/libraries': specifier: workspace:* version: link:../libraries @@ -260,6 +284,9 @@ importers: '@mettascript/debug': specifier: workspace:* version: link:../debug + '@mettascript/fuzz': + specifier: workspace:* + version: link:../fuzz '@mettascript/libraries': specifier: workspace:* version: link:../libraries @@ -2246,6 +2273,9 @@ packages: pure-rand@6.1.0: resolution: {integrity: sha512-bVWawvoZoBYpp6yIoQtQXHZjmz35RSVHnUOTefl8Vcjr8snTPY1wnpSPMWekcFwbxI6gtmT7rSYPFvz71ldiOA==} + pure-rand@8.4.2: + resolution: {integrity: sha512-vvuOGgcuPJAirlHvuQw1TrOiw7ptaIXXmIbNuiNOY6lNGJJH49PQ1Kj4nd783nPdQhQdicgOjVI2yI/9BD6/Ng==} + pyodide@314.0.2: resolution: {integrity: sha512-rXkXOriXhzRkEV/coVGELjz4da77oNQEOu8hOf8dtBHEKOzqoIAmSJGeKuPl4wbLDv9EDibfKOchnC73CVX4DQ==} engines: {node: '>=18.0.0'} @@ -4373,6 +4403,8 @@ snapshots: pure-rand@6.1.0: {} + pure-rand@8.4.2: {} + pyodide@314.0.2: dependencies: '@types/emscripten': 1.41.5 diff --git a/website/.vitepress/config.ts b/website/.vitepress/config.ts index 7e4faf2..aab58de 100644 --- a/website/.vitepress/config.ts +++ b/website/.vitepress/config.ts @@ -164,6 +164,11 @@ export default defineConfig({ collapsed: false, items: [{ text: "Overview", link: "/edsl/overview" }], }, + { + text: "Property testing", + collapsed: false, + items: [{ text: "Overview", link: "/fuzz/overview" }], + }, { text: "Tools", collapsed: false, @@ -192,6 +197,7 @@ export default defineConfig({ { text: "@mettascript/hyperon", link: "/reference/hyperon" }, { text: "@mettascript/edsl", link: "/reference/edsl" }, { text: "@mettascript/node and browser", link: "/reference/node-browser" }, + { text: "@mettascript/fuzz", link: "/reference/fuzz" }, { text: "@mettascript/grapher", link: "/reference/grapher" }, { text: "@mettascript/py", link: "/reference/py" }, { text: "@mettascript/prolog", link: "/reference/prolog" }, diff --git a/website/fuzz/overview.md b/website/fuzz/overview.md new file mode 100644 index 0000000..0dfe5ac --- /dev/null +++ b/website/fuzz/overview.md @@ -0,0 +1,272 @@ + + +# Property testing + +`@mettascript/fuzz` tests MeTTa with MeTTa. Instead of writing examples by hand, you state a property that should hold for every input, and the library generates inputs, finds a counterexample, and shrinks it until it is the smallest one that still fails. + +```bash +npm install @mettascript/fuzz +``` + +Importing the package registers a `fuzz` module, so your program reaches it the usual way. + +## Your first property + +Reversing a list twice should give you the list back. Let us state that and check it. + +```metta +!(import! &self fuzz) + +(: reverse-involution (-> Atom FuzzProperty)) +(= (reverse-involution $xs) + (expect-atom-equal (reverse (reverse $xs)) $xs)) + +!(fuzz-check reverse-involution + (gen-list (gen-int -100 100) 0 40) + reverse-involution + (fuzz-config (Runs 100))) +``` + +Four things go in: a name for the property, a generator, the property itself, and a configuration. What comes out says the property held and how it was checked. + +```text +(FuzzPassed (Property reverse-involution) (Seed 0) + (FuzzStatistics (Counts (Passed 113) ... (Edges 13) (Random 100)) ...)) +``` + +`Runs` counts the random cases. Boundary values are drawn first and added on top, which is why 100 runs report 113 passes: the empty list, the single-element list, the extreme integers, and so on are tried before anything random. + +## When it fails + +Now a property that is not true. Addition of a list's elements is never negative, we might think, forgetting that the elements can be. + +```metta +(: sum-nonnegative (-> Atom FuzzProperty)) +(= (sum-nonnegative $xs) + (expect-true (>= (foldl-atom $xs 0 $a $b (+ $a $b)) 0) (Sum $xs))) + +!(fuzz-check sum-nonnegative + (gen-list (gen-int -10 10) 1 6) + sum-nonnegative + (fuzz-config (Seed 1) (Runs 50) (EdgeCases 0))) +``` + +The result names the smallest input that fails, not the one that happened to be generated: + +```text +(FuzzFailed (Property sum-nonnegative) ... (FailureTag ExpectedTrue) + (OriginalValue (4 -5)) ... (SmallestValue (-1)) ... + (Shrink (Order mettascript-shrink-v1) (Status LocallyMinimal) (Reason None) + (Attempts 5) (Accepted 4) ...)) +``` + +Generation found `(4 -5)`. Shrinking dropped the element that was not needed and pulled the remaining one toward zero until one step further would have made the property pass, which took five attempts and accepted four of them. A single `-1` is as small as a failing list gets here, and `LocallyMinimal` says so: every smaller candidate the order offers was tried and passed. The original is kept alongside it, in case the difference tells you something. + +## Say what failed, not just that it failed + +Write properties with the expectation combinators rather than returning a bare `Bool`. A `False` tells you nothing; an expectation carries a tag and the details you chose. + +- `(fuzz-pass)` and `(fuzz-fail

)` are what everything else is built from. +- `(expect-true
)` and `(expect-false
)`. +- `(expect-atom-equal )` compares structure. `(expect-alpha-equal )` treats two terms that differ only in variable names as equal. +- `(expect-results-exact )` compares two result bags in order. `-alpha`, `-multiset`, and `-set` relax that to variable renaming, to order, and to multiplicity, which matters when you are testing something nondeterministic. + +## Generators are data + +`(gen-int 0 9)` is not a function call that returns a number. It is an atom the runner interprets, which is what lets the same declaration be replayed with a seed, shrunk toward simpler values, or enumerated exhaustively. + +Start with the scalars: `gen-bool`, `gen-int`, `gen-float`, `gen-char`, `gen-symbol`, `gen-string`. Build structure with `gen-tuple`, `gen-list`, `gen-option`. Choose between alternatives with `gen-element`, `gen-one-of`, and `gen-frequency` when you want one alternative more often than another. + +Then the combinators, which is where generators get interesting: + +```metta +(= (double $n) (* 2 $n)) +(: even-double (-> Atom FuzzProperty)) +(= (even-double $n) (expect-true (== 0 (% $n 2)) (Odd $n))) + +!(fuzz-check even-double + (gen-map double (gen-int 0 50)) + even-double + (fuzz-config (Runs 20))) +``` + +`gen-map` applies a function to whatever the inner generator produced. `gen-bind` chooses the next generator from the value drawn so far, which is how you generate a list and then an index into it. `gen-filter` rejects values that do not fit, up to a discard budget. `gen-sized` and `gen-resize` control how big generated values get, and `gen-recursive` builds trees without running away. + +## Generating well-formed terms + +Random trees are rarely what you want when the thing under test only accepts a language. Declare the shape and generate inside it: + +```metta +(FuzzGrammar Arith + (Productions + ((Production 2 Arith (Lit (Field (gen-int 0 9)))) + (Production 1 Arith (Add (Ref Arith) (Ref Arith)))))) + +(: well-formed (-> Atom FuzzProperty)) +(= (well-formed $term) (expect-true (arith-head $term) (Term $term))) +(= (arith-head $term) + (if (== (get-metatype $term) Expression) + (if-decons-expr $term $head $tail (or (== $head Lit) (== $head Add)) False) + False)) + +!(fuzz-check well-formed + (gen-grammar Arith) + well-formed + (fuzz-config (Seed 2) (Runs 20) (MaxSize 6))) +``` + +A production carries a weight, the nonterminal it produces, and a template. `(Ref Arith)` recurses into the grammar, and `(Field (gen-int 0 9))` drops an ordinary generator into a slot, so the two kinds compose. Every generated term is a sentence of the grammar, which means the property tests the thing you meant rather than the parser's error path. `gen-well-typed` does the same job from type constructors when what you need is a well-typed term. + +## Proving a small domain instead of sampling + +When a domain is small enough to enumerate, do that. Sampling gives you evidence; enumeration gives you a result over the whole domain. + +```metta +(: bool-involution (-> Atom FuzzProperty)) +(= (bool-involution $b) (expect-atom-equal (not (not $b)) $b)) + +!(fuzz-check-exhaustive bool-involution (gen-bool) bool-involution + (fuzz-config (MaxEnumerated 10))) +``` + +```text +(FuzzExhaustivelyVerified (Property bool-involution) (DomainCount 2) ...) +``` + +`DomainCount 2` is the whole domain of `gen-bool`, so the property holds for every input there is. A domain that does not fit inside `MaxEnumerated` is reported as an incomplete run, never as verified: the library will not tell you it checked everything when it checked a prefix. + +## Testing a stateful system + +A property over one input does not catch a bug that needs three operations in the right order. For that, describe the system twice: as a model you trust and as the real thing you do not. + +```metta +(= (counter-initialize) (new-state 0)) +(: counter-command-generator (-> Atom %Undefined%)) +(= (counter-command-generator $model) (gen-element (increment reset))) +(= (counter-precondition $model $command) True) +(= (counter-execute $real increment) + (let $seen (get-state $real) + (let $changed (change-state! $real (+ $seen 1)) + (+ $seen 1)))) +(= (counter-execute $real reset) (let $changed (change-state! $real 0) 0)) +(= (counter-next-model (Count $n) increment) (Count (+ $n 1))) +(= (counter-next-model (Count $n) reset) (Count 0)) +(= (counter-postcondition (Count $n) increment $result) (== $result (+ $n 1))) +(= (counter-postcondition (Count $n) reset $result) (== $result 0)) +(= (counter-invariant (Count $n)) (>= $n 0)) +(= (counter-cleanup $real) Done) + +(FuzzMachine Counter + (InitialModel (Count 0)) + (InitializeReal counter-initialize) + (CommandGenerator counter-command-generator) + (Precondition counter-precondition) + (Execute counter-execute) + (NextModel counter-next-model) + (Postcondition counter-postcondition) + (Invariant counter-invariant) + (Cleanup counter-cleanup)) + +!(fuzz-check-machine Counter (fuzz-config (Runs 20) (MaxSize 6))) +``` + +Generation walks the model only: `CommandGenerator` proposes commands, `Precondition` filters them, and `NextModel` threads the model forward, all without touching the real system. Execution then builds the real system, runs the same commands through `Execute`, and checks each result against `Postcondition` and the model against `Invariant`. + +When the two disagree, the failing command sequence is shrunk, so you get the shortest sequence that separates them. + +## Searching for a state + +Sometimes the question is not "does this property hold" but "can the system ever get here". Give the library a transition relation and a target, and it searches breadth first. + +```metta +(= (counter-enumerate (Count $n)) + (if (< $n 4) (FiniteCommands up split) (FiniteCommands))) +(= (counter-transition (Count $n) up) (Count (+ $n 1))) +(= (counter-transition (Count $n) split) (superpose ((Count (+ $n 1)) (Count (+ $n 2))))) +(= (counter-target (Count $n)) (== $n 3)) + +!(fuzz-reachable Counter (Count 0) + counter-enumerate counter-transition counter-target + (reach-config (MaxDepth 20))) +``` + +```text +(FuzzReachable (Property Counter) (Depth 2) (Commands (up split)) + (Witness ((Step 0 up 0) (Step 1 split 1))) (Target (quote (Count 3))) ...) +``` + +Breadth first means the first witness found is the shortest. A transition may return several next states, and all of them become edges, so the witness records which branch it took at each step and can be replayed through a nondeterministic model. It is replayed, in fact, before the result is reported: if replaying the witness does not reproduce the state, the answer is a cutoff rather than a claim, because a relation that is not a function of the state cannot support a witness. + +The four answers are kept apart on purpose, and the difference matters: + +| Answer | What it means | +| --- | --- | +| `FuzzReachable` | A witness, replayed from the initial state before being reported. | +| `FuzzReachabilityExhausted` | Unreachable in the declared finite model: the frontier ran dry with every enumeration complete. | +| `FuzzUnreachableWithinDepth` | Nothing found at or below `MaxDepth`. Says nothing about deeper states. | +| `FuzzReachabilityCutoff` | A limit fired, an enumeration was incomplete, or a replay disagreed. | + +`MaxDepth` bounds the depth of every state considered, so a witness is never longer than it. The boundary level is still enumerated, because a state with no commands ends the model while a state with commands continues past the bound, and that is the difference between exhaustion and a depth answer. + +## Running a suite + +Declare your tests as data and let the CLI find them, instead of writing a query per property. + +```metta +(FuzzTest involution (gen-list (gen-int -20 20) 0 6) reverse-involution + (fuzz-config (Runs 200))) +(FuzzTest bounded (gen-int 0 9) sum-nonnegative (fuzz-config (Runs 50))) +``` + +```bash +metta fuzz suite.metta # run every declaration +metta fuzz --list suite.metta # see what is declared, run nothing +metta fuzz --seed 7 --runs 50 suite.metta # override each declaration's config +metta fuzz --exhaustive suite.metta # enumerate each domain instead +metta reach suite.metta # run every (FuzzReachTest ...) +``` + +Each line reports one declaration, and the exit code is the run's verdict: 0 for a pass or a definitive answer, 1 for a property failure, 2 for invalid input or corrupt stored data, 3 for an incomplete run. + +```text +ok involution 213 cases, seed 0 +FAILED bounded ExpectedTrue (-1) +``` + +Reading a suite does not run the file's own `!` queries. That keeps discovery from being a way to execute whatever else the file would have done; `import!` is kept, because a property defined in another file would be undefined without it. + +## Keeping the failures you found + +A counterexample is worth more than the run that found it. Point the CLI at a directory and it will replay what it stored before generating anything new: + +```bash +metta fuzz --corpus regressions suite.metta # replay stored cases, record new ones +metta fuzz --corpus regressions --no-record suite.metta # replay only, for CI +``` + +Each counterexample becomes one small file, named for the digest of its own contents, so recording the same one twice changes nothing. Commit the directory: the failure then travels with the code that caused it, and the run that first found it does not have to be lucky twice. + +Values are stored through a versioned codec rather than printed, which matters more than it sounds. A float is written as its two 32-bit words, so a counterexample of `NaN` or `-0.0` comes back exactly, and a value holding a live host object is refused outright instead of being written back as something that only looks like it. + +A corpus file that cannot be read stops the run with exit code 2. Quietly skipping it would drop a known failure while still calling the run clean. + +## Reading a result from TypeScript + +Results are atoms, so you can work with them in MeTTa. If you are driving from TypeScript, the package hands you a typed view: + +```ts +import { decodeFuzzOutcome, exitCodeForOutcomes, renderOutcomeLine } from "@mettascript/fuzz"; + +const outcome = decodeFuzzOutcome(resultAtom); +if (outcome.kind === "failed") console.log(renderOutcomeLine(outcome)); +process.exit(exitCodeForOutcomes([outcome])); +``` + +The decoder is strict: an atom it does not recognize comes back as an `undecodable` outcome, never as a pass. See the [API reference](/reference/fuzz) for the full surface. + +## Determinism + +A run is a function of its seed. The random source, the shrink order, the replay keys, and the enumeration order are all named and versioned, so the same seed gives the same cases and a reported failure reproduces. That is what makes a stored counterexample worth keeping and a shrunk value worth reading. diff --git a/website/guide/getting-started.md b/website/guide/getting-started.md index e1cec4d..819a079 100644 --- a/website/guide/getting-started.md +++ b/website/guide/getting-started.md @@ -111,4 +111,4 @@ See the **[typed eDSL](/edsl/overview)** for builders, the tagged template, and ## Where to next -You now have MeTTa running. To learn the language, start with **[Main concepts](/learn/evaluation/main-concepts)**. To go deeper on the TypeScript side, see **[Running MeTTa in TypeScript](/typescript/running-metta)**. +You now have MeTTa running. To learn the language, start with **[Main concepts](/learn/evaluation/main-concepts)**. To go deeper on the TypeScript side, see **[Running MeTTa in TypeScript](/typescript/running-metta)**. To test what you write against every input rather than a few examples, see **[Property testing](/fuzz/overview)**. diff --git a/website/index.md b/website/index.md index bc0fac5..b5a9890 100644 --- a/website/index.md +++ b/website/index.md @@ -38,6 +38,8 @@ features: details: One core ESM bundle, about 23 KB gzipped. No native addon, no required WASM, no Rust. Import it in a web page, a serverless handler, or an agent loop and go. - title: Immutable and concurrent details: Keep immutable snapshots you can branch and roll back. Grounded operations do real I/O, and concurrency primitives (par, race, once, with-mutex) and transactions build on top. + - title: Test it with properties, not examples + details: A property-testing library written in MeTTa itself ships with the toolkit. State what should hold for every input and it generates cases, shrinks a failure to the smallest one that still fails, and replays it. It also enumerates small domains exhaustively, checks a real system against a model over command sequences, and searches a transition relation for a reachable state. - title: Validated against the reference details: MeTTaScript implements MeTTa, the language of OpenCog Hyperon, and matches Hyperon's Rust reference on 270/270 oracle tests and the Lean-verified LeaTTa semantics. The library you pick up in a minute and the exact reference semantics are the same engine. --- diff --git a/website/reference/fuzz.md b/website/reference/fuzz.md new file mode 100644 index 0000000..c11af35 --- /dev/null +++ b/website/reference/fuzz.md @@ -0,0 +1,175 @@ + + +# @mettascript/fuzz + +Property testing, shrinking, exhaustive checking, model-based state machines, and bounded reachability, written in MeTTa. For a walk through the ideas, see [Property testing](/fuzz/overview); this page is the surface. + +```bash +npm install @mettascript/fuzz +``` + +Importing the package registers the `fuzz` module and its private grounded operations, so bare `@mettascript/core` resolves `(import! &self fuzz)` once the package has been imported anywhere. `registerFuzz()` is exported for a host that would rather register explicitly; it is idempotent, so calling it after the import changes nothing. + +```ts +import { registerFuzz } from "@mettascript/fuzz"; + +registerFuzz(); +``` + +The node, browser, and hyperon packages already import it, so nothing is needed there. + +## Entry points + +| Operation | Signature | What it does | +| --- | --- | --- | +| `fuzz-check` | `(fuzz-check )` | Generates cases, shrinks a failure, reports one result. | +| `fuzz-check-exhaustive` | `(fuzz-check-exhaustive )` | Enumerates the generator's whole domain instead of sampling. | +| `fuzz-check-machine` | `(fuzz-check-machine )` | Runs a declared `FuzzMachine` over generated command sequences. | +| `fuzz-reachable` | `(fuzz-reachable )` | Breadth-first search for a state satisfying the target. | +| `fuzz-run-suite` | `(fuzz-run-suite)` | Runs every `FuzzTest` declaration, one `FuzzSuiteResult` each. | +| `fuzz-run-suite-with` | `(fuzz-run-suite-with )` | The same, with config options replaced. | +| `fuzz-run-suite-exhaustive` | `(fuzz-run-suite-exhaustive )` | Every declaration, enumerated. | +| `fuzz-suite-tests` | `(fuzz-suite-tests)` | The declarations, without running them. | +| `fuzz-run-reach-suite` | `(fuzz-run-reach-suite)` | Runs every `FuzzReachTest` declaration. | +| `fuzz-run-reach-suite-with` | `(fuzz-run-reach-suite-with )` | The same, with reach options replaced. | +| `fuzz-reach-suite-tests` | `(fuzz-reach-suite-tests)` | The declared searches, without running them. | + +## Properties + +A property takes one generated value and returns a `FuzzProperty`. + +| Combinator | Signature | +| --- | --- | +| `fuzz-pass` | `(fuzz-pass)` | +| `fuzz-fail` | `(fuzz-fail
)` | +| `expect-true` | `(expect-true
)` | +| `expect-false` | `(expect-false
)` | +| `expect-atom-equal` | `(expect-atom-equal )` | +| `expect-alpha-equal` | `(expect-alpha-equal )` | +| `expect-results-exact` | `(expect-results-exact )` | +| `expect-results-alpha` | `(expect-results-alpha )` | +| `expect-results-multiset` | `(expect-results-multiset )` | +| `expect-results-set` | `(expect-results-set )` | + +Declare the property's type with a concrete return type, not `Atom`, or the call is left unreduced: + +```metta +(: reverse-involution (-> Atom FuzzProperty)) +(= (reverse-involution $xs) (expect-atom-equal (reverse (reverse $xs)) $xs)) + +!(fuzz-check reverse-involution (gen-list (gen-int 0 9) 0 4) reverse-involution + (fuzz-config (Runs 10))) +``` + +A property can also annotate its own case, which shows up in the run's statistics rather than changing its verdict: `(fuzz-annotate )`, `(fuzz-classify