diff --git a/.github/cert-lanes.json b/.github/cert-lanes.json index a68072187..37e701828 100644 --- a/.github/cert-lanes.json +++ b/.github/cert-lanes.json @@ -96,26 +96,36 @@ "mode": "cargo", "smoke": true }, + { + "suite": "cert_hardening_spec", + "lane": "", + "mode": "cargo", + "features": "wasm,wasip2", + "smoke": true + }, { "suite": "cert_whole_module_guard_iso", "lane": "guard-iso-1/3", "mode": "nextest", "filter": "all()", - "partition": "1/3" + "partition": "1/3", + "smoke": true }, { "suite": "cert_whole_module_guard_iso", "lane": "guard-iso-2/3", "mode": "nextest", "filter": "all()", - "partition": "2/3" + "partition": "2/3", + "smoke": true }, { "suite": "cert_whole_module_guard_iso", "lane": "guard-iso-3/3", "mode": "nextest", "filter": "all()", - "partition": "3/3" + "partition": "3/3", + "smoke": true }, { "suite": "cert_verify_spec", diff --git a/.github/workflows/cert.yml b/.github/workflows/cert.yml index b4ebddf24..66fb15f6e 100644 --- a/.github/workflows/cert.yml +++ b/.github/workflows/cert.yml @@ -63,6 +63,17 @@ jobs: bad.append(f"{suite} {family}: expected 1..{n}, got {sorted(seen)}") if not any(lane.get('smoke') for lane in lanes): bad.append("no lane is marked smoke — every pull request would run nothing") + # Every certificate suite runs here, where Lean is installed. A suite + # without a lane would run only in ci.yml, whose runners have no + # `lake`, and its Lean-backed tests would skip there without a word. + # The one exception carries no Lean test. + import glob, os + no_lean = {'cert_delegate_spec', 'cert_one_build_spec'} # no Lean: byte identity runs in ci.yml's wasm-gc lane + laned = {lane['suite'] for lane in lanes} + for path in sorted(glob.glob('tests/cert_*.rs')): + suite = os.path.splitext(os.path.basename(path))[0] + if suite not in laned and suite not in no_lean: + bad.append(f"{suite} has no lane in .github/cert-lanes.json") if bad: print("\n".join(bad)); sys.exit(1) print(f"{len(lanes)} lanes, {len(groups)} partitioned families, all complete") @@ -75,8 +86,9 @@ jobs: run: | set -euo pipefail - # A pull request runs the smoke lanes only: the five cheapest that - # still reach all four suites, about five minutes of wall clock. They + # A pull request runs the smoke lanes only: the cheap ones that + # still reach every suite, plus the hardening tampers and the + # guard-isolation lanes, whose failures are soundness regressions. They # are marked in .github/cert-lanes.json rather than listed here, so # the full set stays the single source and a lane cannot be dropped # from one place and kept in the other. @@ -146,6 +158,9 @@ jobs: CARGO_BUILD_JOBS: '2' CARGO_INCREMENTAL: '0' RUSTFLAGS: -C debuginfo=0 + # Lean is installed on these runners, so a certificate test that finds + # no `lake` fails instead of skipping. + AVER_CERT_REQUIRE_LEAN: '1' steps: - uses: actions/checkout@v5 @@ -233,7 +248,7 @@ jobs: - name: Run certification suite if: matrix.mode == 'cargo' - run: cargo test -p aver-lang --features wasm --test ${{ matrix.suite }} + run: cargo test -p aver-lang --features ${{ matrix.features || 'wasm' }} --test ${{ matrix.suite }} - name: Run certification suite lane # Filtering happens before slice partitioning. Each family filter (one @@ -248,6 +263,6 @@ jobs: env: AVER_CERT_PHASE_TIMEOUT_SECS: ${{ matrix.phase_timeout_secs || 900 }} run: >- - cargo nextest run -p aver-lang --features wasm --test ${{ matrix.suite }} + cargo nextest run -p aver-lang --features ${{ matrix.features || 'wasm' }} --test ${{ matrix.suite }} -E '${{ matrix.filter }}' --partition slice:${{ matrix.partition }} diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 8cfc76e63..58596a561 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -105,7 +105,9 @@ jobs: - name: aver-lang unit and docs command: cargo test -p aver-lang --lib --bins && cargo test -p aver-lang --doc - name: workspace crates - command: cargo test --workspace --exclude aver-lang + # The workspace test builds aver-cert with its default `verify` + # feature only; the producer's unit tests need `engine` as well. + command: cargo test --workspace --exclude aver-lang && cargo test -p aver-cert --lib --all-features - name: integrations 1/4 command: python3 tools/ci_test_shard.py 0 4 - name: integrations 2/4 @@ -263,6 +265,20 @@ jobs: if: matrix.lane == 'checks' run: cargo test -p aver-lang --features wasm,wasip2 --test provider_spec --test capability_grammar_spec --test capability_target_manifest_spec + - name: Certificate coupling ratchet + if: matrix.lane == 'checks' + # An emitter or MIR change that makes a certified function decline must + # fail the PR that makes it, not the next Lean run. `--certify` writes + # the package without building it, so this needs no Lean: it compiles + # the certificate corpus and compares the certified exports, bridges + # and law-claims per program with tools/cert-baseline.json. A gain is + # recorded in the same commit with `python3 tools/cert_ratchet.py + # --update`. The binary is the one the canaries above just linked. + timeout-minutes: 10 + run: | + cargo build -p aver-lang --bin aver --features wasm,wasip2 + python3 tools/cert_ratchet.py --aver target/debug/aver + - name: Install Node for the JavaScript Work host if: matrix.lane == 'wasm-gc' uses: actions/setup-node@v4 @@ -303,6 +319,7 @@ jobs: bigint_literals_differential \ cert_certify_spec \ cert_decode_spec \ + cert_one_build_spec \ cert_verify_spec \ cross_backend_proptest \ cross_backend_stress \ diff --git a/AGENTS.md b/AGENTS.md index 0f4d32f51..1689dfd72 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -46,7 +46,7 @@ Below: implementation details relevant to development only. - **Opaque types** (`exposes opaque [T]`): module-level access control for types. An opaque type is visible in signatures (can be passed, returned, stored) but cannot be constructed, have its fields accessed, or be pattern-matched from outside the defining module. Enforced at compile time in the typechecker; `load_module_sigs` registers a dummy sig (type resolves) but omits field types, constructors, and variant info. Parser recognizes `exposes opaque` after the `Exposes` token by checking for `Ident("opaque")`. - **Provider-backed standard capabilities** (`stdlib/capabilities/`): `Args`, `Console`, `Disk`, `Env`, `Http`, `Process`, `Random`, `Tcp`, `Terminal`, and `Time` own their operation signatures, Oracle/replay declarations, hostile profiles, and represented boundary types in Aver source. VM and generated Rust bind exact-contract native providers through `src/provider/standard.rs`; their native adapters live in `aver-rt/src/provider/`. `Process.stopRequested` is a monotonic cooperative SIGINT/SIGTERM flag; wasm-gc supplies it as a host import and wasip2 rejects it because WASI 0.2 has no signal binding. Disk includes byte-exact whole-file, positional, write, and append methods plus metadata `size`; `readBytesAt` returns at most the requested length and treats EOF as a successful short read, and `sync` forces one path's bytes and metadata to stable storage — a file or a directory, because a file's own fsync does not make its directory entry durable. `Http.Response` and `Terminal.Size` are represented capability-owned records; `Tcp.Connection` is a provider-owned capability resource, not a surface record or an `exposes opaque` type. wasm-gc and wasip2 register supported host/WASI lowerings as bindings of the same contracts, with operation-level target availability where only part of a capability is supported. Standard capability operations are not legacy service builtins. - **WASM-GC backend** (`src/codegen/wasm_gc/`, feature-gated behind `--features wasm`): compiles Aver to wasm modules using the WebAssembly GC + tail-call proposals (typed structs/arrays, no linear-memory heap for first-class values). Two emission modes share the lowering pipeline: (a) `--target wasm-gc` for browsers / Workers / JS hosts via the `aver/*` standard host ABI plus contract-derived `aver:user/cap-…` imports for program-defined capabilities; (b) `--target wasip2` (and `aver run --wasip2`) for the WASI 0.2 / Component Model story — the same backend emits canonical-ABI WIT imports (`wasi:cli/stdout`, `wasi:filesystem/preopens`, `wasi:io/streams`, ...) and `src/codegen/wasip2/wrap.rs` wraps the core module via `wit-component`, no preview-1 adapter. Custom raw wasm-gc imports use native GC values, `externref` resources, full `Int = ℤ`, and generated `__cap_abi_*` factory/accessor exports; see [docs/wasm-gc-custom-capabilities.md](docs/wasm-gc-custom-capabilities.md). Effect set on wasip2: Console, Time, Random, Args, Env (read), all Disk, all `Http.*` verbs, the connected half of `Tcp` (`connect`, `close`, `writeLine`, `writeBytes`, `writeNow`, `readLine`, `readBytes`, `readSome`, `readNow`, `poll`, `send`, `sendBytes`, `ping`), and the reserved job contracts `Wait.poll` and `Work.cancel`; `Terminal.*`, `Env.set`, `Process.*`, and the seven `Tcp` dial/listener operations are compile-rejected. Job kinds on wasm-gc use the versioned `aver:work/v1` ABI: the native runner and Wasmtime packs schedule isolated worker instances over shared compiled code, and `tools/wasm-work` supplies a JavaScript Worker adapter. Task/result transport uses owned values and generated capability helpers; generated coordinators expose a post-wait step so JS can receive worker messages between turns. WASI 0.2 retains inline `begin`. See [docs/wasm-work.md](docs/wasm-work.md); lowering is in `src/codegen/wasm_gc/jobs.rs`, native scheduling in `src/runtime/wasm_gc/host_work/`. Incoming HTTP is an explicit `--handler ` export in fetch/proxy worlds, while native programs use the Aver `HttpServer` module over `Tcp` (see [docs/wasip2.md](docs/wasip2.md)). The legacy linear-memory `--target wasm` backend was deleted in 0.18 Phase 1.8, and its `abi.rs` import table with it. Standard host imports are enumerated by `EffectName` in `src/codegen/wasm_gc/effects.rs` and mirrored in `aver-cert/src/format.rs`; custom imports are admitted by the exact hashed namespace grammar in both Rust and the Lean wall. -- **Artifact certificates** (`aver-cert/`): `aver-cert` 0.1.x is an independently versioned verifier/process; `aver cert` is an exact subprocess shortcut. Public package version is `1` (`FORMAT_VERSION`) and manifest schema version is `8` (`CERT_SCHEMA_VERSION`): schema 2 made the subject `hostRoleTable` optional — `null` for modules without the Int box helper, pinned against a byte-derived proof of the helper's absence; schema 3 added the required `toIndex` key to the object form; schema 4 added the required `cmp` and `eq` keys; schema 5 added the required top-level `target` field; schema 6 added the wasip2 component-envelope byte binding; schema 7 added the required top-level `laws` array — the law-claims surface whose `Laws.lean` corollaries the checker-owned witness re-elaborates and axiom-audits; schema 8 added the required top-level `sourceBridges` array and the `bridges` key on every law entry — the plan-equals-source surface, one kernel-checked theorem per compute-face export identifying the plan its obligation evaluates with the transpiled source function. A bridge entry transports STRUCTURE (export, model, and one closed-form encoder per parameter and result); the checker renders the pinned statement from it with `aver-cert/src/bridge_statement.rs`, the same renderer the producer writes `Bridge.lean` with, so no statement text the package writes is ever read as a claim. A law-claim listing bridges carries a second `_bridged` corollary conjoining them, pinned and audited apart from the law's own. `Plans.lean` is the sole authoritative plan data, while the verifier supplies the actual artifact bytes, Lean 4.34 wall, build, and witness. See [docs/certification.md](docs/certification.md) and [docs/certification-architecture.md](docs/certification-architecture.md). +- **Artifact certificates** (`aver-cert/`): `aver-cert` 0.1.x is an independently versioned verifier/process; `aver cert` is an exact subprocess shortcut. Public package version is `1` (`FORMAT_VERSION`) and manifest schema version is `9` (`CERT_SCHEMA_VERSION`): schema 2 made the subject `hostRoleTable` optional — `null` for modules without the Int box helper, pinned against a byte-derived proof of the helper's absence; schema 3 added the required `toIndex` key to the object form; schema 4 added the required `cmp` and `eq` keys; schema 5 added the required top-level `target` field; schema 6 added the wasip2 component-envelope byte binding; schema 7 added the required top-level `laws` array — the law-claims surface whose `Laws.lean` corollaries the checker-owned witness re-elaborates and axiom-audits; schema 8 added the required top-level `sourceBridges` array and the `bridges` key on every law entry — the plan-equals-source surface, one kernel-checked theorem per compute-face export identifying the plan its obligation evaluates with the transpiled source function. A bridge entry transports STRUCTURE (export, model, and one closed-form encoder per parameter and result); the checker renders the pinned statement from it with `aver-cert/src/bridge_statement.rs`, the same renderer the producer writes `Bridge.lean` with, so no statement text the package writes is ever read as a claim. A law-claim listing bridges carries a second `_bridged` corollary conjoining them, pinned and audited apart from the law's own; the list must be exactly the bridges of the functions its statement names. Schema 9 states every obligation over one plan grammar (the optimized MIR printed 1:1), and a bridge statement is an application of the wall's `GrammarBridge.Exact`/`Adequate` with `nat_lit` numerals. The checker's witness is pure `_root_`-qualified pins; a separate checker-authored audit program, elaborated without the package, audits axioms, package instances, parser extensions and bridge encoder shapes; the final `leanchecker --fresh` replays the witness and its whole import closure; the package text gate (`aver-cert/src/lean_gate.rs`) is token-based and admits only listed `set_option`s. `Plans.lean` is the sole authoritative plan data, while the verifier supplies the actual artifact bytes, Lean 4.34 wall, build, and witness. See [docs/certification.md](docs/certification.md) and [docs/certification-architecture.md](docs/certification-architecture.md). - **Independent products** (`?!` / `!`): a tuple followed by `!` is a product of independent computations; `?!` adds Result unwrapping. `Expr::IndependentProduct(Vec>, bool)` in AST. Parser detects `?` + `!` or bare `!` after tuple in `parse_postfix`. Typechecker: `?!` verifies all elements are `Result` with compatible error types and that elements are function calls; `!` infers as regular tuple. Interpreter: sequential evaluation with replay groups. Codegen: `std::thread::scope` with real parallelism. VM: `CALL_PAR` dispatches callable values plus per-branch arity, so aliases like `f = foo; (f(x), f(y))!` work. Replay: effects within a product share `group_id`, matched by `branch_path + effect_occurrence + effect_type + effect_args`, not execution order. See [docs/independence.md](docs/independence.md). ### Design omissions diff --git a/CHANGELOG.md b/CHANGELOG.md index 6b4a14c01..b896164ae 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -104,6 +104,10 @@ The generated loop is now written from the program's source alone, and the manif - **A call inside a `!` or `?!` branch is numbered from zero, whatever the surrounding body has already charged.** A branch is its own numbering scope in a run: every operation gets a fresh slot each time the branch is entered. A body threading the `Process.stopRequested` base used to carry that base into its branches, so a poll inside an independent product was exported at the loop's turn count while the run charged it 0 on every turn, and from the second turn on the exported model computed a different function from the one the run computes. The branch now numbers its own calls and a law over such a loop keeps a theorem about the run. ### Changed +- **`aver-cert check` scales to large modules.** The checker used to decode the type, export and code sections one byte at a time, and the kernel kept a copy of the rest of the section for every byte, so a 740 KB module ran out of memory at the export accounting and spent over fifty minutes on the String helper roles. A package now declares the byte length of every entry of those three sections; the checker decodes each entry on its own and requires it to fill its declared length exactly, so a wrong length declines the package. The export accounting and the certified-closure check sort their keys instead of indexing them in balanced trees. What a certificate proves is unchanged, and certificates produced by earlier versions name a different wall and must be produced again. + +- **`aver-cert verify` builds without caches, and the verifier writes `Module.lean` itself.** `verify` now ignores `AVER_CERT_DATA_CACHE` and `AVER_CERT_PRELUDE_CACHE` and prints a notice; only `check` uses them. A certificate package no longer carries `Module.lean`: the verifier renders the artifact hash into it from the bytes it reads, and ignores a package file of that name. Packages declaring names inside the verifier's own Lean namespaces are declined. Certificates produced by earlier versions name a different wall and must be produced again. + - **Five kinds of law that used to stay open, or break the Lean build, now prove.** A law whose `given` ranges over a refinement record no longer fails the exported project, which used to cost every other law in the file its tier: each sample is substituted into the proof instead of case-split, a sample carries its type where it meets a `when`, the sampled-domain proof sits under a `sorry` floor, and a module called `Min` or `Max` no longer clashes with a core Lean name in the lakefile. A law over a sum type whose variant carries a payload is split by constructor before the closers run. A law that divides by a variable, such as `n * quot(a, n) + rem(a, n) => a` or `0 <= rem(a, n) < n` under `n >= 1`, now cites the quotient-remainder facts of Lean's `Int` division, which is Euclidean like Aver's `Int.div` and `Int.mod`. A list induction whose step needs the subject's own `if` split before anything else is simplified (`count(y, insert(x, xs))`) keeps its induction hypothesis. A cited law about a non-recursive helper (`ok(push(x, xs))` under `ok(xs)`) is applied before that helper is unfolded. Each new step is tried after the ones that were there before, so a law that already proved keeps its proof. - **A law whose claim reveals a helper that matches on a name closes again.** The alternative that reveals every outer helper at once and then lets the solver saturate was also offered when a revealed body still held a match the goal had not resolved, and on a large corpus that is a deterministic timeout, which stops the whole export rather than falling through to the alternatives that open one computation at a time. It is no longer offered on that shape. Measured on an external corpus of a hundred and twenty laws: all of them close, where one of them had stopped closing. diff --git a/Cargo.lock b/Cargo.lock index 0da310458..cd054be9a 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -150,7 +150,6 @@ dependencies = [ "colored", "serde_json", "sha2", - "wasm-encoder 0.248.0", "wasmparser 0.248.0", "wat", ] diff --git a/Cargo.toml b/Cargo.toml index df4691f76..f2985cb0d 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -154,3 +154,9 @@ required-features = ["wasm"] [profile.release] lto = true codegen-units = 1 + +# The certificate checker hashes its build caches (hundreds of MiB of `.olean` +# files) with SHA-256; unoptimised, that hashing alone costs seconds per check +# in the debug builds the developer loop and the test suites use. +[profile.dev.package.sha2] +opt-level = 3 diff --git a/aver-cert/Cargo.toml b/aver-cert/Cargo.toml index 0cee74207..31990e116 100644 --- a/aver-cert/Cargo.toml +++ b/aver-cert/Cargo.toml @@ -20,11 +20,10 @@ include = [ [features] default = ["verify"] -# Plan surface only: the fragment/sym plan IR types plus the canonical byte -# lowering the wasm-gc emitter consumes in every build. No classifier, no -# renderer, no embedded Lean wall — this keeps ordinary (non-certify) -# compiler builds free of the certificate engine. -plans = ["dep:wasm-encoder"] +# Plan surface only: the one-grammar plan data types the compiler prints +# into. No producer, no renderer, no embedded Lean wall — this keeps ordinary +# (non-certify) compiler builds free of the certificate engine. +plans = [] engine = ["plans", "dep:sha2", "dep:wasmparser"] producer = ["engine"] verify = [ @@ -45,7 +44,6 @@ clap = { version = "4", features = ["derive"], optional = true } colored = { version = "2", optional = true } serde_json = { version = "1", optional = true } sha2 = { version = "0.10", optional = true } -wasm-encoder = { version = "0.248", optional = true } wasmparser = { version = "0.248", optional = true } [dev-dependencies] diff --git a/aver-cert/assets/wall/current/AcceptanceSoundness.lean b/aver-cert/assets/wall/current/AcceptanceSoundness.lean index d5fef45a0..cab000b01 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundness.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundness.lean @@ -1,188 +1,203 @@ /- -ACCEPTANCE-SOUNDNESS ASSEMBLY. - -The audited byte predicates do not constrain the semantic faces of an -`Obligation` (`policy`, `Dom`, `Cod`, representations, and `model`). The -family discharge theorems therefore expose those faces as semantic bridge -predicates. For the Int-dispatch and named-ADT constructor families those -bridges are no longer producer premises: the checked standard faces carry -declared-index envelope pins. String.concat likewise derives its bridge from a -checked standard face, but its ABI/type-section evidence is carried by -`stringConcatPlanAccepted` rather than by a synthetic declared envelope. -`dischargeSideConditions` collects precisely the remaining assumptions; -everything else in this file is the mechanical ten-family assembly. +ACCEPTANCE-SOUNDNESS ASSEMBLY (statement schema 9). + +`fn_claim_discharges`: every obligation the wall derives from the plans holds +at its policy. One application of `GrammarSound.fn_certified_group` over ALL +plans (fuel induction: self, mutual and cross-group calls alike) gives every +planned function `FnCertified` at the one model of all plans; for an L3 +obligation, `GrammarTotal.fn_certified_total_of_check` over its call group, +with every function outside the group taken from that result, adds `FnTotal`. +The only runtime premises are the named contracts of `Schema.HostContracts` +(and `Schema.HostTotal` at L3); the box helper is the wall's `boxRef`, and the +never-declared negation index is the trap-only function. + +`accept_sound`: the conjuncts of `AcceptedArtifact.accepted` other than +`Holds` imply `Holds`, so `Holds` is derived, never asserted. The theorem is +about the plans' lowering (`codeOf`); the byte conjuncts of the acceptance +(`plansAccepted`) are what make that lowering the delivered code. -/ -import DischargeExprFragment -import DischargeFieldProjection -import DischargeConstruct -import DischargeVerbatim -import DischargeString -import DischargeIntDispatch -import DischargeRecursion -import DischargeComposition -import StandardFace -import DeclaredEnvelopeAcceptTransport +import AcceptanceSoundnessCore +import ClaimAxes open AverCert open AverCert.Schema +open AverCert.Grammar +open AverCert.TypeTable open AverCert.AcceptedArtifact +open CertPrelude namespace AcceptanceSoundness -/-- The String.eq half of `stringSemanticBridges`; the String.concat half is -derived from the checked declared-envelope face. -/ -def stringEqSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.stringEqClaims, - ∀ plan, - stringEqPlanForExport claim.exportName - artifact.manifest.stringEqPlans = some plan → - stringEqSemanticBridge claim plan - -/-- The non-named slice of `constructSemanticBridges`: bridges for the wall -canonical `List` constructor packs. Named user-ADT constructor bridges are -derived from the checked declared-envelope face. -/ -def constructListSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.constructClaims, - (∀ name, claim.symPlan.result ≠ .named name) → - ∀ plan, - constructPlanForExport claim.exportName - artifact.manifest.constructPlans = some plan → - constructSemanticBridge claim plan - -/-- Semantic premises still exposed by the kernel-clean family discharge -theorems after the declared-envelope faces took over the Int-dispatch, -named-ADT constructor, and String.concat bridges. Composition uses the tied -root/member bridge so a root's selected source models cannot be separated -from the member facts that discharge its calls. -/ -def dischargeSideConditions (artifact : ArtifactData) : Prop := - exprFragmentSemanticBridges artifact ∧ - stringEqSemanticBridges artifact ∧ - constructListSemanticBridges artifact ∧ - recursionSemanticBridges artifact ∧ - mutualSemanticBridges artifact ∧ - verbatimSemanticBridges artifact ∧ - fieldProjectionSemanticBridges artifact ∧ - compositionClaimSemanticBridges artifact - -/-! ### Face-derived semantic bridges - -Each lemma peels the family slice out of `StandardFace.checkedFaces`, reduces -the checked plan lookup, and hands the checked face to the matching transport, -which emits the exact residual bridge body the family discharge consumes. -/ - -theorem intDispatch_bridges_of_faces - (artifact : ArtifactData) - (hFaces : AverCert.StandardFace.checkedFaces artifact) : - intDispatchSemanticBridges artifact := by - obtain ⟨-, -, -, -, -, -, -, -, hInt, -, -⟩ := hFaces - intro claim hMem plan hPlan - have hMatch := allClaims_of_mem _ artifact.intDispatchClaims hInt claim hMem - obtain ⟨-, hArm⟩ := hMatch - rw [hPlan] at hArm - obtain ⟨hPolicy, -, typePrefix, env, hFace⟩ := hArm - exact AverCert.DeclaredIndexEnvelope.face_gives_declaredIntDispatch_bridge - artifact.modBytes artifact.modLen typePrefix env plan claim.obligation - hFace hPolicy - -theorem stringConcat_bridges_of_faces - (artifact : ArtifactData) - (hFaces : AverCert.StandardFace.checkedFaces artifact) : - ∀ claim ∈ artifact.stringConcatClaims, - ∀ plan, - stringConcatPlanForExport claim.exportName - artifact.manifest.stringConcatPlans = some plan → - stringConcatSemanticBridge claim plan := by - obtain ⟨-, -, -, hConcat, -, -, -, -, -, -, -⟩ := hFaces - intro claim hMem plan hPlan - have hMatch := allClaims_of_mem _ artifact.stringConcatClaims hConcat claim hMem - rw [AverCert.StandardFace.stringConcatMatches, hPlan] at hMatch - obtain ⟨-, -, typePrefix, env, hFace⟩ := hMatch - exact AverCert.DeclaredIndexEnvelope.face_gives_declaredStringConcat_bridge - artifact.modBytes artifact.modLen typePrefix env claim.resultTy - claim.containerTy plan claim.obligation hFace - -theorem construct_bridges_of_faces - (artifact : ArtifactData) - (hFaces : AverCert.StandardFace.checkedFaces artifact) - (hList : constructListSemanticBridges artifact) : - constructSemanticBridges artifact := by - obtain ⟨-, -, -, -, hConstruct, -, -, -, -, -, -⟩ := hFaces - intro claim hMem plan hPlan - have hMatch := allClaims_of_mem _ artifact.constructClaims hConstruct claim hMem - rw [AverCert.StandardFace.constructMatches, hPlan] at hMatch - cases hRes : claim.symPlan.result with - | named name => - rw [hRes] at hMatch - obtain ⟨-, -, -, typePrefix, env, hhit, hFace⟩ := hMatch - exact AverCert.DeclaredIndexEnvelope.face_gives_declaredConstruct_bridge - artifact.modBytes artifact.modLen typePrefix env claim.structIdx hhit - plan claim.obligation hFace - | int => exact hList claim hMem (fun name h => by simp [hRes] at h) plan hPlan - | float => exact hList claim hMem (fun name h => by simp [hRes] at h) plan hPlan - | bool => exact hList claim hMem (fun name h => by simp [hRes] at h) plan hPlan - | string => exact hList claim hMem (fun name h => by simp [hRes] at h) plan hPlan - | app1 name arg => - exact hList claim hMem (fun n h => by simp [hRes] at h) plan hPlan - | app2 name left right => - exact hList claim hMem (fun n h => by simp [hRes] at h) plan hPlan - -/-- Every claimed obligation holds. Membership in the audited concatenation -is split into its ten family slices, then discharged by the matching generic -family theorem. The Int-dispatch, named-ADT constructor, and String.concat -bridges are derived from the checked declared-envelope faces; the remaining -families consume the explicit side conditions. -/ -theorem hClaims_of_accepted - (artifact : ArtifactData) - (hFaces : AverCert.StandardFace.checkedFaces artifact) - (hAccepted : acceptedFragments artifact) - (hSide : dischargeSideConditions artifact) : - ∀ o ∈ claimObligations artifact, obligationHolds o := by - rcases hAccepted with - ⟨hSym, hStringEq, hStringConcat, hConstruct, hRecursion, hMutual, - hVerbatim, hIntDispatch, hFieldProjection, hComposition, _⟩ - rcases hSide with - ⟨hExprSemantic, hStringEqSemantic, hConstructListSemantic, - hRecursionSemantic, hMutualSemantic, hVerbatimSemantic, - hFieldProjectionSemantic, hCompositionSemantic⟩ - have hStringSemantic : stringSemanticBridges artifact := - ⟨hStringEqSemantic, stringConcat_bridges_of_faces artifact hFaces⟩ - have hConstructSemantic : constructSemanticBridges artifact := - construct_bridges_of_faces artifact hFaces hConstructListSemantic - have hIntDispatchSemantic : intDispatchSemanticBridges artifact := - intDispatch_bridges_of_faces artifact hFaces +section Discharge +variable {s : Subject} {tt : TypeTable} {fns : List FnEntry} + +/-- The named contracts give the grammar's Int contracts, with the wall's + `boxRef` as the box helper. -/ +theorem contracts_of {C : Nat} (S : CarrierSpec C) (h : HostFns) (hc : HostContracts S h) : + Contracts S (boxRef C) h.add h.sub h.mul h.cmp h.eq where + hBox := by + intro n w hlo hhi hw + simp only [boxRef, Option.some.injEq] at hw + subst hw + exact ⟨S.smallIntro n, (S.canonSmall n).mpr ⟨hlo, hhi⟩⟩ + hAdd := hc.add + hSub := hc.sub + hMul := hc.mul + hCmp := hc.cmp + hEq := hc.eq + +/-- Every planned function is certified at the one model of all plans. -/ +theorem fns_certified (hf : PlanFacts s tt fns) + (S : CarrierSpec (mctxOf s tt fns).carrier) (h : HostFns) (hc : HostContracts S h) : + ∀ f p, planOf fns f = some p → + FnCertified S (mctxOf s tt fns) (codeOf (mctxOf s tt fns) fns) + (hostOf (mctxOf s tt fns) h) f p.sig (fun fuel => modelOf fns fuel f) := by + obtain ⟨hBox, hAdd, hSub, hMul, hNeg, hCmp, hEq, hConcat, hStreq, hToIndex, hDivmod, + hClaims⟩ := + host_facts (M := mctxOf s tt fns) h hf.distinct + have R : XHost S (mctxOf s tt fns) (hostOf (mctxOf s tt fns) h) := + ⟨⟨_, hConcat, fun parts c hr => hc.stringConcat _ parts c hr⟩, + ⟨_, hStreq, fun a b r hr => hc.stringEq a b r hr⟩, + ⟨_, hToIndex, hc.toIndex⟩, + ⟨_, hDivmod, fun a b wa wb m r ha hb hne hm hr => + hc.divmod a b wa wb m r ha.1 hb.1 ha.2 hb.2 hne hm hr⟩⟩ + refine fn_certified_group S (boxRef _) h.add h.sub h.mul h.cmp h.eq (fun _ => none) + (contracts_of S h hc) (fun _ _ _ _ hr => by cases hr) _ _ (mctxOf s tt fns) rfl + hBox hAdd hSub hMul hNeg hCmp hEq R (planOf fns) (fun _ _ _ => none) ?_ ?_ + · intro f sig hs hG + simp [mctxOf, hG] at hs + · intro f p hp + obtain ⟨e, he, rfl, rfl⟩ := planOf_some hp + refine ⟨by simp [mctxOf, hp], hf.typed e he, hClaims e he, by simp [codeOf, hp]⟩ + +theorem obligationsOf_mem {o : Obligation} (ho : o ∈ obligationsOf s tt fns) : + ∃ e ∈ fns, o = obligationOf s tt fns e := by + unfold obligationsOf at ho + obtain ⟨e, he, rfl⟩ := List.mem_map.mp ho + exact ⟨e, (List.mem_filter.mp he).1, rfl⟩ + +theorem groupMembers_mem {g f : Nat} {p : FnPlan} (h : (f, p) ∈ groupMembers fns g) : + ∃ e ∈ fns, e.funcIdx = f ∧ e.plan = p := by + unfold groupMembers at h + obtain ⟨e, he, hep⟩ := List.mem_map.mp h + simp only [Prod.mk.injEq] at hep + exact ⟨e, (List.mem_filter.mp he).1, hep.1, hep.2⟩ + +/-- The partial half of every derived obligation. -/ +theorem obligation_holds (hf : PlanFacts s tt fns) {e : FnEntry} (he : e ∈ fns) : + (obligationOf s tt fns e).holds := by + intro S h hc fuel svs ws r hT hR hrun + exact (fns_certified hf S h hc e.funcIdx e.plan (planOf_mem hf.nodup he)).2.2 + fuel svs ws r hT hR hrun + +/-- The total half of an L3 obligation: its call group passed the wall's + termination check, so every member returns at fuel `n.natAbs + 1`. -/ +theorem obligation_total (hf : PlanFacts s tt fns) {e : FnEntry} (he : e ∈ fns) + {role : TotalityRole} (hck : checkTermGroup (groupMembers fns e.group) = some role) : + ∀ (S : CarrierSpec (obligationOf s tt fns e).carrier) (h : HostFns), HostContracts S h → + HostTotal S h role → + ∀ (svs : List SVal) (ws : List WVal), + HasTyL (obligationOf s tt fns e).layout svs (obligationOf s tt fns e).sig.params → + SReprL S (obligationOf s tt fns e).layout svs ws → + ∃ n tl, svs = .i n :: tl ∧ ∃ r sv, + wFuncN (obligationOf s tt fns e).code ((obligationOf s tt fns e).host h) + (n.natAbs + 1) (obligationOf s tt fns e).self ws = some r ∧ + (obligationOf s tt fns e).model (n.natAbs + 1) svs = some sv ∧ + SRepr S (obligationOf s tt fns e).layout sv r ∧ + HasTy (obligationOf s tt fns e).layout sv (obligationOf s tt fns e).sig.ret := by + intro S h hc ht + let ms := groupMembers fns e.group + have hnd := hf.nodup + have hmsnd : (ms.map (·.1)).Nodup := by + have hsub : ms.map (·.1) = (fns.filter (·.group == e.group)).map (·.funcIdx) := by + simp [ms, groupMembers, Function.comp_def] + rw [hsub] + exact hnd.sublist (List.Sublist.map _ (List.filter_sublist)) + have hGall : ∀ m ∈ ms, groupOf ms m.1 = some m.2 := by + intro m hm + have := find?_key_nodup (fun y : Nat × FnPlan => y.1) hmsnd hm + simp only [groupOf] + rw [this] + rfl + have hGP : ∀ f p, groupOf ms f = some p → planOf fns f = some p := by + intro f p hg + obtain ⟨e', he', rfl, rfl⟩ := groupMembers_mem (groupOf_mem hg) + exact planOf_mem hnd he' + obtain ⟨hBox, hAdd, hSub, hMul, hNeg, hCmp, hEq, hConcat, hStreq, hToIndex, hDivmod, + hClaims⟩ := + host_facts (M := mctxOf s tt fns) h hf.distinct + have R : XHost S (mctxOf s tt fns) (hostOf (mctxOf s tt fns) h) := + ⟨⟨_, hConcat, fun parts c hr => hc.stringConcat _ parts c hr⟩, + ⟨_, hStreq, fun a b r hr => hc.stringEq a b r hr⟩, + ⟨_, hToIndex, hc.toIndex⟩, + ⟨_, hDivmod, fun a b wa wb m r ha hb hne hm hr => + hc.divmod a b wa wb m r ha.1 hb.1 ha.2 hb.2 hne hm hr⟩⟩ + have hAll := fns_certified hf S h hc + have key := fn_certified_total_of_check S (boxRef _) h.add h.sub h.mul h.cmp h.eq + (fun _ => none) (contracts_of S h hc) (fun _ _ _ _ hr => by cases hr) + (codeOf (mctxOf s tt fns) fns) (hostOf (mctxOf s tt fns) h) (mctxOf s tt fns) rfl + hBox hAdd hSub hMul hNeg hCmp hEq R ms role hck (groupOf ms) + (fun f p hg => groupOf_mem hg) hGall (modelOf fns) + (by + intro f sig hs _ + simp only [mctxOf, Option.map_eq_some_iff] at hs + obtain ⟨p, hp, rfl⟩ := hs + exact hAll f p hp) + (by + intro f p hg + have hp := hGP f p hg + obtain ⟨e', he', rfl, rfl⟩ := planOf_some hp + exact ⟨by simp [mctxOf, hp], hf.typed e' he', hClaims e' he', by simp [codeOf, hp]⟩) + (fun k _ _ => boxRef_total _ k) ht.add ht.sub ht.mul + e.funcIdx e.plan (hGall (e.funcIdx, e.plan) (by + simp only [ms, groupMembers] + exact List.mem_map.mpr ⟨e, List.mem_filter.mpr ⟨he, by simp⟩, rfl⟩)) + intro svs ws hT hR + obtain ⟨n, tl, hsv, r, sv, hrun, hm, hrep, hty⟩ := key.2 svs ws hT hR + refine ⟨n, tl, hsv, r, sv, hrun, ?_, hrep, hty⟩ + show groupModel (fun _ _ _ => none) (planOf fns) (n.natAbs + 1) e.funcIdx svs = some sv + rw [← groupModel_restrict (planOf fns) (groupOf ms) hGP] + exact hm + +/-- Every derived obligation holds at its policy. -/ +theorem fn_claim_discharges (hf : PlanFacts s tt fns) : + ∀ o ∈ obligationsOf s tt fns, obligationHolds o := by intro o ho - simp only [claimObligations, List.mem_append] at ho - rcases ho with ho | ho - · rcases ho with ho | ho - · rcases ho with ho | ho - · rcases ho with ho | ho - · rcases ho with ho | ho - · rcases ho with ho | ho - · rcases ho with ho | ho - · rcases ho with ho | ho - · rcases ho with ho | ho - · exact exprFragment_discharges artifact hSym hFaces.2.1 - hExprSemantic o ho - · exact stringEq_discharges artifact hStringEq hStringSemantic o ho - · exact stringConcat_discharges artifact hStringConcat - hStringSemantic o ho - · exact construct_discharges artifact hConstruct - hConstructSemantic o ho - · exact recursion_discharges artifact hRecursion hRecursionSemantic o ho - · exact mutual_discharges artifact hMutual hMutualSemantic o ho - · exact verbatim_discharges artifact hVerbatim hVerbatimSemantic o ho - · exact intDispatch_discharges artifact hIntDispatch - hIntDispatchSemantic o ho - · exact fieldProjection_discharges artifact hFieldProjection - hFieldProjectionSemantic o ho - · exact composition_discharges_with_bridges artifact hComposition hCompositionSemantic - o ho - -/-- The faithful accept-sound capstone. Manifest coverage and export -uniqueness are recovered from `acceptedCompositionFragments`, which is an -unconditional slice of `acceptedFragments`. The artifact hash and -target/profile/ABI identity remains an explicit premise because it is fixed -statement metadata rather than a byte-derived fragment fact. -/ + obtain ⟨e, he, rfl⟩ := obligationsOf_mem ho + unfold obligationHolds + cases hpol : (obligationOf s tt fns e).policy with + | simulatesModel => exact obligation_holds hf he + | simulatesModelTotally => + refine ⟨obligation_holds hf he, ?_⟩ + have hax : (obligationOf s tt fns e).policy = (axesOf fns e).1 := rfl + have hrole : (obligationOf s tt fns e).totalityRole = (axesOf fns e).2.2 := rfl + unfold axesOf groupPolicy at hax hrole + cases hck : checkTermGroup (groupMembers fns e.group) with + | none => + rw [hck] at hax + rw [hax] at hpol + cases hpol + | some role => + rw [hck] at hrole + intro S h hc ht + rw [hrole] at ht + exact obligation_total hf he hck S h hc ht + +end Discharge + +/-- The statement at an artifact hash, without the generated `Module.lean`. -/ +def holdsAtHash (wasmSha256 : String) (m : Manifest) : Prop := + m.subject.artifactHash = wasmSha256 ∧ + m.subject.profile = expectedProfile ∧ + artifactTargetAbiAccepted m.subject.target m.subject.abi = true ∧ + HoldsCore m + +/-- ROOT THEOREM. The manifest's obligations are the derived ones and the plans + pass the acceptance's byte facts, hence every certified export's emitted + function simulates its plan's model (`holds`), and every L3 export also + returns at the checked fuel (`holdsTotal`), under exactly the named runtime + contracts. The hash and target/profile/ABI identity are premises: they are + fixed statement metadata, pinned by the checker. -/ theorem accept_sound (wasmSha256 : String) (artifact : ArtifactData) @@ -190,22 +205,74 @@ theorem accept_sound (hProfile : artifact.manifest.subject.profile = expectedProfile) (hTargetAbi : artifactTargetAbiAccepted artifact.manifest.subject.target artifact.manifest.subject.abi = true) - (hInManifest : fragmentClaimObligationsInManifest artifact) - (hFaces : AverCert.StandardFace.checkedFaces artifact) - (hAccepted : acceptedFragments artifact) - (hSide : dischargeSideConditions artifact) : + (hDerived : obligationsDerived artifact) + (hPlans : plansAccepted artifact = true) : holdsAtHash wasmSha256 artifact.manifest := by - have hAcceptedParts := hAccepted - rcases hAcceptedParts with - ⟨_, _, _, _, _, _, _, _, _, hComposition, _⟩ - rcases hComposition with ⟨_, _, hCover, hUnique⟩ - exact ⟨hHash, hProfile, hTargetAbi, - holdsCore_of_claims artifact hCover hInManifest hUnique - (hClaims_of_accepted artifact hFaces hAccepted hSide)⟩ - -#print axioms intDispatch_bridges_of_faces -#print axioms stringConcat_bridges_of_faces -#print axioms construct_bridges_of_faces + refine ⟨hHash, hProfile, hTargetAbi, ?_⟩ + rw [holdsCore_iff] + intro o ho + rw [hDerived] at ho + exact fn_claim_discharges (planFacts_of_accepted artifact hPlans) o ho + +/-! ### Non-vacuity + +`Obligation.holds` quantifies over well-typed source arguments. The +acceptance's declaration check (`TypeTable.declsWellFormed`) makes that +quantification non-empty: every certified export has well-typed arguments, +and its result type has a value, so no accepted obligation is true merely +because its hypothesis cannot be met. -/ + +/-- Every certified export of an accepted artifact has well-typed arguments + (and its result type is inhabited): its obligation is not vacuous. -/ +theorem accepted_nonvacuous (artifact : ArtifactData) + (hDerived : obligationsDerived artifact) (hPlans : plansAccepted artifact = true) : + ∀ o ∈ artifact.manifest.obligations, + (∃ svs, HasTyL o.layout svs o.sig.params) ∧ ∃ sv, HasTy o.layout sv o.sig.ret := by + intro o ho + rw [hDerived] at ho + obtain ⟨e, he, rfl⟩ := obligationsOf_mem ho + have hwf : declsWellFormed artifact.manifest.subject artifact.manifest.types + artifact.manifest.fnPlans = true := by + simp only [plansAccepted, Bool.and_eq_true] at hPlans + exact hPlans.2 + have hti : typesInhabited (mctxOf artifact.manifest.subject artifact.manifest.types + artifact.manifest.fnPlans) artifact.manifest.types artifact.manifest.fnPlans = true := by + simp only [declsWellFormed, Bool.and_eq_true] at hwf + exact hwf.2 + simp only [typesInhabited, Bool.and_eq_true, List.all_eq_true] at hti + have hsig := hti.2 e he + exact ⟨inhabitedL_sound (List.all_eq_true.mpr hsig.1), inhabited_sound hsig.2⟩ + +/-! ### S-3: the exact `ref.test` of an accepted artifact is the wasm test -/ + +/-- For every sum an accepted artifact declares, the interpreter's exact + `ref.test` on two of its constructor structs agrees with the wasm subtype + test, under the two wasm facts `GrammarSound.GcTestSpec` states about the + rec group that opens the type section. -/ +theorem refTest_exact_of_accepted (artifact : ArtifactData) + (hPlans : plansAccepted artifact = true) + {grp : List (List Nat × _root_.CertDecode.TypeEntry)} + (hg : firstRecGroup artifact.modBytes artifact.modLen = some grp) + {sub : Nat → Nat → Prop} (hspec : GcTestSpec (grp.map (·.1)) sub) + {d : SumDecl} (hd : d ∈ artifact.manifest.types.sums) {a b : Nat} + (ha : a < d.ctors.length) (hb : b < d.ctors.length) : + let M := mctxOf artifact.manifest.subject artifact.manifest.types artifact.manifest.fnPlans + M.ctorStruct d.tid a = M.ctorStruct d.tid b ↔ + sub (M.ctorStruct d.tid a) (M.ctorStruct d.tid b) := by + intro M + have hpin : S3Pin M d.tid d.ctors.length (grp.map (·.1)) = true := by + simp only [plansAccepted, Bool.and_eq_true] at hPlans + have htt := hPlans.1.1.1.2 + unfold typeTableConfirmed at htt + simp only [hg, Bool.and_eq_true, List.all_eq_true] at htt + have hs := htt.2.1.1.1.1.1.1.1.2 d hd + simp only [sumConfirmed, Bool.and_eq_true] at hs + exact hs.2 + exact ctor_refTest_exact hspec hpin ha hb + +#print axioms fn_claim_discharges #print axioms accept_sound +#print axioms refTest_exact_of_accepted +#print axioms accepted_nonvacuous end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean b/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean index 4e9649d6e..5331ba79b 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean @@ -1,208 +1,175 @@ /- ACCEPTANCE-SOUNDNESS CORE. -This file assembles the structural heart against the REAL audited types: -`holdsCore_of_claims` reduces `HoldsCore m` (∀ manifest obligation, it holds) -to the per-claim obligations holding, via the coverage bijection -(`manifestObligationsClaimed` + `fragmentClaimObligationsInManifest` + -export-name uniqueness). Each family's generic soundness theorem discharges -its slice of the per-claim hypothesis; the capstone wires all ten families. +The list and lookup facts the discharge needs, stated over the real audited +definitions: a planned function is found at its own index when indices are +unique; the host table resolves every role to its own function and every +planned index to nothing; the one group model over all plans agrees with a +group's model over the rest; and the two facts `plansAccepted` supplies to the +proof (distinct indices, typed plans). -/ import AcceptedArtifactCore -import ExprFragmentSoundness open AverCert open AverCert.Schema +open AverCert.Grammar +open AverCert.TypeTable open AverCert.AcceptedArtifact +open CertPrelude namespace AcceptanceSoundness -/-- Per-obligation denotation selected by policy — the body of `HoldsCore`. -/ +/-- Per-obligation denotation selected by policy: the body of `HoldsCore`. -/ def obligationHolds (o : Obligation) : Prop := match o.policy with | .simulatesModel => o.holds | .simulatesModelTotally => o.holdsTotal -/-- `HoldsCore` restated pointwise over the manifest obligation list. -/ theorem holdsCore_iff (m : Manifest) : HoldsCore m ↔ ∀ o ∈ m.obligations, obligationHolds o := by constructor <;> intro h o ho <;> exact h o ho -/-- Membership reflection for the audited `foldl insert` set index. -/ -private theorem mem_foldl_insert (xs : List String) (s : Std.TreeSet String) - (x : String) - (h : x ∈ xs.foldl (fun set value => set.insert value) s) : - x ∈ s ∨ x ∈ xs := by - induction xs generalizing s with - | nil => exact Or.inl h - | cons y ys ih => - have h' := ih (s := s.insert y) h - rcases h' with hset | hys - · rw [Std.TreeSet.mem_insert] at hset - simp only [Std.LawfulEqCmp.compare_eq_iff_eq] at hset - rcases hset with hyx | hs - · exact Or.inr (by simp [hyx]) - · exact Or.inl hs - · exact Or.inr (by simp [hys]) - -private theorem mem_of_orderedSet_contains (xs : List String) (x : String) - (h : (AverCert.WasmSlice.orderedSet xs).contains x = true) : x ∈ xs := by - have hm := Std.TreeSet.contains_iff_mem.mp h - rcases mem_foldl_insert xs Std.TreeSet.empty x hm with hempty | hxs - · exact (Std.TreeSet.not_mem_emptyc hempty).elim - · exact hxs - -/-- A successful `uniqueMap` contains the key of every source entry. -/ -private theorem uniqueMap_mem_key {β : Type u} (entries : List (String × β)) - (index : Std.TreeMap String β) - (hu : AverCert.WasmSlice.uniqueMap entries = some index) - (entry : String × β) (he : entry ∈ entries) : entry.1 ∈ index := by - induction entries generalizing index with - | nil => simp at he - | cons head tail ih => - cases htail : AverCert.WasmSlice.uniqueMap tail with - | none => simp [AverCert.WasmSlice.uniqueMap, htail] at hu - | some tailIndex => - by_cases hc : tailIndex.contains head.1 = true - · simp [AverCert.WasmSlice.uniqueMap, htail, hc] at hu - · simp only [AverCert.WasmSlice.uniqueMap, htail, hc, - Bool.false_eq_true, if_false, Option.some.injEq] at hu - subst index - simp only [List.mem_cons] at he - rcases he with rfl | he - · exact Std.TreeMap.mem_insert_self - · exact Std.TreeMap.mem_insert.mpr (Or.inr (ih tailIndex htail he)) - -/-- Unique export keys make `find?` return any listed obligation at its key. -/ -private theorem find?_eq_some_of_uniqueMap {α : Type u} (xs : List α) - (key : α → String) - (hunique : (AverCert.WasmSlice.uniqueMap - (xs.map fun x => (key x, x))).isSome = true) - (x : α) (hx : x ∈ xs) : - xs.find? (fun y => key y = key x) = some x := by - induction xs with - | nil => simp at hx - | cons head tail ih => - cases htail : AverCert.WasmSlice.uniqueMap - (tail.map fun y => (key y, y)) with - | none => simp [AverCert.WasmSlice.uniqueMap, htail] at hunique - | some tailIndex => - have hnot : tailIndex.contains (key head) = false := by - cases hc : tailIndex.contains (key head) with - | false => rfl - | true => - simp [AverCert.WasmSlice.uniqueMap, htail, hc] at hunique - simp only [List.mem_cons] at hx - rcases hx with rfl | hx - · simp - · have hne : key head ≠ key x := by - intro heq - have hmem : (key x, x) ∈ tail.map (fun y => (key y, y)) := by - exact List.mem_map.mpr ⟨x, hx, rfl⟩ - have hkey : key x ∈ tailIndex := - uniqueMap_mem_key _ _ htail _ hmem - have hcontains : tailIndex.contains (key x) = true := - Std.TreeMap.mem_iff_contains.mp hkey - rw [← heq, hnot] at hcontains - contradiction - have htailUnique : (AverCert.WasmSlice.uniqueMap - (tail.map fun y => (key y, y))).isSome = true := by - simp [htail] - simpa [hne] using ih htailUnique hx - -/-- The recursive claims-in-manifest predicate exposes the equation for any -listed claim obligation. -/ -private theorem find?_eq_claim_of_mem (manifest claims : List Obligation) - (h : claimObligationsInManifest manifest claims) - (o : Obligation) (ho : o ∈ claims) : - manifest.find? (fun candidate => candidate.export_ = o.export_) = some o := by - induction claims with - | nil => simp at ho - | cons head tail ih => - simp only [claimObligationsInManifest] at h - rcases h with ⟨hhead, htail⟩ - simp only [List.mem_cons] at ho - rcases ho with rfl | ho - · exact hhead - · exact ih htail ho - -/-- -STRUCTURAL HEART of the master. If every manifest obligation is claimed -(`manifestObligationsClaimed`), every claim's obligation is found-in-manifest -and equal (`fragmentClaimObligationsInManifest`), obligation export names are -unique, and every CLAIMED obligation holds, then `HoldsCore` holds for the -whole manifest. - -The bijection: a manifest obligation `o` has its export in the claimed set -(hCover); some claim carries that export; that claim's obligation is found in -the manifest by export and equals what `find?` returns; uniqueness of export -names forces that found obligation to be `o` itself; hence `o` is (equal to) a -claimed obligation and `hClaims` applies. --/ -theorem holdsCore_of_claims - (artifact : ArtifactData) - (hCover : manifestObligationsClaimed artifact = true) - (hInManifest : fragmentClaimObligationsInManifest artifact) - (hUnique : manifestObligationExportsUnique artifact = true) - (hClaims : ∀ o ∈ claimObligations artifact, obligationHolds o) : - HoldsCore artifact.manifest := by - rw [holdsCore_iff] - intro o ho - -- hCover: o.export_ is in the claimed-export set. - have hclaimed : (AverCert.WasmSlice.orderedSet - (claimObligationExports artifact)).contains o.export_ = true := by - have := hCover - simp only [manifestObligationsClaimed] at this - exact (List.all_eq_true.mp this) o ho - -- The claimed exports are exactly the export_ of claimObligations. - have hexp : o.export_ ∈ (claimObligations artifact).map (·.export_) := by - have hraw := mem_of_orderedSet_contains _ _ hclaimed - simpa only [claimObligationExports, claimObligations, List.map_append, - List.map_map, Function.comp_def] using hraw - -- Some claim obligation shares o's export; fragmentClaimObligationsInManifest - -- + uniqueness pin it to o; then hClaims closes. - rcases List.mem_map.mp hexp with ⟨claimed, hclaimedMem, hExport⟩ - have hClaimFind := find?_eq_claim_of_mem - artifact.manifest.obligations (claimObligations artifact) - hInManifest claimed hclaimedMem - rw [hExport] at hClaimFind - have hManifestFind : artifact.manifest.obligations.find? - (fun candidate => candidate.export_ = o.export_) = some o := by - apply find?_eq_some_of_uniqueMap artifact.manifest.obligations - (fun obligation : Obligation => obligation.export_) - · simpa only [manifestObligationExportsUnique] using hUnique - · exact ho - rw [hManifestFind] at hClaimFind - have hClaimedEq : claimed = o := (Option.some.inj hClaimFind).symm - simpa only [hClaimedEq] using hClaims claimed hclaimedMem - -/-- -MASTER TARGET (the capstone). The byte-acceptance conjuncts of the production -`accepted` predicate, MINUS the asserted `Holds`, plus obligation coverage, -imply `Holds` — i.e. `Holds` is derivable, not asserted. - -Stated here as the goal; its proof is `holdsCore_of_claims` (structural heart, -above) composed with the ten per-family discharges of `hClaims` from -`acceptedFragments` + each family's generic soundness theorem, plus the -hash and target/profile/ABI identity conjunct from checker-owned identity pins. -See VERDICT.md for the enumerated residual. --/ -def holdsAtHash (wasmSha256 : String) (m : Manifest) : Prop := - m.subject.artifactHash = wasmSha256 ∧ - m.subject.profile = expectedProfile ∧ - artifactTargetAbiAccepted m.subject.target m.subject.abi = true ∧ - HoldsCore m - -/-- Artifact-independent form of the production target. Supplying the -artifact's audited wasm hash recovers the thin `Schema.Holds` shim without -importing generated `Module.lean`. -/ -def masterTarget (wasmSha256 : String) (artifact : ArtifactData) : Prop := - subjectMatchesArtifactRoot artifact → - fragmentClaimObligationsInManifest artifact → - claimsMatchManifest artifact → - decodedNonExprFacts artifact → - acceptedFragments artifact → - manifestObligationsClaimed artifact = true → - holdsAtHash wasmSha256 artifact.manifest +/-! ### Unique keys -/ + +theorem find?_key_nodup {α : Type} (key : α → Nat) : + ∀ {l : List α}, (l.map key).Nodup → ∀ {x : α}, x ∈ l → + l.find? (fun y => key y == key x) = some x + | [], _, _, hx => by simp at hx + | a :: t, hnd, x, hx => by + simp only [List.map_cons, List.nodup_cons] at hnd + rcases List.mem_cons.mp hx with rfl | hxt + · simp + · have hne : key a ≠ key x := by + intro h + exact hnd.1 (by rw [h]; exact List.mem_map_of_mem hxt) + have hb : (key a == key x) = false := by simpa using hne + rw [List.find?_cons, hb] + exact find?_key_nodup key hnd.2 hxt + +theorem entryOf_mem {fns : List FnEntry} (hnd : (fns.map (·.funcIdx)).Nodup) + {e : FnEntry} (he : e ∈ fns) : entryOf fns e.funcIdx = some e := by + show fns.find? (fun y => y.funcIdx == e.funcIdx) = some e + exact find?_key_nodup (fun y => y.funcIdx) hnd he + +theorem planOf_mem {fns : List FnEntry} (hnd : (fns.map (·.funcIdx)).Nodup) + {e : FnEntry} (he : e ∈ fns) : planOf fns e.funcIdx = some e.plan := by + simp [planOf, entryOf_mem hnd he] + +theorem planOf_some {fns : List FnEntry} {f : Nat} {p : FnPlan} (h : planOf fns f = some p) : + ∃ e ∈ fns, e.funcIdx = f ∧ e.plan = p := by + unfold planOf entryOf at h + cases hf : fns.find? (·.funcIdx == f) with + | none => rw [hf] at h; cases h + | some e => + rw [hf] at h + simp only [Option.map_some, Option.some.injEq] at h + have hk := List.find?_some hf + simp only [beq_iff_eq] at hk + exact ⟨e, List.mem_of_find?_eq_some hf, hk, h⟩ + +/-! ### The host table -/ + +theorem lookup_of_nodup {β : Type} : + ∀ {l : List (Nat × β)}, (l.map (·.1)).Nodup → ∀ {k : Nat} {v : β}, (k, v) ∈ l → + l.lookup k = some v + | [], _, _, _, h => by simp at h + | (a, b) :: t, hnd, k, v, h => by + simp only [List.map_cons, List.nodup_cons] at hnd + rcases List.mem_cons.mp h with he | ht + · cases he + simp [List.lookup] + · have hne : k ≠ a := by + intro hk + subst hk + exact hnd.1 (List.mem_map_of_mem (f := (·.1)) ht) + have hb : (k == a) = false := by simpa using hne + simp only [List.lookup, hb] + exact lookup_of_nodup hnd.2 ht + +theorem lookup_none {β : Type} : + ∀ {l : List (Nat × β)} {k : Nat}, k ∉ l.map (·.1) → l.lookup k = none + | [], _, _ => rfl + | (a, b) :: t, k, h => by + simp only [List.map_cons, List.mem_cons, not_or] at h + have hb : (k == a) = false := by simpa using h.1 + simp only [List.lookup, hb] + exact lookup_none h.2 + +theorem hostAssoc_keys (M : MCtx) (h : HostFns) : + (hostAssoc M h).map (·.1) = roleIndices M := rfl + +/-- Under distinct role indices, the host table resolves every role to its own + function; under disjointness, every planned index to nothing. -/ +theorem host_facts {M : MCtx} {fns : List FnEntry} (h : HostFns) + (hd : (roleIndices M ++ fns.map (·.funcIdx)).Nodup) : + hostOf M h M.box = some (1, boxRef M.carrier) ∧ + hostOf M h M.add = some (2, h.add) ∧ + hostOf M h M.sub = some (2, h.sub) ∧ + hostOf M h M.mul = some (2, h.mul) ∧ + hostOf M h M.neg = some (1, fun _ => none) ∧ + hostOf M h M.cmp = some (2, h.cmp) ∧ + hostOf M h M.eq = some (2, h.eq) ∧ + hostOf M h M.concat = some (1, h.stringConcat M.str) ∧ + hostOf M h M.streq = some (2, h.stringEq) ∧ + hostOf M h M.toIndex = some (1, h.toIndex) ∧ + hostOf M h M.divmod = some (3, h.divmod) ∧ + ∀ e ∈ fns, hostOf M h e.funcIdx = none := by + have hkeys : ((hostAssoc M h).map (·.1)).Nodup := by + rw [hostAssoc_keys] + exact (List.nodup_append.mp hd).1 + have L : ∀ {k v}, (k, v) ∈ hostAssoc M h → hostOf M h k = some v := + fun hm => lookup_of_nodup hkeys hm + refine ⟨L (by simp [hostAssoc]), L (by simp [hostAssoc]), L (by simp [hostAssoc]), + L (by simp [hostAssoc]), L (by simp [hostAssoc]), L (by simp [hostAssoc]), + L (by simp [hostAssoc]), L (by simp [hostAssoc]), L (by simp [hostAssoc]), + L (by simp [hostAssoc]), L (by simp [hostAssoc]), ?_⟩ + intro e he + apply lookup_none + rw [hostAssoc_keys] + intro hr + have hdis := (List.nodup_append.mp hd).2.2 + exact hdis _ hr _ (List.mem_map_of_mem he) rfl + +/-! ### One model over all plans -/ + +/-- A group's model over the one model of all plans IS that model, when the + group's plans are plans of the artifact. -/ +theorem groupModel_restrict (P G : Nat → Option FnPlan) + (hGP : ∀ f p, G f = some p → P f = some p) : + ∀ k f args, groupModel (groupModel (fun _ _ _ => none) P) G k f args = + groupModel (fun _ _ _ => none) P k f args := by + intro k + induction k with + | zero => + intro f args + cases hG : G f with + | none => simp [groupModel, hG] + | some p => simp [groupModel, hG, hGP f p hG] + | succ k ih => + intro f args + have hfun : groupModel (groupModel (fun _ _ _ => none) P) G k = + groupModel (fun _ _ _ => none) P k := funext fun g => funext fun a => ih g a + cases hG : G f with + | none => simp [groupModel, hG] + | some p => simp [groupModel, hG, hGP f p hG, hfun] + +/-! ### What `plansAccepted` supplies to the proof -/ + +structure PlanFacts (s : Subject) (tt : TypeTable) (fns : List FnEntry) : Prop where + distinct : (roleIndices (mctxOf s tt fns) ++ fns.map (·.funcIdx)).Nodup + typed : ∀ e ∈ fns, planTyped (mctxOf s tt fns) e.plan = true + +theorem PlanFacts.nodup {s : Subject} {tt : TypeTable} {fns : List FnEntry} + (hf : PlanFacts s tt fns) : (fns.map (·.funcIdx)).Nodup := + (List.nodup_append.mp hf.distinct).2.1 + +theorem planFacts_of_accepted (artifact : ArtifactData) (h : plansAccepted artifact = true) : + PlanFacts artifact.manifest.subject artifact.manifest.types artifact.manifest.fnPlans := by + simp only [plansAccepted, Bool.and_eq_true, List.all_eq_true] at h + obtain ⟨⟨⟨⟨⟨hd, he⟩, _⟩, _⟩, _⟩, _⟩ := h + refine ⟨of_decide_eq_true hd, fun e hm => ?_⟩ + have := he e hm + simp only [entryAccepted, Bool.and_eq_true] at this + exact this.1.1 end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/AcceptedArtifact.lean b/aver-cert/assets/wall/current/AcceptedArtifact.lean index c9a666f8f..0a58ffde0 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifact.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifact.lean @@ -2,25 +2,27 @@ -- -- The dependency-closed acceptance machinery lives in -- `AcceptedArtifactCore.lean`; this shim adds the one conjunction that uses --- the Module-dependent `Schema.Holds` proposition. +-- the Module-dependent `Schema.Holds` proposition. `AcceptanceSoundness` +-- proves that `Holds` follows from the other conjuncts +-- (`AcceptanceSoundness.accept_sound`), so a certificate discharges it with +-- that theorem rather than asserting it. import Schema import AcceptedArtifactCore import ClaimAxes -import StandardFace import ArtifactComponentBytes namespace AverCert.AcceptedArtifact def accepted (artifact : ArtifactData) : Prop := - AverCert.Schema.Holds artifact.manifest ∧ - artifactEnvelopeAccepted AverCert.ArtifactComponentBytes.componentBytes - AverCert.ArtifactComponentBytes.componentLen artifact = true ∧ + _root_.AverCert.Schema.Holds artifact.manifest ∧ + artifactEnvelopeAccepted _root_.AverCert.ArtifactComponentBytes.componentBytes + _root_.AverCert.ArtifactComponentBytes.componentLen artifact = true ∧ subjectMatchesArtifactRoot artifact ∧ - fragmentClaimObligationsInManifest artifact ∧ - claimsMatchManifest artifact ∧ - AverCert.StandardFace.checkedFaces artifact ∧ - AverCert.ClaimAxes.checked artifact = true ∧ - decodedNonExprFacts artifact ∧ - acceptedFragments artifact + obligationsDerived artifact ∧ + plansAccepted artifact = true ∧ + decodedHostRoleTable artifact ∧ + decodedStringHostRoles artifact ∧ + _root_.AverCert.ClaimAxes.checked artifact = true ∧ + acceptedWholeModule artifact end AverCert.AcceptedArtifact diff --git a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean index 56740f652..4eafb0ad4 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean @@ -1,1542 +1,25 @@ --- Dependency-closed Lean-side artifact acceptance helpers. +-- Lean-side artifact acceptance for the one plan grammar (statement schema 9). -- --- These predicates pin checked plans and Wasm bindings to the --- `Schema.Obligation` fields used by the final certificate theorem. -import CertPrelude -import SchemaCore -import ArithTemplateDerisk -import PlanCheck -import PlanLower -import PlanBytes -import ExprFragmentAccepted +-- A certificate declares its plans (`Manifest.fnPlans`), the module layout +-- (`Manifest.types`) and the runtime helper indices (`Subject`). This file +-- derives the obligations from them (`obligationsOf`: the wall computes the +-- code, the host wiring, the model and the policy axes), and states the byte +-- facts the acceptance checks: every plan's lowering IS the function's code +-- entry, every call goes to a planned function of the same or an earlier +-- group, the helper indices are the byte-pinned helpers, and the whole module +-- is accounted for. +import TypeTable +import GrammarTotal import WasmSlice import CertDecode +import ArithTemplateDerisk import Wasip2Envelope namespace AverCert.AcceptedArtifact open AverCert.Schema open CertPrelude - -/-- Select the first plan attached to an export name. Every manifest plan -family uses this exact lookup; keeping it once prevents family-specific copies -from drifting in name comparison or first-match behaviour. -/ -def namedPlanForExport {Plan : Type u} (exportName : String) : - List (String × Plan) → Option Plan - | [] => none - | (name, plan) :: rest => - if name == exportName then some plan - else namedPlanForExport exportName rest - -/-- Canonical locals count declared by `lowerExprFragmentBodyBytes`: every - accepted expression fragment has one carrier scratch local. -/ -def exprFragmentNLocals (_plan : ExprFragmentRawPlan) : Nat := 1 - -/-- Artifact-level acceptance for one expression-fragment export. The body, - canonical code-entry bytes, and function binding are witnesses to the - audited Lean predicate `ExprFragmentAccepted.accepted`, existentially - quantified rather than accepted as external parameters. -/ -def exprFragmentPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Nat) - (plan : ExprFragmentRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - ∃ body codeEntry binding, - AverCert.ExprFragmentAccepted.accepted - modBytes modLen exportNameBytes carrier plan body codeEntry binding ∧ - AverCert.WasmSlice.exprFragmentFuncTypeMatches - modBytes modLen binding.typeIdx carrier plan.params plan.result = true ∧ - AverCert.WasmSlice.exprFragmentNominalTypesMatch - modBytes modLen binding.typeIdx carrier plan = true ∧ - obligation.self = binding.funcIdx ∧ - obligation.code binding.funcIdx = - some { arity := plan.params.length, - nlocals := exprFragmentNLocals plan, body := body } - -/-- Whether one representation-level fragment type names the Int carrier. - Every `FragTy` constructor is listed: a new one makes this match - non-exhaustive and stops the wall building, rather than silently defaulting - to "does not name the carrier". -/ -def fragTyIsIntCarrier : FragTy → Bool - | .intCarrier => true - | .f64 | .boolI32 | .i64 | .rawI32 | .ref | .adtRef => false - -/-- Does any node of this block — or of any block nested inside it — carry the - Int-carrier type? - - Every `FragNodeKind` constructor is listed explicitly, so a future - block-carrying node cannot slip past the walk unvisited: adding one makes - this match non-exhaustive and the wall stops building. Running out of fuel - answers `true` (REQUIRE the binding), never `false`; the walk is used to - decide whether a constraint applies, so its unreachable case must fail - closed. -/ -def fragBlockMentionsIntCarrierFuel : Nat → FragBlock → Bool - | 0, _ => true - | fuel + 1, block => - block.nodes.any fun node => - fragTyIsIntCarrier node.ty || - match node.kind with - | .ifElse _ thenBlock elseBlock => - fragBlockMentionsIntCarrierFuel fuel thenBlock || - fragBlockMentionsIntCarrierFuel fuel elseBlock - | .local _ | .constBool _ | .constI64 _ | .constI32 _ - | .constF64Bits _ | .structGet _ _ | .structGetUser _ _ _ - | .refIsNull _ | .prim _ _ | .hostCall _ _ _ | .selfCall _ _ _ - | .vectorGetOrDefault _ _ _ _ | .structNew _ _ - | .intSignCmp _ _ _ _ => false - -/-- Whether an encoded fragment plan names the Int carrier ANYWHERE. A - `FragTy` occurs in exactly three positions of an `ExprFragmentRawPlan` — - the parameter list, the result, and `FragNode.ty` of every node in the body - and in every nested block — and this visits all three. -/ -def fragPlanMentionsIntCarrier (plan : ExprFragmentRawPlan) : Bool := - plan.params.any fragTyIsIntCarrier || - fragTyIsIntCarrier plan.result || - fragBlockMentionsIntCarrierFuel AverCert.PlanCheck.maxFuel plan.body - -/-- When a source-fragment claim must present the byte-derived carrier index. - Both triggers are DERIVED from the claim's own data — the encoded plan and - the host table — never from a hand-listed set of families: - - * the encoded plan names `.intCarrier` anywhere, or - * the host table is non-empty. - - Keying on the host table alone was unsound. `StandardFace.fragment`'s - `domRepr` is `args = FragParams.encodeArgs carrier params values`, and - `FragTy.encodeArg` sends an `.intCarrier` parameter to - `CertPrelude.carrierSmall carrier value` — the CONCRETE three-field struct - `structv carrier [i64v k, null, i32v 0]` at the claimed index. A generic - Int fragment (`genericFragmentAllowed` forbids `.adtRef` parameters and - `.adtRef`/`.intCarrier` RESULTS, but admits `.intCarrier` PARAMETERS; the - Int-versus-constant comparison family lowers without consulting any host - role) therefore models that layout while citing no role at all, so an - empty table exempted a carrier-sensitive face. - - The residual permissive case is exactly "no `.intCarrier` in the encoded - plan AND no role cited". There the claimed index cannot reach the face's - meaning: `FragParams.encodeArgs`/`FragTy.resultRepr` mention `carrier` only - on `.intCarrier`, the remaining representations (`boolRepr`, - `floatBitsRepr`, `verbatimRepr`) and the projection face's - `vs = [.structv structIdx [p.1, p.2]]` discard the `CarrierSpec` argument, - and `host = emptyHost` presents no `boxRef carrier` slot. That case is what - keeps projection and float/string-boundary fragments certifiable in - carrierless modules. - - Interior node types are included even though only parameters and the result - reach the face; the walk is total and conservative by construction, which - is the side to err on. -/ -def symFragmentCarrierBindingRequired - (hostTable : List (HostRole × Nat)) (plan : ExprFragmentRawPlan) : Bool := - !hostTable.isEmpty || fragPlanMentionsIntCarrier plan - -/-- Byte-derived carrier binding for a source fragment. When the claim's own - data requires it (`symFragmentCarrierBindingRequired`), the claimed index - must be the one the module's own type section decodes to: - `CertDecode.carrierState` (three-state, fail-closed) must return - `some (some carrier)`. A byte-provably carrierless module (`some none`) and - a module whose type section does not decode (`none`) both reject. - - Because `CertDecode.TypeEntry.isCarrier` admits only a three-field struct - whose field 0 is `i64` and whose field 2 is `i32`, this equality also pins - the field COUNT of the type the `carrierSmall` layout is asserted at — a - claim naming a four-field struct is rejected here rather than certifying a - theorem quantified over states the module's type section forbids. - - This binding and the declared-type pin beside it are COMPLEMENTARY, not - alternatives. `hostTableFuncTypesMatch` compares each helper's declared - function type against the CLAIMED carrier, so on this family alone it was - circular (the expr-fragment carrier is claim data bound to no decoder — - see the scope note at `decodedStrictCarrierIndex`): a producer that - declares the box helper AT a fake supertype and claims that same fake - index satisfies the pin, while the template-pinned box BODY still builds - structs at the real byte-derived carrier — the face's `boxRef` would be a - fiction. The equality here removes the free reference point (catching - "both consistently fake"); the declared-type pin then catches "claimed - carrier right, helper type wrong", which no carrier equality can see. -/ -def symFragmentCarrierBound - (modBytes modLen carrier : Nat) - (hostTable : List (HostRole × Nat)) - (plan : ExprFragmentRawPlan) : Bool := - if symFragmentCarrierBindingRequired hostTable plan then - CertDecode.carrierState modBytes modLen == some (some carrier) - else - true - -/-- Artifact-level acceptance for one source-level symbolic fragment export. - The source plan is still untrusted data: the audited checker/encoder must - accept it and produce the representation-level expr-fragment plan before - the existing byte-origin predicate is allowed to run. - - Two conjuncts of this predicate constrain the CARRIER REFERENCE POINT the - proof faces are stated over: `symFragmentCarrierBound` forces the claimed - index to be the decoded one whenever the encoded plan or the host table can - make a face read it, and `hostTableFuncTypesMatch` forces every cited - helper's DECLARED function type to be the one its role fixes over that - index. Neither subsumes the other and both live here. - - The rest of the host-helper pinning lives in OTHER predicates and is not - duplicated here: the role-to-index binding against the decoded role table - is `StandardFace.hostTableBound` (whole-module face checking), and the - helper BODY equality against the audited templates is `arithRoleCheck` / - `arithTableCheck` further down this file. -/ -def symFragmentPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Nat) - (hostTable : List (HostRole × Nat)) - (structTable : List (String × Nat)) - (plan : SymRawPlan) - (obligation : Obligation) : Prop := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - hostTable structTable plan with - | some exprPlan => - symFragmentCarrierBound modBytes modLen carrier hostTable exprPlan = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch - modBytes modLen carrier hostTable = true ∧ - exprFragmentPlanAccepted - modBytes modLen exportNameBytes exportName carrier exprPlan obligation - | none => False - -/-- One source-level symbolic fragment claim inside an artifact certificate. - `hostTable`/`structTable` are representation context (host-role and - struct-type indices), not part of the source plan. - - What a wrong table costs depends on whether the plan CITES it. A table - entry the encoder actually resolves — a `hostCall` role, the fused - vector-read helpers, a `projectField`/`tagMatch` struct name — is copied - into the encoded plan and then into the lowered bytes, so a wrong entry - yields a code entry the module does not contain and the byte gate rejects - it. A table entry no node cites is NOT bound that way: for a role-free plan - the byte gate never reads the table at all. Those entries are constrained - only by the conjuncts stated at `symFragmentPlanAccepted` - (`symFragmentCarrierBound`, `hostTableFuncTypesMatch`) and, at - whole-module level, by `StandardFace.hostTableBound` against the decoded - role table. -/ -structure SymFragmentClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - hostTable : List (HostRole × Nat) - structTable : List (String × Nat) - plan : SymRawPlan - obligation : Obligation - -def symFragmentClaimAccepted - (modBytes modLen : Nat) - (claim : SymFragmentClaim) : Prop := - symFragmentPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - claim.hostTable - claim.structTable - claim.plan - claim.obligation - -/-- Canonical locals count declared by `lowerStringConcatBodyBytes`: one carrier - scratch local in a module that has an Int carrier struct, none in a module - that provably has not. Reading the SAME `carrier?` the byte lowering reads - keeps the semantic frame and the emitted prelude from ever disagreeing, and - `decodedCodeAt` equates this count with the locals vector decoded from the - real code section — so the number is byte-checked, not asserted. -/ -def stringConcatNLocals (carrier? : Option Nat) : Nat := - match carrier? with - | some _ => 1 - | none => 0 - -/-- Canonical whole-host builders for the two byte-exact string roles. -/ -def stringEqCanonicalHost (funcIdx : Nat) : - (List WVal → Option WVal) → (List WVal → Option WVal) → - (List WVal → Option WVal) → (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl := - fun _add _sub _mul stringEq _stringConcat _toIndex _cmp _eq fn => - if fn = funcIdx then some (2, stringEq) else none - -def stringConcatCanonicalHost (funcIdx resultTy : Nat) : - (List WVal → Option WVal) → (List WVal → Option WVal) → - (List WVal → Option WVal) → (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl := - fun _add _sub _mul _stringEq stringConcat _toIndex _cmp _eq fn => - if fn = funcIdx then some (1, stringConcat resultTy) else none - -/-- Artifact-level acceptance for one String.concat export. The raw plan carries - source-level chunks plus the encoder's data-index binding; the audited Lean - lowerers rebuild both the semantic `WInstr` body and exact code-entry bytes, - and the Wasm slicer binds those bytes to the exported function. The exported - fragment's declared function type and the internal concat helper's declared - function type are then checked against the decoded type/function sections, - including nullable-reference tags; the code-entry match alone does not bind - either ABI. - - `carrier` is the declared CARRIER STATE of the module, not a plan parameter, - and the second conjunct pins it to `CertDecode.carrierState` recomputed from - the same bytes. That single equality decides which locals prelude the byte - lowering below synthesizes and which locals count the semantic frame carries: - a module whose type section holds an Int carrier struct can present only - `some idx` (for that exact index), a module whose type section decodes and - holds none can present only `none`, and a module whose type section does not - decode can present neither. The producer has no third option and no choice - between the two, which is the whole point of stating the template selector - against a decoder instead of leaving it as claim data. - - It is also STRICTLY stronger than the `obligation.carrier = carrier` it - replaces: that conjunct only tied one declared field to another, whereas the - pair below ties the claim to the bytes, and `decodedCarrierIndex` ties the - obligation to the same decoded state. -/ -def stringConcatPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Option Nat) - (resultTy containerTy concatFuncIdx : Nat) - (stringHostRoles : List (Nat × CertDecode.StringHost.Role)) - (symPlan : SymRawPlan) - (plan : StringConcatRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - CertDecode.carrierState modBytes modLen = some carrier ∧ - obligation.carrier = carrier.getD 0 ∧ - stringHostRoles.contains (concatFuncIdx, .concat) = true ∧ - obligation.host = stringConcatCanonicalHost concatFuncIdx resultTy ∧ - ∃ body codeEntry binding, - AverCert.PlanCheck.checkSymRawPlan symPlan = true ∧ - AverCert.PlanCheck.stringConcatPlanMatchesSymRawPlan symPlan plan = true ∧ - AverCert.PlanCheck.checkStringConcatRawPlan plan = true ∧ - AverCert.PlanLower.lowerStringConcatBody - resultTy containerTy concatFuncIdx plan = some body ∧ - AverCert.PlanBytes.lowerStringConcatCodeEntry - carrier resultTy containerTy concatFuncIdx plan = some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - AverCert.WasmSlice.stringConcatExportFuncTypeMatches - modBytes modLen binding.typeIdx resultTy = true ∧ - AverCert.WasmSlice.stringConcatHelperFuncTypeMatches - modBytes modLen concatFuncIdx containerTy resultTy = true ∧ - obligation.self = binding.funcIdx ∧ - obligation.code binding.funcIdx = - some { arity := 1, nlocals := stringConcatNLocals carrier, body := body } - -def stringEqPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier stringTy stringEqFuncIdx : Nat) - (stringHostRoles : List (Nat × CertDecode.StringHost.Role)) - (symPlan : SymRawPlan) - (plan : StringEqRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - stringHostRoles.contains (stringEqFuncIdx, .eq) = true ∧ - obligation.host = stringEqCanonicalHost stringEqFuncIdx ∧ - AverCert.PlanCheck.checkSymRawPlan symPlan = true ∧ - AverCert.PlanCheck.stringEqPlanMatchesSymRawPlan symPlan plan = true ∧ - AverCert.PlanCheck.checkStringEqRawPlan plan = true ∧ - ∃ body codeEntry binding, - AverCert.PlanLower.lowerStringEqBody stringTy stringEqFuncIdx plan = some body ∧ - AverCert.PlanBytes.lowerStringEqCodeEntry carrier stringTy stringEqFuncIdx plan = - some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - binding.funcIdx = obligation.self ∧ - obligation.code binding.funcIdx = - some { arity := 1, nlocals := 2, body := body } - -def stringEqPlanForExport - (exportName : String) : List (String × StringEqRawPlan) → - Option StringEqRawPlan := - namedPlanForExport exportName - -def stringConcatPlanForExport - (exportName : String) : List (String × StringConcatRawPlan) → - Option StringConcatRawPlan := - namedPlanForExport exportName - -def constructPlanForExport - (exportName : String) : List (String × ConstructRawPlan) → - Option ConstructRawPlan := - namedPlanForExport exportName - -/-- One source-level String.concat claim inside an artifact certificate. - `carrier` is the module's carrier STATE — `none` for a module with no Int - carrier struct — and is pinned to `CertDecode.carrierState` by - `stringConcatPlanAccepted`. -/ -structure StringConcatClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Option Nat - resultTy : Nat - containerTy : Nat - concatFuncIdx : Nat - symPlan : SymRawPlan - obligation : Obligation - -/-- One source-level String.eq claim inside an artifact certificate. -/ -structure StringEqClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - stringTy : Nat - stringEqFuncIdx : Nat - symPlan : SymRawPlan - obligation : Obligation - -/-- One source-level ADT constructor claim inside an artifact certificate. The - source `SymRawPlan` describes the Aver value being constructed; the - target-bound `ConstructRawPlan` is taken from the manifest and checked - against it before byte lowering. -/ -structure ConstructClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - structIdx : Nat - fieldCount : Nat - elemTy : ConstructValType - symPlan : SymRawPlan - obligation : Obligation - -/-- One fuel-recursion claim inside an artifact certificate. Its byte-derived - `RecursionRawPlan` lives in `manifest.recursionPlans` (a byte-origin veneer, - no source `SymPlan`): the plan is checked against the fuel-recursion grammar - (self-calls pinned to the byte-derived function binding, host calls pinned - to the byte-derived role table), lowered to the self-recursive body and its - exact code-entry bytes, and bound to the exported function. `hostTable` is - representation context like `SymFragmentClaim`'s: byte-derived indices for - the box/combinator/sub roles this export's obligation wires — a wrong table - describes calls the module bytes cannot reproduce, so the claim fail-closes - at the byte gate. The `obligation` is the unchanged fuel-induction - obligation the manifest already pins; this claim only certifies where its - body bytes came from. -/ -structure RecursionClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - hostTable : List (HostRole × Nat) - obligation : Obligation - -/-- One mutual-recursion member claim inside an artifact certificate. Its - byte-derived `MutualRawPlan` lives in `manifest.mutualPlans` (a byte-origin - veneer, no source `SymPlan`): the plan is checked against the mutual member - grammar (its cross member-call pinned IN the byte-derived SCC member set, - host calls pinned to the byte-derived box/sub role table), lowered to the - member body and its exact code-entry bytes, and bound to the exported - member. `memberSet` is the byte-derived SCC self-index set and `hostTable` - the byte-derived box/sub indices this SCC's shared obligation wires — both - representation context like `RecursionClaim`'s `hostTable`; a wrong set or - table describes calls the module bytes cannot reproduce, so the claim - fail-closes at the byte gate. The `obligation` is the unchanged conjunction - fuel-induction obligation the manifest already pins (each member cites its - own conjunct); this claim only certifies where its body bytes came from. -/ -structure MutualRecursionClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - memberSet : List Nat - hostTable : List (HostRole × Nat) - obligation : Obligation - -/-- One verbatim `ref.test`-dispatch claim inside an artifact certificate. Its - byte-derived `VerbatimRawPlan` lives in `manifest.verbatimPlans` (a - byte-origin veneer, no source `SymPlan`: `Cod := WVal` / `verbatimRepr`, no - representation to name). The plan is checked structurally, lowered to the - match body and its exact code-entry bytes, and bound to the exported - function. Unlike the recursion/mutual families there are NO host/self calls - to tie, so the code entry carries most of the binding — but not the function - SIGNATURE nor the `array.new_data` payload CONTENTS, which the acceptance - predicate binds separately (`verbatimFuncTypeMatches`, `verbatimPayloadsBound`) - so no two distinct plans lower to the same accepted artifact; the - `obligation` is the unchanged verbatim widened-match / variant-dispatch - obligation the manifest already pins, and this claim only certifies where its - body bytes came from. -/ -structure VerbatimClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - obligation : Obligation - -/-- One Int-face `ref.test`-dispatch claim inside an artifact certificate. Its - byte-derived `IntDispatchRawPlan` lives in `manifest.intDispatchPlans` (a - byte-origin veneer, no source `SymPlan`: the `Cod := Int` variant-dispatch / - widened-Int-match obligation, its `cases`-spine proof face and Int-valued - model are unchanged and stay an independent read anchor — the plan claim - only certifies where the body bytes came from). `hostTable` is - representation context like `RecursionClaim`'s: the byte-derived box (and, - when consumed, add/sub) indices this export's obligation wires. The plan - names host helpers by ROLE only; the lowerers substitute table indices, so a - wrong table describes calls the module bytes cannot reproduce and the claim - fail-closes at the byte gate — PROVIDED the table maps roles to distinct - indices, which the acceptance predicate checks (`hostTableIndicesDistinct`; - a duplicated table would make the byte gate blind to an arm's role). -/ -structure IntDispatchClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - hostTable : List (HostRole × Nat) - obligation : Obligation - -/-- One bare tuple/record projection claim. Only `plan.fieldIdx` is producer - plan data. The remaining fields are reconstructed from validated Wasm by - the checker and independently re-bound here to the type section and exact - code entry. -/ -structure FieldProjectionClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - carrier : Nat - structIdx : Nat - fieldCount : Nat - resultTy : FieldProjectionResultTy - obligation : Obligation - -/-- One byte-bound member of the artifact-wide composition call graph. The plan - names only callees; `compositionFuncTable` below resolves every name through - the module's export table before either lowerer can use an index. -/ -structure CompositionMemberClaim where - exportNameBytes : AverCert.WasmSlice.ByteSeq - exportName : String - plan : CompositionRawPlan - -/-- One certified composition root. `memberNames` is not trusted closure data: - `compositionClaimAccepted` requires it to equal the transitive closure - reached from `exportName` in the byte-bound member call graph. -/ -structure CompositionClaim where - exportName : String - carrier : Nat - hostTable : List (HostRole × Nat) - memberNames : List String - obligation : Obligation - -def stringEqClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : StringEqClaim) : Prop := - match stringEqPlanForExport claim.exportName manifest.stringEqPlans with - | some plan => - stringEqPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - claim.stringTy - claim.stringEqFuncIdx - manifest.subject.stringHostRoles - claim.symPlan - plan - claim.obligation - | none => False - -def stringConcatClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : StringConcatClaim) : Prop := - match stringConcatPlanForExport claim.exportName manifest.stringConcatPlans with - | some plan => - stringConcatPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - claim.resultTy - claim.containerTy - claim.concatFuncIdx - manifest.subject.stringHostRoles - claim.symPlan - plan - claim.obligation - | none => False - -/-- Whether a source constructor claim is specifically a `List` constructor. - The byte-level two-field cons-cell guards below apply only to this source - family; ordinary one-field ADT constructors retain their existing exact - code-entry binding. -/ -def isListConstructSymPlan (symPlan : SymRawPlan) : Bool := - match symPlan.result with - | .app1 "List" _ => true - | _ => false - -def constructPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Nat) - (structIdx fieldCount : Nat) - (elemTy : ConstructValType) - (symPlan : SymRawPlan) - (plan : ConstructRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - AverCert.PlanCheck.checkSymRawPlan symPlan = true ∧ - AverCert.PlanCheck.constructPlanMatchesSymRawPlan symPlan plan = true ∧ - AverCert.PlanCheck.checkConstructRawPlan plan = true ∧ - plan.fields.length = fieldCount ∧ - ∃ body codeEntry binding, - AverCert.PlanLower.lowerConstructBody structIdx plan = some body ∧ - AverCert.PlanBytes.lowerConstructCodeEntry carrier structIdx plan = some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - binding.funcIdx = obligation.self ∧ - (isListConstructSymPlan symPlan = false ∨ - AverCert.WasmSlice.listConstructStructTypeMatches - modBytes modLen structIdx elemTy = true) ∧ - (isListConstructSymPlan symPlan = false ∨ - AverCert.WasmSlice.listConstructFuncTypeMatches - modBytes modLen binding.typeIdx plan.arity structIdx elemTy = true) ∧ - obligation.code binding.funcIdx = - some { arity := plan.arity, nlocals := 1, body := body } - -def constructClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : ConstructClaim) : Prop := - match constructPlanForExport claim.exportName manifest.constructPlans with - | some plan => - constructPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - claim.structIdx - claim.fieldCount - claim.elemTy - claim.symPlan - plan - claim.obligation - | none => False - -/-- Canonical locals count declared by `lowerRecursionBodyBytes`: every - accepted fuel-recursion shape has one carrier scratch local. -/ -def recursionNLocals (_plan : RecursionRawPlan) : Nat := 1 - -/-- Artifact-level acceptance for one fuel-recursion export. The - `RecursionRawPlan` is checked (generic block typing AND the - context-sensitive fuel-recursion grammar: every `selfCall` must target the - byte-derived binding's own function index and every host call must cite the - byte-derived role table), lowered to the self-recursive `WInstr` body and - the exact code-entry bytes, those bytes are bound to the exported function, - and the binding's declared type-section entry must be the canonical - certified signature `[(ref null carrier)^arity] → [(ref null carrier)]`. - The self index is additionally tied to the obligation through - `binding.funcIdx = obligation.self`. -/ -def recursionPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Nat) - (hostTable : List (HostRole × Nat)) - (plan : RecursionRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - AverCert.PlanCheck.checkRecursionRawPlan plan = true ∧ - (match obligation.policy, obligation.termination? with - | .simulatesModel, none => true - | .simulatesModelTotally, some witness => AverCert.Schema.checkTerm plan witness - | _, _ => false) = true ∧ - ∃ body codeEntry binding, - AverCert.PlanLower.lowerRecursionBody carrier plan = some body ∧ - AverCert.PlanBytes.lowerRecursionCodeEntry carrier plan = some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - binding.funcIdx = obligation.self ∧ - AverCert.PlanCheck.checkRecursionPlanShape binding.funcIdx hostTable - obligation.totalityRole plan = true ∧ - AverCert.WasmSlice.funcTypeMatches - modBytes modLen binding.typeIdx plan.params.length carrier = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch - modBytes modLen carrier hostTable = true ∧ - obligation.code binding.funcIdx = - some { arity := plan.params.length, - nlocals := recursionNLocals plan, body := body } - -def recursionPlanForExport - (exportName : String) : List (String × RecursionRawPlan) → - Option RecursionRawPlan := - namedPlanForExport exportName - -def recursionClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : RecursionClaim) : Prop := - match recursionPlanForExport claim.exportName manifest.recursionPlans with - | some plan => - recursionPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - claim.hostTable - plan - claim.obligation - | none => False - -/-- Canonical locals count declared by `lowerMutualBodyBytes`: every accepted - mutual-recursion member shape has one carrier scratch local. -/ -def mutualNLocals (_plan : MutualRawPlan) : Nat := 1 - -/-- Artifact-level acceptance for one mutual-recursion member export. The - `MutualRawPlan` is checked (generic block typing AND the context-sensitive - mutual member grammar: the member-call must target an index IN the - byte-derived SCC member set and every host call must cite the byte-derived - box/sub role table), lowered to the member `WInstr` body and the exact - code-entry bytes, those bytes are bound to the exported member, and the - binding's declared type-section entry must be the canonical certified - signature `[(ref null carrier)] → [(ref null carrier)]`. The member index is - tied to the (shared) obligation through `binding.funcIdx = obligation.self`; - `obligation.code binding.funcIdx` picks this member's arm out of the shared - multi-arm code table. -/ -def mutualPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Nat) - (memberSet : List Nat) - (hostTable : List (HostRole × Nat)) - (plan : MutualRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - obligation.totalityRole = .addSub ∧ - AverCert.PlanCheck.checkMutualRawPlan plan = true ∧ - (match obligation.policy, obligation.termination? with - | .simulatesModel, none => true - | .simulatesModelTotally, some witness => AverCert.Schema.checkTermMutual plan witness - | _, _ => false) = true ∧ - ∃ body codeEntry binding, - AverCert.PlanLower.lowerMutualBody carrier plan = some body ∧ - AverCert.PlanBytes.lowerMutualCodeEntry carrier plan = some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - binding.funcIdx = obligation.self ∧ - AverCert.PlanCheck.checkMutualPlanShape memberSet hostTable plan = true ∧ - AverCert.WasmSlice.funcTypeMatches - modBytes modLen binding.typeIdx plan.params.length carrier = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch - modBytes modLen carrier hostTable = true ∧ - obligation.code binding.funcIdx = - some { arity := plan.params.length, - nlocals := mutualNLocals plan, body := body } - -def mutualPlanForExport - (exportName : String) : List (String × MutualRawPlan) → - Option MutualRawPlan := - namedPlanForExport exportName - -def mutualRecursionClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : MutualRecursionClaim) : Prop := - match mutualPlanForExport claim.exportName manifest.mutualPlans with - | some plan => - mutualPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - claim.memberSet - claim.hostTable - plan - claim.obligation - | none => False - -/-- Whether one dispatch leaf's payload is byte-bound to the module. Only an - `arrayNewData` leaf carries a payload; its claimed `bytes` must equal the - exact contents of passive data segment `dataIdx` recovered from the module's - data section. Every other leaf trivially satisfies the binding. -/ -def verbatimLeafPayloadBound - (modBytes modLen : Nat) : VerbatimLeaf → Bool - | .arrayNewData _ dataIdx bytes => - match AverCert.WasmSlice.dataSegmentBytes modBytes modLen dataIdx with - | some contents => contents == bytes - | none => false - | _ => true - -/-- Every `arrayNewData` leaf in a verbatim dispatch has a byte-bound payload. - The canonical code-entry lowering pins each string literal's data-segment - INDEX and copied LENGTH but not its CONTENTS, so without this an equal-length - payload substitution keeps the code entry byte-identical while changing what - the plan (hence the model) claims. -/ -def verbatimPayloadsBound - (modBytes modLen : Nat) : VerbatimDispatch → Bool - | .leaf l => verbatimLeafPayloadBound modBytes modLen l - | .test _ hit rest => - verbatimLeafPayloadBound modBytes modLen hit && - verbatimPayloadsBound modBytes modLen rest - -/-- Canonical locals count declared by `lowerVerbatimLocalsBytes`: projecting - plans declare the field scratch, scrutinee, and carrier locals; all other - plans declare only the scrutinee and carrier locals. -/ -def verbatimNLocals (plan : VerbatimRawPlan) : Nat := - if AverCert.PlanCheck.dispatchHasProjection plan.body then 3 else 2 - -/-- Artifact-level acceptance for one verbatim `ref.test`-dispatch export. The - `VerbatimRawPlan` is checked against the canonical local count, lowered to the - match `WInstr` body and its exact code-entry bytes, and those bytes are bound - to the exported function by name. There are no host/self calls to tie, - so the code entry is nearly the whole binding — but the code entry alone does - NOT determine the export's meaning: it omits the function SIGNATURE (a second - nominal-root parameter leaves the locals + body bytes identical) and the - `array.new_data` PAYLOAD CONTENTS (only the segment index and length are - encoded). Two further conjuncts close both holes in-kernel: - `verbatimFuncTypeMatches` forces the byte-derived type-section entry to have - one nullable concrete root parameter and the ref-null or f64 result declared - by `plan.resultSig`, and `verbatimPayloadsBound` - forces every literal's claimed bytes to equal the byte-pinned data segment. A - body byte-noisier than the canonical dispatch lowering still fails the - byte-equality gate. The member index is tied to the obligation through - `binding.funcIdx = obligation.self`. -/ -def verbatimPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Nat) - (plan : VerbatimRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - AverCert.PlanCheck.checkVerbatimPlan (verbatimNLocals plan) plan = true ∧ - ∃ codeEntry binding, - AverCert.PlanBytes.lowerVerbatimCodeEntry carrier plan = some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - binding.funcIdx = obligation.self ∧ - AverCert.WasmSlice.verbatimFuncTypeMatches - modBytes modLen binding.typeIdx plan.resultSig = true ∧ - verbatimPayloadsBound modBytes modLen plan.body = true ∧ - obligation.code binding.funcIdx = - some { arity := 1, nlocals := verbatimNLocals plan, - body := AverCert.PlanLower.lowerVerbatimBody plan } - -def verbatimPlanForExport - (exportName : String) : List (String × VerbatimRawPlan) → - Option VerbatimRawPlan := - namedPlanForExport exportName - -def verbatimClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : VerbatimClaim) : Prop := - match verbatimPlanForExport claim.exportName manifest.verbatimPlans with - | some plan => - verbatimPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - plan - claim.obligation - | none => False - -/-- The canonical Int-face host slot chain: the byte-derived role table lowered - to exactly the `if fn = idx then …` chain (in table order) the emitter's - `{name}Host` definitions carry — a `box` entry wires the audited `boxRef` - over the carrier, an `add`/`sub` entry wires that contract-slot PARAMETER. - This reuses the same contract functions the obligation host is built from - (`boxRef` and the abstract add/sub slots of - `Obligation.host`); it defines no new semantics. -/ -def intDispatchCanonicalSlots - (carrier : Nat) (add sub mul : List WVal → Option WVal) : - List (HostRole × Nat) → HostTbl - | [] => fun _ => none - | (role, idx) :: rest => fun fn => - if fn = idx then - some (match role with - | .box => ((1 : Nat), boxRef carrier) - | .add => ((2 : Nat), add) - | .mul => ((2 : Nat), mul) - | .sub => ((2 : Nat), sub) - -- The Int-face dispatch grammar cites neither the to-index role nor - -- either comparison role; a table entry for one of them wires a slot - -- that always fails (trap-only). The arities are the real helper - -- arities so the wiring stays honest about the shape it refuses. - | .toIndex => ((1 : Nat), fun _ => none) - | .cmp => ((2 : Nat), fun _ => none) - | .eq => ((2 : Nat), fun _ => none)) - else intDispatchCanonicalSlots carrier add sub mul rest fn - -/-- The canonical Int-face host BUILDER for a byte-derived role table: the - whole `Obligation.host` value an honest Int-face dispatch obligation - carries (mul/stringEq/stringConcat slots unused). The acceptance predicate - requires `obligation.host` to EQUAL this builder — one extensional, - definitional equality over the whole function, mirroring in-kernel the - checker's whole-host `rfl` pin. A sampled probe is NOT enough here: in the - standalone-artifact posture the obligation is claim data, so a slot could - behave as its role's contract only on the probed inputs (e.g. add on `[]` - but sub on every real two-argument list, or a box helper defined only at - the probe's constant that traps on every other) — builder equality leaves - no unsampled behaviour, so the table is a function of the obligation the - model semantics actually reference, not a claim-supplied choice. -/ -def intDispatchCanonicalHost - (carrier : Nat) (hostTable : List (HostRole × Nat)) : - (List WVal → Option WVal) → (List WVal → Option WVal) → - (List WVal → Option WVal) → (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl := - fun add sub mul _stringEq _stringConcat _toIndex _cmp _eq => - intDispatchCanonicalSlots carrier add sub mul hostTable - -/-- Artifact-level acceptance for one Int-face `ref.test`-dispatch export. The - `IntDispatchRawPlan` is checked structurally (`checkIntDispatchRawPlan`), - lowered — parameterized by the claim's byte-derived host-role table, whose - indices must be pairwise DISTINCT (`hostTableIndicesDistinct`: the plan - names helpers by role only, so a duplicated table would let two plans - differing in an arm's role lower to identical bytes) and which must EQUAL, - through the obligation's own host builder, the canonical wiring - (`obligation.host = intDispatchCanonicalHost carrier hostTable`: otherwise - a role permutation in the plan plus a consistently permuted table cancels - out byte-identically, and a sampled check would leave unsampled slot - behaviour free) — to the match - `WInstr` body and its exact code-entry bytes, and those bytes are bound to - the exported function by name. The dispatch structure (tags, arm constants, - operand order, roles) is pinned entirely by the byte-equality gate: every - plan field reaches the lowered bytes. The code entry omits the function - SIGNATURE (a second nominal-root parameter leaves the locals + body bytes - identical), so `verbatimFuncTypeMatches` additionally forces the - byte-derived type-section entry to be the unary nominal-ref → - `[(ref null carrier)]` signature — the same shape check the - verbatim family uses, here with the Int carrier as the result heap type. - The function index is tied to the obligation through - `binding.funcIdx = obligation.self`, and the obligation's code table must - carry exactly the plan-lowered body WITH the canonical byte-derived locals - count (`bindArmCount + 2`, exactly what the byte lowering declares in the - locals vector — a const/nullary arm spills no per-arm local): an - existentially-free `nlocals` would let an honest-bytes artifact claim a - 0-locals table whose body traps on its first `local.set`, making the - partial-correctness obligation vacuously true. -/ -def intDispatchPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) - (carrier : Nat) - (hostTable : List (HostRole × Nat)) - (plan : IntDispatchRawPlan) - (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - AverCert.PlanCheck.checkIntDispatchRawPlan plan = true ∧ - AverCert.PlanCheck.hostTableIndicesDistinct hostTable = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch - modBytes modLen carrier hostTable = true ∧ - obligation.host = intDispatchCanonicalHost carrier hostTable ∧ - ∃ body codeEntry binding, - AverCert.PlanLower.lowerIntDispatchBody hostTable plan = some body ∧ - AverCert.PlanBytes.lowerIntDispatchCodeEntry carrier hostTable plan = - some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - binding.funcIdx = obligation.self ∧ - AverCert.WasmSlice.verbatimFuncTypeMatches - modBytes modLen binding.typeIdx (.refNull carrier) = true ∧ - obligation.code binding.funcIdx = - some { arity := 1, - nlocals := AverCert.PlanCheck.bindArmCount plan.body + 2, - body := body } - -def intDispatchPlanForExport - (exportName : String) : List (String × IntDispatchRawPlan) → - Option IntDispatchRawPlan := - namedPlanForExport exportName - -def intDispatchClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : IntDispatchClaim) : Prop := - match intDispatchPlanForExport claim.exportName manifest.intDispatchPlans with - | some plan => - intDispatchPlanAccepted - modBytes modLen - claim.exportNameBytes - claim.exportName - claim.carrier - claim.hostTable - plan - claim.obligation - | none => False - -def fieldProjectionPlanForExport - (exportName : String) : List (String × FieldProjectionRawPlan) → - Option FieldProjectionRawPlan := - namedPlanForExport exportName - -/-- Plan-backed acceptance for the bare bind/cast projection lowering. The - exact three-local layout is part of the canonical code-entry encoder and is - also pinned in the semantic code table. The type-section guards bind the - checker-derived struct index/count/result reference to the selected module - field and to the exported unary function signature. -/ -def fieldProjectionPlanAccepted - (modBytes modLen : Nat) - (exportNameBytes : AverCert.WasmSlice.ByteSeq) - (exportName : String) (carrier structIdx fieldCount : Nat) - (resultTy : FieldProjectionResultTy) - (plan : FieldProjectionRawPlan) (obligation : Obligation) : Prop := - obligation.export_ = exportName ∧ - obligation.carrier = carrier ∧ - AverCert.PlanCheck.checkFieldProjectionRawPlan fieldCount plan = true ∧ - ∃ body codeEntry binding, - AverCert.PlanLower.lowerFieldProjectionBody structIdx fieldCount plan = some body ∧ - AverCert.PlanBytes.lowerFieldProjectionCodeEntry - carrier structIdx fieldCount resultTy plan = some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportNameBytes codeEntry = some binding ∧ - AverCert.WasmSlice.projectionStructTypeMatches - modBytes modLen structIdx fieldCount plan.fieldIdx resultTy = true ∧ - AverCert.WasmSlice.projectionFuncTypeMatches - modBytes modLen binding.typeIdx structIdx resultTy = true ∧ - obligation.self = binding.funcIdx ∧ - obligation.code binding.funcIdx = - some { arity := 1, nlocals := 3, body := body } - -def fieldProjectionClaimAccepted - (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) - (claim : FieldProjectionClaim) : Prop := - match fieldProjectionPlanForExport claim.exportName manifest.fieldProjectionPlans with - | some plan => - fieldProjectionPlanAccepted modBytes modLen claim.exportNameBytes claim.exportName - claim.carrier claim.structIdx claim.fieldCount claim.resultTy plan claim.obligation - | none => False - -/-! ### Cross-function composition: byte-bound member graph and closure -/ - -/-- Exact canonical locals count emitted by both composition byte lowerers. -/ -def compositionNLocals (_plan : CompositionRawPlan) : Nat := 1 - -def compositionMemberBinding - (modBytes modLen : Nat) - (member : CompositionMemberClaim) : Option (String × Nat) := - match AverCert.WasmSlice.funcBindingForExport modBytes modLen member.exportNameBytes with - | some binding => some (member.exportName, binding.funcIdx) - | none => none - -def compositionFuncTable - (modBytes modLen : Nat) : - List CompositionMemberClaim → Option (List (String × Nat)) - | [] => some [] - | member :: rest => - match compositionMemberBinding modBytes modLen member, - compositionFuncTable modBytes modLen rest with - | some binding, some bindings => some (binding :: bindings) - | _, _ => none - -def compositionMemberForName - (name : String) : List CompositionMemberClaim → Option CompositionMemberClaim - | [] => none - | member :: rest => - if member.exportName == name then some member - else compositionMemberForName name rest - -def compositionMemberPlanAccepted - (modBytes modLen : Nat) - (carrier : Nat) - (hostTable : List (HostRole × Nat)) - (funcTable : List (String × Nat)) - (obligation : Obligation) - (member : CompositionMemberClaim) : Prop := - AverCert.PlanCheck.checkCompositionRawPlan member.plan = true ∧ - ∃ body codeEntry binding, - AverCert.PlanLower.lowerCompositionBody hostTable funcTable member.plan = some body ∧ - AverCert.PlanBytes.lowerCompositionCodeEntry carrier hostTable funcTable member.plan = - some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen member.exportNameBytes codeEntry = some binding ∧ - AverCert.WasmSlice.funcTypeMatches modBytes modLen binding.typeIdx 1 carrier = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch - modBytes modLen carrier hostTable = true ∧ - obligation.code binding.funcIdx = - some { arity := 1, nlocals := compositionNLocals member.plan, body := body } - -def compositionNamedMembersAccepted - (modBytes modLen : Nat) - (carrier : Nat) - (hostTable : List (HostRole × Nat)) - (funcTable : List (String × Nat)) - (obligation : Obligation) - (members : List CompositionMemberClaim) : List String → Prop - | [] => True - | name :: rest => - match compositionMemberForName name members with - | some member => - compositionMemberPlanAccepted - modBytes modLen carrier hostTable funcTable obligation member ∧ - compositionNamedMembersAccepted - modBytes modLen carrier hostTable funcTable obligation members rest - | none => False - -def compositionPlanCallees (plan : CompositionRawPlan) : List String := - match plan.shape with - | .selfSum => [] - | .chain callees => callees - -def stringListNodup (xs : List String) : Bool := - AverCert.WasmSlice.indexedNodup xs - -def stringListSetEq (xs ys : List String) : Bool := - AverCert.WasmSlice.indexedNodup xs && - AverCert.WasmSlice.indexedNodup ys && - AverCert.WasmSlice.indexedSetEq xs ys - -def compositionEdges - (members : List CompositionMemberClaim) : List (String × List String) := - members.map (fun member => (member.exportName, compositionPlanCallees member.plan)) - -/-- One worklist step on an already-indexed composition graph. Missing targets - fail closed; undiscovered callee edges are discovered exactly once. -/ -def compositionReachStep - (edgeIndex : Std.TreeMap String (List String)) - (memberNames : Std.TreeSet String) : - Nat → List String → Std.TreeSet String → Std.TreeSet String → List String → - Option (List String) - | 0, _, _, _, _ => none - | _fuel + 1, seen, seenSet, queuedSet, [] => some seen - | fuel + 1, seen, seenSet, queuedSet, name :: work => - if seenSet.contains name then - compositionReachStep edgeIndex memberNames fuel seen seenSet queuedSet work - else - match edgeIndex.get? name with - | none => none - | some callees => - if List.all callees (fun callee => memberNames.contains callee) then - let (nextWork, nextQueuedSet) := - List.foldl - (fun state callee => - let work := state.1 - let discovered := state.2 - if seenSet.contains callee || discovered.contains callee then - state - else - (callee :: work, discovered.insert callee)) - (work, queuedSet) callees - compositionReachStep edgeIndex memberNames fuel - (name :: seen) (seenSet.insert name) nextQueuedSet nextWork - else none - -def compositionReachClosure - (edges : List (String × List String)) : Nat → List String → Option (List String) - | 0, reached => some reached - | fuel, reached => - let edgeIndex := edges.foldl (fun index edge => - index.insert edge.1 edge.2) Std.TreeMap.empty - let memberNameSet := AverCert.WasmSlice.orderedSet (edges.map (fun edge => edge.1)) - let queuedSet := AverCert.WasmSlice.orderedSet reached - match compositionReachStep edgeIndex memberNameSet fuel [] Std.TreeSet.empty queuedSet reached with - | some reachedSet => some (reachedSet.reverse) - | none => none - -/-- Numeric target indices strictly descend along every edge. Both endpoints - come from byte-derived export bindings, so this rejects cycles without - trusting a plan-supplied ordering or membership set. -/ -def compositionEdgesDescend - (funcTable : List (String × Nat)) - (edges : List (String × List String)) : Bool := - edges.all (fun edge => - match AverCert.PlanLower.compositionFuncIdx? funcTable edge.1 with - | some self => edge.2.all (fun callee => - match AverCert.PlanLower.compositionFuncIdx? funcTable callee with - | some target => target < self - | none => false) - | none => false) - -/-- Closure membership is recomputed by following the call graph extracted - from byte-bound plans. `memberNames` must equal that closure exactly; extra, - omitted, duplicate, dangling, or cyclic members are rejected. -/ -def compositionClosureBound - (root : String) - (memberNames : List String) - (members : List CompositionMemberClaim) - (funcTable : List (String × Nat)) : Bool := - let edges := compositionEdges members - stringListNodup (members.map (fun member => member.exportName)) && - stringListNodup memberNames && - AverCert.PlanCheck.hostTableIndicesDistinct (funcTable.map (fun entry => (.add, entry.2))) && - compositionEdgesDescend funcTable edges && - (match compositionMemberForName root members with - | some rootMember => - (match rootMember.plan.shape with - | .chain _ => true - | .selfSum => false) && - (match compositionReachClosure edges (members.length + 1) [root] with - | some reached => stringListSetEq memberNames reached - | none => false) - | none => false) - -def compositionClaimAccepted - (modBytes modLen : Nat) - (members : List CompositionMemberClaim) - (claim : CompositionClaim) : Prop := - claim.obligation.export_ = claim.exportName ∧ - claim.obligation.carrier = claim.carrier ∧ - AverCert.PlanCheck.checkCompositionHostTable claim.hostTable = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch - modBytes modLen claim.carrier claim.hostTable = true ∧ - claim.obligation.host = intDispatchCanonicalHost claim.carrier claim.hostTable ∧ - match compositionFuncTable modBytes modLen members with - | some funcTable => - compositionClosureBound claim.exportName claim.memberNames members funcTable = true ∧ - (match AverCert.PlanLower.compositionFuncIdx? funcTable claim.exportName with - | some rootIdx => claim.obligation.self = rootIdx - | none => False) ∧ - compositionNamedMembersAccepted modBytes modLen claim.carrier claim.hostTable - funcTable claim.obligation members claim.memberNames - | none => False - -/-- Shared acceptance spine for every claim family. Family-specific views - choose the checked predicate; the conjunction shape seen by consumers is - unchanged. -/ -def allClaims (accept : Claim → Prop) : List Claim → Prop - | [] => True - | claim :: rest => accept claim ∧ allClaims accept rest - -/-- Recover one accepted claim from the shared conjunction spine. Keeping this - structural lemma beside `allClaims` gives every family discharge the same - proof instead of maintaining one private copy per claim kind. -/ -theorem allClaims_of_mem (accept : Claim → Prop) - (claims : List Claim) (hAll : allClaims accept claims) - (claim : Claim) (hMem : claim ∈ claims) : accept claim := by - induction claims with - | nil => simp at hMem - | cons head tail ih => - simp only [allClaims] at hAll - simp only [List.mem_cons] at hMem - rcases hAll with ⟨hHead, hTail⟩ - rcases hMem with rfl | hMem - · exact hHead - · exact ih hTail hMem - -def symFragmentClaimsAccepted (modBytes modLen : Nat) - (claims : List SymFragmentClaim) : Prop := - allClaims (symFragmentClaimAccepted modBytes modLen) claims - -/-- Aggregate source-level String.concat witness acceptance for one artifact's - string claim list. -/ -def stringConcatClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List StringConcatClaim) : Prop := - allClaims (stringConcatClaimAccepted modBytes modLen manifest) claims - -/-- Aggregate source-level String.eq witness acceptance for one artifact's - string equality claim list. -/ -def stringEqClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List StringEqClaim) : Prop := - allClaims (stringEqClaimAccepted modBytes modLen manifest) claims - -/-- Aggregate source-level constructor witness acceptance for one artifact's - constructor claim list. -/ -def constructClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List ConstructClaim) : Prop := - allClaims (constructClaimAccepted modBytes modLen manifest) claims - -/-- Aggregate fuel-recursion witness acceptance for one artifact's recursion - claim list. -/ -def recursionClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List RecursionClaim) : Prop := - allClaims (recursionClaimAccepted modBytes modLen manifest) claims - -/-- Aggregate mutual-recursion witness acceptance for one artifact's mutual - claim list. -/ -def mutualRecursionClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List MutualRecursionClaim) : Prop := - allClaims (mutualRecursionClaimAccepted modBytes modLen manifest) claims - -/-- Aggregate verbatim `ref.test`-dispatch acceptance for one artifact's verbatim - claim list. -/ -def verbatimClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List VerbatimClaim) : Prop := - allClaims (verbatimClaimAccepted modBytes modLen manifest) claims - -/-- Aggregate Int-face `ref.test`-dispatch acceptance for one artifact's - int-dispatch claim list. -/ -def intDispatchClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List IntDispatchClaim) : Prop := - allClaims (intDispatchClaimAccepted modBytes modLen manifest) claims - -def fieldProjectionClaimsAccepted (modBytes modLen : Nat) - (manifest : AverCert.Schema.Manifest) (claims : List FieldProjectionClaim) : Prop := - allClaims (fieldProjectionClaimAccepted modBytes modLen manifest) claims - -/-- Aggregate composition-root acceptance. All roots share the artifact-wide - unique member table, while each root independently re-derives its reachable - closure and pins every reachable body into its own shared `CodeTbl`. -/ -def compositionClaimsAccepted (modBytes modLen : Nat) - (members : List CompositionMemberClaim) (claims : List CompositionClaim) : Prop := - allClaims (compositionClaimAccepted modBytes modLen members) claims - -/-- Every name claimed as a reachable member across all composition roots. Each - claim's `memberNames` is pinned to its root's byte-derived reachable closure - by `compositionClosureBound`, so this is the union of those closures. -/ -def compositionClaimedNames : List CompositionClaim → List String - | [] => [] - | claim :: rest => claim.memberNames ++ compositionClaimedNames rest - -/-- Coverage: every artifact-wide composition member is named by (hence - reachable from) some composition root. The byte-check - (`compositionNamedMembersAccepted`) only inspects members NAMED by a claim's - `memberNames`, while `claimsMatchManifest` equates the whole - `compositionMembers` list to `manifest.compositionPlans`. Without this - conjunct an ORPHAN member — present in `compositionMembers` (and therefore - in `manifest.compositionPlans`) but reachable from no claimed root — would - ride into the manifest with NO code-entry / signature / code-table / - `nlocals` check: the "exists but is not constrained" class at - manifest-coverage level. Requiring every member to appear in the union of - the roots' `memberNames` — combined with `compositionNamedMembersAccepted` - (byte-checks each named member) and `compositionClosureBound` - (`memberNames` = the root's byte-derived closure) — makes - `compositionMembers` EXACTLY the union of the claimed roots' reachable - closures, so every member entry that reaches the manifest is byte-checked. - Stated over the whole artifact (not per claim) because the union is a - cross-claim fact: `quad` and `hex16` share one member table yet have - different closures (`{quad, double}` vs `{hex16, quad, double}`), so no - single root's closure equals the member set — only their union does. -/ -def compositionMembersCovered - (members : List CompositionMemberClaim) - (claims : List CompositionClaim) : Bool := - let claimed := compositionClaimedNames claims - members.all (fun member => claimed.contains member.exportName) - -/-! ### Byte-derived SCC closure - -`mutualRecursionClaimsAccepted` above certifies each member's body byte-origin -in ISOLATION. On its own that leaves the SCC's IDENTITY as unconstrained claim -data: a claim's `memberSet` could list extra/missing members, the members could -disagree on the set, and nothing forces the member-call graph to be one closed -cycle visiting every member. This section binds the SCC to bytes: it derives -each member's `(self, cross-target)` edge from the SAME byte-bound facts the -per-claim acceptance pins — `self` is the obligation's byte-pinned function -index (`= binding.funcIdx` from `mutualPlanAccepted`), `target` is read from the -byte-pinned plan (joined to the export by `exactFuncBindingForExport`). It then -checks, purely over those byte-derived edges, that the claims form disjoint -CLOSED simple cycles and that every member's declared `memberSet` equals its own -cycle's vertex set — so `memberSet` is a function of the bytes, not a free -choice. Composed with the per-claim acceptance (which pins `self`/`target` to -bytes) this makes the negative-space closure property hold in-kernel. -/ - -/-- The byte-pinned member-call target of a checked mutual member plan: the - tail `selfCall` index in the step arm of the fixed mutual grammar. Returns - `none` for any other shape (fail-closed); the per-claim `checkMutualPlanShape` - already forces this exact shape, so a claimed member always yields `some`. -/ -def mutualPlanTarget (plan : MutualRawPlan) : Option Nat := - match plan.body.result, plan.body.nodes with - | 4, [_, _, _, _, { kind := .ifElse 3 _ step, .. }] => - match step.result, step.nodes with - | 4, [_, _, _, _, { kind := .selfCall true cc [3], .. }] => some cc - | _, _ => none - | _, _ => none - -/-- The byte-derived edge and declared member set for one claim: - `(self, cross-target, memberSet)`. `self` is the obligation's byte-pinned - index; `target` is read from the byte-pinned manifest plan. -/ -def mutualClaimEdge - (manifest : AverCert.Schema.Manifest) - (claim : MutualRecursionClaim) : Option (Nat × Nat × List Nat) := - match mutualPlanForExport claim.exportName manifest.mutualPlans with - | some plan => - match mutualPlanTarget plan with - | some t => some (claim.obligation.self, t, claim.memberSet) - | none => none - | none => none - -def mutualClaimEdges - (manifest : AverCert.Schema.Manifest) : - List MutualRecursionClaim → Option (List (Nat × Nat × List Nat)) - | [] => some [] - | claim :: rest => - match mutualClaimEdge manifest claim, mutualClaimEdges manifest rest with - | some m, some ms => some (m :: ms) - | _, _ => none - -/-- No repeated element (no two claims for the same byte-derived member index). -/ -def natListNodup (xs : List Nat) : Bool := - AverCert.WasmSlice.indexedNodup xs - -/-- Set equality via mutual containment plus equal length: rejects extras, - omissions AND duplicates (a duplicate makes the lengths differ). -/ -def natListSetEq (xs ys : List Nat) : Bool := - AverCert.WasmSlice.indexedNodup xs && - AverCert.WasmSlice.indexedNodup ys && - AverCert.WasmSlice.indexedSetEq xs ys - -def natEdgeLookup : List (Nat × Nat) → Nat → Option Nat - | [], _ => none - | (a, b) :: rest, k => if a == k then some b else natEdgeLookup rest k - -/-- Follow the target-chain from `start`, collecting visited members, until the - next hop closes the walk. A SIMPLE closed cycle returns to `start` (the head - of the visited list); a hop to any other already-visited node (a rho tail) or - a hop to a non-member (dangling edge) fail-closes to `none`. -/ -def followSccCycle (edges : List (Nat × Nat)) : - Nat → Nat → List Nat → Option (List Nat) - | 0, _, _ => none - | fuel + 1, cur, visited => - match natEdgeLookup edges cur with - | some nxt => - let visited := visited ++ [cur] - if visited.contains nxt then - (if visited.head? == some nxt then some visited else none) - else - followSccCycle edges fuel nxt visited - | none => none - -/-- The byte-derived closure check over all mutual members: the member indices - are distinct (no duplicate claims), and every member sits on a SINGLE closed - simple cycle of length ≥ 2 whose vertex set equals that member's declared - `memberSet`. Since every target must be a member index and every member must - lie on a cycle returning to itself, the edge relation is a disjoint union of - pure cycles — exactly the mutual-recursion SCC shape — and `memberSet` is - pinned to the byte-derived cycle rather than chosen by the claim. -/ -def mutualMembersFormClosedSccs (members : List (Nat × Nat × List Nat)) : Bool := - let selfs := members.map (fun m => m.1) - let edges := members.map (fun m => (m.1, m.2.1)) - natListNodup selfs && - members.all (fun m => - selfs.contains m.2.1 && - (match followSccCycle edges (members.length + 1) m.1 [] with - | some cyc => decide (2 ≤ cyc.length) && natListSetEq m.2.2 cyc - | none => false)) - -/-- The artifact's mutual claims form byte-derived closed SCCs. Composed with - `mutualRecursionClaimsAccepted` (which pins each `self`/`target` to bytes) - this establishes the whole closed-call-graph property in-kernel. -/ -def mutualClaimsFormClosedSccs - (manifest : AverCert.Schema.Manifest) - (claims : List MutualRecursionClaim) : Prop := - match mutualClaimEdges manifest claims with - | some members => mutualMembersFormClosedSccs members = true - | none => False - -/-- The source plans claimed by an artifact, projected into the same manifest - surface used for pinning. Keeping this in the audited predicate means a - self-checking artifact cannot prove acceptance for one claim list while - advertising a different source-plan list in its manifest. -/ -def symFragmentClaimPlanPairs - (claims : List SymFragmentClaim) : List (String × SymRawPlan) := - claims.map (fun c => (c.exportName, c.plan)) - -/-- Representation plans induced by source-level claims. This is what keeps the - artifact surface source-first: the byte-bound plan is computed by the - audited encoder rather than carried as a separate claim. -/ -def symFragmentClaimEncodedPlanPair? - (claim : SymFragmentClaim) : Option (String × ExprFragmentRawPlan) := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | some exprPlan => some (claim.exportName, exprPlan) - | none => none - -def symFragmentClaimEncodedPlanPairs : - List SymFragmentClaim → Option (List (String × ExprFragmentRawPlan)) - | [] => some [] - | claim :: rest => - match symFragmentClaimEncodedPlanPair? claim, - symFragmentClaimEncodedPlanPairs rest with - | some pair, some pairs => some (pair :: pairs) - | _, _ => none - -def stringConcatClaimExportNames - (claims : List StringConcatClaim) : List String := - claims.map (fun c => c.exportName) - -def stringConcatManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.stringConcatPlans.map (fun p => p.1) - -def stringEqClaimExportNames - (claims : List StringEqClaim) : List String := - claims.map (fun c => c.exportName) - -def stringEqManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.stringEqPlans.map (fun p => p.1) - -def constructClaimExportNames - (claims : List ConstructClaim) : List String := - claims.map (fun c => c.exportName) - -def constructManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.constructPlans.map (fun p => p.1) - -/-- Recursion claims are pinned to `manifest.recursionPlans` by export name, - mirroring the String.eq/constructor families: a self-checking artifact - cannot advertise a different recursion-plan list than the claims it proves - acceptance for. -/ -def recursionClaimExportNames - (claims : List RecursionClaim) : List String := - claims.map (fun c => c.exportName) - -def recursionManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.recursionPlans.map (fun p => p.1) - -/-- Mutual-recursion claims are pinned to `manifest.mutualPlans` by export name, - mirroring the recursion family: a self-checking artifact cannot advertise a - different mutual-plan list than the claims it proves acceptance for. -/ -def mutualRecursionClaimExportNames - (claims : List MutualRecursionClaim) : List String := - claims.map (fun c => c.exportName) - -def mutualManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.mutualPlans.map (fun p => p.1) - -/-- Verbatim claims are pinned to `manifest.verbatimPlans` by export name, - mirroring the recursion/mutual families: a self-checking artifact cannot - advertise a different verbatim-plan list than the claims it proves acceptance - for. -/ -def verbatimClaimExportNames - (claims : List VerbatimClaim) : List String := - claims.map (fun c => c.exportName) - -def verbatimManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.verbatimPlans.map (fun p => p.1) - -/-- Int-face dispatch claims are pinned to `manifest.intDispatchPlans` by export - name, mirroring the recursion/mutual/verbatim families: a self-checking - artifact cannot advertise a different int-dispatch-plan list than the claims - it proves acceptance for. -/ -def intDispatchClaimExportNames - (claims : List IntDispatchClaim) : List String := - claims.map (fun c => c.exportName) - -def intDispatchManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.intDispatchPlans.map (fun p => p.1) - -def fieldProjectionClaimExportNames - (claims : List FieldProjectionClaim) : List String := - claims.map (fun c => c.exportName) - -def fieldProjectionManifestPlanNames - (manifest : AverCert.Schema.Manifest) : List String := - manifest.fieldProjectionPlans.map (fun p => p.1) - -def compositionMemberPlanPairs - (members : List CompositionMemberClaim) : List (String × CompositionRawPlan) := - members.map (fun member => (member.exportName, member.plan)) - -/-- The source `SymPlan`s carried by String.concat claims. These live in the - manifest's common `symFragmentPlans` list; the byte-lowering-specific - `StringConcatRawPlan` stays in `stringConcatPlans`. -/ -def stringConcatClaimSymPlanPairs - (claims : List StringConcatClaim) : List (String × SymRawPlan) := - claims.map (fun c => (c.exportName, c.symPlan)) - -def stringEqClaimSymPlanPairs - (claims : List StringEqClaim) : List (String × SymRawPlan) := - claims.map (fun c => (c.exportName, c.symPlan)) - -def constructClaimSymPlanPairs - (claims : List ConstructClaim) : List (String × SymRawPlan) := - claims.map (fun c => (c.exportName, c.symPlan)) +open AverCert.Grammar +open AverCert.TypeTable /-- Exact whole-module direct-call closure claimed by the producer and independently recomputed from the artifact bytes. `roots` are precisely the @@ -1547,256 +30,196 @@ structure ClosureClaim where helpers : List Nat admitted : List Nat -/-- The checker-facing artifact data currently accepted by the Lean bridge. - `symFragmentClaims` is the source-level expression surface. There is no - artifact-level raw `ExprFragmentClaim`; representation plans are derived by - the audited source encoder. -/ +/-- The checker-facing artifact data: the module bytes, the manifest, the + optional wasip2 component envelope, and the direct-call closure claim. The + plans live in the manifest alone. -/ structure ArtifactData where modBytes : Nat modLen : Nat - manifest : AverCert.Schema.Manifest - wasip2ComponentEnvelope : Option AverCert.Wasip2Envelope.ComponentEnvelope - symFragmentClaims : List SymFragmentClaim - stringEqClaims : List StringEqClaim - stringConcatClaims : List StringConcatClaim - constructClaims : List ConstructClaim - recursionClaims : List RecursionClaim - mutualRecursionClaims : List MutualRecursionClaim - verbatimClaims : List VerbatimClaim - intDispatchClaims : List IntDispatchClaim - fieldProjectionClaims : List FieldProjectionClaim - compositionMembers : List CompositionMemberClaim - compositionClaims : List CompositionClaim + manifest : _root_.AverCert.Schema.Manifest + wasip2ComponentEnvelope : Option _root_.AverCert.Wasip2Envelope.ComponentEnvelope closureFuel : Nat closureClaim : ClosureClaim -/-! ### In-kernel artifact binding - -The source expression-fragment family retains its canonical plan-to-code-entry -byte equality. Every other accepted family is additionally tied to the full -profile decoder here: code-table entries, the carrier index, and (where the -family consumes them) struct-field counts are computed from `modBytes` by -`CertDecode`, then equated to the claim obligation already pinned into the -manifest. None of these equalities takes an externally supplied code, carrier, -or field literal. -/ - -def decodedCodeAt - (modBytes modLen : Nat) (obligation : Obligation) (funcIdx : Nat) : Prop := - CertDecode.decodeCode modBytes modLen funcIdx = obligation.code funcIdx - -def decodedCodeAtAll - (modBytes modLen : Nat) (obligation : Obligation) : List Nat → Prop - | [] => True - | funcIdx :: rest => - decodedCodeAt modBytes modLen obligation funcIdx ∧ - decodedCodeAtAll modBytes modLen obligation rest - -/-- Byte-derived binding of one obligation's carrier index, stated over the - THREE states `CertDecode.carrierState` distinguishes rather than over a - collapsed `Option Nat`: - - * `some (some idx)` — the module has an Int carrier struct, and the - obligation must declare that exact index. Identical to the - `decodeCarrier … = some obligation.carrier` this replaces, so nothing an - existing certificate relies on moves. - * `some none` — the type section decodes and holds no carrier struct. There - is no index to bind, so the wall forces the reserved `0`. Writing the pin - against `decodeCarrier` left this state with no admissible declaration at - all, which is what made a carrierless module permanently uncertifiable. - * `none` — the type section does not decode. No declaration is admissible, - exactly as before. - - Matching on the state instead of mapping it through `Option.getD` matters: - a collapsed reading sends both `some (some 0)` and `some none` to the same - `some 0`, reintroducing at `0` precisely the ambivalence `carrierState` was - introduced to remove at `none`. Both arms happen to force the same field - today, but a family that later branches on the carrier state would inherit a - decoder that cannot tell "the carrier is type 0" from "there is no carrier". - - SCOPE. This relaxation is admitted for the String.concat claim list ALONE - (`decodedCarrierFreeClaims` below); every other NON-EXPRESSION-FRAGMENT - family keeps the strict `decodedStrictCarrierIndex`, and the - expression-fragment family is bound by neither (see - `decodedStrictCarrierIndex`). The reserved index is only harmless for a family - whose face provably never consults the `CarrierSpec`, and String.concat is - the family this leg established that for: its `Dom`/`Cod` are `WVal`, its - `domRepr` is `vs = [v]` and its `codRepr` is `verbatimRepr`, all of which - discard the spec argument. Applying it uniformly would be unsound, and - concretely so: `construct-v1`'s named face pins `HEq o.Dom Int` and - `HEq o.domRepr (intArgDomRepr env.carrier)`, an INT-REPRESENTATION face, and - it cites no arith role (`constructNamedFace` fixes `host = emptyHost`), so - neither the arith-table carrier pin nor the role table constrains it. Under a - uniform relaxation a module with no decodable carrier struct could carry a - constructor claim whose representation face is stated over `CarrierSpec 0` - while the module provably has no carrier struct at index `0` at all. -/ -def decodedCarrierIndex - (modBytes modLen : Nat) (obligation : Obligation) : Prop := - match CertDecode.carrierState modBytes modLen with - | some (some idx) => obligation.carrier = idx - | some none => obligation.carrier = 0 - | none => False - -/-- The carrier binding every NON-EXPRESSION-FRAGMENT family but String.concat - must satisfy: the module has a decodable Int-carrier struct and the - obligation declares that exact index. A module with no carrier struct, or one - whose type section does not decode, admits no claim in those families at all - — which is the guarantee that held before the carrierless state was admitted - anywhere, and the one that keeps a carrier-SENSITIVE face among them from - ever being stated over an index the bytes do not license. - - The expression-fragment family is NOT among them and satisfies neither this - binding nor `decodedCarrierIndex`: `symFragmentClaims` is deliberately absent - from `decodedNonExprClaimFacts` (see the note there). What binds an - `expr-fragment-v1` claim's carrier depends on whether the claim cites host - roles. A ROLE-FREE claim is bound by `ExprFragmentAccepted.accepted` alone, - purely by BYTE EQUALITY: the declared index is spliced into the synthesized - locals prelude (`01 01 63 `) and into every carrier-typed - instruction immediate, and `WasmSlice.exactFuncBindingForExport` requires - the result to equal the export's real code entry; the integer-family - renders additionally pin the declared function type through - `WasmSlice.funcTypeMatches`, which matches each `intCarrier` position - against `(ref null carrier)`. Those equalities confirm the index against - the CODE and the SIGNATURE but never against a decoder — a module can spell - them out consistently at ANY index — which is exactly why a claim whose own - data can make a face read the carrier (`symFragmentCarrierBindingRequired`: - a non-empty `hostTable`, or an `.intCarrier` anywhere in the encoded plan) - carries the additional decoder equality `symFragmentCarrierBound` inside - `symFragmentPlanAccepted`: those faces model helpers or arguments at the - claimed index, so that index must be the one `CertDecode.carrierState` - derives from the bytes. Do not describe this - file's decoded-claim bindings as covering "every family": they cover every - family whose claims appear below. -/ -def decodedStrictCarrierIndex - (modBytes modLen : Nat) (obligation : Obligation) : Prop := - CertDecode.decodeCarrier modBytes modLen = some obligation.carrier - -/-- Byte-derived facts every non-expression-fragment obligation must satisfy. -/ -def decodedObligationFacts - (modBytes modLen : Nat) (obligation : Obligation) (funcIndices : List Nat) : Prop := - decodedStrictCarrierIndex modBytes modLen obligation ∧ - decodedCodeAtAll modBytes modLen obligation funcIndices - -/-- The same facts with the three-state carrier binding, for the one family - whose face is carrier-inert. -/ -def decodedCarrierFreeObligationFacts - (modBytes modLen : Nat) (obligation : Obligation) (funcIndices : List Nat) : Prop := - decodedCarrierIndex modBytes modLen obligation ∧ - decodedCodeAtAll modBytes modLen obligation funcIndices - -def decodedClaims - {Claim : Type u} - (modBytes modLen : Nat) - (obligation : Claim → Obligation) - (funcIndices : Claim → List Nat) : List Claim → Prop - | [] => True - | claim :: rest => - decodedObligationFacts modBytes modLen (obligation claim) (funcIndices claim) ∧ - decodedClaims modBytes modLen obligation funcIndices rest - -/-- `decodedClaims` with the three-state carrier binding. Applied to the - String.concat claim list only; see `decodedCarrierIndex`. -/ -def decodedCarrierFreeClaims - {Claim : Type u} - (modBytes modLen : Nat) - (obligation : Claim → Obligation) - (funcIndices : Claim → List Nat) : List Claim → Prop - | [] => True - | claim :: rest => - decodedCarrierFreeObligationFacts modBytes modLen - (obligation claim) (funcIndices claim) ∧ - decodedCarrierFreeClaims modBytes modLen obligation funcIndices rest - -def decodedConstructStructFields - (modBytes modLen : Nat) : List ConstructClaim → Prop - | [] => True - | claim :: rest => - CertDecode.decodeStructFieldCount modBytes modLen claim.structIdx = - some claim.fieldCount ∧ - decodedConstructStructFields modBytes modLen rest - -def decodedProjectionStructFields - (modBytes modLen : Nat) : List FieldProjectionClaim → Prop - | [] => True - | claim :: rest => - CertDecode.decodeStructFieldCount modBytes modLen claim.structIdx = - some claim.fieldCount ∧ - decodedProjectionStructFields modBytes modLen rest - -def decodedCompositionNames - (modBytes modLen : Nat) - (members : List CompositionMemberClaim) - (obligation : Obligation) : List String → Prop - | [] => True - | name :: rest => - match compositionMemberForName name members with - | some member => - match compositionMemberBinding modBytes modLen member with - | some (_, funcIdx) => - decodedCodeAt modBytes modLen obligation funcIdx ∧ - decodedCompositionNames modBytes modLen members obligation rest - | none => False - | none => False - -def decodedCompositionClaims - (modBytes modLen : Nat) - (members : List CompositionMemberClaim) : List CompositionClaim → Prop - | [] => True - | claim :: rest => - decodedStrictCarrierIndex modBytes modLen claim.obligation ∧ - decodedCompositionNames modBytes modLen members claim.obligation claim.memberNames ∧ - decodedCompositionClaims modBytes modLen members rest - -/-- Artifact-decoded facts for every non-expression-fragment family. - Mutual obligations bind every member of their shared SCC `CodeTbl`; - composition obligations bind every name in their byte-checked transitive - closure. The source expression-fragment claim list is deliberately absent. - Kept separate so the module-wide host-role guard has a literal - one-conjunct-weakened GuardIso counterpart. -/ -def decodedNonExprClaimFacts (artifact : ArtifactData) : Prop := - decodedClaims artifact.modBytes artifact.modLen - (fun c : StringEqClaim => c.obligation) - (fun c : StringEqClaim => [c.obligation.self]) - artifact.stringEqClaims ∧ - -- The ONE list here on the three-state carrier binding. Every other list - -- below keeps the strict one, so among the families collected in THIS - -- predicate a module with no decodable carrier struct carries String.concat - -- claims and nothing else. That is not a statement about the whole artifact: - -- `symFragmentClaims` is absent from this predicate entirely, and such a - -- module can also carry expression-fragment claims — the `none, none` arith - -- arm needs only `carrierHelperAbsent`, `hostTableBound roles []` is - -- vacuously true, and generic and projection fragments cite no role at all. - decodedCarrierFreeClaims artifact.modBytes artifact.modLen - (fun c : StringConcatClaim => c.obligation) - (fun c : StringConcatClaim => [c.obligation.self]) - artifact.stringConcatClaims ∧ - decodedClaims artifact.modBytes artifact.modLen - (fun c : ConstructClaim => c.obligation) - (fun c : ConstructClaim => [c.obligation.self]) - artifact.constructClaims ∧ - decodedConstructStructFields artifact.modBytes artifact.modLen artifact.constructClaims ∧ - decodedClaims artifact.modBytes artifact.modLen - (fun c : RecursionClaim => c.obligation) - (fun c : RecursionClaim => [c.obligation.self]) - artifact.recursionClaims ∧ - decodedClaims artifact.modBytes artifact.modLen - (fun c : MutualRecursionClaim => c.obligation) - (fun c : MutualRecursionClaim => c.memberSet) - artifact.mutualRecursionClaims ∧ - decodedClaims artifact.modBytes artifact.modLen - (fun c : VerbatimClaim => c.obligation) - (fun c : VerbatimClaim => [c.obligation.self]) - artifact.verbatimClaims ∧ - decodedClaims artifact.modBytes artifact.modLen - (fun c : IntDispatchClaim => c.obligation) - (fun c : IntDispatchClaim => [c.obligation.self]) - artifact.intDispatchClaims ∧ - decodedClaims artifact.modBytes artifact.modLen - (fun c : FieldProjectionClaim => c.obligation) - (fun c : FieldProjectionClaim => [c.obligation.self]) - artifact.fieldProjectionClaims ∧ - decodedProjectionStructFields artifact.modBytes artifact.modLen artifact.fieldProjectionClaims ∧ - decodedCompositionClaims artifact.modBytes artifact.modLen - artifact.compositionMembers artifact.compositionClaims +/-! ### The derived obligations + +Nothing below is a producer choice: the host table, the code table, the model +and the policy axes are functions of the plans, the type table and the +subject. -/ + +/-- The host table an obligation runs against, as an association list keyed + by role index: the wall's own `boxRef` at the box index, the contract + functions at their role indices, and the trap-only function at the (never + declared) negation index. -/ +def hostAssoc (M : MCtx) (h : HostFns) : List (Nat × (Nat × (List WVal → Option WVal))) := + [(M.box, (1, boxRef M.carrier)), (M.add, (2, h.add)), (M.sub, (2, h.sub)), + (M.mul, (2, h.mul)), (M.neg, (1, fun _ => none)), (M.cmp, (2, h.cmp)), (M.eq, (2, h.eq)), + (M.concat, (1, h.stringConcat M.str)), (M.streq, (2, h.stringEq)), + (M.toIndex, (1, h.toIndex)), (M.divmod, (3, h.divmod))] + +def hostOf (M : MCtx) (h : HostFns) : HostTbl := fun f => (hostAssoc M h).lookup f + +/-- The role indices of a lowering context, in `hostAssoc` order. -/ +def roleIndices (M : MCtx) : List Nat := + [M.box, M.add, M.sub, M.mul, M.neg, M.cmp, M.eq, M.concat, M.streq, M.toIndex, M.divmod] + +/-- The emitted code of every planned function: its plan's lowering. -/ +def codeOf (M : MCtx) (fns : List FnEntry) : CodeTbl := fun f => (planOf fns f).map (fnCode M) + +/-- The meaning of every planned function: ONE group model over all plans (at + fuel `k + 1` a body runs with every callee at fuel `k`). -/ +def modelOf (fns : List FnEntry) : Nat → Nat → List SVal → Option SVal := + groupModel (fun _ _ _ => none) (planOf fns) + +/-- The members of call group `g`, as `(function index, plan)` pairs. -/ +def groupMembers (fns : List FnEntry) (g : Nat) : List (Nat × FnPlan) := + (fns.filter (·.group == g)).map fun e => (e.funcIdx, e.plan) + +/-- The policy axes of a planned function, from its group's termination check + (`GrammarTotal.groupPolicy`): L3 with the canonical witness and the group's + role when the check passes, L1 otherwise. Never a manifest flag. -/ +def axesOf (fns : List FnEntry) (e : FnEntry) : + Policy × Option TerminationWitness × TotalityRole := + groupPolicy (groupMembers fns e.group) + +def obligationOf (s : Subject) (tt : TypeTable) (fns : List FnEntry) (e : FnEntry) : + Obligation := + { export_ := e.name + policy := (axesOf fns e).1 + termination? := (axesOf fns e).2.1 + totalityRole := (axesOf fns e).2.2 + carrier := (mctxOf s tt fns).carrier + layout := mctxOf s tt fns + code := codeOf (mctxOf s tt fns) fns + host := hostOf (mctxOf s tt fns) + self := e.funcIdx + sig := e.plan.sig + model := fun fuel => modelOf fns fuel e.funcIdx } + +/-- The certified obligations: one per exported planned function. -/ +def obligationsOf (s : Subject) (tt : TypeTable) (fns : List FnEntry) : List Obligation := + (fns.filter (·.exported)).map (obligationOf s tt fns) + +/-! ### Calls -/ + +mutual + /-- The function indices a plan calls (`call` and `tailCall`). -/ + def callTargets : Expr → List Nat + | .literal _ => [] + | .local _ => [] + | .let_ _ v body => callTargets v ++ callTargets body + | .call (.fn f) args => f :: argsTargets args + | .call _ args => argsTargets args + | .tailCall f args => f :: argsTargets args + | .binOp _ l r => callTargets l ++ callTargets r + | .neg e => callTargets e + | .ifThenElse c t e => callTargets c ++ callTargets t ++ callTargets e + | .recordCreate _ fs => argsTargets fs + | .project _ _ b => callTargets b + | .match_ s arms => callTargets s ++ armsTargets arms + | .construct _ _ args => argsTargets args + | .interp parts => argsTargets parts + | .list _ items => argsTargets items + def argsTargets : List Expr → List Nat + | [] => [] + | e :: es => callTargets e ++ argsTargets es + def armsTargets : Arms → List Nat + | .nil => [] + | .cons _ b rest => callTargets b ++ armsTargets rest +end + +/-- S-4: every call of a plan targets a planned function of the same call + group or of an earlier one. Two groups can therefore never vouch for each + other, and a call to an unplanned index (a helper disguised as a callee, + or any other function) declines. -/ +def callsOrdered (fns : List FnEntry) (e : FnEntry) : Bool := + (callTargets e.plan.body).all fun t => + match entryOf fns t with + | some e' => decide (e'.group ≤ e.group) + | none => false + +/-! ### Binding a plan to its function -/ + +def stringBytes (s : String) : _root_.AverCert.WasmSlice.ByteSeq := + s.toList.map Char.toNat + +/-- The declared function type of the bound function is exactly the plan's + signature, read through the layout. -/ +def sigPinned (n len : Nat) (M : MCtx) (sig : Sig) (typeIdx : Nat) : Bool := + match sig.params.mapM (valTyD M), valTyD M sig.ret with + | some ps, some r => + _root_.AverCert.WasmSlice.typeSectionMatches (_root_.AverCert.WasmSlice.checkFuncTypeExact ps [r]) n len + typeIdx + | _, _ => false + +/-- The function a planned entry is bound to, selected by the plan's own code + entry: an exported entry through its export name, an internal callee + through its function index. Either way the module's code entry must be + EXACTLY `codeEntryBytes` of the plan (locals vector included). -/ +def boundFunction (n len : Nat) (M : MCtx) (e : FnEntry) : + Option _root_.AverCert.WasmSlice.FuncBinding := + match codeEntryBytes M e.plan with + | none => none + | some bytes => + if e.exported then + _root_.AverCert.WasmSlice.exactFuncBindingForExport n len (stringBytes e.name) bytes + else + (_root_.AverCert.WasmSlice.funcBindingByFuncIndex n len e.funcIdx).filter + (fun b => b.codeEntry == bytes) + +/-- One planned function: its plan types at its signature, its lowering is + the code entry of the function at its declared index, the declared + function type is its signature, and its calls are ordered. -/ +def entryAccepted (n len : Nat) (M : MCtx) (fns : List FnEntry) (e : FnEntry) : Bool := + planTyped M e.plan && + (match boundFunction n len M e with + | some b => b.funcIdx == e.funcIdx && sigPinned n len M e.plan.sig b.typeIdx + | none => false) && + callsOrdered fns e + +/-! ### Host roles -/ + +/-- The declared function type of each present role at its index; an absent + role (`TypeTable.absent`) has no function and is never called. -/ +def roleTypePinned (n len : Nat) (idx : Nat) (params results : List _root_.CertDecode.ValType) : Bool := + if idx < 4294967296 then + match _root_.AverCert.WasmSlice.funcBindingByFuncIndex n len idx with + | some b => + _root_.AverCert.WasmSlice.typeSectionMatches + (_root_.AverCert.WasmSlice.checkFuncTypeExact params results) n len b.typeIdx + | none => false + else true + +def refN (i : Nat) : _root_.CertDecode.ValType := .ref 0x63 (Int.ofNat i) + +/-- Every present helper declares exactly the function type its role fixes: + `box` `i64 -> carrier`, the arithmetic helpers `carrier carrier -> carrier`, + `cmp` / `eq` `carrier carrier -> i32`, `toIndex` `carrier -> i32`, String + equality `$string $string -> i32`, and concatenation + `Vector -> $string`, whose result type is the one the obligation + wires into its contract (`hostOf`), and Euclidean division + `carrier carrier i32 -> carrier` (its body is pinned by template, its + type here). -/ +def roleTypesPinned (n len : Nat) (M : MCtx) : Bool := + let c := refN M.carrier + roleTypePinned n len M.box [.numeric 0x7e] [c] && + roleTypePinned n len M.add [c, c] [c] && + roleTypePinned n len M.sub [c, c] [c] && + roleTypePinned n len M.mul [c, c] [c] && + roleTypePinned n len M.cmp [c, c] [.numeric 0x7f] && + roleTypePinned n len M.eq [c, c] [.numeric 0x7f] && + roleTypePinned n len M.toIndex [c] [.numeric 0x7f] && + roleTypePinned n len M.streq [refN M.str, refN M.str] [.numeric 0x7f] && + roleTypePinned n len M.concat [refN M.strVec] [refN M.str] && + roleTypePinned n len M.divmod [c, c, .numeric 0x7f] [c] + +/-- Role indices are pairwise distinct and distinct from every planned + function, so the host table resolves each role to its own contract and no + planned function is a helper. Planned indices are unique. -/ +def indicesDistinct (M : MCtx) (fns : List FnEntry) : Bool := + decide (roleIndices M ++ fns.map (·.funcIdx)).Nodup + +/-! ### Helper bodies -/ /-- Body bytes of the defined function at absolute wasm function index `idx` (the import base is applied before indexing the code section), or `none` @@ -1806,13 +229,13 @@ def decodedNonExprClaimFacts (artifact : ArtifactData) : Prop := `codeLocs` isolates each entry (`entryN`, `entryLen`, size-LEB included); re-reading that size LEB yields the locals+body region as `esz` bytes. -/ def bodyBytesAtFuncIndex (n len idx : Nat) : Option (List Nat) := - match CertDecode.funcImportBase n len, CertDecode.codeLocs n len with + match _root_.CertDecode.funcImportBase n len, _root_.CertDecode.codeLocs n len with | some nimp, some locs => if nimp ≤ idx then match locs[idx - nimp]? with | some loc => - match CertDecode.readU loc.entryN loc.entryLen with - | some (esz, bodyN, _) => some (CertDecode.takeBytes esz bodyN) + match _root_.CertDecode.readU loc.entryN loc.entryLen with + | some (esz, bodyN, _) => some (_root_.CertDecode.takeBytes esz bodyN) | none => none | none => none else none @@ -1824,12 +247,12 @@ def bodyBytesAtFuncIndex (n len idx : Nat) : Option (List Nat) := role (`none`) is vacuously pinned — no claim can cite an absent role, so no plan can use it. No byte is scanned to DISCOVER a role; a wrong declaration synthesizes the wrong bytes and fails this equality. -/ -def arithRoleCheck (n len : Nat) (role : ArithTemplateDerisk.ArithRole) - (idx? : Option Nat) (p : ArithTemplateDerisk.ArithHostParams) : Bool := +def arithRoleCheck (n len : Nat) (role : _root_.ArithTemplateDerisk.ArithRole) + (idx? : Option Nat) (p : _root_.ArithTemplateDerisk.ArithHostParams) : Bool := match idx? with | none => true | some idx => - bodyBytesAtFuncIndex n len idx == some (ArithTemplateDerisk.arithHelperBody role p) + bodyBytesAtFuncIndex n len idx == some (_root_.ArithTemplateDerisk.arithHelperBody role p) /-- The whole-module arith host-role pin — declare-and-confirm, no fingerprint. A byte-provably carrierless module (`__rt_aint_from_i64` export absent) @@ -1844,49 +267,12 @@ def arithRoleCheck (n len : Nat) (role : ArithTemplateDerisk.ArithRole) A declared table also has to name a carrier that the TYPE SECTION shows: `carrierState n len = some (some p.carrier)`. Every other conjunct here reads the export section, the code section, or nothing at all, so without this one - `p.carrier` was a free index that the wall only ever spliced into the helper - bodies it synthesized — an arith table could be admitted by a module whose - type section holds no Int-carrier struct anywhere. That is not hypothetical: - `isCarrier` requires the third field's storage tag to be `0x7f`, so a - perfectly working carrier whose flag field is a PACKED `i8` (tag `0x78`) - decodes as no carrier at all, and a module built that way could pair a real - Int runtime with a carrierless type section. Combined with the reserved - carrier index that `decodedCarrierIndex` forces in the carrierless state, - that would have let an Int-family claim wire the box role and state its - obligation over `CarrierSpec 0` while the values the code actually builds - live at a different struct index — the claim's representation face and the - module's representation would simply be about different things. - - What this conjunct restores is the precondition every host-role-consuming - family needs and none of them state for themselves: an admitted arith table - now implies a byte-derived carrier struct at exactly the index the helper - bodies splice. - - It is NOT what confines the carrierless state to `string-concat-v1`. Several - families cite no arith role at all — String.eq, verbatim dispatch, field - projection and named-ADT construction all reach acceptance with the table - absent — so this conjunct never runs for them. What confines the carrierless - state is that `decodedCarrierIndex` is wired to the String.concat claim list - ALONE; every other NON-EXPRESSION-FRAGMENT family keeps - `decodedStrictCarrierIndex`, which no module without a decodable carrier - struct can satisfy. Both mechanisms are needed: this one stops a role-citing - family from wiring an Int runtime the type section does not corroborate, and - the scoping stops a role-FREE family that is nonetheless carrier-sensitive - (`construct-v1`) from being stated over the reserved index. - - Neither mechanism reaches the expression-fragment family, whose claims are - absent from `decodedNonExprClaimFacts`. A fragment claim that can make no - face read its carrier — no role cited AND no `.intCarrier` in the encoded - plan — has that field confirmed only by the byte equalities of - `ExprFragmentAccepted.accepted`, and a carrierless module can therefore - carry such claims as well as String.concat ones. Every other fragment claim - carries its own decoder equality instead (`symFragmentCarrierBound`, inside - `symFragmentPlanAccepted`), which pins the claimed carrier to the same - `carrierState` this conjunct pins `ArithHostParams.carrier` to — so a - role-citing fragment and the arith table it cites can never disagree about - where the carrier lives. - - `box`, `toIndex`, `cmp` and `eq` carry a SECOND pin, to their runtime export + `p.carrier` would be a free index spliced only into the helper bodies the + wall synthesizes. The type table pins its own carrier declaration to the + same decoder (`TypeTable.carrierConfirmed`), so the helper bodies and the + plans' representation agree about where the carrier lives. + + `box`, `toIndex` and `cmp` carry a SECOND pin, to their runtime export names (#736 for `box`), and both pins are kept because they constrain different things. The name equality says at WHICH INDEX the role may be declared; the template equality says WHICH BYTES sit there. Only the name @@ -1897,50 +283,50 @@ def arithRoleCheck (n len : Nat) (role : ArithTemplateDerisk.ArithRole) honestly-named export, which the name equality never reads. The `toIndex` pins are load-bearing, not decorative: the fused vector-read - face wires an ABSTRACT contract function at the declared index and never + lowering calls an ABSTRACT contract function at the declared index and never interprets that function's body, so without them a package could declare any same-signature function as the index helper and certify a law the bytes do not satisfy. `none` on both sides is the honest reading for a carriered module that exports no `__aint_to_index`; a claim citing the role then fails to match, because `Subject.hostRoles` binds it to `none`. - The two comparison roles inherit that argument WORD FOR WORD — a comparison - face also wires an abstract contract at a declared index — and add one of - their own. `cmp` and `eq` declare the SAME function type - (`[(ref null carrier), (ref null carrier)] -> [i32]`), so - `hostTableFuncTypesMatch` cannot separate them: without the name equalities - an artifact could declare the equality helper as the `cmp` role and the - three-way helper as the `eq` role and still satisfy every declared-type - conjunct. The template equalities do separate them, since the two bodies - differ — but only where a declaration is `some`. On `none` the templates say - nothing at all, which is exactly the hole the name pin closes: a module that - really does export `__aint_cmp` may not declare that role absent and thereby - escape both pins. + The comparison helper `cmp` inherits that argument word for word — a + comparison also calls an abstract contract at a declared index. + + The equality helper `eq` is pinned by TEMPLATE only, like `add`, `sub` and + `mul`. The emitter exports `__aint_eq` only when some user code path marks + it live, while an Int literal `match` calls it all the same, so a name pin + would decline every such module. Dropping the name pin keeps everything the + pins establish: a `some` declaration must sit on a function whose body IS + the equality template (so the three-way helper, whose body differs, can + never be declared as `eq`, and `cmp` stays name-bound), and a `none` + declaration lowers every call to `eq` to `absent 7`, which no code entry + encodes, so a plan citing an undeclared `eq` declines. What none of this establishes: the template equality identifies the code behind a role, never its meaning. The add/sub/mul/box/index-extraction and comparison contracts stay explicit hypotheses of `Obligation.holds` and stay disclosed by `ClaimAxes`. Pinning bytes narrows the artifact, not the trusted-computing base. -/ -def arithTableCheck (n len : Nat) (roles? : Option CertDecode.AddSub.Roles) - (params? : Option ArithTemplateDerisk.ArithHostParams) : Bool := +def arithTableCheck (n len : Nat) (roles? : Option _root_.CertDecode.AddSub.Roles) + (params? : Option _root_.ArithTemplateDerisk.ArithHostParams) : Bool := match roles?, params? with - | none, none => CertDecode.AddSub.carrierHelperAbsent n len + | none, none => _root_.CertDecode.AddSub.carrierHelperAbsent n len | some roles, some p => - !CertDecode.AddSub.carrierHelperAbsent n len && - (CertDecode.carrierState n len == some (some p.carrier)) && - (roles.box == CertDecode.AddSub.boxIdx n len) && - (roles.toIndex == CertDecode.AddSub.toIndexIdx n len) && - (roles.cmp == CertDecode.AddSub.cmpIdx n len) && - (roles.eq == CertDecode.AddSub.eqIdx n len) && - ArithTemplateDerisk.checkArithHostParams p && + !_root_.CertDecode.AddSub.carrierHelperAbsent n len && + (_root_.CertDecode.carrierState n len == some (some p.carrier)) && + (roles.box == _root_.CertDecode.AddSub.boxIdx n len) && + (roles.toIndex == _root_.CertDecode.AddSub.toIndexIdx n len) && + (roles.cmp == _root_.CertDecode.AddSub.cmpIdx n len) && + _root_.ArithTemplateDerisk.checkArithHostParams p && arithRoleCheck n len .box roles.box p && arithRoleCheck n len .toIndex roles.toIndex p && arithRoleCheck n len .add roles.add p && arithRoleCheck n len .sub roles.sub p && arithRoleCheck n len .mul roles.mul p && arithRoleCheck n len .cmp roles.cmp p && - arithRoleCheck n len .eq roles.eq p + arithRoleCheck n len .eq roles.eq p && + arithRoleCheck n len .divmod roles.divmod p | _, _ => false /-- Bind the declared host-role table and arith indices to the module bytes by @@ -1948,7 +334,7 @@ def arithTableCheck (n len : Nat) (roles? : Option CertDecode.AddSub.Roles) certificate DECLARES which function index carries each helper (plus the carrier/limb/sub-routine indices the bodies mention) and the wall SYNTHESIZES the canonical helper body from that declaration and pins the real - code bytes equal to it. `box`, `toIndex`, `cmp` and `eq` stay name-bound as + code bytes equal to it. `box`, `toIndex` and `cmp` stay name-bound as well, and the carrierless class stays proved by the absent `__rt_aint_from_i64` export (#736 intact). -/ def decodedHostRoleTable (artifact : ArtifactData) : Prop := @@ -1959,57 +345,29 @@ def decodedHostRoleTable (artifact : ArtifactData) : Prop := Unlike add/sub, the result is a list because every matching function is classified independently; duplicate roles at distinct indices are retained. -/ def decodedStringHostRoles (artifact : ArtifactData) : Prop := - CertDecode.StringHost.roleTable artifact.modBytes artifact.modLen = + _root_.CertDecode.StringHost.roleTable artifact.modBytes artifact.modLen = some artifact.manifest.subject.stringHostRoles -/-- All in-kernel non-expression byte facts. Keeping `decodedHostRoleTable` - outside every per-obligation fold is load-bearing for the - 200000-heartbeat budget. -/ -def decodedNonExprFacts (artifact : ArtifactData) : Prop := - decodedHostRoleTable artifact ∧ - decodedStringHostRoles artifact ∧ - decodedNonExprClaimFacts artifact - -def claimObligationExports (artifact : ArtifactData) : List String := - artifact.symFragmentClaims.map (fun c => c.obligation.export_) ++ - artifact.stringEqClaims.map (fun c => c.obligation.export_) ++ - artifact.stringConcatClaims.map (fun c => c.obligation.export_) ++ - artifact.constructClaims.map (fun c => c.obligation.export_) ++ - artifact.recursionClaims.map (fun c => c.obligation.export_) ++ - artifact.mutualRecursionClaims.map (fun c => c.obligation.export_) ++ - artifact.verbatimClaims.map (fun c => c.obligation.export_) ++ - artifact.intDispatchClaims.map (fun c => c.obligation.export_) ++ - artifact.fieldProjectionClaims.map (fun c => c.obligation.export_) ++ - artifact.compositionClaims.map (fun c => c.obligation.export_) - -/-- Coverage: every manifest obligation is claimed. The claims ⊆ manifest - direction is `fragmentClaimObligationsInManifest`; without THIS conjunct an - obligation present in `manifest.obligations` but claimed by no family rides - into the accepted artifact with no byte-derived check — the - "exists but is not constrained" class at the obligation level. -/ -def manifestObligationsClaimed (artifact : ArtifactData) : Bool := - let claimed := claimObligationExports artifact - let claimedIndex := AverCert.WasmSlice.orderedSet claimed - artifact.manifest.obligations.all (fun o => claimedIndex.contains o.export_) - -/-- Manifest obligations bind by export name; a duplicate name would let a - second, unclaimed obligation ride behind a claimed one (find? sees only the - first). Names must be pairwise distinct. -/ -def manifestObligationExportsUnique (artifact : ArtifactData) : Bool := - (AverCert.WasmSlice.uniqueMap - (artifact.manifest.obligations.map (fun obligation => - (obligation.export_, obligation)))).isSome /-! ### Whole-module interface accounting and certified-closure isolation -/ -def stringBytes (s : String) : AverCert.WasmSlice.ByteSeq := - s.toList.map Char.toNat +/-- Distinct byte sequences, decided on their numeric keys (`WasmSlice.seqKey`, + injective). -/ +def byteSeqListNodup (xs : List _root_.AverCert.WasmSlice.ByteSeq) : Bool := + match _root_.AverCert.WasmSlice.seqKeys xs with + | some keys => _root_.AverCert.WasmSlice.natListNodup keys + | none => false + +/-- Distinct Strings, decided on their code points (`stringBytes` is + injective): ordering two Strings in the kernel re-encodes both. -/ +def stringListNodup (xs : List String) : Bool := + byteSeqListNodup (xs.map stringBytes) def lowerHexByte (byte : Nat) : Bool := (decide (48 ≤ byte) && decide (byte ≤ 57)) || (decide (97 ≤ byte) && decide (byte ≤ 102)) -def customCapabilityModuleTail : Nat → AverCert.WasmSlice.ByteSeq → Bool +def customCapabilityModuleTail : Nat → _root_.AverCert.WasmSlice.ByteSeq → Bool | count, 45 :: 99 :: hash => decide (0 < count) && count % 2 == 0 && hash.length == 64 && hash.all lowerHexByte @@ -2033,55 +391,114 @@ def customCapabilityImport (capability : String × String) : Bool := !operationTail.isEmpty && operationTail.length % 2 == 0 && operationTail.all lowerHexByte -def byteSeqListNodup (xs : List AverCert.WasmSlice.ByteSeq) : Bool := - AverCert.WasmSlice.indexedNodup xs - def certifiedExportEntries - (manifest : AverCert.Schema.Manifest) : List AverCert.WasmSlice.ExportEntry := + (manifest : _root_.AverCert.Schema.Manifest) : List _root_.AverCert.WasmSlice.ExportEntry := manifest.obligations.map (fun obligation => { name := stringBytes obligation.export_, kind := 0, idx := obligation.self }) def declaredUncertifiedNames - (manifest : AverCert.Schema.Manifest) : List AverCert.WasmSlice.ByteSeq := + (manifest : _root_.AverCert.Schema.Manifest) : List _root_.AverCert.WasmSlice.ByteSeq := manifest.subject.declaredUncertified.map (fun entry => stringBytes entry.1) +/-- An export entry keyed for the set-shaped accounting: its name's numeric + key (`WasmSlice.seqKey`), kind and index. -/ structure ExportKey where - name : AverCert.WasmSlice.ByteSeq + name : Nat kind : Nat idx : Nat deriving Ord -def exportEntryKey (entry : AverCert.WasmSlice.ExportEntry) : ExportKey := - ⟨entry.name, entry.kind, entry.idx⟩ +def exportEntryKey (entry : _root_.AverCert.WasmSlice.ExportEntry) : Option ExportKey := + (_root_.AverCert.WasmSlice.seqKey entry.name).map (fun name => ⟨name, entry.kind, entry.idx⟩) /-- Every byte-derived module export is classified exactly once: either the function/name/index of a claimed obligation or an explicit uncertified declaration. Both declaration lists are duplicate-free, disjoint and have - no phantom names absent from the export section. -/ -def exportsAccounted (artifact : ArtifactData) : Bool := - match AverCert.WasmSlice.enumExports artifact.modBytes artifact.modLen with + no phantom names absent from the export section. Names are compared + through their numeric keys, which identify them exactly (`seqKey_inj`); + a name without a key fails the check. -/ +def exportsAccountedOf (modBytes modLen : Nat) + (certified : List _root_.AverCert.WasmSlice.ExportEntry) + (declared : List _root_.AverCert.WasmSlice.ByteSeq) : Bool := + match _root_.AverCert.WasmSlice.enumExports modBytes modLen with | none => false | some actual => - let certified := certifiedExportEntries artifact.manifest - let declared := declaredUncertifiedNames artifact.manifest - let actualNames := actual.map (fun entry => entry.name) - let certifiedNames := certified.map (fun entry => entry.name) - let actualNameIndex := AverCert.WasmSlice.orderedSet actualNames - let declaredIndex := AverCert.WasmSlice.orderedSet declared - let actualEntryIndex := AverCert.WasmSlice.orderedSet (actual.map exportEntryKey) - let certifiedEntryIndex := AverCert.WasmSlice.orderedSet (certified.map exportEntryKey) - byteSeqListNodup actualNames && - byteSeqListNodup certifiedNames && - byteSeqListNodup declared && - certifiedNames.all (fun name => !declaredIndex.contains name) && - actual.all (fun entry => - certifiedEntryIndex.contains (exportEntryKey entry) || - declaredIndex.contains entry.name) && - certified.all (fun entry => actualEntryIndex.contains (exportEntryKey entry)) && - declared.all actualNameIndex.contains + match actual.mapM exportEntryKey, certified.mapM exportEntryKey, + _root_.AverCert.WasmSlice.seqKeys declared with + | some actual, some certified, some declared => + let actualNames := actual.map (fun entry => entry.name) + let certifiedNames := certified.map (fun entry => entry.name) + let actualNameIndex := _root_.AverCert.WasmSlice.orderedSet actualNames + let declaredIndex := _root_.AverCert.WasmSlice.orderedSet declared + let actualEntryIndex := _root_.AverCert.WasmSlice.orderedSet actual + let certifiedEntryIndex := _root_.AverCert.WasmSlice.orderedSet certified + _root_.AverCert.WasmSlice.natListNodup actualNames && + _root_.AverCert.WasmSlice.natListNodup certifiedNames && + _root_.AverCert.WasmSlice.natListNodup declared && + certifiedNames.all (fun name => !declaredIndex.contains name) && + actual.all (fun entry => + certifiedEntryIndex.contains entry || declaredIndex.contains entry.name) && + certified.all (fun entry => actualEntryIndex.contains entry) && + declared.all actualNameIndex.contains + | _, _, _ => false + +def exportsAccounted (artifact : ArtifactData) : Bool := + exportsAccountedOf artifact.modBytes artifact.modLen + (certifiedExportEntries artifact.manifest) (declaredUncertifiedNames artifact.manifest) + +/-! #### Names as character lists + +The kernel has no fast path for String literals: `stringBytes` of a literal +rebuilds its UTF-8 bytes, in time quadratic in its length, and a large +module's accounting converts hundreds of names. A literal is definitionally +`String.ofList` of its characters, which the kernel checks without building +bytes, so a package states its names as character lists once (by `rfl`) and +the lemmas below turn every `stringBytes` of them into the code-point lists +of those characters. -/ + +theorem stringBytes_ofList (c : List Char) : stringBytes (String.ofList c) = c.map Char.toNat := by + simp [stringBytes, String.toList_ofList] + +theorem certifiedExportEntries_of_chars {m : _root_.AverCert.Schema.Manifest} (cs : List (List Char)) + (h : m.obligations.map (·.export_) = cs.map String.ofList) : + certifiedExportEntries m = + List.zipWith (fun (o : Obligation) (c : List Char) => + ({ name := c.map Char.toNat, kind := 0, idx := o.self } : _root_.AverCert.WasmSlice.ExportEntry)) + m.obligations cs := by + unfold certifiedExportEntries + generalize m.obligations = os at h ⊢ + induction os generalizing cs with + | nil => cases cs <;> simp_all + | cons o os ih => + cases cs with + | nil => simp at h + | cons c cs => + simp only [List.map_cons, List.cons.injEq] at h + rw [List.map_cons, List.zipWith_cons_cons, ih cs h.2, h.1, stringBytes_ofList] + +theorem declaredUncertifiedNames_of_chars {m : _root_.AverCert.Schema.Manifest} (ds : List (List Char)) + (h : m.subject.declaredUncertified.map (·.1) = ds.map String.ofList) : + declaredUncertifiedNames m = ds.map (List.map Char.toNat) := by + have := congrArg (List.map stringBytes) h + simp only [List.map_map, Function.comp_def, stringBytes_ofList] at this + exact this + +/-- `exportsAccounted`, with the export names given as character lists. -/ +theorem exportsAccounted_of_chars (artifact : ArtifactData) (cs ds : List (List Char)) + (hc : artifact.manifest.obligations.map (·.export_) = cs.map String.ofList) + (hd : artifact.manifest.subject.declaredUncertified.map (·.1) = ds.map String.ofList) + (h : exportsAccountedOf artifact.modBytes artifact.modLen + (List.zipWith (fun (o : Obligation) (c : List Char) => + ({ name := c.map Char.toNat, kind := 0, idx := o.self } : _root_.AverCert.WasmSlice.ExportEntry)) + artifact.manifest.obligations cs) + (ds.map (List.map Char.toNat)) = true) : + exportsAccounted artifact = true := by + unfold exportsAccounted + rw [certifiedExportEntries_of_chars cs hc, declaredUncertifiedNames_of_chars ds hd] + exact h def capabilityBytes (capability : String × String) : - AverCert.WasmSlice.ByteSeq × AverCert.WasmSlice.ByteSeq := + _root_.AverCert.WasmSlice.ByteSeq × _root_.AverCert.WasmSlice.ByteSeq := (stringBytes capability.1, stringBytes capability.2) /-- The manifest capability list is exact (including import order), contains no @@ -2092,16 +509,16 @@ def importsWithinCapabilities (artifact : ArtifactData) : Bool := let declared := artifact.manifest.subject.capabilities stringListNodup (declared.map (fun capability => capability.1 ++ "." ++ capability.2)) && declared.all (fun capability => - (AverCert.Schema.capabilityRegistryForTarget artifact.manifest.subject.target).contains capability || + (_root_.AverCert.Schema.capabilityRegistryForTarget artifact.manifest.subject.target).contains capability || customCapabilityImport capability) && - match AverCert.WasmSlice.enumImportNames artifact.modBytes artifact.modLen with + match _root_.AverCert.WasmSlice.enumImportNames artifact.modBytes artifact.modLen with | some actual => actual == declared.map capabilityBytes | none => false /-- The manifest declares absence/presence and, when present, the exact start function index read from section 8. -/ def startAccounted (artifact : ArtifactData) : Bool := - AverCert.WasmSlice.startFuncIndex artifact.modBytes artifact.modLen == + _root_.AverCert.WasmSlice.startFuncIndex artifact.modBytes artifact.modLen == some artifact.manifest.subject.start /-- One union closure over all certified roots. Closure of a union is the union @@ -2112,122 +529,89 @@ def startAccounted (artifact : ArtifactData) : Bool := def closureIsolation (artifact : ArtifactData) : Bool := let claim := artifact.closureClaim let certified := artifact.manifest.obligations.map (fun obligation => obligation.self) - AverCert.WasmSlice.natListNodup claim.roots && - AverCert.WasmSlice.natListNodup claim.helpers && - AverCert.WasmSlice.natListNodup claim.admitted && - AverCert.WasmSlice.natSetEq claim.roots certified && - claim.roots.all (fun root => !AverCert.WasmSlice.natMem root claim.helpers) && - AverCert.WasmSlice.natSetEq claim.admitted (claim.roots ++ claim.helpers) && - AverCert.WasmSlice.noSharedMemory artifact.modBytes artifact.modLen && - match AverCert.WasmSlice.closureFold artifact.modBytes artifact.modLen + _root_.AverCert.WasmSlice.natListNodup claim.roots && + _root_.AverCert.WasmSlice.natListNodup claim.helpers && + _root_.AverCert.WasmSlice.natListNodup claim.admitted && + _root_.AverCert.WasmSlice.natSetEq claim.roots certified && + claim.roots.all (fun root => !_root_.AverCert.WasmSlice.natMem root claim.helpers) && + _root_.AverCert.WasmSlice.natSetEq claim.admitted (claim.roots ++ claim.helpers) && + _root_.AverCert.WasmSlice.noSharedMemory artifact.modBytes artifact.modLen && + match _root_.AverCert.WasmSlice.closureFold artifact.modBytes artifact.modLen artifact.closureFuel claim.roots [] with - | some actual => AverCert.WasmSlice.natSetEq actual claim.admitted + | some actual => _root_.AverCert.WasmSlice.natSetEq actual claim.admitted | none => false def acceptedWholeModule (artifact : ArtifactData) : Prop := - CertDecode.moduleFramingValid artifact.modBytes artifact.modLen = true ∧ + _root_.CertDecode.moduleFramingValid artifact.modBytes artifact.modLen = true ∧ exportsAccounted artifact = true ∧ importsWithinCapabilities artifact = true ∧ startAccounted artifact = true ∧ closureIsolation artifact = true -def acceptedSymFragments (artifact : ArtifactData) : Prop := - symFragmentClaimsAccepted artifact.modBytes artifact.modLen artifact.symFragmentClaims - -def acceptedStringConcatFragments (artifact : ArtifactData) : Prop := - stringConcatClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.stringConcatClaims - -def acceptedStringEqFragments (artifact : ArtifactData) : Prop := - stringEqClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.stringEqClaims - -def acceptedConstructFragments (artifact : ArtifactData) : Prop := - constructClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.constructClaims ∧ - (constructClaimExportNames artifact.constructClaims).Nodup - -def acceptedRecursionFragments (artifact : ArtifactData) : Prop := - recursionClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.recursionClaims - -def acceptedMutualRecursionFragments (artifact : ArtifactData) : Prop := - mutualRecursionClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.mutualRecursionClaims ∧ - mutualClaimsFormClosedSccs - artifact.manifest - artifact.mutualRecursionClaims - -def acceptedVerbatimFragments (artifact : ArtifactData) : Prop := - verbatimClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.verbatimClaims - -def acceptedIntDispatchFragments (artifact : ArtifactData) : Prop := - intDispatchClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.intDispatchClaims - -def acceptedFieldProjectionFragments (artifact : ArtifactData) : Prop := - fieldProjectionClaimsAccepted - artifact.modBytes artifact.modLen - artifact.manifest - artifact.fieldProjectionClaims - -/-- Besides the composition-claim acceptance this def carries the two - ARTIFACT-WIDE manifest-coverage conjuncts (`manifestObligationsClaimed`, - `manifestObligationExportsUnique`). Like `compositionMembersCovered` they - are cross-claim facts about the whole manifest, not per-family facts, and - `acceptedFragments` conjoins this def unconditionally for every artifact — - composition claims present or not. -/ -def acceptedCompositionFragments (artifact : ArtifactData) : Prop := - compositionClaimsAccepted - artifact.modBytes artifact.modLen - artifact.compositionMembers artifact.compositionClaims ∧ - compositionMembersCovered - artifact.compositionMembers artifact.compositionClaims = true ∧ - manifestObligationsClaimed artifact = true ∧ - manifestObligationExportsUnique artifact = true - -def acceptedFragments (artifact : ArtifactData) : Prop := - acceptedSymFragments artifact ∧ - acceptedStringEqFragments artifact ∧ - acceptedStringConcatFragments artifact ∧ - acceptedConstructFragments artifact ∧ - acceptedRecursionFragments artifact ∧ - acceptedMutualRecursionFragments artifact ∧ - acceptedVerbatimFragments artifact ∧ - acceptedIntDispatchFragments artifact ∧ - acceptedFieldProjectionFragments artifact ∧ - acceptedCompositionFragments artifact ∧ - acceptedWholeModule artifact - -def artifactCoreBytes (artifact : ArtifactData) : AverCert.Wasip2Envelope.ByteSeq := - AverCert.Wasip2Envelope.ComponentEnvelope.bytes artifact.modBytes artifact.modLen + +/-! ### The plans against the bytes -/ + +/-- Every byte fact about the plans: role and planned indices distinct, every + planned function bound to its code entry (and signature, and ordered + calls), the type table confirmed against the type section, every string + literal against its data segment, and every present helper's declared + type. Last, the declarations are well formed (`TypeTable.declsWellFormed`): + `eqref` only on the subject scratch, no newtype cycle, and every declared + type and every signature type inhabited, so no obligation is vacuous + (`AcceptanceSoundness.accepted_nonvacuous`). -/ +def plansAccepted (artifact : ArtifactData) : Bool := + let m := artifact.manifest + let M := mctxOf m.subject m.types m.fnPlans + indicesDistinct M m.fnPlans && + m.fnPlans.all (entryAccepted artifact.modBytes artifact.modLen M m.fnPlans) && + typeTableConfirmed artifact.modBytes artifact.modLen m.subject m.types m.fnPlans && + dataConfirmed artifact.modBytes artifact.modLen m.subject m.types m.fnPlans && + roleTypesPinned artifact.modBytes artifact.modLen M && + declsWellFormed m.subject m.types m.fnPlans + +/-- The conjuncts of `plansAccepted` other than the per-entry checks. A + package proves the per-entry checks in chunks, one declaration each, so + that no single kernel check walks every plan of a large module. -/ +def plansAcceptedRest (artifact : ArtifactData) : Bool := + let m := artifact.manifest + let M := mctxOf m.subject m.types m.fnPlans + indicesDistinct M m.fnPlans && + typeTableConfirmed artifact.modBytes artifact.modLen m.subject m.types m.fnPlans && + dataConfirmed artifact.modBytes artifact.modLen m.subject m.types m.fnPlans && + roleTypesPinned artifact.modBytes artifact.modLen M && + declsWellFormed m.subject m.types m.fnPlans + +theorem plansAccepted_of_parts (artifact : ArtifactData) + (hall : artifact.manifest.fnPlans.all + (entryAccepted artifact.modBytes artifact.modLen + (mctxOf artifact.manifest.subject artifact.manifest.types artifact.manifest.fnPlans) + artifact.manifest.fnPlans) = true) + (hrest : plansAcceptedRest artifact = true) : plansAccepted artifact = true := by + simp only [plansAcceptedRest, Bool.and_eq_true] at hrest + obtain ⟨⟨⟨⟨ha, hc⟩, hd⟩, he⟩, hf⟩ := hrest + simp only [plansAccepted, Bool.and_eq_true] + exact ⟨⟨⟨⟨⟨ha, hall⟩, hc⟩, hd⟩, he⟩, hf⟩ + +/-- The manifest's obligations are exactly the ones the wall derives from its + plans: no obligation field is producer data. -/ +def obligationsDerived (artifact : ArtifactData) : Prop := + artifact.manifest.obligations = + obligationsOf artifact.manifest.subject artifact.manifest.types artifact.manifest.fnPlans + +def artifactCoreBytes (artifact : ArtifactData) : _root_.AverCert.Wasip2Envelope.ByteSeq := + _root_.AverCert.Wasip2Envelope.ComponentEnvelope.bytes artifact.modBytes artifact.modLen /-- Check a single wasip2 envelope declaration against delivered component bytes and the already-selected core module bytes. The split is length-driven only: it never parses component syntax or searches for a core module. -/ def wasip2EnvelopeAccepted - (env : AverCert.Wasip2Envelope.ComponentEnvelope) + (env : _root_.AverCert.Wasip2Envelope.ComponentEnvelope) (componentBytes componentLen modBytes modLen : Nat) : Bool := env.embeddedCoreModuleLen != 0 && componentLen == env.prefixLen + env.embeddedCoreModuleLen + env.suffixLen && match env.split componentBytes componentLen with | some (_, core, _) => - core == AverCert.Wasip2Envelope.ComponentEnvelope.bytes modBytes modLen + core == _root_.AverCert.Wasip2Envelope.ComponentEnvelope.bytes modBytes modLen | none => false /-- Bind the target artifact bytes to the core module bytes used by the existing @@ -2255,58 +639,5 @@ def expectedArtifactRoot : String := def subjectMatchesArtifactRoot (artifact : ArtifactData) : Prop := artifact.manifest.subject.artifactRoot = expectedArtifactRoot -def claimObligations (artifact : ArtifactData) : List Obligation := - artifact.symFragmentClaims.map (fun c => c.obligation) ++ - artifact.stringEqClaims.map (fun c => c.obligation) ++ - artifact.stringConcatClaims.map (fun c => c.obligation) ++ - artifact.constructClaims.map (fun c => c.obligation) ++ - artifact.recursionClaims.map (fun c => c.obligation) ++ - artifact.mutualRecursionClaims.map (fun c => c.obligation) ++ - artifact.verbatimClaims.map (fun c => c.obligation) ++ - artifact.intDispatchClaims.map (fun c => c.obligation) ++ - artifact.fieldProjectionClaims.map (fun c => c.obligation) ++ - artifact.compositionClaims.map (fun c => c.obligation) - -def claimObligationsInManifest - (manifestObligations : List Obligation) : List Obligation → Prop - | [] => True - | obligation :: rest => - manifestObligations.find? - (fun o => o.export_ = obligation.export_) = some obligation ∧ - claimObligationsInManifest manifestObligations rest - -def fragmentClaimObligationsInManifest (artifact : ArtifactData) : Prop := - claimObligationsInManifest - artifact.manifest.obligations - (claimObligations artifact) - -def claimsMatchManifest (artifact : ArtifactData) : Prop := - match symFragmentClaimEncodedPlanPairs artifact.symFragmentClaims with - | some encodedSymExprPlans => - symFragmentClaimPlanPairs artifact.symFragmentClaims ++ - stringEqClaimSymPlanPairs artifact.stringEqClaims ++ - stringConcatClaimSymPlanPairs artifact.stringConcatClaims ++ - constructClaimSymPlanPairs artifact.constructClaims = - artifact.manifest.symFragmentPlans ∧ - stringEqClaimExportNames artifact.stringEqClaims = - stringEqManifestPlanNames artifact.manifest ∧ - stringConcatClaimExportNames artifact.stringConcatClaims = - stringConcatManifestPlanNames artifact.manifest ∧ - constructClaimExportNames artifact.constructClaims = - constructManifestPlanNames artifact.manifest ∧ - encodedSymExprPlans = artifact.manifest.exprFragmentPlans ∧ - recursionClaimExportNames artifact.recursionClaims = - recursionManifestPlanNames artifact.manifest ∧ - mutualRecursionClaimExportNames artifact.mutualRecursionClaims = - mutualManifestPlanNames artifact.manifest ∧ - verbatimClaimExportNames artifact.verbatimClaims = - verbatimManifestPlanNames artifact.manifest ∧ - intDispatchClaimExportNames artifact.intDispatchClaims = - intDispatchManifestPlanNames artifact.manifest ∧ - fieldProjectionClaimExportNames artifact.fieldProjectionClaims = - fieldProjectionManifestPlanNames artifact.manifest ∧ - compositionMemberPlanPairs artifact.compositionMembers = - artifact.manifest.compositionPlans - | none => False end AverCert.AcceptedArtifact diff --git a/aver-cert/assets/wall/current/ArithTemplateDerisk.lean b/aver-cert/assets/wall/current/ArithTemplateDerisk.lean index 7dd976dea..aace91163 100644 --- a/aver-cert/assets/wall/current/ArithTemplateDerisk.lean +++ b/aver-cert/assets/wall/current/ArithTemplateDerisk.lean @@ -1,9 +1,9 @@ /- # De-risk: declared arith host-role helpers pinned by TEMPLATE equality -Fourth column of the declared-envelope family (`dCtorBody` / `concatPinnedAt` -lower the TYPE section from declaration; this module lowers the arith helper -CODE bodies). The certificate DECLARES which function index carries each of +This module lowers the arith helper CODE bodies from declaration, as +`GrammarLower` lowers the certified functions and `TypeTable` confirms the type +section. The certificate DECLARES which function index carries each of the host-role contracts — `Int.add` / `Int.sub` / `Int.mul`, the Int-carrier `box` constructor, the `toIndex` index-extraction helper and the two value-comparison helpers `cmp` / `eq` (the manifest @@ -69,7 +69,7 @@ namespace ArithTemplateDerisk tell them apart and only the export name decides which of the two a given index is. -/ inductive ArithRole where - | box | add | sub | mul | toIndex | cmp | eq + | box | add | sub | mul | toIndex | cmp | eq | divmod deriving Repr, DecidableEq /-- The DECLARED indices the helper bodies are a function of. Nothing here is @@ -532,6 +532,194 @@ def eqTemplateBody (p : ArithHostParams) : List Nat := [0x20, 0x04, 0x41, 0x01, 0x6a, 0x21, 0x04, 0x0c, 0x00, 0x0b, 0x0b] ++ [0x20, 0x06, 0x0b, 0x0b, 0x0b, 0x0b, 0x0b] +/-- `__aint_divmod(a, b, want_mod)`: Euclidean division (`want_mod = 0`) or + remainder (`want_mod != 0`) (`src/codegen/wasm_gc/builtins/wat/divmod.wat`, + `emit_aint_divmod`). Like `add`, `sub` and `mul` it is not exported, so + it is pinned by this template alone. + + It mentions `carrier` at every `struct.get` / `struct.new` of an operand + or a Small result and in its result block types, `limb` in its locals + vector and at every magnitude-array operation (`array.new_default`, + `array.get`, `array.set`, `array.copy`) and `ref.null`, and calls the + four factored sub-routines: `decompose` (twice, one per operand), `strip` + (twice), `umagCmp` (twice: remainder against divisor in the shift-subtract + loop, and the operand magnitudes) and `normalize` (once per result + branch). Every other byte is a literal of the WAT template: the Small fast + path (`i64.rem_s` / `i64.div_s` with the Euclidean lift, guarded against + the `i64::MIN / -1` edge), the one-limb and shift-subtract long division, + and the sign and Euclidean adjustment. The template was read off the + emitted body with `aver-cert` probe tooling and every splice position is + exercised by the byte probes over two modules with different declared + indices. + + TEMPLATE HAZARD, as for `cmp`: the body has this shape only when the four + sub-routines are registered (the emitter inlines them otherwise); an + inlined body matches no template and the role declines. -/ +def divmodTemplateBody (p : ArithHostParams) : List Nat := + [0x0b, 0x04, 0x7e, 0x01, 0x63] ++ + CertPrelude.s33Bytes p.limb ++ + [0x01, 0x7f, 0x01, 0x63] ++ + CertPrelude.s33Bytes p.limb ++ + [0x03, 0x7f, 0x02, 0x63] ++ + CertPrelude.s33Bytes p.limb ++ + [0x01, 0x7f, 0x02, 0x63] ++ + CertPrelude.s33Bytes p.limb ++ + [0x09, 0x7f, 0x07, 0x7e, 0x01, 0x63] ++ + CertPrelude.s33Bytes p.limb ++ + [0x20, 0x00, 0xfb, 0x02] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x01, 0xd1, 0x20, 0x01, 0xfb, 0x02] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x01, 0xd1, 0x71, 0x20, 0x00, 0xfb, 0x02] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x00, 0x42, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x7f, 0x51, 0x20, + 0x01, 0xfb, 0x02] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x00, 0x42, 0x7f, 0x51, 0x71, 0x45, 0x71, 0x04, 0x63] ++ + CertPrelude.s33Bytes p.carrier ++ + [0x20, 0x00, 0xfb, 0x02] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x00, 0x21, 0x03, 0x20, 0x01, 0xfb, 0x02] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x00, 0x21, 0x04, 0x20, 0x03, 0x20, 0x04, 0x81, 0x21, 0x06, 0x20, 0x06, 0x42, 0x00, + 0x53, 0x04, 0x40, 0x20, 0x06, 0x20, 0x04, 0x42, 0x00, 0x53, 0x04, 0x7e, 0x42, 0x00, + 0x20, 0x04, 0x7d, 0x05, 0x20, 0x04, 0x0b, 0x7c, 0x21, 0x06, 0x0b, 0x20, 0x02, 0x04, + 0x63] ++ + CertPrelude.s33Bytes p.carrier ++ + [0x20, 0x06, 0xd0] ++ + CertPrelude.s33Bytes p.limb ++ + [0x41, 0x00, 0xfb, 0x00] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x05, 0x20, 0x03, 0x20, 0x04, 0x7f, 0x21, 0x05, 0x20, 0x03, 0x20, 0x04, 0x81, 0x21, + 0x06, 0x20, 0x06, 0x42, 0x00, 0x53, 0x04, 0x40, 0x20, 0x04, 0x42, 0x00, 0x55, 0x04, + 0x7e, 0x20, 0x05, 0x42, 0x01, 0x7d, 0x05, 0x20, 0x05, 0x42, 0x01, 0x7c, 0x0b, 0x21, + 0x05, 0x0b, 0x20, 0x05, 0xd0] ++ + CertPrelude.s33Bytes p.limb ++ + [0x41, 0x00, 0xfb, 0x00] ++ + CertPrelude.uleb32Bytes p.carrier ++ + [0x0b, 0x05, 0x20, 0x00, 0x10] ++ + CertPrelude.uleb32Bytes p.decompose ++ + [0x21, 0x08, 0x21, 0x07, 0x20, 0x01, 0x10] ++ + CertPrelude.uleb32Bytes p.decompose ++ + [0x21, 0x0a, 0x21, 0x09, 0x20, 0x07, 0x10] ++ + CertPrelude.uleb32Bytes p.strip ++ + [0x21, 0x0b, 0x20, 0x09, 0x10] ++ + CertPrelude.uleb32Bytes p.strip ++ + [0x21, 0x0c, 0x20, 0x0b, 0x45, 0x04, 0x7f, 0x41, 0x01, 0x05, 0x20, 0x0b, 0x0b, 0xfb, + 0x07] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x21, 0x0d, 0x20, 0x0c, 0x41, 0x01, 0x6a, 0xfb, 0x07] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x21, 0x0e, 0x41, 0x00, 0x21, 0x0f, 0x20, 0x0c, 0x41, 0x01, 0x46, 0x04, 0x40, 0x20, + 0x09, 0x41, 0x00, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x21, 0x04, 0x42, 0x00, 0x21, 0x06, 0x20, 0x0b, 0x41, 0x01, 0x6b, 0x21, 0x17, 0x02, + 0x40, 0x03, 0x40, 0x20, 0x17, 0x41, 0x00, 0x48, 0x0d, 0x01, 0x20, 0x06, 0x42, 0x20, + 0x86, 0x20, 0x07, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x84, 0x21, 0x1c, 0x20, 0x0d, 0x20, 0x17, 0x20, 0x1c, 0x20, 0x04, 0x80, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x1c, 0x20, 0x04, 0x82, 0x21, 0x06, 0x20, 0x17, 0x41, 0x01, 0x6b, 0x21, 0x17, + 0x0c, 0x00, 0x0b, 0x0b, 0x20, 0x0e, 0x41, 0x00, 0x20, 0x06, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x05, 0x02, 0x40, 0x20, 0x07, 0x20, 0x0b, 0x20, 0x09, 0x20, 0x0c, 0x10] ++ + CertPrelude.uleb32Bytes p.umagCmp ++ + [0x21, 0x19, 0x20, 0x19, 0x41, 0x00, 0x48, 0x04, 0x40, 0x20, 0x0e, 0x41, 0x00, 0x20, + 0x07, 0x41, 0x00, 0x20, 0x0b, 0xfb, 0x11] ++ + CertPrelude.uleb32Bytes p.limb ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x0c, 0x01, 0x0b, 0x20, 0x0c, 0x41, 0x01, 0x6b, 0x21, 0x0f, 0x20, 0x0b, 0x20, 0x0f, + 0x6b, 0x21, 0x15, 0x20, 0x0e, 0x41, 0x00, 0x20, 0x07, 0x20, 0x15, 0x20, 0x0f, 0xfb, + 0x11] ++ + CertPrelude.uleb32Bytes p.limb ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x15, 0x41, 0x20, 0x6c, 0x41, 0x01, 0x6b, 0x21, 0x14, 0x02, 0x40, 0x03, 0x40, + 0x20, 0x14, 0x41, 0x00, 0x48, 0x0d, 0x01, 0x20, 0x0f, 0x20, 0x0c, 0x49, 0x04, 0x7f, + 0x20, 0x0f, 0x05, 0x20, 0x0c, 0x0b, 0x41, 0x01, 0x6a, 0x21, 0x0f, 0x42, 0x00, 0x21, + 0x1b, 0x41, 0x00, 0x21, 0x17, 0x02, 0x40, 0x03, 0x40, 0x20, 0x17, 0x20, 0x0f, 0x4f, + 0x0d, 0x01, 0x20, 0x0e, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x42, 0x01, 0x86, 0x42, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x83, 0x20, 0x1b, 0x84, 0x21, + 0x1c, 0x20, 0x0e, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x42, 0x1f, 0x88, 0x21, 0x1b, 0x20, 0x0e, 0x20, 0x17, 0x20, 0x1c, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x17, 0x41, 0x01, 0x6a, 0x21, 0x17, 0x0c, 0x00, 0x0b, 0x0b, 0x20, 0x14, 0x41, + 0x20, 0x6e, 0x21, 0x15, 0x20, 0x14, 0x41, 0x20, 0x70, 0x21, 0x16, 0x20, 0x07, 0x20, + 0x15, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x16, 0xad, 0x88, 0x42, 0x01, 0x83, 0x42, 0x00, 0x52, 0x04, 0x40, 0x20, 0x0e, + 0x41, 0x00, 0x20, 0x0e, 0x41, 0x00, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x42, 0x01, 0x84, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x0b, 0x02, 0x40, 0x03, 0x40, 0x20, 0x0f, 0x45, 0x0d, 0x01, 0x20, 0x0e, 0x20, 0x0f, + 0x41, 0x01, 0x6b, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x42, 0x00, 0x52, 0x0d, 0x01, 0x20, 0x0f, 0x41, 0x01, 0x6b, 0x21, 0x0f, 0x0c, 0x00, + 0x0b, 0x0b, 0x20, 0x0e, 0x20, 0x0f, 0x20, 0x09, 0x20, 0x0c, 0x10] ++ + CertPrelude.uleb32Bytes p.umagCmp ++ + [0x21, 0x19, 0x20, 0x19, 0x41, 0x00, 0x4e, 0x04, 0x40, 0x42, 0x00, 0x21, 0x1d, 0x41, + 0x00, 0x21, 0x17, 0x02, 0x40, 0x03, 0x40, 0x20, 0x17, 0x20, 0x0c, 0x41, 0x01, 0x6a, + 0x4f, 0x0d, 0x01, 0x20, 0x0e, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x17, 0x20, 0x0c, 0x49, 0x04, 0x7e, 0x20, 0x09, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x05, 0x42, 0x00, 0x0b, 0x7d, 0x20, 0x1d, 0x7d, 0x21, 0x1e, 0x20, 0x1e, 0x42, 0x00, + 0x53, 0x04, 0x40, 0x20, 0x1e, 0x42, 0x80, 0x80, 0x80, 0x80, 0x10, 0x7c, 0x21, 0x1e, + 0x42, 0x01, 0x21, 0x1d, 0x05, 0x42, 0x00, 0x21, 0x1d, 0x0b, 0x20, 0x0e, 0x20, 0x17, + 0x20, 0x1e, 0x42, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x83, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x17, 0x41, 0x01, 0x6a, 0x21, 0x17, 0x0c, 0x00, 0x0b, 0x0b, 0x20, 0x0d, 0x20, + 0x15, 0x20, 0x0d, 0x20, 0x15, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x42, 0x01, 0x20, 0x16, 0xad, 0x86, 0x84, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x0b, 0x20, 0x14, 0x41, 0x01, 0x6b, 0x21, 0x14, 0x0c, 0x00, 0x0b, 0x0b, 0x0b, 0x0b, + 0x20, 0x0c, 0x41, 0x01, 0x6a, 0x21, 0x0f, 0x02, 0x40, 0x03, 0x40, 0x20, 0x0f, 0x45, + 0x0d, 0x01, 0x20, 0x0e, 0x20, 0x0f, 0x41, 0x01, 0x6b, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x42, 0x00, 0x52, 0x0d, 0x01, 0x20, 0x0f, 0x41, 0x01, 0x6b, 0x21, 0x0f, 0x0c, 0x00, + 0x0b, 0x0b, 0x20, 0x08, 0x41, 0x00, 0x48, 0x20, 0x0f, 0x41, 0x00, 0x47, 0x71, 0x21, + 0x1a, 0x20, 0x02, 0x04, 0x63] ++ + CertPrelude.s33Bytes p.carrier ++ + [0x20, 0x1a, 0x04, 0x40, 0x20, 0x0c, 0xfb, 0x07] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x21, 0x10, 0x42, 0x00, 0x21, 0x1d, 0x41, 0x00, 0x21, 0x17, 0x02, 0x40, 0x03, 0x40, + 0x20, 0x17, 0x20, 0x0c, 0x4f, 0x0d, 0x01, 0x20, 0x09, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x17, 0x20, 0x0f, 0x49, 0x04, 0x7e, 0x20, 0x0e, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x05, 0x42, 0x00, 0x0b, 0x7d, 0x20, 0x1d, 0x7d, 0x21, 0x1e, 0x20, 0x1e, 0x42, 0x00, + 0x53, 0x04, 0x40, 0x20, 0x1e, 0x42, 0x80, 0x80, 0x80, 0x80, 0x10, 0x7c, 0x21, 0x1e, + 0x42, 0x01, 0x21, 0x1d, 0x05, 0x42, 0x00, 0x21, 0x1d, 0x0b, 0x20, 0x10, 0x20, 0x17, + 0x20, 0x1e, 0x42, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x83, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x17, 0x41, 0x01, 0x6a, 0x21, 0x17, 0x0c, 0x00, 0x0b, 0x0b, 0x20, 0x10, 0x21, + 0x11, 0x05, 0x20, 0x0e, 0x21, 0x11, 0x0b, 0x41, 0x01, 0x21, 0x12, 0x20, 0x11, 0x20, + 0x12, 0x10] ++ + CertPrelude.uleb32Bytes p.normalize ++ + [0x05, 0x20, 0x08, 0x20, 0x0a, 0x6c, 0x21, 0x12, 0x20, 0x1a, 0x04, 0x40, 0x20, 0x0b, + 0x41, 0x01, 0x6a, 0xfb, 0x07] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x21, 0x10, 0x41, 0x00, 0x21, 0x17, 0x02, 0x40, 0x03, 0x40, 0x20, 0x17, 0x20, 0x0b, + 0x4f, 0x0d, 0x01, 0x20, 0x10, 0x20, 0x17, 0x20, 0x0d, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x17, 0x41, 0x01, 0x6a, 0x21, 0x17, 0x0c, 0x00, 0x0b, 0x0b, 0x42, 0x01, 0x21, + 0x1b, 0x41, 0x00, 0x21, 0x17, 0x02, 0x40, 0x03, 0x40, 0x20, 0x1b, 0x50, 0x0d, 0x01, + 0x20, 0x10, 0x20, 0x17, 0xfb, 0x0b] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x1b, 0x7c, 0x21, 0x1c, 0x20, 0x10, 0x20, 0x17, 0x20, 0x1c, 0x42, 0xff, 0xff, + 0xff, 0xff, 0x0f, 0x83, 0xfb, 0x0e] ++ + CertPrelude.uleb32Bytes p.limb ++ + [0x20, 0x1c, 0x42, 0x20, 0x88, 0x21, 0x1b, 0x20, 0x17, 0x41, 0x01, 0x6a, 0x21, 0x17, + 0x0c, 0x00, 0x0b, 0x0b, 0x20, 0x10, 0x21, 0x11, 0x05, 0x20, 0x0d, 0x21, 0x11, 0x0b, + 0x20, 0x11, 0x20, 0x12, 0x10] ++ + CertPrelude.uleb32Bytes p.normalize ++ + [0x0b, 0x0b, 0x0b] + /-- Dispatch: the canonical body bytes for a declared role. -/ def arithHelperBody : ArithRole → ArithHostParams → List Nat | .box, p => boxTemplateBody p @@ -541,5 +729,6 @@ def arithHelperBody : ArithRole → ArithHostParams → List Nat | .toIndex, p => toIndexTemplateBody p | .cmp, p => cmpTemplateBody p | .eq, p => eqTemplateBody p + | .divmod, p => divmodTemplateBody p end ArithTemplateDerisk diff --git a/aver-cert/assets/wall/current/ByteWindow.lean b/aver-cert/assets/wall/current/ByteWindow.lean new file mode 100644 index 000000000..3a4672dcd --- /dev/null +++ b/aver-cert/assets/wall/current/ByteWindow.lean @@ -0,0 +1,1136 @@ +-- Section cuts: a section decoded one declared entry at a time. +import CertDecode + +set_option linter.unusedSimpArgs false + +namespace AverCert.ByteWindow +open CertDecode + +/-! ### Windows + +The decoders read a section as a little-endian numeral `n` and a length, one +byte at a time: each byte read shifts the remaining numeral, so decoding a +section of `S` bytes builds `S` numerals of average size `S / 2`, and the +kernel keeps every one of them until the declaration is checked. A window is +the numeral of one entry, `w < 2 ^ (8 * l)`, followed in the section by the +rest `R`: the section is `w + 2 ^ (8 * l) * R`. The lemmas below show that a +decoder run on a window alone gives what it gives inside the section, so a +section can be cut into its entries and each entry decoded alone. -/ + +theorem pow_eight (l : Nat) : 2 ^ (8 * (l + 1)) = 256 * 2 ^ (8 * l) := by + rw [Nat.mul_succ, Nat.pow_add, Nat.mul_comm] + +theorem pow_split {k l : Nat} (h : k ≤ l) : 2 ^ (8 * l) = 2 ^ (8 * k) * 2 ^ (8 * (l - k)) := by + rw [← Nat.pow_add, ← Nat.mul_add, Nat.add_sub_cancel' h] + +theorem land_ff (x : Nat) : x &&& 0xff = x % 256 := + Nat.and_two_pow_sub_one_eq_mod x 8 + +theorem byte_ext {w l R : Nat} (hl : l ≠ 0) : (w + 2 ^ (8 * l) * R) &&& 0xff = w &&& 0xff := by + obtain ⟨l, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hl + rw [land_ff, land_ff, pow_eight, Nat.mul_assoc, Nat.add_mul_mod_self_left] + +theorem shr_ext {w l R : Nat} (k : Nat) (hk : k ≤ l) : + (w + 2 ^ (8 * l) * R) >>> (8 * k) = (w >>> (8 * k)) + 2 ^ (8 * (l - k)) * R := by + rw [Nat.shiftRight_eq_div_pow, Nat.shiftRight_eq_div_pow, pow_split hk, Nat.mul_assoc, + Nat.add_mul_div_left _ _ (Nat.two_pow_pos _)] + +theorem shr_lt {w l : Nat} (k : Nat) (hk : k ≤ l) (hw : w < 2 ^ (8 * l)) : + w >>> (8 * k) < 2 ^ (8 * (l - k)) := by + rw [Nat.shiftRight_eq_div_pow, Nat.div_lt_iff_lt_mul (Nat.two_pow_pos _), Nat.mul_comm, + ← pow_split hk] + exact hw + +theorem shr8_ext {w l R : Nat} (hl : l ≠ 0) : + (w + 2 ^ (8 * l) * R) >>> 8 = (w >>> 8) + 2 ^ (8 * (l - 1)) * R := by + have := shr_ext (w := w) (R := R) 1 (Nat.one_le_iff_ne_zero.mpr hl) + simpa using this + +theorem shr8_lt {w l : Nat} (hl : l ≠ 0) (hw : w < 2 ^ (8 * l)) : w >>> 8 < 2 ^ (8 * (l - 1)) := by + have := shr_lt (w := w) 1 (Nat.one_le_iff_ne_zero.mpr hl) hw + simpa using this + +theorem takeBytes_ext : ∀ {k w l R : Nat}, k ≤ l → w < 2 ^ (8 * l) → + takeBytes k (w + 2 ^ (8 * l) * R) = takeBytes k w + | 0, _, _, _, _, _ => rfl + | k + 1, w, l, R, hk, hw => by + have hl : l ≠ 0 := by omega + simp only [takeBytes] + rw [byte_ext hl, shr8_ext hl, takeBytes_ext (by omega) (shr8_lt hl hw)] + +theorem isolateBytes_eq (n k : Nat) : isolateBytes n k = n % 2 ^ (8 * k) := by + unfold isolateBytes + rw [Nat.shiftLeft_eq, Nat.one_mul, Nat.and_two_pow_sub_one_eq_mod] + +theorem isolateBytes_ext {w l R k : Nat} (hk : k ≤ l) : + isolateBytes (w + 2 ^ (8 * l) * R) k = isolateBytes w k := by + rw [isolateBytes_eq, isolateBytes_eq, pow_split hk, Nat.mul_assoc, Nat.add_mul_mod_self_left] + +theorem isolateBytes_lt (n k : Nat) : isolateBytes n k < 2 ^ (8 * k) := by + rw [isolateBytes_eq]; exact Nat.mod_lt _ (Nat.two_pow_pos _) + +/-- A reader's result on a window is its result inside the section: the same + value, and the section's rest after the window's rest. -/ +def Ext {α : Type} (r : Nat → Nat → Option (α × Nat × Nat)) : Prop := + ∀ {w l x w' l'}, w < 2 ^ (8 * l) → r w l = some (x, w', l') → + w' < 2 ^ (8 * l') ∧ l' ≤ l ∧ + ∀ R L, r (w + 2 ^ (8 * l) * R) (l + L) = some (x, w' + 2 ^ (8 * l') * R, l' + L) + +theorem uleb_ext : ∀ (fuel acc sh : Nat), Ext (uleb fuel acc sh) + | 0, _, _, _, _, _, _, _, _, h => by simp [uleb] at h + | fuel + 1, acc, sh, w, l, x, w', l', hw, h => by + unfold uleb at h + by_cases hl : l = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ite_false] at h + split at h + · rename_i hb + split at h + · cases h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr8_lt hl hw, by omega, fun R L => ?_⟩ + have hlL : (l + L == 0) = false := by simp; omega + unfold uleb + simp only [hlL, Bool.false_eq_true, ite_false, byte_ext hl, shr8_ext hl, hb, ite_true] + rename_i hc + simp only [hc, Bool.false_eq_true, ite_false] + congr 3 + omega + · rename_i hb + obtain ⟨hw', hle, hext⟩ := uleb_ext fuel _ _ (shr8_lt hl hw) h + refine ⟨hw', by omega, fun R L => ?_⟩ + have hlL : (l + L == 0) = false := by simp; omega + unfold uleb + simp only [hlL, Bool.false_eq_true, ite_false, byte_ext hl, shr8_ext hl, hb, ite_false] + have := hext R L + rw [show l + L - 1 = l - 1 + L by omega] + exact this + +theorem readU_ext : Ext readU := uleb_ext 5 0 0 + +theorem readName_ext : Ext readName := by + intro w l x w' l' hw h + unfold readName at h + split at h + · cases h + · rename_i nameLen b bl hU + obtain ⟨hb, hbl, hext⟩ := readU_ext hw hU + split at h + · rename_i hle + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr_lt nameLen hle hb, by omega, fun R L => ?_⟩ + unfold readName + rw [hext R L] + simp only [show nameLen ≤ bl + L by omega, ↓reduceIte, takeBytes_ext hle hb, + shr_ext nameLen hle, Option.some.injEq, Prod.mk.injEq, true_and] + omega + · cases h + +theorem readExportEntry_ext : Ext readExportEntry := by + intro w l x w' l' hw h + unfold readExportEntry at h + split at h + · cases h + · rename_i name n1 l1 hN + obtain ⟨hn1, hl1, hext⟩ := readName_ext hw hN + by_cases h0 : l1 = 0 + · simp [h0] at h + simp only [h0, beq_iff_eq, ↓reduceIte] at h + split at h + · cases h + · rename_i hk + split at h + · cases h + · rename_i idx n2 l2 hU + obtain ⟨hn2, hl2, hext2⟩ := readU_ext (shr8_lt h0 hn1) hU + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨hn2, by omega, fun R L => ?_⟩ + unfold readExportEntry + rw [hext R L] + have hL : (l1 + L == 0) = false := by simp; omega + simp only [hL, Bool.false_eq_true, ↓reduceIte, byte_ext h0, hk, shr8_ext h0, + show l1 + L - 1 = l1 - 1 + L by omega, hext2 R L] + +/-- A vector of entries read one after another. -/ +def vec {α : Type} (r : Nat → Nat → Option (α × Nat × Nat)) : Nat → Nat → Nat → Option (List α × Nat × Nat) + | 0, n, len => some ([], n, len) + | k + 1, n, len => + match r n len with + | none => none + | some (x, n1, len1) => + match vec r k n1 len1 with + | none => none + | some (rest, n2, len2) => some (x :: rest, n2, len2) + +theorem decRawExportVec_eq_vec : ∀ k n len, decRawExportVec k n len = vec readExportEntry k n len + | 0, _, _ => rfl + | k + 1, n, len => by + simp only [decRawExportVec, vec, decRawExportVec_eq_vec k] + rcases readExportEntry n len with _ | ⟨e, n1, l1⟩ + · rfl + · simp only [] + rcases vec readExportEntry k n1 l1 with _ | ⟨xs, n2, l2⟩ <;> rfl + +theorem vec_ext {α : Type} {r : Nat → Nat → Option (α × Nat × Nat)} (hr : Ext r) (k : Nat) : + Ext (vec r k) := by + induction k with + | zero => + intro w l x w' l' hw h + simp only [vec, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + exact ⟨hw, Nat.le_refl _, fun _ _ => rfl⟩ + | succ k ih => + intro w l x w' l' hw h + simp only [vec] at h + split at h + · cases h + · rename_i y w1 l1 h1 + split at h + · cases h + · rename_i ys w2 l2 h2 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + obtain ⟨hw1, hl1, hx1⟩ := hr hw h1 + obtain ⟨hw2, hl2, hx2⟩ := ih hw1 h2 + refine ⟨hw2, by omega, fun R L => ?_⟩ + simp only [vec, hx1 R L, hx2 R L] + +/-- A byte-at-a-time step: the byte is the window's, and the rest is the + window's rest followed by the section's. -/ +theorem step_ext {w l R L : Nat} (hl : l ≠ 0) : + (l + L == 0) = false ∧ (w + 2 ^ (8 * l) * R) &&& 0xff = w &&& 0xff ∧ + (w + 2 ^ (8 * l) * R) >>> 8 = (w >>> 8) + 2 ^ (8 * (l - 1)) * R ∧ l + L - 1 = l - 1 + L := by + refine ⟨by simp; omega, byte_ext hl, shr8_ext hl, by omega⟩ + +theorem sleb_ext : ∀ (fuel : Nat) (acc : Int) (sh : Nat), Ext (sleb fuel acc sh) + | 0, _, _, _, _, _, _, _, _, h => by simp [sleb] at h + | fuel + 1, acc, sh, w, l, x, w', l', hw, h => by + unfold sleb at h + by_cases hl : l = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ite_false] at h + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := 0) (L := 0) (w := w) hl + split at h + · rename_i hlt + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr8_lt hl hw, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold sleb + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, hlt, ite_true] + · rename_i hlt + obtain ⟨hw', hle, hext⟩ := sleb_ext fuel _ _ (shr8_lt hl hw) h + refine ⟨hw', by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold sleb + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, hlt] + exact hext R L + +theorem readS_ext : Ext readS := sleb_ext 10 0 0 + +theorem readS33_ext : Ext readS33 := by + intro w l x w' l' hw h + unfold readS33 at h + split at h + · rename_i v w1 l1 h1 + split at h + · rename_i hr + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + obtain ⟨hw1, hl1, hx⟩ := sleb_ext 5 0 0 hw h1 + refine ⟨hw1, hl1, fun R L => ?_⟩ + unfold readS33 + simp only [hx R L, hr, and_self, ite_true] + · cases h + · cases h + +theorem readValType_ext : Ext readValType := by + intro w l x w' l' hw h + unfold readValType at h + by_cases hl : l = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ite_false] at h + split at h + · rename_i ht + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr8_lt hl hw, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readValType + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ite_true] + · rename_i ht + split at h + · rename_i ht2 + split at h + · rename_i heap w2 l2 h2 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + obtain ⟨hw2, hl2, hx⟩ := readS33_ext (shr8_lt hl hw) h2 + refine ⟨hw2, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readValType + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ht2, ite_true, hx R L] + · cases h + · rename_i ht2 + split at h + · rename_i ht3 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr8_lt hl hw, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readValType + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ht2, ht3, ite_true] + · cases h + +theorem readValTypes_eq_vec : ∀ k n len, readValTypes k n len = vec readValType k n len + | 0, _, _ => rfl + | k + 1, n, len => by + simp only [readValTypes, vec, readValTypes_eq_vec k] + rcases readValType n len with _ | ⟨e, n1, l1⟩ + · rfl + · simp only [] + rcases vec readValType k n1 l1 with _ | ⟨xs, n2, l2⟩ <;> rfl + +theorem readValTypes_ext (k : Nat) : Ext (readValTypes k) := by + intro w l x w' l' hw h + rw [readValTypes_eq_vec] at h + obtain ⟨a, b, c⟩ := vec_ext readValType_ext k hw h + exact ⟨a, b, fun R L => by rw [readValTypes_eq_vec]; exact c R L⟩ + +theorem readStorageType_ext : Ext readStorageType := by + intro w l x w' l' hw h + unfold readStorageType at h + by_cases hl : l = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ite_false] at h + split at h + · rename_i ht + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr8_lt hl hw, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readStorageType + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ite_true] + · rename_i ht + cases h1 : readValType w l with + | none => simp [h1] at h + | some p => + obtain ⟨v, w1, l1⟩ := p + simp only [h1, Option.map_some, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + obtain ⟨hw1, hl1, hx⟩ := readValType_ext hw h1 + refine ⟨hw1, hl1, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readStorageType + simp only [h0, Bool.false_eq_true, ite_false, hb, ht, hx R L, Option.map_some] + +theorem readField_ext : Ext readField := by + intro w l x w' l' hw h + unfold readField at h + split at h + · cases h + · rename_i st w1 l1 h1 + obtain ⟨hw1, hl1, hx⟩ := readStorageType_ext hw h1 + by_cases hz : l1 = 0 + · simp [hz] at h + simp only [hz, beq_iff_eq, ite_false] at h + split at h + · rename_i hm + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr8_lt hz hw1, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm'⟩ := step_ext (R := R) (L := L) (w := w1) hz + unfold readField + simp only [hx R L, h0, Bool.false_eq_true, ite_false, hb, hs, hm', hm, ite_true] + · cases h + +theorem readFields_eq_vec : ∀ k n len, readFields k n len = vec readField k n len + | 0, _, _ => rfl + | k + 1, n, len => by + simp only [readFields, vec, readFields_eq_vec k] + rcases readField n len with _ | ⟨e, n1, l1⟩ + · rfl + · simp only [] + rcases vec readField k n1 l1 with _ | ⟨xs, n2, l2⟩ <;> rfl + +theorem readFields_ext (k : Nat) : Ext (readFields k) := by + intro w l x w' l' hw h + rw [readFields_eq_vec] at h + obtain ⟨a, b, c⟩ := vec_ext readField_ext k hw h + exact ⟨a, b, fun R L => by rw [readFields_eq_vec]; exact c R L⟩ + +theorem readUlebs_eq_vec : ∀ k n len, readUlebs k n len = vec readU k n len + | 0, _, _ => rfl + | k + 1, n, len => by + simp only [readUlebs, vec, readUlebs_eq_vec k] + rcases readU n len with _ | ⟨e, n1, l1⟩ + · rfl + · simp only [] + rcases vec readU k n1 l1 with _ | ⟨xs, n2, l2⟩ <;> rfl + +theorem readUlebs_ext (k : Nat) : Ext (readUlebs k) := by + intro w l x w' l' hw h + rw [readUlebs_eq_vec] at h + obtain ⟨a, b, c⟩ := vec_ext readU_ext k hw h + exact ⟨a, b, fun R L => by rw [readUlebs_eq_vec]; exact c R L⟩ + +theorem readCompositeType_ext : Ext readCompositeType := by + intro w l x w' l' hw h + unfold readCompositeType at h + by_cases hl : l = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ite_false] at h + have hw0 := shr8_lt hl hw + split at h + · rename_i ht + split at h + · cases h + · rename_i np w2 l2 h2 + obtain ⟨hw2, hl2, hx2⟩ := readU_ext hw0 h2 + split at h + · cases h + · rename_i ps w3 l3 h3 + obtain ⟨hw3, hl3, hx3⟩ := readValTypes_ext np hw2 h3 + split at h + · cases h + · rename_i nr w4 l4 h4 + obtain ⟨hw4, hl4, hx4⟩ := readU_ext hw3 h4 + split at h + · rename_i rs w5 l5 h5 + obtain ⟨hw5, hl5, hx5⟩ := readValTypes_ext nr hw4 h5 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨hw5, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readCompositeType + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ite_true, beq_self_eq_true, ↓reduceIte, Nat.reduceBEq, hx2 R L, + hx3 R L, hx4 R L, hx5 R L] + · cases h + · rename_i ht + split at h + · rename_i ht2 + split at h + · cases h + · rename_i nf w2 l2 h2 + obtain ⟨hw2, hl2, hx2⟩ := readU_ext hw0 h2 + split at h + · rename_i fs w3 l3 h3 + obtain ⟨hw3, hl3, hx3⟩ := readFields_ext nf hw2 h3 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨hw3, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readCompositeType + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ht2, ite_true, beq_self_eq_true, ↓reduceIte, Nat.reduceBEq, hx2 R L, + hx3 R L] + · cases h + · rename_i ht2 + split at h + · rename_i ht3 + split at h + · rename_i fd w2 l2 h2 + obtain ⟨hw2, hl2, hx2⟩ := readField_ext hw0 h2 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨hw2, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readCompositeType + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ht2, ht3, ite_true, beq_self_eq_true, ↓reduceIte, Nat.reduceBEq, + hx2 R L] + · cases h + · cases h + +theorem readSubtypeForm_ext : Ext readSubtypeForm := by + intro w l x w' l' hw h + unfold readSubtypeForm at h + by_cases hl : l = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ite_false] at h + split at h + · rename_i ht + split at h + · cases h + · rename_i cnt w1 l1 h1 + obtain ⟨hw1, hl1, hx1⟩ := readU_ext (shr8_lt hl hw) h1 + split at h + · cases h + · rename_i sup w2 l2 h2 + obtain ⟨hw2, hl2, hx2⟩ := readUlebs_ext cnt hw1 h2 + have key : ∀ R L, readSubtypeForm (w + 2 ^ (8 * l) * R) (l + L) = + if (w &&& 0xff) == 0x50 then some (.sub sup, w2 + 2 ^ (8 * l2) * R, l2 + L) + else some (.subFinal sup, w2 + 2 ^ (8 * l2) * R, l2 + L) := by + intro R L + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readSubtypeForm + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ite_true, hx1 R L, hx2 R L] + split at h + · rename_i h50 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + exact ⟨hw2, by omega, fun R L => by rw [key R L]; simp [h50]⟩ + · rename_i h50 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + exact ⟨hw2, by omega, fun R L => by rw [key R L]; simp [h50]⟩ + · rename_i ht + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨hw, Nat.le_refl _, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readSubtypeForm + simp only [h0, Bool.false_eq_true, ite_false, hb, ht] + +theorem readTypeEntry_ext : Ext readTypeEntry := by + intro w l x w' l' hw h + unfold readTypeEntry at h + split at h + · cases h + · rename_i form w1 l1 h1 + obtain ⟨hw1, hl1, hx1⟩ := readSubtypeForm_ext hw h1 + split at h + · cases h + · rename_i comp w2 l2 h2 + obtain ⟨hw2, hl2, hx2⟩ := readCompositeType_ext hw1 h2 + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨hw2, by omega, fun R L => ?_⟩ + unfold readTypeEntry + simp only [hx1 R L, hx2 R L] + +theorem readTypeEntries_eq_vec : ∀ k n len, readTypeEntries k n len = vec readTypeEntry k n len + | 0, _, _ => rfl + | k + 1, n, len => by + simp only [readTypeEntries, vec, readTypeEntries_eq_vec k] + rcases readTypeEntry n len with _ | ⟨e, n1, l1⟩ + · rfl + · simp only [] + rcases vec readTypeEntry k n1 l1 with _ | ⟨xs, n2, l2⟩ <;> rfl + +theorem readTypeEntries_ext (k : Nat) : Ext (readTypeEntries k) := by + intro w l x w' l' hw h + rw [readTypeEntries_eq_vec] at h + obtain ⟨a, b, c⟩ := vec_ext readTypeEntry_ext k hw h + exact ⟨a, b, fun R L => by rw [readTypeEntries_eq_vec]; exact c R L⟩ + +/-- One entry of the type section: a rec group, or a single subtype. -/ +def readRecEntry (n len : Nat) : Option (List TypeEntry × Nat × Nat) := + if len == 0 then none else + if (n &&& 0xff) == 0x4e then + match readU (n >>> 8) (len - 1) with + | none => none + | some (count, n1, len1) => readTypeEntries count n1 len1 + else + (readTypeEntry n len).map (fun p => ([p.1], p.2.1, p.2.2)) + +theorem readRecEntry_ext : Ext readRecEntry := by + intro w l x w' l' hw h + unfold readRecEntry at h + by_cases hl : l = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ite_false] at h + split at h + · rename_i ht + split at h + · cases h + · rename_i cnt w1 l1 h1 + obtain ⟨hw1, hl1, hx1⟩ := readU_ext (shr8_lt hl hw) h1 + obtain ⟨hw2, hl2, hx2⟩ := readTypeEntries_ext cnt hw1 h + refine ⟨hw2, by omega, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readRecEntry + simp only [h0, Bool.false_eq_true, ite_false, hb, hs, hm, ht, ite_true, beq_self_eq_true, ↓reduceIte, hx1 R L, hx2 R L] + · rename_i ht + cases h1 : readTypeEntry w l with + | none => simp [h1] at h + | some p => + obtain ⟨e, w1, l1⟩ := p + simp only [h1, Option.map_some, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + obtain ⟨hw1, hl1, hx⟩ := readTypeEntry_ext hw h1 + refine ⟨hw1, hl1, fun R L => ?_⟩ + obtain ⟨h0, hb, hs, hm⟩ := step_ext (R := R) (L := L) (w := w) hl + unfold readRecEntry + simp only [h0, Bool.false_eq_true, ite_false, hb, beq_iff_eq, ht, ↓reduceIte, hx R L, Option.map_some] + +/-! ### Cutting a section at declared entry lengths -/ + +/-- The windows of the entries of the given lengths, one after another. -/ +def seqWin (P : Nat) : List Nat → List (Nat × Nat) + | [] => [] + | l :: ls => (P % 2 ^ (8 * l), l) :: seqWin (P >>> (8 * l)) ls + +/-- A window decoded alone, consuming it exactly. -/ +def whole {α : Type} (r : Nat → Nat → Option (α × Nat × Nat)) (win : Nat × Nat) : Option α := + match r win.1 win.2 with + | some (x, _, 0) => some x + | _ => none + +theorem split_pow (P l : Nat) : P % 2 ^ (8 * l) + 2 ^ (8 * l) * (P >>> (8 * l)) = P := by + rw [Nat.shiftRight_eq_div_pow]; exact Nat.mod_add_div P _ + +/-- Each window decoded alone and consumed exactly: the vector reads the same + entries inside the section, and stops after the last window. -/ +theorem vec_of_windows {α : Type} {r : Nat → Nat → Option (α × Nat × Nat)} (hr : Ext r) : + ∀ (ls : List Nat) (P S : Nat) (xs : List α), ls.sum ≤ S → + (seqWin P ls).mapM (whole r) = some xs → + vec r ls.length P S = some (xs, P >>> (8 * ls.sum), S - ls.sum) + | [], P, S, xs, _, h => by + simp only [seqWin, List.mapM_nil, Option.pure_def, Option.some.injEq] at h + subst h; simp [vec] + | l :: ls, P, S, xs, hS, h => by + simp only [seqWin, List.mapM_cons, Option.bind_eq_bind, Option.pure_def] at h + cases hx : whole r (P % 2 ^ (8 * l), l) with + | none => simp [hx] at h + | some x => + cases hxs : (seqWin (P >>> (8 * l)) ls).mapM (whole r) with + | none => simp [hx, hxs] at h + | some ys => + simp only [hx, hxs, Option.bind_some, Option.some.injEq] at h + subst h + simp only [List.sum_cons] at hS + unfold whole at hx + split at hx + · rename_i x' w' hw + simp only [Option.some.injEq] at hx + subst hx + obtain ⟨hw', _, hext⟩ := hr (Nat.mod_lt _ (Nat.two_pow_pos _)) hw + have hw0 : w' = 0 := by simpa using hw' + subst hw0 + have hstep := hext (P >>> (8 * l)) (S - l) + rw [split_pow, show l + (S - l) = S by omega] at hstep + simp only [Nat.mul_zero, Nat.pow_zero, Nat.one_mul, Nat.zero_add] at hstep + have hrest := vec_of_windows hr ls (P >>> (8 * l)) (S - l) ys (by omega) hxs + simp only [List.length_cons, vec, hstep, hrest, List.sum_cons, + Nat.shiftRight_add, Option.some.injEq, Prod.mk.injEq, true_and, Nat.mul_add] + omega + · cases hx + +theorem mod_mod_pow {P l a : Nat} (h : l ≤ a) : P % 2 ^ (8 * a) % 2 ^ (8 * l) = P % 2 ^ (8 * l) := + Nat.mod_mod_of_dvd _ (Nat.pow_dvd_pow 2 (Nat.mul_le_mul_left 8 h)) + +theorem mod_shr_pow {P l a : Nat} (h : l ≤ a) : + (P % 2 ^ (8 * a)) >>> (8 * l) = (P >>> (8 * l)) % 2 ^ (8 * (a - l)) := by + rw [Nat.shiftRight_eq_div_pow, Nat.shiftRight_eq_div_pow, pow_split h, Nat.mod_mul_right_div_self] + +theorem seqWin_mod : ∀ (ls : List Nat) (P a : Nat), ls.sum ≤ a → seqWin (P % 2 ^ (8 * a)) ls = seqWin P ls + | [], _, _, _ => rfl + | l :: ls, P, a, h => by + simp only [List.sum_cons] at h + simp only [seqWin, mod_mod_pow (show l ≤ a by omega), mod_shr_pow (show l ≤ a by omega), + seqWin_mod ls (P >>> (8 * l)) (a - l) (by omega)] + +theorem seqWin_append : ∀ (xs ys : List Nat) (P : Nat), + seqWin P (xs ++ ys) = seqWin (P % 2 ^ (8 * xs.sum)) xs ++ seqWin (P >>> (8 * xs.sum)) ys + | [], ys, P => by simp [seqWin] + | x :: xs, ys, P => by + simp only [List.cons_append, seqWin, List.sum_cons, seqWin_append xs ys, List.cons.injEq] + refine ⟨by rw [mod_mod_pow (by omega)], ?_⟩ + rw [mod_shr_pow (show x ≤ x + xs.sum by omega), Nat.add_sub_cancel_left, + Nat.mul_add, Nat.shiftRight_add] + +/-- `seqWin`, a group of entries at a time: the kernel shifts the rest of the + section once per group, and each entry's window out of its group's. -/ +def cutWin : Nat → Nat → List Nat → List (Nat × Nat) + | 0, P, ls => seqWin P ls + | f + 1, P, ls => + match ls with + | [] => [] + | _ :: _ => + seqWin (P % 2 ^ (8 * (ls.take 64).sum)) (ls.take 64) ++ + cutWin f (P >>> (8 * (ls.take 64).sum)) (ls.drop 64) + +theorem cutWin_eq : ∀ (f P : Nat) (ls : List Nat), cutWin f P ls = seqWin P ls + | 0, _, _ => rfl + | f + 1, P, [] => rfl + | f + 1, P, l :: ls => by + unfold cutWin + simp only + rw [cutWin_eq f, ← seqWin_append, List.take_append_drop] + + +/-! ### The export section, cut -/ + +/-- The export entries, read one declared window at a time. -/ +def decodeRawExportsCut (n len : Nat) (ls : List Nat) : Option (List ExportEntry) := + match modulePayload 7 n len with + | none => none + | some (eN, eLen) => + match readU eN eLen with + | none => none + | some (cnt, n1, len1) => + if cnt == ls.length && ls.sum == len1 then + (cutWin ls.length n1 ls).mapM (whole readExportEntry) + else none + +theorem decodeRawExports_of_cut {n len : Nat} {ls : List Nat} {E : List ExportEntry} + (h : decodeRawExportsCut n len ls = some E) : decodeRawExports n len = some E := by + unfold decodeRawExportsCut at h + unfold decodeRawExports + split at h + · cases h + · rename_i eN eLen hP + rw [hP] + split at h + · cases h + · rename_i cnt n1 len1 hU + simp only [hU] + split at h + · rename_i hc + simp only [Bool.and_eq_true, beq_iff_eq] at hc + obtain ⟨rfl, hsum⟩ := hc + rw [cutWin_eq] at h + have hv := vec_of_windows readExportEntry_ext ls n1 len1 E (by omega) h + rw [decRawExportVec_eq_vec, hv, hsum, Nat.sub_self] + rfl + · cases h + +theorem decodeRawExports_eq_cut {n len : Nat} {ls : List Nat} + (h : (decodeRawExportsCut n len ls).isSome = true) : + decodeRawExports n len = decodeRawExportsCut n len ls := by + obtain ⟨E, hE⟩ := Option.isSome_iff_exists.mp h + rw [hE, decodeRawExports_of_cut hE] + +/-! ### The type section, cut -/ + +theorem decRecVec_eq_vec : ∀ k n len, + decRecVec k n len = (vec readRecEntry k n len).map (fun p => (p.1.flatten, p.2.1, p.2.2)) + | 0, _, _ => rfl + | k + 1, n, len => by + unfold decRecVec + simp only [vec, readRecEntry, decRecVec_eq_vec k] + by_cases hl : len = 0 + · simp [hl] + simp only [hl, beq_iff_eq, ↓reduceIte] + split + · rcases readU (n >>> 8) (len - 1) with _ | ⟨c, n1, l1⟩ + · rfl + · simp only [] + rcases readTypeEntries c n1 l1 with _ | ⟨g, n2, l2⟩ + · rfl + · simp only [] + rcases vec readRecEntry k n2 l2 with _ | ⟨gs, n3, l3⟩ <;> rfl + · rcases readTypeEntry n len with _ | ⟨e, n1, l1⟩ + · rfl + · simp only [Option.map_some] + rcases vec readRecEntry k n1 l1 with _ | ⟨gs, n3, l3⟩ <;> rfl + +/-- The type information of a flat entry list, built as `decodeTypes` builds it. -/ +def typeInfoOf (entries : List TypeEntry) : TypeInfo := + { nfields := entries.map TypeEntry.fieldCount + , arityIndex := (entries.map TypeEntry.arity).toArray + , nfieldIndex := (entries.map TypeEntry.fieldCount).toArray + , carrier := firstCarrier 0 entries + , entries := entries + , entryIndex := entries.toArray } + +/-- The type section, read one declared window (rec group or subtype) at a time. -/ +def decodeTypesCut (n len : Nat) (ls : List Nat) : Option TypeInfo := + match modulePayload 1 n len with + | none => none + | some (tN, tLen) => + match readU tN tLen with + | none => none + | some (count, n1, len1) => + if count == ls.length && ls.sum == len1 then + ((cutWin ls.length n1 ls).mapM (whole readRecEntry)).map + (fun groups => typeInfoOf groups.flatten) + else none + +theorem decodeTypes_of_cut {n len : Nat} {ls : List Nat} {T : TypeInfo} + (h : decodeTypesCut n len ls = some T) : decodeTypes n len = some T := by + unfold decodeTypesCut at h + unfold decodeTypes + split at h + · cases h + · rename_i tN tLen hP + rw [hP] + split at h + · cases h + · rename_i cnt n1 len1 hU + simp only [hU] + split at h + · rename_i hc + simp only [Bool.and_eq_true, beq_iff_eq] at hc + obtain ⟨rfl, hsum⟩ := hc + rw [cutWin_eq] at h + cases hg : (seqWin n1 ls).mapM (whole readRecEntry) with + | none => simp [hg] at h + | some gs => + simp only [hg, Option.map_some, Option.some.injEq] at h + subst h + have hv := vec_of_windows readRecEntry_ext ls n1 len1 gs (by omega) hg + rw [decRecVec_eq_vec, hv, hsum, Nat.sub_self] + rfl + · cases h + +theorem decodeTypes_eq_cut {n len : Nat} {ls : List Nat} + (h : (decodeTypesCut n len ls).isSome = true) : + decodeTypes n len = decodeTypesCut n len ls := by + obtain ⟨T, hT⟩ := Option.isSome_iff_exists.mp h + rw [hT, decodeTypes_of_cut hT] + +/-! ### The code section, cut -/ + +/-- One code entry, as `decCodeLocs` reads it. -/ +def readCodeEntry (n len : Nat) : Option (CodeLoc × Nat × Nat) := + match readU n len with + | none => none + | some (esz, bN, bLen) => + if esz ≤ bLen then + match readU (isolateBytes bN esz) esz with + | none => none + | some (ng, gN, gLen) => + match decLocals ng gN gLen with + | none => none + | some (nloc, bodyN, bodyLen) => + some (⟨nloc, isolateBytes bodyN bodyLen, bodyLen, + isolateBytes n (len - bLen + esz), len - bLen + esz⟩, bN >>> (8 * esz), bLen - esz) + else none + +theorem decCodeLocs_eq_vec : ∀ k n len, + decCodeLocs k n len = (vec readCodeEntry k n len).bind + (fun p => if p.2.2 == 0 then some p.1 else none) + | 0, _, _ => rfl + | k + 1, n, len => by + unfold decCodeLocs + simp only [vec, readCodeEntry, decCodeLocs_eq_vec k] + rcases readU n len with _ | ⟨esz, bN, bLen⟩ + · rfl + · simp only [] + split + · rcases readU (isolateBytes bN esz) esz with _ | ⟨ng, gN, gLen⟩ + · rfl + · simp only [] + rcases decLocals ng gN gLen with _ | ⟨nloc, bodyN, bodyLen⟩ + · rfl + · simp only [] + rcases vec readCodeEntry k (bN >>> (8 * esz)) (bLen - esz) with _ | ⟨ls, n3, l3⟩ + · rfl + · simp only [Option.bind_some] + by_cases h3 : l3 = 0 <;> simp [h3] + · rfl + +theorem readCodeEntry_ext : Ext readCodeEntry := by + intro w l x w' l' hw h + unfold readCodeEntry at h + split at h + · cases h + · rename_i esz bN bLen hU + obtain ⟨hb, hbl, hx⟩ := readU_ext hw hU + have hl : l ≠ 0 := by + intro h0; subst h0; simp [readU, uleb] at hU + have hbl' : bLen < l := by + have := hU + unfold readU uleb at this + simp only [hl, beq_iff_eq, ite_false] at this + split at this + · split at this + · cases this + · simp only [Option.some.injEq, Prod.mk.injEq] at this; omega + · have := (uleb_ext 4 _ 7 (shr8_lt hl hw) this).2.1; omega + split at h + · rename_i hle + split at h + · cases h + · rename_i ng gN gLen hG + split at h + · cases h + · rename_i nloc bodyN bodyLen hL + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + refine ⟨shr_lt esz hle hb, by omega, fun R L => ?_⟩ + unfold readCodeEntry + rw [hx R L] + simp only [show esz ≤ bLen + L by omega, ↓reduceIte, isolateBytes_ext hle, hG, hL, + Option.some.injEq, Prod.mk.injEq, shr_ext esz hle] + refine ⟨?_, ?_, by omega⟩ + · rw [show l + L - (bLen + L) + esz = l - bLen + esz by omega, + isolateBytes_ext (by omega)] + · trivial + · cases h + +/-- The code section, read one declared entry at a time. -/ +def codeLocsCut (n len : Nat) (ls : List Nat) : Option (Array CodeLoc) := + match modulePayload 10 n len with + | none => none + | some (codeN, codeLen) => + match readU codeN codeLen with + | none => none + | some (nf, r0, l0) => + if nf == ls.length && ls.sum == l0 then + ((cutWin ls.length r0 ls).mapM (whole readCodeEntry)).map List.toArray + else none + +theorem codeLocs_of_cut {n len : Nat} {ls : List Nat} {C : Array CodeLoc} + (h : codeLocsCut n len ls = some C) : codeLocs n len = some C := by + unfold codeLocsCut at h + unfold codeLocs + split at h + · cases h + · rename_i cN cLen hP + rw [hP] + split at h + · cases h + · rename_i nf r0 l0 hU + simp only [hU] + split at h + · rename_i hc + simp only [Bool.and_eq_true, beq_iff_eq] at hc + obtain ⟨rfl, hsum⟩ := hc + rw [cutWin_eq] at h + cases hg : (seqWin r0 ls).mapM (whole readCodeEntry) with + | none => simp [hg] at h + | some locs => + simp only [hg, Option.map_some, Option.some.injEq] at h + subst h + have hv := vec_of_windows readCodeEntry_ext ls r0 l0 locs (by omega) hg + rw [decCodeLocs_eq_vec, hv, hsum, Nat.sub_self] + rfl + · cases h + +theorem codeLocs_eq_cut {n len : Nat} {ls : List Nat} + (h : (codeLocsCut n len ls).isSome = true) : + codeLocs n len = codeLocsCut n len ls := by + obtain ⟨C, hC⟩ := Option.isSome_iff_exists.mp h + rw [hC, codeLocs_of_cut hC] + +/-! ### Reading a confirmed cut lazily + +Once one declaration has confirmed a cut (every window decodes alone and is +consumed exactly), the section is the list of its windows' entries. The lazy +forms below build that list without re-checking any window: the kernel +decodes a window only when a check reads its entry, so a check that reads a +few entries of a section decodes only those. -/ + +theorem seqWin_bound : ∀ (P : Nat) (ls : List Nat) (w : Nat × Nat), w ∈ seqWin P ls → + w.1 < 2 ^ (8 * w.2) + | _, [], _, h => by cases h + | P, l :: ls, w, h => by + simp only [seqWin, List.mem_cons] at h + rcases h with rfl | h + · exact Nat.mod_lt _ (Nat.two_pow_pos _) + · exact seqWin_bound _ ls w h + +/-- A checked `mapM` over windows is the plain `map` of any reading that agrees + with it on every window it accepts. -/ +theorem mapM_eq_map {α : Type} {g : Nat × Nat → Option α} {f : Nat × Nat → α} : + ∀ (ws : List (Nat × Nat)) (xs : List α), + (∀ w ∈ ws, ∀ x, g w = some x → f w = x) → ws.mapM g = some xs → ws.map f = xs + | [], xs, _, h => by simpa using h + | w :: ws, xs, hf, h => by + simp only [List.mapM_cons, Option.bind_eq_bind, Option.pure_def] at h + cases hw : g w with + | none => simp [hw] at h + | some x => + cases hws : ws.mapM g with + | none => simp [hw, hws] at h + | some ys => + simp only [hw, hws, Option.bind_some, Option.some.injEq] at h + subst h + simp only [List.map_cons, List.cons.injEq] + exact ⟨hf w (List.mem_cons_self) x hw, + mapM_eq_map ws ys (fun v hv => hf v (List.mem_cons_of_mem _ hv)) hws⟩ + +/-- A window's entry, read without checking the window. -/ +def entryOf {α : Type} (r : Nat → Nat → Option (α × Nat × Nat)) (d : α) (w : Nat × Nat) : α := + (whole r w).getD d + +theorem entryOf_eq {α : Type} {r : Nat → Nat → Option (α × Nat × Nat)} {d : α} {w : Nat × Nat} + {x : α} (h : whole r w = some x) : entryOf r d w = x := by + simp [entryOf, h] + +def noExport : ExportEntry := ⟨[], 0, 0⟩ + +/-- The export entries of a cut, read lazily. -/ +def exportsLazy (n len : Nat) (ls : List Nat) : Option (List ExportEntry) := + match modulePayload 7 n len with + | none => none + | some (eN, eLen) => + match readU eN eLen with + | none => none + | some (cnt, n1, len1) => + if cnt == ls.length && ls.sum == len1 then + some ((cutWin ls.length n1 ls).map (entryOf readExportEntry noExport)) + else none + +theorem exportsLazy_of_cut {n len : Nat} {ls : List Nat} {E : List ExportEntry} + (h : decodeRawExportsCut n len ls = some E) : exportsLazy n len ls = some E := by + unfold decodeRawExportsCut at h + unfold exportsLazy + split at h + · cases h + · rename_i eN eLen hP + try rw [hP] + split at h + · cases h + · rename_i cnt n1 len1 hU + try simp only [hU] + split at h + · rename_i hc + simp only [hc, ↓reduceIte, Option.some.injEq] + exact mapM_eq_map _ E (fun w _ x hx => entryOf_eq hx) h + · cases h + +/-- A confirmed export cut: the export section is its lazily read windows. -/ +theorem decodeRawExports_eq_lazy {n len : Nat} {ls : List Nat} + (h : (decodeRawExportsCut n len ls).isSome = true) : + decodeRawExports n len = exportsLazy n len ls := by + obtain ⟨E, hE⟩ := Option.isSome_iff_exists.mp h + rw [decodeRawExports_of_cut hE, exportsLazy_of_cut hE] + +def noTypeEntry : TypeEntry := ⟨.plain, .structType []⟩ + +/-- A window of the type section read lazily: a rec group in full, a single + subtype as its one entry. -/ +def groupOf (w : Nat × Nat) : List TypeEntry := + if (w.1 &&& 0xff) == 0x4e then (whole readRecEntry w).getD [] + else [entryOf readTypeEntry noTypeEntry w] + +theorem groupOf_eq {w : Nat × Nat} {g : List TypeEntry} (h : whole readRecEntry w = some g) : + groupOf w = g := by + unfold groupOf + split + · simp [h] + · rename_i hb + unfold whole readRecEntry at h + by_cases hl : w.2 = 0 + · simp [hl] at h + simp only [hl, beq_iff_eq, ↓reduceIte] at h + simp only [beq_iff_eq] at hb + simp only [hb, ↓reduceIte] at h + cases he : readTypeEntry w.1 w.2 with + | none => simp [he] at h + | some p => + obtain ⟨e, w1, l1⟩ := p + simp only [he, Option.map_some] at h + split at h + · rename_i x w' heq + simp only [Option.some.injEq, Prod.mk.injEq] at heq h + obtain ⟨rfl, -, rfl⟩ := heq + subst h + have : whole readTypeEntry w = some e := by simp [whole, he] + simp [entryOf_eq this] + · cases h + +/-- The type section of a cut, read lazily. -/ +def typesLazy (n len : Nat) (ls : List Nat) : Option TypeInfo := + match modulePayload 1 n len with + | none => none + | some (tN, tLen) => + match readU tN tLen with + | none => none + | some (count, n1, len1) => + if count == ls.length && ls.sum == len1 then + some (typeInfoOf ((cutWin ls.length n1 ls).map groupOf).flatten) + else none + +theorem typesLazy_of_cut {n len : Nat} {ls : List Nat} {T : TypeInfo} + (h : decodeTypesCut n len ls = some T) : typesLazy n len ls = some T := by + unfold decodeTypesCut at h + unfold typesLazy + split at h + · cases h + · rename_i tN tLen hP + try rw [hP] + split at h + · cases h + · rename_i cnt n1 len1 hU + try simp only [hU] + split at h + · rename_i hc + simp only [hc, ↓reduceIte] + cases hg : (cutWin ls.length n1 ls).mapM (whole readRecEntry) with + | none => simp [hg] at h + | some gs => + simp only [hg, Option.map_some, Option.some.injEq] at h + rw [mapM_eq_map _ gs (fun w _ g hx => groupOf_eq hx) hg, h] + · cases h + +/-- A confirmed type cut: the type section is its lazily read windows. -/ +theorem decodeTypes_eq_lazy {n len : Nat} {ls : List Nat} + (h : (decodeTypesCut n len ls).isSome = true) : + decodeTypes n len = typesLazy n len ls := by + obtain ⟨T, hT⟩ := Option.isSome_iff_exists.mp h + rw [decodeTypes_of_cut hT, typesLazy_of_cut hT] + +def noCodeLoc : CodeLoc := ⟨0, 0, 0, 0, 0⟩ + +/-- A code entry read lazily: the window is the whole entry, and its locals + and body are decoded only when a check reads them. -/ +def locOf (w : Nat × Nat) : CodeLoc := + let loc := entryOf readCodeEntry noCodeLoc w + ⟨loc.nlocals, loc.bodyN, loc.bodyLen, w.1, w.2⟩ + +theorem locOf_eq {w : Nat × Nat} {loc : CodeLoc} (hw : w.1 < 2 ^ (8 * w.2)) + (h : whole readCodeEntry w = some loc) : locOf w = loc := by + have he := entryOf_eq (d := noCodeLoc) h + unfold locOf + rw [he] + unfold whole readCodeEntry at h + split at h + · rename_i x w' heq + split at heq + · cases heq + · rename_i esz bN bLen hU + split at heq + · rename_i hle + split at heq + · cases heq + · split at heq + · cases heq + · simp only [Option.some.injEq, Prod.mk.injEq] at heq h + obtain ⟨rfl, -, hz⟩ := heq + subst h + have hlen : w.2 - bLen + esz = w.2 := by + have := (readU_ext hw hU).2.1; omega + simp only [hlen, isolateBytes_eq, Nat.mod_eq_of_lt hw] + · cases heq + · cases h + +/-- The code section of a cut, read lazily. -/ +def codeLazy (n len : Nat) (ls : List Nat) : Option (Array CodeLoc) := + match modulePayload 10 n len with + | none => none + | some (codeN, codeLen) => + match readU codeN codeLen with + | none => none + | some (nf, r0, l0) => + if nf == ls.length && ls.sum == l0 then + some ((cutWin ls.length r0 ls).map locOf).toArray + else none + +theorem codeLazy_of_cut {n len : Nat} {ls : List Nat} {C : Array CodeLoc} + (h : codeLocsCut n len ls = some C) : codeLazy n len ls = some C := by + unfold codeLocsCut at h + unfold codeLazy + split at h + · cases h + · rename_i cN cLen hP + try rw [hP] + split at h + · cases h + · rename_i nf r0 l0 hU + try simp only [hU] + split at h + · rename_i hc + simp only [hc, ↓reduceIte] + cases hg : (cutWin ls.length r0 ls).mapM (whole readCodeEntry) with + | none => simp [hg] at h + | some locs => + simp only [hg, Option.map_some, Option.some.injEq] at h + have hb : ∀ w ∈ cutWin ls.length r0 ls, w.1 < 2 ^ (8 * w.2) := by + rw [cutWin_eq]; exact seqWin_bound r0 ls + rw [mapM_eq_map _ locs (fun w hw loc hx => locOf_eq (hb w hw) hx) hg, h] + · cases h + +/-- A confirmed code cut: the code section is its lazily read windows. -/ +theorem codeLocs_eq_lazy {n len : Nat} {ls : List Nat} + (h : (codeLocsCut n len ls).isSome = true) : + codeLocs n len = codeLazy n len ls := by + obtain ⟨C, hC⟩ := Option.isSome_iff_exists.mp h + rw [codeLocs_of_cut hC, codeLazy_of_cut hC] + +end AverCert.ByteWindow diff --git a/aver-cert/assets/wall/current/CertDecode.lean b/aver-cert/assets/wall/current/CertDecode.lean index ccb85c56f..4efb79a4d 100644 --- a/aver-cert/assets/wall/current/CertDecode.lean +++ b/aver-cert/assets/wall/current/CertDecode.lean @@ -969,13 +969,6 @@ def cmpIdx (n len : Nat) : Option Nat := | none => none | some es => (es.find? (fun e => e.1 == "__aint_cmp")).map Prod.snd -/-- The `__aint_eq` helper role, bound by its named runtime export; see - `cmpIdx`. -/ -def eqIdx (n len : Nat) : Option Nat := - match decodeExports n len with - | none => none - | some es => (es.find? (fun e => e.1 == "__aint_eq")).map Prod.snd - structure Roles where box : Option Nat add : Option Nat @@ -984,6 +977,8 @@ structure Roles where toIndex : Option Nat cmp : Option Nat eq : Option Nat + /-- `__aint_divmod`, pinned by its template only (it is not exported). -/ + divmod : Option Nat := none deriving DecidableEq, Repr /-- Byte-derived proof that the module carries no Int-carrier box helper: the diff --git a/aver-cert/assets/wall/current/CertPrelude.lean b/aver-cert/assets/wall/current/CertPrelude.lean index 5462cf393..94cd8c460 100644 --- a/aver-cert/assets/wall/current/CertPrelude.lean +++ b/aver-cert/assets/wall/current/CertPrelude.lean @@ -19,7 +19,7 @@ it depends only on `host`/`ar`/`callee`, matching the probe's clean shape. f64 values are stored as their IEEE-754 bit pattern (`UInt64`) so `WVal` - has `DecidableEq` (needed for the `native_decide` anti-vacuity guards) while + has `DecidableEq` (needed for the `decide` anti-vacuity guards) while staying bit-exact under the arithmetic opcodes. -/ @@ -28,7 +28,7 @@ namespace CertPrelude /-! ## LEB128 index encodings (total, fuel-bounded) The one audited pair of index encoders shared by every wall module that -SYNTHESIZES bytes (`PlanBytes` lowers plans, `ArithTemplateDerisk` synthesizes +SYNTHESIZES bytes (`GrammarLower` lowers plans, `ArithTemplateDerisk` synthesizes the arith helper bodies). Both are TOTAL — they return `List Nat`, never an `Option` — because a synthesized template that could be `none` would let an undecodable module body agree with an unencodable declaration (`none == none`) @@ -38,7 +38,7 @@ recursion, so `decide +kernel` reduces these definitions. The fuel-exhausted branch emits the final quotient raw. It is NOT a correct LEB128 encoding of out-of-range values, and it does not need to be: fuel `f` encodes every value below `2 ^ (7 * f)` exactly (the branch is unreachable -there), and every caller either range-guards its input (`PlanBytes` wraps +there), and every caller either range-guards its input (`GrammarLower` wraps these in `Option` behind a `< 2 ^ 32` test) or conjoins an explicit bound on the accepted path (`ArithTemplateDerisk.checkArithHostParams` bounds every spliced index below `2 ^ 32`). `2 ^ 32 ≤ 2 ^ 35`, so five unsigned groups and @@ -109,6 +109,10 @@ inductive WInstr where | arrayGet (tyIdx : Nat) | i64Eqz | i64Eq | i64LeS | i64LtS | i64GeS | i64GtS | i32Eq | i32And | i32LtS | i32LeS | i32GtS | i32GeS | i32LtU + -- Added for the one-grammar plan (`Grammar*.lean`): `i64.ne` (the `!=` + -- literal compare's Small arm), `i32.eqz` (`Bool.not`, and `!=` over + -- `__aint_eq`), `i32.ne` (Bool `!=`) and `i32.or` (`Bool.or`). + | i64Ne | i32Eqz | i32Ne | i32Or | f64Add | f64Sub | f64Mul | f64Div | f64Eq | f64Lt | f64Le | f64Ge | f64Gt | ifElse (thenB elseB : List WInstr) @@ -264,6 +268,31 @@ def wRunF (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) : | .i32v b :: .i32v a :: st' => wRunF host ar callee rest locals (b32 (a ≠ 0 ∧ b ≠ 0) :: st') | _ => none + | .i64Ne :: rest, locals, st => + -- Same value convention as `.i64Eq`: operands are the signed i64 + -- values the emitter produced, compared exactly. + match st with + | .i64v b :: .i64v a :: st' => wRunF host ar callee rest locals (b32 (a ≠ b) :: st') + | _ => none + | .i32Eqz :: rest, locals, st => + -- Same value convention as `.i32Eq`: `1` exactly when the operand is `0`. + match st with + | .i32v a :: st' => wRunF host ar callee rest locals (b32 (a = 0) :: st') + | _ => none + | .i32Ne :: rest, locals, st => + match st with + | .i32v b :: .i32v a :: st' => wRunF host ar callee rest locals (b32 (a ≠ b) :: st') + | _ => none + | .i32Or :: rest, locals, st => + -- Exact on the 0/1 Boolean domain the emitter feeds it, and STUCK + -- (`none`) on any other operand, so it can never produce a value the + -- bitwise wasm `i32.or` would not (unlike `.i32And`'s logical reading). + match st with + | .i32v b :: .i32v a :: st' => + if (a = 0 ∨ a = 1) ∧ (b = 0 ∨ b = 1) then + wRunF host ar callee rest locals (b32 (a = 1 ∨ b = 1) :: st') + else none + | _ => none | .i32LtS :: rest, locals, st => match st with | .i32v b :: .i32v a :: st' => wRunF host ar callee rest locals (b32 (a < b) :: st') diff --git a/aver-cert/assets/wall/current/CertPreludeSanity.lean b/aver-cert/assets/wall/current/CertPreludeSanity.lean index f87bdb728..b370a064a 100644 --- a/aver-cert/assets/wall/current/CertPreludeSanity.lean +++ b/aver-cert/assets/wall/current/CertPreludeSanity.lean @@ -6,7 +6,7 @@ pattern from the kill-fast probe survives the generalization to `structv`-based carriers, and stays kernel-clean under `#print axioms` ([propext, Classical.choice, Quot.sound]; no `sorryAx`); - * executable `example`s via `native_decide` (OUTSIDE the proof budget) that + * executable `example`s via `decide +kernel` (OUTSIDE the proof budget) that force the interpreter to actually COMPUTE a decoded result on concrete inputs across every value family (Int, Bool, f64, ADT, String, List, tail recursion). A vacuous semantics — e.g. one that fails `localGet` on @@ -92,15 +92,15 @@ def cSumTo : CodeTbl := fun fn => example : ((wFuncN cSumTo gHost 20 1 [carrierSmall 5 3]).bind carrierToInt) = some 6 := by - native_decide + decide +kernel example : ((wFuncN cSumTo gHost 20 1 [carrierSmall 5 0]).bind carrierToInt) = some 0 := by - native_decide + decide +kernel example : ((wFuncN cSumTo gHost 20 1 [carrierSmall 5 (-4)]).bind carrierToInt) = some 0 := by - native_decide + decide +kernel -- 2) Tail recursion via return_call (countDown-style accumulator): tick(3,0)=6. def cTick : CodeTbl := fun fn => @@ -115,7 +115,7 @@ def cTick : CodeTbl := fun fn => example : ((wFuncN cTick gHost 20 1 [carrierSmall 5 3, carrierSmall 5 0]).bind carrierToInt) - = some 6 := by native_decide + = some 6 := by decide +kernel -- 3) ADT match via ref.test / ref.cast / struct.get: classify(Circle)=1, Point=3. -- Shape types: Circle = 0 (one f64 field), Rect = 1 (two), Point = 2 (empty). @@ -132,11 +132,11 @@ def cClassify : CodeTbl := fun fn => example : ((wFuncN cClassify gHost 8 1 [WVal.structv 0 [.f64v (1.5 : Float).toBits]]).bind carrierToInt) - = some 1 := by native_decide + = some 1 := by decide +kernel example : ((wFuncN cClassify gHost 8 1 [WVal.structv 2 []]).bind carrierToInt) - = some 3 := by native_decide + = some 3 := by decide +kernel -- 4) String literal via array.new_data: describe(Point) = "point" (bytes). def cDescribe : CodeTbl := fun fn => @@ -149,7 +149,7 @@ def cDescribe : CodeTbl := fun fn => example : ((wFuncN cDescribe gHost 8 1 [WVal.structv 2 []]).bind asBytes) - = some [112, 111, 105, 110, 116] := by native_decide + = some [112, 111, 105, 110, 116] := by decide +kernel -- 5) f64 arithmetic + comparison, Bool result: (a < a*a) style through opcodes. def cFcmp : CodeTbl := fun fn => @@ -159,15 +159,15 @@ def cFcmp : CodeTbl := fun fn => example : ((wFuncN cFcmp gHost 4 1 [WVal.f64v (1.0 : Float).toBits, WVal.f64v (2.0 : Float).toBits]).bind asBool) - = some true := by native_decide + = some true := by decide +kernel example : ((wFuncN cFcmp gHost 4 1 [WVal.f64v (2.0 : Float).toBits, WVal.f64v (2.0 : Float).toBits]).bind asBool) - = some true := by native_decide + = some true := by decide +kernel example : ((wFuncN cFcmp gHost 4 1 [WVal.f64v (3.0 : Float).toBits, WVal.f64v (2.0 : Float).toBits]).bind asBool) - = some false := by native_decide + = some false := by decide +kernel -- 6) f64 arithmetic value: 8.0 / 2.0 - 1.0 = 3.0 (bit-exact through the opcodes). def cFarith : CodeTbl := fun fn => @@ -177,16 +177,16 @@ def cFarith : CodeTbl := fun fn => example : ((wFuncN cFarith gHost 4 1 [WVal.f64v (2.0 : Float).toBits, WVal.f64v (8.0 : Float).toBits]).bind asF64) - = some (3.0 : Float).toBits := by native_decide + = some (3.0 : Float).toBits := by decide +kernel -- 7) Bool logic via i32.eq / i32.and and list head via structGet on a cons cell. def cAnd : CodeTbl := fun fn => if fn = 1 then some ⟨2, 0, [.localGet 0, .localGet 1, .i32And]⟩ else none example : - ((wFuncN cAnd gHost 4 1 [WVal.i32v 1, WVal.i32v 1]).bind asBool) = some true := by native_decide + ((wFuncN cAnd gHost 4 1 [WVal.i32v 1, WVal.i32v 1]).bind asBool) = some true := by decide +kernel example : - ((wFuncN cAnd gHost 4 1 [WVal.i32v 1, WVal.i32v 0]).bind asBool) = some false := by native_decide + ((wFuncN cAnd gHost 4 1 [WVal.i32v 1, WVal.i32v 0]).bind asBool) = some false := by decide +kernel /-! ## Residue guards — opcodes the differential harness cannot drive end-to-end without string / Result / list-builder runtime contracts (kept @@ -203,64 +203,64 @@ def cArrFixed : CodeTbl := fun fn => if fn = 1 then some ⟨0, 0, [.i64Const 10, .call 6, .i64Const 20, .call 6, .arrayNewFixed 7 2]⟩ else none example : - ((wFuncN cArrFixed gHost 4 1 []).bind asIntList) = some [10, 20] := by native_decide + ((wFuncN cArrFixed gHost 4 1 []).bind asIntList) = some [10, 20] := by decide +kernel -- i32.eq def cI32Eq : CodeTbl := fun fn => if fn = 1 then some ⟨2, 0, [.localGet 0, .localGet 1, .i32Eq]⟩ else none example : ((wFuncN cI32Eq gHost 4 1 [WVal.i32v 5, WVal.i32v 5]).bind asBool) = some true := by - native_decide + decide +kernel example : ((wFuncN cI32Eq gHost 4 1 [WVal.i32v 5, WVal.i32v 4]).bind asBool) = some false := by - native_decide + decide +kernel -- i64.eqz def cI64Eqz : CodeTbl := fun fn => if fn = 1 then some ⟨1, 0, [.localGet 0, .i64Eqz]⟩ else none -example : ((wFuncN cI64Eqz gHost 4 1 [WVal.i64v 0]).bind asBool) = some true := by native_decide -example : ((wFuncN cI64Eqz gHost 4 1 [WVal.i64v 3]).bind asBool) = some false := by native_decide +example : ((wFuncN cI64Eqz gHost 4 1 [WVal.i64v 0]).bind asBool) = some true := by decide +kernel +example : ((wFuncN cI64Eqz gHost 4 1 [WVal.i64v 3]).bind asBool) = some false := by decide +kernel -- ref.null (+ ref.is_null) def cRefNull : CodeTbl := fun fn => if fn = 1 then some ⟨0, 0, [.refNull, .refIsNull]⟩ else none -example : ((wFuncN cRefNull gHost 4 1 []).bind asBool) = some true := by native_decide +example : ((wFuncN cRefNull gHost 4 1 []).bind asBool) = some true := by decide +kernel -- return (plain): box the argument then early-return it. def cRet : CodeTbl := fun fn => if fn = 1 then some ⟨1, 0, [.localGet 0, .structGet 5 0, .call 6, .ret, .i64Const 999, .call 6]⟩ else none example : - ((wFuncN cRet gHost 4 1 [carrierSmall 5 42]).bind carrierToInt) = some 42 := by native_decide + ((wFuncN cRet gHost 4 1 [carrierSmall 5 42]).bind carrierToInt) = some 42 := by decide +kernel -- remaining i32 / i64 / f64 comparison + arithmetic opcodes, each executed once. def cMisc (ops : List WInstr) : CodeTbl := fun fn => if fn = 1 then some ⟨2, 0, ops⟩ else none example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .i32GtS]) gHost 4 1 - [WVal.i32v 7, WVal.i32v 3]).bind asBool) = some true := by native_decide + [WVal.i32v 7, WVal.i32v 3]).bind asBool) = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .i32LeS]) gHost 4 1 - [WVal.i32v 3, WVal.i32v 3]).bind asBool) = some true := by native_decide + [WVal.i32v 3, WVal.i32v 3]).bind asBool) = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .i64Eq]) gHost 4 1 - [WVal.i64v 9, WVal.i64v 9]).bind asBool) = some true := by native_decide + [WVal.i64v 9, WVal.i64v 9]).bind asBool) = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .i64GeS]) gHost 4 1 - [WVal.i64v 9, WVal.i64v 8]).bind asBool) = some true := by native_decide + [WVal.i64v 9, WVal.i64v 8]).bind asBool) = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .i64GtS]) gHost 4 1 - [WVal.i64v 9, WVal.i64v 8]).bind asBool) = some true := by native_decide + [WVal.i64v 9, WVal.i64v 8]).bind asBool) = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .i64LtS]) gHost 4 1 - [WVal.i64v 8, WVal.i64v 9]).bind asBool) = some true := by native_decide + [WVal.i64v 8, WVal.i64v 9]).bind asBool) = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .f64Add]) gHost 4 1 [WVal.f64v (1.5 : Float).toBits, WVal.f64v (2.5 : Float).toBits]).bind asF64) - = some (4.0 : Float).toBits := by native_decide + = some (4.0 : Float).toBits := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .f64Mul]) gHost 4 1 [WVal.f64v (3.0 : Float).toBits, WVal.f64v (2.0 : Float).toBits]).bind asF64) - = some (6.0 : Float).toBits := by native_decide + = some (6.0 : Float).toBits := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .f64Le]) gHost 4 1 [WVal.f64v (2.0 : Float).toBits, WVal.f64v (2.0 : Float).toBits]).bind asBool) - = some true := by native_decide + = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .f64Ge]) gHost 4 1 [WVal.f64v (2.0 : Float).toBits, WVal.f64v (2.0 : Float).toBits]).bind asBool) - = some true := by native_decide + = some true := by decide +kernel example : ((wFuncN (cMisc [.localGet 0, .localGet 1, .f64Gt]) gHost 4 1 [WVal.f64v (3.0 : Float).toBits, WVal.f64v (2.0 : Float).toBits]).bind asBool) - = some true := by native_decide + = some true := by decide +kernel /-! ## LEB128 index encoders @@ -288,4 +288,40 @@ example : s33Bytes 128 = [0x80, 0x01] := by decide example : s33Bytes 8192 = [0x80, 0xc0, 0x00] := by decide example : s33Bytes 4294967295 = [0xff, 0xff, 0xff, 0xff, 0x0f] := by decide +/-! ## One-grammar opcodes: `i64.ne`, `i32.eqz`, `i32.ne`, `i32.or` + +Edge values for each new instruction, proved on the interpreter directly. The +stack is written top first. `i32.or` is exact on 0/1 and STUCK on any other +operand, so it never yields a value the bitwise wasm instruction would not. -/ + +section OneGrammarOps +variable (h : HostTbl) (a : Nat → Option Nat) (c : Callee) (l : List WVal) + +example : wRunF h a c [.i64Ne] l [.i64v 7, .i64v 7] = some (.ok l [.i32v 0]) := by + simp [wRunF, b32] +example : wRunF h a c [.i64Ne] l [.i64v 7, .i64v (-7)] = some (.ok l [.i32v 1]) := by + simp [wRunF, b32] +example : wRunF h a c [.i64Ne] l [.i32v 7, .i32v 7] = none := by simp [wRunF] +example : wRunF h a c [.i32Eqz] l [.i32v 0] = some (.ok l [.i32v 1]) := by simp [wRunF, b32] +example : wRunF h a c [.i32Eqz] l [.i32v 5] = some (.ok l [.i32v 0]) := by simp [wRunF, b32] +example : wRunF h a c [.i32Eqz] l [.i32v (-1)] = some (.ok l [.i32v 0]) := by + simp [wRunF, b32] +example : wRunF h a c [.i32Eqz] l [.i64v 0] = none := by simp [wRunF] +example : wRunF h a c [.i32Ne] l [.i32v 1, .i32v 0] = some (.ok l [.i32v 1]) := by + simp [wRunF, b32] +example : wRunF h a c [.i32Ne] l [.i32v 1, .i32v 1] = some (.ok l [.i32v 0]) := by + simp [wRunF, b32] +example : wRunF h a c [.i32Or] l [.i32v 0, .i32v 0] = some (.ok l [.i32v 0]) := by + simp [wRunF, b32] +example : wRunF h a c [.i32Or] l [.i32v 1, .i32v 0] = some (.ok l [.i32v 1]) := by + simp [wRunF, b32] +example : wRunF h a c [.i32Or] l [.i32v 0, .i32v 1] = some (.ok l [.i32v 1]) := by + simp [wRunF, b32] +example : wRunF h a c [.i32Or] l [.i32v 1, .i32v 1] = some (.ok l [.i32v 1]) := by + simp [wRunF, b32] +example : wRunF h a c [.i32Or] l [.i32v 2, .i32v 0] = none := by simp [wRunF] +example : wRunF h a c [.i32Or] l [.i32v 0, .i32v (-1)] = none := by simp [wRunF] + +end OneGrammarOps + end CertPrelude diff --git a/aver-cert/assets/wall/current/ClaimAxes.lean b/aver-cert/assets/wall/current/ClaimAxes.lean index ffead7207..96773e510 100644 --- a/aver-cert/assets/wall/current/ClaimAxes.lean +++ b/aver-cert/assets/wall/current/ClaimAxes.lean @@ -1,85 +1,42 @@ /- -Canonical claim axes derived inside Lean. - -Policy, termination evidence, totality role, and disclosed runtime contracts -are outputs of the checked family plans. They are not producer-selected inputs. +Canonical claim axes and report data derived inside Lean. + +Policy, termination evidence and totality role are fields of the derived +obligations (`AcceptedArtifact.obligationsOf`, from the wall's termination +check). What is left here is disclosure: the runtime contracts the certificate +is conditional on, computed from the helper calls the plans' lowerings make, +and the report entries (one class for every plan, D2, plus facets derived from +the plans). None of these is a producer choice; the checker witness pins them +against the JSON manifest. -/ import AcceptedArtifactCore namespace AverCert.ClaimAxes open AverCert.Schema +open AverCert.Grammar +open AverCert.TypeTable open AverCert.AcceptedArtifact - -def canonicalTermination : TerminationWitness := - { measure := .intNatAbs 0, descent := -1 } - -structure AxisSpec where - policy : Policy - termination? : Option TerminationWitness - totalityRole : TotalityRole - -def partialAxis : AxisSpec := - { policy := .simulatesModel, termination? := none, totalityRole := .addSub } - -def total (role : TotalityRole) : AxisSpec := - { policy := .simulatesModelTotally - termination? := some canonicalTermination - totalityRole := role } - -def AxisSpec.matches (spec : AxisSpec) (obligation : Obligation) : Bool := - obligation.policy == spec.policy && - obligation.termination? == spec.termination? && - obligation.totalityRole == spec.totalityRole - -/-- Classify the byte-bound recursion grammar first; compare the obligation's - claimed role only after classification. The additive unary and accumulator - shapes are disjoint from the unary multiplication shape. -/ -def classifyRecursionPlanShape - (self : Nat) - (hostTable : List (HostRole × Nat)) - (plan : RecursionRawPlan) : Option TotalityRole := - AverCert.PlanCheck.classifyRecursionPlanShape self hostTable plan - -def recursionAxis (manifest : Manifest) (claim : RecursionClaim) : Option AxisSpec := do - let plan ← recursionPlanForExport claim.exportName manifest.recursionPlans - let role ← classifyRecursionPlanShape claim.obligation.self claim.hostTable plan - pure (total role) - -def mutualAxis (manifest : Manifest) (claim : MutualRecursionClaim) : Option AxisSpec := do - let _ ← mutualPlanForExport claim.exportName manifest.mutualPlans - pure (total .addSub) - -def allMatch (axis : Claim → Option AxisSpec) - (obligation : Claim → Obligation) : List Claim → Bool - | [] => true - | claim :: rest => - match axis claim with - | some spec => - spec.matches (obligation claim) && allMatch axis obligation rest - | none => false - -def checkedAxes (artifact : ArtifactData) : Bool := - allMatch (fun _ : SymFragmentClaim => some partialAxis) (fun c => c.obligation) - artifact.symFragmentClaims && - allMatch (fun _ : StringEqClaim => some partialAxis) (fun c => c.obligation) - artifact.stringEqClaims && - allMatch (fun _ : StringConcatClaim => some partialAxis) (fun c => c.obligation) - artifact.stringConcatClaims && - allMatch (fun _ : ConstructClaim => some partialAxis) (fun c => c.obligation) - artifact.constructClaims && - allMatch (recursionAxis artifact.manifest) (fun c => c.obligation) - artifact.recursionClaims && - allMatch (mutualAxis artifact.manifest) (fun c => c.obligation) - artifact.mutualRecursionClaims && - allMatch (fun _ : VerbatimClaim => some partialAxis) (fun c => c.obligation) - artifact.verbatimClaims && - allMatch (fun _ : IntDispatchClaim => some partialAxis) (fun c => c.obligation) - artifact.intDispatchClaims && - allMatch (fun _ : FieldProjectionClaim => some partialAxis) (fun c => c.obligation) - artifact.fieldProjectionClaims && - allMatch (fun _ : CompositionClaim => some partialAxis) (fun c => c.obligation) - artifact.compositionClaims +open CertPrelude + +/-- The one report class of a certified export. -/ +def planClass : String := "source-plan-v1" + +mutual + /-- Every function index a lowered body calls (`call` and `return_call`). -/ + def wCalls : WInstr → List Nat + | .call f => [f] + | .returnCall f => [f] + | .ifElse t e => wCallsL t ++ wCallsL e + | _ => [] + def wCallsL : List WInstr → List Nat + | [] => [] + | i :: is => wCalls i ++ wCallsL is +end + +/-- The helper calls of every planned function's lowering. -/ +def usedCalls (M : MCtx) (fns : List FnEntry) : List Nat := + (fns.map fun e => wCallsL (fnCode M e.plan).body).flatten structure ContractUse where box : Bool := false @@ -91,119 +48,35 @@ structure ContractUse where toIndex : Bool := false cmp : Bool := false eq : Bool := false + divmod : Bool := false addTotal : Bool := false subTotal : Bool := false mulTotal : Bool := false deriving Repr, DecidableEq -def ContractUse.merge (left right : ContractUse) : ContractUse := - { box := left.box || right.box - add := left.add || right.add - sub := left.sub || right.sub - mul := left.mul || right.mul - stringEq := left.stringEq || right.stringEq - stringConcat := left.stringConcat || right.stringConcat - toIndex := left.toIndex || right.toIndex - cmp := left.cmp || right.cmp - eq := left.eq || right.eq - addTotal := left.addTotal || right.addTotal - subTotal := left.subTotal || right.subTotal - mulTotal := left.mulTotal || right.mulTotal } - -def useHostRole : HostRole → ContractUse - | .box => { box := true } - | .add => { add := true } - | .sub => { sub := true } - | .mul => { mul := true } - | .toIndex => { toIndex := true } - | .cmp => { cmp := true } - | .eq => { eq := true } - -def useFragBlockFuel : Nat → FragBlock → ContractUse - | 0, _ => {} - | fuel + 1, block => - block.nodes.foldl (fun used node => - let here := match node.kind with - | .hostCall role _ _ => useHostRole role - | .ifElse _ thenBlock elseBlock => - (useFragBlockFuel fuel thenBlock).merge - (useFragBlockFuel fuel elseBlock) - -- The fused vector read calls both the to-index and box helpers. - | .vectorGetOrDefault _ _ _ _ => { box := true, toIndex := true } - | _ => {} - used.merge here) {} - -def useFragBlock (block : FragBlock) : ContractUse := - useFragBlockFuel AverCert.PlanLower.maxFuel block - -def useSymFragment (claim : SymFragmentClaim) : Option ContractUse := do - let plan ← AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan - pure (useFragBlock plan.body) - -def useRecursion (manifest : Manifest) (claim : RecursionClaim) : Option ContractUse := do - let plan ← recursionPlanForExport claim.exportName manifest.recursionPlans - let role ← classifyRecursionPlanShape claim.obligation.self claim.hostTable plan - match role with - | .addSub => - pure { box := true, add := true, sub := true - addTotal := true, subTotal := true } - | .mul => - pure { box := true, sub := true, mul := true - addTotal := true, subTotal := true, mulTotal := true } - -def useMutual (manifest : Manifest) (claim : MutualRecursionClaim) : Option ContractUse := do - let _ ← mutualPlanForExport claim.exportName manifest.mutualPlans - pure { box := true, sub := true, addTotal := true, subTotal := true } - -def useIntDispatchLeaf : IntDispatchLeaf → ContractUse - | .proj => {} - | .hostOp .add _ _ => { box := true, add := true } - | .hostOp .sub _ _ => { box := true, sub := true } - | .const _ => { box := true } - -def useIntDispatchCascade : IntDispatchCascade → ContractUse - | .default _ => { box := true } - | .test _ hit rest => - (useIntDispatchLeaf hit).merge (useIntDispatchCascade rest) - -def useIntDispatch (manifest : Manifest) (claim : IntDispatchClaim) : Option ContractUse := do - let plan ← intDispatchPlanForExport claim.exportName manifest.intDispatchPlans - pure (useIntDispatchCascade plan.body) - -def usesOf (use : Claim → Option ContractUse) : List Claim → Option ContractUse - | [] => some {} - | claim :: rest => do - let head ← use claim - let tail ← usesOf use rest - pure (head.merge tail) - -def requiredContractUse (artifact : ArtifactData) : Option ContractUse := do - let sym ← usesOf useSymFragment artifact.symFragmentClaims - let stringEq ← usesOf (fun _ : StringEqClaim => - some { stringEq := true }) artifact.stringEqClaims - let stringConcat ← usesOf (fun _ : StringConcatClaim => - some { stringConcat := true }) artifact.stringConcatClaims - let construct ← usesOf (fun _ : ConstructClaim => some {}) artifact.constructClaims - let recursion ← usesOf (useRecursion artifact.manifest) artifact.recursionClaims - let mutualUse ← usesOf (useMutual artifact.manifest) artifact.mutualRecursionClaims - let verbatim ← usesOf (fun _ : VerbatimClaim => some {}) artifact.verbatimClaims - let intDispatch ← usesOf (useIntDispatch artifact.manifest) artifact.intDispatchClaims - let projection ← usesOf (fun _ : FieldProjectionClaim => some {}) - artifact.fieldProjectionClaims - -- Every accepted composition closure contains a `selfSum` leaf and its - -- canonical host table contains exactly the add role. - let composition ← usesOf (fun _ : CompositionClaim => - some { add := true }) artifact.compositionClaims - let used := sym.merge stringEq - let used := used.merge stringConcat - let used := used.merge construct - let used := used.merge recursion - let used := used.merge mutualUse - let used := used.merge verbatim - let used := used.merge intDispatch - let used := used.merge projection - pure (used.merge composition) +/-- The contracts one artifact depends on: a helper contract when some + lowering calls that helper, and the totality contracts of every L3 + obligation's role. -/ +def contractUse (artifact : ArtifactData) : ContractUse := + let m := artifact.manifest + let M := mctxOf m.subject m.types m.fnPlans + let calls := usedCalls M m.fnPlans + let total := m.obligations.any fun o => o.policy == .simulatesModelTotally + let totalMul := m.obligations.any fun o => + o.policy == .simulatesModelTotally && o.totalityRole == .mul + { box := calls.contains M.box + add := calls.contains M.add + sub := calls.contains M.sub + mul := calls.contains M.mul + stringEq := calls.contains M.streq + stringConcat := calls.contains M.concat + toIndex := calls.contains M.toIndex + cmp := calls.contains M.cmp + eq := calls.contains M.eq + divmod := calls.contains M.divmod + addTotal := total + subTotal := total + mulTotal := totalMul } def boxContract : String := "__rt_aint_from_i64 (box i64 -> carrier)" @@ -223,6 +96,8 @@ def cmpContract : String := "__aint_cmp (canonical carrier pair -> i32 sign; -1 less, 0 equal, 1 greater)" def eqContract : String := "__aint_eq (canonical carrier pair -> i32 boolean; 1 when equal, else 0)" +def divmodContract : String := + "__aint_divmod (canonical carrier pair, nonzero divisor, want_mod 0 or 1 -> canonical Euclidean quotient (0) or remainder in [0, |b|) (1))" def addTotalContract : String := "Int.add (carrier add = exact integer addition on represented values; result canonical); total on represented values" def subTotalContract : String := @@ -240,20 +115,76 @@ def ContractUse.contracts (use : ContractUse) : List String := (if use.toIndex then [toIndexContract] else []) ++ (if use.cmp then [cmpContract] else []) ++ (if use.eq then [eqContract] else []) ++ + (if use.divmod then [divmodContract] else []) ++ (if use.addTotal then [addTotalContract] else []) ++ (if use.subTotal then [subTotalContract] else []) ++ (if use.mulTotal then [mulTotalContract] else []) -def requiredContracts (artifact : ArtifactData) : Option (List String) := do - let use ← requiredContractUse artifact - pure use.contracts +def requiredContracts (artifact : ArtifactData) : List String := + (contractUse artifact).contracts def contractsMatch (artifact : ArtifactData) : Bool := - requiredContracts artifact == some artifact.manifest.subject.contracts - -/-- All producer-selectable claim metadata that is instead canonicalized by - the checked family and plan. -/ + requiredContracts artifact == artifact.manifest.subject.contracts + +/-! ### Report data -/ + +mutual + /-- Facet flags of one plan body: `(calls, records, variants, strings, + floats)`. -/ + def facetsE : Expr → List String + | .literal (.str _) => ["strings"] + | .literal (.float _) => ["floats"] + | .literal _ => [] + | .local _ => [] + | .let_ _ v body => facetsE v ++ facetsE body + | .call (.fn _) args => "calls" :: facetsL args + | .call _ args => facetsL args + | .tailCall _ args => "calls" :: facetsL args + | .binOp _ l r => facetsE l ++ facetsE r + | .neg e => facetsE e + | .ifThenElse c t e => facetsE c ++ facetsE t ++ facetsE e + | .recordCreate _ fs => "records" :: facetsL fs + | .project _ _ b => "records" :: facetsE b + | .match_ s arms => facetsE s ++ facetsA arms + | .construct _ _ args => "variants" :: facetsL args + | .interp parts => "strings" :: facetsL parts + | .list _ items => facetsL items + def facetsL : List Expr → List String + | [] => [] + | e :: es => facetsE e ++ facetsL es + def facetsA : Arms → List String + | .nil => [] + | .cons p b rest => + (match p with + | .ctor _ _ => ["variants"] + | .litStr _ => ["strings"] + | .tuple _ => ["records"] + | _ => []) ++ facetsE b ++ facetsA rest +end + +/-- The facets of one planned function, in a fixed order, derived from its + plan and its group: `recursive` (its group calls itself), `mutual` (a group + of two or more), then the constructs its body uses. -/ +def facetsOf (fns : List FnEntry) (e : FnEntry) : List String := + let grp := groupMembers fns e.group + let body := facetsE e.plan.body + let recursive := grp.any fun m => (callTargets m.2.body).any fun t => grp.any (·.1 == t) + ["recursive", "mutual", "calls", "records", "variants", "strings", "floats"].filter fun f => + if f == "recursive" then recursive + else if f == "mutual" then recursive && decide (2 ≤ grp.length) + else body.contains f + +/-- `(export, class)` for every certified export, in obligation order. -/ +def reportEntries (artifact : ArtifactData) : List (String × String) := + artifact.manifest.obligations.map fun o => (o.export_, planClass) + +/-- `(export, facets)` for every exported planned function. -/ +def reportFacets (artifact : ArtifactData) : List (String × List String) := + (artifact.manifest.fnPlans.filter (·.exported)).map fun e => + (e.name, facetsOf artifact.manifest.fnPlans e) + +/-- All producer-selectable claim metadata the wall canonicalizes. -/ def checked (artifact : ArtifactData) : Bool := - checkedAxes artifact && contractsMatch artifact + contractsMatch artifact end AverCert.ClaimAxes diff --git a/aver-cert/assets/wall/current/CompositionSoundness.lean b/aver-cert/assets/wall/current/CompositionSoundness.lean deleted file mode 100644 index bd32d05ca..000000000 --- a/aver-cert/assets/wall/current/CompositionSoundness.lean +++ /dev/null @@ -1,167 +0,0 @@ -/- Generic soundness for composition-family call chains. - - A composition root is a unary chain of user calls. The byte-bound plan - resolves each callee name through the kernel function table. Soundness of - each member is supplied as a hypothesis with exactly the generated member - theorem's face; this file proves only the straight-line call glue. -/ -import AcceptedArtifactCore - -set_option maxRecDepth 1000000 -set_option linter.unusedSimpArgs false - -namespace CompositionSoundness -open CertPrelude AverCert.Schema AverCert.PlanLower -open AverCert.AcceptedArtifact -open AverCert - -/-- Source-model composition in the same left-to-right order as - `lowerCompositionCalls`. -/ -def evalCompositionCalls (models : String → Int → Int) : - List String → Int → Int - | [], x => x - | name :: rest, x => evalCompositionCalls models rest (models name x) - -/-- The exact semantic face emitted today for every member theorem. -/ -def MemberCertified {C : Nat} (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) (idx : Nat) (model : Int → Int) : Prop := - ∀ (fuel : Nat) (x : Int) (v w : WVal), S.Repr x v → - wFuncN code host fuel idx [v] = some w → S.Repr (model x) w - -/-- A member theorem plus the byte-derived routing facts needed by the call - interpreter. `member`/`member_lookup` align this hypothesis with the - `CompositionMemberClaim` table consumed by artifact acceptance. -/ -structure MemberFact {C : Nat} (S : CarrierSpec C) - (members : List CompositionMemberClaim) - (funcTable : List (String × Nat)) - (code : CodeTbl) (host : HostTbl) - (models : String → Int → Int) (name : String) where - member : CompositionMemberClaim - member_lookup : compositionMemberForName name members = some member - idx : Nat - target : compositionFuncIdx? funcTable name = some idx - host_absent : host idx = none - body : List WInstr - code_entry : code idx = some { - arity := 1 - nlocals := compositionNLocals member.plan - body := body - } - certified : MemberCertified S code host idx (models name) - -/-- The result projection used by `wFuncN` after interpreting a body. -/ -def finishRun : Option Out → Option WVal - | some (.ok _ [v]) => some v - | some (.ret v) => some v - | _ => none - -/-- Generic straight-line simulation for the `.call` list produced by the - audited composition lowerer. -/ -theorem simCompositionCalls {C : Nat} (S : CarrierSpec C) - (members : List CompositionMemberClaim) - (funcTable : List (String × Nat)) - (code : CodeTbl) (host : HostTbl) (models : String → Int → Int) - (fuel : Nat) (locals : List WVal) : - ∀ (callees : List String) (instrs : List WInstr) (x : Int) (v w : WVal), - lowerCompositionCalls funcTable callees = some instrs → - (∀ name, name ∈ callees → MemberFact S members funcTable code host models name) → - S.Repr x v → - finishRun (wRunF host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - instrs locals [v]) = some w → - S.Repr (evalCompositionCalls models callees x) w := by - intro callees - induction callees with - | nil => - intro instrs x v w hlow _facts hv hrun - simp only [lowerCompositionCalls, Option.some.injEq] at hlow - subst instrs - simp only [wRunF, finishRun, Option.some.injEq] at hrun - subst w - simpa [evalCompositionCalls] using hv - | cons name rest ih => - intro instrs x v w hlow facts hv hrun - have fact := facts name (by simp) - simp only [lowerCompositionCalls] at hlow - rw [fact.target] at hlow - cases htail : lowerCompositionCalls funcTable rest with - | none => simp [htail] at hlow - | some tail => - rw [htail] at hlow - simp only [Option.some.injEq] at hlow - subst instrs - cases hcall : wFuncN code host fuel fact.idx [v] with - | none => - simp [wRunF, finishRun, fact.host_absent, fact.code_entry, popArgs, hcall] at hrun - | some mid => - have hrun' : finishRun ( - wRunF host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - tail locals [mid]) = some w := by - simpa [wRunF, fact.host_absent, fact.code_entry, popArgs, hcall] - using hrun - have hmid : S.Repr (models name x) mid := - fact.certified fuel x v mid hv hcall - apply ih tail (models name x) mid w htail - · intro callee hmem - exact facts callee (by simp [hmem]) - · exact hmid - · exact hrun' - -/-- ONE generic theorem for a composition root. Member semantics are cited, - never re-proved; `hcheck` and `hlow` bind the glue to the admitted plan and - canonical lowering. -/ -theorem generic_composition_certified {C : Nat} (S : CarrierSpec C) - (members : List CompositionMemberClaim) - (funcTable : List (String × Nat)) - (code : CodeTbl) (host : HostTbl) - (models : String → Int → Int) - (rootModel : Int → Int) (self : Nat) - (hostTable : List (HostRole × Nat)) - (plan : CompositionRawPlan) (callees : List String) - (hshape : plan.shape = .chain callees) - (hcheck : AverCert.PlanCheck.checkCompositionRawPlan plan = true) - (body : List WInstr) - (hlow : lowerCompositionBody hostTable funcTable plan = some body) - (hself : code self = some { - arity := 1, nlocals := compositionNLocals plan, body := body }) - (facts : ∀ name, name ∈ callees → - MemberFact S members funcTable code host models name) - (hmodel : ∀ x, rootModel x = evalCompositionCalls models callees x) : - MemberCertified S code host self rootModel := by - intro fuel x v w hv hrun - cases fuel with - | zero => simp [wFuncN] at hrun - | succ fuel => - unfold lowerCompositionBody at hlow - rw [if_pos hcheck] at hlow - simp only [hshape] at hlow - cases hcalls : lowerCompositionCalls funcTable callees with - | none => simp [hcalls] at hlow - | some callInstrs => - rw [hcalls] at hlow - simp only [Option.some.injEq] at hlow - subst body - simp only [wFuncN, hself] at hrun - change finishRun (wRunF host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - (.localGet 0 :: callInstrs) (initLocals { - arity := 1 - nlocals := compositionNLocals plan - body := .localGet 0 :: callInstrs - } [v]) []) = some w at hrun - simp only [wRunF, initLocals] at hrun - have hrun' : finishRun ( - wRunF host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - callInstrs (initLocals { - arity := 1 - nlocals := compositionNLocals plan - body := .localGet 0 :: callInstrs - } [v]) [v]) = some w := by - exact hrun - rw [hmodel] - exact simCompositionCalls S members funcTable code host models fuel _ - callees callInstrs x v w hcalls facts hv hrun' - - -end CompositionSoundness diff --git a/aver-cert/assets/wall/current/ConstructVerbatimSoundness.lean b/aver-cert/assets/wall/current/ConstructVerbatimSoundness.lean deleted file mode 100644 index e8efafabc..000000000 --- a/aver-cert/assets/wall/current/ConstructVerbatimSoundness.lean +++ /dev/null @@ -1,451 +0,0 @@ -import CertPrelude -import SchemaCore -import PlanCheck -import PlanLower -import PlanBytes - -set_option maxRecDepth 100000 -set_option maxHeartbeats 1000000 - -namespace ConstructVerbatimSoundness -open CertPrelude AverCert.Schema - -def outValue : Option Out → Option WVal - | some (.ok _ [value]) => some value - | some (.ret value) => some value - | _ => none - -/-! ## Constructor family -/ - -def constructModelField (locals : List WVal) : ConstructField → WVal - | .local index => locals.getD index .null - | .null => .null - -def constructModelFields (locals : List WVal) : List ConstructField → List WVal - | [] => [] - | field :: rest => - constructModelField locals field :: constructModelFields locals rest - -@[simp] theorem constructModelFields_length - (locals : List WVal) (fields : List ConstructField) : - (constructModelFields locals fields).length = fields.length := by - induction fields <;> simp [constructModelFields, *] - -@[simp] theorem popArgs_reverse (values : List WVal) : - popArgs values.length values.reverse = some (values, []) := by - unfold popArgs - rw [if_neg (by simp)] - have hlen : values.length = values.reverse.length := by simp - rw [hlen, List.take_length, List.drop_length] - simp - -def FieldsReadable (locals : List WVal) (fields : List ConstructField) : Prop := - ∀ i, ConstructField.local i ∈ fields → ∃ v, locals[i]? = some v - -theorem fieldsReadable_tail - {locals : List WVal} {field : ConstructField} {fields : List ConstructField} - (h : FieldsReadable locals (field :: fields)) : FieldsReadable locals fields := by - intro i hi - exact h i (by simp [hi]) - -/-- The constructor-family simulation lemma. Its `rest` quantifier is the same - compositional device used by the straight-line soundness proof. -/ -theorem simNodes_construct - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (structIdx : Nat) (locals : List WVal) : - ∀ fields, FieldsReadable locals fields → ∀ rest stack, - wRunF host ar callee - (AverCert.PlanLower.lowerConstructFields structIdx fields ++ rest) locals stack = - wRunF host ar callee rest locals - ((constructModelFields locals fields).reverse ++ stack) := by - intro fields - induction fields with - | nil => - intro _ rest stack - rfl - | cons field fields ih => - intro hread rest stack - cases field with - | «local» i => - obtain ⟨v, hv⟩ := hread i (by simp) - have htail := fieldsReadable_tail hread - simpa [AverCert.PlanLower.lowerConstructFields, - AverCert.PlanLower.lowerConstructField, constructModelFields, - constructModelField, List.getD, hv, wRunF, List.reverse_cons, - List.append_assoc] using ih htail rest (v :: stack) - | null => - have htail := fieldsReadable_tail hread - simpa [AverCert.PlanLower.lowerConstructFields, - AverCert.PlanLower.lowerConstructField, constructModelFields, - constructModelField, wRunF, List.reverse_cons, List.append_assoc] - using ih htail rest (WVal.null :: stack) - -theorem constructFieldsOk_local_lt - (arity i : Nat) : ∀ fields, - AverCert.PlanCheck.constructFieldsOk arity fields = true → - ConstructField.local i ∈ fields → i < arity := by - intro fields - induction fields with - | nil => simp - | cons field fields ih => - cases field with - | «local» j => - intro hok hmem - simp [AverCert.PlanCheck.constructFieldsOk, - AverCert.PlanCheck.constructFieldOk] at hok - simp at hmem - rcases hmem with rfl | hmem - · exact hok.1 - · exact ih hok.2 hmem - | null => - intro hok hmem - simp [AverCert.PlanCheck.constructFieldsOk, - AverCert.PlanCheck.constructFieldOk] at hok - simp at hmem - exact ih hok hmem - -theorem accepted_fields_readable - (plan : ConstructRawPlan) (nlocals : Nat) (args : List WVal) - (hcheck : AverCert.PlanCheck.checkConstructRawPlan plan = true) - (hlen : args.length = plan.arity) : - FieldsReadable (args ++ List.replicate nlocals .null) plan.fields := by - have hfields : AverCert.PlanCheck.constructFieldsOk plan.arity plan.fields = true := by - have hall := hcheck - simp [AverCert.PlanCheck.checkConstructRawPlan] at hall - exact hall.1.2 - intro i hi - have hlt : i < plan.arity := - constructFieldsOk_local_lt plan.arity i plan.fields hfields hi - have hargs : i < args.length := by simpa [hlen] using hlt - refine ⟨args[i], ?_⟩ - rw [List.getElem?_append_left hargs] - exact List.getElem?_eq_getElem hargs - -/-- Any checker-accepted constructor plan, when tied to its audited lowering, - constructs exactly the field list described by the plan. -/ -theorem generic_construct_certified - (structIdx : Nat) (plan : ConstructRawPlan) - (code : CodeTbl) (host : HostTbl) (self nlocals : Nat) - (hcheck : AverCert.PlanCheck.checkConstructRawPlan plan = true) - (instrs : List WInstr) - (hlow : AverCert.PlanLower.lowerConstructBody structIdx plan = some instrs) - (hself : code self = some - { arity := plan.arity, nlocals := nlocals, body := instrs }) - (args : List WVal) (hlen : args.length = plan.arity) : - wFuncN code host 1 self args = - some (.structv structIdx - (constructModelFields (args ++ List.replicate nlocals .null) plan.fields)) := by - have hcanon : instrs = - AverCert.PlanLower.lowerConstructFields structIdx plan.fields ++ - [.structNew structIdx plan.fields.length] := by - simp [AverCert.PlanLower.lowerConstructBody, hcheck] at hlow - exact hlow.symm - subst instrs - simp only [wFuncN] - rw [hself] - simp only [initLocals] - change outValue (wRunF host (fun g => (code g).map (·.arity)) - (fun _ _ => none) - (AverCert.PlanLower.lowerConstructFields structIdx plan.fields ++ - [.structNew structIdx plan.fields.length]) - (args ++ List.replicate nlocals .null) []) = _ - have hsim := simNodes_construct host (fun g => (code g).map (·.arity)) - (fun _ _ => none) - structIdx (args ++ List.replicate nlocals .null) plan.fields - (accepted_fields_readable plan nlocals args hcheck hlen) - [.structNew structIdx plan.fields.length] [] - rw [hsim] - simp only [List.append_nil] - rw [show plan.fields.length = - (constructModelFields (args ++ List.replicate nlocals .null) plan.fields).length by simp] - simp only [wRunF, popArgs_reverse] - rfl - -/-! ## Verbatim family -/ - -def verbatimLeafModel (scrutinee : WVal) : VerbatimLeaf → Option WVal - | .project tyIdx field => - match scrutinee with - | .structv ty fields => if ty = tyIdx then fields[field]? else none - | _ => none - | .arrayNewData arrTy _ bytes => - some (.arr arrTy (bytes.map (fun b => .i32v (Int.ofNat b)))) - | .refNull => some .null - | .f64Bits bits => some (.f64v (UInt64.ofNat bits)) - -def verbatimDispatchModel (scrutinee : WVal) : VerbatimDispatch → Option WVal - | .leaf leaf => verbatimLeafModel scrutinee leaf - | .test tyIdx hit rest => - match scrutinee with - | .structv ty _ => - if ty = tyIdx then verbatimLeafModel scrutinee hit - else verbatimDispatchModel scrutinee rest - | .arr ty _ => - if ty = tyIdx then verbatimLeafModel scrutinee hit - else verbatimDispatchModel scrutinee rest - | _ => verbatimDispatchModel scrutinee rest - -def verbatimModel (plan : VerbatimRawPlan) (scrutinee : WVal) : WVal := - (verbatimDispatchModel scrutinee plan.body).getD .null - -@[simp] theorem finishRun_nil - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (r : Option Out) : - (match r with - | some (.ok locals stack) => - wRunF host ar callee [] locals stack - | some (.ret value) => some (.ret value) - | none => none) = r := by - cases r with - | none => rfl - | some out => cases out <;> simp [wRunF] - -@[simp] theorem outValue_finishRun_nil - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (r : Option Out) : - outValue - (match r with - | some (.ok locals stack) => wRunF host ar callee [] locals stack - | some (.ret value) => some (.ret value) - | none => none) = outValue r := by - rw [finishRun_nil] - -@[simp] theorem outValue_passthrough (r : Option Out) : - outValue - (match r with - | some (.ok locals stack) => some (.ok locals stack) - | some (.ret value) => some (.ret value) - | none => none) = outValue r := by - cases r with - | none => rfl - | some out => cases out <;> rfl - -theorem unwrap_passthrough {r : Option Out} {w : WVal} - (h : outValue - (match r with - | some (.ok locals stack) => some (.ok locals stack) - | some (.ret value) => some (.ret value) - | none => none) = some w) : outValue r = some w := by - cases r with - | none => simpa [outValue] using h - | some out => cases out <;> simpa [outValue] using h - -/-- A verbatim leaf started with an empty operand stack returns the value - described by that leaf whenever it does not trap. -/ -theorem simLeaf_verbatim - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (S F : Nat) (locals : List WVal) (scrutinee : WVal) : - ∀ leaf w, - locals[S]? = some scrutinee → - F < locals.length → - outValue (wRunF host ar callee - (AverCert.PlanLower.lowerLeaf S F leaf) - locals []) = some w → - w = (verbatimLeafModel scrutinee leaf).getD .null := by - intro leaf w hslot hF hrun - cases leaf with - | project ty field => - cases scrutinee with - | structv actual fields => - by_cases hty : actual = ty - · subst actual - simp [AverCert.PlanLower.lowerLeaf, verbatimLeafModel, - wRunF, hslot] at hrun ⊢ - split at hrun - · rename_i value hfield - have hset : (locals.set F value)[F]? = some value := - List.getElem?_set_self hF - simp [outValue, hfield, hset] at hrun ⊢ - exact hrun.symm - · contradiction - · simp [AverCert.PlanLower.lowerLeaf, verbatimLeafModel, - outValue, wRunF, hslot, hty] at hrun - | i32v n => simp [AverCert.PlanLower.lowerLeaf, outValue, wRunF, hslot] at hrun - | i64v n => simp [AverCert.PlanLower.lowerLeaf, outValue, wRunF, hslot] at hrun - | f64v bits => simp [AverCert.PlanLower.lowerLeaf, outValue, wRunF, hslot] at hrun - | arr ty elems => simp [AverCert.PlanLower.lowerLeaf, outValue, wRunF, hslot] at hrun - | null => simp [AverCert.PlanLower.lowerLeaf, outValue, wRunF, hslot] at hrun - | arrayNewData arrTy dataIdx bytes => - simp [AverCert.PlanLower.lowerLeaf, verbatimLeafModel, - outValue, wRunF, Function.comp_def] at hrun ⊢ - exact hrun.symm - | refNull => - simp [AverCert.PlanLower.lowerLeaf, verbatimLeafModel, outValue, wRunF] at hrun ⊢ - exact hrun.symm - | f64Bits bits => - simp [AverCert.PlanLower.lowerLeaf, verbatimLeafModel, outValue, wRunF] at hrun ⊢ - exact hrun.symm - -/-- Simulation for the non-first tail of a dispatch cascade. -/ -theorem simNodes_verbatim_tail - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (S F : Nat) (locals : List WVal) (scrutinee : WVal) - (hslot : locals[S]? = some scrutinee) (hF : F < locals.length) : - ∀ dispatch w, - outValue (wRunF host ar callee - (AverCert.PlanLower.lowerDispatch S F false dispatch) - locals []) = some w → - w = (verbatimDispatchModel scrutinee dispatch).getD .null := by - intro dispatch - induction dispatch with - | leaf leaf => - intro w hrun - exact simLeaf_verbatim host ar callee S F locals scrutinee - leaf w hslot hF (by simpa [AverCert.PlanLower.lowerDispatch] using hrun) - | test ty hit rest ih => - intro w hrun - cases scrutinee with - | structv actual fields => - by_cases hty : actual = ty - · subst ty - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, hslot, b32] at hrun ⊢ - exact simLeaf_verbatim host ar callee S F locals - (.structv actual fields) hit w hslot hF - (unwrap_passthrough hrun) - · simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, hslot, b32, hty] at hrun ⊢ - exact ih w (unwrap_passthrough hrun) - | arr actual elems => - by_cases hty : actual = ty - · subst ty - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, hslot, b32] at hrun ⊢ - exact simLeaf_verbatim host ar callee S F locals - (.arr actual elems) hit w hslot hF - (unwrap_passthrough hrun) - · simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, hslot, b32, hty] at hrun ⊢ - exact ih w (unwrap_passthrough hrun) - | i32v n => - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - outValue, wRunF, hslot] at hrun - | i64v n => - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - outValue, wRunF, hslot] at hrun - | f64v bits => - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - outValue, wRunF, hslot] at hrun - | null => - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - outValue, wRunF, hslot, b32] at hrun ⊢ - exact ih w (unwrap_passthrough hrun) - -/-- Generic dispatch simulation. It is deliberately a partial-correctness - statement: failed casts/projections trap, exactly as `wFuncN` does. -/ -theorem simNodes_verbatim - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (S F : Nat) (locals : List WVal) (scrutinee : WVal) - (hslot : locals[S]? = some scrutinee) (hF : F < locals.length) : - ∀ ty hit rest w, - outValue (wRunF host ar callee - (AverCert.PlanLower.lowerDispatch S F true (.test ty hit rest)) - locals [scrutinee]) = some w → - w = (verbatimDispatchModel scrutinee (.test ty hit rest)).getD .null := by - intro ty hit rest w hrun - cases scrutinee with - | structv actual fields => - by_cases hty : actual = ty - · subst ty - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, b32] at hrun ⊢ - exact simLeaf_verbatim host ar callee S F locals - (.structv actual fields) hit w hslot hF - (unwrap_passthrough hrun) - · simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, b32, hty] at hrun ⊢ - exact simNodes_verbatim_tail host ar callee S F locals - (.structv actual fields) hslot hF rest w - (unwrap_passthrough hrun) - | arr actual elems => - by_cases hty : actual = ty - · subst ty - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, b32] at hrun ⊢ - exact simLeaf_verbatim host ar callee S F locals - (.arr actual elems) hit w hslot hF - (unwrap_passthrough hrun) - · simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - wRunF, b32, hty] at hrun ⊢ - exact simNodes_verbatim_tail host ar callee S F locals - (.arr actual elems) hslot hF rest w - (unwrap_passthrough hrun) - | i32v n => simp [AverCert.PlanLower.lowerDispatch, outValue, wRunF] at hrun - | i64v n => simp [AverCert.PlanLower.lowerDispatch, outValue, wRunF] at hrun - | f64v bits => simp [AverCert.PlanLower.lowerDispatch, outValue, wRunF] at hrun - | null => - simp [AverCert.PlanLower.lowerDispatch, verbatimDispatchModel, - outValue, wRunF, b32] at hrun ⊢ - exact simNodes_verbatim_tail host ar callee S F locals - .null hslot hF rest w (unwrap_passthrough hrun) - -/-- Any checker-accepted verbatim plan tied to its audited lowering simulates - the plan-derived `WVal → WVal` model on every successful execution. -/ -theorem generic_verbatim_shape_certified - (plan : VerbatimRawPlan) (code : CodeTbl) (host : HostTbl) - (self nlocals : Nat) - (hcheck : AverCert.PlanCheck.checkVerbatimRawPlan plan = true) - (hroot : ∃ ty hit rest, plan.body = .test ty hit rest) - (hscratch : plan.scrutineeLocal < 1 + nlocals) - (hfieldScratch : plan.fieldLocal < 1 + nlocals) - (hself : code self = some - { arity := 1, nlocals := nlocals, - body := AverCert.PlanLower.lowerVerbatimBody plan }) : - ∀ fuel v w, - wFuncN code host (fuel + 1) self [v] = some w → - w = verbatimModel plan v := by - intro fuel v w hrun - rcases hroot with ⟨ty, hit, rest, hroot⟩ - simp only [wFuncN] at hrun - rw [hself] at hrun - let updated := - ([v] ++ List.replicate nlocals WVal.null).set plan.scrutineeLocal v - have hslot : - updated[plan.scrutineeLocal]? = some v := by - dsimp [updated] - apply List.getElem?_set_self - simpa [Nat.add_comm] using hscratch - have hslotRaw := hslot - dsimp [updated] at hslotRaw - have hF : plan.fieldLocal < updated.length := by - simp [updated] - simpa [Nat.add_comm] using hfieldScratch - change outValue (wRunF host (fun g => (code g).map (·.arity)) - (fun g as => wFuncN code host fuel g as) - (AverCert.PlanLower.lowerVerbatimBody plan) - ([v] ++ List.replicate nlocals .null) []) = some w at hrun - dsimp [AverCert.PlanLower.lowerVerbatimBody] at hrun - simp only [wRunF, hslotRaw] at hrun - have hsim := simNodes_verbatim host (fun g => (code g).map (·.arity)) - (fun g as => wFuncN code host fuel g as) - plan.scrutineeLocal plan.fieldLocal - updated v hslot hF ty hit rest w - have hrun' : outValue (wRunF host (fun g => (code g).map (·.arity)) - (fun g as => wFuncN code host fuel g as) - (AverCert.PlanLower.lowerDispatch plan.scrutineeLocal plan.fieldLocal true - (.test ty hit rest)) updated [v]) = some w := by - simpa [hroot, updated, wRunF, hslotRaw] using hrun - have hmodel := hsim hrun' - simpa [verbatimModel, hroot] using hmodel - -/-- Checked generic certificate for the full admitted verbatim family. -/ -theorem generic_verbatim_certified - (plan : VerbatimRawPlan) (code : CodeTbl) (host : HostTbl) - (self nlocals : Nat) - (hcheck : AverCert.PlanCheck.checkVerbatimPlan nlocals plan = true) - (hself : code self = some - { arity := 1, nlocals := nlocals, - body := AverCert.PlanLower.lowerVerbatimBody plan }) : - ∀ fuel v w, - wFuncN code host (fuel + 1) self [v] = some w → - w = verbatimModel plan v := by - cases hbody : plan.body with - | leaf leaf => - simp [AverCert.PlanCheck.checkVerbatimPlan, hbody] at hcheck - | test ty hit rest => - have hall := hcheck - simp [AverCert.PlanCheck.checkVerbatimPlan, hbody] at hall - exact generic_verbatim_shape_certified plan code host self nlocals - hall.1.1 ⟨ty, hit, rest, hbody⟩ hall.1.2 hall.2 hself - -end ConstructVerbatimSoundness diff --git a/aver-cert/assets/wall/current/DeclaredEnvelopeAcceptTransport.lean b/aver-cert/assets/wall/current/DeclaredEnvelopeAcceptTransport.lean deleted file mode 100644 index 19df256c5..000000000 --- a/aver-cert/assets/wall/current/DeclaredEnvelopeAcceptTransport.lean +++ /dev/null @@ -1,289 +0,0 @@ -/- -The HEq transport that carries the declared-index envelope bridges -(`DeclaredIndexEnvelope.env_declaredIntDispatch_bridge` and -`env_declaredConstruct_bridge`) from their canonical statements over -`(DAdtVal env, dEnvDomRepr env, dEnvStructModel …, intRepr …)` / -`(Int, intArgDomRepr …, dEnvCtorModel …, dEnvCodRepr …)` onto the -acceptance-soundness obligation fields `o.Dom / o.domRepr / o.model / o.codRepr`. - -Same discipline as `EnvelopeAcceptTransport`: the field values are supplied as -ordinary universally quantified variables (not `o.field` projections) so that -`subst` applies once each pin is turned into an `Eq`; the `HEq`s become `Eq`s -via `eq_of_heq` after `o.carrier` / `o.Dom` / `o.Cod` are substituted, and no -cast residue survives. The obligation-level corollaries then apply the cores to -`o.carrier`, `o.Dom`, … directly, producing exactly the residual bodies of -`AcceptanceSoundness.intDispatchSemanticBridge` and `constructSemanticBridge`. - -The `o.policy = .simulatesModel` conjunct is carried by the face itself -(`DIdxIntReadFace` supplies it as a separate hypothesis; `DIdxCtorFace` includes -it), which is what makes the FULL semantic bridge — policy conjunct included — -derivable. - -Self-verified `#print axioms` at the foot of the file: `[propext]`. --/ -import DeclaredIndexEnvelope -import StringSoundness - -set_option maxRecDepth 1000000 -set_option maxHeartbeats 4000000 - -namespace AverCert.DeclaredIndexEnvelope - -open AverCert.Schema -open CertPrelude - -/-! ## §1 The Int-dispatch transport -/ - -/-- The dependent-cast core for the Int-read column: with the field values as - free variables and the face's pins as `Eq`/`HEq`, the residual - `intDispatchSemanticBridge` body over those fields is exactly - `env_declaredIntDispatch_bridge`. -/ -theorem env_declaredIntDispatch_bridge_transport - (env : DIdxEnvelope) (plan : IntDispatchRawPlan) - (hcasc : dCascadeInEnv env plan.body = true) - (carrier : Nat) (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hcar : carrier = env.carrier) - (hDom : HEq Dom (DAdtVal env)) - (hCod : HEq Cod Int) - (hdomRepr : HEq domRepr (dEnvDomRepr env)) - (hcodRepr : HEq codRepr (@AverCert.Schema.intRepr env.carrier)) - (hmodel : HEq model (dEnvStructModel env plan.body)) : - ∀ (S : CarrierSpec carrier) (x : Dom) (vs : List WVal), - domRepr S x vs → - ∃ tag fields n, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S plan.body tag fields n ∧ - ∀ w, S.Repr n w → codRepr S (model x) w := by - subst hcar - have hDomEq : Dom = DAdtVal env := eq_of_heq hDom - subst hDomEq - have hCodEq : Cod = Int := eq_of_heq hCod - subst hCodEq - have hdomReprEq : domRepr = dEnvDomRepr env := eq_of_heq hdomRepr - subst hdomReprEq - have hcodReprEq : codRepr = @AverCert.Schema.intRepr env.carrier := - eq_of_heq hcodRepr - subst hcodReprEq - have hmodelEq : model = dEnvStructModel env plan.body := eq_of_heq hmodel - subst hmodelEq - intro S x vs hdom - exact env_declaredIntDispatch_bridge env plan hcasc S x vs hdom - -/-- Obligation-level corollary for the Int-read column: the declared-index face - (`DIdxIntReadFace`) plus `o.policy = .simulatesModel` yields the FULL - residual `intDispatchSemanticBridge` body over the real `Obligation` - projections — the policy conjunct AND the represented model agreement. -/ -theorem face_gives_declaredIntDispatch_bridge - (modBytes modLen : Nat) (typePrefix : List Nat) - (env : DIdxEnvelope) (plan : IntDispatchRawPlan) (o : Obligation) - (hface : DIdxIntReadFace modBytes modLen typePrefix env plan o) - (hpolicy : o.policy = .simulatesModel) : - o.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec o.carrier) (x : o.Dom) (vs : List WVal), - o.domRepr S x vs → - ∃ tag fields n, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S plan.body tag fields n ∧ - ∀ w, S.Repr n w → o.codRepr S (o.model x) w := by - obtain ⟨-, hcasc, -, hcar, hDom, hCod, hdomRepr, hcodRepr, hmodel⟩ := hface - refine ⟨hpolicy, ?_⟩ - exact env_declaredIntDispatch_bridge_transport env plan hcasc - o.carrier o.Dom o.Cod o.domRepr o.codRepr o.model - hcar hDom hCod hdomRepr hcodRepr hmodel - -/-! ## §2 The constructor transport -/ - -/-- The dependent-cast core for the constructor column: with the field values as - free variables and the face's pins as `Eq`/`HEq`, the residual - `constructSemanticBridge` body over those fields is exactly - `env_declaredConstruct_bridge`. -/ -theorem env_declaredConstruct_bridge_transport - (env : DIdxEnvelope) (structIdx : Nat) - (hhit : dCtorShape? env structIdx = some .hit) - (plan : ConstructRawPlan) - (harity : plan.arity = 1) (hfields : plan.fields = [.local 0]) - (carrier : Nat) (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hcar : carrier = env.carrier) - (hDom : HEq Dom Int) - (hCod : HEq Cod (DAdtVal env)) - (hdomRepr : HEq domRepr (AverCert.EnvelopeLowering.intArgDomRepr env.carrier)) - (hcodRepr : HEq codRepr (dEnvCodRepr env)) - (hmodel : HEq model (dEnvCtorModel env structIdx hhit)) : - ∀ (S : CarrierSpec carrier) (x : Dom) (args : List WVal), - domRepr S x args → - args.length = plan.arity ∧ - codRepr S (model x) - (.structv structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields)) := by - subst hcar - have hDomEq : Dom = Int := eq_of_heq hDom - subst hDomEq - have hCodEq : Cod = DAdtVal env := eq_of_heq hCod - subst hCodEq - have hdomReprEq : domRepr = AverCert.EnvelopeLowering.intArgDomRepr env.carrier := - eq_of_heq hdomRepr - subst hdomReprEq - have hcodReprEq : codRepr = dEnvCodRepr env := eq_of_heq hcodRepr - subst hcodReprEq - have hmodelEq : model = dEnvCtorModel env structIdx hhit := eq_of_heq hmodel - subst hmodelEq - intro S x args hdom - exact env_declaredConstruct_bridge env structIdx hhit plan harity hfields - S x args hdom - -/-- Obligation-level corollary for the constructor column: the declared-index - constructor face (`DIdxCtorFace`, whose `o.policy = .simulatesModel` conjunct - is included) yields the FULL residual `constructSemanticBridge` body over the - real `Obligation` projections. -/ -theorem face_gives_declaredConstruct_bridge - (modBytes modLen : Nat) (typePrefix : List Nat) - (env : DIdxEnvelope) (structIdx : Nat) - (hhit : dCtorShape? env structIdx = some .hit) - (plan : ConstructRawPlan) (o : Obligation) - (hface : DIdxCtorFace modBytes modLen typePrefix env structIdx hhit plan o) : - o.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec o.carrier) (x : o.Dom) (args : List WVal), - o.domRepr S x args → - args.length = plan.arity ∧ - o.codRepr S (o.model x) - (.structv structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields)) := by - obtain ⟨-, harity, hfields, -, hpolicy, hcar, hDom, hCod, hdomRepr, - hcodRepr, hmodel⟩ := hface - refine ⟨hpolicy, ?_⟩ - exact env_declaredConstruct_bridge_transport env structIdx hhit plan harity hfields - o.carrier o.Dom o.Cod o.domRepr o.codRepr o.model - hcar hDom hCod hdomRepr hcodRepr hmodel - -#print axioms env_declaredIntDispatch_bridge_transport -#print axioms face_gives_declaredIntDispatch_bridge -#print axioms env_declaredConstruct_bridge_transport -#print axioms face_gives_declaredConstruct_bridge - -/-! ## §3 The string-concat transport (finishing the Lean core) - -The String.concat column uses this transport only for semantic-face fields. The -model terms are exactly the canonical string obligation's (`DischargeString`): the -domain is the single input `WVal`, `domRepr` is `vs = [v]`, `codRepr` is -`verbatimRepr` (`w = v`), and the model is the plan's `evalStringConcat`. The -face pins those onto `o.Dom / o.domRepr / o.codRepr / o.model` plus -`o.policy = .simulatesModel`. The String.concat ABI/type-section pins live in -`AcceptedArtifact.stringConcatPlanAccepted`, where they are checked against the -real exported binding and helper function; this face deliberately carries no -synthetic declared-envelope byte pin. -/ - -/-- Canonical string-concat domain representation: the single input `WVal`. -/ -def dStrConcatDomRepr (carrier : Nat) : CarrierSpec carrier → WVal → List WVal → Prop := - fun _ v vs => vs = [v] - -/-- Canonical string-concat codomain representation: `verbatimRepr` (`w = v`). -/ -def dStrConcatCodRepr (carrier : Nat) : CarrierSpec carrier → WVal → WVal → Prop := - fun S v w => verbatimRepr S v w - -/-- Canonical string-concat model: the plan's `evalStringConcat` over the single - input, with the declared result / container element type indices. -/ -def dStrConcatModel (resultTy containerTy : Nat) (plan : StringConcatRawPlan) : - WVal → WVal := - fun v => StringSoundness.evalStringConcat resultTy containerTy plan v - -/-- The positive string-concat bridge: on the single-input representation, the - model output is represented (verbatim) by exactly the plan's - `evalStringConcat` of that input. -/ -theorem dStringConcat_bridge (carrier resultTy containerTy : Nat) - (plan : StringConcatRawPlan) - (S : CarrierSpec carrier) (x : WVal) (vs : List WVal) - (hdom : dStrConcatDomRepr carrier S x vs) : - ∃ v, vs = [v] ∧ - dStrConcatCodRepr carrier S (dStrConcatModel resultTy containerTy plan x) - (StringSoundness.evalStringConcat resultTy containerTy plan v) := by - refine ⟨x, hdom, ?_⟩ - simp only [dStrConcatCodRepr, dStrConcatModel, verbatimRepr] - -/-- The String.concat semantic face. It intentionally does NOT carry a - `concatPinnedAt (declaredConcat …)` conjunct: String.concat has no declared - ADT envelope, and the previous empty envelope made that byte pin vacuous. - ABI/type-section checks are separate byte-derived acceptance conjuncts. -/ -def DIdxStringConcatFace - (_modBytes _modLen : Nat) (_typePrefix : List Nat) - (env : DIdxEnvelope) (resultTy containerTy : Nat) - (plan : StringConcatRawPlan) (o : Obligation) : Prop := - o.policy = .simulatesModel ∧ - o.carrier = env.carrier ∧ - HEq o.Dom WVal ∧ - HEq o.Cod WVal ∧ - HEq o.domRepr (dStrConcatDomRepr env.carrier) ∧ - HEq o.codRepr (dStrConcatCodRepr env.carrier) ∧ - HEq o.model (dStrConcatModel resultTy containerTy plan) - -/-- The dependent-cast core for the string-concat column: with the field values - as free variables and the face's pins as `Eq`/`HEq`, the residual - `stringConcatSemanticBridge` body over those fields is exactly - `dStringConcat_bridge`. -/ -theorem dStringConcat_bridge_transport - (env : DIdxEnvelope) (resultTy containerTy : Nat) (plan : StringConcatRawPlan) - (carrier : Nat) (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hcar : carrier = env.carrier) - (hDom : HEq Dom WVal) (hCod : HEq Cod WVal) - (hdomRepr : HEq domRepr (dStrConcatDomRepr env.carrier)) - (hcodRepr : HEq codRepr (dStrConcatCodRepr env.carrier)) - (hmodel : HEq model (dStrConcatModel resultTy containerTy plan)) : - ∀ (S : CarrierSpec carrier) (x : Dom) (vs : List WVal), - domRepr S x vs → - ∃ v, vs = [v] ∧ - codRepr S (model x) - (StringSoundness.evalStringConcat resultTy containerTy plan v) := by - subst hcar - have hDomEq : Dom = WVal := eq_of_heq hDom - subst hDomEq - have hCodEq : Cod = WVal := eq_of_heq hCod - subst hCodEq - have e1 : domRepr = dStrConcatDomRepr env.carrier := eq_of_heq hdomRepr - subst e1 - have e2 : codRepr = dStrConcatCodRepr env.carrier := eq_of_heq hcodRepr - subst e2 - have e3 : model = dStrConcatModel resultTy containerTy plan := eq_of_heq hmodel - subst e3 - intro S x vs hdom - exact dStringConcat_bridge env.carrier resultTy containerTy plan S x vs hdom - -/-- Obligation-level corollary for the string-concat column: the declared-index - string-concat face yields the FULL residual `stringConcatSemanticBridge` body - over the real `Obligation` projections — the policy conjunct AND the - represented-model agreement against `evalStringConcat`. This is the body - `AcceptanceSoundness.stringConcatSemanticBridge` is defined as, with - `claim.obligation := o`, `claim.resultTy := resultTy`, - `claim.containerTy := containerTy`. -/ -theorem face_gives_declaredStringConcat_bridge - (modBytes modLen : Nat) (typePrefix : List Nat) - (env : DIdxEnvelope) (resultTy containerTy : Nat) - (plan : StringConcatRawPlan) (o : Obligation) - (hface : DIdxStringConcatFace modBytes modLen typePrefix env resultTy - containerTy plan o) : - o.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec o.carrier) (x : o.Dom) (vs : List WVal), - o.domRepr S x vs → - ∃ v, vs = [v] ∧ - o.codRepr S (o.model x) - (StringSoundness.evalStringConcat resultTy containerTy plan v) := by - obtain ⟨hpolicy, hcar, hDom, hCod, hdomRepr, hcodRepr, hmodel⟩ := hface - refine ⟨hpolicy, ?_⟩ - exact dStringConcat_bridge_transport env resultTy containerTy plan - o.carrier o.Dom o.Cod o.domRepr o.codRepr o.model - hcar hDom hCod hdomRepr hcodRepr hmodel - -#print axioms dStringConcat_bridge -#print axioms dStringConcat_bridge_transport -#print axioms face_gives_declaredStringConcat_bridge - -end AverCert.DeclaredIndexEnvelope diff --git a/aver-cert/assets/wall/current/DeclaredIndexEnvelope.lean b/aver-cert/assets/wall/current/DeclaredIndexEnvelope.lean deleted file mode 100644 index b28d65781..000000000 --- a/aver-cert/assets/wall/current/DeclaredIndexEnvelope.lean +++ /dev/null @@ -1,594 +0,0 @@ -/- -Declared-index envelope lowering (real shared-rec-group modules). - -`EnvelopeLowering` / `WidenedEnvelope` derive every non-root type index -ARITHMETICALLY: `carrier = root + ctors.length + 3`, string array `root + len + 1`, -and so on, and model each ADT as living in its OWN rec group. That is exactly the -shape the SYNTHETIC `synthMod` test modules had. It is WRONG for the modules the -real compiler emits: `aver compile --target wasm-gc` puts ALL ADTs of a module -PLUS the shared `List`/`Map` cons structs and the Int carrier into ONE rec group, -with compiler-assigned type indices and source-order constructor positions. In -`examples/data/json.av` the `Json` ADT's Int carrier sits at type index 21, its -string byte-array at 19, its `List` cons at 27, its `Map` struct at 38 — none of -which equals `root + len + 3 = 10` (index 10 is in fact the *other* ADT's -`ParseResult.Err`). - -This module stops COMPUTING those indices. It DECLARES them — the carrier index, -each constructor's flattened type index, and each non-Int payload target index — -as OPAQUE `Nat` fields pulled up from the bytes, and pins each constructor's -synthesized struct-body AT ITS DECLARED INDEX in the REAL module. The struct-body -bytes are still SYNTHESIZED from the plan (they already byte-match the compiler); -the only residue lifted from the bytes are those opaque indices. Source order and -multiple-ADTs-per-module are then non-problems: each constructor is pinned wherever -it actually sits, navigated to by a cursor that descends into the shared rec group -and DISCARDS every value it parses. - -There is NO byte -> structure decoder: `dEnvDomRepr` / `dEnvStructModel` are -computed FROM THE PLAN; the cursor only advances, never yields a parsed type. --/ -import WidenedEnvelope -import IntDispatchSoundness -import ConstructVerbatimSoundness - -set_option maxRecDepth 1000000 -set_option maxHeartbeats 4000000 - -namespace AverCert.DeclaredIndexEnvelope - -open AverCert.Schema -open CertPrelude -open AverCert.WidenedEnvelope (WCtor WPayload) -open AverCert.EnvelopeLowering (cascadeEval takeBytes_take) - -/-! ## §0 The type-section START cursor, and the single concat pin - -The previous revision navigated to each constructor's flattened index with a -fuel loop (`entryStep`) that called `CertDecode.readTypeEntry` on every preceding -entry to COUNT positions. That put a per-entry byte-structure parser in the -trusted confirmation path: a `readTypeEntry` length mistake would land the cursor -at a wrong position and the pin would confirm a wrong body at a wrong index. - -That parser is now GONE. The only byte navigation that remains is locating the -type section's entry region — `modulePayload 1` (section framing) followed by -`readU` (skip the vector count LEB). Neither descends into the entry bytes; both -are fixed section-framing locates. Positions are no longer walked out of the -bytes: they are DECLARED (see `declaredConcat`) and CONFIRMED by one byte-slice -equality against the located start. -/ - -/-- Cursor at the FIRST type-section entry: the section payload located by - `modulePayload 1`, advanced past the vector count `readU` reads. No entry is - parsed; this is the type-section-framing locate and nothing more. -/ -def typeSectionCursor (modBytes modLen : Nat) : Option (Nat × Nat) := - match CertDecode.modulePayload 1 modBytes modLen with - | none => none - | some (tN, tLen) => - match CertDecode.readU tN tLen with - | none => none - | some (_count, n1, len1) => some (n1, len1) - -/-- The module's type-section entry bytes, taken from the located start, are - EXACTLY `expected`. A single byte-slice equality over the whole declared - prefix of the type section — not a per-entry walk. Because `expected` is a - concatenation of DECLARED chunks (§2 `declaredConcat`), this one equality - fixes every declared byte, hence every declared position, by construction. -/ -def concatPinnedAt (modBytes modLen : Nat) (expected : List Nat) : Prop := - ∃ cur : Nat × Nat, - typeSectionCursor modBytes modLen = some cur ∧ - expected.length ≤ cur.2 ∧ - CertDecode.takeBytes expected.length cur.1 = expected - -/-! ## §1 The declared-index envelope - -Every index is DECLARED, not computed. `DCtor.idx` is the constructor's flattened -type index (its source-order position in the shared group); `DCtor.target` is the -declared payload TARGET index the constructor's ref field points at (the carrier -for `hit`, the string array for `strBox`, the `List` cons for `listBox`, the `Map` -struct for `mapBox`; unused by the payloadless / scalar shapes). `root` and -`carrier` are the two remaining declared indices. -/ - -structure DCtor where - idx : Nat - shape : WCtor - target : Nat -deriving Repr, DecidableEq - -structure DIdxEnvelope where - root : Nat - carrier : Nat - ctors : List DCtor -deriving Repr, DecidableEq - -/-! ## §2 Canonical byte LOWERING of one declared constructor (meaning -> bytes) - -Mirrors `src/codegen/wasm_gc/module.rs`: each constructor is one -`(sub_final [root] struct{…})` entry. The struct body is a function of the shape -and the declared target index. The ref shapes (`hit`/`strBox`/`listBox`/`mapBox`) -share the `struct{(ref null target)}` body and differ ONLY in which declared index -`target` names; the scalar/unit shapes ignore `target`. -/ - -def dCtorBody (root : Nat) (c : DCtor) : List Nat := - 0x4f :: 0x01 :: root :: - (match c.shape with - | .hit => [0x5f, 0x01, 0x63, c.target, 0x00] - | .strBox => [0x5f, 0x01, 0x63, c.target, 0x00] - | .listBox => [0x5f, 0x01, 0x63, c.target, 0x00] - | .mapBox => [0x5f, 0x01, 0x63, c.target, 0x00] - | .floatBox => [0x5f, 0x01, 0x7c, 0x00] - | .boolBox => [0x5f, 0x01, 0x7f, 0x00] - | .unit => [0x5f, 0x00]) - -/-- The DECLARED type-section prefix as one ordered byte list: an opaque declared - chunk (`typePrefix` — the rec-group header and every entry BEFORE the ADT's - constructors: other ADTs, `List`/`Map` cons structs, the prelude, function - signatures, all named as literal bytes), followed by the ADT's constructor - entries SYNTHESIZED from meaning in source order (`dCtorBody`). Every position - is fixed by construction: constructor `k`'s flattened index is the number of - entries before it, and its byte offset is `typePrefix.length` plus the summed - lengths of the earlier constructor bodies. No byte is read to compute either. -/ -def declaredConcat (typePrefix : List Nat) (env : DIdxEnvelope) : List Nat := - typePrefix ++ (env.ctors.map (dCtorBody env.root)).flatten - -/-- Declared shape at a flattened index (fail-closed): the constructor whose - declared `idx` equals `tag`. On its own the label lookup would be FREE — - `dCtorBody` never reads `c.idx` and `declaredConcat` lays bodies by list - order, so permuting labels is invisible to a body-only byte pin. The unified - walk (§2c) is what makes the label DERIVED from byte position: the ctor at - counted position `tag` is the one whose body the walk fixes at that position - by equality, so `dCtorShape? env tag` can only resolve `tag` to a shape the - real entry at type index `tag` actually carries. -/ -def dCtorShape? (env : DIdxEnvelope) (tag : Nat) : Option WCtor := - (env.ctors.find? (fun c => decide (c.idx = tag))).map (fun c => c.shape) - -/-! ## §2c The UNIFIED walk-match pin (position by counting, content by equality) - -ONE single-pass traversal of the type section replaces the former split of a -whole-prefix concat equality plus a separate entry-count walk. Entry by entry, -starting at flattened index 0, the walk: - -* skips a rec-group header (`0x4e` + single-byte member count) WITHOUT counting - — group boundaries do not contribute a flattened index; -* at a position where a constructor is DECLARED (`idx = current count`), confirms - the entry bytes EQUAL that constructor's declared template `dCtorBody` and - advances by the TEMPLATE's length — the length comes from the DECLARATION, and - the bytes are matched by equality, never read for meaning; -* at every other (undeclared) position, NAVIGATES one entry by its REAL byte - length via the WebAssembly type-entry grammar and counts it — the navigator - yields only the advanced cursor (a position), never a surfaced shape. - -Both jobs — assigning each entry its flattened index by counting, and confirming -each declared constructor's body at its declared index by equality — are done in -this ONE traversal. The only primitives are length-advance (`bEntryStep`, -`takeBytes`-length) and equality (`takeBytes … = template`); there is no -shape-to-meaning decoder. It also drops the contiguity assumption of -`declaredConcat` (`prefix ++ bodies.flatten`): declared constructors may be -separated by unrelated navigated entries and still be pinned at their true -indices, because position is counted, not assumed. A relabelled (idx-swapped) -constructor fails because the walk matches its template at the position its label -names, and the real bytes there are a different entry — the equality breaks. -/ - -/-- Peel one byte off the little-endian cursor `(n, len)`; fail-closed at the - end of the bounded region. -/ -@[inline] def dpByte : Nat × Nat → Option (Nat × (Nat × Nat)) - | (n, len) => if len = 0 then none else some (n &&& 0xff, (n >>> 8, len - 1)) - -/-- Navigate one single-byte (`< 0x80`) LEB index over the cursor. -/ -def bIdxByte : Nat × Nat → Option (Nat × Nat) - | (n, len) => if len = 0 then none - else if (n &&& 0xff) < 0x80 then some (n >>> 8, len - 1) else none - -/-- Navigate one value/storage type: a one-byte code (numeric, packed, or - abstract-ref shorthand `0x65..0x7f`) or a `(ref …)`/`(ref null …)` prefix - (`0x63`/`0x64`) followed by a single-byte heap type. Fail-closed otherwise. -/ -def bValStep : Nat × Nat → Option (Nat × Nat) - | (n, len) => if len = 0 then none else - let b := n &&& 0xff - if b = 0x63 ∨ b = 0x64 then bIdxByte (n >>> 8, len - 1) - else if 0x65 ≤ b ∧ b ≤ 0x7f then some (n >>> 8, len - 1) - else none - -/-- Navigate one field type: a storage type then a mutability byte. -/ -def bFieldStep (c : Nat × Nat) : Option (Nat × Nat) := - match bValStep c with - | some (n, len) => if len = 0 then none else - let m := n &&& 0xff - if m = 0x00 ∨ m = 0x01 then some (n >>> 8, len - 1) else none - | none => none - -/-- Navigate `k` items with `step`. -/ -def bSteps (step : Nat × Nat → Option (Nat × Nat)) : Nat → Nat × Nat → Option (Nat × Nat) - | 0, c => some c - | k + 1, c => (step c).bind (bSteps step k) - -/-- Navigate one composite type: `struct` (`0x5f` + field vector), `array` - (`0x5e` + one field), or `func` (`0x60` + param vector + result vector). - Vector counts must be single-byte LEBs; fail-closed otherwise. -/ -def bCompStep : Nat × Nat → Option (Nat × Nat) - | (n, len) => if len = 0 then none else - let b := n &&& 0xff - let c1 := (n >>> 8, len - 1) - if b = 0x5f then - match dpByte c1 with - | some (nf, c2) => if nf < 0x80 then bSteps bFieldStep nf c2 else none - | none => none - else if b = 0x5e then bFieldStep c1 - else if b = 0x60 then - match dpByte c1 with - | some (np, c2) => - if np < 0x80 then - match bSteps bValStep np c2 with - | some c3 => - match dpByte c3 with - | some (nr, c4) => if nr < 0x80 then bSteps bValStep nr c4 else none - | none => none - | none => none - else none - | none => none - else none - -/-- Navigate one complete type entry: a `sub` / `sub final` header - (`0x50`/`0x4f` + single-byte supertype vector) followed by a composite type, - or a bare composite type. Returns only the advanced cursor. -/ -def bEntryStep : Nat × Nat → Option (Nat × Nat) - | (n, len) => if len = 0 then none else - let b := n &&& 0xff - let c1 := (n >>> 8, len - 1) - if b = 0x50 ∨ b = 0x4f then - match dpByte c1 with - | some (m, c2) => if m < 0x80 then (bSteps bIdxByte m c2).bind bCompStep else none - | none => none - else bCompStep (n, len) - -/-- The single-pass walk-match. `fuel` bounds the traversal, `idx` is the running - flattened index, `(n, len)` the cursor. Succeeds once every declared - constructor has been passed (each matched at its own index along the way). -/ -def dWalkFuel (root : Nat) (ctors : List DCtor) : Nat → Nat → Nat × Nat → Bool - | 0, _, _ => false - | fuel + 1, idx, (n, len) => - if ctors.all (fun c => decide (c.idx < idx)) then true - else if len = 0 then false - else - let b := n &&& 0xff - if b = 0x4e then - -- rec-group header: consume `0x4e` + single-byte member count, no count - if decide (2 ≤ len) && decide (((n >>> 8) &&& 0xff) < 0x80) then - dWalkFuel root ctors fuel idx (n >>> 16, len - 2) - else false - else - match ctors.find? (fun c => decide (c.idx = idx)) with - | some c => - let tmpl := dCtorBody root c - if decide (tmpl.length ≤ len) && (CertDecode.takeBytes tmpl.length n == tmpl) then - dWalkFuel root ctors fuel (idx + 1) (n >>> (8 * tmpl.length), len - tmpl.length) - else false - | none => - match bEntryStep (n, len) with - | some c' => dWalkFuel root ctors fuel (idx + 1) c' - | none => false - -/-- THE PIN: from the located type-section start, the unified walk succeeds. One - traversal both counts positions and confirms every declared constructor's - body at its declared index by equality — replacing `concatPinnedAt - (declaredConcat …)` and any separate index-alignment walk. -/ -def dWalkPinned (modBytes modLen : Nat) (env : DIdxEnvelope) : Prop := - ∃ cur : Nat × Nat, - typeSectionCursor modBytes modLen = some cur ∧ - dWalkFuel env.root env.ctors (cur.2 + 1) 0 cur = true - -/-- Profile checker, fail-closed. Single-byte index regime (`< 64`, covering the - real fixtures whose largest declared index is the `Map` struct at 38), at - least one constructor, and — crucially — the declared `carrier` is the target - of every `hit` constructor, so the Int-box read index and the pinned hit body - name the SAME index. -/ -def checkDIdxEnvelope (env : DIdxEnvelope) : Bool := - decide (1 ≤ env.ctors.length) && - decide (env.carrier < 64) && decide (env.root < 64) && - env.ctors.all (fun c => - decide (c.idx < 64) && decide (c.target < 64) && - (if c.shape == WCtor.hit then decide (c.target = env.carrier) else true)) - -/-! ## §3 Wall-owned meaning terms over the PLAN (no decode output) - -Identical discipline to `WidenedEnvelope`, but the carrier index is the DECLARED -`env.carrier`, not `wCarrierIdx`. A payload-BINDING (`proj`/`hostOp`) arm reads the -`hit` constructor's Int payload; a `const` arm reads NO field and returns its -constant regardless of the (possibly absent) payload, so it is sound at any -declared constructor — including a nullary (`unit`) one. `dCascadeEval` is the -declared-face model that gives a matched `const` arm its constant directly; a -non-hit payload under a BINDING arm is excluded by `dCascadeInEnv`. -/ - -def DEnvValidChild (env : DIdxEnvelope) (tag : Nat) (p : WPayload) : Prop := - (dCtorShape? env tag = some .hit ∧ ∃ n, p = .int n) ∨ - (∃ c, dCtorShape? env tag = some c ∧ c ≠ .hit ∧ ∃ fs, p = .opaqueFields fs) - -def DAdtVal (env : DIdxEnvelope) : Type := - { q : Nat × WPayload // DEnvValidChild env q.1 q.2 } - -def dEnvDomRepr (env : DIdxEnvelope) : - CarrierSpec env.carrier → DAdtVal env → List WVal → Prop := - fun S x vs => - match x.1.2 with - | .int n => ∃ v, vs = [.structv x.1.1 [v]] ∧ S.Repr n v - | .opaqueFields fs => vs = [.structv x.1.1 fs] - -/-- Declared-face cascade model. Like `EnvelopeLowering.cascadeEval` but a matched - `const` arm returns its constant WITHOUT consulting the payload: without this, - a nullary value (`payload = none`) would send every arm through `none.map _` - to the wrong `getD 0 = 0`. Kept separate from the shared `cascadeEval` so the - narrow/widened bridges (which never carry a `const` arm) are untouched. -/ -def dCascadeEval : IntDispatchCascade → Nat → Option Int → Option Int - | .default k, _, _ => some k - | .test tyIdx leaf rest, tag, payload => - if tag = tyIdx then - (match leaf with - | .const k => some k - | _ => payload.map (IntDispatchSoundness.evalLeaf leaf)) - else dCascadeEval rest tag payload - -def dEnvStructModel (env : DIdxEnvelope) (body : IntDispatchCascade) : - DAdtVal env → Int := - fun x => (dCascadeEval body x.1.1 x.1.2.toInt?).getD 0 - -/-- Plan-INTERNAL declared-envelope consistency, LEAF-AWARE. A payload-BINDING - (`proj`/`hostOp`) arm projects the tested variant's field, so its tag must be a - declared `hit` (Int-payload) constructor. A `const` arm reads no field, so its - tag need only be a DECLARED constructor of any shape (a nullary `unit` is - fine). A uniform `= some .hit` would wrongly reject the nullary const arms; a - uniform `.isSome` would be UNSOUND for a binding arm (it could project an - opaque non-Int payload). -/ -def dCascadeInEnv (env : DIdxEnvelope) : IntDispatchCascade → Bool - | .default _ => true - | .test tyIdx leaf rest => - (match leaf with - | .const _ => (dCtorShape? env tyIdx).isSome - | .proj => decide (dCtorShape? env tyIdx = some .hit) - | .hostOp _ _ _ => decide (dCtorShape? env tyIdx = some .hit)) && - dCascadeInEnv env rest - -/-! ## §4 The declared-index Int-read face - -The pin is now ONE byte-slice equality over the whole declared type-section -prefix (`concatPinnedAt … (declaredConcat typePrefix env)`), replacing the former -per-constructor walked pin. Every declared byte — `env.root`, each `c.target`, and -the exact source-order placement of every synthesized constructor body — sits -inside that single `expected` list, so the equality against the real bytes fixes -all of them at once. `env.carrier` equals every hit `c.target` by the checker, -and each hit `c.target` byte lives inside the pinned concat, so the carrier index -is confirmed by byte equality, not chosen. No `readTypeEntry` walk participates. -/ - -def DIdxIntReadFace - (modBytes modLen : Nat) (_typePrefix : List Nat) - (env : DIdxEnvelope) (plan : IntDispatchRawPlan) (o : Obligation) : Prop := - checkDIdxEnvelope env = true ∧ - dCascadeInEnv env plan.body = true ∧ - dWalkPinned modBytes modLen env ∧ - o.carrier = env.carrier ∧ - HEq o.Dom (DAdtVal env) ∧ - HEq o.Cod Int ∧ - HEq o.domRepr (dEnvDomRepr env) ∧ - HEq o.codRepr (@AverCert.Schema.intRepr env.carrier) ∧ - HEq o.model (dEnvStructModel env plan.body) - -/-! ## §5 The positive bridge (BINDING arms read hit, CONST arms read nothing) - -On any represented declared value the byte-origin `EvalCascade` relates it to -exactly the plan-computed `dCascadeEval` result. A matched `const` arm relates by -`constHit` (reads no field, sound for a nullary value); a matched BINDING arm -relates by `hit` (its tag is `hit`, so the value carries the readable Int payload); -a non-matched tag recurses through `miss` regardless of leaf shape. Mirrors -`WidenedEnvelope.wCascade_bridge` over the declared carrier, extended with `const`. -/ - -theorem dCascade_bridge (env : DIdxEnvelope) (body : IntDispatchCascade) - (hcasc : dCascadeInEnv env body = true) - (S : CarrierSpec env.carrier) (x : DAdtVal env) (vs : List WVal) - (hdom : dEnvDomRepr env S x vs) : - ∃ tag fields, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S body tag fields - ((dCascadeEval body x.1.1 x.1.2.toInt?).getD 0) := by - induction body with - | default k => - refine ⟨x.1.1, ?_⟩ - unfold dEnvDomRepr at hdom - cases hpay : x.1.2 with - | int m => - rw [hpay] at hdom - obtain ⟨v, hvs, _hrepr⟩ := hdom - refine ⟨[v], hvs, ?_⟩ - simp only [dCascadeEval, Option.getD] - exact IntDispatchSoundness.EvalCascade.default k x.1.1 [v] - | opaqueFields fs => - rw [hpay] at hdom - refine ⟨fs, hdom, ?_⟩ - simp only [dCascadeEval, Option.getD] - exact IntDispatchSoundness.EvalCascade.default k x.1.1 fs - | test tyIdx leaf rest ih => - simp only [dCascadeInEnv, Bool.and_eq_true] at hcasc - obtain ⟨hleaf, hrest⟩ := hcasc - by_cases htag : x.1.1 = tyIdx - · -- matched tag: split on the leaf shape - cases leaf with - | const kk => - -- const arm: reads no field, sound at any declared shape - unfold dEnvDomRepr at hdom - cases hpay : x.1.2 with - | int m => - rw [hpay] at hdom - obtain ⟨v, hvs, _hrepr⟩ := hdom - refine ⟨tyIdx, [v], by rw [← htag]; exact hvs, ?_⟩ - have hce : (dCascadeEval (.test tyIdx (.const kk) rest) - x.1.1 (WPayload.int m).toInt?).getD 0 = kk := by - rw [htag]; simp [dCascadeEval] - rw [hce] - exact IntDispatchSoundness.EvalCascade.constHit tyIdx kk rest [v] - | opaqueFields fs => - rw [hpay] at hdom - refine ⟨tyIdx, fs, by rw [← htag]; exact hdom, ?_⟩ - have hce : (dCascadeEval (.test tyIdx (.const kk) rest) - x.1.1 (WPayload.opaqueFields fs).toInt?).getD 0 = kk := by - rw [htag]; simp [dCascadeEval] - rw [hce] - exact IntDispatchSoundness.EvalCascade.constHit tyIdx kk rest fs - | proj => - have hpayTy : dCtorShape? env tyIdx = some .hit := by - simpa using hleaf - have hchild := x.2 - unfold DEnvValidChild at hchild - rw [htag] at hchild - rcases hchild with ⟨_, m, hm⟩ | ⟨c, hcshape, hcne, _⟩ - · unfold dEnvDomRepr at hdom - rw [hm] at hdom - obtain ⟨v, hvs, hrepr⟩ := hdom - refine ⟨tyIdx, [v], by rw [← htag]; exact hvs, ?_⟩ - have hce : (dCascadeEval (.test tyIdx .proj rest) - x.1.1 x.1.2.toInt?).getD 0 - = IntDispatchSoundness.evalLeaf .proj m := by - rw [hm]; simp [dCascadeEval, htag, WPayload.toInt?] - rw [hce] - exact IntDispatchSoundness.EvalCascade.hit tyIdx .proj rest [v] m v rfl hrepr - · rw [hpayTy] at hcshape - exact absurd (Option.some.inj hcshape).symm hcne - | hostOp role kk cf => - have hpayTy : dCtorShape? env tyIdx = some .hit := by - simpa using hleaf - have hchild := x.2 - unfold DEnvValidChild at hchild - rw [htag] at hchild - rcases hchild with ⟨_, m, hm⟩ | ⟨c, hcshape, hcne, _⟩ - · unfold dEnvDomRepr at hdom - rw [hm] at hdom - obtain ⟨v, hvs, hrepr⟩ := hdom - refine ⟨tyIdx, [v], by rw [← htag]; exact hvs, ?_⟩ - have hce : (dCascadeEval (.test tyIdx (.hostOp role kk cf) rest) - x.1.1 x.1.2.toInt?).getD 0 - = IntDispatchSoundness.evalLeaf (.hostOp role kk cf) m := by - rw [hm]; simp [dCascadeEval, htag, WPayload.toInt?] - rw [hce] - exact IntDispatchSoundness.EvalCascade.hit tyIdx (.hostOp role kk cf) - rest [v] m v rfl hrepr - · rw [hpayTy] at hcshape - exact absurd (Option.some.inj hcshape).symm hcne - · -- non-matched tag: recurse, leaf shape irrelevant - obtain ⟨tag, fields, hvs, hev⟩ := ih hrest - refine ⟨tag, fields, hvs, ?_⟩ - have htageq : tag = x.1.1 := by - unfold dEnvDomRepr at hdom - cases hpay : x.1.2 with - | int m => - rw [hpay] at hdom; obtain ⟨v, hvs2, _⟩ := hdom - rw [hvs2] at hvs; injection hvs with hh; injection hh with h1 _; exact h1.symm - | opaqueFields fs => - rw [hpay] at hdom - rw [hdom] at hvs; injection hvs with hh; injection hh with h1 _; exact h1.symm - have hne : x.1.1 ≠ tyIdx := htag - have hce : (dCascadeEval (.test tyIdx leaf rest) x.1.1 x.1.2.toInt?).getD 0 - = (dCascadeEval rest x.1.1 x.1.2.toInt?).getD 0 := by - simp only [dCascadeEval, if_neg hne] - rw [hce] - subst htageq - exact IntDispatchSoundness.EvalCascade.miss tyIdx x.1.1 leaf rest fields _ hne hev - -/-- The bridge in assembly shape: every represented declared input relates to the - declared-carrier Int model, whatever its non-hit payload. -/ -theorem env_declaredIntDispatch_bridge (env : DIdxEnvelope) (plan : IntDispatchRawPlan) - (hcasc : dCascadeInEnv env plan.body = true) - (S : CarrierSpec env.carrier) (x : DAdtVal env) (vs : List WVal) - (hdom : dEnvDomRepr env S x vs) : - ∃ tag fields n, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S plan.body tag fields n ∧ - ∀ w, S.Repr n w → - intRepr S (dEnvStructModel env plan.body x) w := by - obtain ⟨tag, fields, hvs, hev⟩ := dCascade_bridge env plan.body hcasc S x vs hdom - refine ⟨tag, fields, (dCascadeEval plan.body x.1.1 x.1.2.toInt?).getD 0, hvs, hev, ?_⟩ - intro w hw - simpa [intRepr, dEnvStructModel] using hw - -#print axioms dCascade_bridge -#print axioms env_declaredIntDispatch_bridge - -/-! ## §6 The declared-index CONSTRUCTOR column (meaning -> bytes, reverse arrow) - -The Int-read column reads the hit constructor's Int payload OUT of a declared -value; the constructor column builds one IN. The domain is a single `Int` -argument; the model is the declared hit constructor at its DECLARED index -carrying that Int as its Int-box payload; the codomain relation is the -single-result view of `dEnvDomRepr`. No new byte pin is needed beyond the same -single `concatPinnedAt` equality the read face already carries — the constructed -struct's body sits at its declared offset inside the pinned concat, so a forger -cannot build at a fabricated position without breaking the byte equality. -/ - -/-- Single-result codomain view of `dEnvDomRepr`: the declared value `y` is - represented by exactly one `WVal`. Reads the same payload discipline. -/ -def dEnvCodRepr (env : DIdxEnvelope) : - CarrierSpec env.carrier → DAdtVal env → WVal → Prop := - fun S y w => - match y.1.2 with - | .int n => ∃ v, w = .structv y.1.1 [v] ∧ S.Repr n v - | .opaqueFields fs => w = .structv y.1.1 fs - -/-- Constructor model from the plan: build the DECLARED hit constructor - `structIdx` with the Int argument as its readable Int-box payload. The hit - fact is DEMANDED so the value is well-formed (`DEnvValidChild`). -/ -def dEnvCtorModel (env : DIdxEnvelope) (structIdx : Nat) - (h : dCtorShape? env structIdx = some .hit) : Int → DAdtVal env := - fun n => ⟨(structIdx, .int n), Or.inl ⟨h, n, rfl⟩⟩ - -/-- The declared-index constructor face. Mirrors `DIdxIntReadFace` with the - domain/codomain arrow reversed: the constructed result is a `DAdtVal` at the - declared hit position, the plan builds that hit constructor with the Int - argument as its Int-box payload, the ctor entries are pinned at their - declared indices, and `o.policy = .simulatesModel` is asserted so the full - semantic bridge (policy conjunct included) is derivable. -/ -def DIdxCtorFace - (modBytes modLen : Nat) (_typePrefix : List Nat) - (env : DIdxEnvelope) (structIdx : Nat) - (hhit : dCtorShape? env structIdx = some .hit) - (plan : ConstructRawPlan) (o : Obligation) : Prop := - checkDIdxEnvelope env = true ∧ - plan.arity = 1 ∧ plan.fields = [.local 0] ∧ - dWalkPinned modBytes modLen env ∧ - o.policy = .simulatesModel ∧ - o.carrier = env.carrier ∧ - HEq o.Dom Int ∧ - HEq o.Cod (DAdtVal env) ∧ - HEq o.domRepr (AverCert.EnvelopeLowering.intArgDomRepr env.carrier) ∧ - HEq o.codRepr (dEnvCodRepr env) ∧ - HEq o.model (dEnvCtorModel env structIdx hhit) - -/-- The positive constructor bridge, in the exact shape the acceptance-soundness - assembly (`constructSemanticBridge`) consumes for the unary Int-payload - constructor profile. On the declared Int-argument representation, the - plan-computed constructor model `dEnvCtorModel env structIdx hhit x` is - represented by exactly the struct the canonical lowering builds: - `structv structIdx [v]`, where `v` represents the argument. `model`, - `codRepr`, and `domRepr` are all wall terms over the plan envelope; there is - no byte -> structure decoder. -/ -theorem env_declaredConstruct_bridge (env : DIdxEnvelope) (structIdx : Nat) - (hhit : dCtorShape? env structIdx = some .hit) - (plan : ConstructRawPlan) - (harity : plan.arity = 1) (hfields : plan.fields = [.local 0]) - (S : CarrierSpec env.carrier) (x : Int) (args : List WVal) - (hdom : AverCert.EnvelopeLowering.intArgDomRepr env.carrier S x args) : - args.length = plan.arity ∧ - dEnvCodRepr env S (dEnvCtorModel env structIdx hhit x) - (.structv structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields)) := by - obtain ⟨v, hargs, hrepr⟩ := hdom - subst hargs - rw [harity, hfields] - refine ⟨rfl, ?_⟩ - have hflds : ConstructVerbatimSoundness.constructModelFields - ([v] ++ List.replicate 1 (.null : WVal)) [.local 0] = [v] := by - simp [ConstructVerbatimSoundness.constructModelFields, - ConstructVerbatimSoundness.constructModelField] - rw [hflds] - show dEnvCodRepr env S (dEnvCtorModel env structIdx hhit x) - (.structv structIdx [v]) - unfold dEnvCodRepr dEnvCtorModel - exact ⟨v, rfl, hrepr⟩ - -#print axioms dEnvCodRepr -#print axioms env_declaredConstruct_bridge - -end AverCert.DeclaredIndexEnvelope diff --git a/aver-cert/assets/wall/current/DeclaredLayout.lean b/aver-cert/assets/wall/current/DeclaredLayout.lean new file mode 100644 index 000000000..8b3a6b811 --- /dev/null +++ b/aver-cert/assets/wall/current/DeclaredLayout.lean @@ -0,0 +1,966 @@ +-- Declared module layout, confirmed once against the decoders. +import AcceptedArtifactCore + +namespace AverCert.DeclaredLayout +open AverCert.Schema AverCert.AcceptedArtifact AverCert.TypeTable AverCert.Grammar + +/-! ### Packed tables -/ + +/-- Entry `i` of a table of `w`-bit numbers packed into one numeral, entry 0 + in the lowest bits. The kernel reads it with two GMP operations. -/ +def packedAt (t w i : Nat) : Nat := (t >>> (w * i)) % 2 ^ w + +theorem packedAt_zero (c t w : Nat) (hc : c < 2 ^ w) : packedAt (c + 2 ^ w * t) w 0 = c := by + simp only [packedAt, Nat.mul_zero, Nat.shiftRight_zero] + rw [Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt hc] + +theorem packedAt_succ (c t w i : Nat) (hc : c < 2 ^ w) : + packedAt (c + 2 ^ w * t) w (i + 1) = packedAt t w i := by + simp only [packedAt, Nat.shiftRight_eq_div_pow] + rw [Nat.mul_succ, Nat.pow_add, Nat.mul_comm (2 ^ (w * i)) (2 ^ w), ← Nat.div_div_eq_div_mul] + congr 2 + rw [Nat.add_mul_div_left _ _ (Nat.two_pow_pos w), Nat.div_eq_of_lt hc, Nat.zero_add] + + +/-! ### The declared function layout + +The producer declares, for every defined function `k` (code-section order), +its function-section type index and the byte offset and length of its code +entry (size prefix included), as packed tables. `layoutConfirmed` decodes the +module ONCE and confirms every declared entry by equality against the +decoders; the lemmas below then answer every decoder query about a function +from the declaration, with no further decoding. -/ + +structure Layout where + imports : Nat + count : Nat + width : Nat + types : Nat + offsets : Nat + lengths : Nat + +namespace Layout + +def ty (L : Layout) (k : Nat) : Nat := packedAt L.types L.width k +def off (L : Layout) (k : Nat) : Nat := packedAt L.offsets L.width k +def len (L : Layout) (k : Nat) : Nat := packedAt L.lengths L.width k + +/-- The declared code entry of defined function `k`, as the exact slice. -/ +def entryN (L : Layout) (n k : Nat) : Nat := CertDecode.isolateBytes (n >>> (8 * L.off k)) (L.len k) + +def entry (L : Layout) (n k : Nat) : AverCert.WasmSlice.ByteSeq := + CertDecode.takeBytes (L.len k) (L.entryN n k) + +/-- The code entry of function index `f`, when it is a defined function. -/ +def entryAt (L : Layout) (n f : Nat) : Option AverCert.WasmSlice.ByteSeq := + if L.imports ≤ f ∧ f - L.imports < L.count then some (L.entry n (f - L.imports)) else none + +end Layout + +def locsMatch (n : Nat) (L : Layout) : Nat → List Nat → List CertDecode.CodeLoc → Bool + | _, [], [] => true + | k, t :: ts, loc :: locs => + t == L.ty k && loc.entryLen == L.len k && loc.entryN == L.entryN n k && + locsMatch n L (k + 1) ts locs + | _, _, _ => false + +/-- The declared layout is what the decoders read: the imported function + count, and for every defined function its type index and exact code + entry. The function and code sections are decoded in full (and must be + exhausted), so the declaration covers every function and hides nothing. -/ +def layoutConfirmed (n len : Nat) (L : Layout) : Bool := + match CertDecode.funcImportBase n len, CertDecode.decodeFuncTypes n len, + CertDecode.codeLocs n len with + | some nimp, some fts, some locs => + nimp == L.imports && fts.length == L.count && locsMatch n L 0 fts locs.toList + | _, _, _ => false + +theorem locsMatch_spec {n : Nat} {L : Layout} : + ∀ {k : Nat} {ts : List Nat} {locs : List CertDecode.CodeLoc}, + locsMatch n L k ts locs = true → + ts.length = locs.length ∧ ∀ j, j < ts.length → + ts[j]? = some (L.ty (k + j)) ∧ ∃ loc, locs[j]? = some loc ∧ + loc.entryLen = L.len (k + j) ∧ loc.entryN = L.entryN n (k + j) + | _, [], [], _ => ⟨rfl, fun j hj => absurd hj (Nat.not_lt_zero j)⟩ + | _, [], _ :: _, h => by simp [locsMatch] at h + | _, _ :: _, [], h => by simp [locsMatch] at h + | k, t :: ts, loc :: locs, h => by + simp only [locsMatch, Bool.and_eq_true, beq_iff_eq] at h + obtain ⟨⟨⟨ht, hl⟩, hn⟩, hrest⟩ := h + obtain ⟨hlen, hget⟩ := locsMatch_spec hrest + refine ⟨by simp [hlen], fun j hj => ?_⟩ + cases j with + | zero => exact ⟨by simp [ht], loc, rfl, hl, hn⟩ + | succ j => + have := hget j (by simpa using hj) + simpa [Nat.add_assoc, Nat.add_comm 1 j] using this + +theorem codeEntryByFuncIndex_of_layout {n len : Nat} {L : Layout} + (h : layoutConfirmed n len L = true) (f : Nat) : + AverCert.WasmSlice.codeEntryByFuncIndex n len f = L.entryAt n f := by + unfold layoutConfirmed at h + split at h + · rename_i nimp fts locs himp hfts hlocs + simp only [Bool.and_eq_true, beq_iff_eq] at h + obtain ⟨⟨rfl, hcount⟩, hm⟩ := h + obtain ⟨hlen, hget⟩ := locsMatch_spec hm + simp only [AverCert.WasmSlice.codeEntryByFuncIndex, AverCert.WasmSlice.codeIndexByFuncIndex, + AverCert.WasmSlice.importedFuncCount, himp, AverCert.WasmSlice.codeEntryByCodeIndex, hlocs, + Layout.entryAt] + by_cases hlo : L.imports ≤ f + · simp only [hlo, ↓reduceIte, true_and] + by_cases hhi : f - L.imports < L.count + · obtain ⟨_, loc, hloc, hl, hn⟩ := hget (f - L.imports) (by omega) + simp only [Array.getElem?_toList] at hloc + simp [hloc, hhi, hl, hn, Layout.entry] + · have : locs[f - L.imports]? = none := by + rw [← Array.getElem?_toList] + apply List.getElem?_eq_none + simp only [Array.length_toList] at hlen ⊢; omega + simp [this, hhi] + · simp [hlo] + · simp at h + +theorem funcBindingByFuncIndex_of_layout {n len : Nat} {L : Layout} + (h : layoutConfirmed n len L = true) {f : Nat} (hlo : L.imports ≤ f) + (hhi : f - L.imports < L.count) : + AverCert.WasmSlice.funcBindingByFuncIndex n len f = + some ⟨f, L.ty (f - L.imports), L.entry n (f - L.imports)⟩ := by + have hcode := codeEntryByFuncIndex_of_layout h f + unfold layoutConfirmed at h + split at h + · rename_i nimp fts locs himp hfts hlocs + simp only [Bool.and_eq_true, beq_iff_eq] at h + obtain ⟨⟨rfl, hcount⟩, hm⟩ := h + obtain ⟨hlen, hget⟩ := locsMatch_spec hm + obtain ⟨hty, _⟩ := hget (f - L.imports) (by omega) + simp only [AverCert.WasmSlice.codeEntryByFuncIndex, AverCert.WasmSlice.codeIndexByFuncIndex, + AverCert.WasmSlice.importedFuncCount, himp, hlo, ↓reduceIte, Layout.entryAt, hhi, and_self] + at hcode + simp only [AverCert.WasmSlice.funcBindingByFuncIndex, AverCert.WasmSlice.codeIndexByFuncIndex, + AverCert.WasmSlice.importedFuncCount, himp, hlo, ↓reduceIte, + AverCert.WasmSlice.typeIndexByCodeIndex, hfts, hty, hcode, Nat.zero_add] + · simp at h + + +theorem funcBindingByFuncIndex_of_layout_out {n len : Nat} {L : Layout} + (h : layoutConfirmed n len L = true) {f : Nat} + (hout : ¬(L.imports ≤ f ∧ f - L.imports < L.count)) : + AverCert.WasmSlice.funcBindingByFuncIndex n len f = none := by + have hcode := codeEntryByFuncIndex_of_layout h f + simp only [Layout.entryAt, hout, ↓reduceIte] at hcode + unfold AverCert.WasmSlice.funcBindingByFuncIndex + unfold AverCert.WasmSlice.codeEntryByFuncIndex at hcode + split + · rename_i k hk + rw [hk] at hcode + simp only at hcode + rw [hcode] + split + · rename_i hne; cases hne + · rfl + · rfl + +/-! ### Helper function types over the declared layout -/ + +/-- `roleTypePinned`, with the helper's type index read from the layout. -/ +def roleTypePinnedL (L : Layout) (n len idx : Nat) (params results : List CertDecode.ValType) : + Bool := + if idx < 4294967296 then + if L.imports ≤ idx ∧ idx - L.imports < L.count then + AverCert.WasmSlice.typeSectionMatches + (AverCert.WasmSlice.checkFuncTypeExact params results) n len (L.ty (idx - L.imports)) + else false + else true + +theorem roleTypePinned_of_layout {n len : Nat} {L : Layout} (h : layoutConfirmed n len L = true) + (idx : Nat) (params results : List CertDecode.ValType) : + roleTypePinned n len idx params results = roleTypePinnedL L n len idx params results := by + unfold roleTypePinned roleTypePinnedL + by_cases hin : L.imports ≤ idx ∧ idx - L.imports < L.count + · rw [funcBindingByFuncIndex_of_layout h hin.1 hin.2] + simp [hin] + · rw [funcBindingByFuncIndex_of_layout_out h hin] + simp [hin] + +/-- `roleTypesPinned` over the layout. -/ +def roleTypesPinnedL (L : Layout) (n len : Nat) (M : MCtx) : Bool := + let c := refN M.carrier + roleTypePinnedL L n len M.box [.numeric 0x7e] [c] && + roleTypePinnedL L n len M.add [c, c] [c] && + roleTypePinnedL L n len M.sub [c, c] [c] && + roleTypePinnedL L n len M.mul [c, c] [c] && + roleTypePinnedL L n len M.cmp [c, c] [.numeric 0x7f] && + roleTypePinnedL L n len M.eq [c, c] [.numeric 0x7f] && + roleTypePinnedL L n len M.toIndex [c] [.numeric 0x7f] && + roleTypePinnedL L n len M.streq [refN M.str, refN M.str] [.numeric 0x7f] && + roleTypePinnedL L n len M.concat [refN M.strVec] [refN M.str] && + roleTypePinnedL L n len M.divmod [c, c, .numeric 0x7f] [c] + +/-- `plansAcceptedRest` with the helper types read over the layout. -/ +def plansAcceptedRestL (artifact : ArtifactData) (L : Layout) : Bool := + let m := artifact.manifest + let M := mctxOf m.subject m.types m.fnPlans + indicesDistinct M m.fnPlans && + typeTableConfirmed artifact.modBytes artifact.modLen m.subject m.types m.fnPlans && + dataConfirmed artifact.modBytes artifact.modLen m.subject m.types m.fnPlans && + roleTypesPinnedL L artifact.modBytes artifact.modLen M && + declsWellFormed m.subject m.types m.fnPlans + +theorem plansAcceptedRest_of_layout {artifact : ArtifactData} {L : Layout} + (hL : layoutConfirmed artifact.modBytes artifact.modLen L = true) + (h : plansAcceptedRestL artifact L = true) : plansAcceptedRest artifact = true := by + unfold plansAcceptedRest + unfold plansAcceptedRestL at h + simp only [roleTypesPinned, roleTypePinned_of_layout hL] + exact h + +/-! ### Distinct export names -/ + +theorem foldl_insert_nodup : + ∀ (xs : List Nat) (t : Std.TreeSet Nat compare), + (xs.foldl (fun set value => set.insert value) t).size ≤ t.size + xs.length ∧ + ((xs.foldl (fun set value => set.insert value) t).size = t.size + xs.length → + xs.Nodup ∧ ∀ x ∈ xs, t.contains x = false) + | [], t => by simp + | x :: xs, t => by + obtain ⟨hle, heq⟩ := foldl_insert_nodup xs (t.insert x) + have hsz := Std.TreeSet.size_insert (t := t) (k := x) + simp only [List.foldl_cons, List.length_cons] + by_cases hx : t.contains x = true + · simp only [hsz, hx, ↓reduceIte] at hle heq + refine ⟨by omega, fun h => ?_⟩ + omega + · simp only [hsz, hx, Bool.false_eq_true, ↓reduceIte] at hle heq + refine ⟨by omega, fun h => ?_⟩ + obtain ⟨hnd, hout⟩ := heq (by omega) + refine ⟨List.nodup_cons.mpr ⟨fun hmem => ?_, hnd⟩, ?_⟩ + · have := hout x hmem + rw [Std.TreeSet.contains_insert] at this + simp at this + · intro y hy + cases hy with + | head => exact Bool.eq_false_iff.mpr hx + | tail _ hmem => + have := hout y hmem + rw [Std.TreeSet.contains_insert] at this + simp only [Bool.or_eq_false_iff] at this + exact this.2 + +theorem natListNodup_nodup {xs : List Nat} (h : AverCert.WasmSlice.natListNodup xs = true) : + xs.Nodup := by + simp only [AverCert.WasmSlice.natListNodup, AverCert.WasmSlice.indexedNodup, + AverCert.WasmSlice.orderedSet, beq_iff_eq] at h + have := (foldl_insert_nodup xs Std.TreeSet.empty).2 + have h0 : (Std.TreeSet.empty : Std.TreeSet Nat compare).size = 0 := by simp + rw [h0, Nat.zero_add] at this + exact (this h).1 + +theorem mapM_cons_some {f : α → Option β} {x : α} {xs : List α} {keys : List β} + (h : (x :: xs).mapM f = some keys) : + ∃ k ks, f x = some k ∧ xs.mapM f = some ks ∧ keys = k :: ks := by + cases hx : f x with + | none => simp [List.mapM_cons, hx] at h + | some k => + cases hxs : xs.mapM f with + | none => simp [List.mapM_cons, hx, hxs] at h + | some ks => + simp only [List.mapM_cons, hx, hxs, Option.bind_eq_bind, Option.bind_some, + Option.pure_def, Option.some.injEq] at h + exact ⟨k, ks, rfl, rfl, h.symm⟩ + +theorem mapM_seqKey_mem : + ∀ {xs : List AverCert.WasmSlice.ByteSeq} {keys : List Nat}, + xs.mapM AverCert.WasmSlice.seqKey = some keys → + ∀ y ∈ xs, ∃ k ∈ keys, AverCert.WasmSlice.seqKey y = some k + | [], _, _, _, hy => by cases hy + | x :: xs, keys, h, y, hy => by + obtain ⟨k, ks, hk, hks, rfl⟩ := mapM_cons_some h + cases hy with + | head => exact ⟨k, List.mem_cons_self, hk⟩ + | tail _ hmem => + obtain ⟨k', hk', hy'⟩ := mapM_seqKey_mem hks y hmem + exact ⟨k', List.mem_cons_of_mem _ hk', hy'⟩ + +theorem mapM_seqKey_nodup : + ∀ {xs : List AverCert.WasmSlice.ByteSeq} {keys : List Nat}, + xs.mapM AverCert.WasmSlice.seqKey = some keys → keys.Nodup → xs.Nodup + | [], _, _, _ => List.nodup_nil + | x :: xs, keys, h, hnd => by + obtain ⟨k, ks, hk, hks, rfl⟩ := mapM_cons_some h + have hnd' := List.nodup_cons.mp hnd + refine List.nodup_cons.mpr ⟨fun hmem => ?_, mapM_seqKey_nodup hks hnd'.2⟩ + obtain ⟨k', hk'mem, hk'⟩ := mapM_seqKey_mem hks x hmem + have : k = k' := by rw [hk] at hk'; exact Option.some.inj hk' + exact hnd'.1 (this ▸ hk'mem) + +theorem byteSeqListNodup_nodup {xs : List AverCert.WasmSlice.ByteSeq} + (h : byteSeqListNodup xs = true) : xs.Nodup := by + unfold byteSeqListNodup at h + split at h + · rename_i keys hkeys + exact mapM_seqKey_nodup hkeys (natListNodup_nodup h) + · cases h + +/-- Every export name of the module is distinct (decided on numeric name keys). -/ +def exportNamesDistinct (n len : Nat) : Bool := + match CertDecode.decodeRawExports n len with + | some entries => byteSeqListNodup (entries.map (·.name)) + | none => false + +theorem findExportFuncIndex_of_pos : + ∀ {E : List AverCert.WasmSlice.ExportEntry} {p : Nat} {nm : AverCert.WasmSlice.ByteSeq} + {fi : Nat}, (E.map (·.name)).Nodup → E[p]? = some ⟨nm, 0, fi⟩ → + AverCert.WasmSlice.findExportFuncIndex nm E = some fi + | [], _, _, _, _, h => by simp at h + | e :: E, 0, nm, fi, _, h => by + simp only [List.getElem?_cons_zero, Option.some.injEq] at h + subst h + simp [AverCert.WasmSlice.findExportFuncIndex] + | e :: E, p + 1, nm, fi, hnd, h => by + simp only [List.getElem?_cons_succ] at h + simp only [List.map_cons, List.nodup_cons] at hnd + have hne : e.name ≠ nm := by + intro heq + apply hnd.1 + rw [heq] + exact List.mem_map.mpr ⟨_, List.mem_of_getElem? h, rfl⟩ + simp only [AverCert.WasmSlice.findExportFuncIndex, hne, and_false, ↓reduceIte] + exact findExportFuncIndex_of_pos hnd.2 h + + +/-! ### Declared function types -/ + +/-- A declared function type: its type index, parameters and results. -/ +abbrev FnType := Nat × List CertDecode.ValType × List CertDecode.ValType + +/-- The declared function types against the decoded type entries, in one + walk: the declarations are in strictly increasing index order, and each + is the exact function type of the entry at its index. -/ +def typesMatch : Nat → List CertDecode.TypeEntry → List FnType → Bool + | _, _, [] => true + | _, [], _ :: _ => false + | i, e :: es, x :: xs => + if i == x.1 then AverCert.WasmSlice.checkFuncTypeExact x.2.1 x.2.2 e && typesMatch (i + 1) es xs + else if i < x.1 then typesMatch (i + 1) es (x :: xs) + else false + +/-- Every declared function type is the type-section entry at its index. -/ +def fnTypesConfirmed (n len : Nat) (fts : List FnType) : Bool := + match CertDecode.decodeTypes n len with + | some info => typesMatch 0 info.entries fts + | none => false + +theorem typesMatch_spec : + ∀ {i : Nat} {es : List CertDecode.TypeEntry} {fts : List FnType}, + typesMatch i es fts = true → ∀ x ∈ fts, i ≤ x.1 ∧ ∃ e, es[x.1 - i]? = some e ∧ + AverCert.WasmSlice.checkFuncTypeExact x.2.1 x.2.2 e = true + | _, _, [], _, x, hx => by cases hx + | _, [], _ :: _, h, _, _ => by simp [typesMatch] at h + | i, e :: es, y :: ys, h, x, hx => by + unfold typesMatch at h + by_cases hi : i = y.1 + · subst hi + simp only [beq_self_eq_true, ↓reduceIte, Bool.and_eq_true] at h + obtain ⟨hc, hrest⟩ := h + cases hx with + | head => exact ⟨Nat.le_refl _, e, by simp, hc⟩ + | tail _ hmem => + obtain ⟨hle, e', he', hc'⟩ := typesMatch_spec hrest x hmem + refine ⟨by omega, e', ?_, hc'⟩ + have : x.1 - y.1 = (x.1 - (y.1 + 1)) + 1 := by omega + rw [this, List.getElem?_cons_succ] + exact he' + · have hne : (i == y.1) = false := by simpa using hi + simp only [hne, Bool.false_eq_true, ↓reduceIte] at h + by_cases hlt : i < y.1 + · simp only [hlt, ↓reduceIte] at h + obtain ⟨hle, e', he', hc'⟩ := typesMatch_spec h x hx + refine ⟨by omega, e', ?_, hc'⟩ + have : x.1 - i = (x.1 - (i + 1)) + 1 := by omega + rw [this, List.getElem?_cons_succ] + exact he' + · simp [hlt] at h + +theorem typeSectionMatches_of_confirmed {n len : Nat} {fts : List FnType} + (h : fnTypesConfirmed n len fts = true) {x : FnType} (hx : x ∈ fts) : + AverCert.WasmSlice.typeSectionMatches (AverCert.WasmSlice.checkFuncTypeExact x.2.1 x.2.2) + n len x.1 = true := by + unfold fnTypesConfirmed at h + split at h + · rename_i info hinfo + obtain ⟨_, e, he, hc⟩ := typesMatch_spec h x hx + have hidx : info.entryIndex = info.entries.toArray := by + unfold CertDecode.decodeTypes at hinfo + split at hinfo + · cases hinfo + · split at hinfo + · cases hinfo + · split at hinfo + · cases hinfo; rfl + · cases hinfo + simp only [AverCert.WasmSlice.typeSectionMatches, hinfo, hidx, List.getElem?_toArray] + simp only [Nat.sub_zero] at he + rw [he] + exact hc + · cases h + +/-! ### One planned function against the declarations -/ + +/-- What a plan entry declares about its function beyond the plan: its name + as characters (checked against the entry's name by `rfl`), the position + of its export entry in the export section, and the position of its + function type in the declared function types. -/ +structure FnDecl where + name : List Char + exportPos : Nat + sigPos : Nat + +/-- `entryAccepted` with every module fact read from a confirmed + declaration: the code entry from the layout (one slice), the type index + from the layout and its type from the declared function types, and an + exported function's export entry at its declared position. No section is + decoded and nothing is searched. -/ +def entryFast (n : Nat) (L : Layout) (fts : List FnType) + (E : List AverCert.WasmSlice.ExportEntry) (M : MCtx) (fns : List FnEntry) + (e : FnEntry) (d : FnDecl) : Bool := + planTyped M e.plan && callsOrdered fns e && + decide (L.imports ≤ e.funcIdx) && decide (e.funcIdx - L.imports < L.count) && + match codeEntryBytes M e.plan, e.plan.sig.params.mapM (valTyD M), valTyD M e.plan.sig.ret with + | some bytes, some ps, some r => + L.entry n (e.funcIdx - L.imports) == bytes && + fts[d.sigPos]? == some (L.ty (e.funcIdx - L.imports), ps, [r]) && + (!e.exported || E[d.exportPos]? == some ⟨d.name.map Char.toNat, 0, e.funcIdx⟩) + | _, _, _ => false + +theorem entryAccepted_of_fast {n len : Nat} {L : Layout} {fts : List FnType} + {E : List AverCert.WasmSlice.ExportEntry} {M : MCtx} {fns : List FnEntry} + {e : FnEntry} {d : FnDecl} + (hL : layoutConfirmed n len L = true) (hT : fnTypesConfirmed n len fts = true) + (hE : CertDecode.decodeRawExports n len = some E) (hX : (E.map (·.name)).Nodup) + (hname : stringBytes e.name = d.name.map Char.toNat) + (h : entryFast n L fts E M fns e d = true) : entryAccepted n len M fns e = true := by + unfold entryFast at h + simp only [Bool.and_eq_true, decide_eq_true_eq] at h + obtain ⟨⟨⟨⟨htyped, hcalls⟩, hlo⟩, hhi⟩, hm⟩ := h + have hbind := funcBindingByFuncIndex_of_layout hL hlo hhi + split at hm + · rename_i bytes ps r hbytes hps hr + simp only [Bool.and_eq_true, beq_iff_eq, Bool.or_eq_true, Bool.not_eq_true'] at hm + obtain ⟨⟨hcode, hsig⟩, hexp⟩ := hm + have hmem : (L.ty (e.funcIdx - L.imports), ps, [r]) ∈ fts := List.mem_of_getElem? hsig + have htype := typeSectionMatches_of_confirmed hT hmem + simp only [entryAccepted, htyped, hcalls, Bool.true_and, Bool.and_true, boundFunction, hbytes] + have hpin : sigPinned n len M e.plan.sig (L.ty (e.funcIdx - L.imports)) = true := by + simp only [sigPinned, hps, hr] + exact htype + cases hx : e.exported + · simp only [Bool.false_eq_true, ↓reduceIte, hbind, Option.filter_some, hcode, BEq.rfl, + hpin, Bool.and_self] + · have hpos : E[d.exportPos]? = some ⟨stringBytes e.name, 0, e.funcIdx⟩ := by + rw [hname] + rcases hexp with hno | hyes + · rw [hx] at hno; cases hno + · exact hyes + have hfind := findExportFuncIndex_of_pos hX hpos + simp only [↓reduceIte, AverCert.WasmSlice.exactFuncBindingForExport, + AverCert.WasmSlice.funcBindingForExport, AverCert.WasmSlice.exportFuncIndex, hE, hfind, + hbind, Option.filter_some, hcode, decide_true, ↓reduceIte, BEq.rfl, hpin, Bool.and_self] + · cases hm + +/-- The per-entry checks of a run of plan entries, with the export section + decoded once for the run. -/ +def entriesFast (n len : Nat) (L : Layout) (fts : List FnType) (M : MCtx) + (fns : List FnEntry) (es : List FnEntry) (ds : List FnDecl) : Bool := + match CertDecode.decodeRawExports n len with + | some E => es.length == ds.length && (es.zip ds).all (fun p => entryFast n L fts E M fns p.1 p.2) + | none => false + +theorem entries_of_fast {n len : Nat} {L : Layout} {fts : List FnType} {M : MCtx} + {fns : List FnEntry} {es : List FnEntry} {ds : List FnDecl} + (hL : layoutConfirmed n len L = true) (hT : fnTypesConfirmed n len fts = true) + (hX : exportNamesDistinct n len = true) + (hnames : es.map (·.name) = ds.map (fun d => String.ofList d.name)) + (h : entriesFast n len L fts M fns es ds = true) : + es.all (entryAccepted n len M fns) = true := by + unfold entriesFast at h + unfold exportNamesDistinct at hX + split at h + · rename_i E hE + rw [hE] at hX + have hnd := byteSeqListNodup_nodup hX + simp only [Bool.and_eq_true, beq_iff_eq, List.all_eq_true] at h + obtain ⟨hlen, hall⟩ := h + apply List.all_eq_true.mpr + intro e he + obtain ⟨i, hi, rfl⟩ := List.getElem_of_mem he + have hi' : i < ds.length := hlen ▸ hi + have hz : (es[i], ds[i]) ∈ es.zip ds := by + rw [List.mem_iff_getElem] + exact ⟨i, by simp only [List.length_zip]; omega, by simp⟩ + have hname : stringBytes es[i].name = ds[i].name.map Char.toNat := by + have := congrArg (fun l => l[i]?) hnames + simp only [List.getElem?_map, List.getElem?_eq_getElem hi, List.getElem?_eq_getElem hi', + Option.map_some, Option.some.injEq] at this + rw [this, stringBytes_ofList] + exact entryAccepted_of_fast hL hT hE hnd hname (hall _ hz) + · cases h + + +/-! ### Closure isolation over the declared layout -/ + +/-- `WasmSlice.closureFold` with the code entries read through `look`. -/ +def closureFoldWith (look : Nat → Option AverCert.WasmSlice.ByteSeq) : + Nat → List Nat → List Nat → Option (List Nat) + | 0, [], seen => some seen + | 0, _ :: _, _ => none + | _fuel + 1, [], seen => some seen + | fuel + 1, func :: work, seen => + if AverCert.WasmSlice.natMem func seen then + closureFoldWith look fuel work seen + else + match (look func).bind AverCert.WasmSlice.scanClosureCodeEntry with + | some callees => closureFoldWith look fuel (callees ++ work) (func :: seen) + | none => none + +theorem closureFold_eq_with (n len : Nat) : + ∀ (fuel : Nat) (work seen : List Nat), + AverCert.WasmSlice.closureFold n len fuel work seen = + closureFoldWith (AverCert.WasmSlice.codeEntryByFuncIndex n len) fuel work seen + | 0, [], _ => rfl + | 0, _ :: _, _ => rfl + | _ + 1, [], _ => rfl + | fuel + 1, func :: work, seen => by + simp only [AverCert.WasmSlice.closureFold, closureFoldWith, + AverCert.WasmSlice.scanClosureBody] + split + · exact closureFold_eq_with n len fuel work seen + · cases AverCert.WasmSlice.codeEntryByFuncIndex n len func with + | none => rfl + | some entry => + simp only [Option.bind_some] + cases AverCert.WasmSlice.scanClosureCodeEntry entry with + | none => rfl + | some callees => exact closureFold_eq_with n len fuel _ _ + +/-- `closureIsolation`, reading the code entries from a confirmed layout. -/ +def closureIsolationL (artifact : ArtifactData) (L : Layout) : Bool := + let claim := artifact.closureClaim + let certified := artifact.manifest.obligations.map (fun obligation => obligation.self) + AverCert.WasmSlice.natListNodup claim.roots && + AverCert.WasmSlice.natListNodup claim.helpers && + AverCert.WasmSlice.natListNodup claim.admitted && + AverCert.WasmSlice.natSetEq claim.roots certified && + claim.roots.all (fun root => !AverCert.WasmSlice.natMem root claim.helpers) && + AverCert.WasmSlice.natSetEq claim.admitted (claim.roots ++ claim.helpers) && + AverCert.WasmSlice.noSharedMemory artifact.modBytes artifact.modLen && + match closureFoldWith (L.entryAt artifact.modBytes) artifact.closureFuel claim.roots [] with + | some actual => AverCert.WasmSlice.natSetEq actual claim.admitted + | none => false + +theorem closureIsolation_of_layout {artifact : ArtifactData} {L : Layout} + (hL : layoutConfirmed artifact.modBytes artifact.modLen L = true) + (h : closureIsolationL artifact L = true) : closureIsolation artifact = true := by + have hlook : AverCert.WasmSlice.codeEntryByFuncIndex artifact.modBytes artifact.modLen = + L.entryAt artifact.modBytes := funext (codeEntryByFuncIndex_of_layout hL) + unfold closureIsolation + simp only [closureFold_eq_with, hlook] + exact h + +/-! ### Helper bodies over the declared layout -/ + +/-- `bodyBytesAtFuncIndex` read from the layout: the code entry without its + size prefix. -/ +def Layout.bodyAt (L : Layout) (n idx : Nat) : Option (List Nat) := + if L.imports ≤ idx ∧ idx - L.imports < L.count then + match CertDecode.readU (L.entryN n (idx - L.imports)) (L.len (idx - L.imports)) with + | some (esz, bodyN, _) => some (CertDecode.takeBytes esz bodyN) + | none => none + else none + +theorem bodyBytesAtFuncIndex_of_layout {n len : Nat} {L : Layout} + (h : layoutConfirmed n len L = true) (idx : Nat) : + bodyBytesAtFuncIndex n len idx = L.bodyAt n idx := by + unfold layoutConfirmed at h + split at h + · rename_i nimp fts locs himp hfts hlocs + simp only [Bool.and_eq_true, beq_iff_eq] at h + obtain ⟨⟨rfl, hcount⟩, hm⟩ := h + obtain ⟨hlen, hget⟩ := locsMatch_spec hm + simp only [bodyBytesAtFuncIndex, himp, hlocs, Layout.bodyAt] + by_cases hlo : L.imports ≤ idx + · simp only [hlo, ↓reduceIte, true_and] + by_cases hhi : idx - L.imports < L.count + · obtain ⟨_, loc, hloc, hl, hn⟩ := hget (idx - L.imports) (by omega) + simp only [Array.getElem?_toList] at hloc + simp only [hloc, hhi, ↓reduceIte, hl, hn, Nat.zero_add] + rfl + · have : locs[idx - L.imports]? = none := by + rw [← Array.getElem?_toList] + apply List.getElem?_eq_none + simp only [Array.length_toList] at hlen ⊢; omega + simp [this, hhi] + · simp [hlo] + · simp at h + +theorem arithRoleCheck_of_layout {n len : Nat} {L : Layout} + (h : layoutConfirmed n len L = true) (role : ArithTemplateDerisk.ArithRole) + (idx? : Option Nat) (p : ArithTemplateDerisk.ArithHostParams) : + arithRoleCheck n len role idx? p = + match idx? with + | none => true + | some idx => L.bodyAt n idx == some (ArithTemplateDerisk.arithHelperBody role p) := by + unfold arithRoleCheck + cases idx? with + | none => rfl + | some idx => simp only [bodyBytesAtFuncIndex_of_layout h] + + +/-! ### String helper roles with a signature-shape index + +`StringHost.roleTable` classifies every defined function by the signature of +its type, read from an array by type index; the kernel pays a walk of the +decoded type list for each function. Only a function whose signature has the +shape of an eq or concat helper can be classified, so `roleTableFast` first +folds the signature list into a bitmap of those shapes (one numeral, read +with two GMP operations per function) and reads a signature only for such a +function. `roleTableFast_eq` shows it is `roleTable`. -/ + +namespace StringFast +open CertDecode.StringHost + +/-- A signature of the shape an eq (`[ref, ref] → i32`) or concat + (`[ref] → ref`) helper has. -/ +def candShape (sbat : List Nat) : Option CertDecode.StringHost.Sig → Bool + | some ([Ty.ref l, Ty.ref r], Ty.i32 :: _) => l == r && sbat.contains l + | some ([Ty.ref _], Ty.ref b :: _) => sbat.contains b + | _ => false + +/-- Bit `i` is set when signature `i` has a helper shape. -/ +def shapeBits (sbat : List Nat) : List (Option CertDecode.StringHost.Sig) → Nat + | [] => 0 + | s :: ss => (if candShape sbat s then 1 else 0) + 2 * shapeBits sbat ss + +theorem shapeBits_at (sbat : List Nat) : ∀ (ts : List (Option CertDecode.StringHost.Sig)) (i : Nat), + packedAt (shapeBits sbat ts) 1 i = if candShape sbat ((ts[i]?).getD none) then 1 else 0 + | [], i => by simp [shapeBits, packedAt, candShape] + | s :: ss, 0 => by + have h := packedAt_zero (if candShape sbat s then 1 else 0) (shapeBits sbat ss) 1 (by split <;> decide) + simpa [shapeBits] using h + | s :: ss, i + 1 => by + have h := packedAt_succ (if candShape sbat s then 1 else 0) (shapeBits sbat ss) 1 i (by split <;> decide) + simp only [Nat.pow_one] at h + simp only [shapeBits, h, List.getElem?_cons_succ] + exact shapeBits_at sbat ss i + +/-- `classify` over a signature lookup function. -/ +def classifyBy (nimp : Nat) (sbat : List Nat) (look : Nat → Option CertDecode.StringHost.Sig) : + Nat → List Nat → List (Nat × Nat × Nat) → List (Nat × Role) + | _, [], _ => [] + | _, _ :: _, [] => [] + | def_idx, ty :: tys, (nloc, bodyN, bodyLen) :: locs => + match classifyOne sbat (look ty) nloc bodyN bodyLen with + | some role => (nimp + def_idx, role) :: classifyBy nimp sbat look (def_idx+1) tys locs + | none => classifyBy nimp sbat look (def_idx+1) tys locs + +theorem classify_eq_by (nimp : Nat) (sbat : List Nat) (tsigs : Array (Option CertDecode.StringHost.Sig)) : + ∀ (d : Nat) (tys : List Nat) (locs : List (Nat × Nat × Nat)), + classify nimp sbat tsigs d tys locs = + classifyBy nimp sbat (fun ty => (tsigs[ty]?).getD none) d tys locs + | _, [], _ => by simp [classify, classifyBy] + | _, _ :: _, [] => by simp [classify, classifyBy] + | d, ty :: tys, (nloc, bodyN, bodyLen) :: locs => by + simp only [classify, classifyBy] + rw [classify_eq_by nimp sbat tsigs (d + 1) tys locs] + rfl + +theorem classifyBy_congr (nimp : Nat) (sbat : List Nat) (f g : Nat → Option CertDecode.StringHost.Sig) + (h : ∀ ty nloc bodyN bodyLen, + classifyOne sbat (f ty) nloc bodyN bodyLen = classifyOne sbat (g ty) nloc bodyN bodyLen) : + ∀ (d : Nat) (tys : List Nat) (locs : List (Nat × Nat × Nat)), + classifyBy nimp sbat f d tys locs = classifyBy nimp sbat g d tys locs + | _, [], _ => by simp [classifyBy] + | _, _ :: _, [] => by simp [classifyBy] + | d, ty :: tys, (nloc, bodyN, bodyLen) :: locs => by + simp only [classifyBy, h ty nloc bodyN bodyLen, + classifyBy_congr nimp sbat f g h (d + 1) tys locs] + +theorem eqCandidate_some {s : Option CertDecode.StringHost.Sig} {nloc lhs : Nat} + (h : eqCandidate s nloc = some lhs) : + ∃ rs, s = some ([Ty.ref lhs, Ty.ref lhs], Ty.i32 :: rs) := by + unfold eqCandidate at h + split at h + · split at h + · rename_i l r rs + by_cases hc : (l == r && nloc == 2) = true + · simp only [hc, ↓reduceIte] at h + simp only [Bool.and_eq_true, beq_iff_eq] at hc + obtain ⟨rfl, _⟩ := hc + cases h + exact ⟨rs, rfl⟩ + · simp only [hc, Bool.false_eq_true, ↓reduceIte, reduceCtorEq] at h + · cases h + · cases h + +theorem concatCandidate_some {s : Option CertDecode.StringHost.Sig} {nloc c b : Nat} + (h : concatCandidate s nloc = some (c, b)) : + ∃ rs, s = some ([Ty.ref c], Ty.ref b :: rs) := by + unfold concatCandidate at h + split at h + · split at h + · rename_i c' b' rs + by_cases hc : (nloc == 7) = true + · simp only [hc, ↓reduceIte] at h + cases h + exact ⟨rs, rfl⟩ + · simp only [hc, Bool.false_eq_true, ↓reduceIte, reduceCtorEq] at h + · cases h + · cases h + +theorem classifyOne_of_not_shape (sbat : List Nat) (s : Option CertDecode.StringHost.Sig) + (hs : candShape sbat s = false) (nloc bodyN bodyLen : Nat) : + classifyOne sbat s nloc bodyN bodyLen = none := by + unfold classifyOne + split + · rename_i lhs he + obtain ⟨rs, rfl⟩ := eqCandidate_some he + have : lhs ∉ sbat := by simpa [candShape] using hs + simp [this] + · split + · rename_i c b hc + obtain ⟨rs, rfl⟩ := concatCandidate_some hc + have : b ∉ sbat := by simpa [candShape] using hs + simp [this] + · rfl + +/-- The signature lookup through the shape bitmap. -/ +def sigLook (sbat : List Nat) (ts : List (Option CertDecode.StringHost.Sig)) (ty : Nat) : Option CertDecode.StringHost.Sig := + if packedAt (shapeBits sbat ts) 1 ty == 1 then (ts[ty]?).getD none else none + +theorem classifyOne_sigLook (sbat : List Nat) (ts : List (Option CertDecode.StringHost.Sig)) (ty nloc bodyN bodyLen : Nat) : + classifyOne sbat (sigLook sbat ts ty) nloc bodyN bodyLen = + classifyOne sbat ((ts[ty]?).getD none) nloc bodyN bodyLen := by + unfold sigLook + rw [shapeBits_at] + by_cases hs : candShape sbat ((ts[ty]?).getD none) = true + · simp [hs] + · have hs' : candShape sbat ((ts[ty]?).getD none) = false := by simpa using hs + have h0 : ((if candShape sbat ((ts[ty]?).getD none) = true then 1 else 0) == 1) = false := by + simp [hs'] + simp only [h0, Bool.false_eq_true, ↓reduceIte] + rw [classifyOne_of_not_shape sbat _ hs', classifyOne_of_not_shape sbat none rfl] + +/-- `roleTable`, reading signatures through the shape bitmap. -/ +def roleTableFast (n len : Nat) : Option (List (Nat × Role)) := + match decodeTypeSigs n len, CertDecode.decodeFuncTypes n len, + CertDecode.funcImportBase n len, bodyLocs n len with + | some (tsigs, sbat), some ftys, some nimp, some locs => + some (classifyBy nimp sbat (sigLook sbat tsigs.toList) 0 ftys locs) + | _, _, _, _ => none + +theorem roleTableFast_eq (n len : Nat) : roleTableFast n len = roleTable n len := by + unfold roleTableFast roleTable + cases decodeTypeSigs n len with + | none => rfl + | some p => + obtain ⟨tsigs, sbat⟩ := p + cases CertDecode.decodeFuncTypes n len with + | none => rfl + | some ftys => + cases CertDecode.funcImportBase n len with + | none => rfl + | some nimp => + cases bodyLocs n len with + | none => rfl + | some locs => + show some _ = some _ + rw [classify_eq_by] + congr 1 + apply classifyBy_congr + intro ty nloc bodyN bodyLen + rw [classifyOne_sigLook, Array.getElem?_toList] + +end StringFast + + +/-! ### Names as characters + +The kernel has no fast path for String values: converting one to its bytes +or comparing two rebuilds their UTF-8 arrays, in time quadratic in their +length. A package states the Strings a check reads as character lists +(a literal is definitionally `String.ofList` of its characters, which the +kernel checks by `rfl` without building bytes), and the lemmas below turn +each check into the same check over the characters' code points. -/ + +namespace Chars + +theorem map_toNat_inj : ∀ {a b : List Char}, a.map Char.toNat = b.map Char.toNat → a = b + | [], [], _ => rfl + | [], _ :: _, h => by simp at h + | _ :: _, [], h => by simp at h + | x :: xs, y :: ys, h => by + simp only [List.map_cons, List.cons.injEq] at h + rw [Char.toNat_inj.mp h.1, map_toNat_inj h.2] + +theorem stringBytes_inj {s t : String} (h : stringBytes s = stringBytes t) : s = t := by + have : s.toList = t.toList := map_toNat_inj h + simpa using congrArg String.ofList this + +theorem stringBytes_append (s t : String) : stringBytes (s ++ t) = stringBytes s ++ stringBytes t := by + simp [stringBytes, String.toList_append] + +/-- Membership of a String pair, decided on the pairs' bytes. -/ +theorem contains_pair_bytes (reg : List (String × String)) (s t : String) : + reg.contains (s, t) = (reg.map capabilityBytes).contains (stringBytes s, stringBytes t) := by + apply Bool.eq_iff_iff.mpr + simp only [List.contains_iff_mem, List.mem_map, capabilityBytes, Prod.mk.injEq] + constructor + · intro h; exact ⟨(s, t), h, rfl, rfl⟩ + · rintro ⟨⟨a, b⟩, hab, ha, hb⟩ + simp only at ha hb + rw [stringBytes_inj ha, stringBytes_inj hb] at hab + exact hab + +/-- `customCapabilityImport` over the capability's bytes. -/ +def customCapabilityImportBytes (moduleBytes operationBytes : AverCert.WasmSlice.ByteSeq) : Bool := + let modulePrefix := stringBytes "aver:user/cap-n" + let operationPrefix := stringBytes "op-n" + let operationTail := operationBytes.drop operationPrefix.length + modulePrefix.isPrefixOf moduleBytes && + customCapabilityModuleTail 0 (moduleBytes.drop modulePrefix.length) && + operationPrefix.isPrefixOf operationBytes && + !operationTail.isEmpty && operationTail.length % 2 == 0 && + operationTail.all lowerHexByte + +theorem customCapabilityImport_bytes (c : String × String) : + customCapabilityImport c = customCapabilityImportBytes (stringBytes c.1) (stringBytes c.2) := + rfl + +/-- `importsWithinCapabilities` with the declared capabilities as characters. -/ +def importsWithinCapabilitiesChars (artifact : ArtifactData) + (caps : List (List Char × List Char)) : Bool := + let bytes := caps.map (fun c => (c.1.map Char.toNat, c.2.map Char.toNat)) + byteSeqListNodup (bytes.map (fun c => c.1 ++ [46] ++ c.2)) && + bytes.all (fun c => + ((AverCert.Schema.capabilityRegistryForTarget artifact.manifest.subject.target).map + capabilityBytes).contains c || + customCapabilityImportBytes c.1 c.2) && + match AverCert.WasmSlice.enumImportNames artifact.modBytes artifact.modLen with + | some actual => actual == bytes + | none => false + +theorem importsWithinCapabilities_of_chars (artifact : ArtifactData) + (caps : List (List Char × List Char)) + (hcaps : artifact.manifest.subject.capabilities = + caps.map (fun c => (String.ofList c.1, String.ofList c.2))) + (h : importsWithinCapabilitiesChars artifact caps = true) : + importsWithinCapabilities artifact = true := by + unfold importsWithinCapabilitiesChars at h + unfold importsWithinCapabilities + rw [hcaps] + have hdot : stringBytes "." = [46] := by decide + simp only [List.map_map, Function.comp_def, stringListNodup, stringBytes_append, + stringBytes_ofList, hdot, List.all_map, customCapabilityImport_bytes, contains_pair_bytes, + capabilityBytes] at h ⊢ + exact h + +/-- A code point list names `s` exactly when its characters do, for a `s` + without the character 0 (every other code point `Char.ofNat` maps to + itself or to 0). -/ +theorem mkName_beq (ns : List Nat) (s : String) (hs : ∀ c ∈ s.toList, c.toNat ≠ 0) : + (CertDecode.mkName ns == s) = (ns == stringBytes s) := by + apply Bool.eq_iff_iff.mpr + simp only [beq_iff_eq, CertDecode.mkName, stringBytes] + constructor + · intro h + have hl : ns.map Char.ofNat = s.toList := by rw [← h]; simp + rw [← hl, List.map_map] + calc ns = ns.map id := (List.map_id ns).symm + _ = ns.map (Char.toNat ∘ Char.ofNat) := List.map_congr_left (fun n hn => ?_) + have hc : Char.ofNat n ∈ s.toList := hl ▸ List.mem_map_of_mem hn + have hz := hs _ hc + simp only [id, Function.comp_apply] + by_cases hv : n.isValidChar + · simp [Char.ofNat, hv, Char.ofNatAux] + · simp [Char.ofNat, hv] at hz + · intro h + rw [h, List.map_map] + have : (Char.ofNat ∘ Char.toNat) = id := by funext c; simp + simp [this] + +/-- The first function export named `s`, read on the raw export entries. -/ +theorem functionExports_find (s : String) (hs : ∀ c ∈ s.toList, c.toNat ≠ 0) : + ∀ raw : List CertDecode.ExportEntry, + ((CertDecode.functionExports raw).find? (fun e => e.1 == s)).map Prod.snd = + AverCert.WasmSlice.findExportFuncIndex (stringBytes s) raw + | [] => rfl + | e :: raw => by + simp only [CertDecode.functionExports, AverCert.WasmSlice.findExportFuncIndex] + by_cases hk : e.kind = 0 + · simp only [hk, beq_self_eq_true, ↓reduceIte, List.find?_cons, mkName_beq _ _ hs, true_and] + by_cases hn : e.name = stringBytes s + · simp [hn] + · have hb : (e.name == stringBytes s) = false := by simpa using hn + simp only [hb, hn, ↓reduceIte] + exact functionExports_find s hs raw + · have : (e.kind == 0) = false := by simpa using hk + simp only [this, Bool.false_eq_true, ↓reduceIte, hk, false_and] + exact functionExports_find s hs raw + +theorem functionExports_all (s : String) (hs : ∀ c ∈ s.toList, c.toNat ≠ 0) : + ∀ raw : List CertDecode.ExportEntry, + (CertDecode.functionExports raw).all (fun e => e.1 != s) = + (AverCert.WasmSlice.findExportFuncIndex (stringBytes s) raw).isNone + | [] => rfl + | e :: raw => by + simp only [CertDecode.functionExports, AverCert.WasmSlice.findExportFuncIndex] + by_cases hk : e.kind = 0 + · simp only [hk, beq_self_eq_true, ↓reduceIte, List.all_cons, bne, mkName_beq _ _ hs, true_and] + by_cases hn : e.name = stringBytes s + · simp [hn] + · have hb : (e.name == stringBytes s) = false := by simpa using hn + simp only [hb, hn, ↓reduceIte, Bool.not_false, Bool.true_and] + exact functionExports_all s hs raw + · have : (e.kind == 0) = false := by simpa using hk + simp only [this, Bool.false_eq_true, ↓reduceIte, hk, false_and] + exact functionExports_all s hs raw + +/-- The export index of a helper's name, on the raw export entries. -/ +def helperIdx (n len : Nat) (name : AverCert.WasmSlice.ByteSeq) : Option Nat := + (CertDecode.decodeRawExports n len).bind (AverCert.WasmSlice.findExportFuncIndex name) + +theorem boxIdx_eq (n len : Nat) : + CertDecode.AddSub.boxIdx n len = helperIdx n len (stringBytes "__rt_aint_from_i64") := by + unfold CertDecode.AddSub.boxIdx helperIdx CertDecode.decodeExports + cases CertDecode.decodeRawExports n len with + | none => rfl + | some raw => exact functionExports_find _ (by decide) raw + +theorem toIndexIdx_eq (n len : Nat) : + CertDecode.AddSub.toIndexIdx n len = helperIdx n len (stringBytes "__aint_to_index") := by + unfold CertDecode.AddSub.toIndexIdx helperIdx CertDecode.decodeExports + cases CertDecode.decodeRawExports n len with + | none => rfl + | some raw => exact functionExports_find _ (by decide) raw + +theorem cmpIdx_eq (n len : Nat) : + CertDecode.AddSub.cmpIdx n len = helperIdx n len (stringBytes "__aint_cmp") := by + unfold CertDecode.AddSub.cmpIdx helperIdx CertDecode.decodeExports + cases CertDecode.decodeRawExports n len with + | none => rfl + | some raw => exact functionExports_find _ (by decide) raw + +theorem carrierHelperAbsent_eq (n len : Nat) : + CertDecode.AddSub.carrierHelperAbsent n len = + match CertDecode.decodeRawExports n len with + | some raw => + (AverCert.WasmSlice.findExportFuncIndex (stringBytes "__rt_aint_from_i64") raw).isNone + | none => false := by + unfold CertDecode.AddSub.carrierHelperAbsent CertDecode.decodeExports + cases CertDecode.decodeRawExports n len with + | none => rfl + | some raw => exact functionExports_all _ (by decide) raw + +end Chars + +end AverCert.DeclaredLayout diff --git a/aver-cert/assets/wall/current/DischargeComposition.lean b/aver-cert/assets/wall/current/DischargeComposition.lean deleted file mode 100644 index 9cb22ffc9..000000000 --- a/aver-cert/assets/wall/current/DischargeComposition.lean +++ /dev/null @@ -1,376 +0,0 @@ -/- -Acceptance-soundness wiring for composition. - -The audited acceptance predicate supplies the byte-derived root member, -closure membership, canonical lowering, and the shared obligation code table. -The semantic bridge ties the root's selected source models to the member facts -used by the generic composition theorem, preventing model-selection drift. --/ -import AcceptanceSoundnessCore -import CompositionSoundness - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -private theorem mem_foldl_insert (xs : List String) (s : Std.TreeSet String) - (x : String) - (h : x ∈ xs.foldl (fun set value => set.insert value) s) : - x ∈ s ∨ x ∈ xs := by - induction xs generalizing s with - | nil => exact Or.inl h - | cons y ys ih => - have h' := ih (s := s.insert y) h - rcases h' with hset | hys - · rw [Std.TreeSet.mem_insert] at hset - simp only [Std.LawfulEqCmp.compare_eq_iff_eq] at hset - rcases hset with hyx | hs - · exact Or.inr (by simp [hyx]) - · exact Or.inl hs - · exact Or.inr (by simp [hys]) - -private theorem mem_of_orderedSet_contains (xs : List String) (x : String) - (h : (AverCert.WasmSlice.orderedSet xs).contains x = true) : x ∈ xs := by - have hm := Std.TreeSet.contains_iff_mem.mp h - rcases mem_foldl_insert xs Std.TreeSet.empty x hm with hempty | hxs - · exact (Std.TreeSet.not_mem_emptyc hempty).elim - · exact hxs - -/-- A successful worklist run never drops an already-seen member. -/ -private theorem compositionReachStep_preserves_seen - (edgeIndex : Std.TreeMap String (List String)) - (memberNames : Std.TreeSet String) : - ∀ fuel seen seenSet queuedSet work reached, - compositionReachStep edgeIndex memberNames fuel - seen seenSet queuedSet work = some reached → - ∀ name ∈ seen, name ∈ reached := by - intro fuel - induction fuel with - | zero => - intro seen seenSet queuedSet work reached h - simp [compositionReachStep] at h - | succ fuel ih => - intro seen seenSet queuedSet work reached h name hName - cases work with - | nil => - simp only [compositionReachStep, Option.some.injEq] at h - simpa [← h] using hName - | cons head work => - simp only [compositionReachStep] at h - split at h - next => exact ih _ _ _ _ _ h name hName - next => - split at h - next => simp at h - next callees hLookup => - split at h - next hAll => - exact ih _ _ _ _ _ h name (by simp [hName]) - next => simp at h - -/-- Every successful nonzero closure computation retains its initial root. -/ -private theorem compositionReachClosure_root_mem - (edges : List (String × List String)) (fuel : Nat) (root : String) - (h : compositionReachClosure edges (fuel + 1) [root] = some reached) : - root ∈ reached := by - change (match compositionReachStep - (edges.foldl (fun index edge => index.insert edge.1 edge.2) - Std.TreeMap.empty) - (AverCert.WasmSlice.orderedSet (edges.map (fun edge => edge.1))) - (fuel + 1) [] Std.TreeSet.empty - (AverCert.WasmSlice.orderedSet [root]) [root] with - | some reachedSet => some reachedSet.reverse - | none => none) = some reached at h - cases hStep : compositionReachStep - (edges.foldl (fun index edge => index.insert edge.1 edge.2) - Std.TreeMap.empty) - (AverCert.WasmSlice.orderedSet (edges.map (fun edge => edge.1))) - (fuel + 1) [] Std.TreeSet.empty - (AverCert.WasmSlice.orderedSet [root]) [root] with - | none => rw [hStep] at h; contradiction - | some reachedSet => - rw [hStep] at h - simp only [Option.some.injEq] at h - subst reached - simp only [List.mem_reverse] - simp only [compositionReachStep] at hStep - have hEmpty : (Std.TreeSet.empty : Std.TreeSet String).contains root = false := by - exact Std.TreeSet.contains_emptyc - simp only [hEmpty, Bool.false_eq_true, if_false] at hStep - split at hStep - next => simp at hStep - next callees hLookup => - split at hStep - next hAll => - exact compositionReachStep_preserves_seen _ _ fuel [root] _ _ _ - reachedSet hStep root (by simp) - next => simp at hStep - -/-- `compositionClosureBound` selects a chain-shaped root and puts it in the -checked member-name list. -/ -private theorem compositionClosureBound_root - (root : String) (memberNames : List String) - (members : List CompositionMemberClaim) - (funcTable : List (String × Nat)) - (hBound : compositionClosureBound root memberNames members funcTable = true) : - ∃ rootMember callees, - compositionMemberForName root members = some rootMember ∧ - rootMember.plan.shape = .chain callees ∧ - root ∈ memberNames := by - unfold compositionClosureBound at hBound - dsimp only at hBound - simp only [Bool.and_eq_true] at hBound - have hRoot := hBound.2 - cases hMember : compositionMemberForName root members with - | none => simp [hMember] at hRoot - | some rootMember => - rw [hMember] at hRoot - cases hShape : rootMember.plan.shape with - | selfSum => simp [hShape] at hRoot - | chain callees => - simp only [hShape, Bool.true_and] at hRoot - cases hReach : compositionReachClosure (compositionEdges members) - (members.length + 1) [root] with - | none => simp [hReach] at hRoot - | some reached => - have hReached : root ∈ reached := by - simpa [Nat.add_assoc] using - compositionReachClosure_root_mem - (compositionEdges members) members.length root hReach - simp only [hReach] at hRoot - unfold stringListSetEq at hRoot - simp only [Bool.and_eq_true] at hRoot - have hSetEq := hRoot.2 - unfold AverCert.WasmSlice.indexedSetEq at hSetEq - simp only [Bool.and_eq_true] at hSetEq - have hSubset := hSetEq.2 - unfold AverCert.WasmSlice.indexedSubset at hSubset - have hContains := (List.all_eq_true.mp hSubset) root hReached - exact ⟨rootMember, callees, by simp, hShape, - mem_of_orderedSet_contains memberNames root hContains⟩ - -private theorem compositionNamedMemberAccepted_of_mem - (modBytes modLen carrier : Nat) - (hostTable : List (HostRole × Nat)) - (funcTable : List (String × Nat)) - (obligation : Obligation) - (members : List CompositionMemberClaim) - (names : List String) - (hAccepted : compositionNamedMembersAccepted modBytes modLen carrier - hostTable funcTable obligation members names) - (name : String) (hMem : name ∈ names) : - ∃ member, - compositionMemberForName name members = some member ∧ - compositionMemberPlanAccepted modBytes modLen carrier hostTable - funcTable obligation member := by - induction names with - | nil => simp at hMem - | cons head tail ih => - simp only [List.mem_cons] at hMem - unfold compositionNamedMembersAccepted at hAccepted - cases hLookup : compositionMemberForName head members with - | none => simp [hLookup] at hAccepted - | some member => - simp only [hLookup] at hAccepted - rcases hAccepted with ⟨hHead, hTail⟩ - rcases hMem with rfl | hMem - · exact ⟨member, hLookup, hHead⟩ - · exact ih hTail hMem - -/-- A member's function-table target is exactly its byte-derived export - binding. Generated option-(b) bridges use this instead of re-evaluating - the whole artifact byte parser or pinning a second function table. -/ -theorem compositionFuncIdx_eq_binding - (modBytes modLen : Nat) (members : List CompositionMemberClaim) - (funcTable : List (String × Nat)) (name : String) - (member : CompositionMemberClaim) - (binding : AverCert.WasmSlice.FuncBinding) - (hTable : compositionFuncTable modBytes modLen members = some funcTable) - (hMember : compositionMemberForName name members = some member) - (hBinding : AverCert.WasmSlice.funcBindingForExport - modBytes modLen member.exportNameBytes = some binding) : - AverCert.PlanLower.compositionFuncIdx? funcTable name = - some binding.funcIdx := by - induction members generalizing funcTable with - | nil => simp [compositionMemberForName] at hMember - | cons head tail ih => - unfold compositionFuncTable at hTable - unfold compositionMemberBinding at hTable - cases hHeadBinding : AverCert.WasmSlice.funcBindingForExport - modBytes modLen head.exportNameBytes with - | none => simp [hHeadBinding] at hTable - | some headBinding => - cases hTailTable : compositionFuncTable modBytes modLen tail with - | none => simp [hHeadBinding, hTailTable] at hTable - | some tailTable => - simp only [hHeadBinding, hTailTable, Option.some.injEq] at hTable - subst funcTable - by_cases hName : head.exportName = name - · subst name - simp [compositionMemberForName] at hMember - subst member - rw [hHeadBinding] at hBinding - have hEq : headBinding = binding := Option.some.inj hBinding - subst binding - simp [AverCert.PlanLower.compositionFuncIdx?] - · have hMemberTail : compositionMemberForName name tail = - some member := by - simpa [compositionMemberForName, hName] using hMember - have hTail := ih tailTable hTailTable hMemberTail - have hBeq : (head.exportName == name) = false := by - simpa using hName - simpa [AverCert.PlanLower.compositionFuncIdx?, hBeq] using hTail - -/-- Per-obligation semantic bridge. The source model selection and member facts - are existentially tied, so a generated bridge cannot prove facts for one - model function and discharge a root using another. -/ -def compositionClaimSemanticBridge - (artifact : ArtifactData) (claim : CompositionClaim) - (callees : List String) : Prop := - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal) - (hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w ∧ S.Canon w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w ∧ S.Canon w) - (hMul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - mul [va, vb] = some w → S.Repr (a * b) w ∧ S.Canon w) - (hStringEq : ∀ a b w, stringEq [a, b] = some w → - w = b32 (stringEqW a b)) - (hStringConcat : ∀ resultTy parts c, - stringConcat resultTy [parts] = some c → - stringConcatW resultTy parts = some c) - (hToIndex : ∀ n v r, S.Repr n v → toIndex [v] = some r → - r = .i32v (toIndexW n)) - (hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → - S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) - (hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → - S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ (n : Int) (v : WVal) (models : String → Int → Int) - (rootModel : Int → Int), - vs = [v] ∧ S.Repr n v ∧ - (∀ input, rootModel input = - CompositionSoundness.evalCompositionCalls models callees input) ∧ - (∀ w, S.Repr (rootModel n) w → - claim.obligation.codRepr S (claim.obligation.model x) w) ∧ - ∀ funcTable, - compositionFuncTable artifact.modBytes artifact.modLen - artifact.compositionMembers = some funcTable → - ∀ name ∈ callees, - Nonempty (CompositionSoundness.MemberFact S artifact.compositionMembers - funcTable claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - models name) - -/-- Artifact-wide form of the tied composition bridge. Each root's selected - source models and member facts remain in one proposition. -/ -def compositionClaimSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.compositionClaims, - ∀ rootMember, - compositionMemberForName claim.exportName artifact.compositionMembers = - some rootMember → - ∀ callees, rootMember.plan.shape = .chain callees → - compositionClaimSemanticBridge artifact claim callees - -/-- Per-obligation option-(b) composition discharge. Acceptance supplies the - byte-derived root and member table; the single semantic bridge supplies a - source model and member facts tied to that same model selection. -/ -theorem composition_claim_discharges_with_bridge - (artifact : ArtifactData) - (claim : CompositionClaim) - (hClaim : compositionClaimAccepted artifact.modBytes artifact.modLen - artifact.compositionMembers claim) - (hBridge : ∀ rootMember, - compositionMemberForName claim.exportName artifact.compositionMembers = - some rootMember → - ∀ callees, rootMember.plan.shape = .chain callees → - compositionClaimSemanticBridge artifact claim callees) : - obligationHolds claim.obligation := by - rcases hClaim with ⟨_hExport, hCarrier, _hHostCheck, _hHostTypes, hHost, hClaim⟩ - cases hTable : compositionFuncTable artifact.modBytes artifact.modLen - artifact.compositionMembers with - | none => simp [hTable] at hClaim - | some funcTable => - simp only [hTable] at hClaim - rcases hClaim with ⟨hClosure, hRootIdx, hNamed⟩ - obtain ⟨rootMember, callees, hRootLookup, hShape, hRootMem⟩ := - compositionClosureBound_root claim.exportName claim.memberNames - artifact.compositionMembers funcTable hClosure - obtain ⟨acceptedRoot, hAcceptedLookup, hRootAccepted⟩ := - compositionNamedMemberAccepted_of_mem artifact.modBytes artifact.modLen - claim.carrier claim.hostTable funcTable claim.obligation - artifact.compositionMembers claim.memberNames hNamed - claim.exportName hRootMem - rw [hRootLookup] at hAcceptedLookup - have hRootEq : acceptedRoot = rootMember := - (Option.some.inj hAcceptedLookup).symm - subst acceptedRoot - clear hClosure - rcases hRootAccepted with - ⟨hCheck, body, codeEntry, binding, hLower, _hCodeEntry, - hExactBinding, _hType, _hHostTypes, hCode⟩ - unfold AverCert.WasmSlice.exactFuncBindingForExport at hExactBinding - have hBinding := Option.eq_some_of_filter_eq_some hExactBinding - cases hTarget : AverCert.PlanLower.compositionFuncIdx? - funcTable claim.exportName with - | none => simp [hTarget] at hRootIdx - | some rootIdx => - have hSelf : claim.obligation.self = rootIdx := by - simpa [hTarget] using hRootIdx - have hBindingIdx : binding.funcIdx = rootIdx := by - have hResolved := compositionFuncIdx_eq_binding - artifact.modBytes artifact.modLen artifact.compositionMembers - funcTable claim.exportName rootMember binding hTable - hRootLookup hBinding - rw [hTarget] at hResolved - exact (Option.some.inj hResolved).symm - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, compositionNLocals rootMember.plan, body⟩ := by - simpa [hSelf, ← hBindingIdx] using hCode - rcases hBridge rootMember hRootLookup callees hShape with - ⟨hPolicy, hModel⟩ - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub hMul hStringEq hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hModel S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub hMul hStringEq hStringConcat _hToIndex _hCmp _hEq x vs hDom with - ⟨n, v, models, rootModel, rfl, hv, hRootModel, hCod, hMembers⟩ - have hCertified := CompositionSoundness.generic_composition_certified - S artifact.compositionMembers funcTable claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - models rootModel claim.obligation.self claim.hostTable - rootMember.plan callees hShape hCheck body hLower hCodeSelf - (fun name hName => Classical.choice - (hMembers funcTable hTable name hName)) hRootModel - apply hCod - exact hCertified fuel n v w hv hRun - -/-- Family slice discharge through the tied root/member bridge consumed by the -production accept-sound capstone. -/ -theorem composition_discharges_with_bridges - (artifact : ArtifactData) - (hAcc : acceptedCompositionFragments artifact) - (hBridges : compositionClaimSemanticBridges artifact) : - ∀ o ∈ artifact.compositionClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - have hClaim : compositionClaimAccepted artifact.modBytes artifact.modLen - artifact.compositionMembers claim := - allClaims_of_mem - (compositionClaimAccepted artifact.modBytes artifact.modLen - artifact.compositionMembers) - artifact.compositionClaims hAcc.1 claim hMem - exact composition_claim_discharges_with_bridge artifact claim hClaim - (hBridges claim hMem) - -end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/DischargeConstruct.lean b/aver-cert/assets/wall/current/DischargeConstruct.lean deleted file mode 100644 index 4613d0686..000000000 --- a/aver-cert/assets/wall/current/DischargeConstruct.lean +++ /dev/null @@ -1,338 +0,0 @@ -/- -Acceptance-soundness wiring for constructors. - -Acceptance supplies the checked plan, canonical lowering, and exact code -entry. The independent semantic face is kept explicit, as in the established -field-projection discharge pattern. --/ -import AcceptanceSoundnessCore -import ConstructVerbatimSoundness - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -/-- The semantic face not carried by `constructPlanAccepted`: represented -inputs have the plan's arity and the exact constructed `WVal` represents the -obligation's independently declared model result. -/ -def constructSemanticBridge - (claim : ConstructClaim) (plan : ConstructRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (args : List WVal), - claim.obligation.domRepr S x args → - args.length = plan.arity ∧ - claim.obligation.codRepr S (claim.obligation.model x) - (.structv claim.structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields)) - -def constructSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.constructClaims, - ∀ plan, - constructPlanForExport claim.exportName - artifact.manifest.constructPlans = some plan → - constructSemanticBridge claim plan - -private theorem construct_run_succ_eq_one - (structIdx : Nat) (plan : ConstructRawPlan) - (code : CodeTbl) (host : HostTbl) (self : Nat) - (hCheck : AverCert.PlanCheck.checkConstructRawPlan plan = true) - (body : List WInstr) - (hLow : AverCert.PlanLower.lowerConstructBody structIdx plan = some body) - (hCode : code self = some - { arity := plan.arity, nlocals := 1, body := body }) - (fuel : Nat) (args : List WVal) (hLen : args.length = plan.arity) : - wFuncN code host (fuel + 1) self args = - wFuncN code host 1 self args := by - have hCanonical : body = - AverCert.PlanLower.lowerConstructFields structIdx plan.fields ++ - [.structNew structIdx plan.fields.length] := by - simp [AverCert.PlanLower.lowerConstructBody, hCheck] at hLow - exact hLow.symm - subst body - have hReadable := ConstructVerbatimSoundness.accepted_fields_readable - plan 1 args hCheck hLen - have hFuel := ConstructVerbatimSoundness.simNodes_construct - host (fun g => (code g).map (·.arity)) - (fun g as => wFuncN code host fuel g as) - structIdx (args ++ List.replicate 1 .null) plan.fields hReadable - [.structNew structIdx plan.fields.length] [] - have hOne := ConstructVerbatimSoundness.simNodes_construct - host (fun g => (code g).map (·.arity)) (fun _ _ => none) - structIdx (args ++ List.replicate 1 .null) plan.fields hReadable - [.structNew structIdx plan.fields.length] [] - simp only [wFuncN, hCode, initLocals] - change ConstructVerbatimSoundness.outValue - (wRunF host (fun g => (code g).map (·.arity)) - (fun g as => wFuncN code host fuel g as) - (AverCert.PlanLower.lowerConstructFields structIdx plan.fields ++ - [.structNew structIdx plan.fields.length]) - (args ++ List.replicate 1 .null) []) = - ConstructVerbatimSoundness.outValue - (wRunF host (fun g => (code g).map (·.arity)) (fun _ _ => none) - (AverCert.PlanLower.lowerConstructFields structIdx plan.fields ++ - [.structNew structIdx plan.fields.length]) - (args ++ List.replicate 1 .null) []) - rw [hFuel, hOne] - simp [wRunF] - -/-- The single byte-to-execution seam for one accepted constructor claim. - It exposes the selected plan and its exact result at every positive fuel; - downstream model discharge no longer reopens artifact acceptance. -/ -theorem construct_accepted_call - (artifact : ArtifactData) - (hAcc : acceptedConstructFragments artifact) - (claim : ConstructClaim) - (hMem : claim ∈ artifact.constructClaims) : - ∃ plan, - constructPlanForExport claim.exportName - artifact.manifest.constructPlans = some plan ∧ - ∀ (host : HostTbl) (fuel : Nat) (args : List WVal), - args.length = plan.arity → - wFuncN claim.obligation.code host (fuel + 1) - claim.obligation.self args = - some (.structv claim.structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields)) := by - have hClaim : constructClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := by - exact allClaims_of_mem - (constructClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.constructClaims hAcc.1 claim hMem - unfold constructClaimAccepted at hClaim - cases hPlan : constructPlanForExport claim.exportName - artifact.manifest.constructPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : constructPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.structIdx claim.fieldCount claim.elemTy claim.symPlan - plan claim.obligation := by - simpa [hPlan] using hClaim - rcases hAccepted with - ⟨_hExport, _hCarrier, _hSym, _hMatches, hCheck, _hFields, - body, codeEntry, binding, hLow, _hCodeEntry, _hExactBinding, - hSelf, _hStructTy, _hFuncTy, hCode⟩ - have hCodeSelf : claim.obligation.code claim.obligation.self = - some { arity := plan.arity, nlocals := 1, body := body } := by - simpa [← hSelf] using hCode - refine ⟨plan, rfl, ?_⟩ - intro host fuel args hLen - have hOne := ConstructVerbatimSoundness.generic_construct_certified - claim.structIdx plan claim.obligation.code host claim.obligation.self 1 - hCheck body hLow hCodeSelf args hLen - exact (construct_run_succ_eq_one - claim.structIdx plan claim.obligation.code host claim.obligation.self - hCheck body hLow hCodeSelf fuel args hLen).trans hOne - -/-- Per-obligation option-(b) discharge for a concrete model-bearing -constructor export. The checked plan, canonical lowering, and code binding are -data; `hSemantic` is the intentionally residual bridge from the named source -model to the exact plan-derived constructed value. -/ -theorem construct_canonical_discharges - (exportName : String) (carrier structIdx self : Nat) - (plan : ConstructRawPlan) (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hCheck : AverCert.PlanCheck.checkConstructRawPlan plan = true) - (body : List WInstr) - (hLow : AverCert.PlanLower.lowerConstructBody structIdx plan = some body) - (hCode : code self = some - { arity := plan.arity, nlocals := 1, body := body }) - (hSemantic : ∀ (S : CarrierSpec carrier) (x : Dom) (args : List WVal), - domRepr S x args → - args.length = plan.arity ∧ - codRepr S (model x) - (.structv structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields))) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := Dom - Cod := Cod - domRepr := domRepr - codRepr := codRepr - model := model } : Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x args w hDom hRun - rcases hSemantic S x args hDom with ⟨hLen, hCod⟩ - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hCall := ConstructVerbatimSoundness.generic_construct_certified - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self 1 - hCheck body hLow hCode args hLen - have hFuel := construct_run_succ_eq_one - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self - hCheck body hLow hCode fuel args hLen - rw [hFuel, hCall] at hRun - have hw : - .structv structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields) = w := - Option.some.inj hRun - simpa [← hw] using hCod - -/-- Canonical option-(c) leaf bridge for a unary verbatim constructor pack. -/ -theorem constructUnary_canonical_discharges - (exportName : String) (carrier structIdx self : Nat) - (plan : ConstructRawPlan) (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (hArity : plan.arity = 1) - (hCheck : AverCert.PlanCheck.checkConstructRawPlan plan = true) - {body : List WInstr} - (hLow : AverCert.PlanLower.lowerConstructBody structIdx plan = some body) - (hCode : code self = some - { arity := plan.arity, nlocals := 1, body := body }) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := WVal - Cod := WVal - domRepr := fun _ p vs => vs = [p] - codRepr := fun S v w => verbatimRepr S v w - model := fun p => .structv structIdx - (ConstructVerbatimSoundness.constructModelFields - ([p] ++ List.replicate 1 .null) plan.fields) } : Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel p args w hDom hRun - subst args - have hLen : [p].length = plan.arity := by simp [hArity] - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hCall := ConstructVerbatimSoundness.generic_construct_certified - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self 1 - hCheck body hLow hCode [p] hLen - have hFuel := construct_run_succ_eq_one - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self - hCheck body hLow hCode fuel [p] hLen - rw [hFuel, hCall] at hRun - exact (Option.some.inj hRun).symm - -/-- Canonical option-(c) leaf bridge for a binary verbatim constructor pack. -/ -theorem constructBinary_canonical_discharges - (exportName : String) (carrier structIdx self : Nat) - (plan : ConstructRawPlan) (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (hArity : plan.arity = 2) - (hCheck : AverCert.PlanCheck.checkConstructRawPlan plan = true) - {body : List WInstr} - (hLow : AverCert.PlanLower.lowerConstructBody structIdx plan = some body) - (hCode : code self = some - { arity := plan.arity, nlocals := 1, body := body }) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := WVal × WVal - Cod := WVal - domRepr := fun _ p vs => vs = [p.1, p.2] - codRepr := fun S v w => verbatimRepr S v w - model := fun p => .structv structIdx - (ConstructVerbatimSoundness.constructModelFields - ([p.1, p.2] ++ List.replicate 1 .null) plan.fields) } : Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel p args w hDom hRun - subst args - have hLen : [p.1, p.2].length = plan.arity := by simp [hArity] - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hCall := ConstructVerbatimSoundness.generic_construct_certified - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self 1 - hCheck body hLow hCode [p.1, p.2] hLen - have hFuel := construct_run_succ_eq_one - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self - hCheck body hLow hCode fuel [p.1, p.2] hLen - rw [hFuel, hCall] at hRun - exact (Option.some.inj hRun).symm - -theorem construct_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedConstructFragments artifact) - (claim : ConstructClaim) - (hMem : claim ∈ artifact.constructClaims) - (hBridge : ∀ plan, - constructPlanForExport claim.exportName - artifact.manifest.constructPlans = some plan → - constructSemanticBridge claim plan) : - obligationHolds claim.obligation := by - rcases construct_accepted_call artifact hAcc claim hMem with - ⟨plan, hPlan, hCall⟩ - rcases hBridge plan hPlan with ⟨hPolicy, hSemantic⟩ - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x args w hDom hRun - rcases hSemantic S x args hDom with ⟨hLen, hCod⟩ - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hResult := hCall - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - fuel args hLen - rw [hResult] at hRun - have hw : - .structv claim.structIdx - (ConstructVerbatimSoundness.constructModelFields - (args ++ List.replicate 1 .null) plan.fields) = w := - Option.some.inj hRun - simpa [← hw] using hCod - -theorem construct_discharges - (artifact : ArtifactData) - (hAcc : acceptedConstructFragments artifact) - (hSemantic : constructSemanticBridges artifact) : - ∀ o ∈ artifact.constructClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact construct_claim_discharges artifact hAcc claim hMem - (hSemantic claim hMem) - -end AcceptanceSoundness - --- Compatibility diagnostic; the checker enforces axioms once at the root. -#print axioms AcceptanceSoundness.construct_canonical_discharges diff --git a/aver-cert/assets/wall/current/DischargeExprFragment.lean b/aver-cert/assets/wall/current/DischargeExprFragment.lean deleted file mode 100644 index 592bd4626..000000000 --- a/aver-cert/assets/wall/current/DischargeExprFragment.lean +++ /dev/null @@ -1,818 +0,0 @@ -/- -Acceptance-soundness wiring for source expression fragments. - -Acceptance pins the audited SymRawPlan encoder, checked representation plan, -canonical lowering, and exact code entry. The independent obligation -domain/model face and the plan-evaluator result stay explicit, following the -established family-discharge pattern. The bridge chooses the exact input -values: comparison fragments use `carrierSmall`, Bool fragments use `b32`, -and contracted integer fragments preserve arbitrary represented inputs. For -partial host contracts, the successful byte run is exposed only to rule out a -missing host result; the audited generic still identifies the evaluator result -with the byte result. --/ -import AcceptanceSoundnessCore -import StandardFace - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -/-- The semantic face not carried by `symFragmentPlanAccepted`. It relates an -arbitrary obligation-domain representation to the generic theorem's honest -input values and pins the SymRawPlan-derived evaluator's result to the -obligation's independently declared model/codomain relation. -/ -def exprFragmentSemanticBridge - (claim : SymFragmentClaim) (plan : ExprFragmentRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal) - (hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w ∧ S.Canon w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w ∧ S.Canon w) - (hMul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - mul [va, vb] = some w → S.Repr (a * b) w ∧ S.Canon w) - (hStringEq : ∀ a b w, stringEq [a, b] = some w → - w = b32 (stringEqW a b)) - (hStringConcat : ∀ resultTy parts c, - stringConcat resultTy [parts] = some c → - stringConcatW resultTy parts = some c) - (hToIndex : ∀ n v r, S.Repr n v → toIndex [v] = some r → - r = .i32v (toIndexW n)) - (hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → - S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) - (hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → - S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) - (fuel : Nat) (x : claim.obligation.Dom) (vs : List WVal) (w : WVal), - claim.obligation.domRepr S x vs → - wFuncN claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - (fuel + 1) claim.obligation.self vs = some w → - ∃ (inputs : List WVal) (modelLocals : List WVal) (result : WVal), - vs = inputs ∧ - inputs.length = plan.params.length ∧ - ExprFragmentSoundness.blockCallsOK - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - (fun g => (claim.obligation.code g).map (fun c => c.arity)) - plan.body ∧ - ExprFragmentSemantics.evalSymRawPlan - claim.hostTable claim.structTable - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - (fun g => (claim.obligation.code g).map (fun c => c.arity)) - (fun g args => wFuncN claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) fuel g args) - claim.obligation.carrier claim.plan - (initLocals ⟨plan.params.length, exprFragmentNLocals plan, []⟩ - inputs) = - some (.ok modelLocals [result]) ∧ - claim.obligation.codRepr S (claim.obligation.model x) result - -/-- The audited expression-fragment generic currently owns exactly the -integer/Bool boundary admitted by the producer classifier. -/ -def exprFragmentUsesAuditedGeneric (claim : SymFragmentClaim) : Bool := - claim.plan.params.all (fun ty => ty = .int || ty = .bool) && - (claim.plan.result = .int || claim.plan.result = .bool) - -/-- Float semantics are deliberately outside the audited integer/Bool model. A -float at the source boundary is the only bespoke residual admitted below. -/ -def exprFragmentHasFloatBoundary (claim : SymFragmentClaim) : Bool := - claim.plan.params.any (· = .float) || claim.plan.result = .float - -/-- Projection-faced expression fragments are migrated, but their canonical -discharge lives in the audited field-projection wall. -/ -def exprFragmentHasFieldProjection (claim : SymFragmentClaim) : Bool := - claim.plan.body.nodes.any (fun node => - match node.kind with - | .projectField _ _ _ _ => true - | _ => false) - -/-- Tag-dispatch fragments (Option/Result `match` returning an Int constant) -also discharge through the symbolic generic — their operational model is a -conditional over boxed constants — but their source scrutinee is an ADT, so -they are outside the int/Bool `exprFragmentUsesAuditedGeneric` gate. The gate -here is the encoded representation shape: an `adtRef` scrutinee, an `intCarrier` -result, and a `struct.get.user` tag read. -/ -def exprFragmentIsTagDispatch (claim : SymFragmentClaim) : Bool := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | some plan => - plan.params = [.adtRef] && plan.result = .intCarrier && - plan.body.nodes.any (fun node => - match node.kind with - | .structGetUser _ _ _ => true - | _ => false) - | none => false - -/-- Fused vector-read fragments (`Option.withDefault(Vector.get(p0, p1), d)`) -discharge through the audited template theorem -(`StandardFace.vectorGetOrDefault_simulates_model`), not through the symbolic -generic: their operational content is the monolithic bounds-checked template, -whose semantics the interpreter clauses prove once, generically over every -hole. The gate is the encoded representation shape: exactly the single -monolithic node. -/ -def exprFragmentIsVectorGetOrDefault (claim : SymFragmentClaim) : Bool := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | some plan => - match AverCert.WasmSlice.exprVectorGetOrDefaultArrTy? plan with - | some _ => true - | none => false - | none => false - -/-- Record-parameter field-read fragments (`isMember(p) = p.isMember`) carry -no producer semantic premise at all: the checked record face -(`StandardFace.recordParamDeclaredFace`, a conjunct of `checkedFaces`) pins the -type-section entry by equality against the wall lowering of the Plan record -declaration, and the discharge below derives the obligation from -`recordParam_simulates_model` plus byte acceptance. The gate is the encoded -representation shape: exactly the recognized two-node scalar field read. -/ -def exprFragmentIsRecordParam (claim : SymFragmentClaim) : Bool := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | some plan => (AverCert.WasmSlice.exprRecordProjFace? plan).isSome - | none => false - -/-- Int selection fragments (`match a < b { true -> a; false -> b }`), the same -way. Their result is a passthrough of an input local, so the codomain relation -is discharged by the chosen argument's own representation premise. -/ -def exprFragmentIsIntSelect (claim : SymFragmentClaim) : Bool := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | some plan => (AverCert.StandardFace.classifyIntSelect plan).isSome - | none => false - -/-- Routing marker for the record projection-compute face: the encoded plan - exists and the compute classifier fires on it. Like the record-parameter - arm, it contributes NO semantic premise — the discharge derives the - obligation from the checked declared face. -/ -def exprFragmentIsRecordCompute (claim : SymFragmentClaim) : Bool := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | some plan => - (AverCert.StandardFace.classifyRecordCompute claim.hostTable plan).isSome - | none => false - -/-- Side condition for one source expression claim. In-model claims must use -the symbolic generic. Projection claims may use the audited projection -generic. Fused vector-read claims discharge through the audited template -theorem. Only float-boundary claims may use a bespoke direct discharge. -Record-parameter claims contribute NO semantic premise: the arm only routes, -and the discharge derives their obligation from the checked record face. The -Int selection arm is the same shape — the face pins its model too, so the -only thing left to state is the partial-correctness policy the family runs -under. -/ -def exprFragmentSideCondition (claim : SymFragmentClaim) : Prop := - (exprFragmentUsesAuditedGeneric claim = true ∧ - ∀ plan, - AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan = some plan → - exprFragmentSemanticBridge claim plan) ∨ - (exprFragmentIsTagDispatch claim = true ∧ - ∀ plan, - AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan = some plan → - exprFragmentSemanticBridge claim plan) ∨ - (exprFragmentIsVectorGetOrDefault claim = true ∧ - obligationHolds claim.obligation) ∨ - (exprFragmentHasFieldProjection claim = true ∧ - obligationHolds claim.obligation) ∨ - (exprFragmentHasFloatBoundary claim = true ∧ - obligationHolds claim.obligation) ∨ - (exprFragmentIsRecordParam claim = true) ∨ - (exprFragmentIsIntSelect claim = true ∧ - claim.obligation.policy = .simulatesModel) ∨ - (exprFragmentIsRecordCompute claim = true) - -def exprFragmentSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.symFragmentClaims, exprFragmentSideCondition claim - -theorem exprFragment_claim_discharges_generic - (artifact : ArtifactData) - (hAcc : acceptedSymFragments artifact) - (claim : SymFragmentClaim) - (hMem : claim ∈ artifact.symFragmentClaims) - (hBridge : ∀ plan, - AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan = some plan → - exprFragmentSemanticBridge claim plan) : - obligationHolds claim.obligation := by - have hClaim : symFragmentClaimAccepted artifact.modBytes artifact.modLen claim := - allClaims_of_mem - (symFragmentClaimAccepted artifact.modBytes artifact.modLen) - artifact.symFragmentClaims hAcc claim hMem - unfold symFragmentClaimAccepted symFragmentPlanAccepted at hClaim - cases hEncode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | none => simp [hEncode] at hClaim - | some plan => - have hAccepted : symFragmentCarrierBound - artifact.modBytes artifact.modLen claim.carrier claim.hostTable - plan = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch - artifact.modBytes artifact.modLen claim.carrier - claim.hostTable = true ∧ - exprFragmentPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier plan claim.obligation := by - simpa [hEncode] using hClaim - have hAccepted := hAccepted.2.2 - rcases hAccepted with - ⟨_hExport, hCarrier, body, codeEntry, binding, hPlanAccepted, - _hFuncType, _hNominalTypes, hSelf, hCode⟩ - rcases hPlanAccepted with - ⟨hCheck, hLowerExpr, _hCodeEntry, _hExactBinding⟩ - rcases hBridge plan hEncode with ⟨hPolicy, hSemantic⟩ - have hLower : AverCert.PlanLower.lowerBlock - claim.obligation.carrier plan.body = some body := by - simp only [AverCert.PlanLower.lowerExprFragmentBody, hCheck, - if_true] at hLowerExpr - simpa [hCarrier] using hLowerExpr - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨plan.params.length, exprFragmentNLocals plan, body⟩ := by - simpa [← hSelf] using hCode - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub hMul hStringEq hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - rcases hSemantic S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub hMul hStringEq hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun with - ⟨inputs, modelLocals, result, rfl, hArity, hCalls, hEval, hCod⟩ - have hGeneric := ExprFragmentSoundness.exprfragment_generic_certified - S claim.hostTable claim.structTable claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - claim.plan plan hEncode hCheck body hLower claim.obligation.self - (exprFragmentNLocals plan) fuel hCodeSelf vs hArity hCalls - modelLocals result hEval - rw [hGeneric] at hRun - have hResult : result = w := Option.some.inj hRun - simpa [hResult] using hCod - -/-- Face-derived discharge of one record-parameter claim, mirroring the -declared-index envelope columns: the checked record face -(`StandardFace.recordParamDeclaredFace`) supplies the equality-pinned Plan -declaration and the `HEq` meaning pins, byte acceptance supplies the exact -canonical body at the obligation's own code/self, and -`recordParam_simulates_model` (through `recordParam_transport`) closes the run. -No producer semantic premise participates. -/ -theorem recordParam_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedSymFragments artifact) - (claim : SymFragmentClaim) - (hMem : claim ∈ artifact.symFragmentClaims) - (hFace : AverCert.StandardFace.symFragmentMatches - artifact.modBytes artifact.modLen artifact.manifest.subject.hostRoles claim) - (hIs : exprFragmentIsRecordParam claim = true) : - obligationHolds claim.obligation := by - have hClaim : symFragmentClaimAccepted artifact.modBytes artifact.modLen claim := - allClaims_of_mem - (symFragmentClaimAccepted artifact.modBytes artifact.modLen) - artifact.symFragmentClaims hAcc claim hMem - unfold symFragmentClaimAccepted symFragmentPlanAccepted at hClaim - unfold exprFragmentIsRecordParam at hIs - cases hEncode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | none => simp [hEncode] at hIs - | some plan => - simp only [hEncode, Option.isSome_iff_exists] at hIs - obtain ⟨⟨structIdx, field⟩, hRec⟩ := hIs - have hNone := AverCert.StandardFace.symFragmentFace_none_of_recordProj - claim plan hEncode structIdx field hRec - unfold AverCert.StandardFace.symFragmentMatches at hFace - obtain ⟨-, hMatch⟩ := hFace - simp only [hNone, hEncode, hRec] at hMatch - have hAccepted : symFragmentCarrierBound artifact.modBytes artifact.modLen - claim.carrier claim.hostTable plan = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch artifact.modBytes artifact.modLen - claim.carrier claim.hostTable = true ∧ - exprFragmentPlanAccepted artifact.modBytes artifact.modLen - claim.exportNameBytes claim.exportName claim.carrier plan - claim.obligation := by - simpa [hEncode] using hClaim - obtain ⟨-, -, hExpr⟩ := hAccepted - obtain ⟨-, hCarrier, body, codeEntry, binding, hByteAccepted, -, -, - hSelf, hCode⟩ := hExpr - obtain ⟨hCheck, hLowerExpr, -, -⟩ := hByteAccepted - obtain ⟨hparams, -, hplanBody⟩ := - AverCert.WasmSlice.exprRecordProjFace?_spec plan structIdx field hRec - have hLower : AverCert.PlanLower.lowerBlock claim.carrier plan.body - = some body := by - simp only [AverCert.PlanLower.lowerExprFragmentBody, hCheck, if_true] - at hLowerExpr - exact hLowerExpr - have hBody : body = recordProjTemplate structIdx field := by - rw [hplanBody, AverCert.StandardFace.lowerBlock_recordProj] at hLower - exact (Option.some.inj hLower).symm - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, exprFragmentNLocals plan, recordProjTemplate structIdx field⟩ := by - rw [hSelf, hCode, hBody, hparams] - rfl - obtain ⟨hPolicy, -, hCarrierEq, decl, structIdx', field', fields, hfield, - hdecl, hRec', -, -, -, -, -, hDomP, hCodP, hdomReprP, hcodReprP, - hmodelP⟩ := hMatch - rw [hRec] at hRec' - injection hRec' with hpair - injection hpair with hsi hfi - subst hsi - subst hfi - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - exact AverCert.StandardFace.recordParam_transport claim.carrier fields - structIdx field hfield claim.obligation.carrier claim.obligation.Dom - claim.obligation.Cod claim.obligation.domRepr claim.obligation.codRepr - claim.obligation.model hCarrierEq hDomP hCodP hdomReprP hcodReprP hmodelP - claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - claim.obligation.self (exprFragmentNLocals plan) hCodeSelf - S fuel x vs w hDom hRun - -/-- The same column for the Int selection shape. -/ -theorem intSelect_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedSymFragments artifact) - (claim : SymFragmentClaim) - (hMem : claim ∈ artifact.symFragmentClaims) - (hFace : AverCert.StandardFace.symFragmentMatches - artifact.modBytes artifact.modLen artifact.manifest.subject.hostRoles claim) - (hIs : exprFragmentIsIntSelect claim = true) - (hPolicy : claim.obligation.policy = .simulatesModel) : - obligationHolds claim.obligation := by - have hClaim : symFragmentClaimAccepted artifact.modBytes artifact.modLen claim := - allClaims_of_mem - (symFragmentClaimAccepted artifact.modBytes artifact.modLen) - artifact.symFragmentClaims hAcc claim hMem - unfold symFragmentClaimAccepted symFragmentPlanAccepted at hClaim - unfold exprFragmentIsIntSelect at hIs - cases hEncode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | none => simp [hEncode] at hIs - | some plan => - simp only [hEncode, Option.isSome_iff_exists] at hIs - obtain ⟨face, hCls⟩ := hIs - obtain ⟨hparams, -, hbody⟩ := - AverCert.StandardFace.classifyIntSelect_spec plan face hCls - have hAccepted : symFragmentCarrierBound artifact.modBytes artifact.modLen - claim.carrier claim.hostTable plan = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch artifact.modBytes artifact.modLen - claim.carrier claim.hostTable = true ∧ - exprFragmentPlanAccepted artifact.modBytes artifact.modLen - claim.exportNameBytes claim.exportName claim.carrier plan - claim.obligation := by - simpa [hEncode] using hClaim - obtain ⟨-, -, hExpr⟩ := hAccepted - obtain ⟨-, -, body, codeEntry, binding, hByteAccepted, -, -, hSelf, hCode⟩ := hExpr - obtain ⟨hCheck, hLowerExpr, -, -⟩ := hByteAccepted - have hLower : AverCert.PlanLower.lowerBlock claim.carrier plan.body - = some body := by - simp only [AverCert.PlanLower.lowerExprFragmentBody, hCheck, if_true] - at hLowerExpr - exact hLowerExpr - have hBody : body = - AverCert.StandardFace.intSelectTemplate face.op face.helperIdx := by - rw [hbody, AverCert.StandardFace.lowerBlock_intSelect] at hLower - exact (Option.some.inj hLower).symm - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨2, exprFragmentNLocals plan, - AverCert.StandardFace.intSelectTemplate face.op face.helperIdx⟩ := by - rw [hSelf, hCode, hBody, hparams] - rfl - have hFaceSel := AverCert.StandardFace.symFragmentFace_intSelect - claim plan face hEncode hCls - unfold AverCert.StandardFace.symFragmentMatches at hFace - obtain ⟨-, hMatch⟩ := hFace - simp only [hFaceSel] at hMatch - have hM : claim.obligation.carrier = claim.carrier ∧ - HEq claim.obligation.Dom (Int × Int) ∧ - HEq claim.obligation.Cod Int ∧ - HEq claim.obligation.domRepr - (AverCert.StandardFace.intPairSmallBandDomRepr claim.carrier) ∧ - HEq claim.obligation.codRepr (intRepr (C := claim.carrier)) ∧ - claim.obligation.host = AverCert.StandardFace.intCmpHost face ∧ - HEq claim.obligation.model - (AverCert.StandardFace.intSelectModel face.op) := hMatch - obtain ⟨hcar, hDomT, hCodT, hdomReprT, hcodReprT, hhost, hmodelT⟩ := hM - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex hCmp hEq fuel x vs w - hDom hRun - rw [hhost] at hRun - exact AverCert.StandardFace.intSelect_transport claim.carrier face.helperIdx - face.op claim.obligation.carrier claim.obligation.Dom claim.obligation.Cod - claim.obligation.domRepr claim.obligation.codRepr claim.obligation.model - hcar hDomT hCodT hdomReprT hcodReprT hmodelT S cmp eq - (canonicalCmp_smallBand S cmp hCmp) (canonicalEq_smallBand S eq hEq) - claim.obligation.code claim.obligation.self (exprFragmentNLocals plan) - hCodeSelf fuel x vs w hDom hRun - -/-! ### Record projection-compute discharge helpers - -The wasm entry runs with `initLocals`' one-slot `.null` scratch pad appended -to the arguments. The bridge's source evaluator mirrors that slot with its -own `SVal.pad`, so the two locals lists are pointwise `SRepr`-related from -the start and stay related when the inline sign template writes the slot. -The helpers here convert classifier facts into the bridge's admission and -typing hypotheses and transport the face's `HEq` pins onto the obligation -fields, like `recordParam_transport`. -/ - -section RecordComputeDischarge - -open ExprFragmentSemantics AverCert.PlanLower RecordComputeBridge - -private theorem sreprAll_len {C : Nat} {S : CarrierSpec C} {structIdx : Nat} : - ∀ {ss : List RecordComputeBridge.SVal} {ws : List WVal}, - SReprAll S structIdx ss ws → ss.length = ws.length := by - intro ss ws h - induction h with - | nil => rfl - | cons _ _ ih => simp [ih] - -private theorem planTyped_mem {structIdx : Nat} {tyOf : Nat → FragTy} - {params : List FragTy} : - ∀ {nodes : List FragNode}, planTyped structIdx tyOf params nodes → - ∀ n ∈ nodes, nodeTyped structIdx tyOf params n := by - intro nodes - induction nodes with - | nil => intro _ n hn; simp at hn - | cons head tail ih => - intro h n hn - rcases List.mem_cons.mp hn with rfl | htail - · exact h.1 - · exact ih h.2 n htail - -/-- The compute face's executable node admission implies the bridge's - table-keyed admission, kind by kind. -/ -private theorem recordComputeNodeOk_admits - (hostTable : List (HostRole × Nat)) (kind : FragNodeKind) - (h : AverCert.StandardFace.recordComputeNodeOk hostTable kind = true) : - nodeAdmitted hostTable kind = true := by - cases kind - case hostCall role f args => - cases role <;> - simp_all [AverCert.StandardFace.recordComputeNodeOk, - RecordComputeBridge.nodeAdmitted] - case prim op args => - cases op <;> - simp_all [AverCert.StandardFace.recordComputeNodeOk, - RecordComputeBridge.nodeAdmitted] - all_goals - simp_all [AverCert.StandardFace.recordComputeNodeOk, - RecordComputeBridge.nodeAdmitted] - -/-- A fired compute classifier evaluated the bridge's Bool typing face at the - pinned struct index — extracted by the same `split at` walk as - `classifyRecordCompute_spec`. -/ -private theorem classifyRecordCompute_typed - (hostTable : List (HostRole × Nat)) (plan : ExprFragmentRawPlan) - (face : AverCert.StandardFace.RecordComputeFace) - (h : AverCert.StandardFace.classifyRecordCompute hostTable plan - = some face) : - planTypedB face.structIdx - (fun nodeId => ((plan.body.nodes[nodeId]?).map (fun n => n.ty)).getD .i64) - plan.params plan.body.nodes = true := by - simp only [AverCert.StandardFace.classifyRecordCompute] at h - split at h - case isFalse => exact absurd h (by simp) - case isTrue => - split at h - case h_1 => - -- No node cites a struct: the face carries the reserved index `0`, and - -- the typing face was decided at that index. - split at h - case isTrue => exact absurd h (by simp) - case isFalse => - split at h - case isFalse => exact absurd h (by simp) - case isTrue hty => - have hface : face = ⟨0⟩ := (Option.some.inj h).symm - subst hface - exact hty - case h_2 i rest heq => - split at h - case isFalse => exact absurd h (by simp) - case isTrue hcond => - have hface : face = ⟨i⟩ := (Option.some.inj h).symm - subst hface - exact ((Bool.and_eq_true _ _).mp hcond).2 - -/-- The compute face's template-implies-model core, at the face's concrete - types: a successful `wFuncN` run of the canonically lowered body under - the compute-face host slots yields a word representing the source - evaluator's result — instruction-run success gives plan-walker success - (`runBlock_complete`), and the lockstep agreement - (`sourceRunBlock_agrees`) lands on the model's value. -/ -private theorem recordCompute_simulates_model - (carrier structIdx : Nat) (hostTable : List (HostRole × Nat)) - (plan : ExprFragmentRawPlan) (body : List WInstr) - (hDistinct : AverCert.PlanCheck.hostTableIndicesDistinct hostTable = true) - (hAdm : nodesAdmitted hostTable plan.body.nodes = true) - (hTyB : planTypedB structIdx - (fun nodeId => ((plan.body.nodes[nodeId]?).map (fun n => n.ty)).getD .i64) - plan.params plan.body.nodes = true) - (hLower : AverCert.PlanLower.lowerBlock carrier plan.body = some body) - (code : CodeTbl) (self : Nat) - (hCode : code self = some ⟨plan.params.length, 1, body⟩) - (S : CarrierSpec carrier) - (add sub mul cmp eq : List WVal → Option WVal) - (hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w ∧ S.Canon w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w ∧ S.Canon w) - (hMul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - mul [va, vb] = some w → S.Repr (a * b) w ∧ S.Canon w) - (hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) - (hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) - (fuel : Nat) (x : List RecordComputeBridge.SVal) (vs : List WVal) (w : WVal) - (hdom : AverCert.StandardFace.recordComputeDomRepr carrier structIdx - plan.params S x vs) - (hRun : wFuncN code - (AverCert.StandardFace.recordComputeSlots carrier add sub mul cmp eq - hostTable) - fuel self vs = some w) : - AverCert.StandardFace.recordComputeCodRepr carrier structIdx S - (AverCert.StandardFace.recordComputeModel plan.body x) w := by - obtain ⟨hSRepr, hLen, hTyIdx⟩ := hdom - have hTy := planTypedB_sound hTyB - have hbox : ∀ (n : Int) (bw : WVal), -(2 ^ 63 : Int) ≤ n → n < 2 ^ 63 → - boxRef carrier [WVal.i64v n] = some bw → CanonRepr S n bw := by - intro n bw hlo hhi hb - simp only [boxRef, Option.some.injEq] at hb - exact ⟨hb ▸ S.smallIntro n, hb ▸ (S.canonSmall n).mpr ⟨hlo, hhi⟩⟩ - have hC : Contracts S (boxRef carrier) add sub mul cmp eq := - ⟨hbox, hAdd, hSub, hMul, hCmp, hEq⟩ - have hHost : ∀ role idx, - role ∈ [HostRole.box, HostRole.add, HostRole.sub, HostRole.mul, - HostRole.cmp, HostRole.eq] → - AverCert.PlanCheck.hostRoleIdx? hostTable role = some idx → - AverCert.StandardFace.recordComputeSlots carrier add sub mul cmp eq - hostTable idx = - some (roleArity role, - roleFn (boxRef carrier) add sub mul cmp eq role) := - fun role idx hRole hLookup => - AverCert.StandardFace.recordComputeSlots_bind carrier add sub mul cmp eq - hostTable hDistinct role idx hRole hLookup - have hlow : AverCert.PlanLower.lowerBlockFuel AverCert.PlanCheck.maxFuel - carrier plan.body = some body := hLower - have hpad : (vs ++ List.replicate 1 WVal.null) = vs ++ [WVal.null] := by simp - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - simp only [wFuncN, hCode, initLocals] at hRun - split at hRun - next ls v heq => - have hvw : v = w := Option.some.inj hRun - subst hvw - have hRB := runBlock_complete _ _ _ hostTable - AverCert.PlanCheck.maxFuel carrier plan.body body _ _ - hAdm hlow heq (Or.inl ⟨ls, v, rfl⟩) - rw [hpad] at hRB - obtain ⟨wl, w', sv, hout, hsrc, hsrepr⟩ := - sourceRunBlock_agrees S structIdx (boxRef carrier) add sub mul cmp eq - hC _ _ _ hostTable hHost AverCert.PlanCheck.maxFuel plan.body x vs - _ hAdm - (fun nodeId => - ((plan.body.nodes[nodeId]?).map (fun n => n.ty)).getD .i64) - plan.params hTy hLen hTyIdx hSRepr hRB - injection hout with hls hst - injection hst with hvv htail - subst hvv - exact ⟨sv, hsrc, hsrepr⟩ - next v heq => - have hRB := runBlock_complete _ _ _ hostTable - AverCert.PlanCheck.maxFuel carrier plan.body body _ _ - hAdm hlow heq (Or.inr ⟨v, rfl⟩) - rw [hpad] at hRB - obtain ⟨wl, w', sv, hout, -, -⟩ := - sourceRunBlock_agrees S structIdx (boxRef carrier) add sub mul cmp eq - hC _ _ _ hostTable hHost AverCert.PlanCheck.maxFuel plan.body x vs - _ hAdm - (fun nodeId => - ((plan.body.nodes[nodeId]?).map (fun n => n.ty)).getD .i64) - plan.params hTy hLen hTyIdx hSRepr hRB - simp at hout - next => simp at hRun - -/-- The dependent-cast shell: the obligation's field values arrive as free - variables with the declared face's `Eq`/`HEq` pins, `subst` collapses - every pin (the face's `Dom`/`Cod` are concrete types), and the core - theorem above closes the run. Mirrors `recordParam_transport`. -/ -private theorem recordCompute_transport - (claimCarrier : Nat) (face : AverCert.StandardFace.RecordComputeFace) - (hostTable : List (HostRole × Nat)) (plan : ExprFragmentRawPlan) - (body : List WInstr) - (hDistinct : AverCert.PlanCheck.hostTableIndicesDistinct hostTable = true) - (hAdm : nodesAdmitted hostTable plan.body.nodes = true) - (hTyB : planTypedB face.structIdx - (fun nodeId => ((plan.body.nodes[nodeId]?).map (fun n => n.ty)).getD .i64) - plan.params plan.body.nodes = true) - (hLower : AverCert.PlanLower.lowerBlock claimCarrier plan.body = some body) - (carrier : Nat) (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hcar : carrier = claimCarrier) - (hDomT : HEq Dom (List RecordComputeBridge.SVal)) - (hCodT : HEq Cod (Option RecordComputeBridge.SVal)) - (hdomReprT : HEq domRepr (AverCert.StandardFace.recordComputeDomRepr - claimCarrier face.structIdx plan.params)) - (hcodReprT : HEq codRepr (AverCert.StandardFace.recordComputeCodRepr - claimCarrier face.structIdx)) - (hmodelT : HEq model (AverCert.StandardFace.recordComputeModel plan.body)) - (code : CodeTbl) (self : Nat) - (hCode : code self = some ⟨plan.params.length, 1, body⟩) - (S : CarrierSpec carrier) - (add sub mul cmp eq : List WVal → Option WVal) - (hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w ∧ S.Canon w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w ∧ S.Canon w) - (hMul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - mul [va, vb] = some w → S.Repr (a * b) w ∧ S.Canon w) - (hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) - (hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) - (fuel : Nat) (x : Dom) (vs : List WVal) (w : WVal) - (hdom : domRepr S x vs) - (hRun : wFuncN code - (AverCert.StandardFace.recordComputeSlots claimCarrier add sub mul cmp eq - hostTable) - fuel self vs = some w) : - codRepr S (model x) w := by - subst hcar - have hD : Dom = List RecordComputeBridge.SVal := eq_of_heq hDomT - subst hD - have hCo : Cod = Option RecordComputeBridge.SVal := eq_of_heq hCodT - subst hCo - have e1 : domRepr = AverCert.StandardFace.recordComputeDomRepr carrier - face.structIdx plan.params := eq_of_heq hdomReprT - subst e1 - have e2 : codRepr = AverCert.StandardFace.recordComputeCodRepr carrier - face.structIdx := eq_of_heq hcodReprT - subst e2 - have e3 : model = AverCert.StandardFace.recordComputeModel plan.body := - eq_of_heq hmodelT - subst e3 - exact recordCompute_simulates_model carrier face.structIdx hostTable plan - body hDistinct hAdm hTyB hLower code self hCode S add sub mul cmp eq - hAdd hSub hMul hCmp hEq fuel x vs w hdom hRun - -/-- Face-derived discharge of one record projection-compute claim: the - declared face pins the obligation's meaning to the wall's compute-face - terms (plan-as-claim); byte acceptance pins the checked plan, its - canonical lowering, and the exact code entry; the run then transports - through the bridge: instruction-run success gives plan-walker success - (`runBlock_complete`), the lockstep agreement gives a source result - SRepr-related to the machine word, and that IS the model's value. -/ -theorem recordCompute_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedSymFragments artifact) - (claim : SymFragmentClaim) - (hMem : claim ∈ artifact.symFragmentClaims) - (hFace : AverCert.StandardFace.symFragmentMatches - artifact.modBytes artifact.modLen artifact.manifest.subject.hostRoles claim) - (hIs : exprFragmentIsRecordCompute claim = true) : - obligationHolds claim.obligation := by - have hClaim : symFragmentClaimAccepted artifact.modBytes artifact.modLen claim := - allClaims_of_mem - (symFragmentClaimAccepted artifact.modBytes artifact.modLen) - artifact.symFragmentClaims hAcc claim hMem - unfold symFragmentClaimAccepted symFragmentPlanAccepted at hClaim - unfold exprFragmentIsRecordCompute at hIs - cases hEncode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | none => simp [hEncode] at hIs - | some plan => - simp only [hEncode, Option.isSome_iff_exists] at hIs - obtain ⟨face, hFace'⟩ := hIs - obtain ⟨-, hAllOk, hAny, -⟩ := - AverCert.StandardFace.classifyRecordCompute_spec claim.hostTable plan - face hFace' - have hproj : AverCert.WasmSlice.exprRecordProjFace? plan = none := by - cases hp : AverCert.WasmSlice.exprRecordProjFace? plan with - | none => rfl - | some p => - obtain ⟨si, fi⟩ := p - exact absurd - (AverCert.StandardFace.exprRecordProjFace?_no_compute plan si fi hp) - (by simp [hAny]) - have hNone := AverCert.StandardFace.symFragmentFace_none_of_recordCompute - claim plan hEncode face hFace' - unfold AverCert.StandardFace.symFragmentMatches at hFace - obtain ⟨hBound, hMatch⟩ := hFace - simp only [hNone, hEncode, hproj, hFace'] at hMatch - obtain ⟨hPolicy, -, -, -, fields, paramTys, resultTy, -, -, -, -, - hMatches⟩ := hMatch - have hM : claim.obligation.carrier = claim.carrier ∧ - HEq claim.obligation.Dom (List RecordComputeBridge.SVal) ∧ - HEq claim.obligation.Cod (Option RecordComputeBridge.SVal) ∧ - HEq claim.obligation.domRepr - (AverCert.StandardFace.recordComputeDomRepr claim.carrier - face.structIdx plan.params) ∧ - HEq claim.obligation.codRepr - (AverCert.StandardFace.recordComputeCodRepr claim.carrier - face.structIdx) ∧ - claim.obligation.host = - AverCert.StandardFace.recordComputeHost claim.carrier - claim.hostTable ∧ - HEq claim.obligation.model - (AverCert.StandardFace.recordComputeModel plan.body) := hMatches - obtain ⟨hcar, hDomT, hCodT, hdomReprT, hcodReprT, hhost, hmodelT⟩ := hM - have hDistinct : AverCert.PlanCheck.hostTableIndicesDistinct - claim.hostTable = true := by - simp only [AverCert.StandardFace.hostTableBound, Bool.and_eq_true] - at hBound - exact hBound.1 - have hAdm : nodesAdmitted claim.hostTable plan.body.nodes = true := by - simp only [RecordComputeBridge.nodesAdmitted, List.all_eq_true] - intro n hn - exact recordComputeNodeOk_admits claim.hostTable n.kind - (List.all_eq_true.mp hAllOk n hn) - have hTyB := classifyRecordCompute_typed claim.hostTable plan face hFace' - have hAccepted : symFragmentCarrierBound artifact.modBytes artifact.modLen - claim.carrier claim.hostTable plan = true ∧ - AverCert.WasmSlice.hostTableFuncTypesMatch artifact.modBytes - artifact.modLen claim.carrier claim.hostTable = true ∧ - exprFragmentPlanAccepted artifact.modBytes artifact.modLen - claim.exportNameBytes claim.exportName claim.carrier plan - claim.obligation := by - simpa [hEncode] using hClaim - obtain ⟨-, -, hExpr⟩ := hAccepted - obtain ⟨-, -, body, codeEntry, binding, hByteAccepted, -, -, hSelf, - hCode⟩ := hExpr - obtain ⟨hCheck, hLowerExpr, -, -⟩ := hByteAccepted - have hLower : AverCert.PlanLower.lowerBlock claim.carrier plan.body - = some body := by - simp only [AverCert.PlanLower.lowerExprFragmentBody, hCheck, if_true] - at hLowerExpr - exact hLowerExpr - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨plan.params.length, exprFragmentNLocals plan, body⟩ := by - rw [hSelf]; exact hCode - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub hMul _hStringEq _hStringConcat _hToIndex hCmp hEq - fuel x vs w hDom hRun - rw [hhost] at hRun - exact recordCompute_transport claim.carrier face claim.hostTable plan - body hDistinct hAdm hTyB hLower - claim.obligation.carrier claim.obligation.Dom claim.obligation.Cod - claim.obligation.domRepr claim.obligation.codRepr - claim.obligation.model - hcar hDomT hCodT hdomReprT hcodReprT hmodelT - claim.obligation.code claim.obligation.self hCodeSelf - S add sub mul cmp eq hAdd hSub hMul hCmp hEq fuel x vs w hDom hRun - -end RecordComputeDischarge - -theorem exprFragment_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedSymFragments artifact) - (claim : SymFragmentClaim) - (hMem : claim ∈ artifact.symFragmentClaims) - (hFace : AverCert.StandardFace.symFragmentMatches - artifact.modBytes artifact.modLen artifact.manifest.subject.hostRoles claim) - (hSide : exprFragmentSideCondition claim) : - obligationHolds claim.obligation := by - rcases hSide with hGeneric | hTagDispatch | hVectorGet | hProjection | hFloat | - hRecord | hIntSelect | hRecordCompute - · exact exprFragment_claim_discharges_generic artifact hAcc claim hMem hGeneric.2 - · exact exprFragment_claim_discharges_generic artifact hAcc claim hMem hTagDispatch.2 - · exact hVectorGet.2 - · exact hProjection.2 - · exact hFloat.2 - · exact recordParam_claim_discharges artifact hAcc claim hMem hFace hRecord - · exact intSelect_claim_discharges artifact hAcc claim hMem hFace - hIntSelect.1 hIntSelect.2 - · exact recordCompute_claim_discharges artifact hAcc claim hMem hFace - hRecordCompute - -theorem exprFragment_discharges - (artifact : ArtifactData) - (hAcc : acceptedSymFragments artifact) - (hFaces : allClaims (AverCert.StandardFace.symFragmentMatches - artifact.modBytes artifact.modLen artifact.manifest.subject.hostRoles) - artifact.symFragmentClaims) - (hSemantic : exprFragmentSemanticBridges artifact) : - ∀ o ∈ artifact.symFragmentClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact exprFragment_claim_discharges artifact hAcc claim hMem - (allClaims_of_mem _ artifact.symFragmentClaims hFaces claim hMem) - (hSemantic claim hMem) - -#print axioms intSelect_claim_discharges -#print axioms recordCompute_claim_discharges - -end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/DischargeFieldProjection.lean b/aver-cert/assets/wall/current/DischargeFieldProjection.lean deleted file mode 100644 index 22a95dfcb..000000000 --- a/aver-cert/assets/wall/current/DischargeFieldProjection.lean +++ /dev/null @@ -1,281 +0,0 @@ -/- -Acceptance-soundness wiring for field projections. - -This file deliberately separates the byte/plan theorem, which follows from -`acceptedFieldProjectionFragments`, from the semantic-face bridge required to -turn that theorem into `Obligation.holds`. --/ -import AcceptanceSoundnessCore -import FieldProjectionSoundness - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -/-- The semantic face which the raw field-projection acceptance predicate does -not currently carry. It says that represented inputs expose a two-field -struct and that the generic theorem's exact projected `WVal` represents the -obligation's independently declared model result. -/ -def fieldProjectionSemanticBridge - (claim : FieldProjectionClaim) (plan : FieldProjectionRawPlan) : Prop := - claim.fieldCount = 2 ∧ - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ a b, - vs = [.structv claim.structIdx [a, b]] ∧ - claim.obligation.codRepr S (claim.obligation.model x) - (FieldProjectionSoundness.pairProjection plan.fieldIdx a b) - -/-- Artifact-wide semantic bridges for all field-projection claims. The plan -is selected by the same manifest lookup used by -`fieldProjectionClaimAccepted`, preventing a bridge from naming a different -field index. -/ -def fieldProjectionSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.fieldProjectionClaims, - ∀ plan, - fieldProjectionPlanForExport claim.exportName - artifact.manifest.fieldProjectionPlans = some plan → - fieldProjectionSemanticBridge claim plan - -private theorem fieldProjection_run_succ_eq_one - (structIdx : Nat) (plan : FieldProjectionRawPlan) - (code : CodeTbl) (host : HostTbl) (self : Nat) - (hCheck : AverCert.PlanCheck.checkFieldProjectionRawPlan 2 plan = true) - (body : List WInstr) - (hLow : AverCert.PlanLower.lowerFieldProjectionBody structIdx 2 plan = some body) - (hCode : code self = some { arity := 1, nlocals := 3, body := body }) - (fuel : Nat) (a b : WVal) : - wFuncN code host (fuel + 1) self [.structv structIdx [a, b]] = - wFuncN code host 1 self [.structv structIdx [a, b]] := by - cases plan with - | mk profile fieldIdx => - have hCanonical : - [.localGet 0, .localSet 2, .localGet 2, .refCast structIdx, - .structGet structIdx fieldIdx, .localSet 1, .localGet 1] = body := by - rw [AverCert.PlanLower.lowerFieldProjectionBody, hCheck] at hLow - simpa using hLow - subst body - simp [wFuncN, hCode, initLocals, wRunF] - -/-- The single byte-to-execution seam for an accepted projection claim. - Acceptance itself proves the two-field profile; the result is exposed at - every positive fuel so model discharge need not reopen the byte facts. -/ -theorem fieldProjection_accepted_call - (artifact : ArtifactData) - (hAcc : acceptedFieldProjectionFragments artifact) - (claim : FieldProjectionClaim) - (hMem : claim ∈ artifact.fieldProjectionClaims) : - ∃ plan, - fieldProjectionPlanForExport claim.exportName - artifact.manifest.fieldProjectionPlans = some plan ∧ - ∀ (host : HostTbl) (fuel : Nat) (a b : WVal), - wFuncN claim.obligation.code host (fuel + 1) claim.obligation.self - [.structv claim.structIdx [a, b]] = - some (FieldProjectionSoundness.pairProjection plan.fieldIdx a b) := by - have hClaim : fieldProjectionClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := by - exact allClaims_of_mem - (fieldProjectionClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.fieldProjectionClaims hAcc claim hMem - unfold fieldProjectionClaimAccepted at hClaim - cases hPlan : fieldProjectionPlanForExport claim.exportName - artifact.manifest.fieldProjectionPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : fieldProjectionPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.structIdx claim.fieldCount claim.resultTy plan - claim.obligation := by - simpa [hPlan] using hClaim - rcases hAccepted with - ⟨_hExport, _hCarrier, hCheck, body, codeEntry, binding, - hLow, _hCodeEntry, _hExactBinding, _hStructTy, - _hFuncTy, hSelf, hCode⟩ - have hTwo : claim.fieldCount = 2 := by - by_cases hEq : claim.fieldCount = 2 - · exact hEq - · simp [AverCert.PlanCheck.checkFieldProjectionRawPlan, hEq] at hCheck - have hCheckTwo : AverCert.PlanCheck.checkFieldProjectionRawPlan 2 plan = true := by - simpa [hTwo] using hCheck - have hLowTwo : AverCert.PlanLower.lowerFieldProjectionBody - claim.structIdx 2 plan = some body := by - simpa [hTwo] using hLow - have hCodeSelf : claim.obligation.code claim.obligation.self = - some { arity := 1, nlocals := 3, body := body } := by - simpa [hSelf] using hCode - refine ⟨plan, rfl, ?_⟩ - intro host fuel a b - have hOne := FieldProjectionSoundness.generic_field_projection_certified - claim.structIdx plan claim.obligation.code host claim.obligation.self - hCheckTwo body hLowTwo hCodeSelf a b - exact (fieldProjection_run_succ_eq_one - claim.structIdx plan claim.obligation.code host claim.obligation.self - hCheckTwo body hLowTwo hCodeSelf fuel a b).trans hOne - -/-- Canonical option-(c) leaf bridge for one field projection. The obligation -face is fully canonical: a represented pair is lowered to a two-field struct, -the result is represented verbatim, and the model is the checked plan's pair -projection. Artifact-specific callers supply only the reducible plan check and -code-table binding; no per-obligation semantic proof remains. -/ -theorem fieldProjection_canonical_discharges - (exportName : String) - (carrier structIdx self : Nat) - (plan : FieldProjectionRawPlan) - (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (hCheck : AverCert.PlanCheck.checkFieldProjectionRawPlan 2 plan = true) - (hCode : code self = some { - arity := 1 - nlocals := 3 - body := [.localGet 0, .localSet 2, .localGet 2, .refCast structIdx, - .structGet structIdx plan.fieldIdx, .localSet 1, .localGet 1] }) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := WVal × WVal - Cod := WVal - domRepr := fun _ p vs => vs = [.structv structIdx [p.1, p.2]] - codRepr := fun S v w => verbatimRepr S v w - model := fun p => FieldProjectionSoundness.pairProjection plan.fieldIdx p.1 p.2 } : - Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel p vs w hDom hRun - rcases p with ⟨a, b⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - let body : List WInstr := - [.localGet 0, .localSet 2, .localGet 2, .refCast structIdx, - .structGet structIdx plan.fieldIdx, .localSet 1, .localGet 1] - have hLow : AverCert.PlanLower.lowerFieldProjectionBody structIdx 2 plan = - some body := by - simp [body, AverCert.PlanLower.lowerFieldProjectionBody, hCheck] - have hCall := FieldProjectionSoundness.generic_field_projection_certified - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self - hCheck body hLow hCode a b - have hFuel := fieldProjection_run_succ_eq_one - structIdx plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self - hCheck body hLow hCode fuel a b - rw [hFuel, hCall] at hRun - exact (Option.some.inj hRun).symm - -/-- Canonical option-(c) leaf bridge for the projection-faced expression -fragment lowering. This is the direct two-instruction sibling of -`fieldProjection_canonical_discharges`: the checked fragment loads its sole -struct argument and projects field zero or one without the legacy spill/cast -spine. -/ -theorem fieldProjection_direct_canonical_discharges - (exportName : String) - (carrier structIdx self fieldIdx : Nat) - (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (hField : fieldIdx < 2) - (hCode : code self = some { - arity := 1 - nlocals := 1 - body := [.localGet 0, .structGet structIdx fieldIdx] }) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := WVal × WVal - Cod := WVal - domRepr := fun _ p vs => vs = [.structv structIdx [p.1, p.2]] - codRepr := fun S v w => verbatimRepr S v w - model := fun p => FieldProjectionSoundness.pairProjection fieldIdx p.1 p.2 } : - Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel p vs w hDom hRun - rcases p with ⟨a, b⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - cases fieldIdx with - | zero => - simpa [FieldProjectionSoundness.pairProjection, verbatimRepr] using - (Option.some.inj (by - simpa [wFuncN, hCode, initLocals, wRunF] using hRun)).symm - | succ fieldIdx => - cases fieldIdx with - | zero => - simpa [FieldProjectionSoundness.pairProjection, verbatimRepr] using - (Option.some.inj (by - simpa [wFuncN, hCode, initLocals, wRunF] using hRun)).symm - | succ fieldIdx => omega - -/-- One accepted claim discharges once its semantic face is tied to the checked -projection plan. This is the complete reusable per-claim proof shape. -/ -theorem fieldProjection_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedFieldProjectionFragments artifact) - (claim : FieldProjectionClaim) - (hMem : claim ∈ artifact.fieldProjectionClaims) - (hBridge : ∀ plan, - fieldProjectionPlanForExport claim.exportName - artifact.manifest.fieldProjectionPlans = some plan → - fieldProjectionSemanticBridge claim plan) : - obligationHolds claim.obligation := by - unfold fieldProjectionSemanticBridge at hBridge - rcases fieldProjection_accepted_call artifact hAcc claim hMem with - ⟨plan, hPlan, hCall⟩ - rcases hBridge plan hPlan with ⟨_hTwo, hPolicy, hSemantic⟩ - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hSemantic S x vs hDom with ⟨a, b, hVs, hCod⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hResult := hCall - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - fuel a b - rw [hResult] at hRun - have hw : FieldProjectionSoundness.pairProjection plan.fieldIdx a b = w := - Option.some.inj hRun - simpa [← hw] using hCod - -/-- Family slice discharge with the currently missing semantic-face seam made -explicit. `acceptedFieldProjectionFragments` supplies every byte/plan fact; -`fieldProjectionSemanticBridges` supplies only the independent model face. -/ -theorem fieldProjection_discharges - (artifact : ArtifactData) - (hAcc : acceptedFieldProjectionFragments artifact) - (hSemantic : fieldProjectionSemanticBridges artifact) : - ∀ o ∈ artifact.fieldProjectionClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact fieldProjection_claim_discharges artifact hAcc claim hMem - (hSemantic claim hMem) - -end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/DischargeIntDispatch.lean b/aver-cert/assets/wall/current/DischargeIntDispatch.lean deleted file mode 100644 index f6c3240ad..000000000 --- a/aver-cert/assets/wall/current/DischargeIntDispatch.lean +++ /dev/null @@ -1,306 +0,0 @@ -/- -Acceptance-soundness wiring for integer dispatch. - -Acceptance supplies the checked plan, canonical host wiring, lowering, and -exact code entry. The audited raw checker supplies the generic theorem's -non-default-root premise; only the independent domain/model face remains in -the semantic bridge. --/ -import AcceptanceSoundnessCore -import IntDispatchSoundness - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -private theorem intDispatchRoot_of_raw (plan : IntDispatchRawPlan) - (hRaw : AverCert.PlanCheck.checkIntDispatchRawPlan plan = true) : - ∃ tyIdx leaf rest, plan.body = .test tyIdx leaf rest := by - cases hBody : plan.body with - | default k => - simp [AverCert.PlanCheck.checkIntDispatchRawPlan, hBody] at hRaw - | test tyIdx leaf rest => - exact ⟨tyIdx, leaf, rest, rfl⟩ - -private theorem hostRoleIdx_mem_pair - (hostTable : List (HostRole × Nat)) (role : HostRole) (idx : Nat) - (hLookup : AverCert.PlanCheck.hostRoleIdx? hostTable role = some idx) : - (role, idx) ∈ hostTable := by - induction hostTable with - | nil => simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - | cons head rest ih => - rcases head with ⟨headRole, headIdx⟩ - by_cases hRole : headRole = role - · subst headRole - simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - subst idx - simp - · simp [AverCert.PlanCheck.hostRoleIdx?, hRole] at hLookup - simp [ih hLookup] - -private def intDispatchExpectedSlot - (C : Nat) (add sub mul : List WVal → Option WVal) : - HostRole → Nat × (List WVal → Option WVal) - | .box => (1, boxRef C) - | .add => (2, add) - | .mul => (2, mul) - | .sub => (2, sub) - | .toIndex => (1, fun _ => none) - | .cmp => (2, fun _ => none) - | .eq => (2, fun _ => none) - -private theorem canonicalSlot_of_lookup - (C : Nat) (add sub mul : List WVal → Option WVal) - (hostTable : List (HostRole × Nat)) - (hDistinct : AverCert.PlanCheck.hostTableIndicesDistinct hostTable = true) - (role : HostRole) (idx : Nat) - (hLookup : AverCert.PlanCheck.hostRoleIdx? hostTable role = some idx) : - intDispatchCanonicalSlots C add sub mul hostTable idx = - some (intDispatchExpectedSlot C add sub mul role) := by - induction hostTable generalizing role idx with - | nil => simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - | cons head rest ih => - rcases head with ⟨headRole, headIdx⟩ - simp only [AverCert.PlanCheck.hostTableIndicesDistinct, - AverCert.PlanCheck.natListNoDup, List.map_cons, - Bool.and_eq_true] at hDistinct - rcases hDistinct with ⟨hHeadFresh, hRestDistinct⟩ - by_cases hRole : headRole = role - · subst headRole - simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - subst idx - cases role <;> - simp [intDispatchCanonicalSlots, intDispatchExpectedSlot] - · have hTailLookup : AverCert.PlanCheck.hostRoleIdx? rest role = some idx := by - simpa [AverCert.PlanCheck.hostRoleIdx?, hRole] using hLookup - have hPairMem : (role, idx) ∈ rest := - hostRoleIdx_mem_pair rest role idx hTailLookup - have hNe : idx ≠ headIdx := by - intro hEq - subst idx - simp at hHeadFresh - exact hHeadFresh role hPairMem - change (if idx = headIdx then _ else - intDispatchCanonicalSlots C add sub mul rest idx) = _ - rw [if_neg hNe] - exact ih hRestDistinct role idx hTailLookup - -private theorem canonicalHostSlots - (C : Nat) (add sub mul : List WVal → Option WVal) - (hostTable : List (HostRole × Nat)) - (hDistinct : AverCert.PlanCheck.hostTableIndicesDistinct hostTable = true) : - IntDispatchSoundness.HostSlots C - (intDispatchCanonicalSlots C add sub mul hostTable) hostTable add sub := by - constructor - · intro idx hLookup - simpa [intDispatchExpectedSlot] using - canonicalSlot_of_lookup C add sub mul hostTable hDistinct .box idx hLookup - · constructor - · intro idx hLookup - simpa [intDispatchExpectedSlot] using - canonicalSlot_of_lookup C add sub mul hostTable hDistinct .add idx hLookup - · intro idx hLookup - simpa [intDispatchExpectedSlot] using - canonicalSlot_of_lookup C add sub mul hostTable hDistinct .sub idx hLookup - -/-- The semantic face intentionally absent from `intDispatchPlanAccepted`. -A represented source input must expose one runtime variant, `EvalCascade` must -relate that variant to the checked plan's Int result, and every representation -of that result must satisfy the independently declared codomain/model relation. -/ -def intDispatchSemanticBridge - (claim : IntDispatchClaim) (plan : IntDispatchRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ tag fields n, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S plan.body tag fields n ∧ - ∀ w, S.Repr n w → - claim.obligation.codRepr S (claim.obligation.model x) w - -def intDispatchSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.intDispatchClaims, - ∀ plan, - intDispatchPlanForExport claim.exportName - artifact.manifest.intDispatchPlans = some plan → - intDispatchSemanticBridge claim plan - -/-- Byte/plan and generic-application half for one accepted Int-dispatch claim. -/ -theorem intDispatch_accepted_call - (artifact : ArtifactData) - (hAcc : acceptedIntDispatchFragments artifact) - (claim : IntDispatchClaim) - (hMem : claim ∈ artifact.intDispatchClaims) : - ∃ plan, - intDispatchPlanForExport claim.exportName - artifact.manifest.intDispatchPlans = some plan ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal), - (∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w) → - (∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) → - ∀ fuel tag fields n w, - IntDispatchSoundness.EvalCascade S plan.body tag fields n → - wFuncN claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - (fuel + 1) claim.obligation.self [.structv tag fields] = some w → - S.Repr n w := by - have hClaim : intDispatchClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := by - exact allClaims_of_mem - (intDispatchClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.intDispatchClaims hAcc claim hMem - unfold intDispatchClaimAccepted at hClaim - cases hPlan : intDispatchPlanForExport claim.exportName - artifact.manifest.intDispatchPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : intDispatchPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.hostTable plan claim.obligation := by - simpa [hPlan] using hClaim - rcases hAccepted with - ⟨_hExport, hCarrier, hRaw, hDistinct, _hHostTypes, hHost, - body, codeEntry, binding, hLow, _hCodeEntry, _hExactBinding, - hSelf, _hFuncType, hCode⟩ - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, AverCert.PlanCheck.bindArmCount plan.body + 2, - body⟩ := by - simpa [← hSelf] using hCode - have hHost' : claim.obligation.host = - intDispatchCanonicalHost claim.obligation.carrier claim.hostTable := by - simpa [hCarrier] using hHost - refine ⟨plan, rfl, ?_⟩ - intro S add sub mul stringEq stringConcat toIndex cmp eq hAdd hSub - fuel tag fields n w hSem hRun - have hSlots : IntDispatchSoundness.HostSlots claim.obligation.carrier - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - claim.hostTable add sub := by - rw [hHost'] - exact canonicalHostSlots claim.obligation.carrier add sub mul - claim.hostTable hDistinct - exact IntDispatchSoundness.generic_int_dispatch_certified - S plan claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - claim.obligation.self claim.hostTable add sub hSlots hAdd hSub - (intDispatchRoot_of_raw plan hRaw) body hLow hCodeSelf - fuel tag fields n w hSem hRun - -theorem intDispatch_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedIntDispatchFragments artifact) - (claim : IntDispatchClaim) - (hMem : claim ∈ artifact.intDispatchClaims) - (hBridge : ∀ plan, - intDispatchPlanForExport claim.exportName - artifact.manifest.intDispatchPlans = some plan → - intDispatchSemanticBridge claim plan) : - obligationHolds claim.obligation := by - have hCall := intDispatch_accepted_call artifact hAcc claim hMem - rcases hCall with ⟨plan, hPlan, hGeneric⟩ - rcases hBridge plan hPlan with ⟨hPolicy, hSemantic⟩ - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hSemantic S x vs hDom with - ⟨tag, fields, n, hVs, hCascade, hCod⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - exact hCod w (hGeneric S add sub mul stringEq stringConcat toIndex cmp eq - (carrierContract_weaken hAdd) (carrierContract_weaken hSub) - fuel tag fields n w hCascade hRun) - -/-- Per-obligation option-(b) discharge for a concrete Int-dispatch export. -The checked plan, canonical host table, lowering, and code binding are data; -`hSemantic` is the intentionally residual source-model bridge emitted for the -user function. Unlike the option-(c) leaf theorems, the model is not replaced -by a canonical evaluator: the bridge proves that the user's model agrees with -the byte-derived `EvalCascade` on every represented source constructor. -/ -theorem intDispatch_canonical_discharges - (exportName : String) - (carrier self : Nat) - (plan : IntDispatchRawPlan) - (hostTable : List (HostRole × Nat)) - (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (Dom : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (model : Dom → Int) - (hRaw : AverCert.PlanCheck.checkIntDispatchRawPlan plan = true) - (hDistinct : AverCert.PlanCheck.hostTableIndicesDistinct hostTable = true) - (hHost : ∀ add sub mul stringEq stringConcat toIndex cmp eq, - host add sub mul stringEq stringConcat toIndex cmp eq = - intDispatchCanonicalHost carrier hostTable - add sub mul stringEq stringConcat toIndex cmp eq) - (body : List WInstr) - (hLow : AverCert.PlanLower.lowerIntDispatchBody hostTable plan = some body) - (hCode : code self = some { - arity := 1, - nlocals := AverCert.PlanCheck.bindArmCount plan.body + 2, - body := body }) - (hSemantic : ∀ (S : CarrierSpec carrier) (x : Dom) (vs : List WVal), - domRepr S x vs → - ∃ tag fields n, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S plan.body tag fields n ∧ - ∀ w, S.Repr n w → intRepr S (model x) w) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := Dom - Cod := Int - domRepr := domRepr - codRepr := fun S n w => intRepr S n w - model := model } : Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hSemantic S x vs hDom with - ⟨tag, fields, n, hVs, hCascade, hCod⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hSlots : IntDispatchSoundness.HostSlots carrier - (host add sub mul stringEq stringConcat toIndex cmp eq) hostTable add sub := by - rw [hHost] - exact canonicalHostSlots carrier add sub mul hostTable hDistinct - have hGeneric := IntDispatchSoundness.generic_int_dispatch_certified - S plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self - hostTable add sub hSlots (carrierContract_weaken hAdd) - (carrierContract_weaken hSub) - (intDispatchRoot_of_raw plan hRaw) body hLow hCode - exact hCod w (hGeneric fuel tag fields n w hCascade hRun) - -/-- Complete family slice under the residual semantic bridge. -/ -theorem intDispatch_discharges - (artifact : ArtifactData) - (hAcc : acceptedIntDispatchFragments artifact) - (hSemantic : intDispatchSemanticBridges artifact) : - ∀ o ∈ artifact.intDispatchClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact intDispatch_claim_discharges artifact hAcc claim hMem - (hSemantic claim hMem) - -end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/DischargeRecursion.lean b/aver-cert/assets/wall/current/DischargeRecursion.lean deleted file mode 100644 index 0c0b2c9c5..000000000 --- a/aver-cert/assets/wall/current/DischargeRecursion.lean +++ /dev/null @@ -1,422 +0,0 @@ -/- -Acceptance-soundness wiring for unary, accumulator, and mutual recursion. - -The accepted-plan predicates supply policy/termination admission and the exact -selected code entry. The independent obligation host/domain/model faces stay -explicit, following the established discharge pattern. Mutual recursion also -needs the shared-code/SCC package: one member's acceptance constrains only its -own obligation code table, while the k-generic theorem executes every member. --/ -import AcceptanceSoundnessCore -import RecursionSoundness -import MutualRecursionSoundness - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -/-- Host, unary-domain, and source-model faces not pinned by -`recursionPlanAccepted`. The domain bridge decomposes every represented -obligation input and relates the generic evaluator to the source model. -/ -def unaryRecursionSemanticBridge - (claim : RecursionClaim) (plan : RecursionRawPlan) : Prop := - ∃ combineOp boxIdx combineIdx subIdx sh, - RecursionSoundness.parseRecShapeU combineOp claim.obligation.self boxIdx combineIdx subIdx plan = some sh ∧ - claim.obligation.totalityRole = - (match combineOp with | .add => .addSub | .mul => .mul) ∧ - (∀ add sub mul stringEq stringConcat toIndex cmp eq, - let host := claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq - host boxIdx = some (1, boxRef claim.obligation.carrier) ∧ - (match combineOp with - | .add => host combineIdx = some (2, add) - | .mul => host combineIdx = some (2, mul)) ∧ - host subIdx = some (2, sub) ∧ - host claim.obligation.self = none) ∧ - (∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ n v, vs = [v] ∧ S.Repr n v ∧ - ∀ w, S.Repr (RecursionSoundness.evalRecU combineOp sh n) w → - claim.obligation.codRepr S (claim.obligation.model x) w) - -/-- Host, arity-two domain, and source-model faces for the accumulator shape. - The domain bridge pins the exact `[counter, accumulator]` ordering. -/ -def accumulatorRecursionSemanticBridge - (claim : RecursionClaim) (plan : RecursionRawPlan) : Prop := - ∃ boxIdx addIdx subIdx sh, - RecursionSoundness.parseRecShapeA claim.obligation.self boxIdx addIdx subIdx plan = some sh ∧ - claim.obligation.totalityRole = .addSub ∧ - (∀ add sub mul stringEq stringConcat toIndex cmp eq, - let host := claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq - host boxIdx = some (1, boxRef claim.obligation.carrier) ∧ - host addIdx = some (2, add) ∧ - host subIdx = some (2, sub) ∧ - host claim.obligation.self = none) ∧ - (∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ n acc vn vacc, - vs = [vn, vacc] ∧ S.Repr n vn ∧ S.Repr acc vacc ∧ - ∀ w, S.Repr (RecursionSoundness.evalRecA n acc) w → - claim.obligation.codRepr S (claim.obligation.model x) w) - -def recursionSemanticBridge - (claim : RecursionClaim) (plan : RecursionRawPlan) : Prop := - unaryRecursionSemanticBridge claim plan ∨ - accumulatorRecursionSemanticBridge claim plan - -def recursionSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.recursionClaims, - ∀ plan, - recursionPlanForExport claim.exportName - artifact.manifest.recursionPlans = some plan → - recursionSemanticBridge claim plan - -theorem unary_recursion_claim_discharges - (artifact : ArtifactData) - (claim : RecursionClaim) - (plan : RecursionRawPlan) - (hAccepted : recursionPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.hostTable plan claim.obligation) - (hBridge : unaryRecursionSemanticBridge claim plan) : - obligationHolds claim.obligation := by - rcases hAccepted with - ⟨_hExport, hCarrier, hRaw, _hTermination, - body, codeEntry, binding, hLow, _hCodeEntry, _hExactBinding, - hSelf, _hShape, _hType, _hHostTypes, hCode⟩ - rcases hBridge with - ⟨combineOp, boxIdx, combineIdx, subIdx, sh, - hParse, hTotalityRole, hHost, hModel⟩ - have hParams : plan.params = [.intCarrier] := by - unfold RecursionSoundness.parseRecShapeU at hParse - split at hParse - next h => exact h.2.1 - next => simp at hParse - have hLower : AverCert.PlanLower.lowerBlock claim.obligation.carrier - plan.body = some body := by - simpa [hCarrier, AverCert.PlanLower.lowerRecursionBody, hRaw] using hLow - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, 1, body⟩ := by - simpa [hParams, recursionNLocals, ← hSelf] using hCode - cases hPolicy : claim.obligation.policy with - | simulatesModel => - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hModel S x vs hDom with ⟨n, v, rfl, hv, hCod⟩ - rcases hHost add sub mul stringEq stringConcat toIndex cmp eq with - ⟨hBox, hCombineHost, hSubHost, hSelfHost⟩ - apply hCod w - cases combineOp with - | add => - exact RecursionSoundness.recursion_generic_certified - claim.obligation.carrier .add claim.obligation.self boxIdx - combineIdx subIdx 1 S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - add sub hBox hCombineHost hSubHost hSelfHost - (carrierContract_weaken hAdd) (carrierContract_weaken hSub) plan sh - hParse body hLower hCodeSelf fuel n v w hv hRun - | mul => - exact RecursionSoundness.recursion_generic_certified - claim.obligation.carrier .mul claim.obligation.self boxIdx - combineIdx subIdx 1 S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - mul sub hBox hCombineHost hSubHost hSelfHost - (carrierContract_weaken _hMul) (carrierContract_weaken hSub) plan sh - hParse body hLower hCodeSelf fuel n v w hv hRun - | simulatesModelTotally => - cases combineOp with - | add => - rw [obligationHolds, hPolicy] - simp only [Obligation.holdsTotal, hTotalityRole] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq - hAddTot hSubTot x vs hDom - rcases hModel S x vs hDom with ⟨n, v, rfl, hv, hCod⟩ - rcases hHost add sub mul stringEq stringConcat toIndex cmp eq with - ⟨hBox, hCombineHost, hSubHost, hSelfHost⟩ - obtain ⟨w, hRun, hRepr⟩ := - RecursionSoundness.recursion_generic_certified_total - claim.obligation.carrier .add claim.obligation.self boxIdx - combineIdx subIdx 1 S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - add sub hBox hCombineHost hSubHost hSelfHost - (carrierContract_weaken hAdd) (carrierContract_weaken hSub) - hAddTot hSubTot plan sh hParse body hLower hCodeSelf n v hv - exact ⟨n, v, [], rfl, hv, w, hRun, hCod w hRepr⟩ - | mul => - rw [obligationHolds, hPolicy] - simp only [Obligation.holdsTotal, hTotalityRole] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd hSub hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq - _hAddTot hSubTot hMulTot x vs hDom - rcases hModel S x vs hDom with ⟨n, v, rfl, hv, hCod⟩ - rcases hHost add sub mul stringEq stringConcat toIndex cmp eq with - ⟨hBox, hCombineHost, hSubHost, hSelfHost⟩ - obtain ⟨w, hRun, hRepr⟩ := - RecursionSoundness.recursion_generic_certified_total - claim.obligation.carrier .mul claim.obligation.self boxIdx - combineIdx subIdx 1 S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - mul sub hBox hCombineHost hSubHost hSelfHost - (carrierContract_weaken hMul) (carrierContract_weaken hSub) - hMulTot hSubTot plan sh hParse body hLower hCodeSelf n v hv - exact ⟨n, v, [], rfl, hv, w, hRun, hCod w hRepr⟩ - -theorem accumulator_recursion_claim_discharges - (artifact : ArtifactData) - (claim : RecursionClaim) - (plan : RecursionRawPlan) - (hAccepted : recursionPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.hostTable plan claim.obligation) - (hBridge : accumulatorRecursionSemanticBridge claim plan) : - obligationHolds claim.obligation := by - rcases hAccepted with - ⟨_hExport, hCarrier, hRaw, _hTermination, - body, codeEntry, binding, hLow, _hCodeEntry, _hExactBinding, - hSelf, _hShape, _hType, _hHostTypes, hCode⟩ - rcases hBridge with - ⟨boxIdx, addIdx, subIdx, sh, hParse, hTotalityRole, hHost, hModel⟩ - have hParams : plan.params = [.intCarrier, .intCarrier] := by - unfold RecursionSoundness.parseRecShapeA at hParse - split at hParse - next h => exact h.2.1 - next => simp at hParse - have hLower : AverCert.PlanLower.lowerBlock claim.obligation.carrier - plan.body = some body := by - simpa [hCarrier, AverCert.PlanLower.lowerRecursionBody, hRaw] using hLow - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨2, 1, body⟩ := by - simpa [hParams, recursionNLocals, ← hSelf] using hCode - cases hPolicy : claim.obligation.policy with - | simulatesModel => - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hModel S x vs hDom with - ⟨n, acc, vn, vacc, rfl, hvn, hvacc, hCod⟩ - rcases hHost add sub mul stringEq stringConcat toIndex cmp eq with - ⟨hBox, hAddHost, hSubHost, hSelfHost⟩ - apply hCod w - exact RecursionSoundness.recursion_accumulator_generic_certified - claim.obligation.carrier claim.obligation.self boxIdx addIdx - subIdx 1 S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - add sub hBox hAddHost hSubHost hSelfHost - (carrierContract_weaken hAdd) (carrierContract_weaken hSub) plan sh - hParse body hLower hCodeSelf fuel n acc vn vacc w hvn hvacc hRun - | simulatesModelTotally => - rw [obligationHolds, hPolicy] - simp only [Obligation.holdsTotal, hTotalityRole] - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq - hAddTot hSubTot x vs hDom - rcases hModel S x vs hDom with - ⟨n, acc, vn, vacc, rfl, hvn, hvacc, hCod⟩ - rcases hHost add sub mul stringEq stringConcat toIndex cmp eq with - ⟨hBox, hAddHost, hSubHost, hSelfHost⟩ - obtain ⟨w, hRun, hRepr⟩ := - RecursionSoundness.recursion_accumulator_generic_certified_total - claim.obligation.carrier claim.obligation.self boxIdx addIdx - subIdx 1 S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - add sub hBox hAddHost hSubHost hSelfHost - (carrierContract_weaken hAdd) (carrierContract_weaken hSub) - hAddTot hSubTot plan sh hParse body hLower hCodeSelf - n acc vn vacc hvn hvacc - exact ⟨n, vn, [vacc], rfl, hvn, w, hRun, hCod w hRepr⟩ - -theorem recursion_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedRecursionFragments artifact) - (claim : RecursionClaim) - (hMem : claim ∈ artifact.recursionClaims) - (hBridge : ∀ plan, - recursionPlanForExport claim.exportName - artifact.manifest.recursionPlans = some plan → - recursionSemanticBridge claim plan) : - obligationHolds claim.obligation := by - have hClaim : recursionClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := - allClaims_of_mem - (recursionClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.recursionClaims hAcc claim hMem - unfold recursionClaimAccepted at hClaim - cases hPlan : recursionPlanForExport claim.exportName - artifact.manifest.recursionPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : recursionPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.hostTable plan claim.obligation := by - simpa [hPlan] using hClaim - rcases hBridge plan hPlan with hUnary | hAccumulator - · exact unary_recursion_claim_discharges - artifact claim plan hAccepted hUnary - · exact accumulator_recursion_claim_discharges - artifact claim plan hAccepted hAccumulator - -theorem recursion_discharges - (artifact : ArtifactData) - (hAcc : acceptedRecursionFragments artifact) - (hSemantic : recursionSemanticBridges artifact) : - ∀ o ∈ artifact.recursionClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact recursion_claim_discharges artifact hAcc claim hMem - (hSemantic claim hMem) - -/-- The cross-member faces absent from `mutualPlanAccepted`. `scc` is the -k-generic conjunction package tied to the exact selected plan and to the raw -edge list computed from this artifact. `codeOther` is necessary because -acceptance for another claim constrains that other claim's obligation code -table, not the selected obligation's shared table. -/ -def mutualSemanticBridge - (artifact : ArtifactData) (claim : MutualRecursionClaim) - (plan : MutualRawPlan) : Prop := - ∃ k boxIdx subIdx, - ∃ (scc : MutualRecursionSoundness.AdmittedScc k claim.obligation.carrier boxIdx subIdx) - (i : Fin k), - scc.plans i = plan ∧ - (scc.members i).self = claim.obligation.self ∧ - plan.params = [.intCarrier] ∧ - mutualClaimEdges artifact.manifest artifact.mutualRecursionClaims = - some scc.rawEdges ∧ - (∀ j, j ≠ i → claim.obligation.code (scc.members j).self = - some ⟨1, 1, MutualRecursionSoundness.mutualInstrs claim.obligation.carrier - boxIdx subIdx scc.members j⟩) ∧ - (∀ add sub mul stringEq stringConcat toIndex cmp eq, - let host := claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq - host boxIdx = some (1, boxRef claim.obligation.carrier) ∧ - host subIdx = some (2, sub) ∧ - (∀ j, host (scc.members j).self = none)) ∧ - (∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ n v, vs = [v] ∧ S.Repr n v ∧ - ∀ w, S.Repr (MutualRecursionSoundness.evalMutualU scc.members i n) w → - claim.obligation.codRepr S (claim.obligation.model x) w) - -def mutualSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.mutualRecursionClaims, - ∀ plan, - mutualPlanForExport claim.exportName artifact.manifest.mutualPlans = - some plan → - mutualSemanticBridge artifact claim plan - -theorem mutual_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedMutualRecursionFragments artifact) - (claim : MutualRecursionClaim) - (hMem : claim ∈ artifact.mutualRecursionClaims) - (hBridge : ∀ plan, - mutualPlanForExport claim.exportName artifact.manifest.mutualPlans = - some plan → - mutualSemanticBridge artifact claim plan) : - obligationHolds claim.obligation := by - have hClaim : mutualRecursionClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := - allClaims_of_mem - (mutualRecursionClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.mutualRecursionClaims hAcc.1 claim hMem - unfold mutualRecursionClaimAccepted at hClaim - cases hPlan : mutualPlanForExport claim.exportName - artifact.manifest.mutualPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : mutualPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.memberSet claim.hostTable plan claim.obligation := by - simpa [hPlan] using hClaim - rcases hAccepted with - ⟨_hExport, hCarrier, hTotalityRole, hRaw, _hTermination, - body, codeEntry, binding, hLow, _hCodeEntry, _hExactBinding, - hSelf, _hShape, _hType, _hHostTypes, hCode⟩ - rcases hBridge plan hPlan with - ⟨k, boxIdx, subIdx, scc, i, hSccPlan, hSccSelf, hParams, - hEdges, hCodeOther, hHost, hModel⟩ - have hArtifactClosed : - mutualMembersFormClosedSccs scc.rawEdges = true := by - have hClosed := hAcc.2 - unfold mutualClaimsFormClosedSccs at hClosed - rw [hEdges] at hClosed - exact hClosed - have _hSameClosedProof : - mutualMembersFormClosedSccs scc.rawEdges = true := scc.closed - have hLower : AverCert.PlanLower.lowerMutualBody claim.obligation.carrier - plan = some body := by - simpa [hCarrier] using hLow - have hCanonical : body = MutualRecursionSoundness.mutualInstrs - claim.obligation.carrier boxIdx subIdx scc.members i := by - have hSccLower := scc.lowered i - rw [hSccPlan] at hSccLower - rw [hLower] at hSccLower - exact Option.some.inj hSccLower - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, 1, body⟩ := by - simpa [hParams, mutualNLocals, ← hSelf] using hCode - have hCodeAll : ∀ j, claim.obligation.code (scc.members j).self = - some ⟨1, 1, MutualRecursionSoundness.mutualInstrs claim.obligation.carrier - boxIdx subIdx scc.members j⟩ := by - intro j - by_cases hji : j = i - · subst j - simpa [hSccSelf, hCanonical] using hCodeSelf - · exact hCodeOther j hji - cases hPolicy : claim.obligation.policy with - | simulatesModel => - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hModel S x vs hDom with ⟨n, v, rfl, hv, hCod⟩ - rcases hHost add sub mul stringEq stringConcat toIndex cmp eq with - ⟨hBox, hSubHost, hMemberHost⟩ - have hRun' : wFuncN claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - fuel (scc.members i).self [v] = some w := by - simpa [hSccSelf] using hRun - apply hCod w - simpa [hSccSelf] using MutualRecursionSoundness.mutual_generic_certified - k claim.obligation.carrier boxIdx subIdx scc S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - sub hBox hSubHost hMemberHost hCodeAll (carrierContract_weaken hSub) - fuel i n v w hv hRun' - | simulatesModelTotally => - rw [obligationHolds, hPolicy] - simp only [Obligation.holdsTotal, hTotalityRole] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq - _hAddTot hSubTot x vs hDom - rcases hModel S x vs hDom with ⟨n, v, rfl, hv, hCod⟩ - rcases hHost add sub mul stringEq stringConcat toIndex cmp eq with - ⟨hBox, hSubHost, hMemberHost⟩ - obtain ⟨w, hRun, hRepr⟩ := - MutualRecursionSoundness.mutual_generic_certified_total - k claim.obligation.carrier boxIdx subIdx scc S claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - sub hBox hSubHost hMemberHost hCodeAll (carrierContract_weaken hSub) - hSubTot i n v hv - exact ⟨n, v, [], rfl, hv, w, - by simpa [hSccSelf] using hRun, hCod w hRepr⟩ - -theorem mutual_discharges - (artifact : ArtifactData) - (hAcc : acceptedMutualRecursionFragments artifact) - (hSemantic : mutualSemanticBridges artifact) : - ∀ o ∈ artifact.mutualRecursionClaims.map (·.obligation), - obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact mutual_claim_discharges artifact hAcc claim hMem - (hSemantic claim hMem) - -end AcceptanceSoundness - --- Compatibility diagnostics; the checker enforces axioms once at the root. -#print axioms AcceptanceSoundness.recursion_claim_discharges -#print axioms AcceptanceSoundness.mutual_claim_discharges diff --git a/aver-cert/assets/wall/current/DischargeString.lean b/aver-cert/assets/wall/current/DischargeString.lean deleted file mode 100644 index 24faf7512..000000000 --- a/aver-cert/assets/wall/current/DischargeString.lean +++ /dev/null @@ -1,337 +0,0 @@ -/- -Acceptance-soundness wiring for String.eq and String.concat. - -The generic theorems consume exactly the named helper contracts quantified by -`Schema.Obligation.holds`; this file threads those hypotheses through the -audited canonical host wiring. String results use the concrete `WVal` model -face (the generated obligations instantiate `codRepr` with `verbatimRepr`). --/ -import AcceptanceSoundnessCore -import StringSoundness - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -def stringEqSemanticBridge - (claim : StringEqClaim) (plan : StringEqRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ v, - vs = [v] ∧ - claim.obligation.codRepr S (claim.obligation.model x) - (StringSoundness.evalStringEq claim.stringTy plan v) - -def stringConcatSemanticBridge - (claim : StringConcatClaim) (plan : StringConcatRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ v, - vs = [v] ∧ - claim.obligation.codRepr S (claim.obligation.model x) - (StringSoundness.evalStringConcat claim.resultTy claim.containerTy plan v) - -def stringSemanticBridges (artifact : ArtifactData) : Prop := - (∀ claim ∈ artifact.stringEqClaims, - ∀ plan, - stringEqPlanForExport claim.exportName - artifact.manifest.stringEqPlans = some plan → - stringEqSemanticBridge claim plan) ∧ - (∀ claim ∈ artifact.stringConcatClaims, - ∀ plan, - stringConcatPlanForExport claim.exportName - artifact.manifest.stringConcatPlans = some plan → - stringConcatSemanticBridge claim plan) - -/-- The string family's two adjacent slices in `claimObligations`. -/ -theorem stringEq_accepted_call - (artifact : ArtifactData) - (hAcc : acceptedStringEqFragments artifact) - (claim : StringEqClaim) - (hMem : claim ∈ artifact.stringEqClaims) : - ∃ plan, - stringEqPlanForExport claim.exportName - artifact.manifest.stringEqPlans = some plan ∧ - ∀ (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal), - (∀ a b w, stringEq [a, b] = some w → - w = b32 (stringEqW a b)) → - ∀ (fuel : Nat) (v w : WVal), - wFuncN claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - (fuel + 1) claim.obligation.self [v] = some w → - w = StringSoundness.evalStringEq claim.stringTy plan v := by - have hClaim : stringEqClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := by - exact allClaims_of_mem - (stringEqClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.stringEqClaims hAcc claim hMem - unfold stringEqClaimAccepted at hClaim - cases hPlan : stringEqPlanForExport claim.exportName - artifact.manifest.stringEqPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : stringEqPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.stringTy claim.stringEqFuncIdx - artifact.manifest.subject.stringHostRoles claim.symPlan plan - claim.obligation := by - simpa [hPlan] using hClaim - rcases hAccepted with - ⟨_hExport, _hCarrier, _hRole, hHost, _hSym, _hMatches, hCheck, - body, codeEntry, binding, hLow, _hCodeEntry, _hExactBinding, - hSelf, hCode⟩ - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, 2, body⟩ := by - simpa [← hSelf] using hCode - refine ⟨plan, rfl, ?_⟩ - intro add sub mul stringEq stringConcat toIndex cmp eq hStringEq fuel v w hRun - have hHostSlot : - claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq - claim.stringEqFuncIdx = some (2, stringEq) := by - rw [hHost] - simp [stringEqCanonicalHost] - exact StringSoundness.generic_string_eq_certified - claim.stringTy claim.stringEqFuncIdx plan claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - claim.obligation.self stringEq hStringEq hCheck body hLow hCodeSelf - hHostSlot fuel v w hRun - -theorem stringConcat_accepted_call - (artifact : ArtifactData) - (hAcc : acceptedStringConcatFragments artifact) - (claim : StringConcatClaim) - (hMem : claim ∈ artifact.stringConcatClaims) : - ∃ plan, - stringConcatPlanForExport claim.exportName - artifact.manifest.stringConcatPlans = some plan ∧ - ∀ (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal), - (∀ resultTy parts c, - stringConcat resultTy [parts] = some c → - stringConcatW resultTy parts = some c) → - ∀ (fuel : Nat) (v w : WVal), - wFuncN claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - (fuel + 1) claim.obligation.self [v] = some w → - w = StringSoundness.evalStringConcat - claim.resultTy claim.containerTy plan v := by - have hClaim : stringConcatClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := by - exact allClaims_of_mem - (stringConcatClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.stringConcatClaims hAcc claim hMem - unfold stringConcatClaimAccepted at hClaim - cases hPlan : stringConcatPlanForExport claim.exportName - artifact.manifest.stringConcatPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : stringConcatPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier claim.resultTy claim.containerTy claim.concatFuncIdx - artifact.manifest.subject.stringHostRoles claim.symPlan plan - claim.obligation := by - simpa [hPlan] using hClaim - rcases hAccepted with - ⟨_hExport, _hCarrierState, _hCarrier, _hRole, hHost, body, codeEntry, binding, - _hSym, _hMatches, hCheck, hLow, _hCodeEntry, _hExactBinding, - _hExportFuncType, _hHelperFuncType, hSelf, hCode⟩ - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, stringConcatNLocals claim.carrier, body⟩ := by - simpa [hSelf] using hCode - refine ⟨plan, rfl, ?_⟩ - intro add sub mul stringEq stringConcat toIndex cmp eq hStringConcat fuel v w hRun - have hHostSlot : - claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq - claim.concatFuncIdx = - some (1, stringConcat claim.resultTy) := by - rw [hHost] - simp [stringConcatCanonicalHost] - exact StringSoundness.generic_string_concat_certified - claim.resultTy claim.containerTy claim.concatFuncIdx - (stringConcatNLocals claim.carrier) plan - claim.obligation.code - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - claim.obligation.self stringConcat hStringConcat hCheck body hLow - hCodeSelf hHostSlot fuel v w hRun - -/-- Canonical option-(c) leaf bridge for a String.eq obligation. The model, -helper index, checked plan, lowering, and code binding are all explicit. -/ -theorem stringEq_canonical_discharges - (exportName : String) - (carrier stringTy stringEqFuncIdx self : Nat) - (plan : StringEqRawPlan) (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (hCheck : AverCert.PlanCheck.checkStringEqRawPlan plan = true) - {body : List WInstr} - (hLow : AverCert.PlanLower.lowerStringEqBody - stringTy stringEqFuncIdx plan = some body) - (hCode : code self = some ⟨1, 2, body⟩) - (hHost : ∀ add sub mul stringEq stringConcat toIndex cmp eq, - host add sub mul stringEq stringConcat toIndex cmp eq stringEqFuncIdx = - some (2, stringEq)) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := WVal - Cod := WVal - domRepr := fun _ v vs => vs = [v] - codRepr := fun S v w => verbatimRepr S v w - model := fun v => StringSoundness.evalStringEq stringTy plan v } : - Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel v vs w hDom hRun - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hCall := StringSoundness.generic_string_eq_certified - stringTy stringEqFuncIdx plan code - (host add sub mul stringEq stringConcat toIndex cmp eq) self stringEq hStringEq - hCheck body hLow hCode (hHost add sub mul stringEq stringConcat toIndex cmp eq) - fuel v w hRun - simpa [verbatimRepr] using hCall - -/-- Canonical option-(c) leaf bridge for a String.concat obligation. `nlocals` - is whatever the module's carrier state made the emitter declare; the body - reads only the argument, so the bridge holds at either count. -/ -theorem stringConcat_canonical_discharges - (exportName : String) - (carrier resultTy containerTy concatFuncIdx self nlocals : Nat) - (plan : StringConcatRawPlan) (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (hCheck : AverCert.PlanCheck.checkStringConcatRawPlan plan = true) - {body : List WInstr} - (hLow : AverCert.PlanLower.lowerStringConcatBody - resultTy containerTy concatFuncIdx plan = some body) - (hCode : code self = some ⟨1, nlocals, body⟩) - (hHost : ∀ add sub mul stringEq stringConcat toIndex cmp eq, - host add sub mul stringEq stringConcat toIndex cmp eq concatFuncIdx = - some (1, stringConcat resultTy)) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := WVal - Cod := WVal - domRepr := fun _ v vs => vs = [v] - codRepr := fun S v w => verbatimRepr S v w - model := fun v => - StringSoundness.evalStringConcat resultTy containerTy plan v } : - Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq hStringConcat _hToIndex _hCmp _hEq fuel v vs w hDom hRun - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hCall := StringSoundness.generic_string_concat_certified - resultTy containerTy concatFuncIdx nlocals plan code - (host add sub mul stringEq stringConcat toIndex cmp eq) self stringConcat hStringConcat - hCheck body hLow hCode (hHost add sub mul stringEq stringConcat toIndex cmp eq) - fuel v w hRun - simpa [verbatimRepr] using hCall - -theorem stringEq_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedStringEqFragments artifact) - (claim : StringEqClaim) - (hMem : claim ∈ artifact.stringEqClaims) - (hBridge : ∀ plan, - stringEqPlanForExport claim.exportName - artifact.manifest.stringEqPlans = some plan → - stringEqSemanticBridge claim plan) : - obligationHolds claim.obligation := by - rcases stringEq_accepted_call artifact hAcc claim hMem with - ⟨plan, hPlan, hCall⟩ - rcases hBridge plan hPlan with ⟨hPolicy, hSemantic⟩ - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hSemantic S x vs hDom with ⟨v, hVs, hCod⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hResult := hCall add sub mul stringEq stringConcat toIndex cmp eq - hStringEq fuel v w hRun - simpa [hResult] using hCod - -theorem stringConcat_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedStringConcatFragments artifact) - (claim : StringConcatClaim) - (hMem : claim ∈ artifact.stringConcatClaims) - (hBridge : ∀ plan, - stringConcatPlanForExport claim.exportName - artifact.manifest.stringConcatPlans = some plan → - stringConcatSemanticBridge claim plan) : - obligationHolds claim.obligation := by - rcases stringConcat_accepted_call artifact hAcc claim hMem with - ⟨plan, hPlan, hCall⟩ - rcases hBridge plan hPlan with ⟨hPolicy, hSemantic⟩ - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hSemantic S x vs hDom with ⟨v, hVs, hCod⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hResult := hCall add sub mul stringEq stringConcat toIndex cmp eq - hStringConcat fuel v w hRun - simpa [hResult] using hCod - -theorem stringEq_discharges - (artifact : ArtifactData) - (hAcc : acceptedStringEqFragments artifact) - (hSemantic : stringSemanticBridges artifact) : - ∀ o ∈ artifact.stringEqClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact stringEq_claim_discharges artifact hAcc claim hMem - (hSemantic.1 claim hMem) - -theorem stringConcat_discharges - (artifact : ArtifactData) - (hAcc : acceptedStringConcatFragments artifact) - (hSemantic : stringSemanticBridges artifact) : - ∀ o ∈ artifact.stringConcatClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact stringConcat_claim_discharges artifact hAcc claim hMem - (hSemantic.2 claim hMem) - -end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/DischargeVerbatim.lean b/aver-cert/assets/wall/current/DischargeVerbatim.lean deleted file mode 100644 index 86ae14707..000000000 --- a/aver-cert/assets/wall/current/DischargeVerbatim.lean +++ /dev/null @@ -1,154 +0,0 @@ -/- -Acceptance-soundness wiring for verbatim plans. --/ -import AcceptanceSoundnessCore -import ConstructVerbatimSoundness - -open AverCert -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -namespace AcceptanceSoundness - -/-- The exact plan-derived `WVal` must represent the obligation's separately -declared model result. Plan admission is already part of artifact acceptance. -/ -def verbatimSemanticBridge - (claim : VerbatimClaim) (plan : VerbatimRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - ∀ (S : CarrierSpec claim.obligation.carrier) - (x : claim.obligation.Dom) (vs : List WVal), - claim.obligation.domRepr S x vs → - ∃ v, - vs = [v] ∧ - claim.obligation.codRepr S (claim.obligation.model x) - (ConstructVerbatimSoundness.verbatimModel plan v) - -def verbatimSemanticBridges (artifact : ArtifactData) : Prop := - ∀ claim ∈ artifact.verbatimClaims, - ∀ plan, - verbatimPlanForExport claim.exportName - artifact.manifest.verbatimPlans = some plan → - verbatimSemanticBridge claim plan - -/-- The accepted byte/plan binding simulates its audited plan model. -/ -theorem verbatim_accepted_call - (artifact : ArtifactData) - (hAcc : acceptedVerbatimFragments artifact) - (claim : VerbatimClaim) - (hMem : claim ∈ artifact.verbatimClaims) : - ∃ plan, - verbatimPlanForExport claim.exportName - artifact.manifest.verbatimPlans = some plan ∧ - ∀ (host : HostTbl) (fuel : Nat) (v w : WVal), - wFuncN claim.obligation.code host (fuel + 1) - claim.obligation.self [v] = some w → - w = ConstructVerbatimSoundness.verbatimModel plan v := by - have hClaim : verbatimClaimAccepted artifact.modBytes artifact.modLen - artifact.manifest claim := by - exact allClaims_of_mem - (verbatimClaimAccepted artifact.modBytes artifact.modLen artifact.manifest) - artifact.verbatimClaims hAcc claim hMem - unfold verbatimClaimAccepted at hClaim - cases hPlan : verbatimPlanForExport claim.exportName - artifact.manifest.verbatimPlans with - | none => simp [hPlan] at hClaim - | some plan => - have hAccepted : verbatimPlanAccepted - artifact.modBytes artifact.modLen claim.exportNameBytes claim.exportName - claim.carrier plan claim.obligation := by - simpa [hPlan] using hClaim - rcases hAccepted with - ⟨_hExport, _hCarrier, hCheck, codeEntry, binding, - _hCodeEntry, _hExactBinding, hSelf, _hFuncType, _hPayload, hCode⟩ - have hCodeSelf : claim.obligation.code claim.obligation.self = - some ⟨1, verbatimNLocals plan, - AverCert.PlanLower.lowerVerbatimBody plan⟩ := by - simpa [← hSelf] using hCode - refine ⟨plan, rfl, ?_⟩ - intro host fuel v w hRun - exact ConstructVerbatimSoundness.generic_verbatim_certified - plan claim.obligation.code host claim.obligation.self - (verbatimNLocals plan) hCheck hCodeSelf fuel v w hRun - -/-- Canonical option-(c) leaf bridge for a byte-derived verbatim dispatch. -The obligation model is the audited plan evaluator itself, so artifact-specific -callers supply only the reducible plan guard and code-table binding. -/ -theorem verbatim_canonical_discharges - (exportName : String) (carrier self : Nat) - (plan : VerbatimRawPlan) (code : CodeTbl) - (host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl) - (hCheck : AverCert.PlanCheck.checkVerbatimPlan - (verbatimNLocals plan) plan = true) - (hCode : code self = some - ⟨1, verbatimNLocals plan, - AverCert.PlanLower.lowerVerbatimBody plan⟩) : - Obligation.holds - ({ export_ := exportName - policy := .simulatesModel - carrier := carrier - code := code - host := host - self := self - Dom := WVal - Cod := WVal - domRepr := fun _ v vs => vs = [v] - codRepr := fun S v w => verbatimRepr S v w - model := fun v => ConstructVerbatimSoundness.verbatimModel plan v } : - Obligation) := by - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel v vs w hDom hRun - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hCall := ConstructVerbatimSoundness.generic_verbatim_certified - plan code (host add sub mul stringEq stringConcat toIndex cmp eq) self - (verbatimNLocals plan) hCheck hCode fuel v w hRun - simpa [verbatimRepr] using hCall - -theorem verbatim_claim_discharges - (artifact : ArtifactData) - (hAcc : acceptedVerbatimFragments artifact) - (claim : VerbatimClaim) - (hMem : claim ∈ artifact.verbatimClaims) - (hBridge : ∀ plan, - verbatimPlanForExport claim.exportName - artifact.manifest.verbatimPlans = some plan → - verbatimSemanticBridge claim plan) : - obligationHolds claim.obligation := by - rcases verbatim_accepted_call artifact hAcc claim hMem with - ⟨plan, hPlan, hCall⟩ - rcases hBridge plan hPlan with ⟨hPolicy, hSemantic⟩ - rw [obligationHolds, hPolicy] - intro S add sub mul stringEq stringConcat toIndex cmp eq - _hAdd _hSub _hMul _hStringEq _hStringConcat _hToIndex _hCmp _hEq fuel x vs w hDom hRun - rcases hSemantic S x vs hDom with ⟨v, hVs, hCod⟩ - subst vs - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - have hResult := hCall - (claim.obligation.host add sub mul stringEq stringConcat toIndex cmp eq) - fuel v w hRun - simpa [hResult] using hCod - -theorem verbatim_discharges - (artifact : ArtifactData) - (hAcc : acceptedVerbatimFragments artifact) - (hSemantic : verbatimSemanticBridges artifact) : - ∀ o ∈ artifact.verbatimClaims.map (·.obligation), obligationHolds o := by - intro o hObligation - rcases List.mem_map.mp hObligation with ⟨claim, hMem, rfl⟩ - exact verbatim_claim_discharges artifact hAcc claim hMem - (hSemantic claim hMem) - -end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/EnvelopeLowering.lean b/aver-cert/assets/wall/current/EnvelopeLowering.lean deleted file mode 100644 index dbcc4ca8f..000000000 --- a/aver-cert/assets/wall/current/EnvelopeLowering.lean +++ /dev/null @@ -1,409 +0,0 @@ -/- -Envelope lowering: the plan declares the meaning envelope it operates on -(the ADT it reads or builds, and — as future columns — a string result type, -or the absence of an effect), a canonical wall LOWER emits the exact bytes -that envelope must occupy, and the face pins `lower(envelope) = bytes`. - -This is the same trick the wall already uses for function BODIES -(`PlanBytes.lower… = codeEntry`), lifted to the type envelope. There is NO -byte -> structure decoder in the meaning path: `domRepr`/`codRepr`/`model` -are wall terms computed FROM THE PLAN, never from a decode output. The only -value pulled up from the bytes is the compiler-assigned base type INDEX (a -bare opaque `Nat`), and even the byte OFFSET of a pinned entry is derived -from that index by cursor-only navigation that discards everything it reads. - -## The general abstraction - -`EnvelopeFact` is a plan-declared requirement together with its canonical -lowering to bytes; `EnvelopeFact.pinnedAt` is the pin `lower(req) = bytes at -target`. The ADT rec-group and the ADT function-signature entry are the FIRST -two instances. Further meaning envelopes plug in as additional `EnvelopeFact` -values without reworking this abstraction: - - * `stringConcat.resultTy` — an `EnvelopeFact` whose `Req` is the declared - result element type and whose `lower` emits its type-section entry; - * effect-absence ("no SSTORE", "no call") — an `EnvelopeFact` whose pin, - combined with a once-per-lowering "no constructor emits the opcode" - lemma (see `lowerConstructBody_no_call` below for the shape), turns an - absence claim into a corollary of `lower(plan) = bytes` with no scan. --/ -import AcceptedArtifactCore -import IntDispatchSoundness - -set_option maxRecDepth 1000000 -set_option maxHeartbeats 4000000 - -namespace AverCert.EnvelopeLowering - -open AverCert.Schema -open CertPrelude - -/-! ## §0 Cursor-only navigation from a type INDEX to its byte position - -This is NOT a decoder: every value `readTypeEntry`/`readTypeEntries` parses is -DISCARDED — only the cursor `(n, len)` advances. It answers one question: "at -which byte does the rectype whose first flattened type index is `target` -begin?" — the exact analogue of `CertDecode.codeLocs` locating code entries -for `funcBindingForExport`. A `target` that does not begin a rectype fails -closed. It is shared by every type-section `EnvelopeFact`. -/ - -def rectypeCursorAt : Nat → Nat → Nat → Nat → Nat → Option (Nat × Nat) - | 0, _, _, _, _ => none - | fuel + 1, target, flatBase, n, len => - if flatBase = target then some (n, len) - else if len == 0 then none - else if (n &&& 0xff) == 0x4e then - match CertDecode.readU (n >>> 8) (len - 1) with - | none => none - | some (count, n1, len1) => - match CertDecode.readTypeEntries count n1 len1 with - | none => none - | some (_, n2, len2) => - if target < flatBase + count then none - else rectypeCursorAt fuel target (flatBase + count) n2 len2 - else - match CertDecode.readTypeEntry n len with - | none => none - | some (_, n1, len1) => rectypeCursorAt fuel target (flatBase + 1) n1 len1 - -def typeCursorAt (modBytes modLen target : Nat) : Option (Nat × Nat) := - match CertDecode.modulePayload 1 modBytes modLen with - | none => none - | some (tN, tLen) => - match CertDecode.readU tN tLen with - | none => none - | some (_count, n1, len1) => rectypeCursorAt (tLen + 1) target 0 n1 len1 - -/-- The module's type-section bytes at (the position of) type index `target` - are EXACTLY `expected`. The length guard keeps the read inside the type - section. This is the byte-level pin shared by all type-section facts. -/ -def bytesPinnedAt (modBytes modLen target : Nat) (expected : List Nat) : Prop := - ∃ cur : Nat × Nat, - typeCursorAt modBytes modLen target = some cur ∧ - expected.length ≤ cur.2 ∧ - CertDecode.takeBytes expected.length cur.1 = expected - -/-! ## §1 The general envelope fact -/ - -/-- A plan-declared meaning envelope together with its canonical LOWER to the - exact bytes it must occupy. `Req` is whatever the plan declares (an ADT - profile, a result type, an effect profile); `lower` is the wall's - structural encoder for that declaration, fail-closed. The pin is taken at - a `target` type index that is supplied at the pin site (the ADT root, or a - function-signature `typeIdx` read off the export binding). -/ -structure EnvelopeFact where - Req : Type - lower : Req → Option (List Nat) - -/-- THE PIN, one shape for every envelope column: the module's bytes at - `target` are exactly `lower req`. -/ -@[reducible] def EnvelopeFact.pinnedAt - (F : EnvelopeFact) (modBytes modLen target : Nat) (req : F.Req) : Prop := - ∃ bs, F.lower req = some bs ∧ bytesPinnedAt modBytes modLen target bs - -/-! ## §2 The ADT envelope (the first instance) - -`root` is the compiler-assigned base type index — THE opaque residue pulled up -from the bytes. Everything else is DECLARED structure: `ctors[i] = true` iff -source constructor `i` carries the one Int payload. Constructor `i` lowers to -type index `root + 1 + i`; the prelude tail (string array, limb array, Int -carrier) follows the constructors inside the same rec group, so the carrier -index is DERIVED, never decoded. -/ - -structure AdtEnvelope where - root : Nat - ctors : List Bool -deriving Repr, DecidableEq - -def carrierIdxE (env : AdtEnvelope) : Nat := env.root + env.ctors.length + 3 -def limbIdxE (env : AdtEnvelope) : Nat := env.root + env.ctors.length + 2 - -/-- Profile checker, fail-closed. The `< 64` bound keeps every index in the - single-byte LEB/s33 regime (covers the current compiler's certified - profile; lifting it is a routine uleb exercise, not a design change). -/ -def checkAdtEnvelope (env : AdtEnvelope) : Bool := - decide (1 ≤ env.ctors.length) && decide (carrierIdxE env < 64) - -/-! ## §3 Canonical byte LOWERING of the declared ADT envelope (meaning -> bytes) - -Mirrors `src/codegen/wasm_gc/module.rs`: one rec group - `4e (sub [] struct{}) (sub_final [root] struct{(ref null C)}|{})* - (array i8 mut) (array i64 mut) - (struct {i64 mut, (ref null limbs) mut, i32 mut})` -exactly as `PlanBytes` lowers bodies: structural recursion over the plan, -emitting bytes. -/ - -def lowerCtorEntry (root C : Nat) : Bool → List Nat - | true => [0x4f, 0x01, root, 0x5f, 0x01, 0x63, C, 0x00] - | false => [0x4f, 0x01, root, 0x5f, 0x00] - -def lowerCtorEntries (root C : Nat) : List Bool → List Nat - | [] => [] - | b :: rest => lowerCtorEntry root C b ++ lowerCtorEntries root C rest - -/-- The canonical wasm-gc prelude tail the compiler appends inside the ADT's - rec group: string byte-array, bignum limb array, Int carrier struct. -/ -def preludeTail (limb : Nat) : List Nat := - [0x5e, 0x78, 0x01, - 0x5e, 0x7e, 0x01, - 0x5f, 0x03, 0x7e, 0x01, 0x63, limb, 0x01, 0x7f, 0x01] - -/-- LOWER for the whole declared rec group, header included. -/ -def lowerAdtRecGroup (env : AdtEnvelope) : Option (List Nat) := - if checkAdtEnvelope env = true then - some ([0x4e, env.ctors.length + 4, 0x50, 0x00, 0x5f, 0x00] ++ - lowerCtorEntries env.root (carrierIdxE env) env.ctors ++ - preludeTail (limbIdxE env)) - else none - -/-- LOWER for the dispatch export's function-signature type entry: - `(ref null root) -> (ref null carrier)`. -/ -def lowerDispatchSig (env : AdtEnvelope) : Option (List Nat) := - if checkAdtEnvelope env = true then - some [0x60, 0x01, 0x63, env.root, 0x01, 0x63, carrierIdxE env] - else none - -/-- LOWER for a constructor export's signature: `(ref null carrier) -> (ref null root)`. -/ -def lowerCtorSig (env : AdtEnvelope) : Option (List Nat) := - if checkAdtEnvelope env = true then - some [0x60, 0x01, 0x63, carrierIdxE env, 0x01, 0x63, env.root] - else none - -/-! ### The ADT `EnvelopeFact` instances -/ - -/-- The ADT rec-group fact: declared `AdtEnvelope`, lowered to the whole - type-section rec group, pinned at `env.root`. -/ -def adtRecGroupFact : EnvelopeFact := ⟨AdtEnvelope, lowerAdtRecGroup⟩ - -/-- The ADT dispatch-signature fact, pinned at the export binding's `typeIdx`. -/ -def adtDispatchSigFact : EnvelopeFact := ⟨AdtEnvelope, lowerDispatchSig⟩ - -/-- The ADT constructor-signature fact, pinned at the export binding's `typeIdx`. -/ -def adtCtorSigFact : EnvelopeFact := ⟨AdtEnvelope, lowerCtorSig⟩ - -/-! ## §4 Wall-owned meaning terms over the PLAN structure (no decode output) - -`Dom`, `domRepr`, `codRepr`, `model` are computed from the envelope + the -checked cascade. No `AdtTS`, no `TypeInfo`, no view function. -/ - -/-- Declared payload discipline of the tag `root+1+i |-> ctors[i]`. -/ -def ctorPayload? (env : AdtEnvelope) (tag : Nat) : Option Bool := - if env.root + 1 ≤ tag then env.ctors[tag - (env.root + 1)]? else none - -def EnvValidChild (env : AdtEnvelope) (tag : Nat) (payload : Option Int) : Prop := - (ctorPayload? env tag = some true ∧ ∃ n, payload = some n) ∨ - (ctorPayload? env tag = some false ∧ payload = none) - -/-- A value of the DECLARED ADT: a constructor tag plus its Int payload - exactly when the plan declares one. -/ -def AdtVal (env : AdtEnvelope) : Type := - { p : Nat × Option Int // EnvValidChild env p.1 p.2 } - -/-- Canonical domain representation from the plan structure: total in `x` - (vacuity structurally impossible), zero producer choice. -/ -def envDomRepr (env : AdtEnvelope) : - CarrierSpec (carrierIdxE env) → AdtVal env → List WVal → Prop := - fun S x vs => - match x.1.2 with - | some n => ∃ v, vs = [.structv x.1.1 [v]] ∧ S.Repr n v - | none => vs = [.structv x.1.1 []] - -/-- Same relation as a single-result representation (constructor codomain). -/ -def envCodRepr (env : AdtEnvelope) : - CarrierSpec (carrierIdxE env) → AdtVal env → WVal → Prop := - fun S y w => - match y.1.2 with - | some n => ∃ v, w = .structv y.1.1 [v] ∧ S.Repr n v - | none => w = .structv y.1.1 [] - -/-- Canonical Int argument representation (constructor domain). -/ -def intArgDomRepr (C : Nat) : CarrierSpec C → Int → List WVal → Prop := - fun S n vs => ∃ v, vs = [v] ∧ S.Repr n v - -/-- Total functional cascade evaluation (leaves reuse the real - `IntDispatchSoundness.evalLeaf`). -/ -def cascadeEval : IntDispatchCascade → Nat → Option Int → Option Int - | .default k, _, _ => some k - | .test tyIdx leaf rest, tag, payload => - if tag = tyIdx then payload.map (IntDispatchSoundness.evalLeaf leaf) - else cascadeEval rest tag payload - -/-- structModelFromPlan: THE model, computed from the checked plan. -/ -def envStructModel (env : AdtEnvelope) (body : IntDispatchCascade) : - AdtVal env → Int := - fun x => (cascadeEval body x.1.1 x.1.2).getD 0 - -/-- Plan-INTERNAL consistency (a pure plan <-> plan check): every tag the - cascade tests and projects must be a DECLARED payload constructor of the - envelope. Both plan components are separately byte-pinned by lowering, so - this closes the triangle cascade <-> envelope <-> bytes with no decode. -/ -def cascadeInEnv (env : AdtEnvelope) : IntDispatchCascade → Bool - | .default _ => true - | .test tyIdx _ rest => - decide (ctorPayload? env tyIdx = some true) && cascadeInEnv env rest - -/-- Constructor model from the plan: build the DECLARED payload constructor - `tag` with the Int argument as payload. The payload fact is DEMANDED. -/ -def envCtorModel (env : AdtEnvelope) (tag : Nat) - (h : ctorPayload? env tag = some true) : Int → AdtVal env := - fun n => ⟨(tag, some n), Or.inl ⟨h, n, rfl⟩⟩ - -/-! ## §5 The lower-pinned ADT faces - -FREE-PARAMETER AUDIT — complete input list of `AdtIntFaceLower`: - modBytes/modLen — the artifact bytes (sha256-pinned upstream); - exportNameBytes/exportName — the claimed export, bound by - `funcBindingForExport` (fail-closed); - carrier — claim data, pinned to `carrierIdxE env` (derived); - hostTable — claim data, byte-checked through the code-entry gate; - env, plan — PLAN data. Each is pinned meaning -> bytes: - `lowerIntDispatchCodeEntry plan = codeEntry` (existing), - `adtRecGroupFact.pinnedAt … env.root env`, - `adtDispatchSigFact.pinnedAt … binding.typeIdx env`; - `cascadeInEnv` ties them to each other; - o — the obligation; Dom/Cod/domRepr/codRepr/model are all - pinned to terms COMPUTED from env/plan. -NOT inputs: any decoded type structure, any view function, any byte offset -(derived from `env.root` by navigation). A fabricated type structure is not -merely refuted — it is UNSTATABLE (there is no such input). -/ - -def AdtIntFaceLower - (modBytes modLen : Nat) - (exportNameBytes : List Nat) (exportName : String) - (carrier : Nat) (hostTable : List (HostRole × Nat)) - (env : AdtEnvelope) (plan : IntDispatchRawPlan) (o : Obligation) : Prop := - AverCert.AcceptedArtifact.intDispatchPlanAccepted - modBytes modLen exportNameBytes exportName carrier hostTable plan o ∧ - checkAdtEnvelope env = true ∧ - cascadeInEnv env plan.body = true ∧ - carrier = carrierIdxE env ∧ - adtRecGroupFact.pinnedAt modBytes modLen env.root env ∧ - (∃ binding, - AverCert.WasmSlice.funcBindingForExport modBytes modLen exportNameBytes - = some binding ∧ - adtDispatchSigFact.pinnedAt modBytes modLen binding.typeIdx env) ∧ - o.carrier = carrierIdxE env ∧ - HEq o.Dom (AdtVal env) ∧ - HEq o.Cod Int ∧ - HEq o.domRepr (envDomRepr env) ∧ - HEq o.codRepr (@AverCert.Schema.intRepr (carrierIdxE env)) ∧ - HEq o.model (envStructModel env plan.body) - -/-- Constructor face (unary Int-payload constructor profile). `structIdx` is - pinned twice: by the exact code entry (`struct.new structIdx` immediate) - and by the DECLARED payload fact `ctorPayload? env structIdx = some true`, - whose envelope is byte-pinned by lowering. -/ -def AdtCtorFaceLower - (modBytes modLen : Nat) - (exportNameBytes : List Nat) (exportName : String) - (carrier structIdx fieldCount : Nat) (elemTy : ConstructValType) - (symPlan : SymRawPlan) (env : AdtEnvelope) (plan : ConstructRawPlan) - (o : Obligation) : Prop := - AverCert.AcceptedArtifact.constructPlanAccepted - modBytes modLen exportNameBytes exportName carrier structIdx fieldCount - elemTy symPlan plan o ∧ - plan.arity = 1 ∧ plan.fields = [.local 0] ∧ - checkAdtEnvelope env = true ∧ - carrier = carrierIdxE env ∧ - adtRecGroupFact.pinnedAt modBytes modLen env.root env ∧ - (∃ binding, - AverCert.WasmSlice.funcBindingForExport modBytes modLen exportNameBytes - = some binding ∧ - adtCtorSigFact.pinnedAt modBytes modLen binding.typeIdx env) ∧ - o.carrier = carrierIdxE env ∧ - ∃ hpay : ctorPayload? env structIdx = some true, - HEq o.Dom Int ∧ - HEq o.Cod (AdtVal env) ∧ - HEq o.domRepr (intArgDomRepr (carrierIdxE env)) ∧ - HEq o.codRepr (envCodRepr env) ∧ - HEq o.model (envCtorModel env structIdx hpay) - -/-! ## §6 Generic forcing lemmas (fixture-independent) - -The envelope IS an input, but the two lower-pins leave a forger ZERO choice on -a given module: the signature pin forces `root` and the carrier index (hence -the constructor count), and the rec-group pin then decides the payload map. -These are the encoder-injectivity facts the fixture uniqueness theorems use; -they involve no bytes of their own. -/ - -theorem takeBytes_take : - ∀ (k m n : Nat), k ≤ m → - CertDecode.takeBytes k n = (CertDecode.takeBytes m n).take k := by - intro k - induction k with - | zero => intro m n _; simp [CertDecode.takeBytes] - | succ k ih => - intro m n h - obtain ⟨m', rfl⟩ : ∃ m', m = m' + 1 := ⟨m - 1, by omega⟩ - simp only [CertDecode.takeBytes, List.take_succ_cons] - exact congrArg _ (ih m' (n >>> 8) (by omega)) - -theorem sig_forces_dispatch (env : AdtEnvelope) (sig : List Nat) - (hlow : lowerDispatchSig env = some sig) - (heq : sig = [0x60, 0x01, 0x63, 0x00, 0x01, 0x63, 0x05]) : - env.root = 0 ∧ env.ctors.length = 2 := by - unfold lowerDispatchSig at hlow - by_cases hc : checkAdtEnvelope env = true - · rw [if_pos hc] at hlow - have h := (Option.some.inj hlow).trans heq - have hroot : env.root = 0 := congrArg (fun l => l.getD 3 0) h - have hcar : carrierIdxE env = 5 := congrArg (fun l => l.getD 6 0) h - refine ⟨hroot, ?_⟩ - unfold carrierIdxE at hcar - omega - · rw [if_neg hc] at hlow; exact absurd hlow (by simp) - -theorem sig_forces_ctor (env : AdtEnvelope) (sig : List Nat) - (hlow : lowerCtorSig env = some sig) - (heq : sig = [0x60, 0x01, 0x63, 0x06, 0x01, 0x63, 0x00]) : - env.root = 0 ∧ env.ctors.length = 3 := by - unfold lowerCtorSig at hlow - by_cases hc : checkAdtEnvelope env = true - · rw [if_pos hc] at hlow - have h := (Option.some.inj hlow).trans heq - have hcar : carrierIdxE env = 6 := congrArg (fun l => l.getD 3 0) h - have hroot : env.root = 0 := congrArg (fun l => l.getD 6 0) h - refine ⟨hroot, ?_⟩ - unfold carrierIdxE at hcar - omega - · rw [if_neg hc] at hlow; exact absurd hlow (by simp) - -/-! ## §7 Effect-absence, the shape of the future effect column - -An absence claim ("no call", "no SSTORE") is a corollary of `lower(plan) = -bytes` plus "the plan has no such node": prove once, per lowering, that no -constructor emits the opcode — by structural induction on the plan, with NO -byte scan. The byte-level statement transports along the pin because the byte -encoder is the same structural recursion (`PlanBytes` mirrors `PlanLower` node -by node). Below: the REAL wall constructor lowering provably emits no `call`. -/ - -theorem lowerConstructFields_no_call (structIdx : Nat) - (fields : List ConstructField) : - ∀ i ∈ AverCert.PlanLower.lowerConstructFields structIdx fields, - ∀ k, i ≠ .call k := by - induction fields with - | nil => intro i hi; simp [AverCert.PlanLower.lowerConstructFields] at hi - | cons f rest ih => - intro i hi k - simp only [AverCert.PlanLower.lowerConstructFields, List.mem_cons] at hi - rcases hi with hi | hi - · subst hi; cases f <;> simp [AverCert.PlanLower.lowerConstructField] - · exact ih i hi k - -/-- Absence-of-effect corollary, REAL lowering: a lowered constructor body - contains no `call` — proved from the PLAN, not from the bytes. -/ -theorem lowerConstructBody_no_call (structIdx : Nat) (plan : ConstructRawPlan) - (body : List WInstr) - (hlow : AverCert.PlanLower.lowerConstructBody structIdx plan = some body) : - ∀ i ∈ body, ∀ k, i ≠ .call k := by - unfold AverCert.PlanLower.lowerConstructBody at hlow - by_cases hc : AverCert.PlanCheck.checkConstructRawPlan plan = true - · rw [if_pos hc] at hlow - intro i hi k - rw [← Option.some.inj hlow] at hi - rcases List.mem_append.mp hi with hi | hi - · exact lowerConstructFields_no_call structIdx plan.fields i hi k - · simp at hi; subst hi; simp - · rw [if_neg hc] at hlow; exact absurd hlow (by simp) - -end AverCert.EnvelopeLowering diff --git a/aver-cert/assets/wall/current/ExprFragmentAccepted.lean b/aver-cert/assets/wall/current/ExprFragmentAccepted.lean deleted file mode 100644 index fd358c6f8..000000000 --- a/aver-cert/assets/wall/current/ExprFragmentAccepted.lean +++ /dev/null @@ -1,30 +0,0 @@ --- Lean-side acceptance predicate for one `expr-fragment-v1` certified export. --- --- This intentionally aggregates the small audited pieces instead of adding a --- second checker: structural plan check, plan -> WInstr lowering, plan -> exact --- code-entry bytes, and wasm bytes -> export/function binding. -import CertPrelude -import PlanCheck -import PlanLower -import PlanBytes -import WasmSlice - -namespace AverCert.ExprFragmentAccepted -open AverCert.Schema -open CertPrelude - -def accepted - (modBytes modLen : Nat) - (exportName : AverCert.WasmSlice.ByteSeq) - (carrier : Nat) - (plan : ExprFragmentRawPlan) - (body : List WInstr) - (codeEntry : List Nat) - (binding : AverCert.WasmSlice.FuncBinding) : Prop := - AverCert.PlanCheck.checkExprFragmentRawPlan plan = true ∧ - AverCert.PlanLower.lowerExprFragmentBody carrier plan = some body ∧ - AverCert.PlanBytes.lowerExprFragmentCodeEntry carrier plan = some codeEntry ∧ - AverCert.WasmSlice.exactFuncBindingForExport - modBytes modLen exportName codeEntry = some binding - -end AverCert.ExprFragmentAccepted diff --git a/aver-cert/assets/wall/current/ExprFragmentSemantics.lean b/aver-cert/assets/wall/current/ExprFragmentSemantics.lean deleted file mode 100644 index 9b403f12c..000000000 --- a/aver-cert/assets/wall/current/ExprFragmentSemantics.lean +++ /dev/null @@ -1,179 +0,0 @@ -/- Plan-shaped expression-fragment semantics used by the audited lowering. -/ -import CertPrelude -import SchemaCore -import PlanCheck -import PlanLower - -set_option maxRecDepth 100000 -set_option maxHeartbeats 4000000 - -namespace ExprFragmentSemantics -open CertPrelude AverCert.Schema AverCert.PlanLower - -/-! The model is plan-shaped, not the old five-node integer evaluator. It - executes every constructor admitted by `FragNodeKind`, including nested - blocks and every `FragPrim`. The symbolic stack checks are deliberately - the same `popExpected`/`popExpectedAll` discipline used by the audited - lowerer, but this evaluator walks the raw plan rather than lowered code. -/ - -def runPrim : FragPrim -> List WVal -> Option (List WVal) - | .f64Add, .f64v b :: .f64v a :: st => - some (.f64v (f a + f b).toBits :: st) - | .f64Mul, .f64v b :: .f64v a :: st => - some (.f64v (f a * f b).toBits :: st) - | .f64Le, .f64v b :: .f64v a :: st => - some (b32 (f a <= f b) :: st) - | .f64Ge, .f64v b :: .f64v a :: st => - some (b32 (f b <= f a) :: st) - | .f64Lt, .f64v b :: .f64v a :: st => - some (b32 (f a < f b) :: st) - | .f64Gt, .f64v b :: .f64v a :: st => - some (b32 (f b < f a) :: st) - | .f64Eq, .f64v b :: .f64v a :: st => - some (b32 (f a == f b) :: st) - | .i64Eq, .i64v b :: .i64v a :: st => - some (b32 (a = b) :: st) - | .i64LeS, .i64v b :: .i64v a :: st => - some (b32 (a <= b) :: st) - | .i64LtS, .i64v b :: .i64v a :: st => - some (b32 (a < b) :: st) - | .i64GeS, .i64v b :: .i64v a :: st => - some (b32 (a >= b) :: st) - | .i64GtS, .i64v b :: .i64v a :: st => - some (b32 (a > b) :: st) - | .i32Eq, .i32v b :: .i32v a :: st => - some (b32 (a = b) :: st) - | .i32LtS, .i32v b :: .i32v a :: st => - some (b32 (a < b) :: st) - | .i32GtS, .i32v b :: .i32v a :: st => - some (b32 (a > b) :: st) - | .i32GeS, .i32v b :: .i32v a :: st => - some (b32 (a ≥ b) :: st) - -- Twin of the `wRunF` `.i32And` clause: logical AND on the {0,1} Boolean - -- domain `PlanCheck` pins for this primitive's operands. - | .i32And, .i32v b :: .i32v a :: st => - some (b32 (a ≠ 0 ∧ b ≠ 0) :: st) - | _, _ => none - -def finishWith - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (rest : List WInstr) : Option Out -> Option Out - | some (.ok locals stack) => wRunF host ar callee rest locals stack - | some (.ret value) => some (.ret value) - | none => none - -mutual - def runNodesFuel - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) : - Nat -> Nat -> List FragNode -> List Nat -> List WVal -> List WVal -> Option Out - | 0, _, _, _, _, _ => none - | _fuel + 1, _, [], _, locals, stack => some (.ok locals stack) - | fuel + 1, carrier, node :: rest, symStack, locals, stack => - -- `stepN` runs a whole instruction LIST for one node (the monolithic - -- templates emit several); `step` is the single-instruction case. - let stepN (symStack' : List Nat) (instrs : List WInstr) := - match wRunF host ar callee instrs locals stack with - | some (.ok locals' stack') => - runNodesFuel host ar callee fuel carrier rest - (node.id :: symStack') locals' stack' - | some (.ret value) => some (.ret value) - | none => none - let step (symStack' : List Nat) (instr : WInstr) := stepN symStack' [instr] - match node.kind with - | .local index => step symStack (.localGet index) - | .constBool value => step symStack (.i32Const (if value then 1 else 0)) - | .constI64 value => step symStack (.i64Const value) - | .constI32 value => step symStack (.i32Const value) - | .constF64Bits bits => step symStack (.f64Const (UInt64.ofNat bits)) - | .structGet field receiver => - match popExpected symStack receiver with - | some symStack' => step symStack' (.structGet carrier field) - | none => none - | .structGetUser tyIdx field value => - match popExpected symStack value with - | some symStack' => step symStack' (.structGet tyIdx field) - | none => none - | .structNew tyIdx args => - match popExpectedAll symStack args.reverse with - | some symStack' => step symStack' (.structNew tyIdx args.length) - | none => none - | .refIsNull value => - match popExpected symStack value with - | some symStack' => step symStack' .refIsNull - | none => none - | .prim op args => - match popExpectedAll symStack args.reverse with - | some symStack' => step symStack' (primInstr op) - | none => none - | .hostCall _role funcIdx args => - match popExpectedAll symStack args.reverse with - | none => none - | some symStack' => step symStack' (.call funcIdx) - | .selfCall tail funcIdx args => - match popExpectedAll symStack args.reverse with - | none => none - | some symStack' => - step symStack' (if tail then .returnCall funcIdx else .call funcIdx) - -- The monolithic fused vector read has no symbolic-generic - -- semantics: its face discharges through the audited template - -- theorem, never through this evaluator (fail-closed here). - | .vectorGetOrDefault _ _ _ _ => none - -- The sign template IS its instruction list: the node steps exactly - -- the sequence `PlanLower` emits for it, so plan-walker and lowered - -- code agree by construction in both directions. - | .intSignCmp op k scratch value => - match popExpected symStack value with - | some symStack' => - stepN symStack' - (AverCert.PlanLower.intSignCmpTemplate carrier scratch op k) - | none => none - -- The branch runs on a fresh block stack; already-computed values - -- under the condition (e.g. the first operand of `Bool.and` over two - -- encoded comparisons) ride through untouched, mirroring the wasm - -- `if`, whose branch executes above the remaining operand stack - -- (`InterpreterSequencing.wRunF_frame`). - | .ifElse cond thenBlock elseBlock => - match popExpected symStack cond, stack with - | some symRest, .i32v c :: stackRest => - let branch := if c = 0 then elseBlock else thenBlock - finishWith host ar callee [] - (runBlockFuel host ar callee fuel carrier branch locals) - |> fun branchOut => - match branchOut with - | some (.ok locals' [value]) => - runNodesFuel host ar callee fuel carrier rest - (node.id :: symRest) locals' (value :: stackRest) - | some (.ret value) => some (.ret value) - | _ => none - | _, _ => none - - def runBlockFuel - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) : - Nat -> Nat -> FragBlock -> List WVal -> Option Out - | 0, _, _, _ => none - | fuel + 1, carrier, block, locals => - match runNodesFuel host ar callee fuel carrier block.nodes [] locals [] with - | some (.ok locals' [value]) => some (.ok locals' [value]) - | some (.ret value) => some (.ret value) - | _ => none -end - -def runBlock - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (carrier : Nat) (block : FragBlock) (locals : List WVal) : Option Out := - runBlockFuel host ar callee maxFuel carrier block locals - -/-! `evalSymRawPlan` is the manifest-plan-derived evaluator. It starts from - the checked source plan and uses the audited encoder to obtain the exact - representation grammar whose structured semantics is above. -/ -def evalSymRawPlan - (hostTable : List (HostRole × Nat)) - (structTable : List (String × Nat)) - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (carrier : Nat) (plan : SymRawPlan) (locals : List WVal) : Option Out := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - hostTable structTable plan with - | some exprPlan => runBlock host ar callee carrier exprPlan.body locals - | none => none - -end ExprFragmentSemantics diff --git a/aver-cert/assets/wall/current/ExprFragmentSoundness.lean b/aver-cert/assets/wall/current/ExprFragmentSoundness.lean deleted file mode 100644 index 69f89f9b9..000000000 --- a/aver-cert/assets/wall/current/ExprFragmentSoundness.lean +++ /dev/null @@ -1,554 +0,0 @@ -/- Generic soundness theorem for accepted expression-fragment plans. -/ -import ExprFragmentSemantics -import InterpreterSequencing - -set_option maxRecDepth 1000000 -set_option maxHeartbeats 8000000 - -namespace ExprFragmentSoundness -open CertPrelude AverCert.Schema AverCert.PlanLower -open ExprFragmentSemantics InterpreterSequencing - -/-! ## The call/grammar fence - -`checkExprFragmentRawPlan` checks the representation types, ANF stack -discipline, and the general-Wasm exact-bit Float/NaN admission boundary. -Runtime call arities are necessarily a separate hypothesis: they -live in the byte-derived host/code tables, not in the raw plan. `CallsOK` is -the exact missing fence. It also excludes `selfCall`, whose proof face is the -separate recursion family rather than expr-fragment-v1. - -The nested grammar is genuinely recursive through `ifElse`; the explicit -size measure is what makes this definition robust to the mutually nested -`FragNodeKind`/`FragBlock` declarations. -/ - -mutual - def kindCallsOK (host : HostTbl) (ar : Nat -> Option Nat) - (kind : FragNodeKind) : Prop := - match kind with - | .hostCall _ f args => - (exists hf, host f = some (args.length, hf)) \/ - (host f = none /\ ar f = some args.length) - | .selfCall _ _ _ => False - | .ifElse _ t e => blockCallsOK host ar t /\ blockCallsOK host ar e - | _ => True - termination_by (sizeOf kind, 1) - decreasing_by all_goals simp_wf; omega - - def nodesCallsOK (host : HostTbl) (ar : Nat -> Option Nat) - (nodes : List FragNode) : Prop := - match nodes with - | [] => True - | n :: ns => kindCallsOK host ar n.kind /\ nodesCallsOK host ar ns - termination_by (sizeOf nodes, 2) - decreasing_by all_goals cases n <;> simp_wf <;> omega - - def blockCallsOK (host : HostTbl) (ar : Nat -> Option Nat) - (b : FragBlock) : Prop := - nodesCallsOK host ar b.nodes - termination_by (sizeOf b, 3) - decreasing_by all_goals cases b <;> simp_wf <;> omega -end - -/-! ## Fuel-indexed lowering/execution correctness -/ - -def NodesCorrect (fuel : Nat) : Prop := - forall (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (carrier : Nat) (nodes : List FragNode) (symStack : List Nat) - (instrs : List WInstr) (finalStack : List Nat), - nodesCallsOK host ar nodes -> - lowerNodesFuel fuel carrier nodes symStack = some (instrs, finalStack) -> - forall (locals stack : List WVal) out, - runNodesFuel host ar callee fuel carrier nodes symStack locals stack = some out -> - wRunF host ar callee instrs locals stack = some out - -def BlockCorrect (fuel : Nat) : Prop := - forall (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (carrier : Nat) (block : FragBlock) (instrs : List WInstr), - blockCallsOK host ar block -> - lowerBlockFuel fuel carrier block = some instrs -> - forall locals out, - runBlockFuel host ar callee fuel carrier block locals = some out -> - wRunF host ar callee instrs locals [] = some out - -/-- One node's instruction LIST, then the rest of the block. The monolithic - templates emit several instructions per node; `oneThenNodes` is the - single-instruction case. -/ -theorem manyThenNodes (fuel : Nat) (hcorrect : NodesCorrect fuel) - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (carrier : Nat) (rest : List FragNode) (nextSym : List Nat) - (instrs : List WInstr) (restInstrs : List WInstr) (finalStack : List Nat) - (hcalls : nodesCallsOK host ar rest) - (hlow : lowerNodesFuel fuel carrier rest nextSym = - some (restInstrs, finalStack)) - (locals stack : List WVal) (out : Out) - (hrun : - (match wRunF host ar callee instrs locals stack with - | some (.ok locals' stack') => - runNodesFuel host ar callee fuel carrier rest nextSym locals' stack' - | some (.ret value) => some (.ret value) - | none => none) = some out) : - wRunF host ar callee (instrs ++ restInstrs) locals stack = some out := by - rw [wRunF_append] - cases hs : wRunF host ar callee instrs locals stack with - | none => simp [hs] at hrun - | some stepOut => - cases stepOut with - | ret value => simpa [seqOut, hs] using hrun - | ok locals' stack' => - simp only [hs] at hrun - simp only [seqOut] - exact hcorrect host ar callee carrier rest nextSym restInstrs finalStack - hcalls hlow locals' stack' out hrun - -theorem oneThenNodes (fuel : Nat) (hcorrect : NodesCorrect fuel) - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (carrier : Nat) (rest : List FragNode) (nextSym : List Nat) - (instr : WInstr) (restInstrs : List WInstr) (finalStack : List Nat) - (hcalls : nodesCallsOK host ar rest) - (hlow : lowerNodesFuel fuel carrier rest nextSym = - some (restInstrs, finalStack)) - (locals stack : List WVal) (out : Out) - (hrun : - (match wRunF host ar callee [instr] locals stack with - | some (.ok locals' stack') => - runNodesFuel host ar callee fuel carrier rest nextSym locals' stack' - | some (.ret value) => some (.ret value) - | none => none) = some out) : - wRunF host ar callee ([instr] ++ restInstrs) locals stack = some out := - manyThenNodes fuel hcorrect host ar callee carrier rest nextSym [instr] - restInstrs finalStack hcalls hlow locals stack out hrun - -theorem runBlockFuel_ok_stack - (host : HostTbl) (ar : Nat -> Option Nat) (callee : Callee) - (fuel carrier : Nat) (block : FragBlock) (locals locals' stack : List WVal) - (h : runBlockFuel host ar callee fuel carrier block locals = - some (.ok locals' stack)) : exists value, stack = [value] := by - cases fuel with - | zero => simp [runBlockFuel] at h - | succ fuel => - simp only [runBlockFuel] at h - cases hr : runNodesFuel host ar callee fuel carrier block.nodes [] locals [] with - | none => simp [hr] at h - | some out => - rw [hr] at h - cases out with - | ret value => simp at h - | ok ls st => - cases st with - | nil => simp at h - | cons value tail => - cases tail with - | nil => - have hs : ls = locals' /\ [value] = stack := by simpa using h - exact ⟨value, hs.2.symm⟩ - | cons value' tail => simp at h - -/- The mutual theorem is intentionally stated in the strong-induction shape - left by the architect fork. -/ -theorem mutualCorrectStep : - forall fuel, - (forall smaller, smaller < fuel -> NodesCorrect smaller /\ BlockCorrect smaller) -> - NodesCorrect fuel /\ BlockCorrect fuel := by - intro fuel ihStrong - cases fuel with - | zero => - constructor - · intro host ar callee carrier nodes symS instrs finalS _ hlow - simp [lowerNodesFuel] at hlow - · intro host ar callee carrier block instrs _ hlow - simp [lowerBlockFuel] at hlow - | succ fuel => - have ih : NodesCorrect fuel /\ BlockCorrect fuel := - ihStrong fuel (Nat.lt_succ_self fuel) - constructor - · intro host ar callee carrier nodes - induction nodes with - | nil => - intro symS instrs finalS _ hlow locals stack out hrun - simp only [lowerNodesFuel, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simpa [runNodesFuel, wRunF] using hrun - | cons node rest restIH => - intro symS instrs finalS hcalls hlow locals stack out hrun - simp only [nodesCallsOK] at hcalls - obtain ⟨hcall, hcallsRest⟩ := hcalls - simp only [lowerNodesFuel] at hlow - cases hk : node.kind <;> simp only [hk] at hlow hcall <;> - simp only [runNodesFuel, hk] at hrun - next index => - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS) (.localGet index) restInstrs fin - hcallsRest hrest locals stack out hrun - next value => - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS) (.i32Const (if value then 1 else 0)) restInstrs fin - hcallsRest hrest locals stack out hrun - next value => - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS) (.i64Const value) restInstrs fin - hcallsRest hrest locals stack out hrun - next value => - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS) (.i32Const value) restInstrs fin - hcallsRest hrest locals stack out hrun - next bits => - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS) (.f64Const (UInt64.ofNat bits)) restInstrs fin - hcallsRest hrest locals stack out hrun - next field receiver => - cases hp : popExpected symS receiver with - | none => simp [hp] at hlow hrun - | some symS' => - simp only [hp] at hlow hrun - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS') with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS') (.structGet carrier field) restInstrs fin - hcallsRest hrest locals stack out hrun - next tyIdx field value => - cases hp : popExpected symS value with - | none => simp [hp] at hlow hrun - | some symS' => - simp only [hp] at hlow hrun - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS') with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS') (.structGet tyIdx field) restInstrs fin - hcallsRest hrest locals stack out hrun - next value => - cases hp : popExpected symS value with - | none => simp [hp] at hlow hrun - | some symS' => - simp only [hp] at hlow hrun - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS') with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS') .refIsNull restInstrs fin - hcallsRest hrest locals stack out hrun - next op args => - cases hp : popExpectedAll symS args.reverse with - | none => simp [hp] at hlow hrun - | some symS' => - simp only [hp] at hlow hrun - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS') with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS') (primInstr op) restInstrs fin - hcallsRest hrest locals stack out hrun - next role funcIdx args => - cases hp : popExpectedAll symS args.reverse with - | none => simp [hp] at hlow hrun - | some symS' => - simp only [hp] at hlow hrun - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS') with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS') (.call funcIdx) restInstrs fin - hcallsRest hrest locals stack out hrun - next tail funcIdx args => - exact (by simpa [kindCallsOK] using hcall : False).elim - next cond thenBlock elseBlock => - have hbranches : blockCallsOK host ar thenBlock /\ - blockCallsOK host ar elseBlock := by - simpa [kindCallsOK] using hcall - cases hp : popExpected symS cond with - | none => simp [hp] at hlow hrun - | some popped => - simp only [hp] at hlow hrun - cases ht : lowerBlockFuel fuel carrier thenBlock with - | none => simp [ht] at hlow - | some thenInstrs => - rw [ht] at hlow - cases he : lowerBlockFuel fuel carrier elseBlock with - | none => simp [he] at hlow - | some elseInstrs => - rw [he] at hlow - simp only at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: popped) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - cases stack with - | nil => simp at hrun - | cons cv stackTail => - cases cv <;> try simp at hrun - next c => - by_cases hc : c = 0 - · have hbcall := hbranches.2 - cases hb : runBlockFuel host ar callee fuel carrier - elseBlock locals with - | none => simp [finishWith, hc, hb] at hrun - | some branchOut => - have hbw := ih.2 host ar callee carrier elseBlock - elseInstrs hbcall he locals branchOut hb - -- The branch was proven on the empty stack; - -- frame it over the values still under the - -- condition. - have hbwf := wRunF_frame host ar callee stackTail - elseInstrs locals [] branchOut hbw - simp only [List.nil_append] at hbwf - cases branchOut with - | ret value => - simp [finishWith, hc, hb] at hrun - subst out - rw [wRunF_append] - simp [seqOut, wRunF, hc, hbwf, frameOut] - | ok locals' branchStack => - obtain ⟨value, rfl⟩ := - runBlockFuel_ok_stack host ar callee fuel - carrier elseBlock locals locals' - branchStack hb - have hstep : wRunF host ar callee - [.ifElse thenInstrs elseInstrs] - locals (.i32v c :: stackTail) = - some (.ok locals' (value :: stackTail)) := by - simp [wRunF, hc, hbwf, frameOut] - simp [finishWith, wRunF, hc, hb] at hrun - apply oneThenNodes fuel ih.1 host ar callee - carrier rest (node.id :: popped) - (.ifElse thenInstrs elseInstrs) - restInstrs fin hcallsRest hrest locals - (.i32v c :: stackTail) out - simpa [hstep] using hrun - · have hbcall := hbranches.1 - cases hb : runBlockFuel host ar callee fuel carrier - thenBlock locals with - | none => simp [finishWith, hc, hb] at hrun - | some branchOut => - have hbw := ih.2 host ar callee carrier thenBlock - thenInstrs hbcall ht locals branchOut hb - have hbwf := wRunF_frame host ar callee stackTail - thenInstrs locals [] branchOut hbw - simp only [List.nil_append] at hbwf - cases branchOut with - | ret value => - simp [finishWith, hc, hb] at hrun - subst out - rw [wRunF_append] - simp [seqOut, wRunF, hc, hbwf, frameOut] - | ok locals' branchStack => - obtain ⟨value, rfl⟩ := - runBlockFuel_ok_stack host ar callee fuel - carrier thenBlock locals locals' - branchStack hb - have hstep : wRunF host ar callee - [.ifElse thenInstrs elseInstrs] - locals (.i32v c :: stackTail) = - some (.ok locals' (value :: stackTail)) := by - simp [wRunF, hc, hbwf, frameOut] - simp [finishWith, wRunF, hc, hb] at hrun - apply oneThenNodes fuel ih.1 host ar callee - carrier rest (node.id :: popped) - (.ifElse thenInstrs elseInstrs) - restInstrs fin hcallsRest hrest locals - (.i32v c :: stackTail) out - simpa [hstep] using hrun - next _arrTy _toIndexIdx _boxIdx _default => - -- The monolithic fused vector read never runs through the - -- symbolic evaluator, so a successful run is contradictory. - simp at hrun - next tyIdx args => - cases hp : popExpectedAll symS args.reverse with - | none => simp [hp] at hlow hrun - | some symS' => - simp only [hp] at hlow hrun - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS') with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact oneThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS') (.structNew tyIdx args.length) restInstrs fin - hcallsRest hrest locals stack out hrun - next op k scratch value => - -- Monolithic sign template: the plan walker steps exactly the - -- instruction list the lowerer emits, so the step is `wRunF` of - -- the same list on both sides. - cases hp : popExpected symS value with - | none => simp [hp] at hlow hrun - | some symS' => - simp only [hp] at hlow hrun - cases hrest : lowerNodesFuel fuel carrier rest (node.id :: symS') with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - rw [hrest] at hlow - simp only [Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - exact manyThenNodes fuel ih.1 host ar callee carrier rest - (node.id :: symS') - (AverCert.PlanLower.intSignCmpTemplate carrier scratch op k) - restInstrs fin hcallsRest hrest locals stack out hrun - · intro host ar callee carrier block instrs hcalls hlow locals out hrun - simp only [lowerBlockFuel] at hlow - cases hn : lowerNodesFuel fuel carrier block.nodes [] with - | none => simp [hn] at hlow - | some pair => - obtain ⟨is, fs⟩ := pair - rw [hn] at hlow - cases fs with - | nil => simp at hlow - | cons r rs => - cases rs with - | cons r' rs => simp at hlow - | nil => - by_cases hr : r = block.result - · subst r - have his : is = instrs := by simpa using hlow - subst instrs - simp only [blockCallsOK] at hcalls - simp only [runBlockFuel, hn] at hrun - cases hrn : runNodesFuel host ar callee fuel carrier - block.nodes [] locals [] with - | none => simp [hrn] at hrun - | some nodeOut => - rw [hrn] at hrun - cases nodeOut with - | ret value => - simp at hrun - subst out - exact ih.1 host ar callee carrier block.nodes [] is - [block.result] hcalls hn locals [] _ hrn - | ok locals' stack' => - cases stack' with - | nil => simp at hrun - | cons value tail => - cases tail with - | nil => - simp at hrun - subst out - exact ih.1 host ar callee carrier block.nodes [] is - [block.result] hcalls hn locals [] _ hrn - | cons value' tail => simp at hrun - · simp [hr] at hlow - -theorem mutualCorrect (fuel : Nat) : NodesCorrect fuel /\ BlockCorrect fuel := by - exact Nat.strongRecOn fuel (fun n ih => mutualCorrectStep n ih) - -/-! ## Audited-plan generic certificate - -The input values are supplied by the per-obligation semantic bridge. This -keeps the lowering theorem representation-polymorphic: comparison obligations -may still choose the honest `carrierSmall` domain, while contracted integer -operations may retain their stronger arbitrary-`S.Repr` domain and Bool -fragments may use their canonical `b32` inputs. - -`evalSymRawPlan` begins at the checked source `SymRawPlan`, invokes the audited -encoder, and evaluates the resulting structured plan. Thus the theorem is -simultaneously gated by source encoding, `checkExprFragmentRawPlan`, and the -audited `lowerBlock`. -/ - -theorem exprfragment_generic_certified {C : Nat} (S : CarrierSpec C) - (hostTable : List (HostRole × Nat)) - (structTable : List (String × Nat)) - (code : CodeTbl) (host : HostTbl) - (symPlan : SymRawPlan) (plan : ExprFragmentRawPlan) - (hencode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - hostTable structTable symPlan = some plan) - (hcheck : AverCert.PlanCheck.checkExprFragmentRawPlan plan = true) - (instrs : List WInstr) - (hlower : lowerBlock C plan.body = some instrs) - (self nlocals fuel : Nat) - (hself : code self = some ⟨plan.params.length, nlocals, instrs⟩) - (inputs : List WVal) - (hinputArity : inputs.length = plan.params.length) - (hcalls : blockCallsOK host (fun g => (code g).map (fun c => c.arity)) - plan.body) - (modelLocals : List WVal) (result : WVal) - (heval : evalSymRawPlan hostTable structTable host - (fun g => (code g).map (fun c => c.arity)) - (fun g args => wFuncN code host fuel g args) - C symPlan - (initLocals ⟨plan.params.length, nlocals, instrs⟩ inputs) = - some (.ok modelLocals [result])) : - wFuncN code host (fuel + 1) self inputs = some result := by - have hevalBlock : runBlock host - (fun g => (code g).map (fun c => c.arity)) - (fun g args => wFuncN code host fuel g args) - C plan.body - (initLocals ⟨plan.params.length, nlocals, instrs⟩ inputs) = - some (.ok modelLocals [result]) := by - simp only [evalSymRawPlan, hencode] at heval - exact heval - change runBlockFuel host - (fun g => (code g).map (fun (c : WCode) => c.arity)) - (fun g args => wFuncN code host fuel g args) - maxFuel C plan.body - (initLocals ⟨plan.params.length, nlocals, instrs⟩ inputs) = - some (.ok modelLocals [result]) at hevalBlock - have hwrun := (mutualCorrect maxFuel).2 host - (fun g => (code g).map (fun (c : WCode) => c.arity)) - (fun g args => wFuncN code host fuel g args) - C plan.body instrs hcalls hlower - (initLocals ⟨plan.params.length, nlocals, instrs⟩ inputs) - (.ok modelLocals [result]) hevalBlock - simp [wFuncN, hself, hwrun] - -end ExprFragmentSoundness diff --git a/aver-cert/assets/wall/current/FieldProjectionSoundness.lean b/aver-cert/assets/wall/current/FieldProjectionSoundness.lean deleted file mode 100644 index 7ed18d407..000000000 --- a/aver-cert/assets/wall/current/FieldProjectionSoundness.lean +++ /dev/null @@ -1,60 +0,0 @@ -import CertPrelude -import SchemaCore -import PlanCheck -import PlanLower - -set_option maxRecDepth 100000 - -namespace FieldProjectionSoundness -open CertPrelude AverCert.Schema - -/-- Read field `fieldIdx` from a represented pair. -/ -def pairProjection (fieldIdx : Nat) (a b : WVal) : WVal := - match fieldIdx with - | 0 => a - | _ => b - -/-- Generic field-projection certificate shape. - -Given accepted projection-plan metadata and the audited lowering, the emitted -unary function on a represented two-element struct reads field `fieldIdx` of -that struct. --/ -theorem generic_field_projection_certified - (structIdx : Nat) - (plan : FieldProjectionRawPlan) - (code : CodeTbl) (host : HostTbl) - (self : Nat) - (hcheck : AverCert.PlanCheck.checkFieldProjectionRawPlan 2 plan = true) - (instrs : List WInstr) - (hlow : AverCert.PlanLower.lowerFieldProjectionBody structIdx 2 plan = some instrs) - (hself : code self = some { arity := 1, nlocals := 3, body := instrs }) : - ∀ (a b : WVal), - wFuncN code host 1 self [.structv structIdx [a, b]] = - some (pairProjection plan.fieldIdx a b) := by - intro a b - cases plan with - | mk profile fIdx => - have hcheck' : profile = "field-projection-v1" ∧ 2 = 2 ∧ fIdx < 2 := by - simpa [AverCert.PlanCheck.checkFieldProjectionRawPlan] using hcheck - have hlt : fIdx < 2 := hcheck'.2.2 - have hinstrs : - [.localGet 0, .localSet 2, .localGet 2, .refCast structIdx, - .structGet structIdx fIdx, .localSet 1, .localGet 1] = instrs := by - rw [AverCert.PlanLower.lowerFieldProjectionBody, hcheck] at hlow - simpa using hlow - subst hinstrs - cases fIdx with - | zero => - simp [pairProjection, wFuncN, hself, initLocals, wRunF] - | succ k => - cases k with - | zero => - simp [pairProjection, wFuncN, hself, initLocals, wRunF] - | succ k => - have hbad : ¬ Nat.succ (Nat.succ k) < 2 := by - exact Nat.not_lt_of_ge (Nat.succ_le_succ (Nat.succ_le_succ (Nat.zero_le k))) - exact False.elim (hbad (by simpa using hlt)) - - -end FieldProjectionSoundness diff --git a/aver-cert/assets/wall/current/Grammar.lean b/aver-cert/assets/wall/current/Grammar.lean new file mode 100644 index 000000000..c9d52eee0 --- /dev/null +++ b/aver-cert/assets/wall/current/Grammar.lean @@ -0,0 +1,1040 @@ +/- Grammar — the one-grammar certificate plan. + + The plan IS the optimized MIR function body (`src/ir/mir/expr.rs` + `MirExpr`), restricted to an admitted subset and printed 1:1 into this + Lean data. There is no hand-designed IR and no classifier: `Expr` keeps + MIR's node names and shape, so a mechanical printer can serialize a + `MirFn` body into it and decline every other node by name. + + This file holds the grammar, its typing (`tyOf`) and its source semantics + (`eval`, `groupModel`). `GrammarLower` ports the wasm-gc MIR emitter for + exactly these nodes, and `GrammarSound` proves the simulation theorem. + + Admitted subset (and how it maps to `MirExpr`): + + * `literal (.int k)` / `literal (.bool b)` / `literal (.float bits)` / + `literal (.str bytes)` — `Literal(Int)` (always in the i64 band; + `Literal::BigInt` is declined), `Literal(Bool)`, `Literal(Float)` by its + bit pattern and `Literal(Str)` by its UTF-8 bytes. + * `local slot` — `Local`; the slot is the resolver `LocalId`, which is the + wasm local index 1:1. + * `let_ binding value body` — a NAMED `Let` (an empty `binding_name`, the + synthetic drop form, is declined). + * `call (.fn idx) args` — `Call { callee: Fn(..) }`, the callee by its + wasm function index; `call (.builtin b) args` — `Call { callee: + Builtin(..) }` for `Bool.and`, `Bool.or`, `Bool.not`, `List.prepend`. + * `tailCall target args` — `TailCall`, target by wasm function index. + * `binOp op lhs rhs` — `BinOp` with `ast::BinOp` minus `Div`, over two + `Int` operands (arithmetic and the six comparisons), two `Bool` + operands (`==` and `!=`), two `Float` operands (the comparisons but + `!=`; no arithmetic) or two `String` operands (`+`, `==`, `!=`). + * `neg e` — `Neg` on `Int`. + * `ifThenElse c t e` — `IfThenElse`. + * `recordCreate tid fields` — `RecordCreate` whose fields are written in + declared order (the printer lists the values in that order); records + with fewer than two fields are declined, because the emitter lowers a + one-field record as a newtype. + * `project tid field base` — `Project`, the field by declared index. + * `call (.lazy b) [opt, dflt]` — `Call { callee: Builtin(..) }` for + `Option.withDefault` / `Result.withDefault` (the boxed path: the default + is evaluated only on the `None` / `Err` side, as the emitter does), the + fused `Option.withDefault(Vector.get(v, i), )` over two bare + locals (the emitter's bounds-checked `array.get`), and the fused + `Result.withDefault(Int.div(a, b), )` / + `Result.withDefault(Int.mod(a, b), )` (the emitter's guarded + `__aint_divmod` call; `Int.div` / `Int.mod` are admitted only there). + * `call (.intrinsic i) [a, ]` — `Call { callee: + Intrinsic(IntDivEuclid | IntModEuclid) }`, the resolver's discharge of + `Int.div` / `Int.mod` by a syntactic nonzero literal divisor: a bare + Euclidean `__aint_divmod` call. + * `interp parts` — `InterpolatedStr` whose parts are all `String` (a + literal part printed as a string literal). + * `list t []` — the empty `List(..)` literal, with its element type. + * `construct c ty args` — `Construct`; `c` is the constructor + (`MirCtor::User(CtorId)` as type id + constructor index, or a built-in + `Some`/`None`/`Ok`/`Err`) and `ty` is the node's stamped type + (`Option`, `Result` or the sum), which the emitter reads for + the struct index and the default filler. + * `match_ subject arms` — `Match`, the arms 1:1 (`MirMatchArm` pattern and + body). Patterns: `wild`, `litInt`, `litBool`, `litStr`, `bind slot`, + `ctor c bindings`, `tuple bindings` (the bindings are the resolver + slots, `noSlot` for `_`). The typing admits exactly the arm shapes the + emitter lowers with first-match meaning: an Int literal cascade with a + catch-all last, a two-arm Bool match, the two-arm Option / Result tag + dispatch, a user variant `ref.test` cascade of two or more arms that + covers every constructor, a String literal cascade with `_` last, and + the single-arm flat tuple destructure. + + Values: `SVal` has nested records (`record tid fields`; a one-field record + is a newtype, represented as its field's value), user variants (`variant + tid ctor fields`), Option / Result values that carry their instantiation, + Floats (bits), Strings (bytes), Vectors, Lists (`nil` / `cons`) and opaque + pass-through values (a `Map` field). A tuple instantiation is a record + type id of the type table. -/ +import SchemaBase + +namespace AverCert.Grammar +open CertPrelude AverCert.Schema + +/-! ## Grammar -/ + +/-- The i64 band: the Int literals the emitter boxes from one `i64.const`. -/ +def inI64Band (value : Int) : Bool := + decide (-(2 ^ 63 : Int) ≤ value) && decide (value < (2 ^ 63 : Int)) + +/-- Source types. `record tid` is a user record and `sum tid` a user sum type + by type id; `option` / `result` carry their instantiation. `eqref` is the + type of the subject-scratch local only: no source value has it. -/ +inductive Ty where + | int + | bool + | record (tid : Nat) + | sum (tid : Nat) + | option (t : Ty) + | result (t e : Ty) + | eqref + | float + | string + /-- `Vector`: a wasm array of the element representation. -/ + | vec (t : Ty) + /-- `List`: `null` or a cons cell struct `{head, tail}`. -/ + | list (t : Ty) + /-- A type the plan only passes through (a `Map` field of a constructor): + no operation reads it, and its values are the wasm values themselves. -/ + | opaque (tid : Nat) +deriving DecidableEq, Repr + +structure Sig where + params : List Ty + ret : Ty +deriving DecidableEq, Repr + +/-- `ast::Literal`, admitted part. -/ +inductive Lit where + | int (k : Int) + | bool (b : Bool) + /-- `Literal(Float)` by its IEEE-754 bit pattern. -/ + | float (bits : UInt64) + /-- `Literal(Str)` by its UTF-8 bytes. -/ + | str (bytes : List Nat) +deriving DecidableEq, Repr + +/-- `ast::BinOp` without `Div`. -/ +inductive BinOp where + | add | sub | mul | eq | neq | lt | gt | lte | gte +deriving DecidableEq, Repr + +/-- `MirCallee::Builtin`, admitted part (by dotted name). -/ +inductive Builtin where + | boolAnd | boolOr | boolNot + /-- `List.prepend(head, tail)`: one cons cell. -/ + | listPrepend + /-- `Vector.get(v, i)`: admitted only fused under `Option.withDefault` with + a literal default (the emitter's bounds-checked `array.get`). -/ + | vecGet + /-- `Int.div(a, b)` / `Int.mod(a, b)`: `Result`, admitted only + fused under `Result.withDefault` with an Int literal default (the + emitter's guarded `__aint_divmod` call). -/ + | intDiv | intMod +deriving DecidableEq, Repr + +/-- `BuiltinIntrinsic::IntDivEuclid` / `IntModEuclid`: Euclidean division and + remainder by a syntactic nonzero literal (no `Result`). -/ +inductive Intrinsic where + | intDivEuclid | intModEuclid +deriving DecidableEq, Repr + +/-- Builtins whose second argument the emitter evaluates only on one side + of the tag test (`Option.withDefault`, `Result.withDefault`, boxed path). -/ +inductive LazyBuiltin where + | optWithDefault | resWithDefault +deriving DecidableEq, Repr + +/-- `MirCallee`, admitted part. -/ +inductive MirCallee where + | fn (idx : Nat) + | builtin (b : Builtin) + | lazy (b : LazyBuiltin) + | intrinsic (i : Intrinsic) +deriving DecidableEq, Repr + +/-- `MirCtor`: a user constructor (type id, constructor index in declaration + order) or a built-in one. -/ +inductive CtorTag where + | user (tid c : Nat) + | some | none | ok | err +deriving DecidableEq, Repr + +/-- The resolver's slot for an ignored binder (`_`), `u16::MAX`. -/ +def noSlot : Nat := 65535 + +/-- `MirPattern`, admitted part. -/ +inductive Pat where + | wild + | litInt (k : Int) + | litBool (b : Bool) + | bind (slot : Nat) + | ctor (c : CtorTag) (bindings : List Nat) + /-- `Literal(Str)` pattern, by its bytes. -/ + | litStr (bytes : List Nat) + /-- A flat tuple destructure: one slot per component (`noSlot` for `_`). -/ + | tuple (bindings : List Nat) +deriving DecidableEq, Repr + +mutual + /-- `MirExpr`, admitted part. -/ + inductive Expr where + | literal (l : Lit) + | local (slot : Nat) + | let_ (binding : Nat) (value body : Expr) + | call (callee : MirCallee) (args : List Expr) + | tailCall (target : Nat) (args : List Expr) + | binOp (op : BinOp) (lhs rhs : Expr) + | neg (e : Expr) + | ifThenElse (cond thenB elseB : Expr) + | recordCreate (tid : Nat) (fields : List Expr) + | project (tid : Nat) (field : Nat) (base : Expr) + | match_ (subject : Expr) (arms : Arms) + | construct (c : CtorTag) (ty : Ty) (args : List Expr) + /-- `InterpolatedStr` whose parts are all `String`: a literal part is + printed as a string literal, an embed as its expression. -/ + | interp (parts : List Expr) + /-- `List(items)` with its element type (the stamped instantiation); + only the empty literal `[]` is admitted. -/ + | list (elem : Ty) (items : List Expr) + /-- The arms of a `Match`, in source order. -/ + inductive Arms where + | nil + | cons (pat : Pat) (body : Expr) (rest : Arms) +end + +def BinOp.isArith : BinOp → Bool + | .add | .sub | .mul => true + | _ => false + +def BinOp.isEquality : BinOp → Bool + | .eq | .neq => true + | _ => false + +/-- The Float comparisons the emitter lowers to one `f64` instruction + (`!=` would need `f64.ne`, which the interpreter does not model). -/ +def BinOp.isFloatCmp : BinOp → Bool + | .eq | .lt | .gt | .lte | .gte => true + | _ => false + +/-- The operations on two `String` operands: `+` (concatenation) and + `==` / `!=` (the ordering comparisons call a helper this grammar does + not admit). -/ +def BinOp.isStrOp : BinOp → Bool + | .add | .eq | .neq => true + | _ => false + +/-- Module context: the byte-derived indices a lowering needs (Int carrier, + host helpers, struct index per record type id, per variant constructor, + per Option / Result instantiation, the root struct of each sum, the + carrier's magnitude array) and the declarations the typing reads (record + field types, constructor field types, callee signatures). -/ +structure MCtx where + carrier : Nat + box : Nat + add : Nat + sub : Nat + mul : Nat + neg : Nat + cmp : Nat + /-- `__aint_divmod(a, b, want_mod)`, the Euclidean division helper. -/ + divmod : Nat := 0 + eq : Nat + structOf : Nat → Nat + recFields : Nat → Option (List Ty) + sigs : Nat → Option Sig + sumCtors : Nat → Option (List (List Ty)) := fun _ => none + ctorStruct : Nat → Nat → Nat := fun _ _ => 0 + sumRoot : Nat → Nat := fun _ => 0 + optStruct : Ty → Nat := fun _ => 0 + resStruct : Ty → Ty → Nat := fun _ _ => 0 + mag : Nat := 0 + /-- The String array type (`$string`, `(array (mut i8))`). -/ + str : Nat := 0 + /-- The passive data segment holding a string literal's bytes. -/ + strSeg : List Nat → Nat := fun _ => 0 + /-- The `Vector` array type the concatenation helper takes. -/ + strVec : Nat := 0 + /-- `__wasmgc_concat_n`, `__wasmgc_string_eq`, `__aint_to_index`. -/ + concat : Nat := 0 + streq : Nat := 0 + toIndex : Nat := 0 + /-- The array type of `Vector`, the cons struct of `List`, and the + heap type of an opaque type. -/ + vecStruct : Ty → Nat := fun _ => 0 + listStruct : Ty → Nat := fun _ => 0 + opaqueStruct : Nat → Nat := fun _ => 0 + +/-- One function's plan: signature, the resolver slot count (parameters and + every binder; the const-compare scratch local sits at this index), the + declared locals past the parameters (their wasm types, byte-pinned), and + the body. -/ +structure FnPlan where + sig : Sig + nslots : Nat + locals : List Ty + body : Expr + +/-- Point update of a slot map. -/ +def upd {α : Type} (f : Nat → Option α) (i : Nat) (a : α) : Nat → Option α := + fun j => if j = i then some a else f j + +/-- Bind a pattern's binders in order (skipping `noSlot`), each fresh and + below the slot count `n`; `none` on a length mismatch or a clash. -/ +def bindTys (n : Nat) (Γ : Nat → Option Ty) : List Nat → List Ty → Option (Nat → Option Ty) + | [], [] => some Γ + | b :: bs, t :: ts => + if b = noSlot then bindTys n Γ bs ts + else if b < n ∧ Γ b = none then bindTys n (upd Γ b t) bs ts else none + | _, _ => none + +/-- The field types of constructor `c` of sum `tid`. -/ +def ctorFields (M : MCtx) (tid c : Nat) : Option (List Ty) := + (M.sumCtors tid).bind (·[c]?) + +/-- A sum the emitter lowers as structs: declared, not a newtype (one + constructor with one field, which the emitter may erase to its payload), + and with distinct struct indices for distinct constructors (so an exact + `ref.test` tells the constructors apart). -/ +def sumOk (M : MCtx) (tid : Nat) : Bool := + match M.sumCtors tid with + | some cs => + !(cs.length == 1 && (cs.map List.length) == [1]) && + (List.range cs.length).all fun a => (List.range cs.length).all fun b => + M.ctorStruct tid a != M.ctorStruct tid b || a == b + | none => false + +/-- A one-field record is a newtype: the emitter erases it to its field's + value (`newtype_underlying`), so its values are represented as that + value. -/ +def MCtx.newtype (M : MCtx) (tid : Nat) : Bool := + match M.recFields tid with + | some [_] => true + | _ => false + +/-- A type with a default filler value (the emitter's `emit_default_value`): + the Small zero carrier, `i32 0`, `f64 0`, or `ref.null` of the type's + heap type (a record, sum, Option, Result, String, List or Vector). -/ +def Ty.hasDefault : Ty → Bool + | .int | .bool | .record _ | .sum _ | .option _ | .result _ _ => true + | .string | .float | .list _ | .vec _ => true + | _ => false + +def Pat.isWild : Pat → Bool + | .wild => true + | _ => false + +def Arms.length : Arms → Nat + | .nil => 0 + | .cons _ _ rest => rest.length + 1 + +/-- The Int cascade needs a literal first arm, so the subject is evaluated + at least once on every path. -/ +def Arms.firstLit : Arms → Bool + | .cons (.litInt _) _ _ => true + | _ => false + +/-- Constructor `c` is reached by some arm: a wildcard, or an arm of `c`. -/ +def coversB (c : Nat) : Arms → Bool + | .nil => false + | .cons .wild _ _ => true + | .cons (.ctor (.user _ c') _) _ rest => c' == c || coversB c rest + | .cons _ _ rest => coversB c rest + +/-- Every constructor of the sum is reached: the untested last arm of the + emitter's cascade is then exactly the remaining constructor. -/ +def varExhaustive (M : MCtx) (tid : Nat) (arms : Arms) : Bool := + match M.sumCtors tid with + | some cs => (List.range cs.length).all fun c => coversB c arms + | none => false + +/-- The emitter's Option arm pick for the admitted shapes: `(swap, binder)`, + where `swap` says the `Some` arm is the second one. -/ +def optPick : Pat → Pat → Option (Bool × Nat) + | .ctor .some [b], .ctor .none [] => some (false, b) + | .ctor .some [b], .wild => some (false, b) + | .ctor .none [], .ctor .some [b] => some (true, b) + | .ctor .none [], .wild => some (true, noSlot) + | _, _ => none + +/-- The emitter's Result arm pick: `(swap, okBinder, errBinder)`, where + `swap` says the `Ok` arm is the second one. -/ +def resPick : Pat → Pat → Option (Bool × Nat × Nat) + | .ctor .ok [a], .ctor .err [b] => some (false, a, b) + | .ctor .ok [a], .wild => some (false, a, noSlot) + | .ctor .err [b], .ctor .ok [a] => some (true, a, b) + | .ctor .err [b], .wild => some (true, noSlot, b) + | _, _ => none + +/-- The fused `Option.withDefault(Vector.get(v, i), )` shape + (`emit_mir_option_with_default`): the vector and index slots when the + vector and the index are bare locals. Any other operand shape is + declined (the emitter re-evaluates both operands per read). -/ +def vecGetOr? : LazyBuiltin → Expr → Expr → Option (Nat × Nat) + | .optWithDefault, .call (.builtin .vecGet) [.local v, .local i], .literal _ => some (v, i) + | _, _, _ => none + +/-- The fused `Result.withDefault(Int.div(a, b), )` / + `Result.withDefault(Int.mod(a, b), )` shape + (`emit_mir_result_with_default`, bignum path): `(isMod, a, b)`. The + emitter evaluates `a`, `b` and the default once each, in that order, + before the zero test; with a literal default the source meaning (the + default only on the `Err` side) is the same. Any other default shape is + declined. -/ +def divOr? : LazyBuiltin → Expr → Expr → Option (Bool × Expr × Expr) + | .resWithDefault, .call (.builtin .intDiv) [a, b], .literal (.int _) => some (false, a, b) + | .resWithDefault, .call (.builtin .intMod) [a, b], .literal (.int _) => some (true, a, b) + | _, _, _ => none + +/-- An intrinsic's divisor: a nonzero Int literal in the i64 band (the + resolver discharges only a syntactic nonzero literal). -/ +def divisorLit? : Expr → Option Int + | .literal (.int k) => if k ≠ 0 ∧ inI64Band k then some k else none + | _ => none + +/-- Every part of an interpolation is a `String`, and there is one. -/ +def allStr : List Ty → Bool + | [] => false + | [.string] => true + | .string :: ts => allStr ts + | _ => false + +/-- One binder of a built-in payload. -/ +def bindOne (n : Nat) (Γ : Nat → Option Ty) (b : Nat) (t : Ty) : Option (Nat → Option Ty) := + bindTys n Γ [b] [t] + +/-- The typing environment of one variant-cascade arm. -/ +def varArmΓ (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tid : Nat) : Pat → Option (Nat → Option Ty) + | .ctor (.user tid' c) bs => + if tid' = tid then + match ctorFields M tid c with + | some fts => bindTys n Γ bs fts + | none => none + else none + | .wild => some Γ + | _ => none + +/-! ## Typing + +One checker for every node. `n` is the resolver slot count: a `let` binder +must be below it and not yet bound (fresh), so the scratch local at `n` is +never a binder. `tail` is the position: `tailCall` is typed only in tail +position (its `return_call` leaves the function). -/ + +def builtinTy : Builtin → List Ty → Option Ty + | .boolAnd, [.bool, .bool] => some .bool + | .boolOr, [.bool, .bool] => some .bool + | .boolNot, [.bool] => some .bool + | .listPrepend, [t, .list t'] => if t = t' then some (.list t) else none + | _, _ => none + +/-- `withDefault` over a subject and default of these types. -/ +def lazyTy : LazyBuiltin → Ty → Ty → Option Ty + | .optWithDefault, .option t, d => if t = d ∧ t.hasDefault then some t else none + | .resWithDefault, .result t _, d => if t = d ∧ t.hasDefault then some t else none + | _, _, _ => none + +/-- The type a constructor node builds from argument types `ts`. -/ +def ctorTy (M : MCtx) : CtorTag → Ty → List Ty → Option Ty + | .user tid c, .sum tid', ts => + if tid = tid' ∧ sumOk M tid ∧ ctorFields M tid c = some ts then some (.sum tid) else none + | .some, .option t, ts => if ts = [t] ∧ t.hasDefault then some (.option t) else none + | .none, .option t, ts => if ts = [] ∧ t.hasDefault then some (.option t) else none + | .ok, .result t e, ts => + if ts = [t] ∧ t.hasDefault ∧ e.hasDefault then some (.result t e) else none + | .err, .result t e, ts => + if ts = [e] ∧ t.hasDefault ∧ e.hasDefault then some (.result t e) else none + | _, _, _ => none + +mutual + def tyOf (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) : + Expr → Option Ty + | .literal (.int k) => if inI64Band k then some .int else none + | .literal (.bool _) => some .bool + | .literal (.float _) => some .float + | .literal (.str _) => some .string + | .local i => Γ i + | .let_ b v body => + if b < n ∧ Γ b = none then + match tyOf M n Γ false v with + | some T => tyOf M n (upd Γ b T) tail body + | none => none + else none + | .call (.fn f) args => + match M.sigs f, tysOf M n Γ args with + | some sig, some ts => if ts = sig.params then some sig.ret else none + | _, _ => none + | .call (.builtin bi) args => + match tysOf M n Γ args with + | some ts => builtinTy bi ts + | none => none + | .tailCall f args => + if tail then + match M.sigs f, tysOf M n Γ args with + | some sig, some ts => if ts = sig.params then some sig.ret else none + | _, _ => none + else none + | .binOp op l r => + match tyOf M n Γ false l, tyOf M n Γ false r with + | some .int, some .int => if op.isArith then some .int else some .bool + | some .bool, some .bool => if op.isEquality then some .bool else none + | some .float, some .float => if op.isFloatCmp then some .bool else none + | some .string, some .string => + if op = .add then some .string else if op.isStrOp then some .bool else none + | _, _ => none + | .neg e => + match tyOf M n Γ false e with + | some .int => some .int + | _ => none + | .ifThenElse c t e => + match tyOf M n Γ false c, tyOf M n Γ tail t, tyOf M n Γ tail e with + | some .bool, some T, some T' => if T = T' then some T else none + | _, _, _ => none + | .recordCreate tid fs => + match M.recFields tid, tysOf M n Γ fs with + | some fts, some ts => if 2 ≤ fts.length ∧ ts = fts then some (.record tid) else none + | _, _ => none + | .project tid i base => + match tyOf M n Γ false base, M.recFields tid with + | some (.record tid'), some fts => + if tid' = tid ∧ 2 ≤ fts.length then fts[i]? else none + | _, _ => none + | .call (.lazy lb) args => + match args with + | [o, d] => + match vecGetOr? lb o d with + | some (v, i) => + match Γ v, Γ i, tyOf M n Γ false d with + | some (.vec t), some .int, some td => if td = t then some t else none + | _, _, _ => none + | none => + match divOr? lb o d with + | some _ => + if tyDivOperands M n Γ o = true ∧ tyOf M n Γ false d = some .int then + some .int + else none + | none => + match tyOf M n Γ false o, tyOf M n Γ false d with + | some to, some td => lazyTy lb to td + | _, _ => none + | _ => none + | .call (.intrinsic _) args => + match args with + | [a, dv] => + match divisorLit? dv, tyOf M n Γ false a with + | some _, some .int => some .int + | _, _ => none + | _ => none + | .construct c ty args => + match tysOf M n Γ args with + | some ts => ctorTy M c ty ts + | none => none + | .interp parts => + match tysOf M n Γ parts with + | some ts => if allStr ts then some .string else none + | none => none + | .list t items => + match items with + | [] => some (.list t) + | _ => none + | .match_ s arms => + match tyOf M n Γ false s with + | some .int => if arms.firstLit then tyIntArms M n Γ tail arms else none + | some .bool => tyBoolArms M n Γ tail arms + | some (.option t) => tyOptArms M n Γ tail t arms + | some (.result t e) => tyResArms M n Γ tail t e arms + | some (.sum tid) => + if sumOk M tid ∧ varExhaustive M tid arms ∧ 2 ≤ arms.length then + tyVarArms M n Γ tail tid arms + else none + | some .string => tyStrArms M n Γ tail arms + | some (.record tid) => tyTupArms M n Γ tail tid arms + | _ => none + def tysOf (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) : List Expr → Option (List Ty) + | [] => some [] + | e :: es => + match tyOf M n Γ false e, tysOf M n Γ es with + | some t, some ts => some (t :: ts) + | _, _ => none + /-- The operands of the fused `Int.div(a, b)` / `Int.mod(a, b)` are two + Ints (the node itself has no type of its own: it is admitted only + under `Result.withDefault`). -/ + def tyDivOperands (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) : Expr → Bool + | .call _ oargs => + match tysOf M n Γ oargs with + | some [.int, .int] => true + | _ => false + | _ => false + /-- Int literal cascade: literal arms, then one catch-all (`_` or a binder) + as the last arm. -/ + def tyIntArms (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) : Arms → Option Ty + | .nil => none + | .cons p b rest => + match p, rest with + | .litInt k, _ => + if inI64Band k then + match tyOf M n Γ tail b, tyIntArms M n Γ tail rest with + | some t, some t' => if t = t' then some t else none + | _, _ => none + else none + | .wild, .nil => tyOf M n Γ tail b + | .bind s, .nil => + if s < n ∧ Γ s = none ∧ s ≠ noSlot then tyOf M n (upd Γ s .int) tail b else none + | _, _ => none + /-- Two-arm Bool match: a literal arm, then the other literal or `_`. -/ + def tyBoolArms (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) : Arms → Option Ty + | .cons (.litBool v) t (.cons p e .nil) => + if p = .litBool (!v) ∨ p = .wild then + match tyOf M n Γ tail t, tyOf M n Γ tail e with + | some a, some b => if a = b then some a else none + | _, _ => none + else none + | _ => none + /-- Two-arm Option match (`optPick` shapes); the `Some` binder is fresh. -/ + def tyOptArms (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) (t : Ty) : + Arms → Option Ty + | .cons p1 b1 (.cons p2 b2 .nil) => + match optPick p1 p2 with + | some (swap, sb) => + match bindOne n Γ sb t with + | some Γs => + match swap with + | false => + match tyOf M n Γs tail b1, tyOf M n Γ tail b2 with + | some a, some b => if a = b then some a else none + | _, _ => none + | true => + match tyOf M n Γs tail b2, tyOf M n Γ tail b1 with + | some a, some b => if a = b then some a else none + | _, _ => none + | none => none + | none => none + | _ => none + /-- Two-arm Result match (`resPick` shapes); binders fresh. -/ + def tyResArms (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) (t e : Ty) : + Arms → Option Ty + | .cons p1 b1 (.cons p2 b2 .nil) => + match resPick p1 p2 with + | some (swap, ob, eb) => + match bindOne n Γ ob t, bindOne n Γ eb e with + | some Γo, some Γe => + match swap with + | false => + match tyOf M n Γo tail b1, tyOf M n Γe tail b2 with + | some a, some b => if a = b then some a else none + | _, _ => none + | true => + match tyOf M n Γo tail b2, tyOf M n Γe tail b1 with + | some a, some b => if a = b then some a else none + | _, _ => none + | _, _ => none + | none => none + | _ => none + /-- User-variant cascade: constructor arms of this sum, `_` only last. -/ + def tyVarArms (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) (tid : Nat) : + Arms → Option Ty + | .nil => none + | .cons p b .nil => + match varArmΓ M n Γ tid p with + | some Γ' => tyOf M n Γ' tail b + | none => none + | .cons p b (.cons p' b' r) => + if p.isWild then none + else + match varArmΓ M n Γ tid p with + | some Γ' => + match tyOf M n Γ' tail b, tyVarArms M n Γ tail tid (.cons p' b' r) with + | some a, some c => if a = c then some a else none + | _, _ => none + | none => none + /-- String literal cascade (`emit_mir_string_match`): literal arms, then + one `_` as the last arm (the emitter tests every literal arm before + its single default, so a default anywhere else would not be + first-match, and a binder default would never be bound). -/ + def tyStrArms (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) : Arms → Option Ty + | .nil => none + | .cons p b rest => + match p, rest with + | .litStr _, _ => + match tyOf M n Γ tail b, tyStrArms M n Γ tail rest with + | some t, some t' => if t = t' then some t else none + | _, _ => none + | .wild, .nil => tyOf M n Γ tail b + | _, _ => none + /-- The single-arm flat tuple destructure (`emit_mir_tuple_match`) over a + tuple instantiation, which the type table lists as a record of two or + more fields; at least one component is bound (so the destructure reads + the stashed subject). -/ + def tyTupArms (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) (tid : Nat) : + Arms → Option Ty + | .cons (.tuple bs) b .nil => + match M.recFields tid with + | some fts => + if 2 ≤ fts.length ∧ bs.any (· != noSlot) then + match bindTys n Γ bs fts with + | some Γ' => tyOf M n Γ' tail b + | none => none + else none + | none => none + | _ => none +end + +/-! ## Source values -/ + +/-- Source values. Option and Result values carry their instantiation, so a + value alone names the struct that represents it. -/ +inductive SVal where + | i (n : Int) + | b (v : Bool) + | record (tid : Nat) (fields : List SVal) + | variant (tid c : Nat) (fields : List SVal) + | none (t : Ty) + | some (t : Ty) (v : SVal) + | ok (t e : Ty) (v : SVal) + | err (t e : Ty) (v : SVal) + /-- A Float by its IEEE-754 bit pattern. -/ + | f (bits : UInt64) + /-- A String by its UTF-8 bytes. -/ + | s (bytes : List Nat) + /-- A `Vector`. -/ + | vec (t : Ty) (vs : List SVal) + /-- The empty `List` and a cons cell of a `List`. -/ + | nil (t : Ty) + | cons (t : Ty) (h tl : SVal) + /-- A value of an opaque type: the wasm value itself. -/ + | w (v : CertPrelude.WVal) +deriving Repr + +mutual + /-- A source value inhabits a type, over the module's record and sum + declarations. -/ + def HasTy (M : MCtx) : SVal → Ty → Prop + | .i _, .int => True + | .b _, .bool => True + | .record tid fs, .record tid' => + tid = tid' ∧ ∃ fts, M.recFields tid = some fts ∧ HasTyL M fs fts + | .variant tid c fs, .sum tid' => + tid = tid' ∧ ∃ fts, ctorFields M tid c = some fts ∧ HasTyL M fs fts + | .none t, .option t' => t = t' + | .some t v, .option t' => t = t' ∧ HasTy M v t + | .ok t e v, .result t' e' => t = t' ∧ e = e' ∧ HasTy M v t + | .err t e v, .result t' e' => t = t' ∧ e = e' ∧ HasTy M v e + | .f _, .float => True + | .s _, .string => True + | .vec t vs, .vec t' => t = t' ∧ HasTyAll M vs t + | .nil t, .list t' => t = t' + | .cons t h tl, .list t' => t = t' ∧ HasTy M h t ∧ HasTy M tl (.list t) + | .w _, .opaque _ => True + | _, _ => False + def HasTyL (M : MCtx) : List SVal → List Ty → Prop + | [], [] => True + | v :: vs, t :: ts => HasTy M v t ∧ HasTyL M vs ts + | _, _ => False + /-- Every element has type `t`. -/ + def HasTyAll (M : MCtx) : List SVal → Ty → Prop + | [], _ => True + | v :: vs, t => HasTy M v t ∧ HasTyAll M vs t +end + +/-! ## Source semantics + +`F f` is the meaning of callee `f` (already specialised to a fuel level); +nothing here knows any function body. Evaluation is pure and strict, except +that `withDefault` evaluates its default only on the `None` / `Err` side (as +the emitted code does), and a `Match` takes its FIRST matching arm. -/ + +def intBin : BinOp → Int → Int → SVal + | .add, x, y => .i (x + y) + | .sub, x, y => .i (x - y) + | .mul, x, y => .i (x * y) + | .eq, x, y => .b (decide (x = y)) + | .neq, x, y => .b (decide (x ≠ y)) + | .lt, x, y => .b (decide (x < y)) + | .gt, x, y => .b (decide (x > y)) + | .lte, x, y => .b (decide (x ≤ y)) + | .gte, x, y => .b (decide (x ≥ y)) + +def boolBin : BinOp → Bool → Bool → Option SVal + | .eq, x, y => some (.b (x == y)) + | .neq, x, y => some (.b (x != y)) + | _, _, _ => none + +/-- Float comparisons, read exactly as the audited interpreter reads the + `f64` instruction the emitter picks (IEEE-754: every comparison with a + NaN is false, and `-0.0 == 0.0`). -/ +def floatBin : BinOp → UInt64 → UInt64 → Option SVal + | .eq, x, y => some (.b (CertPrelude.f x == CertPrelude.f y)) + | .lt, x, y => some (.b (decide (CertPrelude.f x < CertPrelude.f y))) + | .gt, x, y => some (.b (decide (CertPrelude.f y < CertPrelude.f x))) + | .lte, x, y => some (.b (decide (CertPrelude.f x ≤ CertPrelude.f y))) + | .gte, x, y => some (.b (decide (CertPrelude.f y ≤ CertPrelude.f x))) + | _, _, _ => none + +/-- String concatenation and byte equality. -/ +def strBin : BinOp → List Nat → List Nat → Option SVal + | .add, x, y => some (.s (x ++ y)) + | .eq, x, y => some (.b (x == y)) + | .neq, x, y => some (.b (x != y)) + | _, _, _ => none + +/-- The bytes of a list of Strings, concatenated in order. -/ +def strCat : List SVal → Option (List Nat) + | [] => some [] + | .s x :: rest => (strCat rest).map (x ++ ·) + | _ => none + +/-- The UTF-8 bytes of `"division by zero"`, the `Err` payload of `Int.div` / + `Int.mod` at a zero divisor (`src/types/int.rs`). -/ +def divByZeroBytes : List Nat := + [100, 105, 118, 105, 115, 105, 111, 110, 32, 98, 121, 32, 122, 101, 114, 111] + +def builtinEval : Builtin → List SVal → Option SVal + | .boolAnd, [.b x, .b y] => some (.b (x && y)) + | .boolOr, [.b x, .b y] => some (.b (x || y)) + | .boolNot, [.b x] => some (.b (!x)) + | .listPrepend, [h, .nil t] => some (.cons t h (.nil t)) + | .listPrepend, [h, .cons t x r] => some (.cons t h (.cons t x r)) + | .vecGet, [.vec t vs, .i n] => + if 0 ≤ n ∧ n < vs.length then (vs[n.toNat]?).map (.some t) else some (.none t) + | .intDiv, [.i x, .i y] => + if y = 0 then some (.err .int .string (.s divByZeroBytes)) else some (.ok .int .string (.i (x / y))) + | .intMod, [.i x, .i y] => + if y = 0 then some (.err .int .string (.s divByZeroBytes)) else some (.ok .int .string (.i (x % y))) + | _, _ => none + +/-- A Euclidean intrinsic (Lean's `Int` `/` and `%` are `Int.ediv` and + `Int.emod`: the remainder lies in `[0, |y|)`); `none` at a zero divisor, + which the typing rules out. -/ +def intrinsicEval : Intrinsic → List SVal → Option SVal + | .intDivEuclid, [.i x, .i y] => if y = 0 then none else some (.i (x / y)) + | .intModEuclid, [.i x, .i y] => if y = 0 then none else some (.i (x % y)) + | _, _ => none + +/-- The value a constructor node builds. -/ +def ctorVal : CtorTag → Ty → List SVal → Option SVal + | .user tid c, _, vs => some (.variant tid c vs) + | .some, .option t, [v] => some (.some t v) + | .none, .option t, [] => some (.none t) + | .ok, .result t e, [v] => some (.ok t e v) + | .err, .result t e, [v] => some (.err t e v) + | _, _, _ => none + +/-- A pattern against a value: `none` when it does not match, else the + binders with the values they take (in field order). -/ +def patMatch : Pat → SVal → Option (List Nat × List SVal) + | .wild, _ => some ([], []) + | .litInt k, .i x => if x = k then some ([], []) else none + | .litBool v, .b x => if x = v then some ([], []) else none + | .bind s, v => some ([s], [v]) + | .ctor (.user tid c) bs, .variant tid' c' fs => + if tid = tid' ∧ c = c' then some (bs, fs) else none + | .ctor .some bs, .some _ v => some (bs, [v]) + | .ctor .none bs, .none _ => some (bs, []) + | .ctor .ok bs, .ok _ _ v => some (bs, [v]) + | .ctor .err bs, .err _ _ v => some (bs, [v]) + | .litStr k, .s x => if x = k then some ([], []) else none + | .tuple bs, .record _ fs => some (bs, fs) + | _, _ => none + +/-- Bind the binders in order, skipping `noSlot`; `none` on a length + mismatch. -/ +def bindVals (env : Nat → Option SVal) : List Nat → List SVal → Option (Nat → Option SVal) + | [], [] => some env + | b :: bs, v :: vs => if b = noSlot then bindVals env bs vs else bindVals (upd env b v) bs vs + | _, _ => none + +mutual + def eval (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) : + Expr → Option SVal + | .literal (.int k) => some (.i k) + | .literal (.bool v) => some (.b v) + | .literal (.float bits) => some (.f bits) + | .literal (.str bytes) => some (.s bytes) + | .local i => env i + | .let_ b v body => + match eval F env v with + | some x => eval F (upd env b x) body + | none => none + | .call (.fn f) args => + match evalArgs F env args with + | some vs => F f vs + | none => none + | .call (.builtin bi) args => + match evalArgs F env args with + | some vs => builtinEval bi vs + | none => none + | .call (.intrinsic ie) args => + match evalArgs F env args with + | some vs => intrinsicEval ie vs + | none => none + | .tailCall f args => + match evalArgs F env args with + | some vs => F f vs + | none => none + | .binOp op l r => + match eval F env l, eval F env r with + | some (.i x), some (.i y) => some (intBin op x y) + | some (.b x), some (.b y) => boolBin op x y + | some (.f x), some (.f y) => floatBin op x y + | some (.s x), some (.s y) => strBin op x y + | _, _ => none + | .neg e => + match eval F env e with + | some (.i x) => some (.i (-x)) + | _ => none + | .ifThenElse c t e => + match eval F env c with + | some (.b true) => eval F env t + | some (.b false) => eval F env e + | _ => none + | .recordCreate tid fs => + match evalArgs F env fs with + | some vs => some (.record tid vs) + | none => none + | .project _ i base => + match eval F env base with + | some (.record _ fs) => fs[i]? + | _ => none + | .call (.lazy lb) args => + match args with + | [o, d] => + match lb, eval F env o with + | .optWithDefault, some (.some _ v) => some v + | .optWithDefault, some (.none _) => eval F env d + | .resWithDefault, some (.ok _ _ v) => some v + | .resWithDefault, some (.err _ _ _) => eval F env d + | _, _ => none + | _ => none + | .construct c ty args => + match evalArgs F env args with + | some vs => ctorVal c ty vs + | none => none + | .match_ s arms => + match eval F env s with + | some v => evalArms F env v arms + | none => none + | .interp parts => + match evalArgs F env parts with + | some vs => (strCat vs).map .s + | none => none + | .list t items => + match items with + | [] => some (.nil t) + | _ => none + def evalArgs (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) : + List Expr → Option (List SVal) + | [] => some [] + | e :: es => + match eval F env e, evalArgs F env es with + | some v, some vs => some (v :: vs) + | _, _ => none + /-- First-match: the first arm whose pattern matches runs, with its + binders bound. -/ + def evalArms (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (v : SVal) : + Arms → Option SVal + | .nil => none + | .cons p b rest => + match patMatch p v with + | some (bs, vs) => + match bindVals env bs vs with + | some env' => eval F env' b + | none => none + | none => evalArms F env v rest +end + +def argsEnv (vs : List SVal) : Nat → Option SVal := fun i => vs[i]? + +def paramsΓ (ts : List Ty) : Nat → Option Ty := fun i => ts[i]? + +/-- The lowering's local layout: `n` resolver slots (parameters and binders), + then the scratch locals the emitter reserves after them + (`SlotTable::build_for_fn`): the subject scratch (`eqref`, present when + the function has a constructor match) and the const-compare scratch. -/ +structure LCtx where + n : Nat + cmp : Nat + subj : Nat + +/-- Scratch positions as a WALL function of the declared locals: the subject + scratch is the `eqref` local right after the resolver slots, and the + const-compare scratch follows it (or sits there when there is none). -/ +def FnPlan.lctx (p : FnPlan) : LCtx := + if p.locals[p.nslots - p.sig.params.length]? = some .eqref then + { n := p.nslots, cmp := p.nslots + 1, subj := p.nslots } + else + { n := p.nslots, cmp := p.nslots, subj := p.nslots } + +/-- The typing and slot-layout checks one plan must pass: parameters sit + below the slot count, the scratch locals are declared, and the body has + the declared result type in tail position. -/ +def planTyped (M : MCtx) (p : FnPlan) : Bool := + decide (p.sig.params.length ≤ p.nslots) && + decide (p.nslots ≤ p.sig.params.length + p.locals.length) && + decide (tyOf M p.nslots (paramsΓ p.sig.params) true p.body = some p.sig.ret) + +/-- The meaning of a group of functions (one SCC), fuel-indexed exactly as + `wFuncN` peels fuel: at fuel `k + 1` a member's body runs with every + callee at fuel `k` — members through this model, functions outside the + group through `outer`. -/ +def groupModel (outer : Nat → Nat → List SVal → Option SVal) + (G : Nat → Option FnPlan) : Nat → Nat → List SVal → Option SVal + | 0, f, args => + match G f with + | some _ => none + | none => outer 0 f args + | k + 1, f, args => + match G f with + | some p => eval (groupModel outer G k) (argsEnv args) p.body + | none => outer (k + 1) f args + +/-! ## Representation + +The representation relation the statement is written over (`SchemaCore` +`Obligation.holds`): a source value against the wasm value that represents it, +read off the module layout `M`. -/ + +/-- The wasm image of a String: the `$string` array of its bytes. -/ +def strW (M : MCtx) (bytes : List Nat) : WVal := + .arr M.str (bytes.map fun (b : Nat) => .i32v (b : Int)) + +mutual + /-- Representation, read off the module context's layout: a record is the + struct of its type (a one-field newtype record is its field's value), a + variant the struct of its constructor, an Option / Result the struct + of its instantiation with the tag in field 0 (the unused payload field + holds an arbitrary filler); a Float is its `f64` bits, a String the + `$string` array of its bytes, a Vector the array of its elements (below + `2^31` of them, the index space `__aint_to_index` maps onto), a List + `null` or a cons struct `{head, tail}`, and an opaque value itself. -/ + def SRepr {C : Nat} (S : CarrierSpec C) (M : MCtx) : SVal → WVal → Prop + | .i n, w => CanonRepr S n w + | .b v, w => w = b32 v + | .record tid fs, w => + if M.newtype tid then SReprL S M fs [w] + else ∃ ws, w = .structv (M.structOf tid) ws ∧ SReprL S M fs ws + | .variant tid c fs, w => ∃ ws, w = .structv (M.ctorStruct tid c) ws ∧ SReprL S M fs ws + | .none t, w => ∃ d, w = .structv (M.optStruct t) [.i32v 0, d] + | .some t v, w => ∃ x, w = .structv (M.optStruct t) [.i32v 1, x] ∧ SRepr S M v x + | .ok t e v, w => ∃ x d, w = .structv (M.resStruct t e) [.i32v 1, x, d] ∧ SRepr S M v x + | .err t e v, w => ∃ d x, w = .structv (M.resStruct t e) [.i32v 0, d, x] ∧ SRepr S M v x + | .f bits, w => w = .f64v bits + | .s bytes, w => w = strW M bytes + | .vec t vs, w => + vs.length < 2147483648 ∧ ∃ ws, w = .arr (M.vecStruct t) ws ∧ SReprL S M vs ws + | .nil _, w => w = .null + | .cons t h tl, w => + ∃ x y, w = .structv (M.listStruct t) [x, y] ∧ SRepr S M h x ∧ SRepr S M tl y + | .w v, x => x = v + def SReprL {C : Nat} (S : CarrierSpec C) (M : MCtx) : + List SVal → List WVal → Prop + | [], [] => True + | v :: vs, w :: ws => SRepr S M v w ∧ SReprL S M vs ws + | _, _ => False +end + +end AverCert.Grammar diff --git a/aver-cert/assets/wall/current/GrammarBridge.lean b/aver-cert/assets/wall/current/GrammarBridge.lean new file mode 100644 index 000000000..95571940c --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarBridge.lean @@ -0,0 +1,470 @@ +/- GrammarBridge — plan-equals-source bridges on the one grammar. + + A certified export's obligation is stated over its plan: the model is the + plan's fuel-indexed meaning (`AcceptedArtifact.modelOf`). A BRIDGE says + that this model computes a named source function `f`, read through + source-value encoders. The checker renders every bridge statement from + structure (`aver-cert/src/bridge_statement.rs`) in one of two kinds, both + defined here: + + * `Exact` — for a plan whose call closure has no recursion: above some + fuel, the model at every encoded argument list returns exactly the + encoded source result. + * `Adequate` — for any plan, recursive or not: every result the model + returns (at any fuel) on an encoded argument list is the encoded source + result. Together with the obligation's `holds` this is the L1 meaning + "whatever the bytes return on represented source arguments represents + `f` of those arguments" (`adequate_transfer`). It says nothing about + termination: a model that never returns satisfies it vacuously, and a + bridge is never read as a totality claim. + + Both kinds also state that every encoded argument list inhabits the plan's + parameter types, so the obligation's `holds` applies to it. + + The proof engines are generic in the plan. The producer supplies a source + IMAGE table `I` (per bridged function, the encoded source result at the + argument lists its decoder recognises) and ONE step lemma per function + (`Step`): the plan body, with every call answered by the callees' images, + returns the function's own image. That lemma unfolds the source function + once; it never inducts. `bridge_of_step` turns the step lemmas of a call + closure into adequacy at every fuel by one fuel induction for the whole + closure (self and mutual recursion alike), using that evaluation is + monotone in the callee table (`eval_mono`). `exact_of_step` turns them + into exact answers above a declared call depth, for a closure without + recursion. -/ +import AcceptedArtifactCore + +namespace AverCert.GrammarBridge +open AverCert.Schema AverCert.Grammar AverCert.TypeTable AverCert.AcceptedArtifact CertPrelude + +/-! ## The statement vocabulary -/ + +/-- Export `name`'s obligation: the first obligation of the manifest carrying + that export name (`HoldsCore` covers every member, so the choice among + duplicates is immaterial). -/ +def exportObligation (m : Manifest) (name : String) : Option Obligation := + m.obligations.find? (fun o => o.export_ == name) + +theorem exportObligation_mem {m : Manifest} {name : String} {o : Obligation} + (h : exportObligation m name = some o) : o ∈ m.obligations := + List.mem_of_find?_eq_some h + +/-! Selecting an export's obligation without evaluating String equality. + +The kernel has no fast path for String literals: deciding `a == b` rebuilds +both UTF-8 byte arrays, in time quadratic in their length. Deciding +`exportObligation` directly therefore compares the wanted name with every +earlier export name. The lemmas below select it from pairwise-distinct names +instead: the names are shown distinct ONCE per package, as character lists +(a literal is definitionally `String.ofList` of its characters, which the +kernel checks without building bytes), and each export's obligation then +follows from membership and one literal-to-literal name equality. -/ + +theorem find?_export_of_nodup {os : List Obligation} {name : String} {o : Obligation} + (hnd : (os.map (·.export_)).Nodup) (hmem : o ∈ os) (hname : o.export_ = name) : + os.find? (fun o => o.export_ == name) = some o := by + induction os with + | nil => cases hmem + | cons a rest ih => + rw [List.map_cons, List.nodup_cons] at hnd + rcases List.mem_cons.mp hmem with rfl | hrest + · simp [hname] + · have hne : ¬ a.export_ = name := fun h => + hnd.1 (List.mem_map.mpr ⟨o, hrest, hname.trans h.symm⟩) + simp [hne, ih hnd.2 hrest] + +/-- One number per code-point list: base `2^21` digits `c + 1`. A decided + `Nodup` over these numbers compares one numeral per pair; it needs no + injectivity, since distinct images already have distinct preimages. -/ +def natOfCodes : List Nat → Nat + | [] => 0 + | c :: cs => (c + 1) + 2097152 * natOfCodes cs + +/-- Pairwise-distinct names, from pairwise-distinct character lists, decided + on one number per list. -/ +theorem names_nodup_of_chars {names : List String} (cs : List (List Char)) + (h : names = cs.map String.ofList) + (hnd : (cs.map (fun c => natOfCodes (c.map Char.toNat))).Nodup) : names.Nodup := by + subst h + have hcs : cs.Nodup := + List.Pairwise.of_map (fun c => natOfCodes (c.map Char.toNat)) + (fun a b hab heq => hab (heq ▸ rfl)) hnd + exact List.Pairwise.map String.ofList (fun a b hab heq => + hab (by simpa [String.toList_ofList] using congrArg String.toList heq)) hcs + +/-- The obligation of a planned, exported entry, when the manifest's export + names are pairwise distinct. -/ +theorem exportObligation_of_entry {m : Manifest} {s : Subject} {tt : TypeTable} + {fns : List FnEntry} (hm : m.obligations = obligationsOf s tt fns) + (hnd : (m.obligations.map (·.export_)).Nodup) {e : FnEntry} (he : e ∈ fns) + (hex : e.exported = true) : + exportObligation m e.name = some (obligationOf s tt fns e) := by + unfold exportObligation + refine find?_export_of_nodup hnd ?_ rfl + rw [hm] + exact List.mem_map.mpr ⟨e, List.mem_filter.mpr ⟨he, hex⟩, rfl⟩ + +/-- An argument list inhabits the obligation's parameter types. -/ +def ArgsTyped (o : Obligation) (args : List SVal) : Prop := + HasTyL o.layout args o.sig.params + +/-- The adequate kind, over one argument binder `α` (a rendered statement + spells the same proposition with one binder per parameter). -/ +def Adequate (m : Manifest) (name : String) {α : Type} (args : α → List SVal) + (res : α → SVal) : Prop := + ∃ o, exportObligation m name = some o ∧ (∀ x, ArgsTyped o (args x)) ∧ + ∀ fuel x v, o.model fuel (args x) = some v → v = res x + +/-- The exact kind. -/ +def Exact (m : Manifest) (name : String) {α : Type} (args : α → List SVal) + (res : α → SVal) : Prop := + ∃ o, exportObligation m name = some o ∧ (∀ x, ArgsTyped o (args x)) ∧ + ∃ k, ∀ fuel, k ≤ fuel → ∀ x, o.model fuel (args x) = some (res x) + +/-! ## String values + +A String is represented by its UTF-8 bytes (`SVal.s`); `strBytes` is that +encoding, the one the plan's String literals, concatenation and equality +read. It is injective, so `decodeStr` — the String whose encoding a value is, +by choice — inverts it exactly on encoded values. A bridge matches a String +argument as a whole value and decodes it with `decodeStr`. -/ + +/-- The UTF-8 bytes of a String. -/ +def strBytes (s : String) : List Nat := s.toByteArray.data.toList.map UInt8.toNat + +theorem strBytes_inj {a b : String} (h : strBytes a = strBytes b) : a = b := by + unfold strBytes at h + have hl : a.toByteArray.data.toList = b.toByteArray.data.toList := by + have := congrArg (List.map UInt8.ofNat) h + simpa [List.map_map, Function.comp_def, UInt8.ofNat_toNat] using this + have hd : a.toByteArray.data = b.toByteArray.data := Array.ext' hl + have hb : a.toByteArray = b.toByteArray := by + cases ha : a.toByteArray + cases hb' : b.toByteArray + rw [ha, hb'] at hd + simp only [ByteArray.mk.injEq] + exact hd + exact String.toByteArray_inj.mp hb + +theorem strBytes_append (a b : String) : strBytes (a ++ b) = strBytes a ++ strBytes b := by + unfold strBytes + rw [String.toByteArray_append, ByteArray.data_append, Array.toList_append, List.map_append] + +/-- The same, for a model that spells concatenation as `+` through an + `HAdd String String String` instance whose operation is `String.append`. -/ +theorem strBytes_hadd (a b : String) : + strBytes (@HAdd.hAdd String String String ⟨String.append⟩ a b) = strBytes a ++ strBytes b := + strBytes_append a b + +/-- A model's String interpolation renders a String part through `toString`, + which is the identity on Strings. -/ +theorem strBytes_toString (s : String) : strBytes (toString s) = strBytes s := rfl + +theorem string_eq_iff (a b : String) : a = b ↔ strBytes a = strBytes b := + ⟨fun h => h ▸ rfl, strBytes_inj⟩ + +theorem string_beq (a b : String) : (a == b) = (strBytes a == strBytes b) := by + rw [Bool.eq_iff_iff, beq_iff_eq, beq_iff_eq] + exact string_eq_iff a b + +/-- The String a value encodes, if any. -/ +noncomputable def decodeStr (v : SVal) : Option String := by + classical + exact if h : ∃ s, SVal.s (strBytes s) = v then some (Classical.choose h) else none + +theorem decodeStr_eq_some {v : SVal} {s : String} : + decodeStr v = some s ↔ v = SVal.s (strBytes s) := by + classical + unfold decodeStr + split + · rename_i hx + constructor + · intro h + have hc := Classical.choose_spec hx + simp only [Option.some.injEq] at h + rw [← hc, h] + · intro h + have hc : SVal.s (strBytes (Classical.choose hx)) = SVal.s (strBytes s) := + (Classical.choose_spec hx).trans h + simp only [SVal.s.injEq] at hc + simp only [Option.some.injEq] + exact strBytes_inj hc + · rename_i hx + constructor + · intro h; cases h + · intro h; exact absurd ⟨s, h.symm⟩ hx + +theorem decodeStr_strBytes (s : String) : decodeStr (SVal.s (strBytes s)) = some s := + decodeStr_eq_some.mpr rfl + +/-! ## What an adequate bridge means for the bytes -/ + +theorem holds_of_mem {m : Manifest} (hm : HoldsCore m) {o : Obligation} + (ho : o ∈ m.obligations) : o.holds := by + have h := hm o ho + cases hp : o.policy <;> rw [hp] at h + · exact h + · exact h.1 + +/-- The bytes compute the source function: under the named runtime + contracts, a run of the export's emitted function on a represented + encoded argument list that returns, returns a represented, well-typed + image of the source result. -/ +theorem adequate_transfer {m : Manifest} (hm : HoldsCore m) {name : String} {α : Type} + {args : α → List SVal} {res : α → SVal} (hb : Adequate m name args res) : + ∃ o, exportObligation m name = some o ∧ + ∀ (S : CarrierSpec o.carrier) (h : HostFns), HostContracts S h → + ∀ fuel x ws r, SReprL S o.layout (args x) ws → + wFuncN o.code (o.host h) fuel o.self ws = some r → + SRepr S o.layout (res x) r ∧ HasTy o.layout (res x) o.sig.ret := by + obtain ⟨o, ho, hty, hadq⟩ := hb + refine ⟨o, ho, ?_⟩ + intro S h hc fuel x ws r hrep hrun + obtain ⟨sv, hmod, hrep', hty'⟩ := + holds_of_mem hm (exportObligation_mem ho) S h hc fuel (args x) ws r (hty x) hrep hrun + have := hadq fuel x sv hmod + subst this + exact ⟨hrep', hty'⟩ + +/-! ## The plan model, one step at a time -/ + +theorem modelOf_zero (fns : List FnEntry) (g : Nat) (a : List SVal) : + modelOf fns 0 g a = none := by + simp only [modelOf, groupModel] + split <;> rfl + +theorem modelOf_succ (fns : List FnEntry) (k g : Nat) (a : List SVal) {p : FnPlan} + (h : planOf fns g = some p) : + modelOf fns (k + 1) g a = eval (modelOf fns k) (argsEnv a) p.body := by + simp only [modelOf, groupModel, h] + +/-! ## Callee tables and monotonicity -/ + +/-- A callee table: the meaning of each function index at an argument list. -/ +abbrev Table := Nat → List SVal → Option SVal + +/-- `G` extends `F`: every answer of `F` is an answer of `G`. -/ +def Le (F G : Table) : Prop := ∀ g a v, F g a = some v → G g a = some v + +mutual +theorem eval_mono {F G : Nat → List SVal → Option SVal} (hle : Le F G) : + ∀ (env : Nat → Option SVal) (e : Expr) (v : SVal), eval F env e = some v → eval G env e = some v + | env, .literal l, v, h => by cases l <;> simpa [eval] using h + | env, .local i, v, h => by simpa [eval] using h + | env, .let_ b x body, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i x' hx + rw [eval_mono hle env x x' hx] + exact eval_mono hle _ body v h + · cases h + | env, .call (.fn f) args, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i vs hvs + rw [evalArgs_mono hle env args vs hvs] + exact hle f vs v h + · cases h + | env, .call (.builtin b) args, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i vs hvs + rw [evalArgs_mono hle env args vs hvs] + exact h + · cases h + | env, .call (.intrinsic i) args, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i vs hvs + rw [evalArgs_mono hle env args vs hvs] + exact h + · cases h + | env, .call (.lazy b) [o, d], v, h => by + simp only [eval] at h ⊢ + split at h <;> rename_i heq <;> + first + | (rw [eval_mono hle env o _ heq]; first | exact h | exact eval_mono hle env d v h) + | cases h + | env, .call (.lazy b) [], v, h => by simp [eval] at h + | env, .call (.lazy b) [_], v, h => by simp [eval] at h + | env, .call (.lazy b) (_ :: _ :: _ :: _), v, h => by simp [eval] at h + | env, .tailCall f args, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i vs hvs + rw [evalArgs_mono hle env args vs hvs] + exact hle f vs v h + · cases h + | env, .binOp op l r, v, h => by + simp only [eval] at h ⊢ + split at h <;> rename_i hl hr <;> + first + | (rw [eval_mono hle env l _ hl, eval_mono hle env r _ hr]; exact h) + | cases h + | env, .neg e, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i x hx; rw [eval_mono hle env e _ hx]; exact h + · cases h + | env, .ifThenElse c t e, v, h => by + simp only [eval] at h ⊢ + split at h <;> rename_i hc <;> + first + | (rw [eval_mono hle env c _ hc]; first | exact eval_mono hle env t v h | exact eval_mono hle env e v h) + | cases h + | env, .recordCreate tid fs, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i vs hvs; rw [evalArgs_mono hle env fs vs hvs]; exact h + · cases h + | env, .project tid i base, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i t fs hb; rw [eval_mono hle env base _ hb]; exact h + · cases h + | env, .match_ s arms, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i x hx; rw [eval_mono hle env s x hx]; exact evalArms_mono hle env x arms v h + · cases h + | env, .construct c ty args, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i vs hvs; rw [evalArgs_mono hle env args vs hvs]; exact h + · cases h + | env, .interp parts, v, h => by + simp only [eval] at h ⊢ + split at h + · rename_i vs hvs; rw [evalArgs_mono hle env parts vs hvs]; exact h + · cases h + | env, .list t items, v, h => by simpa [eval] using h +theorem evalArgs_mono {F G : Nat → List SVal → Option SVal} (hle : Le F G) : + ∀ (env : Nat → Option SVal) (es : List Expr) (vs : List SVal), + evalArgs F env es = some vs → evalArgs G env es = some vs + | env, [], vs, h => by simpa [evalArgs] using h + | env, e :: es, vs, h => by + simp only [evalArgs] at h ⊢ + split at h + · rename_i x xs hx hxs + rw [eval_mono hle env e x hx, evalArgs_mono hle env es xs hxs]; exact h + · cases h +theorem evalArms_mono {F G : Nat → List SVal → Option SVal} (hle : Le F G) : + ∀ (env : Nat → Option SVal) (sv : SVal) (arms : Arms) (v : SVal), + evalArms F env sv arms = some v → evalArms G env sv arms = some v + | env, sv, .nil, v, h => by simp [evalArms] at h + | env, sv, .cons p b rest, v, h => by + simp only [evalArms] at h ⊢ + split at h + · split at h + · exact eval_mono hle _ b v h + · cases h + · exact evalArms_mono hle env sv rest v h +end + + +/-! ## Source images and one-step obligations + +A source IMAGE `I` gives, for each bridged function index, the encoded +source result at the argument lists it recognises (`none` elsewhere); the +producer builds it from pattern-matching decoders and the transpiled source +functions. `over I Cs F` answers a call to a function of `Cs` with its image +where the image is defined, and with `F` everywhere else. -/ + +def over (I : Table) (Cs : List Nat) (F : Table) : Table := fun g a => + if g ∈ Cs then + match I g a with + | some w => some w + | none => F g a + else F g a + +theorem over_of_image {I : Table} {Cs : List Nat} {F : Table} {g : Nat} {a : List SVal} {w : SVal} + (hg : g ∈ Cs) (hw : I g a = some w) : over I Cs F g a = some w := by + simp [over, hg, hw] + +/-- The one-step obligation of function `g` over its direct callees `Cs`: + whatever the other functions answer, its plan body, with every call to + `Cs` answered by the image, returns `g`'s image wherever that image is + defined. This is the only per-function proof a bridge needs; it unfolds + the source function once and never inducts. -/ +def Step (fns : List FnEntry) (I : Table) (Cs : List Nat) (g : Nat) : Prop := + ∃ p, planOf fns g = some p ∧ + ∀ (F : Table) (a : List SVal) (w : SVal), I g a = some w → + eval (over I Cs F) (argsEnv a) p.body = some w + +/-- Every answer of `F` at an index of `D` agrees with the image where the + image is defined. -/ +def SoundOn (I : Table) (D : List Nat) (F : Table) : Prop := + ∀ g ∈ D, ∀ a v w, F g a = some v → I g a = some w → v = w + +/-- At an index of `D`, `F` answers the image wherever the image is defined. -/ +def ExactOn (I : Table) (D : List Nat) (F : Table) : Prop := + ∀ g ∈ D, ∀ a w, I g a = some w → F g a = some w + +theorem le_over {I : Table} {Cs : List Nat} {F : Table} (h : SoundOn I Cs F) : + Le F (over I Cs F) := by + intro g a v hv + unfold over + split + · rename_i hg + cases hI : I g a with + | none => simpa using hv + | some w => + have := h g hg a v w hv hI + subst this + rfl + · exact hv + +theorem over_eq {I : Table} {Cs : List Nat} {F : Table} (h : ExactOn I Cs F) : + over I Cs F = F := by + funext g a + unfold over + split + · rename_i hg + cases hI : I g a with + | none => rfl + | some w => exact (h g hg a w hI).symm + · rfl + +/-- `bridge_of_step`, adequate form: one-step obligations for every function + of `D` (each over callees inside `D`) make the plan model sound for the + image at every fuel, for all of `D` at once. One fuel induction covers + self recursion and mutual recursion alike. -/ +theorem bridge_of_step (fns : List FnEntry) (I : Table) (D : List Nat) + (hstep : ∀ g ∈ D, ∃ Cs, (∀ c ∈ Cs, c ∈ D) ∧ Step fns I Cs g) : + ∀ fuel, SoundOn I D (modelOf fns fuel) := by + intro fuel + induction fuel with + | zero => + intro g _ a v w h + rw [modelOf_zero] at h + cases h + | succ k ih => + intro g hg a v w h hw + obtain ⟨Cs, hcs, p, hp, hs⟩ := hstep g hg + rw [modelOf_succ fns k g a hp] at h + have hsound : SoundOn I Cs (modelOf fns k) := fun c hc => ih c (hcs c hc) + have hmono := eval_mono (le_over hsound) (argsEnv a) p.body v h + rw [hs (modelOf fns k) a w hw] at hmono + exact (Option.some.inj hmono).symm + +/-- `bridge_of_step`, exact form: over an acyclic call order (a declared + `depth` that every call strictly decreases), the plan model at any fuel + above a function's depth answers exactly its image. -/ +theorem exact_of_step (fns : List FnEntry) (I : Table) (D : List Nat) (depth : Nat → Nat) + (hstep : ∀ g ∈ D, ∃ Cs, (∀ c ∈ Cs, c ∈ D ∧ depth c < depth g) ∧ Step fns I Cs g) : + ∀ fuel, ∀ g ∈ D, depth g < fuel → ∀ a w, I g a = some w → modelOf fns fuel g a = some w := by + intro fuel + induction fuel with + | zero => intro g _ h; omega + | succ k ih => + intro g hg hd a w hw + obtain ⟨Cs, hcs, p, hp, hs⟩ := hstep g hg + rw [modelOf_succ fns k g a hp] + have hexact : ExactOn I Cs (modelOf fns k) := by + intro c hc b u hu + obtain ⟨hcD, hlt⟩ := hcs c hc + exact ih c hcD (by omega) b u hu + rw [← over_eq hexact] + exact hs (modelOf fns k) a w hw + +end AverCert.GrammarBridge diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean new file mode 100644 index 000000000..53d404538 --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -0,0 +1,744 @@ +/- GrammarLower — the lowering of a `Grammar` plan to wasm-gc, as a port of + the MIR emitter (`src/codegen/wasm_gc/body/from_mir/**`) for exactly the + admitted nodes. + + `lowerB` makes the emitter's choices from the same tree, by the same + predicates, and never from a plan flag: + + * an `Int` comparison with an `Int` literal operand is the bignum + const-compare tag branch (`emit_mir_numeric_binop`, builtins.rs). The + literal is looked for on the LEFT first (`const_on_left`, then the + operator is flipped, `flip_cmp`), then on the right. The other operand + is RE-EMITTED per read when it is a bare `Local` + (`aint_const_cmp_operand_is_reemittable`), and otherwise evaluated once + and stashed in the const-compare scratch local, which is the slot right + after the resolver slots (`SlotTable::build_for_fn`); + * an `Int` comparison without a literal calls `__aint_cmp` and compares + the verdict with `0`, or calls `__aint_eq` (plus `i32.eqz` for `!=`) + (`emit_aint_binop`); + * `Bool` `==` / `!=` are `i32.eq` / `i32.ne`; the operand type is read + from the left operand, as the emitter reads `bop.lhs.ty()`; + * `TailCall` is `return_call`, `Call` is `call` (the MIR decides tail + position, the typing checks it); + * a named `Let` is `value; local.set binding; body` — a single-use copy is + kept as a local, exactly as the emitter keeps it; + * `IfThenElse` takes its block type from the then-branch's type; + * an Int `Match` is the literal cascade (`emit_mir_int_cascade`): the + subject RE-EMITTED per arm, the literal boxed and compared with + `__aint_eq`, the catch-all binder stored from one more subject run; + * a two-arm Bool `Match` is one `if` on the subject; + * an Option / Result `Match` stashes the subject in the subject scratch, + `ref.cast`s it and reads the tag field, then extracts the payload + binder (a dead binder too, `noSlot` skipped) before the arm body; + * a user-variant `Match` stashes the subject and runs the `ref.test` + cascade over the arms, the LAST arm untested + (`emit_mir_variant_dispatch`); binders are extracted by + `ref.cast` + `struct.get` per field; + * `withDefault` stashes the carrier and runs the default only in `else`; + * `Construct` pushes the tag, the payload and the default filler of the + other side, then `struct.new` (`constructors.rs`); + * a Float comparison is one `f64` instruction; a String literal is + `array.new_data $string seg` over its data segment; String `+` and an + interpolation build a `Vector` and call `__wasmgc_concat_n`; + String `==` / `!=` call `__wasmgc_string_eq` (plus `i32.eqz`); + * a String `Match` stashes the subject and cascades over the literal arms, + each `ref.cast (ref null $string)` + literal + `__wasmgc_string_eq`; + * a tuple destructure stashes the subject and reads each bound component + with `ref.cast` + `struct.get` (`emit_mir_tuple_match`); + * `[]` is `ref.null` of the list's cons struct, `List.prepend` is + `struct.new` of it; + * the fused `Vector.get`-or-default re-reads the vector and the index + locals, converts the index through `__aint_to_index`, and bounds-checks + it signed `>= 0` and unsigned `< array.len` before `array.get`; + * the fused `Result.withDefault(Int.div/mod(a, b), d)` evaluates `a`, `b` + and `d` once each, parks them in the three operand scratch locals that + follow the const-compare scratch (`aint_operand_scratch`), tests the + divisor for zero on the carrier (`$magf` null and `$small == 0`), and + returns the default or calls `__aint_divmod(a, b, want_mod)`; + * a Euclidean intrinsic (`IntDivEuclid` / `IntModEuclid`) is its two + operands, the `want_mod` flag and a call of `__aint_divmod`. + + ONE lowering carries both images: `lowerB` yields instructions whose `if` + carries its block type. `eraseL` forgets the block types (the audited + interpreter's `WInstr` tree), and `encBL` writes the bytes. So the + instructions the simulation theorem runs and the bytes a certificate pins + come from the same tree by construction. -/ +import Grammar + +namespace AverCert.Grammar +open CertPrelude AverCert.Schema + +/-! ## Byte encoders + +Canonical LEB128 of the immediates the lowering writes, fail-closed at the +u32 index space and the i32 / i64 constant ranges the binary format admits. -/ + +/-- Canonical unsigned LEB128 of a u32 index, or `none` outside the range. The + bytes come from the shared total encoder (`CertPrelude.uleb32Bytes`, exact + below `2 ^ 35`). -/ +def uleb32 (value : Nat) : Option (List Nat) := + if value < 4294967296 then some (CertPrelude.uleb32Bytes value) else none + +def slebFuel : Nat → Int → Option (List Nat) + | 0, _ => none + | fuel + 1, value => + let byte := Int.toNat (value % 128) + let rest := value / 128 + let signSet := 64 ≤ byte + let done := (rest = 0 ∧ !signSet) ∨ (rest = -1 ∧ signSet) + let outByte := if done then byte else byte + 128 + if done then + some [outByte] + else + match slebFuel fuel rest with + | some bytes => some (outByte :: bytes) + | none => none + +def inI32Range (value : Int) : Bool := + decide ((-2147483648 : Int) ≤ value) && decide (value ≤ 2147483647) + +def inI64Range (value : Int) : Bool := + decide ((-9223372036854775808 : Int) ≤ value) && decide (value ≤ 9223372036854775807) + +def sleb32 (value : Int) : Option (List Nat) := + if inI32Range value then slebFuel 5 value else none + +def sleb64 (value : Int) : Option (List Nat) := + if inI64Range value then slebFuel 10 value else none + +/-- Concrete heap-type indices (inside a reftype `0x63 `, a block type, or a + `ref.cast` / `ref.test` / `ref.null` immediate) are SIGNED s33 LEB128: index + 64 is `c0 00`, never `40`. Instruction type indices stay unsigned u32. -/ +def s33HeapIdx (idx : Nat) : Option (List Nat) := + if idx < 4294967296 then some (CertPrelude.s33Bytes idx) else none + +/-! ## Instructions with block types -/ + +inductive BI where + | op (i : WInstr) + | ifElse (bt : Option Ty) (thenB elseB : List BI) + /-- `ref.null ht`: the interpreter's `refNull`, with its heap type for + the bytes. -/ + | nullOf (ht : Nat) + /-- `array.new_data ty seg`: the interpreter's `arrayNewData` carries the + segment's bytes; the byte image names the segment, whose contents the + acceptance pins to exactly `bytes`. -/ + | newData (ty seg : Nat) (bytes : List Nat) + /-- `ref.cast (ref null ht)`: the interpreter's `refCast`, which rejects a + null the wasm cast would pass (that only makes a run fail). -/ + | castNull (ht : Nat) + +mutual + def eraseI : BI → WInstr + | .op i => i + | .ifElse _ t e => .ifElse (eraseL t) (eraseL e) + | .nullOf _ => .refNull + | .newData ty _ bytes => .arrayNewData ty bytes + | .castNull ht => .refCast ht + def eraseL : List BI → List WInstr + | [] => [] + | x :: xs => eraseI x :: eraseL xs +end + +theorem eraseL_append (xs ys : List BI) : eraseL (xs ++ ys) = eraseL xs ++ eraseL ys := by + induction xs with + | nil => simp [eraseL] + | cons x xs ih => simp [eraseL, ih] + +theorem eraseL_ops (is : List WInstr) : eraseL (is.map BI.op) = is := by + induction is with + | nil => rfl + | cons i is ih => simp [eraseL, eraseI, ih] + +/-! ## Emitter templates -/ + +def BinOp.flip : BinOp → BinOp + | .lt => .gt + | .gt => .lt + | .lte => .gte + | .gte => .lte + | op => op + +/-- `mir_int_literal`: an `Int` literal operand. -/ +def litInt? : Expr → Option Int + | .literal (.int k) => some k + | _ => none + +/-- `aint_const_cmp_operand_is_reemittable`: a bare local. -/ +def slot? : Expr → Option Nat + | .local i => some i + | _ => none + +def MCtx.arithIdx (M : MCtx) : BinOp → Nat + | .add => M.add + | .sub => M.sub + | _ => M.mul + +/-- Small arm of the const compare: native i64 compare of the `small` field. -/ +def smallCmpInstr : BinOp → WInstr + | .eq => .i64Eq + | .neq => .i64Ne + | .lt => .i64LtS + | .gt => .i64GtS + | .lte => .i64LeS + | _ => .i64GeS + +/-- Big arm of the const compare: the sign decides every order relation, and a + Big value never equals an i64 constant. -/ +def bigCmpArm (C s : Nat) : BinOp → List WInstr + | .lt | .lte => [.localGet s, .structGet C 2, .i32Const 0, .i32LtS] + | .gt | .gte => [.localGet s, .structGet C 2, .i32Const 0, .i32GtS] + | .eq => [.i32Const 0] + | .neq => [.i32Const 1] + | _ => [] + +/-- The const-compare tag branch over the carrier held in local `s` + (`emit_aint_cmp_const_reemit`; `emit_aint_cmp_const` is `local.set s` + followed by this). -/ +def cmpArmB (C s : Nat) (op : BinOp) (k : Int) : List BI := + [ .op (.localGet s), .op (.structGet C 1), .op .refIsNull, + .ifElse (some .bool) + [.op (.localGet s), .op (.structGet C 0), .op (.i64Const k), .op (smallCmpInstr op)] + ((bigCmpArm C s op).map .op) ] + +/-- Int against Int without a literal (`emit_aint_binop`). -/ +def intCmpTail (M : MCtx) : BinOp → List WInstr + | .eq => [.call M.eq] + | .neq => [.call M.eq, .i32Eqz] + | .lt => [.call M.cmp, .i32Const 0, .i32LtS] + | .gt => [.call M.cmp, .i32Const 0, .i32GtS] + | .lte => [.call M.cmp, .i32Const 0, .i32LeS] + | _ => [.call M.cmp, .i32Const 0, .i32GeS] + +def boolCmpInstr : BinOp → WInstr + | .eq => .i32Eq + | _ => .i32Ne + +/-- The instruction a builtin call ends with, given its argument types: + one `i32` instruction for the Bool builtins, `struct.new` of the tail's + cons struct for `List.prepend`. -/ +def builtinTail (M : MCtx) : Builtin → Option (List Ty) → List BI + | .boolAnd, _ => [.op .i32And] + | .boolOr, _ => [.op .i32Or] + | .boolNot, _ => [.op .i32Eqz] + | .listPrepend, some [_, .list t] => [.op (.structNew (M.listStruct t) 2)] + | _, _ => [] + +/-- The `f64` comparison of a Float `BinOp`. -/ +def floatCmpInstr : BinOp → WInstr + | .eq => .f64Eq + | .lt => .f64Lt + | .gt => .f64Gt + | .lte => .f64Le + | _ => .f64Ge + +/-- A string literal: `array.new_data $string seg` over offset 0 and the + literal's length (`emit_string_literal_bytes`). -/ +def strLitB (M : MCtx) (bytes : List Nat) : List BI := + [.op (.i32Const 0), .op (.i32Const bytes.length), .newData M.str (M.strSeg bytes) bytes] + +/-- Concatenate the `n` Strings on the stack: a `Vector` of them, then + `__wasmgc_concat_n` (`emit_mir_string_binop`, `emit_mir_interpolated_str`). -/ +def concatB (M : MCtx) (n : Nat) : List BI := + [.op (.arrayNewFixed M.strVec n), .op (.call M.concat)] + +/-- The tail of a `String` `BinOp` after both operands. -/ +def strOpTail (M : MCtx) : BinOp → List BI + | .add => concatB M 2 + | .eq => [.op (.call M.streq)] + | _ => [.op (.call M.streq), .op .i32Eqz] + +/-- `Option.withDefault(Vector.get(v, i), d)` fused + (`emit_mir_option_with_default`): the index through `__aint_to_index`, + tested `>= 0` and (unsigned) `< array.len`, both halves evaluated, then + `array.get` or the default. `dc` is the default's code. -/ +def vecGetOrB (M : MCtx) (v i : Nat) (t : Ty) (dc : List BI) : List BI := + [ .op (.localGet i), .op (.call M.toIndex), .op (.i32Const 0), .op .i32GeS, + .op (.localGet i), .op (.call M.toIndex), .op (.localGet v), .op .arrayLen, .op .i32LtU, + .op .i32And, + .ifElse (some t) + [.op (.localGet v), .op (.localGet i), .op (.call M.toIndex), + .op (.arrayGet (M.vecStruct t))] + dc ] + +/-- `emit_default_value`: the filler of the unused payload field. -/ +def dfltB (M : MCtx) : Ty → List BI + | .int => [.op (.i64Const 0), .nullOf M.mag, .op (.i32Const 0), .op (.structNew M.carrier 3)] + | .bool => [.op (.i32Const 0)] + | .record tid => [.nullOf (M.structOf tid)] + | .sum tid => [.nullOf (M.sumRoot tid)] + | .option t => [.nullOf (M.optStruct t)] + | .result t e => [.nullOf (M.resStruct t e)] + | .string => [.nullOf M.str] + | .float => [.op (.f64Const 0)] + | .list t => [.nullOf (M.listStruct t)] + | .vec t => [.nullOf (M.vecStruct t)] + | _ => [] + +/-- Read field `i` of the struct `idx` held (as `eqref`) in the subject + scratch `ss` into binder `b`; nothing for an ignored binder. -/ +def bindFieldB (ss idx i b : Nat) : List BI := + if b = noSlot then [] + else [.op (.localGet ss), .op (.refCast idx), .op (.structGet idx i), .op (.localSet b)] + +/-- The binders of a variant arm, fields `i, i+1, …`. -/ +def extractB (ss idx : Nat) : Nat → List Nat → List BI + | _, [] => [] + | i, b :: bs => bindFieldB ss idx i b ++ extractB ss idx (i + 1) bs + +/-- The tag test of an Option / Result held in the subject scratch. -/ +def tagTestB (ss idx : Nat) : List BI := + [.op (.localGet ss), .op (.refCast idx), .op (.structGet idx 0), .op (.i32Const 1), .op .i32Eq] + +/-- The fused `Result.withDefault(Int.div/mod(a, b), d)` after its three + operands (`emit_mir_result_with_default`, bignum path): the operands are + parked in the operand scratch locals `cmp + 1 .. cmp + 3` (the default + last in, first out), the divisor is tested for zero on the carrier, and + the default or `__aint_divmod(a, b, want_mod)` is the result. -/ +def divOrB (M : MCtx) (X : LCtx) (isMod : Bool) : List BI := + [ .op (.localSet (X.cmp + 3)), .op (.localSet (X.cmp + 2)), .op (.localSet (X.cmp + 1)), + .op (.localGet (X.cmp + 2)), .op (.structGet M.carrier 1), .op .refIsNull, + .op (.localGet (X.cmp + 2)), .op (.structGet M.carrier 0), .op .i64Eqz, .op .i32And, + .ifElse (some .int) [.op (.localGet (X.cmp + 3))] + [.op (.localGet (X.cmp + 1)), .op (.localGet (X.cmp + 2)), + .op (.i32Const (if isMod then 1 else 0)), .op (.call M.divmod)] ] + +/-- The `want_mod` flag of a Euclidean intrinsic. -/ +def Intrinsic.flag : Intrinsic → Int + | .intDivEuclid => 0 + | .intModEuclid => 1 + +/-! ## The lowering -/ + +mutual + def lowerB (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) : Expr → List BI + | .literal (.int k) => [.op (.i64Const k), .op (.call M.box)] + | .literal (.bool v) => [.op (.i32Const (if v then 1 else 0))] + | .literal (.float bits) => [.op (.f64Const bits)] + | .literal (.str bytes) => strLitB M bytes + | .local i => [.op (.localGet i)] + | .let_ b v body => + lowerB M X Γ false v ++ [.op (.localSet b)] ++ + lowerB M X (match tyOf M X.n Γ false v with + | some T => upd Γ b T + | none => Γ) tail body + | .call (.fn f) args => lowerArgsB M X Γ args ++ [.op (.call f)] + | .call (.builtin bi) args => + lowerArgsB M X Γ args ++ builtinTail M bi (tysOf M X.n Γ args) + | .tailCall f args => lowerArgsB M X Γ args ++ [.op (.returnCall f)] + | .binOp op l r => + match tyOf M X.n Γ false l with + | some .bool => + lowerB M X Γ false l ++ lowerB M X Γ false r ++ [.op (boolCmpInstr op)] + | some .float => + lowerB M X Γ false l ++ lowerB M X Γ false r ++ [.op (floatCmpInstr op)] + | some .string => + lowerB M X Γ false l ++ lowerB M X Γ false r ++ strOpTail M op + | _ => + if op.isArith then + lowerB M X Γ false l ++ lowerB M X Γ false r ++ [.op (.call (M.arithIdx op))] + else + match litInt? l, litInt? r with + | some k, _ => + match slot? r with + | some i => cmpArmB M.carrier i op.flip k + | none => + lowerB M X Γ false r ++ [.op (.localSet X.cmp)] ++ + cmpArmB M.carrier X.cmp op.flip k + | none, some k => + match slot? l with + | some i => cmpArmB M.carrier i op k + | none => + lowerB M X Γ false l ++ [.op (.localSet X.cmp)] ++ + cmpArmB M.carrier X.cmp op k + | none, none => + lowerB M X Γ false l ++ lowerB M X Γ false r ++ (intCmpTail M op).map .op + | .neg e => lowerB M X Γ false e ++ [.op (.call M.neg)] + | .ifThenElse c t e => + lowerB M X Γ false c ++ + [.ifElse (tyOf M X.n Γ tail t) (lowerB M X Γ tail t) (lowerB M X Γ tail e)] + | .recordCreate tid fs => + lowerArgsB M X Γ fs ++ [.op (.structNew (M.structOf tid) fs.length)] + | .project tid i base => lowerB M X Γ false base ++ [.op (.structGet (M.structOf tid) i)] + | .call (.lazy lb) args => + match args with + | [o, d] => + match vecGetOr? lb o d with + | some (v, i) => + match Γ v with + | some (.vec t) => vecGetOrB M v i t (lowerB M X Γ false d) + | _ => [] + | none => + match divOr? lb o d with + | some (isMod, _, _) => + -- `o` is `Int.div(a, b)` / `Int.mod(a, b)`, whose own lowering + -- is just its two operands (`builtinTail` adds nothing) + lowerB M X Γ false o ++ lowerB M X Γ false d ++ divOrB M X isMod + | none => + match lb, tyOf M X.n Γ false o with + | .optWithDefault, some (.option t) => + lowerB M X Γ false o ++ [.op (.localSet X.subj)] ++ + tagTestB X.subj (M.optStruct t) ++ + [.ifElse (some t) + [.op (.localGet X.subj), .op (.refCast (M.optStruct t)), + .op (.structGet (M.optStruct t) 1)] + (lowerB M X Γ false d)] + | .resWithDefault, some (.result t e) => + lowerB M X Γ false o ++ [.op (.localSet X.subj)] ++ + tagTestB X.subj (M.resStruct t e) ++ + [.ifElse (some t) + [.op (.localGet X.subj), .op (.refCast (M.resStruct t e)), + .op (.structGet (M.resStruct t e) 1)] + (lowerB M X Γ false d)] + | _, _ => [] + | _ => [] + | .call (.intrinsic ie) args => + lowerArgsB M X Γ args ++ [.op (.i32Const ie.flag), .op (.call M.divmod)] + | .construct c ty args => + match c, ty with + | .user tid k, _ => + lowerArgsB M X Γ args ++ [.op (.structNew (M.ctorStruct tid k) args.length)] + | .some, .option t => + [.op (.i32Const 1)] ++ lowerArgsB M X Γ args ++ [.op (.structNew (M.optStruct t) 2)] + | .none, .option t => + [.op (.i32Const 0)] ++ dfltB M t ++ lowerArgsB M X Γ args ++ + [.op (.structNew (M.optStruct t) 2)] + | .ok, .result t e => + [.op (.i32Const 1)] ++ lowerArgsB M X Γ args ++ dfltB M e ++ + [.op (.structNew (M.resStruct t e) 3)] + | .err, .result t e => + [.op (.i32Const 0)] ++ dfltB M t ++ lowerArgsB M X Γ args ++ + [.op (.structNew (M.resStruct t e) 3)] + | _, _ => [] + | .match_ s arms => + match tyOf M X.n Γ false s with + | some .int => + lowerIntArms M X Γ tail (lowerB M X Γ false s) + (tyOf M X.n Γ tail (.match_ s arms)) arms + | some .bool => + lowerB M X Γ false s ++ + lowerBoolArms M X Γ tail (tyOf M X.n Γ tail (.match_ s arms)) arms + | some (.option t) => + lowerB M X Γ false s ++ [.op (.localSet X.subj)] ++ + lowerOptArms M X Γ tail (tyOf M X.n Γ tail (.match_ s arms)) t arms + | some (.result t e) => + lowerB M X Γ false s ++ [.op (.localSet X.subj)] ++ + lowerResArms M X Γ tail (tyOf M X.n Γ tail (.match_ s arms)) t e arms + | some (.sum tid) => + lowerB M X Γ false s ++ [.op (.localSet X.subj)] ++ + lowerVarArms M X Γ tail (tyOf M X.n Γ tail (.match_ s arms)) tid arms + | some .string => + lowerB M X Γ false s ++ [.op (.localSet X.subj)] ++ + lowerStrArms M X Γ tail (tyOf M X.n Γ tail (.match_ s arms)) arms + | some (.record tid) => + lowerB M X Γ false s ++ [.op (.localSet X.subj)] ++ + lowerTupArms M X Γ tail tid arms + | _ => [] + | .interp parts => lowerArgsB M X Γ parts ++ concatB M parts.length + | .list t _ => [.nullOf (M.listStruct t)] + def lowerArgsB (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) : List Expr → List BI + | [] => [] + | e :: es => lowerB M X Γ false e ++ lowerArgsB M X Γ es + /-- `emit_mir_int_cascade`: `sc` is the subject's code, re-emitted per + literal arm; the first catch-all ends the cascade. -/ + def lowerIntArms (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) (sc : List BI) + (bt : Option Ty) : Arms → List BI + | .nil => [] + | .cons p b rest => + match p with + | .litInt k => + sc ++ [.op (.i64Const k), .op (.call M.box), .op (.call M.eq), + .ifElse bt (lowerB M X Γ tail b) (lowerIntArms M X Γ tail sc bt rest)] + | .wild => lowerB M X Γ tail b + | .bind s => sc ++ [.op (.localSet s)] ++ lowerB M X (upd Γ s .int) tail b + | _ => [] + /-- The emitter's Bool `match`: one `if` on the subject. -/ + def lowerBoolArms (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) + (bt : Option Ty) : Arms → List BI + | .cons (.litBool v) t (.cons _ e _) => + if v then [.ifElse bt (lowerB M X Γ tail t) (lowerB M X Γ tail e)] + else [.ifElse bt (lowerB M X Γ tail e) (lowerB M X Γ tail t)] + | _ => [] + /-- `emit_mir_option_match`, the subject already in the subject scratch. -/ + def lowerOptArms (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) + (bt : Option Ty) (t : Ty) : Arms → List BI + | .cons p1 b1 (.cons p2 b2 _) => + match optPick p1 p2 with + | some (false, sb) => + tagTestB X.subj (M.optStruct t) ++ + [.ifElse bt + (bindFieldB X.subj (M.optStruct t) 1 sb ++ + lowerB M X ((bindOne X.n Γ sb t).getD Γ) tail b1) + (lowerB M X Γ tail b2)] + | some (true, sb) => + tagTestB X.subj (M.optStruct t) ++ + [.ifElse bt + (bindFieldB X.subj (M.optStruct t) 1 sb ++ + lowerB M X ((bindOne X.n Γ sb t).getD Γ) tail b2) + (lowerB M X Γ tail b1)] + | none => [] + | _ => [] + /-- `emit_mir_result_match`: the `Ok` payload is field 1, the `Err` one + field 2. -/ + def lowerResArms (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) + (bt : Option Ty) (t e : Ty) : Arms → List BI + | .cons p1 b1 (.cons p2 b2 _) => + match resPick p1 p2 with + | some (false, ob, eb) => + tagTestB X.subj (M.resStruct t e) ++ + [.ifElse bt + (bindFieldB X.subj (M.resStruct t e) 1 ob ++ + lowerB M X ((bindOne X.n Γ ob t).getD Γ) tail b1) + (bindFieldB X.subj (M.resStruct t e) 2 eb ++ + lowerB M X ((bindOne X.n Γ eb e).getD Γ) tail b2)] + | some (true, ob, eb) => + tagTestB X.subj (M.resStruct t e) ++ + [.ifElse bt + (bindFieldB X.subj (M.resStruct t e) 1 ob ++ + lowerB M X ((bindOne X.n Γ ob t).getD Γ) tail b2) + (bindFieldB X.subj (M.resStruct t e) 2 eb ++ + lowerB M X ((bindOne X.n Γ eb e).getD Γ) tail b1)] + | none => [] + | _ => [] + /-- `emit_mir_variant_arm_cascade`: `ref.test` each arm's constructor, the + last arm untested; a `_` arm ends the cascade. -/ + def lowerVarArms (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) + (bt : Option Ty) (tid : Nat) : Arms → List BI + | .nil => [] + | .cons p b .nil => + match p with + | .ctor (.user tid' c) bs => + extractB X.subj (M.ctorStruct tid' c) 0 bs ++ + lowerB M X ((varArmΓ M X.n Γ tid p).getD Γ) tail b + | _ => lowerB M X Γ tail b + | .cons p b (.cons p' b' r) => + match p with + | .ctor (.user tid' c) bs => + [.op (.localGet X.subj), .op (.refTest (M.ctorStruct tid' c)), + .ifElse bt + (extractB X.subj (M.ctorStruct tid' c) 0 bs ++ + lowerB M X ((varArmΓ M X.n Γ tid p).getD Γ) tail b) + (lowerVarArms M X Γ tail bt tid (.cons p' b' r))] + | .wild => lowerB M X Γ tail b + | _ => [] + /-- `emit_mir_string_match`, the subject already in the subject scratch: + per literal arm, cast the scratch back to `$string`, compare with the + literal through `__wasmgc_string_eq`, `if`; the default innermost. -/ + def lowerStrArms (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) + (bt : Option Ty) : Arms → List BI + | .nil => [] + | .cons p b rest => + match p with + | .litStr k => + [.op (.localGet X.subj), .castNull M.str] ++ strLitB M k ++ + [.op (.call M.streq), .ifElse bt (lowerB M X Γ tail b) + (lowerStrArms M X Γ tail bt rest)] + | _ => lowerB M X Γ tail b + /-- `emit_mir_tuple_match`, the subject already in the subject scratch: + each bound component read with `ref.cast` + `struct.get`, then the body. -/ + def lowerTupArms (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) (tid : Nat) : + Arms → List BI + | .cons (.tuple bs) b _ => + extractB X.subj (M.structOf tid) 0 bs ++ + lowerB M X (((M.recFields tid).bind (bindTys X.n Γ bs)).getD Γ) tail b + | _ => [] +end + +/-- The instructions the interpreter runs. -/ +def lowerW (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) (e : Expr) : + List WInstr := + eraseL (lowerB M X Γ tail e) + +def lowerArgsW (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (es : List Expr) : List WInstr := + eraseL (lowerArgsB M X Γ es) + +/-- The instruction tree of one function. -/ +def fnCode (M : MCtx) (p : FnPlan) : WCode := + { arity := p.sig.params.length, nlocals := p.locals.length, + body := lowerW M p.lctx (paramsΓ p.sig.params) true p.body } + +/-! ## The byte image -/ + +/-- The eight little-endian bytes of an `f64.const` immediate. -/ +def u64le (bits : UInt64) : List Nat := + (List.range 8).map fun i => bits.toNat / 256 ^ i % 256 + +/-- Opcode bytes of one instruction of the admitted fragment (`none` for any + other instruction, so an unexpected instruction fails closed). -/ +def encW : WInstr → Option (List Nat) + | .localGet i => (uleb32 i).map ([0x20] ++ ·) + | .localSet i => (uleb32 i).map ([0x21] ++ ·) + | .i64Const k => (sleb64 k).map ([0x42] ++ ·) + | .i32Const k => (sleb32 k).map ([0x41] ++ ·) + | .call f => (uleb32 f).map ([0x10] ++ ·) + | .returnCall f => (uleb32 f).map ([0x12] ++ ·) + | .structNew t _ => (uleb32 t).map ([0xfb, 0x00] ++ ·) + | .structGet t fld => + match uleb32 t, uleb32 fld with + | some a, some b => some ([0xfb, 0x02] ++ a ++ b) + | _, _ => none + | .refIsNull => some [0xd1] + | .i64Eqz => some [0x50] + | .i32Eqz => some [0x45] + | .i32Eq => some [0x46] + | .i32Ne => some [0x47] + | .i32LtS => some [0x48] + | .i32GtS => some [0x4a] + | .i32LeS => some [0x4c] + | .i32GeS => some [0x4e] + | .i64Eq => some [0x51] + | .i64Ne => some [0x52] + | .i64LtS => some [0x53] + | .i64GtS => some [0x55] + | .i64LeS => some [0x57] + | .i64GeS => some [0x59] + | .i32And => some [0x71] + | .i32Or => some [0x72] + | .i32LtU => some [0x49] + | .f64Const bits => some ([0x44] ++ u64le bits) + | .f64Eq => some [0x61] + | .f64Lt => some [0x63] + | .f64Gt => some [0x64] + | .f64Le => some [0x65] + | .f64Ge => some [0x66] + | .arrayLen => some [0xfb, 0x0f] + | .arrayGet t => (uleb32 t).map ([0xfb, 0x0b] ++ ·) + | .arrayNewFixed t n => + match uleb32 t, uleb32 n with + | some a, some b => some ([0xfb, 0x08] ++ a ++ b) + | _, _ => none + | .refTest t => (s33HeapIdx t).map ([0xfb, 0x14] ++ ·) + | .refCast t => (s33HeapIdx t).map ([0xfb, 0x16] ++ ·) + | _ => none + +/-- Value-type bytes of a source type: the Int carrier, records, sums (their + root struct), Option and Result are nullable concrete references, Bool is + `i32`, and the subject scratch is `eqref`. -/ +def valTy (M : MCtx) : Ty → Option (List Nat) + | .int => (s33HeapIdx M.carrier).map ([0x63] ++ ·) + | .bool => some [0x7f] + | .record tid => (s33HeapIdx (M.structOf tid)).map ([0x63] ++ ·) + | .sum tid => (s33HeapIdx (M.sumRoot tid)).map ([0x63] ++ ·) + | .option t => (s33HeapIdx (M.optStruct t)).map ([0x63] ++ ·) + | .result t e => (s33HeapIdx (M.resStruct t e)).map ([0x63] ++ ·) + | .eqref => some [0x6d] + | .float => some [0x7c] + | .string => (s33HeapIdx M.str).map ([0x63] ++ ·) + | .vec t => (s33HeapIdx (M.vecStruct t)).map ([0x63] ++ ·) + | .list t => (s33HeapIdx (M.listStruct t)).map ([0x63] ++ ·) + | .opaque tid => (s33HeapIdx (M.opaqueStruct tid)).map ([0x63] ++ ·) + +mutual + def encBI (M : MCtx) : BI → Option (List Nat) + | .op i => encW i + | .ifElse bt t e => + match bt.bind (valTy M), encBL M t, encBL M e with + | some btB, some tB, some eB => some ([0x04] ++ btB ++ tB ++ [0x05] ++ eB ++ [0x0b]) + | _, _, _ => none + | .nullOf ht => (s33HeapIdx ht).map ([0xd0] ++ ·) + | .newData ty seg _ => + match uleb32 ty, uleb32 seg with + | some a, some b => some ([0xfb, 0x09] ++ a ++ b) + | _, _ => none + | .castNull ht => (s33HeapIdx ht).map ([0xfb, 0x17] ++ ·) + def encBL (M : MCtx) : List BI → Option (List Nat) + | [] => some [] + | x :: xs => + match encBI M x, encBL M xs with + | some a, some b => some (a ++ b) + | _, _ => none +end + +/-- One `(1, type)` local group per declared local, as the emitter declares + them (`module.rs`, `Function::new` over `(1, ty)` pairs). -/ +def localGroups (M : MCtx) : List Ty → Option (List Nat) + | [] => some [] + | t :: ts => + match valTy M t, localGroups M ts with + | some a, some b => some ([0x01] ++ a ++ b) + | _, _ => none + +/-- The exact code entry (size prefix included) of one function. -/ +def codeEntryBytes (M : MCtx) (p : FnPlan) : Option (List Nat) := + match uleb32 p.locals.length, localGroups M p.locals, + encBL M (lowerB M p.lctx (paramsΓ p.sig.params) true p.body) with + | some cnt, some groups, some body => + let entry := cnt ++ groups ++ body ++ [0x0b] + (uleb32 entry.length).map (· ++ entry) + | _, _, _ => none + +/-! ## S-3: the byte fact behind the exact `ref.test` + +The audited interpreter's `ref.test` compares type indices EXACTLY, while +wasm GC tests subtyping. The variant cascade relies on `ref.test (ref $C)`, +so the certificate is sound only if no represented value has a struct type +that is a strict subtype of (or equivalent to) another constructor's struct. +The emitter declares every user type in ONE rec group that opens the type +section, a sum's root as a non-final empty struct and each constructor as +`sub final root (struct …)` (`module.rs`, `mk_sub_struct(fields, true, +Some(root))`). The pin below is the byte image of that declaration header; +`GrammarSound.ctor_refTest_exact` shows it makes the exact test the wasm +test. The acceptance checks `S3Pin` against the raw entries of the rec group +that opens the type section, together with `sumOk` +(`TypeTable.sumConfirmed`). -/ + +/-- The type-section header of a constructor struct: `0x4f` (`sub final`), + one supertype, the sum's root. -/ +def ctorEntryHeader (root : Nat) : Option (List Nat) := + (uleb32 root).map ([0x4f, 0x01] ++ ·) + +/-- The S-3 pin over `entries`, the byte image of the rec group that opens + the type section (entry `k` is the subtype declared at type index `k`): + every constructor struct of sum `tid` (constructors `0 … ncs-1`) is an + entry of that group and is declared `sub final` under the sum's root. -/ +def S3Pin (M : MCtx) (tid ncs : Nat) (entries : List (List Nat)) : Bool := + (List.range ncs).all fun c => + match entries[M.ctorStruct tid c]?, ctorEntryHeader (M.sumRoot tid) with + | some e, some h => h.isPrefixOf e + | _, _ => false + +/-! ## S-11: the byte fact behind a string literal + +The interpreter's `arrayNewData` carries the literal's bytes, while the code +entry names only a passive data segment (`array.new_data $string seg`, with +offset `0` and the literal's length as operands). The certificate is sound +only if that segment holds exactly those bytes. `exprLits` lists every +string literal a plan lowers to `array.new_data` (literal nodes and literal +match arms), and `DataPin` checks each against the module's data segments +(`segs[i]` is the contents of segment `i`). The acceptance checks it against +the decoded data section (`TypeTable.dataConfirmed`). -/ + +mutual + def exprLits : Expr → List (List Nat) + | .literal (.str b) => [b] + | .literal _ => [] + | .local _ => [] + | .let_ _ v body => exprLits v ++ exprLits body + | .call _ args => argsLits args + | .tailCall _ args => argsLits args + | .binOp _ l r => exprLits l ++ exprLits r + | .neg e => exprLits e + | .ifThenElse c t e => exprLits c ++ exprLits t ++ exprLits e + | .recordCreate _ fs => argsLits fs + | .project _ _ b => exprLits b + | .match_ s arms => exprLits s ++ armsLits arms + | .construct _ _ args => argsLits args + | .interp parts => argsLits parts + | .list _ items => argsLits items + def argsLits : List Expr → List (List Nat) + | [] => [] + | e :: es => exprLits e ++ argsLits es + def armsLits : Arms → List (List Nat) + | .nil => [] + | .cons p b rest => + (match p with + | .litStr k => [k] + | _ => []) ++ exprLits b ++ armsLits rest +end + +/-- The S-11 pin: every string literal of the plan names a data segment that + holds exactly its bytes. -/ +def DataPin (M : MCtx) (segs : List (List Nat)) (p : FnPlan) : Bool := + (exprLits p.body).all fun b => segs[M.strSeg b]? == some b + +end AverCert.Grammar diff --git a/aver-cert/assets/wall/current/GrammarSound.lean b/aver-cert/assets/wall/current/GrammarSound.lean new file mode 100644 index 000000000..b59325eeb --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -0,0 +1,3880 @@ +/- GrammarSound — the simulation theorem for the one-grammar plan. + + ONE statement, `agreement`, by induction on the size of a `Grammar.Expr` + (mutually with the argument lists and with one statement per admitted + `Match` arm shape, each by induction over the arms): + a successful run of the lowered instructions in the audited interpreter + means the source semantics succeeds with a value the run represents. It + depends on no particular function body. Calls cite a `Contract` for the + callee, never its body; `fn_certified_group` supplies those contracts for + a whole group of functions (one SCC: self and mutual calls) by induction + on the interpreter fuel, and takes functions outside the group as + `FnCertified` hypotheses from earlier groups. + + Representation: Int is a canonical carrier word (`CanonRepr`, as in the + existing wall), Bool is `i32` 0/1, a record is the struct of its type (a + one-field newtype record its field's value) and a variant the struct of + its constructor, both with pointwise represented fields; an Option / + Result is the struct of its instantiation with the tag in field 0; a + Float is its `f64` bits, a String the `$string` array of its bytes, a + Vector the array of its elements, a List `null` or a cons struct. The + locals relation `LRel` constrains only the slots the source environment + defines, and all of them sit below the resolver slot count `X.n`; the + scratch locals (subject scratch, const-compare scratch) sit at or above it + and are free for the templates to overwrite, and need not exist at all + (a stash is read back at once, and that read fails on a missing local). A + match reads its stashed subject only before any arm body runs, so a + nested match reusing the same scratch is harmless. + + The String and Vector nodes call three more runtime helpers, taken with + exactly the contracts `Schema.Obligation.holds` already assumes of them + (`XHost`): `__wasmgc_concat_n`, `__wasmgc_string_eq`, `__aint_to_index`. + + The interpreter's `ref.test` is exact while wasm GC tests subtyping; the + S-3 section below shows the two agree on constructor structs under the + byte pin `GrammarLower.S3Pin`, which the acceptance must check. -/ +import GrammarLower +import InterpreterSequencing + +set_option maxHeartbeats 4000000 +set_option maxRecDepth 100000 +set_option linter.unusedSectionVars false +set_option linter.unusedSimpArgs false + +namespace AverCert.Grammar +open CertPrelude AverCert.Schema InterpreterSequencing + +/-! ## Relations -/ + +/-- The source environment agrees with the typing environment. -/ +def EnvTy (M : MCtx) (env : Nat → Option SVal) (Γ : Nat → Option Ty) : + Prop := + ∀ i, (env i = none ∧ Γ i = none) ∨ + ∃ v T, env i = some v ∧ Γ i = some T ∧ HasTy M v T + +section Rel +variable {C : Nat} (S : CarrierSpec C) (M : MCtx) (X : LCtx) + +/-- Locals relation: every resolver slot is a local, and every defined source + slot sits below the resolver slot count `X.n` and is represented at its + own wasm local. The scratch locals sit at or above `X.n`, so the + templates may overwrite them freely. A scratch local need not exist (a + carrier-free function declares no locals at all): a template that stashes + into a missing scratch reads it back next, and that read fails. -/ +def LRel (env : Nat → Option SVal) (wl : List WVal) : Prop := + (X.n ≤ X.cmp ∧ X.n ≤ X.subj ∧ X.n ≤ wl.length) ∧ + ∀ i v, env i = some v → i < X.n ∧ ∃ w, wl[i]? = some w ∧ SRepr S M v w + +/-- What a node's run looks like: a normal run pushes exactly one represented + value on the untouched stack and keeps the locals relation; a `.ret` (a + `return_call`) happens only in tail position. -/ +def Res (tail : Bool) (env : Nat → Option SVal) (st : List WVal) (sv : SVal) : Out → Prop + | .ok wl' st' => ∃ w, st' = w :: st ∧ SRepr S M sv w ∧ LRel S M X env wl' + | .ret w => tail = true ∧ SRepr S M sv w + +end Rel + +/-- The runtime helpers the String and Vector nodes call, at their indices, + each with the contract `Schema.Obligation.holds` already assumes of it: + `__wasmgc_concat_n` concatenates the byte arrays of its `Vector` + argument into a `$string` array, `__wasmgc_string_eq` is byte equality, + and `__aint_to_index` maps a represented Int to its `i32` index or the + `-1` sentinel; `__aint_divmod(a, b, want_mod)` is Euclidean division + (`want_mod = 0`) or remainder (`want_mod = 1`) on a canonical pair with a + nonzero divisor, with a canonical result. -/ +structure XHost {C : Nat} (S : CarrierSpec C) (M : MCtx) (host : HostTbl) : Prop where + concat : ∃ g, host M.concat = some (1, g) ∧ + ∀ parts c, g [parts] = some c → stringConcatW M.str parts = some c + streq : ∃ g, host M.streq = some (2, g) ∧ + ∀ a b r, g [a, b] = some r → r = b32 (stringEqW a b) + toIndex : ∃ g, host M.toIndex = some (1, g) ∧ + ∀ n v r, S.Repr n v → g [v] = some r → r = .i32v (toIndexW n) + divmod : ∃ g, host M.divmod = some (3, g) ∧ + ∀ a b wa wb m r, CanonRepr S a wa → CanonRepr S b wb → b ≠ 0 → (m = 0 ∨ m = 1) → + g [wa, wb, .i32v m] = some r → CanonRepr S (if m = 1 then a % b else a / b) r + +/-- Assume–guarantee contract of a code function `f` at signature `sig` for + one opaque `callee`: the ONLY thing a caller knows about `f`. -/ +def Contract {C : Nat} (S : CarrierSpec C) (M : MCtx) + (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (f : Nat) (sig : Sig) (model : List SVal → Option SVal) : Prop := + host f = none ∧ ar f = some sig.params.length ∧ + ∀ svs ws r, HasTyL M svs sig.params → SReprL S M svs ws → callee f ws = some r → + ∃ sv, model svs = some sv ∧ SRepr S M sv r ∧ HasTy M sv sig.ret + +/-- The certificate face of one function, with a fuel-indexed model. -/ +def FnCertified {C : Nat} (S : CarrierSpec C) (M : MCtx) + (code : CodeTbl) (host : HostTbl) (f : Nat) (sig : Sig) + (model : Nat → List SVal → Option SVal) : Prop := + host f = none ∧ (code f).map (·.arity) = some sig.params.length ∧ + ∀ fuel svs ws r, HasTyL M svs sig.params → SReprL S M svs ws → + wFuncN code host fuel f ws = some r → + ∃ sv, model fuel svs = some sv ∧ SRepr S M sv r ∧ HasTy M sv sig.ret + +theorem FnCertified.contract {C : Nat} {S : CarrierSpec C} {M : MCtx} + {code : CodeTbl} {host : HostTbl} {f : Nat} {sig : Sig} + {model : Nat → List SVal → Option SVal} + (h : FnCertified S M code host f sig model) (fuel : Nat) : + Contract S M host (fun g => (code g).map (·.arity)) + (fun g as => wFuncN code host fuel g as) f sig (model fuel) := + ⟨h.1, h.2.1, fun svs ws r hT hr hc => h.2.2 fuel svs ws r hT hr hc⟩ + +/-! ## Small lemmas -/ + +section Small +variable {M : MCtx} + +theorem hasTy_int {v : SVal} (h : HasTy M v .int) : ∃ n, v = .i n := by + cases v <;> simp_all [HasTy] + +theorem hasTy_bool {v : SVal} (h : HasTy M v .bool) : ∃ b, v = .b b := by + cases v <;> simp_all [HasTy] + +theorem hasTy_record {v : SVal} {tid : Nat} (h : HasTy M v (.record tid)) : + ∃ fs fts, v = .record tid fs ∧ M.recFields tid = some fts ∧ HasTyL M fs fts := by + cases v <;> simp only [HasTy] at h + obtain ⟨rfl, fts, hR, hfs⟩ := h + exact ⟨_, fts, rfl, hR, hfs⟩ + +theorem hasTy_sum {v : SVal} {tid : Nat} (h : HasTy M v (.sum tid)) : + ∃ c fs fts, v = .variant tid c fs ∧ ctorFields M tid c = some fts ∧ HasTyL M fs fts := by + cases v <;> simp only [HasTy] at h + obtain ⟨rfl, fts, hR, hfs⟩ := h + exact ⟨_, _, fts, rfl, hR, hfs⟩ + +theorem hasTy_option {v : SVal} {t : Ty} (h : HasTy M v (.option t)) : + v = .none t ∨ ∃ x, v = .some t x ∧ HasTy M x t := by + cases v <;> simp only [HasTy] at h + · subst h; exact Or.inl rfl + · obtain ⟨rfl, hx⟩ := h; exact Or.inr ⟨_, rfl, hx⟩ + +theorem hasTy_result {v : SVal} {t e : Ty} (h : HasTy M v (.result t e)) : + (∃ x, v = .ok t e x ∧ HasTy M x t) ∨ (∃ x, v = .err t e x ∧ HasTy M x e) := by + cases v <;> simp only [HasTy] at h + · obtain ⟨rfl, rfl, hx⟩ := h; exact Or.inl ⟨_, rfl, hx⟩ + · obtain ⟨rfl, rfl, hx⟩ := h; exact Or.inr ⟨_, rfl, hx⟩ + +theorem hasTy_float {v : SVal} (h : HasTy M v .float) : ∃ x, v = .f x := by + cases v <;> simp_all [HasTy] + +theorem hasTy_string {v : SVal} (h : HasTy M v .string) : ∃ x, v = .s x := by + cases v <;> simp_all [HasTy] + +theorem hasTy_vec {v : SVal} {t : Ty} (h : HasTy M v (.vec t)) : + ∃ vs, v = .vec t vs ∧ HasTyAll M vs t := by + cases v <;> simp only [HasTy] at h + obtain ⟨rfl, h⟩ := h + exact ⟨_, rfl, h⟩ + +theorem hasTyAll_get : ∀ {vs : List SVal} {t : Ty}, HasTyAll M vs t → + ∀ {i : Nat} {v : SVal}, vs[i]? = some v → HasTy M v t + | [], _, _, i, v, hv => by simp at hv + | v' :: vs, t, h, i, v, hv => by + cases i with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at hv + subst hv + exact h.1 + | succ i => + simp only [List.getElem?_cons_succ] at hv + exact hasTyAll_get h.2 hv + +theorem hasTyL_length : ∀ {vs : List SVal} {ts : List Ty}, HasTyL M vs ts → + vs.length = ts.length + | [], [], _ => rfl + | _ :: _, _ :: _, h => by simp [hasTyL_length h.2] + | [], _ :: _, h => by simp [HasTyL] at h + | _ :: _, [], h => by simp [HasTyL] at h + +theorem hasTyL_get : ∀ {vs : List SVal} {ts : List Ty}, HasTyL M vs ts → + ∀ {i : Nat} {t : Ty}, ts[i]? = some t → ∃ v, vs[i]? = some v ∧ HasTy M v t + | [], [], _, i, t, ht => by simp at ht + | v :: vs, t' :: ts, h, i, t, ht => by + cases i with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at ht + subst ht + exact ⟨v, rfl, h.1⟩ + | succ i => + simp only [List.getElem?_cons_succ] at ht ⊢ + exact hasTyL_get h.2 ht + | [], _ :: _, h, _, _, _ => by simp [HasTyL] at h + | _ :: _, [], h, _, _, _ => by simp [HasTyL] at h + +theorem hasTyL_get' : ∀ {vs : List SVal} {ts : List Ty}, HasTyL M vs ts → + ∀ {i : Nat} {v : SVal}, vs[i]? = some v → ∃ t, ts[i]? = some t ∧ HasTy M v t + | [], [], _, i, v, hv => by simp at hv + | v' :: vs, t :: ts, h, i, v, hv => by + cases i with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at hv + subst hv + exact ⟨t, rfl, h.1⟩ + | succ i => + simp only [List.getElem?_cons_succ] at hv ⊢ + exact hasTyL_get' h.2 hv + | [], _ :: _, h, _, _, _ => by simp [HasTyL] at h + | _ :: _, [], h, _, _, _ => by simp [HasTyL] at h + +end Small + +section SmallRepr +variable {C : Nat} {S : CarrierSpec C} {M : MCtx} + +theorem sreprL_length : ∀ {vs : List SVal} {ws : List WVal}, SReprL S M vs ws → + vs.length = ws.length + | [], [], _ => rfl + | _ :: _, _ :: _, h => by simp [sreprL_length h.2] + | [], _ :: _, h => by simp [SReprL] at h + | _ :: _, [], h => by simp [SReprL] at h + +theorem sreprL_get : ∀ {vs : List SVal} {ws : List WVal}, SReprL S M vs ws → + ∀ {i : Nat} {v : SVal}, vs[i]? = some v → ∃ w, ws[i]? = some w ∧ SRepr S M v w + | [], [], _, i, v, hv => by simp at hv + | v' :: vs, w :: ws, h, i, v, hv => by + cases i with + | zero => + simp only [List.getElem?_cons_zero, Option.some.injEq] at hv + subst hv + exact ⟨w, rfl, h.1⟩ + | succ i => + simp only [List.getElem?_cons_succ] at hv ⊢ + exact sreprL_get h.2 hv + | [], _ :: _, h, _, _, _ => by simp [SReprL] at h + | _ :: _, [], h, _, _, _ => by simp [SReprL] at h + +theorem srepr_b {v : Bool} {w : WVal} (h : SRepr S M (.b v) w) : w = b32 v := by + simpa [SRepr] using h + +end SmallRepr + +theorem popArgs_rev {ws st : List WVal} : + popArgs ws.length (ws.reverse ++ st) = some (ws, st) := by + simp [popArgs] + +theorem popArgs_one (a : WVal) (st : List WVal) : popArgs 1 (a :: st) = some ([a], st) := by + simp [popArgs] + +theorem popArgs_two (a b : WVal) (st : List WVal) : + popArgs 2 (b :: a :: st) = some ([a, b], st) := by + simp [popArgs] + +theorem run_split {host : HostTbl} {ar : Nat → Option Nat} {callee : Callee} + {xs ys : List WInstr} {l st : List WVal} {out : Out} + (h : wRunF host ar callee (xs ++ ys) l st = some out) : + ∃ o, wRunF host ar callee xs l st = some o ∧ + seqOut host ar callee ys (some o) = some out := by + rw [wRunF_append] at h + cases hx : wRunF host ar callee xs l st with + | none => rw [hx] at h; simp [seqOut] at h + | some o => exact ⟨o, rfl, by rw [hx] at h; exact h⟩ + +/-- Running a lone `if` on an i32 condition is running the chosen branch. -/ +theorem wRunF_ifElse_single (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (tB eB : List WInstr) (l : List WVal) (c : Int) (st : List WVal) : + wRunF host ar callee [.ifElse tB eB] l (.i32v c :: st) = + if c = 0 then wRunF host ar callee eB l st else wRunF host ar callee tB l st := by + by_cases hc : c = 0 + · simp only [wRunF, hc, ite_true] + cases h : wRunF host ar callee eB l st with + | none => rfl + | some o => cases o <;> simp + · simp only [wRunF, hc, ite_false] + cases h : wRunF host ar callee tB l st with + | none => rfl + | some o => cases o <;> simp + +theorem upd_same {α : Type} (f : Nat → Option α) (i : Nat) (a : α) : upd f i a i = some a := by + simp [upd] + +theorem upd_ne {α : Type} (f : Nat → Option α) {i j : Nat} (a : α) (h : j ≠ i) : + upd f i a j = f j := by + simp [upd, h] + +/-! ## Locals-relation maintenance -/ + +section LRelLemmas +variable {C : Nat} {S : CarrierSpec C} {M : MCtx} {X : LCtx} + +/-- Writing a slot the source environment does not define keeps the relation + (the stash into the scratch local). -/ +theorem lrel_set_free {env : Nat → Option SVal} {wl : List WVal} {j : Nat} (w : WVal) + (hl : LRel S M X env wl) (hj : X.n ≤ j) : LRel S M X env (wl.set j w) := by + refine ⟨by simpa using hl.1, ?_⟩ + intro i v hv + obtain ⟨hi, w', hw', hr⟩ := hl.2 i v hv + refine ⟨hi, w', ?_, hr⟩ + rw [List.getElem?_set_ne (by omega)] + exact hw' + +/-- Binding a fresh slot `b < n` on both sides keeps the relation. -/ +theorem lrel_bind {env : Nat → Option SVal} {wl : List WVal} {b : Nat} {v : SVal} {w : WVal} + (hl : LRel S M X env wl) (hb : b < X.n) (hr : SRepr S M v w) : + LRel S M X (upd env b v) (wl.set b w) := by + refine ⟨by simpa using hl.1, ?_⟩ + intro i v' hv' + by_cases hib : i = b + · subst hib + rw [upd_same] at hv' + cases hv' + refine ⟨hb, w, ?_, hr⟩ + rw [List.getElem?_set_self (by have := hl.1; omega)] + · rw [upd_ne _ _ hib] at hv' + obtain ⟨hi, w', hw', hr'⟩ := hl.2 i v' hv' + refine ⟨hi, w', ?_, hr'⟩ + rw [List.getElem?_set_ne (fun h => hib h.symm)] + exact hw' + +/-- A relation for an extended environment implies the one for the original + when the new slot was unbound. -/ +theorem lrel_of_upd {env : Nat → Option SVal} {wl : List WVal} {b : Nat} {v : SVal} + (hfree : env b = none) (hl : LRel S M X (upd env b v) wl) : LRel S M X env wl := by + refine ⟨hl.1, ?_⟩ + intro i v' hv' + have hib : i ≠ b := by + intro h; subst h; rw [hfree] at hv'; cases hv' + exact hl.2 i v' (by rw [upd_ne _ _ hib]; exact hv') + +theorem res_of_upd {tail : Bool} {env : Nat → Option SVal} {st : List WVal} {sv : SVal} + {out : Out} {b : Nat} {v : SVal} (hfree : env b = none) + (h : Res S M X tail (upd env b v) st sv out) : Res S M X tail env st sv out := by + cases out with + | ok wl' st' => + obtain ⟨w, h1, h2, h3⟩ := h + exact ⟨w, h1, h2, lrel_of_upd hfree h3⟩ + | ret w => exact h + +theorem res_ok {tail : Bool} {env : Nat → Option SVal} {st wl' : List WVal} {sv : SVal} + {w : WVal} (h : SRepr S M sv w) (hl : LRel S M X env wl') : + Res S M X tail env st sv (.ok wl' (w :: st)) := + ⟨w, rfl, h, hl⟩ + +/-- A non-tail node never returns: its run is a normal frame. -/ +theorem res_false {env : Nat → Option SVal} {st : List WVal} {sv : SVal} {out : Out} + (h : Res S M X false env st sv out) : + ∃ wl' w, out = .ok wl' (w :: st) ∧ SRepr S M sv w ∧ LRel S M X env wl' := by + cases out with + | ok wl' st' => + obtain ⟨w, rfl, hw, hl⟩ := h + exact ⟨wl', w, rfl, hw, hl⟩ + | ret w => exact absurd h.1 (by simp) + +end LRelLemmas + +theorem envTy_upd {M : MCtx} {env : Nat → Option SVal} + {Γ : Nat → Option Ty} {b : Nat} {v : SVal} {T : Ty} + (h : EnvTy M env Γ) (hv : HasTy M v T) : EnvTy M (upd env b v) (upd Γ b T) := by + intro i + by_cases hib : i = b + · subst hib + exact Or.inr ⟨v, T, upd_same _ _ _, upd_same _ _ _, hv⟩ + · rw [upd_ne _ _ hib, upd_ne _ _ hib] + exact h i + +theorem envTy_get {M : MCtx} {env : Nat → Option SVal} + {Γ : Nat → Option Ty} {i : Nat} {T : Ty} + (h : EnvTy M env Γ) (hT : Γ i = some T) : ∃ v, env i = some v ∧ HasTy M v T := by + rcases h i with ⟨_, h2⟩ | ⟨v, T', h1, h2, h3⟩ + · rw [hT] at h2; cases h2 + · rw [hT] at h2; cases h2; exact ⟨v, h1, h3⟩ + +theorem envTy_free {M : MCtx} {env : Nat → Option SVal} + {Γ : Nat → Option Ty} {i : Nat} + (h : EnvTy M env Γ) (hT : Γ i = none) : env i = none := by + rcases h i with ⟨h1, _⟩ | ⟨v, T', h1, h2, h3⟩ + · exact h1 + · rw [hT] at h2; cases h2 + +/-! ## Comparison semantics and the two comparison templates -/ + +/-- The source meaning of the six comparisons (arithmetic operators map to + `false`; they never reach this function). -/ +def cmpDen : BinOp → Int → Int → Bool + | .eq, x, y => decide (x = y) + | .neq, x, y => decide (x ≠ y) + | .lt, x, y => decide (x < y) + | .gt, x, y => decide (x > y) + | .lte, x, y => decide (x ≤ y) + | .gte, x, y => decide (x ≥ y) + | _, _, _ => false + +theorem intBin_cmp {op : BinOp} (h : op.isArith = false) (x y : Int) : + intBin op x y = .b (cmpDen op x y) := by + cases op <;> simp_all [intBin, cmpDen, BinOp.isArith] + +theorem cmpDen_flip (op : BinOp) (x y : Int) : cmpDen op.flip x y = cmpDen op y x := by + cases op <;> simp [cmpDen, BinOp.flip, eq_comm] + +theorem flip_isArith {op : BinOp} (h : op.isArith = false) : op.flip.isArith = false := by + cases op <;> simp_all [BinOp.flip, BinOp.isArith] + +/-- One lemma for BOTH literal-comparison templates: the re-emit template + reads the bare local's own slot, the stash template the scratch slot. -/ +theorem cmpArm_step {C : Nat} (S : CarrierSpec C) + (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (op : BinOp) (hop : op.isArith = false) (k : Int) (slot : Nat) + (locals stack : List WVal) (n : Int) (w : WVal) (out : Out) + (hband : inI64Band k = true) + (hget : locals[slot]? = some w) + (hR : CanonRepr S n w) + (hrun : wRunF host ar callee (eraseL (cmpArmB C slot op k)) locals stack = some out) : + out = .ok locals (b32 (cmpDen op n k) :: stack) := by + have hk : -(2 ^ 63 : Int) ≤ k ∧ k < 2 ^ 63 := by + simpa [inI64Band, Bool.and_eq_true, decide_eq_true_eq] using hband + rcases S.car n w hR.1 with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ + · have hs : s = n := S.smallElim n s sg hR.1 + subst hs + cases op <;> simp [BinOp.isArith] at hop <;> + · simp [cmpArmB, eraseL, eraseI, bigCmpArm, smallCmpInstr, wRunF, hget, b32] at hrun + subst hrun + simp [cmpDen, b32] + · obtain ⟨hnb, hsgne⟩ := S.canonBig n s lty les sg hR.1 hR.2 + obtain ⟨hsign, _hnz⟩ := S.bigElim n s lty les sg hR.1 + have hLtIff : (sg < 0) ↔ n < k := by + constructor + · intro h; have := hsign.mp h; omega + · intro h; exact hsign.mpr (by omega) + have hGtIff : (0 < sg) ↔ k < n := by + constructor + · intro h + have hnn : ¬ n < 0 := by intro hc; have := hsign.mpr hc; omega + omega + · intro h + have hnn : ¬ sg < 0 := by intro hc; have := hsign.mp hc; omega + omega + have hNe : ¬ n = k := by + intro he; subst he; omega + have hLe : (n ≤ k) = (n < k) := by + simp only [eq_iff_iff] + constructor + · intro h; omega + · intro h; omega + have hGe : (k ≤ n) = (k < n) := by + simp only [eq_iff_iff] + constructor + · intro h; omega + · intro h; omega + cases op <;> simp [BinOp.isArith] at hop <;> + · simp [cmpArmB, eraseL, eraseI, bigCmpArm, smallCmpInstr, wRunF, hget, b32] at hrun + subst hrun + simp [cmpDen, b32, hLtIff, hGtIff, hNe, hLe, hGe] + +section Templates +variable {C : Nat} (S : CarrierSpec C) + (box add sub mul cmp eq : List WVal → Option WVal) + (Ctr : Contracts S box add sub mul cmp eq) + (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) (M : MCtx) +include Ctr + +/-- Int against Int without a literal: `__aint_cmp` against `0`, or + `__aint_eq` (and `i32.eqz`). -/ +theorem intCmpTail_step + (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) + (op : BinOp) (hop : op.isArith = false) (a b : Int) (wa wb : WVal) + (ha : CanonRepr S a wa) (hb : CanonRepr S b wb) + (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee (intCmpTail M op) wl (wb :: wa :: st) = some out) : + out = .ok wl (b32 (cmpDen op a b) :: st) := by + cases op <;> simp [BinOp.isArith] at hop + · -- eq + cases hr : eq [wa, wb] with + | none => simp [intCmpTail, wRunF, hEq, popArgs_two, hr] at hrun + | some r => + have hr' := Ctr.hEq a b wa wb r ha.1 hb.1 ha.2 hb.2 hr + subst hr' + simp [intCmpTail, wRunF, hEq, popArgs_two, hr] at hrun + subst hrun + by_cases h : a = b <;> simp [cmpDen, eqW, b32, h] + · -- neq + cases hr : eq [wa, wb] with + | none => simp [intCmpTail, wRunF, hEq, popArgs_two, hr] at hrun + | some r => + have hr' := Ctr.hEq a b wa wb r ha.1 hb.1 ha.2 hb.2 hr + subst hr' + simp [intCmpTail, wRunF, hEq, popArgs_two, hr] at hrun + subst hrun + by_cases h : a = b <;> simp [cmpDen, eqW, b32, h] + all_goals + cases hr : cmp [wa, wb] with + | none => simp [intCmpTail, wRunF, hCmp, popArgs_two, hr] at hrun + | some r => + have hr' := Ctr.hCmp a b wa wb r ha.1 hb.1 ha.2 hb.2 hr + subst hr' + simp [intCmpTail, wRunF, hCmp, popArgs_two, hr] at hrun + subst hrun + unfold cmpW + by_cases h1 : a < b + · simp [cmpDen, b32, h1] <;> omega + · by_cases h2 : a = b + · subst h2; simp [cmpDen, b32] + · simp [cmpDen, b32, h1, h2] <;> omega + +/-- Int arithmetic through the named helper contracts. -/ +theorem arith_step + (hAdd : host M.add = some (2, add)) (hSub : host M.sub = some (2, sub)) + (hMul : host M.mul = some (2, mul)) + (op : BinOp) (hop : op.isArith = true) (a b : Int) (wa wb : WVal) + (ha : CanonRepr S a wa) (hb : CanonRepr S b wb) + (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee [.call (M.arithIdx op)] wl (wb :: wa :: st) = some out) : + ∃ w, out = .ok wl (w :: st) ∧ SRepr S M (intBin op a b) w ∧ + HasTy M (intBin op a b) .int := by + cases op <;> simp [BinOp.isArith] at hop + · cases hr : add [wa, wb] with + | none => simp [MCtx.arithIdx, wRunF, hAdd, popArgs_two, hr] at hrun + | some r => + simp [MCtx.arithIdx, wRunF, hAdd, popArgs_two, hr] at hrun + exact ⟨r, hrun.symm, by simp only [intBin, SRepr]; exact Ctr.hAdd a b wa wb r ha.1 hb.1 hr, + by simp [intBin, HasTy]⟩ + · cases hr : sub [wa, wb] with + | none => simp [MCtx.arithIdx, wRunF, hSub, popArgs_two, hr] at hrun + | some r => + simp [MCtx.arithIdx, wRunF, hSub, popArgs_two, hr] at hrun + exact ⟨r, hrun.symm, by simp only [intBin, SRepr]; exact Ctr.hSub a b wa wb r ha.1 hb.1 hr, + by simp [intBin, HasTy]⟩ + · cases hr : mul [wa, wb] with + | none => simp [MCtx.arithIdx, wRunF, hMul, popArgs_two, hr] at hrun + | some r => + simp [MCtx.arithIdx, wRunF, hMul, popArgs_two, hr] at hrun + exact ⟨r, hrun.symm, by simp only [intBin, SRepr]; exact Ctr.hMul a b wa wb r ha.1 hb.1 hr, + by simp [intBin, HasTy]⟩ + +end Templates + +theorem boolCmp_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (op : BinOp) (hop : op.isEquality = true) (x y : Bool) (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee [boolCmpInstr op] wl (b32 y :: b32 x :: st) = some out) : + ∃ v, boolBin op x y = some (.b v) ∧ out = .ok wl (b32 v :: st) := by + cases op <;> simp [BinOp.isEquality] at hop + · refine ⟨x == y, rfl, ?_⟩ + cases x <;> cases y <;> simp [boolCmpInstr, wRunF, b32] at hrun ⊢ <;> + exact hrun.symm + · refine ⟨x != y, rfl, ?_⟩ + cases x <;> cases y <;> simp [boolCmpInstr, wRunF, b32] at hrun ⊢ <;> + exact hrun.symm + +theorem hasTyL_cons_inv {M : MCtx} {svs : List SVal} {t : Ty} + {ts : List Ty} (h : HasTyL M svs (t :: ts)) : + ∃ v vs, svs = v :: vs ∧ HasTy M v t ∧ HasTyL M vs ts := by + cases svs with + | nil => simp [HasTyL] at h + | cons v vs => exact ⟨v, vs, rfl, h.1, h.2⟩ + +theorem hasTyL_nil_inv {M : MCtx} {svs : List SVal} + (h : HasTyL M svs []) : svs = [] := by + cases svs with + | nil => rfl + | cons _ _ => simp [HasTyL] at h + +theorem sreprL_cons_inv {C : Nat} {S : CarrierSpec C} {M : MCtx} {v : SVal} + {vs : List SVal} {ws : List WVal} (h : SReprL S M (v :: vs) ws) : + ∃ w ws', ws = w :: ws' ∧ SRepr S M v w ∧ SReprL S M vs ws' := by + cases ws with + | nil => simp [SReprL] at h + | cons w ws' => exact ⟨w, ws', rfl, h.1, h.2⟩ + +theorem sreprL_nil_inv {C : Nat} {S : CarrierSpec C} {M : MCtx} {ws : List WVal} + (h : SReprL S M [] ws) : ws = [] := by + cases ws with + | nil => rfl + | cons _ _ => simp [SReprL] at h + +theorem hasTy_list {M : MCtx} {v : SVal} {t : Ty} (h : HasTy M v (.list t)) : + v = .nil t ∨ ∃ x r, v = .cons t x r ∧ HasTy M x t ∧ HasTy M r (.list t) := by + cases v <;> simp only [HasTy] at h + · left; rw [h] + · obtain ⟨rfl, hx, hr⟩ := h + exact Or.inr ⟨_, _, rfl, hx, hr⟩ + +/-- A builtin call's tail after its arguments: the Bool builtins are one + `i32` instruction, `List.prepend` builds the cons cell of the tail's + type. -/ +theorem builtin_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + {C : Nat} {S : CarrierSpec C} {M : MCtx} + (bi : Builtin) (ts : List Ty) (T : Ty) (hty : builtinTy bi ts = some T) + (svs : List SVal) (ws : List WVal) (hT : HasTyL M svs ts) (hr : SReprL S M svs ws) + (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee (eraseL (builtinTail M bi (some ts))) wl (ws.reverse ++ st) = + some out) : + ∃ sv w, builtinEval bi svs = some sv ∧ HasTy M sv T ∧ SRepr S M sv w ∧ + out = .ok wl (w :: st) := by + unfold builtinTy at hty + split at hty + · simp only [Option.some.injEq] at hty + subst hty + obtain ⟨a, svs1, rfl, ha, hT1⟩ := hasTyL_cons_inv hT + obtain ⟨b, svs2, rfl, hb, hT2⟩ := hasTyL_cons_inv hT1 + have := hasTyL_nil_inv hT2; subst this + obtain ⟨wa, ws1, rfl, hwa, hr1⟩ := sreprL_cons_inv hr + obtain ⟨wb, ws2, rfl, hwb, hr2⟩ := sreprL_cons_inv hr1 + have := sreprL_nil_inv hr2; subst this + obtain ⟨x, rfl⟩ := hasTy_bool ha + obtain ⟨y, rfl⟩ := hasTy_bool hb + have hwa' := srepr_b hwa + have hwb' := srepr_b hwb + subst hwa' hwb' + cases x <;> cases y <;> + simp [builtinTail, eraseL, eraseI, wRunF, b32, builtinEval, HasTy, SRepr] at hrun ⊢ <;> + exact hrun.symm + · simp only [Option.some.injEq] at hty + subst hty + obtain ⟨a, svs1, rfl, ha, hT1⟩ := hasTyL_cons_inv hT + obtain ⟨b, svs2, rfl, hb, hT2⟩ := hasTyL_cons_inv hT1 + have := hasTyL_nil_inv hT2; subst this + obtain ⟨wa, ws1, rfl, hwa, hr1⟩ := sreprL_cons_inv hr + obtain ⟨wb, ws2, rfl, hwb, hr2⟩ := sreprL_cons_inv hr1 + have := sreprL_nil_inv hr2; subst this + obtain ⟨x, rfl⟩ := hasTy_bool ha + obtain ⟨y, rfl⟩ := hasTy_bool hb + have hwa' := srepr_b hwa + have hwb' := srepr_b hwb + subst hwa' hwb' + cases x <;> cases y <;> + simp [builtinTail, eraseL, eraseI, wRunF, b32, builtinEval, HasTy, SRepr] at hrun ⊢ <;> + exact hrun.symm + · simp only [Option.some.injEq] at hty + subst hty + obtain ⟨a, svs1, rfl, ha, hT1⟩ := hasTyL_cons_inv hT + have := hasTyL_nil_inv hT1; subst this + obtain ⟨wa, ws1, rfl, hwa, hr1⟩ := sreprL_cons_inv hr + have := sreprL_nil_inv hr1; subst this + obtain ⟨x, rfl⟩ := hasTy_bool ha + have hwa' := srepr_b hwa + subst hwa' + cases x <;> + simp [builtinTail, eraseL, eraseI, wRunF, b32, builtinEval, HasTy, SRepr] at hrun ⊢ <;> + exact hrun.symm + · rename_i t t' + split at hty + · rename_i htt + subst htt + simp only [Option.some.injEq] at hty + subst hty + obtain ⟨h, svs1, rfl, hh, hT1⟩ := hasTyL_cons_inv hT + obtain ⟨tl, svs2, rfl, htl, hT2⟩ := hasTyL_cons_inv hT1 + have := hasTyL_nil_inv hT2; subst this + obtain ⟨wh, ws1, rfl, hwh, hr1⟩ := sreprL_cons_inv hr + obtain ⟨wt, ws2, rfl, hwt, hr2⟩ := sreprL_cons_inv hr1 + have := sreprL_nil_inv hr2; subst this + simp [builtinTail, eraseL, eraseI, wRunF, popArgs_two] at hrun + subst hrun + refine ⟨.cons t h tl, .structv (M.listStruct t) [wh, wt], ?_, ⟨rfl, hh, htl⟩, + ⟨wh, wt, rfl, hwh, hwt⟩, rfl⟩ + rcases hasTy_list htl with rfl | ⟨x, r, rfl, _, _⟩ <;> rfl + · cases hty + · cases hty + +/-! ## Strings and Floats -/ + +theorem newtype_false {M : MCtx} {tid : Nat} {fts : List Ty} (hR : M.recFields tid = some fts) + (h2 : 2 ≤ fts.length) : M.newtype tid = false := by + match fts, h2 with + | _ :: _ :: _, _ => simp [MCtx.newtype, hR] + +/-- A record of two or more fields is the struct of its type. -/ +theorem srepr_record {C : Nat} {S : CarrierSpec C} {M : MCtx} {tid : Nat} {fts : List Ty} + (hR : M.recFields tid = some fts) (h2 : 2 ≤ fts.length) (fs : List SVal) (w : WVal) : + SRepr S M (.record tid fs) w ↔ ∃ ws, w = .structv (M.structOf tid) ws ∧ SReprL S M fs ws := by + simp [SRepr, newtype_false hR h2] + +theorem wByteListEq_map : ∀ (x y : List Nat), + wByteListEq (x.map fun (b : Nat) => .i32v (b : Int)) (y.map fun (b : Nat) => .i32v (b : Int)) = + (x == y) + | [], [] => rfl + | [], _ :: _ => rfl + | _ :: _, [] => rfl + | a :: x, b :: y => by + simp only [List.map_cons, wByteListEq, wByteListEq_map x y] + by_cases h : a = b + · subst h; simp + · have : (a :: x == b :: y) = false := by simp [h] + rw [this] + have hc : ((a : Int) == (b : Int)) = false := by + simp only [beq_eq_false_iff_ne, ne_eq] + intro hab + exact h (by exact_mod_cast hab) + rw [hc] + rfl + +theorem stringEqW_strW (M : MCtx) (x y : List Nat) : + stringEqW (strW M x) (strW M y) = (x == y) := by + unfold stringEqW strW + exact wByteListEq_map x y + +theorem wByteAppend_map (acc : List WVal) : ∀ x : List Nat, + wByteAppend (x.map fun (b : Nat) => .i32v (b : Int)) acc = + some (x.map (fun (b : Nat) => .i32v (b : Int)) ++ acc) + | [] => rfl + | a :: x => by + simp only [List.map_cons, wByteAppend] + rw [wByteAppend_map acc x] + rfl + +theorem stringConcatParts_of {C : Nat} {S : CarrierSpec C} {M : MCtx} : + ∀ {svs : List SVal} {ws : List WVal} {bs : List Nat}, + SReprL S M svs ws → strCat svs = some bs → + stringConcatParts ws = some (bs.map fun (b : Nat) => .i32v (b : Int)) + | [], [], bs, _, hc => by + simp only [strCat, Option.some.injEq] at hc + subst hc + rfl + | v :: vs, w :: ws, bs, h, hc => by + cases v with + | s x => + simp only [strCat] at hc + cases hr : strCat vs with + | none => simp [hr] at hc + | some rest => + simp only [hr, Option.map_some, Option.some.injEq] at hc + subst hc + have hw : w = strW M x := h.1 + subst hw + have ih := stringConcatParts_of h.2 hr + simp [stringConcatParts, ih, strW, wByteAppend_map] + | _ => simp [strCat] at hc + | [], _ :: _, _, h, _ => by simp [SReprL] at h + | _ :: _, [], _, h, _ => by simp [SReprL] at h + +theorem allStr_cons {t : Ty} {ts : List Ty} (h : allStr (t :: ts) = true) : + t = .string ∧ (ts = [] ∨ allStr ts = true) := by + cases t <;> cases ts <;> simp_all [allStr] + +theorem strCat_of_allStr {M : MCtx} : ∀ {svs : List SVal} {ts : List Ty}, + HasTyL M svs ts → allStr ts = true → ∃ bs, strCat svs = some bs + | [], [], _, h => by simp [allStr] at h + | v :: vs, t :: ts, hT, ha => by + obtain ⟨rfl, hrest⟩ := allStr_cons ha + obtain ⟨x, rfl⟩ := hasTy_string hT.1 + rcases hrest with rfl | hrest + · have := hasTyL_nil_inv hT.2 + subst this + exact ⟨x, by simp [strCat]⟩ + · obtain ⟨bs, hbs⟩ := strCat_of_allStr hT.2 hrest + exact ⟨x ++ bs, by simp [strCat, hbs]⟩ + | [], _ :: _, h, _ => by simp [HasTyL] at h + | _ :: _, [], h, _ => by simp [HasTyL] at h + +theorem floatCmp_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (op : BinOp) (hop : op.isFloatCmp = true) (x y : UInt64) (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee [floatCmpInstr op] wl (.f64v y :: .f64v x :: st) = some out) : + ∃ v, floatBin op x y = some (.b v) ∧ out = .ok wl (b32 v :: st) := by + cases op <;> simp [BinOp.isFloatCmp] at hop <;> + simp only [floatCmpInstr, wRunF, Option.some.injEq] at hrun <;> + exact ⟨_, rfl, hrun.symm⟩ + +section StrHost +variable {C : Nat} {S : CarrierSpec C} {M : MCtx} {host : HostTbl} + {ar : Nat → Option Nat} {callee : Callee} + +/-- `__wasmgc_concat_n` over the Strings on the stack. -/ +theorem concat_run (R : XHost S M host) {svs : List SVal} {ws : List WVal} {bs : List Nat} + (hrep : SReprL S M svs ws) (hcat : strCat svs = some bs) (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee (eraseL (concatB M ws.length)) wl (ws.reverse ++ st) = + some out) : + out = .ok wl (strW M bs :: st) := by + obtain ⟨g, hg, hgc⟩ := R.concat + have hparts := stringConcatParts_of hrep hcat + simp only [concatB, eraseL, eraseI, wRunF, popArgs_rev, hg, popArgs_one] at hrun + cases hc : g [.arr M.strVec ws] with + | none => simp [hc] at hrun + | some c => + simp only [hc, Option.some.injEq] at hrun + have h := hgc _ _ hc + simp [stringConcatW, hparts] at h + subst h + try simp only [wRunF, Option.some.injEq] at hrun + exact hrun.symm + +/-- `__wasmgc_string_eq` (and `i32.eqz` for `!=`) on two Strings. -/ +theorem streq_step (R : XHost S M host) (op : BinOp) (hs : op.isStrOp = true) (hne : op ≠ .add) + (x y : List Nat) (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee (eraseL (strOpTail M op)) wl (strW M y :: strW M x :: st) = + some out) : + ∃ v, strBin op x y = some (.b v) ∧ out = .ok wl (b32 v :: st) := by + obtain ⟨g, hg, hgc⟩ := R.streq + cases hr : g [strW M x, strW M y] with + | none => + cases op <;> simp [BinOp.isStrOp] at hs hne <;> + simp [strOpTail, eraseL, eraseI, wRunF, hg, popArgs_two, hr] at hrun + | some r => + have h := hgc _ _ _ hr + rw [stringEqW_strW] at h + subst h + cases op <;> simp [BinOp.isStrOp] at hs hne + · simp [strOpTail, eraseL, eraseI, wRunF, hg, popArgs_two, hr] at hrun + exact ⟨_, rfl, hrun.symm⟩ + · simp [strOpTail, eraseL, eraseI, wRunF, hg, popArgs_two, hr] at hrun + refine ⟨_, rfl, ?_⟩ + by_cases hxy : x = y <;> simp [b32, wRunF, hxy] at hrun ⊢ <;> exact hrun.symm + +theorem toIndex_cond (n : Int) (len : Nat) (hlen : len < 2147483648) : + (0 ≤ toIndexW n ∧ toIndexW n % 4294967296 < (len : Int) % 4294967296) ↔ + (0 ≤ n ∧ n < len) := by + unfold toIndexW + split <;> omega + +/-- The bounds test of the fused `Vector.get`: `__aint_to_index` twice, the + signed `>= 0` and the unsigned `< array.len`, conjoined. -/ +theorem vecCond_run (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) (ti : Nat) + (g : List WVal → Option WVal) (hg : host ti = some (1, g)) (wl st : List WVal) (wi : WVal) + (ws : List WVal) (a : Int) (i v ty : Nat) + (hwi : wl[i]? = some wi) (hwv : wl[v]? = some (.arr ty ws)) (hr : g [wi] = some (.i32v a)) : + wRunF host ar callee [.localGet i, .call ti, .i32Const 0, .i32GeS, .localGet i, .call ti, + .localGet v, .arrayLen, .i32LtU, .i32And] wl st = + some (.ok wl (.i32v (if 0 ≤ a ∧ a % 4294967296 < (ws.length : Int) % 4294967296 then 1 else 0) + :: st)) := by + simp [wRunF, hwi, hwv, hg, hr, popArgs_one, b32] + by_cases h1 : 0 ≤ a <;> by_cases h2 : a % 4294967296 < (ws.length : Int) % 4294967296 <;> + simp [h1, h2] + all_goals first | exact h2 | exact Int.not_lt.mp h2 + +/-- The fused `Vector.get`-or-default: in range, the element; otherwise the + default's code runs. -/ +theorem vecGetOr_step (R : XHost S M host) {v i : Nat} {t : Ty} {vs : List SVal} {n : Int} + {wv wi : WVal} {wl st : List WVal} {dc : List BI} {out : Out} + (hwv : wl[v]? = some wv) (hrv : SRepr S M (.vec t vs) wv) + (hwi : wl[i]? = some wi) (hri : SRepr S M (.i n) wi) + (hrun : wRunF host ar callee (eraseL (vecGetOrB M v i t dc)) wl st = some out) : + ((0 ≤ n ∧ n < vs.length) ∧ ∃ x wx, vs[n.toNat]? = some x ∧ SRepr S M x wx ∧ + out = .ok wl (wx :: st)) ∨ + (¬(0 ≤ n ∧ n < vs.length) ∧ wRunF host ar callee (eraseL dc) wl st = some out) := by + obtain ⟨g, hg, hgc⟩ := R.toIndex + simp only [SRepr] at hrv hri + obtain ⟨hlen, ws, rfl, hws⟩ := hrv + have hwsl : ws.length = vs.length := (sreprL_length hws).symm + cases hr : g [wi] with + | none => + simp [vecGetOrB, eraseL, eraseI, wRunF, hwi, hg, popArgs_one, hr] at hrun + | some r => + have hr' := hgc n wi r hri.1 hr + subst hr' + have hc := toIndex_cond n ws.length (by omega) + have hpre := vecCond_run host ar callee M.toIndex g hg wl st wi ws (toIndexW n) i v + (M.vecStruct t) hwi hwv hr + have hsplit : eraseL (vecGetOrB M v i t dc) = + [.localGet i, .call M.toIndex, .i32Const 0, .i32GeS, .localGet i, .call M.toIndex, + .localGet v, .arrayLen, .i32LtU, .i32And] ++ + [.ifElse [.localGet v, .localGet i, .call M.toIndex, .arrayGet (M.vecStruct t)] + (eraseL dc)] := rfl + rw [hsplit, wRunF_append, hpre] at hrun + have hseq := hrun + simp only [seqOut] at hseq + rw [wRunF_ifElse_single] at hseq + by_cases hin : 0 ≤ n ∧ n < vs.length + · left + have hC := hc.mpr (by rw [hwsl]; exact hin) + simp only [hC, and_self, ↓reduceIte, Int.reduceEq] at hseq + have hti : toIndexW n = n := by unfold toIndexW; split <;> omega + obtain ⟨x, hx⟩ : ∃ x, vs[n.toNat]? = some x := + ⟨vs[n.toNat]'(by omega), List.getElem?_eq_getElem (by omega)⟩ + obtain ⟨wx, hwx, hsx⟩ := sreprL_get hws hx + refine ⟨hin, x, wx, hx, hsx, ?_⟩ + simp [wRunF, hwi, hwv, hg, popArgs_one, hr, hti, hin.1, hwx] at hseq + exact hseq.symm + · right + have hC : ¬(0 ≤ toIndexW n ∧ toIndexW n % 4294967296 < (ws.length : Int) % 4294967296) := + fun h => hin (by have := hc.mp h; rw [hwsl] at this; exact this) + simp only [hC, ↓reduceIte] at hseq + exact ⟨hin, hseq⟩ + +end StrHost + +theorem vecGetOr?_some {lb : LazyBuiltin} {o d : Expr} {v i : Nat} + (h : vecGetOr? lb o d = some (v, i)) : + lb = .optWithDefault ∧ o = .call (.builtin .vecGet) [.local v, .local i] ∧ + ∃ lit, d = .literal lit := by + unfold vecGetOr? at h + split at h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + exact ⟨rfl, rfl, _, rfl⟩ + · cases h + +/-- `divOr?` names exactly the fused `Result.withDefault(Int.div/mod(a, b), k)`. -/ +theorem divOr?_some {lb : LazyBuiltin} {o d : Expr} {m : Bool} {a b : Expr} + (h : divOr? lb o d = some (m, a, b)) : + lb = .resWithDefault ∧ o = .call (.builtin (if m then .intMod else .intDiv)) [a, b] ∧ + ∃ k, d = .literal (.int k) := by + unfold divOr? at h + split at h + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + exact ⟨rfl, rfl, _, rfl⟩ + · simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + exact ⟨rfl, rfl, _, rfl⟩ + · cases h + +theorem lowerStrArms_head (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) + (bt : Option Ty) (k : List Nat) (b : Expr) (r : Arms) : + ∃ ys, eraseL (lowerStrArms M X Γ tail bt (.cons (.litStr k) b r)) = + .localGet X.subj :: ys := by + simp [lowerStrArms, eraseL, eraseI] + +theorem extractB_head (ss idx : Nat) : ∀ (i : Nat) (bs : List Nat) (zs : List BI), + bs.any (· != noSlot) = true → + ∃ ys, eraseL (extractB ss idx i bs ++ zs) = .localGet ss :: ys + | _, [], _, h => by simp at h + | i, b :: bs, zs, h => by + by_cases hb : b = noSlot + · have h' : bs.any (· != noSlot) = true := by simpa [hb] using h + obtain ⟨ys, hys⟩ := extractB_head ss idx (i + 1) bs zs h' + refine ⟨ys, ?_⟩ + simpa [extractB, bindFieldB, hb] using hys + · simp [extractB, bindFieldB, hb, eraseL, eraseI] + +theorem tyTupArms_shape {M : MCtx} {n : Nat} {Γ : Nat → Option Ty} {tail : Bool} {tid : Nat} + {arms : Arms} {T : Ty} {fts : List Ty} + (hR : M.recFields tid = some fts) (h : tyTupArms M n Γ tail tid arms = some T) : + ∃ bs b, 2 ≤ fts.length ∧ bs.any (· != noSlot) = true ∧ arms = .cons (.tuple bs) b .nil := by + cases arms with + | nil => simp [tyTupArms] at h + | cons p b rest => + cases p + case tuple bs => + cases rest with + | cons _ _ _ => simp [tyTupArms] at h + | nil => + simp only [tyTupArms, hR] at h + split at h + · rename_i hc + exact ⟨bs, b, hc.1, hc.2, rfl⟩ + · cases h + all_goals simp [tyTupArms] at h + +theorem lowerTupArms_head {M : MCtx} {X : LCtx} {Γ : Nat → Option Ty} {tail : Bool} {tid : Nat} + {arms : Arms} {bs : List Nat} {b : Expr} (hany : bs.any (· != noSlot) = true) + (harms : arms = .cons (.tuple bs) b .nil) : + ∃ ys, eraseL (lowerTupArms M X Γ tail tid arms) = .localGet X.subj :: ys := by + subst harms + simp only [lowerTupArms] + exact extractB_head X.subj (M.structOf tid) 0 bs _ hany + +/-! ## Binders, fillers and tag tests + +The pieces the match and constructor templates share: the binder +extraction from a struct held in the subject scratch (one `local.set` per +non-ignored binder, in field order, mirrored by `bindTys` on the typing side +and `bindVals` on the value side), the default filler of an unused payload +field, and the Option / Result tag test. -/ + +theorem run_seq {host : HostTbl} {ar : Nat → Option Nat} {callee : Callee} + {xs ys : List WInstr} {l st l' st' : List WVal} {out : Out} + (hx : wRunF host ar callee xs l st = some (.ok l' st')) + (h : wRunF host ar callee (xs ++ ys) l st = some out) : + wRunF host ar callee ys l' st' = some out := by + rw [wRunF_append, hx] at h + exact h + +theorem run_seq_eq {host : HostTbl} {ar : Nat → Option Nat} {callee : Callee} + {xs ys : List WInstr} {l st l' st' : List WVal} + (hx : wRunF host ar callee xs l st = some (.ok l' st')) : + wRunF host ar callee (xs ++ ys) l st = wRunF host ar callee ys l' st' := by + rw [wRunF_append, hx] + rfl + +theorem hasTyL_nil_inv' {M : MCtx} {svs : List SVal} (h : HasTyL M svs []) : svs = [] := by + cases svs with + | nil => rfl + | cons _ _ => simp [HasTyL] at h + +theorem popArgs_three (a b c : WVal) (st : List WVal) : + popArgs 3 (c :: b :: a :: st) = some ([a, b, c], st) := by + unfold popArgs + split + · rename_i h; simp at h; omega + · simp + +section Binders +variable {C : Nat} {S : CarrierSpec C} {M : MCtx} {X : LCtx} + (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + +/-- A non-tail run is a run at any tail position. -/ +theorem res_any_tail {tail : Bool} {env : Nat → Option SVal} {st : List WVal} {sv : SVal} + {out : Out} (h : Res S M X false env st sv out) : Res S M X tail env st sv out := by + cases out with + | ok wl' st' => exact h + | ret w => exact absurd h.1 (by simp) + +/-- The default filler runs, pushes one value and touches no local. -/ +theorem dflt_run (t : Ty) (ht : t.hasDefault = true) (wl st : List WVal) : + ∃ d, wRunF host ar callee (eraseL (dfltB M t)) wl st = some (.ok wl (d :: st)) := by + cases t <;> simp_all [Ty.hasDefault, dfltB, eraseL, eraseI, wRunF, popArgs_three] + +/-- The Option / Result tag test on the struct in the subject scratch. -/ +theorem tagTest_run (ss idx : Nat) (tag : Int) (fs : List WVal) (wl st : List WVal) + (hss : wl[ss]? = some (.structv idx (.i32v tag :: fs))) : + wRunF host ar callee (eraseL (tagTestB ss idx)) wl st = + some (.ok wl (b32 (tag = 1) :: st)) := by + simp [tagTestB, eraseL, eraseI, wRunF, hss, b32] + +/-- One binder read from field `i` of the struct in the scratch `ss`. -/ +theorem bindField_run (ss idx i b : Nat) (ws : List WVal) (x : WVal) (wl st : List WVal) + (hss : wl[ss]? = some (.structv idx ws)) (hx : ws[i]? = some x) : + wRunF host ar callee (eraseL (bindFieldB ss idx i b)) wl st = + some (.ok (if b = noSlot then wl else wl.set b x) st) := by + by_cases hb : b = noSlot + · simp [bindFieldB, hb, eraseL, wRunF] + · simp [bindFieldB, hb, eraseL, eraseI, wRunF, hss, hx] + +/-- The binder extraction of a constructor arm: it binds exactly what + `bindVals` binds, keeps the relations, leaves the scratch alone, and a + result for the extended environment is one for the original. -/ +theorem extract_run (ss idx : Nat) (ws : List WVal) : + ∀ (bs : List Nat) (i : Nat) (vs : List SVal) (ts : List Ty) (fs : List WVal) + (env : Nat → Option SVal) (Γ Γ' : Nat → Option Ty) (wl st : List WVal), + X.n ≤ ss → + wl[ss]? = some (.structv idx ws) → + (∀ j y, fs[j]? = some y → ws[i + j]? = some y) → + HasTyL M vs ts → SReprL S M vs fs → + bindTys X.n Γ bs ts = some Γ' → + EnvTy M env Γ → LRel S M X env wl → + ∃ env' wl', bindVals env bs vs = some env' ∧ EnvTy M env' Γ' ∧ + LRel S M X env' wl' ∧ wl'[ss]? = some (.structv idx ws) ∧ + wRunF host ar callee (eraseL (extractB ss idx i bs)) wl st = some (.ok wl' st) ∧ + (∀ tail st' sv o, Res S M X tail env' st' sv o → Res S M X tail env st' sv o) + | [], i, vs, ts, fs, env, Γ, Γ', wl, st, hssn, hss, hws, hT, hR, hb, henv, hl => by + cases ts with + | cons _ _ => simp [bindTys] at hb + | nil => + simp only [bindTys, Option.some.injEq] at hb + subst hb + have := hasTyL_nil_inv' hT + subst this + exact ⟨env, wl, by simp [bindVals], henv, hl, hss, by simp [extractB, eraseL, wRunF], + fun _ _ _ _ h => h⟩ + | b :: bs, i, vs, ts, fs, env, Γ, Γ', wl, st, hssn, hss, hws, hT, hR, hb, henv, hl => by + cases ts with + | nil => simp [bindTys] at hb + | cons t ts => + obtain ⟨v, vs', rfl, hvT, hT'⟩ := hasTyL_cons_inv hT + obtain ⟨x, fs', rfl, hvx, hR'⟩ := sreprL_cons_inv hR + have hx : ws[i]? = some x := by simpa using hws 0 x (by simp) + have hws' : ∀ j y, fs'[j]? = some y → ws[i + 1 + j]? = some y := by + intro j y hy + have := hws (j + 1) y (by simpa using hy) + rw [show i + (j + 1) = i + 1 + j by omega] at this + exact this + have hstep := bindField_run host ar callee ss idx i b ws x wl st hss hx + by_cases hns : b = noSlot + · simp only [bindTys, hns, ↓reduceIte] at hb + rw [show (if b = noSlot then wl else wl.set b x) = wl by simp [hns]] at hstep + obtain ⟨env', wl', hbv, henv', hl', hss', hrun', hres⟩ := + extract_run ss idx ws bs (i + 1) vs' ts fs' env Γ Γ' wl st hssn hss hws' hT' hR' + hb henv hl + refine ⟨env', wl', by simp [bindVals, hns, hbv], henv', hl', hss', ?_, hres⟩ + simp only [extractB, eraseL_append] + rw [run_seq_eq hstep] + exact hrun' + · simp only [bindTys, hns, ↓reduceIte] at hb + split at hb + · rename_i hfresh + obtain ⟨hbn, hΓb⟩ := hfresh + rw [show (if b = noSlot then wl else wl.set b x) = wl.set b x by simp [hns]] at hstep + have hbs : b ≠ ss := by omega + have hss1 : (wl.set b x)[ss]? = some (.structv idx ws) := by + rw [List.getElem?_set_ne (fun h => hbs h)] + exact hss + obtain ⟨env', wl', hbv, henv', hl', hss', hrun', hres⟩ := + extract_run ss idx ws bs (i + 1) vs' ts fs' (upd env b v) (upd Γ b t) Γ' + (wl.set b x) st hssn hss1 hws' hT' hR' hb (envTy_upd henv hvT) + (lrel_bind hl hbn hvx) + refine ⟨env', wl', by simp [bindVals, hns, hbv], henv', hl', hss', ?_, ?_⟩ + · simp only [extractB, eraseL_append] + rw [run_seq_eq hstep] + exact hrun' + · intro tl st' sv o h + exact res_of_upd (envTy_free henv hΓb) (hres tl st' sv o h) + · cases hb + +/-- A single payload binder (Option / Result), field `i`. -/ +theorem bindOne_run (ss idx i b : Nat) (ws : List WVal) (v : SVal) (t : Ty) (x : WVal) + (env : Nat → Option SVal) (Γ Γ' : Nat → Option Ty) (wl st : List WVal) + (hssn : X.n ≤ ss) (hss : wl[ss]? = some (.structv idx ws)) (hx : ws[i]? = some x) + (hvT : HasTy M v t) (hvx : SRepr S M v x) (hb : bindOne X.n Γ b t = some Γ') + (henv : EnvTy M env Γ) (hl : LRel S M X env wl) : + ∃ env' wl', bindVals env [b] [v] = some env' ∧ EnvTy M env' Γ' ∧ + LRel S M X env' wl' ∧ + wRunF host ar callee (eraseL (bindFieldB ss idx i b)) wl st = some (.ok wl' st) ∧ + (∀ tail st' sv o, Res S M X tail env' st' sv o → Res S M X tail env st' sv o) := by + have hws : ∀ j y, [x][j]? = some y → ws[i + j]? = some y := by + intro j y hy + cases j with + | zero => simp at hy; subst hy; simpa using hx + | succ j => simp at hy + obtain ⟨env', wl', hbv, henv', hl', _, hrun, hres⟩ := + extract_run host ar callee ss idx ws [b] i [v] [t] [x] env Γ Γ' wl st hssn hss hws + ⟨hvT, trivial⟩ ⟨hvx, trivial⟩ hb henv hl + refine ⟨env', wl', hbv, henv', hl', ?_, hres⟩ + simpa [extractB, eraseL_append, eraseL] using hrun + +end Binders + +/-! ## Typing inversions -/ + +section TypingInv +variable {M : MCtx} {n : Nat} {Γ : Nat → Option Ty} {tail : Bool} + +theorem tyOf_litInt_inv {k : Int} {T : Ty} + (h : tyOf M n Γ tail (.literal (.int k)) = some T) : + inI64Band k = true ∧ T = .int := by + simp only [tyOf] at h + split at h <;> simp_all + +theorem tyOf_litBool_inv {v : Bool} {T : Ty} + (h : tyOf M n Γ tail (.literal (.bool v)) = some T) : T = .bool := by + simp only [tyOf, Option.some.injEq] at h + exact h.symm + +theorem tyOf_let_inv {b : Nat} {v body : Expr} {T : Ty} + (h : tyOf M n Γ tail (.let_ b v body) = some T) : + b < n ∧ Γ b = none ∧ ∃ Tv, tyOf M n Γ false v = some Tv ∧ + tyOf M n (upd Γ b Tv) tail body = some T := by + simp only [tyOf] at h + split at h + · rename_i hc + split at h + · rename_i Tv hv + exact ⟨hc.1, hc.2, Tv, hv, h⟩ + · simp at h + · simp at h + +theorem tyOf_callFn_inv {f : Nat} {args : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.call (.fn f) args) = some T) : + ∃ sig, M.sigs f = some sig ∧ tysOf M n Γ args = some sig.params ∧ T = sig.ret := by + simp only [tyOf] at h + split at h + · rename_i sig ts hs hts + split at h + · simp_all + · simp at h + · simp at h + +theorem tyOf_callBuiltin_inv {bi : Builtin} {args : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.call (.builtin bi) args) = some T) : + ∃ ts, tysOf M n Γ args = some ts ∧ builtinTy bi ts = some T := by + simp only [tyOf] at h + split at h + · rename_i ts hts + exact ⟨ts, hts, h⟩ + · simp at h + +theorem tyOf_tailCall_inv {f : Nat} {args : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.tailCall f args) = some T) : + tail = true ∧ ∃ sig, M.sigs f = some sig ∧ tysOf M n Γ args = some sig.params ∧ + T = sig.ret := by + simp only [tyOf] at h + split at h + · rename_i ht + refine ⟨ht, ?_⟩ + split at h + · rename_i sig ts hs hts + split at h + · simp_all + · simp at h + · simp at h + · simp at h + +theorem tyOf_binOp_inv {op : BinOp} {l r : Expr} {T : Ty} + (h : tyOf M n Γ tail (.binOp op l r) = some T) : + (tyOf M n Γ false l = some .int ∧ tyOf M n Γ false r = some .int ∧ + T = if op.isArith then .int else .bool) ∨ + (tyOf M n Γ false l = some .bool ∧ tyOf M n Γ false r = some .bool ∧ + op.isEquality = true ∧ T = .bool) ∨ + (tyOf M n Γ false l = some .float ∧ tyOf M n Γ false r = some .float ∧ + op.isFloatCmp = true ∧ T = .bool) ∨ + (tyOf M n Γ false l = some .string ∧ tyOf M n Γ false r = some .string ∧ + ((op = .add ∧ T = .string) ∨ (op.isStrOp = true ∧ op ≠ .add ∧ T = .bool))) := by + simp only [tyOf] at h + split at h + · rename_i hl hr + left + refine ⟨hl, hr, ?_⟩ + split at h <;> simp_all + · rename_i hl hr + right; left + split at h + · simp_all + · simp at h + · rename_i hl hr + right; right; left + split at h + · simp_all + · simp at h + · rename_i hl hr + right; right; right + refine ⟨hl, hr, ?_⟩ + split at h + · simp_all + · split at h + · rename_i hne hs + simp only [Option.some.injEq] at h + exact Or.inr ⟨hs, hne, h.symm⟩ + · simp at h + · simp at h + +theorem tyOf_neg_inv {e : Expr} {T : Ty} + (h : tyOf M n Γ tail (.neg e) = some T) : tyOf M n Γ false e = some .int ∧ T = .int := by + simp only [tyOf] at h + split at h <;> simp_all + +theorem tyOf_ite_inv {c t e : Expr} {T : Ty} + (h : tyOf M n Γ tail (.ifThenElse c t e) = some T) : + tyOf M n Γ false c = some .bool ∧ tyOf M n Γ tail t = some T ∧ + tyOf M n Γ tail e = some T := by + simp only [tyOf] at h + split at h + · split at h <;> simp_all + · simp at h + +theorem tyOf_rec_inv {tid : Nat} {fs : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.recordCreate tid fs) = some T) : + ∃ fts, M.recFields tid = some fts ∧ tysOf M n Γ fs = some fts ∧ 2 ≤ fts.length ∧ + T = .record tid := by + simp only [tyOf] at h + split at h + · rename_i fts ts hR hts + split at h + · rename_i hc + simp only [Option.some.injEq] at h + exact ⟨fts, hR, hc.2 ▸ hts, hc.1, h.symm⟩ + · simp at h + · simp at h + +theorem tyOf_proj_inv {tid i : Nat} {base : Expr} {T : Ty} + (h : tyOf M n Γ tail (.project tid i base) = some T) : + tyOf M n Γ false base = some (.record tid) ∧ + ∃ fts, M.recFields tid = some fts ∧ 2 ≤ fts.length ∧ fts[i]? = some T := by + simp only [tyOf] at h + split at h + · rename_i tid' fts hb hR + split at h + · rename_i hc + obtain ⟨rfl, h2⟩ := hc + exact ⟨hb, fts, hR, h2, h⟩ + · simp at h + · simp at h + +theorem tysOf_cons_inv {e : Expr} {es : List Expr} {Ts : List Ty} + (h : tysOf M n Γ (e :: es) = some Ts) : + ∃ t ts, tyOf M n Γ false e = some t ∧ tysOf M n Γ es = some ts ∧ Ts = t :: ts := by + simp only [tysOf] at h + split at h <;> simp_all + +theorem tysOf_length : ∀ {es : List Expr} {ts : List Ty}, tysOf M n Γ es = some ts → + ts.length = es.length + | [], ts, h => by simp [tysOf] at h; subst h; rfl + | e :: es, ts, h => by + obtain ⟨t, ts', _, hts, rfl⟩ := tysOf_cons_inv h + simp [tysOf_length hts] + +theorem tyOf_lazy_inv {lb : LazyBuiltin} {o d : Expr} {T : Ty} + (h : tyOf M n Γ tail (.call (.lazy lb) [o, d]) = some T) : + (vecGetOr? lb o d = none ∧ divOr? lb o d = none ∧ ∃ to td, tyOf M n Γ false o = some to ∧ + tyOf M n Γ false d = some td ∧ lazyTy lb to td = some T) ∨ + (∃ v i t, vecGetOr? lb o d = some (v, i) ∧ Γ v = some (.vec t) ∧ Γ i = some .int ∧ + tyOf M n Γ false d = some t ∧ T = t) ∨ + (vecGetOr? lb o d = none ∧ ∃ m a b, divOr? lb o d = some (m, a, b) ∧ + tyOf M n Γ false a = some .int ∧ tyOf M n Γ false b = some .int ∧ + tyOf M n Γ false d = some .int ∧ T = .int) := by + simp only [tyOf] at h + split at h + · rename_i v i hvg + right; left + split at h + · rename_i t td hv hi hd + split at h + · rename_i htd + subst htd + simp only [Option.some.injEq] at h + exact ⟨v, i, td, hvg, hv, hi, hd, h.symm⟩ + · simp at h + · simp at h + · rename_i hvg + split at h + · rename_i p hdg + right; right + obtain ⟨m, a, b⟩ := p + obtain ⟨_, ho, _⟩ := divOr?_some hdg + split at h + · rename_i hc + obtain ⟨hops, hd⟩ := hc + simp only [Option.some.injEq] at h + rw [ho] at hops + simp only [tyDivOperands, tysOf] at hops + refine ⟨hvg, m, a, b, hdg, ?_, ?_, hd, h.symm⟩ + · cases ha : tyOf M n Γ false a <;> cases hb : tyOf M n Γ false b <;> + simp only [ha, hb] at hops <;> (try cases hops) + rename_i ta tb + cases ta <;> cases tb <;> simp_all + · cases ha : tyOf M n Γ false a <;> cases hb : tyOf M n Γ false b <;> + simp only [ha, hb] at hops <;> (try cases hops) + rename_i ta tb + cases ta <;> cases tb <;> simp_all + · cases h + · rename_i hdg + left + refine ⟨hvg, hdg, ?_⟩ + split at h + · rename_i to td ho hd + exact ⟨to, td, ho, hd, h⟩ + · simp at h + +theorem tyOf_intrinsic_inv {ie : Intrinsic} {args : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.call (.intrinsic ie) args) = some T) : + ∃ a k, args = [a, .literal (.int k)] ∧ k ≠ 0 ∧ inI64Band k = true ∧ + tyOf M n Γ false a = some .int ∧ T = .int := by + rcases args with _ | ⟨a, _ | ⟨dv, _ | ⟨e3, rest⟩⟩⟩ + · simp [tyOf] at h + · simp [tyOf] at h + · simp only [tyOf] at h + cases hdv : divisorLit? dv with + | none => simp [hdv] at h + | some k => + cases ha : tyOf M n Γ false a with + | none => simp [hdv, ha] at h + | some ta => + cases ta <;> simp [hdv, ha] at h + subst h + unfold divisorLit? at hdv + split at hdv + · rename_i k' + split at hdv + · rename_i hc + simp only [Option.some.injEq] at hdv + subst hdv + exact ⟨a, k', rfl, hc.1, hc.2, ha, rfl⟩ + · cases hdv + · cases hdv + · simp [tyOf] at h + +theorem tyOf_litFloat_inv {bits : UInt64} {T : Ty} + (h : tyOf M n Γ tail (.literal (.float bits)) = some T) : T = .float := by + simp only [tyOf, Option.some.injEq] at h + exact h.symm + +theorem tyOf_litStr_inv {bytes : List Nat} {T : Ty} + (h : tyOf M n Γ tail (.literal (.str bytes)) = some T) : T = .string := by + simp only [tyOf, Option.some.injEq] at h + exact h.symm + +theorem tyOf_interp_inv {parts : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.interp parts) = some T) : + ∃ ts, tysOf M n Γ parts = some ts ∧ allStr ts = true ∧ T = .string := by + simp only [tyOf] at h + split at h + · rename_i ts hts + split at h + · rename_i ha + simp only [Option.some.injEq] at h + exact ⟨ts, hts, ha, h.symm⟩ + · simp at h + · simp at h + +theorem tyOf_list_inv {t : Ty} {items : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.list t items) = some T) : items = [] ∧ T = .list t := by + simp only [tyOf] at h + split at h + · simp only [Option.some.injEq] at h + exact ⟨rfl, h.symm⟩ + · simp at h + +theorem tyOf_construct_inv {c : CtorTag} {ty : Ty} {args : List Expr} {T : Ty} + (h : tyOf M n Γ tail (.construct c ty args) = some T) : + ∃ ts, tysOf M n Γ args = some ts ∧ ctorTy M c ty ts = some T := by + simp only [tyOf] at h + split at h + · rename_i ts hts + exact ⟨ts, hts, h⟩ + · simp at h + +theorem tyOf_match_inv {s : Expr} {arms : Arms} {T : Ty} + (h : tyOf M n Γ tail (.match_ s arms) = some T) : + ∃ Ts, tyOf M n Γ false s = some Ts ∧ + ((Ts = .int ∧ arms.firstLit = true ∧ tyIntArms M n Γ tail arms = some T) ∨ + (Ts = .bool ∧ tyBoolArms M n Γ tail arms = some T) ∨ + (∃ t, Ts = .option t ∧ tyOptArms M n Γ tail t arms = some T) ∨ + (∃ t e, Ts = .result t e ∧ tyResArms M n Γ tail t e arms = some T) ∨ + (∃ tid, Ts = .sum tid ∧ sumOk M tid = true ∧ varExhaustive M tid arms = true ∧ + 2 ≤ arms.length ∧ tyVarArms M n Γ tail tid arms = some T) ∨ + (Ts = .string ∧ tyStrArms M n Γ tail arms = some T) ∨ + (∃ tid, Ts = .record tid ∧ tyTupArms M n Γ tail tid arms = some T)) := by + simp only [tyOf] at h + split at h + · rename_i hs + split at h + · rename_i hfl + exact ⟨_, hs, Or.inl ⟨rfl, hfl, h⟩⟩ + · cases h + · rename_i hs + exact ⟨_, hs, Or.inr (Or.inl ⟨rfl, h⟩)⟩ + · rename_i t hs + exact ⟨_, hs, Or.inr (Or.inr (Or.inl ⟨t, rfl, h⟩))⟩ + · rename_i t e hs + exact ⟨_, hs, Or.inr (Or.inr (Or.inr (Or.inl ⟨t, e, rfl, h⟩)))⟩ + · rename_i tid hs + split at h + · rename_i hc + obtain ⟨h1, h2, h3⟩ := hc + exact ⟨_, hs, Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨tid, rfl, h1, h2, h3, h⟩))))⟩ + · cases h + · rename_i hs + exact ⟨_, hs, Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨rfl, h⟩)))))⟩ + · rename_i tid hs + exact ⟨_, hs, Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr ⟨tid, rfl, h⟩)))))⟩ + · cases h + +end TypingInv + +theorem litInt?_some {e : Expr} {k : Int} (h : litInt? e = some k) : e = .literal (.int k) := by + unfold litInt? at h + split at h <;> simp_all + +theorem slot?_some {e : Expr} {i : Nat} (h : slot? e = some i) : e = .local i := by + unfold slot? at h + split at h <;> simp_all + +/-! ## Match shapes: first-match meaning of the admitted arm shapes -/ + +theorem lowerIntArms_firstLit (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) + (sc : List BI) (bt : Option Ty) {arms : Arms} (h : arms.firstLit = true) : + ∃ ys, lowerIntArms M X Γ tail sc bt arms = sc ++ ys := by + cases arms with + | nil => simp [Arms.firstLit] at h + | cons p b rest => + cases p <;> simp [Arms.firstLit] at h + exact ⟨_, rfl⟩ + +theorem ctorFields_lt {M : MCtx} {tid c : Nat} {fts : List Ty} + (h : ctorFields M tid c = some fts) : + ∃ cs, M.sumCtors tid = some cs ∧ c < cs.length := by + unfold ctorFields at h + cases hs : M.sumCtors tid with + | none => simp [hs] at h + | some cs => + refine ⟨cs, rfl, ?_⟩ + simp only [hs, Option.bind_some] at h + rcases Nat.lt_or_ge c cs.length with hc | hc + · exact hc + · rw [List.getElem?_eq_none hc] at h; cases h + +/-- `sumOk` makes the constructor struct indices of one sum pairwise + distinct, so the interpreter's exact `ref.test` separates them. -/ +theorem sumOk_inj {M : MCtx} {tid a b : Nat} {fa fb : List Ty} (hok : sumOk M tid = true) + (ha : ctorFields M tid a = some fa) (hb : ctorFields M tid b = some fb) + (h : M.ctorStruct tid a = M.ctorStruct tid b) : a = b := by + obtain ⟨cs, hcs, hal⟩ := ctorFields_lt ha + obtain ⟨cs', hcs', hbl⟩ := ctorFields_lt hb + rw [hcs] at hcs' + cases hcs' + unfold sumOk at hok + rw [hcs] at hok + simp only [Bool.and_eq_true, List.all_eq_true, List.mem_range] at hok + have := hok.2 a hal b hbl + simpa [h] using this + +theorem varExhaustive_covers {M : MCtx} {tid c : Nat} {arms : Arms} {fts : List Ty} + (hex : varExhaustive M tid arms = true) (hc : ctorFields M tid c = some fts) : + coversB c arms = true := by + obtain ⟨cs, hcs, hcl⟩ := ctorFields_lt hc + unfold varExhaustive at hex + rw [hcs] at hex + simp only [List.all_eq_true, List.mem_range] at hex + exact hex c hcl + +theorem optPick_spec {p1 p2 : Pat} {swap : Bool} {sb : Nat} + (h : optPick p1 p2 = some (swap, sb)) : + (swap = false ∧ p1 = .ctor .some [sb] ∧ (p2 = .ctor .none [] ∨ p2 = .wild)) ∨ + (swap = true ∧ p1 = .ctor .none [] ∧ + (p2 = .ctor .some [sb] ∨ (p2 = .wild ∧ sb = noSlot))) := by + unfold optPick at h + split at h <;> simp_all + +theorem resPick_spec {p1 p2 : Pat} {swap : Bool} {ob eb : Nat} + (h : resPick p1 p2 = some (swap, ob, eb)) : + (swap = false ∧ p1 = .ctor .ok [ob] ∧ + (p2 = .ctor .err [eb] ∨ (p2 = .wild ∧ eb = noSlot))) ∨ + (swap = true ∧ p1 = .ctor .err [eb] ∧ + (p2 = .ctor .ok [ob] ∨ (p2 = .wild ∧ ob = noSlot))) := by + unfold resPick at h + split at h <;> simp_all + +section ShapeEval +variable (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) + +/-- The Option shapes pick the `Some` arm for a `Some` value, binding `sb`. -/ +theorem evalOpt_some {p1 p2 : Pat} {b1 b2 : Expr} {swap : Bool} {sb : Nat} {t : Ty} + {x : SVal} (h : optPick p1 p2 = some (swap, sb)) : + evalArms F env (.some t x) (.cons p1 b1 (.cons p2 b2 .nil)) = + match bindVals env [sb] [x] with + | some env' => eval F env' (if swap then b2 else b1) + | none => none := by + rcases optPick_spec h with ⟨rfl, rfl, rfl | rfl⟩ | ⟨rfl, rfl, rfl | ⟨rfl, rfl⟩⟩ <;> + simp [evalArms, patMatch, bindVals, noSlot] <;> rfl + +theorem evalOpt_none {p1 p2 : Pat} {b1 b2 : Expr} {swap : Bool} {sb : Nat} {t : Ty} + (h : optPick p1 p2 = some (swap, sb)) : + evalArms F env (.none t) (.cons p1 b1 (.cons p2 b2 .nil)) = + eval F env (if swap then b1 else b2) := by + rcases optPick_spec h with ⟨rfl, rfl, rfl | rfl⟩ | ⟨rfl, rfl, rfl | ⟨rfl, rfl⟩⟩ <;> + simp [evalArms, patMatch, bindVals] + +theorem evalRes_ok {p1 p2 : Pat} {b1 b2 : Expr} {swap : Bool} {ob eb : Nat} {t e : Ty} + {x : SVal} (h : resPick p1 p2 = some (swap, ob, eb)) : + evalArms F env (.ok t e x) (.cons p1 b1 (.cons p2 b2 .nil)) = + match bindVals env [ob] [x] with + | some env' => eval F env' (if swap then b2 else b1) + | none => none := by + rcases resPick_spec h with ⟨rfl, rfl, rfl | ⟨rfl, rfl⟩⟩ | ⟨rfl, rfl, rfl | ⟨rfl, rfl⟩⟩ <;> + simp [evalArms, patMatch, bindVals, noSlot] <;> rfl + +theorem evalRes_err {p1 p2 : Pat} {b1 b2 : Expr} {swap : Bool} {ob eb : Nat} {t e : Ty} + {x : SVal} (h : resPick p1 p2 = some (swap, ob, eb)) : + evalArms F env (.err t e x) (.cons p1 b1 (.cons p2 b2 .nil)) = + match bindVals env [eb] [x] with + | some env' => eval F env' (if swap then b1 else b2) + | none => none := by + rcases resPick_spec h with ⟨rfl, rfl, rfl | ⟨rfl, rfl⟩⟩ | ⟨rfl, rfl, rfl | ⟨rfl, rfl⟩⟩ <;> + simp [evalArms, patMatch, bindVals, noSlot] <;> rfl + +end ShapeEval + +theorem run_test (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (ss ty t : Nat) (fs : List WVal) (ys : List WInstr) (wl st : List WVal) + (h : wl[ss]? = some (.structv t fs)) : + wRunF host ar callee (.localGet ss :: .refTest ty :: ys) wl st = + wRunF host ar callee ys wl (b32 (t = ty) :: st) := by + simp [wRunF, h] + +theorem run_localSet (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (j : Nat) (w : WVal) (ys : List WInstr) (wl st : List WVal) : + wRunF host ar callee (.localSet j :: ys) wl (w :: st) = + wRunF host ar callee ys (wl.set j w) st := by + simp [wRunF] + +/-! ## Reading back a stashed scratch local + +A scratch local need not exist (`LRel` does not demand it). Every template +that stashes a value reads the scratch back as its very next instruction, and +that read fails on a missing local, so a successful run proves the stash +landed. -/ + +theorem stash_read {host : HostTbl} {ar : Nat → Option Nat} {callee : Callee} + {j : Nat} {w : WVal} {wl st : List WVal} {xs ys : List WInstr} {out : Out} + (hx : xs = .localGet j :: ys) + (h : wRunF host ar callee xs (wl.set j w) st = some out) : + (wl.set j w)[j]? = some w := by + by_cases hj : j < wl.length + · exact List.getElem?_set_self hj + · subst hx + have hn : (wl.set j w)[j]? = none := by + rw [List.getElem?_eq_none] + simp only [List.length_set] + omega + simp [wRunF, hn] at h + +theorem lowerOptArms_head {M : MCtx} {X : LCtx} {Γ : Nat → Option Ty} {tail : Bool} + {bt : Option Ty} {t : Ty} {arms : Arms} {T : Ty} + (h : tyOptArms M X.n Γ tail t arms = some T) : + ∃ ys, eraseL (lowerOptArms M X Γ tail bt t arms) = .localGet X.subj :: ys := by + match arms, h with + | .nil, h => simp [tyOptArms] at h + | .cons _ _ .nil, h => simp [tyOptArms] at h + | .cons _ _ (.cons _ _ (.cons _ _ _)), h => simp [tyOptArms] at h + | .cons p1 b1 (.cons p2 b2 .nil), h => + simp only [tyOptArms] at h + cases hpk : optPick p1 p2 with + | none => simp [hpk] at h + | some pr => + obtain ⟨swap, sb⟩ := pr + cases swap <;> simp [lowerOptArms, hpk, tagTestB, eraseL, eraseI] + +theorem lowerResArms_head {M : MCtx} {X : LCtx} {Γ : Nat → Option Ty} {tail : Bool} + {bt : Option Ty} {t e : Ty} {arms : Arms} {T : Ty} + (h : tyResArms M X.n Γ tail t e arms = some T) : + ∃ ys, eraseL (lowerResArms M X Γ tail bt t e arms) = .localGet X.subj :: ys := by + match arms, h with + | .nil, h => simp [tyResArms] at h + | .cons _ _ .nil, h => simp [tyResArms] at h + | .cons _ _ (.cons _ _ (.cons _ _ _)), h => simp [tyResArms] at h + | .cons p1 b1 (.cons p2 b2 .nil), h => + simp only [tyResArms] at h + cases hpk : resPick p1 p2 with + | none => simp [hpk] at h + | some pr => + obtain ⟨swap, ob, eb⟩ := pr + cases swap <;> simp [lowerResArms, hpk, tagTestB, eraseL, eraseI] + +theorem lowerVarArms_head {M : MCtx} {X : LCtx} {Γ : Nat → Option Ty} {tail : Bool} + {bt : Option Ty} {tid : Nat} {arms : Arms} {T : Ty} + (h : tyVarArms M X.n Γ tail tid arms = some T) (hlen : 2 ≤ arms.length) : + ∃ ys, eraseL (lowerVarArms M X Γ tail bt tid arms) = .localGet X.subj :: ys := by + match arms, h, hlen with + | .nil, _, hlen => simp [Arms.length] at hlen + | .cons _ _ .nil, _, hlen => simp [Arms.length] at hlen + | .cons p b (.cons p' b' r), h, _ => + simp only [tyVarArms] at h + cases p with + | ctor cc bs => + cases cc with + | user tid' c => simp [lowerVarArms, eraseL, eraseI] + | _ => simp [Pat.isWild, varArmΓ] at h + | _ => simp [Pat.isWild, varArmΓ] at h + +/-! ## S-3: the exact `ref.test` on constructor structs is the wasm test + +`declaredFinal` / `inRecGroup` read the pinned rec-group entries through the +binary format (`subtype ::= 0x4f vec(typeidx) comptype` is `sub final`). +`GcTestSpec` states the two wasm GC facts the argument uses: subtyping is +reflexive, and a type declared final has no subtype in its own rec group +other than itself (validation rejects a `sub` naming a final type, and +distinct positions of one rec group are distinct types under iso-recursive +equivalence). Under `S3Pin`, the interpreter's `t = ty` and the wasm +`t <: ty` agree on every pair of constructor structs of one sum, which are +the only pairs a typed cascade tests. -/ + +def declaredFinal (entries : List (List Nat)) (idx : Nat) : Prop := + ∃ e, entries[idx]? = some e ∧ e.head? = some 0x4f + +def inRecGroup (entries : List (List Nat)) (idx : Nat) : Prop := + idx < entries.length + +structure GcTestSpec (entries : List (List Nat)) (sub : Nat → Nat → Prop) : Prop where + refl : ∀ t, sub t t + final_sub : ∀ t ty, inRecGroup entries t → inRecGroup entries ty → + declaredFinal entries ty → sub t ty → t = ty + +theorem s3Pin_facts {M : MCtx} {tid ncs : Nat} {entries : List (List Nat)} + (h : S3Pin M tid ncs entries = true) {c : Nat} (hc : c < ncs) : + declaredFinal entries (M.ctorStruct tid c) ∧ inRecGroup entries (M.ctorStruct tid c) := by + unfold S3Pin at h + simp only [List.all_eq_true, List.mem_range] at h + have hc' := h c hc + split at hc' + · rename_i e hd he hh + refine ⟨⟨e, he, ?_⟩, ?_⟩ + · unfold ctorEntryHeader at hh + cases hu : uleb32 (M.sumRoot tid) with + | none => simp [hu] at hh + | some u => + simp only [hu, Option.map_some, Option.some.injEq] at hh + subst hh + cases e with + | nil => simp [List.isPrefixOf] at hc' + | cons x xs => + simp only [List.cons_append, List.isPrefixOf, Bool.and_eq_true, beq_iff_eq] at hc' + simp [hc'.1] + · rcases Nat.lt_or_ge (M.ctorStruct tid c) entries.length with hl | hl + · exact hl + · rw [List.getElem?_eq_none hl] at he; cases he + · cases hc' + +/-- Under the pin, the interpreter's exact `ref.test` on two constructors of + one sum is the wasm subtype test. -/ +theorem ctor_refTest_exact {M : MCtx} {tid ncs : Nat} {entries : List (List Nat)} + {sub : Nat → Nat → Prop} (hspec : GcTestSpec entries sub) + (hpin : S3Pin M tid ncs entries = true) {a b : Nat} (ha : a < ncs) (hb : b < ncs) : + M.ctorStruct tid a = M.ctorStruct tid b ↔ sub (M.ctorStruct tid a) (M.ctorStruct tid b) := by + obtain ⟨_, hga⟩ := s3Pin_facts hpin ha + obtain ⟨hfb, hgb⟩ := s3Pin_facts hpin hb + exact ⟨fun h => h ▸ hspec.refl _, hspec.final_sub _ _ hga hgb hfb⟩ + + +/-! ## Euclidean division: the intrinsic and the fused guarded form -/ + +/-- The zero test of the divisor on its carrier word (`$magf` null and + `$small == 0`) is exactly `y = 0` on any represented word: a Small word + carries its value, and a limb-carrying word is never zero. -/ +theorem divZeroTest_run {C : Nat} {S : CarrierSpec C} (host : HostTbl) + (ar : Nat → Option Nat) (callee : Callee) (j : Nat) (y : Int) (wb : WVal) + (hb : S.Repr y wb) (ys : List WInstr) (wl st : List WVal) (hj : wl[j]? = some wb) : + wRunF host ar callee (.localGet j :: .structGet C 1 :: .refIsNull :: .localGet j :: + .structGet C 0 :: .i64Eqz :: .i32And :: ys) wl st = + wRunF host ar callee ys wl (b32 (decide (y = 0)) :: st) := by + rcases S.car y wb hb with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ + · have := S.smallElim y s sg hb + subst this + by_cases h0 : s = 0 <;> simp [wRunF, hj, b32, h0] + · have hne := (S.bigElim y s lty les sg hb).2 + by_cases h0 : s = 0 <;> simp [wRunF, hj, b32, hne, h0] + +/-- The fused guarded division after its three operands: the default when + the divisor is zero, else the helper's Euclidean quotient / remainder. -/ +theorem divOr_run {C : Nat} {S : CarrierSpec C} {M : MCtx} {host : HostTbl} + (hCarrier : M.carrier = C) (R : XHost S M host) + (ar : Nat → Option Nat) (callee : Callee) (X : LCtx) (isMod : Bool) + (x y k : Int) (wa wb wd : WVal) (ha : CanonRepr S x wa) (hb : CanonRepr S y wb) + (hd : CanonRepr S k wd) (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee (eraseL (divOrB M X isMod)) wl (wd :: wb :: wa :: st) = + some out) : + ∃ w, out = .ok (((wl.set (X.cmp + 3) wd).set (X.cmp + 2) wb).set (X.cmp + 1) wa) + (w :: st) ∧ + CanonRepr S (if y = 0 then k else if isMod then x % y else x / y) w := by + obtain ⟨g, hg, hgc⟩ := R.divmod + subst hCarrier + simp only [divOrB, eraseL, eraseI] at hrun + rw [run_localSet, run_localSet, run_localSet] at hrun + generalize hwl' : ((wl.set (X.cmp + 3) wd).set (X.cmp + 2) wb).set (X.cmp + 1) wa = wl' at hrun + by_cases h2 : X.cmp + 2 < wl.length + · have g2 : wl'[X.cmp + 2]? = some wb := by + subst hwl'; simp [List.getElem?_set, h2] + have g1 : wl'[X.cmp + 1]? = some wa := by + subst hwl'; simp [List.getElem?_set]; omega + rw [divZeroTest_run host ar callee (X.cmp + 2) y wb hb.1 _ wl' st g2] at hrun + simp only [b32] at hrun + by_cases hy : y = 0 + · simp only [hy, decide_true, ↓reduceIte] at hrun + rw [wRunF_ifElse_single] at hrun + simp only [Int.one_ne_zero, ↓reduceIte] at hrun + by_cases h3 : X.cmp + 3 < wl.length + · have g3 : wl'[X.cmp + 3]? = some wd := by + subst hwl'; simp [List.getElem?_set, h3] + simp [wRunF, g3] at hrun + subst hrun + exact ⟨wd, rfl, by simpa [hy] using hd⟩ + · have g3 : wl'[X.cmp + 3]? = none := by + subst hwl'; simp [List.getElem?_set]; omega + simp [wRunF, g3] at hrun + · simp only [hy, decide_false, Bool.false_eq_true, ↓reduceIte] at hrun + rw [wRunF_ifElse_single, if_pos rfl] at hrun + cases hr : g [wa, wb, .i32v (if isMod then 1 else 0)] with + | none => simp [wRunF, g1, g2, hg, popArgs_three, hr] at hrun + | some r => + simp [wRunF, g1, g2, hg, popArgs_three, hr] at hrun + subst hrun + have hc := hgc x y wa wb _ r ha hb hy (by cases isMod <;> simp) hr + refine ⟨r, rfl, ?_⟩ + cases isMod <;> simpa [hy] using hc + · have g2 : wl'[X.cmp + 2]? = none := by + subst hwl'; simp [List.getElem?_set]; omega + simp [wRunF, g2] at hrun + +/-- A Euclidean intrinsic after its two operands. -/ +theorem intrinsic_run {C : Nat} {S : CarrierSpec C} {M : MCtx} {host : HostTbl} + (R : XHost S M host) (ar : Nat → Option Nat) (callee : Callee) (ie : Intrinsic) + (x y : Int) (hy : y ≠ 0) (wa wb : WVal) (ha : CanonRepr S x wa) (hb : CanonRepr S y wb) + (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee [.i32Const ie.flag, .call M.divmod] wl (wb :: wa :: st) = + some out) : + ∃ w sv, intrinsicEval ie [.i x, .i y] = some sv ∧ out = .ok wl (w :: st) ∧ + SRepr S M sv w := by + obtain ⟨g, hg, hgc⟩ := R.divmod + cases hr : g [wa, wb, .i32v ie.flag] with + | none => simp [wRunF, hg, popArgs_three, hr] at hrun + | some r => + simp [wRunF, hg, popArgs_three, hr] at hrun + subst hrun + have hc := hgc x y wa wb _ r ha hb hy (by cases ie <;> simp [Intrinsic.flag]) hr + cases ie + · exact ⟨r, .i (x / y), by simp [intrinsicEval, hy], rfl, by + simpa [SRepr, Intrinsic.flag] using hc⟩ + · exact ⟨r, .i (x % y), by simp [intrinsicEval, hy], rfl, by + simpa [SRepr, Intrinsic.flag] using hc⟩ + +/-! ## The agreement theorem + +ONE statement, by induction on the size of the grammar term (jointly with +the nested argument lists and the arm shapes). The context fixes: the carrier specification and the named +host contracts at their indices, an arbitrary opaque `callee`, and a +`Contract` for every callee the typing admits. -/ + +section Agreement +variable {C : Nat} (S : CarrierSpec C) + (box add sub mul cmp eq neg : List WVal → Option WVal) + (Ctr : Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, CanonRepr S x w → neg [w] = some r → + CanonRepr S (-x) r) + (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) (M : MCtx) + (hCarrier : M.carrier = C) + (hBox : host M.box = some (1, box)) (hAdd : host M.add = some (2, add)) + (hSub : host M.sub = some (2, sub)) (hMul : host M.mul = some (2, mul)) + (hNeg : host M.neg = some (1, neg)) + (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) + (R : XHost S M host) + (F : Nat → List SVal → Option SVal) + (hCallees : ∀ f sig, M.sigs f = some sig → + Contract S M host ar callee f sig (F f)) + (X : LCtx) +include Ctr hNegC hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R hCallees + +set_option hygiene false in +/-- The size side condition of a recursive call in the agreement proofs: the + argument is a strict part of the one the enclosing case matched, whose + bound the case's `hsz` states. -/ +macro "agreement_size" : tactic => + `(tactic| first + | omega + | (simp at hsz ⊢; omega)) + +/-! The recursion of the agreement theorems is a strong induction on a size +bound: each theorem's cases form a non-recursive step over hypotheses that +answer every strictly smaller argument, and one induction on the bound joins +the steps. The theorems keep their statements. A step need not use every +hypothesis it is given. -/ +set_option linter.unusedVariables false + +section Steps +variable (n : Nat) + (agreement : + ∀ (e : Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out), + tyOf M X.n Γ tail e = some T → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerW M X Γ tail e) wl st = some out → + (_ : sizeOf e < n := by agreement_size) → + ∃ sv, eval F env e = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) + (agreementArgs : + ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) + (wl st : List WVal) (out : Out), + tysOf M X.n Γ es = some Ts → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerArgsW M X Γ es) wl st = some out → + (_ : sizeOf es < n := by agreement_size) → + ∃ svs ws wl', out = .ok wl' (ws.reverse ++ st) ∧ + evalArgs F env es = some svs ∧ HasTyL M svs Ts ∧ + SReprL S M svs ws ∧ LRel S M X env wl') + (agreementIntArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (sc : List BI) (bt : Option Ty) (x : Int), + (∀ wl0 st0 out0, LRel S M X env wl0 → + wRunF host ar callee (eraseL sc) wl0 st0 = some out0 → + ∃ wl1 w, out0 = .ok wl1 (w :: st0) ∧ CanonRepr S x w ∧ + LRel S M X env wl1) → + tyIntArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerIntArms M X Γ tail sc bt arms)) wl st = some out → + (_ : sizeOf arms < n := by agreement_size) → + ∃ sv, evalArms F env (.i x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) + (agreementBoolArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : Bool), + tyBoolArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerBoolArms M X Γ tail bt arms)) wl (b32 x :: st) = + some out → + (_ : sizeOf arms < n := by agreement_size) → + ∃ sv, evalArms F env (.b x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) + (agreementOptArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.option t) → + tyOptArms M X.n Γ tail t arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerOptArms M X Γ tail bt t arms)) wl st = some out → + (_ : sizeOf arms < n := by agreement_size) → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out) + (agreementResArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t e : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.result t e) → + tyResArms M X.n Γ tail t e arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerResArms M X Γ tail bt t e arms)) wl st = some out → + (_ : sizeOf arms < n := by agreement_size) → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out) + (agreementVarArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (tid cv : Nat) (fs : List SVal) + (ws : List WVal) (fts : List Ty), + wl[X.subj]? = some (.structv (M.ctorStruct tid cv) ws) → + SReprL S M fs ws → ctorFields M tid cv = some fts → HasTyL M fs fts → + coversB cv arms = true → + (∀ c fc, ctorFields M tid c = some fc → M.ctorStruct tid c = M.ctorStruct tid cv → + c = cv) → + tyVarArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerVarArms M X Γ tail bt tid arms)) wl st = some out → + (_ : sizeOf arms < n := by agreement_size) → + ∃ sv, evalArms F env (.variant tid cv fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) + (agreementStrArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : List Nat), + ((∃ k b r, arms = .cons (.litStr k) b r) → wl[X.subj]? = some (strW M x)) → + tyStrArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerStrArms M X Γ tail bt arms)) wl st = some out → + (_ : sizeOf arms < n := by agreement_size) → + ∃ sv, evalArms F env (.s x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) + (agreementTupArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (tid : Nat) (fs : List SVal) (ws : List WVal) + (fts : List Ty), + wl[X.subj]? = some (.structv (M.structOf tid) ws) → + SReprL S M fs ws → M.recFields tid = some fts → HasTyL M fs fts → + tyTupArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerTupArms M X Γ tail tid arms)) wl st = some out → + (_ : sizeOf arms < n := by agreement_size) → + ∃ sv, evalArms F env (.record tid fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) +include agreement agreementArgs agreementIntArms agreementBoolArms agreementOptArms agreementResArms agreementVarArms agreementStrArms agreementTupArms + +theorem agreement_step : + ∀ (e : Expr) (hsz : sizeOf e < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out), + tyOf M X.n Γ tail e = some T → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerW M X Γ tail e) wl st = some out → + ∃ sv, eval F env e = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + | .literal (.int k), hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨hband, rfl⟩ := tyOf_litInt_inv hty + have hk : -(2 ^ 63 : Int) ≤ k ∧ k < 2 ^ 63 := by + simpa [inI64Band, Bool.and_eq_true, decide_eq_true_eq] using hband + cases hb : box [.i64v k] with + | none => simp [lowerW, lowerB, eraseL, eraseI, wRunF, hBox, popArgs, hb] at hrun + | some r => + simp [lowerW, lowerB, eraseL, eraseI, wRunF, hBox, popArgs, hb] at hrun + subst hrun + refine ⟨.i k, by simp [eval], by simp [HasTy], res_ok ?_ hl⟩ + simp only [SRepr] + exact Ctr.hBox k r hk.1 hk.2 hb + | .literal (.bool v), hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + have hT := tyOf_litBool_inv hty + subst hT + simp [lowerW, lowerB, eraseL, eraseI, wRunF] at hrun + subst hrun + exact ⟨.b v, by simp [eval], by simp [HasTy], res_ok (by simp [SRepr, b32]) hl⟩ + | .literal (.float bits), hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + have hT := tyOf_litFloat_inv hty + subst hT + simp [lowerW, lowerB, eraseL, eraseI, wRunF] at hrun + subst hrun + exact ⟨.f bits, by simp [eval], by simp [HasTy], res_ok (by simp [SRepr]) hl⟩ + | .literal (.str bytes), hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + have hT := tyOf_litStr_inv hty + subst hT + simp [lowerW, lowerB, strLitB, eraseL, eraseI, wRunF] at hrun + subst hrun + refine ⟨.s bytes, by simp [eval], by simp [HasTy], res_ok ?_ hl⟩ + simp [SRepr, strW, Function.comp_def] + | .local i, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + simp only [tyOf] at hty + obtain ⟨sv, hsv, hT⟩ := envTy_get henv hty + obtain ⟨_, w, hw, hrep⟩ := hl.2 i sv hsv + simp [lowerW, lowerB, eraseL, eraseI, wRunF, hw] at hrun + subst hrun + exact ⟨sv, by simp [eval, hsv], hT, res_ok hrep hl⟩ + | .let_ b v body, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨hbn, hΓb, Tv, htv, htb⟩ := tyOf_let_inv hty + simp only [lowerW, lowerB, htv, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := agreement v Γ env false Tv wl st o1 htv henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append, wRunF] at hseq + have henv' : EnvTy M (upd env b sv1) (upd Γ b Tv) := envTy_upd henv hT1 + have hl' := lrel_bind hl1 hbn hw1 + obtain ⟨sv, hev, hT, hres⟩ := + agreement body (upd Γ b Tv) (upd env b sv1) tail T (wl1.set b w1) st out htb henv' hl' + hseq + have hfree := envTy_free henv hΓb + exact ⟨sv, by simp [eval, hev1, hev], hT, res_of_upd hfree hres⟩ + | .call (.fn f) args, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨sig, hsig, hts, rfl⟩ := tyOf_callFn_inv hty + obtain ⟨hhost, har, hspec⟩ := hCallees f sig hsig + simp only [lowerW, lowerB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env sig.params wl st o1 hts henv hl h1 + have hlen : sig.params.length = ws.length := by + rw [← hasTyL_length hTs, sreprL_length hrep] + simp only [seqOut, eraseL, eraseI] at hseq + cases hr : callee f ws with + | none => simp [wRunF, hhost, har, hlen, popArgs_rev, hr] at hseq + | some r => + simp [wRunF, hhost, har, hlen, popArgs_rev, hr] at hseq + subst hseq + obtain ⟨sv, hm, hsv, hT⟩ := hspec svs ws r hTs hrep hr + exact ⟨sv, by simp [eval, hevs, hm], hT, res_ok hsv hl1⟩ + | .call (.builtin bi) args, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨ts, hts, hbt⟩ := tyOf_callBuiltin_inv hty + simp only [lowerW, lowerB, eraseL_append, hts] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env ts wl st o1 hts henv hl h1 + simp only [seqOut] at hseq + obtain ⟨sv, w, hbe, hT, hsw, rfl⟩ := + builtin_step host ar callee bi ts T hbt svs ws hTs hrep wl1 st out hseq + exact ⟨sv, by simp [eval, hevs, hbe], hT, res_ok hsw hl1⟩ + | .call (.intrinsic ie) args, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨a, k, rfl, hk0, hband, hta, rfl⟩ := tyOf_intrinsic_inv hty + simp only [lowerW, lowerB, lowerArgsB, eraseL_append, List.append_nil, + List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sva, heva, hTa, hresa⟩ := agreement a Γ env false .int wl st o1 hta henv hl h1 + obtain ⟨wl1, wa, rfl, hwa, hl1⟩ := res_false hresa + simp only [seqOut] at hseq + obtain ⟨o2, h2, hseq2⟩ := run_split hseq + obtain ⟨svd, hevd, hTd, hresd⟩ := agreement (.literal (.int k)) Γ env false .int wl1 + (wa :: st) o2 (by simp [tyOf, hband]) henv hl1 h2 + obtain ⟨wl2, wd, rfl, hwd, hl2⟩ := res_false hresd + simp only [seqOut, eraseL, eraseI] at hseq2 + obtain ⟨x, rfl⟩ := hasTy_int hTa + simp only [eval, Option.some.injEq] at hevd + subst hevd + obtain ⟨w, sv, hsv, rfl, hw⟩ := intrinsic_run R ar callee ie x k hk0 wa wd + (by simpa [SRepr] using hwa) (by simpa [SRepr] using hwd) wl2 st out hseq2 + refine ⟨sv, by simp [eval, evalArgs, heva, hsv], ?_, res_ok hw hl2⟩ + cases ie <;> simp [intrinsicEval, hk0] at hsv <;> subst hsv <;> simp [HasTy] + | .tailCall f args, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨rfl, sig, hsig, hts, rfl⟩ := tyOf_tailCall_inv hty + obtain ⟨hhost, har, hspec⟩ := hCallees f sig hsig + simp only [lowerW, lowerB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env sig.params wl st o1 hts henv hl h1 + have hlen : sig.params.length = ws.length := by + rw [← hasTyL_length hTs, sreprL_length hrep] + simp only [seqOut, eraseL, eraseI] at hseq + cases hr : callee f ws with + | none => simp [wRunF, har, hlen, popArgs_rev, hr] at hseq + | some r => + simp [wRunF, har, hlen, popArgs_rev, hr] at hseq + subst hseq + obtain ⟨sv, hm, hsv, hT⟩ := hspec svs ws r hTs hrep hr + exact ⟨sv, by simp [eval, hevs, hm], hT, ⟨rfl, hsv⟩⟩ + | .binOp op l r, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + rcases tyOf_binOp_inv hty with ⟨htl, htr, hT⟩ | ⟨htl, htr, hop, rfl⟩ | + ⟨htl, htr, hop, rfl⟩ | ⟨htl, htr, hsop⟩ + · -- Int operands + simp only [lowerW, lowerB, htl] at hrun + cases hA : op.isArith + · -- a comparison + simp only [hA, Bool.false_eq_true, ↓reduceIte] at hT hrun + subst hT + cases hlk : litInt? l with + | some kk => + have hl0 := litInt?_some hlk + subst hl0 + have hband := (tyOf_litInt_inv htl).1 + simp only [litInt?] at hrun + cases hsr : slot? r with + | some i => + have hr0 := slot?_some hsr + subst hr0 + simp only [slot?, hCarrier] at hrun + simp only [tyOf] at htr + obtain ⟨sv, hsv, hTv⟩ := envTy_get henv htr + obtain ⟨m, rfl⟩ := hasTy_int hTv + obtain ⟨_, w, hw, hrep⟩ := hl.2 i _ hsv + have hout := cmpArm_step S host ar callee op.flip (flip_isArith hA) kk i wl st + m w out hband hw hrep hrun + subst hout + refine ⟨.b (cmpDen op kk m), ?_, by simp [HasTy], res_ok ?_ hl⟩ + · simp [eval, hsv, intBin_cmp hA] + · simp [SRepr, cmpDen_flip] + | none => + simp only [hsr, hCarrier, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement r Γ env false .int wl st o1 htr henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨m, rfl⟩ := hasTy_int hT1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append, + wRunF] at hseq + have hget : (wl1.set X.cmp w1)[X.cmp]? = some w1 := stash_read rfl hseq + have hout := cmpArm_step S host ar callee op.flip (flip_isArith hA) kk X.cmp + (wl1.set X.cmp w1) st m w1 out hband hget hw1 hseq + subst hout + refine ⟨.b (cmpDen op kk m), ?_, by simp [HasTy], + res_ok ?_ (lrel_set_free w1 hl1 hl1.1.1)⟩ + · simp [eval, hev1, intBin_cmp hA] + · simp [SRepr, cmpDen_flip] + | none => + cases hrk : litInt? r with + | some kk => + have hr0 := litInt?_some hrk + subst hr0 + have hband := (tyOf_litInt_inv htr).1 + rw [hlk] at hrun + simp only [litInt?] at hrun + cases hsl : slot? l with + | some i => + have hl0 := slot?_some hsl + subst hl0 + simp only [slot?, hCarrier] at hrun + simp only [tyOf] at htl + obtain ⟨sv, hsv, hTv⟩ := envTy_get henv htl + obtain ⟨m, rfl⟩ := hasTy_int hTv + obtain ⟨_, w, hw, hrep⟩ := hl.2 i _ hsv + have hout := cmpArm_step S host ar callee op hA kk i wl st m w out hband hw + hrep hrun + subst hout + refine ⟨.b (cmpDen op m kk), ?_, by simp [HasTy], res_ok ?_ hl⟩ + · simp [eval, hsv, intBin_cmp hA] + · simp [SRepr] + | none => + simp only [hsl, hCarrier, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement l Γ env false .int wl st o1 htl henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨m, rfl⟩ := hasTy_int hT1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append, + wRunF] at hseq + have hget : (wl1.set X.cmp w1)[X.cmp]? = some w1 := stash_read rfl hseq + have hout := cmpArm_step S host ar callee op hA kk X.cmp (wl1.set X.cmp w1) st m w1 + out hband hget hw1 hseq + subst hout + refine ⟨.b (cmpDen op m kk), ?_, by simp [HasTy], + res_ok ?_ (lrel_set_free w1 hl1 hl1.1.1)⟩ + · simp [eval, hev1, intBin_cmp hA] + · simp [SRepr] + | none => + simp only [hlk, hrk, eraseL_append, eraseL_ops, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sva, heva, hTa, hresa⟩ := + agreement l Γ env false .int wl st o1 htl henv hl h1 + obtain ⟨wl1, wa, rfl, hwa, hl1⟩ := res_false hresa + simp only [seqOut] at hseq + obtain ⟨o2, h2, hseq2⟩ := run_split hseq + obtain ⟨svb, hevb, hTb, hresb⟩ := + agreement r Γ env false .int wl1 (wa :: st) o2 htr henv hl1 h2 + obtain ⟨wl2, wb, rfl, hwb, hl2⟩ := res_false hresb + simp only [seqOut] at hseq2 + obtain ⟨x, rfl⟩ := hasTy_int hTa + obtain ⟨y, rfl⟩ := hasTy_int hTb + have hout := intCmpTail_step S box add sub mul cmp eq Ctr host ar callee M hCmp + hEq op hA x y wa wb hwa hwb wl2 st out hseq2 + subst hout + refine ⟨.b (cmpDen op x y), ?_, by simp [HasTy], res_ok (by simp [SRepr]) hl2⟩ + simp [eval, heva, hevb, intBin_cmp hA] + · -- arithmetic + simp only [hA, ↓reduceIte] at hT hrun + subst hT + simp only [eraseL_append, eraseL, eraseI, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sva, heva, hTa, hresa⟩ := agreement l Γ env false .int wl st o1 htl henv hl h1 + obtain ⟨wl1, wa, rfl, hwa, hl1⟩ := res_false hresa + simp only [seqOut] at hseq + obtain ⟨o2, h2, hseq2⟩ := run_split hseq + obtain ⟨svb, hevb, hTb, hresb⟩ := + agreement r Γ env false .int wl1 (wa :: st) o2 htr henv hl1 h2 + obtain ⟨wl2, wb, rfl, hwb, hl2⟩ := res_false hresb + simp only [seqOut] at hseq2 + obtain ⟨x, rfl⟩ := hasTy_int hTa + obtain ⟨y, rfl⟩ := hasTy_int hTb + obtain ⟨w, rfl, hw, hTw⟩ := arith_step S box add sub mul cmp eq Ctr host ar callee M + hAdd hSub hMul op hA x y wa wb hwa hwb wl2 st out hseq2 + exact ⟨intBin op x y, by simp [eval, heva, hevb], hTw, res_ok hw hl2⟩ + · -- Bool operands + simp only [lowerW, lowerB, htl, eraseL_append, eraseL, eraseI, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sva, heva, hTa, hresa⟩ := agreement l Γ env false .bool wl st o1 htl henv hl h1 + obtain ⟨wl1, wa, rfl, hwa, hl1⟩ := res_false hresa + simp only [seqOut] at hseq + obtain ⟨o2, h2, hseq2⟩ := run_split hseq + obtain ⟨svb, hevb, hTb, hresb⟩ := + agreement r Γ env false .bool wl1 (wa :: st) o2 htr henv hl1 h2 + obtain ⟨wl2, wb, rfl, hwb, hl2⟩ := res_false hresb + simp only [seqOut] at hseq2 + obtain ⟨x, rfl⟩ := hasTy_bool hTa + obtain ⟨y, rfl⟩ := hasTy_bool hTb + have hwa' := srepr_b hwa + have hwb' := srepr_b hwb + subst hwa' hwb' + obtain ⟨v, hbb, rfl⟩ := boolCmp_step host ar callee op hop x y wl2 st out hseq2 + exact ⟨.b v, by simp [eval, heva, hevb, hbb], by simp [HasTy], + res_ok (by simp [SRepr]) hl2⟩ + · -- Float operands: one `f64` comparison + simp only [lowerW, lowerB, htl, eraseL_append, eraseL, eraseI, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sva, heva, hTa, hresa⟩ := agreement l Γ env false .float wl st o1 htl henv hl h1 + obtain ⟨wl1, wa, rfl, hwa, hl1⟩ := res_false hresa + simp only [seqOut] at hseq + obtain ⟨o2, h2, hseq2⟩ := run_split hseq + obtain ⟨svb, hevb, hTb, hresb⟩ := + agreement r Γ env false .float wl1 (wa :: st) o2 htr henv hl1 h2 + obtain ⟨wl2, wb, rfl, hwb, hl2⟩ := res_false hresb + simp only [seqOut] at hseq2 + obtain ⟨x, rfl⟩ := hasTy_float hTa + obtain ⟨y, rfl⟩ := hasTy_float hTb + simp only [SRepr] at hwa hwb + subst hwa hwb + obtain ⟨v, hfb, rfl⟩ := floatCmp_step host ar callee op hop x y wl2 st out hseq2 + exact ⟨.b v, by simp [eval, heva, hevb, hfb], by simp [HasTy], + res_ok (by simp [SRepr]) hl2⟩ + · -- String operands: concatenation, or byte equality + simp only [lowerW, lowerB, htl, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sva, heva, hTa, hresa⟩ := agreement l Γ env false .string wl st o1 htl henv hl h1 + obtain ⟨wl1, wa, rfl, hwa, hl1⟩ := res_false hresa + simp only [seqOut] at hseq + obtain ⟨o2, h2, hseq2⟩ := run_split hseq + obtain ⟨svb, hevb, hTb, hresb⟩ := + agreement r Γ env false .string wl1 (wa :: st) o2 htr henv hl1 h2 + obtain ⟨wl2, wb, rfl, hwb, hl2⟩ := res_false hresb + simp only [seqOut] at hseq2 + obtain ⟨x, rfl⟩ := hasTy_string hTa + obtain ⟨y, rfl⟩ := hasTy_string hTb + simp only [SRepr] at hwa hwb + subst hwa hwb + rcases hsop with ⟨rfl, rfl⟩ | ⟨hs, hne, rfl⟩ + · have hout := concat_run R (svs := [.s x, .s y]) (ws := [strW M x, strW M y]) + (bs := x ++ y) ⟨rfl, rfl, trivial⟩ (by simp [strCat]) wl2 st out + (by simpa [strOpTail] using hseq2) + subst hout + exact ⟨.s (x ++ y), by simp [eval, heva, hevb, strBin], by simp [HasTy], + res_ok (by simp [SRepr]) hl2⟩ + · obtain ⟨v, hsb, rfl⟩ := streq_step R op hs hne x y wl2 st out hseq2 + exact ⟨.b v, by simp [eval, heva, hevb, hsb], by simp [HasTy], + res_ok (by simp [SRepr]) hl2⟩ + | .neg e, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨hte, rfl⟩ := tyOf_neg_inv hty + simp only [lowerW, lowerB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := agreement e Γ env false .int wl st o1 hte henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨x, rfl⟩ := hasTy_int hT1 + simp only [seqOut, eraseL, eraseI] at hseq + cases hr : neg [w1] with + | none => simp [wRunF, hNeg, popArgs_one, hr] at hseq + | some r => + simp [wRunF, hNeg, popArgs_one, hr] at hseq + subst hseq + have hw1' : CanonRepr S x w1 := by simpa [SRepr] using hw1 + refine ⟨.i (-x), by simp [eval, hev1], by simp [HasTy], res_ok ?_ hl1⟩ + simp only [SRepr] + exact hNegC x w1 r hw1' hr + | .ifThenElse c t e, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨htc, htt, hte⟩ := tyOf_ite_inv hty + simp only [lowerW, lowerB, eraseL_append, eraseL, eraseI] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svc, hevc, hTc, hresc⟩ := agreement c Γ env false .bool wl st o1 htc henv hl h1 + obtain ⟨wl1, wc, rfl, hwc, hl1⟩ := res_false hresc + obtain ⟨v, rfl⟩ := hasTy_bool hTc + have hwc' := srepr_b hwc + subst hwc' + cases v with + | false => + simp only [seqOut, b32, Bool.false_eq_true, ↓reduceIte] at hseq + rw [wRunF_ifElse_single] at hseq + simp only [↓reduceIte] at hseq + obtain ⟨sv, hev, hT, hres⟩ := agreement e Γ env tail T wl1 st out hte henv hl1 hseq + exact ⟨sv, by simp [eval, hevc, hev], hT, hres⟩ + | true => + simp only [seqOut, b32, ↓reduceIte] at hseq + rw [wRunF_ifElse_single] at hseq + simp only [Int.reduceEq, ↓reduceIte] at hseq + obtain ⟨sv, hev, hT, hres⟩ := agreement t Γ env tail T wl1 st out htt henv hl1 hseq + exact ⟨sv, by simp [eval, hevc, hev], hT, hres⟩ + | .recordCreate tid fs, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨fts, hR, hts, h2, rfl⟩ := tyOf_rec_inv hty + simp only [lowerW, lowerB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs fs Γ env fts wl st o1 hts henv hl h1 + have hlen : fs.length = ws.length := by + rw [← tysOf_length hts, ← hasTyL_length hTs, sreprL_length hrep] + simp only [seqOut, eraseL, eraseI] at hseq + simp only [hlen, wRunF, popArgs_rev, Option.some.injEq] at hseq + subst hseq + refine ⟨.record tid svs, by simp [eval, hevs], ?_, res_ok ?_ hl1⟩ + · simp only [HasTy, true_and] + exact ⟨fts, hR, hTs⟩ + · exact (srepr_record hR h2 _ _).mpr ⟨ws, rfl, hrep⟩ + | .project tid i base, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨htb, fts, hR, h2, hi⟩ := tyOf_proj_inv hty + simp only [lowerW, lowerB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement base Γ env false (.record tid) wl st o1 htb henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨fs, fts', rfl, hR', hfs⟩ := hasTy_record hT1 + rw [hR] at hR' + cases hR' + obtain ⟨sv, hsv, hTsv⟩ := hasTyL_get hfs hi + obtain ⟨ws, rfl, hws⟩ := (srepr_record hR h2 _ _).mp hw1 + obtain ⟨w, hw, hwr⟩ := sreprL_get hws hsv + simp only [seqOut, eraseL, eraseI] at hseq + simp [wRunF, hw] at hseq + subst hseq + exact ⟨sv, by simp [eval, hev1, hsv], hTsv, res_ok hwr hl1⟩ + + | .call (.lazy _) [], hsz, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty + | .call (.lazy _) [_], hsz, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty + | .call (.lazy _) (_ :: _ :: _ :: _), hsz, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyOf] at hty + | .call (.lazy lb) [o, d], hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + rcases tyOf_lazy_inv hty with ⟨hvg, hdg, to, td, hto, htd, hlz⟩ | + ⟨v, i, t, hvg, hΓv, hΓi, htd, rfl⟩ | ⟨hvg, m, a, b, hdg, hta, htb, htd, rfl⟩ + · -- the boxed `withDefault`: the default runs only on the `None` / `Err` side + cases lb with + | optWithDefault => + obtain ⟨t, rfl⟩ : ∃ t, to = .option t := by + cases to <;> simp [lazyTy] at hlz + exact ⟨_, rfl⟩ + simp only [lazyTy] at hlz + split at hlz + · rename_i hc + obtain ⟨htd', _⟩ := hc + subst td + simp only [Option.some.injEq] at hlz + subst T + simp only [lowerW, lowerB, hvg, hdg, hto, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement o Γ env false (.option t) wl st o1 hto henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have hl2 := lrel_set_free w1 hl1 hl1.1.2.1 + have hss : (wl1.set X.subj w1)[X.subj]? = some w1 := stash_read rfl hseq + rcases hasTy_option hT1 with rfl | ⟨x, rfl, hx⟩ + · simp only [SRepr] at hw1 + obtain ⟨dd, rfl⟩ := hw1 + rw [run_seq_eq (tagTest_run host ar callee _ _ 0 [dd] _ st hss)] at hseq + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte] at hseq + rw [wRunF_ifElse_single] at hseq + simp only [Int.reduceEq, ↓reduceIte] at hseq + obtain ⟨sv, hev, hT, hres⟩ := agreement d Γ env false t _ st out htd henv hl2 hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, res_any_tail hres⟩ + · simp only [SRepr] at hw1 + obtain ⟨xw, rfl, hxw⟩ := hw1 + rw [run_seq_eq (tagTest_run host ar callee _ _ 1 [xw] _ st hss)] at hseq + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte] at hseq + rw [wRunF_ifElse_single] at hseq + simp [wRunF, hss] at hseq + subst hseq + exact ⟨x, by simp [eval, hev1], hx, res_ok hxw hl2⟩ + · cases hlz + | resWithDefault => + obtain ⟨t, e, rfl⟩ : ∃ t e, to = .result t e := by + cases to <;> simp [lazyTy] at hlz + exact ⟨_, _, rfl⟩ + simp only [lazyTy] at hlz + split at hlz + · rename_i hc + obtain ⟨htd', _⟩ := hc + subst td + simp only [Option.some.injEq] at hlz + subst T + simp only [lowerW, lowerB, hvg, hdg, hto, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement o Γ env false (.result t e) wl st o1 hto henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have hl2 := lrel_set_free w1 hl1 hl1.1.2.1 + have hss : (wl1.set X.subj w1)[X.subj]? = some w1 := stash_read rfl hseq + rcases hasTy_result hT1 with ⟨x, rfl, hx⟩ | ⟨x, rfl, hx⟩ + · simp only [SRepr] at hw1 + obtain ⟨xw, dd, rfl, hxw⟩ := hw1 + rw [run_seq_eq (tagTest_run host ar callee _ _ 1 [xw, dd] _ st hss)] at hseq + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte] at hseq + rw [wRunF_ifElse_single] at hseq + simp [wRunF, hss] at hseq + subst hseq + exact ⟨x, by simp [eval, hev1], hx, res_ok hxw hl2⟩ + · simp only [SRepr] at hw1 + obtain ⟨dd, xw, rfl, hxw⟩ := hw1 + rw [run_seq_eq (tagTest_run host ar callee _ _ 0 [dd, xw] _ st hss)] at hseq + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte] at hseq + rw [wRunF_ifElse_single] at hseq + simp only [Int.reduceEq, ↓reduceIte] at hseq + obtain ⟨sv, hev, hT, hres⟩ := agreement d Γ env false t _ st out htd henv hl2 hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, res_any_tail hres⟩ + · cases hlz + · -- `Option.withDefault(Vector.get(v, i), )`, fused + obtain ⟨rfl, rfl, -⟩ := vecGetOr?_some hvg + obtain ⟨vv, hvv, hTv⟩ := envTy_get henv hΓv + obtain ⟨iv, hiv, hTi⟩ := envTy_get henv hΓi + obtain ⟨vs, rfl, hall⟩ := hasTy_vec hTv + obtain ⟨n, rfl⟩ := hasTy_int hTi + obtain ⟨_, wv, hwv, hrv⟩ := hl.2 v _ hvv + obtain ⟨_, wi, hwi, hri⟩ := hl.2 i _ hiv + simp only [lowerW, lowerB, hvg, hΓv] at hrun + rcases vecGetOr_step R hwv hrv hwi hri hrun with ⟨hin, x, wx, hx, hwx, rfl⟩ | ⟨hout, hd⟩ + · refine ⟨x, ?_, hasTyAll_get hall hx, res_ok hwx hl⟩ + obtain ⟨hlt, hx'⟩ := List.getElem?_eq_some_iff.mp hx + simp [eval, evalArgs, hvv, hiv, builtinEval, hin, List.getElem?_eq_getElem hlt, hx'] + · obtain ⟨sv, hev, hT, hres⟩ := agreement d Γ env false T wl st out htd henv hl hd + refine ⟨sv, ?_, hT, res_any_tail hres⟩ + simp [eval, evalArgs, hvv, hiv, builtinEval, hout, hev] + · -- `Result.withDefault(Int.div/mod(a, b), k)`, fused: the three + -- operands once each, then the zero test and `__aint_divmod` + obtain ⟨rfl, rfl, k, rfl⟩ := divOr?_some hdg + have hband : inI64Band k = true := by + simp only [tyOf] at htd + split at htd + · assumption + · cases htd + have htail : ∀ ts, builtinTail M (if m then .intMod else .intDiv) ts = [] := by + intro ts; cases m <;> rfl + simp only [lowerW, lowerB, hvg, hdg, lowerArgsB, htail, eraseL_append, List.append_nil, + List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sva, heva, hTa, hresa⟩ := agreement a Γ env false .int wl st o1 hta henv hl h1 + obtain ⟨wl1, wa, rfl, hwa, hl1⟩ := res_false hresa + simp only [seqOut] at hseq + obtain ⟨o2, h2, hseq2⟩ := run_split hseq + obtain ⟨svb, hevb, hTb, hresb⟩ := + agreement b Γ env false .int wl1 (wa :: st) o2 htb henv hl1 h2 + obtain ⟨wl2, wb, rfl, hwb, hl2⟩ := res_false hresb + simp only [seqOut] at hseq2 + obtain ⟨o3, h3, hseq3⟩ := run_split hseq2 + obtain ⟨svd, hevd, hTd, hresd⟩ := agreement (.literal (.int k)) Γ env false .int wl2 + (wb :: wa :: st) o3 htd henv hl2 h3 + obtain ⟨wl3, wd, rfl, hwd, hl3⟩ := res_false hresd + simp only [seqOut] at hseq3 + obtain ⟨x, rfl⟩ := hasTy_int hTa + obtain ⟨y, rfl⟩ := hasTy_int hTb + simp only [eval, Option.some.injEq] at hevd + subst hevd + obtain ⟨w, rfl, hw⟩ := divOr_run hCarrier R ar callee X m x y k wa wb wd + (by simpa [SRepr] using hwa) (by simpa [SRepr] using hwb) + (by simpa [SRepr] using hwd) wl3 st out hseq3 + have hc := hl3.1.1 + have hl4 := lrel_set_free wa (lrel_set_free wb (lrel_set_free wd hl3 + (show X.n ≤ X.cmp + 3 by omega)) (show X.n ≤ X.cmp + 2 by omega)) + (show X.n ≤ X.cmp + 1 by omega) + refine ⟨if y = 0 then .i k else if m then .i (x % y) else .i (x / y), ?_, ?_, + res_ok ?_ hl4⟩ + · by_cases hy : y = 0 <;> cases m <;> + simp [eval, evalArgs, heva, hevb, builtinEval, hy] + · by_cases hy : y = 0 <;> cases m <;> simp [HasTy, hy] + · by_cases hy : y = 0 <;> cases m <;> simpa [SRepr, hy] using hw + + | .construct c ty args, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨ts, hts, hct⟩ := tyOf_construct_inv hty + cases c with + | user tid k => + cases ty with + | int => simp [ctorTy] at hct + | bool => simp [ctorTy] at hct + | record _ => simp [ctorTy] at hct + | option _ => simp [ctorTy] at hct + | result _ _ => simp [ctorTy] at hct + | eqref => simp [ctorTy] at hct + | float => simp [ctorTy] at hct + | string => simp [ctorTy] at hct + | vec _ => simp [ctorTy] at hct + | list _ => simp [ctorTy] at hct + | «opaque» _ => simp [ctorTy] at hct + | sum tid' => + simp only [ctorTy] at hct + split at hct + · rename_i hc + obtain ⟨htid, _, hcf⟩ := hc + subst htid + cases hct + simp only [lowerW, lowerB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env ts wl st o1 hts henv hl h1 + have hlen : args.length = ws.length := by + rw [← tysOf_length hts, ← hasTyL_length hTs, sreprL_length hrep] + simp only [seqOut, eraseL, eraseI] at hseq + simp only [hlen, wRunF, popArgs_rev, Option.some.injEq] at hseq + subst hseq + refine ⟨.variant tid k svs, by simp [eval, hevs, ctorVal], ?_, res_ok ?_ hl1⟩ + · simp only [HasTy, true_and] + exact ⟨ts, hcf, hTs⟩ + · simp only [SRepr] + exact ⟨ws, rfl, hrep⟩ + · cases hct + | some => + cases ty with + | int => simp [ctorTy] at hct + | bool => simp [ctorTy] at hct + | record _ => simp [ctorTy] at hct + | sum _ => simp [ctorTy] at hct + | result _ _ => simp [ctorTy] at hct + | eqref => simp [ctorTy] at hct + | float => simp [ctorTy] at hct + | string => simp [ctorTy] at hct + | vec _ => simp [ctorTy] at hct + | list _ => simp [ctorTy] at hct + | «opaque» _ => simp [ctorTy] at hct + | option t => + simp only [ctorTy] at hct + split at hct + · rename_i hc + obtain ⟨rfl, _⟩ := hc + cases hct + simp only [lowerW, lowerB, eraseL_append, List.append_assoc] at hrun + simp only [eraseL, eraseI, List.cons_append, List.nil_append, wRunF] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env [t] wl (.i32v 1 :: st) o1 hts henv hl h1 + obtain ⟨v, svs', rfl, hv, hTs'⟩ := hasTyL_cons_inv hTs + have := hasTyL_nil_inv hTs' + subst this + obtain ⟨w, ws', rfl, hw, hrep'⟩ := sreprL_cons_inv hrep + have := sreprL_nil_inv hrep' + subst this + simp [seqOut, wRunF, popArgs_two] at hseq + subst hseq + refine ⟨.some t v, by simp [eval, hevs, ctorVal], by simp [HasTy, hv], res_ok ?_ hl1⟩ + simp only [SRepr] + exact ⟨w, rfl, hw⟩ + · cases hct + | none => + cases ty with + | int => simp [ctorTy] at hct + | bool => simp [ctorTy] at hct + | record _ => simp [ctorTy] at hct + | sum _ => simp [ctorTy] at hct + | result _ _ => simp [ctorTy] at hct + | eqref => simp [ctorTy] at hct + | float => simp [ctorTy] at hct + | string => simp [ctorTy] at hct + | vec _ => simp [ctorTy] at hct + | list _ => simp [ctorTy] at hct + | «opaque» _ => simp [ctorTy] at hct + | option t => + simp only [ctorTy] at hct + split at hct + · rename_i hc + obtain ⟨rfl, hdt⟩ := hc + cases hct + simp only [lowerW, lowerB, eraseL_append, List.append_assoc] at hrun + simp only [eraseL, eraseI, List.cons_append, List.nil_append, wRunF] at hrun + obtain ⟨dd, hdd⟩ := dflt_run host ar callee (M := M) t hdt wl (.i32v 0 :: st) + rw [run_seq_eq hdd] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env [] wl (dd :: .i32v 0 :: st) o1 hts henv hl h1 + have := hasTyL_nil_inv hTs + subst this + have := sreprL_nil_inv hrep + subst this + simp [seqOut, eraseL, eraseI, wRunF, popArgs_two] at hseq + subst hseq + refine ⟨.none t, by simp [eval, hevs, ctorVal], by simp [HasTy], res_ok ?_ hl1⟩ + simp only [SRepr] + exact ⟨dd, rfl⟩ + · cases hct + | ok => + cases ty with + | int => simp [ctorTy] at hct + | bool => simp [ctorTy] at hct + | record _ => simp [ctorTy] at hct + | sum _ => simp [ctorTy] at hct + | option _ => simp [ctorTy] at hct + | eqref => simp [ctorTy] at hct + | float => simp [ctorTy] at hct + | string => simp [ctorTy] at hct + | vec _ => simp [ctorTy] at hct + | list _ => simp [ctorTy] at hct + | «opaque» _ => simp [ctorTy] at hct + | result t e => + simp only [ctorTy] at hct + split at hct + · rename_i hc + obtain ⟨rfl, _, hde⟩ := hc + cases hct + simp only [lowerW, lowerB, eraseL_append, List.append_assoc] at hrun + simp only [eraseL, eraseI, List.cons_append, List.nil_append, wRunF] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env [t] wl (.i32v 1 :: st) o1 hts henv hl h1 + obtain ⟨v, svs', rfl, hv, hTs'⟩ := hasTyL_cons_inv hTs + have := hasTyL_nil_inv hTs' + subst this + obtain ⟨w, ws', rfl, hw, hrep'⟩ := sreprL_cons_inv hrep + have := sreprL_nil_inv hrep' + subst this + simp only [seqOut, List.reverse_cons, List.reverse_nil, List.nil_append, + List.cons_append] at hseq + obtain ⟨dd, hdd⟩ := dflt_run host ar callee (M := M) e hde wl1 (w :: .i32v 1 :: st) + rw [run_seq_eq hdd] at hseq + simp [eraseL, eraseI, wRunF, popArgs_three] at hseq + subst hseq + refine ⟨.ok t e v, by simp [eval, hevs, ctorVal], by simp [HasTy, hv], + res_ok ?_ hl1⟩ + simp only [SRepr] + exact ⟨w, dd, rfl, hw⟩ + · cases hct + | err => + cases ty with + | int => simp [ctorTy] at hct + | bool => simp [ctorTy] at hct + | record _ => simp [ctorTy] at hct + | sum _ => simp [ctorTy] at hct + | option _ => simp [ctorTy] at hct + | eqref => simp [ctorTy] at hct + | float => simp [ctorTy] at hct + | string => simp [ctorTy] at hct + | vec _ => simp [ctorTy] at hct + | list _ => simp [ctorTy] at hct + | «opaque» _ => simp [ctorTy] at hct + | result t e => + simp only [ctorTy] at hct + split at hct + · rename_i hc + obtain ⟨rfl, hdt, _⟩ := hc + cases hct + simp only [lowerW, lowerB, eraseL_append, List.append_assoc] at hrun + simp only [eraseL, eraseI, List.cons_append, List.nil_append, wRunF] at hrun + obtain ⟨dd, hdd⟩ := dflt_run host ar callee (M := M) t hdt wl (.i32v 0 :: st) + rw [run_seq_eq hdd] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs args Γ env [e] wl (dd :: .i32v 0 :: st) o1 hts henv hl h1 + obtain ⟨v, svs', rfl, hv, hTs'⟩ := hasTyL_cons_inv hTs + have := hasTyL_nil_inv hTs' + subst this + obtain ⟨w, ws', rfl, hw, hrep'⟩ := sreprL_cons_inv hrep + have := sreprL_nil_inv hrep' + subst this + simp [seqOut, eraseL, eraseI, wRunF, popArgs_three] at hseq + subst hseq + refine ⟨.err t e v, by simp [eval, hevs, ctorVal], by simp [HasTy, hv], + res_ok ?_ hl1⟩ + simp only [SRepr] + exact ⟨dd, w, rfl, hw⟩ + · cases hct + | .match_ s arms, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨Ts, hts, hcases⟩ := tyOf_match_inv hty + rcases hcases with ⟨rfl, hfl, hta⟩ | ⟨rfl, hta⟩ | ⟨t, rfl, hta⟩ | ⟨t, e, rfl, hta⟩ | + ⟨tid, rfl, hok, hex, hlen2, hta⟩ | ⟨rfl, hta⟩ | ⟨tid, rfl, hta⟩ + · -- Int literal cascade: the subject is re-run per arm + simp only [lowerW, lowerB, hts] at hrun + obtain ⟨ys, hys⟩ := lowerIntArms_firstLit M X Γ tail (lowerB M X Γ false s) + (tyOf M X.n Γ tail (.match_ s arms)) hfl + have hrun0 := hrun + rw [hys, eraseL_append] at hrun0 + obtain ⟨o1, h1, _⟩ := run_split hrun0 + obtain ⟨sv1, hev1, hT1, _⟩ := agreement s Γ env false .int wl st o1 hts henv hl h1 + obtain ⟨x, rfl⟩ := hasTy_int hT1 + have hsc : ∀ wl0 st0 out0, LRel S M X env wl0 → + wRunF host ar callee (eraseL (lowerB M X Γ false s)) wl0 st0 = some out0 → + ∃ wl1 w, out0 = .ok wl1 (w :: st0) ∧ CanonRepr S x w ∧ + LRel S M X env wl1 := by + intro wl0 st0 out0 hl0 hr0 + obtain ⟨sv0, hev0, _, hres0⟩ := agreement s Γ env false .int wl0 st0 out0 hts henv hl0 hr0 + rw [hev1] at hev0 + cases hev0 + obtain ⟨wl1, w, rfl, hw, hl1⟩ := res_false hres0 + exact ⟨wl1, w, rfl, by simpa [SRepr] using hw, hl1⟩ + obtain ⟨sv, hev, hT, hres⟩ := + agreementIntArms arms Γ env tail T wl st out (lowerB M X Γ false s) _ x hsc hta henv hl + hrun + exact ⟨sv, by simp [eval, hev1, hev], hT, hres⟩ + · -- Bool: one `if` on the subject + simp only [lowerW, lowerB, hts, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := agreement s Γ env false .bool wl st o1 hts henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨x, rfl⟩ := hasTy_bool hT1 + have hw1' := srepr_b hw1 + subst hw1' + simp only [seqOut] at hseq + obtain ⟨sv, hev, hT, hres⟩ := + agreementBoolArms arms Γ env tail T wl1 st out _ x hta henv hl1 hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, hres⟩ + · -- Option: stash, tag test, payload binder + simp only [lowerW, lowerB, hts, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement s Γ env false (.option t) wl st o1 hts henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have hss : (wl1.set X.subj w1)[X.subj]? = some w1 := by + obtain ⟨ys, hys⟩ := lowerOptArms_head (bt := tyOf M X.n Γ tail (.match_ s arms)) hta + exact stash_read hys hseq + obtain ⟨sv, hev, hT, hres⟩ := + agreementOptArms arms Γ env tail T (wl1.set X.subj w1) st out _ t sv1 w1 hss hw1 hT1 + hta henv (lrel_set_free w1 hl1 hl1.1.2.1) hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, hres⟩ + · -- Result: stash, tag test, payload binders + simp only [lowerW, lowerB, hts, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement s Γ env false (.result t e) wl st o1 hts henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have hss : (wl1.set X.subj w1)[X.subj]? = some w1 := by + obtain ⟨ys, hys⟩ := lowerResArms_head (bt := tyOf M X.n Γ tail (.match_ s arms)) hta + exact stash_read hys hseq + obtain ⟨sv, hev, hT, hres⟩ := + agreementResArms arms Γ env tail T (wl1.set X.subj w1) st out _ t e sv1 w1 hss hw1 hT1 + hta henv (lrel_set_free w1 hl1 hl1.1.2.1) hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, hres⟩ + · -- user variant: stash, `ref.test` cascade + simp only [lowerW, lowerB, hts, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement s Γ env false (.sum tid) wl st o1 hts henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨cv, fs, fts, rfl, hcf, hfs⟩ := hasTy_sum hT1 + simp only [SRepr] at hw1 + obtain ⟨ws, rfl, hws⟩ := hw1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have hss : (wl1.set X.subj (.structv (M.ctorStruct tid cv) ws))[X.subj]? = + some (.structv (M.ctorStruct tid cv) ws) := by + obtain ⟨ys, hys⟩ := + lowerVarArms_head (bt := tyOf M X.n Γ tail (.match_ s arms)) hta hlen2 + exact stash_read hys hseq + obtain ⟨sv, hev, hT, hres⟩ := + agreementVarArms arms Γ env tail T _ st out _ tid cv fs ws fts hss hws hcf hfs + (varExhaustive_covers hex hcf) + (fun c fc hc heq => sumOk_inj hok hc hcf heq) hta henv + (lrel_set_free _ hl1 hl1.1.2.1) hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, hres⟩ + · -- String: stash, literal cascade through `__wasmgc_string_eq` + simp only [lowerW, lowerB, hts, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := agreement s Γ env false .string wl st o1 hts henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨x, rfl⟩ := hasTy_string hT1 + simp only [SRepr] at hw1 + subst hw1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have hss : (∃ k b r, arms = .cons (.litStr k) b r) → + (wl1.set X.subj (strW M x))[X.subj]? = some (strW M x) := by + rintro ⟨k, b, r, rfl⟩ + obtain ⟨ys, hys⟩ := lowerStrArms_head M X Γ tail (tyOf M X.n Γ tail (.match_ s + (.cons (.litStr k) b r))) k b r + exact stash_read hys hseq + obtain ⟨sv, hev, hT, hres⟩ := + agreementStrArms arms Γ env tail T _ st out _ x hss hta henv + (lrel_set_free _ hl1 hl1.1.2.1) hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, hres⟩ + · -- tuple destructure: stash, bind the components + simp only [lowerW, lowerB, hts, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv1, hev1, hT1, hres1⟩ := + agreement s Γ env false (.record tid) wl st o1 hts henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨fs, fts, rfl, hR, hfs⟩ := hasTy_record hT1 + obtain ⟨bs, b, h2, hany, harms⟩ := tyTupArms_shape hR hta + obtain ⟨ws, rfl, hws⟩ := (srepr_record hR h2 _ _).mp hw1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have hss : (wl1.set X.subj (.structv (M.structOf tid) ws))[X.subj]? = + some (.structv (M.structOf tid) ws) := by + obtain ⟨ys, hys⟩ := lowerTupArms_head (M := M) (X := X) (Γ := Γ) (tail := tail) + (tid := tid) hany harms + exact stash_read hys hseq + obtain ⟨sv, hev, hT, hres⟩ := + agreementTupArms arms Γ env tail T _ st out tid fs ws fts hss hws hR hfs hta henv + (lrel_set_free _ hl1 hl1.1.2.1) hseq + exact ⟨sv, by simp [eval, hev1, hev], hT, hres⟩ + | .interp parts, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨ts, hts, hall, rfl⟩ := tyOf_interp_inv hty + simp only [lowerW, lowerB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, hl1⟩ := + agreementArgs parts Γ env ts wl st o1 hts henv hl h1 + obtain ⟨bs, hbs⟩ := strCat_of_allStr hTs hall + have hlen : parts.length = ws.length := by + rw [← tysOf_length hts, ← hasTyL_length hTs, sreprL_length hrep] + simp only [seqOut, hlen] at hseq + have hout := concat_run R hrep hbs wl1 st out hseq + subst hout + exact ⟨.s bs, by simp [eval, hevs, hbs], by simp [HasTy], res_ok (by simp [SRepr]) hl1⟩ + | .list t items, hsz, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨rfl, rfl⟩ := tyOf_list_inv hty + simp [lowerW, lowerB, eraseL, eraseI, wRunF] at hrun + subst hrun + exact ⟨.nil t, by simp [eval], by simp [HasTy], res_ok (by simp [SRepr]) hl⟩ + +theorem agreementArgs_step : + ∀ (es : List Expr) (hsz : sizeOf es < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) + (wl st : List WVal) (out : Out), + tysOf M X.n Γ es = some Ts → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerArgsW M X Γ es) wl st = some out → + ∃ svs ws wl', out = .ok wl' (ws.reverse ++ st) ∧ + evalArgs F env es = some svs ∧ HasTyL M svs Ts ∧ + SReprL S M svs ws ∧ LRel S M X env wl' + | [], hsz, Γ, env, Ts, wl, st, out, hty, henv, hl, hrun => by + simp only [tysOf, Option.some.injEq] at hty + subst hty + simp only [lowerArgsW, lowerArgsB, eraseL, wRunF, Option.some.injEq] at hrun + subst hrun + exact ⟨[], [], wl, by simp, by simp [evalArgs], by simp [HasTyL], by simp [SReprL], hl⟩ + | e :: es, hsz, Γ, env, Ts, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨t, ts, hte, htes, rfl⟩ := tysOf_cons_inv hty + simp only [lowerArgsW, lowerArgsB, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨sv, hev, hT, hres⟩ := agreement e Γ env false t wl st o1 hte henv hl h1 + obtain ⟨wl1, w, rfl, hw, hl1⟩ := res_false hres + simp only [seqOut] at hseq + obtain ⟨svs, ws, wl2, rfl, hevs, hTs, hrep, hl2⟩ := + agreementArgs es Γ env ts wl1 (w :: st) out htes henv hl1 hseq + exact ⟨sv :: svs, w :: ws, wl2, by simp, by simp [evalArgs, hev, hevs], ⟨hT, hTs⟩, + ⟨hw, hrep⟩, hl2⟩ + +theorem agreementIntArms_step : + ∀ (arms : Arms) (hsz : sizeOf arms < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (sc : List BI) (bt : Option Ty) (x : Int), + (∀ wl0 st0 out0, LRel S M X env wl0 → + wRunF host ar callee (eraseL sc) wl0 st0 = some out0 → + ∃ wl1 w, out0 = .ok wl1 (w :: st0) ∧ CanonRepr S x w ∧ + LRel S M X env wl1) → + tyIntArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerIntArms M X Γ tail sc bt arms)) wl st = some out → + ∃ sv, evalArms F env (.i x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyIntArms] at hty + | .cons p b rest, hsz, Γ, env, tail, T, wl, st, out, sc, bt, x, hsc, hty, henv, hl, hrun => by + cases p with + | litInt k => + simp only [tyIntArms] at hty + by_cases hband : inI64Band k = true + · simp only [hband, ↓reduceIte] at hty + cases hb : tyOf M X.n Γ tail b with + | none => simp [hb] at hty + | some T1 => + cases hr : tyIntArms M X.n Γ tail rest with + | none => simp [hb, hr] at hty + | some T2 => + simp only [hb, hr] at hty + by_cases hTT : T1 = T2 + · subst hTT + simp only [↓reduceIte, Option.some.injEq] at hty + subst hty + simp only [lowerIntArms, eraseL_append] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨wl1, w, rfl, hw, hl1⟩ := hsc wl st o1 hl h1 + simp only [seqOut, eraseL, eraseI] at hseq + have hk : -(2 ^ 63 : Int) ≤ k ∧ k < 2 ^ 63 := by + simpa [inI64Band, Bool.and_eq_true, decide_eq_true_eq] + using hband + cases hbx : box [.i64v k] with + | none => simp [wRunF, hBox, popArgs_one, hbx] at hseq + | some wk => + have hwk := Ctr.hBox k wk hk.1 hk.2 hbx + cases hq : eq [w, wk] with + | none => simp [wRunF, hBox, hEq, popArgs_one, popArgs_two, hbx, hq] at hseq + | some r => + have hr' := Ctr.hEq x k w wk r hw.1 hwk.1 hw.2 hwk.2 hq + subst hr' + have hpre : wRunF host ar callee [.i64Const k, .call M.box, .call M.eq] + wl1 (w :: st) = some (.ok wl1 (.i32v (eqW x k) :: st)) := by + simp [wRunF, hBox, hEq, popArgs_one, popArgs_two, hbx, hq] + have hseq' := run_seq (xs := [.i64Const k, .call M.box, .call M.eq]) + (ys := [.ifElse (eraseL (lowerB M X Γ tail b)) + (eraseL (lowerIntArms M X Γ tail sc bt rest))]) hpre hseq + rw [wRunF_ifElse_single] at hseq' + by_cases hxk : x = k + · subst hxk + simp only [eqW, ↓reduceIte, Int.reduceEq] at hseq' + obtain ⟨sv, hev, hT, hres⟩ := + agreement b Γ env tail T1 wl1 st out hb henv hl1 hseq' + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · simp only [eqW, hxk, ↓reduceIte] at hseq' + obtain ⟨sv, hev, hT, hres⟩ := + agreementIntArms rest Γ env tail T1 wl1 st out sc bt x hsc hr henv + hl1 hseq' + exact ⟨sv, by simp [evalArms, patMatch, hxk, hev], hT, hres⟩ + · simp [hTT] at hty + · simp [hband] at hty + | wild => + cases rest with + | cons _ _ _ => simp [tyIntArms] at hty + | nil => + simp only [tyIntArms] at hty + simp only [lowerIntArms] at hrun + obtain ⟨sv, hev, hT, hres⟩ := agreement b Γ env tail T wl st out hty henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + | bind sl => + cases rest with + | cons _ _ _ => simp [tyIntArms] at hty + | nil => + simp only [tyIntArms] at hty + split at hty + · rename_i hc + obtain ⟨hsn, hΓs, hns⟩ := hc + simp only [lowerIntArms, eraseL_append, List.append_assoc] at hrun + obtain ⟨o1, h1, hseq⟩ := run_split hrun + obtain ⟨wl1, w, rfl, hw, hl1⟩ := hsc wl st o1 hl h1 + simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append] at hseq + rw [run_localSet] at hseq + have henv' : EnvTy M (upd env sl (.i x)) (upd Γ sl .int) := + envTy_upd henv (by simp [HasTy]) + have hl' := lrel_bind hl1 hsn (v := .i x) (by simpa [SRepr] using hw) + obtain ⟨sv, hev, hT, hres⟩ := + agreement b (upd Γ sl .int) (upd env sl (.i x)) tail T _ st out hty henv' hl' + hseq + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hns, hev], hT, + res_of_upd (envTy_free henv hΓs) hres⟩ + · cases hty + | litBool _ => simp [tyIntArms] at hty + | ctor _ _ => simp [tyIntArms] at hty + | litStr _ => simp [tyIntArms] at hty + | tuple _ => simp [tyIntArms] at hty + +theorem agreementBoolArms_step : + ∀ (arms : Arms) (hsz : sizeOf arms < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : Bool), + tyBoolArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerBoolArms M X Γ tail bt arms)) wl (b32 x :: st) = + some out → + ∃ sv, evalArms F env (.b x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + | .nil, hsz, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyBoolArms] at hty + | .cons p _ .nil, hsz, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + cases p <;> simp [tyBoolArms] at hty + | .cons p _ (.cons _ _ (.cons _ _ _)), hsz, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + cases p <;> simp [tyBoolArms] at hty + | .cons p t (.cons p2 e .nil), hsz, Γ, env, tail, T, wl, st, out, bt, x, hty, henv, hl, hrun => by + cases p with + | litBool v => + simp only [tyBoolArms] at hty + by_cases hp2 : p2 = .litBool (!v) ∨ p2 = .wild + · simp only [hp2, ↓reduceIte] at hty + cases hta : tyOf M X.n Γ tail t with + | none => simp [hta] at hty + | some a => + cases hte : tyOf M X.n Γ tail e with + | none => simp [hta, hte] at hty + | some c => + simp only [hta, hte] at hty + by_cases hac : a = c + · subst hac + simp only [↓reduceIte, Option.some.injEq] at hty + subst hty + simp only [b32] at hrun + rcases hp2 with rfl | rfl <;> cases v <;> cases x <;> + simp only [lowerBoolArms, Bool.false_eq_true, ↓reduceIte, eraseL, eraseI] + at hrun <;> + rw [wRunF_ifElse_single] at hrun <;> + simp only [Int.reduceEq, ↓reduceIte] at hrun + · obtain ⟨sv, hev, hT, hres⟩ := agreement t Γ env tail a wl st out hta henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · obtain ⟨sv, hev, hT, hres⟩ := agreement e Γ env tail a wl st out hte henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · obtain ⟨sv, hev, hT, hres⟩ := agreement e Γ env tail a wl st out hte henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · obtain ⟨sv, hev, hT, hres⟩ := agreement t Γ env tail a wl st out hta henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · obtain ⟨sv, hev, hT, hres⟩ := agreement t Γ env tail a wl st out hta henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · obtain ⟨sv, hev, hT, hres⟩ := agreement e Γ env tail a wl st out hte henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · obtain ⟨sv, hev, hT, hres⟩ := agreement e Γ env tail a wl st out hte henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · obtain ⟨sv, hev, hT, hres⟩ := agreement t Γ env tail a wl st out hta henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · simp [hac] at hty + · simp [hp2] at hty + | wild => simp [tyBoolArms] at hty + | litInt _ => simp [tyBoolArms] at hty + | bind _ => simp [tyBoolArms] at hty + | ctor _ _ => simp [tyBoolArms] at hty + | litStr _ => simp [tyBoolArms] at hty + | tuple _ => simp [tyBoolArms] at hty + +theorem agreementOptArms_step : + ∀ (arms : Arms) (hsz : sizeOf arms < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.option t) → + tyOptArms M X.n Γ tail t arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerOptArms M X Γ tail bt t arms)) wl st = some out → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOptArms] at hty + | .cons _ _ .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyOptArms] at hty + | .cons _ _ (.cons _ _ (.cons _ _ _)), hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, + _ => by simp [tyOptArms] at hty + | .cons p1 b1 (.cons p2 b2 .nil), hsz, Γ, env, tail, T, wl, st, out, bt, t, sv, w, hss, hsw, hsT, + hty, henv, hl, hrun => by + simp only [tyOptArms] at hty + cases hpk : optPick p1 p2 with + | none => simp [hpk] at hty + | some pr => + obtain ⟨swap, sb⟩ := pr + simp only [hpk] at hty + cases hbo : bindOne X.n Γ sb t with + | none => simp [hbo] at hty + | some Γs => + simp only [hbo] at hty + -- the arm bodies: `bs` runs under the binder, `bn` without + have key : ∀ (bs bn : Expr) (a : Ty), + (∀ env' wl', EnvTy M env' Γs → LRel S M X env' wl' → + wRunF host ar callee (eraseL (lowerB M X Γs tail bs)) wl' st = some out → + ∃ sv', eval F env' bs = some sv' ∧ HasTy M sv' a ∧ + Res S M X tail env' st sv' out) → + (wRunF host ar callee (eraseL (lowerB M X Γ tail bn)) wl st = some out → + ∃ sv', eval F env bn = some sv' ∧ HasTy M sv' a ∧ + Res S M X tail env st sv' out) → + (∀ env', eval F env' (if swap then b2 else b1) = eval F env' bs) → + (eval F env (if swap then b1 else b2) = eval F env bn) → + wRunF host ar callee (eraseL (tagTestB X.subj (M.optStruct t) ++ + [.ifElse bt (bindFieldB X.subj (M.optStruct t) 1 sb ++ + lowerB M X Γs tail bs) (lowerB M X Γ tail bn)])) wl st = some out → + ∃ sv', evalArms F env sv (.cons p1 b1 (.cons p2 b2 .nil)) = some sv' ∧ + HasTy M sv' a ∧ Res S M X tail env st sv' out := by + intro bs bn a hAs hAn hbs hbn hr + rw [eraseL_append] at hr + rcases hasTy_option hsT with rfl | ⟨x, rfl, hx⟩ + · simp only [SRepr] at hsw + obtain ⟨dd, rfl⟩ := hsw + rw [run_seq_eq (tagTest_run host ar callee _ _ 0 [dd] _ st hss)] at hr + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte, eraseL, eraseI] at hr + rw [wRunF_ifElse_single] at hr + simp only [Int.reduceEq, ↓reduceIte] at hr + obtain ⟨sv', hev, hT, hres⟩ := hAn hr + exact ⟨sv', by rw [evalOpt_none F env hpk, hbn]; exact hev, hT, hres⟩ + · simp only [SRepr] at hsw + obtain ⟨xw, rfl, hxw⟩ := hsw + obtain ⟨env', wl', hbv, henv', hl', hbrun, hres'⟩ := + bindOne_run host ar callee X.subj (M.optStruct t) 1 sb [.i32v 1, xw] x t xw + env Γ Γs wl st hl.1.2.1 hss (by simp) hx hxw hbo henv hl + rw [run_seq_eq (tagTest_run host ar callee _ _ 1 [xw] _ st hss)] at hr + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte, eraseL, eraseI] at hr + rw [wRunF_ifElse_single] at hr + simp only [Int.reduceEq, ↓reduceIte, eraseL_append] at hr + rw [run_seq_eq hbrun] at hr + obtain ⟨sv', hev, hT, hres⟩ := hAs env' wl' henv' hl' hr + refine ⟨sv', ?_, hT, hres' _ _ _ _ hres⟩ + simp only [evalOpt_some F env hpk, hbv, hbs] + exact hev + cases swap with + | false => + simp only at hty + cases hta : tyOf M X.n Γs tail b1 with + | none => simp [hta] at hty + | some a => + cases hte : tyOf M X.n Γ tail b2 with + | none => simp [hta, hte] at hty + | some c => + simp only [hta, hte] at hty + by_cases hac : a = c + · subst hac + simp only [↓reduceIte, Option.some.injEq] at hty + subst hty + simp only [lowerOptArms, hpk, hbo, Option.getD_some] at hrun + exact key b1 b2 a + (fun env' wl' he hl' hr => agreement b1 Γs env' tail a wl' st out hta he hl' hr) + (fun hr => agreement b2 Γ env tail a wl st out hte henv hl hr) + (fun _ => by simp) (by simp) hrun + · simp [hac] at hty + | true => + simp only at hty + cases hta : tyOf M X.n Γs tail b2 with + | none => simp [hta] at hty + | some a => + cases hte : tyOf M X.n Γ tail b1 with + | none => simp [hta, hte] at hty + | some c => + simp only [hta, hte] at hty + by_cases hac : a = c + · subst hac + simp only [↓reduceIte, Option.some.injEq] at hty + subst hty + simp only [lowerOptArms, hpk, hbo, Option.getD_some] at hrun + exact key b2 b1 a + (fun env' wl' he hl' hr => agreement b2 Γs env' tail a wl' st out hta he hl' hr) + (fun hr => agreement b1 Γ env tail a wl st out hte henv hl hr) + (fun _ => by simp) (by simp) hrun + · simp [hac] at hty + +theorem agreementResArms_step : + ∀ (arms : Arms) (hsz : sizeOf arms < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t e : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.result t e) → + tyResArms M X.n Γ tail t e arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerResArms M X Γ tail bt t e arms)) wl st = some out → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyResArms] at hty + | .cons _ _ .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyResArms] at hty + | .cons _ _ (.cons _ _ (.cons _ _ _)), hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, + _, _ => by simp [tyResArms] at hty + | .cons p1 b1 (.cons p2 b2 .nil), hsz, Γ, env, tail, T, wl, st, out, bt, t, e, sv, w, hss, hsw, + hsT, hty, henv, hl, hrun => by + simp only [tyResArms] at hty + cases hpk : resPick p1 p2 with + | none => simp [hpk] at hty + | some pr => + obtain ⟨swap, ob, eb⟩ := pr + simp only [hpk] at hty + cases hbo : bindOne X.n Γ ob t with + | none => simp [hbo] at hty + | some Γo => + cases hbe : bindOne X.n Γ eb e with + | none => simp [hbo, hbe] at hty + | some Γe => + simp only [hbo, hbe] at hty + have key : ∀ (bo be : Expr) (a : Ty), + (∀ env' wl', EnvTy M env' Γo → LRel S M X env' wl' → + wRunF host ar callee (eraseL (lowerB M X Γo tail bo)) wl' st = some out → + ∃ sv', eval F env' bo = some sv' ∧ HasTy M sv' a ∧ + Res S M X tail env' st sv' out) → + (∀ env' wl', EnvTy M env' Γe → LRel S M X env' wl' → + wRunF host ar callee (eraseL (lowerB M X Γe tail be)) wl' st = some out → + ∃ sv', eval F env' be = some sv' ∧ HasTy M sv' a ∧ + Res S M X tail env' st sv' out) → + (∀ env', eval F env' (if swap then b2 else b1) = eval F env' bo) → + (∀ env', eval F env' (if swap then b1 else b2) = eval F env' be) → + wRunF host ar callee (eraseL (tagTestB X.subj (M.resStruct t e) ++ + [.ifElse bt (bindFieldB X.subj (M.resStruct t e) 1 ob ++ + lowerB M X Γo tail bo) (bindFieldB X.subj (M.resStruct t e) 2 eb ++ + lowerB M X Γe tail be)])) wl st = some out → + ∃ sv', evalArms F env sv (.cons p1 b1 (.cons p2 b2 .nil)) = some sv' ∧ + HasTy M sv' a ∧ Res S M X tail env st sv' out := by + intro bo be a hAo hAe hbo' hbe' hr + rw [eraseL_append] at hr + rcases hasTy_result hsT with ⟨x, rfl, hx⟩ | ⟨x, rfl, hx⟩ + · simp only [SRepr] at hsw + obtain ⟨xw, dd, rfl, hxw⟩ := hsw + obtain ⟨env', wl', hbv, henv', hl', hbrun, hres'⟩ := + bindOne_run host ar callee X.subj (M.resStruct t e) 1 ob [.i32v 1, xw, dd] x + t xw env Γ Γo wl st hl.1.2.1 hss (by simp) hx hxw hbo henv hl + rw [run_seq_eq (tagTest_run host ar callee _ _ 1 [xw, dd] _ st hss)] at hr + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte, eraseL, eraseI] at hr + rw [wRunF_ifElse_single] at hr + simp only [Int.reduceEq, ↓reduceIte, eraseL_append] at hr + rw [run_seq_eq hbrun] at hr + obtain ⟨sv', hev, hT, hres⟩ := hAo env' wl' henv' hl' hr + refine ⟨sv', ?_, hT, hres' _ _ _ _ hres⟩ + simp only [evalRes_ok F env hpk, hbv, hbo'] + exact hev + · simp only [SRepr] at hsw + obtain ⟨dd, xw, rfl, hxw⟩ := hsw + obtain ⟨env', wl', hbv, henv', hl', hbrun, hres'⟩ := + bindOne_run host ar callee X.subj (M.resStruct t e) 2 eb [.i32v 0, dd, xw] x + e xw env Γ Γe wl st hl.1.2.1 hss (by simp) hx hxw hbe henv hl + rw [run_seq_eq (tagTest_run host ar callee _ _ 0 [dd, xw] _ st hss)] at hr + simp only [b32, Int.reduceEq, decide_false, decide_true, Bool.false_eq_true, ↓reduceIte, eraseL, eraseI] at hr + rw [wRunF_ifElse_single] at hr + simp only [Int.reduceEq, ↓reduceIte, eraseL_append] at hr + rw [run_seq_eq hbrun] at hr + obtain ⟨sv', hev, hT, hres⟩ := hAe env' wl' henv' hl' hr + refine ⟨sv', ?_, hT, hres' _ _ _ _ hres⟩ + simp only [evalRes_err F env hpk, hbv, hbe'] + exact hev + cases swap with + | false => + simp only at hty + cases hta : tyOf M X.n Γo tail b1 with + | none => simp [hta] at hty + | some a => + cases hte : tyOf M X.n Γe tail b2 with + | none => simp [hta, hte] at hty + | some c => + simp only [hta, hte] at hty + by_cases hac : a = c + · subst hac + simp only [↓reduceIte, Option.some.injEq] at hty + subst hty + simp only [lowerResArms, hpk, hbo, hbe, Option.getD_some] at hrun + exact key b1 b2 a + (fun env' wl' he hl' hr => agreement b1 Γo env' tail a wl' st out hta he hl' hr) + (fun env' wl' he hl' hr => agreement b2 Γe env' tail a wl' st out hte he hl' hr) + (fun _ => by simp) (fun _ => by simp) hrun + · simp [hac] at hty + | true => + simp only at hty + cases hta : tyOf M X.n Γo tail b2 with + | none => simp [hta] at hty + | some a => + cases hte : tyOf M X.n Γe tail b1 with + | none => simp [hta, hte] at hty + | some c => + simp only [hta, hte] at hty + by_cases hac : a = c + · subst hac + simp only [↓reduceIte, Option.some.injEq] at hty + subst hty + simp only [lowerResArms, hpk, hbo, hbe, Option.getD_some] at hrun + exact key b2 b1 a + (fun env' wl' he hl' hr => agreement b2 Γo env' tail a wl' st out hta he hl' hr) + (fun env' wl' he hl' hr => agreement b1 Γe env' tail a wl' st out hte he hl' hr) + (fun _ => by simp) (fun _ => by simp) hrun + · simp [hac] at hty + +theorem agreementVarArms_step : + ∀ (arms : Arms) (hsz : sizeOf arms < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (tid cv : Nat) (fs : List SVal) + (ws : List WVal) (fts : List Ty), + wl[X.subj]? = some (.structv (M.ctorStruct tid cv) ws) → + SReprL S M fs ws → ctorFields M tid cv = some fts → HasTyL M fs fts → + coversB cv arms = true → + (∀ c fc, ctorFields M tid c = some fc → M.ctorStruct tid c = M.ctorStruct tid cv → + c = cv) → + tyVarArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerVarArms M X Γ tail bt tid arms)) wl st = some out → + ∃ sv, evalArms F env (.variant tid cv fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyVarArms] at hty + | .cons p b .nil, hsz, Γ, env, tail, T, wl, st, out, bt, tid, cv, fs, ws, fts, hss, hws, hcf, hfs, + hcov, _, hty, henv, hl, hrun => by + simp only [tyVarArms] at hty + cases hva : varArmΓ M X.n Γ tid p with + | none => simp [hva] at hty + | some Γ' => + simp only [hva] at hty + have hva0 := hva + cases p with + | wild => + simp only [varArmΓ, Option.some.injEq] at hva + subst hva + simp only [lowerVarArms] at hrun + obtain ⟨sv, hev, hT, hres⟩ := agreement b Γ env tail T wl st out hty henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + | ctor cc bs => + cases cc with + | user tid' c => + simp only [varArmΓ] at hva + split at hva + · rename_i htid + subst tid' + cases hcfc : ctorFields M tid c with + | none => simp [hcfc] at hva + | some fts' => + simp only [hcfc] at hva + have hc : c = cv := by simpa [coversB] using hcov + subst hc + rw [hcf] at hcfc + cases hcfc + simp only [lowerVarArms, hva0, Option.getD_some, eraseL_append] at hrun + obtain ⟨env', wl', hbv, henv', hl', _, hxrun, hres'⟩ := + extract_run host ar callee X.subj (M.ctorStruct tid c) ws bs 0 fs fts ws + env Γ Γ' wl st hl.1.2.1 hss (by intro j y h; simpa using h) hfs hws + hva henv hl + rw [run_seq_eq hxrun] at hrun + obtain ⟨sv, hev, hT, hres⟩ := + agreement b Γ' env' tail T wl' st out hty henv' hl' hrun + exact ⟨sv, by simp [evalArms, patMatch, hbv, hev], hT, + hres' _ _ _ _ hres⟩ + · cases hva + | some => simp [varArmΓ] at hva + | none => simp [varArmΓ] at hva + | ok => simp [varArmΓ] at hva + | err => simp [varArmΓ] at hva + | litInt _ => simp [varArmΓ] at hva + | litBool _ => simp [varArmΓ] at hva + | bind _ => simp [varArmΓ] at hva + | litStr _ => simp [varArmΓ] at hva + | tuple _ => simp [varArmΓ] at hva + | .cons p b (.cons p' b' r), hsz, Γ, env, tail, T, wl, st, out, bt, tid, cv, fs, ws, fts, hss, + hws, hcf, hfs, hcov, hinj, hty, henv, hl, hrun => by + simp only [tyVarArms] at hty + cases p with + | wild => simp [Pat.isWild] at hty + | ctor cc bs => + cases cc with + | user tid' c => + simp only [Pat.isWild, Bool.false_eq_true, ↓reduceIte] at hty + cases hva : varArmΓ M X.n Γ tid (.ctor (.user tid' c) bs) with + | none => simp [hva] at hty + | some Γ' => + simp only [hva] at hty + cases hta : tyOf M X.n Γ' tail b with + | none => simp [hta] at hty + | some a => + cases hr : tyVarArms M X.n Γ tail tid (.cons p' b' r) with + | none => simp [hta, hr] at hty + | some a' => + simp only [hta, hr] at hty + split at hty + · rename_i haa + subst a' + simp only [Option.some.injEq] at hty + subst T + have hva0 := hva + simp only [varArmΓ] at hva + split at hva + · rename_i htid + subst tid' + cases hcfc : ctorFields M tid c with + | none => simp [hcfc] at hva + | some fts' => + simp only [hcfc] at hva + simp only [lowerVarArms, hva0, Option.getD_some, eraseL, + eraseI, List.cons_append, List.nil_append] at hrun + rw [run_test host ar callee _ _ _ _ _ _ _ hss] at hrun + simp only [b32] at hrun + rw [wRunF_ifElse_single] at hrun + by_cases hc : c = cv + · subst hc + rw [hcf] at hcfc + cases hcfc + simp only [decide_true, ↓reduceIte, Int.reduceEq, + eraseL_append] at hrun + obtain ⟨env', wl', hbv, henv', hl', _, hxrun, hres'⟩ := + extract_run host ar callee X.subj (M.ctorStruct tid c) ws bs 0 + fs fts ws env Γ Γ' wl st hl.1.2.1 hss + (by intro j y h; simpa using h) hfs hws hva henv hl + rw [run_seq_eq hxrun] at hrun + obtain ⟨sv, hev, hT, hres⟩ := + agreement b Γ' env' tail a wl' st out hta henv' hl' hrun + exact ⟨sv, by simp [evalArms, patMatch, hbv, hev], hT, + hres' _ _ _ _ hres⟩ + · have hne : M.ctorStruct tid cv ≠ M.ctorStruct tid c := by + intro h + exact hc (hinj c fts' hcfc h.symm) + simp only [hne, decide_false, Bool.false_eq_true, + ↓reduceIte] at hrun + have hcov' : coversB cv (.cons p' b' r) = true := by + simpa [coversB, hc] using hcov + obtain ⟨sv, hev, hT, hres⟩ := + agreementVarArms (.cons p' b' r) Γ env tail a wl st out bt tid + cv fs ws fts hss hws hcf hfs hcov' hinj hr henv hl hrun + refine ⟨sv, ?_, hT, hres⟩ + rw [← hev] + conv => lhs; rw [evalArms] + simp [patMatch, hc] + · cases hva + · cases hty + | some => simp [varArmΓ] at hty + | none => simp [varArmΓ] at hty + | ok => simp [varArmΓ] at hty + | err => simp [varArmΓ] at hty + | litInt _ => simp [varArmΓ] at hty + | litBool _ => simp [varArmΓ] at hty + | bind _ => simp [varArmΓ] at hty + | litStr _ => simp [varArmΓ] at hty + | tuple _ => simp [varArmΓ] at hty + +theorem agreementStrArms_step : + ∀ (arms : Arms) (hsz : sizeOf arms < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : List Nat), + ((∃ k b r, arms = .cons (.litStr k) b r) → wl[X.subj]? = some (strW M x)) → + tyStrArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerStrArms M X Γ tail bt arms)) wl st = some out → + ∃ sv, evalArms F env (.s x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyStrArms] at hty + | .cons p b rest, hsz, Γ, env, tail, T, wl, st, out, bt, x, hss, hty, henv, hl, hrun => by + cases p + case litStr k => + have hss' := hss ⟨k, b, rest, rfl⟩ + simp only [tyStrArms] at hty + cases hb : tyOf M X.n Γ tail b with + | none => simp [hb] at hty + | some T1 => + cases hr : tyStrArms M X.n Γ tail rest with + | none => simp [hb, hr] at hty + | some T2 => + simp only [hb, hr] at hty + by_cases hTT : T1 = T2 + · subst hTT + simp only [↓reduceIte, Option.some.injEq] at hty + subst hty + obtain ⟨g, hg, hgc⟩ := R.streq + have hrun' := hrun + simp only [lowerStrArms, eraseL_append] at hrun' + cases hq : g [strW M x, strW M k] with + | none => + simp [strLitB, eraseL, eraseI, wRunF, hss', strW, hg, popArgs_two, + Function.comp_def] at hrun' + simp only [strW] at hq + simp [hq] at hrun' + | some q => + have hq' := hgc _ _ _ hq + rw [stringEqW_strW] at hq' + subst hq' + have hpre : wRunF host ar callee + (eraseL ([BI.op (.localGet X.subj), .castNull M.str] ++ strLitB M k ++ + [BI.op (.call M.streq)])) wl st = + some (.ok wl (b32 (x == k) :: st)) := by + simp only [strW] at hq + simp [strLitB, eraseL, eraseI, wRunF, hss', strW, hg, popArgs_two, + Function.comp_def, hq] + have hsplit : eraseL (lowerStrArms M X Γ tail bt (.cons (.litStr k) b rest)) = + eraseL ([BI.op (.localGet X.subj), .castNull M.str] ++ strLitB M k ++ + [BI.op (.call M.streq)]) ++ + [.ifElse (eraseL (lowerB M X Γ tail b)) + (eraseL (lowerStrArms M X Γ tail bt rest))] := by + simp only [lowerStrArms, eraseL_append, eraseL, eraseI, List.append_assoc, + List.cons_append, List.nil_append] + rw [hsplit] at hrun + have hseq := run_seq hpre hrun + simp only [b32] at hseq + rw [wRunF_ifElse_single] at hseq + by_cases hxk : x = k + · subst hxk + simp [b32] at hseq + obtain ⟨sv, hev, hT, hres⟩ := agreement b Γ env tail T1 wl st out hb henv hl hseq + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + · simp [b32, hxk] at hseq + obtain ⟨sv, hev, hT, hres⟩ := + agreementStrArms rest Γ env tail T1 wl st out bt x (fun _ => hss') hr henv + hl hseq + exact ⟨sv, by simp [evalArms, patMatch, hxk, hev], hT, hres⟩ + · simp [hTT] at hty + case wild => + cases rest with + | cons _ _ _ => simp [tyStrArms] at hty + | nil => + simp only [tyStrArms] at hty + simp only [lowerStrArms] at hrun + obtain ⟨sv, hev, hT, hres⟩ := agreement b Γ env tail T wl st out hty henv hl hrun + exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ + all_goals simp [tyStrArms] at hty + +theorem agreementTupArms_step : + ∀ (arms : Arms) (hsz : sizeOf arms < n + 1) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (tid : Nat) (fs : List SVal) (ws : List WVal) + (fts : List Ty), + wl[X.subj]? = some (.structv (M.structOf tid) ws) → + SReprL S M fs ws → M.recFields tid = some fts → HasTyL M fs fts → + tyTupArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerTupArms M X Γ tail tid arms)) wl st = some out → + ∃ sv, evalArms F env (.record tid fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyTupArms] at hty + | .cons p b rest, hsz, Γ, env, tail, T, wl, st, out, tid, fs, ws, fts, hss, hws, hR, hfs, hty, + henv, hl, hrun => by + cases p + case tuple bs => + cases rest with + | cons _ _ _ => simp [tyTupArms] at hty + | nil => + simp only [tyTupArms, hR] at hty + split at hty + · cases hbt : bindTys X.n Γ bs fts with + | none => simp [hbt] at hty + | some Γ' => + simp only [hbt] at hty + simp only [lowerTupArms, hR, Option.bind_some, hbt, Option.getD_some, + eraseL_append] at hrun + obtain ⟨env', wl', hbv, henv', hl', _, hxrun, hres'⟩ := + extract_run host ar callee X.subj (M.structOf tid) ws bs 0 fs fts ws env Γ + Γ' wl st hl.1.2.1 hss (by intro j y h; simpa using h) hfs hws hbt henv hl + rw [run_seq_eq hxrun] at hrun + obtain ⟨sv, hev, hT, hres⟩ := + agreement b Γ' env' tail T wl' st out hty henv' hl' hrun + exact ⟨sv, by simp [evalArms, patMatch, hbv, hev], hT, hres' _ _ _ _ hres⟩ + · cases hty + all_goals simp [tyTupArms] at hty + +end Steps + +theorem agreement_upto : ∀ n : Nat, + ( ∀ (e : Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out), + tyOf M X.n Γ tail e = some T → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerW M X Γ tail e) wl st = some out → + (_ : sizeOf e < n) → + ∃ sv, eval F env e = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) ∧ + ( ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) + (wl st : List WVal) (out : Out), + tysOf M X.n Γ es = some Ts → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerArgsW M X Γ es) wl st = some out → + (_ : sizeOf es < n) → + ∃ svs ws wl', out = .ok wl' (ws.reverse ++ st) ∧ + evalArgs F env es = some svs ∧ HasTyL M svs Ts ∧ + SReprL S M svs ws ∧ LRel S M X env wl') ∧ + ( ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (sc : List BI) (bt : Option Ty) (x : Int), + (∀ wl0 st0 out0, LRel S M X env wl0 → + wRunF host ar callee (eraseL sc) wl0 st0 = some out0 → + ∃ wl1 w, out0 = .ok wl1 (w :: st0) ∧ CanonRepr S x w ∧ + LRel S M X env wl1) → + tyIntArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerIntArms M X Γ tail sc bt arms)) wl st = some out → + (_ : sizeOf arms < n) → + ∃ sv, evalArms F env (.i x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) ∧ + ( ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : Bool), + tyBoolArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerBoolArms M X Γ tail bt arms)) wl (b32 x :: st) = + some out → + (_ : sizeOf arms < n) → + ∃ sv, evalArms F env (.b x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) ∧ + ( ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.option t) → + tyOptArms M X.n Γ tail t arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerOptArms M X Γ tail bt t arms)) wl st = some out → + (_ : sizeOf arms < n) → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out) ∧ + ( ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t e : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.result t e) → + tyResArms M X.n Γ tail t e arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerResArms M X Γ tail bt t e arms)) wl st = some out → + (_ : sizeOf arms < n) → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out) ∧ + ( ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (tid cv : Nat) (fs : List SVal) + (ws : List WVal) (fts : List Ty), + wl[X.subj]? = some (.structv (M.ctorStruct tid cv) ws) → + SReprL S M fs ws → ctorFields M tid cv = some fts → HasTyL M fs fts → + coversB cv arms = true → + (∀ c fc, ctorFields M tid c = some fc → M.ctorStruct tid c = M.ctorStruct tid cv → + c = cv) → + tyVarArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerVarArms M X Γ tail bt tid arms)) wl st = some out → + (_ : sizeOf arms < n) → + ∃ sv, evalArms F env (.variant tid cv fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) ∧ + ( ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : List Nat), + ((∃ k b r, arms = .cons (.litStr k) b r) → wl[X.subj]? = some (strW M x)) → + tyStrArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerStrArms M X Γ tail bt arms)) wl st = some out → + (_ : sizeOf arms < n) → + ∃ sv, evalArms F env (.s x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) ∧ + ( ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (tid : Nat) (fs : List SVal) (ws : List WVal) + (fts : List Ty), + wl[X.subj]? = some (.structv (M.structOf tid) ws) → + SReprL S M fs ws → M.recFields tid = some fts → HasTyL M fs fts → + tyTupArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerTupArms M X Γ tail tid arms)) wl st = some out → + (_ : sizeOf arms < n) → + ∃ sv, evalArms F env (.record tid fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out) := by + intro n + induction n with + | zero => + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ <;> (intros; omega) + | succ n ih => + obtain ⟨ih0, ih1, ih2, ih3, ih4, ih5, ih6, ih7, ih8⟩ := ih + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · intros + apply agreement_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementArgs_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementIntArms_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementBoolArms_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementOptArms_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementResArms_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementVarArms_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementStrArms_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + · intros + apply agreementTupArms_step S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X n ih0 ih1 ih2 ih3 ih4 ih5 ih6 ih7 ih8 _ ‹_› <;> assumption + +theorem agreement : + ∀ (e : Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out), + tyOf M X.n Γ tail e = some T → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerW M X Γ tail e) wl st = some out → + ∃ sv, eval F env e = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + := by + intro e + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf e + 1)).1 e <;> first | assumption | exact Nat.lt_succ_self _ + +theorem agreementArgs : + ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) + (wl st : List WVal) (out : Out), + tysOf M X.n Γ es = some Ts → + EnvTy M env Γ → + LRel S M X env wl → + wRunF host ar callee (lowerArgsW M X Γ es) wl st = some out → + ∃ svs ws wl', out = .ok wl' (ws.reverse ++ st) ∧ + evalArgs F env es = some svs ∧ HasTyL M svs Ts ∧ + SReprL S M svs ws ∧ LRel S M X env wl' + := by + intro es + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf es + 1)).2.1 es <;> first | assumption | exact Nat.lt_succ_self _ + +/-- The Int literal cascade: `sc` is the subject's code, re-run per literal + arm; every run yields the same Int `x` (evaluation is pure). -/ +theorem agreementIntArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (sc : List BI) (bt : Option Ty) (x : Int), + (∀ wl0 st0 out0, LRel S M X env wl0 → + wRunF host ar callee (eraseL sc) wl0 st0 = some out0 → + ∃ wl1 w, out0 = .ok wl1 (w :: st0) ∧ CanonRepr S x w ∧ + LRel S M X env wl1) → + tyIntArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerIntArms M X Γ tail sc bt arms)) wl st = some out → + ∃ sv, evalArms F env (.i x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + := by + intro arms + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf arms + 1)).2.2.1 arms <;> first | assumption | exact Nat.lt_succ_self _ + +/-- The two-arm Bool match: one `if` on the subject's `i32`. -/ +theorem agreementBoolArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : Bool), + tyBoolArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerBoolArms M X Γ tail bt arms)) wl (b32 x :: st) = + some out → + ∃ sv, evalArms F env (.b x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + := by + intro arms + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf arms + 1)).2.2.2.1 arms <;> first | assumption | exact Nat.lt_succ_self _ + +/-- The two-arm Option match over the subject held in the scratch. -/ +theorem agreementOptArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.option t) → + tyOptArms M X.n Γ tail t arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerOptArms M X Γ tail bt t arms)) wl st = some out → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out + := by + intro arms + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf arms + 1)).2.2.2.2.1 arms <;> first | assumption | exact Nat.lt_succ_self _ + +/-- The two-arm Result match: `Ok` in the `then` (payload field 1), `Err` in + the `else` (payload field 2). -/ +theorem agreementResArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (t e : Ty) (sv : SVal) (w : WVal), + wl[X.subj]? = some w → SRepr S M sv w → HasTy M sv (.result t e) → + tyResArms M X.n Γ tail t e arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerResArms M X Γ tail bt t e arms)) wl st = some out → + ∃ sv', evalArms F env sv arms = some sv' ∧ HasTy M sv' T ∧ + Res S M X tail env st sv' out + := by + intro arms + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf arms + 1)).2.2.2.2.2.1 arms <;> first | assumption | exact Nat.lt_succ_self _ + +/-- The user-variant `ref.test` cascade over the subject held in the + scratch. `coversB` says some remaining arm reaches the subject's + constructor, so the untested last arm is exactly that constructor. -/ +theorem agreementVarArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (tid cv : Nat) (fs : List SVal) + (ws : List WVal) (fts : List Ty), + wl[X.subj]? = some (.structv (M.ctorStruct tid cv) ws) → + SReprL S M fs ws → ctorFields M tid cv = some fts → HasTyL M fs fts → + coversB cv arms = true → + (∀ c fc, ctorFields M tid c = some fc → M.ctorStruct tid c = M.ctorStruct tid cv → + c = cv) → + tyVarArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerVarArms M X Γ tail bt tid arms)) wl st = some out → + ∃ sv, evalArms F env (.variant tid cv fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + := by + intro arms + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf arms + 1)).2.2.2.2.2.2.1 arms <;> first | assumption | exact Nat.lt_succ_self _ + +/-- The String literal cascade over the subject held in the scratch: each + literal arm compares through `__wasmgc_string_eq`; `_` ends it. -/ +theorem agreementStrArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (bt : Option Ty) (x : List Nat), + ((∃ k b r, arms = .cons (.litStr k) b r) → wl[X.subj]? = some (strW M x)) → + tyStrArms M X.n Γ tail arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerStrArms M X Γ tail bt arms)) wl st = some out → + ∃ sv, evalArms F env (.s x) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + := by + intro arms + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf arms + 1)).2.2.2.2.2.2.2.1 arms <;> first | assumption | exact Nat.lt_succ_self _ + +/-- The flat tuple destructure over the subject held in the scratch. -/ +theorem agreementTupArms : + ∀ (arms : Arms) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out) (tid : Nat) (fs : List SVal) (ws : List WVal) + (fts : List Ty), + wl[X.subj]? = some (.structv (M.structOf tid) ws) → + SReprL S M fs ws → M.recFields tid = some fts → HasTyL M fs fts → + tyTupArms M X.n Γ tail tid arms = some T → + EnvTy M env Γ → LRel S M X env wl → + wRunF host ar callee (eraseL (lowerTupArms M X Γ tail tid arms)) wl st = some out → + ∃ sv, evalArms F env (.record tid fs) arms = some sv ∧ HasTy M sv T ∧ + Res S M X tail env st sv out + := by + intro arms + intros + apply (agreement_upto S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X (sizeOf arms + 1)).2.2.2.2.2.2.2.2 arms <;> first | assumption | exact Nat.lt_succ_self _ + + +end Agreement + +/-! ## Function level: fuel discharges every member contract of a group -/ + +theorem groupModel_outer (outer : Nat → Nat → List SVal → Option SVal) + (G : Nat → Option FnPlan) {f : Nat} (hG : G f = none) (fuel : Nat) (args : List SVal) : + groupModel outer G fuel f args = outer fuel f args := by + cases fuel <;> simp [groupModel, hG] + +theorem groupModel_member (outer : Nat → Nat → List SVal → Option SVal) + (G : Nat → Option FnPlan) {f : Nat} {p : FnPlan} (hG : G f = some p) (fuel : Nat) + (args : List SVal) : + groupModel outer G (fuel + 1) f args = + eval (groupModel outer G fuel) (argsEnv args) p.body := by + simp [groupModel, hG] + +theorem envTy_args {M : MCtx} {svs : List SVal} {ts : List Ty} + (h : HasTyL M svs ts) : EnvTy M (argsEnv svs) (paramsΓ ts) := by + intro i + cases hv : svs[i]? with + | none => + left + refine ⟨hv, ?_⟩ + have hlen := hasTyL_length h + have : ts.length ≤ i := by + rw [← hlen] + exact List.getElem?_eq_none_iff.mp hv + exact List.getElem?_eq_none_iff.mpr this + | some v => + right + obtain ⟨t, ht, hvt⟩ := hasTyL_get' h hv + exact ⟨v, t, hv, ht, hvt⟩ + +theorem FnPlan.lctx_spec (p : FnPlan) : + p.lctx.n = p.nslots ∧ p.nslots ≤ p.lctx.cmp ∧ p.lctx.subj = p.nslots ∧ + p.lctx.subj ≤ p.lctx.cmp := by + unfold FnPlan.lctx + split <;> simp + +/-- The group theorem: every member of one group (an SCC, or a single + function) is certified at its plan's model, given the planned code at its + index, the typing checks, and `FnCertified` for every callee outside the + group. Self and mutual calls need nothing more: at fuel `k + 1` the + members' contracts at fuel `k` are the induction hypothesis. -/ +theorem fn_certified_group {C : Nat} (S : CarrierSpec C) + (box add sub mul cmp eq neg : List WVal → Option WVal) + (Ctr : Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, CanonRepr S x w → neg [w] = some r → + CanonRepr S (-x) r) + (code : CodeTbl) (host : HostTbl) (M : MCtx) + (hCarrier : M.carrier = C) + (hBox : host M.box = some (1, box)) (hAdd : host M.add = some (2, add)) + (hSub : host M.sub = some (2, sub)) (hMul : host M.mul = some (2, mul)) + (hNeg : host M.neg = some (1, neg)) + (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) + (R : XHost S M host) + (G : Nat → Option FnPlan) (outer : Nat → Nat → List SVal → Option SVal) + (hOuter : ∀ f sig, M.sigs f = some sig → G f = none → + FnCertified S M code host f sig (fun fuel => outer fuel f)) + (hMem : ∀ f p, G f = some p → + M.sigs f = some p.sig ∧ planTyped M p = true ∧ host f = none ∧ + code f = some (fnCode M p)) : + ∀ f p, G f = some p → + FnCertified S M code host f p.sig + (fun fuel => groupModel outer G fuel f) := by + have core : ∀ fuel f p, G f = some p → ∀ svs ws r, + HasTyL M svs p.sig.params → SReprL S M svs ws → + wFuncN code host fuel f ws = some r → + ∃ sv, groupModel outer G fuel f svs = some sv ∧ SRepr S M sv r ∧ + HasTy M sv p.sig.ret := by + intro fuel + induction fuel with + | zero => intro f p _ svs ws r _ _ h; simp [wFuncN] at h + | succ k ih => + intro f p hG svs ws r hTs hrep hrun + obtain ⟨_, htyped, _, hcode⟩ := hMem f p hG + simp only [planTyped, Bool.and_eq_true, decide_eq_true_eq] at htyped + obtain ⟨⟨hpn, hnl⟩, hty⟩ := htyped + obtain ⟨hXn, hXc, hXs, hXsc⟩ := FnPlan.lctx_spec p + rw [← hXn] at hty + have hCallees : ∀ g sig, M.sigs g = some sig → + Contract S M host (fun g => (code g).map (·.arity)) + (fun g as => wFuncN code host k g as) g sig (groupModel outer G k g) := by + intro g sig hsig + cases hg : G g with + | some p' => + obtain ⟨hsig', _, hhost', hcode'⟩ := hMem g p' hg + rw [hsig] at hsig' + cases hsig' + refine ⟨hhost', by simp [hcode', fnCode], ?_⟩ + intro svs' ws' r' hT' hr' hc' + exact ih g p' hg svs' ws' r' hT' hr' hc' + | none => + have hc := (hOuter g sig hsig hg).contract k + refine ⟨hc.1, hc.2.1, ?_⟩ + intro svs' ws' r' hT' hr' hc' + obtain ⟨sv, hm, hsv, hT⟩ := hc.2.2 svs' ws' r' hT' hr' hc' + exact ⟨sv, by rw [groupModel_outer outer G hg]; exact hm, hsv, hT⟩ + have hlenw : ws.length = p.sig.params.length := by + rw [← sreprL_length hrep, hasTyL_length hTs] + have hLR : LRel S M p.lctx (argsEnv svs) (initLocals (fnCode M p) ws) := by + refine ⟨by simp [initLocals, fnCode]; omega, ?_⟩ + intro i sv hs + rw [hXn] + obtain ⟨w, hw, hsv⟩ := sreprL_get hrep hs + have hi : i < ws.length := by + rcases Nat.lt_or_ge i ws.length with h | h + · exact h + · rw [List.getElem?_eq_none h] at hw; simp at hw + refine ⟨by omega, w, ?_, hsv⟩ + simp [initLocals, List.getElem?_append_left hi, hw] + unfold wFuncN at hrun + rw [hcode] at hrun + simp only at hrun + cases hw : wRunF host (fun g => (code g).map (·.arity)) + (fun g as => wFuncN code host k g as) (fnCode M p).body + (initLocals (fnCode M p) ws) [] with + | none => rw [hw] at hrun; simp at hrun + | some o => + rw [hw] at hrun + obtain ⟨sv, hev, hT, hres⟩ := agreement S box add sub mul cmp eq neg Ctr hNegC host + (fun g => (code g).map (·.arity)) (fun g as => wFuncN code host k g as) M + hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R (groupModel outer G k) hCallees + p.lctx p.body (paramsΓ p.sig.params) (argsEnv svs) true p.sig.ret + (initLocals (fnCode M p) ws) [] o hty (envTy_args hTs) hLR hw + have hm : groupModel outer G (k + 1) f svs = some sv := by + rw [groupModel_member outer G hG]; exact hev + cases o with + | ok wl' st' => + obtain ⟨w, rfl, hsv, _⟩ := hres + simp at hrun + subst hrun + exact ⟨sv, hm, hsv, hT⟩ + | ret w => + obtain ⟨_, hsv⟩ := hres + simp at hrun + subst hrun + exact ⟨sv, hm, hsv, hT⟩ + intro f p hG + obtain ⟨_, _, hhost, hcode⟩ := hMem f p hG + exact ⟨hhost, by simp [hcode, fnCode], fun fuel => core fuel f p hG⟩ + +end AverCert.Grammar diff --git a/aver-cert/assets/wall/current/GrammarTotal.lean b/aver-cert/assets/wall/current/GrammarTotal.lean new file mode 100644 index 000000000..593f3e967 --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarTotal.lean @@ -0,0 +1,756 @@ +/- GrammarTotal — totality (level L3) for the one-grammar plan. + + Main's L3 (`Schema.Obligation.holdsTotal`, policy `simulatesModelTotally`) + promises, under the partial contracts plus totality of the Int helpers the + obligation's `totalityRole` selects (`.addSub`: add and sub; `.mul`: also + mul), that the export returns a represented result of its model at fuel + `n.natAbs + 1`, where `n` is the first (Int) argument. The termination + evidence is the one canonical witness `{measure := .intNatAbs 0, descent := + -1}`, checked against the byte-bound plan: a floor guard `n <= 0` and the + recursive argument `n - 1` (`Schema.checkTerm`, `checkTermMutual`). + + Here the same discipline is a decidable check over the plan, computed by + the wall from the plan alone (`checkTermGroup`), and `fn_certified_total` + proves the same promise for every member of a checked group: the wasm run + at fuel `n.natAbs + 1` returns, and the fuel-indexed model at that fuel is + defined and represented by the result. + + The admitted shape (every member of the group): + + * every parameter is `Int` (at least one), the result is `Int` or `Bool`; + * the body is `if n <= 0 then base else step` over parameter 0 (the MIR + `IfThenElse` the emitter lowers with the inline sign test); + * `base` and `step` are built from Int / Bool literals, parameters, and + `+`, `-`, `*` on Int; `step` may also + call a member of the group, by `call` or `tailCall`, and every such call + passes `n - 1` as its first argument; `step` makes at least one such + call (a plan without recursion stays at L1, as on main). + + Against main this admits more (all of it proved below): other straight-line + Int arithmetic in either arm, several member calls per arm, non-tail calls + to other members of a mutual group, further Int parameters, and a Bool + result. A literal multiplier (`k * f(n-1)`, recdecline's `wild`) is L3 at + role `.mul` for every `k` the typing admits; main reached such a plan only + when the producer's sampled i128 guard passed. A literal outside the i64 + band is declined by the typing (`tyOf`), so it never reaches this check. + + Runtime contracts: the partial ones `fn_certified_group` already takes, + plus totality of box (the Int literal and the `n - 1` operand box an + `i64`; on main box is the wall's own `boxRef`, see `boxRef_total`), add + and sub, and mul when the group's role is `.mul` (a member multiplies). -/ +import GrammarSound + +set_option maxHeartbeats 4000000 +set_option maxRecDepth 100000 +set_option linter.unusedSectionVars false +set_option linter.unusedSimpArgs false + +namespace AverCert.Grammar +open CertPrelude AverCert.Schema InterpreterSequencing + +/-! ## The termination check -/ + +/-- The recursive argument `n - 1` over parameter 0. -/ +def isDescent : Expr → Bool + | .binOp .sub (.local i) (.literal (.int k)) => i == 0 && k == 1 + | _ => false + +/-- The first argument of a member call is the descent. -/ +def descentHead : List Expr → Bool + | a :: _ => isDescent a + | [] => false + +mutual + /-- The straight-line total fragment. `mem` is the group's member set, + `mulOk` says the group's role admits `*`, and `calls` says member + calls are admitted here (only in the step arm). -/ + def totE (mem : Nat → Bool) (mulOk calls : Bool) : Expr → Bool + | .literal (.int _) => true + | .literal (.bool _) => true + | .local _ => true + | .binOp op l r => + (op == .add || op == .sub || (op == .mul && mulOk)) && + totE mem mulOk calls l && totE mem mulOk calls r + | .call (.fn g) args => + calls && mem g && descentHead args && totArgs mem mulOk calls args + | .tailCall g args => + calls && mem g && descentHead args && totArgs mem mulOk calls args + | _ => false + def totArgs (mem : Nat → Bool) (mulOk calls : Bool) : List Expr → Bool + | [] => true + | e :: es => totE mem mulOk calls e && totArgs mem mulOk calls es +end + +mutual + /-- Some member call occurs. -/ + def hasCall : Expr → Bool + | .binOp _ l r => hasCall l || hasCall r + | .call (.fn _) _ => true + | .tailCall _ _ => true + | _ => false +end + +mutual + /-- Some Int multiplication occurs (the `.mul` totality role). -/ + def usesMul : Expr → Bool + | .binOp op l r => op == .mul || usesMul l || usesMul r + | .call _ args => usesMulArgs args + | .tailCall _ args => usesMulArgs args + | .ifThenElse c t e => usesMul c || usesMul t || usesMul e + | _ => false + def usesMulArgs : List Expr → Bool + | [] => false + | e :: es => usesMul e || usesMulArgs es +end + +/-- The body: `if n <= 0 then base else step` over parameter 0. -/ +def totBody (mem : Nat → Bool) (mulOk : Bool) : Expr → Bool + | .ifThenElse (.binOp .lte (.local i) (.literal (.int k))) base step => + i == 0 && k == 0 && totE mem mulOk false base && totE mem mulOk true step && + hasCall step + | _ => false + +def isIntTy (t : Ty) : Bool := decide (t = .int) + +/-- One member plan: Int parameters (at least one), an Int or Bool result, + and a total body. -/ +def totPlan (mem : Nat → Bool) (mulOk : Bool) (p : FnPlan) : Bool := + !p.sig.params.isEmpty && p.sig.params.all isIntTy && + (decide (p.sig.ret = .int) || decide (p.sig.ret = .bool)) && + totBody mem mulOk p.body + +/-- The member set of a group given as `(function index, plan)` pairs. -/ +def memOf (ms : List (Nat × FnPlan)) (g : Nat) : Bool := ms.any (·.1 == g) + +/-- The group's totality role: `.mul` exactly when a member multiplies. -/ +def groupRole (ms : List (Nat × FnPlan)) : TotalityRole := + if ms.any (fun m => usesMul m.2.body) then .mul else .addSub + +/-- The wall's termination check for one group (an SCC, or one + self-recursive function): every member passes `totPlan` over the group's + member set, at the group's role. `some role` means L3 at that role. -/ +def checkTermGroup (ms : List (Nat × FnPlan)) : Option TotalityRole := + if !ms.isEmpty && ms.all (fun m => totPlan (memOf ms) (groupRole ms == .mul) m.2) then + some (groupRole ms) + else none + +/-- A single self-recursive function is the one-member group. -/ +def checkTerm (self : Nat) (p : FnPlan) : Option TotalityRole := checkTermGroup [(self, p)] + +/-- The canonical (and only) termination witness, as on main. -/ +def canonicalWitness : TerminationWitness := { measure := .intNatAbs 0, descent := -1 } + +/-- The claim axes of one group, derived from the plans alone: L3 with the + canonical witness and the group's role when the check passes, else L1. -/ +def groupPolicy (ms : List (Nat × FnPlan)) : Policy × Option TerminationWitness × TotalityRole := + match checkTermGroup ms with + | some role => (.simulatesModelTotally, some canonicalWitness, role) + | none => (.simulatesModel, none, .addSub) + +/-- The group as a code-index map (first binding wins). -/ +def groupOf (ms : List (Nat × FnPlan)) (f : Nat) : Option FnPlan := + (ms.find? (·.1 == f)).map (·.2) + +/-! ## Check facts -/ + +theorem isDescent_eq {a : Expr} (h : isDescent a = true) : + a = .binOp .sub (.local 0) (.literal (.int 1)) := by + unfold isDescent at h + split at h + · simp only [Bool.and_eq_true, beq_iff_eq] at h + obtain ⟨rfl, rfl⟩ := h + rfl + · cases h + +theorem descentHead_eq {args : List Expr} (h : descentHead args = true) : + ∃ rest, args = .binOp .sub (.local 0) (.literal (.int 1)) :: rest := by + cases args with + | nil => simp [descentHead] at h + | cons a rest => exact ⟨rest, by rw [isDescent_eq h]⟩ + +theorem totBody_eq {mem : Nat → Bool} {mulOk : Bool} {b : Expr} + (h : totBody mem mulOk b = true) : + ∃ base step, b = .ifThenElse (.binOp .lte (.local 0) (.literal (.int 0))) base step ∧ + totE mem mulOk false base = true ∧ totE mem mulOk true step = true := by + unfold totBody at h + split at h + · simp only [Bool.and_eq_true, beq_iff_eq] at h + obtain ⟨⟨⟨⟨rfl, rfl⟩, hb⟩, hs⟩, _⟩ := h + exact ⟨_, _, rfl, hb, hs⟩ + · cases h + +theorem totPlan_spec {mem : Nat → Bool} {mulOk : Bool} {p : FnPlan} + (h : totPlan mem mulOk p = true) : + (∃ ps, p.sig.params = .int :: ps) ∧ (∀ t ∈ p.sig.params, t = .int) ∧ + (p.sig.ret = .int ∨ p.sig.ret = .bool) ∧ totBody mem mulOk p.body = true := by + simp only [totPlan, Bool.and_eq_true, Bool.not_eq_true', List.isEmpty_eq_false_iff, + List.all_eq_true, Bool.or_eq_true, decide_eq_true_eq, isIntTy] at h + obtain ⟨⟨⟨hne, hall⟩, hret⟩, hb⟩ := h + refine ⟨?_, hall, hret, hb⟩ + cases hps : p.sig.params with + | nil => exact absurd hps hne + | cons t ps => + have := hall t (by rw [hps]; exact List.mem_cons_self) + exact ⟨ps, by rw [this]⟩ + +theorem checkTermGroup_spec {ms : List (Nat × FnPlan)} {role : TotalityRole} + (h : checkTermGroup ms = some role) : + role = groupRole ms ∧ + ∀ m ∈ ms, totPlan (memOf ms) (role == .mul) m.2 = true := by + unfold checkTermGroup at h + split at h + · rename_i hc + simp only [Option.some.injEq] at h + subst h + simp only [Bool.and_eq_true, Bool.not_eq_true', List.all_eq_true] at hc + exact ⟨rfl, hc.2⟩ + · cases h + +theorem groupOf_mem {ms : List (Nat × FnPlan)} {f : Nat} {p : FnPlan} + (h : groupOf ms f = some p) : (f, p) ∈ ms := by + unfold groupOf at h + cases hf : ms.find? (·.1 == f) with + | none => rw [hf] at h; cases h + | some m => + rw [hf] at h + simp only [Option.map_some, Option.some.injEq] at h + have hm := List.mem_of_find?_eq_some hf + have hk := List.find?_some hf + simp only [beq_iff_eq] at hk + subst h + obtain ⟨a, b⟩ := m + simp only at hk + subst hk + exact hm + +theorem memOf_groupOf {ms : List (Nat × FnPlan)} {g : Nat} (h : memOf ms g = true) : + ∃ p, groupOf ms g = some p := by + unfold memOf at h + unfold groupOf + cases hf : ms.find? (·.1 == g) with + | none => + rw [List.find?_eq_none] at hf + obtain ⟨m, hm, hmg⟩ := List.any_eq_true.mp h + exact absurd hmg (hf m hm) + | some m => exact ⟨m.2, rfl⟩ + +theorem boxRef_total (C : Nat) (k : Int) : ∃ w, boxRef C [.i64v k] = some w := + ⟨_, rfl⟩ + +/-! ## Progress: a total-fragment node runs to completion + +`agreement` says what a successful run means; the lemmas here say the run +succeeds. Each composite case runs its parts in order, taking the shape of +each intermediate frame from `agreement`. -/ + +theorem totE_binOp {mem : Nat → Bool} {mulOk calls : Bool} {op : BinOp} {l r : Expr} + (h : totE mem mulOk calls (.binOp op l r) = true) : + (op = .add ∨ op = .sub ∨ (op = .mul ∧ mulOk = true)) ∧ + totE mem mulOk calls l = true ∧ totE mem mulOk calls r = true := by + simp only [totE, Bool.and_eq_true, Bool.or_eq_true, beq_iff_eq] at h + obtain ⟨⟨hop, hl⟩, hr⟩ := h + refine ⟨?_, hl, hr⟩ + rcases hop with (h1 | h1) | h1 + · exact Or.inl h1 + · exact Or.inr (Or.inl h1) + · exact Or.inr (Or.inr ⟨h1.1, h1.2⟩) + +/-- A total-fragment node never has type `String` (so `+` is Int addition): + parameters are Int and member results are Int or Bool. -/ +theorem totE_notStr {M : MCtx} {n : Nat} {mem : Nat → Bool} {mulOk calls : Bool} + (hSig : ∀ g sig, mem g = true → M.sigs g = some sig → sig.ret = .int ∨ sig.ret = .bool) : + ∀ (e : Expr) (Γ : Nat → Option Ty) (tail : Bool), + (∀ i T', Γ i = some T' → T' = .int) → + totE mem mulOk calls e = true → tyOf M n Γ tail e ≠ some .string + | .literal (.int k), Γ, tail, hΓ, _, h => by + have := (tyOf_litInt_inv h).2; cases this + | .literal (.bool v), Γ, tail, hΓ, _, h => by + have := tyOf_litBool_inv h; cases this + | .local i, Γ, tail, hΓ, _, h => by + simp only [tyOf] at h + have := hΓ i _ h; cases this + | .binOp op l r, Γ, tail, hΓ, ht, h => by + obtain ⟨_, hl, _⟩ := totE_binOp ht + rcases tyOf_binOp_inv h with ⟨_, _, hT⟩ | ⟨_, _, _, hT⟩ | ⟨_, _, _, hT⟩ | ⟨htl, _, _⟩ + · split at hT <;> cases hT + · cases hT + · cases hT + · exact totE_notStr hSig l Γ false hΓ hl htl + | .call (.fn g) args, Γ, tail, hΓ, ht, h => by + simp only [totE, Bool.and_eq_true] at ht + obtain ⟨sig, hsig, _, hT⟩ := tyOf_callFn_inv h + rcases hSig g sig ht.1.1.2 hsig with h2 | h2 <;> rw [h2] at hT <;> cases hT + | .tailCall g args, Γ, tail, hΓ, ht, h => by + simp only [totE, Bool.and_eq_true] at ht + obtain ⟨_, sig, hsig, _, hT⟩ := tyOf_tailCall_inv h + rcases hSig g sig ht.1.1.2 hsig with h2 | h2 <;> rw [h2] at hT <;> cases hT + | .literal (.float _), _, _, _, ht, _ => by simp [totE] at ht + | .literal (.str _), _, _, _, ht, _ => by simp [totE] at ht + | .let_ _ _ _, _, _, _, ht, _ => by simp [totE] at ht + | .call (.builtin _) _, _, _, _, ht, _ => by simp [totE] at ht + | .call (.lazy _) _, _, _, _, ht, _ => by simp [totE] at ht + | .neg _, _, _, _, ht, _ => by simp [totE] at ht + | .ifThenElse _ _ _, _, _, _, ht, _ => by simp [totE] at ht + | .recordCreate _ _, _, _, _, ht, _ => by simp [totE] at ht + | .project _ _ _, _, _, _, ht, _ => by simp [totE] at ht + | .match_ _ _, _, _, _, ht, _ => by simp [totE] at ht + | .construct _ _ _, _, _, _, ht, _ => by simp [totE] at ht + | .interp _, _, _, _, ht, _ => by simp [totE] at ht + | .list _ _, _, _, _, ht, _ => by simp [totE] at ht + +/-- The `n <= 0` guard over a represented Int in a local runs to its + verdict (the inline sign test: no helper is called). -/ +theorem guard_run {C : Nat} (S : CarrierSpec C) + (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + (slot : Nat) (locals stack : List WVal) (n : Int) (w : WVal) + (hget : locals[slot]? = some w) + (hR : CanonRepr S n w) : + wRunF host ar callee (eraseL (cmpArmB C slot .lte 0)) locals stack = + some (.ok locals (b32 (decide (n ≤ 0)) :: stack)) := by + rcases S.car n w hR.1 with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ + · have hs : s = n := S.smallElim n s sg hR.1 + subst hs + simp [cmpArmB, eraseL, eraseI, bigCmpArm, smallCmpInstr, wRunF, hget, b32] + · obtain ⟨hsign, hnz⟩ := S.bigElim n s lty les sg hR.1 + have hiff : (sg < 0) ↔ (n ≤ 0) := by + constructor + · intro h; have := hsign.mp h; omega + · intro h; exact hsign.mpr (by omega) + simp [cmpArmB, eraseL, eraseI, bigCmpArm, smallCmpInstr, wRunF, hget, b32, hiff] + +section Progress +variable {C : Nat} (S : CarrierSpec C) + (box add sub mul cmp eq neg : List WVal → Option WVal) + (Ctr : Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, CanonRepr S x w → neg [w] = some r → + CanonRepr S (-x) r) + (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) (M : MCtx) + (hCarrier : M.carrier = C) + (hBox : host M.box = some (1, box)) (hAdd : host M.add = some (2, add)) + (hSub : host M.sub = some (2, sub)) (hMul : host M.mul = some (2, mul)) + (hNeg : host M.neg = some (1, neg)) + (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) + (R : XHost S M host) + (F : Nat → List SVal → Option SVal) + (hCallees : ∀ f sig, M.sigs f = some sig → + Contract S M host ar callee f sig (F f)) + (X : LCtx) + (hBoxT : ∀ k : Int, -(2 ^ 63 : Int) ≤ k → k < 2 ^ 63 → ∃ w, box [.i64v k] = some w) + (hAddT : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, add [va, vb] = some w) + (hSubT : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, sub [va, vb] = some w) + (mulOk : Bool) + (hMulT : mulOk = true → ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, mul [va, vb] = some w) + (mem : Nat → Bool) (calls : Bool) (n : Int) + (hSig : ∀ g sig, mem g = true → M.sigs g = some sig → sig.ret = .int ∨ sig.ret = .bool) + (hCallP : calls = true → ∀ g sig, mem g = true → M.sigs g = some sig → + ∀ svs ws, HasTyL M (.i (n - 1) :: svs) sig.params → + SReprL S M (.i (n - 1) :: svs) ws → ∃ r, callee g ws = some r) +include Ctr hNegC hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R hCallees hBoxT hAddT hSubT hMulT + hSig hCallP + +mutual +theorem progress : + ∀ (e : Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal), + totE mem mulOk calls e = true → + (∀ i T', Γ i = some T' → T' = .int) → + tyOf M X.n Γ tail e = some T → + EnvTy M env Γ → + LRel S M X env wl → + env 0 = some (.i n) → + ∃ out, wRunF host ar callee (lowerW M X Γ tail e) wl st = some out + | .literal (.int k), Γ, env, tail, T, wl, st, _, _, hty, _, _, _ => by + obtain ⟨hband, _⟩ := tyOf_litInt_inv hty + have hk : -(2 ^ 63 : Int) ≤ k ∧ k < 2 ^ 63 := by + simpa [inI64Band, Bool.and_eq_true, decide_eq_true_eq] using hband + obtain ⟨w, hw⟩ := hBoxT k hk.1 hk.2 + simp [lowerW, lowerB, eraseL, eraseI, wRunF, hBox, popArgs, hw] + | .literal (.bool v), Γ, env, tail, T, wl, st, _, _, _, _, _, _ => by + simp [lowerW, lowerB, eraseL, eraseI, wRunF] + | .local i, Γ, env, tail, T, wl, st, _, _, hty, henv, hl, _ => by + simp only [tyOf] at hty + obtain ⟨sv, hsv, _⟩ := envTy_get henv hty + obtain ⟨_, w, hw, _⟩ := hl.2 i sv hsv + simp [lowerW, lowerB, eraseL, eraseI, wRunF, hw] + | .binOp op l r, Γ, env, tail, T, wl, st, htot, hΓ, hty, henv, hl, h0 => by + obtain ⟨hop, htl0, htr0⟩ := totE_binOp htot + have hA : op.isArith = true := by + rcases hop with rfl | rfl | ⟨rfl, _⟩ <;> rfl + rcases tyOf_binOp_inv hty with ⟨htl, htr, _⟩ | ⟨_, _, hq, _⟩ | ⟨_, _, hq, _⟩ | + ⟨htl, _, _⟩ + · simp only [lowerW, lowerB, htl, hA, ↓reduceIte, eraseL_append, eraseL, eraseI] + obtain ⟨o1, h1⟩ := progress l Γ env false .int wl st htl0 hΓ htl henv hl h0 + obtain ⟨sv1, _, hT1, hres1⟩ := agreement S box add sub mul cmp eq neg Ctr hNegC host ar + callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X l Γ env false .int + wl st o1 htl henv hl h1 + obtain ⟨wl1, w1, rfl, hw1, hl1⟩ := res_false hres1 + obtain ⟨a, rfl⟩ := hasTy_int hT1 + obtain ⟨o2, h2⟩ := progress r Γ env false .int wl1 (w1 :: st) htr0 hΓ htr henv hl1 h0 + obtain ⟨sv2, _, hT2, hres2⟩ := agreement S box add sub mul cmp eq neg Ctr hNegC host ar + callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X r Γ env false .int + wl1 (w1 :: st) o2 htr henv hl1 h2 + obtain ⟨wl2, w2, rfl, hw2, _⟩ := res_false hres2 + obtain ⟨b, rfl⟩ := hasTy_int hT2 + simp only [SRepr, CanonRepr] at hw1 hw2 + rw [wRunF_append, wRunF_append] + simp only [lowerW] at h1 h2 + rw [h1] + simp only [seqOut] + rw [h2] + simp only [seqOut] + rcases hop with rfl | rfl | ⟨rfl, hm⟩ + · obtain ⟨w, hw⟩ := hAddT a b w1 w2 hw1.1 hw2.1 + simp [MCtx.arithIdx, wRunF, hAdd, popArgs_two, hw] + · obtain ⟨w, hw⟩ := hSubT a b w1 w2 hw1.1 hw2.1 + simp [MCtx.arithIdx, wRunF, hSub, popArgs_two, hw] + · obtain ⟨w, hw⟩ := hMulT hm a b w1 w2 hw1.1 hw2.1 + simp [MCtx.arithIdx, wRunF, hMul, popArgs_two, hw] + · rcases hop with rfl | rfl | ⟨rfl, _⟩ <;> cases hq + · rcases hop with rfl | rfl | ⟨rfl, _⟩ <;> cases hq + · exact absurd htl (totE_notStr hSig l Γ false hΓ htl0) + | .call (.fn g) args, Γ, env, tail, T, wl, st, htot, hΓ, hty, henv, hl, h0 => by + simp only [totE, Bool.and_eq_true] at htot + obtain ⟨⟨⟨hc, hmem⟩, hdh⟩, hargs⟩ := htot + obtain ⟨sig, hsig, hts, rfl⟩ := tyOf_callFn_inv hty + obtain ⟨hhost, har, _⟩ := hCallees g sig hsig + simp only [lowerW, lowerB, eraseL_append] + obtain ⟨o1, h1⟩ := progressArgs args Γ env sig.params wl st hargs hΓ hts henv hl h0 + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, _⟩ := + agreementArgs S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd + hSub hMul hNeg hCmp hEq R F hCallees X args Γ env sig.params wl st o1 hts henv hl h1 + obtain ⟨rest, rfl⟩ := descentHead_eq hdh + have hd : eval F env (.binOp .sub (.local 0) (.literal (.int 1))) = some (.i (n - 1)) := by + simp [eval, h0, intBin] + simp only [evalArgs, hd] at hevs + cases hrs : evalArgs F env rest with + | none => rw [hrs] at hevs; cases hevs + | some svs' => + rw [hrs] at hevs + simp only [Option.some.injEq] at hevs + subst hevs + obtain ⟨r, hr⟩ := hCallP hc g sig hmem hsig svs' ws hTs hrep + have hlen : sig.params.length = ws.length := by + rw [← hasTyL_length hTs, sreprL_length hrep] + rw [wRunF_append] + simp only [lowerArgsW] at h1 + rw [h1] + simp [seqOut, eraseL, eraseI, wRunF, hhost, har, hlen, popArgs_rev, hr] + | .tailCall g args, Γ, env, tail, T, wl, st, htot, hΓ, hty, henv, hl, h0 => by + simp only [totE, Bool.and_eq_true] at htot + obtain ⟨⟨⟨hc, hmem⟩, hdh⟩, hargs⟩ := htot + obtain ⟨_, sig, hsig, hts, rfl⟩ := tyOf_tailCall_inv hty + obtain ⟨_, har, _⟩ := hCallees g sig hsig + simp only [lowerW, lowerB, eraseL_append] + obtain ⟨o1, h1⟩ := progressArgs args Γ env sig.params wl st hargs hΓ hts henv hl h0 + obtain ⟨svs, ws, wl1, rfl, hevs, hTs, hrep, _⟩ := + agreementArgs S box add sub mul cmp eq neg Ctr hNegC host ar callee M hCarrier hBox hAdd + hSub hMul hNeg hCmp hEq R F hCallees X args Γ env sig.params wl st o1 hts henv hl h1 + obtain ⟨rest, rfl⟩ := descentHead_eq hdh + have hd : eval F env (.binOp .sub (.local 0) (.literal (.int 1))) = some (.i (n - 1)) := by + simp [eval, h0, intBin] + simp only [evalArgs, hd] at hevs + cases hrs : evalArgs F env rest with + | none => rw [hrs] at hevs; cases hevs + | some svs' => + rw [hrs] at hevs + simp only [Option.some.injEq] at hevs + subst hevs + obtain ⟨r, hr⟩ := hCallP hc g sig hmem hsig svs' ws hTs hrep + have hlen : sig.params.length = ws.length := by + rw [← hasTyL_length hTs, sreprL_length hrep] + rw [wRunF_append] + simp only [lowerArgsW] at h1 + rw [h1] + simp [seqOut, eraseL, eraseI, wRunF, har, hlen, popArgs_rev, hr] + | .literal (.float _), _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .literal (.str _), _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .let_ _ _ _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .call (.builtin _) _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .call (.lazy _) _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .neg _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .ifThenElse _ _ _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .recordCreate _ _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .project _ _ _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .match_ _ _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .construct _ _ _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .interp _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + | .list _ _, _, _, _, _, _, _, ht, _, _, _, _, _ => by simp [totE] at ht + +theorem progressArgs : + ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) + (wl st : List WVal), + totArgs mem mulOk calls es = true → + (∀ i T', Γ i = some T' → T' = .int) → + tysOf M X.n Γ es = some Ts → + EnvTy M env Γ → + LRel S M X env wl → + env 0 = some (.i n) → + ∃ out, wRunF host ar callee (lowerArgsW M X Γ es) wl st = some out + | [], Γ, env, Ts, wl, st, _, _, _, _, _, _ => by + simp [lowerArgsW, lowerArgsB, eraseL, wRunF] + | e :: es, Γ, env, Ts, wl, st, htot, hΓ, hty, henv, hl, h0 => by + simp only [totArgs, Bool.and_eq_true] at htot + obtain ⟨t, ts, hte, htes, rfl⟩ := tysOf_cons_inv hty + simp only [lowerArgsW, lowerArgsB, eraseL_append] + obtain ⟨o1, h1⟩ := progress e Γ env false t wl st htot.1 hΓ hte henv hl h0 + obtain ⟨sv, _, _, hres⟩ := agreement S box add sub mul cmp eq neg Ctr hNegC host ar + callee M hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R F hCallees X e Γ env false t + wl st o1 hte henv hl h1 + obtain ⟨wl1, w, rfl, _, hl1⟩ := res_false hres + obtain ⟨o2, h2⟩ := progressArgs es Γ env ts wl1 (w :: st) htot.2 hΓ htes henv hl1 h0 + rw [wRunF_append] + simp only [lowerW] at h1 + rw [h1] + simp only [lowerArgsW] at h2 + exact ⟨_, by simp only [seqOut]; exact h2⟩ +end + +end Progress + +/-! ## Function level: a checked group returns at fuel `n.natAbs + 1` -/ + +/-- The callee contracts of a group at one fuel level: members through their + `FnCertified`, functions outside the group through the outer ones. -/ +theorem groupCallees {C : Nat} (S : CarrierSpec C) (M : MCtx) (code : CodeTbl) (host : HostTbl) + (G : Nat → Option FnPlan) (outer : Nat → Nat → List SVal → Option SVal) + (hOuter : ∀ f sig, M.sigs f = some sig → G f = none → + FnCertified S M code host f sig (fun fuel => outer fuel f)) + (hSigOf : ∀ f p, G f = some p → M.sigs f = some p.sig) + (hCert : ∀ f p, G f = some p → + FnCertified S M code host f p.sig (fun fuel => groupModel outer G fuel f)) + (k : Nat) : + ∀ g sig, M.sigs g = some sig → + Contract S M host (fun g => (code g).map (·.arity)) + (fun g as => wFuncN code host k g as) g sig (groupModel outer G k g) := by + intro g sig hsig + cases hg : G g with + | some p' => + have hs := hSigOf g p' hg + rw [hsig] at hs + cases hs + exact (hCert g p' hg).contract k + | none => + have hc := (hOuter g sig hsig hg).contract k + refine ⟨hc.1, hc.2.1, ?_⟩ + intro svs' ws' r' hT' hr' hc' + obtain ⟨sv, hm, hsv, hT⟩ := hc.2.2 svs' ws' r' hT' hr' hc' + exact ⟨sv, by rw [groupModel_outer outer G hg]; exact hm, hsv, hT⟩ + +/-- The total face of one function (main's `holdsTotal` shape over the + plan's model): every well-typed represented input has an Int first + argument `n`, the run at fuel `n.natAbs + 1` returns, and the model at + that fuel is defined and represented by the result. -/ +def FnTotal {C : Nat} (S : CarrierSpec C) (M : MCtx) + (code : CodeTbl) (host : HostTbl) (f : Nat) (sig : Sig) + (model : Nat → List SVal → Option SVal) : Prop := + ∀ svs ws, HasTyL M svs sig.params → SReprL S M svs ws → + ∃ n tl, svs = .i n :: tl ∧ ∃ r sv, wFuncN code host (n.natAbs + 1) f ws = some r ∧ + model (n.natAbs + 1) svs = some sv ∧ SRepr S M sv r ∧ HasTy M sv sig.ret + +theorem paramsΓ_int {ts : List Ty} (h : ∀ t ∈ ts, t = .int) : + ∀ i T', paramsΓ ts i = some T' → T' = .int := by + intro i T' hi + exact h T' (List.mem_of_getElem? hi) + +/-- The group theorem at L3: every member of a group whose plans pass the + termination check is certified (`FnCertified`, as `fn_certified_group`) + and total (`FnTotal`), under the partial contracts plus totality of box, + add and sub, and of mul when `mulOk` (the group's role is `.mul`). -/ +theorem fn_certified_total {C : Nat} (S : CarrierSpec C) + (box add sub mul cmp eq neg : List WVal → Option WVal) + (Ctr : Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, CanonRepr S x w → neg [w] = some r → + CanonRepr S (-x) r) + (code : CodeTbl) (host : HostTbl) (M : MCtx) + (hCarrier : M.carrier = C) + (hBox : host M.box = some (1, box)) (hAdd : host M.add = some (2, add)) + (hSub : host M.sub = some (2, sub)) (hMul : host M.mul = some (2, mul)) + (hNeg : host M.neg = some (1, neg)) + (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) + (R : XHost S M host) + (G : Nat → Option FnPlan) (outer : Nat → Nat → List SVal → Option SVal) + (hOuter : ∀ f sig, M.sigs f = some sig → G f = none → + FnCertified S M code host f sig (fun fuel => outer fuel f)) + (hMem : ∀ f p, G f = some p → + M.sigs f = some p.sig ∧ planTyped M p = true ∧ host f = none ∧ + code f = some (fnCode M p)) + (hBoxT : ∀ k : Int, -(2 ^ 63 : Int) ≤ k → k < 2 ^ 63 → ∃ w, box [.i64v k] = some w) + (hAddT : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, add [va, vb] = some w) + (hSubT : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, sub [va, vb] = some w) + (mulOk : Bool) + (hMulT : mulOk = true → ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, mul [va, vb] = some w) + (mem : Nat → Bool) (hmem : ∀ g, mem g = true → ∃ p, G g = some p) + (hTot : ∀ f p, G f = some p → totPlan mem mulOk p = true) : + ∀ f p, G f = some p → + FnCertified S M code host f p.sig (fun fuel => groupModel outer G fuel f) ∧ + FnTotal S M code host f p.sig (fun fuel => groupModel outer G fuel f) := by + have hCert := fn_certified_group S box add sub mul cmp eq neg Ctr hNegC code host M hCarrier + hBox hAdd hSub hMul hNeg hCmp hEq R G outer hOuter hMem + have hSigOf : ∀ f p, G f = some p → M.sigs f = some p.sig := fun f p h => (hMem f p h).1 + have hSig : ∀ g sig, mem g = true → M.sigs g = some sig → sig.ret = .int ∨ sig.ret = .bool := by + intro g sig hg hs + obtain ⟨p, hp⟩ := hmem g hg + have := hSigOf g p hp + rw [hs] at this + cases this + exact (totPlan_spec (hTot g p hp)).2.2.1 + -- One fuel level, given every member returns one level below. + have key : ∀ m, + (∀ f p, G f = some p → ∀ n tl ws, HasTyL M (.i n :: tl) p.sig.params → + SReprL S M (.i n :: tl) ws → n.natAbs + 1 = m → ∃ r, wFuncN code host m f ws = some r) → + ∀ f p, G f = some p → ∀ n tl ws, HasTyL M (.i n :: tl) p.sig.params → + SReprL S M (.i n :: tl) ws → n.natAbs = m → + ∃ r, wFuncN code host (m + 1) f ws = some r := by + intro m ih f p hG n tl ws hTs hrep hm + obtain ⟨_, htyped, _, hcode⟩ := hMem f p hG + obtain ⟨⟨ps, hps⟩, hall, _, hbody⟩ := totPlan_spec (hTot f p hG) + obtain ⟨base, step, hb, hbase, hstep⟩ := totBody_eq hbody + simp only [planTyped, Bool.and_eq_true, decide_eq_true_eq] at htyped + obtain ⟨⟨hpn, hnl⟩, hty⟩ := htyped + obtain ⟨hXn, hXc, hXs, hXsc⟩ := FnPlan.lctx_spec p + rw [← hXn] at hty + have hCallees := groupCallees S M code host G outer hOuter hSigOf hCert m + have hlenw : ws.length = p.sig.params.length := by + rw [← sreprL_length hrep, hasTyL_length hTs] + have hLR : LRel S M p.lctx (argsEnv (.i n :: tl)) (initLocals (fnCode M p) ws) := by + refine ⟨by simp [initLocals, fnCode]; omega, ?_⟩ + intro i sv hs + rw [hXn] + obtain ⟨w, hw, hsv⟩ := sreprL_get hrep hs + have hi : i < ws.length := by + rcases Nat.lt_or_ge i ws.length with h | h + · exact h + · rw [List.getElem?_eq_none h] at hw; simp at hw + refine ⟨by omega, w, ?_, hsv⟩ + simp [initLocals, List.getElem?_append_left hi, hw] + have henv := envTy_args hTs + have hΓ := paramsΓ_int hall + have h0 : argsEnv (.i n :: tl) 0 = some (.i n) := rfl + obtain ⟨w0, ws', rfl, hw0, _⟩ := sreprL_cons_inv hrep + have hget : (initLocals (fnCode M p) (w0 :: ws'))[0]? = some w0 := by + simp [initLocals] + have hΓ0 : paramsΓ p.sig.params 0 = some .int := by simp [paramsΓ, hps] + -- the body runs to some outcome + have hrun : ∃ out, wRunF host (fun g => (code g).map (·.arity)) + (fun g as => wFuncN code host m g as) (fnCode M p).body + (initLocals (fnCode M p) (w0 :: ws')) [] = some out := by + have hbodyEq : (fnCode M p).body = eraseL (cmpArmB C 0 .lte 0) ++ + [WInstr.ifElse (eraseL (lowerB M p.lctx (paramsΓ p.sig.params) true base)) + (eraseL (lowerB M p.lctx (paramsΓ p.sig.params) true step))] := by + simp only [fnCode, hb, lowerW, lowerB, hΓ0, tyOf, BinOp.isArith, Bool.false_eq_true, + ↓reduceIte, litInt?, slot?, eraseL_append, eraseL, eraseI, hCarrier] + rw [hbodyEq, wRunF_append, guard_run S _ _ _ 0 _ [] n w0 hget hw0] + simp only [seqOut, b32] + rw [wRunF_ifElse_single] + by_cases hn : n ≤ 0 + · simp only [hn, decide_true, ↓reduceIte, Int.reduceEq] + have hbty := (tyOf_ite_inv (hb ▸ hty)).2.1 + exact progress (S := S) (box := box) (add := add) (sub := sub) (mul := mul) (cmp := cmp) + (eq := eq) (neg := neg) (Ctr := Ctr) (hNegC := hNegC) (host := host) + (ar := fun g => (code g).map (·.arity)) (callee := fun g as => wFuncN code host m g as) + (M := M) (hCarrier := hCarrier) (hBox := hBox) (hAdd := hAdd) (hSub := hSub) + (hMul := hMul) (hNeg := hNeg) (hCmp := hCmp) (hEq := hEq) (R := R) + (F := groupModel outer G m) (hCallees := hCallees) (X := p.lctx) (hBoxT := hBoxT) + (hAddT := hAddT) (hSubT := hSubT) (mulOk := mulOk) (hMulT := hMulT) (mem := mem) + (calls := false) (n := n) (hSig := hSig) (hCallP := fun h => by cases h) + base _ _ true p.sig.ret _ [] hbase hΓ hbty henv hLR h0 + · simp only [hn, decide_false, Bool.false_eq_true, ↓reduceIte] + have hsty := (tyOf_ite_inv (hb ▸ hty)).2.2 + have hCallP : true = true → ∀ g sig, mem g = true → M.sigs g = some sig → + ∀ svs ws, HasTyL M (.i (n - 1) :: svs) sig.params → + SReprL S M (.i (n - 1) :: svs) ws → + ∃ r, (fun g as => wFuncN code host m g as) g ws = some r := by + intro _ g sig hg hs svs ws2 hT2 hr2 + obtain ⟨p', hp'⟩ := hmem g hg + have := hSigOf g p' hp' + rw [hs] at this + cases this + exact ih g p' hp' (n - 1) svs ws2 hT2 hr2 (by omega) + exact progress (S := S) (box := box) (add := add) (sub := sub) (mul := mul) (cmp := cmp) + (eq := eq) (neg := neg) (Ctr := Ctr) (hNegC := hNegC) (host := host) + (ar := fun g => (code g).map (·.arity)) (callee := fun g as => wFuncN code host m g as) + (M := M) (hCarrier := hCarrier) (hBox := hBox) (hAdd := hAdd) (hSub := hSub) + (hMul := hMul) (hNeg := hNeg) (hCmp := hCmp) (hEq := hEq) (R := R) + (F := groupModel outer G m) (hCallees := hCallees) (X := p.lctx) (hBoxT := hBoxT) + (hAddT := hAddT) (hSubT := hSubT) (mulOk := mulOk) (hMulT := hMulT) (mem := mem) + (calls := true) (n := n) (hSig := hSig) (hCallP := hCallP) + step _ _ true p.sig.ret _ [] hstep hΓ hsty henv hLR h0 + obtain ⟨out, hout⟩ := hrun + obtain ⟨sv, _, _, hres⟩ := agreement S box add sub mul cmp eq neg Ctr hNegC host + (fun g => (code g).map (·.arity)) (fun g as => wFuncN code host m g as) M + hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R (groupModel outer G m) hCallees + p.lctx p.body (paramsΓ p.sig.params) (argsEnv (.i n :: tl)) true p.sig.ret + (initLocals (fnCode M p) (w0 :: ws')) [] out hty henv hLR hout + unfold wFuncN + rw [hcode] + simp only + rw [hout] + cases out with + | ok wl' st' => + obtain ⟨w, rfl, _, _⟩ := hres + exact ⟨w, rfl⟩ + | ret w => exact ⟨w, rfl⟩ + have term : ∀ m f p, G f = some p → ∀ n tl ws, HasTyL M (.i n :: tl) p.sig.params → + SReprL S M (.i n :: tl) ws → n.natAbs = m → + ∃ r, wFuncN code host (m + 1) f ws = some r := by + intro m + induction m with + | zero => exact key 0 (fun _ _ _ _ _ _ _ _ h => by omega) + | succ k ih => + exact key (k + 1) (fun f p hG n tl ws hT hr h => ih f p hG n tl ws hT hr (by omega)) + intro f p hG + refine ⟨hCert f p hG, ?_⟩ + intro svs ws hTs hrep + obtain ⟨⟨ps, hps⟩, _, _, _⟩ := totPlan_spec (hTot f p hG) + rw [hps] at hTs + obtain ⟨v, tl, rfl, hv, _⟩ := hasTyL_cons_inv hTs + obtain ⟨n, rfl⟩ := hasTy_int hv + rw [← hps] at hTs + obtain ⟨r, hr⟩ := term n.natAbs f p hG n tl ws hTs hrep rfl + obtain ⟨sv, hm, hsv, hT⟩ := (hCert f p hG).2.2 (n.natAbs + 1) _ ws r hTs hrep hr + exact ⟨n, tl, rfl, r, sv, hr, hm, hsv, hT⟩ + +/-- `fn_certified_total` for a group the wall's check accepts: `G` is any + code-index map whose bindings are exactly the group's pairs, and the + role the check returns selects the mul totality premise. -/ +theorem fn_certified_total_of_check {C : Nat} (S : CarrierSpec C) + (box add sub mul cmp eq neg : List WVal → Option WVal) + (Ctr : Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, CanonRepr S x w → neg [w] = some r → + CanonRepr S (-x) r) + (code : CodeTbl) (host : HostTbl) (M : MCtx) + (hCarrier : M.carrier = C) + (hBox : host M.box = some (1, box)) (hAdd : host M.add = some (2, add)) + (hSub : host M.sub = some (2, sub)) (hMul : host M.mul = some (2, mul)) + (hNeg : host M.neg = some (1, neg)) + (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) + (R : XHost S M host) + (ms : List (Nat × FnPlan)) (role : TotalityRole) (hck : checkTermGroup ms = some role) + (G : Nat → Option FnPlan) + (hGin : ∀ f p, G f = some p → (f, p) ∈ ms) (hGall : ∀ m ∈ ms, G m.1 = some m.2) + (outer : Nat → Nat → List SVal → Option SVal) + (hOuter : ∀ f sig, M.sigs f = some sig → G f = none → + FnCertified S M code host f sig (fun fuel => outer fuel f)) + (hMem : ∀ f p, G f = some p → + M.sigs f = some p.sig ∧ planTyped M p = true ∧ host f = none ∧ + code f = some (fnCode M p)) + (hBoxT : ∀ k : Int, -(2 ^ 63 : Int) ≤ k → k < 2 ^ 63 → ∃ w, box [.i64v k] = some w) + (hAddT : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, add [va, vb] = some w) + (hSubT : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, sub [va, vb] = some w) + (hMulT : role = .mul → ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, mul [va, vb] = some w) : + ∀ f p, G f = some p → + FnCertified S M code host f p.sig (fun fuel => groupModel outer G fuel f) ∧ + FnTotal S M code host f p.sig (fun fuel => groupModel outer G fuel f) := by + obtain ⟨_, hall⟩ := checkTermGroup_spec hck + refine fn_certified_total S box add sub mul cmp eq neg Ctr hNegC code host M hCarrier hBox hAdd + hSub hMul hNeg hCmp hEq R G outer hOuter hMem hBoxT hAddT hSubT (role == .mul) + (fun h => hMulT (by simpa using h)) (memOf ms) ?_ ?_ + · intro g hg + obtain ⟨m, hm, hmg⟩ := List.any_eq_true.mp hg + simp only [beq_iff_eq] at hmg + subst hmg + exact ⟨m.2, hGall m hm⟩ + · intro f p hG + exact hall (f, p) (hGin f p hG) + +end AverCert.Grammar diff --git a/aver-cert/assets/wall/current/IntDispatchSoundness.lean b/aver-cert/assets/wall/current/IntDispatchSoundness.lean deleted file mode 100644 index 99a79d4e8..000000000 --- a/aver-cert/assets/wall/current/IntDispatchSoundness.lean +++ /dev/null @@ -1,526 +0,0 @@ -import CertPrelude -import SchemaCore -import PlanCheck -import PlanLower - -set_option maxRecDepth 100000 -set_option maxHeartbeats 2000000 - -namespace IntDispatchSoundness -open CertPrelude AverCert.Schema - -/-! ### Semantic evaluator and family invariant -/ - -def evalLeaf : IntDispatchLeaf → Int → Int - | .proj, x => x - | .hostOp .add k true, x => k + x - | .hostOp .add k false, x => x + k - | .hostOp .sub k true, x => k - x - | .hostOp .sub k false, x => x - k - | .const k, _ => k - -/-- `EvalCascade S body tag fields n` is the semantic meaning of one admitted - dispatch input. It relates the byte-origin plan to the existing source - model without inventing a decoder for the abstract Int carrier. -/ -inductive EvalCascade {C : Nat} (S : CarrierSpec C) : - IntDispatchCascade → Nat → List WVal → Int → Prop where - | default (k : Int) (tag : Nat) (fields : List WVal) : - EvalCascade S (.default k) tag fields k - | hit (tyIdx : Nat) (leaf : IntDispatchLeaf) (rest : IntDispatchCascade) - (fields : List WVal) (x : Int) (v : WVal) - (hfield : fields[0]? = some v) (hrepr : S.Repr x v) : - EvalCascade S (.test tyIdx leaf rest) tyIdx fields (evalLeaf leaf x) - | constHit (tyIdx : Nat) (k : Int) (rest : IntDispatchCascade) (fields : List WVal) : - EvalCascade S (.test tyIdx (.const k) rest) tyIdx fields k - | miss (tyIdx tag : Nat) (leaf : IntDispatchLeaf) (rest : IntDispatchCascade) - (fields : List WVal) (n : Int) (hne : tag ≠ tyIdx) - (hrest : EvalCascade S rest tag fields n) : - EvalCascade S (.test tyIdx leaf rest) tag fields n - -/-- Matched inversion for a payload-BINDING arm. A `const` matched arm has no - field, so `constHit` is excluded here by the leaf hypothesis (the caller - already discriminates `proj`/`hostOp` from `const`). -/ -theorem evalCascade_hit_inv {C : Nat} {S : CarrierSpec C} - {tyIdx : Nat} {leaf : IntDispatchLeaf} {rest : IntDispatchCascade} - {fields : List WVal} {n : Int} - (hnc : ∀ k, leaf ≠ .const k) - (h : EvalCascade S (.test tyIdx leaf rest) tyIdx fields n) : - ∃ x v, fields[0]? = some v ∧ S.Repr x v ∧ n = evalLeaf leaf x := by - cases h with - | hit _ _ _ _ x v hfield hrepr => exact ⟨x, v, hfield, hrepr, rfl⟩ - | constHit => exact absurd rfl (hnc _) - | miss _ _ _ _ _ _ hne _ => exact False.elim (hne rfl) - -/-- Matched inversion for a `const` arm: the result is the constant, whether the - witness was `constHit` or a `hit` carrying a `.const` leaf (which evaluates to - the same constant regardless of the field). Reads no field. -/ -theorem evalCascade_constHit_inv {C : Nat} {S : CarrierSpec C} - {tyIdx : Nat} {k : Int} {rest : IntDispatchCascade} - {fields : List WVal} {n : Int} - (h : EvalCascade S (.test tyIdx (.const k) rest) tyIdx fields n) : - n = k := by - cases h with - | hit _ _ _ _ x v hfield hrepr => rfl - | constHit => rfl - | miss _ _ _ _ _ _ hne _ => exact absurd rfl hne - -theorem evalCascade_miss_inv {C : Nat} {S : CarrierSpec C} - {tyIdx tag : Nat} {leaf : IntDispatchLeaf} {rest : IntDispatchCascade} - {fields : List WVal} {n : Int} (hne : tag ≠ tyIdx) - (h : EvalCascade S (.test tyIdx leaf rest) tag fields n) : - EvalCascade S rest tag fields n := by - cases h with - | hit _ _ _ _ _ _ _ _ => exact False.elim (hne rfl) - | constHit => exact False.elim (hne rfl) - | miss _ _ _ _ _ _ _ hrest => exact hrest - -/-- The template's stack invariant at a block boundary: a successful sub-block - leaves one represented result above the unchanged incoming stack. -/ -def StackOK {C : Nat} (S : CarrierSpec C) (n : Int) (base : List WVal) : - Option Out → Prop - | some (.ok _ (w :: rest)) => rest = base ∧ S.Repr n w - | _ => False - -/-- A block has the same `StackOK`-preserving property at every nesting depth. -/ -def BlockOK {C : Nat} (S : CarrierSpec C) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (n : Int) (base : List WVal) (instrs : List WInstr) - (locals : List WVal) (stack : List WVal) : Prop := - ∀ out, wRunF host ar callee instrs locals stack = some out → - StackOK S n base (some out) - -theorem finishRun_nil - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (r : Option Out) : - (match r with - | some (.ok locals stack) => wRunF host ar callee [] locals stack - | some (.ret value) => some (.ret value) - | none => none) = r := by - cases r with - | none => rfl - | some out => cases out <;> simp [wRunF] - -theorem popArgs_one (a : WVal) (rest : List WVal) : - popArgs 1 (a :: rest) = some ([a], rest) := by - simp [popArgs, List.take, List.drop] - -theorem popArgs_two (b a : WVal) (rest : List WVal) : - popArgs 2 (b :: a :: rest) = some ([a, b], rest) := by - simp [popArgs, List.take, List.drop] - -/-! ### The branching arm, proved once -/ - -/-- Both sub-blocks satisfy the same invariant; selecting either branch - preserves it. This is the only proof that unfolds nested-block sequencing. -/ -theorem blockOK_ifElse {C : Nat} (S : CarrierSpec C) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (n : Int) (base : List WVal) (thenB elseB : List WInstr) - (locals : List WVal) (stack : List WVal) (cond : Bool) - (hbranch : BlockOK S host ar callee n base - (if cond then thenB else elseB) locals stack) : - BlockOK S host ar callee n base [.ifElse thenB elseB] - locals (b32 cond :: stack) := by - cases cond with - | false => - intro out hrun - cases hb : wRunF host ar callee elseB locals stack with - | none => simp [wRunF, b32, hb] at hrun - | some branchOut => - cases branchOut <;> simp [wRunF, b32, hb] at hrun - all_goals subst out; exact hbranch _ (by simpa using hb) - | true => - intro out hrun - cases hb : wRunF host ar callee thenB locals stack with - | none => simp [wRunF, b32, hb] at hrun - | some branchOut => - cases branchOut <;> simp [wRunF, b32, hb] at hrun - all_goals subst out; exact hbranch _ (by simpa using hb) - -/-! ### Host-slot hypotheses -/ - -def HostSlots (C : Nat) (host : HostTbl) - (hostTable : List (HostRole × Nat)) - (add sub : List WVal → Option WVal) : Prop := - (∀ idx, AverCert.PlanCheck.hostRoleIdx? hostTable .box = some idx → - host idx = some (1, boxRef C)) ∧ - (∀ idx, AverCert.PlanCheck.hostRoleIdx? hostTable .add = some idx → - host idx = some (2, add)) ∧ - (∀ idx, AverCert.PlanCheck.hostRoleIdx? hostTable .sub = some idx → - host idx = some (2, sub)) - -/-! ### Leaf simulation -/ - -theorem simLeaf {C : Nat} (S : CarrierSpec C) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (hostTable : List (HostRole × Nat)) - (add sub : List WVal → Option WVal) - (hslots : HostSlots C host hostTable add sub) - (hadd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w) - (hsub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (scrutineeLocal fieldLocal tyIdx : Nat) - (locals : List WVal) (fields : List WVal) (x : Int) (v : WVal) - (hslot : locals[scrutineeLocal]? = some (.structv tyIdx fields)) - (hfieldLocal : fieldLocal < locals.length) - (hfield : fields[0]? = some v) (hrepr : S.Repr x v) : - ∀ leaf instrs base, - AverCert.PlanLower.lowerIntDispatchArm hostTable - scrutineeLocal fieldLocal tyIdx leaf = some instrs → - BlockOK S host ar callee (evalLeaf leaf x) base instrs locals base := by - intro leaf instrs base hlow - cases leaf with - | const k => - -- A const arm never lowers through `lowerIntDispatchArm` (it is emitted - -- inline in the cascade); the projection lowering fail-closes. - simp [AverCert.PlanLower.lowerIntDispatchArm] at hlow - | proj => - simp only [AverCert.PlanLower.lowerIntDispatchArm, Option.some.injEq] at hlow - subst instrs - have hset : (locals.set fieldLocal v)[fieldLocal]? = some v := - List.getElem?_set_self hfieldLocal - simp [BlockOK, StackOK, wRunF, hslot, hfield, hset, evalLeaf, hrepr] - | hostOp role k constFirst => - cases hb : AverCert.PlanCheck.hostRoleIdx? hostTable .box with - | none => simp [AverCert.PlanLower.lowerIntDispatchArm, hb] at hlow - | some boxIdx => - cases hh : AverCert.PlanCheck.hostRoleIdx? hostTable - (AverCert.PlanCheck.intDispatchRoleHostRole role) with - | none => simp [AverCert.PlanLower.lowerIntDispatchArm, hb, hh] at hlow - | some hostIdx => - simp only [AverCert.PlanLower.lowerIntDispatchArm, hb, hh, - Option.some.injEq] at hlow - subst instrs - have hset : (locals.set fieldLocal v)[fieldLocal]? = some v := - List.getElem?_set_self hfieldLocal - have hbox := hslots.1 boxIdx hb - cases role with - | add => - have hhost := hslots.2.1 hostIdx hh - cases constFirst with - | false => - cases hop : add [v, carrierSmall C k] with - | none => simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, hop] - | some w => - have hw := hadd x k v (carrierSmall C k) w hrepr - (S.smallIntro k) hop - simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, - hop, evalLeaf, hw] - | true => - cases hop : add [carrierSmall C k, v] with - | none => simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, hop] - | some w => - have hw := hadd k x (carrierSmall C k) v w - (S.smallIntro k) hrepr hop - simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, - hop, evalLeaf, hw] - | sub => - have hhost := hslots.2.2 hostIdx hh - cases constFirst with - | false => - cases hop : sub [v, carrierSmall C k] with - | none => simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, hop] - | some w => - have hw := hsub x k v (carrierSmall C k) w hrepr - (S.smallIntro k) hop - simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, - hop, evalLeaf, hw] - | true => - cases hop : sub [carrierSmall C k, v] with - | none => simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, hop] - | some w => - have hw := hsub k x (carrierSmall C k) v w - (S.smallIntro k) hrepr hop - simp [BlockOK, StackOK, wRunF, hslot, hfield, - hset, hbox, boxRef, hhost, popArgs_one, popArgs_two, - hop, evalLeaf, hw] - -/-- `simConstArm`: a const arm's if-branch `[i64.const k, call box]` leaves the - represented constant above the unchanged stack — EXACTLY the terminal-default - closer (`S.smallIntro k`), now reused inside a `ref.test` `if`. Reads no local - and no field, so it is sound for a nullary (payloadless) constructor. -/ -theorem simConstArm {C : Nat} (S : CarrierSpec C) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (boxIdx : Nat) (hbox : host boxIdx = some (1, boxRef C)) - (k : Int) (base locals : List WVal) : - BlockOK S host ar callee k base [.i64Const k, .call boxIdx] locals base := by - simpa [BlockOK, StackOK, wRunF, hbox, boxRef, popArgs_one] - using S.smallIntro k - -/-! ### Nested cascade simulation -/ - -theorem simCascade {C : Nat} (S : CarrierSpec C) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (hostTable : List (HostRole × Nat)) - (add sub : List WVal → Option WVal) - (hslots : HostSlots C host hostTable add sub) - (hadd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w) - (hsub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (scrutineeLocal : Nat) (locals : List WVal) - (tag : Nat) (fields : List WVal) - (hslot : locals[scrutineeLocal]? = some (.structv tag fields)) : - ∀ body pos first n instrs base, - EvalCascade S body tag fields n → - pos + AverCert.PlanCheck.bindArmCount body < locals.length → - (match body with | .default _ => first = false | .test _ _ _ => True) → - AverCert.PlanLower.lowerIntDispatchCascade hostTable scrutineeLocal - pos first body = some instrs → - BlockOK S host ar callee n base instrs locals - (if first then .structv tag fields :: base else base) := by - intro body - induction body with - | default k => - intro pos first n instrs base hsem _hlen hfirst hlow - cases hsem - have hfirst' : first = false := hfirst - subst first - cases hb : AverCert.PlanCheck.hostRoleIdx? hostTable .box with - | none => simp [AverCert.PlanLower.lowerIntDispatchCascade, hb] at hlow - | some boxIdx => - simp only [AverCert.PlanLower.lowerIntDispatchCascade, hb, - Option.some.injEq] at hlow - subst instrs - have hbox := hslots.1 boxIdx hb - simpa [BlockOK, StackOK, wRunF, hbox, boxRef, popArgs_one] - using S.smallIntro k - | test tyIdx leaf rest ih => - intro pos first n instrs base hsem hlen _hfirst hlow - cases leaf with - | const k => - -- Const arm: the if-branch is the boxed constant (no projection), the - -- binding position does not advance. Closes via `simConstArm`. - cases hb : AverCert.PlanCheck.hostRoleIdx? hostTable .box with - | none => simp [AverCert.PlanLower.lowerIntDispatchCascade, hb] at hlow - | some boxIdx => - cases hr : AverCert.PlanLower.lowerIntDispatchCascade hostTable - scrutineeLocal pos false rest with - | none => - simp [AverCert.PlanLower.lowerIntDispatchCascade, hb, hr] at hlow - | some restInstrs => - simp only [AverCert.PlanLower.lowerIntDispatchCascade, hb, hr, - Option.some.injEq] at hlow - subst instrs - have hbox := hslots.1 boxIdx hb - by_cases htag : tag = tyIdx - · subst tag - have hn : n = k := evalCascade_constHit_inv hsem - subst n - have harm : BlockOK S host ar callee k base - [.i64Const k, .call boxIdx] locals base := - simConstArm S host ar callee boxIdx hbox k base locals - have hif := blockOK_ifElse S host ar callee k base - [.i64Const k, .call boxIdx] restInstrs locals base true - (by simpa using harm) - cases first <;> - simpa [BlockOK, StackOK, wRunF, hslot, b32] using hif - · have hrest := evalCascade_miss_inv htag hsem - have hrestLen : - pos + AverCert.PlanCheck.bindArmCount rest < locals.length := by - simp only [AverCert.PlanCheck.bindArmCount, - AverCert.PlanCheck.bindArmLeaf] at hlen - omega - have htail := ih pos false n restInstrs base hrest - hrestLen (by cases rest <;> simp) hr - have hif := blockOK_ifElse S host ar callee n base - [.i64Const k, .call boxIdx] restInstrs locals base false - (by simpa using htail) - cases first <;> - simp [BlockOK, StackOK, wRunF, hslot, b32, htag] at hif ⊢ <;> - exact hif - | proj => - cases ha : AverCert.PlanLower.lowerIntDispatchArm hostTable - scrutineeLocal (pos + 1) tyIdx .proj with - | none => simp [AverCert.PlanLower.lowerIntDispatchCascade, ha] at hlow - | some hitInstrs => - cases hr : AverCert.PlanLower.lowerIntDispatchCascade hostTable - scrutineeLocal (pos + 1) false rest with - | none => - simp [AverCert.PlanLower.lowerIntDispatchCascade, ha, hr] at hlow - | some restInstrs => - simp only [AverCert.PlanLower.lowerIntDispatchCascade, ha, hr, - Option.some.injEq] at hlow - subst instrs - have hfieldLocal : pos + 1 < locals.length := by - simp only [AverCert.PlanCheck.bindArmCount, - AverCert.PlanCheck.bindArmLeaf] at hlen - omega - by_cases htag : tag = tyIdx - · subst tag - obtain ⟨x, v, hfield, hrepr, hn⟩ := - evalCascade_hit_inv (by intro k h; cases h) hsem - subst n - have hhit := simLeaf S host ar callee hostTable add sub hslots - hadd hsub scrutineeLocal (pos + 1) tyIdx locals fields x v - hslot hfieldLocal hfield hrepr .proj hitInstrs base ha - have hif := blockOK_ifElse S host ar callee - (evalLeaf .proj x) base hitInstrs restInstrs locals base true - (by simpa using hhit) - cases first <;> - simpa [BlockOK, StackOK, wRunF, hslot, b32] using hif - · have hrest := evalCascade_miss_inv htag hsem - have hrestLen : pos + 1 + - AverCert.PlanCheck.bindArmCount rest < locals.length := by - simp only [AverCert.PlanCheck.bindArmCount, - AverCert.PlanCheck.bindArmLeaf] at hlen - omega - have htail := ih (pos + 1) false n restInstrs base hrest - hrestLen (by cases rest <;> simp) hr - have hif := blockOK_ifElse S host ar callee n base - hitInstrs restInstrs locals base false (by simpa using htail) - cases first <;> - simp [BlockOK, StackOK, wRunF, hslot, b32, htag] at hif ⊢ <;> - exact hif - | hostOp role kk cf => - cases ha : AverCert.PlanLower.lowerIntDispatchArm hostTable - scrutineeLocal (pos + 1) tyIdx (.hostOp role kk cf) with - | none => simp [AverCert.PlanLower.lowerIntDispatchCascade, ha] at hlow - | some hitInstrs => - cases hr : AverCert.PlanLower.lowerIntDispatchCascade hostTable - scrutineeLocal (pos + 1) false rest with - | none => - simp [AverCert.PlanLower.lowerIntDispatchCascade, ha, hr] at hlow - | some restInstrs => - simp only [AverCert.PlanLower.lowerIntDispatchCascade, ha, hr, - Option.some.injEq] at hlow - subst instrs - have hfieldLocal : pos + 1 < locals.length := by - simp only [AverCert.PlanCheck.bindArmCount, - AverCert.PlanCheck.bindArmLeaf] at hlen - omega - by_cases htag : tag = tyIdx - · subst tag - obtain ⟨x, v, hfield, hrepr, hn⟩ := - evalCascade_hit_inv (by intro k h; cases h) hsem - subst n - have hhit := simLeaf S host ar callee hostTable add sub hslots - hadd hsub scrutineeLocal (pos + 1) tyIdx locals fields x v - hslot hfieldLocal hfield hrepr (.hostOp role kk cf) hitInstrs - base ha - have hif := blockOK_ifElse S host ar callee - (evalLeaf (.hostOp role kk cf) x) base hitInstrs restInstrs - locals base true (by simpa using hhit) - cases first <;> - simpa [BlockOK, StackOK, wRunF, hslot, b32] using hif - · have hrest := evalCascade_miss_inv htag hsem - have hrestLen : pos + 1 + - AverCert.PlanCheck.bindArmCount rest < locals.length := by - simp only [AverCert.PlanCheck.bindArmCount, - AverCert.PlanCheck.bindArmLeaf] at hlen - omega - have htail := ih (pos + 1) false n restInstrs base hrest - hrestLen (by cases rest <;> simp) hr - have hif := blockOK_ifElse S host ar callee n base - hitInstrs restInstrs locals base false (by simpa using htail) - cases first <;> - simp [BlockOK, StackOK, wRunF, hslot, b32, htag] at hif ⊢ <;> - exact hif - -/-! ### Generic family certificate -/ - -theorem generic_int_dispatch_certified {C : Nat} (S : CarrierSpec C) - (plan : IntDispatchRawPlan) - (code : CodeTbl) (host : HostTbl) (self : Nat) - (hostTable : List (HostRole × Nat)) - (add sub : List WVal → Option WVal) - (hslots : HostSlots C host hostTable add sub) - (hadd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w) - (hsub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (hroot : ∃ tyIdx leaf rest, plan.body = .test tyIdx leaf rest) - (body : List WInstr) - (hlow : AverCert.PlanLower.lowerIntDispatchBody hostTable plan = some body) - (hself : code self = some { - arity := 1, - nlocals := AverCert.PlanCheck.bindArmCount plan.body + 2, - body := body }) : - ∀ fuel tag fields n w, - EvalCascade S plan.body tag fields n → - wFuncN code host (fuel + 1) self [.structv tag fields] = some w → - S.Repr n w := by - intro fuel tag fields n w hsem hrun - rcases hroot with ⟨rootTy, rootLeaf, rootRest, hroot⟩ - simp only [wFuncN, hself] at hrun - let nlocals := AverCert.PlanCheck.bindArmCount plan.body + 2 - let scrutineeLocal := AverCert.PlanCheck.bindArmCount plan.body + 1 - let locals : List WVal := [WVal.structv tag fields] ++ - List.replicate nlocals WVal.null - let updated := locals.set scrutineeLocal (WVal.structv tag fields) - have hslt : scrutineeLocal < locals.length := by - simp [scrutineeLocal, locals, nlocals] - have hslot : updated[scrutineeLocal]? = some (.structv tag fields) := by - exact List.getElem?_set_self hslt - have hlen : 0 + AverCert.PlanCheck.bindArmCount plan.body < - updated.length := by - simp [updated, locals, nlocals] - omega - cases hcascade : AverCert.PlanLower.lowerIntDispatchCascade hostTable - scrutineeLocal 0 true plan.body with - | none => simp [AverCert.PlanLower.lowerIntDispatchBody, scrutineeLocal, - hcascade] at hlow - | some cascade => - simp only [AverCert.PlanLower.lowerIntDispatchBody, scrutineeLocal, - hcascade, Option.some.injEq] at hlow - subst body - have hsim := simCascade S host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - hostTable add sub hslots hadd hsub scrutineeLocal updated tag fields hslot - plan.body 0 true n cascade [] hsem hlen (by - simp [hroot]) - hcascade - change - (match wRunF host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - ([.localGet 0, .localSet scrutineeLocal, .localGet scrutineeLocal] ++ cascade) - locals [] with - | some (.ok _ [value]) => some value - | some (.ret value) => some value - | _ => none) = some w at hrun - simp only [List.cons_append, List.nil_append, wRunF] at hrun - have hzero : locals[0]? = some (WVal.structv tag fields) := by - simp [locals] - have hslotRaw : (locals.set scrutineeLocal - (WVal.structv tag fields))[scrutineeLocal]? = - some (WVal.structv tag fields) := - List.getElem?_set_self hslt - simp only [hzero, hslotRaw] at hrun - change - (match wRunF host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - cascade updated [WVal.structv tag fields] with - | some (.ok _ [value]) => some value - | some (.ret value) => some value - | _ => none) = some w at hrun - cases hr : wRunF host (fun g => (code g).map (·.arity)) - (fun g args => wFuncN code host fuel g args) - cascade updated [.structv tag fields] with - | none => simp [hr] at hrun - | some out => - cases out with - | ret value => - simp [hr] at hrun - have hfalse := hsim (.ret value) hr - simp [StackOK] at hfalse - | ok finalLocals stack => - cases stack with - | nil => simp [hr] at hrun - | cons value rest => - cases rest with - | nil => - simp [hr] at hrun - subst w - have hok := hsim (.ok finalLocals [value]) hr - exact hok.2 - | cons x xs => simp [hr] at hrun - - -end IntDispatchSoundness diff --git a/aver-cert/assets/wall/current/ModelPrelude.lean b/aver-cert/assets/wall/current/ModelPrelude.lean new file mode 100644 index 000000000..b2836cb9b --- /dev/null +++ b/aver-cert/assets/wall/current/ModelPrelude.lean @@ -0,0 +1,240 @@ +/- ModelPrelude — the checker-owned pieces of the certificate source model. + + A certificate package ships the `aver proof` model of the certified module + as untrusted DATA, and the checker's token gate refuses every construct in + package text that can change how later text elaborates: `syntax`, + `macro_rules`, attributes (`@[simp]`). Two prelude pieces the model needs + are exactly such constructs, so they live HERE, in the wall, where the + checker owns the text and pins it by the wall id: + + * `AverBits` — the model of Aver's `Bits.*` builtins over `Int`, with its + four definitional equations and the complement involution as `@[simp]` + lemmas (the attribute is what lets the law proofs' `simp` reach them); + * `aver_sq_nonneg` and the `aver_int_order` tactic — the nonlinear + order-decision step the law proofs close product inequalities with. + `aver_int_order` is a `syntax`/`macro_rules` pair, and it is recursive, + so it cannot be expanded into the proofs that use it. + + The text below is byte-identical to the compiler's prelude constants + (`LEAN_PRELUDE_AVER_BITS`, `LEAN_PRELUDE_NONLINEAR_NONNEG` in + `src/codegen/lean/prelude.rs`; a compiler test pins the two together). + A model file imports this module only when it uses one of the pieces. -/ + +namespace AverBits + +/-- Magnitude of the infinite two's-complement reading of `x`. -/ +def mag (x : Int) : Nat := + if x < 0 then (-x - 1).toNat else x.toNat + +/-- Pointwise conjunction. Both non-negative: plain `Nat` conjunction. One + negative: `other AND NOT negative`, i.e. `other - (other AND negative)`. + Both negative: every result bit is `NOT (a OR b)`, so the answer is + negative with complement magnitude `a OR b`. -/ +def and (a b : Int) : Int := + let x := mag a + let y := mag b + if a < 0 then + if b < 0 then -((Nat.lor x y : Int)) - 1 else ((y - Nat.land x y : Nat) : Int) + else + if b < 0 then ((x - Nat.land x y : Nat) : Int) else ((Nat.land x y : Nat) : Int) + +/-- Pointwise disjunction, by the same case split. -/ +def or (a b : Int) : Int := + let x := mag a + let y := mag b + if a < 0 then + if b < 0 then -((Nat.land x y : Int)) - 1 else -((x - Nat.land x y : Nat) : Int) - 1 + else + if b < 0 then -((y - Nat.land x y : Nat) : Int) - 1 else ((Nat.lor x y : Nat) : Int) + +/-- Pointwise exclusive-or. The magnitudes always xor; only the SIGN of the + result depends on whether the two sign tails differ. -/ +def xor (a b : Int) : Int := + let x := mag a + let y := mag b + if a < 0 then + if b < 0 then ((Nat.xor x y : Nat) : Int) else -((Nat.xor x y : Nat) : Int) - 1 + else + if b < 0 then -((Nat.xor x y : Nat) : Int) - 1 else ((Nat.xor x y : Nat) : Int) + +/-- Pointwise complement, which over `Int` is exactly `-x - 1`. -/ +def not (a : Int) : Int := -a - 1 + +def shiftLeft (x n : Int) : Int := x * 2 ^ n.toNat +def shiftRight (x n : Int) : Int := x / 2 ^ n.toNat +def low (x w : Int) : Int := x % 2 ^ w.toNat + +/-- The four definitional equations, as `simp` lemmas. Without them a law + like `Bits.not x = -x - 1` is true by `rfl` yet invisible to the tactic + portfolio, which unfolds the USER's function and then stalls on an + opaque-looking `AverBits.*` head. With them, an arithmetic law about the + bit-level view reduces to an ordinary `Int` goal that `simp` / `omega` / + `grind` already close. They fire only on `AverBits.*` terms, so no proof + that never mentions `Bits` is affected. -/ +@[simp] theorem not_eq (x : Int) : not x = -x - 1 := rfl +@[simp] theorem shiftLeft_eq (x n : Int) : shiftLeft x n = x * 2 ^ n.toNat := rfl +@[simp] theorem shiftRight_eq (x n : Int) : shiftRight x n = x / 2 ^ n.toNat := rfl +@[simp] theorem low_eq (x w : Int) : low x w = x % 2 ^ w.toNat := rfl + +/-- Complementing twice is the identity — stated in the form `simp` actually + reaches. `not_eq` rewrites innermost-first, so a `not (not x)` goal has + already become `-(-x - 1) - 1 = x` by the time any lemma about `not` + could fire; matching THAT shape is what makes the involution close + without widening the tactic portfolio. The rewrite is terminating and + matches only this exact term. -/ +@[simp] theorem neg_complement_involution (x : Int) : -(-x - 1) - 1 = x := by + omega + +/-! Masks. A law that masks with a literal (`Bits.and(x, 128)`) is read through + `Nat`: split on the sign of `x`, rewrite `and` with `and_of_nonneg` or + `and_of_neg`, then take the mask apart into single bits (`nat_land_bit`) + and low runs (`nat_land_low`), splitting a composite mask at a run + boundary with `nat_land_split`. What is left is `/` and `%` by literals, + which `omega` decides. Core Lean only. -/ + +/-- A nonnegative number masked by a nonnegative literal mask is the `Nat` + conjunction of the two. -/ +theorem and_of_nonneg (a m : Int) (M : Nat) (hM : m = M) (ha : 0 ≤ a) : + AverBits.and a m = ((a.toNat &&& M : Nat) : Int) := by + subst hM + have hm : ¬ ((M : Int) < 0) := by omega + have hna : ¬ (a < 0) := by omega + simp only [AverBits.and, AverBits.mag, hm, hna, ite_false, Int.toNat_natCast, Nat.land_eq] + +/-- A negative number masked by a nonnegative literal mask: the mask minus the + mask bits the complement `-a - 1` carries. -/ +theorem and_of_neg (a m : Int) (M : Nat) (hM : m = M) (ha : a < 0) : + AverBits.and a m = ((M - ((-a - 1).toNat &&& M) : Nat) : Int) := by + subst hM + have hm : ¬ ((M : Int) < 0) := by omega + simp only [AverBits.and, AverBits.mag, hm, ha, ite_true, ite_false, Int.toNat_natCast, Nat.land_eq] + +/-- A low mask `2^k - 1` keeps the remainder by `2^k`. -/ +theorem nat_land_low (x m M k : Nat) (hM : m + 1 = M) (hk : M = 2 ^ k) : x &&& m = x % M := by + subst hk + have e : m = 2 ^ k - 1 := by omega + rw [e, Nat.and_two_pow_sub_one_eq_mod] + +/-- A single-bit mask `2^k` keeps that bit of the quotient. -/ +theorem nat_land_bit (x m k : Nat) (hm : m = 2 ^ k) : x &&& m = m * (x / m % 2) := by + subst hm + apply Nat.eq_of_testBit_eq + intro i + rw [Nat.testBit_and, Nat.testBit_two_pow] + rcases Nat.mod_two_eq_zero_or_one (x / 2 ^ k) with h | h + · rw [h, Nat.mul_zero, Nat.zero_testBit] + by_cases hk : k = i + · subst hk + rw [Nat.testBit_eq_decide_div_mod_eq, h] + simp + · simp [hk] + · rw [h, Nat.mul_one, Nat.testBit_two_pow] + by_cases hk : k = i + · subst hk + rw [Nat.testBit_eq_decide_div_mod_eq, h] + simp + · simp [hk] + +/-- A mask `2^j * hi + lo` with `lo < 2^j` splits at bit `j`: the high part + masks the quotient, the low part the remainder. Applied repeatedly it takes + any literal mask apart into single bits and low runs. -/ +theorem nat_land_split (x m P j hi lo : Nat) (hP : P = 2 ^ j) (hm : m = P * hi + lo) + (hlo : lo < P) : x &&& m = P * ((x / P) &&& hi) + ((x % P) &&& lo) := by + subst hP + subst hm + have hlt : (x % 2 ^ j) &&& lo < 2 ^ j := Nat.and_lt_two_pow _ hlo + apply Nat.eq_of_testBit_eq + intro i + rw [Nat.testBit_and, Nat.testBit_two_pow_mul_add _ hlo, Nat.testBit_two_pow_mul_add _ hlt] + by_cases hij : i < j + · simp [hij, Nat.testBit_and, Nat.testBit_mod_two_pow] + · simp [hij, Nat.testBit_and, Nat.testBit_div_two_pow, + Nat.sub_add_cancel (Nat.le_of_not_lt hij)] + +end AverBits + +/-- A square is never negative — the sign-split base case the product +closer bottoms out on (`Int.mul_self_nonneg` is absent from core Int). -/ +theorem aver_sq_nonneg (t : Int) : 0 ≤ t * t := by + rcases Int.le_total 0 t with h | h + · exact Int.mul_nonneg h h + · have h2 : 0 ≤ -t := by omega + have := Int.mul_nonneg h2 h2 + rwa [Int.neg_mul_neg] at this + +/-- Generic nonneg/order decision step for nonlinear Int products: the +`omega`-analog for the products-and-squares fragment. Recurse on a product +with `Int.mul_nonneg` (nonneg goal `0 ≤ a*b`), `Int.mul_pos` (strict goal +`0 < a*b`, the value-magnitude positivity the rounding sign condition needs), +or `Int.mul_le_mul` (product ≤ product), +close a product order whose two sides share their right factor (`a*c ≤ b*c` +from `a ≤ b`, `0 ≤ c`) with `Int.mul_le_mul_of_nonneg_right`, bottom squares +out on `aver_sq_nonneg`, split a conjunctive premise, and discharge the linear +leaves with `omega`. The `mul_pos` rung sits right after `mul_nonneg` (their +conclusions `0 < _` / `0 ≤ _` never unify, so neither shadows the other). The +`mul_le_mul_of_nonneg_right` rung sits BEFORE +`mul_le_mul`, and that order is load-bearing for performance: `mul_le_mul` +would also unify with `a*c ≤ b*c` (taking `d := c`) but spawns a `0 ≤ b` leaf +that is NOT derivable when the law carries no `0 ≤ a` guard. Trying +`mul_le_mul_of_nonneg_right` first closes such a goal directly from `a ≤ b` / +`0 ≤ c` and never spawns `0 ≤ b`; on the squared shapes (`e*e ≤ b*b`, the +contraction's `s²` bound) its shared-right-factor unification fails fast (the +two right factors differ), so `mul_le_mul` still takes them — and any genuine +`0 ≤ b` leaf there is closed by the early `omega` rung from that family's +`0 ≤ e ≤ b` guards. The `mul_le_mul` arm is NOT heartbeat-capped: a +deterministic `whnf` timeout is a HARD, uncatchable failure of a `first` +portfolio at the tactic level — it aborts `lake build` rather than falling +through to the next `first` alternative. `set_option maxHeartbeats … in` only +takes effect at the COMMAND level, never inside a `first | …` tactic +alternative (measured 2026-07-02 across three controlled builds under Lean +4.31: the inline wrapper changed nothing). So this timeout class is not +containable here. What actually keeps this arm from diverging in practice is +the narrower conjunction split below (keyed to the named `h_when` guard rather +than an anonymous `_ ∧ _` match, so it no longer feeds spurious metavariable +products into the product rungs), not any cap. When a timeout does occur its +class is surfaced truthfully by the `--check-json` `build_errors` field; the +named follow-up is driver-level re-emission of the offending law WITHOUT this +arm (a tactic-level cap cannot do it). + +The MULTIPLY-BY-POSITIVE rungs (`mul_lt_mul_of_pos_left` / `_right` for a strict +product order `m*a < m*b` / `a*m < b*m`, and `mul_le_mul_of_nonneg_left` for the +nonstrict `m*a ≤ m*b`) sit LAST, after the `<=`-conclusion rungs. They are the +generic non-recursive composition step `omega`/`grind` cannot do — multiplying an +inequality `a < b` by a positive factor `m` — and close any goal already in the +multiplied form `m*a < m*b` from `a < b` (`assumption`) and `0 < m` (the +`mul_pos` recursion on the positive factor). The rational-floor truncation-error +bound (Lemma 7.2.2) ring-bridges its goal into exactly that shape and hands it to +this rung; the same rung is the general non-recursive `mulLeTrans`/`fpMulValue` +composition step. Placed last so their strict (`<`) conclusion never shadows a +`<=`/`0 <=`/`0 <` goal the earlier rungs own (a strict-conclusion lemma cannot +unify with a non-strict goal, but keeping them last also keeps the common +nonneg/positivity search shallow and the output byte-identical for corpora that +never hit a multiplied-form goal). + +The final arm splits a named guard conjunction and recurses. It reads the +hypothesis LITERALLY named `h_when` — the order-law emitters +(`law_auto/inequality.rs`, `law_auto/induction/floor_bound.rs`) intro the guard +under exactly that name and `simp … at h_when ⊢` — takes `And.left`/`And.right`, +and recurses. This is a NAMING CONTRACT: any new order-law emitter that renames +the guard makes this arm silently no-op (no `h_when` in context), and the goal +falls to `sorry`. It also peels ONE level only (measured): a right-nested guard +of three-plus conjuncts (`A ∧ (B ∧ C)`) yields `h_when_left := A` / +`h_when_right := B ∧ C`, leaving the inner conjunction bundled. -/ +syntax "aver_int_order" : tactic +macro_rules + | `(tactic| aver_int_order) => `(tactic| + first + | assumption + | omega + | exact aver_sq_nonneg _ + | (apply Int.mul_nonneg <;> aver_int_order) + | (apply Int.mul_pos <;> aver_int_order) + | (apply Int.mul_le_mul_of_nonneg_right <;> aver_int_order) + | (apply Int.mul_le_mul <;> aver_int_order) + | (apply Int.mul_lt_mul_of_pos_left <;> aver_int_order) + | (apply Int.mul_lt_mul_of_pos_right <;> aver_int_order) + | (apply Int.mul_le_mul_of_nonneg_left <;> aver_int_order) + | (have h_when_left := And.left h_when + have h_when_right := And.right h_when + clear h_when + aver_int_order)) diff --git a/aver-cert/assets/wall/current/MutualRecursionSoundness.lean b/aver-cert/assets/wall/current/MutualRecursionSoundness.lean deleted file mode 100644 index eacff4871..000000000 --- a/aver-cert/assets/wall/current/MutualRecursionSoundness.lean +++ /dev/null @@ -1,324 +0,0 @@ -/- Mutual-recursion soundness — a k-generic conjunction layer over the - unary recursion/fuel proof. - - A member is a byte-bound unary countdown body. Its step tail-calls the - byte-bound member at `cross`. `Fin k` makes the proof motive the finite - conjunction of all k members; the sole fuel induction cites the matching - conjunct at fuel-1. -/ -import CertPrelude -import SchemaCore -import PlanCheck -import PlanLower -import AcceptedArtifactCore - -set_option linter.unusedSimpArgs false -set_option linter.unusedVariables false -set_option maxRecDepth 1000000 - -namespace MutualRecursionSoundness -open CertPrelude AverCert AverCert.Schema AverCert.PlanLower - -structure MemberU (k : Nat) where - self : Nat - base : Int - cross : Fin k -deriving Repr, DecidableEq - -/-! The mutual fuel twin. This is `evalRecUFuel` with the recursive member - selected by the byte-derived cross edge. -/ - -def evalMutualUFuel {k : Nat} (members : Fin k → MemberU k) : - Nat → Fin k → Int → Int - | 0, _, _ => 0 - | fuel + 1, i, n => - if n ≤ 0 then (members i).base - else evalMutualUFuel members fuel (members i).cross (n - 1) - -def evalMutualU {k : Nat} (members : Fin k → MemberU k) - (i : Fin k) (n : Int) : Int := - evalMutualUFuel members (n.natAbs + 1) i n - -/-- One cap induction proves fuel irrelevance for every member simultaneously. - The `∀ i : Fin k` result is the k-generic finite conjunction. -/ -theorem evalMutualU_fuel_irrel {k : Nat} (members : Fin k → MemberU k) : - ∀ (t k1 k2 : Nat) (n : Int), n.natAbs < t → n.natAbs < k1 → n.natAbs < k2 → - ∀ i : Fin k, - evalMutualUFuel members k1 i n = evalMutualUFuel members k2 i n := by - intro t - induction t with - | zero => intro k1 k2 n ht _ _ i; omega - | succ t ih => - intro k1 k2 n ht h1 h2 i - cases k1 with - | zero => omega - | succ m1 => - cases k2 with - | zero => omega - | succ m2 => - by_cases hn : n ≤ 0 - · simp [evalMutualUFuel, hn] - · have hstep : (n - 1).natAbs < t := by - have h1n : (1 : Int) ≤ n := by omega - have h2n : (n - 1).natAbs = n.natAbs - 1 := by omega - omega - simp only [evalMutualUFuel] - rw [if_neg hn, if_neg hn] - exact ih m1 m2 (n - 1) hstep (by omega) (by omega) (members i).cross - -theorem evalMutualU_fuel_stable {k : Nat} (members : Fin k → MemberU k) - (fuel : Nat) (i : Fin k) (n : Int) (h : n.natAbs < fuel) : - evalMutualUFuel members fuel i n = evalMutualU members i n := - evalMutualU_fuel_irrel members (n.natAbs + fuel + 1) fuel (n.natAbs + 1) - n (by omega) h (by omega) i - -theorem evalMutualU_base {k : Nat} (members : Fin k → MemberU k) - (i : Fin k) (n : Int) (hn : n ≤ 0) : - evalMutualU members i n = (members i).base := by - have h0 : evalMutualU members i n = - evalMutualUFuel members (n.natAbs + 1) i n := rfl - rw [h0] - simp [evalMutualUFuel, hn] - -theorem evalMutualU_step {k : Nat} (members : Fin k → MemberU k) - (i : Fin k) (n : Int) (hn : ¬ n ≤ 0) : - evalMutualU members i n = evalMutualU members (members i).cross (n - 1) := by - have h0 : evalMutualU members i n = - evalMutualUFuel members (n.natAbs + 1) i n := rfl - rw [h0] - simp only [evalMutualUFuel] - rw [if_neg hn] - exact evalMutualU_fuel_stable members n.natAbs (members i).cross (n - 1) (by omega) - -/-! Canonical lowering of one accepted mutual-countdown member. -/ - -def signSmallInstrs (C : Nat) : List WInstr := - [.localGet 0, .structGet C 0, .i64Const 0, .i64LeS] - -def signBigInstrs (C : Nat) : List WInstr := - [.localGet 0, .structGet C 2, .i32Const 0, .i32LtS] - -def mutualInstrs {k : Nat} (C boxIdx subIdx : Nat) (members : Fin k → MemberU k) - (i : Fin k) : List WInstr := - [.localGet 0, .structGet C 1, .refIsNull, - .ifElse (signSmallInstrs C) (signBigInstrs C), - .ifElse [.i64Const (members i).base, .call boxIdx] - [.localGet 0, .i64Const 1, .call boxIdx, .call subIdx, - .returnCall (members (members i).cross).self]] - -/-- The plan/byte admission package. SCC closure is deliberately a hypothesis: - production's `mutualMembersFormClosedSccs` already proves it in-kernel. - `lowered` is the required equality from each checked, byte-bound plan to the - canonical member body; changing a cross target breaks this equality. -/ -structure AdmittedScc (k C boxIdx subIdx : Nat) where - members : Fin k → MemberU k - plans : Fin k → MutualRawPlan - rawEdges : List (Nat × Nat × List Nat) - edgesBound : rawEdges = List.ofFn (fun i => - ((members i).self, (members (members i).cross).self, - List.ofFn (fun j => (members j).self))) - closed : AverCert.AcceptedArtifact.mutualMembersFormClosedSccs rawEdges = true - checked : ∀ i, AverCert.PlanCheck.checkMutualRawPlan (plans i) = true - shaped : ∀ i, - AverCert.PlanCheck.checkMutualPlanShape - (List.ofFn (fun j => (members j).self)) - [(.box, boxIdx), (.sub, subIdx)] (plans i) = true - lowered : ∀ i, - lowerMutualBody C (plans i) = some (mutualInstrs C boxIdx subIdx members i) - -/-! One conjunction-over-fuel simulation theorem. -/ - -/-- Every admitted k-member SCC simulates its mutual fuel-twin. There is one - induction over fuel and one finite-conjunction motive (`∀ i : Fin k`). - In the cross-call arm the recursive fact is exactly - `ih (members i).cross ...`. -/ -theorem mutual_generic_certified - (k C boxIdx subIdx : Nat) - (scc : AdmittedScc k C boxIdx subIdx) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (sub : List WVal → Option WVal) - (hBox : host boxIdx = some (1, boxRef C)) - (hSubHost : host subIdx = some (2, sub)) - (hMemberHost : ∀ i, host (scc.members i).self = none) - (hCode : ∀ i, code (scc.members i).self = - some ⟨1, 1, mutualInstrs C boxIdx subIdx scc.members i⟩) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) : - ∀ (fuel : Nat) (i : Fin k) (n : Int) (v w : WVal), S.Repr n v → - wFuncN code host fuel (scc.members i).self [v] = some w → - S.Repr (evalMutualU scc.members i n) w := by - intro fuel - induction fuel with - | zero => - intro i n v w hv hrun - simp [wFuncN] at hrun - | succ fuel ih => - intro i n v w hv hrun - rcases S.car n v hv with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ - · have hs := S.smallElim n s sg hv - subst hs - by_cases hle : s ≤ (0 : Int) - · simp [wFuncN, wRunF, hCode i, hBox, hMemberHost i, - mutualInstrs, signSmallInstrs, signBigInstrs, - boxRef, b32, popArgs, initLocals, hle] at hrun - rw [evalMutualU_base scc.members i s hle, ← hrun] - exact S.smallIntro (scc.members i).base - · simp [wFuncN, wRunF, hCode i, hCode (scc.members i).cross, - hBox, hSubHost, hMemberHost i, - mutualInstrs, signSmallInstrs, signBigInstrs, - boxRef, b32, popArgs, initLocals, hle] at hrun - rcases hsub : sub - [.structv C [.i64v s, .null, .i32v sg], carrierSmall C 1] with _ | vd - · simp [hsub] at hrun - · simp only [hsub] at hrun - have hrd : S.Repr (s - 1) vd := - hSub s 1 _ _ vd hv (S.smallIntro 1) hsub - rcases hrec : wFuncN code host fuel - (scc.members (scc.members i).cross).self [vd] with _ | vr - · simp [hrec] at hrun - · simp only [hrec] at hrun - have hrr := ih (scc.members i).cross (s - 1) vd vr hrd hrec - rw [evalMutualU_step scc.members i s hle] - rw [Option.some.injEq] at hrun - rw [← hrun] - exact hrr - · obtain ⟨hsign, hne⟩ := S.bigElim n s lty les sg hv - by_cases hlt : sg < (0 : Int) - · have hn0 : n ≤ 0 := by have := hsign.mp hlt; omega - simp [wFuncN, wRunF, hCode i, hBox, hMemberHost i, - mutualInstrs, signSmallInstrs, signBigInstrs, - boxRef, b32, popArgs, initLocals, hlt] at hrun - rw [evalMutualU_base scc.members i n hn0, ← hrun] - exact S.smallIntro (scc.members i).base - · have hn0 : ¬ n ≤ 0 := by - intro hle - have : ¬ n < 0 := fun h => hlt (hsign.mpr h) - omega - simp [wFuncN, wRunF, hCode i, hCode (scc.members i).cross, - hBox, hSubHost, hMemberHost i, - mutualInstrs, signSmallInstrs, signBigInstrs, - boxRef, b32, popArgs, initLocals, hlt] at hrun - rcases hsub : sub - [.structv C [.i64v s, .arr lty les, .i32v sg], carrierSmall C 1] with _ | vd - · simp [hsub] at hrun - · simp only [hsub] at hrun - have hrd : S.Repr (n - 1) vd := - hSub n 1 _ _ vd hv (S.smallIntro 1) hsub - rcases hrec : wFuncN code host fuel - (scc.members (scc.members i).cross).self [vd] with _ | vr - · simp [hrec] at hrun - · simp only [hrec] at hrun - have hrr := ih (scc.members i).cross (n - 1) vd vr hrd hrec - rw [evalMutualU_step scc.members i n hn0] - rw [Option.some.injEq] at hrun - rw [← hrun] - exact hrr - -/-- Fuel-parametric progress for every member of an admitted countdown SCC. - The single induction keeps all members in its motive, so a cross call uses - the totality fact for exactly the byte-derived successor member. -/ -theorem mutual_generic_certified_total_aux - (k C boxIdx subIdx : Nat) - (scc : AdmittedScc k C boxIdx subIdx) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (sub : List WVal → Option WVal) - (hBox : host boxIdx = some (1, boxRef C)) - (hSubHost : host subIdx = some (2, sub)) - (hMemberHost : ∀ i, host (scc.members i).self = none) - (hCode : ∀ i, code (scc.members i).self = - some ⟨1, 1, mutualInstrs C boxIdx subIdx scc.members i⟩) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, sub [va, vb] = some w) : - ∀ fuel i n v, S.Repr n v → n.natAbs < fuel → - ∃ w, wFuncN code host fuel (scc.members i).self [v] = some w ∧ - S.Repr (evalMutualU scc.members i n) w := by - intro fuel - induction fuel with - | zero => - intro i n v hv hlt - omega - | succ fuel ih => - intro i n v hv hlt - rcases S.car n v hv with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ - · have hs := S.smallElim n s sg hv - subst hs - by_cases hle : s ≤ (0 : Int) - · refine ⟨carrierSmall C (scc.members i).base, ?_, ?_⟩ - · simp [wFuncN, wRunF, hCode i, hBox, hMemberHost i, - mutualInstrs, signSmallInstrs, signBigInstrs, - boxRef, b32, popArgs, initLocals, hle] - · rw [evalMutualU_base scc.members i s hle] - exact S.smallIntro (scc.members i).base - · obtain ⟨vd, hsub⟩ := hSubTot s 1 _ (carrierSmall C 1) - hv (S.smallIntro 1) - have hrd : S.Repr (s - 1) vd := - hSub s 1 _ _ vd hv (S.smallIntro 1) hsub - obtain ⟨vr, hrec, hrr⟩ := - ih (scc.members i).cross (s - 1) vd hrd (by omega) - refine ⟨vr, ?_, ?_⟩ - · simp [wFuncN, wRunF, hCode i, hCode (scc.members i).cross, - hBox, hSubHost, hMemberHost i, mutualInstrs, - signSmallInstrs, signBigInstrs, boxRef, b32, popArgs, - initLocals, hle, hsub, hrec] - · rw [evalMutualU_step scc.members i s hle] - exact hrr - · obtain ⟨hsign, hne⟩ := S.bigElim n s lty les sg hv - by_cases hlt : sg < (0 : Int) - · have hn0 : n ≤ 0 := by - have := hsign.mp hlt - omega - refine ⟨carrierSmall C (scc.members i).base, ?_, ?_⟩ - · simp [wFuncN, wRunF, hCode i, hBox, hMemberHost i, - mutualInstrs, signSmallInstrs, signBigInstrs, - boxRef, b32, popArgs, initLocals, hlt] - · rw [evalMutualU_base scc.members i n hn0] - exact S.smallIntro (scc.members i).base - · have hn0 : ¬ n ≤ 0 := by - intro hle - have : ¬ n < 0 := fun h => hlt (hsign.mpr h) - omega - obtain ⟨vd, hsub⟩ := hSubTot n 1 _ (carrierSmall C 1) - hv (S.smallIntro 1) - have hrd : S.Repr (n - 1) vd := - hSub n 1 _ _ vd hv (S.smallIntro 1) hsub - obtain ⟨vr, hrec, hrr⟩ := - ih (scc.members i).cross (n - 1) vd hrd (by omega) - refine ⟨vr, ?_, ?_⟩ - · simp [wFuncN, wRunF, hCode i, hCode (scc.members i).cross, - hBox, hSubHost, hMemberHost i, mutualInstrs, - signSmallInstrs, signBigInstrs, boxRef, b32, popArgs, - initLocals, hlt, hsub, hrec] - · rw [evalMutualU_step scc.members i n hn0] - exact hrr - -/-- Bounded-total correctness at the standard `Int.natAbs + 1` fuel for the - whole admitted SCC conjunction. -/ -theorem mutual_generic_certified_total - (k C boxIdx subIdx : Nat) - (scc : AdmittedScc k C boxIdx subIdx) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (sub : List WVal → Option WVal) - (hBox : host boxIdx = some (1, boxRef C)) - (hSubHost : host subIdx = some (2, sub)) - (hMemberHost : ∀ i, host (scc.members i).self = none) - (hCode : ∀ i, code (scc.members i).self = - some ⟨1, 1, mutualInstrs C boxIdx subIdx scc.members i⟩) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, sub [va, vb] = some w) : - ∀ i n v, S.Repr n v → - ∃ w, wFuncN code host (n.natAbs + 1) (scc.members i).self [v] = some w ∧ - S.Repr (evalMutualU scc.members i n) w := by - intro i n v hv - apply mutual_generic_certified_total_aux k C boxIdx subIdx scc S code host sub - hBox hSubHost hMemberHost hCode hSub hSubTot - · exact hv - · omega - - -end MutualRecursionSoundness diff --git a/aver-cert/assets/wall/current/PlanBytes.lean b/aver-cert/assets/wall/current/PlanBytes.lean deleted file mode 100644 index 73f9484d5..000000000 --- a/aver-cert/assets/wall/current/PlanBytes.lean +++ /dev/null @@ -1,815 +0,0 @@ --- Lean-side canonical byte lowering from `expr-fragment-v1` raw plans to the --- exact Wasm code-entry byte sequence used by the current cert island. --- --- This is still not a full Wasm module parser. It is the plan-first byte --- encoder for one checked profile: local declarations + expression body + --- body-size prefix. -import PlanLower - -namespace AverCert.PlanBytes -open AverCert.Schema - -/-- Canonical unsigned LEB128 of a u32 index, or `none` outside the range. - The bytes come from the shared total encoder (`CertPrelude.uleb32Bytes`, - exact below `2 ^ 35`); the guard keeps this plan-side wrapper fail-closed - at the u32 boundary the wasm binary format admits. -/ -def uleb32 (value : Nat) : Option (List Nat) := - if value < 4294967296 then some (CertPrelude.uleb32Bytes value) else none - -def slebFuel : Nat → Int → Option (List Nat) - | 0, _ => none - | fuel + 1, value => - let byte := Int.toNat (value % 128) - let rest := value / 128 - let signSet := 64 ≤ byte - let done := (rest = 0 ∧ !signSet) ∨ (rest = -1 ∧ signSet) - let outByte := if done then byte else byte + 128 - if done then - some [outByte] - else - match slebFuel fuel rest with - | some bytes => some (outByte :: bytes) - | none => none - -def inI32Range (value : Int) : Bool := - if (-2147483648 : Int) ≤ value then - if value ≤ 2147483647 then true else false - else - false - -def inI64Range (value : Int) : Bool := - if (-9223372036854775808 : Int) ≤ value then - if value ≤ 9223372036854775807 then true else false - else - false - -def sleb32 (value : Int) : Option (List Nat) := - if inI32Range value then slebFuel 5 value else none - -def sleb64 (value : Int) : Option (List Nat) := - if inI64Range value then slebFuel 10 value else none - -/-- Concrete heap-type indices (inside a reftype `0x63/0x64 `, a block type, - or a `ref.cast`/`ref.test`/`ref.null` immediate) are encoded as SIGNED s33 - LEB128 per the Wasm spec, not unsigned: index 64 is `c0 00`, never `40`. - Indices below 64 coincide with the unsigned encoding. Instruction TYPE - indices (`struct.get`, `array.new_data`, …) stay unsigned u32. The bytes - come from the shared total encoder (`CertPrelude.s33Bytes`, exact below - `2 ^ 41`); the guard keeps this plan-side wrapper fail-closed at the u32 - boundary. -/ -def s33HeapIdx (idx : Nat) : Option (List Nat) := - if idx < 4294967296 then some (CertPrelude.s33Bytes idx) else none - -/-- Prefix a successfully lowered function body with its canonical u32 byte - length, producing the exact byte sequence stored as one Wasm code entry. -/ -private def codeEntryBytes : Option (List Nat) → Option (List Nat) - | some body => - match uleb32 body.length with - | some lengthBytes => some (lengthBytes ++ body) - | none => none - | none => none - -/-- Encode the local declaration shared by plan families that reserve exactly - one nullable carrier-reference local, then append the lowered expression. -/ -private def singleCarrierLocalBodyBytes - (carrier : Nat) (exprBytes? : Option (List Nat)) : Option (List Nat) := - match uleb32 1, uleb32 1, s33HeapIdx carrier, exprBytes? with - | some localDeclCount, some localCount, some carrierBytes, some exprBytes => - some (localDeclCount ++ localCount ++ [0x63] ++ carrierBytes ++ exprBytes) - | _, _, _, _ => none - -/-- Encode an EMPTY local-declaration vector, then append the lowered - expression. A module that emits no Int carrier struct has no carrier type to - name in a locals prelude, and the emitter reserves no scratch slot there, so - the code entry opens with a zero declaration-group count and goes straight - into the expression. -/ -private def noLocalBodyBytes (exprBytes? : Option (List Nat)) : Option (List Nat) := - match uleb32 0, exprBytes? with - | some localDeclCount, some exprBytes => some (localDeclCount ++ exprBytes) - | _, _ => none - -/-- Locals prelude selected by the module's byte-derived CARRIER STATE. - - This is deliberately a function of `carrier?` and nothing else: a plan cannot - reach the shorter prelude by describing itself differently, because the only - input that selects it is the carrier state, and every acceptance predicate - that calls this passes a `carrier?` pinned by - `CertDecode.carrierState modBytes modLen`. `some` and `none` are therefore - two states of the MODULE, decided by its type section, not two options open - to the producer. -/ -private def carrierLocalsBodyBytes - (carrier? : Option Nat) (exprBytes? : Option (List Nat)) : Option (List Nat) := - match carrier? with - | some carrier => singleCarrierLocalBodyBytes carrier exprBytes? - | none => noLocalBodyBytes exprBytes? - -def fieldProjectionResultTyBytes : FieldProjectionResultTy → Option (List Nat) - | .eqref => some [0x6d] - | .nullableRef idx => (s33HeapIdx idx).map (fun b => [0x63] ++ b) - -def lowerFieldProjectionCodeEntry - (carrier structIdx fieldCount : Nat) - (resultTy : FieldProjectionResultTy) - (plan : FieldProjectionRawPlan) : Option (List Nat) := - if AverCert.PlanCheck.checkFieldProjectionRawPlan fieldCount plan then - match fieldProjectionResultTyBytes resultTy, - s33HeapIdx carrier, s33HeapIdx structIdx, - uleb32 structIdx, uleb32 plan.fieldIdx with - | some resultTyB, some carrierB, some castTy, some getTy, some fieldB => - let body := [0x03, 0x01] ++ resultTyB ++ - [0x01, 0x6d, 0x01, 0x63] ++ carrierB ++ - [0x20, 0x00, 0x21, 0x02, 0x20, 0x02, 0xfb, 0x16] ++ castTy ++ - [0xfb, 0x02] ++ getTy ++ fieldB ++ - [0x21, 0x01, 0x20, 0x01, 0x0b] - codeEntryBytes (some body) - | _, _, _, _, _ => none - else none - -def f64Bytes (bits : Nat) : Option (List Nat) := - if bits < 18446744073709551616 then - some [ - (bits / (2 ^ 0)) % 256, - (bits / (2 ^ 8)) % 256, - (bits / (2 ^ 16)) % 256, - (bits / (2 ^ 24)) % 256, - (bits / (2 ^ 32)) % 256, - (bits / (2 ^ 40)) % 256, - (bits / (2 ^ 48)) % 256, - (bits / (2 ^ 56)) % 256 - ] - else - none - -/-- Block-type bytes for an `if (result …)`. Scalar results are their value - type byte; an Int-carrier result is the ref-null heap type `63 ` - (the value-if of a fuel-recursion body). `carrier` supplies that index. -/ -def blockTypeBytes (carrier : Nat) : FragTy → Option (List Nat) - | .boolI32 => some [0x7f] - | .rawI32 => some [0x7f] - | .i64 => some [0x7e] - | .f64 => some [0x7c] - | .intCarrier => (s33HeapIdx carrier).map (fun c => [0x63] ++ c) - | .ref => none - | .adtRef => none - -def primBytes : FragPrim → List Nat - | .f64Add => [0xa0] - | .f64Mul => [0xa2] - | .f64Le => [0x65] - | .f64Ge => [0x66] - | .f64Lt => [0x63] - | .f64Gt => [0x64] - | .f64Eq => [0x61] - | .i64Eq => [0x51] - | .i64LtS => [0x53] - | .i64LeS => [0x57] - | .i64GeS => [0x59] - | .i64GtS => [0x55] - | .i32Eq => [0x46] - | .i32LtS => [0x48] - | .i32GtS => [0x4a] - | .i32GeS => [0x4e] - | .i32And => [0x71] - -/-- Byte twin of `PlanLower.intSignCmpBigArm`. -/ -def intSignCmpBigArmBytes (carrier scratch : Nat) : SymIntCmp → Option (List Nat) - | .eq => some [0x41, 0x00] - | op => - match uleb32 scratch, uleb32 0x02, uleb32 carrier, uleb32 2 with - | some scratchB, some getOp, some carrierB, some fieldB => - some ([0x20] ++ scratchB ++ [0xfb] ++ getOp ++ carrierB ++ fieldB ++ - [0x41, 0x00] ++ - primBytes (match op with - | .lt | .le => FragPrim.i32LtS - | _ => FragPrim.i32GtS)) - | _, _, _, _ => none - -/-- Byte twin of `PlanLower.intSignCmpTemplate`: `local.set` (`0x21`), the - `limbs = null` test, and an `i32` block-typed `if` whose arms are the byte - twins of the two `WInstr` arms. -/ -def intSignCmpTemplateBytes (carrier scratch : Nat) (op : SymIntCmp) (k : Int) : - Option (List Nat) := - match uleb32 scratch, uleb32 0x02, uleb32 carrier, uleb32 1, uleb32 0, - sleb64 k, intSignCmpBigArmBytes carrier scratch op with - | some scratchB, some getOp, some carrierB, some limbsField, some smallField, - some kB, some bigBytes => - some ([0x21] ++ scratchB ++ - [0x20] ++ scratchB ++ [0xfb] ++ getOp ++ carrierB ++ limbsField ++ - [0xd1] ++ - [0x04, 0x7f] ++ - ([0x20] ++ scratchB ++ [0xfb] ++ getOp ++ carrierB ++ smallField ++ - [0x42] ++ kB ++ - primBytes (AverCert.PlanLower.intSignCmpSmallPrim op)) ++ - [0x05] ++ bigBytes ++ [0x0b]) - | _, _, _, _, _, _, _ => none - -/-- Byte and semantic lowering share one symbolic-stack discipline and one - fail-closed recursion budget. The aliases retain the public API while - making divergence between the two lowerers impossible here. -/ -abbrev popExpected := AverCert.PlanLower.popExpected -abbrev popExpectedAll := AverCert.PlanLower.popExpectedAll -abbrev maxFuel : Nat := AverCert.PlanLower.maxFuel - -mutual - def lowerNodesBytesFuel : - Nat → Nat → List FragNode → List Nat → Option (List Nat × List Nat) - | 0, _, _, _ => none - | _fuel + 1, _carrier, [], stack => some ([], stack) - | fuel + 1, carrier, node :: rest, stack => - let lowered? : Option (List Nat × List Nat) := - match node.kind with - | .local index => - match uleb32 index with - | some indexBytes => some ([0x20] ++ indexBytes, node.id :: stack) - | none => none - | .constBool value => - match sleb32 (if value then 1 else 0) with - | some valueBytes => some ([0x41] ++ valueBytes, node.id :: stack) - | none => none - | .constI64 value => - match sleb64 value with - | some valueBytes => some ([0x42] ++ valueBytes, node.id :: stack) - | none => none - | .constI32 value => - match sleb32 value with - | some valueBytes => some ([0x41] ++ valueBytes, node.id :: stack) - | none => none - | .constF64Bits bits => - match f64Bytes bits with - | some valueBytes => some ([0x44] ++ valueBytes, node.id :: stack) - | none => none - | .structGet field receiver => - match popExpected stack receiver, uleb32 0x02, uleb32 carrier, uleb32 field with - | some stack', some opBytes, some carrierBytes, some fieldBytes => - some ([0xfb] ++ opBytes ++ carrierBytes ++ fieldBytes, node.id :: stack') - | _, _, _, _ => none - | .structGetUser tyIdx field value => - match popExpected stack value, uleb32 0x02, uleb32 tyIdx, uleb32 field with - | some stack', some opBytes, some tyBytes, some fieldBytes => - some ([0xfb] ++ opBytes ++ tyBytes ++ fieldBytes, node.id :: stack') - | _, _, _, _ => none - | .structNew tyIdx args => - match popExpectedAll stack args.reverse, uleb32 0x00, uleb32 tyIdx with - | some stack', some opBytes, some tyBytes => - some ([0xfb] ++ opBytes ++ tyBytes, node.id :: stack') - | _, _, _ => none - | .refIsNull value => - match popExpected stack value with - | some stack' => some ([0xd1], node.id :: stack') - | none => none - | .prim op args => - match popExpectedAll stack args.reverse with - | some stack' => some (primBytes op, node.id :: stack') - | none => none - | .hostCall _role funcIdx args => - match popExpectedAll stack args.reverse, uleb32 funcIdx with - | some stack', some idxBytes => some ([0x10] ++ idxBytes, node.id :: stack') - | _, _ => none - | .selfCall tail funcIdx args => - match popExpectedAll stack args.reverse, uleb32 funcIdx with - | some stack', some idxBytes => - some ((if tail then [0x12] else [0x10]) ++ idxBytes, node.id :: stack') - | _, _ => none - -- Byte twin of `PlanLower`'s arm: operands already on the symbolic - -- stack stay beneath the emitted `if` block. - | .ifElse cond thenBlock elseBlock => - match popExpected stack cond with - | some stack' => - match blockTypeBytes carrier node.ty, - lowerBlockBytesFuel fuel carrier thenBlock, - lowerBlockBytesFuel fuel carrier elseBlock with - | some blockTy, some thenBytes, some elseBytes => - some ([0x04] ++ blockTy ++ thenBytes ++ [0x05] ++ elseBytes ++ [0x0b], - node.id :: stack') - | _, _, _ => none - | none => none - | .vectorGetOrDefault arrTy toIndexIdx boxIdx default => - -- Byte twin of `PlanLower.vectorGetOrDefaultTemplate`, including - -- the `(ref null carrier)` if block type the emitter declares. - match stack with - | [] => - match uleb32 toIndexIdx, uleb32 boxIdx, uleb32 arrTy, - s33HeapIdx carrier, sleb64 default with - | some toIndexB, some boxB, some arrB, some carrierB, some dB => - some ( - [0x20, 0x01, 0x10] ++ toIndexB ++ [0x41, 0x00, 0x4e] ++ - [0x20, 0x01, 0x10] ++ toIndexB ++ - [0x20, 0x00, 0xfb, 0x0f, 0x49, 0x71] ++ - [0x04, 0x63] ++ carrierB ++ - [0x20, 0x00, 0x20, 0x01, 0x10] ++ toIndexB ++ - [0xfb, 0x0b] ++ arrB ++ - [0x05, 0x42] ++ dB ++ [0x10] ++ boxB ++ [0x0b], - [node.id]) - | _, _, _, _, _ => none - | _ => none - | .intSignCmp op k scratch value => - match popExpected stack value, - intSignCmpTemplateBytes carrier scratch op k with - | some stack', some bytes => some (bytes, node.id :: stack') - | _, _ => none - match lowered? with - | some (bytes, stack') => - match lowerNodesBytesFuel fuel carrier rest stack' with - | some (restBytes, finalStack) => some (bytes ++ restBytes, finalStack) - | none => none - | none => none - - def lowerBlockBytesFuel : Nat → Nat → FragBlock → Option (List Nat) - | 0, _, _ => none - | fuel + 1, carrier, block => - match lowerNodesBytesFuel fuel carrier block.nodes [] with - | some (bytes, [result]) => - if result = block.result then some bytes else none - | _ => none -end - -def lowerBlockBytes (carrier : Nat) (block : FragBlock) : Option (List Nat) := - lowerBlockBytesFuel maxFuel carrier block - -def lowerExprFragmentExprBytes (carrier : Nat) (plan : ExprFragmentRawPlan) : - Option (List Nat) := - if AverCert.PlanCheck.checkExprFragmentRawPlan plan then - match lowerBlockBytes carrier plan.body with - | some bytes => some (bytes ++ [0x0b]) - | none => none - else - none - -def lowerExprFragmentBodyBytes (carrier : Nat) (plan : ExprFragmentRawPlan) : - Option (List Nat) := - singleCarrierLocalBodyBytes carrier (lowerExprFragmentExprBytes carrier plan) - -def lowerExprFragmentCodeEntry (carrier : Nat) (plan : ExprFragmentRawPlan) : - Option (List Nat) := - codeEntryBytes (lowerExprFragmentBodyBytes carrier plan) - -def lowerRecursionExprBytes (carrier : Nat) (plan : RecursionRawPlan) : - Option (List Nat) := - if AverCert.PlanCheck.checkRecursionRawPlan plan then - match lowerBlockBytes carrier plan.body with - | some bytes => some (bytes ++ [0x0b]) - | none => none - else - none - -def lowerRecursionBodyBytes (carrier : Nat) (plan : RecursionRawPlan) : - Option (List Nat) := - singleCarrierLocalBodyBytes carrier (lowerRecursionExprBytes carrier plan) - -def lowerRecursionCodeEntry (carrier : Nat) (plan : RecursionRawPlan) : - Option (List Nat) := - codeEntryBytes (lowerRecursionBodyBytes carrier plan) - -def lowerMutualExprBytes (carrier : Nat) (plan : MutualRawPlan) : - Option (List Nat) := - if AverCert.PlanCheck.checkMutualRawPlan plan then - match lowerBlockBytes carrier plan.body with - | some bytes => some (bytes ++ [0x0b]) - | none => none - else - none - -def lowerMutualBodyBytes (carrier : Nat) (plan : MutualRawPlan) : - Option (List Nat) := - singleCarrierLocalBodyBytes carrier (lowerMutualExprBytes carrier plan) - -def lowerMutualCodeEntry (carrier : Nat) (plan : MutualRawPlan) : - Option (List Nat) := - codeEntryBytes (lowerMutualBodyBytes carrier plan) - -/-! ### Verbatim `ref.test`-dispatch byte lowering (exact code-entry bytes). - -`ref.test`/`ref.cast`/`ref.null`/block-type heap indices are s33 SIGNED; -`struct.get`/`array.new_data` type/field/data indices are uleb32. -/ - -def lowerLeafBytes (S F : Nat) (resultSig : VerbatimResultSig) : - VerbatimLeaf → Option (List Nat) - | .project tyIdx field => - match uleb32 S, s33HeapIdx tyIdx, uleb32 tyIdx, uleb32 field, uleb32 F with - | some sB, some castTy, some getTy, some fieldB, some fB => - some ([0x20] ++ sB ++ [0xfb, 0x16] ++ castTy ++ - [0xfb, 0x02] ++ getTy ++ fieldB ++ [0x21] ++ fB ++ [0x20] ++ fB) - | _, _, _, _, _ => none - | .arrayNewData arrTy dataIdx bytes => - match resultSig with - | .refNull _ => - match sleb32 0, sleb32 (Int.ofNat bytes.length), uleb32 arrTy, uleb32 dataIdx with - | some off, some len, some arrTyB, some dataIdxB => - some ([0x41] ++ off ++ [0x41] ++ len ++ [0xfb, 0x09] ++ arrTyB ++ dataIdxB) - | _, _, _, _ => none - | .f64Scalar => none - | .refNull => - match resultSig with - | .refNull heapTy => - match s33HeapIdx heapTy with - | some ht => some ([0xd0] ++ ht) - | none => none - | .f64Scalar => none - | .f64Bits bits => - match resultSig with - | .f64Scalar => - match f64Bytes bits with - | some fb => some ([0x44] ++ fb) - | none => none - | .refNull _ => none - -def lowerDispatchBytes (S F : Nat) (resultSig : VerbatimResultSig) (first : Bool) : - VerbatimDispatch → Option (List Nat) - | .leaf l => lowerLeafBytes S F resultSig l - | .test tyIdx hit rest => - match (if first then some ([] : List Nat) - else (uleb32 S).map (fun b => [0x20] ++ b)), - s33HeapIdx tyIdx, - (match resultSig with - | .refNull heapTy => (s33HeapIdx heapTy).map (fun b => [0x63] ++ b) - | .f64Scalar => some [0x7c]), - lowerLeafBytes S F resultSig hit, - lowerDispatchBytes S F resultSig false rest with - | some reload, some testTy, some blockTy, some hitBytes, some restBytes => - some (reload ++ [0xfb, 0x14] ++ testTy ++ [0x04] ++ blockTy ++ - hitBytes ++ [0x05] ++ restBytes ++ [0x0b]) - | _, _, _, _, _ => none - -def lowerVerbatimExprBytes (plan : VerbatimRawPlan) : Option (List Nat) := - match uleb32 plan.scrutineeLocal, - lowerDispatchBytes plan.scrutineeLocal plan.fieldLocal plan.resultSig true plan.body with - | some sB, some dispatchBytes => - some ([0x20, 0x00] ++ [0x21] ++ sB ++ [0x20] ++ sB ++ dispatchBytes ++ [0x0b]) - | _, _ => none - -/-- Local declarations. A projecting (widened-match) body declares the field - scratch local (of the declared ref or f64 result type) first, then the eqref scrutinee, then - the always-present unused Int-carrier scratch; a non-projecting (variant - dispatch) body declares only the scrutinee and the carrier scratch. -/ -def lowerVerbatimLocalsBytes (carrier : Nat) (resultSig : VerbatimResultSig) (hasProj : Bool) : - Option (List Nat) := - match s33HeapIdx carrier with - | some carrierB => - if hasProj then - match resultSig with - | .refNull heapTy => - match s33HeapIdx heapTy with - | some rhtB => - some ([0x03] ++ [0x01, 0x63] ++ rhtB ++ [0x01, 0x6d] ++ [0x01, 0x63] ++ carrierB) - | none => none - | .f64Scalar => - some ([0x03] ++ [0x01, 0x7c] ++ [0x01, 0x6d] ++ [0x01, 0x63] ++ carrierB) - else - some ([0x02] ++ [0x01, 0x6d] ++ [0x01, 0x63] ++ carrierB) - | none => none - -def lowerVerbatimBodyBytes (carrier : Nat) (plan : VerbatimRawPlan) : Option (List Nat) := - match lowerVerbatimLocalsBytes carrier plan.resultSig - (AverCert.PlanCheck.dispatchHasProjection plan.body), - lowerVerbatimExprBytes plan with - | some localsBytes, some exprBytes => some (localsBytes ++ exprBytes) - | _, _ => none - -def lowerVerbatimCodeEntry (carrier : Nat) (plan : VerbatimRawPlan) : Option (List Nat) := - codeEntryBytes (lowerVerbatimBodyBytes carrier plan) - -/-! ### Int-face `ref.test`-dispatch byte lowering (exact code-entry bytes). - -`ref.test`/`ref.cast`/block-type heap indices are s33 SIGNED; `struct.get` type -and field indices are uleb32; arm/default constants are sleb64. The scratch -locals mirror `PlanLower`: arm `i` spills to local `i+1`, the scrutinee is local -`armCount + 1`, and one trailing unused carrier scratch local is always -declared. The box/add/sub call target indices come from the byte-derived -host-role table PARAMETER — a role the table lacks fail-closes the lowering, so -the plan cannot name a function index. -/ - -/-- The shared arm prefix: project the tested variant's field 0 out of the - spilled scrutinee and spill it to this arm's scratch local - (`local.get S; ref.cast t; struct.get t 0; local.set F`). -/ -def intDispatchProjBytes (S F tyIdx : Nat) : Option (List Nat) := - match uleb32 S, s33HeapIdx tyIdx, uleb32 tyIdx, uleb32 F with - | some sB, some castTy, some getTy, some fB => - some ([0x20] ++ sB ++ [0xfb, 0x16] ++ castTy ++ - [0xfb, 0x02] ++ getTy ++ [0x00] ++ [0x21] ++ fB) - | _, _, _, _ => none - -def lowerIntDispatchArmBytes - (hostTable : List (HostRole × Nat)) (S F tyIdx : Nat) : - IntDispatchLeaf → Option (List Nat) - | .const _ => none - | .proj => - match intDispatchProjBytes S F tyIdx, uleb32 F with - | some proj, some fB => some (proj ++ [0x20] ++ fB) - | _, _ => none - | .hostOp role k constFirst => - match intDispatchProjBytes S F tyIdx, uleb32 F, sleb64 k, - (AverCert.PlanCheck.hostRoleIdx? hostTable .box).bind uleb32, - (AverCert.PlanCheck.hostRoleIdx? hostTable - (AverCert.PlanCheck.intDispatchRoleHostRole role)).bind uleb32 with - | some proj, some fB, some kB, some boxB, some hostB => - some (proj ++ - (if constFirst then - [0x42] ++ kB ++ [0x10] ++ boxB ++ [0x20] ++ fB ++ [0x10] ++ hostB - else - [0x20] ++ fB ++ [0x42] ++ kB ++ [0x10] ++ boxB ++ [0x10] ++ hostB)) - | _, _, _, _, _ => none - -def intDispatchDefaultBytes - (hostTable : List (HostRole × Nat)) (k : Int) : Option (List Nat) := - match sleb64 k, (AverCert.PlanCheck.hostRoleIdx? hostTable .box).bind uleb32 with - | some kB, some boxB => some ([0x42] ++ kB ++ [0x10] ++ boxB) - | _, _ => none - -def lowerIntDispatchCascadeBytes - (hostTable : List (HostRole × Nat)) (carrier S : Nat) : - Nat → Bool → IntDispatchCascade → Option (List Nat) - | _pos, _first, .default k => intDispatchDefaultBytes hostTable k - | pos, first, .test tyIdx (.const k) rest => - -- A const (nullary) arm: the hit block is the boxed constant with NO - -- projection prefix (byte-identical to a default), and the binding - -- position `pos` does not advance (no per-arm payload spill). - match (if first then some ([] : List Nat) - else (uleb32 S).map (fun b => [0x20] ++ b)), - s33HeapIdx tyIdx, s33HeapIdx carrier, - intDispatchDefaultBytes hostTable k, - lowerIntDispatchCascadeBytes hostTable carrier S pos false rest with - | some reload, some testTy, some blockTy, some hitBytes, some restBytes => - some (reload ++ [0xfb, 0x14] ++ testTy ++ [0x04, 0x63] ++ blockTy ++ - hitBytes ++ [0x05] ++ restBytes ++ [0x0b]) - | _, _, _, _, _ => none - | pos, first, .test tyIdx hit rest => - match (if first then some ([] : List Nat) - else (uleb32 S).map (fun b => [0x20] ++ b)), - s33HeapIdx tyIdx, s33HeapIdx carrier, - lowerIntDispatchArmBytes hostTable S (pos + 1) tyIdx hit, - lowerIntDispatchCascadeBytes hostTable carrier S (pos + 1) false rest with - | some reload, some testTy, some blockTy, some hitBytes, some restBytes => - some (reload ++ [0xfb, 0x14] ++ testTy ++ [0x04, 0x63] ++ blockTy ++ - hitBytes ++ [0x05] ++ restBytes ++ [0x0b]) - | _, _, _, _, _ => none - -def lowerIntDispatchExprBytes - (hostTable : List (HostRole × Nat)) (carrier S : Nat) - (body : IntDispatchCascade) : Option (List Nat) := - match uleb32 S, lowerIntDispatchCascadeBytes hostTable carrier S 0 true body with - | some sB, some cascadeBytes => - some ([0x20, 0x00] ++ [0x21] ++ sB ++ [0x20] ++ sB ++ cascadeBytes ++ [0x0b]) - | _, _ => none - -/-- Local declarations: `bindArmCount` single-local carrier-ref groups (the - per-binding-arm payload spills), one eqref group (the scrutinee), and one - trailing unused carrier scratch group — `bindArmCount + 2` groups in all. A - const (nullary) arm declares no spill group. -/ -def intDispatchArmLocalGroups (carrierB : List Nat) : Nat → List Nat - | 0 => [] - | n + 1 => [0x01, 0x63] ++ carrierB ++ intDispatchArmLocalGroups carrierB n - -def lowerIntDispatchLocalsBytes (carrier armCount : Nat) : Option (List Nat) := - match uleb32 (armCount + 2), s33HeapIdx carrier with - | some countB, some carrierB => - some (countB ++ intDispatchArmLocalGroups carrierB armCount ++ - [0x01, 0x6d] ++ [0x01, 0x63] ++ carrierB) - | _, _ => none - -def lowerIntDispatchBodyBytes - (carrier : Nat) (hostTable : List (HostRole × Nat)) - (plan : IntDispatchRawPlan) : Option (List Nat) := - let armCount := AverCert.PlanCheck.bindArmCount plan.body - match lowerIntDispatchLocalsBytes carrier armCount, - lowerIntDispatchExprBytes hostTable carrier (armCount + 1) plan.body with - | some localsBytes, some exprBytes => some (localsBytes ++ exprBytes) - | _, _ => none - -def lowerIntDispatchCodeEntry - (carrier : Nat) (hostTable : List (HostRole × Nat)) - (plan : IntDispatchRawPlan) : Option (List Nat) := - codeEntryBytes (lowerIntDispatchBodyBytes carrier hostTable plan) - -def lowerStringConcatChunkBytes - (resultTy : Nat) (chunk : StringConcatChunk) : Option (List Nat) := - match sleb32 0, - sleb32 (Int.ofNat chunk.bytes.length), - uleb32 0x09, - uleb32 resultTy, - uleb32 chunk.dataIdx with - | some offsetBytes, some lenBytes, some opBytes, some resultTyBytes, some dataIdxBytes => - some ( - [0x41] ++ offsetBytes ++ - [0x41] ++ lenBytes ++ - [0xfb] ++ opBytes ++ resultTyBytes ++ dataIdxBytes - ) - | _, _, _, _, _ => none - -def lowerStringConcatChunksBytes (resultTy : Nat) : - List StringConcatChunk → Option (List Nat) - | [] => some [] - | chunk :: rest => - match lowerStringConcatChunkBytes resultTy chunk, - lowerStringConcatChunksBytes resultTy rest with - | some chunkBytes, some restBytes => some (chunkBytes ++ restBytes) - | _, _ => none - -def lowerStringConcatExprBytes - (resultTy containerTy concatFuncIdx : Nat) - (plan : StringConcatRawPlan) : Option (List Nat) := - if AverCert.PlanCheck.checkStringConcatRawPlan plan then - match lowerStringConcatChunksBytes resultTy plan.prefixes, - uleb32 0, - lowerStringConcatChunksBytes resultTy plan.suffixes, - uleb32 0x08, - uleb32 containerTy, - uleb32 (plan.prefixes.length + 1 + plan.suffixes.length), - uleb32 concatFuncIdx with - | some prefixBytes, some localIdxBytes, some suffixBytes, - some arrayNewFixedOpBytes, some containerTyBytes, some partCountBytes, - some concatFuncIdxBytes => - some ( - prefixBytes ++ - [0x20] ++ localIdxBytes ++ - suffixBytes ++ - [0xfb] ++ arrayNewFixedOpBytes ++ containerTyBytes ++ partCountBytes ++ - [0x10] ++ concatFuncIdxBytes ++ - [0x0b] - ) - | _, _, _, _, _, _, _ => none - else - none - -/-- The `string-concat-v1` code entry, in both carrier states of the module. - The expression is identical either way — concatenation never touches the - carrier — and only the locals prelude differs, so the carrier state is an - environmental fact about the module rather than anything the concatenation - means. `carrier?` is the pinned `CertDecode.carrierState` of the same bytes; - see `carrierLocalsBodyBytes`. -/ -def lowerStringConcatBodyBytes - (carrier? : Option Nat) (resultTy containerTy concatFuncIdx : Nat) - (plan : StringConcatRawPlan) : Option (List Nat) := - carrierLocalsBodyBytes carrier? - (lowerStringConcatExprBytes resultTy containerTy concatFuncIdx plan) - -def lowerStringConcatCodeEntry - (carrier? : Option Nat) (resultTy containerTy concatFuncIdx : Nat) - (plan : StringConcatRawPlan) : Option (List Nat) := - codeEntryBytes - (lowerStringConcatBodyBytes carrier? resultTy containerTy concatFuncIdx plan) - -def lowerStringEqChunkBytes - (stringTy : Nat) - (chunk : StringEqChunk) : Option (List Nat) := - match sleb32 0, sleb32 (Int.ofNat chunk.bytes.length), - uleb32 0x09, uleb32 stringTy, uleb32 chunk.dataIdx with - | some offsetBytes, some lenBytes, some arrayNewDataOpBytes, - some stringTyBytes, some dataIdxBytes => - some ( - [0x41] ++ offsetBytes ++ - [0x41] ++ lenBytes ++ - [0xfb] ++ arrayNewDataOpBytes ++ stringTyBytes ++ dataIdxBytes - ) - | _, _, _, _, _ => none - -def lowerStringEqResultBytes - (stringTy : Nat) : StringEqResult → Option (List Nat) - | .input => - match uleb32 0 with - | some inputIdxBytes => some ([0x20] ++ inputIdxBytes) - | none => none - | .literal chunk => lowerStringEqChunkBytes stringTy chunk - -def lowerStringEqExprBytes - (stringTy stringEqFuncIdx : Nat) - (plan : StringEqRawPlan) : Option (List Nat) := - if AverCert.PlanCheck.checkStringEqRawPlan plan then - match uleb32 0, uleb32 1, uleb32 1, uleb32 0x17, - s33HeapIdx stringTy, lowerStringEqChunkBytes stringTy plan.needle, - uleb32 stringEqFuncIdx, s33HeapIdx stringTy, - lowerStringEqResultBytes stringTy plan.hit, - lowerStringEqResultBytes stringTy plan.default with - | some inputIdxBytes, some scratchIdxBytes, some _localOneBytes, - some refCastOpBytes, some stringTyBytes, some needleBytes, - some stringEqFuncIdxBytes, some blockTypeBytes, some hitBytes, - some defaultBytes => - some ( - [0x20] ++ inputIdxBytes ++ - [0x21] ++ scratchIdxBytes ++ - [0x20] ++ scratchIdxBytes ++ - [0xfb] ++ refCastOpBytes ++ stringTyBytes ++ - needleBytes ++ - [0x10] ++ stringEqFuncIdxBytes ++ - [0x04, 0x63] ++ blockTypeBytes ++ - hitBytes ++ - [0x05] ++ - defaultBytes ++ - [0x0b, 0x0b] - ) - | _, _, _, _, _, _, _, _, _, _ => none - else - none - -def lowerStringEqBodyBytes - (carrier stringTy stringEqFuncIdx : Nat) - (plan : StringEqRawPlan) : Option (List Nat) := - match uleb32 2, uleb32 1, uleb32 1, s33HeapIdx carrier, - lowerStringEqExprBytes stringTy stringEqFuncIdx plan with - | some localDeclCount, some localCount, some carrierLocalCount, - some carrierBytes, some exprBytes => - some ( - localDeclCount ++ - localCount ++ [0x6d] ++ - carrierLocalCount ++ [0x63] ++ carrierBytes ++ - exprBytes - ) - | _, _, _, _, _ => none - -def lowerStringEqCodeEntry - (carrier stringTy stringEqFuncIdx : Nat) - (plan : StringEqRawPlan) : Option (List Nat) := - codeEntryBytes (lowerStringEqBodyBytes carrier stringTy stringEqFuncIdx plan) - -def lowerConstructFieldBytes (structIdx : Nat) : ConstructField → Option (List Nat) - | .local index => - match uleb32 index with - | some indexBytes => some ([0x20] ++ indexBytes) - | none => none - | .null => - match s33HeapIdx structIdx with - | some idxBytes => some ([0xd0] ++ idxBytes) - | none => none - -def lowerConstructFieldsBytes (structIdx : Nat) : List ConstructField → Option (List Nat) - | [] => some [] - | field :: rest => - match lowerConstructFieldBytes structIdx field, lowerConstructFieldsBytes structIdx rest with - | some fieldBytes, some restBytes => some (fieldBytes ++ restBytes) - | _, _ => none - -def lowerConstructExprBytes (structIdx : Nat) (plan : ConstructRawPlan) : Option (List Nat) := - if AverCert.PlanCheck.checkConstructRawPlan plan then - match lowerConstructFieldsBytes structIdx plan.fields, - uleb32 0x00, - uleb32 structIdx with - | some fieldBytes, some structNewOpBytes, some structIdxBytes => - some (fieldBytes ++ [0xfb] ++ structNewOpBytes ++ structIdxBytes ++ [0x0b]) - | _, _, _ => none - else - none - -def lowerConstructBodyBytes - (carrier : Nat) - (structIdx : Nat) - (plan : ConstructRawPlan) : Option (List Nat) := - singleCarrierLocalBodyBytes carrier (lowerConstructExprBytes structIdx plan) - -def lowerConstructCodeEntry - (carrier : Nat) - (structIdx : Nat) - (plan : ConstructRawPlan) : Option (List Nat) := - codeEntryBytes (lowerConstructBodyBytes carrier structIdx plan) - -/-! ### `composition-plan-v1` exact byte lowering -/ - -def compositionFuncIdx? (funcTable : List (String × Nat)) (name : String) : Option Nat := - match funcTable.find? (fun entry => entry.1 == name) with - | some entry => some entry.2 - | none => none - -def lowerCompositionCallBytes - (funcTable : List (String × Nat)) : List String → Option (List Nat) - | [] => some [] - | callee :: rest => - match (compositionFuncIdx? funcTable callee).bind uleb32, - lowerCompositionCallBytes funcTable rest with - | some idx, some tail => some ([0x10] ++ idx ++ tail) - | _, _ => none - -def lowerCompositionExprBytes - (hostTable : List (HostRole × Nat)) - (funcTable : List (String × Nat)) - (plan : CompositionRawPlan) : Option (List Nat) := - if AverCert.PlanCheck.checkCompositionRawPlan plan then - match uleb32 0 with - | some zero => - match plan.shape with - | .selfSum => - match (AverCert.PlanCheck.hostRoleIdx? hostTable .add).bind uleb32 with - | some addIdx => - some ([0x20] ++ zero ++ [0x20] ++ zero ++ [0x10] ++ addIdx ++ [0x0b]) - | none => none - | .chain callees => - match lowerCompositionCallBytes funcTable callees with - | some calls => some ([0x20] ++ zero ++ calls ++ [0x0b]) - | none => none - | none => none - else - none - -def lowerCompositionBodyBytes - (carrier : Nat) - (hostTable : List (HostRole × Nat)) - (funcTable : List (String × Nat)) - (plan : CompositionRawPlan) : Option (List Nat) := - singleCarrierLocalBodyBytes carrier - (lowerCompositionExprBytes hostTable funcTable plan) - -def lowerCompositionCodeEntry - (carrier : Nat) - (hostTable : List (HostRole × Nat)) - (funcTable : List (String × Nat)) - (plan : CompositionRawPlan) : Option (List Nat) := - codeEntryBytes (lowerCompositionBodyBytes carrier hostTable funcTable plan) - -end AverCert.PlanBytes diff --git a/aver-cert/assets/wall/current/PlanCheck.lean b/aver-cert/assets/wall/current/PlanCheck.lean deleted file mode 100644 index bfee295bc..000000000 --- a/aver-cert/assets/wall/current/PlanCheck.lean +++ /dev/null @@ -1,1467 +0,0 @@ --- Lean-side structural checker for `expr-fragment-v1` raw plans. --- --- This is intentionally a small checker over the plan grammar, not a Wasm --- decoder. `AcceptedArtifact` binds checked plans to decoded artifact code; --- this module validates the raw plan grammar before that binding. -import SchemaCore - -namespace AverCert.PlanCheck -open AverCert.Schema - -/-- Dedicated bare-projection structural guard. The byte-derived field count is - an argument rather than plan data, so the only plan claim (`fieldIdx`) must - be in range for the module's actual struct. -/ -def checkFieldProjectionRawPlan - (fieldCount : Nat) (plan : FieldProjectionRawPlan) : Bool := - plan.profile = "field-projection-v1" && - fieldCount = 2 && - plan.fieldIdx < fieldCount - -def sameTy (a b : FragTy) : Bool := - if a = b then true else false - -def sameSymTy (a b : SymTy) : Bool := - if a = b then true else false - -def lookupNode (nodes : List FragNode) (id : Nat) : Option FragNode := - nodes[id]? - -def lookupSymNode (nodes : List SymNode) (id : Nat) : Option SymNode := - nodes[id]? - -def lookupTy (nodes : List FragNode) (id : Nat) : Option FragTy := - match lookupNode nodes id with - | some n => some n.ty - | none => none - -def lookupSymTy (nodes : List SymNode) (id : Nat) : Option SymTy := - match lookupSymNode nodes id with - | some n => some n.ty - | none => none - -def hasTy (nodes : List FragNode) (id : Nat) (expected : FragTy) : Bool := - match lookupTy nodes id with - | some got => sameTy got expected - | none => false - -def hasSymTy (nodes : List SymNode) (id : Nat) (expected : SymTy) : Bool := - match lookupSymTy nodes id with - | some got => sameSymTy got expected - | none => false - -def isSymParam (nodes : List SymNode) (id : Nat) : Bool := - match lookupSymNode nodes id with - | some { kind := .param _, .. } => true - | _ => false - -def hasI32Ty (nodes : List FragNode) (id : Nat) : Bool := - match lookupTy nodes id with - | some .rawI32 => true - | some .boolI32 => true - | _ => false - -def carrierFieldTy? : Nat → Option FragTy - | 0 => some .i64 - | 1 => some .ref - | 2 => some .rawI32 - | _ => none - -def isCarrierLimbField (nodes : List FragNode) (id : Nat) : Bool := - match lookupNode nodes id with - | some { kind := .structGet 1 _, .. } => true - | _ => false - -def argsHaveTys (nodes : List FragNode) : List Nat → List FragTy → Bool - | [], [] => true - | arg :: args, ty :: tys => hasTy nodes arg ty && argsHaveTys nodes args tys - | _, _ => false - -def symArgsHaveTys (nodes : List SymNode) : List Nat → List SymTy → Bool - | [], [] => true - | arg :: args, ty :: tys => hasSymTy nodes arg ty && symArgsHaveTys nodes args tys - | _, _ => false - -def symArgsAllTy (nodes : List SymNode) (expected : SymTy) : List Nat → Bool - | [] => true - | arg :: args => hasSymTy nodes arg expected && symArgsAllTy nodes expected args - -def symArgsExist (nodes : List SymNode) : List Nat → Bool - | [] => true - | arg :: args => - match lookupSymNode nodes arg with - | some _ => symArgsExist nodes args - | none => false - -def primResultTy? (nodes : List FragNode) (op : FragPrim) (args : List Nat) : - Option FragTy := - match op with - | .f64Add => - if argsHaveTys nodes args [.f64, .f64] then some .f64 else none - | .f64Mul => - if argsHaveTys nodes args [.f64, .f64] then some .f64 else none - | .f64Le => - if argsHaveTys nodes args [.f64, .f64] then some .boolI32 else none - | .f64Ge => - if argsHaveTys nodes args [.f64, .f64] then some .boolI32 else none - | .f64Lt => - if argsHaveTys nodes args [.f64, .f64] then some .boolI32 else none - | .f64Gt => - if argsHaveTys nodes args [.f64, .f64] then some .boolI32 else none - | .f64Eq => - if argsHaveTys nodes args [.f64, .f64] then some .boolI32 else none - | .i64Eq => - if argsHaveTys nodes args [.i64, .i64] then some .boolI32 else none - | .i64LeS => - if argsHaveTys nodes args [.i64, .i64] then some .boolI32 else none - | .i64LtS => - if argsHaveTys nodes args [.i64, .i64] then some .boolI32 else none - | .i64GeS => - if argsHaveTys nodes args [.i64, .i64] then some .boolI32 else none - | .i64GtS => - if argsHaveTys nodes args [.i64, .i64] then some .boolI32 else none - | .i32Eq => - match args with - | [a, b] => if hasI32Ty nodes a && hasI32Ty nodes b then some .boolI32 else none - | _ => none - | .i32LtS => - match args with - | [a, b] => if hasI32Ty nodes a && hasI32Ty nodes b then some .boolI32 else none - | _ => none - | .i32GtS => - match args with - | [a, b] => if hasI32Ty nodes a && hasI32Ty nodes b then some .boolI32 else none - | _ => none - | .i32GeS => - match args with - | [a, b] => if hasI32Ty nodes a && hasI32Ty nodes b then some .boolI32 else none - | _ => none - -- SOUNDNESS: `i32.and` must NOT use the loose `hasI32Ty` the comparisons - -- use. Bitwise AND over arbitrary `rawI32` operands can yield a value - -- outside {0,1} (`2 and 2 = 2`), so declaring `boolI32` for it would let a - -- non-Boolean flow into every consumer that reads the result as a `Bool`; - -- on top of that, the interpreter's `.i32And` clause models the operation - -- on the {0,1} domain, where it coincides with wasm's bitwise `i32.and` - -- only when both operands are Booleans. Requiring `.boolI32` on BOTH - -- operands is therefore load-bearing twice over. - | .i32And => - match args with - | [a, b] => - if hasTy nodes a .boolI32 && hasTy nodes b .boolI32 then some .boolI32 - else none - | _ => none - -/-- Static registry of host-helper role type signatures. `box` takes one raw - `i64` and returns the Int carrier; each arithmetic role takes two Int - carriers and returns the Int carrier. The resolved wasm function index is - not checked here (it is bound to the module bytes by the byte-exact gate - and to the in-kernel decoded role table); this is purely the - representation-level type discipline. -/ -def hostCallResultTy? (nodes : List FragNode) (role : HostRole) (args : List Nat) : - Option FragTy := - match role with - | .box => if argsHaveTys nodes args [.i64] then some .intCarrier else none - | .add => - if argsHaveTys nodes args [.intCarrier, .intCarrier] then some .intCarrier else none - | .mul => - if argsHaveTys nodes args [.intCarrier, .intCarrier] then some .intCarrier else none - | .sub => - if argsHaveTys nodes args [.intCarrier, .intCarrier] then some .intCarrier else none - -- `__aint_to_index` is consumed only inside the monolithic fused - -- vector-read node; a standalone host call to it has no admitted face. - | .toIndex => none - -- `__aint_cmp` leaves the carrier: it takes two represented integers and - -- returns the raw three-way sign, which the emitter always feeds into a - -- signed comparison against `i32.const 0`. Typing it `rawI32` rather than - -- `boolI32` is load-bearing: `-1` is a perfectly good result here and would - -- be a lie as a Boolean, and the `boolI32`-only consumers (`i32.and`, the - -- fragment's `if` condition) must not accept it unfiltered. - | .cmp => - if argsHaveTys nodes args [.intCarrier, .intCarrier] then some .rawI32 else none - -- `__aint_eq` already yields the source-level Boolean (`0`/`1`), so its - -- result IS `boolI32` and needs no comparison tail. Read this as a TYPING - -- rule, not as a proved range: the `{0, 1}` guarantee is contract-backed - -- only inside the certified small band (`Obligation.holds`'s `_hEq` is - -- quantified over literal small carriers), and outside it the typing rests - -- on the pinned helper body alone. - | .eq => - if argsHaveTys nodes args [.intCarrier, .intCarrier] then some .boolI32 else none - -/-- All arguments of a self-call must be Int carriers; the recursion class only - threads Int values through its recursive descent. -/ -def fragArgsAllTy (nodes : List FragNode) (expected : FragTy) : List Nat → Bool - | [] => true - | arg :: args => hasTy nodes arg expected && fragArgsAllTy nodes expected args - -def symPrimResultTy? (nodes : List SymNode) (op : SymPrim) (args : List Nat) : - Option SymTy := - match op with - | .floatAdd => - if symArgsHaveTys nodes args [.float, .float] then some .float else none - | .floatMul => - if symArgsHaveTys nodes args [.float, .float] then some .float else none - | .floatLe => - if symArgsHaveTys nodes args [.float, .float] then some .bool else none - | .floatGe => - if symArgsHaveTys nodes args [.float, .float] then some .bool else none - | .floatLt => - if symArgsHaveTys nodes args [.float, .float] then some .bool else none - | .floatGt => - if symArgsHaveTys nodes args [.float, .float] then some .bool else none - | .floatEq => - if symArgsHaveTys nodes args [.float, .float] then some .bool else none - | .intAdd => - if symArgsHaveTys nodes args [.int, .int] then some .int else none - | .intSub => - if symArgsHaveTys nodes args [.int, .int] then some .int else none - | .intMul => - if symArgsHaveTys nodes args [.int, .int] then some .int else none - | .stringEq => - if symArgsHaveTys nodes args [.string, .string] then some .bool else none - | .stringConcat => - if args.isEmpty then none - else if symArgsAllTy nodes .string args then some .string else none - | .boolAnd => - if symArgsHaveTys nodes args [.bool, .bool] then some .bool else none - -/-- Hard cap for recursive plan checking. Exceeding it is a fail-closed - unsupported fragment, matching the producer's profile-limit discipline. -/ -abbrev maxFuel : Nat := 10000 - -/-- Decidable membership of the i64 band `[-2^63, 2^63)`. The sign template's - literal must live there: the limb-carrying arm decides on the sign field - alone, and that is only exact against a literal the band contains. -/ -def inI64Band (value : Int) : Bool := - decide (-(2 ^ 63 : Int) ≤ value) && decide (value < (2 ^ 63 : Int)) - -def isByte (n : Nat) : Bool := - if n <= 255 then true else false - -def bytesAllBytes : List Nat → Bool - | [] => true - | b :: bs => isByte b && bytesAllBytes bs - -def checkBlockFuel : Nat → List FragTy → FragBlock → Bool - | 0, _, _ => false - | fuel + 1, params, block => - let inferNodeKindTy (checked : List FragNode) (node : FragNode) : - Option FragTy := - match node.kind with - | .local index => params[index]? - | .constBool _ => some .boolI32 - | .constI64 _ => some .i64 - | .constI32 _ => some .rawI32 - | .constF64Bits _ => some .f64 - | .structGet field receiver => - if hasTy checked receiver .intCarrier then carrierFieldTy? field else none - -- v1 admits three field reads out of a user struct: the opaque - -- reference-field projection (`adtRef`, flowed verbatim through the - -- field-projection face), the scalar `i32` tag/discriminant read - -- (`rawI32`, e.g. the Option/Result tag) that a tag-dispatch feeds into - -- `i32`-typed primitives, and the record-declaration scalar field read - -- (`intCarrier`/`boolI32`/`f64` via `fragTyIsRecordScalar`), whose - -- declared type is confirmed against the module's type section by the - -- record face's equality pin over the certified Plan declaration. The - -- plan DECLARES which via `node.ty`; the byte-exact gate and decoded - -- struct context bind `tyIdx`/`field` and confirm the field's real - -- storage. A wrong declaration lowers to bytes whose read yields the - -- wrong `WVal` kind and traps (fail-closed). The scalar admission - -- cannot leak into the generic path: `genericFragmentAllowedFuel` - -- rejects EVERY `structGetUser` node outright, so a scalar-typed read - -- is only acceptable through the record-parameter classify branch, - -- whose exact two-node shape and byte pins gate it. - | .structGetUser _tyIdx _field value => - if hasTy checked value .adtRef && - (node.ty = .adtRef || node.ty = .rawI32 || - fragTyIsRecordScalar node.ty) - then some node.ty else none - -- Construction of a user struct from already-computed values: yields - -- the opaque reference. Field-count/type agreement with the module's - -- type section is byte-side work (the type index is bound by the - -- byte-exact gate); the structural check demands the args exist as - -- typed nodes. Like `structGetUser`, the generic path never admits it - -- (`genericFragmentAllowedFuel` rejects it outright). - | .structNew _tyIdx args => - if !args.isEmpty && - args.all (fun a => (lookupNode checked a).isSome) then - some .adtRef - else none - | .refIsNull value => - if hasTy checked value .ref && isCarrierLimbField checked value - then some .boolI32 - else none - | .prim op args => primResultTy? checked op args - | .hostCall role _funcIdx args => hostCallResultTy? checked role args - -- A self-call yields the Int carrier when every argument is an Int - -- carrier. `funcIdx` is not typed here; artifact acceptance binds it to - -- the byte-derived self index, - -- mirroring `hostCall`. - | .selfCall _tail _funcIdx args => - if !args.isEmpty && fragArgsAllTy checked .intCarrier args then - some .intCarrier - else none - | .ifElse cond thenBlock elseBlock => - if hasTy checked cond .boolI32 && - checkBlockFuel fuel params thenBlock && - checkBlockFuel fuel params elseBlock then - match lookupNode thenBlock.nodes thenBlock.result, - lookupNode elseBlock.nodes elseBlock.result with - | some t, some e => if t.ty = e.ty then some t.ty else none - | _, _ => none - else none - -- The monolithic fused vector read hard-references locals 0 (vector) - -- and 1 (index), so it types only under exactly that param prefix. - | .vectorGetOrDefault _arrTy _toIndexIdx _boxIdx _default => - if params[0]? = some .adtRef && params[1]? = some .intCarrier then - some .intCarrier - else none - -- The sign template consumes ONE Int carrier and yields the source - -- Boolean. Two pins live here rather than in a face: the scratch slot - -- is exactly the one declared local (`params.length`), so the template - -- cannot write over a parameter, and the literal must be inside the - -- i64 band, which is what makes its limb-carrying arm exact. - | .intSignCmp _op constant scratch value => - if hasTy checked value .intCarrier && scratch = params.length && - inI64Band constant then - some .boolI32 - else none - let rec checkNodes (checked : List FragNode) : List FragNode → Bool - | [] => true - | node :: rest => - node.id = checked.length && - (match inferNodeKindTy checked node with - | some ty => sameTy node.ty ty - | none => false) && - checkNodes (checked ++ [node]) rest - checkNodes [] block.nodes && - match lookupNode block.nodes block.result with - | some n => n.id = block.result && block.result + 1 = block.nodes.length - | none => false - -def checkBlock (params : List FragTy) (block : FragBlock) : Bool := - checkBlockFuel maxFuel params block - -def checkSymBlockFuel : Nat → List SymTy → SymBlock → Bool - | 0, _, _ => false - | fuel + 1, params, block => - let inferNodeKindTy (checked : List SymNode) (kind : SymNodeKind) : - Option SymTy := - match kind with - | .param index => params[index]? - | .constBool _ => some .bool - | .constInt _ => some .int - | .constFloatBits _ => some .float - | .constStringBytes bytes => - if bytesAllBytes bytes then some .string else none - | .prim op args => symPrimResultTy? checked op args - | .construct typeName _ args => - if typeName = "List" then - match args with - | [head, tail] => - match lookupSymTy checked head, lookupSymTy checked tail with - | some headTy, some (.app1 "List" elemTy) => - if headTy = elemTy then some (.app1 "List" elemTy) else none - | _, _ => none - | _ => none - else if symArgsExist checked args then - some (.named typeName) - else none - | .emptyList elemTy => some (.app1 "List" elemTy) - -- Field projection is typed by the claimed field type; the claim is - -- honest because encoding + byte-exact lowering pin the projection to - -- the module's real struct layout (a lying `fieldTy` encodes to a - -- fragment the byte gate rejects). - | .projectField typeName _field fieldTy value => - if hasSymTy checked value (.named typeName) then some fieldTy else none - -- The operand needs only to be a source Int. A PARAM operand encodes to - -- the two-arm expansion over its local slot; anything computed encodes - -- to the monolithic `intSignCmp` node, which stashes the value in the - -- declared scratch local instead of reading it twice. - | .intConstCmp _ value _ => - if hasSymTy checked value .int then some .bool else none - -- Both operands are ordinary Int VALUES; nothing here demands they be - -- parameters. The two comparison faces pin the encoded node list - -- literally to reads of locals 0 and 1, so a comparison of anything - -- else encodes to a plan no face recognizes and declines there. - | .intCmp _ lhs rhs => - if hasSymTy checked lhs .int && hasSymTy checked rhs .int then some .bool else none - | .tagMatch _typeName scrutinee _tag hit miss => - -- The scrutinee must be an ADT/record value (encodes to `adtRef`, so - -- `struct.get.user` is well-typed); both arms must check under the - -- same params and agree on their result type. - match lookupSymTy checked scrutinee with - | some (.named _) | some (.app1 _ _) | some (.app2 _ _ _) => - if checkSymBlockFuel fuel params hit && - checkSymBlockFuel fuel params miss then - match lookupSymNode hit.nodes hit.result, - lookupSymNode miss.nodes miss.result with - | some t, some e => if t.ty = e.ty then some t.ty else none - | _, _ => none - else none - | _ => none - | .ifElse cond thenBlock elseBlock => - if hasSymTy checked cond .bool && - checkSymBlockFuel fuel params thenBlock && - checkSymBlockFuel fuel params elseBlock then - match lookupSymNode thenBlock.nodes thenBlock.result, - lookupSymNode elseBlock.nodes elseBlock.result with - | some t, some e => if t.ty = e.ty then some t.ty else none - | _, _ => none - else none - -- The fused vector read is pinned to `Vector` in param 0 and an - -- `Int` index in param 1; its value is the read (or default) `Int`. - | .vectorGetOrDefault typeName _default => - if typeName = "Vector" && - params[0]? = some (.app1 "Vector" .int) && - params[1]? = some .int then - some .int - else none - let rec checkNodes (checked : List SymNode) : List SymNode → Bool - | [] => true - | node :: rest => - node.id = checked.length && - (match inferNodeKindTy checked node.kind with - | some ty => sameSymTy node.ty ty - | none => false) && - checkNodes (checked ++ [node]) rest - checkNodes [] block.nodes && - match lookupSymNode block.nodes block.result with - | some n => n.id = block.result && block.result + 1 = block.nodes.length - | none => false - -def checkSymBlock (params : List SymTy) (block : SymBlock) : Bool := - checkSymBlockFuel maxFuel params block - -/-- Exhaustive so extending `FragPrim` requires an explicit NaN-profile choice. -/ -def primNeedsRelationalFloatResult : FragPrim → Bool - | .f64Add => true - | .f64Mul => true - | .f64Le => false - | .f64Ge => false - | .f64Lt => false - | .f64Gt => false - | .f64Eq => false - | .i64Eq => false - | .i64LeS => false - | .i64LtS => false - | .i64GeS => false - | .i64GtS => false - | .i32Eq => false - | .i32LtS => false - | .i32GtS => false - | .i32GeS => false - | .i32And => false - -/-- The general WebAssembly profile gives `f64.add`/`f64.mul` a set-valued - result when they produce NaN: more than one sign/payload bit pattern may - be valid. The current Float codomain face names one exact `UInt64`, so a - Float-result plan containing either operation needs a relational result - model before it can be admitted. Fuel exhaustion rejects fail-closed. The - node match is deliberately exhaustive so extending `FragNodeKind` forces an - explicit decision about nested blocks and Float-bit observation here. - - A Bool-result plan is intentionally outside this gate. In the current - grammar the Float-to-Bool primitives are `f64.le`, `f64.ge`, `f64.lt`, - `f64.gt` and `f64.eq`; each is an IEEE-754 ORDERED comparison, so its - result is false for every NaN operand independently of that NaN's sign or - payload. The single Float comparison general Wasm defines as UNORDERED, - `f64.ne` (true whenever an operand is NaN, including `NaN != NaN`), is - deliberately absent from `FragPrim`: it does not follow from this clause by - analogy and would need its own decision here before it could be admitted. -/ -def blockNeedsRelationalFloatResultFuel : Nat → FragBlock → Bool - | 0, _ => true - | fuel + 1, block => - block.nodes.any fun node => - match node.kind with - | .prim op _ => primNeedsRelationalFloatResult op - | .ifElse _ thenBlock elseBlock => - blockNeedsRelationalFloatResultFuel fuel thenBlock || - blockNeedsRelationalFloatResultFuel fuel elseBlock - | .local _ => false - | .constBool _ => false - | .constI64 _ => false - | .constI32 _ => false - | .constF64Bits _ => false - | .structGet _ _ => false - | .structGetUser _ _ _ => false - | .refIsNull _ => false - | .hostCall _ _ _ => false - | .selfCall _ _ _ => false - | .vectorGetOrDefault _ _ _ _ => false - | .structNew _ _ => false - | .intSignCmp _ _ _ _ => false - -def exactBitFloatResultAllowed (plan : ExprFragmentRawPlan) : Bool := - match plan.result with - | .f64 => !blockNeedsRelationalFloatResultFuel maxFuel plan.body - | _ => true - -def checkExprFragmentRawPlan (plan : ExprFragmentRawPlan) : Bool := - plan.profile = "expr-fragment-v1" && - exactBitFloatResultAllowed plan && - checkBlock plan.params plan.body && - match lookupNode plan.body.nodes plan.body.result with - | some n => sameTy n.ty plan.result - | none => false - -/-! Executable regression pins for the general-Wasm NaN boundary. -/ - -private def binaryFloatProbe (op : FragPrim) (result : FragTy) : ExprFragmentRawPlan := - { profile := "expr-fragment-v1", params := [.f64, .f64], result := result, - body := { nodes := - [{ id := 0, ty := .f64, kind := .local 0 }, - { id := 1, ty := .f64, kind := .local 1 }, - { id := 2, ty := result, kind := .prim op [0, 1] }], result := 2 } } - -private def nestedFloatProbe (op : FragPrim) : ExprFragmentRawPlan := - { profile := "expr-fragment-v1", params := [.boolI32, .f64, .f64], result := .f64, - body := { nodes := - [{ id := 0, ty := .boolI32, kind := .local 0 }, - { id := 1, ty := .f64, kind := .ifElse 0 - { nodes := - [{ id := 0, ty := .f64, kind := .local 1 }, - { id := 1, ty := .f64, kind := .local 2 }, - { id := 2, ty := .f64, kind := .prim op [0, 1] }], result := 2 } - { nodes := - [{ id := 0, ty := .f64, kind := .local 1 }], result := 0 } }], result := 1 } } - -example : checkExprFragmentRawPlan (binaryFloatProbe .f64Add .f64) = false := rfl -example : checkExprFragmentRawPlan (binaryFloatProbe .f64Mul .f64) = false := rfl -example : checkExprFragmentRawPlan (binaryFloatProbe .f64Le .boolI32) = true := rfl -example : checkExprFragmentRawPlan (binaryFloatProbe .f64Ge .boolI32) = true := rfl -example : checkExprFragmentRawPlan (binaryFloatProbe .f64Lt .boolI32) = true := rfl -example : checkExprFragmentRawPlan (binaryFloatProbe .f64Gt .boolI32) = true := rfl -example : checkExprFragmentRawPlan (binaryFloatProbe .f64Eq .boolI32) = true := rfl -example : checkBlock (nestedFloatProbe .f64Add).params - (nestedFloatProbe .f64Add).body = true := rfl -example : checkExprFragmentRawPlan (nestedFloatProbe .f64Add) = false := rfl -example : checkExprFragmentRawPlan (nestedFloatProbe .f64Mul) = false := rfl - -def checkRecursionRawPlan (plan : RecursionRawPlan) : Bool := - plan.profile = "recursion-plan-v1" && - checkBlock plan.params plan.body && - match lookupNode plan.body.nodes plan.body.result with - | some n => sameTy n.ty plan.result - | none => false - -def checkMutualRawPlan (plan : MutualRawPlan) : Bool := - plan.profile = "mutual-plan-v1" && - checkBlock plan.params plan.body && - match lookupNode plan.body.nodes plan.body.result with - | some n => sameTy n.ty plan.result - | none => false - -/-- Generic composition-plan discipline. A chain must contain at least one - call; context-sensitive target/closure checks live in AcceptedArtifactCore, - after names have been resolved from byte-derived export bindings. -/ -def checkCompositionRawPlan (plan : CompositionRawPlan) : Bool := - plan.profile = "composition-plan-v1" && - match plan.shape with - | .selfSum => true - | .chain callees => !callees.isEmpty - -/-- Composition v1 consumes exactly one strict `add` role. Requiring the whole - table shape (not merely a successful lookup) makes the canonical host - builder extensional and unambiguous. -/ -def checkCompositionHostTable (hostTable : List (HostRole × Nat)) : Bool := - match hostTable with - | [(.add, _)] => true - | _ => false - -/-! ### Verbatim `ref.test`-dispatch checker - -The `verbatim-plan-v1` grammar has its own dedicated types (the multi-use -scrutinee is spilled to a scratch local, which pure ANF `FragBlock` cannot -express). The soundness binding is the byte-equality gate in -`AcceptedArtifact.verbatimPlanAccepted`; this structural check only rejects -degenerate plans (wrong profile, or a projection sharing the scrutinee's scratch -local). -/ - -def leafHasProjection : VerbatimLeaf → Bool - | .project _ _ => true - | _ => false - -def dispatchHasProjection : VerbatimDispatch → Bool - | .leaf l => leafHasProjection l - | .test _ hit rest => leafHasProjection hit || dispatchHasProjection rest - -def checkVerbatimLeaf : VerbatimLeaf → Bool - | .project _ _ => true - -- Every payload element must be a real byte: the data-section binding compares - -- the claimed payload against recovered `0..255` segment bytes, so an - -- out-of-range element could never match and is rejected up front. - | .arrayNewData _ _ bytes => bytesAllBytes bytes - | .refNull => true - | .f64Bits _ => true - -def checkVerbatimDispatch : VerbatimDispatch → Bool - | .leaf l => checkVerbatimLeaf l - | .test _ hit rest => checkVerbatimLeaf hit && checkVerbatimDispatch rest - -def checkVerbatimRawPlan (plan : VerbatimRawPlan) : Bool := - plan.profile == "verbatim-plan-v1" && - checkVerbatimDispatch plan.body && - (!dispatchHasProjection plan.body || plan.fieldLocal != plan.scrutineeLocal) - -/-- Full admission for a verbatim plan at its canonical function-local count. - Besides the byte-facing raw checks, the two scratch locals must exist and - the dispatch must begin with a test: the generic proof lane starts with the - scrutinee on the stack and therefore cannot certify a bare leaf root. -/ -def checkVerbatimPlan (nlocals : Nat) (plan : VerbatimRawPlan) : Bool := - checkVerbatimRawPlan plan && - decide (plan.scrutineeLocal < 1 + nlocals) && - decide (plan.fieldLocal < 1 + nlocals) && - match plan.body with - | .test _ _ _ => true - | .leaf _ => false - -def checkSymRawPlan (plan : SymRawPlan) : Bool := - plan.profile = "sym-fragment-v1" && - checkSymBlock plan.params plan.body && - match lookupSymNode plan.body.nodes plan.body.result with - | some n => sameSymTy n.ty plan.result - | none => false - -def byteChunksAllBytes : List (List Nat) → Bool - | [] => true - | bytes :: rest => bytesAllBytes bytes && byteChunksAllBytes rest - -def stringConcatChunksAllBytes : List StringConcatChunk → Bool - | [] => true - | chunk :: rest => bytesAllBytes chunk.bytes && stringConcatChunksAllBytes rest - -def checkStringConcatRawPlan (plan : StringConcatRawPlan) : Bool := - plan.profile = "string-concat-v1" && - stringConcatChunksAllBytes plan.prefixes && - stringConcatChunksAllBytes plan.suffixes - -def stringConcatChunkBytes : StringConcatChunk → List Nat - | { bytes, .. } => bytes - -inductive SymStringConcatPart where - | literal (bytes : List Nat) - | input -deriving Repr, DecidableEq - -inductive SymStringEqResult where - | literal (bytes : List Nat) - | input -deriving Repr, DecidableEq - -def stringEqResultBytes? : StringEqResult → Option SymStringEqResult - | .input => some .input - | .literal chunk => - if bytesAllBytes chunk.bytes then some (.literal chunk.bytes) else none - -def symStringConcatPart? (nodes : List SymNode) (id : Nat) : - Option SymStringConcatPart := - match lookupSymNode nodes id with - | some { ty := .string, kind := .constStringBytes bytes, .. } => - if bytesAllBytes bytes then some (.literal bytes) else none - | some { ty := .string, kind := .param 0, .. } => some .input - | _ => none - -def splitSymStringConcatParts : - List SymStringConcatPart → - Option (List (List Nat) × List (List Nat)) := - let rec go - (seenInput : Bool) - (prefixes suffixes : List (List Nat)) : - List SymStringConcatPart → - Option (List (List Nat) × List (List Nat)) - | [] => - if seenInput then some (prefixes, suffixes) else none - | .input :: rest => - if seenInput then none else go true prefixes suffixes rest - | .literal bytes :: rest => - if seenInput then - go seenInput prefixes (suffixes ++ [bytes]) rest - else - go seenInput (prefixes ++ [bytes]) suffixes rest - go false [] [] - -def symStringConcatParts? (plan : SymRawPlan) : - Option (List (List Nat) × List (List Nat)) := - if checkSymRawPlan plan && - plan.params = [.string] && - plan.result = .string then - match lookupSymNode plan.body.nodes plan.body.result with - | some { kind := .prim .stringConcat args, .. } => - if args = List.range args.length && - args.length + 1 = plan.body.nodes.length then - match args.mapM (symStringConcatPart? plan.body.nodes) with - | some parts => splitSymStringConcatParts parts - | none => none - else none - | _ => none - else none - -def stringConcatPlanMatchesSymRawPlan - (symPlan : SymRawPlan) - (plan : StringConcatRawPlan) : Bool := - match symStringConcatParts? symPlan with - | some (prefixes, suffixes) => - prefixes = plan.prefixes.map stringConcatChunkBytes && - suffixes = plan.suffixes.map stringConcatChunkBytes - | none => false - -def checkStringEqResult : StringEqResult → Bool - | .input => true - | .literal chunk => bytesAllBytes chunk.bytes - -def checkStringEqRawPlan (plan : StringEqRawPlan) : Bool := - plan.profile = "string-eq-v1" && - bytesAllBytes plan.needle.bytes && - checkStringEqResult plan.hit && - checkStringEqResult plan.default - -def symStringEqResult? (block : SymBlock) : Option SymStringEqResult := - match block.nodes, lookupSymNode block.nodes block.result with - | [_], some { ty := .string, kind := .constStringBytes bytes, .. } => - if bytesAllBytes bytes then some (.literal bytes) else none - | [_], some { ty := .string, kind := .param 0, .. } => some .input - | _, _ => none - -def symStringEqParts? (plan : SymRawPlan) : - Option (List Nat × SymStringEqResult × SymStringEqResult) := - if checkSymRawPlan plan && - plan.params = [.string] && - plan.result = .string then - match lookupSymNode plan.body.nodes plan.body.result with - | some { ty := .string, kind := .ifElse cond thenBlock elseBlock, .. } => - match lookupSymNode plan.body.nodes cond, - symStringEqResult? thenBlock, - symStringEqResult? elseBlock with - | some { ty := .bool, kind := .prim .stringEq [input, needle], .. }, - some hit, - some default => - match lookupSymNode plan.body.nodes input, - lookupSymNode plan.body.nodes needle with - | some { ty := .string, kind := .param 0, .. }, - some { ty := .string, kind := .constStringBytes bytes, .. } => - if bytesAllBytes bytes then some (bytes, hit, default) else none - | _, _ => none - | _, _, _ => none - | _ => none - else none - -def stringEqPlanMatchesSymRawPlan - (symPlan : SymRawPlan) - (plan : StringEqRawPlan) : Bool := - if checkStringEqRawPlan plan then - match symStringEqParts? symPlan, - stringEqResultBytes? plan.hit, - stringEqResultBytes? plan.default with - | some (needle, hit, default), some planHit, some planDefault => - needle = plan.needle.bytes && - hit = planHit && - default = planDefault - | _, _, _ => false - else false - -def constructFieldOk (arity : Nat) : ConstructField → Bool - | .local index => index < arity - -- Null is the canonical empty-list tail. Its heap type is NOT plan data: - -- constructor lowering receives the byte-derived target struct index. - | .null => true - -def constructFieldsOk (arity : Nat) : List ConstructField → Bool - | [] => true - | field :: rest => constructFieldOk arity field && constructFieldsOk arity rest - -def constructLocalFields : List ConstructField → List Nat - | [] => [] - | .local index :: rest => index :: constructLocalFields rest - | .null :: rest => constructLocalFields rest - -def natListNoDup : List Nat → Bool - | [] => true - | n :: rest => (!rest.contains n) && natListNoDup rest - -def rangeAllContained (locals : List Nat) : Nat → Bool - | 0 => true - | n + 1 => rangeAllContained locals n && locals.contains n - -def constructUsesAllParams (arity : Nat) (fields : List ConstructField) : Bool := - let locals := constructLocalFields fields - locals.length = arity && - natListNoDup locals && - rangeAllContained locals arity - -def checkConstructRawPlan (plan : ConstructRawPlan) : Bool := - plan.profile = "construct-v1" && - 0 < plan.arity && - 0 < plan.fields.length && - constructFieldsOk plan.arity plan.fields && - constructUsesAllParams plan.arity plan.fields - -def symConstructArgs? (plan : SymRawPlan) : Option (List SymNode × String × String × List Nat) := - match lookupSymNode plan.body.nodes plan.body.result with - | some { ty := .named typeName, kind := .construct _ ctorName args, .. } => - some (plan.body.nodes, typeName, ctorName, args) - | some { ty := .app1 typeName _, kind := .construct _ ctorName args, .. } => - some (plan.body.nodes, typeName, ctorName, args) - | some { ty := .app2 typeName _ _, kind := .construct _ ctorName args, .. } => - some (plan.body.nodes, typeName, ctorName, args) - | _ => none - -def symConstructFieldsMatch - (nodes : List SymNode) : List Nat → List ConstructField → Bool - | [], [] => true - | arg :: args, .local index :: fields => - match lookupSymNode nodes arg with - | some { kind := .param actual, .. } => - actual = index && symConstructFieldsMatch nodes args fields - | _ => false - | arg :: args, .null :: fields => - match lookupSymNode nodes arg with - | some { kind := .emptyList _, .. } => symConstructFieldsMatch nodes args fields - | _ => false - | _, _ => false - -def constructPlanMatchesSymRawPlan - (symPlan : SymRawPlan) - (plan : ConstructRawPlan) : Bool := - if checkConstructRawPlan plan then - match symConstructArgs? symPlan with - | some (nodes, _, _, args) => - symPlan.params.length = plan.arity && - symConstructFieldsMatch nodes args plan.fields - | none => false - else false - -def encodeSymTy? : SymTy → Option FragTy - | .float => some .f64 - | .bool => some .boolI32 - | .int => some .intCarrier - -- Strings and named user types are whole references at the representation - -- level: both encode to the opaque `adtRef`. String OPERATIONS still do not - -- encode (their nodes return `none` below); this only lets reference-typed - -- values flow verbatim through the field-projection face. - | .string => some .adtRef - | .named _ => some .adtRef - | .app1 _ _ => some .adtRef - | .app2 _ _ _ => some .adtRef - -def encodeSymTys? : List SymTy → Option (List FragTy) - | [] => some [] - | ty :: tys => - match encodeSymTy? ty, encodeSymTys? tys with - | some fragTy, some fragTys => some (fragTy :: fragTys) - | _, _ => none - -def encodeSymPrim? : SymPrim → Option FragPrim - | .floatAdd => some .f64Add - | .floatMul => some .f64Mul - | .floatLe => some .f64Le - | .floatGe => some .f64Ge - | .floatLt => some .f64Lt - | .floatGt => some .f64Gt - | .floatEq => some .f64Eq - -- Int arithmetic has no representation-level primitive: the encoder binds - -- it to the byte-derived add/sub/mul host-role calls instead. - | .intAdd => none - | .intSub => none - | .intMul => none - | .stringEq => none - | .stringConcat => none - | .boolAnd => some .i32And - -/-- Look up the resolved wasm function index for one host role in the - byte-derived role table an artifact claim carries. A role the table lacks - fail-closes the encoding (`none`). -/ -def hostRoleIdx? (hostTable : List (HostRole × Nat)) (role : HostRole) : Option Nat := - match hostTable with - | [] => none - | (r, idx) :: rest => if r = role then some idx else hostRoleIdx? rest role - -/-- Look up the resolved wasm struct type index for one source type name in the - byte-derived struct table an artifact claim carries. A name the table lacks - fail-closes the encoding (`none`). Like the host-role table, a wrong table - encodes to a representation plan whose canonical bytes cannot match the - module, so the claim fail-closes at the byte gate. -/ -def structTyIdx? (structTable : List (String × Nat)) (name : String) : Option Nat := - match structTable with - | [] => none - | (n, idx) :: rest => if n = name then some idx else structTyIdx? rest name - -def symIntSmallConstCmpPrim? : SymIntCmp → Option FragPrim - | .eq => some .i64Eq - | .lt => some .i64LtS - | .le => some .i64LeS - | .ge => some .i64GeS - | .gt => some .i64GtS - -/-- The signed relational primitive that reads the three-way `__aint_cmp` - verdict for one source operator. `eq` is absent because it reads a - DIFFERENT helper (`__aint_eq`, which needs no tail at all), and `le` is - absent because the plan grammar has no `i32.le_s` to lower it to. -/ -def symIntCmpTailPrim? : SymIntCmp → Option FragPrim - | .lt => some .i32LtS - | .gt => some .i32GtS - | .ge => some .i32GeS - | .eq => none - | .le => none - -inductive SymBigIntConstCmpKind where - | always (value : Bool) - | signLtZero - | signGtZero - -/-- A Big carrier is strictly outside the i64 range, so its relation to any - i64 literal is fixed by the sign limb alone: Big-positive exceeds every - literal, Big-negative is below every literal, and a Big never equals one. - `gt` therefore lands on the same `signGtZero` branch as `ge`, exactly as - `lt` and `le` share `signLtZero`. -/ -def symIntBigConstCmpKind? : SymIntCmp → Option SymBigIntConstCmpKind - | .eq => some (.always false) - | .lt => some .signLtZero - | .le => some .signLtZero - | .ge => some .signGtZero - | .gt => some .signGtZero - -def appendFragNode - (nodes : List FragNode) - (ty : FragTy) - (kind : FragNodeKind) : List FragNode × Nat := - let id := nodes.length - (nodes ++ [{ id := id, ty := ty, kind := kind }], id) - -def encodeIntSmallConstCmpBlock? (index : Nat) (op : SymIntCmp) (k : Int) : - Option FragBlock := do - let prim ← symIntSmallConstCmpPrim? op - let (nodes, carrier) := appendFragNode [] .intCarrier (.local index) - let (nodes, small) := appendFragNode nodes .i64 (.structGet 0 carrier) - let (nodes, constant) := appendFragNode nodes .i64 (.constI64 k) - let (nodes, result) := appendFragNode nodes .boolI32 (.prim prim [small, constant]) - some { nodes := nodes, result := result } - -def encodeIntBigConstCmpBlock? (index : Nat) (op : SymIntCmp) : - Option FragBlock := do - match symIntBigConstCmpKind? op with - | some (.always value) => - let (nodes, result) := appendFragNode [] .boolI32 (.constBool value) - some { nodes := nodes, result := result } - | some .signLtZero => - let (nodes, carrier) := appendFragNode [] .intCarrier (.local index) - let (nodes, sign) := appendFragNode nodes .rawI32 (.structGet 2 carrier) - let (nodes, zeroId) := appendFragNode nodes .boolI32 (.constBool false) - let (nodes, result) := appendFragNode nodes .boolI32 (.prim .i32LtS [sign, zeroId]) - some { nodes := nodes, result := result } - | some .signGtZero => - let (nodes, carrier) := appendFragNode [] .intCarrier (.local index) - let (nodes, sign) := appendFragNode nodes .rawI32 (.structGet 2 carrier) - let (nodes, zeroId) := appendFragNode nodes .boolI32 (.constBool false) - let (nodes, result) := appendFragNode nodes .boolI32 (.prim .i32GtS [sign, zeroId]) - some { nodes := nodes, result := result } - | none => none - -structure SymEncodeState where - nodes : List FragNode - symToFrag : List Nat - -def sourceParamIndex? (nodes : List SymNode) (id : Nat) : Option Nat := - match lookupSymNode nodes id with - | some { ty := .int, kind := .param index, .. } => some index - | _ => none - -def encodedValue? (st : SymEncodeState) (id : Nat) : Option Nat := - st.symToFrag[id]? - -def pushEncodedNode - (st : SymEncodeState) - (ty : FragTy) - (kind : FragNodeKind) : SymEncodeState × Nat := - let (nodes, id) := appendFragNode st.nodes ty kind - ({ st with nodes := nodes }, id) - -/-- `nparams` is the plan's parameter count, threaded so the sign-template - encoding can name the ONE declared scratch local (slot `nparams`); nested - blocks share the enclosing plan's parameters, so it is constant. -/ -def encodeSymBlockFuel : - Nat → Nat → List (HostRole × Nat) → List (String × Nat) → SymBlock → - Option FragBlock - | 0, _, _, _, _ => none - | fuel + 1, nparams, hostTable, structTable, block => - let encodeNode (st : SymEncodeState) (node : SymNode) : Option SymEncodeState := do - if node.id = st.symToFrag.length then - let fragTy ← encodeSymTy? node.ty - match node.kind with - | .param index => - let (st, id) := pushEncodedNode st fragTy (.local index) - some { st with symToFrag := st.symToFrag ++ [id] } - | .constBool value => - let (st, id) := pushEncodedNode st fragTy (.constBool value) - some { st with symToFrag := st.symToFrag ++ [id] } - | .constInt value => - -- A source Int literal is representation-boxed at the point of - -- appearance: push the raw `i64` constant, then the byte-derived - -- `box` host call; the source node maps to the boxed carrier. - let boxIdx ← hostRoleIdx? hostTable .box - let (st, constId) := pushEncodedNode st .i64 (.constI64 value) - let (st, boxedId) := - pushEncodedNode st fragTy (.hostCall .box boxIdx [constId]) - some { st with symToFrag := st.symToFrag ++ [boxedId] } - | .constFloatBits bits => - let (st, id) := pushEncodedNode st fragTy (.constF64Bits bits) - some { st with symToFrag := st.symToFrag ++ [id] } - | .constStringBytes _ => none - | .prim op args => - match op with - | .intAdd => - let addIdx ← hostRoleIdx? hostTable .add - let fragArgs ← args.mapM (encodedValue? st) - let (st, id) := - pushEncodedNode st fragTy (.hostCall .add addIdx fragArgs) - some { st with symToFrag := st.symToFrag ++ [id] } - | .intSub => - let subIdx ← hostRoleIdx? hostTable .sub - let fragArgs ← args.mapM (encodedValue? st) - let (st, id) := - pushEncodedNode st fragTy (.hostCall .sub subIdx fragArgs) - some { st with symToFrag := st.symToFrag ++ [id] } - | .intMul => - let mulIdx ← hostRoleIdx? hostTable .mul - let fragArgs ← args.mapM (encodedValue? st) - let (st, id) := - pushEncodedNode st fragTy (.hostCall .mul mulIdx fragArgs) - some { st with symToFrag := st.symToFrag ++ [id] } - | _ => - let prim ← encodeSymPrim? op - let fragArgs ← args.mapM (encodedValue? st) - let (st, id) := pushEncodedNode st fragTy (.prim prim fragArgs) - some { st with symToFrag := st.symToFrag ++ [id] } - | .construct typeName _ args => - -- Record construction: bind the declared type name to its - -- byte-derived struct index and pack the planned field values - -- in declaration order (`struct.new`). List cells keep their - -- dedicated constructor family; only opaque user records - -- encode here. - if typeName = "List" || fragTy != FragTy.adtRef then - none - else - let tyIdx ← structTyIdx? structTable typeName - let fragArgs ← args.mapM (encodedValue? st) - let (st, id) := - pushEncodedNode st fragTy (.structNew tyIdx fragArgs) - some { st with symToFrag := st.symToFrag ++ [id] } - | .emptyList _ => none - | .projectField typeName field _fieldTy value => - -- Opaque reference fields encode for the field-projection face; - -- scalar fields (`Int`/`Bool`/`Float`) encode for the - -- record-parameter face, whose equality pin over the certified - -- Plan declaration confirms the declared scalar against the - -- module's real type-section entry. Every other field type - -- fail-closes the encoding. - if fragTy = FragTy.adtRef || fragTyIsRecordScalar fragTy then - let tyIdx ← structTyIdx? structTable typeName - let value ← encodedValue? st value - let (st, id) := - pushEncodedNode st fragTy (.structGetUser tyIdx field value) - some { st with symToFrag := st.symToFrag ++ [id] } - else - none - | .intConstCmp op value constant => - -- A PARAM operand keeps the historical two-arm expansion: both - -- arms re-read the parameter's local slot, so no scratch is - -- needed and the emitted bytes are unchanged. Any COMPUTED - -- operand cannot be re-read, so it encodes to the emitter's real - -- monolithic template, which stashes the value in the declared - -- scratch local (slot `nparams`). - let operand ← encodedValue? st value - match sourceParamIndex? block.nodes value with - | some index => - let (st, magf) := pushEncodedNode st .ref (.structGet 1 operand) - let (st, isSmall) := pushEncodedNode st .boolI32 (.refIsNull magf) - let thenBlock ← encodeIntSmallConstCmpBlock? index op constant - let elseBlock ← encodeIntBigConstCmpBlock? index op - let (st, id) := pushEncodedNode st .boolI32 (.ifElse isSmall thenBlock elseBlock) - some { st with symToFrag := st.symToFrag ++ [id] } - | none => - let (st, id) := pushEncodedNode st .boolI32 - (.intSignCmp op constant nparams operand) - some { st with symToFrag := st.symToFrag ++ [id] } - | .intCmp op lhs rhs => - -- The emitted comparison: read both operands, call the helper the - -- operator names, and — for the three relational operators — - -- compare the raw verdict against `i32.const 0`. Equality reads - -- `__aint_eq`, whose `0`/`1` result IS the source Boolean. - let lhsId ← encodedValue? st lhs - let rhsId ← encodedValue? st rhs - match op with - | .eq => - let eqIdx ← hostRoleIdx? hostTable .eq - let (st, id) := - pushEncodedNode st .boolI32 (.hostCall .eq eqIdx [lhsId, rhsId]) - some { st with symToFrag := st.symToFrag ++ [id] } - | op => - let prim ← symIntCmpTailPrim? op - let cmpIdx ← hostRoleIdx? hostTable .cmp - let (st, verdict) := - pushEncodedNode st .rawI32 (.hostCall .cmp cmpIdx [lhsId, rhsId]) - let (st, zero) := pushEncodedNode st .rawI32 (.constI32 0) - let (st, id) := pushEncodedNode st .boolI32 (.prim prim [verdict, zero]) - some { st with symToFrag := st.symToFrag ++ [id] } - | .tagMatch typeName scrutinee tag hitBlock missBlock => - -- Canonical tag-dispatch lowering: read field 0 (i32 tag) of the - -- scrutinee's struct, compare to the literal discriminant, and - -- branch. The arms carry their own encoded sub-models (for - -- slotCount each is a boxed integer constant). The struct index is - -- resolved from the byte-derived struct table; a wrong table - -- encodes to bytes the module cannot match (fail-closed). - let tyIdx ← structTyIdx? structTable typeName - let scrut ← encodedValue? st scrutinee - let (st, tagId) := pushEncodedNode st .rawI32 (.structGetUser tyIdx 0 scrut) - let (st, kId) := pushEncodedNode st .rawI32 (.constI32 tag) - let (st, cmpId) := pushEncodedNode st .boolI32 (.prim .i32Eq [tagId, kId]) - let hitFrag ← encodeSymBlockFuel fuel nparams hostTable structTable hitBlock - let missFrag ← encodeSymBlockFuel fuel nparams hostTable structTable missBlock - let (st, id) := pushEncodedNode st fragTy (.ifElse cmpId hitFrag missFrag) - some { st with symToFrag := st.symToFrag ++ [id] } - | .ifElse cond thenBlock elseBlock => - let cond ← encodedValue? st cond - let thenFrag ← encodeSymBlockFuel fuel nparams hostTable structTable thenBlock - let elseFrag ← encodeSymBlockFuel fuel nparams hostTable structTable elseBlock - let (st, id) := pushEncodedNode st fragTy (.ifElse cond thenFrag elseFrag) - some { st with symToFrag := st.symToFrag ++ [id] } - | .vectorGetOrDefault typeName default => - -- The monolithic fused read: resolve the vector's array type - -- through the byte-derived struct table and both helpers through - -- the byte-derived role table; a missing binding fail-closes. - let arrTy ← structTyIdx? structTable typeName - let toIndexIdx ← hostRoleIdx? hostTable .toIndex - let boxIdx ← hostRoleIdx? hostTable .box - let (st, id) := pushEncodedNode st fragTy - (.vectorGetOrDefault arrTy toIndexIdx boxIdx default) - some { st with symToFrag := st.symToFrag ++ [id] } - else - none - let rec encodeNodes (st : SymEncodeState) : List SymNode → Option SymEncodeState - | [] => some st - | node :: rest => - match encodeNode st node with - | some st => encodeNodes st rest - | none => none - match encodeNodes { nodes := [], symToFrag := [] } block.nodes with - | some st => - match st.symToFrag[block.result]? with - | some result => some { nodes := st.nodes, result := result } - | none => none - | none => none - -def encodeSymBlock? - (nparams : Nat) - (hostTable : List (HostRole × Nat)) - (structTable : List (String × Nat)) - (block : SymBlock) : - Option FragBlock := - encodeSymBlockFuel maxFuel nparams hostTable structTable block - -def encodeSymRawPlanToExprFragmentRawPlan - (hostTable : List (HostRole × Nat)) - (structTable : List (String × Nat)) - (plan : SymRawPlan) : - Option ExprFragmentRawPlan := - if checkSymRawPlan plan then - match encodeSymTys? plan.params, encodeSymTy? plan.result, - encodeSymBlock? plan.params.length hostTable structTable plan.body with - | some params, some result, some body => - some { profile := "expr-fragment-v1", params := params, result := result, body := body } - | _, _, _ => none - else - none - -/-! ### `recursion-plan-v1` shape checking - -`checkRecursionRawPlan` above is only the generic typed-block discipline; it -deliberately knows nothing about WHICH function a `selfCall` may target or -which indices realise the host roles. This section pins the fuel-recursion -grammar itself, context-sensitively: the exact carrier-sign dispatch the -emitter produces, a base arm that is a boxed literal (unary) or the -accumulator (two-argument), a step arm whose descent is `sub(n, box 1)`, host -calls citing exactly the byte-derived role table, and a self-call whose target -is EXACTLY the exported function's own index. The self index and role table -are context threaded from the byte-derived function binding — never plan -data. -/ - -/-- The small-limb arm of the sign predicate: `n.small ≤ 0`. -/ -def recSignSmall (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .structGet 0 0 }, - { id := 2, ty := .i64, kind := .constI64 z }, - { id := 3, ty := .boolI32, kind := .prim .i64LeS [1, 2] }], 3 => z = 0 - | _, _ => false - -/-- The big-limb arm of the sign predicate: `n.sign < 0`. -/ -def recSignBig (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .rawI32, kind := .structGet 2 0 }, - { id := 2, ty := .boolI32, kind := .constBool false }, - { id := 3, ty := .boolI32, kind := .prim .i32LtS [1, 2] }], 3 => true - | _, _ => false - -/-- Unary base arm: a boxed integer literal (`i64.const k; box`). -/ -def recBaseUnary (boxIdx : Nat) (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .i64, kind := .constI64 _ }, - { id := 1, ty := .intCarrier, kind := .hostCall .box bi [0] }], 1 => bi = boxIdx - | _, _ => false - -/-- Accumulator base arm: return the accumulator parameter. -/ -def recBaseAcc (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 1 }], 0 => true - | _, _ => false - -/-- Unary step arm, all four byte-derived variants: the descent - `sub(n, box 1)` feeding a NON-TAIL self-call, combined with the other - operand (the input `n`, or a boxed constant) on either side by the - role-`add` or role-`mul` combinator helper. Every host index must cite the table and the - self-call must target `self`. -/ -def recStepUnary (combineRole : HostRole) (self boxIdx combineIdx subIdx : Nat) - (b : FragBlock) : Bool := - match b.nodes, b.result with - -- other = input, recursive result second: `n + f(n-1)` - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 0 }, - { id := 2, ty := .i64, kind := .constI64 one }, - { id := 3, ty := .intCarrier, kind := .hostCall .box bi [2] }, - { id := 4, ty := .intCarrier, kind := .hostCall .sub si [1, 3] }, - { id := 5, ty := .intCarrier, kind := .selfCall false sc [4] }, - { id := 6, ty := .intCarrier, kind := .hostCall role ci [0, 5] }], 6 => - one = 1 && bi = boxIdx && si = subIdx && sc = self && - role = combineRole && ci = combineIdx - -- other = boxed constant, recursive result second: `k + f(n-1)` - | [{ id := 0, ty := .i64, kind := .constI64 _ }, - { id := 1, ty := .intCarrier, kind := .hostCall .box bk [0] }, - { id := 2, ty := .intCarrier, kind := .local 0 }, - { id := 3, ty := .i64, kind := .constI64 one }, - { id := 4, ty := .intCarrier, kind := .hostCall .box bi [3] }, - { id := 5, ty := .intCarrier, kind := .hostCall .sub si [2, 4] }, - { id := 6, ty := .intCarrier, kind := .selfCall false sc [5] }, - { id := 7, ty := .intCarrier, kind := .hostCall role ci [1, 6] }], 7 => - one = 1 && bk = boxIdx && bi = boxIdx && si = subIdx && sc = self && - role = combineRole && ci = combineIdx - -- other = input, recursive result first: `f(n-1) + n` - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 one }, - { id := 2, ty := .intCarrier, kind := .hostCall .box bi [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub si [0, 2] }, - { id := 4, ty := .intCarrier, kind := .selfCall false sc [3] }, - { id := 5, ty := .intCarrier, kind := .local 0 }, - { id := 6, ty := .intCarrier, kind := .hostCall role ci [4, 5] }], 6 => - one = 1 && bi = boxIdx && si = subIdx && sc = self && - role = combineRole && ci = combineIdx - -- other = boxed constant, recursive result first: `f(n-1) + k` - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 one }, - { id := 2, ty := .intCarrier, kind := .hostCall .box bi [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub si [0, 2] }, - { id := 4, ty := .intCarrier, kind := .selfCall false sc [3] }, - { id := 5, ty := .i64, kind := .constI64 _ }, - { id := 6, ty := .intCarrier, kind := .hostCall .box bk [5] }, - { id := 7, ty := .intCarrier, kind := .hostCall role ci [4, 6] }], 7 => - one = 1 && bi = boxIdx && bk = boxIdx && si = subIdx && sc = self && - role = combineRole && ci = combineIdx - | _, _ => false - -/-- Accumulator step arm: descent `sub(n, box 1)`, next accumulator - `add(acc, n)`, then a TAIL self-call `f(n-1, acc+n)`. -/ -def recStepAcc (self boxIdx addIdx subIdx : Nat) (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 one }, - { id := 2, ty := .intCarrier, kind := .hostCall .box bi [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub si [0, 2] }, - { id := 4, ty := .intCarrier, kind := .local 1 }, - { id := 5, ty := .intCarrier, kind := .local 0 }, - { id := 6, ty := .intCarrier, kind := .hostCall .add ai [4, 5] }, - { id := 7, ty := .intCarrier, kind := .selfCall true sc [3, 6] }], 7 => - one = 1 && bi = boxIdx && si = subIdx && sc = self && ai = addIdx - | _, _ => false - -/-- The whole recursion body: the carrier discriminator, the sign-predicate - `if`, and the value `if` over base/step. -/ -def recTopBlock (isAcc : Bool) (combineRole : HostRole) - (self boxIdx combineIdx subIdx : Nat) (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .ref, kind := .structGet 1 0 }, - { id := 2, ty := .boolI32, kind := .refIsNull 1 }, - { id := 3, ty := .boolI32, kind := .ifElse 2 signS signB }, - { id := 4, ty := .intCarrier, kind := .ifElse 3 base step }], 4 => - recSignSmall signS && recSignBig signB && - (if isAcc then - recBaseAcc base && recStepAcc self boxIdx combineIdx subIdx step - else - recBaseUnary boxIdx base && - recStepUnary combineRole self boxIdx combineIdx subIdx step) - | _, _ => false - -/-- Classify the context-sensitive `recursion-plan-v1` grammar. Every self-call - targets the byte-derived `self`, every host call cites the byte-derived role - table, and the returned role is a consequence of the checked combine shape: - unary multiplication is `.mul`; unary addition and the accumulator are - `.addSub`. -/ -def classifyRecursionPlanShape - (self : Nat) - (hostTable : List (HostRole × Nat)) - (plan : RecursionRawPlan) : Option TotalityRole := - match hostRoleIdx? hostTable .box, hostRoleIdx? hostTable .sub with - | some boxIdx, some subIdx => - if plan.profile = "recursion-plan-v1" && sameTy plan.result .intCarrier then - match plan.params with - | [.intCarrier] => - match hostRoleIdx? hostTable .add, hostRoleIdx? hostTable .mul with - | some addIdx, _ => - if recTopBlock false .add self boxIdx addIdx subIdx plan.body then - some .addSub - else - match hostRoleIdx? hostTable .mul with - | some mulIdx => - if recTopBlock false .mul self boxIdx mulIdx subIdx plan.body then - some .mul - else none - | none => none - | none, some mulIdx => - if recTopBlock false .mul self boxIdx mulIdx subIdx plan.body then - some .mul - else none - | none, none => none - | [.intCarrier, .intCarrier] => - match hostRoleIdx? hostTable .add with - | some addIdx => - if recTopBlock true .add self boxIdx addIdx subIdx plan.body then - some .addSub - else none - | none => none - | _ => none - else none - | _, _ => none - -/-- Compatibility predicate for family acceptance. The obligation's claimed - role is compared with the independently classified result. -/ -def checkRecursionPlanShape - (self : Nat) - (hostTable : List (HostRole × Nat)) - (totalityRole : TotalityRole) - (plan : RecursionRawPlan) : Bool := - classifyRecursionPlanShape self hostTable plan == some totalityRole - -/-! ### `mutual-plan-v1` shape checking - -`checkMutualRawPlan` above is only the generic typed-block discipline. This -section pins the mutual-member grammar context-sensitively, generalising the -fuel-recursion self-call to a mutual member's cross-call: the carrier-sign -dispatch the emitter produces, a boxed-literal base arm, a step arm whose -descent is `sub(n, box 1)` feeding a TAIL member-call, host calls citing exactly -the byte-derived box/sub role table, and a member-call whose target is IN the -byte-derived SCC member set (`memberSet`). The member set and role table are -context threaded from the byte-derived SCC binding — never plan data. Unlike -`checkRecursionPlanShape` a member's call is NOT pinned to its own index: it -targets a SIBLING member, so the check binds it to the SCC set (the member's own -index is in that set, so a legitimate 2-cycle back-edge is admitted too). The -byte-exact gate then forces it to the member's actual cross target. -/ - -/-- Mutual-member step arm: descent `sub(n, box 1)` feeding a TAIL member-call - `g(n-1)` whose target `cc` is in the byte-derived SCC member set. -/ -def recStepMutual (memberSet : List Nat) (boxIdx subIdx : Nat) (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 one }, - { id := 2, ty := .intCarrier, kind := .hostCall .box bi [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub si [0, 2] }, - { id := 4, ty := .intCarrier, kind := .selfCall true cc [3] }], 4 => - one = 1 && bi = boxIdx && si = subIdx && memberSet.contains cc - | _, _ => false - -/-- The whole mutual-member body: the carrier discriminator, the sign-predicate - `if`, and the value `if` over a boxed-literal base and the mutual step. -/ -def mutTopBlock (memberSet : List Nat) (boxIdx subIdx : Nat) (b : FragBlock) : Bool := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .ref, kind := .structGet 1 0 }, - { id := 2, ty := .boolI32, kind := .refIsNull 1 }, - { id := 3, ty := .boolI32, kind := .ifElse 2 signS signB }, - { id := 4, ty := .intCarrier, kind := .ifElse 3 base step }], 4 => - recSignSmall signS && recSignBig signB && - recBaseUnary boxIdx base && recStepMutual memberSet boxIdx subIdx step - | _, _ => false - -/-- Context-sensitive `mutual-plan-v1` checking: the plan must be the mutual - member grammar, and its member-call must target an index IN the byte-derived - SCC member set with host calls citing the byte-derived box/sub role table. A - table missing the box or sub role fail-closes. -/ -def checkMutualPlanShape - (memberSet : List Nat) - (hostTable : List (HostRole × Nat)) - (plan : MutualRawPlan) : Bool := - match hostRoleIdx? hostTable .box, hostRoleIdx? hostTable .sub with - | some boxIdx, some subIdx => - plan.profile = "mutual-plan-v1" && - sameTy plan.result .intCarrier && - (match plan.params with - | [.intCarrier] => mutTopBlock memberSet boxIdx subIdx plan.body - | _ => false) - | _, _ => false - -/-! ### Int-face `ref.test`-dispatch checker (`int-dispatch-v1`) - -The `Cod := Int` ADT-match families (general variant dispatch, widened Int -match). The soundness binding is the byte-equality gate in -`AcceptedArtifact.intDispatchPlanAccepted` together with the byte-derived -host-role table the lowerers are parameterized by; the plan carries neither -locals nor indices (both are derived). A top-level `test` is required because -the canonical lowering starts with the scrutinee on the stack; a bare default -would violate the generic theorem's stack boundary. -/ - -def checkIntDispatchRawPlan (plan : IntDispatchRawPlan) : Bool := - plan.profile == "int-dispatch-v1" && - match plan.body with - | .test _ _ _ => true - | .default _ => false - -/-- The number of `test` arms in an Int-face dispatch cascade (const and binding - arms alike). The scratch-local layout is NOT a function of this total — only - payload-BINDING arms (`proj`/`hostOp`) spill a local; see `intDispatchBindArmCount` - for the count that drives the layout. -/ -def intDispatchArmCount : IntDispatchCascade → Nat - | .default _ => 0 - | .test _ _ rest => intDispatchArmCount rest + 1 - -/-- Whether one leaf spills a per-arm payload local: `proj`/`hostOp` read the - payload and spill one; a `const` arm reads no field and spills none. -/ -def bindArmLeaf : IntDispatchLeaf → Nat - | .proj => 1 - | .hostOp _ _ _ => 1 - | .const _ => 0 - -/-- The number of PAYLOAD-BINDING (`proj`/`hostOp`) `test` arms in a cascade. A - `const` arm does not contribute to the scratch-local layout: the `i`-th - binding arm spills to local `i+1` and the scrutinee is local - `bindArmCount + 1`. This is what both lowerers thread and what the generic - simulation is parameterized over; `intDispatchArmCount` (which counts every - arm) is retained where total arm count is meant. -/ -def bindArmCount : IntDispatchCascade → Nat - | .default _ => 0 - | .test _ leaf rest => bindArmLeaf leaf + bindArmCount rest - -/-- The `HostRole` an Int-face arm combinator resolves through in the - byte-derived role table. -/ -def intDispatchRoleHostRole : IntDispatchRole → HostRole - | .add => .add - | .sub => .sub - -/-- Whether a byte-derived host-role table maps its roles to pairwise DISTINCT - function indices. The Int-face plan names host helpers by ROLE only and the - byte lowering substitutes table indices, so with a duplicated table (e.g. - `add` and `sub` claiming the same index) two plans differing only in an - arm's role would lower to identical bytes — the byte-equality gate would be - blind to the role. Requiring distinct indices restores the gate's - discrimination; the honest table is byte-derived from the strict role - markers, which are unique per role. -/ -def hostTableIndicesDistinct (hostTable : List (HostRole × Nat)) : Bool := - natListNoDup (hostTable.map (fun e => e.2)) - -end AverCert.PlanCheck diff --git a/aver-cert/assets/wall/current/PlanLower.lean b/aver-cert/assets/wall/current/PlanLower.lean deleted file mode 100644 index 7ceb9c6f7..000000000 --- a/aver-cert/assets/wall/current/PlanLower.lean +++ /dev/null @@ -1,400 +0,0 @@ --- Lean-side canonical lowering from checked plans to the measured --- `CertPrelude.WInstr` tree. `PlanBytes` lowers that tree to exact code-entry --- bytes, and `AcceptedArtifact` binds it to the decoded artifact. -import CertPrelude -import PlanCheck - -namespace AverCert.PlanLower -open AverCert.Schema -open CertPrelude - -def lowerFieldProjectionBody - (structIdx fieldCount : Nat) (plan : FieldProjectionRawPlan) : - Option (List WInstr) := - if AverCert.PlanCheck.checkFieldProjectionRawPlan fieldCount plan then - some [.localGet 0, .localSet 2, .localGet 2, .refCast structIdx, - .structGet structIdx plan.fieldIdx, .localSet 1, .localGet 1] - else none - -def primInstr : FragPrim → WInstr - | .f64Add => .f64Add - | .f64Mul => .f64Mul - | .f64Le => .f64Le - | .f64Ge => .f64Ge - | .f64Lt => .f64Lt - | .f64Gt => .f64Gt - | .f64Eq => .f64Eq - | .i64Eq => .i64Eq - | .i64LeS => .i64LeS - | .i64LtS => .i64LtS - | .i64GeS => .i64GeS - | .i64GtS => .i64GtS - | .i32Eq => .i32Eq - | .i32LtS => .i32LtS - | .i32GtS => .i32GtS - | .i32GeS => .i32GeS - | .i32And => .i32And - -def popExpected : List Nat → Nat → Option (List Nat) - | got :: rest, expected => if got = expected then some rest else none - | [], _ => none - -def popExpectedAll : List Nat → List Nat → Option (List Nat) - | stack, [] => some stack - | stack, expected :: rest => - match popExpected stack expected with - | some stack' => popExpectedAll stack' rest - | none => none - -/-- Semantic lowering uses the checker's one canonical recursive-plan budget. -/ -abbrev maxFuel : Nat := AverCert.PlanCheck.maxFuel - -/-- The fused `Option.withDefault(Vector.get(vec, idx), d)` template exactly as - the wasm-gc emitter produces it (`from_mir/builtins.rs`): extract the index - through `__aint_to_index`, test `idx >= 0 (signed) AND idx < len - (unsigned)`, read the element on hit, box the literal default on miss. - Holes: `toIndexIdx` (the `__aint_to_index` function index), `boxIdx` (the - `__rt_aint_from_i64` function index), `arrTy` (the vector's array type - index), `d` (the literal default). Locals pinned: vec = 0, idx = 1. -/ -def vectorGetOrDefaultTemplate - (toIndexIdx boxIdx arrTy : Nat) (d : Int) : List WInstr := - [ .localGet 1, .call toIndexIdx, .i32Const 0, .i32GeS, - .localGet 1, .call toIndexIdx, - .localGet 0, .arrayLen, .i32LtU, - .i32And, - .ifElse - [.localGet 0, .localGet 1, .call toIndexIdx, .arrayGet arrTy] - [.i64Const d, .call boxIdx] ] - -/-- The emitter's inline sign template for `carrier OP i64-literal` - (`from_mir/builtins.rs::emit_aint_cmp_const`), as a `WInstr` list. The - operand is consumed off the stack into `scratch`; the `limbs = null` test - picks the native i64 compare of the `small` field, and the limb-carrying - arm decides on the sign field alone — `eq` needs no field read there at - all, because a canonical limb-carrying carrier never equals an i64 - literal. Holes: `carrier` (the Int carrier struct index), `scratch` (the - declared scratch local), `op`, `k`. -/ -def intSignCmpSmallPrim : SymIntCmp → FragPrim - | .eq => .i64Eq - | .lt => .i64LtS - | .le => .i64LeS - | .ge => .i64GeS - | .gt => .i64GtS - -def intSignCmpBigArm (carrier scratch : Nat) : SymIntCmp → List WInstr - | .eq => [.i32Const 0] - | .lt => [.localGet scratch, .structGet carrier 2, .i32Const 0, .i32LtS] - | .le => [.localGet scratch, .structGet carrier 2, .i32Const 0, .i32LtS] - | .ge => [.localGet scratch, .structGet carrier 2, .i32Const 0, .i32GtS] - | .gt => [.localGet scratch, .structGet carrier 2, .i32Const 0, .i32GtS] - -def intSignCmpTemplate (carrier scratch : Nat) (op : SymIntCmp) (k : Int) : - List WInstr := - [ .localSet scratch, - .localGet scratch, .structGet carrier 1, .refIsNull, - .ifElse - [.localGet scratch, .structGet carrier 0, .i64Const k, - primInstr (intSignCmpSmallPrim op)] - (intSignCmpBigArm carrier scratch op) ] - -mutual - def lowerNodesFuel : - Nat → Nat → List FragNode → List Nat → Option (List WInstr × List Nat) - | 0, _, _, _ => none - | _fuel + 1, _carrier, [], stack => some ([], stack) - | fuel + 1, carrier, node :: rest, stack => - let lowered? : Option (List WInstr × List Nat) := - match node.kind with - | .local index => - some ([.localGet index], node.id :: stack) - | .constBool value => - some ([.i32Const (if value then 1 else 0)], node.id :: stack) - | .constI64 value => - some ([.i64Const value], node.id :: stack) - | .constI32 value => - some ([.i32Const value], node.id :: stack) - | .constF64Bits bits => - some ([.f64Const (UInt64.ofNat bits)], node.id :: stack) - | .structGet field receiver => - match popExpected stack receiver with - | some stack' => some ([.structGet carrier field], node.id :: stack') - | none => none - | .structGetUser tyIdx field value => - match popExpected stack value with - | some stack' => some ([.structGet tyIdx field], node.id :: stack') - | none => none - | .structNew tyIdx args => - match popExpectedAll stack args.reverse with - | some stack' => - some ([.structNew tyIdx args.length], node.id :: stack') - | none => none - | .refIsNull value => - match popExpected stack value with - | some stack' => some ([.refIsNull], node.id :: stack') - | none => none - | .prim op args => - match popExpectedAll stack args.reverse with - | some stack' => some ([primInstr op], node.id :: stack') - | none => none - | .hostCall _role funcIdx args => - match popExpectedAll stack args.reverse with - | some stack' => some ([.call funcIdx], node.id :: stack') - | none => none - | .selfCall tail funcIdx args => - match popExpectedAll stack args.reverse with - | some stack' => - some ([if tail then .returnCall funcIdx else .call funcIdx], - node.id :: stack') - | none => none - -- Values already on the symbolic stack stay beneath the branch, - -- exactly as the wasm `if` leaves the remaining operand stack in - -- place (`InterpreterSequencing.wRunF_frame`). - | .ifElse cond thenBlock elseBlock => - match popExpected stack cond with - | some stack' => - match lowerBlockFuel fuel carrier thenBlock, - lowerBlockFuel fuel carrier elseBlock with - | some thenInstrs, some elseInstrs => - some ([.ifElse thenInstrs elseInstrs], node.id :: stack') - | _, _ => none - | none => none - | .vectorGetOrDefault arrTy toIndexIdx boxIdx default => - -- Monolithic template over pinned locals 0/1; it consumes no - -- stack operands, so it is canonical only as the sole value. - match stack with - | [] => - some (vectorGetOrDefaultTemplate toIndexIdx boxIdx arrTy default, - [node.id]) - | _ => none - | .intSignCmp op k scratch value => - -- Monolithic template: pops its one operand off the symbolic - -- stack exactly like `refIsNull`, then emits the whole - -- stash/branch/compare sequence. - match popExpected stack value with - | some stack' => - some (intSignCmpTemplate carrier scratch op k, node.id :: stack') - | none => none - match lowered? with - | some (instrs, stack') => - match lowerNodesFuel fuel carrier rest stack' with - | some (restInstrs, finalStack) => some (instrs ++ restInstrs, finalStack) - | none => none - | none => none - - def lowerBlockFuel : Nat → Nat → FragBlock → Option (List WInstr) - | 0, _, _ => none - | fuel + 1, carrier, block => - match lowerNodesFuel fuel carrier block.nodes [] with - | some (instrs, [result]) => - if result = block.result then some instrs else none - | _ => none -end - -def lowerBlock (carrier : Nat) (block : FragBlock) : Option (List WInstr) := - lowerBlockFuel maxFuel carrier block - -def lowerExprFragmentBody (carrier : Nat) (plan : ExprFragmentRawPlan) : - Option (List WInstr) := - if AverCert.PlanCheck.checkExprFragmentRawPlan plan then - lowerBlock carrier plan.body - else - none - -def lowerRecursionBody (carrier : Nat) (plan : RecursionRawPlan) : - Option (List WInstr) := - if AverCert.PlanCheck.checkRecursionRawPlan plan then - lowerBlock carrier plan.body - else - none - -def lowerMutualBody (carrier : Nat) (plan : MutualRawPlan) : - Option (List WInstr) := - if AverCert.PlanCheck.checkMutualRawPlan plan then - lowerBlock carrier plan.body - else - none - -/-! ### Verbatim `ref.test`-dispatch WInstr lowering (mirrors `{name}Code`). -/ - -def lowerLeaf (S F : Nat) : VerbatimLeaf → List WInstr - | .project tyIdx field => - [.localGet S, .refCast tyIdx, .structGet tyIdx field, .localSet F, .localGet F] - | .arrayNewData arrTy _dataIdx bytes => - [.i32Const 0, .i32Const (Int.ofNat bytes.length), .arrayNewData arrTy bytes] - | .refNull => [.refNull] - | .f64Bits bits => [.f64Const (UInt64.ofNat bits)] - -def lowerDispatch (S F : Nat) (first : Bool) : VerbatimDispatch → List WInstr - | .leaf l => lowerLeaf S F l - | .test tyIdx hit rest => - (if first then [] else [.localGet S]) ++ - [.refTest tyIdx, .ifElse (lowerLeaf S F hit) (lowerDispatch S F false rest)] - -def lowerVerbatimBody (plan : VerbatimRawPlan) : List WInstr := - [.localGet 0, .localSet plan.scrutineeLocal, .localGet plan.scrutineeLocal] ++ - lowerDispatch plan.scrutineeLocal plan.fieldLocal true plan.body - -/-! ### Int-face `ref.test`-dispatch WInstr lowering (mirrors `{name}Code`). - -The scrutinee/field scratch locals are a fixed function of the payload-BINDING -arm count: the `j`-th binding (`proj`/`hostOp`) arm (0-based, in dispatch order) -spills its projected payload to local `j+1`, the scrutinee is spilled to local -`bindArmCount + 1`; a `const` arm reads no field and spills no local. The -box/add/sub function indices come from the byte-derived host-role table -PARAMETER — a role the table lacks fail-closes the lowering. -/ - -/-- One hit arm: the payload projection spilled through this arm's scratch - local `F`, then the leaf's own tail. -/ -def lowerIntDispatchArm - (hostTable : List (HostRole × Nat)) (S F tyIdx : Nat) : - IntDispatchLeaf → Option (List WInstr) - | .const _ => none - | .proj => - some [.localGet S, .refCast tyIdx, .structGet tyIdx 0, .localSet F, .localGet F] - | .hostOp role k constFirst => - match AverCert.PlanCheck.hostRoleIdx? hostTable .box, - AverCert.PlanCheck.hostRoleIdx? hostTable - (AverCert.PlanCheck.intDispatchRoleHostRole role) with - | some boxIdx, some hostIdx => - some ([.localGet S, .refCast tyIdx, .structGet tyIdx 0, .localSet F] ++ - (if constFirst then - [.i64Const k, .call boxIdx, .localGet F, .call hostIdx] - else - [.localGet F, .i64Const k, .call boxIdx, .call hostIdx])) - | _, _ => none - -def lowerIntDispatchCascade - (hostTable : List (HostRole × Nat)) (S : Nat) : - Nat → Bool → IntDispatchCascade → Option (List WInstr) - | _pos, _first, .default k => - match AverCert.PlanCheck.hostRoleIdx? hostTable .box with - | some boxIdx => some [.i64Const k, .call boxIdx] - | none => none - | pos, first, .test tyIdx (.const k) rest => - -- A const (nullary) arm reads no field and spills no local: its if-branch - -- is the terminal-style `i64.const k; call box` (NO projection prefix), and - -- the binding position `pos` does not advance. - match AverCert.PlanCheck.hostRoleIdx? hostTable .box, - lowerIntDispatchCascade hostTable S pos false rest with - | some boxIdx, some restInstrs => - some ((if first then [] else [.localGet S]) ++ - [.refTest tyIdx, .ifElse [.i64Const k, .call boxIdx] restInstrs]) - | _, _ => none - | pos, first, .test tyIdx hit rest => - match lowerIntDispatchArm hostTable S (pos + 1) tyIdx hit, - lowerIntDispatchCascade hostTable S (pos + 1) false rest with - | some hitInstrs, some restInstrs => - some ((if first then [] else [.localGet S]) ++ - [.refTest tyIdx, .ifElse hitInstrs restInstrs]) - | _, _ => none - -def lowerIntDispatchBody - (hostTable : List (HostRole × Nat)) - (plan : IntDispatchRawPlan) : Option (List WInstr) := - let S := AverCert.PlanCheck.bindArmCount plan.body + 1 - match lowerIntDispatchCascade hostTable S 0 true plan.body with - | some cascade => some ([.localGet 0, .localSet S, .localGet S] ++ cascade) - | none => none - -def lowerStringConcatChunk (resultTy : Nat) (chunk : StringConcatChunk) : - List WInstr := - [.i32Const 0, .i32Const (Int.ofNat chunk.bytes.length), - .arrayNewData resultTy chunk.bytes] - -def lowerStringConcatChunks (resultTy : Nat) : - List StringConcatChunk → List WInstr - | [] => [] - | chunk :: rest => - lowerStringConcatChunk resultTy chunk ++ - lowerStringConcatChunks resultTy rest - -def lowerStringConcatBody - (resultTy containerTy concatFuncIdx : Nat) - (plan : StringConcatRawPlan) : Option (List WInstr) := - if AverCert.PlanCheck.checkStringConcatRawPlan plan then - some ( - lowerStringConcatChunks resultTy plan.prefixes ++ - [.localGet 0] ++ - lowerStringConcatChunks resultTy plan.suffixes ++ - [.arrayNewFixed containerTy (plan.prefixes.length + 1 + plan.suffixes.length), - .call concatFuncIdx] - ) - else - none - -def lowerStringEqChunk (stringTy : Nat) (chunk : StringEqChunk) : - List WInstr := - [.i32Const 0, .i32Const (Int.ofNat chunk.bytes.length), - .arrayNewData stringTy chunk.bytes] - -def lowerStringEqResult (stringTy : Nat) : StringEqResult → List WInstr - | .input => [.localGet 0] - | .literal chunk => lowerStringEqChunk stringTy chunk - -def lowerStringEqBody - (stringTy stringEqFuncIdx : Nat) - (plan : StringEqRawPlan) : Option (List WInstr) := - if AverCert.PlanCheck.checkStringEqRawPlan plan then - some ( - [.localGet 0, .localSet 1, .localGet 1, .refCast stringTy] ++ - lowerStringEqChunk stringTy plan.needle ++ - [.call stringEqFuncIdx, - .ifElse - (lowerStringEqResult stringTy plan.hit) - (lowerStringEqResult stringTy plan.default)] - ) - else - none - -def lowerConstructField (_structIdx : Nat) : ConstructField → WInstr - | .local index => .localGet index - | .null => .refNull - -def lowerConstructFields (structIdx : Nat) : List ConstructField → List WInstr - | [] => [] - | field :: rest => lowerConstructField structIdx field :: lowerConstructFields structIdx rest - -def lowerConstructBody (structIdx : Nat) (plan : ConstructRawPlan) : Option (List WInstr) := - if AverCert.PlanCheck.checkConstructRawPlan plan then - some (lowerConstructFields structIdx plan.fields ++ [.structNew structIdx plan.fields.length]) - else - none - -/-! ### `composition-plan-v1` lowering - -Function indices are resolved through `funcTable`, which the acceptance -predicate computes from Wasm export bindings. The plan itself names exports. --/ - -def compositionFuncIdx? (funcTable : List (String × Nat)) (name : String) : Option Nat := - match funcTable.find? (fun entry => entry.1 == name) with - | some entry => some entry.2 - | none => none - -def lowerCompositionCalls - (funcTable : List (String × Nat)) : List String → Option (List WInstr) - | [] => some [] - | callee :: rest => - match compositionFuncIdx? funcTable callee, - lowerCompositionCalls funcTable rest with - | some idx, some tail => some (.call idx :: tail) - | _, _ => none - -def lowerCompositionBody - (hostTable : List (HostRole × Nat)) - (funcTable : List (String × Nat)) - (plan : CompositionRawPlan) : Option (List WInstr) := - if AverCert.PlanCheck.checkCompositionRawPlan plan then - match plan.shape with - | .selfSum => - match AverCert.PlanCheck.hostRoleIdx? hostTable .add with - | some addIdx => some [.localGet 0, .localGet 0, .call addIdx] - | none => none - | .chain callees => - match lowerCompositionCalls funcTable callees with - | some calls => some (.localGet 0 :: calls) - | none => none - else - none - -end AverCert.PlanLower diff --git a/aver-cert/assets/wall/current/RecordComputeBridge.lean b/aver-cert/assets/wall/current/RecordComputeBridge.lean deleted file mode 100644 index 8b11ec625..000000000 --- a/aver-cert/assets/wall/current/RecordComputeBridge.lean +++ /dev/null @@ -1,1767 +0,0 @@ -/- The generic source-eval bridge for the record projection-compute face, v1 - node set (what the k5 gate needs): - - local / constI64 / constI32 / structGetUser / structNew / - hostCall {box, add, sub, mul, cmp, eq} / prim {i32LtS, i32GtS, i32GeS} / - intSignCmp - - over ONE user struct type whose fields are all Int carriers (Fraction). - - `sourceRunNodes` mirrors `ExprFragmentSemantics.runNodesFuel` ARM BY ARM — - same fuel discipline, same symbolic-id stack, same popExpected/popExpectedAll - plumbing — but computes over SOURCE values (ℤ, Bool, raw i64 literals, raw - i32 verdicts, records-as-Int-lists). The agreement theorem walks both - evaluators in lockstep: pointwise-SRepr stacks stay related at every step, - host calls are bridged by the named box/add/sub/mul/cmp/eq contracts, and - `structNew`/`structGetUser` are bridged by the record representation. The - obligation's model for the generic face is `sourceRunBlock` — the plan IS - the claim. - - The ONE node that writes a local is `intSignCmp`, the emitter's inline sign - template; both evaluators write the same slot, so the locals lists stay - pointwise related and the source locals carry a `pad` value for the declared - scratch slot the wasm entry initialises to `null`. -/ -import ExprFragmentSoundness - -open CertPrelude AverCert.Schema AverCert.PlanLower ExprFragmentSemantics - -namespace RecordComputeBridge - -/-- Source-level values for the v1 face. `raw` is a bare i64 literal on its - way into the `box` helper (the emitter's `i64.const k; call box` idiom) — - distinct from `i`, which is a boxed source integer in the carrier. `i32` is - a raw comparison verdict (`__aint_cmp`'s `-1`/`0`/`1` and the `i32.const 0` - it is compared against), which is NOT a source Boolean. `pad` is the - declared scratch local's initial `null`: it inhabits no source type and no - admitted node can read it (a `local` node past the parameter prefix fails - the typing face). -/ -inductive SVal where - | i (n : Int) - | b (v : Bool) - | i32 (n : Int) - | raw (n : Int) - | pad - | r (fields : List Int) -deriving Repr - -/-- A represented carrier word that is additionally in the runtime's normal - form. Every carrier this face ever holds is canonical: parameters and - record fields by the face's domain representation, box/add/sub/mul results - by their contracts. Canonicity is what makes the two STRUCTURAL helpers - (`__aint_cmp`, `__aint_eq`) and the inline sign template exact. -/ -def CanonRepr {C : Nat} (S : CarrierSpec C) (n : Int) (w : WVal) : Prop := - S.Repr n w ∧ S.Canon w - -/-- Representation of one source value by one wasm value, over the carrier - specification `S` and the single user struct type `structIdx`. -/ -def SRepr {C : Nat} (S : CarrierSpec C) (structIdx : Nat) : SVal → WVal → Prop - | .i n, w => CanonRepr S n w - | .b v, w => w = b32 v - | .i32 n, w => w = .i32v n - | .raw n, w => w = .i64v n ∧ -(2 ^ 63 : Int) ≤ n ∧ n < 2 ^ 63 - | .pad, w => w = .null - | .r fields, w => - ∃ ws, w = .structv structIdx ws ∧ ReprAll (CanonRepr S) fields ws - -/-- Pointwise representation of a source stack / locals list. -/ -inductive SReprAll {C : Nat} (S : CarrierSpec C) (structIdx : Nat) : - List SVal → List WVal → Prop where - | nil : SReprAll S structIdx [] [] - | cons {sv w ss ws} : SRepr S structIdx sv w → - SReprAll S structIdx ss ws → - SReprAll S structIdx (sv :: ss) (w :: ws) - -/-- Named host contracts of the v1 face — exactly the hypotheses - `Obligation.holds` threads, at this face's concrete slots. `box` is the - boxing helper's meaning (its body is byte-pinned, so at face level this is - the synthesized semantics, not a new trust assumption); it is stated for an - i64-band literal because that is the only literal the emitter can box, and - that band is what `CarrierSpec.canonSmall` needs. -/ -structure Contracts {C : Nat} (S : CarrierSpec C) - (box add sub mul cmp eq : List WVal → Option WVal) : Prop where - hBox : ∀ n w, -(2 ^ 63 : Int) ≤ n → n < 2 ^ 63 → box [.i64v n] = some w → - CanonRepr S n w - hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → CanonRepr S (a + b) w - hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → CanonRepr S (a - b) w - hMul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - mul [va, vb] = some w → CanonRepr S (a * b) w - hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b) - hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b) - -/-- The wasm arity of each host role's signature. -/ -def roleArity : HostRole → Nat - | .box => 1 - | .toIndex => 1 - | _ => 2 - -/-- The contract function a used role denotes; the one role the v1 face never - admits (`toIndex`) maps to the trap-only function. -/ -def roleFn (box add sub mul cmp eq : List WVal → Option WVal) : - HostRole → List WVal → Option WVal - | .box => box - | .add => add - | .sub => sub - | .mul => mul - | .cmp => cmp - | .eq => eq - | .toIndex => fun _ => none - -/-- The source meaning of one comparison operator against a literal. -/ -def symIntCmpDenote : SymIntCmp → Int → Int → Bool - | .eq, n, k => n = k - | .lt, n, k => n < k - | .le, n, k => n ≤ k - | .ge, n, k => n ≥ k - | .gt, n, k => n > k - -/-- Which node kinds the v1 face admits, keyed on the byte-derived role - TABLE: a host call is admitted only when the table resolves its role to - exactly the cited function index. A role the table lacks fail-closes. - Everything else is fail-closed. -/ -def nodeAdmitted (hostTable : List (HostRole × Nat)) : - FragNodeKind → Bool - | .local _ => true - -- The literal must be i64-representable: it is boxed through `canonSmall`, - -- and the sign template's limb arm is only exact against a band literal. - | .constI64 value => AverCert.PlanCheck.inI64Band value - | .constI32 _ => true - | .structGetUser _ _ _ => true - | .structNew _ _ => true - | .prim .i32LtS args => args.length == 2 - | .prim .i32GtS args => args.length == 2 - | .prim .i32GeS args => args.length == 2 - | .intSignCmp _ constant _ _ => AverCert.PlanCheck.inI64Band constant - | .hostCall .box f args => - (AverCert.PlanCheck.hostRoleIdx? hostTable .box == some f) && - args.length == 1 - | .hostCall .add f args => - (AverCert.PlanCheck.hostRoleIdx? hostTable .add == some f) && - args.length == 2 - | .hostCall .sub f args => - (AverCert.PlanCheck.hostRoleIdx? hostTable .sub == some f) && - args.length == 2 - | .hostCall .mul f args => - (AverCert.PlanCheck.hostRoleIdx? hostTable .mul == some f) && - args.length == 2 - | .hostCall .cmp f args => - (AverCert.PlanCheck.hostRoleIdx? hostTable .cmp == some f) && - args.length == 2 - | .hostCall .eq f args => - (AverCert.PlanCheck.hostRoleIdx? hostTable .eq == some f) && - args.length == 2 - | _ => false - -def nodesAdmitted (hostTable : List (HostRole × Nat)) - (nodes : List FragNode) : Bool := - nodes.all fun n => nodeAdmitted hostTable n.kind - -/-- Pop `n` boxed integers off the source stack as record fields: the emitter - pushes fields in declaration order, so the popped (reversed) prefix is - reversed back. -/ -def takeInts : Nat → List SVal → Option (List Int × List SVal) - | 0, st => some ([], st) - | n + 1, .i v :: st => - match takeInts n st with - | some (vs, st') => some (vs ++ [v], st') - | none => none - | _ + 1, _ => none - -/-- Source-level twin of `runNodesFuel`, arm by arm; fail-closed on every - unadmitted shape. A `box` call converts a raw literal into a boxed source - integer. -/ -def sourceRunNodes : - Nat → List FragNode → List Nat → List SVal → List SVal → Option (List SVal) - | 0, _, _, _, _ => none - | _fuel + 1, [], _, _, stack => some stack - | fuel + 1, node :: rest, symStack, locals, stack => - match node.kind with - | .local index => - match locals[index]? with - | some v => sourceRunNodes fuel rest (node.id :: symStack) locals (v :: stack) - | none => none - | .constI64 value => - sourceRunNodes fuel rest (node.id :: symStack) locals (.raw value :: stack) - | .constI32 value => - sourceRunNodes fuel rest (node.id :: symStack) locals (.i32 value :: stack) - | .prim op args => - match popExpectedAll symStack args.reverse with - | some symStack' => - match op, stack with - | .i32LtS, .i32 b :: .i32 a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.b (a < b) :: stackRest) - | .i32GtS, .i32 b :: .i32 a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.b (a > b) :: stackRest) - | .i32GeS, .i32 b :: .i32 a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.b (a ≥ b) :: stackRest) - | _, _ => none - | none => none - | .intSignCmp op k scratch value => - match popExpected symStack value, stack with - | some symStack', .i n :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') - (locals.set scratch (.i n)) - (.b (symIntCmpDenote op n k) :: stackRest) - | _, _ => none - | .structGetUser _tyIdx field value => - match popExpected symStack value, stack with - | some symStack', .r fields :: stackRest => - match fields[field]? with - | some n => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.i n :: stackRest) - | none => none - | _, _ => none - | .structNew _tyIdx args => - match popExpectedAll symStack args.reverse with - | some symStack' => - match takeInts args.length stack with - | some (fields, stackRest) => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.r fields :: stackRest) - | none => none - | none => none - | .hostCall role _f argIds => - match popExpectedAll symStack argIds.reverse with - | some symStack' => - match role, stack with - | .box, .raw n :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.i n :: stackRest) - | .add, .i b :: .i a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.i (a + b) :: stackRest) - | .sub, .i b :: .i a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.i (a - b) :: stackRest) - | .mul, .i b :: .i a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.i (a * b) :: stackRest) - | .cmp, .i b :: .i a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.i32 (cmpW a b) :: stackRest) - | .eq, .i b :: .i a :: stackRest => - sourceRunNodes fuel rest (node.id :: symStack') locals - (.b (a = b) :: stackRest) - | _, _ => none - | none => none - | _ => none - -/-- The v1 face's model: run the plan body over source inputs. Fuel is - peeled exactly as `runBlockFuel` peels it, so the two block evaluators are - twins level by level. -/ -def sourceRunBlock : Nat → FragBlock → List SVal → Option SVal - | 0, _, _ => none - | fuel + 1, block, params => - -- The wasm entry runs with the one declared scratch local appended to - -- the arguments (`initLocals`); the source locals mirror it with `pad` - -- so the two locals lists stay pointwise related when `intSignCmp` - -- writes that slot. No admitted node can READ it. - match sourceRunNodes fuel block.nodes [] (params ++ [.pad]) [] with - | some [v] => some v - | _ => none - -/-! ## Typing scaffold for the agreement proof - -`agreement` is not provable for ill-typed plans: wasm `struct.new` packs ANY -operand values and an abstract host function may succeed on non-carrier -arguments, while the source evaluator demands boxed integers there, so the -source run can fail where the wasm run succeeds (e.g. `constI64` fed straight -into `structNew`). The repair threads the plan's type discipline — the v1 -restriction of what `PlanCheck.checkBlockFuel` enforces on every accepted -plan: `tyOf` declares each node id's `FragTy`, `params` types the locals, -`nodeTyped` demands each admitted node consume/produce declared types, and -`IdsTyped` keeps the symbolic stack pointwise typed against the value -stacks. -/ - -/-- The `FragTy` a v1 source value inhabits. -/ -def svalTy : SVal → FragTy - | .i _ => .intCarrier - | .b _ => .boolI32 - | .i32 _ => .rawI32 - | .raw _ => .i64 - -- No admitted node produces or consumes the scratch pad, so its type is - -- never consulted; `.ref` is the type no plan node yields. - | .pad => .ref - | .r _ => .adtRef - -/-- The symbolic stack and the source stack agree pointwise with the typing - map: position `k` holds a value of the declared type of the id at `k`. -/ -inductive IdsTyped (tyOf : Nat → FragTy) : List Nat → List SVal → Prop where - | nil : IdsTyped tyOf [] [] - | cons {id : Nat} {sv : SVal} {ids : List Nat} {svs : List SVal} : - svalTy sv = tyOf id → IdsTyped tyOf ids svs → - IdsTyped tyOf (id :: ids) (sv :: svs) - -/-- One node's typing discipline (v1 subset of `PlanCheck.checkBlockFuel`). - `structNew` additionally pins its type index to the ONE user struct type; - `structGetUser` needs no pin — the wasm struct-tag check forces it. -/ -def nodeTyped (structIdx : Nat) (tyOf : Nat → FragTy) - (params : List FragTy) (node : FragNode) : Prop := - match node.kind with - | .local index => params[index]? = some (tyOf node.id) - | .constI64 _ => tyOf node.id = .i64 - | .constI32 _ => tyOf node.id = .rawI32 - | .structGetUser _ _ value => - tyOf value = .adtRef ∧ tyOf node.id = .intCarrier - | .structNew tyIdx args => - tyIdx = structIdx ∧ (∀ a ∈ args, tyOf a = .intCarrier) ∧ - tyOf node.id = .adtRef - | .prim _ args => - (∀ a ∈ args, tyOf a = .rawI32) ∧ tyOf node.id = .boolI32 - | .hostCall .box _ args => - (∀ a ∈ args, tyOf a = .i64) ∧ tyOf node.id = .intCarrier - | .hostCall .cmp _ args => - (∀ a ∈ args, tyOf a = .intCarrier) ∧ tyOf node.id = .rawI32 - | .hostCall .eq _ args => - (∀ a ∈ args, tyOf a = .intCarrier) ∧ tyOf node.id = .boolI32 - | .hostCall _ _ args => - (∀ a ∈ args, tyOf a = .intCarrier) ∧ tyOf node.id = .intCarrier - -- The scratch slot is pinned PAST the parameter prefix, so the template - -- can never clobber a parameter local — the lockstep locals invariant of - -- `agreement` rests on exactly that. - | .intSignCmp _ _ scratch value => - tyOf value = .intCarrier ∧ scratch = params.length ∧ - tyOf node.id = .boolI32 - | _ => True - -def planTyped (structIdx : Nat) (tyOf : Nat → FragTy) - (params : List FragTy) : List FragNode → Prop - | [] => True - | node :: rest => - nodeTyped structIdx tyOf params node ∧ planTyped structIdx tyOf params rest - -private theorem svalTy_int {sv : SVal} (h : svalTy sv = .intCarrier) : - ∃ n, sv = .i n := by - cases sv <;> first | exact ⟨_, rfl⟩ | simp [svalTy] at h - -private theorem svalTy_i64 {sv : SVal} (h : svalTy sv = .i64) : - ∃ n, sv = .raw n := by - cases sv <;> first | exact ⟨_, rfl⟩ | simp [svalTy] at h - -private theorem svalTy_adt {sv : SVal} (h : svalTy sv = .adtRef) : - ∃ fields, sv = .r fields := by - cases sv <;> first | exact ⟨_, rfl⟩ | simp [svalTy] at h - -private theorem idsTyped_cons_inv {tyOf : Nat → FragTy} {id : Nat} - {ids : List Nat} {svs : List SVal} - (h : IdsTyped tyOf (id :: ids) svs) : - ∃ sv svs', svs = sv :: svs' ∧ svalTy sv = tyOf id ∧ - IdsTyped tyOf ids svs' := by - cases h with - | cons h1 h2 => exact ⟨_, _, rfl, h1, h2⟩ - -private theorem sreprAll_cons_inv {C : Nat} {S : CarrierSpec C} {structIdx : Nat} - {sv : SVal} {svs : List SVal} {ws : List WVal} - (h : SReprAll S structIdx (sv :: svs) ws) : - ∃ w ws', ws = w :: ws' ∧ SRepr S structIdx sv w ∧ - SReprAll S structIdx svs ws' := by - cases h with - | cons h1 h2 => exact ⟨_, _, rfl, h1, h2⟩ - -private theorem sreprAll_length {C : Nat} {S : CarrierSpec C} {structIdx : Nat} - {ss : List SVal} {ws : List WVal} - (h : SReprAll S structIdx ss ws) : ss.length = ws.length := by - induction h with - | nil => rfl - | cons _ _ ih => simp [ih] - -private theorem sreprAll_getElem? {C : Nat} {S : CarrierSpec C} {structIdx : Nat} - {ss : List SVal} {ws : List WVal} - (h : SReprAll S structIdx ss ws) {i : Nat} {wv : WVal} - (hw : ws[i]? = some wv) : - ∃ sv, ss[i]? = some sv ∧ SRepr S structIdx sv wv := by - induction h generalizing i with - | nil => simp at hw - | cons hsv _ ih => - cases i with - | zero => - simp only [List.getElem?_cons_zero, Option.some.injEq] at hw - exact ⟨_, rfl, hw ▸ hsv⟩ - | succ i => - simp only [List.getElem?_cons_succ] at hw ⊢ - exact ih hw - -private theorem reprAll_getElem? {Repr : Int → WVal → Prop} - {ns : List Int} {vs : List WVal} - (h : ReprAll Repr ns vs) {i : Nat} {wv : WVal} - (hw : vs[i]? = some wv) : - ∃ m, ns[i]? = some m ∧ Repr m wv := by - induction h generalizing i with - | nil => simp at hw - | cons hn _ ih => - cases i with - | zero => - simp only [List.getElem?_cons_zero, Option.some.injEq] at hw - exact ⟨_, rfl, hw ▸ hn⟩ - | succ i => - simp only [List.getElem?_cons_succ] at hw ⊢ - exact ih hw - -private theorem reprAll_append_single {Repr : Int → WVal → Prop} - {ns : List Int} {vs : List WVal} (h : ReprAll Repr ns vs) - {m : Int} {wv : WVal} (hm : Repr m wv) : - ReprAll Repr (ns ++ [m]) (vs ++ [wv]) := by - induction h with - | nil => exact .cons hm .nil - | cons hx _ ih => exact .cons hx ih - -private theorem popExpected_eq {symStack : List Nat} {v : Nat} {s' : List Nat} - (h : popExpected symStack v = some s') : symStack = v :: s' := by - cases symStack with - | nil => simp [popExpected] at h - | cons got r => - by_cases hg : got = v - · subst hg - simp [popExpected] at h - simp [h] - · simp [popExpected, hg] at h - -private theorem popExpectedAll_append {ids : List Nat} : - ∀ {symStack symRest : List Nat}, - popExpectedAll symStack ids = some symRest → - symStack = ids ++ symRest := by - induction ids with - | nil => - intro symStack symRest h - simp only [popExpectedAll, Option.some.injEq] at h - simp [h] - | cons e rest ih => - intro symStack symRest h - simp only [popExpectedAll] at h - cases hp : popExpected symStack e with - | none => simp [hp] at h - | some s' => - simp only [hp] at h - rw [popExpected_eq hp, ih h] - rfl - -private theorem idsTyped_length {tyOf : Nat → FragTy} {ids : List Nat} - {svs : List SVal} (h : IdsTyped tyOf ids svs) : - svs.length = ids.length := by - induction h with - | nil => rfl - | cons _ _ ih => simp [ih] - -private theorem idsTyped_split {tyOf : Nat → FragTy} {ids1 : List Nat} : - ∀ {ids2 : List Nat} {svs : List SVal}, - IdsTyped tyOf (ids1 ++ ids2) svs → - ∃ svs1 svs2, svs = svs1 ++ svs2 ∧ IdsTyped tyOf ids1 svs1 ∧ - IdsTyped tyOf ids2 svs2 := by - induction ids1 with - | nil => - intro ids2 svs h - exact ⟨[], svs, rfl, .nil, h⟩ - | cons id ids ih => - intro ids2 svs h - obtain ⟨sv, svs', rfl, h1, h2⟩ := idsTyped_cons_inv h - obtain ⟨svs1, svs2, rfl, h3, h4⟩ := ih h2 - exact ⟨sv :: svs1, svs2, rfl, .cons h1 h3, h4⟩ - -private theorem sreprAll_split {C : Nat} {S : CarrierSpec C} {structIdx : Nat} - {ss1 : List SVal} : - ∀ {ss2 : List SVal} {ws : List WVal}, - SReprAll S structIdx (ss1 ++ ss2) ws → - ∃ ws1 ws2, ws = ws1 ++ ws2 ∧ SReprAll S structIdx ss1 ws1 ∧ - SReprAll S structIdx ss2 ws2 := by - induction ss1 with - | nil => - intro ss2 ws h - exact ⟨[], ws, rfl, .nil, h⟩ - | cons sv ss ih => - intro ss2 ws h - obtain ⟨w, ws', rfl, h1, h2⟩ := sreprAll_cons_inv h - obtain ⟨ws1, ws2, rfl, h3, h4⟩ := ih h2 - exact ⟨w :: ws1, ws2, rfl, .cons h1 h3, h4⟩ - -private theorem popArgs_append {ws1 wRest : List WVal} : - popArgs ws1.length (ws1 ++ wRest) = some (ws1.reverse, wRest) := by - simp [popArgs, List.take_append, List.drop_append] - -private theorem srepr_rec {C : Nat} {S : CarrierSpec C} {structIdx : Nat} - {fields : List Int} {ws : List WVal} (h : ReprAll (CanonRepr S) fields ws) : - SRepr S structIdx (.r fields) (.structv structIdx ws) := - ⟨ws, rfl, h⟩ - -private theorem takeInts_bridge {C : Nat} {S : CarrierSpec C} {structIdx : Nat} - {tyOf : Nat → FragTy} {ids : List Nat} {svs : List SVal} - (hty : IdsTyped tyOf ids svs) : - (∀ a ∈ ids, tyOf a = .intCarrier) → - ∀ {ws : List WVal}, SReprAll S structIdx svs ws → - ∀ sRest : List SVal, - ∃ fields, takeInts ids.length (svs ++ sRest) = some (fields, sRest) ∧ - ReprAll (CanonRepr S) fields ws.reverse := by - induction hty with - | nil => - intro _ ws hrel sRest - cases hrel - exact ⟨[], rfl, .nil⟩ - | cons hsv htail ih => - intro hint ws hrel sRest - rename_i id sv ids' svs' - obtain ⟨n, rfl⟩ := svalTy_int (hsv.trans (hint id (by simp))) - obtain ⟨w, ws', rfl, h1, h2⟩ := sreprAll_cons_inv hrel - have hR : CanonRepr S n w := h1 - obtain ⟨fields, htake, hra⟩ := - ih (fun a ha => hint a (List.mem_cons_of_mem _ ha)) h2 sRest - refine ⟨fields ++ [n], ?_, ?_⟩ - · simp only [List.length_cons, List.cons_append, takeInts, htake] - · simpa [List.reverse_cons] using reprAll_append_single hra hR - -/-! ## Agreement - -The wasm-side evaluator and the source-side evaluator stay pointwise-SRepr -related at every step. Exactly one admitted node writes a local — the inline -sign template, which stashes its operand in the DECLARED SCRATCH slot — and -both evaluators write the same slot with related values, so the locals lists -stay related too. No admitted node returns early, which is why the conclusion -can pin the run's output to an `.ok`. -/ - -/-- Writing index `i` of a list and reading it back, in range. -/ -private theorem setSelf? {α : Type _} (a : α) : - ∀ (l : List α) (i : Nat), i < l.length → (l.set i a)[i]? = some a := by - intro l - induction l with - | nil => intro i h; simp at h - | cons x xs ih => - intro i h - cases i with - | zero => rfl - | succ i => exact ih i (by simpa using h) - -/-- Writing index `i` leaves every other index alone. -/ -private theorem setNe? {α : Type _} (a : α) : - ∀ (l : List α) (i j : Nat), i ≠ j → (l.set i a)[j]? = l[j]? := by - intro l - induction l with - | nil => intro i j _; simp - | cons x xs ih => - intro i j hne - cases i with - | zero => - cases j with - | zero => exact absurd rfl hne - | succ j => rfl - | succ i => - cases j with - | zero => rfl - | succ j => exact ih i j (fun h => hne (by omega)) - -/-- Pointwise representation survives a write of related values at one index. -/ -private theorem sreprAll_set {C : Nat} {S : CarrierSpec C} {structIdx : Nat} - {sv : SVal} {w : WVal} (hsv : SRepr S structIdx sv w) : - ∀ {ss : List SVal} {ws : List WVal}, SReprAll S structIdx ss ws → - ∀ (i : Nat), SReprAll S structIdx (ss.set i sv) (ws.set i w) := by - intro ss ws h - induction h with - | nil => intro _; exact .nil - | cons h1 h2 ih => - intro i - cases i with - | zero => exact .cons hsv h2 - | succ i => exact .cons h1 (ih i) - -private theorem sreprAll_append {C : Nat} {S : CarrierSpec C} {structIdx : Nat} : - ∀ {ss1 ws1 ss2 ws2 : _}, SReprAll S structIdx ss1 ws1 → - SReprAll S structIdx ss2 ws2 → - SReprAll S structIdx (ss1 ++ ss2) (ws1 ++ ws2) := by - intro ss1 ws1 ss2 ws2 h1 h2 - induction h1 with - | nil => exact h2 - | cons hx _ ih => exact .cons hx ih - -private theorem svalTy_i32 {sv : SVal} (h : svalTy sv = .rawI32) : - ∃ n, sv = .i32 n := by - cases sv <;> first | exact ⟨_, rfl⟩ | simp [svalTy] at h - -private theorem eqW_b32 (a b : Int) : WVal.i32v (eqW a b) = b32 (a = b) := by - by_cases h : a = b <;> simp [eqW, b32, h] - -/-- The whole inline sign template, evaluated. The operand is stashed in the - scratch local; the `limbs = null` test picks the native i64 compare of the - `small` field (exact by `smallElim`) or the sign-only decision, which is - exact because a CANONICAL limb-carrying carrier lies outside the i64 band - the literal lives in (`canonBig`) while its sign tracks the value's sign - (`bigElim`). -/ -private theorem intSignCmp_step {C : Nat} (S : CarrierSpec C) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (op : SymIntCmp) (k : Int) (scratch : Nat) - (locals stack : List WVal) (n : Int) (w : WVal) (out : Out) - (hband : AverCert.PlanCheck.inI64Band k = true) - (hRepr : S.Repr n w) (hCanon : S.Canon w) - (hrun : wRunF host ar callee (intSignCmpTemplate C scratch op k) locals - (w :: stack) = some out) : - out = .ok (locals.set scratch w) - (b32 (symIntCmpDenote op n k) :: stack) := by - have hk : -(2 ^ 63 : Int) ≤ k ∧ k < 2 ^ 63 := by - simpa [AverCert.PlanCheck.inI64Band, Bool.and_eq_true, decide_eq_true_eq] - using hband - by_cases hlt : scratch < locals.length - · have hget : (locals.set scratch w)[scratch]? = some w := - setSelf? w locals scratch hlt - rcases S.car n w hRepr with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ - · have hs : s = n := S.smallElim n s sg hRepr - subst hs - cases op <;> - · simp [intSignCmpTemplate, intSignCmpBigArm, intSignCmpSmallPrim, - primInstr, wRunF, hget, b32] at hrun - subst hrun - simp [symIntCmpDenote, b32] - · obtain ⟨hnb, hsgne⟩ := S.canonBig n s lty les sg hRepr hCanon - obtain ⟨hsign, _hnz⟩ := S.bigElim n s lty les sg hRepr - have hcase : n < -(2 ^ 63 : Int) ∨ (2 ^ 63 : Int) ≤ n := by omega - have hLtIff : (sg < 0) ↔ n < k := by - constructor - · intro h; have := hsign.mp h; omega - · intro h; exact hsign.mpr (by omega) - have hGtIff : (0 < sg) ↔ k < n := by - constructor - · intro h - have hnn : ¬ n < 0 := by intro hc; have := hsign.mpr hc; omega - omega - · intro h - have hnn : ¬ sg < 0 := by intro hc; have := hsign.mp hc; omega - omega - have hNe : ¬ n = k := by - intro he; subst he; omega - have hLe : (n ≤ k) = (n < k) := by - simp only [eq_iff_iff] - constructor - · intro h; omega - · intro h; omega - have hGe : (k ≤ n) = (k < n) := by - simp only [eq_iff_iff] - constructor - · intro h; omega - · intro h; omega - cases op <;> - · simp [intSignCmpTemplate, intSignCmpBigArm, intSignCmpSmallPrim, - primInstr, wRunF, hget, b32] at hrun - subst hrun - simp [symIntCmpDenote, b32, hLtIff, hGtIff, hNe, hLe, hGe] - · have hget : (locals.set scratch w)[scratch]? = none := by - apply List.getElem?_eq_none - simpa using Nat.le_of_not_lt hlt - simp [intSignCmpTemplate, wRunF, hget] at hrun - -/- STATEMENT ADJUSTMENT (authorized, documented): as originally stated the - theorem is unprovable for ill-typed plans — wasm `struct.new` packs ANY - operand values and an abstract host function may succeed on non-carrier - arguments, while the source evaluator demands boxed integers there, so the - source run can fail where the wasm run succeeds (e.g. a `constI64` result - fed straight into `structNew`, or a record fed to `add`). The minimal - repair threads the plan's type discipline, which `PlanCheck.checkBlockFuel` - enforces on every accepted plan: added hypotheses `hTy` (each admitted node - consumes/produces its declared `FragTy`, pinning `structNew`'s type index to - the ONE user struct type and the sign template's scratch slot PAST the - parameter prefix — nothing on the wasm side forces either), `hLocalsTy` - (parameter locals inhabit `params`), and `hStackTy` (the symbolic stack - stays pointwise typed). `structGetUser`'s type index needs no pin: the wasm - struct-tag check forces `tyIdx = structIdx` on any successful run. -/ -theorem agreement - {C : Nat} (S : CarrierSpec C) (structIdx : Nat) - (box add sub mul cmp eq : List WVal → Option WVal) - (Ctr : Contracts S box add sub mul cmp eq) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (hostTable : List (HostRole × Nat)) - (hHost : ∀ role idx, - role ∈ [HostRole.box, HostRole.add, HostRole.sub, HostRole.mul, - HostRole.cmp, HostRole.eq] → - AverCert.PlanCheck.hostRoleIdx? hostTable role = some idx → - host idx = some (roleArity role, roleFn box add sub mul cmp eq role)) - (tyOf : Nat → FragTy) (params : List FragTy) : - ∀ (fuel : Nat) (nodes : List FragNode) (symStack : List Nat) - (sLocals : List SVal) (wLocals : List WVal) - (sStack : List SVal) (wStack : List WVal) (out : Out), - nodesAdmitted hostTable nodes = true → - planTyped structIdx tyOf params nodes → - (∀ (i : Nat) (sv : SVal), i < params.length → - sLocals[i]? = some sv → params[i]? = some (svalTy sv)) → - IdsTyped tyOf symStack sStack → - SReprAll S structIdx sLocals wLocals → - SReprAll S structIdx sStack wStack → - runNodesFuel host ar callee fuel C nodes symStack wLocals wStack - = some out → - ∃ wLocals' wStack' sStack', - out = .ok wLocals' wStack' ∧ - sourceRunNodes fuel nodes symStack sLocals sStack = some sStack' ∧ - SReprAll S structIdx sStack' wStack' := by - intro fuel - induction fuel with - | zero => - intro nodes symStack sLocals wLocals sStack wStack out _ _ _ _ _ _ hrun - simp [runNodesFuel] at hrun - | succ fuel ih => - intro nodes symStack sLocals wLocals sStack wStack out hAdm hTy hLocalsTy - hStackTy hLocals hStack hrun - cases nodes with - | nil => - simp only [runNodesFuel, Option.some.injEq] at hrun - exact ⟨wLocals, wStack, sStack, hrun.symm, by simp [sourceRunNodes], - hStack⟩ - | cons node rest => - have hAdmPair : nodeAdmitted hostTable node.kind = true ∧ - nodesAdmitted hostTable rest = true := by - simpa [nodesAdmitted, List.all_cons] using hAdm - obtain ⟨hAdmN, hAdmR⟩ := hAdmPair - simp only [planTyped] at hTy - obtain ⟨hTyN, hTyR⟩ := hTy - cases hk : node.kind - case «local» index => - simp only [nodeTyped, hk] at hTyN - simp only [runNodesFuel, hk] at hrun - cases hl : wLocals[index]? with - | none => simp [wRunF, hl] at hrun - | some wv => - have hwr : wRunF host ar callee [.localGet index] wLocals wStack - = some (.ok wLocals (wv :: wStack)) := by - simp [wRunF, hl] - simp only [hwr] at hrun - obtain ⟨sv, hsl, hsv⟩ := sreprAll_getElem? hLocals hl - have hidx : index < params.length := by - rcases Nat.lt_or_ge index params.length with h | h - · exact h - · rw [List.getElem?_eq_none h] at hTyN; simp at hTyN - have hty : svalTy sv = tyOf node.id := - Option.some.inj ((hLocalsTy index sv hidx hsl).symm.trans hTyN) - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symStack) sLocals wLocals (sv :: sStack) - (wv :: wStack) out hAdmR hTyR hLocalsTy - (.cons hty hStackTy) hLocals (.cons hsv hStack) hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, hsl, hsrc], hrel⟩ - case constBool value => - simp [nodeAdmitted, hk] at hAdmN - case constI64 value => - simp only [nodeTyped, hk] at hTyN - rw [hk] at hAdmN - simp only [nodeAdmitted] at hAdmN - have hband : -(2 ^ 63 : Int) ≤ value ∧ value < 2 ^ 63 := by - simpa [AverCert.PlanCheck.inI64Band, Bool.and_eq_true, - decide_eq_true_eq] using hAdmN - simp only [runNodesFuel, hk] at hrun - have hwr : wRunF host ar callee [.i64Const value] wLocals wStack - = some (.ok wLocals (.i64v value :: wStack)) := by - simp [wRunF] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symStack) sLocals wLocals - (.raw value :: sStack) (.i64v value :: wStack) out - hAdmR hTyR hLocalsTy (.cons (by simp [svalTy, hTyN]) hStackTy) - hLocals (.cons ⟨rfl, hband.1, hband.2⟩ hStack) hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, hsrc], hrel⟩ - case constI32 value => - simp only [nodeTyped, hk] at hTyN - simp only [runNodesFuel, hk] at hrun - have hwr : wRunF host ar callee [.i32Const value] wLocals wStack - = some (.ok wLocals (.i32v value :: wStack)) := by - simp [wRunF] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symStack) sLocals wLocals - (.i32 value :: sStack) (.i32v value :: wStack) out - hAdmR hTyR hLocalsTy (.cons (by simp [svalTy, hTyN]) hStackTy) - hLocals (.cons rfl hStack) hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, hsrc], hrel⟩ - case constF64Bits bits => - simp [nodeAdmitted, hk] at hAdmN - case structGet field receiver => - simp [nodeAdmitted, hk] at hAdmN - case structGetUser tyIdx field value => - simp only [nodeTyped, hk] at hTyN - obtain ⟨hTyV, hTyId⟩ := hTyN - simp only [runNodesFuel, hk] at hrun - cases hp : popExpected symStack value with - | none => simp [hp] at hrun - | some symRest => - simp only [hp] at hrun - have hsym := popExpected_eq hp - subst hsym - obtain ⟨sv, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨fields, rfl⟩ := svalTy_adt (hty1.trans hTyV) - obtain ⟨w, ws0, rfl, hsv, hStack'⟩ := sreprAll_cons_inv hStack - have hsv' : ∃ wsf, w = .structv structIdx wsf ∧ - ReprAll (CanonRepr S) fields wsf := hsv - obtain ⟨wsf, rfl, hra⟩ := hsv' - by_cases hti : structIdx = tyIdx - · subst hti - cases hf : wsf[field]? with - | none => simp [wRunF, hf] at hrun - | some wv => - have hwr : wRunF host ar callee - [.structGet structIdx field] wLocals - (.structv structIdx wsf :: ws0) - = some (.ok wLocals (wv :: ws0)) := by - simp [wRunF, hf] - simp only [hwr] at hrun - obtain ⟨m, hfm, hRm⟩ := reprAll_getElem? hra hf - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.i m :: svs) (wv :: ws0) out hAdmR hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') hLocals - (.cons hRm hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpected, hfm, hsrc], - hrel⟩ - · simp [wRunF, hti] at hrun - case refIsNull value => - simp [nodeAdmitted, hk] at hAdmN - case prim op args => - rw [hk] at hAdmN - simp only [nodeTyped, hk] at hTyN - obtain ⟨hArgTy, hTyId⟩ := hTyN - simp only [runNodesFuel, hk] at hrun - cases hp : popExpectedAll symStack args.reverse with - | none => simp [hp] at hrun - | some symRest => - simp only [hp] at hrun - have hsym := popExpectedAll_append hp - have hlen : args.length = 2 := by - cases op <;> - simp only [nodeAdmitted] at hAdmN <;> - simpa using hAdmN - cases args with - | nil => simp at hlen - | cons a1 t => - cases t with - | nil => simp at hlen - | cons a2 t2 => - cases t2 with - | cons a3 t3 => - simp only [List.length_cons] at hlen; omega - | nil => - simp at hsym - subst hsym - obtain ⟨sv2, svsA, rfl, hty2, hStackTyA⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨sv1, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTyA - obtain ⟨x2, rfl⟩ := svalTy_i32 - (hty2.trans (hArgTy a2 (by simp))) - obtain ⟨x1, rfl⟩ := svalTy_i32 - (hty1.trans (hArgTy a1 (by simp))) - obtain ⟨wv2, wsA, rfl, hsv2, hStackA⟩ := - sreprAll_cons_inv hStack - obtain ⟨wv1, ws0, rfl, hsv1, hStack'⟩ := - sreprAll_cons_inv hStackA - have hw2 : wv2 = WVal.i32v x2 := hsv2 - have hw1 : wv1 = WVal.i32v x1 := hsv1 - subst hw1 - subst hw2 - cases op - case i32LtS => - have hwr : wRunF host ar callee - [primInstr .i32LtS] wLocals - (WVal.i32v x2 :: WVal.i32v x1 :: ws0) - = some (.ok wLocals (b32 (x1 < x2) :: ws0)) := by - simp [wRunF, primInstr] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.b (x1 < x2) :: svs) (b32 (x1 < x2) :: ws0) - out hAdmR hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals (.cons rfl hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - case i32GtS => - have hwr : wRunF host ar callee - [primInstr .i32GtS] wLocals - (WVal.i32v x2 :: WVal.i32v x1 :: ws0) - = some (.ok wLocals (b32 (x1 > x2) :: ws0)) := by - simp [wRunF, primInstr] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.b (x1 > x2) :: svs) (b32 (x1 > x2) :: ws0) - out hAdmR hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals (.cons rfl hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - case i32GeS => - have hwr : wRunF host ar callee - [primInstr .i32GeS] wLocals - (WVal.i32v x2 :: WVal.i32v x1 :: ws0) - = some (.ok wLocals (b32 (x1 ≥ x2) :: ws0)) := by - simp [wRunF, primInstr] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.b (x1 ≥ x2) :: svs) (b32 (x1 ≥ x2) :: ws0) - out hAdmR hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals (.cons rfl hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - all_goals exact absurd hAdmN (by simp [nodeAdmitted]) - case hostCall role f args => - simp only [runNodesFuel, hk] at hrun - cases hp : popExpectedAll symStack args.reverse with - | none => simp [hp] at hrun - | some symRest => - simp only [hp] at hrun - have hsym := popExpectedAll_append hp - rw [hk] at hAdmN - cases role with - | toIndex => simp [nodeAdmitted] at hAdmN - | box => - simp only [nodeAdmitted, Bool.and_eq_true, - beq_iff_eq] at hAdmN - obtain ⟨hfEq, hlen⟩ := hAdmN - have hHostBox : host f = some (1, box) := - hHost .box f (by simp) hfEq - simp only [nodeTyped, hk] at hTyN - obtain ⟨hArgTy, hTyId⟩ := hTyN - cases args with - | nil => simp at hlen - | cons a t => - cases t with - | cons b t2 => simp only [List.length_cons] at hlen; omega - | nil => - simp at hsym - subst hsym - obtain ⟨sv, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨n, rfl⟩ := svalTy_i64 - (hty1.trans (hArgTy a (by simp))) - obtain ⟨w, ws0, rfl, hsv, hStack'⟩ := - sreprAll_cons_inv hStack - obtain ⟨hw, hlo, hhi⟩ := hsv - subst hw - have hpa : popArgs 1 (WVal.i64v n :: ws0) - = some ([WVal.i64v n], ws0) := by - simpa using popArgs_append - (ws1 := [WVal.i64v n]) (wRest := ws0) - cases hb : box [.i64v n] with - | none => simp [wRunF, hHostBox, hpa, hb] at hrun - | some r => - have hwr : wRunF host ar callee [.call f] - wLocals (.i64v n :: ws0) - = some (.ok wLocals (r :: ws0)) := by - simp [wRunF, hHostBox, hpa, hb] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.i n :: svs) (r :: ws0) out hAdmR hTyR - hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals - (.cons (Ctr.hBox n r hlo hhi hb) hStack') - hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - | add => - simp only [nodeAdmitted, Bool.and_eq_true, - beq_iff_eq] at hAdmN - obtain ⟨hfEq, hlen⟩ := hAdmN - have hHostFn : host f = some (2, add) := - hHost .add f (by simp) hfEq - simp only [nodeTyped, hk] at hTyN - obtain ⟨hArgTy, hTyId⟩ := hTyN - cases args with - | nil => simp at hlen - | cons a1 t => - cases t with - | nil => simp at hlen - | cons a2 t2 => - cases t2 with - | cons a3 t3 => - simp only [List.length_cons] at hlen; omega - | nil => - simp at hsym - subst hsym - obtain ⟨sv2, svsA, rfl, hty2, hStackTyA⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨sv1, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTyA - obtain ⟨x2, rfl⟩ := svalTy_int - (hty2.trans (hArgTy a2 (by simp))) - obtain ⟨x1, rfl⟩ := svalTy_int - (hty1.trans (hArgTy a1 (by simp))) - obtain ⟨wv2, wsA, rfl, hsv2, hStackA⟩ := - sreprAll_cons_inv hStack - obtain ⟨wv1, ws0, rfl, hsv1, hStack'⟩ := - sreprAll_cons_inv hStackA - have hR2 : CanonRepr S x2 wv2 := hsv2 - have hR1 : CanonRepr S x1 wv1 := hsv1 - have hpa : popArgs 2 (wv2 :: wv1 :: ws0) - = some ([wv1, wv2], ws0) := by - simpa using popArgs_append - (ws1 := [wv2, wv1]) (wRest := ws0) - cases hb : add [wv1, wv2] with - | none => simp [wRunF, hHostFn, hpa, hb] at hrun - | some r => - have hwr : wRunF host ar callee [.call f] - wLocals (wv2 :: wv1 :: ws0) - = some (.ok wLocals (r :: ws0)) := by - simp [wRunF, hHostFn, hpa, hb] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.i (x1 + x2) :: svs) (r :: ws0) out hAdmR - hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals - (.cons (Ctr.hAdd x1 x2 wv1 wv2 r hR1.1 - hR2.1 hb) hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - | sub => - simp only [nodeAdmitted, Bool.and_eq_true, - beq_iff_eq] at hAdmN - obtain ⟨hfEq, hlen⟩ := hAdmN - have hHostFn : host f = some (2, sub) := - hHost .sub f (by simp) hfEq - simp only [nodeTyped, hk] at hTyN - obtain ⟨hArgTy, hTyId⟩ := hTyN - cases args with - | nil => simp at hlen - | cons a1 t => - cases t with - | nil => simp at hlen - | cons a2 t2 => - cases t2 with - | cons a3 t3 => - simp only [List.length_cons] at hlen; omega - | nil => - simp at hsym - subst hsym - obtain ⟨sv2, svsA, rfl, hty2, hStackTyA⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨sv1, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTyA - obtain ⟨x2, rfl⟩ := svalTy_int - (hty2.trans (hArgTy a2 (by simp))) - obtain ⟨x1, rfl⟩ := svalTy_int - (hty1.trans (hArgTy a1 (by simp))) - obtain ⟨wv2, wsA, rfl, hsv2, hStackA⟩ := - sreprAll_cons_inv hStack - obtain ⟨wv1, ws0, rfl, hsv1, hStack'⟩ := - sreprAll_cons_inv hStackA - have hR2 : CanonRepr S x2 wv2 := hsv2 - have hR1 : CanonRepr S x1 wv1 := hsv1 - have hpa : popArgs 2 (wv2 :: wv1 :: ws0) - = some ([wv1, wv2], ws0) := by - simpa using popArgs_append - (ws1 := [wv2, wv1]) (wRest := ws0) - cases hb : sub [wv1, wv2] with - | none => simp [wRunF, hHostFn, hpa, hb] at hrun - | some r => - have hwr : wRunF host ar callee [.call f] - wLocals (wv2 :: wv1 :: ws0) - = some (.ok wLocals (r :: ws0)) := by - simp [wRunF, hHostFn, hpa, hb] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.i (x1 - x2) :: svs) (r :: ws0) out hAdmR - hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals - (.cons (Ctr.hSub x1 x2 wv1 wv2 r hR1.1 - hR2.1 hb) hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - | mul => - simp only [nodeAdmitted, Bool.and_eq_true, - beq_iff_eq] at hAdmN - obtain ⟨hfEq, hlen⟩ := hAdmN - have hHostFn : host f = some (2, mul) := - hHost .mul f (by simp) hfEq - simp only [nodeTyped, hk] at hTyN - obtain ⟨hArgTy, hTyId⟩ := hTyN - cases args with - | nil => simp at hlen - | cons a1 t => - cases t with - | nil => simp at hlen - | cons a2 t2 => - cases t2 with - | cons a3 t3 => - simp only [List.length_cons] at hlen; omega - | nil => - simp at hsym - subst hsym - obtain ⟨sv2, svsA, rfl, hty2, hStackTyA⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨sv1, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTyA - obtain ⟨x2, rfl⟩ := svalTy_int - (hty2.trans (hArgTy a2 (by simp))) - obtain ⟨x1, rfl⟩ := svalTy_int - (hty1.trans (hArgTy a1 (by simp))) - obtain ⟨wv2, wsA, rfl, hsv2, hStackA⟩ := - sreprAll_cons_inv hStack - obtain ⟨wv1, ws0, rfl, hsv1, hStack'⟩ := - sreprAll_cons_inv hStackA - have hR2 : CanonRepr S x2 wv2 := hsv2 - have hR1 : CanonRepr S x1 wv1 := hsv1 - have hpa : popArgs 2 (wv2 :: wv1 :: ws0) - = some ([wv1, wv2], ws0) := by - simpa using popArgs_append - (ws1 := [wv2, wv1]) (wRest := ws0) - cases hb : mul [wv1, wv2] with - | none => simp [wRunF, hHostFn, hpa, hb] at hrun - | some r => - have hwr : wRunF host ar callee [.call f] - wLocals (wv2 :: wv1 :: ws0) - = some (.ok wLocals (r :: ws0)) := by - simp [wRunF, hHostFn, hpa, hb] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.i (x1 * x2) :: svs) (r :: ws0) out hAdmR - hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals - (.cons (Ctr.hMul x1 x2 wv1 wv2 r hR1.1 - hR2.1 hb) hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - | cmp => - simp only [nodeAdmitted, Bool.and_eq_true, - beq_iff_eq] at hAdmN - obtain ⟨hfEq, hlen⟩ := hAdmN - have hHostFn : host f = some (2, cmp) := - hHost .cmp f (by simp) hfEq - simp only [nodeTyped, hk] at hTyN - obtain ⟨hArgTy, hTyId⟩ := hTyN - cases args with - | nil => simp at hlen - | cons a1 t => - cases t with - | nil => simp at hlen - | cons a2 t2 => - cases t2 with - | cons a3 t3 => - simp only [List.length_cons] at hlen; omega - | nil => - simp at hsym - subst hsym - obtain ⟨sv2, svsA, rfl, hty2, hStackTyA⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨sv1, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTyA - obtain ⟨x2, rfl⟩ := svalTy_int - (hty2.trans (hArgTy a2 (by simp))) - obtain ⟨x1, rfl⟩ := svalTy_int - (hty1.trans (hArgTy a1 (by simp))) - obtain ⟨wv2, wsA, rfl, hsv2, hStackA⟩ := - sreprAll_cons_inv hStack - obtain ⟨wv1, ws0, rfl, hsv1, hStack'⟩ := - sreprAll_cons_inv hStackA - have hR2 : CanonRepr S x2 wv2 := hsv2 - have hR1 : CanonRepr S x1 wv1 := hsv1 - have hpa : popArgs 2 (wv2 :: wv1 :: ws0) - = some ([wv1, wv2], ws0) := by - simpa using popArgs_append - (ws1 := [wv2, wv1]) (wRest := ws0) - cases hb : cmp [wv1, wv2] with - | none => simp [wRunF, hHostFn, hpa, hb] at hrun - | some r => - have hr := Ctr.hCmp x1 x2 wv1 wv2 r hR1.1 - hR2.1 hR1.2 hR2.2 hb - subst hr - have hwr : wRunF host ar callee [.call f] - wLocals (wv2 :: wv1 :: ws0) - = some (.ok wLocals - (WVal.i32v (cmpW x1 x2) :: ws0)) := by - simp [wRunF, hHostFn, hpa, hb] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - ((SVal.i32 (cmpW x1 x2)) :: svs) - (WVal.i32v (cmpW x1 x2) :: ws0) out hAdmR - hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals (.cons rfl hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - | eq => - simp only [nodeAdmitted, Bool.and_eq_true, - beq_iff_eq] at hAdmN - obtain ⟨hfEq, hlen⟩ := hAdmN - have hHostFn : host f = some (2, eq) := - hHost .eq f (by simp) hfEq - simp only [nodeTyped, hk] at hTyN - obtain ⟨hArgTy, hTyId⟩ := hTyN - cases args with - | nil => simp at hlen - | cons a1 t => - cases t with - | nil => simp at hlen - | cons a2 t2 => - cases t2 with - | cons a3 t3 => - simp only [List.length_cons] at hlen; omega - | nil => - simp at hsym - subst hsym - obtain ⟨sv2, svsA, rfl, hty2, hStackTyA⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨sv1, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTyA - obtain ⟨x2, rfl⟩ := svalTy_int - (hty2.trans (hArgTy a2 (by simp))) - obtain ⟨x1, rfl⟩ := svalTy_int - (hty1.trans (hArgTy a1 (by simp))) - obtain ⟨wv2, wsA, rfl, hsv2, hStackA⟩ := - sreprAll_cons_inv hStack - obtain ⟨wv1, ws0, rfl, hsv1, hStack'⟩ := - sreprAll_cons_inv hStackA - have hR2 : CanonRepr S x2 wv2 := hsv2 - have hR1 : CanonRepr S x1 wv1 := hsv1 - have hpa : popArgs 2 (wv2 :: wv1 :: ws0) - = some ([wv1, wv2], ws0) := by - simpa using popArgs_append - (ws1 := [wv2, wv1]) (wRest := ws0) - cases hb : eq [wv1, wv2] with - | none => simp [wRunF, hHostFn, hpa, hb] at hrun - | some r => - have hr := Ctr.hEq x1 x2 wv1 wv2 r hR1.1 - hR2.1 hR1.2 hR2.2 hb - subst hr - have hwr : wRunF host ar callee [.call f] - wLocals (wv2 :: wv1 :: ws0) - = some (.ok wLocals - (WVal.i32v (eqW x1 x2) :: ws0)) := by - simp [wRunF, hHostFn, hpa, hb] - simp only [hwr] at hrun - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - ((SVal.b (x1 = x2)) :: svs) - (WVal.i32v (eqW x1 x2) :: ws0) out hAdmR - hTyR hLocalsTy - (.cons (by simp [svalTy, hTyId]) hStackTy') - hLocals (.cons (eqW_b32 x1 x2) hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpectedAll, - popExpected, hsrc], hrel⟩ - case selfCall tail f args => - simp [nodeAdmitted, hk] at hAdmN - case ifElse cond thenBlock elseBlock => - simp [nodeAdmitted, hk] at hAdmN - case vectorGetOrDefault arrTy toIndexIdx bIdx default => - simp [nodeAdmitted, hk] at hAdmN - case structNew tyIdx args => - simp only [nodeTyped, hk] at hTyN - obtain ⟨htiEq, hArgsInt, hTyId⟩ := hTyN - subst tyIdx - simp only [runNodesFuel, hk] at hrun - cases hp : popExpectedAll symStack args.reverse with - | none => simp [hp] at hrun - | some symRest => - simp only [hp] at hrun - have hsym := popExpectedAll_append hp - subst hsym - obtain ⟨svs1, svs2, rfl, hty1, hty2⟩ := idsTyped_split hStackTy - obtain ⟨ws1, ws2, rfl, hrel1, hrel2⟩ := sreprAll_split hStack - have hlen1 : svs1.length = args.length := by - simpa using idsTyped_length hty1 - have hlenw : ws1.length = args.length := by - rw [← sreprAll_length hrel1, hlen1] - have hpa : popArgs args.length (ws1 ++ ws2) - = some (ws1.reverse, ws2) := by - rw [← hlenw]; exact popArgs_append - have hwr : wRunF host ar callee - [.structNew structIdx args.length] wLocals (ws1 ++ ws2) - = some (.ok wLocals - (.structv structIdx ws1.reverse :: ws2)) := by - simp [wRunF, hpa] - simp only [hwr] at hrun - obtain ⟨fields, htake, hfra⟩ := takeInts_bridge hty1 - (fun a ha => hArgsInt a (List.mem_reverse.mp ha)) hrel1 svs2 - rw [List.length_reverse] at htake - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) sLocals wLocals - (.r fields :: svs2) - (.structv structIdx ws1.reverse :: ws2) out hAdmR hTyR - hLocalsTy (.cons (by simp [svalTy, hTyId]) hty2) hLocals - (.cons (srepr_rec hfra) hrel2) hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, hp, htake, hsrc], hrel⟩ - case intSignCmp op k scratch value => - simp only [nodeTyped, hk] at hTyN - obtain ⟨hTyV, hScratch, hTyId⟩ := hTyN - rw [hk] at hAdmN - simp only [nodeAdmitted] at hAdmN - simp only [runNodesFuel, hk] at hrun - cases hp : popExpected symStack value with - | none => simp [hp] at hrun - | some symRest => - simp only [hp] at hrun - have hsym := popExpected_eq hp - subst hsym - obtain ⟨sv, svs, rfl, hty1, hStackTy'⟩ := - idsTyped_cons_inv hStackTy - obtain ⟨n, rfl⟩ := svalTy_int (hty1.trans hTyV) - obtain ⟨w, ws0, rfl, hsv, hStack'⟩ := sreprAll_cons_inv hStack - have hsvC : CanonRepr S n w := hsv - cases hstep : wRunF host ar callee - (intSignCmpTemplate C scratch op k) wLocals (w :: ws0) with - | none => simp [hstep] at hrun - | some out0 => - have hout0 := intSignCmp_step S host ar callee op k scratch - wLocals ws0 n w out0 hAdmN hsvC.1 hsvC.2 hstep - subst hout0 - simp only [hstep] at hrun - have hLocalsTy' : ∀ (i : Nat) (sv : SVal), - i < params.length → - (sLocals.set scratch (SVal.i n))[i]? = some sv → - params[i]? = some (svalTy sv) := by - intro i sv hi hset - rw [setNe? (SVal.i n) sLocals scratch i (by omega)] at hset - exact hLocalsTy i sv hi hset - obtain ⟨wl, ws, sStack', hout, hsrc, hrel⟩ := - ih rest (node.id :: symRest) (sLocals.set scratch (.i n)) - (wLocals.set scratch w) - (.b (symIntCmpDenote op n k) :: svs) - (b32 (symIntCmpDenote op n k) :: ws0) out hAdmR hTyR - hLocalsTy' (.cons (by simp [svalTy, hTyId]) hStackTy') - (sreprAll_set (sv := SVal.i n) hsvC hLocals scratch) - (.cons rfl hStack') hrun - exact ⟨wl, ws, sStack', hout, - by simp [sourceRunNodes, hk, popExpected, hsrc], hrel⟩ - -/-- Block-level corollary: a successful wasm run of an admitted body yields a - single value SRepr-related to the source model's value. The wasm entry runs - with the declared scratch pad appended to the arguments; the source model - appends its `pad` twin, so the two locals lists are pointwise related from - the start. -/ -theorem sourceRunBlock_agrees - {C : Nat} (S : CarrierSpec C) (structIdx : Nat) - (box add sub mul cmp eq : List WVal → Option WVal) - (Ctr : Contracts S box add sub mul cmp eq) - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (hostTable : List (HostRole × Nat)) - (hHost : ∀ role idx, - role ∈ [HostRole.box, HostRole.add, HostRole.sub, HostRole.mul, - HostRole.cmp, HostRole.eq] → - AverCert.PlanCheck.hostRoleIdx? hostTable role = some idx → - host idx = some (roleArity role, roleFn box add sub mul cmp eq role)) - (fuel : Nat) (block : FragBlock) - (sParams : List SVal) (wParams : List WVal) (out : Out) - (hAdm : nodesAdmitted hostTable block.nodes = true) - (tyOf : Nat → FragTy) (params : List FragTy) - (hTy : planTyped structIdx tyOf params block.nodes) - (hLenP : sParams.length = params.length) - (hParamsTy : ∀ (i : Nat) (sv : SVal), - sParams[i]? = some sv → params[i]? = some (svalTy sv)) - (hParams : SReprAll S structIdx sParams wParams) - (hrun : runBlockFuel host ar callee fuel C block (wParams ++ [.null]) - = some out) : - ∃ wLocals' w sv, out = .ok wLocals' [w] ∧ - sourceRunBlock fuel block sParams = some sv ∧ - SRepr S structIdx sv w := by - cases fuel with - | zero => simp [runBlockFuel] at hrun - | succ fuel => - simp only [runBlockFuel] at hrun - cases hr : runNodesFuel host ar callee fuel C block.nodes [] - (wParams ++ [WVal.null]) [] with - | none => simp [hr] at hrun - | some out0 => - rw [hr] at hrun - have hLocalsTy : ∀ (i : Nat) (sv : SVal), i < params.length → - (sParams ++ [SVal.pad])[i]? = some sv → - params[i]? = some (svalTy sv) := by - intro i sv hi hget - have hlt : i < sParams.length := by omega - rw [List.getElem?_append_left hlt] at hget - exact hParamsTy i sv hget - have hLocals : SReprAll S structIdx (sParams ++ [SVal.pad]) - (wParams ++ [WVal.null]) := - sreprAll_append hParams (.cons rfl .nil) - obtain ⟨wl, ws, sStack', hout0, hsrc, hrepr⟩ := - agreement S structIdx box add sub mul cmp eq Ctr host ar callee - hostTable hHost tyOf params fuel block.nodes [] - (sParams ++ [SVal.pad]) (wParams ++ [WVal.null]) [] [] out0 - hAdm hTy hLocalsTy IdsTyped.nil hLocals SReprAll.nil hr - subst hout0 - cases ws with - | nil => simp at hrun - | cons v tail => - cases tail with - | nil => - cases hrepr with - | cons hv htail => - cases htail - refine ⟨wl, v, _, ?_, ?_, hv⟩ - · simpa using hrun.symm - · simp [sourceRunBlock, hsrc] - | cons v' t' => simp at hrun - - -/-! ## Reverse completeness: lowered-code success implies plan-walker success - -`ExprFragmentSoundness.mutualCorrect` gives planRun ⇒ instrRun; the discharge -also needs the converse for successful runs. -/ - -/-- One reverse step: a successful run of `[instr] ++ restInstrs` splits into - the single-instruction step the plan walker takes and the continuation. -/ -private theorem completeStepN - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (fuel carrier : Nat) (rest : List FragNode) (nextSym : List Nat) - (instrs : List WInstr) (restInstrs : List WInstr) - (locals stack : List WVal) (out : Out) - (hrun : wRunF host ar callee (instrs ++ restInstrs) locals stack - = some out) - (hcont : ∀ l' s', wRunF host ar callee restInstrs l' s' = some out → - runNodesFuel host ar callee fuel carrier rest nextSym l' s' = some out) : - (match wRunF host ar callee instrs locals stack with - | some (.ok locals' stack') => - runNodesFuel host ar callee fuel carrier rest nextSym locals' stack' - | some (.ret value) => some (.ret value) - | none => none) = some out := by - rw [InterpreterSequencing.wRunF_append] at hrun - cases hs : wRunF host ar callee instrs locals stack with - | none => simp [InterpreterSequencing.seqOut, hs] at hrun - | some stepOut => - cases stepOut with - | ret v => simpa [InterpreterSequencing.seqOut, hs] using hrun - | ok l' s' => - simp only [InterpreterSequencing.seqOut, hs] at hrun - simp only [hs] - exact hcont l' s' hrun - -private theorem completeStep - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (fuel carrier : Nat) (rest : List FragNode) (nextSym : List Nat) - (instr : WInstr) (restInstrs : List WInstr) - (locals stack : List WVal) (out : Out) - (hrun : wRunF host ar callee ([instr] ++ restInstrs) locals stack - = some out) - (hcont : ∀ l' s', wRunF host ar callee restInstrs l' s' = some out → - runNodesFuel host ar callee fuel carrier rest nextSym l' s' = some out) : - (match wRunF host ar callee [instr] locals stack with - | some (.ok locals' stack') => - runNodesFuel host ar callee fuel carrier rest nextSym locals' stack' - | some (.ret value) => some (.ret value) - | none => none) = some out := - completeStepN host ar callee fuel carrier rest nextSym [instr] restInstrs - locals stack out hrun hcont - -/- SCOPE (documented choice): reverse completeness is stated over the SAME - `nodesAdmitted` node set as `agreement`. The claim is FALSE for - `vectorGetOrDefault`: its lowered template executes on the wasm side while - the plan walker is deliberately fail-closed (`none`) on that node. An - `ifElse` extension would additionally need the reverse frame discipline — - restricting a successful branch run over the resting operand stack to the - empty stack the plan walker starts branches on — i.e. a stack-depth - invariant on lowered code that the v1 record-compute discharge does not - need. The admitted straight-line kinds run the identical single instruction - on both sides, so unlike the forward direction no `CallsOK` fence is - needed: both runs consult the same host/ar/callee tables. -/ -theorem runNodes_complete - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (hostTable : List (HostRole × Nat)) : - ∀ (fuel carrier : Nat) (nodes : List FragNode) (symStack : List Nat) - (instrs : List WInstr) (finalStack : List Nat), - nodesAdmitted hostTable nodes = true → - lowerNodesFuel fuel carrier nodes symStack = some (instrs, finalStack) → - ∀ (locals stack : List WVal) (out : Out), - wRunF host ar callee instrs locals stack = some out → - runNodesFuel host ar callee fuel carrier nodes symStack locals stack - = some out := by - intro fuel - induction fuel with - | zero => - intro carrier nodes symStack instrs finalStack _ hlow - simp [lowerNodesFuel] at hlow - | succ fuel ih => - intro carrier nodes symStack instrs finalStack hAdm hlow - locals stack out hrun - cases nodes with - | nil => - simp only [lowerNodesFuel, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [wRunF, Option.some.injEq] at hrun - subst hrun - simp [runNodesFuel] - | cons node rest => - have hAdmPair : nodeAdmitted hostTable node.kind = true ∧ - nodesAdmitted hostTable rest = true := by - simpa [nodesAdmitted, List.all_cons] using hAdm - obtain ⟨hAdmN, hAdmR⟩ := hAdmPair - simp only [lowerNodesFuel] at hlow - cases hk : node.kind - case «local» index => - simp only [hk] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symStack) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk] - exact completeStep host ar callee fuel carrier rest - (node.id :: symStack) (.localGet index) restInstrs - locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symStack) - restInstrs fin hAdmR hrest l' s' out h) - case constBool value => - simp [nodeAdmitted, hk] at hAdmN - case constI64 value => - simp only [hk] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symStack) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk] - exact completeStep host ar callee fuel carrier rest - (node.id :: symStack) (.i64Const value) restInstrs - locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symStack) - restInstrs fin hAdmR hrest l' s' out h) - case constI32 value => - simp only [hk] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symStack) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk] - exact completeStep host ar callee fuel carrier rest - (node.id :: symStack) (.i32Const value) restInstrs - locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symStack) - restInstrs fin hAdmR hrest l' s' out h) - case constF64Bits bits => - simp [nodeAdmitted, hk] at hAdmN - case structGet field receiver => - simp [nodeAdmitted, hk] at hAdmN - case structGetUser tyIdx field value => - simp only [hk] at hlow - cases hpop : popExpected symStack value with - | none => simp [hpop] at hlow - | some symRest => - simp only [hpop] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symRest) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk, hpop] - exact completeStep host ar callee fuel carrier rest - (node.id :: symRest) (.structGet tyIdx field) restInstrs - locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symRest) - restInstrs fin hAdmR hrest l' s' out h) - case refIsNull value => - simp [nodeAdmitted, hk] at hAdmN - case prim op args => - simp only [hk] at hlow - cases hpop : popExpectedAll symStack args.reverse with - | none => simp [hpop] at hlow - | some symRest => - simp only [hpop] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symRest) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk, hpop] - exact completeStep host ar callee fuel carrier rest - (node.id :: symRest) (primInstr op) restInstrs - locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symRest) - restInstrs fin hAdmR hrest l' s' out h) - case hostCall role funcIdx args => - simp only [hk] at hlow - cases hpop : popExpectedAll symStack args.reverse with - | none => simp [hpop] at hlow - | some symRest => - simp only [hpop] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symRest) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk, hpop] - exact completeStep host ar callee fuel carrier rest - (node.id :: symRest) (.call funcIdx) restInstrs - locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symRest) - restInstrs fin hAdmR hrest l' s' out h) - case selfCall tail funcIdx args => - simp [nodeAdmitted, hk] at hAdmN - case ifElse cond thenBlock elseBlock => - simp [nodeAdmitted, hk] at hAdmN - case vectorGetOrDefault arrTy toIndexIdx bIdx default => - simp [nodeAdmitted, hk] at hAdmN - case structNew tyIdx args => - simp only [hk] at hlow - cases hpop : popExpectedAll symStack args.reverse with - | none => simp [hpop] at hlow - | some symRest => - simp only [hpop] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symRest) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk, hpop] - exact completeStep host ar callee fuel carrier rest - (node.id :: symRest) (.structNew tyIdx args.length) - restInstrs locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symRest) - restInstrs fin hAdmR hrest l' s' out h) - case intSignCmp op k scratch value => - simp only [hk] at hlow - cases hpop : popExpected symStack value with - | none => simp [hpop] at hlow - | some symRest => - simp only [hpop] at hlow - cases hrest : lowerNodesFuel fuel carrier rest - (node.id :: symRest) with - | none => simp [hrest] at hlow - | some pair => - obtain ⟨restInstrs, fin⟩ := pair - simp only [hrest, Option.some.injEq, Prod.mk.injEq] at hlow - obtain ⟨rfl, rfl⟩ := hlow - simp only [runNodesFuel, hk, hpop] - exact completeStepN host ar callee fuel carrier rest - (node.id :: symRest) - (intSignCmpTemplate carrier scratch op k) restInstrs - locals stack out hrun - (fun l' s' h => ih carrier rest (node.id :: symRest) - restInstrs fin hAdmR hrest l' s' out h) - -/-- Block-level corollary. The `hshape` hypothesis is the single-value (or - early-return) result shape that block lowering guarantees and that the - discharge possesses concretely; demanding it here avoids re-deriving the - stack-arity invariant of lowered code from the run itself. -/ -theorem runBlock_complete - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (hostTable : List (HostRole × Nat)) - (fuel carrier : Nat) (block : FragBlock) (instrs : List WInstr) - (locals : List WVal) (out : Out) - (hAdm : nodesAdmitted hostTable block.nodes = true) - (hlow : lowerBlockFuel fuel carrier block = some instrs) - (hrun : wRunF host ar callee instrs locals [] = some out) - (hshape : (∃ ls v, out = .ok ls [v]) ∨ (∃ v, out = .ret v)) : - runBlockFuel host ar callee fuel carrier block locals = some out := by - cases fuel with - | zero => simp [lowerBlockFuel] at hlow - | succ fuel => - simp only [lowerBlockFuel] at hlow - cases hn : lowerNodesFuel fuel carrier block.nodes [] with - | none => simp [hn] at hlow - | some pair => - obtain ⟨is, fs⟩ := pair - rw [hn] at hlow - cases fs with - | nil => simp at hlow - | cons r rs => - cases rs with - | cons r' rs' => simp at hlow - | nil => - by_cases hr : r = block.result - · subst hr - have his : is = instrs := by simpa using hlow - subst his - have hcomp := runNodes_complete host ar callee - hostTable fuel carrier - block.nodes [] is [block.result] hAdm hn locals [] out hrun - simp only [runBlockFuel, hcomp] - obtain ⟨ls, v, rfl⟩ | ⟨v, rfl⟩ := hshape <;> simp - · simp [hr] at hlow - -/-! ## Executable typing twin - -`planTypedB` is the Bool face the admission-time recognizer evaluates; the -soundness lemma converts its acceptance into the `planTyped` hypothesis the -`agreement` theorem consumes. Every clause mirrors `nodeTyped` conjunct for -conjunct, so acceptance cannot fail open. -/ - -def nodeTypedB (structIdx : Nat) (tyOf : Nat → FragTy) - (params : List FragTy) (node : FragNode) : Bool := - match node.kind with - | .local index => params[index]? == some (tyOf node.id) - | .constI64 _ => tyOf node.id == .i64 - | .constI32 _ => tyOf node.id == .rawI32 - | .structGetUser _ _ value => - tyOf value == .adtRef && tyOf node.id == .intCarrier - | .structNew tyIdx args => - tyIdx == structIdx && - (args.all (fun a => tyOf a == .intCarrier) && tyOf node.id == .adtRef) - | .prim _ args => - args.all (fun a => tyOf a == .rawI32) && tyOf node.id == .boolI32 - | .hostCall .box _ args => - args.all (fun a => tyOf a == .i64) && tyOf node.id == .intCarrier - | .hostCall .cmp _ args => - args.all (fun a => tyOf a == .intCarrier) && tyOf node.id == .rawI32 - | .hostCall .eq _ args => - args.all (fun a => tyOf a == .intCarrier) && tyOf node.id == .boolI32 - | .hostCall _ _ args => - args.all (fun a => tyOf a == .intCarrier) && tyOf node.id == .intCarrier - | .intSignCmp _ _ scratch value => - tyOf value == .intCarrier && scratch == params.length && - tyOf node.id == .boolI32 - | _ => true - -def planTypedB (structIdx : Nat) (tyOf : Nat → FragTy) - (params : List FragTy) (nodes : List FragNode) : Bool := - nodes.all (nodeTypedB structIdx tyOf params) - -theorem nodeTypedB_sound {structIdx : Nat} {tyOf : Nat → FragTy} - {params : List FragTy} {node : FragNode} - (h : nodeTypedB structIdx tyOf params node = true) : - nodeTyped structIdx tyOf params node := by - cases hk : node.kind - case hostCall role funcIdx args => - cases role <;> - simp only [nodeTypedB, nodeTyped, hk, Bool.and_eq_true, beq_iff_eq, - List.all_eq_true] at h ⊢ <;> - exact h - case intSignCmp op constant scratch value => - simp only [nodeTypedB, nodeTyped, hk, Bool.and_eq_true, beq_iff_eq] at h ⊢ - exact ⟨h.1.1, h.1.2, h.2⟩ - all_goals - simp only [nodeTypedB, nodeTyped, hk, Bool.and_eq_true, beq_iff_eq, - List.all_eq_true] at h ⊢ <;> - try exact h - -theorem planTypedB_sound {structIdx : Nat} {tyOf : Nat → FragTy} - {params : List FragTy} {nodes : List FragNode} - (h : planTypedB structIdx tyOf params nodes = true) : - planTyped structIdx tyOf params nodes := by - induction nodes with - | nil => exact True.intro - | cons node rest ih => - simp only [planTypedB, List.all_cons, Bool.and_eq_true] at h - exact ⟨nodeTypedB_sound h.1, ih h.2⟩ - -end RecordComputeBridge diff --git a/aver-cert/assets/wall/current/RecursionSoundness.lean b/aver-cert/assets/wall/current/RecursionSoundness.lean deleted file mode 100644 index d5b02140f..000000000 --- a/aver-cert/assets/wall/current/RecursionSoundness.lean +++ /dev/null @@ -1,1060 +0,0 @@ -/- Generic fuel-induction soundness for the - descent-by-one unary recursion family. - - One theorem, proven ONCE by fuel induction generically over parsed recursion - plans, that subsumes every per-artifact generated fuel-recursion certificate - of the unary family: if the (data-carrying) shape parser accepts a plan and - the code table carries the plan's canonical lowering, then for every - represented input, every terminating interpreter run returns a - representation of the plan-derived model value. -/ -import CertPrelude -import SchemaCore -import PlanCheck -import PlanLower - -set_option maxRecDepth 100000 - -namespace RecursionSoundness -open CertPrelude AverCert.Schema AverCert.PlanLower - -/-! ### The parsed shape of a unary descent-by-one recursion plan -/ - -/-- The semantic host operation performed after the recursive call. Wasm - bytes identify the exact helper index, while the option-(b) bridge binds - that index to the corresponding independently quantified host contract. -/ -inductive RecCombine where - | add - | mul -deriving Repr, DecidableEq - -def combineHostRole : RecCombine → HostRole - | .add => .add - | .mul => .mul - -/-- The four byte-derived step variants of the unary family. -/ -inductive RecStep where - | inputSecond -- n + f (n-1) - | constSecond (k : Int) -- k + f (n-1) - | inputFirst -- f (n-1) + n - | constFirst (k : Int) -- f (n-1) + k -deriving Repr, DecidableEq - -structure RecShapeU where - base : Int - step : RecStep -deriving Repr, DecidableEq - -/-! ### Data-carrying parsers (mirrors of PlanCheck's boolean shape checks) -/ - -def parseBaseU (boxIdx : Nat) (b : FragBlock) : Option Int := - match b.nodes with - | [{ id := 0, ty := .i64, kind := .constI64 k }, - { id := 1, ty := .intCarrier, kind := .hostCall .box bi [0] }] => - if b.result = 1 ∧ bi = boxIdx then some k else none - | _ => none - -def parseStepU (combine : RecCombine) (self boxIdx combineIdx subIdx : Nat) - (b : FragBlock) : Option RecStep := - match b.nodes with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 0 }, - { id := 2, ty := .i64, kind := .constI64 one }, - { id := 3, ty := .intCarrier, kind := .hostCall .box bi [2] }, - { id := 4, ty := .intCarrier, kind := .hostCall .sub si [1, 3] }, - { id := 5, ty := .intCarrier, kind := .selfCall false sc [4] }, - { id := 6, ty := .intCarrier, kind := .hostCall role ci [0, 5] }] => - if b.result = 6 ∧ one = 1 ∧ bi = boxIdx ∧ si = subIdx ∧ sc = self ∧ - role = combineHostRole combine ∧ ci = combineIdx then - some .inputSecond - else none - | [{ id := 0, ty := .i64, kind := .constI64 k }, - { id := 1, ty := .intCarrier, kind := .hostCall .box bk [0] }, - { id := 2, ty := .intCarrier, kind := .local 0 }, - { id := 3, ty := .i64, kind := .constI64 one }, - { id := 4, ty := .intCarrier, kind := .hostCall .box bi [3] }, - { id := 5, ty := .intCarrier, kind := .hostCall .sub si [2, 4] }, - { id := 6, ty := .intCarrier, kind := .selfCall false sc [5] }, - { id := 7, ty := .intCarrier, kind := .hostCall role ci [1, 6] }] => - if b.result = 7 ∧ one = 1 ∧ bk = boxIdx ∧ bi = boxIdx ∧ si = subIdx ∧ sc = self ∧ - role = combineHostRole combine ∧ ci = combineIdx then - some (.constSecond k) - else none - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 one }, - { id := 2, ty := .intCarrier, kind := .hostCall .box bi [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub si [0, 2] }, - { id := 4, ty := .intCarrier, kind := .selfCall false sc [3] }, - { id := 5, ty := .intCarrier, kind := .local 0 }, - { id := 6, ty := .intCarrier, kind := .hostCall role ci [4, 5] }] => - if b.result = 6 ∧ one = 1 ∧ bi = boxIdx ∧ si = subIdx ∧ sc = self ∧ - role = combineHostRole combine ∧ ci = combineIdx then - some .inputFirst - else none - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 one }, - { id := 2, ty := .intCarrier, kind := .hostCall .box bi [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub si [0, 2] }, - { id := 4, ty := .intCarrier, kind := .selfCall false sc [3] }, - { id := 5, ty := .i64, kind := .constI64 k }, - { id := 6, ty := .intCarrier, kind := .hostCall .box bk [5] }, - { id := 7, ty := .intCarrier, kind := .hostCall role ci [4, 6] }] => - if b.result = 7 ∧ one = 1 ∧ bi = boxIdx ∧ bk = boxIdx ∧ si = subIdx ∧ sc = self ∧ - role = combineHostRole combine ∧ ci = combineIdx then - some (.constFirst k) - else none - | _ => none - -def parseTopU (combine : RecCombine) (self boxIdx combineIdx subIdx : Nat) - (b : FragBlock) : Option RecShapeU := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .ref, kind := .structGet 1 0 }, - { id := 2, ty := .boolI32, kind := .refIsNull 1 }, - { id := 3, ty := .boolI32, kind := .ifElse 2 - ({ nodes := [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .structGet 0 0 }, - { id := 2, ty := .i64, kind := .constI64 (0 : Int) }, - { id := 3, ty := .boolI32, kind := .prim .i64LeS [1, 2] }], result := 3 } : FragBlock) - ({ nodes := [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .rawI32, kind := .structGet 2 0 }, - { id := 2, ty := .boolI32, kind := .constBool false }, - { id := 3, ty := .boolI32, kind := .prim .i32LtS [1, 2] }], result := 3 } : FragBlock) }, - { id := 4, ty := .intCarrier, kind := .ifElse 3 base step }], 4 => - match parseBaseU boxIdx base, - parseStepU combine self boxIdx combineIdx subIdx step with - | some bv, some st => some ⟨bv, st⟩ - | _, _ => none - | _, _ => none - -def parseRecShapeU (combine : RecCombine) (self boxIdx combineIdx subIdx : Nat) - (plan : RecursionRawPlan) : Option RecShapeU := - if plan.profile = "recursion-plan-v1" ∧ plan.params = [FragTy.intCarrier] ∧ - AverCert.PlanCheck.sameTy plan.result .intCarrier then - parseTopU combine self boxIdx combineIdx subIdx plan.body - else none - -/-! ### The generic plan-derived model (fuel twin + natAbs face, once) -/ - -def combineEval : RecCombine → Int → Int → Int - | .add, a, b => a + b - | .mul, a, b => a * b - -def stepEval (combine : RecCombine) : RecStep → Int → Int → Int - | .inputSecond, n, r => combineEval combine n r - | .constSecond k, _, r => combineEval combine k r - | .inputFirst, n, r => combineEval combine r n - | .constFirst k, _, r => combineEval combine r k - -def evalRecUFuel (combine : RecCombine) (sh : RecShapeU) : Nat → Int → Int - | 0, _ => 0 - | fuel + 1, n => - if n ≤ 0 then sh.base - else stepEval combine sh.step n (evalRecUFuel combine sh fuel (n - 1)) - -def evalRecU (combine : RecCombine) (sh : RecShapeU) (n : Int) : Int := - evalRecUFuel combine sh (n.natAbs + 1) n - -theorem evalRecU_fuel_irrel (combine : RecCombine) (sh : RecShapeU) : - ∀ (t k1 k2 : Nat) (n : Int), n.natAbs < t → n.natAbs < k1 → n.natAbs < k2 → - evalRecUFuel combine sh k1 n = evalRecUFuel combine sh k2 n := by - intro t - induction t with - | zero => intro k1 k2 n ht _ _; omega - | succ t ih => - intro k1 k2 n ht h1 h2 - cases k1 with - | zero => omega - | succ m1 => - cases k2 with - | zero => omega - | succ m2 => - by_cases hn : n ≤ 0 - · simp [evalRecUFuel, hn] - · have hrec := ih m1 m2 (n - 1) (by omega) (by omega) (by omega) - simp only [evalRecUFuel] - rw [if_neg hn, if_neg hn, hrec] - -theorem evalRecU_fuel_stable (combine : RecCombine) (sh : RecShapeU) - (k : Nat) (n : Int) (h : n.natAbs < k) : - evalRecUFuel combine sh k n = evalRecU combine sh n := - evalRecU_fuel_irrel combine sh (n.natAbs + k + 1) k (n.natAbs + 1) n - (by omega) h (by omega) - -theorem evalRecU_step (combine : RecCombine) (sh : RecShapeU) - (n : Int) (hn : ¬ n ≤ 0) : - evalRecU combine sh n = - stepEval combine sh.step n (evalRecU combine sh (n - 1)) := by - have h0 : evalRecU combine sh n = - evalRecUFuel combine sh (n.natAbs + 1) n := rfl - rw [h0] - simp only [evalRecUFuel] - rw [if_neg hn, evalRecU_fuel_stable combine sh n.natAbs (n - 1) (by omega)] - -theorem evalRecU_base (combine : RecCombine) (sh : RecShapeU) - (n : Int) (hn : n ≤ 0) : - evalRecU combine sh n = sh.base := by - have h0 : evalRecU combine sh n = - evalRecUFuel combine sh (n.natAbs + 1) n := rfl - rw [h0]; simp [evalRecUFuel, hn] - -/-! ### The canonical lowering of a parsed shape -/ - -def signSInstrs (C : Nat) : List WInstr := - [.localGet 0, .structGet C 0, .i64Const 0, .i64LeS] - -def signBInstrs (C : Nat) : List WInstr := - [.localGet 0, .structGet C 2, .i32Const 0, .i32LtS] - -def baseInstrs (bI : Nat) (b : Int) : List WInstr := - [.i64Const b, .call bI] - -def stepInstrs (self bI aI sI : Nat) : RecStep → List WInstr - | .inputSecond => - [.localGet 0, .localGet 0, .i64Const 1, .call bI, .call sI, .call self, .call aI] - | .constSecond k => - [.i64Const k, .call bI, .localGet 0, .i64Const 1, .call bI, .call sI, - .call self, .call aI] - | .inputFirst => - [.localGet 0, .i64Const 1, .call bI, .call sI, .call self, .localGet 0, .call aI] - | .constFirst k => - [.localGet 0, .i64Const 1, .call bI, .call sI, .call self, .i64Const k, - .call bI, .call aI] - -def recInstrsU (C self bI aI sI : Nat) (sh : RecShapeU) : List WInstr := - [.localGet 0, .structGet C 1, .refIsNull, - .ifElse (signSInstrs C) (signBInstrs C), - .ifElse (baseInstrs bI sh.base) (stepInstrs self bI aI sI sh.step)] - -/-- Block-level: the parse pins the block (sign predicates inlined as literals), - so the audited canonical lowering computes to exactly the shape's instruction - list. Nested `split at h` avoids block-binder naming; each surviving arm is a - literal body whose lowering reduces by `rfl`. -/ --- Block-level literal-pinning: parseTopU succeeding pins b to a literal whose --- canonical lowering is `recInstrsU`. This is the SAME mechanical shape the --- straight-line proof (the lowering invariant plus per-arm reduction) closes --- kernel-clean; the recursion version is strictly more mechanical (no --- induction). The helper equalities below give stable names to the literal --- base and step blocks before the final lowering computation. -theorem parseBase_eq (boxIdx : Nat) (b : FragBlock) (bv : Int) - (h : parseBaseU boxIdx b = some bv) : - b = ⟨ - [{ id := 0, ty := .i64, kind := .constI64 bv }, - { id := 1, ty := .intCarrier, kind := .hostCall .box boxIdx [0] }], - 1⟩ := by - simp only [parseBaseU] at h - split at h - case h_2 => simp at h - case h_1 => - split at h - case isFalse => simp at h - case isTrue hc => - rcases hc with ⟨hr, hbi⟩ - injection h with hk - cases b - simp_all - -def stepBlockU (combine : RecCombine) (self boxIdx combineIdx subIdx : Nat) : RecStep → FragBlock - | .inputSecond => ⟨ - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 0 }, - { id := 2, ty := .i64, kind := .constI64 1 }, - { id := 3, ty := .intCarrier, kind := .hostCall .box boxIdx [2] }, - { id := 4, ty := .intCarrier, kind := .hostCall .sub subIdx [1, 3] }, - { id := 5, ty := .intCarrier, kind := .selfCall false self [4] }, - { id := 6, ty := .intCarrier, - kind := .hostCall (combineHostRole combine) combineIdx [0, 5] }], 6⟩ - | .constSecond k => ⟨ - [{ id := 0, ty := .i64, kind := .constI64 k }, - { id := 1, ty := .intCarrier, kind := .hostCall .box boxIdx [0] }, - { id := 2, ty := .intCarrier, kind := .local 0 }, - { id := 3, ty := .i64, kind := .constI64 1 }, - { id := 4, ty := .intCarrier, kind := .hostCall .box boxIdx [3] }, - { id := 5, ty := .intCarrier, kind := .hostCall .sub subIdx [2, 4] }, - { id := 6, ty := .intCarrier, kind := .selfCall false self [5] }, - { id := 7, ty := .intCarrier, - kind := .hostCall (combineHostRole combine) combineIdx [1, 6] }], 7⟩ - | .inputFirst => ⟨ - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 1 }, - { id := 2, ty := .intCarrier, kind := .hostCall .box boxIdx [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub subIdx [0, 2] }, - { id := 4, ty := .intCarrier, kind := .selfCall false self [3] }, - { id := 5, ty := .intCarrier, kind := .local 0 }, - { id := 6, ty := .intCarrier, - kind := .hostCall (combineHostRole combine) combineIdx [4, 5] }], 6⟩ - | .constFirst k => ⟨ - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 1 }, - { id := 2, ty := .intCarrier, kind := .hostCall .box boxIdx [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub subIdx [0, 2] }, - { id := 4, ty := .intCarrier, kind := .selfCall false self [3] }, - { id := 5, ty := .i64, kind := .constI64 k }, - { id := 6, ty := .intCarrier, kind := .hostCall .box boxIdx [5] }, - { id := 7, ty := .intCarrier, - kind := .hostCall (combineHostRole combine) combineIdx [4, 6] }], 7⟩ - -theorem parseStep_eq (combine : RecCombine) (self boxIdx combineIdx subIdx : Nat) - (b : FragBlock) (st : RecStep) - (h : parseStepU combine self boxIdx combineIdx subIdx b = some st) : - b = stepBlockU combine self boxIdx combineIdx subIdx st := by - simp only [parseStepU] at h - split at h <;> try simp at h - all_goals - rcases h with ⟨hc, hst⟩ - subst st - cases b - simp_all [stepBlockU] - -theorem parseTop_lower (C : Nat) (combine : RecCombine) (self bI aI sI : Nat) - (b : FragBlock) (sh : RecShapeU) - (h : parseTopU combine self bI aI sI b = some sh) : - lowerBlock C b = some (recInstrsU C self bI aI sI sh) := by - simp only [parseTopU] at h - split at h - case h_2 => simp at h - case h_1 => - split at h - case h_2 => simp at h - case h_1 => - rename_i _ _ baseBlock stepBlock hnodes hresult _ _ bv st hbasep hstepp - injection h with hsh - subst sh - have hbase := parseBase_eq bI baseBlock bv hbasep - have hstep := parseStep_eq combine self bI aI sI stepBlock st hstepp - subst baseBlock - subst stepBlock - cases b - cases st <;> simp_all [lowerBlock, maxFuel, lowerBlockFuel, lowerNodesFuel, recInstrsU, - signSInstrs, signBInstrs, baseInstrs, stepInstrs, stepBlockU, combineHostRole, - popExpected, popExpectedAll, primInstr] - -/-- Plan-level corollary. -/ -theorem parse_lower (C : Nat) (combine : RecCombine) (self bI aI sI : Nat) - (plan : RecursionRawPlan) - (sh : RecShapeU) - (h : parseRecShapeU combine self bI aI sI plan = some sh) : - lowerBlock C plan.body = some (recInstrsU C self bI aI sI sh) := by - unfold parseRecShapeU at h - split at h - case isFalse => exact absurd h (by simp) - case isTrue => exact parseTop_lower C combine self bI aI sI plan.body sh h - - -/-! ### One partial-correctness theorem for the parsed recursion family -/ - -def stepLeft : RecStep → Int → Int → Int - | .inputSecond, n, _ => n - | .constSecond k, _, _ => k - | .inputFirst, _, r => r - | .constFirst _, _, r => r - -def stepRight : RecStep → Int → Int → Int - | .inputSecond, _, r => r - | .constSecond _, _, r => r - | .inputFirst, n, _ => n - | .constFirst k, _, _ => k - -def stepWArgs (C : Nat) (step : RecStep) (v vr : WVal) : List WVal := - match step with - | .inputSecond => [v, vr] - | .constSecond k => [carrierSmall C k, vr] - | .inputFirst => [vr, v] - | .constFirst k => [vr, carrierSmall C k] - -def stepLeftW (C : Nat) (step : RecStep) (v vr : WVal) : WVal := - match step with - | .inputSecond => v - | .constSecond k => carrierSmall C k - | .inputFirst | .constFirst _ => vr - -def stepRightW (C : Nat) (step : RecStep) (v vr : WVal) : WVal := - match step with - | .inputSecond | .constSecond _ => vr - | .inputFirst => v - | .constFirst k => carrierSmall C k - -theorem stepOperands_repr (C : Nat) (S : CarrierSpec C) - (step : RecStep) (n r : Int) (v vr : WVal) - (hv : S.Repr n v) (hvr : S.Repr r vr) : - S.Repr (stepLeft step n r) (stepLeftW C step v vr) ∧ - S.Repr (stepRight step n r) (stepRightW C step v vr) := by - cases step <;> - simp [stepLeft, stepRight, stepLeftW, stepRightW, hv, hvr, S.smallIntro] - -/-- Every parser-accepted unary recursion plan whose code entry is its audited - lowering simulates the plan-derived model. The four `RecStep` cases are - deliberately kept as four kernel-visible arms: only operand placement - differs, while the recursive call is discharged by the fuel IH in each. -/ -theorem recursion_generic_certified - (C : Nat) (combineOp : RecCombine) - (self bI cI sI nlocals : Nat) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (combine sub : List WVal → Option WVal) - (hBox : host bI = some (1, boxRef C)) - (hCombineHost : host cI = some (2, combine)) - (hSubHost : host sI = some (2, sub)) - (hSelfHost : host self = none) - (hCombine : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - combine [va, vb] = some w → S.Repr (combineEval combineOp a b) w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (plan : RecursionRawPlan) (sh : RecShapeU) - (hparse : parseRecShapeU combineOp self bI cI sI plan = some sh) - (instrs : List WInstr) - (hlow : lowerBlock C plan.body = some instrs) - (hself : code self = some ⟨1, nlocals, instrs⟩) : - ∀ (fuel : Nat) (n : Int) (v w : WVal), S.Repr n v → - wFuncN code host fuel self [v] = some w → - S.Repr (evalRecU combineOp sh n) w := by - have hcanon := parse_lower C combineOp self bI cI sI plan sh hparse - rw [hlow] at hcanon - injection hcanon with hinstrs - subst instrs - cases sh with - | mk base step => - generalize hstep : step = st - cases st <;> - intro fuel <;> - induction fuel with - | zero => - intro n v w hv hrun - simp [wFuncN] at hrun - | succ fuel ih => - intro n v w hv hrun - rcases S.car n v hv with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ - · have hs := S.smallElim n s sg hv - subst hs - by_cases hle : s ≤ (0 : Int) - · simp [wFuncN, wRunF, hself, hBox, hstep, - recInstrsU, signSInstrs, signBInstrs, baseInstrs, stepInstrs, - boxRef, b32, popArgs, initLocals, hle] at hrun - rw [evalRecU_base combineOp _ s hle, ← hrun] - exact S.smallIntro base - · simp [wFuncN, wRunF, hself, hBox, hCombineHost, hSubHost, hSelfHost, hstep, - recInstrsU, signSInstrs, signBInstrs, baseInstrs, stepInstrs, - boxRef, b32, popArgs, initLocals, hle] at hrun - rcases hsub : sub - [.structv C [.i64v s, .null, .i32v sg], carrierSmall C 1] with _ | vd - · simp [hsub] at hrun - · simp only [hsub] at hrun - have hrd : S.Repr (s - 1) vd := - hSub s 1 _ _ vd hv (S.smallIntro 1) hsub - rcases hrec : wFuncN code host fuel self [vd] with _ | vr - · simp [hrec] at hrun - · simp only [hrec] at hrun - have hrr := ih (s - 1) vd vr hrd hrec - rcases hadd : combine (stepWArgs C step - (.structv C [.i64v s, .null, .i32v sg]) vr) with _ | wa - · have hadd' := hadd - simp [hstep, stepWArgs] at hadd' - simp [hadd'] at hrun - · have hadd' := hadd - simp [hstep, stepWArgs] at hadd' - simp only [hadd', Option.some.injEq] at hrun - obtain ⟨hl, hr⟩ := stepOperands_repr C S step - s (evalRecU combineOp ⟨base, step⟩ (s - 1)) _ _ hv - (by simpa [hstep] using hrr) - have haddArgs : combine - [stepLeftW C step (.structv C [.i64v s, .null, .i32v sg]) vr, - stepRightW C step (.structv C [.i64v s, .null, .i32v sg]) vr] = - some wa := by - simpa [hstep, stepWArgs, stepLeftW, stepRightW] using hadd - have hout := hCombine _ _ _ _ wa hl hr haddArgs - rw [evalRecU_step combineOp _ s hle, ← hrun] - simpa [hstep, stepEval, stepLeft, stepRight, combineEval] using hout - · obtain ⟨hsign, hne⟩ := S.bigElim n s lty les sg hv - by_cases hlt : sg < (0 : Int) - · have hn0 : n ≤ 0 := by have := hsign.mp hlt; omega - simp [wFuncN, wRunF, hself, hBox, hstep, - recInstrsU, signSInstrs, signBInstrs, baseInstrs, stepInstrs, - boxRef, b32, popArgs, initLocals, hlt] at hrun - rw [evalRecU_base combineOp _ n hn0, ← hrun] - exact S.smallIntro base - · have hn0 : ¬ n ≤ 0 := by - intro hle - have : ¬ n < 0 := fun h => hlt (hsign.mpr h) - omega - simp [wFuncN, wRunF, hself, hBox, hCombineHost, hSubHost, hSelfHost, hstep, - recInstrsU, signSInstrs, signBInstrs, baseInstrs, stepInstrs, - boxRef, b32, popArgs, initLocals, hlt] at hrun - rcases hsub : sub - [.structv C [.i64v s, .arr lty les, .i32v sg], carrierSmall C 1] with _ | vd - · simp [hsub] at hrun - · simp only [hsub] at hrun - have hrd : S.Repr (n - 1) vd := - hSub n 1 _ _ vd hv (S.smallIntro 1) hsub - rcases hrec : wFuncN code host fuel self [vd] with _ | vr - · simp [hrec] at hrun - · simp only [hrec] at hrun - have hrr := ih (n - 1) vd vr hrd hrec - rcases hadd : combine (stepWArgs C step - (.structv C [.i64v s, .arr lty les, .i32v sg]) vr) with _ | wa - · have hadd' := hadd - simp [hstep, stepWArgs] at hadd' - simp [hadd'] at hrun - · have hadd' := hadd - simp [hstep, stepWArgs] at hadd' - simp only [hadd', Option.some.injEq] at hrun - obtain ⟨hl, hr⟩ := stepOperands_repr C S step - n (evalRecU combineOp ⟨base, step⟩ (n - 1)) _ _ hv - (by simpa [hstep] using hrr) - have haddArgs : combine - [stepLeftW C step (.structv C [.i64v s, .arr lty les, .i32v sg]) vr, - stepRightW C step (.structv C [.i64v s, .arr lty les, .i32v sg]) vr] = - some wa := by - simpa [hstep, stepWArgs, stepLeftW, stepRightW] using hadd - have hout := hCombine _ _ _ _ wa hl hr haddArgs - rw [evalRecU_step combineOp _ n hn0, ← hrun] - simpa [hstep, stepEval, stepLeft, stepRight, combineEval] using hout - - -/-! ### Bounded-total correctness for the parsed descent-by-one family -/ - -/-- Fuel-parametric progress for every parser-accepted unary descent-by-one - plan. Unlike partial correctness, progress needs totality of both host - operations: subtraction constructs the represented recursive argument and - addition constructs the represented result after the recursive call. -/ -theorem recursion_generic_certified_total_aux - (C : Nat) (combineOp : RecCombine) - (self bI cI sI nlocals : Nat) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (combine sub : List WVal → Option WVal) - (hBox : host bI = some (1, boxRef C)) - (hCombineHost : host cI = some (2, combine)) - (hSubHost : host sI = some (2, sub)) - (hSelfHost : host self = none) - (hCombine : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - combine [va, vb] = some w → S.Repr (combineEval combineOp a b) w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (hCombineTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, combine [va, vb] = some w) - (hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, sub [va, vb] = some w) - (plan : RecursionRawPlan) (sh : RecShapeU) - (hparse : parseRecShapeU combineOp self bI cI sI plan = some sh) - (instrs : List WInstr) - (hlow : lowerBlock C plan.body = some instrs) - (hself : code self = some ⟨1, nlocals, instrs⟩) : - ∀ (fuel : Nat) (n : Int) (v : WVal), S.Repr n v → n.natAbs < fuel → - ∃ w, wFuncN code host fuel self [v] = some w ∧ - S.Repr (evalRecU combineOp sh n) w := by - have hcanon := parse_lower C combineOp self bI cI sI plan sh hparse - rw [hlow] at hcanon - injection hcanon with hinstrs - subst instrs - cases sh with - | mk base step => - generalize hstep : step = st - cases st <;> - intro fuel <;> - induction fuel with - | zero => - intro n v hv hlt - omega - | succ fuel ih => - intro n v hv hlt - rcases S.car n v hv with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ - · have hs := S.smallElim n s sg hv - subst hs - by_cases hle : s ≤ (0 : Int) - · refine ⟨carrierSmall C base, ?_, ?_⟩ - · simp [wFuncN, wRunF, hself, hBox, hstep, - recInstrsU, signSInstrs, signBInstrs, baseInstrs, stepInstrs, - boxRef, b32, popArgs, initLocals, hle] - · rw [evalRecU_base combineOp _ s hle] - exact S.smallIntro base - · obtain ⟨vd, hsub⟩ := hSubTot s 1 _ (carrierSmall C 1) - hv (S.smallIntro 1) - have hrd : S.Repr (s - 1) vd := - hSub s 1 _ _ vd hv (S.smallIntro 1) hsub - obtain ⟨vr, hrec, hrr⟩ := ih (s - 1) vd hrd (by omega) - obtain ⟨hl, hr⟩ := stepOperands_repr C S step - s (evalRecU combineOp ⟨base, step⟩ (s - 1)) _ _ hv - (by simpa [hstep] using hrr) - obtain ⟨wa, hadd⟩ := hCombineTot _ _ _ _ hl hr - refine ⟨wa, ?_, ?_⟩ - · have hadd' := hadd - simp [hstep, stepLeftW, stepRightW] at hadd' - simp [wFuncN, wRunF, hself, hBox, hCombineHost, hSubHost, hSelfHost, - hstep, recInstrsU, signSInstrs, signBInstrs, baseInstrs, - stepInstrs, boxRef, b32, popArgs, initLocals, hle, hsub, hrec, - hadd'] - · have hout := hCombine _ _ _ _ wa hl hr hadd - rw [evalRecU_step combineOp _ s hle] - simpa [hstep, stepEval, stepLeft, stepRight, combineEval] using hout - · obtain ⟨hsign, hne⟩ := S.bigElim n s lty les sg hv - by_cases hlt : sg < (0 : Int) - · have hn0 : n ≤ 0 := by - have := hsign.mp hlt - omega - refine ⟨carrierSmall C base, ?_, ?_⟩ - · simp [wFuncN, wRunF, hself, hBox, hstep, - recInstrsU, signSInstrs, signBInstrs, baseInstrs, stepInstrs, - boxRef, b32, popArgs, initLocals, hlt] - · rw [evalRecU_base combineOp _ n hn0] - exact S.smallIntro base - · have hn0 : ¬ n ≤ 0 := by - intro hle - have : ¬ n < 0 := fun h => hlt (hsign.mpr h) - omega - obtain ⟨vd, hsub⟩ := hSubTot n 1 _ (carrierSmall C 1) - hv (S.smallIntro 1) - have hrd : S.Repr (n - 1) vd := - hSub n 1 _ _ vd hv (S.smallIntro 1) hsub - obtain ⟨vr, hrec, hrr⟩ := ih (n - 1) vd hrd (by omega) - obtain ⟨hl, hr⟩ := stepOperands_repr C S step - n (evalRecU combineOp ⟨base, step⟩ (n - 1)) _ _ hv - (by simpa [hstep] using hrr) - obtain ⟨wa, hadd⟩ := hCombineTot _ _ _ _ hl hr - refine ⟨wa, ?_, ?_⟩ - · have hadd' := hadd - simp [hstep, stepLeftW, stepRightW] at hadd' - simp [wFuncN, wRunF, hself, hBox, hCombineHost, hSubHost, hSelfHost, - hstep, recInstrsU, signSInstrs, signBInstrs, baseInstrs, - stepInstrs, boxRef, b32, popArgs, initLocals, hlt, hsub, hrec, - hadd'] - · have hout := hCombine _ _ _ _ wa hl hr hadd - rw [evalRecU_step combineOp _ n hn0] - simpa [hstep, stepEval, stepLeft, stepRight, combineEval] using hout - - -/-- Bounded-total correctness at the standard fuel selected by the checked - `Int.natAbs` descent witness. -/ -theorem recursion_generic_certified_total - (C : Nat) (combineOp : RecCombine) - (self bI cI sI nlocals : Nat) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (combine sub : List WVal → Option WVal) - (hBox : host bI = some (1, boxRef C)) - (hCombineHost : host cI = some (2, combine)) - (hSubHost : host sI = some (2, sub)) - (hSelfHost : host self = none) - (hCombine : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - combine [va, vb] = some w → S.Repr (combineEval combineOp a b) w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (hCombineTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, combine [va, vb] = some w) - (hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, sub [va, vb] = some w) - (plan : RecursionRawPlan) (sh : RecShapeU) - (hparse : parseRecShapeU combineOp self bI cI sI plan = some sh) - (instrs : List WInstr) - (hlow : lowerBlock C plan.body = some instrs) - (hself : code self = some ⟨1, nlocals, instrs⟩) : - ∀ (n : Int) (v : WVal), S.Repr n v → - ∃ w, wFuncN code host (n.natAbs + 1) self [v] = some w ∧ - S.Repr (evalRecU combineOp sh n) w := - fun n v hv => - recursion_generic_certified_total_aux C combineOp self bI cI sI nlocals - S code host combine sub hBox hCombineHost hSubHost hSelfHost hCombine hSub - hCombineTot hSubTot plan sh hparse instrs hlow hself - (n.natAbs + 1) n v hv (by omega) - - -/-! ### Two-argument accumulator recursion -/ - -/-- The separately parsed arity-two family - `f n acc = if n ≤ 0 then acc else f (n-1) (acc+n)`. -/ -inductive RecShapeA where - | accumulator -deriving Repr, DecidableEq - -def parseBaseA (b : FragBlock) : Option Unit := - match b.nodes with - | [{ id := 0, ty := .intCarrier, kind := .local 1 }] => - if b.result = 0 then some () else none - | _ => none - -def parseStepA (self boxIdx addIdx subIdx : Nat) (b : FragBlock) : Option Unit := - match b.nodes with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 one }, - { id := 2, ty := .intCarrier, kind := .hostCall .box bi [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub si [0, 2] }, - { id := 4, ty := .intCarrier, kind := .local 1 }, - { id := 5, ty := .intCarrier, kind := .local 0 }, - { id := 6, ty := .intCarrier, kind := .hostCall .add ai [4, 5] }, - { id := 7, ty := .intCarrier, kind := .selfCall true sc [3, 6] }] => - if b.result = 7 ∧ one = 1 ∧ bi = boxIdx ∧ si = subIdx ∧ - ai = addIdx ∧ sc = self then some () else none - | _ => none - -def parseTopA (self boxIdx addIdx subIdx : Nat) - (b : FragBlock) : Option RecShapeA := - match b.nodes, b.result with - | [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .ref, kind := .structGet 1 0 }, - { id := 2, ty := .boolI32, kind := .refIsNull 1 }, - { id := 3, ty := .boolI32, kind := .ifElse 2 - ({ nodes := [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .structGet 0 0 }, - { id := 2, ty := .i64, kind := .constI64 (0 : Int) }, - { id := 3, ty := .boolI32, kind := .prim .i64LeS [1, 2] }], result := 3 } : FragBlock) - ({ nodes := [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .rawI32, kind := .structGet 2 0 }, - { id := 2, ty := .boolI32, kind := .constBool false }, - { id := 3, ty := .boolI32, kind := .prim .i32LtS [1, 2] }], result := 3 } : FragBlock) }, - { id := 4, ty := .intCarrier, kind := .ifElse 3 base step }], 4 => - match parseBaseA base, parseStepA self boxIdx addIdx subIdx step with - | some (), some () => some .accumulator - | _, _ => none - | _, _ => none - -def parseRecShapeA (self boxIdx addIdx subIdx : Nat) - (plan : RecursionRawPlan) : Option RecShapeA := - if plan.profile = "recursion-plan-v1" ∧ - plan.params = [FragTy.intCarrier, FragTy.intCarrier] ∧ - AverCert.PlanCheck.sameTy plan.result .intCarrier then - parseTopA self boxIdx addIdx subIdx plan.body - else none - -def evalRecAFuel : Nat → Int → Int → Int - | 0, _, _ => 0 - | fuel + 1, n, acc => - if n ≤ 0 then acc else evalRecAFuel fuel (n - 1) (acc + n) - -def evalRecA (n acc : Int) : Int := - evalRecAFuel (n.natAbs + 1) n acc - -theorem evalRecA_fuel_irrel : - ∀ (t k1 k2 : Nat) (n acc : Int), - n.natAbs < t → n.natAbs < k1 → n.natAbs < k2 → - evalRecAFuel k1 n acc = evalRecAFuel k2 n acc := by - intro t - induction t with - | zero => intro k1 k2 n acc ht _ _; omega - | succ t ih => - intro k1 k2 n acc ht h1 h2 - cases k1 with - | zero => omega - | succ m1 => - cases k2 with - | zero => omega - | succ m2 => - by_cases hn : n ≤ 0 - · simp [evalRecAFuel, hn] - · have hrec := ih m1 m2 (n - 1) (acc + n) (by omega) (by omega) (by omega) - simp only [evalRecAFuel] - rw [if_neg hn, if_neg hn, hrec] - -theorem evalRecA_fuel_stable (k : Nat) (n acc : Int) (h : n.natAbs < k) : - evalRecAFuel k n acc = evalRecA n acc := - evalRecA_fuel_irrel (n.natAbs + k + 1) k (n.natAbs + 1) n acc - (by omega) h (by omega) - -theorem evalRecA_step (n acc : Int) (hn : ¬ n ≤ 0) : - evalRecA n acc = evalRecA (n - 1) (acc + n) := by - have h0 : evalRecA n acc = evalRecAFuel (n.natAbs + 1) n acc := rfl - rw [h0] - simp only [evalRecAFuel] - rw [if_neg hn, evalRecA_fuel_stable n.natAbs (n - 1) (acc + n) (by omega)] - -theorem evalRecA_base (n acc : Int) (hn : n ≤ 0) : - evalRecA n acc = acc := by - have h0 : evalRecA n acc = evalRecAFuel (n.natAbs + 1) n acc := rfl - rw [h0] - simp [evalRecAFuel, hn] - -def baseInstrsA : List WInstr := [.localGet 1] - -def stepInstrsA (self bI aI sI : Nat) : List WInstr := - [.localGet 0, .i64Const 1, .call bI, .call sI, - .localGet 1, .localGet 0, .call aI, .returnCall self] - -def recInstrsA (C self bI aI sI : Nat) : List WInstr := - [.localGet 0, .structGet C 1, .refIsNull, - .ifElse (signSInstrs C) (signBInstrs C), - .ifElse baseInstrsA (stepInstrsA self bI aI sI)] - -theorem parseBaseA_eq (b : FragBlock) (h : parseBaseA b = some ()) : - b = ⟨[{ id := 0, ty := .intCarrier, kind := .local 1 }], 0⟩ := by - simp only [parseBaseA] at h - split at h - case h_2 => simp at h - case h_1 => - split at h - case isFalse => simp at h - case isTrue hr => - cases b - simp_all - -def stepBlockA (self boxIdx addIdx subIdx : Nat) : FragBlock := ⟨ - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .i64, kind := .constI64 1 }, - { id := 2, ty := .intCarrier, kind := .hostCall .box boxIdx [1] }, - { id := 3, ty := .intCarrier, kind := .hostCall .sub subIdx [0, 2] }, - { id := 4, ty := .intCarrier, kind := .local 1 }, - { id := 5, ty := .intCarrier, kind := .local 0 }, - { id := 6, ty := .intCarrier, kind := .hostCall .add addIdx [4, 5] }, - { id := 7, ty := .intCarrier, kind := .selfCall true self [3, 6] }], 7⟩ - -theorem parseStepA_eq (self boxIdx addIdx subIdx : Nat) (b : FragBlock) - (h : parseStepA self boxIdx addIdx subIdx b = some ()) : - b = stepBlockA self boxIdx addIdx subIdx := by - simp only [parseStepA] at h - split at h - case h_2 => simp at h - case h_1 => - split at h - case isFalse => simp at h - case isTrue hc => - cases b - simp_all [stepBlockA] - -theorem parseTopA_lower (C self bI aI sI : Nat) (b : FragBlock) - (sh : RecShapeA) (h : parseTopA self bI aI sI b = some sh) : - lowerBlock C b = some (recInstrsA C self bI aI sI) := by - simp only [parseTopA] at h - split at h - case h_2 => simp at h - case h_1 => - split at h - case h_2 => simp at h - case h_1 => - rename_i _ _ baseBlock stepBlock hnodes hresult _ _ hbase hstep - injection h with hsh - subst sh - have hbaseEq := parseBaseA_eq baseBlock hbase - have hstepEq := parseStepA_eq self bI aI sI stepBlock hstep - subst baseBlock - subst stepBlock - cases b - simp_all [lowerBlock, maxFuel, lowerBlockFuel, lowerNodesFuel, recInstrsA, - signSInstrs, signBInstrs, baseInstrsA, stepInstrsA, stepBlockA, - popExpected, popExpectedAll, primInstr] - -theorem parseA_lower (C self bI aI sI : Nat) (plan : RecursionRawPlan) - (sh : RecShapeA) (h : parseRecShapeA self bI aI sI plan = some sh) : - lowerBlock C plan.body = some (recInstrsA C self bI aI sI) := by - unfold parseRecShapeA at h - split at h - case isFalse => exact absurd h (by simp) - case isTrue => exact parseTopA_lower C self bI aI sI plan.body sh h - - -/-- Partial correctness for the parser-accepted two-argument accumulator - family. The fuel induction is quantified over both the counter and the - threaded accumulator; the recursive IH is instantiated at - `(n - 1, acc + n)`. -/ -theorem recursion_accumulator_generic_certified - (C self bI aI sI nlocals : Nat) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (add sub : List WVal → Option WVal) - (hBox : host bI = some (1, boxRef C)) - (hAddHost : host aI = some (2, add)) - (hSubHost : host sI = some (2, sub)) - (hSelfHost : host self = none) - (hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (plan : RecursionRawPlan) (sh : RecShapeA) - (hparse : parseRecShapeA self bI aI sI plan = some sh) - (instrs : List WInstr) - (hlow : lowerBlock C plan.body = some instrs) - (hself : code self = some ⟨2, nlocals, instrs⟩) : - ∀ (fuel : Nat) (n acc : Int) (vn vacc w : WVal), - S.Repr n vn → S.Repr acc vacc → - wFuncN code host fuel self [vn, vacc] = some w → - S.Repr (evalRecA n acc) w := by - have hcanon := parseA_lower C self bI aI sI plan sh hparse - rw [hlow] at hcanon - injection hcanon with hinstrs - subst instrs - cases sh - intro fuel - induction fuel with - | zero => - intro n acc vn vacc w hvn hvacc hrun - simp [wFuncN] at hrun - | succ fuel ih => - intro n acc vn vacc w hvn hvacc hrun - rcases S.car n vn hvn with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ - · have hs := S.smallElim n s sg hvn - subst hs - by_cases hle : s ≤ (0 : Int) - · simp [wFuncN, wRunF, hself, hBox, recInstrsA, signSInstrs, - signBInstrs, baseInstrsA, stepInstrsA, boxRef, b32, popArgs, - initLocals, hle] at hrun - rw [evalRecA_base s acc hle, ← hrun] - exact hvacc - · simp [wFuncN, wRunF, hself, hBox, hAddHost, hSubHost, hSelfHost, - recInstrsA, signSInstrs, signBInstrs, baseInstrsA, stepInstrsA, - boxRef, b32, popArgs, initLocals, hle] at hrun - rcases hsub : sub - [.structv C [.i64v s, .null, .i32v sg], carrierSmall C 1] with _ | vd - · simp [hsub] at hrun - · simp only [hsub] at hrun - have hrd : S.Repr (s - 1) vd := - hSub s 1 _ _ vd hvn (S.smallIntro 1) hsub - rcases hadd : add - [vacc, .structv C [.i64v s, .null, .i32v sg]] with _ | va - · simp [hadd] at hrun - · simp only [hadd] at hrun - have hra : S.Repr (acc + s) va := hAdd acc s _ _ va hvacc hvn hadd - rcases hrec : wFuncN code host fuel self [vd, va] with _ | vr - · simp [hrec] at hrun - · simp only [hrec, Option.some.injEq] at hrun - rw [evalRecA_step s acc hle, ← hrun] - exact ih (s - 1) (acc + s) vd va vr hrd hra hrec - · obtain ⟨hsign, hne⟩ := S.bigElim n s lty les sg hvn - by_cases hlt : sg < (0 : Int) - · have hn0 : n ≤ 0 := by have := hsign.mp hlt; omega - simp [wFuncN, wRunF, hself, hBox, recInstrsA, signSInstrs, - signBInstrs, baseInstrsA, stepInstrsA, boxRef, b32, popArgs, - initLocals, hlt] at hrun - rw [evalRecA_base n acc hn0, ← hrun] - exact hvacc - · have hn0 : ¬ n ≤ 0 := by - intro hle - have : ¬ n < 0 := fun h => hlt (hsign.mpr h) - omega - simp [wFuncN, wRunF, hself, hBox, hAddHost, hSubHost, hSelfHost, - recInstrsA, signSInstrs, signBInstrs, baseInstrsA, stepInstrsA, - boxRef, b32, popArgs, initLocals, hlt] at hrun - rcases hsub : sub - [.structv C [.i64v s, .arr lty les, .i32v sg], carrierSmall C 1] with _ | vd - · simp [hsub] at hrun - · simp only [hsub] at hrun - have hrd : S.Repr (n - 1) vd := - hSub n 1 _ _ vd hvn (S.smallIntro 1) hsub - rcases hadd : add - [vacc, .structv C [.i64v s, .arr lty les, .i32v sg]] with _ | va - · simp [hadd] at hrun - · simp only [hadd] at hrun - have hra : S.Repr (acc + n) va := hAdd acc n _ _ va hvacc hvn hadd - rcases hrec : wFuncN code host fuel self [vd, va] with _ | vr - · simp [hrec] at hrun - · simp only [hrec, Option.some.injEq] at hrun - rw [evalRecA_step n acc hn0, ← hrun] - exact ih (n - 1) (acc + n) vd va vr hrd hra hrec - - -theorem recursion_accumulator_generic_certified_total_aux - (C self bI aI sI nlocals : Nat) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (add sub : List WVal → Option WVal) - (hBox : host bI = some (1, boxRef C)) - (hAddHost : host aI = some (2, add)) - (hSubHost : host sI = some (2, sub)) - (hSelfHost : host self = none) - (hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (hAddTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, add [va, vb] = some w) - (hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, sub [va, vb] = some w) - (plan : RecursionRawPlan) (sh : RecShapeA) - (hparse : parseRecShapeA self bI aI sI plan = some sh) - (instrs : List WInstr) - (hlow : lowerBlock C plan.body = some instrs) - (hself : code self = some ⟨2, nlocals, instrs⟩) : - ∀ (fuel : Nat) (n acc : Int) (vn vacc : WVal), - S.Repr n vn → S.Repr acc vacc → n.natAbs < fuel → - ∃ w, wFuncN code host fuel self [vn, vacc] = some w ∧ - S.Repr (evalRecA n acc) w := by - have hcanon := parseA_lower C self bI aI sI plan sh hparse - rw [hlow] at hcanon - injection hcanon with hinstrs - subst instrs - cases sh - intro fuel - induction fuel with - | zero => - intro n acc vn vacc hvn hvacc hlt - omega - | succ fuel ih => - intro n acc vn vacc hvn hvacc hfuel - rcases S.car n vn hvn with ⟨s, sg, rfl⟩ | ⟨s, lty, les, sg, rfl⟩ - · have hs := S.smallElim n s sg hvn - subst hs - by_cases hle : s ≤ (0 : Int) - · refine ⟨vacc, ?_, ?_⟩ - · simp [wFuncN, wRunF, hself, recInstrsA, signSInstrs, - signBInstrs, baseInstrsA, stepInstrsA, b32, initLocals, hle] - · rw [evalRecA_base s acc hle] - exact hvacc - · obtain ⟨vd, hsub⟩ := hSubTot s 1 _ (carrierSmall C 1) - hvn (S.smallIntro 1) - have hrd : S.Repr (s - 1) vd := - hSub s 1 _ _ vd hvn (S.smallIntro 1) hsub - obtain ⟨va, hadd⟩ := hAddTot acc s _ _ hvacc hvn - have hra : S.Repr (acc + s) va := hAdd acc s _ _ va hvacc hvn hadd - obtain ⟨w, hrec, hrepr⟩ := ih (s - 1) (acc + s) vd va hrd hra (by omega) - refine ⟨w, ?_, ?_⟩ - · simp [wFuncN, wRunF, hself, hBox, hAddHost, hSubHost, hSelfHost, - recInstrsA, signSInstrs, signBInstrs, baseInstrsA, stepInstrsA, - boxRef, b32, popArgs, initLocals, hle, hsub, hadd, hrec] - · rw [evalRecA_step s acc hle] - exact hrepr - · obtain ⟨hsign, hne⟩ := S.bigElim n s lty les sg hvn - by_cases hlt : sg < (0 : Int) - · have hn0 : n ≤ 0 := by have := hsign.mp hlt; omega - refine ⟨vacc, ?_, ?_⟩ - · simp [wFuncN, wRunF, hself, recInstrsA, signSInstrs, - signBInstrs, baseInstrsA, stepInstrsA, b32, initLocals, hlt] - · rw [evalRecA_base n acc hn0] - exact hvacc - · have hn0 : ¬ n ≤ 0 := by - intro hle - have : ¬ n < 0 := fun h => hlt (hsign.mpr h) - omega - obtain ⟨vd, hsub⟩ := hSubTot n 1 _ (carrierSmall C 1) - hvn (S.smallIntro 1) - have hrd : S.Repr (n - 1) vd := - hSub n 1 _ _ vd hvn (S.smallIntro 1) hsub - obtain ⟨va, hadd⟩ := hAddTot acc n _ _ hvacc hvn - have hra : S.Repr (acc + n) va := hAdd acc n _ _ va hvacc hvn hadd - obtain ⟨w, hrec, hrepr⟩ := ih (n - 1) (acc + n) vd va hrd hra (by omega) - refine ⟨w, ?_, ?_⟩ - · simp [wFuncN, wRunF, hself, hBox, hAddHost, hSubHost, hSelfHost, - recInstrsA, signSInstrs, signBInstrs, baseInstrsA, stepInstrsA, - boxRef, b32, popArgs, initLocals, hlt, hsub, hadd, hrec] - · rw [evalRecA_step n acc hn0] - exact hrepr - - -theorem recursion_accumulator_generic_certified_total - (C self bI aI sI nlocals : Nat) - (S : CarrierSpec C) - (code : CodeTbl) (host : HostTbl) - (add sub : List WVal → Option WVal) - (hBox : host bI = some (1, boxRef C)) - (hAddHost : host aI = some (2, add)) - (hSubHost : host sI = some (2, sub)) - (hSelfHost : host self = none) - (hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - add [va, vb] = some w → S.Repr (a + b) w) - (hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → - sub [va, vb] = some w → S.Repr (a - b) w) - (hAddTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, add [va, vb] = some w) - (hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → - ∃ w, sub [va, vb] = some w) - (plan : RecursionRawPlan) (sh : RecShapeA) - (hparse : parseRecShapeA self bI aI sI plan = some sh) - (instrs : List WInstr) - (hlow : lowerBlock C plan.body = some instrs) - (hself : code self = some ⟨2, nlocals, instrs⟩) : - ∀ (n acc : Int) (vn vacc : WVal), S.Repr n vn → S.Repr acc vacc → - ∃ w, wFuncN code host (n.natAbs + 1) self [vn, vacc] = some w ∧ - S.Repr (evalRecA n acc) w := - fun n acc vn vacc hvn hvacc => - recursion_accumulator_generic_certified_total_aux - C self bI aI sI nlocals S code host add sub hBox hAddHost hSubHost hSelfHost hAdd hSub - hAddTot hSubTot plan sh hparse instrs hlow hself - (n.natAbs + 1) n acc vn vacc hvn hvacc (by omega) - - -/- The fixture-specific section is retained as spike documentation but is not - part of the reusable generic module. -/ -end RecursionSoundness diff --git a/aver-cert/assets/wall/current/Schema.lean b/aver-cert/assets/wall/current/Schema.lean index f5ffb42dd..b0688111b 100644 --- a/aver-cert/assets/wall/current/Schema.lean +++ b/aver-cert/assets/wall/current/Schema.lean @@ -3,20 +3,21 @@ -- The single final certificate theorem is -- `AverCert.Final.cert : AverCert.Schema.Holds manifest`. -- The dependency-closed schema lives in `SchemaCore.lean`; this shim adds the --- one conjunct that binds it to the artifact-specific `Module.lean` data. +-- one conjunct that binds it to the artifact-specific `Module.lean` data, +-- which the checker renders from the bytes it reads (never a package file). import Module import SchemaCore namespace AverCert.Schema /-- The single audited certificate proposition: the manifest's pinned hash is - the delivered artifact hash recorded by `Module.lean`, its + the delivered artifact hash recorded in the checker-rendered `Module.lean`, its target/profile/ABI tuple is one of this schema's admitted identities, and every certified export satisfies the partial or total model-simulation denotation selected by its policy. Target-specific byte-envelope checks live in `AcceptedArtifact.accepted`, where artifact bytes are available. -/ def Holds (m : Manifest) : Prop := - m.subject.artifactHash = CertModule.wasmSha256 ∧ + m.subject.artifactHash = _root_.CertModule.wasmSha256 ∧ m.subject.profile = expectedProfile ∧ artifactTargetAbiAccepted m.subject.target m.subject.abi = true ∧ HoldsCore m diff --git a/aver-cert/assets/wall/current/SchemaBase.lean b/aver-cert/assets/wall/current/SchemaBase.lean new file mode 100644 index 000000000..4d1372d30 --- /dev/null +++ b/aver-cert/assets/wall/current/SchemaBase.lean @@ -0,0 +1,422 @@ +-- AverCert statement base (audited, fixed). +-- +-- The artifact-independent vocabulary the statement schema is written in: +-- the capability registries, the admitted target identities, the subject, +-- the policy axes, the Int carrier specification and the named contracts of +-- the Int helpers. `Grammar` builds the plan grammar on top of this file, and +-- `SchemaCore` states the obligation over that grammar. +import CertPrelude +import CertDecode +import ArithTemplateDerisk + +namespace AverCert.Schema +open CertPrelude +open CertPrelude + +/-- The finite wasm-gc host-capability registry, minted from its exhaustive + `EffectName.import_pair` mapping and the four `aver:work/v1` job-scheduling + imports a module with job kinds carries (`work_abi.rs`). Artifact + manifests may declare only pairs in this kernel-owned list; the Wasm import + section is independently enumerated and must match the declaration + exactly. An import is accounted, never claimed: the closure of every + certified export must reach no import at all (`closureIsolation`). -/ +def WASM_GC_CAPABILITY_REGISTRY : List (String × String) := [ + ("aver", "console_print"), + ("aver", "console_error"), + ("aver", "console_warn"), + ("aver", "time_unix_ms"), + ("aver", "process_stop_requested"), + ("aver", "provider_contract_violation"), + ("aver", "request_method"), + ("aver", "request_url"), + ("aver", "request_query"), + ("aver", "request_body"), + ("aver", "request_headers_load"), + ("aver", "response_text"), + ("aver", "response_set_header"), + ("aver", "http_send"), + ("aver", "http_add_request_header"), + ("aver", "http_clear_request_headers"), + ("aver", "env_get"), + ("aver", "env_set"), + ("aver", "console_read_line"), + ("aver", "args_len"), + ("aver", "args_get"), + ("aver", "random_float"), + ("aver", "random_int"), + ("aver", "time_sleep"), + ("aver", "time_now"), + ("aver", "float_sin"), + ("aver", "float_cos"), + ("aver", "float_atan2"), + ("aver", "float_pow"), + ("aver", "terminal_enable_raw_mode"), + ("aver", "terminal_disable_raw_mode"), + ("aver", "terminal_clear"), + ("aver", "terminal_move_to"), + ("aver", "terminal_print"), + ("aver", "terminal_set_color"), + ("aver", "terminal_reset_color"), + ("aver", "terminal_read_key"), + ("aver", "terminal_size"), + ("aver", "terminal_hide_cursor"), + ("aver", "terminal_show_cursor"), + ("aver", "terminal_flush"), + ("aver", "disk_read_text"), + ("aver", "disk_write_text"), + ("aver", "disk_append_text"), + ("aver", "disk_read_bytes"), + ("aver", "disk_read_bytes_at"), + ("aver", "disk_write_bytes"), + ("aver", "disk_append_bytes"), + ("aver", "disk_size"), + ("aver", "disk_exists"), + ("aver", "disk_delete"), + ("aver", "disk_delete_dir"), + ("aver", "disk_list_dir"), + ("aver", "disk_make_dir"), + ("aver", "disk_sync"), + ("aver", "tcp_connect"), + ("aver", "tcp_begin_connect"), + ("aver", "tcp_dialled"), + ("aver", "tcp_listen"), + ("aver", "tcp_accept"), + ("aver", "tcp_peer_address"), + ("aver", "tcp_write_line"), + ("aver", "tcp_write_bytes"), + ("aver", "tcp_write_now"), + ("aver", "tcp_read_line"), + ("aver", "tcp_read_bytes"), + ("aver", "tcp_read_some"), + ("aver", "tcp_read_now"), + ("aver", "tcp_poll"), + ("aver", "tcp_close"), + ("aver", "tcp_close_dial"), + ("aver", "tcp_close_listener"), + ("aver", "tcp_send"), + ("aver", "tcp_send_bytes"), + ("aver", "tcp_ping"), + ("aver", "http_get"), + ("aver", "http_head"), + ("aver", "http_delete"), + ("aver", "http_post"), + ("aver", "http_put"), + ("aver", "http_patch"), + ("aver", "record_enter_group"), + ("aver", "record_set_branch"), + ("aver", "record_exit_group"), + ("aver", "wait_poll"), + ("aver", "work_cancel"), + ("aver", "work_begin"), + ("aver", "work_take"), + ("aver:work/v1", "submit"), + ("aver:work/v1", "take"), + ("aver:work/v1", "task"), + ("aver:work/v1", "complete") +] + +/-- Exact standard canonical-ABI import surface emitted into wasip2 core + modules. Interface versions and operation names are part of the boundary; + there is deliberately no wildcard for the `wasi:` namespace. -/ +def WASIP2_CAPABILITY_REGISTRY : List (String × String) := [ + ("wasi:cli/stdout@0.2.4", "get-stdout"), + ("wasi:cli/stderr@0.2.4", "get-stderr"), + ("wasi:io/streams@0.2.4", "[method]output-stream.blocking-write-and-flush"), + ("wasi:clocks/wall-clock@0.2.4", "now"), + ("wasi:random/random@0.2.4", "get-random-u64"), + ("wasi:cli/environment@0.2.4", "get-arguments"), + ("wasi:cli/environment@0.2.4", "get-environment"), + ("wasi:cli/stdin@0.2.4", "get-stdin"), + ("wasi:io/streams@0.2.4", "[method]input-stream.blocking-read"), + ("wasi:io/streams@0.2.4", "[method]input-stream.subscribe"), + ("wasi:io/streams@0.2.4", "[method]input-stream.read"), + ("wasi:io/streams@0.2.4", "[method]output-stream.check-write"), + ("wasi:io/streams@0.2.4", "[method]output-stream.write"), + ("wasi:io/streams@0.2.4", "[method]output-stream.flush"), + ("wasi:io/streams@0.2.4", "[method]output-stream.subscribe"), + ("wasi:clocks/monotonic-clock@0.2.4", "subscribe-duration"), + ("wasi:io/poll@0.2.4", "poll"), + ("wasi:io/poll@0.2.4", "[resource-drop]pollable"), + ("wasi:filesystem/preopens@0.2.4", "get-directories"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.stat-at"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.open-at"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.read-via-stream"), + ("wasi:filesystem/types@0.2.4", "[resource-drop]descriptor"), + ("wasi:io/streams@0.2.4", "[resource-drop]input-stream"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.write-via-stream"), + ("wasi:io/streams@0.2.4", "[resource-drop]output-stream"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.unlink-file-at"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.remove-directory-at"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.create-directory-at"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.sync"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.append-via-stream"), + ("wasi:filesystem/types@0.2.4", "[method]descriptor.read-directory"), + ("wasi:filesystem/types@0.2.4", "[method]directory-entry-stream.read-directory-entry"), + ("wasi:filesystem/types@0.2.4", "[resource-drop]directory-entry-stream"), + ("wasi:http/types@0.2.4", "[constructor]fields"), + ("wasi:http/types@0.2.4", "[constructor]outgoing-request"), + ("wasi:http/types@0.2.4", "[method]outgoing-request.set-scheme"), + ("wasi:http/types@0.2.4", "[method]outgoing-request.set-authority"), + ("wasi:http/types@0.2.4", "[method]outgoing-request.set-path-with-query"), + ("wasi:http/outgoing-handler@0.2.4", "handle"), + ("wasi:http/types@0.2.4", "[method]future-incoming-response.subscribe"), + ("wasi:http/types@0.2.4", "[method]future-incoming-response.get"), + ("wasi:http/types@0.2.4", "[method]incoming-response.status"), + ("wasi:http/types@0.2.4", "[method]incoming-response.consume"), + ("wasi:http/types@0.2.4", "[method]incoming-body.stream"), + ("wasi:http/types@0.2.4", "[static]incoming-body.finish"), + ("wasi:http/types@0.2.4", "[resource-drop]outgoing-request"), + ("wasi:http/types@0.2.4", "[resource-drop]future-incoming-response"), + ("wasi:http/types@0.2.4", "[resource-drop]incoming-response"), + ("wasi:http/types@0.2.4", "[resource-drop]future-trailers"), + ("wasi:http/types@0.2.4", "[resource-drop]incoming-body"), + ("wasi:http/types@0.2.4", "[method]incoming-response.headers"), + ("wasi:http/types@0.2.4", "[method]fields.entries"), + ("wasi:http/types@0.2.4", "[resource-drop]fields"), + ("wasi:http/types@0.2.4", "[method]outgoing-request.set-method"), + ("wasi:http/types@0.2.4", "[method]outgoing-request.body"), + ("wasi:http/types@0.2.4", "[method]outgoing-body.write"), + ("wasi:http/types@0.2.4", "[static]outgoing-body.finish"), + ("wasi:http/types@0.2.4", "[method]fields.append"), + ("wasi:http/types@0.2.4", "[resource-drop]outgoing-body"), + ("wasi:http/types@0.2.4", "[method]incoming-request.method"), + ("wasi:http/types@0.2.4", "[method]incoming-request.path-with-query"), + ("wasi:http/types@0.2.4", "[method]incoming-request.headers"), + ("wasi:http/types@0.2.4", "[method]incoming-request.consume"), + ("wasi:http/types@0.2.4", "[resource-drop]incoming-request"), + ("wasi:http/types@0.2.4", "[constructor]outgoing-response"), + ("wasi:http/types@0.2.4", "[method]outgoing-response.set-status-code"), + ("wasi:http/types@0.2.4", "[method]outgoing-response.body"), + ("wasi:http/types@0.2.4", "[static]response-outparam.set"), + ("wasi:sockets/instance-network@0.2.4", "instance-network"), + ("wasi:sockets/ip-name-lookup@0.2.4", "resolve-addresses"), + ("wasi:sockets/ip-name-lookup@0.2.4", "[method]resolve-address-stream.resolve-next-address"), + ("wasi:sockets/ip-name-lookup@0.2.4", "[method]resolve-address-stream.subscribe"), + ("wasi:sockets/ip-name-lookup@0.2.4", "[resource-drop]resolve-address-stream"), + ("wasi:sockets/tcp-create-socket@0.2.4", "create-tcp-socket"), + ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.start-connect"), + ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.finish-connect"), + ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.subscribe"), + ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.shutdown"), + ("wasi:sockets/tcp@0.2.4", "[resource-drop]tcp-socket") +] + +/-- Backwards-compatible name for the original wasm-gc-only registry. -/ +def CAPABILITY_REGISTRY : List (String × String) := WASM_GC_CAPABILITY_REGISTRY + +/-- Core wasm-gc module artifacts use the raw module bytes as the certified artifact. -/ +def expectedWasmGcArtifactTarget : String := "wasm-gc" + +/-- WASI 0.2 Component Model artifacts use a declared component envelope. -/ +def expectedWasip2ArtifactTarget : String := "wasip2" + +/-- Select the finite standard host-import registry from the manifest target. + Unknown targets receive no standard imports and therefore fail closed. -/ +def capabilityRegistryForTarget (target : String) : List (String × String) := + if target == expectedWasmGcArtifactTarget then WASM_GC_CAPABILITY_REGISTRY + else if target == expectedWasip2ArtifactTarget then WASIP2_CAPABILITY_REGISTRY + else [] + +theorem wasiStdoutIsWasip2Only : + (capabilityRegistryForTarget expectedWasip2ArtifactTarget).contains + ("wasi:cli/stdout@0.2.4", "get-stdout") = true ∧ + (capabilityRegistryForTarget expectedWasmGcArtifactTarget).contains + ("wasi:cli/stdout@0.2.4", "get-stdout") = false ∧ + (capabilityRegistryForTarget expectedWasip2ArtifactTarget).contains + ("wasi:cli/stdout@0.2.5", "get-stdout") = false := by + decide + +theorem workV1IsWasmGcOnly : + (capabilityRegistryForTarget expectedWasmGcArtifactTarget).contains + ("aver:work/v1", "submit") = true ∧ + (capabilityRegistryForTarget expectedWasip2ArtifactTarget).contains + ("aver:work/v1", "submit") = false ∧ + (capabilityRegistryForTarget expectedWasmGcArtifactTarget).contains + ("aver:work/v2", "submit") = false := by + decide + +/-- Backwards-compatible alias for the historical wasm-gc-only target constant. -/ +def expectedArtifactTarget : String := expectedWasmGcArtifactTarget + +/-- The only emitted-fragment profile this schema currently admits. -/ +def expectedProfile : String := "AverUserProfile/v1" + +/-- Runtime ABI admitted for raw wasm-gc module artifacts. -/ +def expectedRuntimeAbiWasmGc : String := "aver-wasm-gc/0" + +/-- Runtime ABI admitted for WASI 0.2 Component Model artifacts. -/ +def expectedRuntimeAbiWasip2 : String := "aver-wasip2/0" + +/-- Backwards-compatible alias for the historical wasm-gc-only ABI constant. -/ +def expectedRuntimeAbi : String := expectedRuntimeAbiWasmGc + +/-- Target/ABI pairs admitted by this schema. The byte-level envelope check + lives at artifact acceptance time, where both the delivered target bytes and + the embedded core-module bytes are available. -/ +def artifactTargetAbiAccepted (target abi : String) : Bool := + (target == expectedWasmGcArtifactTarget && abi == expectedRuntimeAbiWasmGc) || + (target == expectedWasip2ArtifactTarget && abi == expectedRuntimeAbiWasip2) + +/-- Full statement identity helper used by tests and documentation. -/ +def artifactIdentityAccepted (target profile abi : String) : Bool := + profile == expectedProfile && artifactTargetAbiAccepted target abi + +/-- What the artifact is: its pinned hash, explicit artifact target, + emitted-fragment profile, runtime ABI, artifact theorem root, the certified + and explicitly uncertified export names, the exact effect-import capability + surface, byte-derived start status, and the runtime contracts every + certificate is conditional on. Pure data, mirrored in `cert-manifest.json`. + + `hostRoleTable` is optional exactly like `start`: a module without the Int + carrier helper has no host-role table at all (`none`), which the acceptance + pin binds against the strict byte decoder returning `some none` — a + byte-derived proof that the `__rt_aint_from_i64` helper export is absent. + A module with the helper always carries `some` table, even when every role + inside it is unbound; a module whose role scan fails decodes to the + poisoned `none`, which no manifest value can match. + + `arithParams` declares the indices the canonical arith helper bodies are a + function of (Int carrier struct, limb array, and the decompose/normalize/ + strip/umagCmp bignum sub-routine functions); it is `some` exactly when + `hostRoleTable` is. The acceptance pin synthesizes each declared add/sub/mul + helper body from these and confirms it byte-for-byte in the real module, so + a wrong declaration fails the pin rather than riding a byte fingerprint. -/ +structure Subject where + artifactHash : String + target : String + profile : String + abi : String + artifactRoot : String + exports : List String + declaredUncertified : List (String × String) + capabilities : List (String × String) + start : Option Nat + hostRoleTable : Option _root_.CertDecode.AddSub.Roles + arithParams : Option _root_.ArithTemplateDerisk.ArithHostParams + stringHostRoles : List (Nat × _root_.CertDecode.StringHost.Role) + contracts : List String + +/-- Claim-matching view of the optional module host-role table. An absent + table binds no host roles, so any claim citing a box/add/mul/sub role + fails to match — strictly fail-closed, never a default index. -/ +def Subject.hostRoles (s : Subject) : _root_.CertDecode.AddSub.Roles := + match s.hostRoleTable with + | some roles => roles + | none => { box := none, add := none, mul := none, sub := none, + toIndex := none, cmp := none, eq := none, divmod := none } + +/-- The certification policy attached to a certified export. Partial simulation + remains the default; the total preset additionally promises return at the + fuel selected by the checked termination witness. -/ +inductive Policy where + | simulatesModel + | simulatesModelTotally +deriving Repr, DecidableEq + +/-- Extra totality premise selected for one total obligation. The default + preserves the shipped L3 contract: add/sub are total, while the partial mul + law remains available but mul need not return. The `.mul` role is derived + when a member of the checked call group multiplies + (`GrammarTotal.groupRole`). -/ +inductive TotalityRole where + | addSub + | mul +deriving Repr, DecidableEq + +/-- Closed measure vocabulary of the total-correctness policy. The wall + derives the one canonical witness from the plans + (`GrammarTotal.canonicalWitness`, when `checkTermGroup` accepts the call + group); it is never a manifest choice. -/ +inductive Measure where + | intNatAbs (paramIdx : Nat) +deriving Repr, DecidableEq + +/-- Termination evidence reported with an L3 obligation: the measure and the + descent the wall's termination check established over the plan. -/ +structure TerminationWitness where + measure : Measure + descent : Int +deriving Repr, DecidableEq + +/-- The representation-relation faces a simulation certificate is stated over + (the Int carrier `{i64 small, ref limbs, i32 sign}`). Bundled in the audited + schema so `Obligation.holds` is self-contained. + + `Canon` is the runtime's NORMAL FORM on carrier words: a value is `Small` + (`limbs = null`) exactly when it fits the i64 band `[-2^63, 2^63)`, and + `Big` otherwise, with tight limbs and a non-zero sign. Every carrier the + emitted runtime builds is in that form, by TWO mechanisms and not one: + + * the i64 fast paths build a `Small` DIRECTLY with `struct.new` — the box + helper `wat/from_i64.wat` is nothing else, and so are the both-`Small` + non-overflow arms of `wat/addsub.wat` and `wat/mul.wat`. Those words are + normal because the value provably fits the band, not because anything + normalised them; + * every path that can produce a limb-carrying result ends in the + normalisation epilogue (`wat/normalize.wat`, called as `__aint_normalize` + or inlined), which strips leading limbs and demotes an in-band magnitude + back to `Small`. + + `Canon` names that state abstractly and the two axioms below say only what + the helpers need: + + * `canonSmall` — a literal small carrier is canonical EXACTLY on the i64 + band. The forward direction is what the boxing helper's output needs; + the backward one says an out-of-band `Small` is not in normal form, which + is what separates the two shapes; + * `canonBig` — a canonical carrier that CARRIES LIMBS represents a value + outside the i64 band and has a non-zero sign. + + Nothing else about `Canon` is assumed, and the two axioms are exactly what + the proofs consume — no more. In particular they do NOT establish that the + real `wat/eq.wat` and `wat/cmp.wat` are exact on a canonical pair: that is + an assumption, carried as an explicit hypothesis of `Obligation.holds` and + validated empirically against the running helpers by + `tests/cert_intcmp_differential.rs`. `Obligation.holds` quantifies over + every `CarrierSpec`, and a specification whose `Canon` marks words the + runtime would never build is admitted by this schema; the instance a + verdict is read at is the runtime's own, where `Canon` is the normal form + described above. -/ +structure CarrierSpec (C : Nat) where + Repr : Int → WVal → Prop + Canon : WVal → Prop + car : ∀ n v, Repr n v → + (∃ s sg, v = .structv C [.i64v s, .null, .i32v sg]) ∨ + (∃ s lty les sg, v = .structv C [.i64v s, .arr lty les, .i32v sg]) + smallIntro : ∀ k : Int, Repr k (carrierSmall C k) + smallElim : ∀ n s sg, Repr n (.structv C [.i64v s, .null, .i32v sg]) → s = n + bigElim : ∀ n s lty les sg, + Repr n (.structv C [.i64v s, .arr lty les, .i32v sg]) → ((sg < 0) ↔ (n < 0)) ∧ n ≠ 0 + canonSmall : ∀ k : Int, + Canon (carrierSmall C k) ↔ (-(2 ^ 63 : Int) ≤ k ∧ k < 2 ^ 63) + canonBig : ∀ n s lty les sg, + Repr n (.structv C [.i64v s, .arr lty les, .i32v sg]) → + Canon (.structv C [.i64v s, .arr lty les, .i32v sg]) → + ¬(-(2 ^ 63 : Int) ≤ n ∧ n < 2 ^ 63) ∧ sg ≠ 0 + +/-- A represented Int whose carrier word is in the runtime's normal form. -/ +def CanonRepr {C : Nat} (S : CarrierSpec C) (n : Int) (w : WVal) : Prop := + S.Repr n w ∧ S.Canon w + +/-- The named Int helper contracts at their function values, as the grammar's + simulation theorem consumes them. `box` is the boxing helper's meaning (its + body is byte-pinned to the wall's template, and the obligation wires the + wall's own `boxRef`), stated for an i64-band literal because that is the + only literal the emitter boxes. The arithmetic helpers conclude canonical + results; the comparison helpers are exact on a canonical pair. -/ +structure Contracts {C : Nat} (S : CarrierSpec C) + (box add sub mul cmp eq : List WVal → Option WVal) : Prop where + hBox : ∀ n w, -(2 ^ 63 : Int) ≤ n → n < 2 ^ 63 → box [.i64v n] = some w → + CanonRepr S n w + hAdd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → + add [va, vb] = some w → CanonRepr S (a + b) w + hSub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → + sub [va, vb] = some w → CanonRepr S (a - b) w + hMul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → + mul [va, vb] = some w → CanonRepr S (a * b) w + hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → + cmp [va, vb] = some r → r = .i32v (cmpW a b) + hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → + eq [va, vb] = some r → r = .i32v (eqW a b) + +end AverCert.Schema diff --git a/aver-cert/assets/wall/current/SchemaCore.lean b/aver-cert/assets/wall/current/SchemaCore.lean index 042e67a88..cef070fa4 100644 --- a/aver-cert/assets/wall/current/SchemaCore.lean +++ b/aver-cert/assets/wall/current/SchemaCore.lean @@ -1,1618 +1,202 @@ --- AverCert dependency-closed statement schema core (audited, fixed). +-- AverCert statement schema core (audited, fixed), statement schema 9. -- -- The single final certificate theorem is --- This file contains every artifact-independent schema definition. The thin --- `Schema.lean` shim adds only the artifact-hash equality from `Module.lean`. -import CertPrelude -import CertDecode -import ArithTemplateDerisk +-- `AverCert.Final.cert : AverCert.Schema.Holds manifest`. +-- This file holds every artifact-independent part of that statement: the +-- manifest data (subject, declared type layout, the function plans and the +-- obligations) and the denotation of an obligation. The thin `Schema.lean` +-- shim adds only the artifact-hash equality from `Module.lean`. +-- +-- Schema 9 states every obligation over the one plan grammar (`Grammar`): +-- the model is the plan's fuel-indexed meaning, and the face is the plan's +-- signature read through the byte-pinned layout (`Grammar.HasTy`, +-- `Grammar.SRepr`). There are no per-family domains, codomains or +-- representation fields left for a producer to choose. +import SchemaBase +import Grammar namespace AverCert.Schema open CertPrelude - -/-- The finite wasm-gc host-capability registry, minted from its exhaustive - `EffectName.import_pair` mapping. Artifact manifests may declare only - pairs in this kernel-owned list; the Wasm import section is independently - enumerated and must match the declaration exactly. -/ -def WASM_GC_CAPABILITY_REGISTRY : List (String × String) := [ - ("aver", "console_print"), - ("aver", "console_error"), - ("aver", "console_warn"), - ("aver", "time_unix_ms"), - ("aver", "process_stop_requested"), - ("aver", "provider_contract_violation"), - ("aver", "request_method"), - ("aver", "request_url"), - ("aver", "request_query"), - ("aver", "request_body"), - ("aver", "request_headers_load"), - ("aver", "response_text"), - ("aver", "response_set_header"), - ("aver", "http_send"), - ("aver", "http_add_request_header"), - ("aver", "http_clear_request_headers"), - ("aver", "env_get"), - ("aver", "env_set"), - ("aver", "console_read_line"), - ("aver", "args_len"), - ("aver", "args_get"), - ("aver", "random_float"), - ("aver", "random_int"), - ("aver", "time_sleep"), - ("aver", "time_now"), - ("aver", "float_sin"), - ("aver", "float_cos"), - ("aver", "float_atan2"), - ("aver", "float_pow"), - ("aver", "terminal_enable_raw_mode"), - ("aver", "terminal_disable_raw_mode"), - ("aver", "terminal_clear"), - ("aver", "terminal_move_to"), - ("aver", "terminal_print"), - ("aver", "terminal_set_color"), - ("aver", "terminal_reset_color"), - ("aver", "terminal_read_key"), - ("aver", "terminal_size"), - ("aver", "terminal_hide_cursor"), - ("aver", "terminal_show_cursor"), - ("aver", "terminal_flush"), - ("aver", "disk_read_text"), - ("aver", "disk_write_text"), - ("aver", "disk_append_text"), - ("aver", "disk_read_bytes"), - ("aver", "disk_read_bytes_at"), - ("aver", "disk_write_bytes"), - ("aver", "disk_append_bytes"), - ("aver", "disk_size"), - ("aver", "disk_exists"), - ("aver", "disk_delete"), - ("aver", "disk_delete_dir"), - ("aver", "disk_list_dir"), - ("aver", "disk_make_dir"), - ("aver", "disk_sync"), - ("aver", "tcp_connect"), - ("aver", "tcp_begin_connect"), - ("aver", "tcp_dialled"), - ("aver", "tcp_listen"), - ("aver", "tcp_accept"), - ("aver", "tcp_peer_address"), - ("aver", "tcp_write_line"), - ("aver", "tcp_write_bytes"), - ("aver", "tcp_write_now"), - ("aver", "tcp_read_line"), - ("aver", "tcp_read_bytes"), - ("aver", "tcp_read_some"), - ("aver", "tcp_read_now"), - ("aver", "tcp_poll"), - ("aver", "tcp_close"), - ("aver", "tcp_close_dial"), - ("aver", "tcp_close_listener"), - ("aver", "tcp_send"), - ("aver", "tcp_send_bytes"), - ("aver", "tcp_ping"), - ("aver", "http_get"), - ("aver", "http_head"), - ("aver", "http_delete"), - ("aver", "http_post"), - ("aver", "http_put"), - ("aver", "http_patch"), - ("aver", "record_enter_group"), - ("aver", "record_set_branch"), - ("aver", "record_exit_group"), - ("aver", "wait_poll"), - ("aver", "work_cancel"), - ("aver", "work_begin"), - ("aver", "work_take") -] - -/-- Exact standard canonical-ABI import surface emitted into wasip2 core - modules. Interface versions and operation names are part of the boundary; - there is deliberately no wildcard for the `wasi:` namespace. -/ -def WASIP2_CAPABILITY_REGISTRY : List (String × String) := [ - ("wasi:cli/stdout@0.2.4", "get-stdout"), - ("wasi:cli/stderr@0.2.4", "get-stderr"), - ("wasi:io/streams@0.2.4", "[method]output-stream.blocking-write-and-flush"), - ("wasi:clocks/wall-clock@0.2.4", "now"), - ("wasi:random/random@0.2.4", "get-random-u64"), - ("wasi:cli/environment@0.2.4", "get-arguments"), - ("wasi:cli/environment@0.2.4", "get-environment"), - ("wasi:cli/stdin@0.2.4", "get-stdin"), - ("wasi:io/streams@0.2.4", "[method]input-stream.blocking-read"), - ("wasi:io/streams@0.2.4", "[method]input-stream.subscribe"), - ("wasi:io/streams@0.2.4", "[method]input-stream.read"), - ("wasi:io/streams@0.2.4", "[method]output-stream.check-write"), - ("wasi:io/streams@0.2.4", "[method]output-stream.write"), - ("wasi:io/streams@0.2.4", "[method]output-stream.flush"), - ("wasi:io/streams@0.2.4", "[method]output-stream.subscribe"), - ("wasi:clocks/monotonic-clock@0.2.4", "subscribe-duration"), - ("wasi:io/poll@0.2.4", "poll"), - ("wasi:io/poll@0.2.4", "[resource-drop]pollable"), - ("wasi:filesystem/preopens@0.2.4", "get-directories"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.stat-at"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.open-at"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.read-via-stream"), - ("wasi:filesystem/types@0.2.4", "[resource-drop]descriptor"), - ("wasi:io/streams@0.2.4", "[resource-drop]input-stream"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.write-via-stream"), - ("wasi:io/streams@0.2.4", "[resource-drop]output-stream"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.unlink-file-at"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.remove-directory-at"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.create-directory-at"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.sync"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.append-via-stream"), - ("wasi:filesystem/types@0.2.4", "[method]descriptor.read-directory"), - ("wasi:filesystem/types@0.2.4", "[method]directory-entry-stream.read-directory-entry"), - ("wasi:filesystem/types@0.2.4", "[resource-drop]directory-entry-stream"), - ("wasi:http/types@0.2.4", "[constructor]fields"), - ("wasi:http/types@0.2.4", "[constructor]outgoing-request"), - ("wasi:http/types@0.2.4", "[method]outgoing-request.set-scheme"), - ("wasi:http/types@0.2.4", "[method]outgoing-request.set-authority"), - ("wasi:http/types@0.2.4", "[method]outgoing-request.set-path-with-query"), - ("wasi:http/outgoing-handler@0.2.4", "handle"), - ("wasi:http/types@0.2.4", "[method]future-incoming-response.subscribe"), - ("wasi:http/types@0.2.4", "[method]future-incoming-response.get"), - ("wasi:http/types@0.2.4", "[method]incoming-response.status"), - ("wasi:http/types@0.2.4", "[method]incoming-response.consume"), - ("wasi:http/types@0.2.4", "[method]incoming-body.stream"), - ("wasi:http/types@0.2.4", "[static]incoming-body.finish"), - ("wasi:http/types@0.2.4", "[resource-drop]outgoing-request"), - ("wasi:http/types@0.2.4", "[resource-drop]future-incoming-response"), - ("wasi:http/types@0.2.4", "[resource-drop]incoming-response"), - ("wasi:http/types@0.2.4", "[resource-drop]future-trailers"), - ("wasi:http/types@0.2.4", "[resource-drop]incoming-body"), - ("wasi:http/types@0.2.4", "[method]incoming-response.headers"), - ("wasi:http/types@0.2.4", "[method]fields.entries"), - ("wasi:http/types@0.2.4", "[resource-drop]fields"), - ("wasi:http/types@0.2.4", "[method]outgoing-request.set-method"), - ("wasi:http/types@0.2.4", "[method]outgoing-request.body"), - ("wasi:http/types@0.2.4", "[method]outgoing-body.write"), - ("wasi:http/types@0.2.4", "[static]outgoing-body.finish"), - ("wasi:http/types@0.2.4", "[method]fields.append"), - ("wasi:http/types@0.2.4", "[resource-drop]outgoing-body"), - ("wasi:http/types@0.2.4", "[method]incoming-request.method"), - ("wasi:http/types@0.2.4", "[method]incoming-request.path-with-query"), - ("wasi:http/types@0.2.4", "[method]incoming-request.headers"), - ("wasi:http/types@0.2.4", "[method]incoming-request.consume"), - ("wasi:http/types@0.2.4", "[resource-drop]incoming-request"), - ("wasi:http/types@0.2.4", "[constructor]outgoing-response"), - ("wasi:http/types@0.2.4", "[method]outgoing-response.set-status-code"), - ("wasi:http/types@0.2.4", "[method]outgoing-response.body"), - ("wasi:http/types@0.2.4", "[static]response-outparam.set"), - ("wasi:sockets/instance-network@0.2.4", "instance-network"), - ("wasi:sockets/ip-name-lookup@0.2.4", "resolve-addresses"), - ("wasi:sockets/ip-name-lookup@0.2.4", "[method]resolve-address-stream.resolve-next-address"), - ("wasi:sockets/ip-name-lookup@0.2.4", "[method]resolve-address-stream.subscribe"), - ("wasi:sockets/ip-name-lookup@0.2.4", "[resource-drop]resolve-address-stream"), - ("wasi:sockets/tcp-create-socket@0.2.4", "create-tcp-socket"), - ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.start-connect"), - ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.finish-connect"), - ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.subscribe"), - ("wasi:sockets/tcp@0.2.4", "[method]tcp-socket.shutdown"), - ("wasi:sockets/tcp@0.2.4", "[resource-drop]tcp-socket") -] - -/-- Backwards-compatible name for the original wasm-gc-only registry. -/ -def CAPABILITY_REGISTRY : List (String × String) := WASM_GC_CAPABILITY_REGISTRY - -/-- Core wasm-gc module artifacts use the raw module bytes as the certified artifact. -/ -def expectedWasmGcArtifactTarget : String := "wasm-gc" - -/-- WASI 0.2 Component Model artifacts use a declared component envelope. -/ -def expectedWasip2ArtifactTarget : String := "wasip2" - -/-- Select the finite standard host-import registry from the manifest target. - Unknown targets receive no standard imports and therefore fail closed. -/ -def capabilityRegistryForTarget (target : String) : List (String × String) := - if target == expectedWasmGcArtifactTarget then WASM_GC_CAPABILITY_REGISTRY - else if target == expectedWasip2ArtifactTarget then WASIP2_CAPABILITY_REGISTRY - else [] - -theorem wasiStdoutIsWasip2Only : - (capabilityRegistryForTarget expectedWasip2ArtifactTarget).contains - ("wasi:cli/stdout@0.2.4", "get-stdout") = true ∧ - (capabilityRegistryForTarget expectedWasmGcArtifactTarget).contains - ("wasi:cli/stdout@0.2.4", "get-stdout") = false ∧ - (capabilityRegistryForTarget expectedWasip2ArtifactTarget).contains - ("wasi:cli/stdout@0.2.5", "get-stdout") = false := by - native_decide - -/-- Backwards-compatible alias for the historical wasm-gc-only target constant. -/ -def expectedArtifactTarget : String := expectedWasmGcArtifactTarget - -/-- The only emitted-fragment profile this schema currently admits. -/ -def expectedProfile : String := "AverUserProfile/v1" - -/-- Runtime ABI admitted for raw wasm-gc module artifacts. -/ -def expectedRuntimeAbiWasmGc : String := "aver-wasm-gc/0" - -/-- Runtime ABI admitted for WASI 0.2 Component Model artifacts. -/ -def expectedRuntimeAbiWasip2 : String := "aver-wasip2/0" - -/-- Backwards-compatible alias for the historical wasm-gc-only ABI constant. -/ -def expectedRuntimeAbi : String := expectedRuntimeAbiWasmGc - -/-- Target/ABI pairs admitted by this schema. The byte-level envelope check - lives at artifact acceptance time, where both the delivered target bytes and - the embedded core-module bytes are available. -/ -def artifactTargetAbiAccepted (target abi : String) : Bool := - (target == expectedWasmGcArtifactTarget && abi == expectedRuntimeAbiWasmGc) || - (target == expectedWasip2ArtifactTarget && abi == expectedRuntimeAbiWasip2) - -/-- Full statement identity helper used by tests and documentation. -/ -def artifactIdentityAccepted (target profile abi : String) : Bool := - profile == expectedProfile && artifactTargetAbiAccepted target abi - -/-- What the artifact is: its pinned hash, explicit artifact target, - emitted-fragment profile, runtime ABI, artifact theorem root, the certified - and explicitly uncertified export names, the exact effect-import capability - surface, byte-derived start status, and the runtime contracts every - certificate is conditional on. Pure data, mirrored in `cert-manifest.json`. - - `hostRoleTable` is optional exactly like `start`: a module without the Int - carrier helper has no host-role table at all (`none`), which the acceptance - pin binds against the strict byte decoder returning `some none` — a - byte-derived proof that the `__rt_aint_from_i64` helper export is absent. - A module with the helper always carries `some` table, even when every role - inside it is unbound; a module whose role scan fails decodes to the - poisoned `none`, which no manifest value can match. - - `arithParams` declares the indices the canonical arith helper bodies are a - function of (Int carrier struct, limb array, and the decompose/normalize/ - strip/umagCmp bignum sub-routine functions); it is `some` exactly when - `hostRoleTable` is. The acceptance pin synthesizes each declared add/sub/mul - helper body from these and confirms it byte-for-byte in the real module, so - a wrong declaration fails the pin rather than riding a byte fingerprint. -/ -structure Subject where - artifactHash : String - target : String - profile : String - abi : String - artifactRoot : String - exports : List String - declaredUncertified : List (String × String) - capabilities : List (String × String) - start : Option Nat - hostRoleTable : Option CertDecode.AddSub.Roles - arithParams : Option ArithTemplateDerisk.ArithHostParams - stringHostRoles : List (Nat × CertDecode.StringHost.Role) - contracts : List String - -/-- Claim-matching view of the optional module host-role table. An absent - table binds no host roles, so any claim citing a box/add/mul/sub role - fails to match — strictly fail-closed, never a default index. -/ -def Subject.hostRoles (s : Subject) : CertDecode.AddSub.Roles := - match s.hostRoleTable with - | some roles => roles - | none => { box := none, add := none, mul := none, sub := none, - toIndex := none, cmp := none, eq := none } - -/-- The certification policy attached to a certified export. Partial simulation - remains the default; the total preset additionally promises return at the - fuel selected by the checked termination witness. -/ -inductive Policy where - | simulatesModel - | simulatesModelTotally -deriving Repr, DecidableEq - -/-- Extra totality premise selected for one total obligation. The default - preserves the shipped L3 contract: add/sub are total, while the partial mul - law remains available but mul need not return. The `.mul` role is reserved - for a byte-checked unary recursion whose combine call is `Int.mul`. -/ -inductive TotalityRole where - | addSub - | mul -deriving Repr, DecidableEq - -/-- Closed measure vocabulary for the first total-correctness family. The - parameter index is claim data; `checkTerm` below accepts it only when the - byte-bound recursion plan descends that integer parameter by one. -/ -inductive Measure where - | intNatAbs (paramIdx : Nat) -deriving Repr, DecidableEq - -/-- Non-canonical termination evidence attached to an obligation rather than - its byte-origin plan. Multiple measures may justify the same code bytes; - the kernel checks the selected measure against the pinned descent. -/ -structure TerminationWitness where - measure : Measure - descent : Int -deriving Repr, DecidableEq - -/-- Value representation types admitted by the `expr-fragment-v1` plan grammar. - `Plans.lean` stores these values as the sole plan DATA representation; the - checker validates and lowers them to artifact bytes. Source-level projection - is explicit through `FragTy.sourceTy?` rather than a raw `WVal` fallback. -/ -inductive FragTy where - | f64 - | boolI32 - | intCarrier - | i64 - | rawI32 - | ref - /-- Opaque user-ADT / record reference. Unlike `ref` (an Int-carrier limb), - this is a whole user struct/array reference handled verbatim. The concrete - wasm type index is never part of the type: it lives on the projecting - node (`structGetUser`) and is bound to the module bytes by the byte-exact - gate, mirroring how `hostCall` carries its resolved function index. -/ - | adtRef -deriving Repr, DecidableEq - -/-- Source-level types for the planned `SymPlan` grammar. This intentionally - has no raw `WVal` escape hatch: if a fragment value cannot be named as an - Aver source type, it should not project to `SymPlan` yet. -/ -inductive SymTy where - | int - | float - | bool - | string - | named (name : String) - | app1 (name : String) (arg : SymTy) - | app2 (name : String) (left right : SymTy) -deriving Repr, DecidableEq - -/-- Projection from representation-level fragment types into the source-level - `SymPlan` type system. Raw wasm limbs and references deliberately return - `none`; they need an explicit source constructor/encoder before they can - participate in source-level certificates. -/ -def FragTy.sourceTy? : FragTy → Option SymTy - | .f64 => some .float - | .boolI32 => some .bool - | .intCarrier => some .int - | .i64 => none - | .rawI32 => none - | .ref => none - -- An opaque ADT reference names no single source type by itself; the source - -- meaning lives in the `SymPlan` node that produced it. - | .adtRef => none - -/-- Source-level primitive operations admitted by the initial `SymPlan` - scaffold. `intAdd` is exact integer addition on Aver `Int` (ℤ); its - encoding binds to the runtime carrier `add` contract through the - byte-derived host-role table. -/ -inductive SymPrim where - | floatAdd - | floatMul - | floatLe - | floatGe - | floatLt - | floatGt - | floatEq - | intAdd - | intSub - | intMul - | stringEq - | stringConcat - /-- Source-level `Bool.and` (eager conjunction on Aver `Bool`). Both - operands must already be source Booleans; the encoder lowers it to the - representation `i32.and` over two `boolI32` values, where bitwise and - logical conjunction coincide. -/ - | boolAnd -deriving Repr, DecidableEq - -/-- Source-level integer comparison against a literal. This is intentionally - narrower than general `Int` comparison so the v1 encoder can stay canonical - and avoid SSA/local sharing. -/ -inductive SymIntCmp where - | eq - | lt - | le - | ge - | gt -deriving Repr, DecidableEq - -mutual - inductive SymNodeKind where - | param (index : Nat) - | constBool (value : Bool) - | constInt (value : Int) - | constFloatBits (bits : Nat) - | constStringBytes (bytes : List Nat) - | prim (op : SymPrim) (args : List Nat) - | construct (typeName ctorName : String) (args : List Nat) - | emptyList (elemTy : SymTy) - /-- Source-level record/ADT field projection: read declared field `field` - (source declaration order) of a value of the named user type. `fieldTy` - is the field's source type; encoding binds the projection to the exact - wasm struct type index through the byte-derived struct table. -/ - | projectField (typeName : String) (field : Nat) (fieldTy : SymTy) (value : Nat) - | intConstCmp (op : SymIntCmp) (value : Nat) (constant : Int) - /-- Source-level comparison of two Int VALUES (`a >= b`, `a == b`). Unlike - `intConstCmp`, which compares one parameter against a LITERAL and - encodes to a carrier-shape test, this encodes to the runtime helper call - the emitter really produces: the three-way `__aint_cmp` followed by a - signed relational operator against `i32.const 0`, or `__aint_eq` alone. - `le` has no admitted encoding — the plan grammar carries no `i32.le_s` - primitive — so it fail-closes. -/ - | intCmp (op : SymIntCmp) (lhs rhs : Nat) - /-- Operational tag-field dispatch over an ADT value (Option/Result). Reads - the i32 discriminant in field 0 of the `typeName` struct that `scrutinee` - holds, compares it to the literal `tag`, and evaluates `hit` when equal - else `miss`. This is a REPRESENTATION-level meaning ("read field 0 == k, - branch"), NOT a source-constructor relation: it never claims the tested - constructor writes `tag` into field 0. The encoder binds `typeName` to - the wasm struct index via the byte-derived struct table; the byte-exact - gate confirms field 0 is the i32 tag. -/ - | tagMatch (typeName : String) (scrutinee : Nat) (tag : Int) (hit miss : SymBlock) - | ifElse (cond : Nat) (thenBlock elseBlock : SymBlock) - /-- Monolithic fused `Option.withDefault(Vector.get(p0, p1), default)`: - read the `typeName` vector in param 0 at the Int index in param 1, - yielding the element in bounds and the literal `default` otherwise. - The whole bounds-checked template is ONE node (mirroring the emitter's - single fused shape); the vector and index are pinned to params 0 and 1, - never chosen by the plan. -/ - | vectorGetOrDefault (typeName : String) (default : Int) - deriving Repr - - structure SymNode where - id : Nat - ty : SymTy - kind : SymNodeKind - deriving Repr - - structure SymBlock where - nodes : List SymNode - result : Nat - deriving Repr -end - -/-- Raw, untrusted source-level symbolic plan. Future profiles should prefer - this over the wasm-representation-shaped `ExprFragmentRawPlan`; a checked - encoder/lowerer then binds it to exact wasm code-entry bytes. -/ -structure SymRawPlan where - profile : String - params : List SymTy - result : SymTy - body : SymBlock -deriving Repr - -/-- Primitive operations admitted by `expr-fragment-v1`. -/ -inductive FragPrim where - | f64Add - | f64Mul - | f64Le - | f64Ge - | f64Lt - | f64Gt - | f64Eq - | i64Eq - | i64LeS - | i64LtS - | i64GeS - | i64GtS - | i32Eq - | i32LtS - | i32GtS - /-- `i32.ge_s`: the tail the emitter appends to a `__aint_cmp` call for a - source-level `>=`. The signed relational family is admitted one member at - a time, as a plan that needs it appears; `i32.le_s` has an interpreter - clause and a `WInstr` constructor already but no admitted plan, so it is - deliberately still outside `FragPrim`. -/ - | i32GeS - /-- `i32.and` restricted to the Boolean domain: `PlanCheck` types it only - over two `boolI32` operands (NOT the loose `hasI32Ty`), because bitwise - AND of arbitrary raw i32 values can produce a non-Boolean result - (`2 and 2 = 2`) and the interpreter models the operation on {0,1}. -/ - | i32And -deriving Repr, DecidableEq - -/-- Runtime host helper roles admitted by `expr-fragment-v1`. Each role fixes a - representation-level type signature (checked by `PlanCheck`); the resolved - wasm function index is carried on the node and bound both to the module - bytes and to the decoded role table by artifact acceptance. -/ -inductive HostRole where - | box - | add - | mul - | sub - /-- `__aint_to_index`: extract a wasm array index from a represented integer - (`[0, 2^31)` passes through; anything else, including every big value, - collapses to the `-1` out-of-bounds sentinel). Consumed only by the - monolithic fused vector-read node, never as a standalone `hostCall`. -/ - | toIndex - /-- `__aint_cmp`: three-way comparison of two Int carriers, yielding the raw - `i32` sentinel `-1`/`0`/`1` (`CertPrelude.cmpW`). The emitter never reads - it as a Boolean: it always follows the call with `i32.const 0` and a - signed relational operator, so the node's result type is `rawI32`, not - `boolI32`. The ASSUMED CONTRACT covers a CANONICAL CARRIER PAIR only — - see the note on `Obligation.holds`. -/ - | cmp - /-- `__aint_eq`: equality of two Int carriers, yielding the `0`/`1` wasm - Boolean directly (`CertPrelude.eqW`). Unlike `cmp` its result IS the - source-level Boolean, so the node's result type is `boolI32` and the - emitter appends no comparison tail. Its assumed contract is over a - canonical carrier pair for the same reason `cmp`'s is, and for one more: - `__aint_eq` decides a `Small`/`Big` pair structurally. -/ - | eq -deriving Repr, DecidableEq - -mutual - /-- A single typed ANF node in an expression-fragment plan. -/ - inductive FragNodeKind where - | local (index : Nat) - | constBool (value : Bool) - | constI64 (value : Int) - | constI32 (value : Int) - | constF64Bits (bits : Nat) - | structGet (field : Nat) (receiver : Nat) - /-- Projection of `field` out of a user struct of wasm type `tyIdx` (a whole - record/ADT, not the Int carrier). The type index is node data bound to - the module bytes by the byte-exact gate and validated against the - struct context decoded from the artifact, mirroring `hostCall`'s - resolved function index. -/ - | structGetUser (tyIdx : Nat) (field : Nat) (value : Nat) - | refIsNull (value : Nat) - | prim (op : FragPrim) (args : List Nat) - | hostCall (role : HostRole) (funcIdx : Nat) (args : List Nat) - /-- A self-recursive call to the function being certified. `tail` selects - `return_call` (tail position, `0x12`) over `call` (`0x10`). `funcIdx` is - the resolved self function index; it is bound to the module bytes by the - byte-exact gate and validated against the decoded self index, exactly as - `hostCall` binds its resolved index. The plan never invents it. -/ - | selfCall (tail : Bool) (funcIdx : Nat) (args : List Nat) - | ifElse (cond : Nat) (thenBlock elseBlock : FragBlock) - /-- Monolithic fused bounds-checked vector read: the exact emitter template - `to_index/ge_s // to_index/len/lt_u // and // if (array.get) (box d)` - over locals 0 (vector) and 1 (index). `arrTy` is the vector's wasm - array type index; `toIndexIdx`/`boxIdx` are the resolved - `__aint_to_index` / box helper indices, bound to the module bytes by - the byte-exact gate and to the byte-derived role table by acceptance. - The node reads locals directly and consumes no operand stack values. -/ - | vectorGetOrDefault (arrTy toIndexIdx boxIdx : Nat) (default : Int) - /-- Construction of a user struct of wasm type `tyIdx` from `args` (source - field order). The type index is node data bound to the module bytes by - the byte-exact gate, mirroring how `structGetUser` binds its projection - index. -/ - | structNew (tyIdx : Nat) (args : List Nat) - /-- The emitter's monolithic sign template for comparing a COMPUTED Int - carrier against an i64 literal, without calling `__aint_cmp` - (`from_mir/builtins.rs::emit_aint_cmp_const`). The operand is already on - the stack; the template stashes it in the scratch local, branches on - `limbs = null`, and decides either by the native i64 compare of the - `small` field against `constant` or — for a limb-carrying operand, - whose value is outside the i64 band — by the sign field alone. - - `scratch` is the local slot the template writes; the checker pins it to - `params.length`, the one declared scratch every plan-first island - reserves, so the template can never clobber a parameter. `constant` is - pinned to the i64 band, which is what makes the sign arm exact. Like - `vectorGetOrDefault` this is ONE node: the whole instruction list - lowers and runs together. -/ - | intSignCmp (op : SymIntCmp) (constant : Int) (scratch : Nat) (value : Nat) - deriving Repr - - /-- A typed value definition. `id` must match its position in the containing - block; `PlanCheck` enforces this before lowering. -/ - structure FragNode where - id : Nat - ty : FragTy - kind : FragNodeKind - deriving Repr - - /-- Ordered ANF block. `result` is the id of the value yielded by the block. -/ - structure FragBlock where - nodes : List FragNode - result : Nat - deriving Repr -end - -/-- Raw, untrusted expression-fragment plan as Lean data. The artifact may - provide this; only the checked plan produced by the trusted checker should - be used for acceptance. -/ -structure ExprFragmentRawPlan where - profile : String - params : List FragTy - result : FragTy - body : FragBlock -deriving Repr - -/-- Raw, untrusted fuel-recursion plan. It reuses the `expr-fragment` ANF - grammar, but its body carries `selfCall` nodes and its value-if yields the - Int carrier. The checked lowerer binds it to the exact self-recursive - function code-entry bytes. This is a byte-origin veneer only: the - fuel-induction proof face and the emitted `Module.lean` body literal are - unchanged, so the plan claim never touches the proof. -/ -structure RecursionRawPlan where - profile : String - params : List FragTy - result : FragTy - body : FragBlock -deriving Repr - -/-! ### Termination-witness checking - -`recursion-plan-v1` is separately checked and lowered byte-exactly by artifact -acceptance. The helpers here inspect the same raw plan and confirm the one L3 -measure currently admitted: `Int.natAbs` of the sole parameter, guarded at -`n ≤ 0`, with a recursive argument computed as `sub(n, box 1)`. -/ - -def checkTermSmallFloor (paramIdx : Nat) (block : FragBlock) : Bool := - match block.result, block.nodes with - | 3, - [{ id := 0, ty := .intCarrier, kind := .local localIdx }, - { id := 1, ty := .i64, kind := .structGet 0 0 }, - { id := 2, ty := .i64, kind := .constI64 0 }, - { id := 3, ty := .boolI32, kind := .prim .i64LeS [1, 2] }] => - localIdx == paramIdx - | _, _ => false - -def checkTermBigFloor (paramIdx : Nat) (block : FragBlock) : Bool := - match block.result, block.nodes with - | 3, - [{ id := 0, ty := .intCarrier, kind := .local localIdx }, - { id := 1, ty := .rawI32, kind := .structGet 2 0 }, - { id := 2, ty := .boolI32, kind := .constBool false }, - { id := 3, ty := .boolI32, kind := .prim .i32LtS [1, 2] }] => - localIdx == paramIdx - | _, _ => false - -/-- The step arm selected by the canonical small/big carrier discriminator and - non-positive floor guard. Returning `none` rejects any different guard. -/ -def checkTermStep? (paramIdx : Nat) (body : FragBlock) : Option FragBlock := - match body.result, body.nodes with - | 4, - [{ id := 0, ty := .intCarrier, kind := .local localIdx }, - { id := 1, ty := .ref, kind := .structGet 1 0 }, - { id := 2, ty := .boolI32, kind := .refIsNull 1 }, - { id := 3, ty := .boolI32, kind := .ifElse 2 small big }, - { id := 4, ty := .intCarrier, kind := .ifElse 3 _base step }] => - if localIdx == paramIdx && checkTermSmallFloor paramIdx small && - checkTermBigFloor paramIdx big then some step else none - | _, _ => none - -/-- Check that one selected self-call argument is exactly - `sub(local paramIdx, box(1))`. -/ -def checkTermDescentArg (paramIdx : Nat) (step : FragBlock) - (descentId : Nat) : Bool := - match step.nodes[descentId]? with - | some { kind := .hostCall .sub _ [inputId, boxedOneId], .. } => - match step.nodes[inputId]?, step.nodes[boxedOneId]? with - | some { kind := .local localIdx, .. }, - some { kind := .hostCall .box _ [oneId], .. } => - match step.nodes[oneId]? with - | some { kind := .constI64 1, .. } => localIdx == paramIdx - | _ => false - | _, _ => false - | _ => false - -/-- Does one node in the step arm call self with a checked first-parameter - descent? Unary recursion uses a non-tail one-argument call; accumulator - recursion uses a tail two-argument call whose second argument is pinned by - the independently checked recursion grammar. -/ -def checkTermDescent (paramIdx : Nat) (step : FragBlock) : Bool := - step.nodes.any fun node => - match node.kind with - | .selfCall false _ [descentId] => - checkTermDescentArg paramIdx step descentId - | .selfCall true _ [descentId, _accId] => - checkTermDescentArg paramIdx step descentId - | _ => false - -/-- Kernel decision procedure for promoted descent-by-one recursion. - It does not synthesise a measure: it checks the claimed `natAbs` parameter, - the `-1` descent, the non-positive floor guard, and the exact recursive - argument chain already pinned to the module bytes by the plan gate. -/ -def checkTerm (plan : RecursionRawPlan) (witness : TerminationWitness) : Bool := - match witness.measure with - | .intNatAbs paramIdx => - plan.profile == "recursion-plan-v1" && - (plan.params == [.intCarrier] || - plan.params == [.intCarrier, .intCarrier]) && - plan.result == .intCarrier && - paramIdx == 0 && - witness.descent == (-1 : Int) && - match checkTermStep? paramIdx plan.body with - | some step => checkTermDescent paramIdx step - | none => false - -/-- Raw, untrusted mutual-recursion member plan. Like `RecursionRawPlan` it - reuses the `expr-fragment` ANF grammar with a `selfCall` node and an - Int-carrier value-if, but the call is a TAIL call to a SIBLING member of the - byte-derived SCC rather than the member's own index. The checked lowerer - binds it to the exact code-entry bytes of ONE member of a mutually-recursive - SCC. This is a byte-origin veneer only: the conjunction fuel-induction proof - face and the emitted shared `Module.lean` code literal are unchanged, so the - plan claim never touches the proof. -/ -structure MutualRawPlan where - profile : String - params : List FragTy - result : FragTy - body : FragBlock -deriving Repr - -/-- Kernel decision procedure for one member of a promoted integer-countdown - mutual SCC. The floor/measure checks are identical to `checkTerm`; the only - intentional shape difference is that the byte-pinned recursive edge is a - tail call to another member rather than a non-tail self call. SCC closure - and target membership remain separate artifact-acceptance guards. -/ -def checkTermMutual (plan : MutualRawPlan) (witness : TerminationWitness) : Bool := - match witness.measure with - | .intNatAbs paramIdx => - plan.profile == "mutual-plan-v1" && - plan.params == [.intCarrier] && - plan.result == .intCarrier && - paramIdx == 0 && - witness.descent == (-1 : Int) && - match checkTermStep? paramIdx plan.body with - | some step => - step.nodes.any fun node => - match node.kind with - | .selfCall true _ [descentId] => - match step.nodes[descentId]? with - | some { kind := .hostCall .sub _ [inputId, boxedOneId], .. } => - match step.nodes[inputId]?, step.nodes[boxedOneId]? with - | some { kind := .local localIdx, .. }, - some { kind := .hostCall .box _ [oneId], .. } => - match step.nodes[oneId]? with - | some { kind := .constI64 1, .. } => localIdx == paramIdx - | _ => false - | _, _ => false - | _ => false - | _ => false - | none => false - -/-- A composition member carries only its semantic-free byte SHAPE. A chain - names callee exports; numeric Wasm indices are resolved from those exports' - byte-derived `FuncBinding`s by the acceptance predicate and are never plan - data. -/ -inductive CompositionShape where - | selfSum - | chain (callees : List String) -deriving Repr, DecidableEq - -/-- Raw, untrusted cross-function composition plan. This is solely a - byte-origin veneer over the existing independently-read model and the - existing callee-composition simulation proof. -/ -structure CompositionRawPlan where - profile : String - shape : CompositionShape -deriving Repr, DecidableEq - -/-- Selected result-reference shape for a bare tuple/record field projection. - This is claim context recovered from the module's function signature and - checked against the selected struct field; it is never plan-selected. -/ -inductive FieldProjectionResultTy where - | eqref - | nullableRef (typeIdx : Nat) - deriving Repr, DecidableEq - -/-- Exact byte-level value type of a constructor field. Unlike `SymTy`, this - is read back from the Wasm type section and therefore cannot be changed by - relabelling a source plan. -/ -inductive ConstructValType where - | i32 - | i64 - | f64 - | eqref - | nullableRef (typeIdx : Nat) - deriving Repr, DecidableEq - -/-- Raw byte-origin veneer for the bare tuple-destructuring projection family. - The projected field index is the only plan datum. Struct identity/count, - selected result-reference type, carrier and function binding are supplied - separately from validated module bytes and checked by artifact acceptance. -/ -structure FieldProjectionRawPlan where - profile : String - fieldIdx : Nat -deriving Repr, DecidableEq - -/-- One terminal leaf of a verbatim `ref.test`-dispatch arm (`verbatim-plan-v1`). - `Cod := WVal`; each leaf is a byte-derived constant or a single-variant - projection. The concrete wasm type/data indices are node data bound to the - module bytes by the byte-exact gate, never trusted from the plan. -/ -inductive VerbatimLeaf where - /-- Project field `field` of the scrutinee cast to user struct type `tyIdx`, - spilled through the field scratch local: - `localGet S; refCast tyIdx; structGet tyIdx field; localSet F; localGet F`. -/ - | project (tyIdx field : Nat) - /-- A String literal built by `array.new_data arrTy dataIdx` over `bytes`: - `i32Const 0; i32Const bytes.length; arrayNewData arrTy bytes`. -/ - | arrayNewData (arrTy dataIdx : Nat) (bytes : List Nat) - /-- The null reference default (`ref.null resultHeapTy`). -/ - | refNull - /-- A float-bits constant (`f64.const bits`). -/ - | f64Bits (bits : Nat) -deriving Repr - -/-- A right-nested `ref.test` dispatch cascade over the (spilled) scrutinee. Each - `test` reads the scrutinee local and branches on `ref.test tyIdx`; the final - `leaf` is the fall-through default. -/ -inductive VerbatimDispatch where - | leaf (l : VerbatimLeaf) - | test (tyIdx : Nat) (hit : VerbatimLeaf) (rest : VerbatimDispatch) -deriving Repr - -/-- The exact result signature claimed by a verbatim plan. Artifact acceptance - checks this variant against the function type recovered from module bytes; - it is not evidence for its own result kind. -/ -inductive VerbatimResultSig where - | refNull (heapTy : Nat) - | f64Scalar -deriving Repr, DecidableEq - -/-- Raw, untrusted verbatim `ref.test`-dispatch plan (`verbatim-plan-v1`). A - byte-origin veneer: the `Cod := WVal` / `verbatimRepr` proof face and the - emitted `Module.lean` body literal are unchanged, so the plan claim never - touches the proof. The multi-use scrutinee is spilled to a scratch local - (which pure ANF `FragBlock` cannot express), so this is its own grammar. -/ -structure VerbatimRawPlan where - profile : String - scrutineeLocal : Nat - fieldLocal : Nat - resultSig : VerbatimResultSig - body : VerbatimDispatch -deriving Repr - -/-- The host-helper role an Int-face dispatch arm combines its projected - payload through (`int-dispatch-v1`). Deliberately narrower than `HostRole`: - an arm combinator is `add` or `sub`, never `box` (boxing appears only at the - fixed positions the lowering emits it), so the illegal state is - unrepresentable rather than checked. -/ -inductive IntDispatchRole where - | add - | sub -deriving Repr, DecidableEq - -/-- One hit arm of an Int-face `ref.test` dispatch (`int-dispatch-v1`, - `Cod := Int`). Every arm projects the tested variant's first (Int-carrier) - field and spills it through its own scratch local; the leaf then either - returns it or combines it with a boxed integer constant through a contracted - host helper. The resolved wasm indices of the box/add/sub helpers are NOT - plan data: the lowerers take the byte-derived host-role table as a - parameter, so the plan can only name roles. -/ -inductive IntDispatchLeaf where - /-- Return the projected payload: `… localSet F; localGet F`. -/ - | proj - /-- Combine the projected payload with the boxed constant `k` through the - `role` helper. `constFirst` selects the operand order `k ⊕ x` (the spill - local defers the payload past the constant) vs `x ⊕ k`. -/ - | hostOp (role : IntDispatchRole) (k : Int) (constFirst : Bool) - /-- Return the constant `k` WITHOUT reading a field: the arm of a nullary - (payloadless) constructor, lowered to `i64.const k; call box` with NO - projection prefix. Because it never touches the payload it is sound for a - constructor that has none. -/ - | const (k : Int) -deriving Repr - -/-- A right-nested Int-face `ref.test` dispatch cascade over the spilled - scrutinee. Each `test` reads the scrutinee local and branches on - `ref.test tyIdx`; the terminal `default` is a boxed integer constant - (`i64.const k; call box`). The scrutinee/field scratch locals are NOT plan - data: they are a fixed function of the BINDING-arm count (only `proj`/`hostOp` - arms read a payload and spill one; a `const` arm spills none). The `i`-th - binding arm spills to local `i+1`, the scrutinee is local `bindArmCount+1`, - exactly what the lowerers compute. -/ -inductive IntDispatchCascade where - | default (k : Int) - | test (tyIdx : Nat) (hit : IntDispatchLeaf) (rest : IntDispatchCascade) -deriving Repr - -/-- Raw, untrusted Int-face `ref.test`-dispatch plan (`int-dispatch-v1`, the - `Cod := Int` ADT-match families: the general variant dispatch and the - widened Int match). A byte-origin veneer: the `cases`-spine proof face, the - Int-valued model and the emitted `Module.lean` body literal are unchanged, - so the plan claim never touches the proof. Like `verbatim-plan-v1` the - multi-use scrutinee is spilled to a scratch local (which pure ANF - `FragBlock` cannot express); unlike it the arms consume contracted host - helpers, whose indices are context (the claim's byte-derived role table) — - never plan data. -/ -structure IntDispatchRawPlan where - profile : String - body : IntDispatchCascade -deriving Repr - -/-- One String.concat literal chunk. `bytes` is the source-level content; `dataIdx` - is the target binding needed to lower back to exact `array.new_data` code - bytes. A later self-checking parser can derive `dataIdx` from the module's - passive data section instead of carrying it in the raw plan. -/ -structure StringConcatChunk where - dataIdx : Nat - bytes : List Nat -deriving Repr - -/-- Raw, untrusted String.concat witness. It is source-shaped around the value - flow (`prefixes ++ input ++ suffixes`) but still carries the current wasm-gc - encoder binding for each literal chunk, so the checked plan can lower to the - exact function code-entry bytes. -/ -structure StringConcatRawPlan where - profile : String - prefixes : List StringConcatChunk - suffixes : List StringConcatChunk -deriving Repr - -/-- One literal used by the String.eq dispatch beachhead. `bytes` is the - source-level string content; `dataIdx` is the target binding needed for the - exact `array.new_data` code bytes. -/ -structure StringEqChunk where - dataIdx : Nat - bytes : List Nat -deriving Repr - -/-- Result branch of the String.eq dispatch: either return the original input - string or return one byte-derived literal. -/ -inductive StringEqResult where - | input - | literal (chunk : StringEqChunk) -deriving Repr - -/-- Raw, untrusted String.eq witness for a one-literal match: - `if String.eq(input, needle) then hit else default`. It is source-shaped but - still carries data segment bindings for exact byte lowering. -/ -structure StringEqRawPlan where - profile : String - needle : StringEqChunk - hit : StringEqResult - default : StringEqResult -deriving Repr - -/-- Target-bound constructor field used by `construct-v1`: either replay one - source/local argument, or emit the null representation slot that the wasm-gc - layout requires but the source constructor does not expose. -/ -inductive ConstructField where - | local (index : Nat) - | null -deriving Repr, DecidableEq - -/-- Raw, untrusted ADT constructor witness. The source-level `SymPlan` says - "construct this Aver value"; this plan carries the current wasm-gc binding - needed to lower that constructor to exact `struct.new` bytes. -/ -structure ConstructRawPlan where - profile : String - arity : Nat - fields : List ConstructField -deriving Repr - -/-- Pointwise lifting of an integer representation relation to argument lists; - this is the standard domain representation for integer families. -/ -inductive ReprAll (R : Int → WVal → Prop) : List Int → List WVal → Prop - | nil : ReprAll R [] [] - | cons {n v ns vs} : R n v → ReprAll R ns vs → ReprAll R (n :: ns) (v :: vs) - -/-- The representation-relation faces a simulation certificate is stated over - (the Int carrier `{i64 small, ref limbs, i32 sign}`). Bundled in the audited - schema so `Obligation.holds` is self-contained. - - `Canon` is the runtime's NORMAL FORM on carrier words: a value is `Small` - (`limbs = null`) exactly when it fits the i64 band `[-2^63, 2^63)`, and - `Big` otherwise, with tight limbs and a non-zero sign. Every carrier the - emitted runtime builds is in that form, by TWO mechanisms and not one: - - * the i64 fast paths build a `Small` DIRECTLY with `struct.new` — the box - helper `wat/from_i64.wat` is nothing else, and so are the both-`Small` - non-overflow arms of `wat/addsub.wat` and `wat/mul.wat`. Those words are - normal because the value provably fits the band, not because anything - normalised them; - * every path that can produce a limb-carrying result ends in the - normalisation epilogue (`wat/normalize.wat`, called as `__aint_normalize` - or inlined), which strips leading limbs and demotes an in-band magnitude - back to `Small`. - - `Canon` names that state abstractly and the two axioms below say only what - the helpers need: - - * `canonSmall` — a literal small carrier is canonical EXACTLY on the i64 - band. The forward direction is what the boxing helper's output needs; - the backward one says an out-of-band `Small` is not in normal form, which - is what separates the two shapes; - * `canonBig` — a canonical carrier that CARRIES LIMBS represents a value - outside the i64 band and has a non-zero sign. - - Nothing else about `Canon` is assumed, and the two axioms are exactly what - the proofs consume — no more. In particular they do NOT establish that the - real `wat/eq.wat` and `wat/cmp.wat` are exact on a canonical pair: that is - an assumption, carried as an explicit hypothesis of `Obligation.holds` and - validated empirically against the running helpers by - `tests/cert_intcmp_differential.rs`. `Obligation.holds` quantifies over - every `CarrierSpec`, and a specification whose `Canon` marks words the - runtime would never build is admitted by this schema; the instance a - verdict is read at is the runtime's own, where `Canon` is the normal form - described above. -/ -structure CarrierSpec (C : Nat) where - Repr : Int → WVal → Prop - Canon : WVal → Prop - car : ∀ n v, Repr n v → - (∃ s sg, v = .structv C [.i64v s, .null, .i32v sg]) ∨ - (∃ s lty les sg, v = .structv C [.i64v s, .arr lty les, .i32v sg]) - smallIntro : ∀ k : Int, Repr k (carrierSmall C k) - smallElim : ∀ n s sg, Repr n (.structv C [.i64v s, .null, .i32v sg]) → s = n - bigElim : ∀ n s lty les sg, - Repr n (.structv C [.i64v s, .arr lty les, .i32v sg]) → ((sg < 0) ↔ (n < 0)) ∧ n ≠ 0 - canonSmall : ∀ k : Int, - Canon (carrierSmall C k) ↔ (-(2 ^ 63 : Int) ≤ k ∧ k < 2 ^ 63) - canonBig : ∀ n s lty les sg, - Repr n (.structv C [.i64v s, .arr lty les, .i32v sg]) → - Canon (.structv C [.i64v s, .arr lty les, .i32v sg]) → - ¬(-(2 ^ 63 : Int) ≤ n ∧ n < 2 ^ 63) ∧ sg ≠ 0 - -/-- The small-band shape of a canonical comparison contract: literal small - carriers inside the i64 band are represented (`smallIntro`) and canonical - (`canonSmall`), so the relational contract specialises to the band form the - exact-shape comparison faces were written against. -/ -theorem canonicalCmp_smallBand {C : Nat} (S : CarrierSpec C) - (cmp : List WVal → Option WVal) - (h : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) : - ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - cmp [carrierSmall C k1, carrierSmall C k2] = some r → r = .i32v (cmpW k1 k2) := - fun k1 k2 r hlo1 hhi1 hlo2 hhi2 hc => - h k1 k2 _ _ r (S.smallIntro k1) (S.smallIntro k2) - ((S.canonSmall k1).mpr ⟨hlo1, hhi1⟩) ((S.canonSmall k2).mpr ⟨hlo2, hhi2⟩) hc - -/-- Forget the canonicity of an arithmetic contract's RESULT. The faces that - predate the canonical-carrier contract consume only the representation - conclusion; this is the one-line adapter their discharges apply. -/ -theorem carrierContract_weaken {C : Nat} {S : CarrierSpec C} - {op : List WVal → Option WVal} {f : Int → Int → Int} - (h : ∀ a b va vb w, S.Repr a va → S.Repr b vb → op [va, vb] = some w → - S.Repr (f a b) w ∧ S.Canon w) : - ∀ a b va vb w, S.Repr a va → S.Repr b vb → op [va, vb] = some w → - S.Repr (f a b) w := - fun a b va vb w h1 h2 h3 => (h a b va vb w h1 h2 h3).1 - -/-- `canonicalCmp_smallBand` for the equality helper. -/ -theorem canonicalEq_smallBand {C : Nat} (S : CarrierSpec C) - (eq : List WVal → Option WVal) - (h : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) : - ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - eq [carrierSmall C k1, carrierSmall C k2] = some r → r = .i32v (eqW k1 k2) := - fun k1 k2 r hlo1 hhi1 hlo2 hhi2 hc => - h k1 k2 _ _ r (S.smallIntro k1) (S.smallIntro k2) - ((S.canonSmall k1).mpr ⟨hlo1, hhi1⟩) ((S.canonSmall k2).mpr ⟨hlo2, hhi2⟩) hc - -/-- Standard representation of a single integer result. -/ -def intRepr (S : CarrierSpec C) : Int → WVal → Prop := S.Repr - -/-- Standard representation of a boolean result. -/ -def boolRepr (_S : CarrierSpec C) (b : Bool) (w : WVal) : Prop := w = b32 b - -/-- Standard representation of a floating-point bit-pattern result. -/ -def floatBitsRepr (_S : CarrierSpec C) (bits : UInt64) (w : WVal) : Prop := w = .f64v bits - -/-- Standard representation for byte-level projections: the model value is the - exact `WVal` the body returns. This deliberately does not inspect strings. -/ -def verbatimRepr (_S : CarrierSpec C) (v : WVal) (w : WVal) : Prop := w = v - -/-! ### User type declarations as certified-Plan members (`typedecl-v1`) - -A user record/variant declaration joins the certified Plan exactly as an -expression node does: the wall LOWERS the declaration to its wasm-gc type-section -entry (`lowerTypeDecl`) and artifact acceptance pins that entry by EQUALITY, so -the layout is a checked-by-equality witness, never trusted plan data. The -representation relation is ONE generic recursive definition (`ReprOf`), audited -once here; per-type certificates are only instances of it. - -Stage 1 admits FLAT records of scalar fields (`Int`/`Bool`/`Float`) with a -field-READ model. Nested records, variants, `String`/`List` fields and computed -comparisons are OUT: the lowerer and the representation relation fail closed on -them (`lowerScalarStorage` returns `none`, the fuel floor rejects recursion, and -the `variant` representation arm is `False`). -/ - -/-- A user type declaration carried in the certified Plan. `intCarrier`, - `boolScalar` and `floatScalar` are the admitted scalar leaves; `record` - carries its wasm struct type index and its source-order fields; `variant` - is present but unreachable in stage 1 (its representation arm is `False`). - `DecidableEq` is written by hand: the derived handler does not fire through - the nested `List TypeDecl` occurrences. -/ -inductive TypeDecl where - | intCarrier - | boolScalar - | floatScalar - | record (idx : Nat) (fields : List TypeDecl) - | variant (idx root : Nat) (ctors : List TypeDecl) -deriving Repr - -mutual - def TypeDecl.decEq : (x y : TypeDecl) → Decidable (x = y) - | .intCarrier, .intCarrier => isTrue rfl - | .boolScalar, .boolScalar => isTrue rfl - | .floatScalar, .floatScalar => isTrue rfl - | .record i1 f1, .record i2 f2 => - if h : i1 = i2 then - match TypeDecl.decEqList f1 f2 with - | isTrue hf => isTrue (by subst h; subst hf; rfl) - | isFalse hf => isFalse (by intro he; injection he with h1 h2; exact hf h2) - else isFalse (by intro he; injection he with h1 h2; exact h h1) - | .variant i1 r1 c1, .variant i2 r2 c2 => - if h : i1 = i2 ∧ r1 = r2 then - match TypeDecl.decEqList c1 c2 with - | isTrue hc => - isTrue (by obtain ⟨ha, hb⟩ := h; subst ha; subst hb; subst hc; rfl) - | isFalse hc => isFalse (by intro he; injection he with h1 h2 h3; exact hc h3) - else isFalse (by intro he; injection he with h1 h2 h3; exact h ⟨h1, h2⟩) - | .intCarrier, .boolScalar | .intCarrier, .floatScalar | .intCarrier, .record .. - | .intCarrier, .variant .. | .boolScalar, .intCarrier | .boolScalar, .floatScalar - | .boolScalar, .record .. | .boolScalar, .variant .. | .floatScalar, .intCarrier - | .floatScalar, .boolScalar | .floatScalar, .record .. | .floatScalar, .variant .. - | .record .., .intCarrier | .record .., .boolScalar | .record .., .floatScalar - | .record .., .variant .. | .variant .., .intCarrier | .variant .., .boolScalar - | .variant .., .floatScalar | .variant .., .record .. => - isFalse (by intro he; nomatch he) - def TypeDecl.decEqList : (x y : List TypeDecl) → Decidable (x = y) - | [], [] => isTrue rfl - | [], _ :: _ => isFalse (by intro he; nomatch he) - | _ :: _, [] => isFalse (by intro he; nomatch he) - | x :: xs, y :: ys => - match TypeDecl.decEq x y, TypeDecl.decEqList xs ys with - | isTrue hx, isTrue hxs => isTrue (by subst hx; subst hxs; rfl) - | isFalse hx, _ => isFalse (by intro he; injection he with h1 h2; exact hx h1) - | _, isFalse hxs => isFalse (by intro he; injection he with h1 h2; exact hxs h2) -end - -instance : DecidableEq TypeDecl := TypeDecl.decEq - -/-- The wasm-gc field storage a scalar leaf lowers to. `intCarrier` is a - nullable reference to the module's Int carrier struct index `C`; `boolScalar` - is `i32`; `floatScalar` is `f64`. Record fields are IMMUTABLE (`mutability - 0`), unlike the carrier's own mutable fields. Non-scalar leaves fail closed. -/ -def lowerScalarStorage (C : Nat) : TypeDecl → Option CertDecode.FieldType - | .intCarrier => some ⟨.val (.ref 0x63 (Int.ofNat C)), 0⟩ - | .boolScalar => some ⟨.val (.numeric 0x7f), 0⟩ - | .floatScalar => some ⟨.val (.numeric 0x7c), 0⟩ - | _ => none - -/-- Lower a Plan type declaration to its expected wasm-gc type-section entry. - Stage 1: a `record` becomes a `.plain` struct whose fields are the pointwise - scalar-storage lowering of its source-order fields; a field that is not a - scalar leaf makes the whole `mapM` fail closed. `fuel` is the recursion floor - for future nested records; at `0`, and for every non-record declaration, the - lowering returns `none` (fail-closed). -/ -def lowerTypeDecl (C : Nat) : Nat → TypeDecl → Option CertDecode.TypeEntry - | 0, _ => none - | _fuel + 1, .record _idx fields => - (fields.mapM (lowerScalarStorage C)).map (fun fts => ⟨.plain, .structType fts⟩) - | _fuel + 1, _ => none - -/-! The value denotation of a Plan type declaration: scalar leaves denote their - source scalar, a record denotes the right-associated product of its fields' - denotations (the `FragParams.denote` shape), and the stage-1-unreachable - variant denotes `Unit`. -/ -mutual - def RecordVal : TypeDecl → Type - | .intCarrier => Int - | .boolScalar => Bool - | .floatScalar => UInt64 - | .record _ fields => RecordFields fields - | .variant _ _ _ => Unit - def RecordFields : List TypeDecl → Type - | [] => Unit - | [f] => RecordVal f - | f :: next :: rest => RecordVal f × RecordFields (next :: rest) -end - -/-! The single generic representation relation between a Plan type declaration, - the wasm-gc value that stores it, and its denotation. Scalar leaves bottom - out at the EXISTING carrier / boolean / float-bits relations; a record is a - struct at its declared index whose fields represent the denotation pointwise - (`ReprFields`); the stage-1-unreachable variant arm is `False`. Audited once; - every per-type certificate is an instance. -/ -mutual - def ReprOf (S : CarrierSpec C) : - (decl : TypeDecl) → WVal → RecordVal decl → Prop - | .intCarrier, w, v => intRepr S v w - | .boolScalar, w, v => boolRepr S v w - | .floatScalar, w, v => floatBitsRepr S v w - | .record idx fields, w, v => - ∃ ws, w = .structv idx ws ∧ ReprFields S fields ws v - | .variant _ _ _, _, _ => False - def ReprFields (S : CarrierSpec C) : - (fields : List TypeDecl) → List WVal → RecordFields fields → Prop - | [], ws, _ => ws = [] - | [f], ws, v => ∃ w, ws = [w] ∧ ReprOf S f w v - | f :: next :: rest, ws, v => - ∃ w wrest, ws = w :: wrest ∧ ReprOf S f w v.1 ∧ - ReprFields S (next :: rest) wrest v.2 -end - -/-- The `k`-th component of a heterogeneous record denotation. Defined by - induction on the field list so the unread fields are skipped structurally. -/ -def nthField : (fields : List TypeDecl) → RecordFields fields → - (k : Nat) → (hk : k < fields.length) → RecordVal (fields[k]'hk) - | [f], v, 0, _ => v - | _f :: next :: rest, v, 0, _ => v.1 - | _f :: next :: rest, v, k+1, hk => nthField (next :: rest) v.2 k (by simpa using hk) - | [], _, _, hk => absurd hk (by simp) - | [_f], _, _k+1, hk => absurd hk (by simp) - -/-- GENERIC record-read lemma (the non-flat core of the field-read bridge): the - `k`-th stored value of a represented record is `some w`, and `w` represents - the `k`-th field of the record denotation. Proved by INDUCTION over the field - list — the fields before `k` are framed past, never case-split. -/ -theorem readField_repr (S : CarrierSpec C) : - ∀ (fields : List TypeDecl) (ws : List WVal) (v : RecordFields fields) - (k : Nat) (hk : k < fields.length), - ReprFields S fields ws v → - ∃ w, ws[k]? = some w ∧ ReprOf S (fields[k]'hk) w (nthField fields v k hk) - | [_f], ws, v, 0, _hk, hrepr => by - obtain ⟨w, hws, hr⟩ := hrepr - exact ⟨w, by simp [hws], hr⟩ - | _f :: next :: rest, ws, v, 0, _hk, hrepr => by - obtain ⟨w, wrest, hws, hr, _⟩ := hrepr - exact ⟨w, by simp [hws], hr⟩ - | _f :: next :: rest, ws, v, k+1, hk, hrepr => by - obtain ⟨w, wrest, hws, _, hrest⟩ := hrepr - have hk' : k < (next :: rest).length := by simpa using hk - obtain ⟨w', hw', hr'⟩ := readField_repr S (next :: rest) wrest v.2 k hk' hrest - exact ⟨w', by simp [hws, hw'], hr'⟩ - -/-- The emitted scalar-field-read body: `local.get 0; struct.get structIdx field` - (`PlanLower` lowers a `structGetUser structIdx field 0` node to exactly this - over param 0). -/ -def recordProjTemplate (structIdx field : Nat) : List WInstr := - [.localGet 0, .structGet structIdx field] - -/-- LOAD-BEARING generic bridge (template ⟹ model). Running the emitted - scalar-field-read body on a value that represents a record yields a `w` that - represents the `field`-th component of the record denotation, under the - generic `ReprOf`. Generic over the carrier spec, the record's field list, the - field index, the declared-local count, the host table (the body makes no host - call), the code table (pinned only at the self entry, exactly what byte - acceptance certifies), and the fuel. Partial correctness — vacuous on trap or - fuel exhaustion, like `Obligation.holds`. The unread fields ride through via - the field-list induction `readField_repr`, never a per-field case split. -/ -theorem recordParam_simulates_model - (S : CarrierSpec C) (structIdx field nlocals : Nat) - (fields : List TypeDecl) (hfield : field < fields.length) - (host : HostTbl) (code : CodeTbl) (self : Nat) - (hCode : code self = some ⟨1, nlocals, recordProjTemplate structIdx field⟩) - (fuel : Nat) (v : RecordFields fields) (ws : List WVal) (w : WVal) - (hrepr : ReprFields S fields ws v) - (hRun : wFuncN code host fuel self [.structv structIdx ws] = some w) : - ReprOf S (fields[field]'hfield) w (nthField fields v field hfield) := by - obtain ⟨w', hw', hr'⟩ := readField_repr S fields ws v field hfield hrepr - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - simp [wFuncN, hCode, recordProjTemplate, initLocals, wRunF, hw'] at hRun - subst hRun - exact hr' - -/-- Whether a Plan type declaration is one of the three admitted scalar leaves. - Every `TypeDecl` constructor is listed: a future constructor makes this - match non-exhaustive and stops the wall building rather than silently - classifying it. -/ -def typeDeclIsScalarLeaf : TypeDecl → Bool - | .intCarrier => true - | .boolScalar => true - | .floatScalar => true - | .record _ _ => false - | .variant _ _ _ => false - -/-- Stage-1 record admission: a `record` head whose every field is a scalar - leaf, with at least one field. Explicit arms over every constructor - (fail-closed, no wildcard), so extending `TypeDecl` forces a decision - here before any new shape can reach the record-parameter face. -/ -def checkRecordDecl : TypeDecl → Bool - | .record _ fields => !fields.isEmpty && fields.all typeDeclIsScalarLeaf - | .intCarrier => false - | .boolScalar => false - | .floatScalar => false - | .variant _ _ _ => false - -/-! Whether a Plan type declaration mentions the Int carrier ANYWHERE. Explicit - arms over every constructor; the list walk is structural, so there is no - fuel to exhaust — a fuel-based variant would have to answer `true` - (REQUIRE the byte-derived carrier binding) on exhaustion, never `false`. - A declaration that mentions the carrier makes the record face's meaning - read the claimed carrier index, so acceptance must pin that index to the - decoded `CertDecode.carrierState`. -/ -mutual - def typeDeclMentionsIntCarrier : TypeDecl → Bool - | .intCarrier => true - | .boolScalar => false - | .floatScalar => false - | .record _ fields => typeDeclsMentionIntCarrier fields - | .variant _ _ ctors => typeDeclsMentionIntCarrier ctors - def typeDeclsMentionIntCarrier : List TypeDecl → Bool - | [] => false - | decl :: rest => - typeDeclMentionsIntCarrier decl || typeDeclsMentionIntCarrier rest -end - -/-- The representation-level fragment type a scalar leaf reads back as: - `intCarrier` fields flow as the boxed carrier reference, `boolScalar` as - the Boolean i32, `floatScalar` as raw f64 bits. Non-leaves have no scalar - fragment type (fail-closed). -/ -def scalarLeafFragTy? : TypeDecl → Option FragTy - | .intCarrier => some FragTy.intCarrier - | .boolScalar => some FragTy.boolI32 - | .floatScalar => some FragTy.f64 - | .record _ _ => none - | .variant _ _ _ => none - -/-- The fragment result types a stage-1 record field read may declare — exactly - the range of `scalarLeafFragTy?`. Every `FragTy` constructor is listed. -/ -def fragTyIsRecordScalar : FragTy → Bool - | .intCarrier => true - | .boolI32 => true - | .f64 => true - | .i64 => false - | .rawI32 => false - | .ref => false - | .adtRef => false - -/-- The one canonical recursion budget for `lowerTypeDecl` wherever acceptance - states the type-section equality pin. Stage 1 lowers only flat records, so - any positive fuel suffices; naming one value keeps the pin's statement - identical across the face, the fixtures, and the generated certificates. -/ -abbrev lowerTypeDeclFuel : Nat := 8 - -/-! ### The pinned declaration is byte-determined (the existential is no choice) - -The record face quantifies its `TypeDecl` existentially inside a proof term. -These inversion lemmas make the soundness argument formal: any declaration the -equality pin accepts lowers to a `.plain` struct (killing the `.sub`/`.subFinal` -doppelganger), is a record whose field list lowers pointwise to the decoded -storages, and can place an `.intCarrier` field exactly where the real entry -holds a concrete reference — so a reference storage in the pinned entry FORCES -the declaration to mention the Int carrier, and a scalar-leaf claim about a -field forces that field's exact storage. Guard-iso probes compose these with -`typeSectionMatches` monotonicity to refute the whole face on hostile bytes. -/ - -/-- Everything `lowerTypeDecl` produces is a `.plain` entry. -/ -theorem lowerTypeDecl_plain (C fuel : Nat) (decl : TypeDecl) - (e : CertDecode.TypeEntry) (h : lowerTypeDecl C fuel decl = some e) : - e.form = .plain := by - cases fuel with - | zero => simp [lowerTypeDecl] at h - | succ fuel => - cases decl <;> simp [lowerTypeDecl] at h - case record idx fields => - obtain ⟨fts, -, hentry⟩ := h - rw [← hentry] - -/-- Everything `lowerTypeDecl` produces comes from a record declaration whose - field list lowers pointwise to the entry's storages. -/ -theorem lowerTypeDecl_recordFields (C fuel : Nat) (decl : TypeDecl) - (e : CertDecode.TypeEntry) (h : lowerTypeDecl C fuel decl = some e) : - ∃ idx fields fts, decl = TypeDecl.record idx fields ∧ - e = ⟨.plain, .structType fts⟩ ∧ - fields.mapM (lowerScalarStorage C) = some fts := by - cases fuel with - | zero => simp [lowerTypeDecl] at h - | succ fuel => - cases decl <;> simp [lowerTypeDecl] at h - case record idx fields => - obtain ⟨fts, hmap, hentry⟩ := h - exact ⟨idx, fields, fts, rfl, hentry.symm, hmap⟩ - -/-- Pointwise inversion of a successful `mapM`: each produced element is the - image of the element at the same position. -/ -theorem mapM_getElem?_inv {α β : Type} (g : α → Option β) : - ∀ (xs : List α) (ys : List β) (k : Nat) (y : β), - xs.mapM g = some ys → ys[k]? = some y → - ∃ x, xs[k]? = some x ∧ g x = some y - | [], ys, k, y, hmap, hget => by - have hys : ([] : List β) = ys := by simpa using hmap - subst hys - simp at hget - | x :: xs, ys, k, y, hmap, hget => by - rw [List.mapM_cons] at hmap - cases hx : g x with - | none => rw [hx] at hmap; simp at hmap - | some b => - cases hxs : xs.mapM g with - | none => rw [hx, hxs] at hmap; simp at hmap - | some bs => - rw [hx, hxs] at hmap - have hys : b :: bs = ys := by simpa using hmap - subst hys - cases k with - | zero => - simp only [List.getElem?_cons_zero] at hget - injection hget with hy - subst hy - exact ⟨x, by simp, hx⟩ - | succ k => - simp only [List.getElem?_cons_succ] at hget - obtain ⟨x', hx', hgx'⟩ := mapM_getElem?_inv g xs bs k y hxs hget - exact ⟨x', by simpa using hx', hgx'⟩ - -/-- Only the `.intCarrier` leaf lowers to a concrete reference storage. -/ -theorem lowerScalarStorage_ref_intCarrier (C : Nat) (f : TypeDecl) - (r : Int) (m : Nat) - (h : lowerScalarStorage C f = some ⟨.val (.ref 0x63 r), m⟩) : - f = TypeDecl.intCarrier := by - cases f <;> simp [lowerScalarStorage] at h ⊢ - -/-- Only the `.boolScalar` leaf lowers to the `i32` storage. -/ -theorem lowerScalarStorage_i32_boolScalar (C : Nat) (f : TypeDecl) (m : Nat) - (h : lowerScalarStorage C f = some ⟨.val (.numeric 0x7f), m⟩) : - f = TypeDecl.boolScalar := by - cases f <;> simp [lowerScalarStorage] at h ⊢ - -/-- A field list holding `.intCarrier` at any position mentions the carrier. -/ -theorem typeDeclsMention_of_getElem? : - ∀ (fields : List TypeDecl) (k : Nat), - fields[k]? = some TypeDecl.intCarrier → - typeDeclsMentionIntCarrier fields = true - | [], k, h => by simp at h - | f :: rest, 0, h => by - simp at h - subst h - simp [typeDeclsMentionIntCarrier, typeDeclMentionsIntCarrier] - | f :: rest, k + 1, h => by - simp only [List.getElem?_cons_succ] at h - have := typeDeclsMention_of_getElem? rest k h - simp [typeDeclsMentionIntCarrier, this] - -/-- Only `.boolScalar` names the Boolean fragment scalar. -/ -theorem scalarLeafFragTy?_boolI32 (f : TypeDecl) - (h : scalarLeafFragTy? f = some FragTy.boolI32) : - f = TypeDecl.boolScalar := by - cases f <;> simp [scalarLeafFragTy?] at h ⊢ - -/-- One certified export. `code`/`host`/`self` pin the emitted body and its - runtime wiring; `Dom`/`Cod` and their representation relations describe the - typed source-model face the body is proven to simulate. `AcceptedArtifact` - decodes and binds the relevant code, function, type, and carrier facts from - the artifact bytes. -/ +open AverCert.Grammar (Ty Sig FnPlan MCtx SVal HasTy HasTyL SRepr SReprL) + +/-! ### The declared module layout (type table) + +The type table names, for every source type a plan mentions, the wasm type +index that represents it. It is DECLARED data: `TypeTable.lean` confirms every +entry against the module's type section (declare-and-confirm), and every +index that the lowering writes into a code entry is confirmed a second time by +the code-entry byte equality. -/ + +/-- A record, or a tuple instantiation, by type id: its struct index and its + field types in declared order. A one-field record is a newtype: the emitter + erases it to its field's value, and `struct` names the heap type of that + value (its field's own representation), never a struct of its own. -/ +structure RecordDecl where + tid : Nat + struct : Nat + fields : List Ty +deriving Repr, DecidableEq + +/-- A user sum type by type id: its root struct and, per constructor in + declaration order, the constructor's struct index and field types. -/ +structure SumDecl where + tid : Nat + root : Nat + ctors : List (Nat × List Ty) +deriving Repr, DecidableEq + +structure TypeTable where + /-- The Int carrier struct; `none` exactly in a module without one. -/ + carrier : Option Nat + /-- The carrier's magnitude (limb) array. -/ + mag : Option Nat + /-- `$string`, `(array (mut i8))`. -/ + str : Option Nat + /-- `Vector`, the argument array of the concatenation helper. -/ + strVec : Option Nat + records : List RecordDecl + sums : List SumDecl + /-- `Option` and `Result` instantiations: `{i32 tag, T}` and + `{i32 tag, T, E}`. -/ + options : List (Ty × Nat) + results : List (Ty × Ty × Nat) + /-- `Vector` arrays and `List` cons structs `{T, ref null self}`. -/ + vecs : List (Ty × Nat) + lists : List (Ty × Nat) + /-- Opaque pass-through types by type id: their heap type. -/ + opaques : List (Nat × Nat) + /-- The passive data segment holding each string literal's bytes. -/ + strSegs : List (List Nat × Nat) +deriving Repr + +/-- One planned function: the plan is the function's MIR body printed 1:1 + (`Grammar.FnPlan`). `exported` functions are bound to the module by their + export name, internal callees by their function index; `name` is the export + name, or `#` for an internal callee. `group` is the function's + call group (its SCC, in callee-first order): a function calls only + functions of its own group or of an earlier one. -/ +structure FnEntry where + name : String + exported : Bool + funcIdx : Nat + group : Nat + plan : FnPlan + +/-! ### Runtime helpers and their named contracts -/ + +/-- The runtime helper functions an obligation's host table wires. The box + helper is not among them: the obligation wires the wall's own `boxRef`, + whose body the acceptance pins by template equality. -/ +structure HostFns where + add : List WVal → Option WVal + sub : List WVal → Option WVal + mul : List WVal → Option WVal + cmp : List WVal → Option WVal + eq : List WVal → Option WVal + stringEq : List WVal → Option WVal + stringConcat : Nat → List WVal → Option WVal + toIndex : List WVal → Option WVal + divmod : List WVal → Option WVal + +/-- The named runtime contracts, exactly the premises schema 8 assumed: + integer add/sub/mul are exact with a canonical result; the three-way + comparison and the equality helper are exact on a CANONICAL CARRIER PAIR + (both helpers decide structurally, so on an arbitrary represented pair + they are not exact at all; canonicity is what rules that pair out, and + `tests/cert_intcmp_differential.rs` checks the assumption against the + running helpers); String equality is byte equality; String concatenation + concatenates the byte arrays of its container argument into an array of + its declared result type; `__aint_to_index` maps a represented Int to its + `i32` index or the `-1` sentinel; `__aint_divmod(a, b, want_mod)` on a + CANONICAL CARRIER PAIR with a nonzero divisor returns the canonical + Euclidean quotient (`want_mod = 0`, Lean's `Int` `/`, which is + `Int.ediv`) or remainder (`want_mod = 1`, `%`, `Int.emod`, in + `[0, |b|)`). A helper that returns `none` makes its premise vacuous: none + of these demands trap-freedom. -/ +structure HostContracts {C : Nat} (S : CarrierSpec C) (h : HostFns) : Prop where + add : ∀ a b va vb w, S.Repr a va → S.Repr b vb → h.add [va, vb] = some w → + S.Repr (a + b) w ∧ S.Canon w + sub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → h.sub [va, vb] = some w → + S.Repr (a - b) w ∧ S.Canon w + mul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → h.mul [va, vb] = some w → + S.Repr (a * b) w ∧ S.Canon w + cmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → + h.cmp [va, vb] = some r → r = .i32v (cmpW a b) + eq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → + h.eq [va, vb] = some r → r = .i32v (eqW a b) + stringEq : ∀ a b w, h.stringEq [a, b] = some w → w = b32 (stringEqW a b) + stringConcat : ∀ resultTy parts c, h.stringConcat resultTy [parts] = some c → + stringConcatW resultTy parts = some c + toIndex : ∀ n v r, S.Repr n v → h.toIndex [v] = some r → r = .i32v (toIndexW n) + divmod : ∀ a b va vb m r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → + b ≠ 0 → (m = 0 ∨ m = 1) → h.divmod [va, vb, .i32v m] = some r → + S.Repr (if m = 1 then a % b else a / b) r ∧ S.Canon r + +/-- The totality premises of an L3 obligation, selected by its totality role: + add and sub return on represented operands, and mul does too when the + role is `.mul`. -/ +structure HostTotal {C : Nat} (S : CarrierSpec C) (h : HostFns) (role : TotalityRole) : + Prop where + add : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, h.add [va, vb] = some w + sub : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, h.sub [va, vb] = some w + mul : role = .mul → ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, h.mul [va, vb] = some w + +/-! ### Obligations -/ + +/-- One certified export. `code` / `host` / `self` pin the emitted function + and its runtime wiring; `layout` is the byte-pinned module layout the + representation is read at; `sig` is the plan's signature and `model` the + plan's fuel-indexed meaning (at fuel `k + 1` the body runs with every + callee at fuel `k`, exactly as `wFuncN` peels fuel). The acceptance + requires every obligation to be the one the wall derives from the plans + (`AcceptedArtifact.obligationsOf`), so none of these fields is a producer + choice. -/ structure Obligation where export_ : String policy : Policy termination? : Option TerminationWitness := none totalityRole : TotalityRole := .addSub carrier : Nat + layout : MCtx code : CodeTbl - host : - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - HostTbl + host : HostFns → HostTbl self : Nat - Dom : Type - Cod : Type - domRepr : CarrierSpec carrier → Dom → List WVal → Prop - codRepr : CarrierSpec carrier → Cod → WVal → Prop - model : Dom → Cod - -/-- Denotation of `simulatesModel`: under any representation `S` and host - contracts obeying the named laws (integer add/sub/mul, integer three-way - comparison and equality, String.eq byte equality, and String.concat byte - concatenation), the emitted body run on a represented domain value yields a - represented result of `model x`. Partial correctness — vacuous on trap or - fuel exhaustion. Each contract is an assumed runtime law: the host helper - wired to that slot computes the named operation on represented values. - - The three arithmetic premises also conclude that the RESULT is canonical. - That is a statement about the helper's output alone: every arm of - `wat/addsub.wat` and `wat/mul.wat` either builds an in-band `Small` - directly or ends in the normalisation epilogue (`wat/normalize.wat`), so - whatever they return is in the runtime's normal form. Nothing is assumed - about non-canonical inputs. - - The two comparison premises are EXACT on the result, like `_hToIndex`, - because the helpers leave the carrier — they return a raw `i32` that no - representation relation describes. They are quantified over a CANONICAL - CARRIER PAIR: two represented operands that are both in the runtime's - normal form. That scoping is load-bearing rather than stylistic. Both - helpers decide STRUCTURALLY — `wat/eq.wat` compares shape and fields, - `wat/cmp.wat` branches on the raw sign fields — so on an arbitrary pair - they are not exact at all: a `Small` and a limb-carrying `Big` word can - represent the same integer and still compare unequal. Canonicity is - exactly the fact the proofs use to rule that pair out: `canonBig` puts a - canonical limb-carrying word outside the i64 band, and the BACKWARD - direction of `canonSmall` puts every canonical `Small` inside it, so the - two shapes cannot denote the same integer. - - What the two axioms do NOT do is make the real helpers exact. Exactness is - an assumption about `wat/cmp.wat` and `wat/eq.wat` at the runtime's own - carrier specification, stated here as a hypothesis and checked empirically - by `tests/cert_intcmp_differential.rs`. This denotation quantifies over - every `CarrierSpec`; an instance that marks non-normal-form words canonical - satisfies the schema, and simply is not the instance a verdict is read at. - - A NON-canonical operand is OUTSIDE THE CERTIFIED DOMAIN — the same - epistemic position as `toIndexW`'s `-1` region, stated rather than assumed - away: the obligation says nothing about it. It is also a state the emitted - runtime never builds: the i64 fast paths construct an in-band `Small` - directly (`wat/from_i64.wat`, and the both-`Small` arms of `wat/addsub.wat` - and `wat/mul.wat`), and every arm that can produce limbs ends in the - normalisation epilogue (`wat/normalize.wat`). Neither premise demands trap-freedom; a helper that - returns `none` makes the premise vacuous and the run yields nothing, - exactly as everywhere else in this denotation. -/ + sig : Sig + model : Nat → List SVal → Option SVal + +/-- Denotation of `simulatesModel`: under any carrier specification `S` and + any runtime helpers obeying the named contracts, a run of the emitted + function on represented, well-typed arguments that returns (at any fuel) + returns a represented, well-typed result of the plan's model at that fuel. + Partial correctness: vacuous on a trap or on fuel exhaustion. -/ def Obligation.holds (o : Obligation) : Prop := - ∀ (S : CarrierSpec o.carrier) - (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal) - (_hadd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → add [va, vb] = some w → - S.Repr (a + b) w ∧ S.Canon w) - (_hsub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → sub [va, vb] = some w → - S.Repr (a - b) w ∧ S.Canon w) - (_hmul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → mul [va, vb] = some w → - S.Repr (a * b) w ∧ S.Canon w) - (_hStringEq : ∀ a b w, stringEq [a, b] = some w → w = b32 (stringEqW a b)) - (_hStringConcat : ∀ resultTy parts c, stringConcat resultTy [parts] = some c → stringConcatW resultTy parts = some c) - (_hToIndex : ∀ n v r, S.Repr n v → toIndex [v] = some r → r = .i32v (toIndexW n)) - (_hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) - (_hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) - (fuel : Nat) (x : o.Dom) (vs : List WVal) (w : WVal), - o.domRepr S x vs → - wFuncN o.code (o.host add sub mul stringEq stringConcat toIndex cmp eq) fuel o.self vs = some w → - o.codRepr S (o.model x) w - -/-- Denotation of `simulatesModelTotally`, with its totality assumptions selected - by the obligation's byte-checked role. The ordinary `.addSub` branch has - exactly the pre-schema-60 premise surface: only integer add and sub must - return on represented operands. The `.mul` branch additionally assumes - multiplication totality and is admitted only for a byte-pinned unary - recursion whose combine role is `.mul`. In either branch the first domain - argument is the checked `Int.natAbs` counter and the body must return at fuel - `natAbs n + 1`; the tail carries any additional represented arguments. -/ + ∀ (S : CarrierSpec o.carrier) (h : HostFns), HostContracts S h → + ∀ (fuel : Nat) (svs : List SVal) (ws : List WVal) (r : WVal), + HasTyL o.layout svs o.sig.params → SReprL S o.layout svs ws → + wFuncN o.code (o.host h) fuel o.self ws = some r → + ∃ sv, o.model fuel svs = some sv ∧ SRepr S o.layout sv r ∧ HasTy o.layout sv o.sig.ret + +/-- Denotation of `simulatesModelTotally`: `holds`, and, under the totality + premises its role selects, every well-typed represented input has an Int + first argument `n`, the run at fuel `n.natAbs + 1` returns, and the model + at that fuel is defined and represented by the result. -/ def Obligation.holdsTotal (o : Obligation) : Prop := - match o.totalityRole with - | .addSub => - ∀ (S : CarrierSpec o.carrier) - (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal) - (_hadd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → add [va, vb] = some w → - S.Repr (a + b) w ∧ S.Canon w) - (_hsub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → sub [va, vb] = some w → - S.Repr (a - b) w ∧ S.Canon w) - (_hmul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → mul [va, vb] = some w → - S.Repr (a * b) w ∧ S.Canon w) - (_hStringEq : ∀ a b w, stringEq [a, b] = some w → w = b32 (stringEqW a b)) - (_hStringConcat : ∀ resultTy parts c, stringConcat resultTy [parts] = some c → stringConcatW resultTy parts = some c) - (_hToIndex : ∀ n v r, S.Repr n v → toIndex [v] = some r → r = .i32v (toIndexW n)) - (_hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) - (_hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) - (_hAddTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, add [va, vb] = some w) - (_hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, sub [va, vb] = some w) - (x : o.Dom) (vs : List WVal), o.domRepr S x vs → - ∃ n v tail, vs = v :: tail ∧ S.Repr n v ∧ - ∃ w, wFuncN o.code (o.host add sub mul stringEq stringConcat toIndex cmp eq) - (n.natAbs + 1) o.self vs = some w ∧ - o.codRepr S (o.model x) w - | .mul => - ∀ (S : CarrierSpec o.carrier) - (add sub mul stringEq : List WVal → Option WVal) - (stringConcat : Nat → List WVal → Option WVal) - (toIndex cmp eq : List WVal → Option WVal) - (_hadd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → add [va, vb] = some w → - S.Repr (a + b) w ∧ S.Canon w) - (_hsub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → sub [va, vb] = some w → - S.Repr (a - b) w ∧ S.Canon w) - (_hmul : ∀ a b va vb w, S.Repr a va → S.Repr b vb → mul [va, vb] = some w → - S.Repr (a * b) w ∧ S.Canon w) - (_hStringEq : ∀ a b w, stringEq [a, b] = some w → w = b32 (stringEqW a b)) - (_hStringConcat : ∀ resultTy parts c, stringConcat resultTy [parts] = some c → stringConcatW resultTy parts = some c) - (_hToIndex : ∀ n v r, S.Repr n v → toIndex [v] = some r → r = .i32v (toIndexW n)) - (_hCmp : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - cmp [va, vb] = some r → r = .i32v (cmpW a b)) - (_hEq : ∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → - eq [va, vb] = some r → r = .i32v (eqW a b)) - (_hAddTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, add [va, vb] = some w) - (_hSubTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, sub [va, vb] = some w) - (_hMulTot : ∀ a b va vb, S.Repr a va → S.Repr b vb → ∃ w, mul [va, vb] = some w) - (x : o.Dom) (vs : List WVal), o.domRepr S x vs → - ∃ n v tail, vs = v :: tail ∧ S.Repr n v ∧ - ∃ w, wFuncN o.code (o.host add sub mul stringEq stringConcat toIndex cmp eq) - (n.natAbs + 1) o.self vs = some w ∧ - o.codRepr S (o.model x) w - + o.holds ∧ + ∀ (S : CarrierSpec o.carrier) (h : HostFns), HostContracts S h → + HostTotal S h o.totalityRole → + ∀ (svs : List SVal) (ws : List WVal), + HasTyL o.layout svs o.sig.params → SReprL S o.layout svs ws → + ∃ n tl, svs = .i n :: tl ∧ ∃ r sv, + wFuncN o.code (o.host h) (n.natAbs + 1) o.self ws = some r ∧ + o.model (n.natAbs + 1) svs = some sv ∧ SRepr S o.layout sv r ∧ + HasTy o.layout sv o.sig.ret + +/-- The manifest: the subject, the declared type layout, every planned + function (`Plans.lean` data, one list), and the certified obligations. -/ structure Manifest where subject : Subject - symFragmentPlans : List (String × SymRawPlan) - stringEqPlans : List (String × StringEqRawPlan) - stringConcatPlans : List (String × StringConcatRawPlan) - constructPlans : List (String × ConstructRawPlan) - exprFragmentPlans : List (String × ExprFragmentRawPlan) - recursionPlans : List (String × RecursionRawPlan) - mutualPlans : List (String × MutualRawPlan) - compositionPlans : List (String × CompositionRawPlan) - verbatimPlans : List (String × VerbatimRawPlan) - intDispatchPlans : List (String × IntDispatchRawPlan) - fieldProjectionPlans : List (String × FieldProjectionRawPlan) + types : TypeTable + fnPlans : List FnEntry obligations : List Obligation /-- The artifact-independent part of the audited certificate proposition: diff --git a/aver-cert/assets/wall/current/SchemaSanity.lean b/aver-cert/assets/wall/current/SchemaSanity.lean index 4f51936d0..d1d181625 100644 --- a/aver-cert/assets/wall/current/SchemaSanity.lean +++ b/aver-cert/assets/wall/current/SchemaSanity.lean @@ -3,7 +3,10 @@ `CertPreludeSanity` deliberately imports only `CertPrelude` — the decoder differential stages it as a standalone three-file package — so anything that - needs `Schema` lives here instead. Like that file, this one is a repo-side + needs `Schema` lives here instead: the carrier-specification witness, a + witness that the named host contracts are jointly satisfiable, and S-6 + negatives (ill-typed plans are rejected by the typing the whole statement + rests on). Like that file, this one is a repo-side gate: it is a root of the wall's own lakefile and is NOT in `wall.rs`'s `SOURCES` or `PRISTINE_ROOTS`, so it is built by `lake build` in this directory and never shipped inside a certificate package. @@ -150,4 +153,65 @@ example (C lty : Nat) (les : List WVal) (s : Int) : subst hsgEq rcases hsg with h | h <;> simp at h +/-! ## The named host contracts are jointly satisfiable + +Trap-only helpers satisfy every contract of `HostContracts` (a helper that +returns nothing makes its premise vacuous), so the premise surface of +`Obligation.holds` is never contradictory: the obligation is not vacuously +true through its contracts. -/ + +def trapHost : HostFns := + { add := fun _ => none, sub := fun _ => none, mul := fun _ => none, cmp := fun _ => none, + eq := fun _ => none, stringEq := fun _ => none, stringConcat := fun _ _ => none, + toIndex := fun _ => none, divmod := fun _ => none } + +example (C : Nat) : HostContracts (sanityCarrierSpec C) trapHost where + add := by intro _ _ _ _ _ _ _ h; cases h + sub := by intro _ _ _ _ _ _ _ h; cases h + mul := by intro _ _ _ _ _ _ _ h; cases h + cmp := by intro _ _ _ _ _ _ _ _ _ h; cases h + eq := by intro _ _ _ _ _ _ _ _ _ h; cases h + stringEq := by intro _ _ _ h; cases h + stringConcat := by intro _ _ _ h; cases h + divmod := by intro _ _ _ _ _ _ _ _ _ _ _ _ h; cases h + toIndex := by intro _ _ _ _ h; cases h + +/-! ## S-6: typing is load-bearing, and ill-typed plans decline -/ + +open AverCert.Grammar in +def sanityM : MCtx := + { carrier := 2, box := 7, add := 8, sub := 9, mul := 10, neg := 11, cmp := 12, eq := 13, + structOf := fun _ => 0, recFields := fun _ => none, sigs := fun _ => none } + +open AverCert.Grammar in +/-- A well-typed plan: `n + 1` at `Int -> Int`. -/ +example : planTyped sanityM + { sig := ⟨[.int], .int⟩, nslots := 1, locals := [.int], + body := .binOp .add (.local 0) (.literal (.int 1)) } = true := by decide + +open AverCert.Grammar in +/-- `if n then 1 else 0` over an Int condition declines. -/ +example : planTyped sanityM + { sig := ⟨[.int], .int⟩, nslots := 1, locals := [.int], + body := .ifThenElse (.local 0) (.literal (.int 1)) (.literal (.int 0)) } = false := by + decide + +open AverCert.Grammar in +/-- A declared result type the body does not have declines. -/ +example : planTyped sanityM + { sig := ⟨[.int], .bool⟩, nslots := 1, locals := [.int], + body := .binOp .add (.local 0) (.literal (.int 1)) } = false := by decide + +open AverCert.Grammar in +/-- A call to a function with no plan (no signature) declines. -/ +example : planTyped sanityM + { sig := ⟨[.int], .int⟩, nslots := 1, locals := [.int], + body := .call (.fn 3) [.local 0] } = false := by decide + +open AverCert.Grammar in +/-- An Int literal outside the i64 band declines. -/ +example : planTyped sanityM + { sig := ⟨[], .int⟩, nslots := 0, locals := [.int], + body := .literal (.int (2 ^ 63)) } = false := by decide + end AverCert.Schema diff --git a/aver-cert/assets/wall/current/SortedKeys.lean b/aver-cert/assets/wall/current/SortedKeys.lean new file mode 100644 index 000000000..ab2c7ed80 --- /dev/null +++ b/aver-cert/assets/wall/current/SortedKeys.lean @@ -0,0 +1,530 @@ +-- Set-shaped checks on sorted numeric keys. +import DeclaredLayout + +set_option linter.unusedSimpArgs false + +namespace AverCert.SortedKeys +open AverCert.AcceptedArtifact + +/-! ### Merge sort on numbers + +The accounting checks index names in balanced trees (`WasmSlice.orderedSet`). +The kernel pays each insertion with a walk through the tree's rebalancing +code, a few thousand steps per name, while a merge of two sorted lists pays +one comparison of two numerals per element. The checks below sort the keys +once and then walk the sorted lists; the lemmas show that what they decide +implies the tree-based accounting. -/ + +def merge : Nat → List Nat → List Nat → List Nat + | 0, xs, ys => xs ++ ys + | _ + 1, [], ys => ys + | _ + 1, x :: xs, [] => x :: xs + | f + 1, x :: xs, y :: ys => + if x ≤ y then x :: merge f xs (y :: ys) else y :: merge f (x :: xs) ys + +theorem merge_perm : ∀ (f : Nat) (xs ys : List Nat), (merge f xs ys).Perm (xs ++ ys) + | 0, xs, ys => List.Perm.refl _ + | _ + 1, [], ys => List.Perm.refl _ + | _ + 1, x :: xs, [] => by simp [merge] + | f + 1, x :: xs, y :: ys => by + unfold merge + split + · exact (merge_perm f xs (y :: ys)).cons x + · have h := (merge_perm f (x :: xs) ys).cons y + exact h.trans (by simpa using (List.perm_middle (a := y) (l₁ := x :: xs) (l₂ := ys)).symm) + +def mergePairs (f : Nat) : List (List Nat) → List (List Nat) + | a :: b :: rest => merge f a b :: mergePairs f rest + | rest => rest + +theorem mergePairs_perm (f : Nat) : ∀ runs : List (List Nat), + (mergePairs f runs).flatten.Perm runs.flatten + | a :: b :: rest => by + simp only [mergePairs, List.flatten_cons, ← List.append_assoc] + exact (merge_perm f a b).append (mergePairs_perm f rest) + | [] => List.Perm.refl _ + | [_] => List.Perm.refl _ + +def sortRuns (f : Nat) : Nat → List (List Nat) → List Nat + | 0, runs => runs.flatten + | _ + 1, [] => [] + | _ + 1, [r] => r + | k + 1, a :: b :: rest => sortRuns f k (mergePairs f (a :: b :: rest)) + +theorem sortRuns_perm (f : Nat) : ∀ (k : Nat) (runs : List (List Nat)), + (sortRuns f k runs).Perm runs.flatten + | 0, _ => List.Perm.refl _ + | _ + 1, [] => List.Perm.refl _ + | _ + 1, [r] => by simp [sortRuns] + | k + 1, a :: b :: rest => by + simp only [sortRuns] + exact (sortRuns_perm f k _).trans (mergePairs_perm f _) + +/-- Merge sort, bottom up: every merge is given enough steps for the whole + list, and 64 rounds halve any list to one run. -/ +def msort (xs : List Nat) : List Nat := sortRuns (xs.length + 1) 64 (xs.map (fun x => [x])) + +theorem msort_perm (xs : List Nat) : (msort xs).Perm xs := by + unfold msort + refine (sortRuns_perm _ _ _).trans ?_ + induction xs with + | nil => exact List.Perm.refl _ + | cons x xs ih => simpa using ih.cons x + +/-- Strictly increasing. -/ +def strictly : List Nat → Bool + | x :: y :: rest => decide (x < y) && strictly (y :: rest) + | _ => true + +theorem strictly_tail {x : Nat} {xs : List Nat} (h : strictly (x :: xs) = true) : strictly xs = true := by + cases xs with + | nil => rfl + | cons y ys => + simp only [strictly, Bool.and_eq_true, decide_eq_true_eq] at h + exact h.2 + +theorem strictly_lt : ∀ {x : Nat} {xs : List Nat}, strictly (x :: xs) = true → ∀ y ∈ xs, x < y + | _, [], _, _, hy => by cases hy + | x, z :: zs, h, y, hy => by + simp only [strictly, Bool.and_eq_true, decide_eq_true_eq] at h + cases hy with + | head => exact h.1 + | tail _ hy' => exact Nat.lt_trans h.1 (strictly_lt h.2 y hy') + +theorem strictly_nodup : ∀ {xs : List Nat}, strictly xs = true → xs.Nodup + | [], _ => List.nodup_nil + | x :: _, h => List.nodup_cons.mpr + ⟨fun hx => Nat.lt_irrefl x (strictly_lt h x hx), strictly_nodup (strictly_tail h)⟩ + +/-- Every element of `s` is in `t`, walking both in order. -/ +def subsetW : Nat → List Nat → List Nat → Bool + | _, [], _ => true + | 0, _ :: _, _ => false + | _ + 1, _ :: _, [] => false + | f + 1, x :: xs, y :: ys => + if x = y then subsetW f xs ys else if y < x then subsetW f (x :: xs) ys else false + +theorem subsetW_mem : ∀ {f : Nat} {s t : List Nat}, subsetW f s t = true → ∀ x ∈ s, x ∈ t + | _, [], _, _, _, hx => by cases hx + | 0, _ :: _, _, h, _, _ => by simp [subsetW] at h + | _ + 1, _ :: _, [], h, _, _ => by simp [subsetW] at h + | f + 1, a :: as, b :: bs, h, x, hx => by + unfold subsetW at h + split at h + · rename_i hab + subst hab + cases hx with + | head => exact List.mem_cons_self + | tail _ hx' => exact List.mem_cons_of_mem _ (subsetW_mem h x hx') + · split at h + · exact List.mem_cons_of_mem _ (subsetW_mem h x hx) + · cases h + +/-- No element of `s` is in `t`, walking both (strictly increasing) in order. -/ +def disjointW : Nat → List Nat → List Nat → Bool + | _, [], _ => true + | _, _ :: _, [] => true + | 0, _ :: _, _ :: _ => false + | f + 1, x :: xs, y :: ys => + if x = y then false else if x < y then disjointW f xs (y :: ys) else disjointW f (x :: xs) ys + +theorem disjointW_sound : ∀ {f : Nat} {s t : List Nat}, strictly s = true → strictly t = true → + disjointW f s t = true → ∀ x ∈ s, x ∈ t → False + | _, [], _, _, _, _, _, hx, _ => by cases hx + | _, _ :: _, [], _, _, _, _, _, ht => by cases ht + | 0, _ :: _, _ :: _, _, _, h, _, _, _ => by simp [disjointW] at h + | f + 1, a :: as, b :: bs, hs, ht, h, x, hx, hmem => by + unfold disjointW at h + split at h + · cases h + · rename_i hne + split at h + · rename_i hlt + cases hx with + | head => + cases hmem with + | head => exact hne rfl + | tail _ hmem' => exact Nat.lt_asymm hlt (strictly_lt ht _ hmem') + | tail _ hx' => exact disjointW_sound (strictly_tail hs) ht h x hx' hmem + · rename_i hge + cases hmem with + | head => + cases hx with + | head => exact hne rfl + | tail _ hx' => exact Nat.lt_irrefl _ (Nat.lt_of_lt_of_le (strictly_lt hs _ hx') + (Nat.le_of_not_lt (by omega))) + | tail _ hmem' => exact disjointW_sound hs (strictly_tail ht) h x hx hmem' + +/-- Every element of `as` is in `cs`, or its quotient by `2 ^ 64` is in `ds`: + a walk over three lists in order. -/ +def cover : Nat → List Nat → List Nat → List Nat → Bool + | _, [], _, _ => true + | 0, _ :: _, _, _ => false + | f + 1, a :: as, cs, ds => + match cs, ds with + | c :: cs', ds => + if a = c then cover f as cs' ds + else match ds with + | d :: ds' => if a / 18446744073709551616 = d then cover f as (c :: cs') ds' else false + | [] => false + | [], d :: ds' => if a / 18446744073709551616 = d then cover f as [] ds' else false + | [], [] => false + +theorem cover_sound : ∀ {f : Nat} {as cs ds : List Nat}, cover f as cs ds = true → + ∀ a ∈ as, a ∈ cs ∨ a / 18446744073709551616 ∈ ds + | _, [], _, _, _, _, ha => by cases ha + | 0, _ :: _, _, _, h, _, _ => by simp [cover] at h + | f + 1, x :: xs, cs, ds, h, a, ha => by + unfold cover at h + split at h + · rename_i c cs' ds0 + split at h + · rename_i hxc + cases ha with + | head => exact Or.inl (hxc ▸ List.mem_cons_self) + | tail _ ha' => + rcases cover_sound h a ha' with h1 | h1 + · exact Or.inl (List.mem_cons_of_mem _ h1) + · exact Or.inr h1 + · split at h + · rename_i d ds' + split at h + · rename_i hxd + cases ha with + | head => exact Or.inr (hxd ▸ List.mem_cons_self) + | tail _ ha' => + rcases cover_sound h a ha' with h1 | h1 + · exact Or.inl h1 + · exact Or.inr (List.mem_cons_of_mem _ h1) + · cases h + · cases h + · rename_i d ds' + split at h + · rename_i hxd + cases ha with + | head => exact Or.inr (hxd ▸ List.mem_cons_self) + | tail _ ha' => + rcases cover_sound h a ha' with h1 | h1 + · exact Or.inl h1 + · exact Or.inr (List.mem_cons_of_mem _ h1) + · cases h + · cases h + +/-! ### What the balanced-tree checks decide -/ + +theorem foldl_contains {α : Type} [Ord α] [Std.TransOrd α] [Std.LawfulEqOrd α] : + ∀ (xs : List α) (t : Std.TreeSet α compare) (a : α), + (xs.foldl (fun set value => set.insert value) t).contains a = true ↔ t.contains a = true ∨ a ∈ xs + | [], t, a => by simp + | x :: xs, t, a => by + rw [List.foldl_cons, foldl_contains xs (t.insert x) a, Std.TreeSet.contains_insert] + simp only [Bool.or_eq_true, beq_iff_eq, Std.LawfulEqCmp.compare_eq_iff_eq, List.mem_cons] + constructor + · rintro ((rfl | h) | h) + · exact Or.inr (Or.inl rfl) + · exact Or.inl h + · exact Or.inr (Or.inr h) + · rintro (h | rfl | h) + · exact Or.inl (Or.inr h) + · exact Or.inl (Or.inl rfl) + · exact Or.inr h + +theorem orderedSet_contains {α : Type} [Ord α] [Std.TransOrd α] [Std.LawfulEqOrd α] (xs : List α) + (a : α) : (AverCert.WasmSlice.orderedSet xs).contains a = true ↔ a ∈ xs := by + unfold AverCert.WasmSlice.orderedSet + rw [foldl_contains] + simp + +theorem foldl_size {α : Type} [Ord α] [Std.TransOrd α] [Std.LawfulEqOrd α] : + ∀ (xs : List α) (t : Std.TreeSet α compare), xs.Nodup → (∀ y ∈ xs, t.contains y = false) → + (xs.foldl (fun set value => set.insert value) t).size = t.size + xs.length + | [], t, _, _ => by simp + | x :: xs, t, hnd, hout => by + rw [List.foldl_cons] + have hx := hout x List.mem_cons_self + obtain ⟨hnx, hnd'⟩ := List.nodup_cons.mp hnd + rw [foldl_size xs (t.insert x) hnd' (fun y hy => ?_), Std.TreeSet.size_insert] + · simp [hx]; omega + · rw [Std.TreeSet.contains_insert] + simp only [Bool.or_eq_false_iff, beq_eq_false_iff_ne, ne_eq, + Std.LawfulEqCmp.compare_eq_iff_eq] + exact ⟨fun h => hnx (h ▸ hy), hout y (List.mem_cons_of_mem _ hy)⟩ + +theorem natListNodup_of_nodup {xs : List Nat} (h : xs.Nodup) : + AverCert.WasmSlice.natListNodup xs = true := by + unfold AverCert.WasmSlice.natListNodup AverCert.WasmSlice.indexedNodup + AverCert.WasmSlice.orderedSet + dsimp only + rw [foldl_size xs _ h (fun y _ => by simp)] + simp + +/-- The derived order on export keys is lexicographic on its three numbers. -/ +theorem compare_exportKey (a b : ExportKey) : + compare a b = compareLex (compareOn ExportKey.name) + (compareLex (compareOn ExportKey.kind) (compareOn ExportKey.idx)) a b := by + cases a; cases b + simp only [compare, instOrdExportKey.ord, compareLex, compareOn] + rename_i n1 k1 i1 n2 k2 i2 + generalize compareOfLessAndEq i1 i2 = o + cases o <;> rfl + +instance : Std.TransOrd ExportKey := by + have h : (compare : ExportKey → ExportKey → Ordering) = compareLex (compareOn ExportKey.name) + (compareLex (compareOn ExportKey.kind) (compareOn ExportKey.idx)) := by + funext a b; exact compare_exportKey a b + unfold Std.TransOrd + rw [h] + infer_instance + +instance : Std.LawfulEqOrd ExportKey where + eq_of_compare {a b} h := by + rw [compare_exportKey] at h + simp only [compareLex_eq_eq, compareOn, Std.LawfulEqCmp.compare_eq_iff_eq] at h + cases a; cases b + simp only at h + obtain ⟨h1, h2, h3⟩ := h + subst h1; subst h2; subst h3; rfl + +/-! ### The export accounting on sorted keys -/ + +/-- An export key as one number: its name key above its kind and index. -/ +def entryNum (k : ExportKey) : Nat := k.name * 18446744073709551616 + k.kind * 4294967296 + k.idx + +def keyBounded (k : ExportKey) : Bool := decide (k.kind < 4294967296) && decide (k.idx < 4294967296) + +theorem entryNum_div {k : ExportKey} (h : keyBounded k = true) : + entryNum k / 18446744073709551616 = k.name := by + simp only [keyBounded, Bool.and_eq_true, decide_eq_true_eq] at h + unfold entryNum; omega + +theorem entryNum_inj {a b : ExportKey} (ha : keyBounded a = true) (hb : keyBounded b = true) + (h : entryNum a = entryNum b) : a = b := by + simp only [keyBounded, Bool.and_eq_true, decide_eq_true_eq] at ha hb + unfold entryNum at h + cases a; cases b + simp only [ExportKey.mk.injEq] + simp only at ha hb h + refine ⟨?_, ?_, ?_⟩ <;> omega + +/-- The accounting of the actual export keys `A` against the certified keys `C` + and the declared name keys `D`, decided on sorted lists. -/ +def accountedSorted (A C : List ExportKey) (D : List Nat) : Bool := + let an := msort (A.map (·.name)) + let cn := msort (C.map (·.name)) + let dn := msort D + let ae := msort (A.map entryNum) + let ce := msort (C.map entryNum) + A.all keyBounded && C.all keyBounded && + strictly an && strictly cn && strictly dn && + disjointW (cn.length + dn.length + 1) cn dn && + cover (ae.length + 1) ae ce dn && + subsetW (ce.length + ae.length + 1) ce ae && + subsetW (dn.length + an.length + 1) dn an + +/-- `exportsAccountedOf`, with the module's export entries given. -/ +def exportsAccountedFast (actual certified : List AverCert.WasmSlice.ExportEntry) + (declared : List AverCert.WasmSlice.ByteSeq) : Bool := + match actual.mapM exportEntryKey, certified.mapM exportEntryKey, + AverCert.WasmSlice.seqKeys declared with + | some A, some C, some D => accountedSorted A C D + | _, _, _ => false + +theorem mem_msort {xs : List Nat} {x : Nat} : x ∈ msort xs ↔ x ∈ xs := (msort_perm xs).mem_iff + +theorem nodup_of_msort {xs : List Nat} (h : strictly (msort xs) = true) : xs.Nodup := + (msort_perm xs).nodup_iff.mp (strictly_nodup h) + +theorem exportsAccountedOf_of_fast {n len : Nat} + {E : Option (List AverCert.WasmSlice.ExportEntry)} + (hE : AverCert.WasmSlice.enumExports n len = E) + {certified : List AverCert.WasmSlice.ExportEntry} {declared : List AverCert.WasmSlice.ByteSeq} + (h : (match E with + | some actual => exportsAccountedFast actual certified declared + | none => false) = true) : + exportsAccountedOf n len certified declared = true := by + unfold exportsAccountedOf + rw [hE] + cases E with + | none => cases h + | some actual => + simp only at h ⊢ + unfold exportsAccountedFast at h + split at h + · rename_i A C D hA hC hD + simp only [hA, hC, hD] + unfold accountedSorted at h + simp only [Bool.and_eq_true, List.all_eq_true] at h + obtain ⟨⟨⟨⟨⟨⟨⟨⟨hAb, hCb⟩, han⟩, hcn⟩, hdn⟩, hdis⟩, hcov⟩, hsub1⟩, hsub2⟩ := h + simp only [Bool.and_eq_true, List.all_eq_true, Bool.or_eq_true, Bool.not_eq_true', + orderedSet_contains] + refine ⟨⟨⟨⟨⟨⟨natListNodup_of_nodup (nodup_of_msort han), + natListNodup_of_nodup (nodup_of_msort hcn)⟩, natListNodup_of_nodup (nodup_of_msort hdn)⟩, + ?_⟩, ?_⟩, ?_⟩, ?_⟩ + · intro name hname + apply Bool.eq_false_iff.mpr + intro hmem + rw [orderedSet_contains] at hmem + exact disjointW_sound hcn hdn hdis name (mem_msort.mpr hname) (mem_msort.mpr hmem) + · intro e he + rcases cover_sound hcov (entryNum e) (mem_msort.mpr (List.mem_map_of_mem he)) with h1 | h1 + · left + obtain ⟨c, hc, hce⟩ := List.mem_map.mp (mem_msort.mp h1) + rw [entryNum_inj (hCb c hc) (hAb e he) hce] at hc + exact hc + · right + rw [entryNum_div (hAb e he)] at h1 + exact mem_msort.mp h1 + · intro c hc + have := subsetW_mem hsub1 (entryNum c) (mem_msort.mpr (List.mem_map_of_mem hc)) + obtain ⟨a, ha, hae⟩ := List.mem_map.mp (mem_msort.mp this) + rw [← entryNum_inj (hAb a ha) (hCb c hc) hae] + exact ha + · intro d hd + exact mem_msort.mp (subsetW_mem hsub2 d (mem_msort.mpr hd)) + · cases h + +/-! ### Distinct export names, from the accounting -/ + +theorem mapM_key_names : ∀ (es : List AverCert.WasmSlice.ExportEntry), + (es.mapM exportEntryKey).map (fun ks => ks.map (·.name)) = + AverCert.WasmSlice.seqKeys (es.map (·.name)) + | [] => rfl + | e :: es => by + have ih := mapM_key_names es + unfold AverCert.WasmSlice.seqKeys at ih ⊢ + simp only [List.mapM_cons, List.map_cons] + have hk : exportEntryKey e = (AverCert.WasmSlice.seqKey e.name).map + (fun name => ({ name := name, kind := e.kind, idx := e.idx } : ExportKey)) := rfl + rw [hk] + cases h1 : AverCert.WasmSlice.seqKey e.name <;> + cases h2 : es.mapM exportEntryKey <;> simp_all <;> (rw [← ih]; rfl) + +/-- The accounting decides that the module's export names are distinct, so a + check that needs them distinct reads it from there instead of deciding it + again. -/ +theorem exportNamesDistinct_of_accounted {n len : Nat} + {certified : List AverCert.WasmSlice.ExportEntry} {declared : List AverCert.WasmSlice.ByteSeq} + (h : exportsAccountedOf n len certified declared = true) : + AverCert.DeclaredLayout.exportNamesDistinct n len = true := by + unfold exportsAccountedOf at h + unfold AverCert.DeclaredLayout.exportNamesDistinct byteSeqListNodup + unfold AverCert.WasmSlice.enumExports at h + cases hE : CertDecode.decodeRawExports n len with + | none => simp [hE] at h + | some actual => + simp only [hE] at h ⊢ + split at h + · rename_i A C D hA hC hD + have hk := mapM_key_names actual + rw [hA, Option.map_some] at hk + rw [← hk] + simp only [Bool.and_eq_true] at h + exact h.1.1.1.1.1.1 + · cases h + +/-! ### Closure isolation on sorted lists and a membership bitmap -/ + +theorem natSetEq_of_sorted {xs ys : List Nat} + (h1 : subsetW ((msort xs).length + (msort ys).length + 1) (msort xs) (msort ys) = true) + (h2 : subsetW ((msort ys).length + (msort xs).length + 1) (msort ys) (msort xs) = true) : + AverCert.WasmSlice.natSetEq xs ys = true := by + unfold AverCert.WasmSlice.natSetEq AverCert.WasmSlice.indexedSetEq AverCert.WasmSlice.indexedSubset + simp only [Bool.and_eq_true, List.all_eq_true, orderedSet_contains] + exact ⟨fun x hx => mem_msort.mp (subsetW_mem h1 x (mem_msort.mpr hx)), + fun y hy => mem_msort.mp (subsetW_mem h2 y (mem_msort.mpr hy))⟩ + +/-- `natSetEq` on sorted lists. -/ +def setEqSorted (xs ys : List Nat) : Bool := + let sx := msort xs + let sy := msort ys + subsetW (sx.length + sy.length + 1) sx sy && subsetW (sy.length + sx.length + 1) sy sx + +theorem natSetEq_of_setEqSorted {xs ys : List Nat} (h : setEqSorted xs ys = true) : + AverCert.WasmSlice.natSetEq xs ys = true := by + unfold setEqSorted at h + simp only [Bool.and_eq_true] at h + exact natSetEq_of_sorted h.1 h.2 + +theorem natMem_iff : ∀ (x : Nat) (xs : List Nat), AverCert.WasmSlice.natMem x xs = true ↔ x ∈ xs + | _, [] => by simp [AverCert.WasmSlice.natMem] + | x, y :: ys => by + simp only [AverCert.WasmSlice.natMem, Bool.or_eq_true, beq_iff_eq, natMem_iff x ys, + List.mem_cons] + +/-- `DeclaredLayout.closureFoldWith`, with the seen functions also kept as a + bitmap, so that asking whether a function was seen is one numeral test. -/ +def closureFoldB (look : Nat → Option AverCert.WasmSlice.ByteSeq) : + Nat → List Nat → List Nat → Nat → Option (List Nat) + | 0, [], seen, _ => some seen + | 0, _ :: _, _, _ => none + | _ + 1, [], seen, _ => some seen + | fuel + 1, func :: work, seen, bits => + if bits.testBit func then closureFoldB look fuel work seen bits + else + match (look func).bind AverCert.WasmSlice.scanClosureCodeEntry with + | some callees => closureFoldB look fuel (callees ++ work) (func :: seen) (bits ||| (1 <<< func)) + | none => none + +theorem closureFoldB_eq (look : Nat → Option AverCert.WasmSlice.ByteSeq) : + ∀ (fuel : Nat) (work seen : List Nat) (bits : Nat), (∀ x, bits.testBit x = true ↔ x ∈ seen) → + closureFoldB look fuel work seen bits = + AverCert.DeclaredLayout.closureFoldWith look fuel work seen + | 0, [], _, _, _ => rfl + | 0, _ :: _, _, _, _ => rfl + | _ + 1, [], _, _, _ => rfl + | fuel + 1, func :: work, seen, bits, hb => by + have hmem : bits.testBit func = AverCert.WasmSlice.natMem func seen := by + apply Bool.eq_iff_iff.mpr + rw [hb, natMem_iff] + simp only [closureFoldB, AverCert.DeclaredLayout.closureFoldWith, hmem] + split + · exact closureFoldB_eq look fuel work seen bits hb + · cases (look func).bind AverCert.WasmSlice.scanClosureCodeEntry with + | none => rfl + | some callees => + simp only + apply closureFoldB_eq look fuel _ _ _ + intro x + rw [Nat.testBit_or, Nat.shiftLeft_eq, Nat.one_mul, Nat.testBit_two_pow, Bool.or_eq_true, + hb, List.mem_cons, decide_eq_true_eq] + constructor + · rintro (h | rfl) + · exact Or.inr h + · exact Or.inl rfl + · rintro (rfl | h) + · exact Or.inr rfl + · exact Or.inl h + +/-- `DeclaredLayout.closureIsolationL`, on sorted lists and the bitmap fold. -/ +def closureIsolationS (artifact : ArtifactData) (L : AverCert.DeclaredLayout.Layout) : Bool := + let claim := artifact.closureClaim + let certified := artifact.manifest.obligations.map (fun obligation => obligation.self) + strictly (msort claim.roots) && + strictly (msort claim.helpers) && + strictly (msort claim.admitted) && + setEqSorted claim.roots certified && + claim.roots.all (fun root => !AverCert.WasmSlice.natMem root claim.helpers) && + setEqSorted claim.admitted (claim.roots ++ claim.helpers) && + AverCert.WasmSlice.noSharedMemory artifact.modBytes artifact.modLen && + match closureFoldB (L.entryAt artifact.modBytes) artifact.closureFuel claim.roots [] 0 with + | some actual => setEqSorted actual claim.admitted + | none => false + +theorem closureIsolationL_of_S {artifact : ArtifactData} {L : AverCert.DeclaredLayout.Layout} + (h : closureIsolationS artifact L = true) : + AverCert.DeclaredLayout.closureIsolationL artifact L = true := by + unfold closureIsolationS at h + unfold AverCert.DeclaredLayout.closureIsolationL + simp only [Bool.and_eq_true] at h ⊢ + obtain ⟨⟨⟨⟨⟨⟨⟨h1, h2⟩, h3⟩, h4⟩, h5⟩, h6⟩, h7⟩, h8⟩ := h + refine ⟨⟨⟨⟨⟨⟨⟨natListNodup_of_nodup (nodup_of_msort h1), natListNodup_of_nodup (nodup_of_msort h2)⟩, + natListNodup_of_nodup (nodup_of_msort h3)⟩, natSetEq_of_setEqSorted h4⟩, h5⟩, + natSetEq_of_setEqSorted h6⟩, h7⟩, ?_⟩ + rw [← closureFoldB_eq _ _ _ _ 0 (fun x => by simp)] + split at h8 + · rename_i actual hact + rw [hact] + exact natSetEq_of_setEqSorted h8 + · cases h8 + +end AverCert.SortedKeys diff --git a/aver-cert/assets/wall/current/StandardFace.lean b/aver-cert/assets/wall/current/StandardFace.lean deleted file mode 100644 index 51795af91..000000000 --- a/aver-cert/assets/wall/current/StandardFace.lean +++ /dev/null @@ -1,2120 +0,0 @@ -/- -The semantic face of an accepted obligation is selected from the checked -claim and plan data. The certificate may still provide source declarations -for models that cannot be reconstructed from Wasm, but it may not weaken the -standard domain, codomain, or representation relations of a known family. --/ -import AcceptedArtifactCore -import ConstructVerbatimSoundness -import RecordComputeBridge -import FieldProjectionSoundness -import StringSoundness -import DeclaredEnvelopeAcceptTransport - -namespace AverCert.StandardFace - -open AverCert.Schema -open AverCert.AcceptedArtifact -open CertPrelude - -/-- The complete host builder stored in an obligation. Faces bind the whole - function, not a finite set of probes, so no unmentioned input can turn a - claimed contract into a trap. -/ -abbrev HostBuilder := - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (Nat → List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → - (List WVal → Option WVal) → HostTbl - -def emptyHost : HostBuilder := fun _ _ _ _ _ _ _ _ _ => none - -def decodedRoleIdx (roles : CertDecode.AddSub.Roles) : HostRole → Option Nat - | .box => roles.box - | .add => roles.add - | .mul => roles.mul - | .sub => roles.sub - | .toIndex => roles.toIndex - | .cmp => roles.cmp - | .eq => roles.eq - -/-- Every role/index pair used by a claim must agree with the unique table - decoded from the module. Family checkers already require every role their - plan consumes; distinct indices make the lookup extensional and reject - duplicate or aliased role entries. -/ -def hostTableBound - (roles : CertDecode.AddSub.Roles) - (hostTable : List (HostRole × Nat)) : Bool := - AverCert.PlanCheck.hostTableIndicesDistinct hostTable && - hostTable.all fun entry => decodedRoleIdx roles entry.1 == some entry.2 - -/-- A fully specified obligation face. `model? = none` keeps the source model - as a read declaration; every other field remains fixed by the checked - family. -/ -structure FaceSpec where - carrier : Nat - Dom : Type - Cod : Type - domRepr : CarrierSpec carrier → Dom → List WVal → Prop - codRepr : CarrierSpec carrier → Cod → WVal → Prop - host : HostBuilder - model? : Option (Dom → Cod) := none - -/-- Known families have a complete standard face. The former `adtIntRead` / - `adtConstructorRead` arms left `Dom`/`domRepr`/`model` unconstrained; user - ADT claims are now pinned by the declared-index envelope faces below. -/ -inductive StandardFace where - | known (spec : FaceSpec) - -/-- Dependent fields are compared with `HEq`: ordinary equality cannot state - the relation before the domain and codomain types have been identified. -/ -def StandardFace.Matches : StandardFace → Obligation → Prop - | .known spec, obligation => - obligation.carrier = spec.carrier ∧ - HEq obligation.Dom spec.Dom ∧ - HEq obligation.Cod spec.Cod ∧ - HEq obligation.domRepr spec.domRepr ∧ - HEq obligation.codRepr spec.codRepr ∧ - obligation.host = spec.host ∧ - match spec.model? with - | some model => HEq obligation.model model - | none => True - -def intList (carrier arity : Nat) (host : HostBuilder) : FaceSpec where - carrier := carrier - Dom := List Int - Cod := Int - domRepr := fun S ns vs => ReprAll S.Repr ns vs ∧ ns.length = arity - codRepr := intRepr - host := host - -def projection (carrier structIdx fieldIdx : Nat) : FaceSpec where - carrier := carrier - Dom := WVal × WVal - Cod := WVal - domRepr := fun _ p vs => vs = [.structv structIdx [p.1, p.2]] - codRepr := verbatimRepr - host := emptyHost - model? := some (fun p => - FieldProjectionSoundness.pairProjection fieldIdx p.1 p.2) - -def verbatim (carrier : Nat) (plan : VerbatimRawPlan) : FaceSpec where - carrier := carrier - Dom := WVal - Cod := WVal - domRepr := fun _ v vs => vs = [v] - codRepr := verbatimRepr - host := emptyHost - model? := some (ConstructVerbatimSoundness.verbatimModel plan) - -def stringEq - (carrier stringTy helperIdx : Nat) (plan : StringEqRawPlan) : FaceSpec where - carrier := carrier - Dom := WVal - Cod := WVal - domRepr := fun _ v vs => vs = [v] - codRepr := verbatimRepr - host := stringEqCanonicalHost helperIdx - model? := some (StringSoundness.evalStringEq stringTy plan) - -def stringConcat - (carrier resultTy containerTy helperIdx : Nat) - (plan : StringConcatRawPlan) : FaceSpec where - carrier := carrier - Dom := WVal - Cod := WVal - domRepr := fun _ v vs => vs = [v] - codRepr := verbatimRepr - host := stringConcatCanonicalHost helperIdx resultTy - model? := some (StringSoundness.evalStringConcat resultTy containerTy plan) - -namespace FragTy - -def denote : AverCert.Schema.FragTy → Type - | .f64 => UInt64 - | .boolI32 => Bool - | .intCarrier => Int - | .i64 | .rawI32 | .ref | .adtRef => WVal - -def encodeArg (carrier : Nat) : - (ty : AverCert.Schema.FragTy) → FragTy.denote ty → WVal - | .f64, bits => .f64v bits - | .boolI32, value => b32 value - | .intCarrier, value => carrierSmall carrier value - | .i64, value | .rawI32, value | .ref, value | .adtRef, value => value - -def resultRepr (carrier : Nat) : - (ty : AverCert.Schema.FragTy) → - CarrierSpec carrier → FragTy.denote ty → WVal → Prop - | .f64 => floatBitsRepr - | .boolI32 => boolRepr - | .intCarrier => intRepr - | .i64 | .rawI32 | .ref | .adtRef => verbatimRepr - -end FragTy - -namespace FragParams - -/-- Right-associated product used by the emitted fragment obligations. -/ -def denote : List AverCert.Schema.FragTy → Type - | [] => Unit - | [ty] => FragTy.denote ty - | ty :: rest => FragTy.denote ty × denote rest - -def encodeArgs (carrier : Nat) : - (params : List AverCert.Schema.FragTy) → denote params → List WVal - | [], _ => [] - | [ty], value => [FragTy.encodeArg carrier ty value] - | ty :: next :: rest, values => - FragTy.encodeArg carrier ty values.1 :: - encodeArgs carrier (next :: rest) values.2 - -end FragParams - -def fragment - (carrier : Nat) - (params : List AverCert.Schema.FragTy) - (result : AverCert.Schema.FragTy) : FaceSpec where - carrier := carrier - Dom := FragParams.denote params - Cod := FragTy.denote result - domRepr := fun _ values args => args = FragParams.encodeArgs carrier params values - codRepr := FragTy.resultRepr carrier result - host := emptyHost - -def constructUnary (carrier structIdx : Nat) (plan : ConstructRawPlan) : FaceSpec where - carrier := carrier - Dom := WVal - Cod := WVal - domRepr := fun _ value args => args = [value] - codRepr := verbatimRepr - host := emptyHost - model? := some (fun value => .structv structIdx - (ConstructVerbatimSoundness.constructModelFields - ([value] ++ List.replicate 1 .null) plan.fields)) - -def constructBinary (carrier structIdx : Nat) (plan : ConstructRawPlan) : FaceSpec where - carrier := carrier - Dom := WVal × WVal - Cod := WVal - domRepr := fun _ values args => args = [values.1, values.2] - codRepr := verbatimRepr - host := emptyHost - model? := some (fun values => .structv structIdx - (ConstructVerbatimSoundness.constructModelFields - ([values.1, values.2] ++ List.replicate 1 .null) plan.fields)) - -/-! ### Tag-dispatch face (Option/Result `match` returning an Int constant) - -An ADT whose discriminant is a tag FIELD (not a `ref.test` subtype): read the -i32 tag in field 0 of the scrutinee struct, compare to a literal, and return a -boxed integer constant on each arm. The face is stated OPERATIONALLY over the -representation — `Dom = (tag, payload)`, `model` reads the tag and branches — -so it never claims that a source constructor writes the tag into field 0. -/ - -structure TagDispatchFace where - optIdx : Nat - boxIdx : Nat - tag : Int - thenC : Int - elseC : Int -deriving Repr, DecidableEq - -def tagDispatchHost (carrier boxIdx : Nat) : HostBuilder := - fun _add _sub _mul _stringEq _stringConcat _toIndex _cmp _eq fn => - if fn = boxIdx then some (1, boxRef carrier) else none - -/-- The complete operational face of a tag-dispatch obligation. `Dom` carries the - tag and payload; `domRepr` pins the scrutinee to the tagged struct; `model` - reads the tag and returns the arm constant; the result is a represented - integer. -/ -def tagDispatch (carrier : Nat) (face : TagDispatchFace) : FaceSpec where - carrier := carrier - Dom := Int × WVal - Cod := Int - domRepr := fun _S p vs => vs = [.structv face.optIdx [.i32v p.1, p.2]] - codRepr := intRepr - host := tagDispatchHost carrier face.boxIdx - model? := some (fun p => if p.1 = face.tag then face.thenC else face.elseC) - -/-- One boxed-Int-constant arm: `[i64.const c, box bi]` yields `(bi, c)`. -/ -def tagDispatchArm? (b : FragBlock) : Option (Nat × Int) := - match b.nodes, b.result with - | [{ id := 0, ty := .i64, kind := .constI64 c }, - { id := 1, ty := .intCarrier, kind := .hostCall .box bi [0] }], 1 => some (bi, c) - | _, _ => none - -/-- Exact tag-dispatch classifier: `local0; struct.get.user optIdx 0; i32.const k; - i32.eq; if (box thenC) (box elseC)`. Both arms must box through the same - `box` helper. -/ -def classifyTagDispatch (plan : ExprFragmentRawPlan) : Option TagDispatchFace := - if plan.params = [.adtRef] && plan.result = .intCarrier && - plan.body.result = 4 then - match plan.body.nodes with - | [n0, n1, n2, n3, n4] => - match n0.kind, n1.kind, n2.kind, n3.kind, n4.kind with - | .local 0, .structGetUser optIdx 0 0, .constI32 tag, .prim .i32Eq [1, 2], - .ifElse 3 hitBlk missBlk => - if n0.ty = .adtRef && n1.ty = .rawI32 && n2.ty = .rawI32 && - n3.ty = .boolI32 && n4.ty = .intCarrier then - match tagDispatchArm? hitBlk, tagDispatchArm? missBlk with - | some (boxIdx, thenC), some (boxIdx2, elseC) => - if boxIdx = boxIdx2 then - some { optIdx := optIdx, boxIdx := boxIdx, tag := tag, - thenC := thenC, elseC := elseC } - else none - | _, _ => none - else none - | _, _, _, _, _ => none - | _ => none - else none -/-! ### Fused vector-read face (`Option.withDefault(Vector.get(vec, idx), d)`) - -The wasm-gc emitter fuses this call pair into one fixed bounds-checked -`array.get` template (`PlanLower.vectorGetOrDefaultTemplate`): extract the -index through the `__aint_to_index` host helper, test `idx >= 0 (signed) AND -idx < len (unsigned)`, read the element on hit, box the literal default on -miss. The helper is bound only by its relational `toIndexW` contract (the -sixth host-contract slot), mirroring the add/sub/mul host contracts. - -SOUNDNESS-CRITICAL BOUND: the representation relation requires -`elems.length < 2^31`. Without it, a state with a `>= 2^31`-element array -would "represent" a vector for which the model reads `v[i]` at -`i in [2^31, len)` while the machine's `to_index` collapses `i` to the `-1` -sentinel and returns the default. The bound lives INSIDE `vecDomRepr` — a -state carrying a larger array simply represents no `(v, i)` at all — never as -an asserted premise. It is also true of the actual runtime: no engine array -spans `2^31` entries (`wat/to_index.wat`). -/ - -structure VectorGetOrDefaultFace where - arrTy : Nat - toIndexIdx : Nat - boxIdx : Nat - d : Int -deriving Repr, DecidableEq - -/-- Host slots of the fused template: the abstract `__aint_to_index` contract - slot and the audited box reference face. -/ -def vectorGetOrDefaultHostSlots - (carrier toIndexIdx boxIdx : Nat) - (toIndex : List WVal → Option WVal) : HostTbl := - fun fn => - if fn = toIndexIdx then some (1, toIndex) - else if fn = boxIdx then some (1, boxRef carrier) else none - -def vectorGetOrDefaultHost - (carrier : Nat) (face : VectorGetOrDefaultFace) : HostBuilder := - fun _add _sub _mul _stringEq _stringConcat toIndex _cmp _eq => - vectorGetOrDefaultHostSlots carrier face.toIndexIdx face.boxIdx toIndex - -/-- Domain representation of the fused-read face: the machine state is exactly - `[vector array, boxed index]`, the array has one represented element per - model element, and — soundness-critical, see the section header — fewer - than `2^31` elements. All witnesses live INSIDE the relation. -/ -def vecDomRepr (carrier arrTy : Nat) (S : CarrierSpec carrier) - (p : List Int × Int) (vs : List WVal) : Prop := - ∃ elems wi, - vs = [.arr arrTy elems, wi] ∧ - elems.length = p.1.length ∧ - elems.length < 2147483648 ∧ - (∀ k, k < p.1.length → ∃ w, elems[k]? = some w ∧ intRepr S (p.1[k]!) w) ∧ - intRepr S p.2 wi - -/-- The source model: in-bounds read, else the literal default. -/ -def vecModel (d : Int) (p : List Int × Int) : Int := - if 0 ≤ p.2 ∧ p.2 < (p.1.length : Int) then p.1[p.2.toNat]! else d - -/-- The complete face of the fused vector-read shape: the four template holes - are the face data; domain, codomain, representations, and model are fixed - by the family. -/ -def vectorGetOrDefault - (carrier : Nat) (face : VectorGetOrDefaultFace) : FaceSpec where - carrier := carrier - Dom := List Int × Int - Cod := Int - domRepr := vecDomRepr carrier face.arrTy - codRepr := intRepr - host := vectorGetOrDefaultHost carrier face - model? := some (vecModel face.d) - -/-- Exact fused vector-read classifier: the plan is the single monolithic - template node over the pinned `(vector, index)` params. The helper indices - must be distinct, or the host builder could not present both slots. -/ -def classifyVectorGetOrDefault - (plan : ExprFragmentRawPlan) : Option VectorGetOrDefaultFace := - if plan.params = [.adtRef, .intCarrier] && plan.result = .intCarrier && - plan.body.result = 0 then - match plan.body.nodes with - | [n0] => - match n0.kind with - | .vectorGetOrDefault arrTy toIndexIdx boxIdx d => - if n0.ty = .intCarrier && toIndexIdx != boxIdx then - some { arrTy := arrTy, toIndexIdx := toIndexIdx, - boxIdx := boxIdx, d := d } - else none - | _ => none - | _ => none - else none - -/-! ### Int value-versus-value comparison faces (`__aint_cmp` / `__aint_eq`) - -Two Int VALUES compared against each other — `a >= b`, `a == b`, and the -`match a < b { true -> a; false -> b }` selection — leave the part of the -fragment grammar that lowers without a helper: the wasm-gc emitter calls a -runtime comparison helper and reads its raw `i32` verdict. -`genericFragmentAllowedFuel` rejects EVERY `.hostCall` node outright, so these -plans need an exact-pinned face — a node-by-node discipline — and NOT a -widened generic gate. - -Both faces are stated over the SMALL BAND (`intPairSmallBandDomRepr`: each -argument is the literal `carrierSmall` encoding of an integer in `[-2^63, -2^63)`), which is exactly the domain the two assumed helper contracts in -`Obligation.holds` are quantified over. That is not a convenience: a face -stated over the full representation relation would need a relational contract, -and a relational contract is REFUTABLE here — `CarrierSpec.smallIntro` admits -`carrierSmall C k` as a representation of `k` for every `k`, while `__aint_eq` -decides a `Small` against a limb-carrying `Big` structurally and `__aint_cmp` -decides on raw sign fields `CarrierSpec.bigElim` does not constrain. Widening -the certified domain to limb-carrying operands needs a carrier specification -that pins those fields, not a wider premise. - -The three relational operators read `__aint_cmp`, whose `-1`/`0`/`1` verdict is -typed `rawI32` and is always consumed by `i32.const 0` plus a signed relational -operator; `==` reads `__aint_eq`, whose `0`/`1` result IS the source Boolean and -carries no tail. `<=` is deliberately absent: no admitted plan produces -`i32.le_s` (see the `FragPrim` note), so a `le` arm would be reachable by -nothing. - -The result of the SELECTION face is a PASSTHROUGH of an input local — the -emitted `if` yields `local.get 0` or `local.get 1`, boxes nothing, and calls no -helper in either arm — so its codomain relation is carried straight from the -chosen argument's `S.Repr` premise. -/ - -/-- Comparison operators admitted on two Int VALUES. `le` is absent by - construction: the plan grammar has no `i32.le_s` primitive to lower it to. -/ -inductive IntCmpOp where - | lt - | gt - | ge - | eq -deriving Repr, DecidableEq - -/-- Face data of both comparison shapes: which operator, and the resolved index - of the single runtime helper it reads (`__aint_cmp` for the relational - operators, `__aint_eq` for equality). Acceptance binds that index to the - module bytes and to the decoded role table; `hostTableBound` additionally - forces the role/index pair to be the decoded one and every claimed index to - be distinct. -/ -structure IntCmpFace where - op : IntCmpOp - helperIdx : Nat -deriving Repr, DecidableEq - -/-- The Boolean the source operator denotes on two exact integers. -/ -def intCmpModel : IntCmpOp → Int × Int → Bool - | .lt, p => decide (p.1 < p.2) - | .gt, p => decide (p.2 < p.1) - | .ge, p => decide (p.2 ≤ p.1) - | .eq, p => decide (p.1 = p.2) - -/-- The Int the source selection denotes: one of its own two arguments. -/ -def intSelectModel (op : IntCmpOp) (p : Int × Int) : Int := - if intCmpModel op p then p.1 else p.2 - -/-- Which contract slot the operator's helper occupies. Equality reads the - `__aint_eq` contract (`eqW`), the three relational operators read the - `__aint_cmp` contract (`cmpW`); nothing reads both. -/ -def intCmpHelper (op : IntCmpOp) (cmp eq : List WVal → Option WVal) : - List WVal → Option WVal := - match op with - | .eq => eq - | .lt | .gt | .ge => cmp - -/-- The single host slot both faces present: the claimed helper index, arity 2, - wired to the contract-bound helper its operator names. Every other index is - absent from this table — which is not what makes the face safe (a body - calling an absent index is merely stuck, and a stuck run says nothing). The - guarantee comes from the PINNED BODY: the classifiers admit exactly one - node list, whose only call is to the claimed helper index, so the emitted - body cannot call anything else in the first place. -/ -def intCmpHostSlots (op : IntCmpOp) (helperIdx : Nat) - (cmp eq : List WVal → Option WVal) : HostTbl := - fun fn => if fn = helperIdx then some (2, intCmpHelper op cmp eq) else none - -def intCmpHost (face : IntCmpFace) : HostBuilder := - fun _add _sub _mul _stringEq _stringConcat _toIndex cmp eq => - intCmpHostSlots face.op face.helperIdx cmp eq - -/-- Domain representation of both comparison faces: the machine state is exactly - the two LITERAL small carriers of two band-bounded integers. This is the - same domain the `_hCmp` / `_hEq` premises of `Obligation.holds` are - quantified over, and it is deliberately narrower than `S.Repr`: see the - section note above for why a relational domain would be unsound to assume - here. The carrier specification is still a parameter — `S` is used, through - `smallIntro`, to represent the selection face's passthrough result. -/ -def intPairSmallBandDomRepr (carrier : Nat) (_S : CarrierSpec carrier) - (p : Int × Int) (vs : List WVal) : Prop := - vs = [carrierSmall carrier p.1, carrierSmall carrier p.2] ∧ - -(2 ^ 63 : Int) ≤ p.1 ∧ p.1 < 2 ^ 63 ∧ -(2 ^ 63 : Int) ≤ p.2 ∧ p.2 < 2 ^ 63 - -/-- The emitted comparison body: read both arguments, call the helper, and — - for the three relational operators — compare the verdict against - `i32.const 0`. This is `PlanLower.lowerBlock` of the pinned node list - (`lowerBlock_intCmp`), not an independent claim about the emitter. -/ -def intCmpTemplate (op : IntCmpOp) (helperIdx : Nat) : List WInstr := - match op with - | .eq => [.localGet 0, .localGet 1, .call helperIdx] - | .lt => [.localGet 0, .localGet 1, .call helperIdx, .i32Const 0, .i32LtS] - | .gt => [.localGet 0, .localGet 1, .call helperIdx, .i32Const 0, .i32GtS] - | .ge => [.localGet 0, .localGet 1, .call helperIdx, .i32Const 0, .i32GeS] - -/-- The emitted selection body: the comparison above followed by an `if` whose - arms are bare argument reads. -/ -def intSelectTemplate (op : IntCmpOp) (helperIdx : Nat) : List WInstr := - intCmpTemplate op helperIdx ++ [.ifElse [.localGet 0] [.localGet 1]] - -/-- The three-way verdict is negative exactly below, positive exactly above and - non-negative exactly at-or-above. These are the only facts about `cmpW` the - faces need, and they are what makes the `i32.const 0` tail meaningful. -/ -theorem cmpW_lt_iff (a b : Int) : cmpW a b < 0 ↔ a < b := by - unfold cmpW - split - · omega - · split <;> omega - -theorem cmpW_gt_iff (a b : Int) : 0 < cmpW a b ↔ b < a := by - unfold cmpW - split - · omega - · split <;> omega - -theorem cmpW_ge_iff (a b : Int) : 0 ≤ cmpW a b ↔ b ≤ a := by - unfold cmpW - split - · omega - · split <;> omega - -/-- The signed relational primitive each operator's tail uses. The map is - injective and total on the admitted operators; every other primitive - declines, which is what keeps a `i32.and`- or `i32.eq`-tailed body out of - this face. -/ -def intCmpOfPrim? : FragPrim → Option IntCmpOp - | .i32LtS => some .lt - | .i32GtS => some .gt - | .i32GeS => some .ge - | _ => none - -/-- Pinned node list of a relational comparison: both arguments, the - `__aint_cmp` call typed `rawI32`, the `i32.const 0`, and the signed tail. -/ -def intCmpRelBlock (prim : FragPrim) (helperIdx : Nat) : FragBlock := - { nodes := - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 1 }, - { id := 2, ty := .rawI32, kind := .hostCall .cmp helperIdx [0, 1] }, - { id := 3, ty := .rawI32, kind := .constI32 0 }, - { id := 4, ty := .boolI32, kind := .prim prim [2, 3] }], - result := 4 } - -/-- Pinned node list of the equality comparison: both arguments and the - `__aint_eq` call, whose result is already the source Boolean. -/ -def intCmpEqBlock (helperIdx : Nat) : FragBlock := - { nodes := - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 1 }, - { id := 2, ty := .boolI32, kind := .hostCall .eq helperIdx [0, 1] }], - result := 2 } - -def intCmpBlock (op : IntCmpOp) (helperIdx : Nat) : FragBlock := - match op with - | .lt => intCmpRelBlock .i32LtS helperIdx - | .gt => intCmpRelBlock .i32GtS helperIdx - | .ge => intCmpRelBlock .i32GeS helperIdx - | .eq => intCmpEqBlock helperIdx - -/-- One arm of the selection: a bare argument read, no box and no host call. -/ -def intSelectArm (localIdx : Nat) : FragBlock := - { nodes := [{ id := 0, ty := .intCarrier, kind := .local localIdx }], result := 0 } - -def intSelectRelBlock (prim : FragPrim) (helperIdx : Nat) : FragBlock := - { nodes := - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 1 }, - { id := 2, ty := .rawI32, kind := .hostCall .cmp helperIdx [0, 1] }, - { id := 3, ty := .rawI32, kind := .constI32 0 }, - { id := 4, ty := .boolI32, kind := .prim prim [2, 3] }, - { id := 5, ty := .intCarrier, - kind := .ifElse 4 (intSelectArm 0) (intSelectArm 1) }], - result := 5 } - -def intSelectEqBlock (helperIdx : Nat) : FragBlock := - { nodes := - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 1 }, - { id := 2, ty := .boolI32, kind := .hostCall .eq helperIdx [0, 1] }, - { id := 3, ty := .intCarrier, - kind := .ifElse 2 (intSelectArm 0) (intSelectArm 1) }], - result := 3 } - -def intSelectBlock (op : IntCmpOp) (helperIdx : Nat) : FragBlock := - match op with - | .lt => intSelectRelBlock .i32LtS helperIdx - | .gt => intSelectRelBlock .i32GtS helperIdx - | .ge => intSelectRelBlock .i32GeS helperIdx - | .eq => intSelectEqBlock helperIdx - -/-- Exact Int-selection classifier: the comparison above, followed by an `if` - whose two arms are pinned — LITERALLY, inside the pattern — to the bare - reads of parameter 0 and parameter 1 in that order. Nothing else is - admitted in an arm, so the result cannot be a freshly boxed value. -/ -def classifyIntSelect (plan : ExprFragmentRawPlan) : Option IntCmpFace := - if plan.params = [.intCarrier, .intCarrier] && plan.result = .intCarrier then - match plan.body with - | { nodes := - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 1 }, - { id := 2, ty := .boolI32, kind := .hostCall .eq helperIdx [0, 1] }, - { id := 3, ty := .intCarrier, - kind := .ifElse 2 - { nodes := [{ id := 0, ty := .intCarrier, kind := .local 0 }], - result := 0 } - { nodes := [{ id := 0, ty := .intCarrier, kind := .local 1 }], - result := 0 } }], - result := 3 } => some { op := .eq, helperIdx := helperIdx } - | { nodes := - [{ id := 0, ty := .intCarrier, kind := .local 0 }, - { id := 1, ty := .intCarrier, kind := .local 1 }, - { id := 2, ty := .rawI32, kind := .hostCall .cmp helperIdx [0, 1] }, - { id := 3, ty := .rawI32, kind := .constI32 0 }, - { id := 4, ty := .boolI32, kind := .prim prim [2, 3] }, - { id := 5, ty := .intCarrier, - kind := .ifElse 4 - { nodes := [{ id := 0, ty := .intCarrier, kind := .local 0 }], - result := 0 } - { nodes := [{ id := 0, ty := .intCarrier, kind := .local 1 }], - result := 0 } }], - result := 5 } => - match intCmpOfPrim? prim with - | some op => some { op := op, helperIdx := helperIdx } - | none => none - | _ => none - else none - -theorem classifyIntSelect_spec - (plan : ExprFragmentRawPlan) (face : IntCmpFace) - (h : classifyIntSelect plan = some face) : - plan.params = [.intCarrier, .intCarrier] ∧ plan.result = .intCarrier ∧ - plan.body = intSelectBlock face.op face.helperIdx := by - unfold classifyIntSelect at h - split at h - case isFalse => exact absurd h (by simp) - case isTrue hcond => - simp only [Bool.and_eq_true, decide_eq_true_eq] at hcond - obtain ⟨hparams, hresult⟩ := hcond - split at h - case h_1 helperIdx heq => - injection h with hface - subst hface - exact ⟨hparams, hresult, by rw [heq]; rfl⟩ - case h_2 helperIdx prim heq => - split at h - case h_2 => exact absurd h (by simp) - case h_1 op hop => - injection h with hface - subst hface - refine ⟨hparams, hresult, ?_⟩ - rw [heq] - cases prim <;> simp [intCmpOfPrim?] at hop <;> subst hop <;> rfl - case h_3 => exact absurd h (by simp) - -/-- The complete face of an Int selection. The codomain relation is the - ordinary `intRepr`, satisfied by the CHOSEN ARGUMENT's own representation - premise — the body boxes nothing. -/ -def intSelectFace (carrier : Nat) (face : IntCmpFace) : FaceSpec where - carrier := carrier - Dom := Int × Int - Cod := Int - domRepr := intPairSmallBandDomRepr carrier - codRepr := intRepr - host := intCmpHost face - model? := some (intSelectModel face.op) - -/-! ### Record-parameter face (a Plan type declaration typed the parameter) - -The certified Plan carries the user record declaration (`SchemaCore.TypeDecl`); -the wall LOWERS it (`lowerTypeDecl`) and the face pins the module's type-section -entry at the projected struct index to that lowering BY EQUALITY, so the layout -is a checked-by-equality witness, never trusted plan data. The declaration -itself sits under an existential, which is sound for the same reason the -declared-index envelope's existentials are: the equality pin forces the -declared bytes to be the module's real bytes, so the witness is not a free -choice — an Int field can only be declared where the real entry holds the -nullable carrier reference, a Bool field only at `i32`, a Float field only at -`f64`, and `.plain` kills the `.sub`/`.subFinal` doppelganger outright. The -meaning terms (`Dom`/`domRepr`/`Cod`/`codRepr`/`model`) are wall terms over the -declaration (`RecordFields`/`ReprFields`/`nthField`), pinned by `HEq` exactly -like `intDispatchDeclaredFace`. -/ - -/-- Domain representation of the record-parameter face: the machine state is - exactly one struct at the pinned index whose fields represent the record - denotation pointwise (`ReprFields`). -/ -def recordParamDomRepr (carrier structIdx : Nat) (fields : List TypeDecl) : - CarrierSpec carrier → RecordFields fields → List WVal → Prop := - fun S v vs => ∃ ws, vs = [.structv structIdx ws] ∧ ReprFields S fields ws v - -/-- Codomain representation: the result represents the projected field under - the single generic wall relation `ReprOf` (definitionally the scalar - `intRepr`/`boolRepr`/`floatBitsRepr` at the admitted leaves). -/ -def recordParamCodRepr (carrier : Nat) (fields : List TypeDecl) - (field : Nat) (hfield : field < fields.length) : - CarrierSpec carrier → RecordVal (fields[field]'hfield) → WVal → Prop := - fun S c w => ReprOf S (fields[field]'hfield) w c - -/-- The source model of a record field read: the `field`-th component of the - record denotation. -/ -def recordParamModel (fields : List TypeDecl) (field : Nat) - (hfield : field < fields.length) : - RecordFields fields → RecordVal (fields[field]'hfield) := - fun v => nthField fields v field hfield - -/-- The declared-record face carried by a record-parameter field-read claim. - Every conjunct is load-bearing: - - * `checkRecordDecl` — the declaration is a stage-1 flat scalar record; - * the TYPE-SECTION EQUALITY PIN — the module's entry at the projected - struct index IS the wall lowering of the declaration (form `.plain`, - full ordered field list, every storage, every mutability); - * the PARAM BINDING — the certified export's declared parameter names - exactly the pinned struct index (`recordParamFuncTypeMatches`); - * the PLAN BINDING — the recognizer fires on this plan at the same - `(structIdx, field)`, the field is in range, and the plan's declared - result is the declared field's scalar fragment type; - * the CARRIER BINDING — a declaration that mentions the Int carrier makes - the face's meaning read the claimed carrier index (through - `lowerTypeDecl` and `ReprFields`' `intRepr` leaf) even when the plan and - host table never name it, so the claimed index must then be the decoded - `CertDecode.carrierState` (the #767 lesson applied to declarations); - * the `HEq` pins — the obligation's meaning fields are the wall terms over - the declaration, exactly like `intDispatchDeclaredFace`; - * `decl = .record structIdx fields` — the declaration's own index is bound - to the pinned struct index (`lowerTypeDecl` never reads it, so leaving it - free would be an unconstrained-witness label). -/ -def recordParamDeclaredFace - (modBytes modLen : Nat) (claim : SymFragmentClaim) - (plan : ExprFragmentRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - claim.obligation.host = emptyHost ∧ - claim.obligation.carrier = claim.carrier ∧ - ∃ (decl : TypeDecl) (structIdx field : Nat) (fields : List TypeDecl) - (hfield : field < fields.length), - decl = .record structIdx fields ∧ - AverCert.WasmSlice.exprRecordProjFace? plan = some (structIdx, field) ∧ - checkRecordDecl decl = true ∧ - scalarLeafFragTy? (fields[field]'hfield) = some plan.result ∧ - (typeDeclMentionsIntCarrier decl = true → - CertDecode.carrierState modBytes modLen = some (some claim.carrier)) ∧ - AverCert.WasmSlice.typeSectionMatches - (fun entry => - decide (lowerTypeDecl claim.carrier lowerTypeDeclFuel decl = some entry)) - modBytes modLen structIdx = true ∧ - AverCert.WasmSlice.recordParamFuncTypeMatches - modBytes modLen claim.exportNameBytes structIdx = true ∧ - HEq claim.obligation.Dom (RecordFields fields) ∧ - HEq claim.obligation.Cod (RecordVal (fields[field]'hfield)) ∧ - HEq claim.obligation.domRepr (recordParamDomRepr claim.carrier structIdx fields) ∧ - HEq claim.obligation.codRepr (recordParamCodRepr claim.carrier fields field hfield) ∧ - HEq claim.obligation.model (recordParamModel fields field hfield) - -def genericFragmentAllowedFuel : Nat → FragBlock → Bool - | 0, _ => false - | fuel + 1, block => - block.nodes.all fun node => - node.ty != .adtRef && - match node.kind with - | .hostCall _ _ _ | .structGetUser _ _ _ | .structNew _ _ => false - | .ifElse _ thenBlock elseBlock => - genericFragmentAllowedFuel fuel thenBlock && - genericFragmentAllowedFuel fuel elseBlock - | .selfCall _ _ _ => false - | .vectorGetOrDefault _ _ _ _ => false - -- The sign template writes the declared scratch local and reads the - -- carrier's limb/sign fields; the generic face has no carrier facts - -- to interpret either with, so it fail-closes here. - | .intSignCmp _ _ _ _ => false - | .local _ | .constBool _ | .constI64 _ | .constI32 _ | - .constF64Bits _ | .structGet _ _ | .refIsNull _ | - .prim _ _ => true - -noncomputable def genericFragmentAllowed (plan : ExprFragmentRawPlan) : Bool := - !plan.params.contains .adtRef && - plan.result != .adtRef && - plan.result != .intCarrier && - genericFragmentAllowedFuel (sizeOf plan.body + 1) plan.body - -/-! ### Record projection-compute face (plan-as-claim over one flat Int record) - -The face admits k record parameters of ONE pinned struct type whose fields -are all Int carriers, a body over the bridge's v1 node set, and a -record/Int/Bool result. Its meaning is the plan itself: the obligation's -model RUNS the checked plan over source values -(`RecordComputeBridge.sourceRunBlock`), so the report shows the exact -expression the bytes compute and no per-shape model term exists to get -wrong. -/ - -/-- Host slots of the compute face: the byte-derived role table lowered to - the canonical `if fn = idx` chain; `box` wires the audited `boxRef`, - add/sub/mul/cmp/eq wire the obligation's contract slots, and the one role - the face's grammar never cites (`toIndex`) wires a trap-only slot at its - honest arity. -/ -def recordComputeSlots - (carrier : Nat) (add sub mul cmp eq : List WVal → Option WVal) : - List (HostRole × Nat) → HostTbl - | [] => fun _ => none - | (role, idx) :: rest => fun fn => - if fn = idx then - some (match role with - | .box => ((1 : Nat), boxRef carrier) - | .add => ((2 : Nat), add) - | .mul => ((2 : Nat), mul) - | .sub => ((2 : Nat), sub) - | .eq => ((2 : Nat), eq) - | .cmp => ((2 : Nat), cmp) - | .toIndex => ((1 : Nat), fun _ => none)) - else recordComputeSlots carrier add sub mul cmp eq rest fn - -def recordComputeHost (carrier : Nat) (hostTable : List (HostRole × Nat)) : - HostBuilder := - fun add sub mul _stringEq _stringConcat _toIndex cmp eq => - recordComputeSlots carrier add sub mul cmp eq hostTable - -structure RecordComputeFace where - structIdx : Nat -deriving Repr, DecidableEq - -private theorem recordComputeHostRoleIdx_mem_pair - (hostTable : List (HostRole × Nat)) (role : HostRole) (idx : Nat) - (hLookup : AverCert.PlanCheck.hostRoleIdx? hostTable role = some idx) : - (role, idx) ∈ hostTable := by - induction hostTable with - | nil => simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - | cons head rest ih => - rcases head with ⟨headRole, headIdx⟩ - by_cases hRole : headRole = role - · subst headRole - simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - subst idx - simp - · simp [AverCert.PlanCheck.hostRoleIdx?, hRole] at hLookup - simp [ih hLookup] - -/-- Discharge-facing binding lemma: over a byte-derived role table whose - indices are pairwise distinct, the compute-face slots bind the index the - table resolves for each ADMITTED role (`box`/`add`/`sub`/`mul`/`cmp`/`eq`) - to exactly that role's arity and wired contract function — `box` wires the - audited `boxRef`. This is the single fact the discharge needs to satisfy - the bridge's `hHost` hypothesis. -/ -theorem recordComputeSlots_bind - (carrier : Nat) (add sub mul cmp eq : List WVal → Option WVal) - (hostTable : List (HostRole × Nat)) - (hDistinct : AverCert.PlanCheck.hostTableIndicesDistinct hostTable = true) - (role : HostRole) (idx : Nat) - (hRole : role ∈ [HostRole.box, HostRole.add, HostRole.sub, HostRole.mul, - HostRole.cmp, HostRole.eq]) - (hLookup : AverCert.PlanCheck.hostRoleIdx? hostTable role = some idx) : - recordComputeSlots carrier add sub mul cmp eq hostTable idx = - some (RecordComputeBridge.roleArity role, - RecordComputeBridge.roleFn (boxRef carrier) add sub mul cmp eq role) := by - induction hostTable with - | nil => simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - | cons head rest ih => - rcases head with ⟨headRole, headIdx⟩ - simp only [AverCert.PlanCheck.hostTableIndicesDistinct, - AverCert.PlanCheck.natListNoDup, List.map_cons, - Bool.and_eq_true] at hDistinct - rcases hDistinct with ⟨hHeadFresh, hRestDistinct⟩ - by_cases hR : headRole = role - · subst headRole - simp [AverCert.PlanCheck.hostRoleIdx?] at hLookup - subst idx - simp only [List.mem_cons, List.not_mem_nil, or_false] at hRole - rcases hRole with rfl | rfl | rfl | rfl | rfl | rfl <;> - simp [recordComputeSlots, RecordComputeBridge.roleArity, - RecordComputeBridge.roleFn] - · have hTailLookup : - AverCert.PlanCheck.hostRoleIdx? rest role = some idx := by - simpa [AverCert.PlanCheck.hostRoleIdx?, hR] using hLookup - have hPairMem : (role, idx) ∈ rest := - recordComputeHostRoleIdx_mem_pair rest role idx hTailLookup - have hNe : idx ≠ headIdx := by - intro hEqIdx - subst idx - simp at hHeadFresh - exact hHeadFresh role hPairMem - change (if idx = headIdx then _ else - recordComputeSlots carrier add sub mul cmp eq rest idx) = _ - rw [if_neg hNe] - exact ih hRestDistinct hTailLookup - - -/-- The user-struct index a node cites, if any. -/ -def fragNodeStructIdx? : FragNodeKind → Option Nat - | .structGetUser tyIdx _ _ => some tyIdx - | .structNew tyIdx _ => some tyIdx - | _ => none - -/-- Executable admission of one node kind against the byte-derived role - table: exactly the bridge's v1 node set, with every host call citing the - table's index for its role at the role's arity. The two i64-band checks - are the sign template's exactness condition and the boxing helper's - canonicity condition; both are decided here rather than assumed. -/ -def recordComputeNodeOk - (hostTable : List (HostRole × Nat)) : FragNodeKind → Bool - | .local _ => true - | .constI64 value => AverCert.PlanCheck.inI64Band value - | .constI32 _ => true - | .structGetUser _ _ _ => true - | .structNew _ _ => true - | .prim .i32LtS args => args.length == 2 - | .prim .i32GtS args => args.length == 2 - | .prim .i32GeS args => args.length == 2 - | .intSignCmp _ constant _ _ => AverCert.PlanCheck.inI64Band constant - | .hostCall role f args => - (AverCert.PlanCheck.hostRoleIdx? hostTable role == some f) && - (match role with - | .box => args.length == 1 - | .add | .sub | .mul | .cmp | .eq => args.length == 2 - | _ => false) - | _ => false - -/- The classifier below and the NOMINAL-SIGNATURE gate - (`WasmSlice.exprRecordComputeStructIdx?`) must count the same nodes as - computing, or a plan passes one gate and fails the other — which is exactly - how the projection-only sign test first showed up. There is one definition, - in `WasmSlice`, and this face uses it under its own name. It used to be two - byte-identical copies pinned equal by `rfl`. -/ -export AverCert.WasmSlice (fragNodeComputes) - -/-- Whether the plan speaks about the ONE user struct type at all: an opaque - record parameter, an opaque record result, or any node citing a user - struct index. A plan for which this is `false` names no record, so the - face carries no record declaration and the byte pins below skip the - type-section entry — its `structIdx` is the reserved `0` and NO source - value of record shape can arise (the domain's parameter-type conjunct - admits no `.adtRef` input, and no node produces one). -/ -def recordComputeUsesStruct (plan : ExprFragmentRawPlan) : Bool := - plan.params.contains .adtRef || plan.result == .adtRef || - plan.body.nodes.any (fun n => (fragNodeStructIdx? n.kind).isSome) - -/-- Admitted parameter shapes. A record-shaped plan keeps the original - all-`.adtRef` list (its nominal signature pin is `k` references to the ONE - pinned struct, `WasmSlice.exprRecordComputeTypesMatch`). A plan that names - no struct takes SCALAR parameters instead — boxed Int carriers and - Booleans, whose domain representation is the same `SRepr` the record - leaves already use. Mixing the two is deliberately NOT admitted: the - byte-side nominal gate speaks `List.replicate` over one type, so a mixed - list has no pin there. -/ -def recordComputeShapeOk (plan : ExprFragmentRawPlan) : Bool := - if recordComputeUsesStruct plan then plan.params.all (· == .adtRef) - else plan.params.all (fun ty => ty == .intCarrier || ty == .boolI32) - -/-- Classifier of the compute face: the parameter list is one of the two - admitted shapes, every node is in the admitted set, at least one node - computes (`fragNodeComputes` — which also rules the two-node projection - faces out), the result is a record/Int/Bool, and every cited user-struct - index agrees on ONE pinned index. A plan that cites no struct at all is - admitted with the reserved index `0`, and only when it names no record - anywhere (`recordComputeUsesStruct`), so an opaque parameter can never - reach a face with no type-section pin. -/ -def classifyRecordCompute - (hostTable : List (HostRole × Nat)) (plan : ExprFragmentRawPlan) : - Option RecordComputeFace := - if recordComputeShapeOk plan && - plan.body.nodes.all (fun n => recordComputeNodeOk hostTable n.kind) && - plan.body.nodes.any fragNodeComputes && - (plan.result == .adtRef || plan.result == .intCarrier || - plan.result == .boolI32) then - match plan.body.nodes.filterMap (fun n => fragNodeStructIdx? n.kind) with - | [] => - if recordComputeUsesStruct plan then none - else if RecordComputeBridge.planTypedB 0 - (fun nodeId => - ((plan.body.nodes[nodeId]?).map (fun n => n.ty)).getD .i64) - plan.params plan.body.nodes then - some { structIdx := 0 } - else none - | i :: rest => - if rest.all (· == i) && - RecordComputeBridge.planTypedB i - (fun nodeId => - ((plan.body.nodes[nodeId]?).map (fun n => n.ty)).getD .i64) - plan.params plan.body.nodes then - some { structIdx := i } - else none - else none - -/-- The declared wasm type of a compute-face fragment type — used for the - plan's result AND, since scalar parameters joined the face, for each of - its parameters: a record is the pinned struct reference, an Int the - carrier reference, a Bool the i32. Anything else has no certified - signature. -/ -def recordComputeResultValType (carrier structIdx : Nat) : - FragTy → Option CertDecode.ValType - | .adtRef => some (AverCert.WasmSlice.nullableRefType structIdx) - | .intCarrier => some (AverCert.WasmSlice.nullableRefType carrier) - | .boolI32 => some (.numeric 0x7f) - | _ => none - -/-- The declared wasm parameter list of a compute-face plan, pointwise. -/ -def recordComputeParamValTypes (carrier structIdx : Nat) - (params : List FragTy) : Option (List CertDecode.ValType) := - params.mapM (recordComputeResultValType carrier structIdx) - -/-- Domain representation of the compute face: pointwise-SRepr inputs whose - source shapes match the plan's declared parameter types. - - DISCLOSURE — this face's CERTIFIED DOMAIN is narrower than "any represented - value". `SRepr` on an Int carrier means REPRESENTED AND CANONICAL, so the - claim is stated about inputs, AND about the Int leaves of the record - parameters, that are in the runtime's normal form. That is an ASSUMPTION - about the words an embedder hands the exported function, not something the - certificate derives from the bytes. - - It is true of every value the emitted module builds, by two mechanisms: - the i64 fast paths construct an in-band `Small` directly with `struct.new` - (`wat/from_i64.wat`, and the both-`Small` non-overflow arms of - `wat/addsub.wat` and `wat/mul.wat`), and every arm that can produce limbs - ends in the normalisation epilogue (`wat/normalize.wat`, shared as - `__aint_normalize` or inlined). So an artifact whose carriers all come out - of this runtime satisfies it — but a host that fabricates a carrier word of - its own is outside what this obligation says anything about. - - The assumption is what the STRUCTURAL helpers (`__aint_cmp`, `__aint_eq`) - and the inline sign template need in order to be exact: all three decide on - shape and fields, and only canonicity makes "same shape and same fields" - and "same integer" coincide. -/ -def recordComputeDomRepr (carrier structIdx : Nat) (params : List FragTy) : - CarrierSpec carrier → List RecordComputeBridge.SVal → List WVal → Prop := - fun S svs vs => - RecordComputeBridge.SReprAll S structIdx svs vs ∧ - svs.length = params.length ∧ - ∀ (i : Nat) (sv : RecordComputeBridge.SVal), svs[i]? = some sv → - params[i]? = some (RecordComputeBridge.svalTy sv) - -/-- Codomain representation: the model produced a source value and the - machine word represents it. -/ -def recordComputeCodRepr (carrier structIdx : Nat) : - CarrierSpec carrier → Option RecordComputeBridge.SVal → WVal → Prop := - fun S o w => ∃ sv, o = some sv ∧ - RecordComputeBridge.SRepr S structIdx sv w - -/-- The compute face's model IS the checked plan, run by the audited source - evaluator (at the wall's audited fixed fuel `PlanCheck.maxFuel` — the same - fuel the canonical lowering and the bridge's completeness speak at, so the - discharge needs no fuel-monotonicity step). -/ -def recordComputeModel (body : FragBlock) : - List RecordComputeBridge.SVal → Option RecordComputeBridge.SVal := - fun svs => - RecordComputeBridge.sourceRunBlock AverCert.PlanCheck.maxFuel body svs - -/-- The compute face as a standard face: the domain is the source values of - the k record parameters, the codomain the (optional) source result, and - the model IS the checked plan, run by the audited source evaluator. -/ -noncomputable def recordCompute (carrier : Nat) (face : RecordComputeFace) - (hostTable : List (HostRole × Nat)) (plan : ExprFragmentRawPlan) : - FaceSpec where - carrier := carrier - Dom := List RecordComputeBridge.SVal - Cod := Option RecordComputeBridge.SVal - domRepr := recordComputeDomRepr carrier face.structIdx plan.params - codRepr := recordComputeCodRepr carrier face.structIdx - host := recordComputeHost carrier hostTable - model? := some (recordComputeModel plan.body) - -/-- The declared face carried by a record projection-compute claim. Byte - conjuncts: the pinned struct's type-section entry IS the wall lowering of - an all-Int flat record declaration at that index; the certified export's - declared signature is EXACTLY k references to the pinned struct in and - the declared result out; the classifier fired on this plan at this face; - the byte-derived carrier is the claimed one. Meaning conjuncts: the - obligation's Dom/Cod/representations/host/model are the wall's compute - face terms over the checked plan (`StandardFace.Matches`). -/ -def recordComputeDeclaredFace - (modBytes modLen : Nat) (claim : SymFragmentClaim) - (plan : ExprFragmentRawPlan) (face : RecordComputeFace) : Prop := - claim.obligation.policy = .simulatesModel ∧ - claim.obligation.carrier = claim.carrier ∧ - classifyRecordCompute claim.hostTable plan = some face ∧ - CertDecode.carrierState modBytes modLen = some (some claim.carrier) ∧ - ∃ (fields : List TypeDecl) (paramTys : List CertDecode.ValType) - (resultTy : CertDecode.ValType), - -- The record declaration and its type-section equality pin are demanded - -- exactly when the plan names a record. A plan that names none carries - -- the reserved index `0` (`classifyRecordCompute`), and its face never - -- reads a struct entry: no parameter, no node and no result is `.adtRef`, - -- so no source value of record shape exists for the meaning terms to - -- represent. - (recordComputeUsesStruct plan = true → - (fields.all fun f => match f with - | .intCarrier => true - | _ => false) = true ∧ - fields.length ≠ 0 ∧ - checkRecordDecl (.record face.structIdx fields) = true ∧ - AverCert.WasmSlice.typeSectionMatches - (fun entry => - decide (lowerTypeDecl claim.carrier lowerTypeDeclFuel - (.record face.structIdx fields) = some entry)) - modBytes modLen face.structIdx = true) ∧ - recordComputeParamValTypes claim.carrier face.structIdx plan.params = - some paramTys ∧ - recordComputeResultValType claim.carrier face.structIdx plan.result = - some resultTy ∧ - AverCert.WasmSlice.funcTypeMatchesExact - modBytes modLen claim.exportNameBytes paramTys [resultTy] = true ∧ - (StandardFace.known - (recordCompute claim.carrier face claim.hostTable plan)).Matches - claim.obligation - -/-- Structural content of a fired compute classifier: the four Bool facts of - its admission condition (an admitted parameter shape, every node admitted, - at least one computing node, record/Int/Bool result). The pinned-index - fact is deliberately absent — non-overlap needs only the condition. -/ -theorem classifyRecordCompute_spec - (hostTable : List (HostRole × Nat)) (plan : ExprFragmentRawPlan) - (face : RecordComputeFace) - (h : classifyRecordCompute hostTable plan = some face) : - recordComputeShapeOk plan = true ∧ - plan.body.nodes.all (fun n => recordComputeNodeOk hostTable n.kind) = true ∧ - plan.body.nodes.any fragNodeComputes = true ∧ - (plan.result == .adtRef || plan.result == .intCarrier || - plan.result == .boolI32) = true := by - simp only [classifyRecordCompute] at h - split at h - case isTrue hcond => - simp only [Bool.and_eq_true] at hcond - obtain ⟨⟨⟨h1, h2⟩, h3⟩, h4⟩ := hcond - exact ⟨h1, h2, h3, h4⟩ - case isFalse => exact absurd h (by simp) - -/-- An admitted compute parameter list is never the fused vector-read face's - pinned `(vector, index)` pair: that list HAS an `.adtRef`, so the plan - names a record and `recordComputeShapeOk` then demands every parameter be - `.adtRef` — which its Int-carrier second entry is not. -/ -theorem recordComputeShapeOk_ne_vectorParams - (plan : ExprFragmentRawPlan) - (hShape : recordComputeShapeOk plan = true) : - plan.params ≠ [.adtRef, .intCarrier] := by - intro hEq - have hUses : recordComputeUsesStruct plan = true := by - simp [recordComputeUsesStruct, hEq] - rw [recordComputeShapeOk, if_pos hUses, hEq] at hShape - simp at hShape - -/-- A fired tag-dispatch classifier's body carries an `i32.eq` primitive node - (the five-node match's `n3`) — a kind the compute face's node admission - rejects. -/ -theorem classifyTagDispatch_hasPrim - (plan : ExprFragmentRawPlan) (face : TagDispatchFace) - (h : classifyTagDispatch plan = some face) : - ∃ n ∈ plan.body.nodes, ∃ args, n.kind = .prim .i32Eq args := by - unfold classifyTagDispatch at h - split at h - case isFalse => exact absurd h (by simp) - case isTrue => - split at h - case h_2 => exact absurd h (by simp) - case h_1 n0 n1 n2 n3 n4 hnodes => - split at h - case h_2 => exact absurd h (by simp) - case h_1 optIdx tag hitBlk missBlk h0 h1 h2 h3 h4 => - exact ⟨n3, by rw [hnodes]; simp, [1, 2], h3⟩ - -/-- The compute face's node admission has no `i32.eq` arm: it admits exactly - the three SIGNED RELATIONAL primitives that read a `__aint_cmp` verdict, so - a body whose every node passes `recordComputeNodeOk` carries no `i32.eq` — - which is the node the tag-dispatch face's five-node shape must have. -/ -theorem recordComputeNodeOk_no_eqPrim - (hostTable : List (HostRole × Nat)) (nodes : List FragNode) - (hAll : nodes.all (fun n => recordComputeNodeOk hostTable n.kind) = true) - (n : FragNode) (hMem : n ∈ nodes) (args : List Nat) : - n.kind ≠ .prim .i32Eq args := by - intro hkind - simp only [List.all_eq_true] at hAll - have hOk := hAll n hMem - rw [hkind] at hOk - simp [recordComputeNodeOk] at hOk - -/-- The two-node opaque projection body computes nothing: no construction - and no host call, against the compute classifier's any-fact. -/ -theorem exprProjectionFace?_no_compute - (plan : ExprFragmentRawPlan) (p : Nat × Nat) - (h : AverCert.WasmSlice.exprProjectionFace? plan = some p) : - plan.body.nodes.any fragNodeComputes = false := by - unfold AverCert.WasmSlice.exprProjectionFace? at h - split at h - case isFalse => exact absurd h (by simp) - case isTrue => - split at h - case h_2 => exact absurd h (by simp) - case h_1 n0 n1 hnodes => - split at h - case h_2 => exact absurd h (by simp) - case h_1 structIdx fieldIdx h0 h1 => - rw [hnodes] - simp [fragNodeComputes, h0, h1] - -/-- The two-node record-projection body computes nothing either. -/ -theorem exprRecordProjFace?_no_compute - (plan : ExprFragmentRawPlan) (structIdx field : Nat) - (h : AverCert.WasmSlice.exprRecordProjFace? plan - = some (structIdx, field)) : - plan.body.nodes.any fragNodeComputes = false := by - obtain ⟨-, -, hbody⟩ := - AverCert.WasmSlice.exprRecordProjFace?_spec plan structIdx field h - rw [hbody] - simp [fragNodeComputes] - -/-- The generic gate's walker rejects every construction and host call, so a - walked body has no node the compute classifier's any-fact counts. -/ -theorem genericFragmentAllowedFuel_no_compute - (fuel : Nat) (block : FragBlock) - (h : genericFragmentAllowedFuel fuel block = true) : - block.nodes.any fragNodeComputes = false := by - cases fuel with - | zero => simp [genericFragmentAllowedFuel] at h - | succ fuel => - simp only [genericFragmentAllowedFuel, List.all_eq_true] at h - simp only [List.any_eq_false] - intro n hMem - have hn := (Bool.and_eq_true _ _).mp (h n hMem) |>.2 - cases hkind : n.kind - case structNew tyIdx args => - rw [hkind] at hn - simp at hn - case hostCall role funcIdx args => - rw [hkind] at hn - simp at hn - -- The generic walker fail-closes on the sign template (it has no carrier - -- facts to read the limb/sign fields with), so a walked body carries none. - case intSignCmp op constant scratch value => - rw [hkind] at hn - simp at hn - all_goals simp [fragNodeComputes, hkind] - -noncomputable def symFragmentFace (claim : SymFragmentClaim) : Option StandardFace := - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | none => none - | some plan => - match AverCert.WasmSlice.exprProjectionFace? plan with - | some (structIdx, fieldIdx) => - some (.known (projection claim.carrier structIdx fieldIdx)) - | none => - match classifyTagDispatch plan with - | some face => some (.known (tagDispatch claim.carrier face)) - | none => - match classifyVectorGetOrDefault plan with - | some face => - some (.known (vectorGetOrDefault claim.carrier face)) - | none => - match classifyIntSelect plan with - | some face => - some (.known (intSelectFace claim.carrier face)) - | none => - if genericFragmentAllowed plan then - some (.known - (fragment claim.carrier plan.params plan.result)) - else none - -/-- No `FaceSpec` branch of the classify chain fires on a record-projection - plan, so appending the record face on the chain's `none` arm neither - shadows nor reorders any existing face. Shape by shape: - `exprProjectionFace?` needs an `.adtRef` result, `classifyTagDispatch` a - five-node body, `classifyVectorGetOrDefault` a two-parameter list, - `classifyIntSelect` a two-Int-carrier parameter list, and the generic gate - forbids `.adtRef` parameters — each contradicted by the recognized record - shape. -/ -theorem symFragmentFace_none_of_recordProj - (claim : SymFragmentClaim) (plan : ExprFragmentRawPlan) - (hEncode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan = some plan) - (structIdx field : Nat) - (hRecord : AverCert.WasmSlice.exprRecordProjFace? plan - = some (structIdx, field)) : - symFragmentFace claim = none := by - obtain ⟨hparams, hscalar, hbody⟩ := - AverCert.WasmSlice.exprRecordProjFace?_spec plan structIdx field hRecord - have hresultNe : plan.result ≠ .adtRef := by - intro h - rw [h] at hscalar - simp [AverCert.Schema.fragTyIsRecordScalar] at hscalar - have hbodyResult : plan.body.result = 1 := by rw [hbody] - unfold symFragmentFace - rw [hEncode] - have hProjection : AverCert.WasmSlice.exprProjectionFace? plan = none := by - unfold AverCert.WasmSlice.exprProjectionFace? - simp [hresultNe] - have hTagDispatch : classifyTagDispatch plan = none := by - unfold classifyTagDispatch - simp [hbodyResult] - have hVectorGet : classifyVectorGetOrDefault plan = none := by - unfold classifyVectorGetOrDefault - simp [hparams] - have hIntSelect : classifyIntSelect plan = none := by - unfold classifyIntSelect - simp [hparams] - have hGeneric : genericFragmentAllowed plan = false := by - unfold genericFragmentAllowed - simp [hparams] - simp [hProjection, hTagDispatch, hVectorGet, hIntSelect, hGeneric] - -/-- No `FaceSpec` branch of the classify chain fires on a compute-face plan, - so trying the compute face on the chain's `none` arm neither shadows nor - reorders any existing face. Parameter kill: `classifyVectorGetOrDefault` - pins the mixed `(record, Int)` list, which no admitted compute shape is - (`recordComputeShapeOk_ne_vectorParams`). Body kills: - `classifyTagDispatch` needs an `i32.eq` primitive the node admission - rejects; `classifyIntSelect` needs an `ifElse` node the node admission - rejects; `exprProjectionFace?` and the generic walker admit no - construction, host call or sign template, against the classifier's - any-fact. -/ -theorem symFragmentFace_none_of_recordCompute - (claim : SymFragmentClaim) (plan : ExprFragmentRawPlan) - (hEncode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan = some plan) - (face : RecordComputeFace) - (hFace : classifyRecordCompute claim.hostTable plan = some face) : - symFragmentFace claim = none := by - obtain ⟨hShape, hAllOk, hAny, -⟩ := - classifyRecordCompute_spec claim.hostTable plan face hFace - have hneVec := recordComputeShapeOk_ne_vectorParams plan hShape - unfold symFragmentFace - rw [hEncode] - have hProjection : AverCert.WasmSlice.exprProjectionFace? plan = none := by - cases hp : AverCert.WasmSlice.exprProjectionFace? plan with - | none => rfl - | some p => - exact absurd (exprProjectionFace?_no_compute plan p hp) (by simp [hAny]) - have hTagDispatch : classifyTagDispatch plan = none := by - cases ht : classifyTagDispatch plan with - | none => rfl - | some f => - obtain ⟨n, hMem, args, hkind⟩ := classifyTagDispatch_hasPrim plan f ht - exact absurd hkind - (recordComputeNodeOk_no_eqPrim claim.hostTable plan.body.nodes hAllOk - n hMem args) - have hVectorGet : classifyVectorGetOrDefault plan = none := by - unfold classifyVectorGetOrDefault - simp [hneVec] - have hIntSelect : classifyIntSelect plan = none := by - cases ht : classifyIntSelect plan with - | none => rfl - | some f => - exfalso - obtain ⟨-, -, hbody⟩ := classifyIntSelect_spec plan f ht - rw [hbody] at hAllOk - revert hAllOk - cases f.op <;> - simp [intSelectBlock, intSelectRelBlock, intSelectEqBlock, - recordComputeNodeOk] - have hGeneric : genericFragmentAllowed plan = false := by - unfold genericFragmentAllowed - cases hw : genericFragmentAllowedFuel (sizeOf plan.body + 1) plan.body with - | false => simp [hw] - | true => - exact absurd (genericFragmentAllowedFuel_no_compute _ _ hw) - (by simp [hAny]) - simp [hProjection, hTagDispatch, hVectorGet, hIntSelect, hGeneric] - -def symFragmentMatches - (modBytes modLen : Nat) - (roles : CertDecode.AddSub.Roles) (claim : SymFragmentClaim) : Prop := - hostTableBound roles claim.hostTable = true ∧ - match symFragmentFace claim with - | some face => face.Matches claim.obligation - | none => - -- The record-parameter face fires strictly AFTER every `FaceSpec` - -- branch (provably non-overlapping — `symFragmentFace_none_of_recordProj` - -- shows the chain yields `none` on every recognized record plan, so - -- this arm is the record shape's ONLY route). A plan matching neither - -- remains `False`, exactly as before. - match AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan with - | some plan => - match AverCert.WasmSlice.exprRecordProjFace? plan with - | some _ => recordParamDeclaredFace modBytes modLen claim plan - | none => - match classifyRecordCompute claim.hostTable plan with - | some face => - recordComputeDeclaredFace modBytes modLen claim plan face - | none => False - | none => False - -/-! ### Declared-index envelope faces (user ADT claims) - -The plan/certificate DECLARES ADT envelopes (root, carrier, every constructor's -flattened index, shape, and payload target) plus the opaque type-section prefix -before the constructor entries; the wall CONFIRMS those declarations with ONE -byte-slice equality (`concatPinnedAt`). The declared envelope then pins the -obligation's `Dom`/`domRepr`/`codRepr`/`model` to wall terms computed from the -checked plan, closing the former free-model / free-`domRepr` faces. String.concat -uses only the semantic-field transport below; its ABI/type-section pins live in -`stringConcatPlanAccepted` rather than a synthetic empty ADT envelope. -/ - -/-- The declared-envelope face carried by a named-ADT constructor claim. The - declared hit constructor sits at the byte-pinned `structIdx`; the byte - acceptance gate independently binds `elemTy`/`fieldCount` to the real type - entry at `structIdx`, and requiring the Int-carrier payload here ties the - declared hit shape to that byte-checked entry. -/ -def constructNamedFace - (modBytes modLen : Nat) (claim : ConstructClaim) - (plan : ConstructRawPlan) : Prop := - claim.elemTy = .nullableRef claim.carrier ∧ - claim.fieldCount = 1 ∧ - claim.obligation.host = emptyHost ∧ - ∃ (typePrefix : List Nat) (env : AverCert.DeclaredIndexEnvelope.DIdxEnvelope) - (hhit : AverCert.DeclaredIndexEnvelope.dCtorShape? env claim.structIdx = - some .hit), - AverCert.DeclaredIndexEnvelope.DIdxCtorFace - modBytes modLen typePrefix env claim.structIdx hhit plan claim.obligation - -/-- The declared-envelope face carried by an Int-dispatch claim. Every tested - dispatch tag must be a declared hit constructor whose synthesized entry is - byte-pinned at its declared index by the single `concatPinnedAt` equality; - the obligation's meaning terms are the wall terms over the declared - envelope and the checked plan. -/ -def intDispatchDeclaredFace - (modBytes modLen : Nat) (claim : IntDispatchClaim) - (plan : IntDispatchRawPlan) : Prop := - claim.obligation.policy = .simulatesModel ∧ - claim.obligation.host = - intDispatchCanonicalHost claim.carrier claim.hostTable ∧ - ∃ (typePrefix : List Nat) (env : AverCert.DeclaredIndexEnvelope.DIdxEnvelope), - AverCert.DeclaredIndexEnvelope.DIdxIntReadFace - modBytes modLen typePrefix env plan claim.obligation - -/-- The semantic face carried by a String.concat claim. The literal chunks are - required non-empty so the declared `resultTy` occurs inside the byte-matched - code entry (`array.new_data resultTy`) — a chunk-less plan would leave the - result element type a free semantic tag. The exported/helper declared - function types are byte-pinned by `stringConcatPlanAccepted`, not here. -/ -def stringConcatDeclaredFace - (modBytes modLen : Nat) (claim : StringConcatClaim) - (plan : StringConcatRawPlan) : Prop := - (plan.prefixes.isEmpty && plan.suffixes.isEmpty) = false ∧ - claim.obligation.host = - stringConcatCanonicalHost claim.concatFuncIdx claim.resultTy ∧ - ∃ (typePrefix : List Nat) (env : AverCert.DeclaredIndexEnvelope.DIdxEnvelope), - AverCert.DeclaredIndexEnvelope.DIdxStringConcatFace - modBytes modLen typePrefix env claim.resultTy claim.containerTy plan - claim.obligation - - -def stringEqMatches (manifest : Manifest) (claim : StringEqClaim) : Prop := - match stringEqPlanForExport claim.exportName manifest.stringEqPlans with - | some plan => - (StandardFace.known - (stringEq claim.carrier claim.stringTy claim.stringEqFuncIdx plan)).Matches - claim.obligation - | none => False - -def stringConcatMatches - (modBytes modLen : Nat) (manifest : Manifest) - (claim : StringConcatClaim) : Prop := - match stringConcatPlanForExport claim.exportName manifest.stringConcatPlans with - | some plan => stringConcatDeclaredFace modBytes modLen claim plan - | none => False - -def verbatimMatches (manifest : Manifest) (claim : VerbatimClaim) : Prop := - match verbatimPlanForExport claim.exportName manifest.verbatimPlans with - | some plan => - (StandardFace.known (verbatim claim.carrier plan)).Matches claim.obligation - | none => False - -def fieldProjectionMatches - (manifest : Manifest) (claim : FieldProjectionClaim) : Prop := - match fieldProjectionPlanForExport claim.exportName manifest.fieldProjectionPlans with - | some plan => - (StandardFace.known - (projection claim.carrier claim.structIdx plan.fieldIdx)).Matches claim.obligation - | none => False - -def constructMatches - (modBytes modLen : Nat) (manifest : Manifest) (claim : ConstructClaim) : Prop := - match constructPlanForExport claim.exportName manifest.constructPlans with - | none => False - | some plan => - match claim.symPlan.result with - | .app1 "List" _ => - match plan.arity with - | 1 => - (StandardFace.known - (constructUnary claim.carrier claim.structIdx plan)).Matches - claim.obligation - | 2 => - (StandardFace.known - (constructBinary claim.carrier claim.structIdx plan)).Matches - claim.obligation - | _ => False - | .named _ => constructNamedFace modBytes modLen claim plan - | _ => False - -def recursionMatches - (manifest : Manifest) (roles : CertDecode.AddSub.Roles) - (claim : RecursionClaim) : Prop := - hostTableBound roles claim.hostTable = true ∧ - match recursionPlanForExport claim.exportName manifest.recursionPlans with - | some plan => - (StandardFace.known - (intList claim.carrier plan.params.length - (intDispatchCanonicalHost claim.carrier claim.hostTable))).Matches - claim.obligation - | none => False - -def mutualMatches - (manifest : Manifest) (roles : CertDecode.AddSub.Roles) - (claim : MutualRecursionClaim) : Prop := - hostTableBound roles claim.hostTable = true ∧ - match mutualPlanForExport claim.exportName manifest.mutualPlans with - | some _ => - (StandardFace.known - (intList claim.carrier 1 - (intDispatchCanonicalHost claim.carrier claim.hostTable))).Matches - claim.obligation - | none => False - -def intDispatchMatches - (modBytes modLen : Nat) - (manifest : Manifest) (roles : CertDecode.AddSub.Roles) - (claim : IntDispatchClaim) : Prop := - hostTableBound roles claim.hostTable = true ∧ - match intDispatchPlanForExport claim.exportName manifest.intDispatchPlans with - | some plan => intDispatchDeclaredFace modBytes modLen claim plan - | none => False - -def compositionMatches - (members : List CompositionMemberClaim) - (roles : CertDecode.AddSub.Roles) (claim : CompositionClaim) : Prop := - hostTableBound roles claim.hostTable = true ∧ - match compositionMemberForName claim.exportName members with - | some _ => - (StandardFace.known - (intList claim.carrier 1 - (intDispatchCanonicalHost claim.carrier claim.hostTable))).Matches - claim.obligation - | none => False - -/-- Cross-family uniqueness closes the gap left by uniqueness within individual - plan lists: one obligation export may be claimed by exactly one family. -/ -def claimExportsUnique (artifact : ArtifactData) : Bool := - AverCert.WasmSlice.indexedNodup (claimObligationExports artifact) - -/-- Report one fixed class for every claim in a family. The export and class - stay paired throughout; the verifier never compares two independently - ordered lists. -/ -def fixedReportEntries {Claim : Type u} - (className : String) (obligation : Claim → Obligation) : - List Claim → List (String × String) := - List.map fun claim => ((obligation claim).export_, className) - -def recursionReportEntry - (manifest : Manifest) (claim : RecursionClaim) : Option (String × String) := do - let plan ← recursionPlanForExport claim.exportName manifest.recursionPlans - let className ← match plan.params with - | [_] => some "self-recursive" - | [_, _] => some "multi-argument self-recursive" - | _ => none - pure (claim.obligation.export_, className) - -/-- Derive every public class label from the checked claim family and plan. - This is report data only, but deriving it in the wall prevents the package - producer from choosing a more favourable label for an accepted obligation. -/ -def claimReportEntries (artifact : ArtifactData) : Option (List (String × String)) := do - let recursion ← artifact.recursionClaims.mapM - (recursionReportEntry artifact.manifest) - pure <| - fixedReportEntries "expr-fragment-v1" - (fun c : SymFragmentClaim => c.obligation) artifact.symFragmentClaims ++ - fixedReportEntries "verbatim-string-eq" - (fun c : StringEqClaim => c.obligation) artifact.stringEqClaims ++ - fixedReportEntries "verbatim-string-concat" - (fun c : StringConcatClaim => c.obligation) artifact.stringConcatClaims ++ - fixedReportEntries "adt-constructor" - (fun c : ConstructClaim => c.obligation) artifact.constructClaims ++ - recursion ++ - fixedReportEntries "mutual-recursive" - (fun c : MutualRecursionClaim => c.obligation) artifact.mutualRecursionClaims ++ - fixedReportEntries "verbatim-dispatch" - (fun c : VerbatimClaim => c.obligation) artifact.verbatimClaims ++ - fixedReportEntries "int-dispatch" - (fun c : IntDispatchClaim => c.obligation) artifact.intDispatchClaims ++ - fixedReportEntries "field-projection" - (fun c : FieldProjectionClaim => c.obligation) artifact.fieldProjectionClaims ++ - fixedReportEntries "cross-function-composition" - (fun c : CompositionClaim => c.obligation) artifact.compositionClaims - -def reportEntryFor - (entries : List (String × String)) (obligation : Obligation) : - Option (String × String) := do - let className ← namedPlanForExport obligation.export_ entries - pure (obligation.export_, className) - -/-- Public report entries in manifest order. Cross-family uniqueness is checked - before lookup, so a label can never be selected by first-match ambiguity. -/ -def reportEntries (artifact : ArtifactData) : Option (List (String × String)) := - if claimExportsUnique artifact then do - let entries ← claimReportEntries artifact - artifact.manifest.obligations.mapM (reportEntryFor entries) - else none - -/-- Every claim is unique across families and carries the semantic face selected - by its checked family and plan. This is deliberately conjoined with the - established byte-origin predicates; moving reconstruction into Lean does - not remove any existing acceptance gate. -/ -def checkedFaces (artifact : ArtifactData) : Prop := - claimExportsUnique artifact = true ∧ - allClaims (symFragmentMatches artifact.modBytes artifact.modLen - artifact.manifest.subject.hostRoles) artifact.symFragmentClaims ∧ - allClaims (stringEqMatches artifact.manifest) artifact.stringEqClaims ∧ - allClaims (stringConcatMatches artifact.modBytes artifact.modLen - artifact.manifest) artifact.stringConcatClaims ∧ - allClaims (constructMatches artifact.modBytes artifact.modLen - artifact.manifest) artifact.constructClaims ∧ - allClaims (recursionMatches artifact.manifest - artifact.manifest.subject.hostRoles) artifact.recursionClaims ∧ - allClaims (mutualMatches artifact.manifest - artifact.manifest.subject.hostRoles) artifact.mutualRecursionClaims ∧ - allClaims (verbatimMatches artifact.manifest) artifact.verbatimClaims ∧ - allClaims (intDispatchMatches artifact.modBytes artifact.modLen - artifact.manifest artifact.manifest.subject.hostRoles) - artifact.intDispatchClaims ∧ - allClaims (fieldProjectionMatches artifact.manifest) artifact.fieldProjectionClaims ∧ - allClaims (compositionMatches artifact.compositionMembers - artifact.manifest.subject.hostRoles) artifact.compositionClaims - -/-! ### The fused vector-read template-implies-model theorem - -Generic over every template hole, the code table (pinned only at the self -entry, exactly what byte acceptance certifies), and any `toIndex` helper -obeying the relational `__aint_to_index` contract: running the fused template -on a represented `(vector, index)` yields a represented `vecModel`. Partial -correctness — vacuous on trap or fuel exhaustion, like `Obligation.holds`. -The generated certificate's fused-read side condition discharges through this -theorem; the semantics is proven by the audited interpreter clauses, never by -a byte-pin of the claim body. -/ -set_option maxRecDepth 100000 in -set_option maxHeartbeats 4000000 in -theorem vectorGetOrDefault_simulates_model - (carrier toIndexIdx boxIdx arrTy : Nat) (d : Int) - (hIdx : toIndexIdx ≠ boxIdx) - (S : CarrierSpec carrier) - (toIndex : List WVal → Option WVal) - (hToIndex : ∀ n w r, intRepr S n w → toIndex [w] = some r → - r = .i32v (toIndexW n)) - (code : CodeTbl) (self : Nat) - (hCode : code self = some - ⟨2, 1, AverCert.PlanLower.vectorGetOrDefaultTemplate toIndexIdx boxIdx arrTy d⟩) - (fuel : Nat) (v : List Int) (i : Int) (vs : List WVal) (w : WVal) - (hDom : vecDomRepr carrier arrTy S (v, i) vs) - (hRun : wFuncN code - (vectorGetOrDefaultHostSlots carrier toIndexIdx boxIdx toIndex) - fuel self vs = some w) : - intRepr S (vecModel d (v, i)) w := by - obtain ⟨elems, wi, rfl, hlen0, hbound, hall0, hwi0⟩ := hDom - -- Re-state the relation components with `(v, i).fst/.snd` projected away so - -- `omega` sees one atom per length. - have hlen : elems.length = v.length := hlen0 - have hall : ∀ k, k < v.length → ∃ w, elems[k]? = some w ∧ - intRepr S (v[k]!) w := hall0 - have hwi : intRepr S i wi := hwi0 - have hbox : ¬(boxIdx = toIndexIdx) := fun h => hIdx h.symm - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - cases htix : toIndex [wi] with - | none => - simp [wFuncN, hCode, AverCert.PlanLower.vectorGetOrDefaultTemplate, - vectorGetOrDefaultHostSlots, initLocals, wRunF, popArgs, htix] at hRun - | some r => - have hr := hToIndex i wi r hwi htix - subst hr - by_cases hin : 0 ≤ i ∧ i < (v.length : Int) - · -- In bounds: the hit arm reads the represented element. - have hlt31 : i < 2147483648 := by omega - have ht : toIndexW i = i := by - simp [toIndexW, hin.1, hlt31] - rw [ht] at htix - have hkn : i.toNat < v.length := by omega - obtain ⟨wv, hw, hwr⟩ := hall i.toNat hkn - have hidx : i.toNat < elems.length := by omega - have hwv : elems[i.toNat] = wv := by - simpa [List.getElem?_eq_getElem hidx] using hw - have hemodI : i.emod 4294967296 = i := by - show i % 4294967296 = i - omega - have hemodL : ((elems.length : Int)).emod 4294967296 = - (elems.length : Int) := by - show (elems.length : Int) % 4294967296 = (elems.length : Int) - omega - have hilen : i < (elems.length : Int) := by omega - simp [wFuncN, hCode, AverCert.PlanLower.vectorGetOrDefaultTemplate, - vectorGetOrDefaultHostSlots, initLocals, wRunF, popArgs, b32, - htix, ht, hin.1, hemodI, hemodL, hilen, hbox, hw] at hRun - subst hRun - simpa [vecModel, hin, hwv] using hwr - · -- Out of bounds: the miss arm boxes the literal default. - have hmodel : vecModel d (v, i) = d := by - simp only [vecModel] - exact if_neg hin - rw [hmodel] - by_cases hsmall : 0 ≤ i ∧ i < 2147483648 - · -- The extracted index is `i` itself but fails the unsigned - -- length test (`i >= len`). - have ht : toIndexW i = i := by simp [toIndexW, hsmall] - rw [ht] at htix - have hemodI : i.emod 4294967296 = i := by - show i % 4294967296 = i - omega - have hemodL : ((elems.length : Int)).emod 4294967296 = - (elems.length : Int) := by - show (elems.length : Int) % 4294967296 = (elems.length : Int) - omega - have hnlt : ¬(i < (elems.length : Int)) := by omega - simp [wFuncN, hCode, AverCert.PlanLower.vectorGetOrDefaultTemplate, - vectorGetOrDefaultHostSlots, initLocals, wRunF, popArgs, b32, - htix, ht, hsmall.1, hemodI, hemodL, hnlt, hbox, boxRef] at hRun - subst hRun - exact S.smallIntro d - · -- The helper collapses the index to the sentinel `-1`, which - -- fails the signed lower-bound test. - have ht : toIndexW i = -1 := by simp [toIndexW, hsmall] - rw [ht] at htix - simp [wFuncN, hCode, AverCert.PlanLower.vectorGetOrDefaultTemplate, - vectorGetOrDefaultHostSlots, initLocals, wRunF, popArgs, b32, - htix, ht, hbox, boxRef] at hRun - subst hRun - exact S.smallIntro d - -/-! ### The record-parameter transport (HEq pins onto the obligation fields) - -Same discipline as `DeclaredEnvelopeAcceptTransport`: the obligation's field -values are supplied as ordinary universally quantified variables so `subst` -applies once each pin is turned into an `Eq`, and no cast residue survives. The -core is `SchemaCore.recordParam_simulates_model` — the single generic -template-implies-model theorem the certified Plan's record declarations -instantiate. -/ - -/-- The canonical lowering of the recognized record-projection body is exactly - the two-instruction `recordProjTemplate` — by computation, for every - carrier, struct index, field and declared node types. -/ -theorem lowerBlock_recordProj (carrier structIdx field : Nat) (ty0 ty1 : FragTy) : - AverCert.PlanLower.lowerBlock carrier - { nodes := [{ id := 0, ty := ty0, kind := .local 0 }, - { id := 1, ty := ty1, kind := .structGetUser structIdx field 0 }], - result := 1 } = - some (recordProjTemplate structIdx field) := rfl - -/-- The dependent-cast core for the record-parameter face: with the obligation - field values as free variables and the face's pins as `Eq`/`HEq`, a - successful run of the pinned template on a represented record yields a - represented model value — exactly `recordParam_simulates_model`, carried - onto the pinned fields. Generic over the host table (the template makes no - host call) and the declared-locals count. -/ -theorem recordParam_transport - (claimCarrier : Nat) - (fields : List TypeDecl) (structIdx field : Nat) - (hfield : field < fields.length) - (carrier : Nat) (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hcar : carrier = claimCarrier) - (hDom : HEq Dom (RecordFields fields)) - (hCod : HEq Cod (RecordVal (fields[field]'hfield))) - (hdomRepr : HEq domRepr (recordParamDomRepr claimCarrier structIdx fields)) - (hcodRepr : HEq codRepr (recordParamCodRepr claimCarrier fields field hfield)) - (hmodel : HEq model (recordParamModel fields field hfield)) - (code : CodeTbl) (host : HostTbl) (self nlocals : Nat) - (hCode : code self = some ⟨1, nlocals, recordProjTemplate structIdx field⟩) - (S : CarrierSpec carrier) (fuel : Nat) (x : Dom) (vs : List WVal) (w : WVal) - (hdom : domRepr S x vs) - (hRun : wFuncN code host fuel self vs = some w) : - codRepr S (model x) w := by - subst hcar - have hDomEq : Dom = RecordFields fields := eq_of_heq hDom - subst hDomEq - have hCodEq : Cod = RecordVal (fields[field]'hfield) := eq_of_heq hCod - subst hCodEq - have e1 : domRepr = recordParamDomRepr carrier structIdx fields := eq_of_heq hdomRepr - subst e1 - have e2 : codRepr = recordParamCodRepr carrier fields field hfield := eq_of_heq hcodRepr - subst e2 - have e3 : model = recordParamModel fields field hfield := eq_of_heq hmodel - subst e3 - obtain ⟨ws, rfl, hrepr⟩ := hdom - exact recordParam_simulates_model S structIdx field nlocals fields hfield - host code self hCode fuel x ws w hrepr hRun - -/-! ### The Int comparison faces: chain selection, lowering, and the two -template-implies-model theorems - -The classifier fires strictly after every earlier `FaceSpec` branch and is -mutually exclusive with all of them by PARAMETER LIST alone (the projection, -tag-dispatch and fused-read shapes all take an `.adtRef`). The generic gate -below it still rejects the shape, because it rejects every `.hostCall` node. - -The `simulates_model` theorems are the audited content of this leg: generic -over the carrier spec, the helper index, the declared-local count, the code -table (pinned only at the self entry, exactly what byte acceptance certifies), -the fuel, and ANY helper obeying the `__aint_cmp` / `__aint_eq` contract, -running the emitted body on the small carriers of two band-bounded integers -yields a represented model value. Partial correctness — vacuous on trap or fuel -exhaustion, like `Obligation.holds`. -/ - -theorem symFragmentFace_intSelect - (claim : SymFragmentClaim) (plan : ExprFragmentRawPlan) (face : IntCmpFace) - (hEncode : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan - claim.hostTable claim.structTable claim.plan = some plan) - (hCls : classifyIntSelect plan = some face) : - symFragmentFace claim = some (.known (intSelectFace claim.carrier face)) := by - obtain ⟨hparams, -, _hbody⟩ := classifyIntSelect_spec plan face hCls - unfold symFragmentFace - rw [hEncode] - have hProjection : AverCert.WasmSlice.exprProjectionFace? plan = none := by - unfold AverCert.WasmSlice.exprProjectionFace? - simp [hparams] - have hTagDispatch : classifyTagDispatch plan = none := by - unfold classifyTagDispatch - simp [hparams] - have hVectorGet : classifyVectorGetOrDefault plan = none := by - unfold classifyVectorGetOrDefault - simp [hparams] - simp [hProjection, hTagDispatch, hVectorGet, hCls] - -/-- The carrier binding is NOT optional for either face, and does not depend on - the host table being non-empty. Both faces pin an `.intCarrier` parameter - list, which makes `fragPlanMentionsIntCarrier` — and therefore - `symFragmentCarrierBindingRequired` — true whatever the table holds, so - acceptance's `symFragmentCarrierBound` must present the DECODED carrier - state (`CertDecode.carrierState`) and not a claimed index. The table trigger - fires too (the encoder resolves a `hostCall` role only through the table, so - a plan carrying one cannot come from an empty table), but this statement - stands without it. -/ -theorem classifyIntSelect_forcesCarrierBinding - (hostTable : List (HostRole × Nat)) (plan : ExprFragmentRawPlan) - (face : IntCmpFace) (h : classifyIntSelect plan = some face) : - symFragmentCarrierBindingRequired hostTable plan = true := by - obtain ⟨hparams, -, -⟩ := classifyIntSelect_spec plan face h - simp [symFragmentCarrierBindingRequired, fragPlanMentionsIntCarrier, hparams, - fragTyIsIntCarrier] - -/-- The canonical lowering of each pinned comparison body is exactly its - template — by computation, for every carrier, operator and helper index. -/ -theorem lowerBlock_intCmp (carrier : Nat) (op : IntCmpOp) (helperIdx : Nat) : - AverCert.PlanLower.lowerBlock carrier (intCmpBlock op helperIdx) - = some (intCmpTemplate op helperIdx) := by - cases op <;> rfl - -theorem lowerBlock_intSelect (carrier : Nat) (op : IntCmpOp) (helperIdx : Nat) : - AverCert.PlanLower.lowerBlock carrier (intSelectBlock op helperIdx) - = some (intSelectTemplate op helperIdx) := by - cases op <;> rfl - -/-! ### The pinned node lists reproduce the measured witness bytes - -`PlanBytes` lowers the pinned blocks to the exact code-entry bodies read off -the real modules in this leg's empirical stage: the ONE-element locals vector -holding an UNUSED carrier-typed local (not optional padding — the emitter -declares it), the two argument reads, the helper call, the `i32.const 0` and -signed tail, and — for the selection — an `if` whose block type is the INLINE -nullable-carrier-reference value type `63 `, never an empty or -`i32` block-type byte. The wide instantiation exercises the multi-byte -`uleb32`/`s33` splices that every measured module leaves untouched (all their -holes are below `0x80`). -/ - -/-- `match a < b { true -> a; false -> b }` at carrier 2, helper index 9: the - 23-byte body, both arms bare argument reads. -/ -theorem intSelectBytes_relational : - AverCert.PlanBytes.lowerExprFragmentBodyBytes 2 - { profile := "expr-fragment-v1", params := [.intCarrier, .intCarrier], - result := .intCarrier, body := intSelectBlock .lt 9 } = - some [0x01, 0x01, 0x63, 0x02, 0x20, 0x00, 0x20, 0x01, 0x10, 0x09, - 0x41, 0x00, 0x48, 0x04, 0x63, 0x02, 0x20, 0x00, 0x05, 0x20, 0x01, - 0x0b, 0x0b] := by - rfl - -/-- The same shape at carrier 200 and helper index 300, where both the block - type and the call immediate need two bytes. -/ -theorem intSelectBytes_wideIndices : - AverCert.PlanBytes.lowerExprFragmentBodyBytes 200 - { profile := "expr-fragment-v1", params := [.intCarrier, .intCarrier], - result := .intCarrier, body := intSelectBlock .gt 300 } = - some [0x01, 0x01, 0x63, 0xc8, 0x01, 0x20, 0x00, 0x20, 0x01, 0x10, 0xac, - 0x02, 0x41, 0x00, 0x4a, 0x04, 0x63, 0xc8, 0x01, 0x20, 0x00, 0x05, - 0x20, 0x01, 0x0b, 0x0b] := by - rfl - -theorem intCmp_simulates_model - (carrier helperIdx : Nat) (op : IntCmpOp) - (S : CarrierSpec carrier) - (cmp eq : List WVal → Option WVal) - (hCmp : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - cmp [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (cmpW k1 k2)) - (hEq : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - eq [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (eqW k1 k2)) - (code : CodeTbl) (self nlocals : Nat) - (hCode : code self = some ⟨2, nlocals, intCmpTemplate op helperIdx⟩) - (fuel : Nat) (p : Int × Int) (vs : List WVal) (w : WVal) - (hDom : intPairSmallBandDomRepr carrier S p vs) - (hRun : wFuncN code (intCmpHostSlots op helperIdx cmp eq) fuel self vs = some w) : - boolRepr S (intCmpModel op p) w := by - obtain ⟨rfl, hlo1, hhi1, hlo2, hhi2⟩ := hDom - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - cases op with - | lt => - cases hc : cmp [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hCmp p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - simp [boolRepr, intCmpModel, ← hRun, b32, cmpW_lt_iff] - | gt => - cases hc : cmp [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hCmp p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - simp [boolRepr, intCmpModel, ← hRun, b32, cmpW_gt_iff] - | ge => - cases hc : cmp [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hCmp p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - simp [boolRepr, intCmpModel, ← hRun, b32, cmpW_ge_iff] - | eq => - cases hc : eq [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hEq p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - simp [wFuncN, hCode, intCmpTemplate, intCmpHostSlots, intCmpHelper, - initLocals, wRunF, popArgs, hc] at hRun - simp [boolRepr, intCmpModel, ← hRun, b32, eqW] - -theorem intSelect_simulates_model - (carrier helperIdx : Nat) (op : IntCmpOp) - (S : CarrierSpec carrier) - (cmp eq : List WVal → Option WVal) - (hCmp : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - cmp [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (cmpW k1 k2)) - (hEq : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - eq [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (eqW k1 k2)) - (code : CodeTbl) (self nlocals : Nat) - (hCode : code self = some ⟨2, nlocals, intSelectTemplate op helperIdx⟩) - (fuel : Nat) (p : Int × Int) (vs : List WVal) (w : WVal) - (hDom : intPairSmallBandDomRepr carrier S p vs) - (hRun : wFuncN code (intCmpHostSlots op helperIdx cmp eq) fuel self vs = some w) : - intRepr S (intSelectModel op p) w := by - obtain ⟨rfl, hlo1, hhi1, hlo2, hhi2⟩ := hDom - cases fuel with - | zero => simp [wFuncN] at hRun - | succ fuel => - cases op with - | lt => - cases hc : cmp [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hCmp p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - by_cases hrel : p.1 < p.2 - · simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, b32, cmpW_lt_iff, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.1 - · simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, b32, cmpW_lt_iff, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.2 - | gt => - cases hc : cmp [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hCmp p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - by_cases hrel : p.2 < p.1 - · simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, b32, cmpW_gt_iff, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.1 - · simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, b32, cmpW_gt_iff, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.2 - | ge => - cases hc : cmp [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hCmp p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - by_cases hrel : p.2 ≤ p.1 - · simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, b32, cmpW_ge_iff, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.1 - · simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, b32, cmpW_ge_iff, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.2 - | eq => - cases hc : eq [carrierSmall carrier p.1, carrierSmall carrier p.2] with - | none => - simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc] at hRun - | some r => - have hr := hEq p.1 p.2 r hlo1 hhi1 hlo2 hhi2 hc - subst hr - by_cases hrel : p.1 = p.2 - · -- `hrel` is an equation between the two operands, so it also - -- rewrites the host-call ARGUMENTS; `hc` has to be moved to the - -- same normal form or it stops matching the run. - rw [hrel] at hc - simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, eqW, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.1 - · simp [wFuncN, hCode, intSelectTemplate, intCmpTemplate, intCmpHostSlots, - intCmpHelper, initLocals, wRunF, popArgs, hc, eqW, - hrel] at hRun - simpa [intRepr, intSelectModel, intCmpModel, hrel, ← hRun] using S.smallIntro p.2 - -/-! ### The Int comparison transports (`HEq` pins onto the obligation fields) - -Same discipline as `recordParam_transport`: the obligation's field values are -supplied as ordinary universally quantified variables so `subst` applies once -each pin is turned into an `Eq`, and no cast residue survives. -/ - -theorem intCmp_transport - (claimCarrier helperIdx : Nat) (op : IntCmpOp) - (carrier : Nat) (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hcar : carrier = claimCarrier) - (hDomT : HEq Dom (Int × Int)) - (hCodT : HEq Cod Bool) - (hdomRepr : HEq domRepr (intPairSmallBandDomRepr claimCarrier)) - (hcodRepr : HEq codRepr (boolRepr (C := claimCarrier))) - (hmodel : HEq model (intCmpModel op)) - (S : CarrierSpec carrier) - (cmp eq : List WVal → Option WVal) - (hCmp : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - cmp [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (cmpW k1 k2)) - (hEq : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - eq [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (eqW k1 k2)) - (code : CodeTbl) (self nlocals : Nat) - (hCode : code self = some ⟨2, nlocals, intCmpTemplate op helperIdx⟩) - (fuel : Nat) (x : Dom) (vs : List WVal) (w : WVal) - (hdom : domRepr S x vs) - (hRun : wFuncN code (intCmpHostSlots op helperIdx cmp eq) fuel self vs = some w) : - codRepr S (model x) w := by - subst hcar - have hD : Dom = (Int × Int) := eq_of_heq hDomT - subst hD - have hC : Cod = Bool := eq_of_heq hCodT - subst hC - have e1 : domRepr = intPairSmallBandDomRepr carrier := eq_of_heq hdomRepr - subst e1 - have e2 : codRepr = boolRepr := eq_of_heq hcodRepr - subst e2 - have e3 : model = intCmpModel op := eq_of_heq hmodel - subst e3 - exact intCmp_simulates_model carrier helperIdx op S cmp eq hCmp hEq code self - nlocals hCode fuel x vs w hdom hRun - -theorem intSelect_transport - (claimCarrier helperIdx : Nat) (op : IntCmpOp) - (carrier : Nat) (Dom Cod : Type) - (domRepr : CarrierSpec carrier → Dom → List WVal → Prop) - (codRepr : CarrierSpec carrier → Cod → WVal → Prop) - (model : Dom → Cod) - (hcar : carrier = claimCarrier) - (hDomT : HEq Dom (Int × Int)) - (hCodT : HEq Cod Int) - (hdomRepr : HEq domRepr (intPairSmallBandDomRepr claimCarrier)) - (hcodRepr : HEq codRepr (intRepr (C := claimCarrier))) - (hmodel : HEq model (intSelectModel op)) - (S : CarrierSpec carrier) - (cmp eq : List WVal → Option WVal) - (hCmp : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - cmp [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (cmpW k1 k2)) - (hEq : ∀ k1 k2 r, -(2 ^ 63 : Int) ≤ k1 → k1 < 2 ^ 63 → - -(2 ^ 63 : Int) ≤ k2 → k2 < 2 ^ 63 → - eq [carrierSmall carrier k1, carrierSmall carrier k2] = some r → - r = .i32v (eqW k1 k2)) - (code : CodeTbl) (self nlocals : Nat) - (hCode : code self = some ⟨2, nlocals, intSelectTemplate op helperIdx⟩) - (fuel : Nat) (x : Dom) (vs : List WVal) (w : WVal) - (hdom : domRepr S x vs) - (hRun : wFuncN code (intCmpHostSlots op helperIdx cmp eq) fuel self vs = some w) : - codRepr S (model x) w := by - subst hcar - have hD : Dom = (Int × Int) := eq_of_heq hDomT - subst hD - have hC : Cod = Int := eq_of_heq hCodT - subst hC - have e1 : domRepr = intPairSmallBandDomRepr carrier := eq_of_heq hdomRepr - subst e1 - have e2 : codRepr = intRepr := eq_of_heq hcodRepr - subst e2 - have e3 : model = intSelectModel op := eq_of_heq hmodel - subst e3 - exact intSelect_simulates_model carrier helperIdx op S cmp eq hCmp hEq code self - nlocals hCode fuel x vs w hdom hRun - -#print axioms symFragmentFace_none_of_recordProj -#print axioms recordParam_transport -#print axioms classifyIntSelect_forcesCarrierBinding -#print axioms intCmp_simulates_model -#print axioms intSelect_simulates_model -#print axioms intCmp_transport -#print axioms intSelect_transport - -end AverCert.StandardFace diff --git a/aver-cert/assets/wall/current/StringSoundness.lean b/aver-cert/assets/wall/current/StringSoundness.lean deleted file mode 100644 index 705606286..000000000 --- a/aver-cert/assets/wall/current/StringSoundness.lean +++ /dev/null @@ -1,288 +0,0 @@ -/- Generic soundness for String.eq and String.concat certificates. - - The model is explicit and the helper implementations remain abstract. The - only facts used about them are the named contracts from SchemaCore.holds. - Literal strings are interpreted exactly as array.new_data does. -/ -import CertPrelude -import SchemaCore -import PlanCheck -import PlanLower - -set_option maxRecDepth 100000 - -namespace StringSoundness -open CertPrelude AverCert.Schema AverCert.PlanLower - -/-! ## Model and reusable invariant -/ - -def byteArray (ty : Nat) (bytes : List Nat) : WVal := - .arr ty (bytes.map (fun b => .i32v (Int.ofNat b))) - -def evalEqResult (stringTy : Nat) (input : WVal) : StringEqResult → WVal - | .input => input - | .literal chunk => byteArray stringTy chunk.bytes - -def evalStringEq (stringTy : Nat) (plan : StringEqRawPlan) (input : WVal) : WVal := - if stringEqW input (byteArray stringTy plan.needle.bytes) then - evalEqResult stringTy input plan.hit - else - evalEqResult stringTy input plan.default - -def evalConcatChunks (stringTy : Nat) : List StringConcatChunk → List WVal - | [] => [] - | chunk :: rest => byteArray stringTy chunk.bytes :: evalConcatChunks stringTy rest - -def evalConcatParts (stringTy : Nat) (plan : StringConcatRawPlan) (input : WVal) : List WVal := - evalConcatChunks stringTy plan.prefixes ++ - [input] ++ evalConcatChunks stringTy plan.suffixes - -def evalStringConcat (stringTy containerTy : Nat) - (plan : StringConcatRawPlan) (input : WVal) : WVal := - (stringConcatW stringTy (.arr containerTy (evalConcatParts stringTy plan input))).getD .null - -inductive ValKind where - | exact (v : WVal) - | arr (ty : Nat) (bytes : List Nat) - -def ValOK : ValKind → WVal → Prop - | .exact v, w => w = v - | .arr ty bytes, w => w = byteArray ty bytes - -def StackOK : List ValKind → List WVal → Prop - | [], [] => True - | k :: ks, w :: ws => ValOK k w ∧ StackOK ks ws - | _, _ => False - -theorem evalConcatChunks_length (stringTy : Nat) : ∀ chunks, - (evalConcatChunks stringTy chunks).length = chunks.length := by - intro chunks - induction chunks <;> simp [evalConcatChunks, *] - -theorem runConcatChunks - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (stringTy : Nat) (locals : List WVal) : - ∀ (chunks : List StringConcatChunk) (st : List WVal) (rest : List WInstr), - wRunF host ar callee - (lowerStringConcatChunks stringTy chunks ++ rest) locals st = - wRunF host ar callee rest locals - ((evalConcatChunks stringTy chunks).reverse ++ st) := by - intro chunks - induction chunks with - | nil => intro st rest; rfl - | cons chunk chunks ih => - intro st rest - simp [lowerStringConcatChunks, lowerStringConcatChunk, evalConcatChunks, - wRunF, byteArray, Function.comp_def, ih, List.append_assoc] - -theorem runEqResult - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (stringTy : Nat) (input : WVal) (locals : List WVal) - (hlocal : locals[0]? = some input) (st : List WVal) : - ∀ (result : StringEqResult) (rest : List WInstr), - wRunF host ar callee (lowerStringEqResult stringTy result ++ rest) locals st = - wRunF host ar callee rest locals (evalEqResult stringTy input result :: st) := by - intro result rest - cases result with - | input => simp [lowerStringEqResult, evalEqResult, wRunF, hlocal] - | literal chunk => - simp [lowerStringEqResult, lowerStringEqChunk, evalEqResult, byteArray, - wRunF, Function.comp_def] - -theorem runEqTail - (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - (stringTy stringEqFuncIdx : Nat) (stringEq : List WVal → Option WVal) - (hhost : host stringEqFuncIdx = some (2, stringEq)) - (hStringEq : ∀ a b w, - stringEq [a, b] = some w → w = b32 (stringEqW a b)) - (plan : StringEqRawPlan) (input : WVal) (locals : List WVal) - (hlocal : locals[0]? = some input) : - wRunF host ar callee - (lowerStringEqChunk stringTy plan.needle ++ - [.call stringEqFuncIdx, - .ifElse (lowerStringEqResult stringTy plan.hit) - (lowerStringEqResult stringTy plan.default)]) - locals [input] = - match stringEq [input, byteArray stringTy plan.needle.bytes] with - | none => none - | some _ => some (.ok locals [evalStringEq stringTy plan input]) := by - simp only [lowerStringEqChunk, List.cons_append, List.nil_append, wRunF, - hhost, popArgs, Function.comp_def] - simp [popArgs] - simp only [byteArray] - cases hcall : stringEq [input, - .arr stringTy (plan.needle.bytes.map (fun b => .i32v (Int.ofNat b)))] with - | none => simp [hcall] - | some got => - have hgot := hStringEq input - (.arr stringTy (plan.needle.bytes.map (fun b => .i32v (Int.ofNat b)))) got hcall - cases heq : stringEqW input - (.arr stringTy (plan.needle.bytes.map (fun b => .i32v (Int.ofNat b)))) - · have hr := runEqResult host ar callee stringTy input locals hlocal [] - plan.default [] - have heq' : stringEqW input - (.arr stringTy (plan.needle.bytes.map (fun b => .i32v (Int.ofNat b)))) = false := heq - have hr' : wRunF host ar callee - (lowerStringEqResult stringTy plan.default) locals [] = - some (.ok locals [evalEqResult stringTy input plan.default]) := by - simpa [wRunF] using hr - rw [hgot] - simp only [b32, heq', Bool.false_eq_true, ↓reduceIte, wRunF] - rw [hr'] - simp only [evalStringEq, byteArray, heq', Bool.false_eq_true, ↓reduceIte] - · have hr := runEqResult host ar callee stringTy input locals hlocal [] - plan.hit [] - have heq' : stringEqW input - (.arr stringTy (plan.needle.bytes.map (fun b => .i32v (Int.ofNat b)))) = true := heq - have hr' : wRunF host ar callee - (lowerStringEqResult stringTy plan.hit) locals [] = - some (.ok locals [evalEqResult stringTy input plan.hit]) := by - simpa [wRunF] using hr - rw [hgot] - simp only [b32, heq', ↓reduceIte, wRunF] - simp - rw [hr'] - simp only [evalStringEq, byteArray, heq', ↓reduceIte] - -theorem popConcatStack (stringTy : Nat) (prefixes suffixes : List StringConcatChunk) - (v : WVal) : - popArgs (prefixes.length + 1 + suffixes.length) - ((evalConcatChunks stringTy suffixes).reverse ++ - v :: (evalConcatChunks stringTy prefixes).reverse) = - some (evalConcatChunks stringTy prefixes ++ [v] ++ - evalConcatChunks stringTy suffixes, []) := by - have hlen : - ((evalConcatChunks stringTy suffixes).reverse ++ - v :: (evalConcatChunks stringTy prefixes).reverse).length = - prefixes.length + 1 + suffixes.length := by - simp [evalConcatChunks_length] - omega - have ht : List.take (prefixes.length + 1 + suffixes.length) - ((evalConcatChunks stringTy suffixes).reverse ++ - v :: (evalConcatChunks stringTy prefixes).reverse) = - ((evalConcatChunks stringTy suffixes).reverse ++ - v :: (evalConcatChunks stringTy prefixes).reverse) := by - rw [← hlen] - exact List.take_length - simp [popArgs, hlen, ht, List.append_assoc] - -/-! ## Generic String.concat certificate -/ - -/-- The concatenation body reads only `local.get 0`, so the certificate is - independent of how many declared locals follow the argument in the frame: - `nlocals` is a parameter here, and the caller supplies whichever count the - module's carrier state produced. -/ -theorem generic_string_concat_certified - (stringTy containerTy concatFuncIdx nlocals : Nat) - (plan : StringConcatRawPlan) - (code : CodeTbl) (host : HostTbl) (self : Nat) - (stringConcat : Nat → List WVal → Option WVal) - (hStringConcat : ∀ resultTy parts c, - stringConcat resultTy [parts] = some c → stringConcatW resultTy parts = some c) - (hcheck : AverCert.PlanCheck.checkStringConcatRawPlan plan = true) - (instrs : List WInstr) - (hlow : lowerStringConcatBody stringTy containerTy concatFuncIdx plan = some instrs) - (hself : code self = some ⟨1, nlocals, instrs⟩) - (hhost : host concatFuncIdx = some (1, stringConcat stringTy)) : - ∀ (fuel : Nat) (v w : WVal), - wFuncN code host (fuel + 1) self [v] = some w → - w = evalStringConcat stringTy containerTy plan v := by - intro fuel v w hrun - have hbody : instrs = - lowerStringConcatChunks stringTy plan.prefixes ++ [.localGet 0] ++ - lowerStringConcatChunks stringTy plan.suffixes ++ - [.arrayNewFixed containerTy (plan.prefixes.length + 1 + plan.suffixes.length), - .call concatFuncIdx] := by - simp [lowerStringConcatBody, hcheck] at hlow - simpa [List.append_assoc] using hlow.symm - subst instrs - simp only [wFuncN, hself, initLocals] at hrun - simp only [List.append_assoc] at hrun - rw [runConcatChunks] at hrun - simp [wRunF] at hrun - rw [runConcatChunks] at hrun - simp only [wRunF, hhost] at hrun - rw [popConcatStack] at hrun - simp only [evalConcatParts, List.singleton_append] at hrun - cases hcall : stringConcat stringTy - [.arr containerTy (evalConcatParts stringTy plan v)] with - | none => - have hcall' : stringConcat stringTy - [.arr containerTy (evalConcatChunks stringTy plan.prefixes ++ - v :: evalConcatChunks stringTy plan.suffixes)] = none := by - simpa [evalConcatParts, List.append_assoc] using hcall - simp [popArgs, hcall'] at hrun - | some got => - have hcall' : stringConcat stringTy - [.arr containerTy (evalConcatChunks stringTy plan.prefixes ++ - v :: evalConcatChunks stringTy plan.suffixes)] = some got := by - simpa [evalConcatParts, List.append_assoc] using hcall - have hgot : stringConcatW stringTy - (.arr containerTy (evalConcatParts stringTy plan v)) = some got := - hStringConcat stringTy (.arr containerTy (evalConcatParts stringTy plan v)) got hcall - simp [popArgs, hcall'] at hrun - subst w - simp [evalStringConcat, hgot] - -/-! ## Generic String.eq certificate -/ - -theorem generic_string_eq_certified - (stringTy stringEqFuncIdx : Nat) - (plan : StringEqRawPlan) - (code : CodeTbl) (host : HostTbl) (self : Nat) - (stringEq : List WVal → Option WVal) - (hStringEq : ∀ a b w, - stringEq [a, b] = some w → w = b32 (stringEqW a b)) - (hcheck : AverCert.PlanCheck.checkStringEqRawPlan plan = true) - (instrs : List WInstr) - (hlow : lowerStringEqBody stringTy stringEqFuncIdx plan = some instrs) - (hself : code self = some ⟨1, 2, instrs⟩) - (hhost : host stringEqFuncIdx = some (2, stringEq)) : - ∀ (fuel : Nat) (v w : WVal), - wFuncN code host (fuel + 1) self [v] = some w → - w = evalStringEq stringTy plan v := by - intro fuel v w hrun - have hbody : instrs = - [.localGet 0, .localSet 1, .localGet 1, .refCast stringTy] ++ - lowerStringEqChunk stringTy plan.needle ++ - [.call stringEqFuncIdx, - .ifElse (lowerStringEqResult stringTy plan.hit) - (lowerStringEqResult stringTy plan.default)] := by - simp [lowerStringEqBody, hcheck] at hlow - exact hlow.symm - subst instrs - cases v with - | i32v n => simp [wFuncN, wRunF, hself, initLocals, List.set] at hrun - | i64v n => simp [wFuncN, wRunF, hself, initLocals, List.set] at hrun - | f64v bits => simp [wFuncN, wRunF, hself, initLocals, List.set] at hrun - | null => simp [wFuncN, wRunF, hself, initLocals, List.set] at hrun - | structv ty fields => - by_cases hty : ty = stringTy - · subst ty - simp only [wFuncN, hself] at hrun - simp [List.append_assoc, wRunF, initLocals, List.set] at hrun - rw [runEqTail host (fun g => (code g).map (·.arity)) - (fun g as => wFuncN code host fuel g as) stringTy stringEqFuncIdx - stringEq hhost hStringEq plan (.structv stringTy fields) - [.structv stringTy fields, .structv stringTy fields, .null] rfl] at hrun - cases hc : stringEq [.structv stringTy fields, - byteArray stringTy plan.needle.bytes] with - | none => simp [hc] at hrun - | some got => simp [hc] at hrun; exact hrun.symm - · simp [wFuncN, wRunF, hself, initLocals, List.set, hty] at hrun - | arr ty elems => - by_cases hty : ty = stringTy - · subst ty - simp only [wFuncN, hself] at hrun - simp [List.append_assoc, wRunF, initLocals, List.set] at hrun - rw [runEqTail host (fun g => (code g).map (·.arity)) - (fun g as => wFuncN code host fuel g as) stringTy stringEqFuncIdx - stringEq hhost hStringEq plan (.arr stringTy elems) - [.arr stringTy elems, .arr stringTy elems, .null] rfl] at hrun - cases hc : stringEq [.arr stringTy elems, - byteArray stringTy plan.needle.bytes] with - | none => simp [hc] at hrun - | some got => simp [hc] at hrun; exact hrun.symm - · simp [wFuncN, wRunF, hself, initLocals, List.set, hty] at hrun - - -end StringSoundness diff --git a/aver-cert/assets/wall/current/TypeTable.lean b/aver-cert/assets/wall/current/TypeTable.lean new file mode 100644 index 000000000..56cbf0bbb --- /dev/null +++ b/aver-cert/assets/wall/current/TypeTable.lean @@ -0,0 +1,489 @@ +/- TypeTable — the declared module layout, confirmed against the bytes. + + A certificate DECLARES, for every source type its plans mention, the wasm + type index that represents it (`Schema.TypeTable`), and the runtime helper + indices (`Schema.Subject`). This file turns those declarations into the + lowering context `Grammar.MCtx` (`mctxOf`), and confirms each declared entry + against the module's type and data sections: + + * the Int carrier is the one `CertDecode.carrierState` finds, or absent + exactly when the module has none; its limb field names the declared + magnitude array; + * every struct and array the table names is an entry of the rec group that + OPENS the type section (so it starts at type index 0), and the entry's + field storage is exactly the representation of the declared field types: + records and tuples, constructor structs `sub final root`, sum roots + `sub (struct)`, Option `{i32, T}`, Result `{i32, T, E}`, `List` + `{T, ref null self}`, `Vector` arrays, `$string` = `(array (mut i8))` + and `Vector` = `(array (ref null $string))`; + * a one-field (newtype) record is represented by its field's value, whose + declared heap type must be the record's declared index (a raw-`i64` + newtype has no heap type and is declined); + * every sum passes `Grammar.sumOk` (distinct constructor structs) and the + S-3 pin `GrammarLower.S3Pin` over the raw bytes of the opening rec group; + * no struct index serves two declarations; + * every string literal's data segment holds exactly its bytes + (`GrammarLower.DataPin`, S-11). + + An index the table or the subject does not declare lowers to `absent k`, + which is outside the u32 index space: any lowering that writes it fails to + encode, so a plan citing an undeclared type or helper declines. -/ +import GrammarLower +import SchemaCore +import CertDecode + +namespace AverCert.TypeTable +open CertPrelude AverCert.Schema AverCert.Grammar + +/-! ## The lowering context of a manifest -/ + +/-- An index that is never a u32: every encoder of the lowering rejects it. -/ +def absent (k : Nat) : Nat := 4294967296 + k + +def idxOr (k : Nat) : Option Nat → Nat + | some i => i + | none => absent k + +def lookupTy (k : Nat) (xs : List (Ty × Nat)) (t : Ty) : Nat := + ((xs.find? fun x => decide (x.1 = t)).map (·.2)).getD (absent k) + +def lookupNat (k : Nat) (xs : List (Nat × Nat)) (t : Nat) : Nat := + ((xs.find? fun x => x.1 == t).map (·.2)).getD (absent k) + +def recordOf (tt : TypeTable) (tid : Nat) : Option RecordDecl := + tt.records.find? (·.tid == tid) + +def sumOf (tt : TypeTable) (tid : Nat) : Option SumDecl := + tt.sums.find? (·.tid == tid) + +def entryOf (fns : List FnEntry) (f : Nat) : Option FnEntry := + fns.find? (·.funcIdx == f) + +/-- The planned function at a function index (first binding). -/ +def planOf (fns : List FnEntry) (f : Nat) : Option FnPlan := + (entryOf fns f).map (·.plan) + +def roleOf (roles : Option CertDecode.AddSub.Roles) (pick : CertDecode.AddSub.Roles → Option Nat) : + Option Nat := + roles.bind pick + +def stringRole (rs : List (Nat × CertDecode.StringHost.Role)) (r : CertDecode.StringHost.Role) : + Option Nat := + (rs.find? fun x => x.2 == r).map (·.1) + +/-- The lowering context of a manifest: every index from a declaration, and + `absent` where there is none. The Int negation helper is not a declared + role (its body has no wall template yet), so a plan with `neg` lowers to + `call (absent 5)` and declines. -/ +def mctxOf (s : Subject) (tt : TypeTable) (fns : List FnEntry) : MCtx := + { carrier := idxOr 0 tt.carrier + box := idxOr 1 (roleOf s.hostRoleTable (·.box)) + add := idxOr 2 (roleOf s.hostRoleTable (·.add)) + sub := idxOr 3 (roleOf s.hostRoleTable (·.sub)) + mul := idxOr 4 (roleOf s.hostRoleTable (·.mul)) + neg := absent 5 + cmp := idxOr 6 (roleOf s.hostRoleTable (·.cmp)) + eq := idxOr 7 (roleOf s.hostRoleTable (·.eq)) + structOf := fun tid => idxOr 8 ((recordOf tt tid).map (·.struct)) + recFields := fun tid => (recordOf tt tid).map (·.fields) + sigs := fun f => (planOf fns f).map (·.sig) + sumCtors := fun tid => (sumOf tt tid).map (fun d => d.ctors.map (·.2)) + ctorStruct := fun tid c => idxOr 9 ((sumOf tt tid).bind (fun d => (d.ctors[c]?).map (·.1))) + sumRoot := fun tid => idxOr 10 ((sumOf tt tid).map (·.root)) + optStruct := lookupTy 11 tt.options + resStruct := fun t e => idxOr 12 ((tt.results.find? fun x => decide (x.1 = t ∧ x.2.1 = e)).map + (·.2.2)) + mag := idxOr 13 tt.mag + str := idxOr 14 tt.str + strSeg := fun b => idxOr 15 ((tt.strSegs.find? fun x => decide (x.1 = b)).map (·.2)) + strVec := idxOr 16 tt.strVec + concat := idxOr 17 (stringRole s.stringHostRoles .concat) + streq := idxOr 18 (stringRole s.stringHostRoles .eq) + toIndex := idxOr 19 (roleOf s.hostRoleTable (·.toIndex)) + divmod := idxOr 23 (roleOf s.hostRoleTable (·.divmod)) + vecStruct := lookupTy 20 tt.vecs + listStruct := lookupTy 21 tt.lists + opaqueStruct := lookupNat 22 tt.opaques } + +/-! ## The opening rec group, raw and decoded + +The type section's first rectype must be an explicit rec group (`0x4e`). Its +subtypes are cut at the lengths `CertDecode.readTypeEntry` consumes, the same +strict decoder the rest of the wall reads the type section with; each entry is +returned as its exact bytes and its decoded form. Entry `k` is the subtype at +type index `k`. -/ + +def typeSectionStart (n len : Nat) : Option (Nat × Nat) := + match CertDecode.modulePayload 1 n len with + | none => none + | some (tN, tLen) => + match CertDecode.readU tN tLen with + | none => none + | some (_, n1, len1) => some (n1, len1) + +def readEntriesRaw : Nat → Nat → Nat → Option (List (List Nat × CertDecode.TypeEntry)) + | 0, _, _ => some [] + | k + 1, n, len => + match CertDecode.readTypeEntry n len with + | none => none + | some (e, n1, len1) => + match readEntriesRaw k n1 len1 with + | none => none + | some rest => some ((CertDecode.takeBytes (len - len1) n, e) :: rest) + +def firstRecGroup (n len : Nat) : Option (List (List Nat × CertDecode.TypeEntry)) := + match typeSectionStart n len with + | none => none + | some (n1, len1) => + if len1 == 0 then none + else if (n1 &&& 0xff) == 0x4e then + match CertDecode.readU (n1 >>> 8) (len1 - 1) with + | none => none + | some (count, n2, len2) => readEntriesRaw count n2 len2 + else none + +/-! ## Expected storage of a source type -/ + +/-- The decoded value type of a source type's representation (the typed twin + of `GrammarLower.valTy`): `i32` for Bool, `f64` for Float, `eqref` for the + subject scratch, and a nullable concrete reference for everything else. An + index outside the u32 space (an undeclared one) has none. -/ +def valTyD (M : MCtx) (t : Ty) : Option CertDecode.ValType := + let ref (i : Nat) : Option CertDecode.ValType := + if i < 4294967296 then some (.ref 0x63 (Int.ofNat i)) else none + match t with + | .int => ref M.carrier + | .bool => some (.numeric 0x7f) + | .float => some (.numeric 0x7c) + | .eqref => some (.abstract 0x6d) + | .record tid => ref (M.structOf tid) + | .sum tid => ref (M.sumRoot tid) + | .option t => ref (M.optStruct t) + | .result t e => ref (M.resStruct t e) + | .string => ref M.str + | .vec t => ref (M.vecStruct t) + | .list t => ref (M.listStruct t) + | .opaque tid => ref (M.opaqueStruct tid) + +def storagesOf (M : MCtx) (ts : List Ty) : Option (List CertDecode.StorageType) := + ts.mapM fun t => (valTyD M t).map .val + +def structStorages : CertDecode.TypeEntry → Option (List CertDecode.StorageType) + | ⟨_, .structType fs⟩ => some (fs.map (·.storage)) + | _ => none + +/-- The entry at `idx` of the group is a struct whose fields store exactly + the representations of `ts` (mutability aside: the grammar never writes a + field). -/ +def structIs (M : MCtx) (grp : List (List Nat × CertDecode.TypeEntry)) (idx : Nat) + (ts : List Ty) : Bool := + match grp[idx]?, storagesOf M ts with + | some (_, e), some ss => structStorages e == some ss + | _, _ => false + +def arrayIs (grp : List (List Nat × CertDecode.TypeEntry)) (idx : Nat) + (st : CertDecode.StorageType) : Bool := + match grp[idx]? with + | some (_, ⟨_, .arrayType f⟩) => f.storage == st + | _ => false + +def refTo (i : Nat) : CertDecode.StorageType := .val (.ref 0x63 (Int.ofNat i)) + +/-! ## The pins -/ + +/-- The carrier declaration is the byte-derived carrier state, and a present + carrier's limb field names the declared magnitude array, itself an `i64` + array of the opening group. -/ +def carrierConfirmed (n len : Nat) (grp : List (List Nat × CertDecode.TypeEntry)) + (tt : TypeTable) : Bool := + match CertDecode.carrierState n len, tt.carrier, tt.mag with + | some (some c), some c', some m => + c == c' && decide (c < 4294967296) && decide (m < 4294967296) && + arrayIs grp m (.val (.numeric 0x7e)) && + (match grp[c]? with + | some (_, ⟨_, .structType fs⟩) => (fs[1]?).map (·.storage) == some (refTo m) + | _ => false) + | some none, none, none => true + | _, _, _ => false + +def recordConfirmed (M : MCtx) (grp : List (List Nat × CertDecode.TypeEntry)) + (r : RecordDecl) : Bool := + match r.fields with + | [f] => valTyD M f == some (.ref 0x63 (Int.ofNat r.struct)) && decide (r.struct < 4294967296) + | _ => decide (2 ≤ r.fields.length) && structIs M grp r.struct r.fields + +def rootIs (grp : List (List Nat × CertDecode.TypeEntry)) (idx : Nat) : Bool := + match grp[idx]? with + | some (_, e) => e == ⟨.sub [], .structType []⟩ + | none => false + +def ctorIs (M : MCtx) (grp : List (List Nat × CertDecode.TypeEntry)) (root : Nat) + (c : Nat × List Ty) : Bool := + structIs M grp c.1 c.2 && + (match grp[c.1]? with + | some (_, e) => e.form == .subFinal [root] + | none => false) + +def sumConfirmed (M : MCtx) (grp : List (List Nat × CertDecode.TypeEntry)) (d : SumDecl) : + Bool := + rootIs grp d.root && d.ctors.all (ctorIs M grp d.root) && sumOk M d.tid && + S3Pin M d.tid d.ctors.length (grp.map (·.1)) + +/-- Every struct index a declaration owns (a newtype owns none; an opaque + type owns its heap type). -/ +def ownedStructs (tt : TypeTable) : List Nat := + (tt.records.filter (fun r => decide (2 ≤ r.fields.length))).map (·.struct) ++ + (tt.sums.map fun d => d.root :: d.ctors.map (·.1)).flatten ++ + tt.options.map (·.2) ++ tt.results.map (·.2.2) ++ tt.lists.map (·.2) ++ + tt.vecs.map (·.2) ++ tt.carrier.toList ++ tt.mag.toList ++ tt.str.toList ++ + tt.strVec.toList ++ tt.opaques.map (·.2) + +def natNodup : List Nat → Bool + | [] => true + | x :: xs => !xs.contains x && natNodup xs + +/-- Every declared type id appears once, so the lookups `mctxOf` makes are the + declarations the pins confirm. -/ +def keysUnique (tt : TypeTable) : Bool := + natNodup (tt.records.map (·.tid)) && natNodup (tt.sums.map (·.tid)) + +/-- The whole type table against the module bytes (S-2, S-3). -/ +def typeTableConfirmed (n len : Nat) (s : Subject) (tt : TypeTable) (fns : List FnEntry) : + Bool := + let M := mctxOf s tt fns + (CertDecode.decodeTypes n len).isSome && + match firstRecGroup n len with + | none => false + | some grp => + keysUnique tt && + carrierConfirmed n len grp tt && + natNodup (ownedStructs tt) && + tt.records.all (recordConfirmed M grp) && + tt.sums.all (sumConfirmed M grp) && + tt.options.all (fun o => structIs M grp o.2 [.bool, o.1]) && + tt.results.all (fun r => structIs M grp r.2.2 [.bool, r.1, r.2.1]) && + tt.lists.all (fun l => structIs M grp l.2 [l.1, .list l.1]) && + tt.vecs.all (fun v => match storagesOf M [v.1] with + | some [st] => arrayIs grp v.2 st + | _ => false) && + tt.opaques.all (fun o => decide (o.2 < grp.length)) && + (match tt.str with + | some i => arrayIs grp i (.packed 0x78) + | none => true) && + (match tt.strVec, tt.str with + | some v, some i => arrayIs grp v (refTo i) + | none, _ => true + | some _, none => false) + +/-- S-11 over the module's data section: every declared literal-to-segment + entry names a passive segment holding exactly its bytes, and every string + literal of every plan names such a segment. -/ +def dataConfirmed (n len : Nat) (s : Subject) (tt : TypeTable) (fns : List FnEntry) : Bool := + match CertDecode.decodeData n len with + | some segs => + tt.strSegs.all (fun x => segs[x.2]? == some x.1) && + fns.all fun e => DataPin (mctxOf s tt fns) segs e.plan + | none => false + +/-! ## Well-formed declarations: no vacuous obligation + +An obligation (`Schema.Obligation.holds`) quantifies over source values of +the plan's parameter types (`Grammar.HasTy`). A declared type no finite value +inhabits makes that hypothesis unsatisfiable and the obligation true of any +code: a self-referential newtype `R = [record R]` (whose struct pin +`recordConfirmed` then reads as a tautology), a record `R = [int, record R]` +over a self-referential struct, or `eqref` in a signature. The acceptance +therefore requires, over the declarations alone: + +* `eqref` appears only as the type of the subject-scratch local, never in a + signature, a record or constructor field, or an Option / Result / List / + Vector element; +* every chain of one-field records ends at a type that is not a one-field + record (no newtype cycle); +* every declared record and sum, and every parameter and result type of every + plan, has a finite value: the least fixpoint below, and `inhabTy_sound` + turns a passing check into a value (`AcceptanceSoundness.accepted_nonvacuous` + states it for every certified export). -/ + +/-- `eqref` occurs nowhere in `t`. -/ +def noEqref : Ty → Bool + | .eqref => false + | .option t => noEqref t + | .vec t => noEqref t + | .list t => noEqref t + | .result t e => noEqref t && noEqref e + | _ => true + +/-- Every local is free of `eqref`, except that the subject-scratch local (at + position `scratch` of the declared locals) may be exactly `eqref`. -/ +def localsOk (scratch : Nat) : Nat → List Ty → Bool + | _, [] => true + | i, t :: ts => + (noEqref t || (i == scratch && decide (t = .eqref))) && localsOk scratch (i + 1) ts + +def planEqrefOk (p : FnPlan) : Bool := + p.sig.params.all noEqref && noEqref p.sig.ret && + localsOk (p.nslots - p.sig.params.length) 0 p.locals + +def eqrefConfined (tt : TypeTable) (fns : List FnEntry) : Bool := + tt.records.all (fun r => r.fields.all noEqref) && + tt.sums.all (fun d => d.ctors.all fun c => c.2.all noEqref) && + tt.options.all (fun o => noEqref o.1) && + tt.results.all (fun r => noEqref r.1 && noEqref r.2.1) && + tt.vecs.all (fun v => noEqref v.1) && + tt.lists.all (fun l => noEqref l.1) && + fns.all (fun e => planEqrefOk e.plan) + +/-- Following one-field records from `t` for at most `k` steps reaches a type + that is not a declared one-field record. -/ +def ntGrounded (tt : TypeTable) : Nat → Ty → Bool + | 0, .record tid => !((recordOf tt tid).any fun r => r.fields.length == 1) + | k + 1, .record tid => + match recordOf tt tid with + | some r => + match r.fields with + | [f] => ntGrounded tt k f + | _ => true + | none => true + | _, _ => true + +/-- No newtype cycle: `recordConfirmed`'s pin of a one-field record reads its + field's representation, which must not lead back to the record itself. -/ +def newtypesGrounded (tt : TypeTable) : Bool := + tt.records.all fun r => ntGrounded tt tt.records.length (.record r.tid) + +/-- The types with a finite value, given record ids `R` and sum ids `S` + already known to have one. -/ +def inhabTy (R S : List Nat) : Ty → Bool + | .int => true + | .bool => true + | .float => true + | .string => true + | .opaque _ => true + | .option _ => true + | .list _ => true + | .vec _ => true + | .result t e => inhabTy R S t || inhabTy R S e + | .record tid => R.contains tid + | .sum tid => S.contains tid + | .eqref => false + +/-- One round: a record whose fields all have a value, a sum with a + constructor whose fields all have a value. -/ +def inhabStep (M : MCtx) (rids sids R S : List Nat) : List Nat × List Nat := + (rids.filter fun tid => + match M.recFields tid with + | some fts => fts.all (inhabTy R S) + | none => false, + sids.filter fun tid => + match M.sumCtors tid with + | some cs => cs.any fun fs => fs.all (inhabTy R S) + | none => false) + +def inhabIter (M : MCtx) (rids sids : List Nat) : Nat → List Nat × List Nat + | 0 => ([], []) + | k + 1 => inhabStep M rids sids (inhabIter M rids sids k).1 (inhabIter M rids sids k).2 + +/-- The inhabited record and sum ids of a table: the step is monotone and + the ids are finite, so this many rounds reach the least fixpoint. -/ +def inhabSets (M : MCtx) (tt : TypeTable) : List Nat × List Nat := + inhabIter M (tt.records.map (·.tid)) (tt.sums.map (·.tid)) + (tt.records.length + tt.sums.length + 1) + +def inhabited (M : MCtx) (tt : TypeTable) (t : Ty) : Bool := + inhabTy (inhabSets M tt).1 (inhabSets M tt).2 t + +/-- Every declared record and sum, and every parameter and result type of + every plan, has a finite value. -/ +def typesInhabited (M : MCtx) (tt : TypeTable) (fns : List FnEntry) : Bool := + tt.records.all (fun r => inhabited M tt (.record r.tid)) && + tt.sums.all (fun d => inhabited M tt (.sum d.tid)) && + fns.all (fun e => e.plan.sig.params.all (inhabited M tt) && inhabited M tt e.plan.sig.ret) + +/-- The whole non-vacuity check of the declarations. -/ +def declsWellFormed (s : Subject) (tt : TypeTable) (fns : List FnEntry) : Bool := + eqrefConfined tt fns && newtypesGrounded tt && typesInhabited (mctxOf s tt fns) tt fns + +/-! ### Soundness of the inhabitation check -/ + +section Inhab +variable {M : MCtx} + +theorem inhabTy_sound {R S : List Nat} + (hR : ∀ tid ∈ R, ∃ v, HasTy M v (.record tid)) + (hS : ∀ tid ∈ S, ∃ v, HasTy M v (.sum tid)) : + ∀ t, inhabTy R S t = true → ∃ v, HasTy M v t + | .int, _ => ⟨.i 0, by simp [HasTy]⟩ + | .bool, _ => ⟨.b true, by simp [HasTy]⟩ + | .float, _ => ⟨.f 0, by simp [HasTy]⟩ + | .string, _ => ⟨.s [], by simp [HasTy]⟩ + | .opaque _, _ => ⟨.w .null, by simp [HasTy]⟩ + | .option t, _ => ⟨.none t, by simp [HasTy]⟩ + | .list t, _ => ⟨.nil t, by simp [HasTy]⟩ + | .vec t, _ => ⟨.vec t [], by simp [HasTy, HasTyAll]⟩ + | .result t e, h => by + simp only [inhabTy, Bool.or_eq_true] at h + rcases h with h | h + · obtain ⟨v, hv⟩ := inhabTy_sound hR hS t h + exact ⟨.ok t e v, by simp [HasTy, hv]⟩ + · obtain ⟨v, hv⟩ := inhabTy_sound hR hS e h + exact ⟨.err t e v, by simp [HasTy, hv]⟩ + | .record tid, h => hR tid (by simpa [inhabTy] using h) + | .sum tid, h => hS tid (by simpa [inhabTy] using h) + | .eqref, h => by simp [inhabTy] at h + +theorem inhabTyL_sound {R S : List Nat} + (hR : ∀ tid ∈ R, ∃ v, HasTy M v (.record tid)) + (hS : ∀ tid ∈ S, ∃ v, HasTy M v (.sum tid)) : + ∀ ts : List Ty, ts.all (inhabTy R S) = true → ∃ vs, HasTyL M vs ts + | [], _ => ⟨[], by simp [HasTyL]⟩ + | t :: ts, h => by + simp only [List.all_cons, Bool.and_eq_true] at h + obtain ⟨v, hv⟩ := inhabTy_sound hR hS t h.1 + obtain ⟨vs, hvs⟩ := inhabTyL_sound hR hS ts h.2 + exact ⟨v :: vs, by simp [HasTyL, hv, hvs]⟩ + +theorem inhabIter_sound (rids sids : List Nat) : + ∀ k, (∀ tid ∈ (inhabIter M rids sids k).1, ∃ v, HasTy M v (.record tid)) ∧ + (∀ tid ∈ (inhabIter M rids sids k).2, ∃ v, HasTy M v (.sum tid)) + | 0 => ⟨by simp [inhabIter], by simp [inhabIter]⟩ + | k + 1 => by + obtain ⟨hR, hS⟩ := inhabIter_sound rids sids k + refine ⟨?_, ?_⟩ + · intro tid htid + simp only [inhabIter, inhabStep, List.mem_filter] at htid + obtain ⟨-, hf⟩ := htid + cases hr : M.recFields tid with + | none => rw [hr] at hf; cases hf + | some fts => + rw [hr] at hf + obtain ⟨vs, hvs⟩ := inhabTyL_sound hR hS fts hf + refine ⟨.record tid vs, ?_⟩ + simp only [HasTy, true_and] + exact ⟨fts, hr, hvs⟩ + · intro tid htid + simp only [inhabIter, inhabStep, List.mem_filter] at htid + obtain ⟨-, hf⟩ := htid + cases hc : M.sumCtors tid with + | none => rw [hc] at hf; cases hf + | some cs => + rw [hc] at hf + obtain ⟨fs, hfs, hall⟩ := List.any_eq_true.mp hf + obtain ⟨c, hcget⟩ := List.getElem?_of_mem hfs + obtain ⟨vs, hvs⟩ := inhabTyL_sound hR hS fs hall + refine ⟨.variant tid c vs, ?_⟩ + simp only [HasTy, true_and] + exact ⟨fs, by simp [ctorFields, hc, hcget], hvs⟩ + +/-- A type the check passes has a value. -/ +theorem inhabited_sound {tt : TypeTable} {t : Ty} (h : inhabited M tt t = true) : + ∃ v, HasTy M v t := + inhabTy_sound (inhabIter_sound _ _ _).1 (inhabIter_sound _ _ _).2 t h + +theorem inhabitedL_sound {tt : TypeTable} {ts : List Ty} + (h : ts.all (inhabited M tt) = true) : ∃ vs, HasTyL M vs ts := + inhabTyL_sound (inhabIter_sound _ _ _).1 (inhabIter_sound _ _ _).2 ts h + +end Inhab + +end AverCert.TypeTable diff --git a/aver-cert/assets/wall/current/WasmSlice.lean b/aver-cert/assets/wall/current/WasmSlice.lean index 603a3c46a..57628aecf 100644 --- a/aver-cert/assets/wall/current/WasmSlice.lean +++ b/aver-cert/assets/wall/current/WasmSlice.lean @@ -5,7 +5,6 @@ -- exact raw code/data slices into the shapes admitted by certified plans. Its -- closure scanner additionally rejects every instruction channel outside the -- certificate profile. -import SchemaCore import CertDecode import Std.Data.TreeSet @@ -196,327 +195,6 @@ def checkComparisonFuncType (carrier : Nat) (entry : CertDecode.TypeEntry) : Boo decide (results = [.numeric 0x7f]) | _, _ => false -/-- The exact declared function type fixed by one certified host-helper role: - `box` wraps a raw `i64` into the carrier, `toIndex` extracts a raw `i32` - array index from the carrier, `cmp` and `eq` take two carriers and return a - raw `i32` verdict, and the arithmetic combinators carry the canonical - two-argument carrier signature. Helper BODIES are pinned - elsewhere by template byte equality, which leaves the declared type free: - a helper declared at a strict supertype of the carrier reference still - wasm-validates by subtyping while the proof faces model the exact claimed - carrier. This check closes that declared-type channel. - - `cmp` and `eq` share a signature, which is exactly why the SEPARATE - export-name pin on each of them is load-bearing: the declared type alone - cannot tell the two helpers apart. -/ -def checkHostRoleFuncType (carrier : Nat) : - AverCert.Schema.HostRole → CertDecode.TypeEntry → Bool - | .box, entry => - match entry.form, entry.composite with - | .plain, .funcType params results => - decide (params = [.numeric 0x7e]) && - decide (results = [nullableRefType carrier]) - | _, _ => false - | .toIndex, entry => - match entry.form, entry.composite with - | .plain, .funcType params results => - decide (params = [nullableRefType carrier]) && - decide (results = [.numeric 0x7f]) - | _, _ => false - | .add, entry => checkCanonicalFuncType 2 carrier entry - | .sub, entry => checkCanonicalFuncType 2 carrier entry - | .mul, entry => checkCanonicalFuncType 2 carrier entry - | .cmp, entry => checkComparisonFuncType carrier entry - | .eq, entry => checkComparisonFuncType carrier entry - -def fragValTypeMatches (carrier : Nat) : - AverCert.Schema.FragTy → CertDecode.ValType → Bool - | .f64, .numeric 0x7c => true - | .boolI32, .numeric 0x7f => true - | .i64, .numeric 0x7e => true - | .rawI32, .numeric 0x7f => true - | .intCarrier, actual => actual == nullableRefType carrier - | .ref, .ref 0x63 heap => decide (0 ≤ heap) - | .adtRef, .ref 0x63 heap => - decide (0 ≤ heap) && decide (heap ≠ Int.ofNat carrier) - | _, _ => false - -def fragParamsMatch (carrier : Nat) : - List AverCert.Schema.FragTy → List CertDecode.ValType → Bool - | [], [] => true - | expected :: expectedRest, actual :: actualRest => - fragValTypeMatches carrier expected actual && - fragParamsMatch carrier expectedRest actualRest - | _, _ => false - -/-- Exact scalar/reference shape of an expression-fragment function. Unlike a - code entry, the type-section binding distinguishes e.g. `f64 → i32` from - `i32 → f64`; reference-shaped ADT projections are tightened nominally by - `exprFragmentNominalTypesMatch` below. -/ -def checkExprFragmentFuncType - (carrier : Nat) - (params : List AverCert.Schema.FragTy) - (result : AverCert.Schema.FragTy) - (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .funcType actualParams [actualResult] => - fragParamsMatch carrier params actualParams && - fragValTypeMatches carrier result actualResult - | _, _ => false - -def exprFragmentFuncTypeMatches - (modBytes modLen typeIdx carrier : Nat) - (params : List AverCert.Schema.FragTy) - (result : AverCert.Schema.FragTy) : Bool := - typeSectionMatches (checkExprFragmentFuncType carrier params result) - modBytes modLen typeIdx - -/-- One of the two admitted opaque-ADT fragment shapes is a direct field - projection (the other, tag dispatch, is checked below). Its function - parameter must name that exact struct, and its result must equal the - selected field's decoded storage type. This simultaneously proves that - the struct and field exist in the artifact's type section. - - `fields.length == 2` is the same arity pin `checkTagDispatchTypes` carries - and for the same reason: the projection face states - `domRepr := vs = [.structv structIdx [p.1, p.2]]`, a struct value with - exactly two fields, so a type entry of any other width would make the - obligation quantify over states the module forbids. -/ -def checkExprProjectionTypes - (carrier structIdx fieldIdx : Nat) - (funcEntry structEntry : CertDecode.TypeEntry) : Bool := - if structIdx == carrier then false else - match funcEntry.form, funcEntry.composite, - structEntry.form, structEntry.composite with - | .plain, .funcType [param] [result], .plain, .structType fields => - fields.length == 2 && decide (param = nullableRefType structIdx) && - match fields[fieldIdx]? with - | some { storage := .val fieldType, .. } => decide (result = fieldType) - | _ => false - | _, _, _, _ => false - -def exprProjectionTypesMatch - (modBytes modLen typeIdx carrier structIdx fieldIdx : Nat) : Bool := - match CertDecode.decodeTypes modBytes modLen with - | some info => - match info.entryIndex[typeIdx]?, info.entryIndex[structIdx]? with - | some funcEntry, some structEntry => - checkExprProjectionTypes carrier structIdx fieldIdx funcEntry structEntry - | _, _ => false - | none => false - -def exprProjectionFace? (plan : AverCert.Schema.ExprFragmentRawPlan) : - Option (Nat × Nat) := - if plan.params = [.adtRef] && plan.result = .adtRef && - plan.body.result = 1 then - match plan.body.nodes with - | [n0, n1] => - match n0.kind, n1.kind with - | .local 0, .structGetUser structIdx fieldIdx 0 => - if fieldIdx ≤ 1 && n0.ty = .adtRef && n1.ty = .adtRef then - some (structIdx, fieldIdx) - else none - | _, _ => none - | _ => none - else none - -/-- Byte-level recognizer of the tag-dispatch shape (mirror of the representation - plan; lives here because WasmSlice cannot import StandardFace). Returns the - scrutinee struct index. -/ -def exprTagDispatchStructIdx? (plan : AverCert.Schema.ExprFragmentRawPlan) : Option Nat := - if plan.params = [.adtRef] && plan.result = .intCarrier && plan.body.result = 4 then - match plan.body.nodes with - | [n0, n1, n2, n3, n4] => - match n0.kind, n1.kind, n2.kind, n3.kind, n4.kind with - | .local 0, .structGetUser structIdx 0 0, .constI32 _, .prim .i32Eq [1, 2], .ifElse 3 _ _ => - if n0.ty = .adtRef && n1.ty = .rawI32 && n2.ty = .rawI32 && - n3.ty = .boolI32 && n4.ty = .intCarrier - then some structIdx else none - | _, _, _, _, _ => none - | _ => none - else none - -/-- The scrutinee struct must have EXACTLY two fields, of which field 0 is the - i32 operational tag. Guard structIdx≠carrier (the Int carrier is never the - scrutinee). - - The field count is soundness-relevant, not tidiness. The tag-dispatch face - states `domRepr := vs = [.structv structIdx [.i32v p.1, p.2]]` — a struct - value with exactly two fields at that index. A module whose type section - declares the index with a different field count admits no such state, so - the obligation would be quantified over nothing while the report labels the - export certified. `fields.length` here is `CertDecode.TypeEntry.fieldCount` - of the same decoded entry — the quantity `CertDecode.decodeStructFieldCount` - reports for this index — read off the single decode already performed by - `exprTagDispatchTypesMatch` rather than by decoding the section twice. -/ -def checkTagDispatchTypes (carrier structIdx : Nat) (structEntry : CertDecode.TypeEntry) : Bool := - if structIdx == carrier then false else - match structEntry.form, structEntry.composite with - | .plain, .structType fields => - fields.length == 2 && - match (fields[0]? : Option CertDecode.FieldType) with - | some { storage := .val (.numeric 0x7f), .. } => true - | _ => false - | _, _ => false - -def exprTagDispatchTypesMatch (modBytes modLen carrier structIdx : Nat) : Bool := - match CertDecode.decodeTypes modBytes modLen with - | some info => - match info.entryIndex[structIdx]? with - | some structEntry => checkTagDispatchTypes carrier structIdx structEntry - | none => false - | none => false - -/-- Byte-level recognizer of the monolithic fused vector-read shape (mirror of - the representation plan). Returns the vector's array type index. -/ -def exprVectorGetOrDefaultArrTy? - (plan : AverCert.Schema.ExprFragmentRawPlan) : Option Nat := - if plan.params = [.adtRef, .intCarrier] && plan.result = .intCarrier && - plan.body.result = 0 then - match plan.body.nodes with - | [n0] => - match n0.kind with - | .vectorGetOrDefault arrTy _toIndexIdx _boxIdx _default => - if n0.ty = .intCarrier then some arrTy else none - | _ => none - | _ => none - else none - -/-- The fused vector read is nominally bound on both ends: the function must - take exactly the declared vector array plus one Int carrier and return the - carrier, and the declared array type's element storage must be the nullable - carrier reference — so the elements a `domRepr` state carries really are - Int-carrier representations. The carrier is never the array itself. - - Unlike the projection and tag-dispatch faces there is no field count to - pin here: `vecDomRepr` reads `vs = [.arr arrTy elems, wi]` with `elems` - existentially quantified, so the face asserts no fixed width — the shape - fact it does assert is the ELEMENT type, which is what this check binds. -/ -def checkVectorGetTypes - (carrier arrTy : Nat) - (funcEntry arrEntry : CertDecode.TypeEntry) : Bool := - if arrTy == carrier then false else - match funcEntry.form, funcEntry.composite, - arrEntry.form, arrEntry.composite with - | .plain, .funcType [vecParam, idxParam] [result], .plain, .arrayType field => - decide (vecParam = nullableRefType arrTy) && - decide (idxParam = nullableRefType carrier) && - decide (result = nullableRefType carrier) && - (match field.storage with - | .val elemTy => decide (elemTy = nullableRefType carrier) - | .packed _ => false) - | _, _, _, _ => false - -def exprVectorGetTypesMatch - (modBytes modLen typeIdx carrier arrTy : Nat) : Bool := - match CertDecode.decodeTypes modBytes modLen with - | some info => - match info.entryIndex[typeIdx]?, info.entryIndex[arrTy]? with - | some funcEntry, some arrEntry => - checkVectorGetTypes carrier arrTy funcEntry arrEntry - | _, _ => false - | none => false - -/-- Byte-level recognizer of the record-parameter scalar field read (mirror of - the representation plan; the record face in `StandardFace` reuses this same - recognizer, so the byte gate and the face fire on exactly one shape): - `local 0 : adtRef; structGetUser structIdx field 0 : `, with the - plan result the same scalar. The node ids are matched literally so the - canonical lowering of a recognized plan is exactly the two-instruction - `recordProjTemplate`. Unlike `exprProjectionFace?` the projected field is a - SCALAR, and the field index is not capped: the record face's equality pin - (`lowerTypeDecl` against the decoded entry) fixes the whole ordered field - list. -/ -def exprRecordProjFace? (plan : AverCert.Schema.ExprFragmentRawPlan) : - Option (Nat × Nat) := - if plan.params = [.adtRef] && - AverCert.Schema.fragTyIsRecordScalar plan.result && - plan.body.result = 1 then - match plan.body.nodes with - | [{ id := 0, ty := ty0, kind := .local 0 }, - { id := 1, ty := ty1, kind := .structGetUser structIdx field 0 }] => - if ty0 = .adtRef && ty1 = plan.result then some (structIdx, field) - else none - | _ => none - else none - -/-- Structural content of a fired record-projection recognizer: the parameter - is the single opaque record reference, the declared result is a stage-1 - scalar, and the body is EXACTLY the two-node field read (ids, types and - kinds all pinned by the literal match). -/ -theorem exprRecordProjFace?_spec - (plan : AverCert.Schema.ExprFragmentRawPlan) (structIdx field : Nat) - (h : exprRecordProjFace? plan = some (structIdx, field)) : - plan.params = [.adtRef] ∧ - AverCert.Schema.fragTyIsRecordScalar plan.result = true ∧ - plan.body = { nodes := [{ id := 0, ty := .adtRef, kind := .local 0 }, - { id := 1, ty := plan.result, - kind := .structGetUser structIdx field 0 }], - result := 1 } := by - unfold exprRecordProjFace? at h - split at h - case isFalse => exact absurd h (by simp) - case isTrue hcond => - simp only [Bool.and_eq_true, decide_eq_true_eq] at hcond - obtain ⟨⟨hparams, hscalar⟩, hres⟩ := hcond - split at h - case h_2 => exact absurd h (by simp) - case h_1 ty0 ty1 si fi heq => - split at h - case isFalse => exact absurd h (by simp) - case isTrue htys => - simp only [Bool.and_eq_true, decide_eq_true_eq] at htys - obtain ⟨hty0, hty1⟩ := htys - injection h with hpair - injection hpair with hsi hfi - subst hsi; subst hfi; subst hty0; subst hty1 - refine ⟨hparams, hscalar, ?_⟩ - have hblock : plan.body = ⟨plan.body.nodes, plan.body.result⟩ := by - cases plan.body - rfl - rw [hblock, heq, hres] - -/-- Storage shape a stage-1 record field may carry: `i32` (Bool), `f64` - (Float), or a nullable concrete reference (the Int carrier field). The - record face's equality pin compares the FULL decoded entry — form, ordered - fields, storages and mutabilities — against the wall lowering of the Plan - declaration; the declaration is not in scope on the byte side, so this - check admits only the SHAPE. -/ -def isRecordScalarStorage : CertDecode.FieldType → Bool - | ⟨.val (.numeric 0x7f), _⟩ => true - | ⟨.val (.numeric 0x7c), _⟩ => true - | ⟨.val (.ref 0x63 _), _⟩ => true - | _ => false - -/-- Byte-side admission of the record-parameter shape: the exported function's - single parameter names EXACTLY the projected struct index (the same move - `checkExprProjectionTypes` makes — this closes the param-type/struct-index - confusion channel on the byte side as well as in the face), the projected - entry is a `.plain` struct of scalar storages only, and the projected field - exists. Deep equality with the Plan declaration lives in the record face, - where the declaration exists. -/ -def checkRecordProjTypes - (carrier structIdx field : Nat) - (funcEntry structEntry : CertDecode.TypeEntry) : Bool := - if structIdx == carrier then false else - match funcEntry.form, funcEntry.composite, - structEntry.form, structEntry.composite with - | .plain, .funcType [param] [_result], .plain, .structType fields => - decide (param = nullableRefType structIdx) && - fields.all isRecordScalarStorage && - (fields[field]?).isSome - | _, _, _, _ => false - -def exprRecordProjTypesMatch - (modBytes modLen typeIdx carrier structIdx field : Nat) : Bool := - match CertDecode.decodeTypes modBytes modLen with - | some info => - match info.entryIndex[typeIdx]?, info.entryIndex[structIdx]? with - | some funcEntry, some structEntry => - checkRecordProjTypes carrier structIdx field funcEntry structEntry - | _, _ => false - | none => false - /-- Exact function-type pin: the decoded entry is a plain func type with EXACTLY the given parameter and result lists. -/ def checkFuncTypeExact (params results : List CertDecode.ValType) @@ -525,240 +203,6 @@ def checkFuncTypeExact (params results : List CertDecode.ValType) | .plain, .funcType ps rs => decide (ps = params) && decide (rs = results) | _, _ => false -/-- The nodes that make a body COMPUTE rather than merely PROJECT — the - any-fact of both the nominal-signature gate below and - `StandardFace.classifyRecordCompute`, which exports this name rather than - keeping a second copy: the two must count the same nodes, or a plan could - pass one gate and fail the other. - - Three kinds qualify: a construction, ANY host call (`cmp` and `eq` - included — they leave the carrier and decide an order), and the inline - sign template, which is the emitter's open-coded comparison of a computed - carrier against a literal and is therefore exactly as computing as the - `cmp` call it replaces. - - Leaving `.intSignCmp` out was a SILENT non-admission: a projection-only - sign test (`f.num >= 0`, no host call anywhere in the body) matched - neither the two-node projection face nor the compute face, so the producer - emitted no plan at all and the export dropped to source-level-only with no - stated reason. The two-node projection faces stay ruled out because their - bodies carry none of the three. -/ -def fragNodeComputes (n : AverCert.Schema.FragNode) : Bool := - match n.kind with - | .structNew _ _ => true - | .hostCall _ _ _ => true - | .intSignCmp _ _ _ _ => true - | _ => false - -/-- Byte-level recognizer of the record projection-compute shape (mirror of - `StandardFace.classifyRecordCompute`'s struct-index core; lives here - because WasmSlice cannot import StandardFace): every parameter is an - opaque record reference, at least one node computes, and every cited - user-struct index agrees on one pinned index. -/ -def exprRecordComputeStructIdx? - (plan : AverCert.Schema.ExprFragmentRawPlan) : Option Nat := - if plan.params.all (· == .adtRef) && - plan.body.nodes.any fragNodeComputes then - match plan.body.nodes.filterMap (fun n => - match n.kind with - | .structGetUser tyIdx _ _ => some tyIdx - | .structNew tyIdx _ => some tyIdx - | _ => none) with - | [] => none - | i :: rest => if rest.all (· == i) then some i else none - else none - -/-- Nominal signature of a compute-shape export: k references to the pinned - struct in, and the declared record/carrier/i32 result out. -/ -def exprRecordComputeTypesMatch - (modBytes modLen typeIdx carrier structIdx : Nat) - (plan : AverCert.Schema.ExprFragmentRawPlan) : Bool := - let result? : Option CertDecode.ValType := - match plan.result with - | .adtRef => some (nullableRefType structIdx) - | .intCarrier => some (nullableRefType carrier) - | .boolI32 => some (.numeric 0x7f) - | _ => none - match result? with - | some result => - typeSectionMatches - (checkFuncTypeExact - (List.replicate plan.params.length (nullableRefType structIdx)) - [result]) - modBytes modLen typeIdx - | none => false - -/-- Opaque references fail closed unless the plan has one of the four admitted - faces: the field-projection face (whose nominal signature and field type are - decoded above), the tag-dispatch face (whose i32 tag field is decoded - below), the fused vector-read face (whose array element type is decoded - above), or the record-parameter scalar field read (whose param binding and - scalar struct shape are decoded above; the deep entry equality lives in the - record face's pin). -/ -def exprFragmentNominalTypesMatch - (modBytes modLen typeIdx carrier : Nat) - (plan : AverCert.Schema.ExprFragmentRawPlan) : Bool := - if plan.params.contains .adtRef || plan.result = .adtRef then - match exprProjectionFace? plan with - | some (structIdx, fieldIdx) => - exprProjectionTypesMatch - modBytes modLen typeIdx carrier structIdx fieldIdx - | none => - match exprTagDispatchStructIdx? plan with - | some structIdx => exprTagDispatchTypesMatch modBytes modLen carrier structIdx - | none => - match exprVectorGetOrDefaultArrTy? plan with - | some arrTy => exprVectorGetTypesMatch modBytes modLen typeIdx carrier arrTy - | none => - match exprRecordProjFace? plan with - | some (structIdx, field) => - exprRecordProjTypesMatch - modBytes modLen typeIdx carrier structIdx field - | none => - match exprRecordComputeStructIdx? plan with - | some structIdx => - exprRecordComputeTypesMatch - modBytes modLen typeIdx carrier structIdx plan - | none => false - else true - -def isNonnegativeNullableRef : CertDecode.ValType → Bool - | .ref 0x63 heap => decide (0 ≤ heap) - | _ => false - -def verbatimResultTypeMatches - (expected : AverCert.Schema.VerbatimResultSig) : CertDecode.ValType → Bool - | .ref 0x63 heap => - match expected with - | .refNull expectedHeap => heap == Int.ofNat expectedHeap - | .f64Scalar => false - | .numeric 0x7c => expected == .f64Scalar - | _ => false - -/-- Exact plain certified verbatim signature: one nullable concrete nominal - root parameter and exactly one result selected by `resultSig`. -/ -def checkVerbatimFuncType (resultSig : AverCert.Schema.VerbatimResultSig) - (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .funcType [root] [result] => - isNonnegativeNullableRef root && verbatimResultTypeMatches resultSig result - | _, _ => false - -/-- Whether the module's byte-derived type-section entry `typeIdx` exactly - matches the verbatim plan's declared result-signature variant. -/ -def verbatimFuncTypeMatches (modBytes modLen typeIdx : Nat) - (resultSig : AverCert.Schema.VerbatimResultSig) : Bool := - typeSectionMatches (checkVerbatimFuncType resultSig) modBytes modLen typeIdx - -/-! ### Bare field-projection type binding -/ - -def projectionResultTypeMatches - (expected : AverCert.Schema.FieldProjectionResultTy) : CertDecode.ValType → Bool - | .abstract 0x6d => expected == .eqref - | .ref 0x63 heap => - match expected with - | .nullableRef expectedIdx => heap == Int.ofNat expectedIdx - | .eqref => false - | _ => false - -def hasValStorage : CertDecode.FieldType → Bool - | ⟨.val _, _⟩ => true - | _ => false - -def projectionFieldMatches - (expected : AverCert.Schema.FieldProjectionResultTy) - (field : CertDecode.FieldType) : Bool := - match field.storage with - | .val actual => projectionResultTypeMatches expected actual - | .packed _ => false - -def checkProjectionStructType - (fieldCount fieldIdx : Nat) - (resultTy : AverCert.Schema.FieldProjectionResultTy) - (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .structType fields => - fields.length == fieldCount && fields.all hasValStorage && - match fields[fieldIdx]? with - | some field => projectionFieldMatches resultTy field - | none => false - | _, _ => false - -def projectionStructTypeMatches - (modBytes modLen structIdx fieldCount fieldIdx : Nat) - (resultTy : AverCert.Schema.FieldProjectionResultTy) : Bool := - typeSectionMatches - (checkProjectionStructType fieldCount fieldIdx resultTy) - modBytes modLen structIdx - -def checkProjectionFuncType - (structIdx : Nat) - (resultTy : AverCert.Schema.FieldProjectionResultTy) - (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .funcType [param] [result] => - decide (param = nullableRefType structIdx) && - projectionResultTypeMatches resultTy result - | _, _ => false - -def projectionFuncTypeMatches - (modBytes modLen typeIdx structIdx : Nat) - (resultTy : AverCert.Schema.FieldProjectionResultTy) : Bool := - typeSectionMatches (checkProjectionFuncType structIdx resultTy) modBytes modLen typeIdx - -/-! ### List-constructor type binding -/ - -def constructValType - (expected : AverCert.Schema.ConstructValType) : CertDecode.ValType := - match expected with - | .i32 => .numeric 0x7f - | .i64 => .numeric 0x7e - | .f64 => .numeric 0x7c - | .eqref => .abstract 0x6d - | .nullableRef typeIdx => nullableRefType typeIdx - -def immutableConstructFieldMatches - (expected : AverCert.Schema.ConstructValType) - (field : CertDecode.FieldType) : Bool := - field.mutability == 0 && - match field.storage with - | .val actual => decide (actual = constructValType expected) - | .packed _ => false - -def checkListConstructStructType - (structIdx : Nat) (elemTy : AverCert.Schema.ConstructValType) - (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .structType [head, tail] => - immutableConstructFieldMatches elemTy head && - immutableConstructFieldMatches (.nullableRef structIdx) tail - | _, _ => false - -def listConstructStructTypeMatches - (modBytes modLen structIdx : Nat) - (elemTy : AverCert.Schema.ConstructValType) : Bool := - typeSectionMatches (checkListConstructStructType structIdx elemTy) modBytes modLen structIdx - -def checkListConstructFuncType - (arity structIdx : Nat) (elemTy : AverCert.Schema.ConstructValType) - (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .funcType params results => - let head := constructValType elemTy - let tail := nullableRefType structIdx - let paramsMatch := - if arity = 1 then decide (params = [head]) - else if arity = 2 then decide (params = [head, tail]) - else false - paramsMatch && decide (results = [tail]) - | _, _ => false - -def listConstructFuncTypeMatches - (modBytes modLen typeIdx arity structIdx : Nat) - (elemTy : AverCert.Schema.ConstructValType) : Bool := - typeSectionMatches (checkListConstructFuncType arity structIdx elemTy) - modBytes modLen typeIdx - /-- Exact selected passive data payload. The full declared vector must parse and exhaust the section payload. -/ def dataSegmentBytes (modBytes modLen dataIdx : Nat) : Option ByteSeq := @@ -840,11 +284,6 @@ def funcBindingByFuncIndex (modBytes modLen funcIdx : Nat) : Option FuncBinding | _, _ => none | none => none -def codeEntryForExport (modBytes modLen : Nat) (targetName : ByteSeq) : Option ByteSeq := - match exportFuncIndex modBytes modLen targetName with - | some funcIdx => codeEntryByFuncIndex modBytes modLen funcIdx - | none => none - def funcBindingForExport (modBytes modLen : Nat) (targetName : ByteSeq) : Option FuncBinding := match exportFuncIndex modBytes modLen targetName with | some funcIdx => funcBindingByFuncIndex modBytes modLen funcIdx @@ -856,107 +295,6 @@ def exactFuncBindingForExport (funcBindingForExport modBytes modLen targetName).filter (fun binding => binding.codeEntry = expectedCode) -/-- The exported String.concat fragment must keep the ordinary Aver string ABI: - one nullable string-array reference in, one nullable string-array reference - out. The code-entry bytes pin the body, but not this function-section type - index; this check makes nullability and the selected string heap type - byte-derived instead of claim-only data. -/ -def checkStringConcatExportFuncType - (resultTy : Nat) (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .funcType [param] [result] => - decide (param = nullableRefType resultTy) && - decide (result = nullableRefType resultTy) - | _, _ => false - -def stringConcatExportFuncTypeMatches - (modBytes modLen typeIdx resultTy : Nat) : Bool := - typeSectionMatches (checkStringConcatExportFuncType resultTy) - modBytes modLen typeIdx - -/-- The internal String.concat helper consumes the temporary container of parts - and returns the packed string array. `CertDecode.StringHost.roleTable` - recognizes the helper's byte body, while this separate pin keeps the helper - signature exact, including `0x63` nullable-reference tags. -/ -def checkStringConcatHelperFuncType - (containerTy resultTy : Nat) (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .funcType [param] [result] => - decide (param = nullableRefType containerTy) && - decide (result = nullableRefType resultTy) - | _, _ => false - -/-- Resolve a helper function index through the function section and require its - declared type to be the exact String.concat helper ABI. Imported functions - and malformed type/function sections fail closed. -/ -def stringConcatHelperFuncTypeMatches - (modBytes modLen funcIdx containerTy resultTy : Nat) : Bool := - match funcBindingByFuncIndex modBytes modLen funcIdx with - | some binding => - typeSectionMatches (checkStringConcatHelperFuncType containerTy resultTy) - modBytes modLen binding.typeIdx - | none => false - -/-- The record face's PARAM BINDING check over one decoded function type: a - single parameter, and that parameter is EXACTLY the nullable reference to - the record's pinned struct index (`checkExprProjectionTypes`'s move). -/ -def checkRecordParamFuncType (structIdx : Nat) (entry : CertDecode.TypeEntry) : Bool := - match entry.form, entry.composite with - | .plain, .funcType [param] [_result] => decide (param = nullableRefType structIdx) - | _, _ => false - -/-- The record face's PARAM BINDING against the module bytes: resolve the - certified export's own function binding and require its declared single - parameter to name exactly the pinned struct index. Without it, a claim - could pin (and lower against) one struct index while the certified function - is declared over a different one — the param/struct confusion class. -/ -def recordParamFuncTypeMatches - (modBytes modLen : Nat) (exportName : ByteSeq) (structIdx : Nat) : Bool := - match funcBindingForExport modBytes modLen exportName with - | some binding => - typeSectionMatches (checkRecordParamFuncType structIdx) - modBytes modLen binding.typeIdx - | none => false - -/-- Exact function-type pin against the module bytes for one certified - export: resolve its function binding and require the declared type to be - exactly the given parameter/result lists. -/ -def funcTypeMatchesExact - (modBytes modLen : Nat) (exportName : ByteSeq) - (params results : List CertDecode.ValType) : Bool := - match funcBindingForExport modBytes modLen exportName with - | some binding => - typeSectionMatches (checkFuncTypeExact params results) - modBytes modLen binding.typeIdx - | none => false - -/-- Whether the module function `funcIdx` declares exactly the certified - function type its host role fixes. The index resolves through the function - section (`funcBindingByFuncIndex`), so an imported function — which has no - function-section binding — fails closed, and `typeSectionMatches` requires - the whole type section to decode exactly. -/ -def hostRoleFuncTypeMatches - (modBytes modLen carrier funcIdx : Nat) - (role : AverCert.Schema.HostRole) : Bool := - match funcBindingByFuncIndex modBytes modLen funcIdx with - | some binding => - typeSectionMatches (checkHostRoleFuncType carrier role) - modBytes modLen binding.typeIdx - | none => false - -/-- Every entry of a claim's byte-derived host-role table declares exactly the - function type its role fixes over the claimed carrier. Acceptance requires - this for EVERY family that carries a host table; the encoder resolves every - role citation a plan makes (`hostCall` nodes AND the fused vector-read - node's `toIndexIdx`/`boxIdx` immediates) through this same table, so the - pin covers every helper index the proof faces model. -/ -def hostTableFuncTypesMatch (modBytes modLen carrier : Nat) : - List (AverCert.Schema.HostRole × Nat) → Bool - | [] => true - | (role, funcIdx) :: rest => - hostRoleFuncTypeMatches modBytes modLen carrier funcIdx role && - hostTableFuncTypesMatch modBytes modLen carrier rest - /-! ### Certified direct-call closure and rejected-channel scan The scanner deliberately recognizes only immediate layouts needed by the @@ -1136,6 +474,55 @@ def natSetEq (xs ys : List Nat) : Bool := def natListNodup (xs : List Nat) : Bool := indexedNodup xs +/-- The numeric key of a byte sequence whose elements are all below + `2^21 - 1` (every byte and every Unicode scalar value): the base-`2^21` + numeral with digits `b + 1`, first element lowest. `none` outside that + range, where every set-shaped check reading keys fails. + + Set-shaped checks over names index these keys, never the sequences: the + kernel compares two keys as one numeral, while ordering two lists walks + them through the generic `Ord` instance (the export accounting of a + 605-export module took minutes that way). The keys are injective + (`seqKey_inj`), so a check over keys decides the same set facts as the + same check over the sequences. -/ +def seqKey : ByteSeq → Option Nat + | [] => some 0 + | b :: rest => + if b < 2097151 then (seqKey rest).map (fun k => b + 1 + 2097152 * k) else none + +theorem seqKey_inj : ∀ {a b : ByteSeq} {k : Nat}, seqKey a = some k → seqKey b = some k → a = b + | [], [], _, _, _ => rfl + | [], x :: xs, k, ha, hb => by + simp only [seqKey, Option.some.injEq] at ha + subst ha + simp only [seqKey] at hb + split at hb + · obtain ⟨k', _, hk⟩ := Option.map_eq_some_iff.mp hb + omega + · cases hb + | x :: xs, [], k, ha, hb => by + simp only [seqKey, Option.some.injEq] at hb + subst hb + simp only [seqKey] at ha + split at ha + · obtain ⟨k', _, hk⟩ := Option.map_eq_some_iff.mp ha + omega + · cases ha + | x :: xs, y :: ys, k, ha, hb => by + simp only [seqKey] at ha hb + split at ha + · split at hb + · obtain ⟨ka, hka, hxa⟩ := Option.map_eq_some_iff.mp ha + obtain ⟨kb, hkb, hyb⟩ := Option.map_eq_some_iff.mp hb + have hxy : x = y ∧ ka = kb := by omega + obtain ⟨rfl, rfl⟩ := hxy + rw [seqKey_inj hka hkb] + · cases hb + · cases ha + +/-- The keys of a list of byte sequences, when every sequence has one. -/ +def seqKeys (xs : List ByteSeq) : Option (List Nat) := xs.mapM seqKey + /-- Fuel-bounded transitive direct-call closure, using the spike-proven worklist/seen fold over the big-Nat module representation. -/ def closureFold (modBytes modLen : Nat) : diff --git a/aver-cert/assets/wall/current/WidenedEnvelope.lean b/aver-cert/assets/wall/current/WidenedEnvelope.lean deleted file mode 100644 index 89f4c25fc..000000000 --- a/aver-cert/assets/wall/current/WidenedEnvelope.lean +++ /dev/null @@ -1,344 +0,0 @@ -/- -Widened envelope lowering. - -`EnvelopeLowering` handles the NARROW ADT profile: every constructor carries at -most one Int payload (`ctors : List Bool`), effectively one ADT per module. The -survey found honest certificates OUTSIDE that profile — a widened Int match over -an ADT whose non-hit constructors carry String / Float / Bool / List / Map / -multi-field payloads (`examples/data/json.av` `jsonInt`), a `Box.StrBox(String)` -match, and modules holding several ADTs. - -This module WIDENS the declared envelope so it lowers the REAL rec-group bytes of -such a type — whatever its constructors actually are — while the meaning MODEL -still reads ONLY the hit constructor (its Int payload) and returns a widen -default for every non-hit constructor. That is exactly why tolerating non-hit -payload shapes is SOUND: the model provably never reads a non-hit payload. - -DESIGN — bounded shape vocabulary, not unbounded bytes. -Each non-hit constructor is drawn from a FINITE shape vocabulary -(`WCtor`) whose byte lowering has a KNOWN length. This is deliberate: an -`unbounded` raw-byte payload would make the rec-group byte length a function of -attacker-chosen payload content, which reopens a substring-coincidence forge — a -malicious envelope could pad an early constructor so that the fixed hit-encoding -lands on an unrelated, coincidentally matching stretch of the module. With every -shape a KNOWN length the rec-group prefix pin covers exactly the declared bytes -and constructor forcing stays a finite decision. The vocabulary covers every -shape the survey needs; adding a shape is a one-line extension, not a redesign. - -There is NO byte -> structure decoder: `wEnvDomRepr` / `wEnvStructModel` are -computed FROM THE PLAN, and the only residue pulled up from the bytes is the -compiler-assigned root type INDEX. --/ -import EnvelopeLowering -import IntDispatchSoundness - -set_option maxRecDepth 1000000 -set_option maxHeartbeats 4000000 - -namespace AverCert.WidenedEnvelope - -open AverCert.Schema -open CertPrelude -open AverCert.EnvelopeLowering - (preludeTail bytesPinnedAt typeCursorAt EnvelopeFact cascadeEval takeBytes_take) - -/-! ## §1 The widened declared envelope - -`WCtor` is the finite shape vocabulary. `hit` is the ONLY shape the meaning model -reads: it lowers to the canonical single-field `struct { (ref null carrier) }`, -the Int box exposed at read offset 0. Every other shape is a non-hit payload the -model ignores; its bytes are pinned only to keep the rec group honest. -/ - -inductive WCtor - | hit -- Int box, readable: struct { (ref null carrier) } - | unit -- no payload: struct { } - | strBox -- String payload: struct { (ref null strArray) } - | floatBox -- Float payload: struct { f64 } - | boolBox -- Bool payload: struct { i32 } - | listBox -- List payload: struct { (ref null listArray) } - | mapBox -- Map payload: struct { (ref map) } -deriving Repr, DecidableEq - -structure WAdtEnvelope where - root : Nat - ctors : List WCtor -deriving Repr, DecidableEq - -def wCarrierIdx (env : WAdtEnvelope) : Nat := env.root + env.ctors.length + 3 -def wLimbIdx (env : WAdtEnvelope) : Nat := env.root + env.ctors.length + 2 -/-- Derived string byte-array index (first prelude entry). -/ -def wStrArrIdx (env : WAdtEnvelope) : Nat := env.root + env.ctors.length + 1 - -/-- Profile checker, fail-closed. Same single-byte index regime as the narrow - profile; the widening is entirely in the constructor shape vocabulary. -/ -def checkWidenedEnvelope (env : WAdtEnvelope) : Bool := - decide (1 ≤ env.ctors.length) && decide (wCarrierIdx env < 64) - -/-- Declared shape of the constructor with tag `tag` (fail-closed). -/ -def wCtorShape? (env : WAdtEnvelope) (tag : Nat) : Option WCtor := - if env.root + 1 ≤ tag then env.ctors[tag - (env.root + 1)]? else none - -/-! ## §2 Canonical byte LOWERING of the declared widened envelope - -Each constructor is ONE `(sub_final [root] struct{…})` rec-group entry, so the -carrier index `root + len + 3` is unchanged by the payload shapes. The body of -each shape (everything after the `0x4f 0x01 root` subtype header) has a KNOWN -length; `strArray`/`listArray`/`map` payload fields reference derived indices. -/ - -/-- Struct-body bytes of a constructor shape (after the `0x4f 0x01 root` head). - `C` is the carrier index, `S` the derived string-array index. -/ -def wCtorBody (C S : Nat) : WCtor → List Nat - | .hit => [0x5f, 0x01, 0x63, C, 0x00] - | .unit => [0x5f, 0x00] - | .strBox => [0x5f, 0x01, 0x63, S, 0x00] - | .floatBox => [0x5f, 0x01, 0x7c, 0x00] - | .boolBox => [0x5f, 0x01, 0x7f, 0x00] - | .listBox => [0x5f, 0x01, 0x64, S, 0x00] - | .mapBox => [0x5f, 0x01, 0x64, C, 0x00] - -def wLowerCtorEntry (root C S : Nat) (c : WCtor) : List Nat := - 0x4f :: 0x01 :: root :: wCtorBody C S c - -def wLowerCtorEntries (root C S : Nat) : List WCtor → List Nat - | [] => [] - | c :: rest => wLowerCtorEntry root C S c ++ wLowerCtorEntries root C S rest - -/-- LOWER for the whole declared rec group, header included. -/ -def wLowerAdtRecGroup (env : WAdtEnvelope) : Option (List Nat) := - if checkWidenedEnvelope env = true then - some ([0x4e, env.ctors.length + 4, 0x50, 0x00, 0x5f, 0x00] ++ - wLowerCtorEntries env.root (wCarrierIdx env) (wStrArrIdx env) env.ctors ++ - preludeTail (wLimbIdx env)) - else none - -/-- LOWER for the dispatch export's function-signature type entry (byte-identical - to the narrow one: it does not mention constructor shapes). -/ -def wLowerDispatchSig (env : WAdtEnvelope) : Option (List Nat) := - if checkWidenedEnvelope env = true then - some [0x60, 0x01, 0x63, env.root, 0x01, 0x63, wCarrierIdx env] - else none - -/-- LOWER for a constructor export's signature. -/ -def wLowerCtorSig (env : WAdtEnvelope) : Option (List Nat) := - if checkWidenedEnvelope env = true then - some [0x60, 0x01, 0x63, wCarrierIdx env, 0x01, 0x63, env.root] - else none - -def wAdtRecGroupFact : EnvelopeFact := ⟨WAdtEnvelope, wLowerAdtRecGroup⟩ -def wAdtDispatchSigFact : EnvelopeFact := ⟨WAdtEnvelope, wLowerDispatchSig⟩ -def wAdtCtorSigFact : EnvelopeFact := ⟨WAdtEnvelope, wLowerCtorSig⟩ - -/-! ## §3 Wall-owned meaning terms over the PLAN (no decode output) - -The widened value carries an Int payload for a `hit` constructor and an OPAQUE -`List WVal` for any non-hit constructor. The model reads only the Int -(`WPayload.toInt?`); a non-hit payload maps to `none`, which — because the -cascade only ever projects at a tested tag and `wCascadeInEnv` forces every -tested tag to be `hit` — never reaches a projection. -/ - -inductive WPayload - | int (n : Int) - | opaqueFields (fields : List WVal) - -def WPayload.toInt? : WPayload → Option Int - | .int n => some n - | .opaqueFields _ => none - -/-- A value of the DECLARED widened ADT: a `hit` tag carries an Int, any other - declared tag carries opaque wasm fields. Vacuity is structurally impossible - for a declared tag. -/ -def WEnvValidChild (env : WAdtEnvelope) (tag : Nat) (p : WPayload) : Prop := - (wCtorShape? env tag = some .hit ∧ ∃ n, p = .int n) ∨ - (∃ c, wCtorShape? env tag = some c ∧ c ≠ .hit ∧ ∃ fs, p = .opaqueFields fs) - -def WAdtVal (env : WAdtEnvelope) : Type := - { q : Nat × WPayload // WEnvValidChild env q.1 q.2 } - -/-- Canonical domain representation from the plan structure. The `hit` case pins - the single Int-box field through the carrier `Repr`; a non-hit value pins its - opaque fields verbatim (the model does not constrain them). -/ -def wEnvDomRepr (env : WAdtEnvelope) : - CarrierSpec (wCarrierIdx env) → WAdtVal env → List WVal → Prop := - fun S x vs => - match x.1.2 with - | .int n => ∃ v, vs = [.structv x.1.1 [v]] ∧ S.Repr n v - | .opaqueFields fs => vs = [.structv x.1.1 fs] - -/-- structModelFromPlan, widened: reads only the hit constructor's Int payload - (via `toInt?`), else the cascade default. -/ -def wEnvStructModel (env : WAdtEnvelope) (body : IntDispatchCascade) : - WAdtVal env → Int := - fun x => (cascadeEval body x.1.1 x.1.2.toInt?).getD 0 - -/-- Plan-internal consistency: every tested tag is a DECLARED `hit` constructor - (byte-pinned by the rec-group lowering), so a projected field is always the - readable Int box. -/ -def wCascadeInEnv (env : WAdtEnvelope) : IntDispatchCascade → Bool - | .default _ => true - | .test tyIdx _ rest => - decide (wCtorShape? env tyIdx = some .hit) && wCascadeInEnv env rest - -/-! ## §4 The widened lower-pinned Int-read face -/ - -def WAdtIntFaceLower - (modBytes modLen : Nat) - (exportNameBytes : List Nat) (exportName : String) - (carrier : Nat) (hostTable : List (HostRole × Nat)) - (env : WAdtEnvelope) (plan : IntDispatchRawPlan) (o : Obligation) : Prop := - AverCert.AcceptedArtifact.intDispatchPlanAccepted - modBytes modLen exportNameBytes exportName carrier hostTable plan o ∧ - checkWidenedEnvelope env = true ∧ - wCascadeInEnv env plan.body = true ∧ - carrier = wCarrierIdx env ∧ - wAdtRecGroupFact.pinnedAt modBytes modLen env.root env ∧ - (∃ binding, - AverCert.WasmSlice.funcBindingForExport modBytes modLen exportNameBytes - = some binding ∧ - wAdtDispatchSigFact.pinnedAt modBytes modLen binding.typeIdx env) ∧ - o.carrier = wCarrierIdx env ∧ - HEq o.Dom (WAdtVal env) ∧ - HEq o.Cod Int ∧ - HEq o.domRepr (wEnvDomRepr env) ∧ - HEq o.codRepr (@AverCert.Schema.intRepr (wCarrierIdx env)) ∧ - HEq o.model (wEnvStructModel env plan.body) - -/-! ### The widened constructor face (unary Int-payload constructor) -/ - -/-- Single-Int-argument constructor domain representation. -/ -def wIntArgDomRepr (C : Nat) : CarrierSpec C → Int → List WVal → Prop := - fun S n vs => ∃ v, vs = [v] ∧ S.Repr n v - -/-- Constructor codomain: same relation as `wEnvDomRepr` on a single result. -/ -def wEnvCodRepr (env : WAdtEnvelope) : - CarrierSpec (wCarrierIdx env) → WAdtVal env → WVal → Prop := - fun S y w => - match y.1.2 with - | .int n => ∃ v, w = .structv y.1.1 [v] ∧ S.Repr n v - | .opaqueFields fs => w = .structv y.1.1 fs - -/-- Constructor model from the plan: build the DECLARED `hit` constructor `tag` - with the Int argument as its Int-box payload. The `hit` fact is DEMANDED. -/ -def wEnvCtorModel (env : WAdtEnvelope) (tag : Nat) - (h : wCtorShape? env tag = some .hit) : Int → WAdtVal env := - fun n => ⟨(tag, .int n), Or.inl ⟨h, n, rfl⟩⟩ - -def WAdtCtorFaceLower - (modBytes modLen : Nat) - (exportNameBytes : List Nat) (exportName : String) - (carrier structIdx fieldCount : Nat) (elemTy : ConstructValType) - (symPlan : SymRawPlan) (env : WAdtEnvelope) (plan : ConstructRawPlan) - (o : Obligation) : Prop := - AverCert.AcceptedArtifact.constructPlanAccepted - modBytes modLen exportNameBytes exportName carrier structIdx fieldCount - elemTy symPlan plan o ∧ - plan.arity = 1 ∧ plan.fields = [.local 0] ∧ - checkWidenedEnvelope env = true ∧ - carrier = wCarrierIdx env ∧ - wAdtRecGroupFact.pinnedAt modBytes modLen env.root env ∧ - (∃ binding, - AverCert.WasmSlice.funcBindingForExport modBytes modLen exportNameBytes - = some binding ∧ - wAdtCtorSigFact.pinnedAt modBytes modLen binding.typeIdx env) ∧ - o.carrier = wCarrierIdx env ∧ - ∃ hpay : wCtorShape? env structIdx = some .hit, - HEq o.Dom Int ∧ - HEq o.Cod (WAdtVal env) ∧ - HEq o.domRepr (wIntArgDomRepr (wCarrierIdx env)) ∧ - HEq o.codRepr (wEnvCodRepr env) ∧ - HEq o.model (wEnvCtorModel env structIdx hpay) - -/-! ## §5 GOAL 2 — the positive widened bridge - -Mirrors `EnvelopeLowering.cascade_bridge` / `env_intDispatch_bridge`, but over the -WIDENED representation: on any represented widened value the byte-origin -`EvalCascade` relates it to exactly the plan-computed `cascadeEval` result, -REGARDLESS of the non-hit payload shapes. The hit branch uses that a tested tag -is `hit` (so the value is `.int`, and its field is the Int box); the miss/default -branches never read a payload. -/ - -theorem wCascade_bridge (env : WAdtEnvelope) (body : IntDispatchCascade) - (hcasc : wCascadeInEnv env body = true) - (S : CarrierSpec (wCarrierIdx env)) (x : WAdtVal env) (vs : List WVal) - (hdom : wEnvDomRepr env S x vs) : - ∃ tag fields, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S body tag fields - ((cascadeEval body x.1.1 x.1.2.toInt?).getD 0) := by - induction body with - | default k => - refine ⟨x.1.1, ?_⟩ - unfold wEnvDomRepr at hdom - cases hpay : x.1.2 with - | int m => - rw [hpay] at hdom - obtain ⟨v, hvs, _hrepr⟩ := hdom - refine ⟨[v], hvs, ?_⟩ - simp only [cascadeEval, Option.getD] - exact IntDispatchSoundness.EvalCascade.default k x.1.1 [v] - | opaqueFields fs => - rw [hpay] at hdom - refine ⟨fs, hdom, ?_⟩ - simp only [cascadeEval, Option.getD] - exact IntDispatchSoundness.EvalCascade.default k x.1.1 fs - | test tyIdx leaf rest ih => - simp only [wCascadeInEnv, Bool.and_eq_true, decide_eq_true_eq] at hcasc - obtain ⟨hpayTy, hrest⟩ := hcasc - by_cases htag : x.1.1 = tyIdx - · -- tested tag: the value must be a `hit` payload (`.int`). - have hchild := x.2 - unfold WEnvValidChild at hchild - rw [htag] at hchild - rcases hchild with ⟨_, m, hm⟩ | ⟨c, hcshape, hcne, _⟩ - · unfold wEnvDomRepr at hdom - rw [hm] at hdom - obtain ⟨v, hvs, hrepr⟩ := hdom - refine ⟨tyIdx, [v], by rw [← htag]; exact hvs, ?_⟩ - have hce : (cascadeEval (.test tyIdx leaf rest) x.1.1 x.1.2.toInt?).getD 0 - = IntDispatchSoundness.evalLeaf leaf m := by - rw [hm]; simp [cascadeEval, htag, WPayload.toInt?] - rw [hce] - exact IntDispatchSoundness.EvalCascade.hit tyIdx leaf rest [v] m v rfl hrepr - · -- a non-hit shape at a tested tag contradicts `wCascadeInEnv`. - rw [hpayTy] at hcshape - exact absurd (Option.some.inj hcshape).symm hcne - · obtain ⟨tag, fields, hvs, hev⟩ := ih hrest - refine ⟨tag, fields, hvs, ?_⟩ - have htageq : tag = x.1.1 := by - unfold wEnvDomRepr at hdom - cases hpay : x.1.2 with - | int m => - rw [hpay] at hdom; obtain ⟨v, hvs2, _⟩ := hdom - rw [hvs2] at hvs; injection hvs with hh; injection hh with h1 _; exact h1.symm - | opaqueFields fs => - rw [hpay] at hdom - rw [hdom] at hvs; injection hvs with hh; injection hh with h1 _; exact h1.symm - have hne : x.1.1 ≠ tyIdx := htag - have hce : (cascadeEval (.test tyIdx leaf rest) x.1.1 x.1.2.toInt?).getD 0 - = (cascadeEval rest x.1.1 x.1.2.toInt?).getD 0 := by - simp only [cascadeEval, if_neg hne] - rw [hce] - subst htageq - exact IntDispatchSoundness.EvalCascade.miss tyIdx x.1.1 leaf rest fields _ hne hev - -/-- GOAL 2, final shape: the widened bridge in the form the acceptance-soundness - assembly consumes. The model is `wEnvStructModel env plan.body`, the domain - representation `wEnvDomRepr env`, and the residual bridge holds outright — for - every represented input, whatever its non-hit payload shape. -/ -theorem env_widenedIntDispatch_bridge (env : WAdtEnvelope) (plan : IntDispatchRawPlan) - (hcasc : wCascadeInEnv env plan.body = true) - (S : CarrierSpec (wCarrierIdx env)) (x : WAdtVal env) (vs : List WVal) - (hdom : wEnvDomRepr env S x vs) : - ∃ tag fields n, - vs = [.structv tag fields] ∧ - IntDispatchSoundness.EvalCascade S plan.body tag fields n ∧ - ∀ w, S.Repr n w → - intRepr S (wEnvStructModel env plan.body x) w := by - obtain ⟨tag, fields, hvs, hev⟩ := wCascade_bridge env plan.body hcasc S x vs hdom - refine ⟨tag, fields, (cascadeEval plan.body x.1.1 x.1.2.toInt?).getD 0, hvs, hev, ?_⟩ - intro w hw - simpa [intRepr, wEnvStructModel] using hw - -#print axioms wCascade_bridge -#print axioms env_widenedIntDispatch_bridge - -end AverCert.WidenedEnvelope diff --git a/aver-cert/assets/wall/current/lakefile.lean b/aver-cert/assets/wall/current/lakefile.lean index c84fac2f7..6990fe6ec 100644 --- a/aver-cert/assets/wall/current/lakefile.lean +++ b/aver-cert/assets/wall/current/lakefile.lean @@ -7,18 +7,8 @@ package «certprelude» where @[default_target] lean_lib «CertPrelude» where srcDir := "." - roots := #[`CertPrelude, `CertPreludeSanity, `CertDecode, `SchemaCore, - `SchemaSanity, - `PlanCheck, `PlanLower, `PlanBytes, `WasmSlice, `Wasip2Envelope, - `ExprFragmentAccepted, - `AcceptedArtifactCore, `IntDispatchSoundness, `EnvelopeLowering, - `ConstructVerbatimSoundness, `StringSoundness, - `WidenedEnvelope, `DeclaredIndexEnvelope, `DeclaredEnvelopeAcceptTransport, - `ClaimAxes, `ExprFragmentSemantics, `InterpreterSequencing, - `RecordComputeBridge, - `ExprFragmentSoundness, `FieldProjectionSoundness, `StandardFace, - `RecursionSoundness, `MutualRecursionSoundness, - `CompositionSoundness, `AcceptanceSoundnessCore, `DischargeExprFragment, - `DischargeFieldProjection, `DischargeConstruct, `DischargeVerbatim, - `DischargeString, `DischargeIntDispatch, `DischargeRecursion, - `DischargeComposition, `AcceptanceSoundness, `ArithTemplateDerisk] + roots := #[`CertPrelude, `CertPreludeSanity, `CertDecode, `SchemaBase, `SchemaCore, + `SchemaSanity, `WasmSlice, `Wasip2Envelope, `ArithTemplateDerisk, + `InterpreterSequencing, `Grammar, `GrammarLower, `GrammarSound, `GrammarTotal, + `TypeTable, `AcceptedArtifactCore, `ClaimAxes, `AcceptanceSoundnessCore, + `AcceptanceSoundness, `GrammarBridge, `ModelPrelude] diff --git a/aver-cert/src/bridge_statement.rs b/aver-cert/src/bridge_statement.rs index a71bda3fe..b979cc81e 100644 --- a/aver-cert/src/bridge_statement.rs +++ b/aver-cert/src/bridge_statement.rs @@ -1,21 +1,36 @@ //! The plan-equals-source bridge statement, rendered from declared structure. //! //! A certificate does not transport the text of a bridge theorem. It transports -//! the STRUCTURE — the certified export, the transpiled source function, and one -//! encoder spec per parameter plus one for the result — and both sides render -//! the statement from that structure with this module. The producer writes the -//! rendered text into `Bridge.lean`; the checker renders it again and pins the -//! package's corollary at exactly that type. +//! the STRUCTURE — the certified export, the transpiled source function, the +//! statement kind, and one encoder per parameter plus one for the result — and +//! both sides render the statement from that structure with this module. The +//! producer writes the rendered text into `Bridge.lean`; the checker renders it +//! again and pins the package's corollary at exactly that type. //! //! That is the whole point of the split. A statement accepted as text can say //! anything the gates do not forbid — `f x = f x` is a single `_root_.`-first //! line naming its declared model, and it proves nothing. A statement RENDERED -//! by the checker can only ever say what this file says: the plan named by the -//! export, at the encoded arguments, is the encoded source result. A manifest -//! that permutes a record's accessors, points at another export's plan, or -//! declares an encoder kind this file does not know renders a different text (or -//! no text at all), and the pin then fails to elaborate — which declines the -//! package rather than crediting the claim. +//! by the checker can only ever say what this file says: the model of the +//! obligation named by the export, at the encoded arguments, returns the +//! encoded source result. A manifest that permutes a record's accessors, points +//! at another export, or declares an encoder kind this file does not know +//! renders a different text (or no text at all), and the pin then fails to +//! elaborate — which declines the package rather than crediting the claim. +//! +//! The statement is over the plan grammar of statement schema 9 +//! (`GrammarBridge.lean`), in one of two kinds: +//! +//! * `exact` — above some fuel, the model at every encoded argument list +//! returns exactly the encoded source result. Proved for plans whose call +//! closure has no recursion. +//! * `adequate` — every result the model returns (at any fuel) on an encoded +//! argument list is the encoded source result. Proved for any plan, recursive +//! or not; together with the obligation's `holds` it means that whatever the +//! bytes return on represented source arguments represents the source +//! result (`GrammarBridge.adequate_transfer`). It is never a totality claim. +//! +//! Both kinds also say that every encoded argument list inhabits the plan's +//! parameter types, so the obligation's `holds` applies to it. //! //! This module is compiled unconditionally, like [`crate::format`], so the //! producer feature and the verifier feature share one renderer rather than two @@ -23,48 +38,113 @@ /// Manifest key carrying an encoder's kind tag. pub const ENCODER_KIND_KEY: &str = "kind"; -/// Manifest key carrying a record encoder's Lean type. -pub const ENCODER_TYPE_KEY: &str = "type"; -/// Manifest key carrying a record encoder's accessor list. -pub const ENCODER_FIELDS_KEY: &str = "fields"; -/// The three encoder kinds the v1 projection-compute face admits. The set is -/// CLOSED: a manifest naming anything else is refused, never rendered. +/// The closed encoder kind set. A manifest naming anything else is refused, +/// never rendered. pub const ENCODER_KIND_INT: &str = "int"; pub const ENCODER_KIND_BOOL: &str = "bool"; +pub const ENCODER_KIND_FLOAT: &str = "float"; +pub const ENCODER_KIND_STRING: &str = "string"; pub const ENCODER_KIND_RECORD: &str = "record"; +pub const ENCODER_KIND_SUM: &str = "sum"; +pub const ENCODER_KIND_OPTION: &str = "option"; +pub const ENCODER_KIND_RESULT: &str = "result"; +pub const ENCODER_KIND_TUPLE: &str = "tuple"; +pub const ENCODER_KIND_LIST: &str = "list"; +pub const ENCODER_KIND_VECTOR: &str = "vector"; + +/// The two statement kinds, by manifest tag. +pub const BRIDGE_KIND_EXACT: &str = "exact"; +pub const BRIDGE_KIND_ADEQUATE: &str = "adequate"; /// Longest name a bridge entry may carry, matching the law surface's cap. pub const MAX_BRIDGE_NAME_LEN: usize = 200; -/// Longest rendered statement the bridge surface admits, matching the law -/// surface's cap: it bounds what the anti-injection gate has to police inside -/// one pinned type. -pub const MAX_BRIDGE_STATEMENT_LEN: usize = 2000; +/// Longest rendered statement the bridge surface admits. It bounds what the +/// anti-injection gate has to police inside one pinned type. +pub const MAX_BRIDGE_STATEMENT_LEN: usize = 16000; +/// Deepest encoder nesting a manifest may declare. +pub const MAX_ENCODER_DEPTH: usize = 8; +/// Most nodes one encoder tree may carry. +pub const MAX_ENCODER_NODES: usize = 256; /// The `_root_.` prefix every Lean name inside a bridge entry carries, so the /// rendered statement means the same at the root (where the checker's pin /// elaborates) as inside the package's own namespaces. pub const ROOT_PREFIX: &str = "_root_."; -/// How one source value of the face's admitted shapes is encoded as the wall's -/// `RecordComputeBridge.SVal`. These are the ONLY three shapes the v1 -/// projection-compute face carries; anything else (a nested record, a record -/// with a non-Int field, a Float or String leaf) has no `SVal` image and gets no -/// bridge rather than an invented encoding. +const SVAL: &str = "_root_.AverCert.Grammar.SVal"; +const TY: &str = "_root_.AverCert.Grammar.Ty"; + +/// Which of the two statement kinds a bridge claims. +#[derive(Debug, Clone, Copy, PartialEq, Eq)] +pub enum BridgeKind { + Exact, + Adequate, +} + +impl BridgeKind { + pub fn tag(self) -> &'static str { + match self { + BridgeKind::Exact => BRIDGE_KIND_EXACT, + BridgeKind::Adequate => BRIDGE_KIND_ADEQUATE, + } + } + + pub fn from_tag(tag: &str) -> Option { + match tag { + BRIDGE_KIND_EXACT => Some(BridgeKind::Exact), + BRIDGE_KIND_ADEQUATE => Some(BridgeKind::Adequate), + _ => None, + } + } +} + +/// How one source value is encoded as the wall's `Grammar.SVal`. The set +/// mirrors the plan grammar's value forms; a type with no form here (a +/// recursive type, a map, an opaque value) has no encoder and gets no bridge +/// rather than an invented encoding. #[derive(Debug, Clone, PartialEq, Eq)] pub enum SourceEncoder { /// `Int ↦ SVal.i`. Int, /// `Bool ↦ SVal.b`. Bool, - /// An all-Int record ↦ `SVal.r` of its accessors in DECLARATION order, - /// which is the order the emitter packs the wasm struct in. + /// `Float ↦ SVal.f` of its IEEE-754 bits. + Float, + /// `String ↦ SVal.s` of its UTF-8 bytes (`GrammarBridge.strBytes`). + Str, + /// A record (type id `tid` of the plan's type table) ↦ `SVal.record` of + /// its fields in DECLARATION order, which is the order the emitter packs + /// the struct in. A one-field record is a newtype and has one field here. Record { - /// `_root_.`-qualified Lean type of the record. + tid: u32, + /// `_root_.`-qualified Lean structure. lean_type: String, - /// `_root_.`-qualified accessors, each a field of `lean_type`. - accessors: Vec, + /// `_root_.`-qualified accessor and the field's encoder, in order. + fields: Vec<(String, SourceEncoder)>, }, + /// A user sum ↦ `SVal.variant tid c` of the constructor's fields, where + /// `c` is the constructor's position here (declaration order). + Sum { + tid: u32, + lean_type: String, + /// `_root_.`-qualified constructor and its field encoders. + ctors: Vec<(String, Vec)>, + }, + /// `Option T ↦ SVal.none` / `SVal.some`, instantiated at the element's + /// plan type. + Option(Box), + /// Aver `Result` (Lean `Except E T`) ↦ `SVal.ok` / `SVal.err`. + Result { + ok: Box, + err: Box, + }, + /// A tuple (Lean nested `×`) ↦ `SVal.record tid` of its components. + Tuple { tid: u32, elems: Vec }, + /// `List T ↦ SVal.nil` / `SVal.cons`. + List(Box), + /// `Array T ↦ SVal.vec` of the elements. + Vector(Box), } impl SourceEncoder { @@ -73,68 +153,380 @@ impl SourceEncoder { match self { SourceEncoder::Int => ENCODER_KIND_INT, SourceEncoder::Bool => ENCODER_KIND_BOOL, + SourceEncoder::Float => ENCODER_KIND_FLOAT, + SourceEncoder::Str => ENCODER_KIND_STRING, SourceEncoder::Record { .. } => ENCODER_KIND_RECORD, + SourceEncoder::Sum { .. } => ENCODER_KIND_SUM, + SourceEncoder::Option(_) => ENCODER_KIND_OPTION, + SourceEncoder::Result { .. } => ENCODER_KIND_RESULT, + SourceEncoder::Tuple { .. } => ENCODER_KIND_TUPLE, + SourceEncoder::List(_) => ENCODER_KIND_LIST, + SourceEncoder::Vector(_) => ENCODER_KIND_VECTOR, } } /// The Lean type a binder of this encoder is declared at. - pub fn binder_type(&self) -> &str { + pub fn binder_type(&self) -> String { match self { - SourceEncoder::Int => "Int", - SourceEncoder::Bool => "Bool", - SourceEncoder::Record { lean_type, .. } => lean_type.as_str(), + SourceEncoder::Int => "_root_.Int".into(), + SourceEncoder::Bool => "_root_.Bool".into(), + SourceEncoder::Float => "_root_.Float".into(), + SourceEncoder::Str => "_root_.String".into(), + SourceEncoder::Record { lean_type, .. } | SourceEncoder::Sum { lean_type, .. } => { + lean_type.clone() + } + SourceEncoder::Option(elem) => format!("(_root_.Option {})", elem.binder_type()), + SourceEncoder::Result { ok, err } => { + format!("(_root_.Except {} {})", err.binder_type(), ok.binder_type()) + } + SourceEncoder::Tuple { elems, .. } => format!( + "({})", + elems + .iter() + .map(SourceEncoder::binder_type) + .collect::>() + .join(" × ") + ), + SourceEncoder::List(elem) => format!("(_root_.List {})", elem.binder_type()), + SourceEncoder::Vector(elem) => format!("(_root_.Array {})", elem.binder_type()), + } + } + + /// The plan-grammar type (`Grammar.Ty`) of an encoded value. + pub fn grammar_ty(&self) -> String { + self.grammar_ty_as(false) + } + + /// [`Self::grammar_ty`], with `nat_lit` type ids when `raw`. + fn grammar_ty_as(&self, raw: bool) -> String { + let tid_of = |tid: &u32| { + if raw { + format!("(nat_lit {tid})") + } else { + tid.to_string() + } + }; + match self { + SourceEncoder::Int => format!("{TY}.int"), + SourceEncoder::Bool => format!("{TY}.bool"), + SourceEncoder::Float => format!("{TY}.float"), + SourceEncoder::Str => format!("{TY}.string"), + SourceEncoder::Record { tid, .. } | SourceEncoder::Tuple { tid, .. } => { + format!("({TY}.record {})", tid_of(tid)) + } + SourceEncoder::Sum { tid, .. } => format!("({TY}.sum {})", tid_of(tid)), + SourceEncoder::Option(elem) => format!("({TY}.option {})", elem.grammar_ty_as(raw)), + SourceEncoder::Result { ok, err } => { + format!( + "({TY}.result {} {})", + ok.grammar_ty_as(raw), + err.grammar_ty_as(raw) + ) + } + SourceEncoder::List(elem) => format!("({TY}.list {})", elem.grammar_ty_as(raw)), + SourceEncoder::Vector(elem) => format!("({TY}.vec {})", elem.grammar_ty_as(raw)), } } /// The `SVal` term for the source value `value` (already a Lean term). - pub fn encode(&self, value: &str) -> String { + /// `fresh` numbers the pattern binders a sum, option, result, list or + /// vector encoder introduces, so nested encoders never shadow each other. + /// Type ids and constructor positions are ordinary numerals: this is the + /// form of the producer's own proof targets. + pub fn encode(&self, value: &str, fresh: &mut usize) -> String { + self.encode_as(value, fresh, false) + } + + /// [`Self::encode`] with every numeral a `nat_lit`: the form a PINNED + /// statement uses, so no `OfNat` instance takes part in what it says. + pub fn encode_pinned(&self, value: &str, fresh: &mut usize) -> String { + self.encode_as(value, fresh, true) + } + + fn encode_as(&self, value: &str, fresh: &mut usize, raw: bool) -> String { + let num = |n: usize| { + if raw { + format!("(nat_lit {n})") + } else { + n.to_string() + } + }; + let bind = |fresh: &mut usize| { + let name = format!("y{fresh}"); + *fresh += 1; + name + }; match self { - SourceEncoder::Int => { - format!("_root_.RecordComputeBridge.SVal.i ({value})") + SourceEncoder::Int => format!("{SVAL}.i ({value})"), + SourceEncoder::Bool => format!("{SVAL}.b ({value})"), + SourceEncoder::Float => format!("{SVAL}.f (_root_.Float.toBits ({value}))"), + SourceEncoder::Str => { + format!("{SVAL}.s (_root_.AverCert.GrammarBridge.strBytes ({value}))") } - SourceEncoder::Bool => { - format!("_root_.RecordComputeBridge.SVal.b ({value})") + SourceEncoder::Record { tid, fields, .. } => { + let leaves = fields + .iter() + .map(|(accessor, enc)| { + enc.encode_as(&format!("{accessor} ({value})"), fresh, raw) + }) + .collect::>() + .join(", "); + format!("{SVAL}.record {} [{leaves}]", num(*tid as usize)) + } + SourceEncoder::Tuple { tid, elems } => { + let components = tuple_components(value, elems.len()); + let leaves = elems + .iter() + .zip(components) + .map(|(enc, component)| enc.encode_as(&component, fresh, raw)) + .collect::>() + .join(", "); + format!("{SVAL}.record {} [{leaves}]", num(*tid as usize)) } - SourceEncoder::Record { accessors, .. } => { - let mut leaves = String::new(); - for (index, accessor) in accessors.iter().enumerate() { - if index > 0 { - leaves.push_str(", "); + SourceEncoder::Sum { tid, ctors, .. } => { + let mut arms = String::new(); + for (index, (ctor, fields)) in ctors.iter().enumerate() { + let names: Vec = fields.iter().map(|_| bind(fresh)).collect(); + let leaves = fields + .iter() + .zip(&names) + .map(|(enc, name)| enc.encode_as(name, fresh, raw)) + .collect::>() + .join(", "); + arms.push_str(" | "); + arms.push_str(ctor); + for name in &names { + arms.push(' '); + arms.push_str(name); } - leaves.push_str(accessor); - leaves.push_str(" ("); - leaves.push_str(value); - leaves.push(')'); + arms.push_str(&format!( + " => {SVAL}.variant {} {} [{leaves}]", + num(*tid as usize), + num(index) + )); } - format!("_root_.RecordComputeBridge.SVal.r [{leaves}]") + format!("(match ({value}) with{arms})") + } + SourceEncoder::Option(elem) => { + let y = bind(fresh); + let ty = elem.grammar_ty_as(raw); + format!( + "(match ({value}) with | _root_.Option.none => {SVAL}.none {ty} \ + | _root_.Option.some {y} => {SVAL}.some {ty} ({}))", + elem.encode_as(&y, fresh, raw) + ) + } + SourceEncoder::Result { ok, err } => { + let y = bind(fresh); + let z = bind(fresh); + let (t, e) = (ok.grammar_ty_as(raw), err.grammar_ty_as(raw)); + format!( + "(match ({value}) with | _root_.Except.ok {y} => {SVAL}.ok {t} {e} ({}) \ + | _root_.Except.error {z} => {SVAL}.err {t} {e} ({}))", + ok.encode_as(&y, fresh, raw), + err.encode_as(&z, fresh, raw) + ) + } + SourceEncoder::List(elem) => { + let y = bind(fresh); + let acc = bind(fresh); + let ty = elem.grammar_ty_as(raw); + format!( + "(_root_.List.foldr (fun {y} {acc} => {SVAL}.cons {ty} ({}) {acc}) \ + ({SVAL}.nil {ty}) ({value}))", + elem.encode_as(&y, fresh, raw) + ) + } + SourceEncoder::Vector(elem) => { + let y = bind(fresh); + format!( + "{SVAL}.vec {} (_root_.List.map (fun {y} => {}) (_root_.Array.toList ({value})))", + elem.grammar_ty_as(raw), + elem.encode_as(&y, fresh, raw) + ) + } + } + } + + /// Nesting depth (a scalar is 1). + pub fn depth(&self) -> usize { + 1 + self.children().map(SourceEncoder::depth).max().unwrap_or(0) + } + + /// Node count. + pub fn size(&self) -> usize { + 1 + self.children().map(SourceEncoder::size).sum::() + } + + fn children(&self) -> Box + '_> { + match self { + SourceEncoder::Int + | SourceEncoder::Bool + | SourceEncoder::Float + | SourceEncoder::Str => Box::new(std::iter::empty()), + SourceEncoder::Record { fields, .. } => Box::new(fields.iter().map(|(_, e)| e)), + SourceEncoder::Sum { ctors, .. } => { + Box::new(ctors.iter().flat_map(|(_, fs)| fs.iter())) } + SourceEncoder::Option(e) | SourceEncoder::List(e) | SourceEncoder::Vector(e) => { + Box::new(std::iter::once(e.as_ref())) + } + SourceEncoder::Result { ok, err } => Box::new([ok.as_ref(), err.as_ref()].into_iter()), + SourceEncoder::Tuple { elems, .. } => Box::new(elems.iter()), } } - /// Whether every name this encoder splices into the rendered statement is a - /// `_root_.`-qualified plain Lean identifier, and — for a record — whether - /// each accessor is a field OF the declared type rather than of some - /// unrelated one. The renderer copies these names verbatim, so this is the - /// gate that keeps the rendered text a plain term. + /// Whether every name this encoder splices into the rendered statement is + /// a `_root_.`-qualified plain Lean identifier, every accessor is a field + /// OF the record it declares and every constructor a constructor OF the + /// sum it declares, and the tree stays within the depth and size caps. The + /// renderer copies these names verbatim, so this is the gate that keeps the + /// rendered text a plain term. pub fn is_well_formed(&self) -> bool { + self.depth() <= MAX_ENCODER_DEPTH && self.size() <= MAX_ENCODER_NODES && self.names_ok() + } + + fn names_ok(&self) -> bool { + let member_of = |owner: &str, name: &str| { + is_root_qualified_name(name) + && name + .strip_prefix(owner) + .and_then(|rest| rest.strip_prefix('.')) + .is_some_and(|member| !member.is_empty() && !member.contains('.')) + }; match self { - SourceEncoder::Int | SourceEncoder::Bool => true, + SourceEncoder::Int + | SourceEncoder::Bool + | SourceEncoder::Float + | SourceEncoder::Str => true, SourceEncoder::Record { - lean_type, - accessors, + lean_type, fields, .. } => { is_root_qualified_name(lean_type) - && !accessors.is_empty() - && accessors.iter().all(|accessor| { - is_root_qualified_name(accessor) - && accessor - .strip_prefix(lean_type.as_str()) - .and_then(|rest| rest.strip_prefix('.')) - .is_some_and(|field| !field.is_empty() && !field.contains('.')) + && !fields.is_empty() + && fields + .iter() + .all(|(accessor, enc)| member_of(lean_type, accessor) && enc.names_ok()) + } + SourceEncoder::Sum { + lean_type, ctors, .. + } => { + is_root_qualified_name(lean_type) + && !ctors.is_empty() + && ctors.iter().all(|(ctor, fields)| { + member_of(lean_type, ctor) && fields.iter().all(SourceEncoder::names_ok) }) } + SourceEncoder::Tuple { elems, .. } => { + elems.len() >= 2 && elems.iter().all(SourceEncoder::names_ok) + } + SourceEncoder::Option(e) | SourceEncoder::List(e) | SourceEncoder::Vector(e) => { + e.names_ok() + } + SourceEncoder::Result { ok, err } => ok.names_ok() && err.names_ok(), + } + } + + /// The manifest JSON of this encoder (the verifier reads it back with the + /// same closed key set). + pub fn to_json(&self) -> String { + let q = json_quote; + match self { + SourceEncoder::Int + | SourceEncoder::Bool + | SourceEncoder::Float + | SourceEncoder::Str => format!("{{\"kind\": {}}}", q(self.kind())), + SourceEncoder::Record { + tid, + lean_type, + fields, + } => format!( + "{{\"kind\": \"record\", \"tid\": {tid}, \"type\": {}, \"fields\": [{}]}}", + q(lean_type), + fields + .iter() + .map(|(accessor, enc)| format!( + "{{\"accessor\": {}, \"encoder\": {}}}", + q(accessor), + enc.to_json() + )) + .collect::>() + .join(", ") + ), + SourceEncoder::Sum { + tid, + lean_type, + ctors, + } => format!( + "{{\"kind\": \"sum\", \"tid\": {tid}, \"type\": {}, \"ctors\": [{}]}}", + q(lean_type), + ctors + .iter() + .map(|(ctor, fields)| format!( + "{{\"ctor\": {}, \"fields\": [{}]}}", + q(ctor), + fields + .iter() + .map(SourceEncoder::to_json) + .collect::>() + .join(", ") + )) + .collect::>() + .join(", ") + ), + SourceEncoder::Option(e) => { + format!("{{\"kind\": \"option\", \"elem\": {}}}", e.to_json()) + } + SourceEncoder::Result { ok, err } => format!( + "{{\"kind\": \"result\", \"ok\": {}, \"err\": {}}}", + ok.to_json(), + err.to_json() + ), + SourceEncoder::Tuple { tid, elems } => format!( + "{{\"kind\": \"tuple\", \"tid\": {tid}, \"elems\": [{}]}}", + elems + .iter() + .map(SourceEncoder::to_json) + .collect::>() + .join(", ") + ), + SourceEncoder::List(e) => format!("{{\"kind\": \"list\", \"elem\": {}}}", e.to_json()), + SourceEncoder::Vector(e) => { + format!("{{\"kind\": \"vector\", \"elem\": {}}}", e.to_json()) + } + } + } +} + +/// The components of an `n`-tuple term, in order (Lean's `×` nests to the +/// right: `(a, b, c)` is `(a, (b, c))`). +pub fn tuple_components(value: &str, n: usize) -> Vec { + let mut out = Vec::with_capacity(n); + let mut rest = format!("({value})"); + for index in 0..n { + if index + 1 == n { + out.push(rest.clone()); + } else { + out.push(format!("(_root_.Prod.fst {rest})")); + rest = format!("(_root_.Prod.snd {rest})"); } } + out +} + +fn json_quote(s: &str) -> String { + let mut out = String::with_capacity(s.len() + 2); + out.push('"'); + for ch in s.chars() { + match ch { + '"' => out.push_str("\\\""), + '\\' => out.push_str("\\\\"), + c if (c as u32) < 0x20 => out.push_str(&format!("\\u{:04x}", c as u32)), + c => out.push(c), + } + } + out.push('"'); + out } /// Whether `value` is a `_root_.`-qualified plain dotted Lean identifier. @@ -146,31 +538,42 @@ pub fn is_root_qualified_name(value: &str) -> bool { /// Whether `value` is a plain dotted Lean identifier: every `.`-separated /// segment nonempty, starting with an ASCII letter or `_`, and continuing with -/// ASCII alphanumerics or `_`. +/// ASCII alphanumerics, `_` or `'`. The prime is the transpiler's escape of a +/// Lean keyword (`none'`), and a name derived from an escaped one carries it +/// mid-segment (the law theorem `at'_law_rulesOnlyTurnOn` of a function +/// `at`). After a letter, Lean lexes `'` as part of the identifier, so a +/// segment of this shape can never open a character literal. pub fn is_plain_dotted_name(value: &str) -> bool { !value.is_empty() && value.len() <= MAX_BRIDGE_NAME_LEN && value.split('.').all(|segment| { let mut chars = segment.chars(); matches!(chars.next(), Some(first) if first.is_ascii_alphabetic() || first == '_') - && chars.all(|c| c.is_ascii_alphanumeric() || c == '_') + && chars.all(|c| c.is_ascii_alphanumeric() || c == '_' || c == '\'') }) } +/// Whether `value` is a certified export name as a bridge entry may carry it: +/// one plain identifier segment, no dot and no prime (export names are the +/// Aver path flattened with `_`). +pub fn is_plain_export_name(value: &str) -> bool { + is_plain_dotted_name(value) && !value.contains('.') && !value.contains('\'') +} + /// The binder names a bridge of this arity quantifies over. pub fn binder_names(arity: usize) -> Vec { (0..arity).map(|index| format!("x{index}")).collect() } -/// `[enc x0, enc x1, …]` — the encoded argument list. -pub fn encoded_args(params: &[SourceEncoder]) -> String { - let mut encoded = String::new(); - for (index, encoder) in params.iter().enumerate() { - if index > 0 { - encoded.push_str(", "); - } - encoded.push_str(&encoder.encode(&format!("x{index}"))); - } +/// `[enc x0, enc x1, …]` — the encoded argument list. `fresh` continues the +/// numbering of pattern binders across the whole statement. +pub fn encoded_args(params: &[SourceEncoder], fresh: &mut usize) -> String { + let encoded = params + .iter() + .enumerate() + .map(|(index, encoder)| encoder.encode(&format!("x{index}"), fresh)) + .collect::>() + .join(", "); format!("[{encoded}]") } @@ -184,55 +587,185 @@ pub fn source_call(model: &str, arity: usize) -> String { } } -/// The Lean name of the plan a bridged export's obligation evaluates. -pub fn plan_body_name(export: &str) -> String { - format!("{ROOT_PREFIX}AverCert.Plans.{export}Plan.body") +/// `(x0 : T0) (x1 : T1)` — the parameter binders. +pub fn param_binders(params: &[SourceEncoder]) -> String { + params + .iter() + .enumerate() + .map(|(index, encoder)| format!("(x{index} : {})", encoder.binder_type())) + .collect::>() + .join(" ") +} + +/// The obligation of `export`, as the statement names it. +pub fn export_obligation(export: &str) -> String { + format!("_root_.AverCert.GrammarBridge.exportObligation _root_.AverCert.manifest \"{export}\"") } -/// The bridge statement for one export: the plan its obligation evaluates, -/// applied to the encoded arguments, is the encoded source result. +/// The binder of a pinned statement: one variable `x` of the tuple of the +/// parameter types (`Unit` for a nullary function), and the term of each +/// parameter as a component of `x`. +fn pinned_binder(params: &[SourceEncoder]) -> (String, Vec) { + match params.len() { + 0 => ("_root_.Unit".to_string(), Vec::new()), + 1 => (params[0].binder_type(), vec!["x".to_string()]), + n => { + let mut ty = params[n - 1].binder_type(); + for param in params[..n - 1].iter().rev() { + ty = format!("(_root_.Prod {} {ty})", param.binder_type()); + } + (ty, tuple_components("x", n)) + } + } +} + +/// The bridge statement for one export: what the checker pins and what the +/// package's `_certified` corollary must state. /// -/// This is the single definition of what a bridge SAYS. Both the producer's -/// `Bridge.lean` and the checker's `bridge_pin_` are rendered from it, so the -/// two agree by construction rather than by comparison. +/// This is the single definition of what a bridge SAYS. The statement is an +/// application of the wall's own `GrammarBridge.Exact` / `GrammarBridge.Adequate` +/// — whose `≤`, quantifiers and numerals were elaborated inside the wall — to +/// the manifest, the export name, and two functions of one tuple binder: the +/// encoded argument list and the encoded source result. Every numeral in those +/// functions is a `nat_lit`, and every name is `_root_`-qualified, so neither a +/// namespace nor an instance the package declares can change what it says. pub fn render_bridge_statement( export: &str, model: &str, + kind: BridgeKind, params: &[SourceEncoder], result: &SourceEncoder, ) -> String { - let mut binders = String::new(); - for (index, encoder) in params.iter().enumerate() { - if index > 0 { - binders.push(' '); - } - binders.push_str("(x"); - binders.push_str(&index.to_string()); - binders.push_str(" : "); - binders.push_str(encoder.binder_type()); - binders.push(')'); - } - let quantifier = if binders.is_empty() { - String::new() + let (binder, components) = pinned_binder(params); + let mut fresh = 0; + let args = params + .iter() + .zip(&components) + .map(|(encoder, component)| encoder.encode_pinned(component, &mut fresh)) + .collect::>() + .join(", "); + let call = if components.is_empty() { + format!("{ROOT_PREFIX}{model}") } else { - format!("∀ {binders}, ") + format!("{ROOT_PREFIX}{model} {}", components.join(" ")) + }; + let image = result.encode_pinned(&call, &mut fresh); + let definition = match kind { + BridgeKind::Exact => "_root_.AverCert.GrammarBridge.Exact", + BridgeKind::Adequate => "_root_.AverCert.GrammarBridge.Adequate", + }; + format!( + "{definition} _root_.AverCert.manifest \"{export}\" \ + (fun (x : {binder}) => [{args}]) (fun (x : {binder}) => {image})" + ) +} + +/// The proof term that turns the producer's expanded bridge theorem +/// (`theorem`, stated by [`render_bridge_statement_expanded`]) into the +/// pinned statement: the same facts, with the parameters read off the tuple +/// binder. +pub fn pinned_from_expanded(theorem: &str, kind: BridgeKind, arity: usize) -> String { + let components = match arity { + 0 => Vec::new(), + 1 => vec!["x".to_string()], + n => tuple_components("x", n), + }; + let applied = |head: &str| { + if components.is_empty() { + head.to_string() + } else { + format!("{head} {}", components.join(" ")) + } + }; + let x = if arity == 0 { "_" } else { "x" }; + let (definition, term) = match kind { + BridgeKind::Exact => ( + "_root_.AverCert.GrammarBridge.Exact", + format!( + "match {theorem} with | ⟨o, ho, ht, k, hk⟩ => \ + ⟨o, ho, fun {x} => {}, k, fun fuel hf {x} => {}⟩", + applied("ht"), + applied("hk fuel hf") + ), + ), + BridgeKind::Adequate => ( + "_root_.AverCert.GrammarBridge.Adequate", + format!( + "match {theorem} with | ⟨o, ho, ht, hk⟩ => \ + ⟨o, ho, fun {x} => {}, fun fuel {x} v h => {} v h⟩", + applied("ht"), + applied("hk fuel") + ), + ), + }; + format!("(by unfold {definition}; exact ({term}))") +} + +/// The producer's own proof target for one bridge: the pinned statement with +/// the wall definition unfolded, one binder per parameter and ordinary +/// numerals — the form its tactic scripts are written against. It is never +/// pinned: the `_certified` corollary restates it as [`render_bridge_statement`] +/// through [`pinned_from_expanded`], so a package instance that changed what +/// this text means makes that restatement fail rather than weakening the pin. +pub fn render_bridge_statement_expanded( + export: &str, + model: &str, + kind: BridgeKind, + params: &[SourceEncoder], + result: &SourceEncoder, +) -> String { + let binders = param_binders(params); + let forall = |body: String| { + if binders.is_empty() { + body + } else { + format!("∀ {binders}, {body}") + } + }; + let mut fresh = 0; + let typed_args = encoded_args(params, &mut fresh); + let typing = forall(format!( + "_root_.AverCert.GrammarBridge.ArgsTyped o {typed_args}" + )); + let args = encoded_args(params, &mut fresh); + let image = result.encode(&source_call(model, params.len()), &mut fresh); + let model_at = format!("_root_.AverCert.Schema.Obligation.model o fuel {args}"); + let tail = match kind { + BridgeKind::Adequate => { + let quantified = if binders.is_empty() { + format!("(fuel : _root_.Nat) (v : {SVAL})") + } else { + format!("(fuel : _root_.Nat) {binders} (v : {SVAL})") + }; + format!("∀ {quantified}, {model_at} = _root_.Option.some v → v = {image}") + } + BridgeKind::Exact => format!( + "∃ (k : _root_.Nat), ∀ (fuel : _root_.Nat), k ≤ fuel → {}", + forall(format!("{model_at} = _root_.Option.some ({image})")) + ), }; format!( - "{quantifier}_root_.AverCert.StandardFace.recordComputeModel {} {} = \ - _root_.Option.some ({})", - plan_body_name(export), - encoded_args(params), - result.encode(&source_call(model, params.len())), + "∃ o, {} = _root_.Option.some o ∧ ({typing}) ∧ ({tail})", + export_obligation(export) ) } -/// The statement gate both the producer and the checker apply to the RENDERED -/// text: one plain term-position line, with balanced delimiters so it cannot -/// escape the single `(...)` the pin wraps it in. +/// The statement gate both the producer and the checker apply to a statement +/// before the witness pins it: one plain term-position line, with balanced +/// delimiters so it cannot escape the single `(...)` it is elaborated in. /// -/// The renderer only ever splices gated names into a fixed skeleton, so this is -/// a backstop rather than the primary defence — but it is the backstop that -/// makes the pin's shape independent of any future encoder. +/// Delimiters are counted the way Lean reads them. The contents of a string +/// literal, a character literal and a `«…»` identifier are skipped, so a `"("` +/// in a statement is not an opening parenthesis. What this gate cannot lex +/// exactly, it refuses: an interpolated or raw string (`s!"…"`, `r"…"`), a +/// backtick (name literals and quotations), and any literal left unterminated. +/// It also refuses the words `set_option` and `open` in any identifier segment +/// (`REFUSED_STATEMENT_WORDS`). +/// +/// The witness does not rely on this gate for the shape of a pin: it elaborates +/// each statement as a definition of its own and conjoins the definition, so no +/// text can re-associate the conjunction. The gate keeps the statement one +/// term, so the definition cannot end early and add a command. pub fn statement_is_single_plain_line(statement: &str, max_len: usize) -> bool { if statement.is_empty() || statement.len() > max_len @@ -240,27 +773,105 @@ pub fn statement_is_single_plain_line(statement: &str, max_len: usize) -> bool { || statement.contains(":=") || statement.contains("--") || statement.contains("/-") + || statement.contains('`') { return false; } + let chars: Vec = statement.chars().collect(); + let identifier_char = + |c: char| c.is_alphanumeric() || matches!(c, '_' | '\'' | '!' | '?' | '.'); let mut depth: Vec = Vec::new(); - for character in statement.chars() { - let matched = match character { - '(' | '[' | '{' | '⟨' => { - depth.push(character); - true - } - ')' => depth.pop() == Some('('), - ']' => depth.pop() == Some('['), - '}' => depth.pop() == Some('{'), - '⟩' => depth.pop() == Some('⟨'), - _ => true, - }; - if !matched { - return false; + // The statement with every literal and `«…»` identifier blanked out: what + // Lean reads as code, for the refused-word check. + let mut code = chars.clone(); + let mut at = 0; + while at < chars.len() { + let character = chars[at]; + let previous = at.checked_sub(1).map(|p| chars[p]); + let start = at; + match character { + '"' => { + // `s!"…"`, `m!"…"` and `r"…"` / `r#"…"#` read their body with + // rules of their own: refuse rather than approximate them. + if matches!(previous, Some('!' | '#')) + || (previous == Some('r') + && at.checked_sub(2).is_none_or(|p| !identifier_char(chars[p]))) + { + return false; + } + at += 1; + loop { + match chars.get(at) { + None => return false, + Some('\\') => at += 2, + Some('"') => break, + Some(_) => at += 1, + } + } + code[start..=at].fill(' '); + } + '\'' if !previous.is_some_and(identifier_char) => { + // A character literal: one character or one escape, then `'`. + at += 1; + match chars.get(at) { + None | Some('\'') => return false, + Some('\\') => { + at += 1; + while chars.get(at).is_some_and(|c| *c != '\'') { + at += 1; + } + } + Some(_) => at += 1, + } + if chars.get(at) != Some(&'\'') { + return false; + } + code[start..=at].fill(' '); + } + '«' => { + at += 1; + while chars.get(at).is_some_and(|c| *c != '»') { + at += 1; + } + if at >= chars.len() { + return false; + } + code[start..=at].fill(' '); + } + '»' => return false, + '(' | '[' | '{' | '⟨' => depth.push(character), + ')' | ']' | '}' | '⟩' => { + let opener = match character { + ')' => '(', + ']' => '[', + '}' => '{', + _ => '⟨', + }; + if depth.pop() != Some(opener) { + return false; + } + } + _ => {} } + at += 1; } - depth.is_empty() + depth.is_empty() && !names_refused_statement_word(&code.into_iter().collect::()) +} + +/// Words a statement may not contain, outside its literals, as any segment of +/// any identifier token. +/// A term-level `set_option … in` would change elaboration options outside +/// the package gate's option whitelist, and a term-level `open … in` would +/// change how the statement's names resolve. The producer writes neither: a +/// model name that spells one of them is emitted with a prime. +const REFUSED_STATEMENT_WORDS: [&str; 2] = ["set_option", "open"]; + +fn names_refused_statement_word(statement: &str) -> bool { + statement_tokens(statement).iter().any(|token| { + token + .split('.') + .any(|segment| REFUSED_STATEMENT_WORDS.contains(&segment)) + }) } /// Whether every dotted name in a statement is spelled `_root_.`-first. @@ -276,174 +887,484 @@ pub fn statement_is_root_qualified(statement: &str) -> bool { .all(|token| token.starts_with(ROOT_PREFIX)) } +/// The identifier tokens of a law statement, in first-appearance order: a +/// token is a maximal run of Lean identifier characters, stripped of leading +/// and trailing dots. +pub fn statement_tokens(statement: &str) -> Vec<&str> { + let mut found: Vec<&str> = Vec::new(); + for token in + statement.split(|c: char| !(c.is_ascii_alphanumeric() || c == '_' || c == '.' || c == '\'')) + { + let token = token.trim_matches('.'); + if !token.is_empty() && !found.contains(&token) { + found.push(token); + } + } + found +} + +/// The bridges a law statement mentions: the positions in `models` (the +/// declared bridges' source functions) of every model the statement names as +/// `_root_.`, in first-appearance order. This is the ONE rule the +/// producer writes a law's `bridges` list by and the checker holds the list +/// to, so the bridges a `_bridged` corollary conjoins are exactly those of the +/// functions its statement speaks about — never a chosen subset or an +/// unrelated bridge. +/// +/// A law statement is elaborated at the root namespace, and only a +/// `_root_.`-spelled name is certain to mean the root constant there: a bare +/// `Tiny.addTwo` would be a field read of a binder named `Tiny`. So only that +/// spelling counts as a mention, and [`law_names_model_unqualified`] refuses +/// any other spelling of a model name in a law that lists bridges. +pub fn law_mentioned_bridges(statement: &str, models: &[&str]) -> Vec { + let mut covering = Vec::new(); + for token in statement_tokens(statement) { + let Some(named) = token.strip_prefix(ROOT_PREFIX) else { + continue; + }; + if let Some(index) = models.iter().position(|model| *model == named) + && !covering.contains(&index) + { + covering.push(index); + } + } + covering +} + +/// Whether a statement token spells `model` without `_root_.`: the bare +/// name, or a name ending in `.` that does not start with `_root_.` +/// (such as `Evil.Tiny.addTwo`). Read inside a namespace, or through a +/// binder, such a token can mean another constant than `model`. A +/// `_root_.`-spelled token names exactly the root constant it spells. +pub fn token_names_model_unqualified(token: &str, model: &str) -> bool { + !token.starts_with(ROOT_PREFIX) + && (token == model + || token + .strip_suffix(model) + .is_some_and(|head| head.ends_with('.'))) +} + +/// The first model of `models` that a law statement spells without +/// `_root_.` ([`token_names_model_unqualified`]), if any. +pub fn law_names_model_unqualified<'a>(statement: &str, models: &[&'a str]) -> Option<&'a str> { + let tokens = statement_tokens(statement); + models + .iter() + .find(|model| { + tokens + .iter() + .any(|token| token_names_model_unqualified(token, model)) + }) + .copied() +} + #[cfg(test)] mod tests { use super::*; fn fraction() -> SourceEncoder { SourceEncoder::Record { + tid: 0, lean_type: "_root_.Domain.Rational.Fraction".to_string(), - accessors: vec![ - "_root_.Domain.Rational.Fraction.top".to_string(), - "_root_.Domain.Rational.Fraction.bottom".to_string(), + fields: vec![ + ( + "_root_.Domain.Rational.Fraction.top".to_string(), + SourceEncoder::Int, + ), + ( + "_root_.Domain.Rational.Fraction.bottom".to_string(), + SourceEncoder::Int, + ), + ], + } + } + + fn op() -> SourceEncoder { + SourceEncoder::Sum { + tid: 1, + lean_type: "_root_.CertGoals.Op".to_string(), + ctors: vec![ + ( + "_root_.CertGoals.Op.add".to_string(), + vec![SourceEncoder::Int], + ), + ("_root_.CertGoals.Op.zero".to_string(), vec![]), ], } } - /// The rendered text is the claim. This pins it verbatim for every encoder - /// kind, in every position, so a change to the renderer has to be a - /// deliberate edit of an expected string rather than a silent reshaping of - /// what every certificate says. + /// The rendered text is the claim. This pins it verbatim for both kinds, + /// so a change to the renderer has to be a deliberate edit of an expected + /// string rather than a silent reshaping of what every certificate says. + /// The pinned text: the wall's definitions, one tuple binder, `nat_lit` + /// numerals, nothing a package instance or namespace can reinterpret. #[test] - fn every_encoder_kind_renders_its_exact_statement() { + fn pinned_statements_go_through_the_wall_definitions() { assert_eq!( render_bridge_statement( "addOne", "CertificateHello.addOne", + BridgeKind::Exact, &[SourceEncoder::Int], &SourceEncoder::Int ), - "∀ (x0 : Int), _root_.AverCert.StandardFace.recordComputeModel \ - _root_.AverCert.Plans.addOnePlan.body \ - [_root_.RecordComputeBridge.SVal.i (x0)] = _root_.Option.some \ - (_root_.RecordComputeBridge.SVal.i (_root_.CertificateHello.addOne x0))" + "_root_.AverCert.GrammarBridge.Exact _root_.AverCert.manifest \"addOne\" \ + (fun (x : _root_.Int) => [_root_.AverCert.Grammar.SVal.i (x)]) \ + (fun (x : _root_.Int) => _root_.AverCert.Grammar.SVal.i \ + (_root_.CertificateHello.addOne x))" + ); + let pinned = render_bridge_statement( + "Domain_Rational_plus", + "Domain.Rational.plus", + BridgeKind::Adequate, + &[fraction(), op()], + &fraction(), + ); + assert!( + pinned.starts_with( + "_root_.AverCert.GrammarBridge.Adequate _root_.AverCert.manifest \ + \"Domain_Rational_plus\" (fun (x : (_root_.Prod _root_.Domain.Rational.Fraction \ + _root_.CertGoals.Op)) => [_root_.AverCert.Grammar.SVal.record (nat_lit 0) [" + ), + "{pinned}" ); + assert!(pinned.contains("_root_.AverCert.Grammar.SVal.variant (nat_lit 1) (nat_lit 0)")); + assert!( + pinned.contains( + "(_root_.Domain.Rational.plus (_root_.Prod.fst (x)) (_root_.Prod.snd (x)))" + ) + ); + // No `≤`, no bare numeral: the only order and numbers in a pinned + // statement are the wall's. + assert!(!pinned.contains('≤')); + assert!(!pinned.contains(" 0 ") && !pinned.contains(" 1 ")); assert_eq!( - render_bridge_statement( - "Domain_Rational_lessThan", - "Domain.Rational.lessThan", - &[fraction(), fraction()], - &SourceEncoder::Bool, + pinned_from_expanded("_root_.AverCert.Bridge.f", BridgeKind::Exact, 0), + "(by unfold _root_.AverCert.GrammarBridge.Exact; exact (match \ + _root_.AverCert.Bridge.f with | ⟨o, ho, ht, k, hk⟩ => ⟨o, ho, fun _ => ht, k, \ + fun fuel hf _ => hk fuel hf⟩))" + ); + } + + #[test] + fn both_kinds_render_their_exact_statement() { + assert_eq!( + render_bridge_statement_expanded( + "addOne", + "CertificateHello.addOne", + BridgeKind::Exact, + &[SourceEncoder::Int], + &SourceEncoder::Int ), - "∀ (x0 : _root_.Domain.Rational.Fraction) (x1 : _root_.Domain.Rational.Fraction), \ - _root_.AverCert.StandardFace.recordComputeModel \ - _root_.AverCert.Plans.Domain_Rational_lessThanPlan.body \ - [_root_.RecordComputeBridge.SVal.r [_root_.Domain.Rational.Fraction.top (x0), \ - _root_.Domain.Rational.Fraction.bottom (x0)], \ - _root_.RecordComputeBridge.SVal.r [_root_.Domain.Rational.Fraction.top (x1), \ - _root_.Domain.Rational.Fraction.bottom (x1)]] = _root_.Option.some \ - (_root_.RecordComputeBridge.SVal.b (_root_.Domain.Rational.lessThan x0 x1))" + "∃ o, _root_.AverCert.GrammarBridge.exportObligation _root_.AverCert.manifest \ + \"addOne\" = _root_.Option.some o ∧ (∀ (x0 : _root_.Int), \ + _root_.AverCert.GrammarBridge.ArgsTyped o [_root_.AverCert.Grammar.SVal.i (x0)]) ∧ \ + (∃ (k : _root_.Nat), ∀ (fuel : _root_.Nat), k ≤ fuel → ∀ (x0 : _root_.Int), \ + _root_.AverCert.Schema.Obligation.model o fuel [_root_.AverCert.Grammar.SVal.i (x0)] \ + = _root_.Option.some (_root_.AverCert.Grammar.SVal.i \ + (_root_.CertificateHello.addOne x0)))" ); - // Nullary: no quantifier, and the source call is the bare name. assert_eq!( - render_bridge_statement( + render_bridge_statement_expanded( + "sumFrom", + "RecGen.sumFrom", + BridgeKind::Adequate, + &[SourceEncoder::Int], + &SourceEncoder::Int + ), + "∃ o, _root_.AverCert.GrammarBridge.exportObligation _root_.AverCert.manifest \ + \"sumFrom\" = _root_.Option.some o ∧ (∀ (x0 : _root_.Int), \ + _root_.AverCert.GrammarBridge.ArgsTyped o [_root_.AverCert.Grammar.SVal.i (x0)]) ∧ \ + (∀ (fuel : _root_.Nat) (x0 : _root_.Int) (v : _root_.AverCert.Grammar.SVal), \ + _root_.AverCert.Schema.Obligation.model o fuel [_root_.AverCert.Grammar.SVal.i (x0)] \ + = _root_.Option.some v → v = _root_.AverCert.Grammar.SVal.i (_root_.RecGen.sumFrom x0))" + ); + // Nullary: no parameter binders, and the source call is the bare name. + assert_eq!( + render_bridge_statement_expanded( "Domain_Rational_zeroFraction", "Domain.Rational.zeroFraction", + BridgeKind::Exact, &[], &fraction(), ), - "_root_.AverCert.StandardFace.recordComputeModel \ - _root_.AverCert.Plans.Domain_Rational_zeroFractionPlan.body [] = _root_.Option.some \ - (_root_.RecordComputeBridge.SVal.r \ - [_root_.Domain.Rational.Fraction.top (_root_.Domain.Rational.zeroFraction), \ - _root_.Domain.Rational.Fraction.bottom (_root_.Domain.Rational.zeroFraction)])" + "∃ o, _root_.AverCert.GrammarBridge.exportObligation _root_.AverCert.manifest \ + \"Domain_Rational_zeroFraction\" = _root_.Option.some o ∧ \ + (_root_.AverCert.GrammarBridge.ArgsTyped o []) ∧ (∃ (k : _root_.Nat), \ + ∀ (fuel : _root_.Nat), k ≤ fuel → _root_.AverCert.Schema.Obligation.model o fuel [] \ + = _root_.Option.some (_root_.AverCert.Grammar.SVal.record 0 \ + [_root_.AverCert.Grammar.SVal.i (_root_.Domain.Rational.Fraction.top \ + (_root_.Domain.Rational.zeroFraction)), _root_.AverCert.Grammar.SVal.i \ + (_root_.Domain.Rational.Fraction.bottom (_root_.Domain.Rational.zeroFraction))]))" + ); + } + + #[test] + fn every_encoder_kind_renders_its_value_form() { + let mut fresh = 0; + assert_eq!( + op().encode("x0", &mut fresh), + "(match (x0) with | _root_.CertGoals.Op.add y0 => \ + _root_.AverCert.Grammar.SVal.variant 1 0 [_root_.AverCert.Grammar.SVal.i (y0)] \ + | _root_.CertGoals.Op.zero => _root_.AverCert.Grammar.SVal.variant 1 1 [])" + ); + let mut fresh = 0; + assert_eq!( + SourceEncoder::Option(Box::new(SourceEncoder::Bool)).encode("x0", &mut fresh), + "(match (x0) with | _root_.Option.none => _root_.AverCert.Grammar.SVal.none \ + _root_.AverCert.Grammar.Ty.bool | _root_.Option.some y0 => \ + _root_.AverCert.Grammar.SVal.some _root_.AverCert.Grammar.Ty.bool \ + (_root_.AverCert.Grammar.SVal.b (y0)))" + ); + let mut fresh = 0; + assert_eq!( + SourceEncoder::Result { + ok: Box::new(SourceEncoder::Int), + err: Box::new(SourceEncoder::Str) + } + .encode("x0", &mut fresh), + "(match (x0) with | _root_.Except.ok y0 => _root_.AverCert.Grammar.SVal.ok \ + _root_.AverCert.Grammar.Ty.int _root_.AverCert.Grammar.Ty.string \ + (_root_.AverCert.Grammar.SVal.i (y0)) | _root_.Except.error y1 => \ + _root_.AverCert.Grammar.SVal.err _root_.AverCert.Grammar.Ty.int \ + _root_.AverCert.Grammar.Ty.string (_root_.AverCert.Grammar.SVal.s \ + (_root_.AverCert.GrammarBridge.strBytes (y1))))" + ); + let mut fresh = 0; + assert_eq!( + SourceEncoder::Tuple { + tid: 4, + elems: vec![ + SourceEncoder::Int, + SourceEncoder::Bool, + SourceEncoder::Float + ] + } + .encode("x0", &mut fresh), + "_root_.AverCert.Grammar.SVal.record 4 [_root_.AverCert.Grammar.SVal.i \ + ((_root_.Prod.fst (x0))), _root_.AverCert.Grammar.SVal.b ((_root_.Prod.fst \ + (_root_.Prod.snd (x0)))), _root_.AverCert.Grammar.SVal.f (_root_.Float.toBits \ + ((_root_.Prod.snd (_root_.Prod.snd (x0)))))]" + ); + let mut fresh = 0; + assert_eq!( + SourceEncoder::List(Box::new(SourceEncoder::Int)).encode("x0", &mut fresh), + "(_root_.List.foldr (fun y0 y1 => _root_.AverCert.Grammar.SVal.cons \ + _root_.AverCert.Grammar.Ty.int (_root_.AverCert.Grammar.SVal.i (y0)) y1) \ + (_root_.AverCert.Grammar.SVal.nil _root_.AverCert.Grammar.Ty.int) (x0))" + ); + let mut fresh = 0; + assert_eq!( + SourceEncoder::Vector(Box::new(SourceEncoder::Int)).encode("x0", &mut fresh), + "_root_.AverCert.Grammar.SVal.vec _root_.AverCert.Grammar.Ty.int \ + (_root_.List.map (fun y0 => _root_.AverCert.Grammar.SVal.i (y0)) \ + (_root_.Array.toList (x0)))" ); } - /// The three ways a hostile manifest could try to make the renderer say - /// something else, and the fact that it cannot: the statement changes, so - /// the pin no longer has the package corollary's type. + /// The ways a hostile manifest could try to make the renderer say something + /// else, and the fact that it cannot: the statement changes, so the pin no + /// longer has the package corollary's type. #[test] fn structure_edits_change_the_rendered_statement() { - let honest = render_bridge_statement( + let render = |export: &str, model: &str, kind, params: &[SourceEncoder]| { + render_bridge_statement(export, model, kind, params, &fraction()) + }; + let honest = render( "Domain_Rational_plus", "Domain.Rational.plus", + BridgeKind::Exact, &[fraction(), fraction()], - &fraction(), ); - // A different plan. + // A different export (another obligation). assert_ne!( honest, - render_bridge_statement( + render( "Domain_Rational_minus", "Domain.Rational.plus", - &[fraction(), fraction()], - &fraction(), + BridgeKind::Exact, + &[fraction(), fraction()] ) ); // A different source function. assert_ne!( honest, - render_bridge_statement( + render( "Domain_Rational_plus", "Domain.Rational.minus", - &[fraction(), fraction()], - &fraction(), + BridgeKind::Exact, + &[fraction(), fraction()] + ) + ); + // The weaker kind. + assert_ne!( + honest, + render( + "Domain_Rational_plus", + "Domain.Rational.plus", + BridgeKind::Adequate, + &[fraction(), fraction()] ) ); // Permuted record accessors. let permuted = SourceEncoder::Record { + tid: 0, lean_type: "_root_.Domain.Rational.Fraction".to_string(), - accessors: vec![ - "_root_.Domain.Rational.Fraction.bottom".to_string(), - "_root_.Domain.Rational.Fraction.top".to_string(), + fields: vec![ + ( + "_root_.Domain.Rational.Fraction.bottom".to_string(), + SourceEncoder::Int, + ), + ( + "_root_.Domain.Rational.Fraction.top".to_string(), + SourceEncoder::Int, + ), ], }; assert_ne!( honest, - render_bridge_statement( + render( "Domain_Rational_plus", "Domain.Rational.plus", - &[permuted, fraction()], - &fraction(), + BridgeKind::Exact, + &[permuted, fraction()] ) ); - // A tautology is unrepresentable: the left-hand side is always the - // plan's model, never the source call. - assert!(honest.contains("recordComputeModel _root_.AverCert.Plans.")); + // A tautology is unrepresentable: the statement is always the wall's + // own `Exact`/`Adequate` of the named export's obligation. + assert!(honest.starts_with("_root_.AverCert.GrammarBridge.Exact _root_.AverCert.manifest")); } #[test] - fn record_encoder_accessors_must_belong_to_the_declared_type() { + fn encoders_must_name_their_own_members() { assert!(fraction().is_well_formed()); + assert!(op().is_well_formed()); assert!(SourceEncoder::Int.is_well_formed()); - assert!(SourceEncoder::Bool.is_well_formed()); // An accessor of an unrelated type. assert!( !SourceEncoder::Record { + tid: 0, lean_type: "_root_.Domain.Rational.Fraction".to_string(), - accessors: vec!["_root_.Other.Type.top".to_string()], + fields: vec![("_root_.Other.Type.top".to_string(), SourceEncoder::Int)], } .is_well_formed() ); - // A nested accessor is not a field of the type. + // A constructor of an unrelated sum. assert!( - !SourceEncoder::Record { - lean_type: "_root_.Domain.Rational.Fraction".to_string(), - accessors: vec!["_root_.Domain.Rational.Fraction.top.inner".to_string()], + !SourceEncoder::Sum { + tid: 1, + lean_type: "_root_.CertGoals.Op".to_string(), + ctors: vec![("_root_.CertGoals.Tag.a".to_string(), vec![])], } .is_well_formed() ); // Unqualified names would mean whatever the package's namespaces say. assert!( !SourceEncoder::Record { + tid: 0, lean_type: "Domain.Rational.Fraction".to_string(), - accessors: vec!["Domain.Rational.Fraction.top".to_string()], + fields: vec![( + "Domain.Rational.Fraction.top".to_string(), + SourceEncoder::Int + )], } .is_well_formed() ); - // A record with no leaves has no `SVal.r` image. + // A record with no fields and a one-component tuple have no image. assert!( !SourceEncoder::Record { + tid: 0, lean_type: "_root_.Domain.Rational.Fraction".to_string(), - accessors: Vec::new(), + fields: Vec::new(), } .is_well_formed() ); + assert!( + !SourceEncoder::Tuple { + tid: 0, + elems: vec![SourceEncoder::Int] + } + .is_well_formed() + ); + // Depth cap. + let mut deep = SourceEncoder::Int; + for _ in 0..MAX_ENCODER_DEPTH { + deep = SourceEncoder::Option(Box::new(deep)); + } + assert!(!deep.is_well_formed()); } #[test] fn rendered_statements_pass_the_gates_they_are_pinned_under() { - let statement = render_bridge_statement( - "Domain_Rational_plus", - "Domain.Rational.plus", - &[fraction(), fraction()], - &fraction(), - ); - assert!(statement_is_single_plain_line( - &statement, - MAX_BRIDGE_STATEMENT_LEN - )); - assert!(statement_is_root_qualified(&statement)); + for kind in [BridgeKind::Exact, BridgeKind::Adequate] { + let statement = render_bridge_statement( + "Domain_Rational_plus", + "Domain.Rational.plus", + kind, + &[ + fraction(), + op(), + SourceEncoder::Option(Box::new(fraction())), + ], + &SourceEncoder::List(Box::new(op())), + ); + assert!(statement_is_single_plain_line( + &statement, + MAX_BRIDGE_STATEMENT_LEN + )); + assert!(statement_is_root_qualified(&statement), "{statement}"); + } + } + + #[test] + fn the_statement_gate_lexes_literals_as_lean_does() { + let gate = |s: &str| statement_is_single_plain_line(s, MAX_BRIDGE_STATEMENT_LEN); + // Parentheses inside string literals do not count: this statement + // closes the wrapping parenthesis early in Lean. + assert!(!gate("\"(\" = \"(\" ) ∨ ( M.f 0 = M.f 0 ∧ \")\" = \")\"")); + assert!(!gate("'(' = '(' ) ∨ ( True")); + assert!(!gate("«(» = 0 ) ∨ ( True")); + // Balanced statements with delimiters inside literals pass. + assert!(gate("f \"(\" = \")\"")); + assert!(gate("g '(' = ')' ∧ h '\\'' = 0")); + assert!(gate("∀ (x' : Int), f x' = x'")); + assert!(gate("M.«weird)name» 0 = 0")); + assert!(gate("s \"a\\\"b(\" = t")); + // What the gate cannot lex exactly, it refuses. + assert!(!gate("s!\"{x}\" = t")); + assert!(!gate("r\"(\" = t")); + assert!(!gate("r#\"(\"# = t")); + assert!(!gate("`(x) = y")); + assert!(!gate("f \"unterminated")); + assert!(!gate("f 'x = y")); + assert!(!gate("f «x = y")); + // An identifier ending in `r` before a string is not a raw string. + assert!(gate("ctr \"x\" = y")); + } + + /// A term-level `set_option … in` or `open … in` would change how the + /// statement elaborates or what its names mean: both words are refused, + /// while names that merely contain them pass. + #[test] + fn the_statement_gate_refuses_set_option_and_open() { + let gate = |s: &str| statement_is_single_plain_line(s, MAX_BRIDGE_STATEMENT_LEN); + assert!(!gate("set_option maxRecDepth 100000 in _root_.M.f 0 = 0")); + assert!(!gate("(set_option pp.all true in True)")); + assert!(!gate("open _root_.Evil in _root_.M.f 0 = 0")); + assert!(!gate("∀ (x : Int), (open Evil in f x) = x")); + assert!(gate("_root_.M.openFile 0 = _root_.M.open' 0")); + assert!(gate("_root_.M.reopen 0 = _root_.M.set_optional 0")); + // Inside a literal or a `«…»` identifier the words are data, not code. + assert!(gate("_root_.M.f \"open set_option\" = «open» 'o'")); + } + + #[test] + fn reserved_word_primes_are_plain_names() { + assert!(is_plain_dotted_name("_root_.Models.Type'.field")); + assert!(!is_plain_dotted_name("_root_.Models.'x")); + // A name derived from an escaped one carries the prime mid-segment. + assert!(is_plain_dotted_name("_root_.Models.at'_law_x")); + assert!(!is_plain_dotted_name("_root_.Models..x")); + assert!(!is_plain_dotted_name("_root_.Models.x\"y")); } } diff --git a/aver-cert/src/cache.rs b/aver-cert/src/cache.rs index c664c2595..33423398b 100644 --- a/aver-cert/src/cache.rs +++ b/aver-cert/src/cache.rs @@ -32,8 +32,9 @@ pub(crate) struct ArtifactBuildCache { } impl ArtifactBuildCache { - pub(crate) fn prepare(build_dir: &Path, material: &KeyMaterial<'_>) -> Self { - let Some(store) = cache_store() else { + /// `enabled` is false for `verify`, which never reads or writes a cache. + pub(crate) fn prepare(build_dir: &Path, material: &KeyMaterial<'_>, enabled: bool) -> Self { + let Some(store) = cache_store().filter(|_| enabled) else { return Self { entry: None, hit: false, @@ -78,6 +79,11 @@ impl ArtifactBuildCache { } } +/// Whether either build cache is configured in the environment. +pub(crate) fn any_cache_configured() -> bool { + cache_store().is_some() || crate::prelude_cache::cache_configured() +} + /// Any explicit value except `0|off|false` opts into a trusted cache directory. /// An absent variable is the strict, cache-free default. fn cache_store() -> Option { @@ -126,6 +132,237 @@ fn artifact_cache_key(build_dir: &Path, material: &KeyMaterial<'_>) -> Result, + modules: Vec<(String, String)>, + restored: usize, +} + +/// A module's build products, relative to the build directory, for a module +/// whose source path (without `.lean`) is `stem`. +fn module_output_files(stem: &str) -> Vec { + [".olean", ".olean.hash", ".ilean", ".ilean.hash", ".trace"] + .iter() + .map(|ext| format!(".lake/build/lib/lean/{stem}{ext}")) + .chain( + [".c", ".c.hash", ".setup.json"] + .iter() + .map(|ext| format!(".lake/build/ir/{stem}{ext}")), + ) + .collect() +} + +/// The module names a Lean source imports, read from its `import` lines +/// (optionally after `public`, `private` or `meta`). Only a key input: Lake +/// validates every restored module against its own trace. +fn import_names(source: &str) -> Vec { + let mut names = Vec::new(); + for line in source.lines() { + let mut words = line.split_whitespace().peekable(); + while matches!(words.peek(), Some(&("public" | "private" | "meta"))) { + words.next(); + } + if words.next() == Some("import") { + names.extend(words.filter(|word| *word != "all").map(str::to_string)); + } + } + names.sort(); + names.dedup(); + names +} + +/// Keys of every staged module that is not a wall source, by module name. +fn module_keys( + build_dir: &Path, + material: &[(&str, &str)], + wall_sources: &[&str], +) -> Result, ()> { + let sources: std::collections::BTreeMap)> = + staged_source_files(build_dir)? + .into_iter() + .filter_map(|(path, bytes)| { + let stem = path.strip_suffix(".lean")?.to_string(); + if stem == "lakefile" || wall_sources.contains(&path.as_str()) { + return None; + } + Some((stem.replace('/', "."), (stem, bytes))) + }) + .collect(); + fn key_of( + name: &str, + sources: &std::collections::BTreeMap)>, + material: &[(&str, &str)], + memo: &mut std::collections::BTreeMap>, + depth: usize, + ) -> Option { + if let Some(key) = memo.get(name) { + return key.clone(); + } + let (stem, bytes) = sources.get(name)?; + if depth > sources.len() { + return None; + } + let mut hasher = Sha256::new(); + hash_part(&mut hasher, b"layout", MODULE_LAYOUT_VERSION.as_bytes()); + for (name, value) in material { + hash_part(&mut hasher, name.as_bytes(), value.as_bytes()); + } + hash_part(&mut hasher, b"module", stem.as_bytes()); + hash_part(&mut hasher, b"source", bytes); + for import in import_names(&String::from_utf8_lossy(bytes)) { + let import_key = if sources.contains_key(&import) { + key_of(&import, sources, material, memo, depth + 1)? + } else { + String::new() + }; + hash_part(&mut hasher, import.as_bytes(), import_key.as_bytes()); + } + let key = format!("{:x}", hasher.finalize()); + memo.insert(name.to_string(), Some(key.clone())); + Some(key) + } + let mut memo = std::collections::BTreeMap::new(); + Ok(sources + .iter() + .filter_map(|(name, (stem, _))| { + key_of(name, &sources, material, &mut memo, 0).map(|key| (stem.clone(), key)) + }) + .collect()) +} + +const MODULE_LAYOUT_VERSION: &str = "v1-modules"; + +impl ModuleOutputCache { + pub(crate) fn disabled() -> Self { + Self { + store: None, + modules: Vec::new(), + restored: 0, + } + } + + pub(crate) fn prepare( + build_dir: &Path, + material: &[(&str, &str)], + wall_sources: &[&str], + ) -> Self { + let Some(store) = cache_store() else { + return Self::disabled(); + }; + let store = store.join(CACHE_LAYOUT_VERSION).join(MODULE_LAYOUT_VERSION); + let Ok(modules) = module_keys(build_dir, material, wall_sources) else { + return Self::disabled(); + }; + let restored = modules + .iter() + .filter(|(stem, key)| restore_module(&store.join(key), build_dir, stem).is_ok()) + .count(); + Self { + store: Some(store), + modules, + restored, + } + } + + /// How many modules were restored from the cache. + pub(crate) fn restored(&self) -> usize { + self.restored + } + + pub(crate) fn publish(&self, build_dir: &Path) { + let Some(store) = &self.store else { + return; + }; + for (stem, key) in &self.modules { + let entry = store.join(key); + if !entry.join("manifest.sha256").is_file() { + let _ = publish_module(&entry, build_dir, stem); + } + } + } +} + +fn restore_module(entry: &Path, build_dir: &Path, stem: &str) -> Result<(), ()> { + if !entry.join("manifest.sha256").is_file() { + return Err(()); + } + let files = entry.join("files"); + if verify_integrity(entry, &files).is_err() { + let _ = std::fs::remove_dir_all(entry); + return Err(()); + } + let mut copied = Vec::new(); + let result = (|| { + for relative in module_output_files(stem) { + let source = files.join(&relative); + if !source.is_file() { + continue; + } + let destination = build_dir.join(&relative); + std::fs::create_dir_all(destination.parent().ok_or(())?).map_err(|_| ())?; + std::fs::copy(&source, &destination).map_err(|_| ())?; + copied.push(destination); + } + Ok(()) + })(); + if result.is_err() { + for file in copied { + let _ = std::fs::remove_file(file); + } + } + result +} + +fn publish_module(entry: &Path, build_dir: &Path, stem: &str) -> Result<(), ()> { + let outputs = module_output_files(stem); + if !outputs + .iter() + .take(5) + .all(|relative| build_dir.join(relative).is_file()) + { + return Err(()); + } + let parent = entry.parent().ok_or(())?; + std::fs::create_dir_all(parent).map_err(|_| ())?; + let temp = parent.join(format!("tmp-{}-{}", std::process::id(), unique_nanos())); + let result = (|| { + for relative in &outputs { + let source = build_dir.join(relative); + if !source.is_file() { + continue; + } + let destination = temp.join("files").join(relative); + std::fs::create_dir_all(destination.parent().ok_or(())?).map_err(|_| ())?; + std::fs::copy(&source, &destination).map_err(|_| ())?; + } + let manifest = lake_tree_hashes(&temp.join("files"))? + .into_iter() + .map(|(path, hash)| format!("{hash} {path}\n")) + .collect::(); + std::fs::write(temp.join("manifest.sha256"), manifest).map_err(|_| ())?; + match std::fs::rename(&temp, entry) { + Ok(()) => Ok(()), + Err(_) if entry.join("manifest.sha256").is_file() => Ok(()), + Err(_) => Err(()), + } + })(); + let _ = std::fs::remove_dir_all(temp); + result +} + fn hash_part(hasher: &mut Sha256, name: &[u8], bytes: &[u8]) { hasher.update((name.len() as u64).to_be_bytes()); hasher.update(name); @@ -431,4 +668,121 @@ mod tests { let _ = std::fs::remove_dir_all(dir); } + + #[test] + fn import_names_read_every_import_form() { + let source = "-- header\nimport A\npublic import B.C D\nmeta import all E\nimports F\n\ndef x := 1\n"; + assert_eq!(import_names(source), vec!["A", "B.C", "D", "E"]); + } + + fn module_dir(label: &str) -> PathBuf { + let dir = std::env::temp_dir().join(format!( + "aver-cert-module-cache-{label}-{}-{}", + std::process::id(), + unique_nanos() + )); + std::fs::create_dir_all(&dir).unwrap(); + dir + } + + fn key_of(dir: &Path, material: &[(&str, &str)], module: &str) -> String { + module_keys(dir, material, &["Wall.lean"]) + .unwrap() + .into_iter() + .find(|(stem, _)| stem == module) + .map(|(_, key)| key) + .unwrap() + } + + #[test] + fn module_key_follows_source_imports_and_material_but_not_the_wall() { + let dir = module_dir("keys"); + std::fs::write(dir.join("Wall.lean"), "def w := 0\n").unwrap(); + std::fs::write(dir.join("Base.lean"), "import Wall\ndef b := 1\n").unwrap(); + std::fs::write( + dir.join("Top.lean"), + "import Base\nimport Wall\ndef t := 1\n", + ) + .unwrap(); + std::fs::write(dir.join("Other.lean"), "import Wall\ndef o := 1\n").unwrap(); + let material = [("wall_id", "w1"), ("toolchain_version", "t")]; + let top = key_of(&dir, &material, "Top"); + let other = key_of(&dir, &material, "Other"); + assert!( + module_keys(&dir, &material, &["Wall.lean"]) + .unwrap() + .iter() + .all(|(stem, _)| stem != "Wall" && stem != "lakefile"), + "wall sources are never package modules" + ); + + // An imported package module's source is part of the key. + std::fs::write(dir.join("Base.lean"), "import Wall\ndef b := 2\n").unwrap(); + assert_ne!(top, key_of(&dir, &material, "Top")); + assert_eq!(other, key_of(&dir, &material, "Other")); + let top = key_of(&dir, &material, "Top"); + + // So is the module's own source and the key material. + std::fs::write( + dir.join("Top.lean"), + "import Base\nimport Wall\ndef t := 2\n", + ) + .unwrap(); + assert_ne!(top, key_of(&dir, &material, "Top")); + let top = key_of(&dir, &material, "Top"); + assert_ne!( + top, + key_of( + &dir, + &[("wall_id", "w2"), ("toolchain_version", "t")], + "Top" + ) + ); + + // A wall source is fixed by the material, not read. + std::fs::write(dir.join("Wall.lean"), "def w := 1\n").unwrap(); + assert_eq!(top, key_of(&dir, &material, "Top")); + let _ = std::fs::remove_dir_all(dir); + } + + #[test] + fn module_outputs_round_trip_and_a_corrupted_entry_is_dropped() { + let build = module_dir("build"); + let store = module_dir("store"); + let outputs = module_output_files("Nested/Mod"); + for relative in &outputs { + let path = build.join(relative); + std::fs::create_dir_all(path.parent().unwrap()).unwrap(); + std::fs::write(&path, relative.as_bytes()).unwrap(); + } + let entry = store.join("key"); + publish_module(&entry, &build, "Nested/Mod").unwrap(); + + let fresh = module_dir("fresh"); + restore_module(&entry, &fresh, "Nested/Mod").unwrap(); + for relative in &outputs { + assert_eq!( + std::fs::read(fresh.join(relative)).unwrap(), + relative.as_bytes() + ); + } + + // A module without its olean and trace is never published. + let partial = module_dir("partial"); + let olean = partial.join(&outputs[0]); + std::fs::create_dir_all(olean.parent().unwrap()).unwrap(); + std::fs::write(&olean, b"olean").unwrap(); + assert!(publish_module(&store.join("partial"), &partial, "Nested/Mod").is_err()); + + // A changed file fails the integrity manifest: nothing is restored + // and the entry is removed. + std::fs::write(entry.join("files").join(&outputs[0]), b"tampered").unwrap(); + let again = module_dir("again"); + assert!(restore_module(&entry, &again, "Nested/Mod").is_err()); + assert!(!again.join(&outputs[0]).exists()); + assert!(!entry.exists()); + for dir in [build, store, fresh, partial, again] { + let _ = std::fs::remove_dir_all(dir); + } + } } diff --git a/aver-cert/src/checker_audit.lean b/aver-cert/src/checker_audit.lean new file mode 100644 index 000000000..e08b3fad6 --- /dev/null +++ b/aver-cert/src/checker_audit.lean @@ -0,0 +1,379 @@ +-- Authored by aver-cert; never accepted from the certificate. +-- +-- The checker's audit program. It is elaborated with only the Lean toolchain +-- in scope: no certificate module is imported while this file is elaborated, +-- so nothing a package declares (an instance, a notation, a name in some +-- namespace) can change what the code below computes. At run time it loads +-- the built `CheckerWitness` environment and inspects it. +import Lean + +namespace AverCertAudit + +open Lean + +/-- The certificate package's own modules (validated module roots). -/ +def packageModules : List Name := @PACKAGE_MODULES@ + +/-- The axiom whitelist. -/ +def allowed : List Name := @ALLOWED@ + +/-- Roots whose closure must stay inside the whitelist: the accepted + artifact and every report pin. -/ +def strictRoots : List Name := @STRICT_ROOTS@ + +/-- Every record a bridge encoder reads, with the accessors it lists. -/ +def recordShapes : List (Name × List Name) := @RECORDS@ + +/-- Every sum a bridge encoder matches on, with the constructors it lists and + the number of fields it encodes for each. -/ +def sumShapes : List (Name × List (Name × Nat)) := @SUMS@ + +/-- The namespace roots the wall and the checker declare in. A package + declares nothing under them. -/ +def wallRoots : List Name := @WALL_ROOTS@ + +/-- The only constants a package declares directly under `AverCert`: the + manifest's `subject` and `manifest`. -/ +def packageAverCertLeaves : List Name := @PACKAGE_AVERCERT_LEAVES@ + +/-- The only namespaces under `AverCert` a package declares in: its plans, + byte facts, final theorem, bridges and law corollaries. -/ +def packageAverCertChildren : List Name := @PACKAGE_AVERCERT_CHILDREN@ + +/-- Why the package constant `n` is refused for where it is declared, if it + is. A package name under a wall namespace, or one nesting `AverCert` + below its first component, is where a dotted reference in the wall or the + witness could resolve first, since Lean tries the innermost enclosing + namespace before the root. Under `AverCert` the admitted names are exact + shapes: `AverCert.manifest`, `AverCert.subject`, and names at least one + component deep in a producer namespace. The caller exempts exactly two + kinds of package constant from this rule: a private constant, and a + `leanAuxiliary` one. -/ +def namespaceRefusal (n : Name) : Option String := + match n.eraseMacroScopes.components with + | [] => none + | first :: rest => + if rest.any (fun c => c == `AverCert || c == `AverCertChecker) then + some s!"a certificate module declares {n}, which nests a checker namespace" + else if first == `AverCert then + match rest with + | [leaf] => + if packageAverCertLeaves.contains leaf then none + else some s!"a certificate module declares {n} inside the checker's AverCert namespace" + | second :: _ :: _ => + if packageAverCertChildren.contains second then none + else some s!"a certificate module declares {n} inside the checker's AverCert namespace" + | [] => some s!"a certificate module declares {n} inside the checker's AverCert namespace" + else if wallRoots.contains first then + some s!"a certificate module declares {n} inside the checker's {first} namespace" + else none + +/-- The longest proper prefix of `n` that is itself a declared constant, if + any. Lean resolves a dotted identifier to the longest prefix that is a + constant and reads the rest as fields, so a package constant + `AverCert.manifest.subject` is what `AverCert.manifest.subject.contracts` + would mean. The witness reads every field through a wall projection + function; this refusal keeps a second layer under that. -/ +def extendedConstant (env : Environment) (n : Name) : Option Name := Id.run do + let mut p := n.getPrefix + for _ in [0:n.getNumParts] do + if p.isAnonymous then return none + if env.contains p then return some p + p := p.getPrefix + return none + +/-- Whether `s` is ``, where `k` is digits, possibly joined by + underscores (`match_1_1`), and starts with a digit. -/ +def numberedAs (stem s : String) : Bool := + let rest := s.toList.drop stem.length + s.startsWith stem && + (match rest with + | c :: _ => c.isDigit + | [] => false) && + rest.all (fun c => c.isDigit || c == '_') + +/-- Whether the last component of `n` is `proof_`, `match_` or + `eq_`, the names Lean gives an abstracted proof, a matcher and an + equation lemma. (The environment the audit imports does not rebuild the + matcher extension's state, so a matcher is recognised by its name.) -/ +def numberedAuxiliary : Name → Bool + | .str _ s => numberedAs "proof_" s || numberedAs "match_" s || numberedAs "eq_" s + | _ => false + +/-- Whether the last component of `n` is `eq_def` or `eq_unfold`, the + names of the unfolding lemmas Lean realizes for a definition. -/ +def unfoldAuxiliary : Name → Bool + | .str _ s => s == "eq_def" || s == "eq_unfold" + | _ => false + +/-- Whether `n` is an auxiliary Lean itself declares beside the constant + `n.getPrefix`. Two cases: + * beside a constant the package does NOT declare (a wall or core + constant), a reserved name such as an equation lemma. That parent + existed before every package module, and Lean refuses a user + declaration of a reserved name whose parent exists, so such a + constant can only have been realized by Lean, in the package module + that first unfolded the parent. (Beside a package constant a reserved + name is not exempt on that ground: a package can declare `V.h.eq_1` + itself before it declares `V.h`.) + * beside a constant the package declares, an internal (`_`-prefixed) + compiler constant, an abstracted `proof_`, a matcher `match_`, + an equation `eq_`, or an unfolding lemma `eq_def` or `eq_unfold`, + recognised by name alone. + None of these is a field name a wall structure has, so no field read + can land on one. -/ +def leanAuxiliary (env : Environment) (inPkg : Name → Bool) (n : Name) : Bool := + let parent := n.getPrefix + env.contains parent && + (if inPkg parent then n.isInternal || numberedAuxiliary n || unfoldAuxiliary n + else isReservedName env n) + +/-- Every bridged law's statement definition in the witness, with the model + constants its bridges are about. -/ +def lawModelUses : List (Name × List Name) := @LAW_MODEL_USES@ + +def lawRoots : List Name := @LAW_ROOTS@ +def bridgedLawRoots : List Name := @BRIDGED_LAW_ROOTS@ +def bridgeRoots : List Name := @BRIDGE_ROOTS@ + +/-- Classes whose instances carry proofs, not choices: an instance of one of + these cannot make a proposition mean something else, and a false one + needs an axiom the audit sees. Admitted at any type. -/ +def proofClasses : List Name := + [``Decidable, ``DecidableEq, ``DecidableRel, ``DecidablePred, ``Nonempty, + ``ReflBEq, ``LawfulBEq] + +/-- Data classes admitted only at a type the package itself declares as an + inductive type: `==`, a default value, and the `SizeOf` instance Lean + generates for every inductive type, of the model's own records and sums. -/ +def ownTypeClasses : List Name := [``Inhabited, ``BEq, ``SizeOf] + +def decline (reason : String) : IO UInt32 := do + IO.println ("@DECLINE_MARKER@ " ++ reason) + return 1 + +def moduleOf (env : Environment) (n : Name) : Option Name := + match env.getModuleIdxFor? n with + | some idx => env.header.moduleNames[idx.toNat]? + | none => none + +def inPackage (env : Environment) (n : Name) : Bool := + match moduleOf env n with + | some m => packageModules.contains m + | none => false + +def axiomsOf (env : Environment) (n : Name) : IO (Array Name) := do + let (axs, _) ← (collectAxioms n : CoreM (Array Name)).toIO + { fileName := "", fileMap := default } { env := env } + return axs + +def runMeta (env : Environment) (x : MetaM α) : IO α := do + let (a, _) ← (x.run' {} {}).toIO + { fileName := "", fileMap := default } { env := env } + return a + +/-- Whether the type of the declaration `n` ends in `Prop` (it is a + proposition former, e.g. a structure or an inductive in `Prop`). -/ +def isPropFormer (env : Environment) (type : Expr) : IO Bool := + runMeta env (Meta.forallTelescopeReducing type fun _ body => return body.isProp) + +/-- Why a record encoder is refused, if it is: the type must be a structure + outside `Prop`, the encoder must list exactly its fields in declaration + order, and no field may be a proof. A proof field (`h : False`) or an + unlisted field would let a bridge quantify over values the plan never + sees, or over none at all. -/ +def recordRefusal (env : Environment) (ty : Name) (fields : List Name) : IO (Option String) := do + let some info := env.find? ty | return some s!"bridge record {ty} is not declared" + unless isStructure env ty do + return some s!"bridge record {ty} is not a structure" + if ← isPropFormer env info.type then + return some s!"bridge record {ty} is a proposition" + unless (getStructureFields env ty).toList == fields do + return some s!"the bridge encoder of {ty} does not list exactly its fields in order" + for field in fields do + let some proj := getProjFnForField? env ty field + | return some s!"bridge record {ty} has no projection for {field}" + let some projInfo := env.find? proj + | return some s!"bridge record {ty} has no projection for {field}" + let proof ← runMeta env (Meta.forallTelescopeReducing projInfo.type fun _ body => Meta.isProp body) + if proof then + return some s!"bridge record {ty} has the proof field {field}" + return none + +/-- Why a sum encoder is refused, if it is: the type must be an inductive + outside `Prop` whose constructors are exactly the listed ones in order, + each with the listed number of fields, none of them a proof. -/ +def sumRefusal (env : Environment) (ty : Name) (ctors : List (Name × Nat)) : IO (Option String) := do + let some (.inductInfo info) := env.find? ty | return some s!"bridge sum {ty} is not an inductive type" + if ← isPropFormer env info.type then + return some s!"bridge sum {ty} is a proposition" + unless info.ctors == ctors.map (·.1) do + return some s!"the bridge encoder of {ty} does not list exactly its constructors in order" + for (ctor, fields) in ctors do + let some (.ctorInfo ci) := env.find? ctor | return some s!"bridge constructor {ctor} is not declared" + unless ci.numFields == fields do + return some s!"the bridge encoder of {ctor} does not encode exactly its fields" + let proof ← runMeta env (Meta.forallTelescopeReducing ci.type fun xs _ => do + let mut found := false + for x in xs.toList.drop ci.numParams do + if ← Meta.isProp (← Meta.inferType x) then found := true + return found) + if proof then + return some s!"bridge constructor {ctor} has a proof field" + return none + +/-- Whether `cls` is declared a class by the module that declares it. Read + off that module's own class-extension entries: the environment the audit + imports does not rebuild the extension's state, so `isClass` would answer + false for every imported class. -/ +def declaredClass (env : Environment) (cls : Name) : Bool := + match env.getModuleIdxFor? cls with + | some idx => (classExtension.getModuleEntries env idx).any (·.name == cls) + | none => false + +/-- The conclusion of a (non-reducing) pi telescope. -/ +def conclusion : Expr → Expr + | .forallE _ _ body _ => conclusion body + | e => e + +/-- The value an admitted core instance must have, when its class and + arguments are one of the two data instances the model prelude declares + over core types: `Coe Int Float` and `HAdd String String String`. -/ +def expectedCoreValue (cls : Name) (args : Array Expr) : Option Expr := + let one := Level.succ Level.zero + if cls == ``Coe && args.size == 2 && args[0]! == mkConst ``Int && args[1]! == mkConst ``Float then + some (mkAppN (mkConst ``Coe.mk [one, one]) + #[mkConst ``Int, mkConst ``Float, + .lam `n (mkConst ``Int) (mkApp (mkConst ``Float.ofInt) (.bvar 0)) .default]) + else if cls == ``HAdd && args.size == 3 && args.all (· == mkConst ``String) then + some (mkAppN (mkConst ``HAdd.mk [Level.zero, Level.zero, Level.zero]) + #[mkConst ``String, mkConst ``String, mkConst ``String, mkConst ``String.append]) + else none + +/-- Why the instance `inst` (declared in a package module) is refused, if it + is. The class is read off the ELABORATED type: a name alias or a class + parent projection does not change the constant at its head. -/ +def instanceRefusal (env : Environment) (inst : Name) : Option String := + match env.find? inst with + | none => some s!"instance {inst} has no declaration" + | some info => + let concl := conclusion info.type + match concl.getAppFn with + | .const cls _ => + let args := concl.getAppArgs + if proofClasses.contains cls then none + else if ownTypeClasses.contains cls then + match args[0]?.map Expr.getAppFn with + | some (.const ty _) => + match env.find? ty with + | some (.inductInfo _) => + if inPackage env ty then none + else some s!"instance {inst} of {cls} is at a type the package does not declare" + | _ => some s!"instance {inst} of {cls} is not at an inductive type" + | _ => some s!"instance {inst} of {cls} is not at a named type" + else if inPackage env cls && declaredClass env cls then none + else match expectedCoreValue cls args with + | some expected => + match info.value? with + | some value => + if value == expected then none + else some s!"instance {inst} of {cls} does not have the admitted value" + | none => some s!"instance {inst} of {cls} has no value" + | none => some s!"instance {inst} of class {cls} is not admitted in a certificate" + | _ => some s!"instance {inst} has no class at its head" + +def main : IO UInt32 := do + initSearchPath (← findSysroot) + let env ← importModules #[{ module := `CheckerWitness }] {} + -- 1. Names reserved for the checker's witness. + for (name, _) in env.constants.map₁.toList do + if (`AverCertChecker).isPrefixOf name && !(moduleOf env name == some `CheckerWitness) then + return ← decline s!"a certificate module declares {name} under the checker's reserved prefix" + -- 1b. Names under the wall's and the checker's namespaces. + -- Exactly two kinds of package constant are exempt from both rules of + -- this step, because no name the wall or the witness writes resolves + -- to them: a private one (a match splitter or other auxiliary Lean + -- builds while a package proof unfolds a wall definition), which no + -- other module can name, and a `leanAuxiliary` one: a reserved name + -- (an equation lemma) realized for a wall or core constant, which + -- states that constant's own fact, or, beside a package constant, an + -- internal compiler constant or a numbered or unfolding auxiliary. + -- A package constant under `AverCert` must also not extend another + -- declared constant's name, since a dotted reference to that constant's + -- fields would resolve to it. + for (name, _) in env.constants.map₁.toList do + if inPackage env name then + let auxiliary := isPrivateName name || leanAuxiliary env (inPackage env) name + unless auxiliary do + if let some reason := namespaceRefusal name then + return ← decline reason + if name.getRoot == `AverCert then + if let some parent := extendedConstant env name then + return ← decline s!"a certificate module declares {name}, which extends the declared constant {parent}, so a field read of {parent} could resolve to it" + -- 2. Parser extensions and instances declared by package modules. + for m in packageModules do + match env.getModuleIdx? m with + | none => pure () + | some idx => + unless (Parser.parserExtension.ext.getModuleEntries env idx).isEmpty do + return ← decline s!"certificate module {m} extends the parser (notation, syntax or an operator)" + for entry in Meta.instanceExtension.ext.getModuleEntries env idx do + match entry with + | .scoped ns _ => + return ← decline s!"certificate module {m} declares a scoped instance in {ns}" + | .global e => + match e.globalName? with + | none => return ← decline s!"certificate module {m} declares an anonymous instance" + | some inst => + match instanceRefusal env inst with + | some reason => return ← decline reason + | none => pure () + -- 3. The shapes the bridge encoders read. + for (ty, fields) in recordShapes do + if let some reason ← recordRefusal env ty fields then + return ← decline reason + for (ty, ctors) in sumShapes do + if let some reason ← sumRefusal env ty ctors then + return ← decline reason + -- 3b. The law statements. The witness elaborates them at the root, where a + -- `_root_.`-spelled model name is exactly the root constant, whatever + -- else the package declares; this re-checks the outcome on the + -- elaborated terms: each bridged law's statement must use every model + -- constant its bridges are about. + for (stmt, models) in lawModelUses do + let some info := env.find? stmt + | return ← decline s!"the witness does not declare {stmt}" + let some value := info.value? + | return ← decline s!"the law statement {stmt} has no value" + let used := value.getUsedConstants + for model in models do + unless used.contains model do + return ← decline s!"the law statement {stmt} does not use the bridged model {model}" + -- 4. The accepted root and the report pins: whitelisted axioms only. + for root in strictRoots do + if (env.find? root).isNone then + return ← decline s!"the witness does not declare {root}" + for used in ← axiomsOf env root do + unless allowed.contains used do + return ← decline s!"non-whitelisted axiom: {used} (under {root})" + -- 5. Per-claim audit lines, read back by the checker. + for root in lawRoots ++ bridgedLawRoots ++ bridgeRoots do + if (env.find? root).isNone then + return ← decline s!"the witness does not declare {root}" + let audit (marker : String) (roots : List Name) : IO Unit := do + for root in roots do + let offending := (← axiomsOf env root).filter (fun used => !allowed.contains used) + if offending.isEmpty then + IO.println s!"{marker} {root} ok" + else + let names := ",".intercalate (offending.toList.map Name.toString) + IO.println s!"{marker} {root} axioms {names}" + audit "@LAW_MARKER@" lawRoots + audit "@BRIDGED_LAW_MARKER@" bridgedLawRoots + audit "@BRIDGE_MARKER@" bridgeRoots + IO.println "@OK_MARKER@" + return 0 + +end AverCertAudit + +def main : IO UInt32 := AverCertAudit.main diff --git a/aver-cert/src/engine/analysis.rs b/aver-cert/src/engine/analysis.rs deleted file mode 100644 index 9c7d1da65..000000000 --- a/aver-cert/src/engine/analysis.rs +++ /dev/null @@ -1,1875 +0,0 @@ -/// Classification of every user function in the module. -pub struct Analysis { - certs: Vec, - declined: Vec<(String, String)>, - module_envelope: ModuleEnvelopeFacts, - carrier: Option, - contracts: Vec, - /// The strict byte-derived host-role table (S1 criteria: carrier-binop - /// signature + strict first-i64-arith + uniqueness, fail-closed to `None` - /// per role). The Int-face dispatch plan gate requires every role index a - /// plan claim would cite to be confirmed by THIS table; the coarse - /// `host_roles` marker map alone would assign a both-ops helper by its - /// first arithmetic instead of rejecting it as ambiguous. - frag_host_table: FragHostTable, - /// String.eq/String.concat helpers, ordered by wasm function index. Unlike - /// add/sub, each matching helper is retained independently (no uniqueness - /// decline), exactly as the Rust classifier and audited kernel classifier do. - string_host_roles: StringHostRoles, - /// Declarable ADT envelopes by constructor type index. User-ADT claims - /// declare an envelope from this table; a claim whose ADT is not - /// extractable declines during analysis (fail-closed). - declared_envelopes: DeclaredEnvelopes, -} - -impl Analysis { - /// The strict byte-derived host-role table, for renderers that state a - /// table-driven obligation host (the compute face). - pub(crate) fn frag_host_table(&self) -> &FragHostTable { - &self.frag_host_table - } - - pub fn certified_names(&self) -> Vec { - self.certs.iter().map(|c| c.name().to_string()).collect() - } - pub fn declined(&self) -> &[(String, String)] { - &self.declined - } -} - -/// Collect the tags the checked cascade tests, in dispatch order. -fn int_dispatch_test_tags(body: &IntDispatchCascade) -> Vec { - let mut tags = Vec::new(); - let mut cursor = body; - while let IntDispatchCascade::Test { ty_idx, rest, .. } = cursor { - tags.push(*ty_idx); - cursor = rest; - } - tags -} - -/// Collect the tags the checked cascade tests, in dispatch order, with whether -/// each arm BINDS a payload (`Proj`/`HostOp`) or is a `Const` (nullary) arm that -/// reads no field. A binding arm's tag must be a declared Int-payload (`hit`) -/// constructor; a const arm's tag need only be a declared constructor of any -/// shape (mirrors the wall's leaf-aware `dCascadeInEnv`). -fn int_dispatch_test_arms(body: &IntDispatchCascade) -> Vec<(u32, bool)> { - let mut arms = Vec::new(); - let mut cursor = body; - while let IntDispatchCascade::Test { ty_idx, hit, rest } = cursor { - let binds = !matches!(hit, IntDispatchLeaf::Const { .. }); - arms.push((*ty_idx, binds)); - cursor = rest; - } - arms -} - -/// Fail-closed declared-envelope gate for user-ADT claims: an Int-dispatch or -/// named-ADT constructor certificate is kept only when its ADT's envelope is -/// extractable and the claim's byte-pinned indices are declared hit -/// constructors of that envelope. Everything else keeps its existing route. -fn declared_envelope_gate( - c: &Cert, - model_info: &ModelInfo, - frag_host_table: FragHostTable, - envelopes: &DeclaredEnvelopes, -) -> Result<(), String> { - match c.inner() { - Cert::VariantDispatch { .. } | Cert::WidenedIntMatch { .. } => { - let plan = int_dispatch_plan_from_cert(c, frag_host_table).ok_or_else(|| { - "declared-envelope gate: no byte-matching int-dispatch plan".to_string() - })?; - let arms = int_dispatch_test_arms(&plan.body); - let (first, _) = *arms.first().ok_or_else(|| { - "declared-envelope gate: dispatch plan tests no variant".to_string() - })?; - let envelope = envelopes.for_ctor(first).ok_or_else(|| { - "user ADT layout is outside the declarable envelope vocabulary; declined" - .to_string() - })?; - let hits = envelope.hit_indices(); - for (tag, binds) in &arms { - if *binds { - // Payload-binding arm: the tag must be a declared Int-payload - // (`hit`) constructor, since the arm projects its field. - if !hits.contains(tag) { - return Err(format!( - "dispatch tests variant {tag} which is not a declared Int-payload constructor; declined" - )); - } - } else { - // Const (nullary) arm: reads no field, so the tag need only be - // a declared constructor of any shape. - if !envelope.ctors.iter().any(|c| c.idx == *tag) { - return Err(format!( - "dispatch tests variant {tag} which is not a declared constructor; declined" - )); - } - } - } - Ok(()) - } - Cert::AdtConstructor { struct_idx, .. } - if adt_constructor_uses_model(c, model_info) => - { - let envelope = envelopes.for_ctor(*struct_idx).ok_or_else(|| { - "user ADT layout is outside the declarable envelope vocabulary; declined" - .to_string() - })?; - if !envelope.hit_indices().contains(struct_idx) { - return Err(format!( - "constructed variant {struct_idx} is not a declared Int-payload constructor; declined" - )); - } - Ok(()) - } - _ => Ok(()), - } -} - -/// Disassemble the emitted module and classify each user function. `model_files` -/// are the reused `aver proof` Lean model; the recursion classifier reads the -/// combinator operator (`+`/`*`) from them since the bytes cannot tell the bignum -/// helpers apart. -pub fn analyze(wasm_bytes: &[u8], model_files: &[(String, String)]) -> Result { - analyze_with_fragment_plans(wasm_bytes, model_files, &[]) -} - -pub fn analyze_with_fragment_plans( - wasm_bytes: &[u8], - model_files: &[(String, String)], - fragment_plans: &[FragmentPlanArtifact], -) -> Result { - analyze_for_target_with_fragment_plans( - wasm_bytes, - model_files, - fragment_plans, - crate::format::TARGET_WASM_GC, - ) -} - -/// Analyze a core module under the exact host-import registry selected by the -/// delivered artifact target. wasip2 still analyzes only its byte-exact -/// embedded core; the target affects capability admission, not body claims. -pub fn analyze_for_target_with_fragment_plans( - wasm_bytes: &[u8], - model_files: &[(String, String)], - fragment_plans: &[FragmentPlanArtifact], - artifact_target: &str, -) -> Result { - let (user_fns, box_idx, user_idx_set, carrier, host_roles, frag_host_table, struct_field_counts) = - disassemble(wasm_bytes)?; - let string_host_roles = string_host_roles(&host_roles); - let model_ops = model_step_ops(model_files); - let model_info = ModelInfo::from_files(model_files); - - // Index the user functions so the composition pass can walk the call graph. - let fns: std::collections::HashMap = - user_fns.iter().map(|f| (f.wasm_idx, f)).collect(); - let user_names: std::collections::HashSet<&str> = - user_fns.iter().map(|f| f.name.as_str()).collect(); - let mut producer_plans = std::collections::HashMap::<&str, &FragmentPlan>::new(); - for artifact in fragment_plans { - if !user_names.contains(artifact.export_name.as_str()) { - return Err(format!( - "producer supplied fragment plan for unknown export `{}`", - artifact.export_name - )); - } - if producer_plans - .insert(artifact.export_name.as_str(), &artifact.plan) - .is_some() - { - return Err(format!( - "producer supplied duplicate fragment plan for `{}`", - artifact.export_name - )); - } - } - - let mut certs = Vec::new(); - let mut declined = Vec::new(); - for f in &user_fns { - if let Some(plan) = producer_plans.get(f.name.as_str()) { - let checked = match plan { - FragmentPlan::Sym(plan) => { - check_sym_fragment_plan_object(wasm_bytes, &f.name, (*plan).clone()) - } - FragmentPlan::Expr(plan) => { - check_expr_fragment_plan_object(wasm_bytes, &f.name, (*plan).clone()) - } - }; - match checked { - Ok((_func_order, cert, true, _reason)) => certs.push(cert), - Ok((_func_order, _cert, false, reason)) => declined.push(( - f.name.clone(), - format!( - "producer fragment plan does not match emitted wasm: {}", - reason.unwrap_or_else(|| "unknown mismatch".to_string()) - ), - )), - Err(reason) => declined.push(( - f.name.clone(), - format!("producer fragment plan rejected: {reason}"), - )), - } - continue; - } - match classify_without_expr_fragment( - f, - box_idx, - carrier, - &user_idx_set, - &fns, - &ClassifierContext { - host_roles: &host_roles, - struct_field_counts: &struct_field_counts, - model_ops: &model_ops, - }, - ) { - Ok(c) => { - if has_complete_artifact_plan(&c, &model_info, frag_host_table) { - certs.push(c); - } else { - declined.push(( - f.name.clone(), - "classified certificate has no byte-matching artifact plan; declined before rendering" - .to_string(), - )); - } - } - Err(reason) => declined.push((f.name.clone(), reason)), - } - } - - // Declared-envelope gate: user-ADT claims must be declarable against the - // module's type section or they decline before rendering. - let declared_envelopes = collect_declared_envelopes(wasm_bytes, carrier)?; - let mut gated_certs = Vec::new(); - for c in certs { - match declared_envelope_gate(&c, &model_info, frag_host_table, &declared_envelopes) { - Ok(()) => gated_certs.push(c), - Err(reason) => declined.push((c.name().to_string(), reason)), - } - } - let certs = gated_certs; - - // Qualified-model-name gate: every class whose generated Lean cites the - // source model by name must resolve that name to the identifier that - // actually exists in the emitted model module — the export name itself at - // entry level, the dotted namespace form for a dependency-module function. - // An export whose citation cannot be derived declines here (fail-closed) - // instead of rendering a name Lean would reject. - let mut named_certs = Vec::new(); - for c in certs { - match model_citation_gate(&c, &model_info) { - Ok(()) => named_certs.push(c), - Err(reason) => declined.push((c.name().to_string(), reason)), - } - } - let certs = named_certs; - - // Named runtime contracts actually consumed by the certified functions. - let contracts = runtime_contracts_for_certs(&certs); - let certified = certs - .iter() - .map(|cert| (cert.name().to_string(), cert.self_idx())) - .collect::>(); - let module_envelope = - collect_module_envelope_facts(wasm_bytes, &certified, artifact_target)?; - - Ok(Analysis { - certs, - declined, - module_envelope, - carrier, - contracts, - frag_host_table, - string_host_roles, - declared_envelopes, - }) -} - -/// Every export name this certificate's renderers cite as a MODEL identifier -/// in generated Lean. Classes that cite no model function (verbatim packs, -/// field projections, string leaves, envelope-modeled dispatch/constructors, -/// plan-modeled fragments) require nothing here; their per-class lookups -/// already skip or decline on a miss. -fn model_citation_names(c: &Cert) -> Vec { - match c.inner() { - Cert::Recursive { name, .. } | Cert::AccumulatorRecursive { name, .. } => { - vec![name.clone()] - } - // The bridge's simultaneous fuel induction cites EVERY member's model. - Cert::MutualRecursion { scc, .. } => { - scc.iter().map(|member| member.name.clone()).collect() - } - // The composition model and its simp set cite the root and every - // closure member. - Cert::Composition { name, closure, .. } => std::iter::once(name.clone()) - .chain(closure.iter().map(|entry| entry.name.clone())) - .collect(), - // Audited integer/Bool fragments state `model := `; - // plan-modeled (float) fragments cite no model name. The Int selection - // face is wall-modeled (`intSelectModel` names no source function) and - // the compute face IS the plan (`recordComputeModel`), so both cite - // nothing even though their types sit inside the audited gate. - Cert::ExprFragment { name, .. } - if c.int_cmp_face().is_none() - && c.record_compute_face().is_none() - && expr_fragment_uses_audited_generic(c) => - { - vec![name.clone()] - } - _ => Vec::new(), - } -} - -/// Fail-closed: decline any cert whose model citation cannot be derived. -fn model_citation_gate(c: &Cert, model_info: &ModelInfo) -> Result<(), String> { - for name in model_citation_names(c) { - if model_info.model_lean_name(&name).is_none() { - return Err(format!( - "model identifier for `{name}` cannot be resolved to a definition \ - in the emitted Lean model; declined" - )); - } - } - Ok(()) -} - -fn has_complete_artifact_plan( - c: &Cert, - model_info: &ModelInfo, - frag_host_table: FragHostTable, -) -> bool { - match c.inner() { - Cert::ExprFragment { .. } => true, - Cert::StringEqVerbatimMatch { .. } => string_eq_plan_from_cert(c).is_some(), - Cert::StringConcatVerbatimMatch { .. } => string_concat_plan_from_cert(c).is_some(), - Cert::Recursive { .. } | Cert::AccumulatorRecursive { .. } => { - recursion_plan_from_cert(c).is_some() - } - Cert::MutualRecursion { .. } => mutual_plan_from_cert(c).is_some(), - Cert::Composition { .. } => composition_plans_from_cert(c, frag_host_table).is_some(), - Cert::VerbatimWidenedMatch { .. } | Cert::VerbatimVariantDispatch { .. } => { - verbatim_plan_from_cert(c).is_some() - } - Cert::VariantDispatch { .. } | Cert::WidenedIntMatch { .. } => { - int_dispatch_plan_from_cert(c, frag_host_table).is_some() - } - Cert::AdtConstructor { .. } => { - adt_constructor_sym_plan_from_cert(c, model_info).is_some() - && construct_plan_from_cert(c).is_some() - } - Cert::FieldProjection { .. } => field_projection_plan_from_cert(c).is_some(), - Cert::NonRecursive { .. } => unreachable!(), - } -} - -fn runtime_contracts_for_certs<'a>(certs: impl IntoIterator) -> Vec { - let mut contracts = Vec::new(); - let mut has_box = false; - let mut has_add = false; - let mut has_sub = false; - let mut has_mul = false; - let mut has_string_eq = false; - let mut has_string_concat = false; - let mut has_to_index = false; - let mut has_cmp = false; - let mut has_eq = false; - let mut has_add_total = false; - let mut has_sub_total = false; - let mut has_mul_total = false; - for c in certs { - if c.policy() == CertificationPolicy::SimulatesModelTotally { - has_add_total = true; - has_sub_total = true; - has_mul_total |= c.requires_mul_totality(); - } - if c.record_compute_face().is_some() { - // Twin of the wall's `useSymFragment` role accounting: disclose - // exactly the roles the encoded compute plan calls. - if let Cert::ExprFragment { plan, .. } = c.inner() { - for node in &plan.body.nodes { - if let FragNodeKind::HostCall { role, .. } = &node.kind { - match role { - FragHostRole::Box => has_box = true, - FragHostRole::Add => has_add = true, - FragHostRole::Sub => has_sub = true, - FragHostRole::Mul => has_mul = true, - FragHostRole::Cmp => has_cmp = true, - FragHostRole::Eq => has_eq = true, - FragHostRole::ToIndex => {} - } - } - } - } - continue; - } - if c.tag_dispatch_face().is_some() { - // Both arms box their Int constant (twin of the wall's - // `useFragBlockFuel` role accounting for the encoded plan). - has_box = true; - continue; - } - if c.vector_get_face().is_some() { - // The fused read calls the to-index helper and boxes the default. - has_box = true; - has_to_index = true; - continue; - } - // Each comparison face reads exactly ONE helper: `__aint_eq` for the - // equality operator, `__aint_cmp` for the three relational ones. Twin - // of the wall's `useHostRole` accounting over the encoded plan. - if let Some(face) = c.int_cmp_face() { - match face.op { - FragIntCmpOp::Eq => has_eq = true, - FragIntCmpOp::Lt | FragIntCmpOp::Gt | FragIntCmpOp::Ge => has_cmp = true, - } - continue; - } - match c.inner() { - Cert::Recursive { - combinator: Combinator::Add, - .. - } => { - has_box = true; - has_add = true; - has_sub = true; - } - Cert::Recursive { - combinator: Combinator::Mul, - .. - } => { - has_box = true; - has_mul = true; - has_sub = true; - } - Cert::AccumulatorRecursive { .. } => { - has_box = true; - has_add = true; - has_sub = true; - } - Cert::AdtConstructor { .. } - | Cert::FieldProjection { .. } - | Cert::VerbatimWidenedMatch { .. } - | Cert::VerbatimVariantDispatch { .. } - | Cert::ExprFragment { .. } => {} - Cert::StringEqVerbatimMatch { .. } => { - has_string_eq = true; - } - Cert::StringConcatVerbatimMatch { .. } => { - has_string_concat = true; - } - Cert::MutualRecursion { .. } => { - // The shared host wires box + sub (no combinator). - has_box = true; - has_sub = true; - } - Cert::WidenedIntMatch { .. } => { - has_box = true; - } - Cert::VariantDispatch { - add_idx, sub_idx, .. - } => { - has_box = true; - has_add |= add_idx.is_some(); - has_sub |= sub_idx.is_some(); - } - Cert::Composition { - has_add: a, - has_sub: s, - has_box: b, - .. - } => { - has_add |= *a; - has_sub |= *s; - has_box |= *b; - } - Cert::NonRecursive { .. } => unreachable!(), - } - } - if has_box { - contracts.push(BOX_CONTRACT.to_string()); - } - if has_add { - contracts.push(INT_ADD_CONTRACT.to_string()); - } - if has_sub { - contracts.push(INT_SUB_CONTRACT.to_string()); - } - if has_mul { - contracts.push(INT_MUL_CONTRACT.to_string()); - } - if has_string_eq { - contracts.push(STRING_EQ_CONTRACT.to_string()); - } - if has_string_concat { - contracts.push(STRING_CONCAT_CONTRACT.to_string()); - } - if has_to_index { - contracts.push(TO_INDEX_CONTRACT.to_string()); - } - if has_cmp { - contracts.push(CMP_CONTRACT.to_string()); - } - if has_eq { - contracts.push(EQ_CONTRACT.to_string()); - } - if has_add_total { - contracts.push(INT_ADD_TOTAL_CONTRACT.to_string()); - } - if has_sub_total { - contracts.push(INT_SUB_TOTAL_CONTRACT.to_string()); - } - if has_mul_total { - contracts.push(INT_MUL_TOTAL_CONTRACT.to_string()); - } - contracts -} - -#[cfg(test)] -mod analysis_without_box_helper_tests { - /// A valid module WITHOUT the `__rt_aint_from_i64` export must still - /// analyze end-to-end: `analyze` returns `Ok`, and the user export is - /// either certified by a carrier-free class or declared uncertified with a - /// readable reason — never a whole-module `Err` that aborts `--certify`. - #[test] - fn analyze_accepts_module_without_box_helper() { - let bytes = wat::parse_str( - r#"(module - (type $t (func (param i64) (result i64))) - (func $identity (type $t) local.get 0) - (export "identity" (func $identity)) -)"#, - ) - .expect("no-box-helper module WAT parses"); - let analysis = super::analyze(&bytes, &[]) - .expect("a module without the Int box helper must analyze, not abort"); - assert!( - analysis.frag_host_table.box_idx.is_none(), - "the host-role table must leave the box role unbound, never invent an index" - ); - let certified = analysis.certified_names(); - if !certified.contains(&"identity".to_string()) { - let reason = analysis - .declined() - .iter() - .find(|(name, _)| name == "identity") - .map(|(_, reason)| reason.as_str()) - .expect("identity must be declared uncertified when it does not certify"); - assert!( - reason.contains("__rt_aint_from_i64"), - "decline reason should name the missing Int carrier helpers, got: {reason}" - ); - } - } - - /// Adversarial half-runtime module: the Int carrier STRUCT TYPE exists, - /// but the `__rt_aint_from_i64` box helper export does not, so every - /// integer-family recognizer sees `carrier = Some(..)` with - /// `box_idx = None`. Each shape below drives one classify path past its - /// `carrier` admission into the `box_idx` decline: - /// - `descend` (self-recursive on the carrier) — `classify_recursion.rs` - /// (both the fueled-recursion and mutual-SCC recognizers); - /// - `dispatch` (sum-root in, scalar out, parseable straight-line body) - /// — `classify_variant_dispatch.rs` via `walk_nonrecursive`; - /// - `probe` (calls an unexported, role-free helper) — - /// `classify_structural.rs`, where the only non-host call cannot be - /// the absent box helper. - /// All three must decline fail-closed with the readable no-Int-helper - /// reason; nothing may panic, certify, or invent a box index. - #[test] - fn analyze_declines_carrier_without_box_helper_across_classify_paths() { - let bytes = wat::parse_str( - r#"(module - (type $carrier (struct (field i64) (field (ref null $carrier)) (field i32))) - (type $sum (struct (field i32))) - (func $descend (param (ref null $carrier)) (result (ref null $carrier)) - local.get 0 - call $descend) - (func $dispatch (param (ref null $sum)) (result i64) - i64.const 5) - (func $helper (param (ref null $sum)) (result i64) - i64.const 1) - (func $probe (param (ref null $sum)) (result i64) - local.get 0 - call $helper) - (func $addlike (param (ref null $carrier) (ref null $carrier)) (result (ref null $carrier)) - (local i64 i64) - local.get 2 - local.get 3 - i64.add - drop - local.get 0) - (export "descend" (func $descend)) - (export "dispatch" (func $dispatch)) - (export "probe" (func $probe)) -)"#, - ) - .expect("carrier-without-box-helper module WAT parses"); - let analysis = super::analyze(&bytes, &[]) - .expect("a carriered module without the box helper must analyze, not abort"); - assert!( - analysis.carrier.is_some(), - "the fixture deliberately carries the Int carrier struct type" - ); - assert!( - analysis.frag_host_table.box_idx.is_none(), - "no `__rt_aint_from_i64` export means no box role, ever" - ); - assert!( - analysis.frag_host_table.add_idx.is_some(), - "the byte-derived add role binds independently of the box helper" - ); - assert!( - analysis.certified_names().is_empty(), - "no integer-family shape may certify without the box helper, got {:?}", - analysis.certified_names() - ); - for export in ["descend", "dispatch", "probe"] { - let reason = analysis - .declined() - .iter() - .find(|(name, _)| name == export) - .map(|(_, reason)| reason.as_str()) - .unwrap_or_else(|| panic!("`{export}` must be declared uncertified")); - assert!( - reason.contains("__rt_aint_from_i64"), - "`{export}` must decline with the no-Int-helper reason, got: {reason}" - ); - } - } -} - -#[cfg(test)] -mod poisoned_role_scan_tests { - /// A module WITH the `__rt_aint_from_i64` export and one carrier-binop- - /// signature function whose body starts with an instruction encoding the - /// certificate decoder's role scan does not support (`ref.as_non_null`). - const POISONED_WAT: &str = r#"(module - (type $carrier (struct (field i64) (field anyref) (field i32))) - (func $box (param i64) (result (ref null $carrier)) - local.get 0 - ref.null any - i32.const 0 - struct.new $carrier) - (func $add (param (ref null $carrier) (ref null $carrier)) (result (ref null $carrier)) - local.get 0 - struct.get $carrier 0 - local.get 1 - struct.get $carrier 0 - i64.add - ref.null any - i32.const 0 - struct.new $carrier) - (func $unrelated (param (ref null $carrier) (ref null $carrier)) (result (ref null $carrier)) - local.get 0 - ref.as_non_null) - (export "__rt_aint_from_i64" (func $box)) -)"#; - - /// A module carrying the Int box helper whose module-wide role scan the - /// certificate decoder cannot complete has NO manifest declaration that - /// satisfies its acceptance pin. The producer must refuse it outright — - /// emitting the package would only defer the failure to verification. - #[test] - fn analyze_refuses_box_helper_module_with_unscannable_carrier_binop_body() { - let bytes = wat::parse_str(POISONED_WAT).expect("poisoned module WAT parses"); - let error = match super::analyze(&bytes, &[]) { - Err(error) => error, - Ok(_) => { - panic!("a box-helper module with an unscannable carrier-binop body must be refused") - } - }; - assert!( - error.contains("__rt_aint_from_i64"), - "the refusal must name the box helper, got: {error}" - ); - assert!( - error.contains("role scan") && error.contains("function index 2"), - "the refusal must name the failed role scan and the offending function, got: {error}" - ); - } - - /// Control: the same module without the unscannable function analyzes and - /// binds its box and add roles. - #[test] - fn analyze_accepts_box_helper_module_when_every_carrier_binop_body_scans() { - let healthy = POISONED_WAT.replace( - r#" (func $unrelated (param (ref null $carrier) (ref null $carrier)) (result (ref null $carrier)) - local.get 0 - ref.as_non_null) -"#, - "", - ); - assert_ne!(healthy, POISONED_WAT, "the control must drop the poisoned function"); - let bytes = wat::parse_str(&healthy).expect("healthy module WAT parses"); - let analysis = super::analyze(&bytes, &[]) - .expect("the healthy sibling must analyze"); - assert_eq!(analysis.frag_host_table.box_idx, Some(0)); - assert_eq!(analysis.frag_host_table.add_idx, Some(1)); - } - - /// Without the box helper export the module-wide table is byte-provably - /// absent, so an unscannable carrier-binop body is NOT the poisoned state: - /// analysis proceeds and every integer-family recognizer declines - /// per-export as usual. - #[test] - fn analyze_accepts_unscannable_body_when_box_helper_is_absent() { - let helperless = POISONED_WAT.replace(" (export \"__rt_aint_from_i64\" (func $box))\n", ""); - assert_ne!(helperless, POISONED_WAT, "the control must drop the helper export"); - let bytes = wat::parse_str(&helperless).expect("helperless module WAT parses"); - let analysis = super::analyze(&bytes, &[]) - .expect("a module without the box helper is never in the poisoned state"); - assert!(analysis.frag_host_table.box_idx.is_none()); - } -} - -// These historical tests compile Aver source through the producer and cannot -// live in the independent engine crate. Their end-to-end coverage remains in -// aver-lang's certificate integration suites; engine-only tests are colocated -// with the extracted modules. -#[cfg(any())] -mod analysis_tests { - use super::*; - - fn compile_float_probe(source: &str) -> crate::codegen::wasm_gc::WasmGcCompileOutput { - let mut items = crate::source::parse_source( - source, - ) - .expect("source parses"); - let pipeline = crate::ir::pipeline::run( - &mut items, - crate::ir::PipelineConfig { - typecheck: Some(crate::ir::TypecheckMode::Full { base_dir: None }), - ..Default::default() - }, - ); - assert!( - pipeline - .typecheck - .as_ref() - .is_none_or(|tc| tc.errors.is_empty()), - "probe source should typecheck" - ); - crate::codegen::wasm_gc::compile_to_wasm_gc_with_handler_and_cert_plans( - &items, None, None, - ) - .expect("probe compiles to wasm-gc") - } - - #[test] - fn expr_fragment_certification_requires_matching_producer_plan() { - let output = compile_float_probe( - r#" -module PlanFirstProbe - intent = "plan-first producer overlay probe" - depends [] - exposes [carrierAnchor, floatLeGoal] - -fn carrierAnchor(x: Int) -> Int - ? "Keeps the shared Int carrier available to the certificate analyzer." - x + 1 - -fn floatLeGoal(a: Float, b: Float) -> Bool - ? "Small scalar comparison island." - a <= b -"#, - ); - let without_plan = analyze(&output.bytes, &[]).expect("analysis without producer plan"); - assert!( - !without_plan - .certified_names() - .contains(&"floatLeGoal".to_string()), - "expr-fragment should not be certified without a producer plan" - ); - - let checked = analyze_with_fragment_plans(&output.bytes, &[], &output.fragment_plans) - .expect("analysis with producer plan"); - assert!( - checked - .certified_names() - .contains(&"floatLeGoal".to_string()), - "matching producer plan should certify the probe" - ); - let source_plan = checked - .certs - .iter() - .find_map(|cert| match cert.inner() { - Cert::ExprFragment { - name, - source_plan, - .. - } if name == "floatLeGoal" => source_plan.as_ref(), - _ => None, - }) - .expect("source-level producer plan should be preserved on the cert"); - assert_eq!(source_plan.result, SymTy::Bool); - - let mut tampered = output - .fragment_plans - .iter() - .find(|artifact| artifact.export_name == "floatLeGoal") - .expect("producer emitted a floatLeGoal plan") - .clone(); - let FragmentPlan::Sym(sym_plan) = &mut tampered.plan else { - panic!("source-level producer should emit floatLeGoal as a SymPlan"); - }; - let mut changed = false; - for node in &mut sym_plan.body.nodes { - if let SymNodeKind::Param { index } = &mut node.kind - && *index == 0 - { - *index = 1; - changed = true; - break; - } - } - assert!(changed, "probe source plan should contain parameter zero"); - - let checked = analyze_with_fragment_plans(&output.bytes, &[], &[tampered]) - .expect("analysis should report a declined producer plan"); - assert!( - !checked - .certified_names() - .contains(&"floatLeGoal".to_string()), - "a bad producer plan must not fall back to byte-derived classification" - ); - let reason = checked - .declined() - .iter() - .find(|(name, _)| name == "floatLeGoal") - .map(|(_, reason)| reason.as_str()) - .expect("floatLeGoal should be declined"); - assert!( - reason.contains("producer fragment plan does not match emitted wasm"), - "decline reason should identify producer-plan mismatch, got: {reason}" - ); - } - - #[test] - fn float_arithmetic_result_is_declined_until_nan_results_are_relational() { - let output = compile_float_probe( - r#" -module FloatNanProfileProbe - intent = "Float NaN portability boundary probe" - depends [] - exposes [floatAddGoal, floatMulAddGoal, floatLeGoal] - -fn floatAddGoal(a: Float, b: Float) -> Float - ? "Float addition has a set-valued NaN result in general WebAssembly." - a + b - -fn floatMulAddGoal(a: Float, b: Float) -> Float - ? "Both arithmetic stages can produce a set-valued NaN result." - a * b + a - -fn floatLeGoal(a: Float, b: Float) -> Bool - ? "NaN makes the comparison false independently of its payload." - a <= b -"#, - ); - let checked = analyze_with_fragment_plans(&output.bytes, &[], &output.fragment_plans) - .expect("analysis should fail closed per Float export"); - - assert!( - checked - .certified_names() - .contains(&"floatLeGoal".to_string()), - "the deterministic Bool comparison should remain certifiable" - ); - for name in ["floatAddGoal", "floatMulAddGoal"] { - assert!( - !checked.certified_names().contains(&name.to_string()), - "{name} must not retain an exact-bit Float certificate" - ); - let reason = checked - .declined() - .iter() - .find(|(declined, _)| declined == name) - .map(|(_, reason)| reason.as_str()) - .unwrap_or_else(|| panic!("{name} should be reported source-level-only")); - assert!( - reason.contains("general Wasm allows multiple NaN sign/payload") - && reason.contains("exact-bit Float output needs a relational result model"), - "{name} should report the semantic boundary honestly, got: {reason}" - ); - } - - // The boundary must hold on the ExprFragment ENCODING of that plan - // too, not only on the SymPlan the producer emitted above: a - // certificate directory carries the encoded form, and the checker - // reads it back through its own path. - let add_plan = output - .fragment_plans - .iter() - .find(|artifact| artifact.export_name == "floatAddGoal") - .expect("producer emitted the historical Float-add plan"); - let FragmentPlan::Sym(add_sym) = &add_plan.plan else { - panic!("Float add should originate as a SymPlan"); - }; - let add_expr = add_sym - .to_expr_fragment_plan( - &FragHostTable::placeholder(), - &FragStructTable::default(), - ) - .expect("Float add encodes to the ExprFragment plan"); - let expr_error = - match check_expr_fragment_plan_object(&output.bytes, "floatAddGoal", add_expr) { - Ok((_, _, true, _)) => { - panic!("the encoded Float-add plan must not be certified") - } - Ok((_, _, false, reason)) => { - reason.expect("a declined plan states its reason") - } - Err(reason) => reason, - }; - assert!( - expr_error.contains("exact-bit Float output needs a relational result model"), - "ExprFragment checker should report the NaN boundary: {expr_error}" - ); - } - - #[test] - fn float_nan_gate_descends_into_nested_if_blocks() { - fn nested_plan(op: FragPrim) -> ExprFragmentPlan { - let arithmetic_branch = FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::F64, - kind: FragNodeKind::Local { index: 1 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::F64, - kind: FragNodeKind::Local { index: 2 }, - }, - FragNode { - id: FragValueId(2), - ty: FragTy::F64, - kind: FragNodeKind::Prim { - op, - args: vec![FragValueId(0), FragValueId(1)], - }, - }, - ], - result: FragValueId(2), - }; - let passthrough_branch = FragBlock { - nodes: vec![FragNode { - id: FragValueId(0), - ty: FragTy::F64, - kind: FragNodeKind::Local { index: 1 }, - }], - result: FragValueId(0), - }; - ExprFragmentPlan { - params: vec![FragTy::BoolI32, FragTy::F64, FragTy::F64], - result: FragTy::F64, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::BoolI32, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::F64, - kind: FragNodeKind::If { - cond: FragValueId(0), - then_block: Box::new(arithmetic_branch), - else_block: Box::new(passthrough_branch), - }, - }, - ], - result: FragValueId(1), - }, - } - } - - for op in [FragPrim::F64Add, FragPrim::F64Mul] { - assert!( - expr_fragment_needs_relational_nan_result(&nested_plan(op)), - "the exact-Float gate must inspect arithmetic inside nested If blocks" - ); - } - } - - #[test] - fn straight_line_without_producer_plan_is_source_level_only() { - let bytes = compile_probe_bytes( - r#" -module StraightLineNoPlanProbe - intent = "straight-line no-plan fail-close probe" - depends [] - exposes [addTwo] - -fn addTwo(x: Int) -> Int - ? "Add a fixed integer." - x + 2 -"#, - ); - let analysis = analyze(&bytes, &[]).expect("analysis without producer plans"); - - assert!( - !analysis.certified_names().contains(&"addTwo".to_string()), - "a straight-line integer body must not certify without its producer plan" - ); - let reason = analysis - .declined() - .iter() - .find(|(name, _)| name == "addTwo") - .map(|(_, reason)| reason.as_str()) - .expect("addTwo should be listed as source-level-only"); - assert!( - reason.contains("does not match a certified template"), - "decline reason should state why the no-plan body is source-level-only, got: {reason}" - ); - } - - /// The plan-first host-role table must bind `add` to EXACTLY the callee a - /// straight-line body actually cites. In a real bignum module the multiply - /// helper's umag loops also contain `i64.add`; the first-arithmetic rule - /// must nevertheless classify it as `Mul`, distinct from the cited `Add`. - /// This pins that the strict table never rides on index order the way the - /// removed `min()` derivation did. - #[test] - fn frag_host_table_binds_add_to_the_cited_callee() { - let mut items = crate::source::parse_source( - r#" -module RoleProbe - intent = "host role probe" - depends [] - exposes [addTwo] - -fn addTwo(x: Int) -> Int - ? "Straight-line integer arithmetic." - x + 2 -"#, - ) - .expect("source parses"); - let pipeline = crate::ir::pipeline::run( - &mut items, - crate::ir::PipelineConfig { - typecheck: Some(crate::ir::TypecheckMode::Full { base_dir: None }), - ..Default::default() - }, - ); - assert!( - pipeline - .typecheck - .as_ref() - .is_none_or(|tc| tc.errors.is_empty()), - "probe source should typecheck" - ); - let output = crate::codegen::wasm_gc::compile_to_wasm_gc_with_handler_and_cert_plans( - &items, None, None, - ) - .expect("probe compiles to wasm-gc"); - let (user_fns, box_idx, _set, _carrier, host_roles, host_table, _struct_counts) = - disassemble(&output.bytes).expect("disassemble"); - let add_two = user_fns - .iter() - .find(|f| f.name == "addTwo") - .expect("addTwo user fn"); - let [cited_box, cited_add] = add_two.calls.as_slice() else { - panic!("addTwo should cite exactly box + add, got {:?}", add_two.calls); - }; - let mul_idx = host_table - .mul_idx - .expect("the module must expose the canonical multiply helper"); - assert_eq!(host_roles.get(cited_add), Some(&HostRole::Add)); - assert_eq!(host_roles.get(&mul_idx), Some(&HostRole::Mul)); - assert_ne!(*cited_add, mul_idx, "add and mul roles must stay distinct"); - // The strict table binds box/add to exactly the cited callees. - assert_eq!(host_table.box_idx, Some(box_idx)); - assert_eq!(host_table.box_idx, Some(*cited_box)); - assert_eq!( - host_table.add_idx, - Some(*cited_add), - "the strict host-role table must bind `add` to the callee the \ - emitted body cites" - ); - } - - /// Synthetic-module template for the role-table derivation tests: an - /// optional decoy function (placed at a LOWER index than the genuine add - /// helper) plus the exact carrier-binop add helper and the named box - /// export the disassembler requires. - fn role_table_module(decoy: &str) -> Vec { - wat::parse_str(format!( - r#"(module - (type $mag (array (mut i64))) - (type $c (struct (field i64) (field (ref null $mag)) (field i32))) - (type $bin (func (param (ref null $c)) (param (ref null $c)) (result (ref null $c)))) - (type $box (func (param i64) (result (ref null $c)))) - {decoy} - (func $box (type $box) - local.get 0 ref.null $mag i32.const 0 struct.new $c) - (func $add (type $bin) - i64.const 1 i64.const 2 i64.add drop local.get 0) - (export "__rt_aint_from_i64" (func $box)) -)"# - )) - .expect("role-table module WAT parses") - } - - /// An EARLIER helper whose body is `i64.add`-shaped but whose signature is - /// not the carrier binop must never capture the `add` role: the table - /// binds the genuine helper, index order notwithstanding. - #[test] - fn frag_host_table_ignores_earlier_non_carrier_i64_add_helper() { - let bytes = role_table_module( - r#"(func $decoy (param i64) (param i64) (result i64) - local.get 0 local.get 1 i64.add)"#, - ); - let (_fns, box_idx, _set, carrier, _roles, host_table, _struct_counts) = - disassemble(&bytes).expect("disassemble"); - assert_eq!(carrier, Some(1), "carrier struct should be recognised"); - assert_eq!(host_table.box_idx, Some(box_idx)); - assert_eq!( - host_table.add_idx, - Some(2), - "the genuine carrier-binop add helper (idx 2) must win over the \ - earlier i64-shaped decoy (idx 0)" - ); - } - - /// If more than one candidate matches the strict signature + body shape, - /// the role stays UNBOUND and every plan citing it declines fail-closed — - /// the table never guesses by index order. - #[test] - fn frag_host_table_declines_ambiguous_add_candidates() { - let bytes = role_table_module( - r#"(func $decoy (type $bin) - i64.const 3 i64.const 4 i64.add drop local.get 1)"#, - ); - let (_fns, box_idx, _set, _carrier, _roles, host_table, _struct_counts) = - disassemble(&bytes).expect("disassemble"); - assert_eq!(host_table.box_idx, Some(box_idx)); - assert_eq!( - host_table.add_idx, None, - "two byte-shape-identical add candidates must leave the role \ - unbound (fail-closed), never bound by index order" - ); - } - - /// The mul helper's fast path multiplies FIRST, so `first arith == add` - /// keeps it out of the add candidacy even though its umag loops contain - /// `i64.add` (which is what earns it the coarse Add marker). - #[test] - fn frag_host_table_excludes_mul_first_bodies() { - let bytes = role_table_module( - r#"(func $decoy (type $bin) - i64.const 3 i64.const 4 i64.mul drop - i64.const 3 i64.const 4 i64.add drop - local.get 1)"#, - ); - let (_fns, _box_idx, _set, _carrier, _roles, host_table, _struct_counts) = - disassemble(&bytes).expect("disassemble"); - assert_eq!( - host_table.add_idx, - Some(2), - "a mul-first body must not compete for the add role" - ); - } - - fn compile_probe_bytes(src: &str) -> Vec { - let mut items = crate::source::parse_source(src).expect("probe source parses"); - let pipeline = crate::ir::pipeline::run( - &mut items, - crate::ir::PipelineConfig { - typecheck: Some(crate::ir::TypecheckMode::Full { base_dir: None }), - ..Default::default() - }, - ); - assert!( - pipeline - .typecheck - .as_ref() - .is_none_or(|tc| tc.errors.is_empty()), - "probe source should typecheck" - ); - crate::codegen::wasm_gc::compile_to_wasm_gc_with_handler_and_cert_plans(&items, None, None) - .expect("probe compiles to wasm-gc") - .bytes - } - - /// Admission gate: `disassemble` runs full wasm validation BEFORE any - /// rederivation, so no byte-derived fact is ever trusted from a module that - /// is not well-typed wasm. An honest module passes; a truncated one and one - /// carrying an out-of-range section id are rejected up front. - #[test] - fn disassemble_validates_module_before_rederiving() { - let honest = compile_probe_bytes(include_str!( - "../../../tools/certkit/fixtures/verbatimwiden.av" - )); - assert!( - disassemble(&honest).is_ok(), - "an honest, well-typed module must validate and disassemble" - ); - assert!( - disassemble(&honest[..honest.len() - 1]).is_err(), - "a truncated module must fail validation, not be rederived" - ); - let mut bogus = honest[..8].to_vec(); - bogus.extend_from_slice(&[0x7f, 0x01, 0x00]); - assert!( - disassemble(&bogus).is_err(), - "an out-of-range section id must fail validation, not be rederived" - ); - } - - /// Isolates the `Validator::validate_all` call itself: a module whose every - /// section is well-formed (the section parser accepts it) and which carries - /// everything `disassemble` structurally requires (the box-helper export), - /// but whose exported function is ill-typed — declared `(result i64)` with - /// a body that leaves an i32. Only full validation can reject it, so - /// dropping the `validate_all` line is exactly what makes this test fail - /// (the truncated/bad-section cases in the test above are also caught by - /// the section parser and do not isolate the validator). - #[test] - fn disassemble_rejects_parseable_but_ill_typed_module() { - // `wat` encodes without type-checking, so the ill-typed body survives - // into well-formed binary sections. - let ill_typed = wat::parse_str( - r#"(module - (type $t (func (param i64) (result i64))) - (func $box (type $t) local.get 0) - (func $bad (type $t) i32.const 0) - (export "__rt_aint_from_i64" (func $box)) - (export "bad" (func $bad)) - )"#, - ) - .expect("wat must encode the ill-typed module"); - assert!( - wasmparser::Parser::new(0) - .parse_all(&ill_typed) - .all(|p| p.is_ok()), - "the fixture must stay structurally parseable, or this test no \ - longer isolates the validator from the section parser" - ); - assert!( - disassemble(&ill_typed).is_err(), - "a parseable but ill-typed module must be rejected by validation \ - before any rederivation" - ); - } - - /// The verbatim-widened fixture's `_ -> []` default arm lowers to a - /// `ref.null` of the `List` struct type. Disassembly must thread that - /// heap-type index through `Op::RefNull` (not drop it, as the old unit - /// variant did) so the S2 grammar can re-lower the empty-list default - /// byte-exactly. The index must equal the module's List struct type — the - /// same concrete type the function's `List` result references. - #[test] - fn ref_null_threads_default_arm_heap_type() { - let bytes = compile_probe_bytes(include_str!( - "../../../tools/certkit/fixtures/verbatimwiden.av" - )); - let (user_fns, _box_idx, _set, _carrier, _roles, _table, _struct_counts) = - disassemble(&bytes).expect("disassemble"); - let wrap_items = user_fns - .iter() - .find(|f| f.name == "wrapItems") - .expect("wrapItems user fn"); - // `wrapItems` returns `List`, i.e. a concrete `(ref null $list)`. - let Some(TyKind::Ref { idx: list_idx, .. }) = wrap_items.result else { - panic!("wrapItems should return a concrete list ref"); - }; - let ref_null_hty = wrap_items - .ops - .iter() - .find_map(|op| match op { - Op::RefNull(hty) => Some(*hty), - _ => None, - }) - .expect("wrapItems `[]` default arm should lower to a ref.null"); - assert_eq!( - ref_null_hty, - Some(list_idx), - "ref.null must carry the List struct heap-type index (the `[]` \ - default's type), not drop it" - ); - } - - /// Mirror of `frag_host_table_binds_add_to_the_cited_callee` for the strict - /// `sub` binding: a straight-line integer subtraction body cites box + sub, - /// and the strict table must bind `sub` to EXACTLY that cited callee (never - /// by index order). `x - 2` lowers to `sub(x, box(2))` — the compiler does - /// not rewrite it as add-with-negated-constant, so it genuinely cites sub. - #[test] - fn frag_host_table_binds_sub_to_the_cited_callee() { - let bytes = compile_probe_bytes( - r#" -module SubRoleProbe - intent = "host sub role probe" - depends [] - exposes [subTwo] - -fn subTwo(x: Int) -> Int - ? "Straight-line integer subtraction." - x - 2 -"#, - ); - let (user_fns, box_idx, _set, _carrier, _roles, host_table, _struct_counts) = - disassemble(&bytes).expect("disassemble"); - let sub_two = user_fns - .iter() - .find(|f| f.name == "subTwo") - .expect("subTwo user fn"); - let [cited_box, cited_sub] = sub_two.calls.as_slice() else { - panic!("subTwo should cite exactly box + sub, got {:?}", sub_two.calls); - }; - assert_eq!(host_table.box_idx, Some(box_idx)); - assert_eq!(host_table.box_idx, Some(*cited_box)); - assert_eq!( - host_table.sub_idx, - Some(*cited_sub), - "the strict host-role table must bind `sub` to the callee the \ - emitted body cites" - ); - } - - /// Synthetic-module template for the `sub` role-table derivation tests: an - /// optional decoy function plus the exact carrier-binop `sub` helper (its - /// first i64 arithmetic op is `i64.sub`) and the named box export the - /// disassembler requires. Parallel to `role_table_module` (which emits an - /// `add`-shaped helper); kept separate so the `add` tests' index - /// assertions are unaffected. - fn role_table_module_sub(decoy: &str) -> Vec { - wat::parse_str(format!( - r#"(module - (type $mag (array (mut i64))) - (type $c (struct (field i64) (field (ref null $mag)) (field i32))) - (type $bin (func (param (ref null $c)) (param (ref null $c)) (result (ref null $c)))) - (type $box (func (param i64) (result (ref null $c)))) - {decoy} - (func $box (type $box) - local.get 0 ref.null $mag i32.const 0 struct.new $c) - (func $sub (type $bin) - i64.const 1 i64.const 2 i64.sub drop local.get 0) - (export "__rt_aint_from_i64" (func $box)) -)"# - )) - .expect("role-table-sub module WAT parses") - } - - /// If more than one candidate matches the strict carrier-binop signature + - /// `i64.sub`-first body shape, the `sub` role stays UNBOUND (fail-closed) — - /// the table never guesses by index order. Mirrors the `add` ambiguity test. - #[test] - fn frag_host_table_declines_ambiguous_sub_candidates() { - let bytes = role_table_module_sub( - r#"(func $decoy (type $bin) - i64.const 3 i64.const 4 i64.sub drop local.get 1)"#, - ); - let (_fns, box_idx, _set, _carrier, _roles, host_table, _struct_counts) = - disassemble(&bytes).expect("disassemble"); - assert_eq!(host_table.box_idx, Some(box_idx)); - assert_eq!( - host_table.sub_idx, None, - "two byte-shape-identical sub candidates must leave the role \ - unbound (fail-closed), never bound by index order" - ); - } - - /// Field-projection tamper matrix at the plan checker (fail-closed, no - /// lake needed): a `struct.get.user` citing a type outside the module's - /// struct context or the Int carrier is DECLINED at the checker; a wrong - /// (but real) struct type or a flipped field index survives the checker - /// but fails canonical code-entry byte equality. - #[test] - fn field_projection_plan_tampers_decline_fail_closed() { - let bytes = compile_probe_bytes( - r#" -module ProjTamperProbe - intent = "field projection tamper probe" - depends [] - exposes [User, userName, addTwo] - -record User - name: String - age: Int - -fn addTwo(x: Int) -> Int - ? "Pulls in the Int carrier and box helper." - x + 2 - -fn userName(u: User) -> String - ? "Record field projection." - u.name -"#, - ); - let (user_fns, _box_idx, _set, carrier, _roles, _table, struct_counts) = - disassemble(&bytes).expect("disassemble"); - let carrier = carrier.expect("carrier struct"); - let user_name = user_fns - .iter() - .find(|f| f.name == "userName") - .expect("userName user fn"); - let real_ty = user_name - .ops - .iter() - .find_map(|op| match op { - Op::StructGet(t, _) if *t != carrier => Some(*t), - _ => None, - }) - .expect("userName projects a user struct"); - assert_eq!( - struct_counts.get(&real_ty), - Some(&2), - "User struct should have two fields" - ); - let projection_plan = |ty_idx: u32, field: u32| ExprFragmentPlan { - params: vec![FragTy::AdtRef], - result: FragTy::AdtRef, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::AdtRef, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::AdtRef, - kind: FragNodeKind::StructGetUser { - ty_idx, - field, - value: FragValueId(0), - }, - }, - ], - result: FragValueId(1), - }, - }; - - // Baseline: the honest plan checks and matches the bytes. - let (_order, _cert, matches, reason) = - check_expr_fragment_plan_object(&bytes, "userName", projection_plan(real_ty, 0)) - .expect("honest projection plan is admitted"); - assert!(matches, "honest projection plan must match bytes: {reason:?}"); - - // (c) ty_idx outside the module's struct types -> DECLINE at checker. - let Err(err) = - check_expr_fragment_plan_object(&bytes, "userName", projection_plan(9999, 0)) - else { - panic!("out-of-module struct type must be declined") - }; - assert!( - err.contains("outside the module's struct types"), - "wrong reason for out-of-module struct type: {err}" - ); - - // The Int carrier is never a projectable user struct -> DECLINE at checker. - let Err(err) = - check_expr_fragment_plan_object(&bytes, "userName", projection_plan(carrier, 0)) - else { - panic!("carrier-typed projection must be declined") - }; - assert!( - err.contains("cites the Int carrier"), - "wrong reason for carrier projection: {err}" - ); - - // Field outside the struct's byte-derived field count -> DECLINE at checker. - let Err(err) = - check_expr_fragment_plan_object(&bytes, "userName", projection_plan(real_ty, 5)) - else { - panic!("projection past the field count must be declined at the checker") - }; - assert!( - err.contains("outside struct"), - "wrong reason for out-of-range field: {err}" - ); - - // (a) wrong (but real) struct type index -> canonical bytes differ. - let wrong_ty = struct_counts - .keys() - .copied() - .find(|t| *t != real_ty && *t != carrier) - .expect("module has another struct type"); - let (_order, _cert, matches, reason) = - check_expr_fragment_plan_object(&bytes, "userName", projection_plan(wrong_ty, 0)) - .expect("wrong-type plan is well-formed but must not match"); - assert!( - !matches, - "wrong struct type must fail canonical byte equality" - ); - assert!( - reason.unwrap_or_default().contains("code_entry_bytes_match=false"), - "wrong-type mismatch should name the byte inequality" - ); - - // (b) field index flipped 0 -> 1: well-typed, wrong bytes. - let (_order, _cert, matches, _reason) = - check_expr_fragment_plan_object(&bytes, "userName", projection_plan(real_ty, 1)) - .expect("flipped-field plan is well-formed but must not match"); - assert!( - !matches, - "flipped field index must fail canonical byte equality" - ); - - // A bad producer plan must decline, never fall back to legacy classes. - let tampered = FragmentPlanArtifact { - export_name: "userName".to_string(), - plan: FragmentPlan::Expr(projection_plan(real_ty, 1)), - }; - let checked = analyze_with_fragment_plans(&bytes, &[], &[tampered]) - .expect("analysis reports the declined producer plan"); - assert!( - !checked.certified_names().contains(&"userName".to_string()), - "tampered projection plan must not certify" - ); - let reason = checked - .declined() - .iter() - .find(|(name, _)| name == "userName") - .map(|(_, reason)| reason.as_str()) - .expect("userName should be declined"); - assert!( - reason.contains("producer fragment plan does not match emitted wasm"), - "wrong tamper decline reason: {reason}" - ); - } - - /// Source-level type names in projection plans carry the MODEL trust - /// story (producer-asserted, not byte-derivable), but they must be - /// internally CONSISTENT: a projection whose claimed owner differs from - /// its value's declared type, or a `named:` type that no projection - /// anchors to a byte-derived struct index, declines fail-closed. A fully - /// coordinated relabel remains a read-surface change (equivalent to - /// shipping a different model) — see docs/certification.md "Read surface". - #[test] - fn field_projection_source_name_inconsistency_declines() { - let bytes = compile_probe_bytes( - r#" -module ProjNameProbe - intent = "field projection source-name consistency probe" - depends [] - exposes [User, userName, addTwo] - -record User - name: String - age: Int - -fn addTwo(x: Int) -> Int - ? "Pulls in the Int carrier and box helper." - x + 2 - -fn userName(u: User) -> String - ? "Record field projection." - u.name -"#, - ); - let sym_projection_plan = |param_name: &str, owner: &str, field_ty: SymTy| SymPlan { - params: vec![SymTy::Named(param_name.to_string())], - result: field_ty.clone(), - body: SymBlock { - nodes: vec![ - SymNode { - id: SymValueId(0), - ty: SymTy::Named(param_name.to_string()), - kind: SymNodeKind::Param { index: 0 }, - }, - SymNode { - id: SymValueId(1), - ty: field_ty.clone(), - kind: SymNodeKind::ProjectField { - type_name: owner.to_string(), - field: 0, - field_ty, - value: SymValueId(0), - }, - }, - ], - result: SymValueId(1), - }, - }; - - // Baseline sanity: the consistent plan is admitted and byte-matched. - let (_o, _c, _s, matches, reason) = check_sym_fragment_plan_object( - &bytes, - "userName", - sym_projection_plan("User", "User", SymTy::String), - ) - .expect("consistent projection plan is admitted"); - assert!(matches, "consistent plan must match bytes: {reason:?}"); - - // Owner name diverging from the projected value's declared type. The - // used-name anchor rule fires first here (`User` is used but never - // projected); the owner-vs-value rule is defense-in-depth behind it. - let Err(err) = check_sym_fragment_plan_object( - &bytes, - "userName", - sym_projection_plan("User", "Other", SymTy::String), - ) else { - panic!("owner/value name mismatch must be declined") - }; - assert!( - err.contains("never projected") || err.contains("claims owner type"), - "wrong reason for owner mismatch: {err}" - ); - - // A named field type that no projection anchors to the bytes. - let Err(err) = check_sym_fragment_plan_object( - &bytes, - "userName", - sym_projection_plan("User", "User", SymTy::Named("Ghost".to_string())), - ) else { - panic!("unanchored named field type must be declined") - }; - assert!( - err.contains("`Ghost` is never projected"), - "wrong reason for unanchored name: {err}" - ); - - // A named parameter that is never projected at all. - let bare = SymPlan { - params: vec![SymTy::Named("User".to_string())], - result: SymTy::Named("User".to_string()), - body: SymBlock { - nodes: vec![SymNode { - id: SymValueId(0), - ty: SymTy::Named("User".to_string()), - kind: SymNodeKind::Param { index: 0 }, - }], - result: SymValueId(0), - }, - }; - let Err(err) = check_sym_fragment_plan_object(&bytes, "userName", bare) else { - panic!("bare named passthrough must be declined") - }; - assert!( - err.contains("never projected") || err.contains("no rendered proof face"), - "wrong reason for bare named passthrough: {err}" - ); - } - - /// An `add`-first body must not compete for the `sub` role even though it - /// contains an `i64.sub`: `first arith == sub` keeps it out of sub - /// candidacy, so the genuine `i64.sub`-first helper (idx 2) binds alone. - /// Mirrors `frag_host_table_excludes_mul_first_bodies` for the add role. - #[test] - fn frag_host_table_excludes_add_first_bodies_from_sub() { - let bytes = role_table_module_sub( - r#"(func $decoy (type $bin) - i64.const 3 i64.const 4 i64.add drop - i64.const 3 i64.const 4 i64.sub drop - local.get 1)"#, - ); - let (_fns, _box_idx, _set, _carrier, _roles, host_table, _struct_counts) = - disassemble(&bytes).expect("disassemble"); - assert_eq!( - host_table.sub_idx, - Some(2), - "an add-first body must not compete for the sub role" - ); - } -} - -#[cfg(test)] -mod decline_reason_tests { - /// A module carrying BOTH packed byte-array types: the `String` carrier the - /// runtime string bridge names, and a second one standing for a - /// byte-sequence record such as `stdlib/bytes.av`'s `exposes opaque Bytes`. - /// The two are indistinguishable by wasm type, which is exactly why the - /// decline reason used to call `Bytes_octets`'s parameter a String. - const TWO_PACKED_ARRAYS_WAT: &str = r#"(module - (type $mag (array (mut i64))) - (type $aint (struct (field (mut i64)) (field (mut (ref null $mag))) (field (mut i32)))) - (type $str (array (mut i8))) - (type $bytes (array (mut i8))) - (func $box (param i64) (result (ref null $aint)) - local.get 0 - ref.null $mag - i32.const 0 - struct.new $aint) - (func $string_to_lm (param (ref null $str)) (result i32) - local.get 0 - array.len) - (func $on_string (param (ref null $str)) (result (ref null $aint)) - local.get 0 - array.len - i64.extend_i32_u - call $box) - (func $on_bytes (param (ref null $bytes)) (result (ref null $aint)) - local.get 0 - array.len - i64.extend_i32_u - call $box) - (func $make_bytes (result (ref null $bytes)) - i32.const 0 - array.new_default $bytes) - (export "__rt_aint_from_i64" (func $box)) - (export "__rt_string_to_lm" (func $string_to_lm)) - (export "onString" (func $on_string)) - (export "onBytes" (func $on_bytes)) - (export "makeBytes" (func $make_bytes)) -)"#; - - fn decline_reason(bytes: &[u8], export: &str) -> String { - super::analyze(bytes, &[]) - .expect("module must analyze, not abort") - .declined() - .iter() - .find(|(name, _)| name == export) - .map(|(_, reason)| reason.clone()) - .unwrap_or_else(|| panic!("`{export}` must be declared uncertified")) - } - - /// The packed byte-array representation is shared by `String` and by every - /// byte-sequence record, so the wasm type alone cannot name the source - /// shape. The module's own `__rt_string_to_lm` export names which array - /// type is the string one; the other must NOT be reported as a String, in - /// either the parameter or the result reason. - #[test] - fn a_packed_byte_record_is_not_reported_as_a_string() { - let bytes = wat::parse_str(TWO_PACKED_ARRAYS_WAT).expect("two-array module WAT parses"); - - let on_string = decline_reason(&bytes, "onString"); - assert!( - on_string.contains("parameter 1 is a String"), - "the bridge-named array type is still a String: {on_string}" - ); - - let on_bytes = decline_reason(&bytes, "onBytes"); - assert!( - !on_bytes.contains("a String"), - "a packed byte record must not be called a String: {on_bytes}" - ); - assert!( - on_bytes.contains("parameter 1 is an opaque byte-sequence record"), - "the packed byte record's own shape must be named: {on_bytes}" - ); - - let make_bytes = decline_reason(&bytes, "makeBytes"); - assert!( - !make_bytes.contains("a String"), - "a packed byte record result must not be called a String: {make_bytes}" - ); - assert!( - make_bytes.contains("returns an opaque byte-sequence record"), - "the packed byte record result shape must be named: {make_bytes}" - ); - } - - /// Without the string bridge no array type is named, so nothing is - /// reclassified and every packed array keeps reading as a `String` — the - /// pre-existing answer. The refinement must never guess. - #[test] - fn packed_arrays_stay_strings_when_no_bridge_names_one() { - let no_bridge = - TWO_PACKED_ARRAYS_WAT.replace(" (export \"__rt_string_to_lm\" (func $string_to_lm))\n", ""); - let bytes = wat::parse_str(&no_bridge).expect("bridge-less module WAT parses"); - let on_bytes = decline_reason(&bytes, "onBytes"); - assert!( - on_bytes.contains("parameter 1 is a String"), - "with no bridge to name the string array, the old answer stands: {on_bytes}" - ); - } - - /// Every decline reason is a transported display string the verifier gates - /// on length before printing it, so a reason that outgrows the budget makes - /// the whole package stop checking. The two reasons this change lengthened - /// — the named callee and the byte-sequence shape — are checked against the - /// budget at their realistic worst case. - #[test] - fn lengthened_decline_reasons_fit_the_candidate_budget() { - let bytes = wat::parse_str(TWO_PACKED_ARRAYS_WAT).expect("two-array module WAT parses"); - for export in ["onString", "onBytes", "makeBytes"] { - let reason = decline_reason(&bytes, export); - assert!( - reason.len() <= crate::format::MAX_CANDIDATE_LEN, - "`{export}` reason is {} bytes, over the {} budget: {reason}", - reason.len(), - crate::format::MAX_CANDIDATE_LEN - ); - } - } - - /// A producer-asserted source type name reaches this reason as untrusted - /// display text, and one of the producer's feeds spells types with the Rust - /// `Debug` derive of the Aver compiler's own type representation. That - /// spelling must be rendered as the Aver type it stands for rather than - /// echoed at the reader. - #[test] - fn a_debug_rendered_type_name_is_shown_as_the_aver_type() { - use super::SymTy; - assert_eq!( - SymTy::display_source_type_name( - "List(Named { id: Some(TypeId(13874036260092058374)), name: \"TaskEventRecord\" })" - ), - "List" - ); - assert_eq!( - SymTy::display_source_type_name("Map(Str, Named { id: None, name: \"Task\" })"), - "Map" - ); - assert_eq!( - SymTy::display_source_type_name("Tuple([Int, Bool])"), - "Tuple" - ); - assert_eq!( - SymTy::display_source_type_name("Named { id: None, name: \"Task\" }"), - "Task" - ); - // Names already written in Aver surface syntax pass through untouched. - for name in ["Task", "List", "Map"] { - assert_eq!(SymTy::display_source_type_name(name), name); - } - } - - /// A body that calls another user function is refused for THAT, not for an - /// instruction: the call is what pulled the uncertifiable instructions in, - /// so naming `I32LeS` pointed the reader at a symptom. The callee is named, - /// and the reason still fits the format's candidate budget. - #[test] - fn a_user_call_is_reported_before_the_instruction_it_explains() { - let bytes = wat::parse_str( - r#"(module - (type $mag (array (mut i64))) - (type $aint (struct (field (mut i64)) (field (mut (ref null $mag))) (field (mut i32)))) - (func $box (param i64) (result (ref null $aint)) - local.get 0 - ref.null $mag - i32.const 0 - struct.new $aint) - (func $days_in_month (param (ref null $aint)) (result i32) - local.get 0 - struct.get $aint 2) - (func $valid_day (param (ref null $aint)) (result i32) - local.get 0 - call $days_in_month - local.get 0 - struct.get $aint 2 - i32.le_s) - (export "__rt_aint_from_i64" (func $box)) - (export "daysInMonth" (func $days_in_month)) - (export "validDay" (func $valid_day)) -)"#, - ) - .expect("user-call module WAT parses"); - - let reason = decline_reason(&bytes, "validDay"); - assert!( - reason.starts_with("calls the user function `daysInMonth`"), - "the call is the reason, and the callee is named: {reason}" - ); - assert!( - !reason.contains("I32LeS"), - "the instruction the call pulled in must not be the reason: {reason}" - ); - assert!( - reason.len() <= crate::format::MAX_CANDIDATE_LEN, - "a decline reason must fit the transported-candidate budget: {} > {}", - reason.len(), - crate::format::MAX_CANDIDATE_LEN - ); - } -} diff --git a/aver-cert/src/engine/cert_defs.rs b/aver-cert/src/engine/cert_defs.rs deleted file mode 100644 index cb14204c8..000000000 --- a/aver-cert/src/engine/cert_defs.rs +++ /dev/null @@ -1,404 +0,0 @@ -/// Policy presets carried by the Rust manifest schema and independently -/// re-derived by `aver cert verify` from the classified artifact bytes. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum CertificationPolicy { - SimulatesModel, - SimulatesModelTotally, -} - -impl CertificationPolicy { - pub fn manifest_name(self) -> &'static str { - match self { - Self::SimulatesModel => "simulatesModel", - Self::SimulatesModelTotally => "simulatesModelTotally", - } - } - - pub fn lean_value(self) -> &'static str { - match self { - Self::SimulatesModel => ".simulatesModel", - Self::SimulatesModelTotally => ".simulatesModelTotally", - } - } - - pub fn level(self) -> &'static str { - match self { - Self::SimulatesModel => "L1", - Self::SimulatesModelTotally => "L3", - } - } -} - -/// Closed v48 measure vocabulary. New variants require a schema bump and a -/// corresponding in-kernel `checkTerm` branch; unknown JSON measures never -/// fall back to this one. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum TerminationMeasure { - IntNatAbs { param_idx: u32 }, -} - -/// Claim-axis termination data. It is deliberately absent from recursion -/// plans and their hashes: the verifier re-derives this value from the admitted -/// recursion family and pins it separately on the obligation. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct TerminationWitness { - pub measure: TerminationMeasure, - pub descent: i64, -} - -impl TerminationWitness { - pub fn lean_value(self) -> String { - match self.measure { - TerminationMeasure::IntNatAbs { param_idx } => format!( - "({{ measure := .intNatAbs {param_idx}, descent := ({}) }} : AverCert.Schema.TerminationWitness)", - self.descent - ), - } - } -} - -/// One field of a stage-1 flat scalar record, as a `TypeDecl` scalar leaf. The -/// producer derives the ordered leaf list by decoding the module's struct type -/// section at the projected struct index (`record_leaves_from_bytes`); the wall -/// re-pins the whole declaration by equality against those same bytes, so this -/// is byte-derived data, not a trusted layout. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum RecordLeaf { - IntCarrier, - BoolScalar, - FloatScalar, -} - -impl RecordLeaf { - /// The Lean `TypeDecl` scalar-leaf constructor this field lowers to. - #[cfg(feature = "engine")] - fn lean_ctor(self) -> &'static str { - match self { - RecordLeaf::IntCarrier => ".intCarrier", - RecordLeaf::BoolScalar => ".boolScalar", - RecordLeaf::FloatScalar => ".floatScalar", - } - } -} - -/// The Lean `List TypeDecl` literal of a record's ordered scalar-leaf fields. -#[cfg(feature = "engine")] -fn record_leaves_lean_value(leaves: &[RecordLeaf]) -> String { - format!( - "[{}]", - leaves - .iter() - .map(|leaf| leaf.lean_ctor()) - .collect::>() - .join(", ") - ) -} - -/// A certified function and the template holes extracted from its body. -enum Cert { - /// Generic non-recursive certificate. The inner shape still carries the - /// byte-derived face and proof parameters; the outer class records that the - /// non-recursive walker admitted it. - NonRecursive { inner: Box }, - /// Single-argument fuel self-recursion `f n = if n≤0 then BASE else `; - /// box/add/sub host helpers. All of the shape below is DATA recovered from the - /// bytes; only the descent (`n-1`) and the host `add` combinator are pinned: - /// - `base_k`: the literal returned in the base arm (sumTo's `0`, but any). - /// - `other` + `rec_first`: the `add` combines the self-call result `f(n-1)` - /// with `other` (the input `n`, or a boxed constant); `rec_first` records - /// which side the recursive result sits on — `f(n-1) + n` vs `n + f(n-1)`. - Recursive { - name: String, - self_idx: u32, - /// Declared type index of the exported function, carried for the - /// byte-first `recursion-plan-v1` artifact claim's function binding. - /// It does not enter the fuel-induction obligation. - type_idx: u32, - nlocals: usize, - carrier: u32, - box_idx: u32, - /// The combinator helper index (whichever arithmetic contract it obeys). - add_idx: u32, - sub_idx: u32, - base_k: i64, - rec_first: bool, - other: BodyOperand, - /// `+` or `*`, read from the model operator (see [`Combinator`]). - combinator: Combinator, - /// Raw code-entry bytes of the export. The recognizer normalizes - /// local-alias hops before classification, so a certified body may be - /// byte-noisier than the canonical template; the `recursion-plan-v1` - /// claim is emitted ONLY when the canonical plan lowering reproduces - /// exactly these bytes (otherwise the export stays on the legacy - /// witness route — never an unverifiable claim). - code_entry_bytes: Vec, - }, - /// countDown-shape two-argument accumulator recursion; box/add/sub host helpers. - AccumulatorRecursive { - name: String, - self_idx: u32, - type_idx: u32, - nlocals: usize, - carrier: u32, - box_idx: u32, - add_idx: u32, - sub_idx: u32, - /// See `Recursive::code_entry_bytes`. - code_entry_bytes: Vec, - }, - /// Non-recursive constructor: local arguments wrapped by `struct.new`. - AdtConstructor { - name: String, - self_idx: u32, - type_idx: u32, - nlocals: usize, - carrier: u32, - struct_idx: u32, - field_count: u32, - elem_ty: TyKind, - arity: usize, - fields: Vec, - ops: Vec, - }, - /// Non-recursive record/variant field projection. - FieldProjection { - name: String, - self_idx: u32, - type_idx: u32, - nlocals: usize, - carrier: u32, - struct_idx: u32, - field_count: u32, - field_idx: u32, - result_ty: TyKind, - code_entry_bytes: Vec, - ops: Vec, - }, - /// Non-recursive two-branch "widened" match projecting one integer-payload - /// variant of a user inductive, with a boxed-`0` default for every other - /// variant: `match j { JsonInt(n) -> n; _ -> 0 }`. Generalises the fixed - /// three-variant match to any inductive with a single projected Int variant. - WidenedIntMatch { - name: String, - self_idx: u32, - nlocals: usize, - carrier: u32, - /// Struct type index of the projected (integer-payload) variant. - hit_variant_idx: u32, - box_idx: u32, - /// Raw code-entry bytes of the export. The `int-dispatch-v1` claim is - /// emitted ONLY when the canonical plan lowering reproduces exactly - /// these bytes (otherwise the export stays on the legacy witness - /// route), exactly like `Cert::VerbatimWidenedMatch::code_entry_bytes`. - /// The claim binds the export by name (anonymous `FuncBinding` - /// witness), so no code/type index is carried. - code_entry_bytes: Vec, - ops: Vec, - }, - /// Non-recursive two-branch match projecting one variant's first field - /// VERBATIM (as a raw `WVal`), defaulting to the null reference for every - /// other variant: `match j { JsonList(items) -> items; _ -> [] }` where the - /// empty list lowers to `ref.null`. No claim about the projected value's - /// meaning — `Cod := WVal`, `verbatimRepr` — so it needs no carrier/string - /// representation. - VerbatimWidenedMatch { - name: String, - self_idx: u32, - nlocals: usize, - carrier: u32, - hit_variant_idx: u32, - default: VerbatimDefault, - /// Raw code-entry bytes of the export. The `verbatim-plan-v1` claim is - /// emitted ONLY when the canonical plan lowering reproduces exactly - /// these bytes (otherwise analysis declines the export before rendering), - /// exactly like `Cert::Recursive::code_entry_bytes`. The claim binds the - /// export by name (anonymous `FuncBinding` witness), so no code/type - /// index is carried. - code_entry_bytes: Vec, - ops: Vec, - }, - /// Non-recursive `ref.test` dispatch over a user enum where EVERY arm returns - /// a distinct VERBATIM constant (a String literal `array.new_data`, a null, or - /// an f64), e.g. `match code { Quote -> "\""; Backslash -> "\\"; ... }` - /// (`unescapedChar`). No host, no arithmetic, no field projection — each tag - /// maps to a byte-derived constant `WVal`. Certified `Cod := WVal`, - /// `verbatimRepr`, model `{name}Model : WVal → WVal`; reuses the verbatim - /// widened face. The generalisation of the verbatim widened match from "one - /// projected hit + a default" to "k constant arms". - VerbatimVariantDispatch { - name: String, - self_idx: u32, - nlocals: usize, - carrier: u32, - /// `(variant tag, its verbatim constant)`, in dispatch order. - arms: Vec<(u32, VerbatimDefault)>, - /// The terminal else constant. - default: VerbatimDefault, - /// Raw code-entry bytes of the export; see - /// `VerbatimWidenedMatch::code_entry_bytes`. - code_entry_bytes: Vec, - ops: Vec, - }, - /// Non-recursive String-literal dispatch whose condition is delegated to a - /// contracted `String.eq` helper. The certified user body stays loop-free: - /// it constructs byte-derived string constants with `array.new_data`, calls - /// the exact String.eq host slot, then returns a byte-derived constant or - /// the original input verbatim. - StringEqVerbatimMatch { - name: String, - self_idx: u32, - type_idx: u32, - nlocals: usize, - carrier: u32, - string_eq_idx: u32, - arms: Vec<(VerbatimDefault, VerbatimDefault)>, - default: StringEqDefault, - ops: Vec, - }, - /// Non-recursive String transformation whose body builds a small container - /// of string arrays (one or more literals from `array.new_data` plus the - /// function argument), then invokes the contracted `String.concat` host - /// helper once and returns the byte-concatenated result. The certified body - /// is loop-free; only the helper is abstract. The simplest beachhead shape - /// is `fn(s) = prefix ++ s` (or `s ++ suffix`) — a single literal concatenated - /// with the input on either side. - StringConcatVerbatimMatch { - name: String, - self_idx: u32, - type_idx: u32, - nlocals: usize, - /// The module's Int-carrier struct type index, or `None` when the module - /// emits no Int carrier at all. Concatenation never touches the carrier, - /// so unlike every other family this one certifies in both states; the - /// index only picks the locals prelude the emitter reserved, and the - /// wall re-derives that choice from the type section rather than taking - /// it from here (`CertDecode.carrierState`). - carrier: Option, - /// The wasm func index of the String.concat host helper. - string_concat_idx: u32, - /// The container type index (the array-of-string-arrays built by - /// `array.new_fixed`). - container_ty: u32, - /// The string byte-array result type returned by the concat helper. - result_ty: u32, - /// The literal prefixes (applied before the input). May be empty. - prefixes: Vec, - /// The literal suffixes (applied after the input). May be empty. - suffixes: Vec, - ops: Vec, - }, - /// Non-recursive typed expression fragment. The byte-bound body lowers from - /// a small ordered ANF representation plan (`ExprFragmentPlan`). When the - /// producer/checker also has a source-level view, `source_plan` preserves - /// that `SymPlan` instead of making renderers recover it from the - /// representation shape. - ExprFragment { - name: String, - self_idx: u32, - type_idx: u32, - nlocals: usize, - carrier: u32, - source_plan: Option, - /// When the plan is a stage-1 record scalar field read, the projected - /// wasm struct index and the record's ordered scalar-leaf field list, - /// byte-derived from the module type section. `None` for every - /// non-record fragment. Renderers pin the whole declaration by equality - /// against the bytes and discharge through the wall's record face. - record_decl: Option<(u32, Vec)>, - /// When the plan is a record projection-compute body (the v1 compute - /// face), the recognized face. Populated only when the pinned struct - /// decodes to a flat ALL-Int record (the face's declared decl), with - /// `record_decl` carrying those leaves. `None` otherwise. - record_compute: Option, - plan: ExprFragmentPlan, - ops: Vec, - }, - /// General non-recursive variant dispatch over one user inductive: a chain - /// of `ref.test` branches (each else-arm continuing the chain) whose hit - /// arms each reduce to one recognised leaf — payload projection, or a - /// contracted host add/sub combining the payload with an integer constant — - /// and whose terminal else is a boxed integer constant. Recognised from the - /// parsed instruction tree, so arm count, arm order, per-arm semantics and - /// the default value are free; no full opcode sequence is pinned. - VariantDispatch { - name: String, - self_idx: u32, - nlocals: usize, - carrier: u32, - box_idx: u32, - add_idx: Option, - sub_idx: Option, - /// `(variant struct tag, leaf)` in dispatch order. - arms: Vec<(u32, ArmLeaf)>, - /// The terminal else: a boxed integer constant. - default_k: i64, - /// Raw code-entry bytes of the export; see - /// `WidenedIntMatch::code_entry_bytes`. - code_entry_bytes: Vec, - ops: Vec, - }, - /// Cross-function composition: a non-recursive `Int -> Int` caller whose body - /// is a unary chain of calls to other user functions, each of which is itself - /// a straight-line integer shape (self-sum or a nested chain). The obligation - /// carries the caller's ENTIRE call closure in one `CodeTbl`, and the caller's - /// simulation lemma cites each callee's simulation lemma at its call site. - Composition { - name: String, - self_idx: u32, - carrier: u32, - /// The whole closure (caller + all transitively-reached callees, incl. - /// the caller's own chain entry), sorted by `self_idx`. Every entry's - /// body goes into the shared `CodeTbl`. - closure: Vec, - /// Runtime contracts consumed anywhere in the closure. - has_add: bool, - has_sub: bool, - has_box: bool, - }, - /// One member of a mutually-recursive SCC `f n = if n≤0 then base else g(n-1)` - /// (each member tail-calls the next in the cycle). Every member of the SCC is - /// a certified export sharing ONE proof: a conjunction fuel-induction over the - /// whole SCC where each cross-call is discharged by the matching conjunct of - /// the induction hypothesis (the `mutual_sim` shape). The lowest-`self_idx` - /// member is the "primary" that emits the shared code table + the conjunction - /// bridge + `mutual_sim`; every member emits its own obligation citing the - /// matching conjunct. Carries the whole (sorted) SCC so any member's cert can - /// render the shared block. - MutualRecursion { - name: String, - self_idx: u32, - carrier: u32, - box_idx: u32, - sub_idx: u32, - /// This member's index in `scc` (which conjunct of `mutual_sim`). The - /// member's own `nlocals`/`base_k` live in `scc[position]`. - position: usize, - /// The whole SCC, sorted by `self_idx`. - scc: Vec, - }, -} - -/// One function of a mutually-recursive SCC. The recogniser verified this -/// member's body against the fixed shape `f n = if n≤0 then base else g(n-1)`, -/// so the shared code table is reconstructed losslessly from these byte-derived -/// fields (base literal, cross-call target) the way `Cert::Recursive` is — no -/// need to carry the raw ops. -#[derive(Clone)] -struct MutualMember { - name: String, - self_idx: u32, - /// Declared type index of this member's exported function, carried for the - /// byte-first `mutual-plan-v1` artifact claim's function binding. It does - /// not enter the fuel-induction obligation. - type_idx: u32, - nlocals: usize, - /// Literal returned in the base arm (`n ≤ 0`). - base_k: i64, - /// The SCC member this one tail-calls in its step arm. - cross_idx: u32, - /// Raw code-entry bytes of this member's export. The `mutual-plan-v1` claim - /// is emitted ONLY when the canonical plan lowering reproduces exactly these - /// bytes (otherwise analysis declines the member before rendering — never - /// an unverifiable claim), exactly like `Cert::Recursive::code_entry_bytes`. - code_entry_bytes: Vec, -} diff --git a/aver-cert/src/engine/cert_methods.rs b/aver-cert/src/engine/cert_methods.rs deleted file mode 100644 index 1cee1df52..000000000 --- a/aver-cert/src/engine/cert_methods.rs +++ /dev/null @@ -1,451 +0,0 @@ -/// Promotion is an SCC property, never a per-export guess. The classifier only -/// constructs `MutualRecursion` for the exact `n ≤ 0` / `g (n - 1)` grammar; -/// this final fail-closed check additionally requires one closed simple cycle -/// in the shared SCC value carried by every member. Thus a malformed or mixed -/// group yields no witness for any of its obligations. -fn mutual_scc_total_eligible(scc: &[MutualMember]) -> bool { - if scc.len() < 2 - || scc - .iter() - .any(|member| scc.iter().filter(|m| m.self_idx == member.self_idx).count() != 1) - { - return false; - } - let start = scc[0].self_idx; - let mut current = start; - let mut visited = std::collections::HashSet::with_capacity(scc.len()); - for _ in 0..scc.len() { - if !visited.insert(current) { - return false; - } - let Some(member) = scc.iter().find(|m| m.self_idx == current) else { - return false; - }; - current = member.cross_idx; - } - current == start && visited.len() == scc.len() -} - -impl Cert { - fn inner(&self) -> &Cert { - match self { - Cert::NonRecursive { inner } => inner, - _ => self, - } - } - - /// The total families: unary `n - 1` recursion, the exact two-argument - /// accumulator, and complete integer-countdown mutual SCCs. Only unary - /// multiplication selects the additional Int.mul totality premise. - fn termination_witness(&self) -> Option { - match self.inner() { - Cert::Recursive { .. } | Cert::AccumulatorRecursive { .. } => { - Some(TerminationWitness { - measure: TerminationMeasure::IntNatAbs { param_idx: 0 }, - descent: -1, - }) - } - Cert::MutualRecursion { scc, .. } if mutual_scc_total_eligible(scc) => { - Some(TerminationWitness { - measure: TerminationMeasure::IntNatAbs { param_idx: 0 }, - descent: -1, - }) - } - _ => None, - } - } - - fn policy(&self) -> CertificationPolicy { - if self.termination_witness().is_some() { - CertificationPolicy::SimulatesModelTotally - } else { - CertificationPolicy::SimulatesModel - } - } - - /// Whether this total obligation genuinely executes a byte-pinned - /// `Int.mul` combine and therefore needs multiplication to be total. - fn requires_mul_totality(&self) -> bool { - self.policy() == CertificationPolicy::SimulatesModelTotally - && matches!( - self.inner(), - Cert::Recursive { - combinator: Combinator::Mul, - .. - } - ) - } - - fn totality_role_lean_value(&self) -> &'static str { - if self.requires_mul_totality() { - ".mul" - } else { - ".addSub" - } - } - - /// The verbatim field-projection face of an ADT-ref expr fragment, when - /// this cert is an `ExprFragment` whose plan is exactly `struct.get ty - /// field∈{0,1}` of the single reference parameter. Renderers branch on - /// this to state the same obligation and proof the legacy field-projection - /// class ships (no weakening). - fn project_face(&self) -> Option { - match self.inner() { - Cert::ExprFragment { plan, .. } => expr_fragment_project_face(plan), - _ => None, - } - } - - fn tag_dispatch_face(&self) -> Option { - match self.inner() { - Cert::ExprFragment { plan, .. } => expr_fragment_tag_dispatch_face(plan), - _ => None, - } - } - - /// The stage-1 record scalar field-read face of an ADT-ref expr fragment, - /// when this cert is an `ExprFragment` whose plan is exactly - /// `struct.get structIdx field` yielding a scalar leaf AND whose struct - /// decoded to a flat scalar record declaration (`record_decl`). Renderers - /// branch on this to state the wall's record-parameter obligation and - /// discharge through `recordParam_claim_discharges`. The `record_decl` - /// guard means a surviving record-projection cert always has its ordered - /// leaf list available. - fn record_param_face(&self) -> Option { - match self.inner() { - Cert::ExprFragment { - plan, - record_decl: Some(_), - .. - } => expr_fragment_record_proj_face(plan), - _ => None, - } - } - - /// The projected struct index and ordered scalar-leaf field list of a record - /// projection cert, byte-derived at check time. - /// The record projection-compute face, when the sidecar recognized one - /// over an all-Int record. Renderers branch on this to state the wall's - /// compute obligation (plan-as-claim) and discharge through - /// `recordCompute_claim_discharges`. - fn record_compute_face(&self) -> Option { - match self.inner() { - Cert::ExprFragment { - record_compute: Some(face), - .. - } => Some(*face), - _ => None, - } - } - - fn record_decl(&self) -> Option<(u32, &[RecordLeaf])> { - match self.inner() { - Cert::ExprFragment { - record_decl: Some((struct_idx, leaves)), - .. - } => Some((*struct_idx, leaves.as_slice())), - _ => None, - } - } - - fn vector_get_face(&self) -> Option { - match self.inner() { - Cert::ExprFragment { plan, .. } => expr_fragment_vector_get_face(plan), - _ => None, - } - } - - /// The Int selection face (`match a < b { true -> a; false -> b }`), when - /// this cert is an `ExprFragment` whose plan is exactly the pinned - /// selection node list. The wall fixes the whole meaning of this face — - /// domain, codomain, both representation relations, the single host slot - /// AND the model — so renderers emit no bespoke proof for it. Its result - /// is a passthrough of an input local. - fn int_select_face(&self) -> Option { - match self.inner() { - Cert::ExprFragment { plan, .. } => expr_fragment_int_select_face(plan), - _ => None, - } - } - - /// The comparison face, for the sites that only need to know that the wall - /// owns this claim's meaning. - fn int_cmp_face(&self) -> Option { - self.int_select_face() - } - - fn name(&self) -> &str { - match self.inner() { - Cert::Recursive { name, .. } - | Cert::AccumulatorRecursive { name, .. } - | Cert::AdtConstructor { name, .. } - | Cert::FieldProjection { name, .. } - | Cert::WidenedIntMatch { name, .. } - | Cert::VerbatimWidenedMatch { name, .. } - | Cert::VerbatimVariantDispatch { name, .. } - | Cert::StringEqVerbatimMatch { name, .. } - | Cert::StringConcatVerbatimMatch { name, .. } - | Cert::ExprFragment { name, .. } - | Cert::VariantDispatch { name, .. } - | Cert::Composition { name, .. } - | Cert::MutualRecursion { name, .. } => name, - Cert::NonRecursive { .. } => unreachable!(), - } - } - fn self_idx(&self) -> u32 { - match self.inner() { - Cert::Recursive { self_idx, .. } - | Cert::AccumulatorRecursive { self_idx, .. } - | Cert::AdtConstructor { self_idx, .. } - | Cert::FieldProjection { self_idx, .. } - | Cert::WidenedIntMatch { self_idx, .. } - | Cert::VerbatimWidenedMatch { self_idx, .. } - | Cert::VerbatimVariantDispatch { self_idx, .. } - | Cert::StringEqVerbatimMatch { self_idx, .. } - | Cert::StringConcatVerbatimMatch { self_idx, .. } - | Cert::ExprFragment { self_idx, .. } - | Cert::VariantDispatch { self_idx, .. } - | Cert::Composition { self_idx, .. } - | Cert::MutualRecursion { self_idx, .. } => *self_idx, - Cert::NonRecursive { .. } => unreachable!(), - } - } - /// The carrier type index this certificate's `Obligation` declares. A - /// String.concat certificate in a module with no Int carrier struct has no - /// index to declare and uses the reserved `0`, matching the wall's - /// `CertDecode.carrierState`'s carrierless arm (`decodedCarrierIndex`). - fn carrier(&self) -> u32 { - match self.inner() { - Cert::Recursive { carrier, .. } - | Cert::AccumulatorRecursive { carrier, .. } - | Cert::AdtConstructor { carrier, .. } - | Cert::FieldProjection { carrier, .. } - | Cert::WidenedIntMatch { carrier, .. } - | Cert::VerbatimWidenedMatch { carrier, .. } - | Cert::VerbatimVariantDispatch { carrier, .. } - | Cert::StringEqVerbatimMatch { carrier, .. } - | Cert::ExprFragment { carrier, .. } - | Cert::VariantDispatch { carrier, .. } - | Cert::Composition { carrier, .. } - | Cert::MutualRecursion { carrier, .. } => *carrier, - Cert::StringConcatVerbatimMatch { carrier, .. } => carrier.unwrap_or(0), - Cert::NonRecursive { .. } => unreachable!(), - } - } - fn arity(&self) -> usize { - match self.inner() { - Cert::Recursive { .. } | Cert::MutualRecursion { .. } => 1, - Cert::AccumulatorRecursive { .. } => 2, - Cert::ExprFragment { plan, .. } => plan.arity(), - Cert::AdtConstructor { arity, .. } => *arity, - Cert::FieldProjection { .. } - | Cert::WidenedIntMatch { .. } - | Cert::VerbatimWidenedMatch { .. } - | Cert::VerbatimVariantDispatch { .. } - | Cert::StringEqVerbatimMatch { .. } - | Cert::StringConcatVerbatimMatch { .. } - | Cert::VariantDispatch { .. } - | Cert::Composition { .. } => 1, - Cert::NonRecursive { .. } => unreachable!(), - } - } - /// The qualified Lean identifier of this export's source model function. - /// - /// Only valid for a cert that passed `model_citation_gate` against THIS - /// `model_info` — `analyze` applies that gate to every cert it keeps, and - /// `write_project` re-checks it before rendering anything, so a resolution - /// failure here is a producer bug rather than a certificate that should - /// decline. Citing an unresolved name would be a guess, so this panics - /// instead of emitting one. - fn model_lean_name(&self, model_info: &ModelInfo) -> String { - model_info - .model_lean_name(self.name()) - .expect("model-citing certificate passed the qualified-name gate") - } - /// The Lean expression for the model this export simulates. - fn model_expr(&self, model_info: &ModelInfo) -> String { - match self.inner() { - Cert::Recursive { .. } - | Cert::Composition { .. } - | Cert::MutualRecursion { .. } => { - format!("fun ns => {} (ns.headD 0)", self.model_lean_name(model_info)) - } - Cert::AccumulatorRecursive { .. } => { - format!( - "fun ns => {} (ns.headD 0) ((ns.drop 1).headD 0)", - self.model_lean_name(model_info) - ) - } - Cert::AdtConstructor { .. } - | Cert::FieldProjection { .. } - | Cert::WidenedIntMatch { .. } - | Cert::VerbatimWidenedMatch { .. } - | Cert::VerbatimVariantDispatch { .. } - | Cert::StringEqVerbatimMatch { .. } - | Cert::StringConcatVerbatimMatch { .. } - | Cert::ExprFragment { .. } - | Cert::VariantDispatch { .. } => "fun x => x".to_string(), - Cert::NonRecursive { .. } => unreachable!(), - } - } - /// The Lean expression for the 4-arg host builder in `Obligation` shape - /// (`add → sub → mul → stringEq → HostTbl`). Every named host keeps its own arity; this - /// wraps it to the obligation shape, ignoring the contracts it does not wire. - fn host_expr(&self) -> String { - if let Some(face) = self.tag_dispatch_face() { - return format!( - "AverCert.StandardFace.tagDispatchHost {} {}", - self.carrier(), - face.box_idx - ); - } - if let Some(face) = self.int_cmp_face() { - return format!( - "AverCert.StandardFace.intCmpHost {{ op := {}, helperIdx := {} }}", - face.op.lean_ctor(), - face.helper_idx - ); - } - if let Some(face) = self.vector_get_face() { - return format!( - "AverCert.StandardFace.vectorGetOrDefaultHost {} \ - {{ arrTy := {}, toIndexIdx := {}, boxIdx := {}, d := ({} : Int) }}", - self.carrier(), - face.arr_ty, - face.to_index_idx, - face.box_idx, - face.default - ); - } - match self.inner() { - Cert::Recursive { - name, combinator, .. - } => { - // Draw the combinator slot (`add` or `mul`) from the obligation. - format!( - "fun add sub mul _ _ _ _ _ => CertModule.{name}Host {} sub", - combinator.param() - ) - } - Cert::AccumulatorRecursive { name, .. } | Cert::Composition { name, .. } => { - format!("fun add sub _ _ _ _ _ _ => CertModule.{name}Host add sub") - } - // The whole SCC shares one host (box + sub only), named after the - // primary (lowest-`self_idx`) member; every member's obligation points - // at it. `add`/`mul` are ignored (mutual has no combinator). - Cert::MutualRecursion { scc, .. } => { - format!("fun _ sub _ _ _ _ _ _ => CertModule.{}Host sub", scc[0].name) - } - Cert::AdtConstructor { name, .. } | Cert::FieldProjection { name, .. } => { - format!("fun _ _ _ _ _ _ _ _ => CertModule.{name}Host") - } - Cert::WidenedIntMatch { name, .. } - | Cert::VerbatimWidenedMatch { name, .. } - | Cert::VerbatimVariantDispatch { name, .. } => { - format!("fun _ _ _ _ _ _ _ _ => CertModule.{name}Host") - } - Cert::ExprFragment { name, .. } => { - format!("fun _ _ _ _ _ _ _ _ => CertModule.{name}Host") - } - Cert::StringEqVerbatimMatch { name, .. } => { - format!("fun _ _ _ stringEq _ _ _ _ => CertModule.{name}Host stringEq") - } - Cert::StringConcatVerbatimMatch { name, .. } => { - format!("fun _ _ _ _ stringConcat _ _ _ => CertModule.{name}Host stringConcat") - } - Cert::VariantDispatch { name, .. } => { - format!("fun add sub _ _ _ _ _ _ => CertModule.{name}Host add sub") - } - Cert::NonRecursive { .. } => unreachable!(), - } - } - /// The source-level `Dom`/`Cod` type names recorded in the manifest JSON so - /// `aver cert verify`/`explain` can surface WHAT is certified without reading - /// Lean. Display-only (the semantic content is what the witness pins); - /// rendered ASCII-safe. - fn source_dom_cod(&self, model_info: &ModelInfo) -> (String, String) { - let ascii = |s: &str| ascii_type_name(s); - if self.project_face().is_some() { - return ("WVal x WVal".to_string(), "WVal".to_string()); - } - if self.tag_dispatch_face().is_some() { - return ("Int x WVal".to_string(), "Int".to_string()); - } - if self.vector_get_face().is_some() { - return ("List Int x Int".to_string(), "Int".to_string()); - } - if self.int_select_face().is_some() { - return ("Int x Int".to_string(), "Int".to_string()); - } - match self.inner() { - Cert::Recursive { .. } - | Cert::AccumulatorRecursive { .. } - | Cert::Composition { .. } - | Cert::MutualRecursion { .. } => ("List Int".to_string(), "Int".to_string()), - Cert::FieldProjection { .. } => ("WVal x WVal".to_string(), "WVal".to_string()), - Cert::VerbatimWidenedMatch { .. } - | Cert::VerbatimVariantDispatch { .. } - | Cert::StringEqVerbatimMatch { .. } - | Cert::StringConcatVerbatimMatch { .. } => ("WVal".to_string(), "WVal".to_string()), - Cert::ExprFragment { plan, .. } => (plan.source_dom(), plan.source_cod()), - Cert::VariantDispatch { name, .. } | Cert::WidenedIntMatch { name, .. } => { - // Display the qualified inductive name when the written type - // resolves (identity for entry-level models). - let dom = model_info - .fns - .get(name) - .and_then(|s| { - s.params.first().map(|written| { - model_info - .resolve_inductive(&s.prefix, written) - .map(|(qualified, _)| qualified) - .unwrap_or_else(|| written.clone()) - }) - }) - .map(|s| ascii(&s)) - .unwrap_or_else(|| "Op".to_string()); - (dom, "Int".to_string()) - } - Cert::AdtConstructor { arity, .. } => { - if adt_constructor_uses_model(self, model_info) { - let cod = model_info - .fns - .get(self.name()) - .map(|s| { - model_info - .resolve_inductive(&s.prefix, &s.ret) - .map(|(qualified, _)| qualified) - .unwrap_or_else(|| s.ret.clone()) - }) - .map(|s| ascii(&s)) - .unwrap_or_else(|| "Unit".to_string()); - ("Int".to_string(), cod) - } else { - let dom = if *arity == 1 { - "WVal".to_string() - } else { - "WVal x WVal".to_string() - }; - (dom, "WVal".to_string()) - } - } - Cert::NonRecursive { .. } => unreachable!(), - } - } -} - -/// Render a Lean/source type name as printable ASCII for the manifest JSON: the -/// common math glyphs `×`/`→` become `x`/`->`, and any other non-ASCII byte is -/// dropped. Keeps a hostile-free, injection-free label the checker can display. -fn ascii_type_name(s: &str) -> String { - let mut out = String::with_capacity(s.len()); - for ch in s.chars() { - match ch { - '×' => out.push('x'), - '→' => out.push_str("->"), - c if c.is_ascii_graphic() || c == ' ' => out.push(c), - _ => {} - } - } - out -} diff --git a/aver-cert/src/engine/classification.rs b/aver-cert/src/engine/classification.rs deleted file mode 100644 index 6362b42ab..000000000 --- a/aver-cert/src/engine/classification.rs +++ /dev/null @@ -1,11 +0,0 @@ -// ---- classification ------------------------------------------------------ - -include!("classify_entry.rs"); -include!("classify_expr_fragment.rs"); -include!("classify_variant_dispatch.rs"); -include!("classify_structural.rs"); -include!("classify_basic.rs"); -include!("classify_verbatim.rs"); -include!("classify_composition.rs"); -include!("classify_recursion.rs"); -include!("classify_model.rs"); diff --git a/aver-cert/src/engine/classify_basic.rs b/aver-cert/src/engine/classify_basic.rs deleted file mode 100644 index e848fc0d0..000000000 --- a/aver-cert/src/engine/classify_basic.rs +++ /dev/null @@ -1,190 +0,0 @@ -fn nr_adt_constructor( - f: &UserFn, - body: &StructuralBody, - box_idx: Option, - carrier: Option, -) -> Option { - use Op::*; - if has_branch(&body.tree) || f.arity == 0 || f.arity > 2 { - return None; - } - let ops = &body.normalized_ops; - let (last, prefix) = ops.split_last()?; - let StructNew(struct_idx, field_count) = last else { - return None; - }; - if *struct_idx == carrier? { - return None; - } - let mut fields = Vec::new(); - for op in prefix { - match op { - LocalGet(i) if (*i as usize) < f.arity => fields.push(ConstructorField::Local(*i)), - RefNull(_) => fields.push(ConstructorField::Null), - _ => return None, - } - } - if fields.len() != *field_count as usize { - return None; - } - let mut seen_locals = fields - .iter() - .filter_map(|field| match field { - ConstructorField::Local(i) => Some(*i), - ConstructorField::Null => None, - }) - .collect::>(); - seen_locals.sort_unstable(); - seen_locals.dedup(); - if seen_locals != (0..f.arity as u32).collect::>() { - return None; - } - // Every call must be the box helper; with no box helper in the module any - // call disqualifies (a call-free constructor still matches). - if f.calls.iter().any(|c| *c == f.wasm_idx || Some(*c) != box_idx) { - return None; - } - Some(Cert::AdtConstructor { - name: f.name.clone(), - self_idx: f.wasm_idx, - type_idx: f.type_idx, - nlocals: f.nlocals, - carrier: carrier?, - struct_idx: *struct_idx, - field_count: *field_count, - elem_ty: *f.params.first()?, - arity: f.arity, - fields, - ops: strip_trailing_end(&f.ops).to_vec(), - }) -} - -fn nr_field_projection( - f: &UserFn, - body: &StructuralBody, - carrier: Option, - struct_field_counts: &std::collections::HashMap, -) -> Option { - use Op::*; - if has_branch(&body.tree) || !f.calls.is_empty() { - return None; - } - let carrier = carrier?; - let mut gets = body - .normalized_ops - .iter() - .filter_map(|op| match op { - StructGet(t, field) => Some((*t, *field)), - _ => None, - }) - .collect::>(); - if gets.len() != 1 { - return None; - } - let (struct_idx, field_idx) = gets.pop()?; - if struct_idx == carrier || field_idx > 1 { - return None; - } - let field_count = *struct_field_counts.get(&struct_idx)?; - let result_ty = f.result?; - Some(Cert::FieldProjection { - name: f.name.clone(), - self_idx: f.wasm_idx, - type_idx: f.type_idx, - nlocals: f.nlocals, - carrier, - struct_idx, - field_count, - field_idx, - result_ty, - code_entry_bytes: f.code_entry_bytes.clone(), - ops: strip_trailing_end(&f.ops).to_vec(), - }) -} - -fn nr_ref_dispatch_match( - f: &UserFn, - body: &StructuralBody, - box_idx: Option, - carrier: Option, - _host_roles: &std::collections::HashMap, -) -> Option { - let carrier = carrier?; - if body - .normalized_ops - .iter() - .take_while(|op| !matches!(op, Op::RefTest(_))) - .any(|op| matches!(op, Op::StructNew(..))) - { - return None; - } - for pair in body.tree.windows(2) { - let [ - InstrNode::Op(Op::RefTest(hit)), - InstrNode::IfElse(hit_arm, miss_arm), - ] = pair - else { - continue; - }; - if *hit == carrier { - continue; - } - let hit_ops = node_ops(hit_arm); - if !hit_ops - .iter() - .any(|op| matches!(op, Op::StructGet(t, 0) if t == hit)) - { - continue; - } - let miss_ops = node_ops(miss_arm); - // Typed admission (belt for the legacy route, mirroring the verbatim - // widened match): exactly one nominal sum-root value in — a - // two-parameter dispatch keeps a byte-identical code entry, so a unary - // obligation must not be certified for a binary export — and exactly - // one nullable Int-carrier reference out (the plan path additionally - // pins the exact unary concrete-ref -> nullable-carrier signature - // in-kernel). - // The widened Int match boxes its `0` default, so it structurally - // requires the box helper; without one this branch never matches and - // the verbatim route below still gets its shot. - if let Some(box_idx) = box_idx - && matches!(miss_ops.as_slice(), [Op::I64Const(0), Op::Call(b)] if *b == box_idx) - && matches!(f.params.as_slice(), [TyKind::Ref { nullable: true, .. }]) - && matches!(f.results.as_slice(), - [TyKind::Ref { nullable: true, idx }] if *idx == carrier) - { - return Some(Cert::WidenedIntMatch { - name: f.name.clone(), - self_idx: f.wasm_idx, - nlocals: f.nlocals, - carrier, - hit_variant_idx: *hit, - box_idx, - code_entry_bytes: f.code_entry_bytes.clone(), - ops: strip_trailing_end(&f.ops).to_vec(), - }); - } - // Typed admission: exactly one nominal sum-root value in — a two-parameter - // dispatch keeps a byte-identical code entry, so a unary obligation must - // not be certified for a binary export — and exactly one result of the - // kind the default implies (a nullable ref here; the plan path additionally - // pins the exact unary concrete-ref -> nullable-result signature in-kernel). - if f.calls.is_empty() - && matches!(f.params.as_slice(), [TyKind::Ref { nullable: true, .. }]) - && let Some(default) = verbatim_default_from_ops(&miss_ops) - && verbatim_results_ok(&f.results, &default) - { - return Some(Cert::VerbatimWidenedMatch { - name: f.name.clone(), - self_idx: f.wasm_idx, - nlocals: f.nlocals, - carrier, - hit_variant_idx: *hit, - default, - code_entry_bytes: f.code_entry_bytes.clone(), - ops: strip_trailing_end(&f.ops).to_vec(), - }); - } - } - None -} diff --git a/aver-cert/src/engine/classify_composition.rs b/aver-cert/src/engine/classify_composition.rs deleted file mode 100644 index f6f589915..000000000 --- a/aver-cert/src/engine/classify_composition.rs +++ /dev/null @@ -1,169 +0,0 @@ -enum CompositionOutcome { - /// The caller and its whole closure classify — a composition certificate. - Certified(Box), - /// The caller IS a unary user-call chain, but its closure leaves the - /// certified classes (an out-of-class callee, or a cycle). The specific, - /// honest reason the caller declines. - Declined(String), - /// The caller is not a unary composition chain at all — let the ordinary - /// decline reasons apply. - NotApplicable, -} - -/// Recognise one function as a straight-line integer shape usable inside a -/// composition closure: a self-sum (`x + x`) or a unary chain of user calls. -/// Returns `None` for anything else (a runtime/ADT/branch body, wrong arity). -fn classify_leaf_shape( - f: &UserFn, - user_idx_set: &std::collections::HashSet, -) -> Option { - use Op::*; - if f.arity != 1 { - return None; - } - let ops = strip_trailing_end(&f.ops); - // Self-sum: [localGet 0, localGet 0, call add] where `add` is a host helper. - if let [LocalGet(0), LocalGet(0), Call(a)] = ops - && *a != f.wasm_idx - && !user_idx_set.contains(a) - { - return Some(LeafShape::SelfSum { add_idx: *a }); - } - // Unary chain: [localGet 0, call c1, ..., call cm] (m >= 1), each ci a user - // function other than the caller itself. No other opcodes. - if let Some((LocalGet(0), rest)) = ops.split_first() - && !rest.is_empty() - && rest.iter().all(|op| match op { - Call(c) => *c != f.wasm_idx && user_idx_set.contains(c), - _ => false, - }) - { - let calls = rest - .iter() - .map(|op| match op { - Call(c) => *c, - _ => unreachable!(), - }) - .collect(); - return Some(LeafShape::Chain { calls }); - } - None -} - -/// Try to certify `f` as a cross-function composition. `f` qualifies only if its -/// own body is a unary user-call chain; then its transitive call closure must be -/// wholly covered by the straight-line integer shapes. -fn try_composition( - f: &UserFn, - box_idx: Option, - carrier: Option, - user_idx_set: &std::collections::HashSet, - fns: &std::collections::HashMap, -) -> CompositionOutcome { - // Only a unary CHAIN caller (one that actually calls other user functions) - // is a composition; a self-sum / non-chain body is handled elsewhere. - match classify_leaf_shape(f, user_idx_set) { - Some(LeafShape::Chain { .. }) => { - let Some(carrier) = carrier else { - return CompositionOutcome::Declined( - "carrier struct type not found in module".to_string(), - ); - }; - let mut closure: std::collections::HashMap = - std::collections::HashMap::new(); - let mut path: Vec = Vec::new(); - if let Err(reason) = - collect_closure(f.wasm_idx, fns, user_idx_set, &mut closure, &mut path) - { - return CompositionOutcome::Declined(reason); - } - let mut entries: Vec = closure.into_values().collect(); - entries.sort_by_key(|e| e.self_idx); - let (has_add, has_sub, has_box) = closure_contracts(&entries); - let _ = box_idx; - CompositionOutcome::Certified(Box::new(Cert::Composition { - name: f.name.clone(), - self_idx: f.wasm_idx, - carrier, - closure: entries, - has_add, - has_sub, - has_box, - })) - } - _ => CompositionOutcome::NotApplicable, - } -} - -/// DFS the call graph from `idx`, classifying every reached function as a -/// straight-line integer shape. `path` is the active DFS stack (cycle guard); -/// `closure` collects each entry once. Fails closed on any out-of-class callee -/// or any cycle. -fn collect_closure( - idx: u32, - fns: &std::collections::HashMap, - user_idx_set: &std::collections::HashSet, - closure: &mut std::collections::HashMap, - path: &mut Vec, -) -> Result<(), String> { - if closure.contains_key(&idx) { - return Ok(()); - } - if path.contains(&idx) { - let name = fns.get(&idx).map(|f| f.name.as_str()).unwrap_or("?"); - return Err(format!( - "cycle in the call graph through user function `{name}`; composition requires an acyclic closure" - )); - } - let Some(uf) = fns.get(&idx) else { - return Err( - "a callee in the composition closure is not an in-module user function".to_string(), - ); - }; - let Some(shape) = classify_leaf_shape(uf, user_idx_set) else { - return Err(format!( - "callee `{}` is outside the certified composition classes (not a unary self-sum or a unary user-call chain)", - uf.name - )); - }; - path.push(idx); - if let LeafShape::Chain { calls } = &shape { - for c in calls { - collect_closure(*c, fns, user_idx_set, closure, path)?; - } - } - path.pop(); - closure.insert( - idx, - ClosureEntry { - name: uf.name.clone(), - self_idx: idx, - type_idx: uf.type_idx, - nlocals: uf.nlocals, - code_entry_bytes: uf.code_entry_bytes.clone(), - ops: strip_trailing_end(&uf.ops).to_vec(), - shape, - }, - ); - Ok(()) -} - -/// `(has_add, has_sub, has_box)` runtime contracts consumed across the closure. -/// v1 leaves consume only carrier `add`; the flags keep the manifest honest as -/// the leaf vocabulary grows. -fn closure_contracts(entries: &[ClosureEntry]) -> (bool, bool, bool) { - let mut has_add = false; - for e in entries { - if let LeafShape::SelfSum { .. } = e.shape { - has_add = true; - } - } - (has_add, false, false) -} - -fn strip_trailing_end(ops: &[Op]) -> &[Op] { - match ops.last() { - Some(Op::End) => &ops[..ops.len() - 1], - _ => ops, - } -} diff --git a/aver-cert/src/engine/classify_entry.rs b/aver-cert/src/engine/classify_entry.rs deleted file mode 100644 index 938bfc815..000000000 --- a/aver-cert/src/engine/classify_entry.rs +++ /dev/null @@ -1,235 +0,0 @@ -struct ClassifierContext<'a> { - host_roles: &'a std::collections::HashMap, - struct_field_counts: &'a std::collections::HashMap, - model_ops: &'a std::collections::HashMap, -} - -fn classify_without_expr_fragment( - f: &UserFn, - box_idx: Option, - carrier: Option, - user_idx_set: &std::collections::HashSet, - fns: &std::collections::HashMap, - context: &ClassifierContext<'_>, -) -> Result { - // Fuel self-recursion (single-argument `n + f(n-1)` / `n * f(n-1)` and - // two-argument accumulator), recognised structurally from the instruction - // tree. The base value is data (any literal / the accumulator) and the - // combinator operation comes from the model, not a pinned constant. - if let Some(cert) = recognize_fueled_recursion( - f, - box_idx, - carrier, - context.host_roles, - context.model_ops, - ) { - return Ok(cert); - } - - // Mutual-recursion SCC (each member tail-calls the next; the cycle closes), - // proven by one conjunction fuel-induction over the whole SCC where every - // cross-call is discharged by the matching conjunct of the induction - // hypothesis (the `mutual_sim` shape validated in - // probe-artifacts/mutual-fuel-probe/MutualSpike-twodefs.lean). The lowest- - // `self_idx` member emits the shared code table + bridge + `mutual_sim`; - // every member emits its own obligation citing the matching conjunct. - if let Some(cert) = recognize_mutual_scc( - f, - box_idx, - carrier, - user_idx_set, - fns, - context.host_roles, - ) { - return Ok(cert); - } - - if let Some(cert) = walk_nonrecursive( - f, - box_idx, - carrier, - user_idx_set, - context.host_roles, - context.struct_field_counts, - ) { - return Ok(Cert::NonRecursive { - inner: Box::new(cert), - }); - } - - // ---- decline with the blocker that actually applies -------------------- - // - // Every template above has already had its shot, so this section only - // reports. It reports the blocker that survives fixing the others, in this - // order: - // - // 1. effects. A body that calls a host capability is not a pure function - // of its arguments, so no signature and no rewrite of the rest of the - // body could make it a simulation of the source model. - // 2. a module with no Int carrier, where every remaining template is out - // of reach whatever this one export looks like. - // 3. what the export DECLARES — parameter shapes, then result shapes. - // No rewrite of a body removes a String parameter or a record result. - // 4. what the body CALLS, which the composition and mutual-recursion - // routes above do cover in specific shapes. - // 5. what the body USES: control flow, then instructions outside the - // opcode vocabulary. - // - // A call to another user function outranks both, because it EXPLAINS - // them: the call is lowered with the operand shuffling and comparison - // instructions the certified fragment has no opcode for, so naming an - // instruction points the reader at a symptom. `Domain_Time_validDay` - // (`day <= maxDay` where `maxDay = daysInMonth(month, year)`) was - // declined for "the wasm instruction `I32LeS`" while the fact that - // decides it is the call to `daysInMonth`. The two are not reported - // together: a reason is a transported display string on the format's - // candidate budget, and both clauses plus a real export name do not - // fit inside it. - // 6. the arity-shaped template misses, LAST. A parameter count is only - // ever the blocker once nothing else is, and reporting it first said - // "unsupported signature" to hundreds of exports whose signature was - // not the problem at all. - // - // Composition keeps the first word because it is still a certifying route: - // its chain callers are unary Int-carrier functions that call other user - // functions, so any check below would otherwise pre-empt a certificate. - match try_composition(f, box_idx, carrier, user_idx_set, fns) { - CompositionOutcome::Certified(c) => return Ok(*c), - CompositionOutcome::Declined(reason) => return Err(reason), - CompositionOutcome::NotApplicable => {} - } - if let Some(capability) = f.host_capability_calls.first() { - return Err(format!( - "calls the host capability `{capability}`; certified templates simulate pure bodies, never effects" - )); - } - // A module can legitimately carry no Int runtime at all. Say so before any - // per-function shape complaint: every integer-family template cites the box - // helper, and the carrier-free templates above already had their shot, so - // in such a module nothing this export could be rewritten into would bind. - // Blaming its parameters here would point at a fix that cannot work. - if box_idx.is_none() { - return Err( - "body does not match a carrier-free certified template, and the module has no Int carrier host helpers (`__rt_aint_from_i64`); integer-family certification requires the Int carrier" - .to_string(), - ); - } - if let Some((position, shape)) = f - .param_shapes - .iter() - .enumerate() - .find(|(_, shape)| shape.outside_scalar_fragment()) - { - return Err(format!( - "parameter {} is {}; a value of that shape is certified only by the projection, variant-dispatch and String templates, and this body matches none of them", - position + 1, - shape.describe() - )); - } - if f.results.is_empty() { - return Err( - "returns nothing; every certified template simulates a function that returns one value" - .to_string(), - ); - } - if f.results.len() > 1 { - return Err(format!( - "returns {} values; every certified template simulates a function that returns one", - f.results.len() - )); - } - if let Some(shape) = f - .result_shapes - .first() - .filter(|shape| shape.outside_scalar_fragment()) - { - return Err(format!( - "returns {}; a value of that shape is built only by the constructor, projection, variant-dispatch and String templates, and this body matches none of them", - shape.describe() - )); - } - let called_user_idx = f - .calls - .iter() - .find(|c| **c != f.wasm_idx && user_idx_set.contains(c)); - if let Some(called) = called_user_idx { - // Name the callee when the finished reason fits the format's candidate - // budget. A reason is a transported display string gated on that - // length, so a long export name degrades to the callee-free wording - // rather than producing a reason the verifier refuses to print. - let named = fns.get(called).map(|callee| { - format!( - "calls the user function `{}`; only the composition and mutual-recursion templates cross function boundaries, and this body fits neither", - callee.name - ) - }); - return Err(match named { - Some(reason) if reason.len() <= crate::format::MAX_CANDIDATE_LEN => reason, - _ => "calls other user functions; only the composition and mutual-recursion templates cross function boundaries, and this body fits neither".to_string(), - }); - } - if f.has_loop_or_branch { - return Err( - "body uses loops/branches outside the certified straight-line/recursive fragment" - .to_string(), - ); - } - if f.ops.iter().any(|o| matches!(o, Op::Other)) { - return Err(match &f.first_unsupported_op { - Some(instruction) => format!( - "body uses the wasm instruction `{instruction}`, which is outside the certified fragment" - ), - None => "body uses wasm instructions outside the certified fragment".to_string(), - }); - } - // Only now can a parameter count be the honest answer: the signature is - // scalar, the body is pure straight-line code that calls nobody, and still - // nothing matched. Name the family templates the arity ruled out rather - // than implying the signature is unsupported in general — the arity-free - // templates (field projection above all) accept any parameter count. - if f.arity == 0 { - return Err( - "takes no parameters; every certified template simulates a function of at least one argument" - .to_string(), - ); - } - if f.arity > 2 { - return Err(format!( - "takes {} parameters; the arity-free templates did not match this body, and the recursion, ADT-construction, variant-dispatch, String and composition templates take one or two arguments", - f.arity - )); - } - Err("body does not match a certified template (straight-line add-constant, single-argument self-recursion, two-argument accumulator recursion, or non-recursive ADT constructor/projection/match)".to_string()) -} - -#[derive(Clone)] -enum InstrNode { - Op(Op), - IfElse(Vec, Vec), -} - -struct StructuralBody { - normalized_ops: Vec, - tree: Vec, -} - -fn walk_nonrecursive( - f: &UserFn, - box_idx: Option, - carrier: Option, - user_idx_set: &std::collections::HashSet, - host_roles: &std::collections::HashMap, - struct_field_counts: &std::collections::HashMap, -) -> Option { - if f.arity == 0 { - return None; - } - let body = structural_body(f, box_idx, user_idx_set, host_roles)?; - nr_adt_constructor(f, &body, box_idx, carrier) - .or_else(|| nr_field_projection(f, &body, carrier, struct_field_counts)) - .or_else(|| nr_ref_dispatch_match(f, &body, box_idx, carrier, host_roles)) - .or_else(|| nr_verbatim_variant_dispatch(f, &body, carrier)) - .or_else(|| nr_string_eq_verbatim_match(f, &body, carrier, host_roles)) - .or_else(|| nr_string_concat_verbatim_match(f, &body, carrier, host_roles)) - .or_else(|| nr_variant_dispatch(f, &body, box_idx, carrier, host_roles)) -} diff --git a/aver-cert/src/engine/classify_expr_fragment.rs b/aver-cert/src/engine/classify_expr_fragment.rs deleted file mode 100644 index ce5021cac..000000000 --- a/aver-cert/src/engine/classify_expr_fragment.rs +++ /dev/null @@ -1,3 +0,0 @@ -include!("classify_expr_fragment_lift.rs"); -include!("classify_expr_fragment_plan_check.rs"); -include!("classify_expr_fragment_lower_ops.rs"); diff --git a/aver-cert/src/engine/classify_expr_fragment_lift.rs b/aver-cert/src/engine/classify_expr_fragment_lift.rs deleted file mode 100644 index 856ad6e36..000000000 --- a/aver-cert/src/engine/classify_expr_fragment_lift.rs +++ /dev/null @@ -1,387 +0,0 @@ -fn expr_fragment_ty_from_wasm_param(ty: &TyKind, carrier: u32) -> Option { - match ty { - TyKind::F64 => Some(FragTy::F64), - TyKind::I32 => Some(FragTy::BoolI32), - TyKind::Ref { idx, .. } if *idx == carrier => Some(FragTy::IntCarrier), - // Any other concrete reference is an opaque user-ADT/record reference. - // Fail-closed downstream: plans over `AdtRef` are accepted ONLY when - // they match the exact field-projection face. - TyKind::Ref { .. } => Some(FragTy::AdtRef), - _ => None, - } -} - -fn expr_fragment_ty_from_wasm_result(ty: TyKind, carrier: u32) -> Option { - match ty { - TyKind::F64 => Some(FragTy::F64), - TyKind::I32 => Some(FragTy::BoolI32), - TyKind::Ref { idx, .. } if idx == carrier => Some(FragTy::IntCarrier), - TyKind::Ref { .. } => Some(FragTy::AdtRef), - _ => None, - } -} - -/// The Lean `List (HostRole × Nat)` literal of the byte-derived host-role -/// table for a whole module. `aver cert verify` splices this into its kernel -/// witness (and the emitter into `Plans.lean`/`Artifact.lean`), so source-plan -/// encoding always runs against byte-derived indices, never plan-supplied -/// ones. The table itself is derived inside `disassemble` (exact carrier-binop -/// signature + first-i64-arith body shape + uniqueness, fail-closed). -pub fn byte_derived_frag_host_table_lean(wasm_bytes: &[u8]) -> Result { - let (_user_fns, _box_idx, _user_idx_set, _carrier, _host_roles, host_table, _struct_field_counts) = - disassemble(wasm_bytes)?; - Ok(host_table.lean_value()) -} - -/// Raw Rust-classifier result used by the permanent kernel differential. The -/// production trust path is `AcceptedArtifact.arithTableCheck`: `box` and -/// `toIndex` are bound by their runtime export names and each declared -/// add/sub/mul index is pinned to its synthesized helper body. This helper -/// keeps the Rust classifier available as an independent transition oracle -/// over the full fixture corpus; it is not what the certificate trusts. -pub fn byte_derived_frag_host_role_indices( - wasm_bytes: &[u8], -) -> Result { - let ( - _user_fns, - _box_idx, - _user_idx_set, - _carrier, - _host_roles, - host_table, - _struct_field_counts, - ) = disassemble(wasm_bytes)?; - Ok(( - host_table.box_idx, - host_table.add_idx, - host_table.mul_idx, - host_table.sub_idx, - host_table.to_index_idx, - host_table.cmp_idx, - host_table.eq_idx, - )) -} - -/// Raw Rust F5-classifier result used by the permanent kernel differential. -/// Entries are sorted by function index and include every independent match; -/// there is deliberately no uniqueness filter for string roles. -pub fn byte_derived_string_host_roles( - wasm_bytes: &[u8], -) -> Result { - let ( - _user_fns, - _box_idx, - _user_idx_set, - _carrier, - host_roles, - _host_table, - _struct_field_counts, - ) = disassemble(wasm_bytes)?; - Ok(string_host_roles(&host_roles)) -} - -/// Every `call` in a candidate expr-fragment body must resolve through the -/// byte-derived host-role table; any other callee fail-closes producer -/// classification (recursion, user calls, unknown helpers). -fn frag_calls_resolvable(calls: &[u32], table: &FragHostTable) -> bool { - calls - .iter() - .all(|idx| { - Some(*idx) == table.box_idx - || Some(*idx) == table.add_idx - || Some(*idx) == table.mul_idx - || Some(*idx) == table.sub_idx - || Some(*idx) == table.to_index_idx - || Some(*idx) == table.cmp_idx - || Some(*idx) == table.eq_idx - }) -} - -/// Fail-closed validation that every `hostCall` node in a checked plan cites -/// exactly the byte-derived index for its role. -fn check_plan_host_calls(block: &FragBlock, table: &FragHostTable) -> Result<(), String> { - for node in &block.nodes { - match &node.kind { - FragNodeKind::HostCall { role, func_idx, .. } - if table.lookup(*role) != Some(*func_idx) => - { - return Err(format!( - "plan hostcall v{} cites function {} for role `{}`, but the \ - byte-derived host-role table resolves it to {:?}", - node.id.0, - func_idx, - role.plan_tag(), - table.lookup(*role) - )); - } - FragNodeKind::HostCall { .. } => {} - FragNodeKind::VectorGetOrDefault { - to_index_idx, - box_idx, - .. - } => { - if table.to_index_idx != Some(*to_index_idx) { - return Err(format!( - "plan fused vector read v{} cites function {} for role `to_index`, but the byte-derived host-role table resolves it to {:?}", - node.id.0, to_index_idx, table.to_index_idx - )); - } - if table.box_idx != Some(*box_idx) { - return Err(format!( - "plan fused vector read v{} cites function {} for role `box`, but the byte-derived host-role table resolves it to {:?}", - node.id.0, box_idx, table.box_idx - )); - } - } - FragNodeKind::If { - then_block, - else_block, - .. - } => { - check_plan_host_calls(then_block, table)?; - check_plan_host_calls(else_block, table)?; - } - _ => {} - } - } - Ok(()) -} - -// `FragProjectFace` and the other face recognisers live in -// `expr_fragment_faces.rs` (`plans` layer): the producer's MIR adapter gates -// plan emission on the same faces the classifier admits. - -/// Fail-closed validation of every `struct.get.user` node against the -/// byte-derived module struct context: the cited type index must be a real -/// module struct type, must not be the Int carrier, and the field must be -/// inside the struct's field count — the projection twin of the hostCall -/// func-idx-vs-role-table check. -fn check_plan_struct_gets( - block: &FragBlock, - carrier: u32, - struct_field_counts: &std::collections::HashMap, -) -> Result<(), String> { - for node in &block.nodes { - match &node.kind { - FragNodeKind::StructGetUser { ty_idx, field, .. } => { - let Some(count) = struct_field_counts.get(ty_idx) else { - return Err(format!( - "plan struct.get.user v{} cites type {} outside the module's struct types", - node.id.0, ty_idx - )); - }; - if *ty_idx == carrier { - return Err(format!( - "plan struct.get.user v{} cites the Int carrier type {}", - node.id.0, ty_idx - )); - } - if field >= count { - return Err(format!( - "plan struct.get.user v{} cites field {} outside struct {}'s {} fields", - node.id.0, field, ty_idx, count - )); - } - } - FragNodeKind::StructNew { ty_idx, args } => { - let Some(count) = struct_field_counts.get(ty_idx) else { - return Err(format!( - "plan struct.new v{} cites type {} outside the module's struct types", - node.id.0, ty_idx - )); - }; - if *ty_idx == carrier { - return Err(format!( - "plan struct.new v{} cites the Int carrier type {}", - node.id.0, ty_idx - )); - } - if args.len() as u32 != *count { - return Err(format!( - "plan struct.new v{} packs {} values into struct {}'s {} fields", - node.id.0, - args.len(), - ty_idx, - count - )); - } - } - FragNodeKind::VectorGetOrDefault { arr_ty, .. } if *arr_ty == carrier => { - return Err(format!( - "plan fused vector read v{} cites the Int carrier type {} as its array", - node.id.0, arr_ty - )); - } - FragNodeKind::If { - then_block, - else_block, - .. - } => { - check_plan_struct_gets(then_block, carrier, struct_field_counts)?; - check_plan_struct_gets(else_block, carrier, struct_field_counts)?; - } - _ => {} - } - } - Ok(()) -} - -fn collect_sym_block_named_tys(block: &SymBlock, out: &mut Vec) { - for node in &block.nodes { - if let SymTy::Named(name) = &node.ty - && !out.contains(name) - { - out.push(name.clone()); - } - match &node.kind { - SymNodeKind::TagMatch { hit, miss, .. } => { - collect_sym_block_named_tys(hit, out); - collect_sym_block_named_tys(miss, out); - } - SymNodeKind::If { - then_block, - else_block, - .. - } => { - collect_sym_block_named_tys(then_block, out); - collect_sym_block_named_tys(else_block, out); - } - _ => {} - } - } -} - -fn check_sym_block_projection_owners(block: &SymBlock) -> Result<(), String> { - for node in &block.nodes { - match &node.kind { - SymNodeKind::ProjectField { - type_name, value, .. - } => { - let got = block.nodes.get(value.0).map(|n| n.ty.clone()); - if got != Some(SymTy::Named(type_name.clone())) { - return Err(format!( - "project.field v{} claims owner type `{}`, but its value is declared `{}`", - node.id.0, - SymTy::display_source_type_name(type_name), - got.map(|ty| ty.plan_tag()).unwrap_or_else(|| "".to_string()) - )); - } - } - SymNodeKind::If { - then_block, - else_block, - .. - } => { - check_sym_block_projection_owners(then_block)?; - check_sym_block_projection_owners(else_block)?; - } - SymNodeKind::TagMatch { hit, miss, .. } => { - check_sym_block_projection_owners(hit)?; - check_sym_block_projection_owners(miss)?; - } - _ => {} - } - } - Ok(()) -} - -/// Fail-closed intra-plan consistency for source-level type names. Names are -/// producer-asserted annotations with the MODEL trust story (see -/// docs/certification.md "Read surface"): the kernel-checked content of a -/// projection claim is the byte-derived struct identity (type index + field -/// index), never the name. What CAN be checked is internal consistency, so a -/// relabel must be total across the artifact or decline: -/// - every `named:` source type used anywhere in the plan (params, result, -/// node types) must be anchored by a `project.field` owner — and therefore -/// bound to a byte-derived struct index by the struct table; unanchored -/// names decline; -/// - every projection's claimed owner must be exactly the declared type of -/// the value it projects from. -fn check_sym_plan_named_consistency(plan: &SymPlan) -> Result<(), String> { - let owners = sym_plan_project_type_names(plan); - let mut used = Vec::new(); - for ty in plan.params.iter().chain(std::iter::once(&plan.result)) { - if let SymTy::Named(name) = ty - && !used.contains(name) - { - used.push(name.clone()); - } - } - collect_sym_block_named_tys(&plan.body, &mut used); - for name in &used { - if !owners.contains(name) { - return Err(format!( - "source type `{}` is never projected, so no byte-derived struct binding anchors it", - SymTy::display_source_type_name(name) - )); - } - } - check_sym_block_projection_owners(&plan.body) -} - -/// Byte-derived struct table for ONE export's source plan: the plan's -/// `project.field` type names bound to the export body's own (unique, -/// non-carrier) `struct.get` type index. Names come from the source plan, -/// indices come only from the module bytes, and artifact acceptance pins the -/// pairing. Fail-closed: no projections → empty table; more -/// than one projected type name or more than one distinct byte-level -/// `struct.get` type → decline. -fn byte_derived_frag_struct_table( - sym_plan: &SymPlan, - f: &UserFn, - carrier: u32, - struct_field_counts: &std::collections::HashMap, -) -> Result { - let names = sym_plan_project_type_names(sym_plan); - if names.is_empty() { - return Ok(FragStructTable::default()); - } - let [name] = names.as_slice() else { - return Err(format!( - "source plan projects {} distinct types; the field-projection face admits one", - names.len() - )); - }; - // The fused vector read binds its one type name to the body's own - // `array.get` type; every struct-shaped face binds a `struct.get` type. - let uses_vector_get = sym_plan_has_vector_get(sym_plan); - let mut tys = f - .ops - .iter() - .filter_map(|op| match op { - Op::StructGet(t, _) if !uses_vector_get && *t != carrier => Some(*t), - Op::StructNew(t, _) if !uses_vector_get && *t != carrier => Some(*t), - Op::ArrayGet(t) if uses_vector_get && *t != carrier => Some(*t), - _ => None, - }) - .collect::>(); - tys.sort_unstable(); - tys.dedup(); - let [ty_idx] = tys.as_slice() else { - return Err(format!( - "export body must contain exactly one non-carrier {} type to bind `{name}`, found {}", - if uses_vector_get { - "array.get" - } else { - "struct.get" - }, - tys.len() - )); - }; - if !uses_vector_get && !struct_field_counts.contains_key(ty_idx) { - return Err(format!( - "byte-derived struct.get type {ty_idx} is not a module struct type" - )); - } - let mut table = FragStructTable::default(); - table.insert(name, *ty_idx); - Ok(table) -} - -/// Whether a source plan contains the monolithic fused vector-read node. -fn sym_plan_has_vector_get(plan: &SymPlan) -> bool { - plan.body - .nodes - .iter() - .any(|node| matches!(node.kind, SymNodeKind::VectorGetOrDefault { .. })) -} diff --git a/aver-cert/src/engine/classify_expr_fragment_lower.rs b/aver-cert/src/engine/classify_expr_fragment_lower.rs deleted file mode 100644 index 453d1e43f..000000000 --- a/aver-cert/src/engine/classify_expr_fragment_lower.rs +++ /dev/null @@ -1,399 +0,0 @@ -// Canonical BYTE lowering of expression-fragment plans — the producer-side -// half the wasm-gc emitter calls at emit time (`plans` layer). The `Op`-level -// twin the classifier re-derives against lives in -// `classify_expr_fragment_lower_ops.rs` (`engine` layer). - -pub fn lower_expr_fragment_plan_function( - plan: &ExprFragmentPlan, - carrier: u32, -) -> Result { - let carrier_ref = wasm_encoder::ValType::Ref(wasm_encoder::RefType { - nullable: true, - heap_type: wasm_encoder::HeapType::Concrete(carrier), - }); - let mut func = wasm_encoder::Function::new([(1, carrier_ref)]); - func.raw(lower_expr_fragment_plan_expr_bytes(plan, carrier)?); - Ok(func) -} - -fn lower_expr_fragment_plan_expr_bytes( - plan: &ExprFragmentPlan, - carrier: u32, -) -> Result, String> { - let mut out = Vec::new(); - lower_expr_fragment_block_bytes(&plan.body, carrier, &mut out)?; - out.push(0x0b); - Ok(out) -} - -fn lower_expr_fragment_plan_body_bytes( - plan: &ExprFragmentPlan, - carrier: u32, -) -> Result, String> { - let mut out = Vec::new(); - // `expr-fragment-v1` is pinned to the current wasm-gc cert island shape: - // one unused scratch local of the Int carrier reference type, followed by - // the canonical expression body. - push_u32_leb(&mut out, 1); - push_u32_leb(&mut out, 1); - out.push(0x63); - push_s33_heap_idx(&mut out, carrier); - out.extend(lower_expr_fragment_plan_expr_bytes(plan, carrier)?); - Ok(out) -} - -pub fn lower_expr_fragment_plan_code_entry_bytes( - plan: &ExprFragmentPlan, - carrier: u32, -) -> Result, String> { - let body = lower_expr_fragment_plan_body_bytes(plan, carrier)?; - let body_len = u32::try_from(body.len()) - .map_err(|_| "expr-fragment body is too large to encode".to_string())?; - let mut out = Vec::new(); - push_u32_leb(&mut out, body_len); - out.extend(body); - Ok(out) -} - -fn lower_expr_fragment_block_bytes( - block: &FragBlock, - carrier: u32, - out: &mut Vec, -) -> Result<(), String> { - let mut stack = Vec::::new(); - for node in &block.nodes { - match &node.kind { - FragNodeKind::Local { index } => { - out.push(0x20); - push_u32_leb(out, *index); - stack.push(node.id); - } - FragNodeKind::ConstBool(value) => { - out.push(0x41); - push_i32_leb(out, if *value { 1 } else { 0 }); - stack.push(node.id); - } - FragNodeKind::ConstI64(value) => { - out.push(0x42); - push_i64_leb(out, *value); - stack.push(node.id); - } - FragNodeKind::ConstI32(value) => { - out.push(0x41); - push_i32_leb(out, *value); - stack.push(node.id); - } - FragNodeKind::ConstF64(bits) => { - out.push(0x44); - out.extend(bits.to_le_bytes()); - stack.push(node.id); - } - FragNodeKind::StructGet { field, receiver } => { - lower_pop(&mut stack, *receiver, node.id)?; - out.push(0xfb); - push_u32_leb(out, 0x02); - push_u32_leb(out, carrier); - push_u32_leb(out, *field); - stack.push(node.id); - } - FragNodeKind::StructGetUser { - ty_idx, - field, - value, - } => { - lower_pop(&mut stack, *value, node.id)?; - out.push(0xfb); - push_u32_leb(out, 0x02); - push_u32_leb(out, *ty_idx); - push_u32_leb(out, *field); - stack.push(node.id); - } - FragNodeKind::RefIsNull { value } => { - lower_pop(&mut stack, *value, node.id)?; - out.push(0xd1); - stack.push(node.id); - } - FragNodeKind::StructNew { ty_idx, args } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - out.push(0xfb); - push_u32_leb(out, 0x00); - push_u32_leb(out, *ty_idx); - stack.push(node.id); - } - FragNodeKind::Prim { op, args } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - push_prim_opcode(out, *op); - stack.push(node.id); - } - FragNodeKind::HostCall { func_idx, args, .. } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - out.push(0x10); - push_u32_leb(out, *func_idx); - stack.push(node.id); - } - FragNodeKind::SelfCall { - tail, - func_idx, - args, - } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - out.push(if *tail { 0x12 } else { 0x10 }); - push_u32_leb(out, *func_idx); - stack.push(node.id); - } - FragNodeKind::VectorGetOrDefault { - arr_ty, - to_index_idx, - box_idx, - default, - } => { - // Monolithic fused template over pinned locals 0/1 (byte twin - // of `PlanBytes`' arm). Consumes no operand stack values. - if !stack.is_empty() { - return Err(format!( - "canonical byte lowering for fused vector read v{} \ - requires an empty stack", - node.id.0 - )); - } - out.push(0x20); - push_u32_leb(out, 1); - out.push(0x10); - push_u32_leb(out, *to_index_idx); - out.push(0x41); - push_i32_leb(out, 0); - out.push(0x4e); - out.push(0x20); - push_u32_leb(out, 1); - out.push(0x10); - push_u32_leb(out, *to_index_idx); - out.push(0x20); - push_u32_leb(out, 0); - out.push(0xfb); - push_u32_leb(out, 0x0f); - out.push(0x49); - out.push(0x71); - out.push(0x04); - out.push(0x63); - push_s33_heap_idx(out, carrier); - out.push(0x20); - push_u32_leb(out, 0); - out.push(0x20); - push_u32_leb(out, 1); - out.push(0x10); - push_u32_leb(out, *to_index_idx); - out.push(0xfb); - push_u32_leb(out, 0x0b); - push_u32_leb(out, *arr_ty); - out.push(0x05); - out.push(0x42); - push_i64_leb(out, *default); - out.push(0x10); - push_u32_leb(out, *box_idx); - out.push(0x0b); - stack.push(node.id); - } - FragNodeKind::IntSignCmp { - op, - constant, - scratch, - value, - } => { - // Monolithic sign template (byte twin of - // `PlanBytes.intSignCmpTemplateBytes`): stash the operand in - // the declared scratch local, test `limbs = null`, then decide - // on the `small` field or on the sign field alone. - lower_pop(&mut stack, *value, node.id)?; - out.push(0x21); - push_u32_leb(out, *scratch); - out.push(0x20); - push_u32_leb(out, *scratch); - out.push(0xfb); - push_u32_leb(out, 0x02); - push_u32_leb(out, carrier); - push_u32_leb(out, 1); - out.push(0xd1); - out.push(0x04); - out.push(0x7f); - out.push(0x20); - push_u32_leb(out, *scratch); - out.push(0xfb); - push_u32_leb(out, 0x02); - push_u32_leb(out, carrier); - push_u32_leb(out, 0); - out.push(0x42); - push_i64_leb(out, *constant); - push_prim_opcode(out, int_sign_cmp_small_prim(*op)); - out.push(0x05); - match int_sign_cmp_sign_prim(*op) { - None => { - out.push(0x41); - push_i32_leb(out, 0); - } - Some(prim) => { - out.push(0x20); - push_u32_leb(out, *scratch); - out.push(0xfb); - push_u32_leb(out, 0x02); - push_u32_leb(out, carrier); - push_u32_leb(out, 2); - out.push(0x41); - push_i32_leb(out, 0); - push_prim_opcode(out, prim); - } - } - out.push(0x0b); - stack.push(node.id); - } - FragNodeKind::If { - cond, - then_block, - else_block, - } => { - lower_pop(&mut stack, *cond, node.id)?; - // Values already on the stack stay beneath the branch, as the - // wasm `if` leaves the remaining operand stack in place (twin - // of `PlanBytes`' arm; `InterpreterSequencing.wRunF_frame`). - out.push(0x04); - push_expr_fragment_blocktype(out, node.ty, carrier)?; - lower_expr_fragment_block_bytes(then_block, carrier, out)?; - out.push(0x05); - lower_expr_fragment_block_bytes(else_block, carrier, out)?; - out.push(0x0b); - stack.push(node.id); - } - } - } - if stack.as_slice() != [block.result] { - return Err(format!( - "canonical byte lowering final stack {} does not equal block result v{}", - render_fragment_value_stack(&stack), - block.result.0 - )); - } - Ok(()) -} - -fn push_expr_fragment_blocktype(out: &mut Vec, ty: FragTy, carrier: u32) -> Result<(), String> { - match ty { - FragTy::BoolI32 | FragTy::RawI32 => out.push(0x7f), - FragTy::I64 => out.push(0x7e), - FragTy::F64 => out.push(0x7c), - // An Int-carrier `if` result (the value-if of a fuel-recursion body) is - // the ref-null heap type `63 `. - FragTy::IntCarrier => { - out.push(0x63); - push_s33_heap_idx(out, carrier); - } - FragTy::Ref | FragTy::AdtRef => { - return Err(format!( - "canonical byte lowering does not support if result `{}` yet", - ty.plan_tag() - )); - } - } - Ok(()) -} - -fn push_prim_opcode(out: &mut Vec, op: FragPrim) { - out.push(match op { - FragPrim::F64Add => 0xa0, - FragPrim::F64Mul => 0xa2, - FragPrim::F64Le => 0x65, - FragPrim::F64Ge => 0x66, - FragPrim::F64Lt => 0x63, - FragPrim::F64Gt => 0x64, - FragPrim::F64Eq => 0x61, - FragPrim::I64Eq => 0x51, - FragPrim::I64LtS => 0x53, - FragPrim::I64LeS => 0x57, - FragPrim::I64GeS => 0x59, - FragPrim::I64GtS => 0x55, - FragPrim::I32Eq => 0x46, - FragPrim::I32LtS => 0x48, - FragPrim::I32GtS => 0x4a, - FragPrim::I32GeS => 0x4e, - FragPrim::I32And => 0x71, - }); -} - -/// Concrete heap-type indices (inside a reftype `0x63/0x64 `, a block type, -/// or a `ref.cast`/`ref.test`/`ref.null` immediate) are encoded as SIGNED s33 -/// LEB128 per the Wasm spec, not unsigned: index 64 is `c0 00`, never `40`. -/// Indices below 64 coincide with the unsigned encoding. Instruction TYPE -/// indices (`struct.get`, `array.new_data`, ...) stay unsigned u32. Twin of -/// `PlanBytes.s33HeapIdx`. -fn push_s33_heap_idx(out: &mut Vec, idx: u32) { - push_i64_leb(out, idx as i64); -} - -fn push_u32_leb(out: &mut Vec, mut value: u32) { - loop { - let mut byte = (value & 0x7f) as u8; - value >>= 7; - if value != 0 { - byte |= 0x80; - } - out.push(byte); - if value == 0 { - break; - } - } -} - -fn push_i32_leb(out: &mut Vec, value: i32) { - push_i64_leb(out, value as i64); -} - -fn push_i64_leb(out: &mut Vec, mut value: i64) { - loop { - let byte = (value as u8) & 0x7f; - value >>= 7; - let sign_set = (byte & 0x40) != 0; - let done = (value == 0 && !sign_set) || (value == -1 && sign_set); - out.push(if done { byte } else { byte | 0x80 }); - if done { - break; - } - } -} - -fn lower_pop( - stack: &mut Vec, - expected: FragValueId, - node: FragValueId, -) -> Result<(), String> { - let got = stack - .pop() - .ok_or_else(|| format!("canonical lowering stack underflow at v{}", node.0))?; - if got == expected { - Ok(()) - } else { - Err(format!( - "canonical lowering for v{} expected stack value v{}, got v{}", - node.0, expected.0, got.0 - )) - } -} - -fn render_fragment_value_stack(stack: &[FragValueId]) -> String { - if stack.is_empty() { - return "[]".to_string(); - } - format!( - "[{}]", - stack - .iter() - .map(|id| format!("v{}", id.0)) - .collect::>() - .join(",") - ) -} diff --git a/aver-cert/src/engine/classify_expr_fragment_lower_ops.rs b/aver-cert/src/engine/classify_expr_fragment_lower_ops.rs deleted file mode 100644 index fa61235e6..000000000 --- a/aver-cert/src/engine/classify_expr_fragment_lower_ops.rs +++ /dev/null @@ -1,210 +0,0 @@ -// `Op`-level canonical lowering of expression-fragment plans. This is the -// checker-side twin of the byte lowering in `classify_expr_fragment_lower.rs`: -// the classifier re-derives a straight-line `Op` body from the plan and -// compares it against the disassembled artifact. It lives in the `engine` -// layer because `Op` is a classifier type; the byte lowering the wasm-gc -// emitter needs stays in the `plans` layer. - -fn lower_expr_fragment_plan(plan: &ExprFragmentPlan, carrier: u32) -> Result, String> { - lower_expr_fragment_block(&plan.body, carrier) -} - -fn lower_expr_fragment_block(block: &FragBlock, carrier: u32) -> Result, String> { - let mut ops = Vec::new(); - let mut stack = Vec::::new(); - for node in &block.nodes { - match &node.kind { - FragNodeKind::Local { index } => { - ops.push(Op::LocalGet(*index)); - stack.push(node.id); - } - FragNodeKind::ConstBool(value) => { - ops.push(Op::I32Const(if *value { 1 } else { 0 })); - stack.push(node.id); - } - FragNodeKind::ConstI64(value) => { - ops.push(Op::I64Const(*value)); - stack.push(node.id); - } - FragNodeKind::ConstI32(value) => { - ops.push(Op::I32Const(*value)); - stack.push(node.id); - } - FragNodeKind::ConstF64(bits) => { - ops.push(Op::F64Const(*bits)); - stack.push(node.id); - } - FragNodeKind::StructGet { field, receiver } => { - lower_pop(&mut stack, *receiver, node.id)?; - ops.push(Op::StructGet(carrier, *field)); - stack.push(node.id); - } - FragNodeKind::StructGetUser { - ty_idx, - field, - value, - } => { - lower_pop(&mut stack, *value, node.id)?; - ops.push(Op::StructGet(*ty_idx, *field)); - stack.push(node.id); - } - FragNodeKind::RefIsNull { value } => { - lower_pop(&mut stack, *value, node.id)?; - ops.push(Op::RefIsNull); - stack.push(node.id); - } - FragNodeKind::Prim { op, args } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - ops.push(op_to_wasm(*op)); - stack.push(node.id); - } - FragNodeKind::HostCall { func_idx, args, .. } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - ops.push(Op::Call(*func_idx)); - stack.push(node.id); - } - FragNodeKind::SelfCall { - tail, - func_idx, - args, - } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - ops.push(if *tail { - Op::ReturnCall(*func_idx) - } else { - Op::Call(*func_idx) - }); - stack.push(node.id); - } - FragNodeKind::VectorGetOrDefault { - arr_ty, - to_index_idx, - box_idx, - default, - } => { - // Monolithic template over pinned locals 0/1; consumes no - // operand stack values, so it is canonical only as the sole - // value (twin of `PlanLower.vectorGetOrDefaultTemplate`). - if !stack.is_empty() { - return Err(format!( - "fused vector read v{} requires an empty stack", - node.id.0 - )); - } - ops.extend([ - Op::LocalGet(1), - Op::Call(*to_index_idx), - Op::I32Const(0), - Op::I32GeS, - Op::LocalGet(1), - Op::Call(*to_index_idx), - Op::LocalGet(0), - Op::ArrayLen, - Op::I32LtU, - Op::I32And, - Op::If, - Op::LocalGet(0), - Op::LocalGet(1), - Op::Call(*to_index_idx), - Op::ArrayGet(*arr_ty), - Op::Else, - Op::I64Const(*default), - Op::Call(*box_idx), - Op::End, - ]); - stack.push(node.id); - } - FragNodeKind::StructNew { ty_idx, args } => { - for arg in args.iter().rev() { - lower_pop(&mut stack, *arg, node.id)?; - } - ops.push(Op::StructNew(*ty_idx, args.len() as u32)); - stack.push(node.id); - } - FragNodeKind::IntSignCmp { - op, - constant, - scratch, - value, - } => { - // Monolithic sign template (twin of - // `PlanLower.intSignCmpTemplate`). - lower_pop(&mut stack, *value, node.id)?; - ops.extend([ - Op::LocalSet(*scratch), - Op::LocalGet(*scratch), - Op::StructGet(carrier, 1), - Op::RefIsNull, - Op::If, - Op::LocalGet(*scratch), - Op::StructGet(carrier, 0), - Op::I64Const(*constant), - op_to_wasm(int_sign_cmp_small_prim(*op)), - Op::Else, - ]); - match int_sign_cmp_sign_prim(*op) { - None => ops.push(Op::I32Const(0)), - Some(prim) => ops.extend([ - Op::LocalGet(*scratch), - Op::StructGet(carrier, 2), - Op::I32Const(0), - op_to_wasm(prim), - ]), - } - ops.push(Op::End); - stack.push(node.id); - } - FragNodeKind::If { - cond, - then_block, - else_block, - } => { - lower_pop(&mut stack, *cond, node.id)?; - // Values already on the stack stay beneath the branch (twin - // of `PlanLower`'s arm; `InterpreterSequencing.wRunF_frame`). - ops.push(Op::If); - ops.extend(lower_expr_fragment_block(then_block, carrier)?); - ops.push(Op::Else); - ops.extend(lower_expr_fragment_block(else_block, carrier)?); - ops.push(Op::End); - stack.push(node.id); - } - } - } - if stack.as_slice() != [block.result] { - return Err(format!( - "canonical lowering final stack {} does not equal block result v{}", - render_fragment_value_stack(&stack), - block.result.0 - )); - } - Ok(ops) -} - -fn op_to_wasm(op: FragPrim) -> Op { - match op { - FragPrim::F64Add => Op::F64Add, - FragPrim::F64Mul => Op::F64Mul, - FragPrim::F64Le => Op::F64Le, - FragPrim::F64Ge => Op::F64Ge, - FragPrim::F64Lt => Op::F64Lt, - FragPrim::F64Gt => Op::F64Gt, - FragPrim::F64Eq => Op::F64Eq, - FragPrim::I64Eq => Op::I64Eq, - FragPrim::I64LeS => Op::I64LeS, - FragPrim::I64LtS => Op::I64LtS, - FragPrim::I64GeS => Op::I64GeS, - FragPrim::I64GtS => Op::I64GtS, - FragPrim::I32Eq => Op::I32Eq, - FragPrim::I32And => Op::I32And, - FragPrim::I32LtS => Op::I32LtS, - FragPrim::I32GtS => Op::I32GtS, - FragPrim::I32GeS => Op::I32GeS, - } -} diff --git a/aver-cert/src/engine/classify_expr_fragment_plan_check.rs b/aver-cert/src/engine/classify_expr_fragment_plan_check.rs deleted file mode 100644 index 9df0c73c3..000000000 --- a/aver-cert/src/engine/classify_expr_fragment_plan_check.rs +++ /dev/null @@ -1,537 +0,0 @@ -fn check_expr_fragment_plan_object( - wasm_bytes: &[u8], - export_name: &str, - plan: ExprFragmentPlan, -) -> Result<(usize, Cert, bool, Option), String> { - let (user_fns, _box_idx, _user_idx_set, carrier, _host_roles, host_table, struct_field_counts) = - disassemble(wasm_bytes)?; - let (func_order, f) = user_fns - .iter() - .enumerate() - .find(|(_, f)| f.name == export_name) - .ok_or_else(|| format!("plan names unknown export `{export_name}`"))?; - // Zero-arity exports are legitimate compute-face targets (constant - // constructors); the per-face parameter checks and the exact nominal - // signature pin keep every other family fail-closed. - if !frag_calls_resolvable(&f.calls, &host_table) { - return Err(format!( - "plan for `{export_name}` does not target a non-recursive expr fragment" - )); - } - let carrier = carrier.ok_or_else(|| { - format!("plan for `{export_name}` needs the Int carrier type from the wasm module") - })?; - let params = f - .params - .iter() - .map(|ty| expr_fragment_ty_from_wasm_param(ty, carrier)) - .collect::>>() - .ok_or_else(|| format!("plan for `{export_name}` has unsupported wasm parameter types"))?; - let result = expr_fragment_ty_from_wasm_result( - f.result - .ok_or_else(|| format!("plan for `{export_name}` targets a function with no result"))?, - carrier, - ) - .ok_or_else(|| format!("plan for `{export_name}` has unsupported wasm result type"))?; - // Fail-closed host-call discipline: every hostCall node must cite exactly - // the byte-derived index for its role. Carrier-returning plans and - // host-call-bearing plans alike are admitted only as one of the exact - // recognised faces below; anything else is declined here, mirroring the - // producer gate in `expr_fragment_plan_has_face`, which reads the same two - // predicates so the pair cannot drift apart. - check_plan_host_calls(&plan.body, &host_table) - .map_err(|e| format!("plan for `{export_name}`: {e}"))?; - // Fail-closed struct discipline: every struct.get.user node must cite a - // real module struct type (never the carrier) and a field inside its - // byte-derived field count, mirroring the hostCall index-vs-table check. - check_plan_struct_gets(&plan.body, carrier, &struct_field_counts) - .map_err(|e| format!("plan for `{export_name}`: {e}"))?; - let tag_dispatch = expr_fragment_is_tag_dispatch(&plan); - let vector_get = expr_fragment_vector_get_face(&plan).is_some(); - let record_proj = expr_fragment_record_proj_face(&plan).is_some(); - // The Int selection face calls a runtime helper and returns an Int - // carrier, so it would trip the gate below without its own admission. - let int_cmp = expr_fragment_int_select_face(&plan).is_some(); - let record_compute = expr_fragment_record_compute_face(&plan, &host_table).is_some(); - if (expr_fragment_plan_has_host_calls(&plan) || plan.result == FragTy::IntCarrier) - && !tag_dispatch - && !vector_get - && !record_proj - && !int_cmp - && !record_compute - { - return Err(format!( - "plan for `{export_name}` has no rendered proof face: Int-carrier results \ - and runtime host calls are supported only through the tag-dispatch, \ - fused vector-read, record field-read, Int selection, or record \ - projection-compute face" - )); - } - // Face-gated AdtRef admission (the FIX-1 pattern): plans touching opaque - // user-ADT references are accepted ONLY as an exact recognised face; - // anything else declines fail-closed on producer and verifier alike. - if expr_fragment_plan_touches_adt_ref(&plan) - && expr_fragment_project_face(&plan).is_none() - && !tag_dispatch - && !vector_get - && !record_proj - && !record_compute - { - return Err(format!( - "plan for `{export_name}` has no rendered proof face: user-ADT references \ - are supported only through the field-projection, fused vector-read, or \ - record field-read face" - )); - } - if plan.params != params { - return Err(format!( - "plan for `{export_name}` has params {:?}, but wasm signature requires {:?}", - plan.params, params - )); - } - if plan.result != result { - return Err(format!( - "plan for `{export_name}` has result {:?}, but wasm signature requires {:?}", - plan.result, result - )); - } - // The ordinary WebAssembly profile admits multiple sign and, in arithmetic - // NaN cases, payload bit patterns for an arithmetic NaN result. - // Our current Float codomain face is `floatBitsRepr`, i.e. equality with - // one exact `UInt64`. It is therefore not a sound face for a Float result - // that depends on f64.add/f64.mul over the unrestricted raw-bit domain. - // Keep comparisons such as f64.le: their Bool result is deterministic even - // when either operand is NaN. Re-enable Float-producing arithmetic only - // after the schema has a relational NaN result representation (or a - // separately declared deterministic/canonicalizing Wasm profile). - if expr_fragment_needs_relational_nan_result(&plan) { - return Err(format!( - "plan for `{export_name}`: general Wasm allows multiple NaN sign/payload results for \ - f64.add/f64.mul; exact-bit Float output needs a relational result model" - )); - } - let canonical_ops = lower_expr_fragment_plan(&plan, carrier)?; - let actual_ops = strip_trailing_end(&f.ops); - let canonical_code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(&plan, carrier)?; - let ops_match = canonical_ops.as_slice() == actual_ops; - let bytes_match = canonical_code_entry_bytes == f.code_entry_bytes; - let cert = Cert::ExprFragment { - name: export_name.to_string(), - self_idx: f.wasm_idx, - type_idx: f.type_idx, - nlocals: f.nlocals, - carrier, - source_plan: None, - record_decl: None, - record_compute: None, - plan: plan.clone(), - ops: canonical_ops, - }; - let mismatch_reason = if ops_match && bytes_match { - None - } else { - Some(format!( - "decoded_ops_match={ops_match}, {}", - byte_match_summary( - "code_entry_bytes", - &canonical_code_entry_bytes, - &f.code_entry_bytes - ) - )) - }; - Ok((func_order, cert, ops_match && bytes_match, mismatch_reason)) -} - -fn expr_fragment_needs_relational_nan_result(plan: &ExprFragmentPlan) -> bool { - plan.result == FragTy::F64 && block_has_nan_nondeterministic_float_op(&plan.body) -} - -fn block_has_nan_nondeterministic_float_op(block: &FragBlock) -> bool { - // Deliberately exhaustive: extending FragNodeKind must force an explicit - // decision about nested blocks and Float-bit observation at this gate. - block.nodes.iter().any(|node| match &node.kind { - // Packs already-computed values; observes no Float bits itself. - FragNodeKind::StructNew { .. } => false, - FragNodeKind::Prim { op, .. } => prim_has_nan_nondeterministic_float_result(op), - FragNodeKind::If { - then_block, - else_block, - .. - } => { - block_has_nan_nondeterministic_float_op(then_block) - || block_has_nan_nondeterministic_float_op(else_block) - } - FragNodeKind::Local { .. } - | FragNodeKind::ConstBool(_) - | FragNodeKind::ConstI64(_) - | FragNodeKind::ConstI32(_) - | FragNodeKind::ConstF64(_) - | FragNodeKind::StructGet { .. } - | FragNodeKind::StructGetUser { .. } - | FragNodeKind::RefIsNull { .. } - | FragNodeKind::HostCall { .. } - | FragNodeKind::SelfCall { .. } - | FragNodeKind::VectorGetOrDefault { .. } - // Yields the source Boolean; observes no Float bits. - | FragNodeKind::IntSignCmp { .. } => false, - }) -} - -fn prim_has_nan_nondeterministic_float_result(op: &FragPrim) -> bool { - match op { - FragPrim::F64Add | FragPrim::F64Mul => true, - FragPrim::F64Le - | FragPrim::F64Ge - | FragPrim::F64Lt - | FragPrim::F64Gt - | FragPrim::F64Eq - | FragPrim::I64Eq - | FragPrim::I64LeS - | FragPrim::I64LtS - | FragPrim::I64GeS - | FragPrim::I64GtS - | FragPrim::I32Eq - | FragPrim::I32LtS - | FragPrim::I32GtS - | FragPrim::I32GeS - | FragPrim::I32And => false, - } -} - -/// Decode the ordered scalar-leaf field list of a stage-1 flat scalar record at -/// `struct_idx` from the module type section, byte-for-byte the inverse of the -/// wall's `lowerTypeDecl`: an immutable `(ref null carrier)` field is the Int -/// carrier leaf, an immutable `i32` is the Bool scalar, an immutable `f64` is -/// the Float scalar. Any other shape (a nullary/exact ref, a mutable field, a -/// supertype `.sub` form, a non-carrier reference, an unexpected storage, or a -/// missing/oversized index) makes the struct NOT a flat scalar record, so the -/// projection declines fail-closed rather than emitting a record face the wall -/// equality pin would refuse. -fn record_leaves_from_bytes( - wasm_bytes: &[u8], - carrier: u32, - struct_idx: u32, -) -> Option> { - use wasmparser::{CompositeInnerType, Parser, Payload, StorageType, ValType}; - let mut next_type_idx: u32 = 0; - for payload in Parser::new(0).parse_all(wasm_bytes) { - let Payload::TypeSection(reader) = payload.ok()? else { - continue; - }; - for rg in reader { - for sub in rg.ok()?.into_types() { - let idx = next_type_idx; - next_type_idx += 1; - if idx != struct_idx { - continue; - } - // `lowerTypeDecl` only ever produces a `.plain` struct: a - // supertyped `.sub`/`.subFinal` form cannot satisfy the - // equality pin, so decline it here rather than at the kernel. - if sub.supertype_idx.is_some() { - return None; - } - let CompositeInnerType::Struct(st) = &sub.composite_type.inner else { - return None; - }; - let mut leaves = Vec::with_capacity(st.fields.len()); - for field in st.fields.iter() { - // Records lower to immutable fields; a mutable storage never - // matches `lowerTypeDecl`'s immutable leaf. - if field.mutable { - return None; - } - let leaf = match field.element_type { - StorageType::Val(ValType::I32) => RecordLeaf::BoolScalar, - StorageType::Val(ValType::F64) => RecordLeaf::FloatScalar, - StorageType::Val(ValType::Ref(rt)) => { - // The Int carrier leaf lowers to `(ref null carrier)` - // exactly: a nullable concrete reference at the - // module's carrier index. - if !rt.is_nullable() || heap_type_index(rt.heap_type()) != Some(carrier) - { - return None; - } - RecordLeaf::IntCarrier - } - _ => return None, - }; - leaves.push(leaf); - } - return Some(leaves); - } - } - } - None -} - -#[cfg(all(test, feature = "engine"))] -mod record_leaves_tests { - use super::*; - - /// A module whose type section holds: index 0 the Int carrier - /// `{i64, anyref, i32}`, index 1 a Person-shaped record - /// `{(ref null carrier), i32}`, index 2 a `{f64, (ref null carrier)}` - /// record, index 3 a struct with a mutable field. - fn fixture() -> Vec { - wat::parse_str( - r#"(module - (type $carrier (struct (field i64) (field anyref) (field i32))) - (type $person (struct (field (ref null $carrier)) (field i32))) - (type $floaty (struct (field f64) (field (ref null $carrier)))) - (type $mutrec (struct (field (mut i32)))))"#, - ) - .expect("fixture module assembles") - } - - #[test] - fn decodes_flat_scalar_records() { - let bytes = fixture(); - assert_eq!( - record_leaves_from_bytes(&bytes, 0, 1), - Some(vec![RecordLeaf::IntCarrier, RecordLeaf::BoolScalar]) - ); - assert_eq!( - record_leaves_from_bytes(&bytes, 0, 2), - Some(vec![RecordLeaf::FloatScalar, RecordLeaf::IntCarrier]) - ); - } - - #[test] - fn declines_wrong_struct_index() { - let bytes = fixture(); - // Out of range. - assert_eq!(record_leaves_from_bytes(&bytes, 0, 99), None); - // The carrier struct itself is not a flat scalar record (its first - // field is a raw `i64`, not a leaf storage). - assert_eq!(record_leaves_from_bytes(&bytes, 0, 0), None); - } - - #[test] - fn declines_scalar_leaf_type_mismatch() { - let bytes = fixture(); - // A reference field that does NOT point at the claimed carrier index is - // not the Int carrier leaf: the record decodes to nothing (fail-closed), - // so the equality pin can never ride a doppelganger carrier. - assert_eq!(record_leaves_from_bytes(&bytes, 5, 1), None); - } - - #[test] - fn declines_mutable_field() { - let bytes = fixture(); - // Records lower to immutable fields; a mutable storage never matches. - assert_eq!(record_leaves_from_bytes(&bytes, 0, 3), None); - } -} - -fn check_sym_fragment_plan_object( - wasm_bytes: &[u8], - export_name: &str, - sym_plan: SymPlan, -) -> Result<(usize, Cert, bool, Option), String> { - let (user_fns, _box_idx, _user_idx_set, carrier, _host_roles, host_table, struct_field_counts) = - disassemble(wasm_bytes)?; - let (_func_order, f) = user_fns - .iter() - .enumerate() - .find(|(_, f)| f.name == export_name) - .ok_or_else(|| format!("source plan names unknown export `{export_name}`"))?; - // Zero-arity exports are legitimate compute-face targets (constant - // constructors); the per-face parameter checks and the exact nominal - // signature pin keep every other family fail-closed. - if !frag_calls_resolvable(&f.calls, &host_table) { - return Err(format!( - "source plan for `{export_name}` does not target a non-recursive expr fragment" - )); - } - let carrier = carrier.ok_or_else(|| { - format!("source plan for `{export_name}` needs the Int carrier type from the wasm module") - })?; - let frag_params = f - .params - .iter() - .map(|ty| expr_fragment_ty_from_wasm_param(ty, carrier)) - .collect::>>() - .ok_or_else(|| { - format!("source plan for `{export_name}` has unsupported wasm parameter types") - })?; - let frag_result = expr_fragment_ty_from_wasm_result( - f.result.ok_or_else(|| { - format!("source plan for `{export_name}` targets a function with no result") - })?, - carrier, - ) - .ok_or_else(|| format!("source plan for `{export_name}` has unsupported wasm result type"))?; - // Encode-compatibility: each declared source type must ENCODE to the - // byte-derived wasm representation type at its position. Scalars - // round-trip exactly; `AdtRef` positions adopt the declared String/Named - // source type (bytes cannot name it) — the byte-exact gate then pins the - // adoption through the encoded plan. - let declared_params = sym_plan - .params - .iter() - .map(SymTy::to_frag_ty) - .collect::>>(); - if declared_params.as_deref() != Some(frag_params.as_slice()) { - return Err(format!( - "source plan for `{export_name}` has params {:?}, but the wasm signature requires source types encoding to {frag_params:?}", - sym_plan - .params - .iter() - .map(SymTy::plan_tag) - .collect::>() - )); - } - if sym_plan.result.to_frag_ty() != Some(frag_result) { - return Err(format!( - "source plan for `{export_name}` has result `{}`, but the wasm signature requires a source type encoding to {frag_result:?}", - sym_plan.result.plan_tag() - )); - } - if sym_plan.body.result_ty() != Some(sym_plan.result.clone()) { - return Err(format!( - "source plan for `{export_name}` root type does not match function result type" - )); - } - // Source-level type names carry the model trust story (see - // docs/certification.md "Read surface"): they are not byte-derivable, but - // they must be internally consistent — every used name anchored by a - // projection, every projection owner matching its value's declared type. - check_sym_plan_named_consistency(&sym_plan) - .map_err(|e| format!("source plan for `{export_name}`: {e}"))?; - // Struct bindings are byte-derived per export (the export's own unique - // non-carrier struct.get), never taken from the plan; encoding under - // this table plus canonical byte equality pins the pairing. - let struct_table = byte_derived_frag_struct_table(&sym_plan, f, carrier, &struct_field_counts) - .map_err(|e| format!("source plan for `{export_name}`: {e}"))?; - let plan = sym_plan - .to_expr_fragment_plan(&host_table, &struct_table) - .ok_or_else(|| { - format!("source plan for `{export_name}` cannot be encoded to expr-fragment-v1") - })?; - let (func_order, mut cert, canonical_matches_actual, mismatch_reason) = - check_expr_fragment_plan_object(wasm_bytes, export_name, plan)?; - let Cert::ExprFragment { - source_plan, - record_decl, - record_compute, - plan, - carrier, - .. - } = &mut cert - else { - unreachable!("expr-fragment plan checker must return an expr-fragment cert") - }; - *source_plan = Some(sym_plan.clone()); - // Stage-1 record scalar field read: derive the record's ordered scalar-leaf - // declaration from the module type section at the projected struct index, so - // the wall pins the whole declaration by equality against those same bytes. - // A recognized record projection whose struct is not a flat scalar record - // declines fail-closed here rather than rendering a record face the wall - // equality pin would refuse. - if let Some(face) = expr_fragment_record_proj_face(plan) { - match record_leaves_from_bytes(wasm_bytes, *carrier, face.struct_idx) { - Some(leaves) => *record_decl = Some((face.struct_idx, leaves)), - None => { - return Err(format!( - "source plan for `{export_name}` reads a record field, but struct index {} \ - does not decode to a flat scalar record", - face.struct_idx - )); - } - } - } - // Record projection-compute face (v1): recognized only when the pinned - // struct decodes to a flat ALL-Int record; otherwise the export simply - // stays on the source-level-only route (no error — the face is optional). - if record_compute.is_none() - && let Some(face) = expr_fragment_record_compute_face(plan, &host_table) - { - if expr_fragment_plan_uses_struct(plan) { - // A record-shaped plan carries its declaration: the wall pins the - // type-section entry at the cited index by equality against it. - if let Some(leaves) = record_leaves_from_bytes(wasm_bytes, *carrier, face.struct_idx) - && leaves.iter().all(|l| matches!(l, RecordLeaf::IntCarrier)) - { - *record_decl = Some((face.struct_idx, leaves)); - *record_compute = Some(face); - } - } else { - // A scalar-parameter plan names no record at all; the face's - // reserved index `0` reads no type-section entry, and the wall's - // declared face demands none. - *record_compute = Some(face); - } - } - if record_compute.is_none() && plan_contains_struct_new(&plan.body) { - return Err(format!( - "source plan for `{export_name}` constructs a struct outside the \ - compute face (its record is not a flat all-Int declaration)" - )); - } - // Same fail-closed shape for the inline sign template: the compute face is - // the only face that interprets it, and the generic renderers have no arm - // for it. - if record_compute.is_none() && plan_contains_int_sign_cmp(&plan.body) { - return Err(format!( - "source plan for `{export_name}` compares a computed Int against a \ - literal outside the compute face" - )); - } - Ok((func_order, cert, canonical_matches_actual, mismatch_reason)) -} - -fn byte_match_summary(label: &str, expected: &[u8], actual: &[u8]) -> String { - if expected == actual { - return format!("{label}_match=true, len={}", actual.len()); - } - let first_diff = expected - .iter() - .zip(actual) - .position(|(expected, actual)| expected != actual); - match first_diff { - Some(idx) => format!( - "{label}_match=false, expected_len={}, actual_len={}, first_diff={} expected=0x{:02x} actual=0x{:02x}", - expected.len(), - actual.len(), - idx, - expected[idx], - actual[idx] - ), - None => format!( - "{label}_match=false, expected_len={}, actual_len={}, first_diff=len", - expected.len(), - actual.len() - ), - } -} - -fn plan_contains_int_sign_cmp(block: &FragBlock) -> bool { - block.nodes.iter().any(|n| match &n.kind { - FragNodeKind::IntSignCmp { .. } => true, - FragNodeKind::If { - then_block, - else_block, - .. - } => { - plan_contains_int_sign_cmp(then_block) - || plan_contains_int_sign_cmp(else_block) - } - _ => false, - }) -} - -fn plan_contains_struct_new(block: &FragBlock) -> bool { - block.nodes.iter().any(|n| match &n.kind { - FragNodeKind::StructNew { .. } => true, - FragNodeKind::If { - then_block, - else_block, - .. - } => { - plan_contains_struct_new(then_block) - || plan_contains_struct_new(else_block) - } - _ => false, - }) -} diff --git a/aver-cert/src/engine/classify_model.rs b/aver-cert/src/engine/classify_model.rs deleted file mode 100644 index 5331856b3..000000000 --- a/aver-cert/src/engine/classify_model.rs +++ /dev/null @@ -1,182 +0,0 @@ -/// Symbolically execute a body-consumed fuel recursion's step arm — a -/// straight-line stack program ending in the host `add` — and recover -/// `(sub, add, rec_first, other)`: which host helpers are the descent/combinator, -/// which side of the `add` the recursive result sits on, and what the other -/// operand is. The descent is pinned to `sub(input, box 1)` = `n-1`; anything the -/// evaluator cannot account for (foreign locals, a second add, a non-descent -/// self-call argument) fails, so the recogniser stays fail-closed. -fn parse_body_step( - ops: &[Op], - box_idx: u32, - self_idx: u32, - host_roles: &std::collections::HashMap, -) -> Option<(u32, u32, bool, BodyOperand)> { - use Op::*; - #[derive(Clone, Copy, PartialEq)] - enum V { - Input, - IntLit(i64), - Boxed(i64), - Descent, - Rec, - } - // The step is ` add`; the trailing `add` - // combines the top two stack values. - let (last, init) = ops.split_last()?; - let Call(add_idx) = last else { return None }; - if !matches!( - host_roles.get(add_idx), - Some(HostRole::Add) | Some(HostRole::Mul) - ) { - return None; - } - let mut st: Vec = Vec::new(); - let mut sub_idx: Option = None; - for op in init { - match op { - LocalGet(0) => st.push(V::Input), - I64Const(k) => st.push(V::IntLit(*k)), - Call(idx) if *idx == box_idx => { - let V::IntLit(k) = st.pop()? else { return None }; - st.push(V::Boxed(k)); - } - Call(idx) if *idx == self_idx => { - if st.pop()? != V::Descent { - return None; - } - st.push(V::Rec); - } - Call(idx) if host_roles.get(idx) == Some(&HostRole::Sub) => { - let b = st.pop()?; - let a = st.pop()?; - if a != V::Input || b != V::Boxed(1) { - return None; - } - if sub_idx.is_some_and(|s| s != *idx) { - return None; - } - sub_idx = Some(*idx); - st.push(V::Descent); - } - _ => return None, - } - } - // exactly the two `add` operands remain. - let [a, b] = st.as_slice() else { return None }; - let operand = |v: &V| match v { - V::Input => Some(BodyOperand::Input), - V::Boxed(k) => Some(BodyOperand::Const(*k)), - _ => None, - }; - let (rec_first, other) = if *a == V::Rec { - (true, operand(b)?) - } else if *b == V::Rec { - (false, operand(a)?) - } else { - return None; - }; - Some((sub_idx?, *add_idx, rec_first, other)) -} - -/// The combinator operator of each `X__fuel` model definition's else-branch: -/// `+` (add) or `*` (mul). The bytes cannot distinguish the bignum helpers, so -/// this is the producer's source of the operation. Lean derives and checks the -/// corresponding standard face from the emitted plan. The descent (`n - 1`) -/// uses `-`, so it never -/// confuses the scan; the recognised body shapes carry no other arithmetic. -fn model_step_ops(model_files: &[(String, String)]) -> std::collections::HashMap { - // Flat key -> (qualified name that claimed it, combinator operator). - let mut ops: std::collections::HashMap = - std::collections::HashMap::new(); - // Flat keys claimed by two different definitions. This parser must agree - // with `ModelInfo::parse_lean`: a collision makes the combinator a guess, - // so the key is dropped and the recursion classifier declines rather than - // reading the operator off whichever definition happened to parse last. - let mut ambiguous = std::collections::HashSet::new(); - let entry_root = entry_model_root(model_files); - for (path, content) in model_files { - // Same user-only file predicate as `ModelInfo::from_files`: the - // prelude defines no user model and must not claim flat keys. - if !is_user_model_file(path) { - continue; - } - let entry_namespace = if model_file_root(path).as_ref() == entry_root.as_ref() { - entry_root.as_deref() - } else { - None - }; - let lines: Vec<&str> = content.lines().collect(); - // Track the namespace stack exactly like `ModelInfo::parse_lean`, so - // a dependency module's `X__fuel` is keyed by its FLAT export-space - // name (`Prefix_X`) and the classifier's export-name lookup hits it. - let mut ns_stack: Vec = Vec::new(); - for i in 0..lines.len() { - let line = lines[i].trim(); - if let Some(rest) = line.strip_prefix("namespace ") - && let Some(ns) = rest.split_whitespace().next() - && rest.trim() == ns - { - ns_stack.push(ns.to_string()); - continue; - } - if let Some(rest) = line.strip_prefix("end ") - && ns_stack.last().map(String::as_str) == Some(rest.trim()) - { - ns_stack.pop(); - continue; - } - let Some(rest) = line.strip_prefix("def ") else { - continue; - }; - let Some(fuel_pos) = rest.find("__fuel ") else { - continue; - }; - let prefix = ns_stack.join("."); - let bare = &rest[..fuel_pos]; - // The qualified Lean name identifies the definition; the flat name - // is the wasm-export-space key the classifier looks up. - let qualified = if prefix.is_empty() { - bare.to_string() - } else { - format!("{prefix}.{bare}") - }; - let name = if entry_namespace == Some(prefix.as_str()) { - bare.to_string() - } else { - qualified.replace('.', "_") - }; - if ambiguous.contains(&name) { - continue; - } - for l in lines.iter().skip(i).take(8) { - if let Some(p) = l.find("else ") { - let els = &l[p + 5..]; - let op = if els.contains('*') { - Some('*') - } else if els.contains('+') { - Some('+') - } else { - None - }; - if let Some(op) = op { - match ops.get(&name) { - // Two DISTINCT definitions flattening onto one key: - // drop it so no combinator is guessed. - Some((existing, _)) if *existing != qualified => { - ops.remove(&name); - ambiguous.insert(name.clone()); - } - _ => { - ops.insert(name.clone(), (qualified.clone(), op)); - } - } - } - break; - } - } - } - } - ops.into_iter() - .map(|(name, (_, op))| (name, op)) - .collect() -} diff --git a/aver-cert/src/engine/classify_recursion.rs b/aver-cert/src/engine/classify_recursion.rs deleted file mode 100644 index d38f33b8a..000000000 --- a/aver-cert/src/engine/classify_recursion.rs +++ /dev/null @@ -1,307 +0,0 @@ -/// Structurally recognise fuel self-recursion from the parsed instruction tree: -/// f n = if n≤0 then BASE else n + f (n-1) (body-consumed, arity 1) -/// f n acc = if n≤0 then acc else f (n-1) (acc + n) (tail accumulator, arity 2) -/// The carrier-sign predicate preamble, the descent (`n-1`) and the combinator -/// (host `add` or `mul`) are pinned; the BASE literal of the arity-1 shape is DATA (any -/// value, recovered from the bytes, not the fixed `0`). Recognition keys on the -/// parsed tree and a symbolic step evaluator; no full opcode sequence is pinned. -fn recognize_fueled_recursion( - f: &UserFn, - box_idx: Option, - carrier: Option, - host_roles: &std::collections::HashMap, - model_ops: &std::collections::HashMap, -) -> Option { - use Op::*; - let carrier = carrier?; - // Both recognised shapes box a constant (base arm / descent), so a module - // without the box helper can never match — decline, don't guess. - let box_idx = box_idx?; - if f.arity != 1 && f.arity != 2 { - return None; - } - let ops = strip_trailing_end(&f.ops); - // Only the self-call, box, and contracted host helpers may be called; no - // foreign user calls, no opaque ops. Must actually recurse. - let mut recurses = false; - for op in ops { - match op { - Op::Call(idx) | Op::ReturnCall(idx) => { - if *idx == f.wasm_idx { - recurses = true; - } else if *idx != box_idx && !host_roles.contains_key(idx) { - return None; - } - } - Op::Other => return None, - _ => {} - } - } - if !recurses { - return None; - } - let normalized = normalize_local_hops(ops); - let mut pos = 0usize; - let tree = parse_instr_tree(&normalized, &mut pos, false)?; - if pos != normalized.len() { - return None; - } - // preamble: localGet 0; structGet carrier 1; refIsNull; - // IfElse(sign-predicate); IfElse(base-arm, step-arm) - let [ - InstrNode::Op(LocalGet(0)), - InstrNode::Op(StructGet(c1, 1)), - InstrNode::Op(RefIsNull), - InstrNode::IfElse(pred_small, pred_big), - InstrNode::IfElse(base_arm, step_arm), - ] = tree.as_slice() - else { - return None; - }; - if *c1 != carrier { - return None; - } - // n≤0 predicate: small = [localGet 0, structGet c 0, i64Const 0, i64LeS]; - // big = [localGet 0, structGet c 2, i32Const 0, i32LtS] - let small_ok = matches!( - node_ops(pred_small).as_slice(), - [LocalGet(0), StructGet(cc, 0), I64Const(0), I64LeS] if *cc == carrier - ); - let big_ok = matches!( - node_ops(pred_big).as_slice(), - [LocalGet(0), StructGet(cc, 2), I32Const(0), I32LtS] if *cc == carrier - ); - if !small_ok || !big_ok { - return None; - } - let is_host = |idx: &u32, role: HostRole| host_roles.get(idx) == Some(&role); - if f.arity == 1 { - // base arm: [i64Const k, call box] — any literal k (the data-driven base). - let base_k = match node_ops(base_arm).as_slice() { - [I64Const(k), Call(b)] if *b == box_idx => *k, - _ => return None, - }; - // step arm: `(_, _)` combining the self-call `f(sub(n,1))` with the - // input `n` or a boxed constant, in either operand order — recovered by - // symbolically executing the straight-line step (descent pinned to n-1). - let (sub_idx, add_idx, rec_first, other) = - parse_body_step(&node_ops(step_arm), box_idx, f.wasm_idx, host_roles)?; - // The source model chooses the semantic operator; the byte-derived host - // role must independently agree with that choice. - let combinator = match model_ops.get(&f.name) { - Some('+') => Combinator::Add, - Some('*') => Combinator::Mul, - _ => return None, - }; - let expected_role = match combinator { - Combinator::Add => HostRole::Add, - Combinator::Mul => HostRole::Mul, - }; - if host_roles.get(&add_idx) != Some(&expected_role) { - return None; - } - // The anti-vacuity guards evaluate the model at fixed samples; a large - // multiplier or base can exceed i128 — decline fail-closed rather than - // overflow-panic in the emitter. - if [3i64, 0, -4] - .iter() - .any(|&s| eval_body_recursion(s, base_k, other, combinator).is_none()) - { - return None; - } - Some(Cert::Recursive { - name: f.name.clone(), - self_idx: f.wasm_idx, - type_idx: f.type_idx, - nlocals: f.nlocals, - carrier, - box_idx, - add_idx, - sub_idx, - base_k, - rec_first, - other, - combinator, - code_entry_bytes: f.code_entry_bytes.clone(), - }) - } else { - // arity 2: accumulator tail recursion; base arm returns the accumulator. - if !matches!(node_ops(base_arm).as_slice(), [LocalGet(1)]) { - return None; - } - // step arm: f(n-1, acc+n) as - // [localGet 0, i64Const 1, call box, call SUB, localGet 1, localGet 0, call ADD, returnCall SELF] - let (sub_idx, add_idx) = match node_ops(step_arm).as_slice() { - [ - LocalGet(0), - I64Const(1), - Call(b), - Call(sub), - LocalGet(1), - LocalGet(0), - Call(add), - ReturnCall(sc), - ] if *b == box_idx - && *sc == f.wasm_idx - && is_host(sub, HostRole::Sub) - && is_host(add, HostRole::Add) => - { - (*sub, *add) - } - _ => return None, - }; - Some(Cert::AccumulatorRecursive { - name: f.name.clone(), - self_idx: f.wasm_idx, - type_idx: f.type_idx, - nlocals: f.nlocals, - carrier, - box_idx, - add_idx, - sub_idx, - code_entry_bytes: f.code_entry_bytes.clone(), - }) - } -} - -/// Recognise one mutual-recursion member body from the parsed tree: -/// `f n = if n≤0 then base else g (n-1)` — a tail cross-call to another user -/// function. Returns `(base_k, cross_idx, sub_idx)`; descent pinned to `n-1`. -/// Shares the carrier-sign preamble/predicate with `recognize_fueled_recursion`. -fn recognize_mutual_member( - f: &UserFn, - box_idx: u32, - carrier: u32, - user_idx_set: &std::collections::HashSet, - host_roles: &std::collections::HashMap, -) -> Option<(i64, u32, u32)> { - use Op::*; - if f.arity != 1 { - return None; - } - let ops = strip_trailing_end(&f.ops); - // The only call is the box; the only tail-call is one other user function; no - // self-call, no foreign user CALL, no opaque ops. - let mut cross: Option = None; - for op in ops { - match op { - Op::ReturnCall(idx) => { - if *idx == f.wasm_idx || !user_idx_set.contains(idx) { - return None; - } - if cross.is_some_and(|c| c != *idx) { - return None; - } - cross = Some(*idx); - } - Op::Call(idx) if *idx != box_idx && !host_roles.contains_key(idx) => { - return None; - } - Op::Other => return None, - _ => {} - } - } - let cross = cross?; - let normalized = normalize_local_hops(ops); - let mut pos = 0usize; - let tree = parse_instr_tree(&normalized, &mut pos, false)?; - if pos != normalized.len() { - return None; - } - let [ - InstrNode::Op(LocalGet(0)), - InstrNode::Op(StructGet(c1, 1)), - InstrNode::Op(RefIsNull), - InstrNode::IfElse(pred_small, pred_big), - InstrNode::IfElse(base_arm, step_arm), - ] = tree.as_slice() - else { - return None; - }; - if *c1 != carrier { - return None; - } - if !matches!( - node_ops(pred_small).as_slice(), - [LocalGet(0), StructGet(cc, 0), I64Const(0), I64LeS] if *cc == carrier - ) || !matches!( - node_ops(pred_big).as_slice(), - [LocalGet(0), StructGet(cc, 2), I32Const(0), I32LtS] if *cc == carrier - ) { - return None; - } - let base_k = match node_ops(base_arm).as_slice() { - [I64Const(k), Call(b)] if *b == box_idx => *k, - _ => return None, - }; - // step arm: [localGet 0, i64Const 1, call box, call SUB, returnCall CROSS] - let sub_idx = match node_ops(step_arm).as_slice() { - [LocalGet(0), I64Const(1), Call(b), Call(sub), ReturnCall(cc)] - if *b == box_idx && *cc == cross && host_roles.get(sub) == Some(&HostRole::Sub) => - { - *sub - } - _ => return None, - }; - Some((base_k, cross, sub_idx)) -} - -/// Recognise a mutually-recursive SCC starting from `f`: follow the tail -/// cross-calls; the chain must return to `f` (a simple cycle) with every member -/// on it a mutual member. Produces this member's `Cert::MutualRecursion` carrying -/// the whole SCC (sorted by `self_idx` so the checker re-derives the same set). -fn recognize_mutual_scc( - f: &UserFn, - box_idx: Option, - carrier: Option, - user_idx_set: &std::collections::HashSet, - fns: &std::collections::HashMap, - host_roles: &std::collections::HashMap, -) -> Option { - let carrier = carrier?; - // Every member's base arm boxes a constant; no box helper, no match. - let box_idx = box_idx?; - let (_, _, sub_idx) = recognize_mutual_member(f, box_idx, carrier, user_idx_set, host_roles)?; - // Walk the cross-call chain from f; it must close back to f. - let mut cycle: Vec = Vec::new(); - let mut cur = f.wasm_idx; - loop { - let uf = fns.get(&cur)?; - let (base_k, cross_idx, s) = - recognize_mutual_member(uf, box_idx, carrier, user_idx_set, host_roles)?; - if s != sub_idx { - return None; // all members share one sub contract - } - cycle.push(MutualMember { - name: uf.name.clone(), - self_idx: cur, - type_idx: uf.type_idx, - nlocals: uf.nlocals, - base_k, - cross_idx, - code_entry_bytes: uf.code_entry_bytes.clone(), - }); - cur = cross_idx; - if cur == f.wasm_idx { - break; - } - if cycle.len() > 64 || cycle.iter().any(|m| m.self_idx == cur) { - return None; // not a simple cycle through f - } - } - if cycle.len() < 2 { - return None; // a 1-cycle is ordinary self-recursion, handled elsewhere - } - let mut scc = cycle; - scc.sort_by_key(|m| m.self_idx); - let position = scc.iter().position(|m| m.self_idx == f.wasm_idx)?; - Some(Cert::MutualRecursion { - name: f.name.clone(), - self_idx: f.wasm_idx, - carrier, - box_idx, - sub_idx, - position, - scc, - }) -} diff --git a/aver-cert/src/engine/classify_structural.rs b/aver-cert/src/engine/classify_structural.rs deleted file mode 100644 index f43e9c18f..000000000 --- a/aver-cert/src/engine/classify_structural.rs +++ /dev/null @@ -1,148 +0,0 @@ -fn structural_body( - f: &UserFn, - box_idx: Option, - user_idx_set: &std::collections::HashSet, - host_roles: &std::collections::HashMap, -) -> Option { - if f.has_loop_or_branch { - return None; - } - let ops = strip_trailing_end(&f.ops); - if ops - .iter() - .any(|op| matches!(op, Op::Other | Op::ReturnCall(_))) - { - return None; - } - for op in ops { - if let Op::Call(idx) = op { - if *idx == f.wasm_idx || user_idx_set.contains(idx) { - return None; - } - // With no box helper in the module, every non-host call is - // unresolvable — strictly fewer bodies parse (fail-closed). - if Some(*idx) != box_idx && !host_roles.contains_key(idx) { - return None; - } - } - } - let normalized_ops = normalize_local_hops(ops); - let mut pos = 0usize; - let tree = parse_instr_tree(&normalized_ops, &mut pos, false)?; - if pos != normalized_ops.len() { - return None; - } - Some(StructuralBody { - normalized_ops, - tree, - }) -} - -fn parse_instr_tree(ops: &[Op], pos: &mut usize, nested: bool) -> Option> { - let mut out = Vec::new(); - while *pos < ops.len() { - match &ops[*pos] { - Op::Else | Op::End if nested => break, - Op::If => { - *pos += 1; - let then_b = parse_instr_tree(ops, pos, true)?; - if !matches!(ops.get(*pos), Some(Op::Else)) { - return None; - } - *pos += 1; - let else_b = parse_instr_tree(ops, pos, true)?; - if !matches!(ops.get(*pos), Some(Op::End)) { - return None; - } - *pos += 1; - out.push(InstrNode::IfElse(then_b, else_b)); - } - Op::Else | Op::End => return None, - op => { - out.push(InstrNode::Op(op.clone())); - *pos += 1; - } - } - } - Some(out) -} - -fn normalize_local_hops(ops: &[Op]) -> Vec { - let mut aliases = std::collections::HashMap::::new(); - let mut out = Vec::new(); - let mut i = 0usize; - while i < ops.len() { - if let (Some(Op::LocalGet(src)), Some(Op::LocalSet(dst))) = (ops.get(i), ops.get(i + 1)) { - let src = *aliases.get(src).unwrap_or(src); - aliases.insert(*dst, src); - i += 2; - continue; - } - let op = match &ops[i] { - Op::LocalGet(idx) => Op::LocalGet(*aliases.get(idx).unwrap_or(idx)), - other => other.clone(), - }; - out.push(op); - i += 1; - } - - let mut changed = true; - while changed { - changed = false; - let mut compact = Vec::new(); - let mut j = 0usize; - while j < out.len() { - if j + 2 < out.len() - && matches!( - out[j], - Op::StructGet(..) - | Op::RefCast(..) - | Op::I64Const(..) - | Op::I32Const(..) - | Op::F64Const(..) - | Op::RefNull(_) - | Op::ArrayNewData { .. } - ) - && matches!((&out[j + 1], &out[j + 2]), (Op::LocalSet(a), Op::LocalGet(b)) if a == b) - { - compact.push(out[j].clone()); - j += 3; - changed = true; - } else { - compact.push(out[j].clone()); - j += 1; - } - } - out = compact; - } - out -} - -fn flat_ops(nodes: &[InstrNode]) -> Vec<&Op> { - let mut out = Vec::new(); - collect_flat_ops(nodes, &mut out); - out -} - -fn collect_flat_ops<'a>(nodes: &'a [InstrNode], out: &mut Vec<&'a Op>) { - for node in nodes { - match node { - InstrNode::Op(op) => out.push(op), - InstrNode::IfElse(then_b, else_b) => { - collect_flat_ops(then_b, out); - collect_flat_ops(else_b, out); - } - } - } -} - -fn node_ops(nodes: &[InstrNode]) -> Vec { - flat_ops(nodes).into_iter().cloned().collect() -} - -fn has_branch(nodes: &[InstrNode]) -> bool { - nodes.iter().any(|node| match node { - InstrNode::Op(_) => false, - InstrNode::IfElse(..) => true, - }) -} diff --git a/aver-cert/src/engine/classify_variant_dispatch.rs b/aver-cert/src/engine/classify_variant_dispatch.rs deleted file mode 100644 index 74e8b2b6e..000000000 --- a/aver-cert/src/engine/classify_variant_dispatch.rs +++ /dev/null @@ -1,150 +0,0 @@ -/// General variant dispatch: walk a `ref.test` chain whose hit arms each -/// reduce to one recognised leaf and whose terminal else is a boxed constant. -/// Anything off this grammar returns `None` (falls through to the honest -/// decline reasons). Recognition keys on the parsed tree only — no full -/// opcode sequence is pinned, so arm count, order and per-arm semantics are -/// byte-derived. -fn nr_variant_dispatch( - f: &UserFn, - body: &StructuralBody, - box_idx: Option, - carrier: Option, - host_roles: &std::collections::HashMap, -) -> Option { - let carrier = carrier?; - // The terminal else is always a boxed constant; no box helper, no match. - let box_idx = box_idx?; - // Typed admission: the byte signature must be exactly one nullable, - // concrete nominal sum-root reference in and one Int carrier out. Full - // wasm validation has already proved that every tested constructor is a - // subtype of that parameter root. - if !matches!(f.params.as_slice(), [TyKind::Ref { nullable: true, .. }]) - || !matches!(f.results.as_slice(), - [TyKind::Ref { nullable: true, idx }] if *idx == carrier) - { - return None; - } - let (arms, default_k) = dispatch_chain(&body.tree, box_idx, host_roles)?; - if arms.is_empty() { - return None; - } - // No duplicate variant tags. - let mut tags: Vec = arms.iter().map(|(t, _)| *t).collect(); - tags.sort_unstable(); - tags.dedup(); - if tags.len() != arms.len() { - return None; - } - // At most one host helper per contract role across all arms. - let mut add_idx = None; - let mut sub_idx = None; - for op in body.normalized_ops.iter() { - let Op::Call(idx) = op else { continue }; - match host_roles.get(idx) { - Some(HostRole::Add) => { - if add_idx.is_some_and(|a: u32| a != *idx) { - return None; - } - add_idx = Some(*idx); - } - Some(HostRole::Sub) => { - if sub_idx.is_some_and(|s: u32| s != *idx) { - return None; - } - sub_idx = Some(*idx); - } - Some(HostRole::Mul) - | Some(HostRole::StringEq) - | Some(HostRole::StringConcat) => return None, - None => {} - } - } - Some(Cert::VariantDispatch { - name: f.name.clone(), - self_idx: f.wasm_idx, - nlocals: f.nlocals, - carrier, - box_idx, - add_idx, - sub_idx, - arms, - default_k, - code_entry_bytes: f.code_entry_bytes.clone(), - ops: strip_trailing_end(&f.ops).to_vec(), - }) -} - -/// Parse `[localGet 0, refTest t, ifElse hit els]` where `els` continues the -/// chain or terminates in a boxed constant. Returns the arms in dispatch order -/// plus the default constant. -fn dispatch_chain( - nodes: &[InstrNode], - box_idx: u32, - host_roles: &std::collections::HashMap, -) -> Option<(Vec<(u32, ArmLeaf)>, i64)> { - let [ - InstrNode::Op(Op::LocalGet(0)), - InstrNode::Op(Op::RefTest(tag)), - InstrNode::IfElse(hit, els), - ] = nodes - else { - // Terminal else: a boxed integer constant. - return match nodes { - [InstrNode::Op(Op::I64Const(k)), InstrNode::Op(Op::Call(b))] if *b == box_idx => { - Some((Vec::new(), *k)) - } - _ => None, - }; - }; - if has_branch(hit) { - return None; - } - let leaf = leaf_of_arm(&node_ops(hit), *tag, box_idx, host_roles)?; - let (mut rest, default_k) = dispatch_chain(els, box_idx, host_roles)?; - rest.insert(0, (*tag, leaf)); - Some((rest, default_k)) -} - -/// Classify one hit arm as a leaf. A nullary (payloadless) constructor's arm is -/// just a boxed constant with NO projection prefix (`i64.const k; call box`). A -/// payload-binding arm opens with the projection `localGet 0; refCast tag; -/// structGet tag 0`; the remainder is either empty (projection), a boxed -/// constant fed to a contracted host with the payload first, or — through the -/// emitter's one-local spill — the constant first. Anything else: no leaf. -fn leaf_of_arm( - ops: &[Op], - tag: u32, - box_idx: u32, - host_roles: &std::collections::HashMap, -) -> Option { - use Op::*; - // Const (nullary) arm: no projection prefix, a boxed constant. - if let [I64Const(k), Call(b)] = ops - && *b == box_idx - { - return Some(ArmLeaf::Const { k: *k }); - } - let rest = match ops { - [LocalGet(0), RefCast(t), StructGet(t2, 0), rest @ ..] if t == &tag && t2 == &tag => rest, - _ => return None, - }; - let role = |idx: &u32| host_roles.get(idx).copied(); - match rest { - [] => Some(ArmLeaf::Proj), - // payload first: x op k - [I64Const(k), Call(b), Call(h)] if *b == box_idx => Some(ArmLeaf::HostOp { - role: role(h)?, - k: *k, - const_first: false, - }), - // constant first through the spill local: k op x - [LocalSet(n), I64Const(k), Call(b), LocalGet(n2), Call(h)] if *b == box_idx && n == n2 => { - Some(ArmLeaf::HostOp { - role: role(h)?, - k: *k, - const_first: true, - }) - } - _ => None, - } -} diff --git a/aver-cert/src/engine/classify_verbatim.rs b/aver-cert/src/engine/classify_verbatim.rs deleted file mode 100644 index 4f91de69c..000000000 --- a/aver-cert/src/engine/classify_verbatim.rs +++ /dev/null @@ -1,349 +0,0 @@ -/// The COMPLETE result-kind vector of a verbatim dispatch must be exactly one -/// result of the kind its fall-through default implies: a scalar `f64` default -/// returns `f64`, and every reference-producing -/// default (`ref.null`, `array.new_data`) — like the field-projection hit of a -/// widened match — returns a NULLABLE reference (`ref null`, the exact form the -/// certified unary nominal-ref -> nullable-result signature promises). A -/// zero-result, two-result, non-nullable-reference, or scalar-integer signature -/// is declined. The plan-backed path is additionally pinned in-kernel to the -/// exact disjoint result-signature variant by `verbatimFuncTypeMatches`. -fn verbatim_results_ok(results: &[TyKind], default: &VerbatimDefault) -> bool { - match default { - VerbatimDefault::F64Bits(_) => matches!(results, [TyKind::F64]), - VerbatimDefault::Null | VerbatimDefault::Array { .. } => { - matches!(results, [TyKind::Ref { nullable: true, .. }]) - } - } -} - -fn verbatim_default_from_ops(ops: &[Op]) -> Option { - match ops { - [Op::RefNull(_)] => Some(VerbatimDefault::Null), - [Op::F64Const(bits)] => Some(VerbatimDefault::F64Bits(*bits)), - [ - Op::I32Const(0), - Op::I32Const(_), - Op::ArrayNewData { - type_idx, - data_idx, - bytes, - }, - ] => Some(VerbatimDefault::Array { - type_idx: *type_idx, - data_idx: *data_idx, - bytes: bytes.clone(), - }), - _ => None, - } -} - -/// A `ref.test` dispatch over a user enum where EVERY arm — hit arms and the -/// terminal else — returns a VERBATIM constant (a String-literal `array.new_data`, -/// a null, or an f64), with no host, no arithmetic, no field projection and no -/// user calls (`unescapedChar`). The generalisation of the verbatim widened match -/// from "one projected hit + a default" to "k constant arms". Certified over -/// `Cod := WVal` / `verbatimRepr`, so no carrier or string representation is -/// needed. Distinct from the variant dispatch (whose hit arms project an Int -/// payload) and the verbatim widened match (whose single hit arm projects a -/// field); a pure-constant hit arm matches neither. -fn nr_verbatim_variant_dispatch( - f: &UserFn, - body: &StructuralBody, - carrier: Option, -) -> Option { - let carrier = carrier?; - // Typed admission: the byte signature must be exactly one nullable concrete - // nominal sum-root value in. Without this a two-parameter dispatch keeps a byte-identical code - // entry (the extra param is overwritten by `local.set`), so a unary obligation - // would be certified for a binary export. The result type is left to the plan - // path: the declared ref-null or f64 result variant is additionally pinned - // in-kernel by `verbatimFuncTypeMatches`. - let [TyKind::Ref { nullable: true, .. }] = f.params.as_slice() else { - return None; - }; - if !f.calls.is_empty() { - return None; - } - // Every arm is a pure verbatim constant: no box, host or any call op. - if body - .normalized_ops - .iter() - .any(|op| matches!(op, Op::Call(_))) - { - return None; - } - let (arms, default) = verbatim_dispatch_chain(&body.tree)?; - if arms.is_empty() { - return None; - } - // Exactly one result of the kind the default implies (and no forged - // extra/zero result). - if !verbatim_results_ok(&f.results, &default) { - return None; - } - let mut tags: Vec = arms.iter().map(|(t, _)| *t).collect(); - tags.sort_unstable(); - tags.dedup(); - if tags.len() != arms.len() { - return None; - } - Some(Cert::VerbatimVariantDispatch { - name: f.name.clone(), - self_idx: f.wasm_idx, - nlocals: f.nlocals, - carrier, - arms, - default, - code_entry_bytes: f.code_entry_bytes.clone(), - ops: strip_trailing_end(&f.ops).to_vec(), - }) -} - -fn nr_string_eq_verbatim_match( - f: &UserFn, - body: &StructuralBody, - carrier: Option, - host_roles: &std::collections::HashMap, -) -> Option { - if f.arity != 1 { - return None; - } - let [TyKind::Ref { idx: param_ty, .. }] = f.params.as_slice() else { - return None; - }; - if !matches!(f.result, Some(TyKind::Ref { idx, .. }) if idx == *param_ty) { - return None; - } - let (arms, default, string_eq_idx) = string_eq_verbatim_chain(&body.tree, host_roles)?; - if arms.len() != 1 { - return None; - } - Some(Cert::StringEqVerbatimMatch { - name: f.name.clone(), - self_idx: f.wasm_idx, - type_idx: f.type_idx, - nlocals: f.nlocals, - carrier: carrier?, - string_eq_idx, - arms, - default, - ops: strip_trailing_end(&f.ops).to_vec(), - }) -} - -/// Recognise a loop-free `String.concat` beachhead: the body builds a container -/// of string arrays (one or more `array.new_data` literals plus the input at -/// `local.get 0`), then invokes the contracted `String.concat` host slot once -/// and returns the result. The container's operand order determines the prefix -/// (literals before the input) and suffix (literals after) lists. -/// -/// Admitted shape (for the first beachhead): exactly ONE `local.get 0` -/// (the input) among the container operands, plus any number of -/// `array.new_data` literals on either side. Any other operand shape (arithmetic, -/// nested calls, struct ops) declines. -fn nr_string_concat_verbatim_match( - f: &UserFn, - body: &StructuralBody, - carrier: Option, - host_roles: &std::collections::HashMap, -) -> Option { - if f.arity != 1 { - return None; - } - let [TyKind::Ref { idx: param_ty, .. }] = f.params.as_slice() else { - return None; - }; - // The result must be a (ref) string array too — concat returns a string. - let Some(TyKind::Ref { idx: result_ty, .. }) = f.result else { - return None; - }; - let string_ty = *param_ty; - if result_ty != string_ty { - return None; - } - // The body must be straight-line (no IfElse nodes) — concat is a pure - // transformation, not a dispatch. - let flat = flatten_ops(&body.tree)?; - // The trailing opcode must be the concat host call. - let (call_op, pre_call) = flat.split_last()?; - let Op::Call(concat_idx) = call_op else { - return None; - }; - if host_roles.get(concat_idx) != Some(&HostRole::StringConcat) { - return None; - } - // Immediately before the call: `array.new_fixed container_ty n`. - let (newfixed_op, operands) = pre_call.split_last()?; - let Op::ArrayNewFixed(container_ty, n) = newfixed_op else { - return None; - }; - let n = *n as usize; - // The container operands are emitted in stack order (first pushed = - // deepest). Each operand is either: - // - the input: `[LocalGet(0)]` - // - a literal: `[I32Const(0), I32Const(len), ArrayNewData(ty, bytes)]` - // Walk the operand list left-to-right; literals before the input become - // prefixes, after become suffixes. Exactly one input must appear. - let mut prefixes = Vec::new(); - let mut suffixes = Vec::new(); - let mut seen_input = false; - let mut parts = 0usize; - let mut i = 0; - while i < operands.len() { - if parts == n { - return None; - } - // Input: a single LocalGet(0). - if matches!(operands[i], Op::LocalGet(0)) { - if seen_input { - return None; // more than one input — decline - } - seen_input = true; - parts += 1; - i += 1; - continue; - } - // Literal: I32Const(0), I32Const(len), ArrayNewData(ty, bytes). - let trio @ [ - Op::I32Const(0), - Op::I32Const(_len), - Op::ArrayNewData { - type_idx: lit_ty, .. - }, - ] = operands.get(i..i + 3)? - else { - return None; // unrecognised operand shape — decline - }; - let _ = trio; - if *lit_ty != string_ty { - return None; // literal must be the same string byte-array type - } - let lit = VerbatimDefault::Array { - type_idx: *lit_ty, - data_idx: match &operands[i + 2] { - Op::ArrayNewData { data_idx, .. } => *data_idx, - _ => return None, - }, - bytes: match &operands[i + 2] { - Op::ArrayNewData { bytes, .. } => bytes.clone(), - _ => return None, - }, - }; - if seen_input { - suffixes.push(lit); - } else { - prefixes.push(lit); - } - parts += 1; - i += 3; - } - if parts != n || !seen_input { - return None; // container has no input — not a beachhead - } - Some(Cert::StringConcatVerbatimMatch { - name: f.name.clone(), - self_idx: f.wasm_idx, - type_idx: f.type_idx, - nlocals: f.nlocals, - // Deliberately NOT `carrier?`. Concatenation reads no carrier, so a - // module that emits no Int carrier at all still certifies here; the - // state is carried through so the byte lowering picks the same locals - // prelude the emitter produced. - carrier, - string_concat_idx: *concat_idx, - container_ty: *container_ty, - result_ty, - prefixes, - suffixes, - ops: strip_trailing_end(&f.ops).to_vec(), - }) -} - -/// Flatten a `Vec` into `Vec` IF it contains no `IfElse` -/// (i.e. the body is straight-line). Returns `None` if any branching node -/// is present — callers use this to reject dispatch-shaped bodies. -fn flatten_ops(tree: &[InstrNode]) -> Option> { - let mut out = Vec::new(); - for node in tree { - match node { - InstrNode::Op(op) => out.push(op.clone()), - InstrNode::IfElse(..) => return None, - } - } - Some(out) -} - -fn string_eq_verbatim_chain( - nodes: &[InstrNode], - host_roles: &std::collections::HashMap, -) -> Option { - use InstrNode::{IfElse, Op as Nop}; - let ops = node_ops(nodes); - if matches!(ops.as_slice(), [Op::LocalGet(0)]) { - return Some((Vec::new(), StringEqDefault::Input, 0)); - } - if let Some(k) = verbatim_default_from_ops(&ops) { - return Some((Vec::new(), StringEqDefault::Verbatim(k), 0)); - } - - let [ - Nop(Op::LocalGet(0)), - maybe_cast @ .., - Nop(Op::I32Const(0)), - Nop(Op::I32Const(_)), - Nop(Op::ArrayNewData { - type_idx, - data_idx, - bytes, - }), - Nop(Op::Call(eq_idx)), - IfElse(hit, els), - ] = nodes - else { - return None; - }; - if !matches!(maybe_cast, [Nop(Op::RefCast(_))] | []) { - return None; - } - if host_roles.get(eq_idx) != Some(&HostRole::StringEq) { - return None; - } - let needle = VerbatimDefault::Array { - type_idx: *type_idx, - data_idx: *data_idx, - bytes: bytes.clone(), - }; - let hit = verbatim_default_from_ops(&node_ops(hit))?; - let (mut rest, default, rest_eq) = string_eq_verbatim_chain(els, host_roles)?; - if rest_eq != 0 && rest_eq != *eq_idx { - return None; - } - let mut arms = vec![(needle, hit)]; - arms.append(&mut rest); - Some((arms, default, *eq_idx)) -} - -/// Parse `[localGet 0, refTest t, ifElse hit els]` where each `hit` is a verbatim -/// constant and `els` continues the chain or terminates in a verbatim constant. -/// Mirrors `dispatch_chain`, but every leaf is a byte-derived constant instead of -/// an Int projection. -fn verbatim_dispatch_chain( - nodes: &[InstrNode], -) -> Option<(Vec<(u32, VerbatimDefault)>, VerbatimDefault)> { - let [ - InstrNode::Op(Op::LocalGet(0)), - InstrNode::Op(Op::RefTest(tag)), - InstrNode::IfElse(hit, els), - ] = nodes - else { - // Terminal else: a verbatim constant. - return verbatim_default_from_ops(&node_ops(nodes)).map(|d| (Vec::new(), d)); - }; - if has_branch(hit) { - return None; - } - let hit_const = verbatim_default_from_ops(&node_ops(hit))?; - let (mut rest, default) = verbatim_dispatch_chain(els)?; - rest.insert(0, (*tag, hit_const)); - Some((rest, default)) -} diff --git a/aver-cert/src/engine/composition_plan_defs.rs b/aver-cert/src/engine/composition_plan_defs.rs deleted file mode 100644 index 0bdb7ee4e..000000000 --- a/aver-cert/src/engine/composition_plan_defs.rs +++ /dev/null @@ -1,212 +0,0 @@ -// Byte-first `composition-plan-v1` builder. -// -// A plan names only the member SHAPE: a self-sum leaf, or an ordered chain of -// callee EXPORT NAMES. Numeric function indices are lowering context derived -// from each named export's Wasm `FuncBinding`; the plan never supplies them. -// Every member is lowered independently and matched byte-for-byte to its real -// code entry. The audited acceptance predicate then follows the call edges in -// those byte-bound plans from the root, rejecting cycles, missing targets, and -// extra members. Thus closure membership is a function of module bytes. - - -#[derive(Clone, PartialEq)] -enum CompositionPlanShape { - SelfSum, - Chain(Vec), -} - -#[derive(Clone, PartialEq)] -struct CompositionRawPlan { - shape: CompositionPlanShape, -} - -fn composition_plan_for_entry( - entry: &ClosureEntry, - names: &std::collections::HashMap, -) -> Option { - let shape = match &entry.shape { - LeafShape::SelfSum { .. } => CompositionPlanShape::SelfSum, - LeafShape::Chain { calls } => CompositionPlanShape::Chain( - calls - .iter() - .map(|idx| names.get(idx).cloned()) - .collect::>>()?, - ), - }; - Some(CompositionRawPlan { shape }) -} - -fn composition_func_table(closure: &[ClosureEntry]) -> std::collections::HashMap { - closure - .iter() - .map(|entry| (entry.name.clone(), entry.self_idx)) - .collect() -} - -fn lower_composition_plan( - plan: &CompositionRawPlan, - add_idx: u32, - funcs: &std::collections::HashMap, -) -> Option> { - let mut ops = vec![Op::LocalGet(0)]; - match &plan.shape { - CompositionPlanShape::SelfSum => { - ops.push(Op::LocalGet(0)); - ops.push(Op::Call(add_idx)); - } - CompositionPlanShape::Chain(callees) if !callees.is_empty() => { - for callee in callees { - ops.push(Op::Call(*funcs.get(callee)?)); - } - } - CompositionPlanShape::Chain(_) => return None, - } - Some(ops) -} - -fn composition_code_entry_bytes( - plan: &CompositionRawPlan, - carrier: u32, - add_idx: u32, - funcs: &std::collections::HashMap, -) -> Option> { - let ops = lower_composition_plan(plan, add_idx, funcs)?; - let expr_plan = ExprFragmentPlan { - params: vec![FragTy::IntCarrier], - result: FragTy::IntCarrier, - body: { - let mut builder = RecBlockBuilder::new(); - let input = builder.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let result = match &plan.shape { - CompositionPlanShape::SelfSum => { - let second = builder.push( - FragTy::IntCarrier, - FragNodeKind::Local { index: 0 }, - ); - builder.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Add, - func_idx: add_idx, - args: vec![input, second], - }, - ) - } - CompositionPlanShape::Chain(callees) => { - let mut value = input; - for callee in callees { - value = builder.push( - FragTy::IntCarrier, - FragNodeKind::SelfCall { - tail: false, - func_idx: *funcs.get(callee)?, - args: vec![value], - }, - ); - } - value - } - }; - builder.finish(result) - }, - }; - let lowered_ops = lower_expr_fragment_plan(&expr_plan, carrier).ok()?; - if lowered_ops != ops { - return None; - } - lower_expr_fragment_plan_code_entry_bytes(&expr_plan, carrier).ok() -} - -/// Rebuild every closure member from shape-only/name-only plan data. All -/// numeric call targets come from the closure's byte-derived export bindings; -/// every lowered entry must equal that member's real code-entry bytes and the -/// canonical lowering's exact one-local declaration. -fn composition_plans_from_cert( - cert: &Cert, - strict: FragHostTable, -) -> Option> { - let Cert::Composition { - carrier, closure, .. - } = cert.inner() - else { - return None; - }; - let add_idx = strict.add_idx?; - let names = closure - .iter() - .map(|entry| (entry.self_idx, entry.name.clone())) - .collect::>(); - let funcs = composition_func_table(closure); - let mut out = Vec::new(); - for entry in closure { - if let LeafShape::SelfSum { add_idx: actual } = &entry.shape - && *actual != add_idx - { - return None; - } - let plan = composition_plan_for_entry(entry, &names)?; - let bytes = composition_code_entry_bytes(&plan, *carrier, add_idx, &funcs)?; - if bytes != entry.code_entry_bytes || entry.nlocals != 1 { - return None; - } - out.push((entry.clone(), plan)); - } - Some(out) -} - -fn composition_member_plans( - analysis: &Analysis, -) -> Vec<(ClosureEntry, CompositionRawPlan)> { - let mut members = std::collections::BTreeMap::< - String, - (ClosureEntry, CompositionRawPlan), - >::new(); - for cert in &analysis.certs { - let Some(plans) = composition_plans_from_cert(cert, analysis.frag_host_table) else { - continue; - }; - for (entry, plan) in plans { - match members.get(&entry.name) { - Some((existing_entry, existing_plan)) => { - if existing_entry.self_idx != entry.self_idx || existing_plan != &plan { - return Vec::new(); - } - } - None => { - members.insert(entry.name.clone(), (entry, plan)); - } - } - } - } - members.into_values().collect() -} - -fn composition_plan_lean_value(plan: &CompositionRawPlan) -> String { - let shape = match &plan.shape { - CompositionPlanShape::SelfSum => ".selfSum".to_string(), - CompositionPlanShape::Chain(callees) => format!( - ".chain [{}]", - callees - .iter() - .map(|name| lean_str(name)) - .collect::>() - .join(", ") - ), - }; - format!("{{ profile := \"composition-plan-v1\", shape := {shape} }}") -} - -fn composition_host_table_lean_value(add_idx: u32) -> String { - format!("[(.add, {add_idx})]") -} - -fn composition_func_table_lean_value(closure: &[ClosureEntry]) -> String { - format!( - "[{}]", - closure - .iter() - .map(|entry| format!("({}, {})", lean_str(&entry.name), entry.self_idx)) - .collect::>() - .join(", ") - ) -} diff --git a/aver-cert/src/engine/construct_plan_defs.rs b/aver-cert/src/engine/construct_plan_defs.rs deleted file mode 100644 index ab9f4b7cc..000000000 --- a/aver-cert/src/engine/construct_plan_defs.rs +++ /dev/null @@ -1,217 +0,0 @@ -#[derive(Clone, Debug, PartialEq, Eq)] -pub enum ConstructFieldPlan { - Local(u32), - Null, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct ConstructPlan { - pub arity: usize, - pub fields: Vec, -} - -fn construct_plan_from_cert(c: &Cert) -> Option { - let Cert::AdtConstructor { - arity, - nlocals, - struct_idx, - field_count, - fields, - ops, - .. - } = c.inner() - else { - return None; - }; - let fields = fields - .iter() - .map(|field| match field { - ConstructorField::Local(index) => Some(ConstructFieldPlan::Local(*index)), - ConstructorField::Null => Some(ConstructFieldPlan::Null), - }) - .collect::>>()?; - let plan = ConstructPlan { - arity: *arity, - fields, - }; - if *nlocals != construct_plan_nlocals(&plan) - || *field_count as usize != plan.fields.len() - || check_construct_plan(&plan).is_err() - || lower_construct_plan(&plan, *struct_idx).ok().as_ref() != Some(ops) - { - return None; - } - Some(plan) -} - -fn construct_plan_nlocals(_plan: &ConstructPlan) -> usize { - // `lower_construct_plan_body_bytes` declares one nullable carrier scratch - // local, independently of constructor arity/field count. - 1 -} - -fn construct_plan_lean_value(plan: &ConstructPlan) -> String { - format!( - "({{ profile := \"construct-v1\", arity := {}, fields := [{}] }} : ConstructRawPlan)", - plan.arity, - plan.fields - .iter() - .map(construct_field_lean_value) - .collect::>() - .join(", ") - ) -} - -fn construct_field_lean_value(field: &ConstructFieldPlan) -> String { - match field { - ConstructFieldPlan::Local(index) => format!(".local {index}"), - ConstructFieldPlan::Null => ".null".to_string(), - } -} - -fn construct_val_type_lean_value(ty: TyKind) -> Option { - match ty { - TyKind::I32 => Some(".i32".to_string()), - TyKind::I64 => Some(".i64".to_string()), - TyKind::F64 => Some(".f64".to_string()), - TyKind::Eqref => Some(".eqref".to_string()), - TyKind::Ref { - nullable: true, - idx, - } => Some(format!(".nullableRef {idx}")), - TyKind::Ref { - nullable: false, .. - } - | TyKind::Other => None, - } -} - -fn lower_construct_plan(plan: &ConstructPlan, struct_idx: u32) -> Result, String> { - check_construct_plan(plan)?; - let mut ops = Vec::new(); - for field in &plan.fields { - match field { - ConstructFieldPlan::Local(index) => ops.push(Op::LocalGet(*index)), - ConstructFieldPlan::Null => ops.push(Op::RefNull(Some(struct_idx))), - } - } - let field_count = u32::try_from(plan.fields.len()) - .map_err(|_| "construct plan has too many fields".to_string())?; - ops.push(Op::StructNew(struct_idx, field_count)); - Ok(ops) -} - -fn lower_construct_plan_code_entry_bytes( - plan: &ConstructPlan, - carrier: u32, - struct_idx: u32, -) -> Result, String> { - let body = lower_construct_plan_body_bytes(plan, carrier, struct_idx)?; - let body_len = u32::try_from(body.len()) - .map_err(|_| "construct body is too large to encode".to_string())?; - let mut out = Vec::new(); - push_u32_leb(&mut out, body_len); - out.extend(body); - Ok(out) -} - -fn lower_construct_plan_body_bytes( - plan: &ConstructPlan, - carrier: u32, - struct_idx: u32, -) -> Result, String> { - check_construct_plan(plan)?; - let mut out = Vec::new(); - push_u32_leb(&mut out, 1); - push_u32_leb(&mut out, 1); - out.push(0x63); - push_s33_heap_idx(&mut out, carrier); - for field in &plan.fields { - match field { - ConstructFieldPlan::Local(index) => { - out.push(0x20); - push_u32_leb(&mut out, *index); - } - ConstructFieldPlan::Null => { - out.push(0xd0); - push_s33_heap_idx(&mut out, struct_idx); - } - } - } - out.push(0xfb); - push_u32_leb(&mut out, 0x00); - push_u32_leb(&mut out, struct_idx); - out.push(0x0b); - Ok(out) -} - -fn check_construct_plan(plan: &ConstructPlan) -> Result<(), String> { - if plan.arity == 0 { - return Err("construct-v1 requires at least one source argument".to_string()); - } - if plan.fields.is_empty() { - return Err("construct-v1 requires at least one target field".to_string()); - } - let mut locals = Vec::new(); - for field in &plan.fields { - match field { - ConstructFieldPlan::Local(index) => { - let index_usize = *index as usize; - if index_usize >= plan.arity { - return Err(format!( - "construct field local {index} is outside arity {}", - plan.arity - )); - } - locals.push(index_usize); - } - ConstructFieldPlan::Null => {} - } - } - locals.sort_unstable(); - locals.dedup(); - let expected = (0..plan.arity).collect::>(); - if locals != expected { - return Err(format!( - "construct fields must use every source argument exactly once, got {locals:?}" - )); - } - Ok(()) -} - -#[cfg(test)] -mod construct_plan_tests { - use super::*; - - #[test] - fn construct_plan_lowers_to_its_ops_and_code_entry() { - let plan = ConstructPlan { - arity: 1, - fields: vec![ConstructFieldPlan::Local(0)], - }; - assert_eq!( - lower_construct_plan(&plan, 7).unwrap(), - vec![Op::LocalGet(0), Op::StructNew(7, 1)] - ); - assert_eq!( - lower_construct_plan_code_entry_bytes(&plan, 18, 7).unwrap(), - vec![10, 1, 1, 99, 18, 32, 0, 251, 0, 7, 11] - ); - } - - #[test] - fn list_singleton_null_tail_uses_byte_derived_struct_index() { - let plan = ConstructPlan { - arity: 1, - fields: vec![ConstructFieldPlan::Local(0), ConstructFieldPlan::Null], - }; - assert_eq!( - lower_construct_plan(&plan, 25).unwrap(), - vec![ - Op::LocalGet(0), - Op::RefNull(Some(25)), - Op::StructNew(25, 2), - ] - ); - } -} diff --git a/aver-cert/src/engine/core_shapes.rs b/aver-cert/src/engine/core_shapes.rs deleted file mode 100644 index ea75bf456..000000000 --- a/aver-cert/src/engine/core_shapes.rs +++ /dev/null @@ -1,73 +0,0 @@ -/// One recognised leaf of a `VariantDispatch` hit arm: what the arm computes -/// from the variant's Int payload. -#[derive(Clone, PartialEq)] -enum ArmLeaf { - /// Return the projected payload unchanged. - Proj, - /// Combine the payload with a boxed constant through a contracted host: - /// `k op x` when `const_first`, else `x op k`. - HostOp { - role: HostRole, - k: i64, - const_first: bool, - }, - /// Return the constant `k` without reading a field: the arm of a nullary - /// (payloadless) constructor, emitted as `i64.const k; call box` with NO - /// projection prefix. - Const { k: i64 }, -} - -/// The straight-line integer shape of one function inside a composition's call -/// closure. Every shape is unary (`Int -> Int`), non-recursive, branch-free, and -/// its simulation lemma is provable over the caller's composed code table by the -/// probe's straight-line skeleton (rcases the host/callee `Option`, cite, close). -#[derive(Clone)] -enum LeafShape { - /// `[localGet 0, localGet 0, call add]` — model `x + x`. - SelfSum { add_idx: u32 }, - /// `[localGet 0, call c1, ..., call cm]` (m >= 1), each `ci` a user function - /// in the closure — model `cm (... (c1 x))`. The composition point. - Chain { calls: Vec }, -} - -/// One function in a composition caller's transitive call closure: its verbatim -/// body (for the shared `CodeTbl`), its self index, and its recognised shape. -#[derive(Clone)] -struct ClosureEntry { - name: String, - self_idx: u32, - type_idx: u32, - nlocals: usize, - code_entry_bytes: Vec, - ops: Vec, - shape: LeafShape, -} - -#[derive(Clone, PartialEq)] -enum VerbatimDefault { - Null, - F64Bits(u64), - Array { - type_idx: u32, - data_idx: u32, - bytes: Vec, - }, -} - -#[derive(Clone, PartialEq)] -enum StringEqDefault { - Input, - Verbatim(VerbatimDefault), -} - -type StringEqVerbatimChain = ( - Vec<(VerbatimDefault, VerbatimDefault)>, - StringEqDefault, - u32, -); - -#[derive(Clone, PartialEq)] -enum ConstructorField { - Local(u32), - Null, -} diff --git a/aver-cert/src/engine/core_wasm.rs b/aver-cert/src/engine/core_wasm.rs deleted file mode 100644 index cb0f109fb..000000000 --- a/aver-cert/src/engine/core_wasm.rs +++ /dev/null @@ -1,316 +0,0 @@ -/// A user function recovered from the emitted module. -#[derive(Clone)] -struct UserFn { - name: String, - wasm_idx: u32, - type_idx: u32, - arity: usize, - /// Byte-level parameter type kinds from the declared function signature. - params: Vec, - /// Byte-level FIRST result type kind (convenience for the many single-result - /// classifiers). `None` when the function returns nothing. - result: Option, - /// Byte-level COMPLETE result-kind vector from the declared function - /// signature. Verbatim routes require this to be exactly one recognized kind - /// (a nullable reference for plan-backed dispatches, `f64` for the scalar - /// legacy route), so a two-result or zero-result signature is rejected. - results: Vec, - nlocals: usize, - /// Raw code-entry bytes: body-size prefix followed by the function body - /// bytes, ending after the final `end`. - code_entry_bytes: Vec, - ops: Vec, - /// call targets in body order, for reason reporting. - calls: Vec, - /// `module.name` of every host capability (function import) this body calls, - /// in body order. Diagnostic only: no certified template admits a call into - /// the import surface, so a non-empty list names the blocker outright. - host_capability_calls: Vec, - /// The declared parameter kinds resolved against the module's own type - /// section, so a decline can say "a String" instead of "a reference to type - /// 20". Diagnostic only; every admission gate reads `params`. - param_shapes: Vec, - /// The declared result kinds, resolved the same way. - result_shapes: Vec, - /// The first instruction in the body that the opcode vocabulary does not - /// model, named as the disassembler saw it. Diagnostic only; `None` when - /// the body is fully in vocabulary or the instruction carried an operand - /// the disassembler could not resolve. - first_unsupported_op: Option, - has_loop_or_branch: bool, -} - -/// What a declared parameter or result actually is, once its wasm type is -/// resolved against the module's own type section. Purely for decline reasons: -/// nothing is admitted or refused on a `ValShape`, so a misreading here can -/// only make a message vaguer, never certify anything. -#[derive(Clone, Copy, PartialEq, Eq)] -enum ValShape { - /// A reference to the Int carrier struct: a boxed `Int`. - Int, - /// A reference to the module's `String` byte-array type. - Str, - /// A reference to a packed byte-array type that is NOT the module's - /// `String` carrier. The backend gives a byte-sequence record — an - /// `exposes opaque` `Bytes` and its kin — the same `(array (mut i8))` - /// representation `String` has, so the wasm type alone does not separate - /// them; the module's own `__rt_string_to_lm` bridge export names which - /// array type is the string one, and everything else packed is this. - BytePayload, - /// Any other reference: a user record, variant or list value. - UserRef, - /// A bare machine scalar (`i64`, `i32`, `f64`) — `Int` in unboxed form, - /// `Bool`, or `Float`. - Scalar, - /// A wasm type outside the certificate's type vocabulary altogether. - Raw, -} - -impl ValShape { - /// Whether the certified fragment treats this shape as an opaque value - /// rather than a number it can compute with. Scalars and boxed `Int`s are - /// the fragment's native vocabulary; everything else is only ever read or - /// built by one of the specific ADT/String templates. - fn outside_scalar_fragment(self) -> bool { - matches!( - self, - ValShape::Str | ValShape::BytePayload | ValShape::UserRef | ValShape::Raw - ) - } - - fn describe(self) -> &'static str { - match self { - ValShape::Int => "an Int", - ValShape::Str => "a String", - ValShape::BytePayload => "an opaque byte-sequence record", - ValShape::UserRef => "a user record, variant or list value", - ValShape::Scalar => "a machine scalar", - ValShape::Raw => "a wasm type the certified fragment does not model", - } - } -} - -#[derive(Clone)] -struct CodeEntry { - nlocals: usize, - code_entry_bytes: Vec, - ops: Vec, - calls: Vec, - has_loop_or_branch: bool, - /// Name of the first instruction the opcode vocabulary does not model, as - /// the disassembler read it. Diagnostic only. - first_unsupported_op: Option, - host_role: Option, - /// The first `i64` arithmetic operator seen in the body — the strict - /// discriminator the plan-first host-role table uses to tell the - /// behavioural `add` helper apart from the `mul` helper (whose umag loops - /// also contain `i64.add`). - first_arith_strict: Option, - /// Result of the certificate decoder's own first-arith body scan, mirrored - /// byte for byte over the body bytes after the locals vector. `None` means - /// the decoder's scan would FAIL on this body (an instruction encoding - /// outside its vocabulary); `Some(first)` is its successful verdict. Used - /// to refuse certification of any module whose module-wide role scan the - /// verifier could never complete. - kernel_arith_scan: Option>, - host_ops: Vec, -} - -/// The minimal opcode surface the two templates need. Anything else is `Other` -/// (which forces a decline) — a certified body never contains an `Other`. -#[derive(Clone, Debug, PartialEq)] -enum Op { - LocalGet(u32), - LocalSet(u32), - I64Const(i64), - I32Const(i32), - F64Const(u64), - RefTest(u32), - RefCast(u32), - StructNew(u32, u32), - StructGet(u32, u32), - ArrayNewData { - type_idx: u32, - data_idx: u32, - bytes: Vec, - }, - ArrayNewDataUnresolved { - type_idx: u32, - data_idx: u32, - offset: i32, - len: i32, - }, - /// `array.new_fixed ty n` — build a fixed-size array of `n` elements from - /// the top `n` stack values. Captured (not `Op::Other`) so the concat - /// recognizer can see the container construction; functions that use it in - /// any shape other than the contracted concat beachhead are still declined. - ArrayNewFixed(u32, u32), - /// `ref.null ` carrying the disassembled heap type. `Some(idx)` is a - /// concrete module type index (e.g. the List struct a widened match's `[]` - /// default nulls); `None` is any abstract heap type (func/extern/none/…), - /// which is not re-lowerable by the plan grammar and so is a fail-closed - /// form. Every classifier ignores the payload (matches `RefNull(_)`), so - /// null-default recognition is unchanged; the index is threaded purely for - /// byte-exact re-lowering in the S2 control-flow grammar. - RefNull(Option), - RefIsNull, - I64Eq, - I64LeS, - I64LtS, - I64GeS, - I64GtS, - F64Add, - F64Mul, - F64Le, - F64Ge, - F64Lt, - F64Gt, - F64Eq, - I32Eq, - I32LtS, - I32GtS, - /// The fused vector-read bounds-check comparisons and combiner, plus the - /// array read itself. Captured (not `Op::Other`) so the fused-read plan - /// re-lowering compares exactly against the disassembled body. - I32LtU, - I32GeS, - I32And, - ArrayLen, - ArrayGet(u32), - If, - Else, - End, - Call(u32), - ReturnCall(u32), - Other, -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -enum HostRole { - Add, - Mul, - Sub, - StringEq, - /// The byte-array concatenation helper (`String.concat` lowering): takes a - /// container array of string-arrays, returns the byte-concatenated array. - StringConcat, -} - -/// Public differential surface for the two byte-exact string helper roles. -/// The production trust path is the audited `CertDecode.StringHost.roleTable` -/// equality; Rust keeps classifying independently as a fail-fast oracle. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum StringHostRole { - Eq, - Concat, -} - -pub type StringHostRoles = Vec<(u32, StringHostRole)>; - -impl StringHostRole { - fn lean_value(self) -> &'static str { - match self { - StringHostRole::Eq => ".eq", - StringHostRole::Concat => ".concat", - } - } - - fn manifest_value(self) -> &'static str { - match self { - StringHostRole::Eq => "stringEq", - StringHostRole::Concat => "stringConcat", - } - } -} - -fn string_host_roles_lean_value(roles: &StringHostRoles) -> String { - format!( - "[{}]", - roles - .iter() - .map(|(idx, role)| format!("({idx}, {})", role.lean_value())) - .collect::>() - .join(", ") - ) -} - -#[derive(Clone, Copy, PartialEq, Eq)] -enum HostOp { - LocalGet(u32), - LocalSet(u32), - I32Const(i32), - ArrayLen, - ArrayGetU(u32), - /// `array.get` (signed/typed, NOT the unsigned `array.get_u`). Used by the - /// concat helper which reads element arrays out of the container array. - ArrayGet(u32), - /// `array.new_default ty` — allocate a zero-filled array of a type index. - /// Used by the concat helper to allocate the result byte array. - ArrayNewDefault(u32), - /// `array.copy dst_ty src_ty` — bulk copy elements between arrays. The two - /// operands are the destination and source array type indices. - ArrayCopy(u32, u32), - I32Ne, - I32GeU, - I32Add, - If, - Block, - Loop, - Br(u32), - BrIf(u32), - Return, - End, - Other, -} - -/// The non-recursive operand of a body-consumed fuel recursion's combinator -/// `f n = if n≤0 then base else `, where `` applies a host -/// arithmetic helper to the self-call result and this operand. From the bytes. -#[derive(Clone, Copy, PartialEq, Eq)] -enum BodyOperand { - /// The descending input `n` (`local.get 0`), as in `sumTo`'s `n + f(n-1)`. - Input, - /// A boxed integer literal, as in `2 + f(n-1)`. - Const(i64), -} - -/// Which arithmetic contract the body-recursion combinator obeys. The model -/// operator selects the semantic evaluator; the distinct byte-derived host role -/// independently pins that selection to the corresponding runtime helper. -#[derive(Clone, Copy, PartialEq, Eq)] -enum Combinator { - /// `f(n-1)` combined with the other operand by integer `+` (host `add`). - Add, - /// integer `*` (host `mul`). - Mul, -} - -impl Combinator { - /// The obligation host slot / theorem contract param this combinator draws. - fn param(self) -> &'static str { - match self { - Combinator::Add => "add", - Combinator::Mul => "mul", - } - } -} - -/// Byte-level summary of one wasm value type in a function signature. Typed -/// admission gates key on these (the shape of the claim as the BYTES declare -/// it) — never on the source model's types, and never on a bare parameter -/// count. -#[derive(Clone, Copy, PartialEq, Eq)] -enum TyKind { - /// Abstract `eq` reference — the emitter's parameter type for a user ADT - /// value that the body dispatches on. - Eqref, - /// Concrete reference to module type `idx`, carrying the declared - /// `nullable` bit (`ref null idx` vs `ref idx`). Nullability is retained - /// rather than erased so a verbatim result can be pinned to the exact - /// `ref null` form the certified signature promises. - Ref { nullable: bool, idx: u32 }, - I64, - I32, - F64, - Other, -} diff --git a/aver-cert/src/engine/declared_envelope.rs b/aver-cert/src/engine/declared_envelope.rs deleted file mode 100644 index 48454ead4..000000000 --- a/aver-cert/src/engine/declared_envelope.rs +++ /dev/null @@ -1,459 +0,0 @@ -// Declared-index ADT envelope extraction (producer side, untrusted). -// -// For every user-ADT claim the generated certificate DECLARES the ADT's -// envelope — root index, every constructor's flattened type index, shape, -// and payload target — plus the opaque type-section byte prefix before the -// constructor entries. The checker-owned wall CONFIRMS the declaration with -// a single byte-slice equality (`DeclaredIndexEnvelope.concatPinnedAt`), so -// nothing here is trusted: a wrong declaration simply fails the kernel pin. -// -// The walker below parses the type section only to locate entry byte ranges -// and classify constructor entries against the exact byte templates the wall -// synthesizes (`dCtorBody`). Anything outside the admitted vocabulary makes -// the affected claim decline (fail-closed) instead of emitting a broken pin. - -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum DeclaredCtorShape { - Hit, - StrBox, - FloatBox, - BoolBox, - ListBox, - MapBox, - Unit, -} - -impl DeclaredCtorShape { - pub fn lean_value(self) -> &'static str { - match self { - DeclaredCtorShape::Hit => ".hit", - DeclaredCtorShape::StrBox => ".strBox", - DeclaredCtorShape::FloatBox => ".floatBox", - DeclaredCtorShape::BoolBox => ".boolBox", - DeclaredCtorShape::ListBox => ".listBox", - DeclaredCtorShape::MapBox => ".mapBox", - DeclaredCtorShape::Unit => ".unit", - } - } -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct DeclaredCtor { - pub idx: u32, - pub shape: DeclaredCtorShape, - pub target: u32, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct DeclaredEnvelope { - pub root: u32, - pub carrier: u32, - pub ctors: Vec, - /// Type-section bytes from the first entry (after the vector count) up to - /// the first constructor entry: rec-group headers plus every earlier - /// flattened entry, declared opaque. - pub type_prefix: Vec, -} - -impl DeclaredEnvelope { - pub fn lean_env(&self) -> String { - let ctors = self - .ctors - .iter() - .map(|c| format!("⟨{}, {}, {}⟩", c.idx, c.shape.lean_value(), c.target)) - .collect::>() - .join(", "); - format!("⟨{}, {}, [{}]⟩", self.root, self.carrier, ctors) - } - - pub fn lean_prefix(&self) -> String { - format!( - "[{}]", - self.type_prefix - .iter() - .map(|b| format!("0x{b:02x}")) - .collect::>() - .join(", ") - ) - } - - pub fn hit_indices(&self) -> Vec { - self.ctors - .iter() - .filter(|c| c.shape == DeclaredCtorShape::Hit) - .map(|c| c.idx) - .collect() - } -} - -/// All extractable ADT envelopes of a module, keyed by constructor index. -#[derive(Clone, Debug, Default)] -pub struct DeclaredEnvelopes { - by_root: std::collections::BTreeMap, - ctor_to_root: std::collections::BTreeMap, -} - -impl DeclaredEnvelopes { - pub fn for_ctor(&self, ctor_idx: u32) -> Option<&DeclaredEnvelope> { - let root = self.ctor_to_root.get(&ctor_idx)?; - self.by_root.get(root) - } -} - -struct RawTypeEntry { - start: usize, - end: usize, -} - -fn read_leb_u32(bytes: &[u8], pos: &mut usize) -> Result { - let mut result: u32 = 0; - let mut shift = 0u32; - loop { - let byte = *bytes - .get(*pos) - .ok_or_else(|| "type section truncated in LEB".to_string())?; - *pos += 1; - result |= u32::from(byte & 0x7f) - .checked_shl(shift) - .ok_or_else(|| "LEB overflows u32".to_string())?; - if byte & 0x80 == 0 { - return Ok(result); - } - shift += 7; - if shift >= 32 { - return Err("LEB longer than u32".to_string()); - } - } -} - -fn skip_sleb33(bytes: &[u8], pos: &mut usize) -> Result<(), String> { - for _ in 0..5 { - let byte = *bytes - .get(*pos) - .ok_or_else(|| "type section truncated in s33".to_string())?; - *pos += 1; - if byte & 0x80 == 0 { - return Ok(()); - } - } - Err("s33 heap type longer than 5 bytes".to_string()) -} - -fn skip_valtype(bytes: &[u8], pos: &mut usize) -> Result<(), String> { - let byte = *bytes - .get(*pos) - .ok_or_else(|| "type section truncated in valtype".to_string())?; - match byte { - // numeric / vector value types - 0x7b..=0x7f => { - *pos += 1; - Ok(()) - } - // (ref null? heaptype) - 0x63 | 0x64 => { - *pos += 1; - skip_sleb33(bytes, pos) - } - // abstract reference-type shorthands (funcref .. nullexternref) - 0x69..=0x79 => { - *pos += 1; - Ok(()) - } - other => Err(format!("unrecognized value type byte 0x{other:02x}")), - } -} - -fn skip_storage_type(bytes: &[u8], pos: &mut usize) -> Result<(), String> { - let byte = *bytes - .get(*pos) - .ok_or_else(|| "type section truncated in storage type".to_string())?; - match byte { - // packed i8 / i16 - 0x78 | 0x77 => { - *pos += 1; - Ok(()) - } - _ => skip_valtype(bytes, pos), - } -} - -fn skip_field_type(bytes: &[u8], pos: &mut usize) -> Result<(), String> { - skip_storage_type(bytes, pos)?; - let mutability = *bytes - .get(*pos) - .ok_or_else(|| "type section truncated in field mutability".to_string())?; - if mutability > 1 { - return Err(format!("invalid field mutability byte 0x{mutability:02x}")); - } - *pos += 1; - Ok(()) -} - -fn skip_comp_type(bytes: &[u8], pos: &mut usize) -> Result<(), String> { - let byte = *bytes - .get(*pos) - .ok_or_else(|| "type section truncated in composite type".to_string())?; - *pos += 1; - match byte { - // func - 0x60 => { - for _ in 0..2 { - let count = read_leb_u32(bytes, pos)?; - for _ in 0..count { - skip_valtype(bytes, pos)?; - } - } - Ok(()) - } - // struct - 0x5f => { - let count = read_leb_u32(bytes, pos)?; - for _ in 0..count { - skip_field_type(bytes, pos)?; - } - Ok(()) - } - // array - 0x5e => skip_field_type(bytes, pos), - other => Err(format!("unrecognized composite type byte 0x{other:02x}")), - } -} - -/// Candidate constructor payload: `(target byte, is-reference)`. -type CtorPayload = Option<(u8, bool)>; - -/// One flattened subtype entry: optional `sub (final)` header, then the -/// composite type. -fn skip_subtype(bytes: &[u8], pos: &mut usize) -> Result<(), String> { - let byte = *bytes - .get(*pos) - .ok_or_else(|| "type section truncated in subtype".to_string())?; - if byte == 0x50 || byte == 0x4f { - *pos += 1; - let count = read_leb_u32(bytes, pos)?; - for _ in 0..count { - read_leb_u32(bytes, pos)?; - } - } - skip_comp_type(bytes, pos) -} - -/// Locate the type section payload; return (entries region, entries offset). -/// The entries region starts after the rectype vector count, mirroring the -/// wall's `typeSectionCursor` (`modulePayload 1` + `readU`). -fn type_section_entries(wasm_bytes: &[u8]) -> Result<(usize, usize, u32), String> { - if wasm_bytes.len() < 8 || &wasm_bytes[0..4] != b"\0asm" { - return Err("not a wasm module".to_string()); - } - let mut pos = 8usize; - while pos < wasm_bytes.len() { - let id = wasm_bytes[pos]; - pos += 1; - let size = read_leb_u32(wasm_bytes, &mut pos)? as usize; - let payload_start = pos; - let payload_end = payload_start - .checked_add(size) - .filter(|end| *end <= wasm_bytes.len()) - .ok_or_else(|| "section size out of range".to_string())?; - if id == 1 { - let mut cursor = payload_start; - let count = read_leb_u32(wasm_bytes, &mut cursor)?; - return Ok((cursor, payload_end, count)); - } - pos = payload_end; - } - Err("module has no type section".to_string()) -} - -/// Classify one constructor entry against the exact byte templates the wall -/// synthesizes (`dCtorBody root ctor`). Returns `(root, shape, target)`. -fn classify_ctor_entry(entry: &[u8]) -> Option<(u32, CtorPayload)> { - // header: 0x4f (sub final) 0x01 (one supertype) root(single byte < 64) - if entry.len() < 5 || entry[0] != 0x4f || entry[1] != 0x01 { - return None; - } - let root = entry[2]; - if root >= 64 { - return None; - } - match &entry[3..] { - // struct { (ref null t) } immutable - [0x5f, 0x01, 0x63, t, 0x00] if *t < 64 => Some((u32::from(root), Some((*t, true)))), - // struct { f64 } immutable - [0x5f, 0x01, 0x7c, 0x00] => Some((u32::from(root), Some((0xfe, false)))), - // struct { i32 } immutable - [0x5f, 0x01, 0x7f, 0x00] => Some((u32::from(root), Some((0xff, false)))), - // struct { } - [0x5f, 0x00] => Some((u32::from(root), None)), - _ => None, - } -} - -/// Walk the module's type section and extract every declarable ADT envelope. -/// -/// Fail-open per ADT: an ADT whose constructor run leaves the admitted byte -/// vocabulary is simply not extractable (its claims decline later); an error -/// is returned only when the section itself cannot be walked. -pub fn collect_declared_envelopes( - wasm_bytes: &[u8], - carrier: Option, -) -> Result { - let (entries_start, payload_end, _count) = match type_section_entries(wasm_bytes) { - Ok(t) => t, - Err(_) => return Ok(DeclaredEnvelopes::default()), - }; - - // Flattened entry byte ranges. Rec-group headers (0x4e n) are recorded as - // part of the stream but not as entries, matching the wall's flattening. - let mut entries: Vec = Vec::new(); - let mut pos = entries_start; - while pos < payload_end { - let byte = wasm_bytes[pos]; - if byte == 0x4e { - let mut cursor = pos + 1; - let group_len = read_leb_u32(wasm_bytes, &mut cursor)?; - for _ in 0..group_len { - let start = cursor; - skip_subtype(wasm_bytes, &mut cursor)?; - entries.push(RawTypeEntry { start, end: cursor }); - } - pos = cursor; - } else { - let start = pos; - let mut cursor = pos; - skip_subtype(wasm_bytes, &mut cursor)?; - entries.push(RawTypeEntry { start, end: cursor }); - pos = cursor; - } - } - if pos != payload_end { - return Err("type section entries overran the section payload".to_string()); - } - - // i8 byte arrays (String storage) and struct field counts, for shape labels. - let mut i8_arrays = std::collections::BTreeSet::new(); - let mut struct_field_counts = std::collections::BTreeMap::new(); - for (idx, entry) in entries.iter().enumerate() { - let bytes = &wasm_bytes[entry.start..entry.end]; - let body = if bytes.first() == Some(&0x50) || bytes.first() == Some(&0x4f) { - let mut cursor = 1usize; - let count = read_leb_u32(bytes, &mut cursor).unwrap_or(0); - for _ in 0..count { - let _ = read_leb_u32(bytes, &mut cursor); - } - &bytes[cursor..] - } else { - bytes - }; - match body.first() { - Some(0x5e) if body.get(1) == Some(&0x78) => { - i8_arrays.insert(idx as u32); - } - Some(0x5f) => { - let mut cursor = 1usize; - if let Ok(count) = read_leb_u32(body, &mut cursor) { - struct_field_counts.insert(idx as u32, count); - } - } - _ => {} - } - } - - // Group candidate constructor entries by their declared root. - let mut ctor_runs: std::collections::BTreeMap> = - std::collections::BTreeMap::new(); - for (idx, entry) in entries.iter().enumerate() { - let bytes = &wasm_bytes[entry.start..entry.end]; - if let Some((root, payload)) = classify_ctor_entry(bytes) { - ctor_runs - .entry(root) - .or_default() - .push((idx as u32, payload)); - } - } - - let mut result = DeclaredEnvelopes::default(); - 'roots: for (root, run) in ctor_runs { - // The root entry must be the canonical empty non-final struct. - let Some(root_entry) = entries.get(root as usize) else { - continue; - }; - if wasm_bytes[root_entry.start..root_entry.end] != [0x50, 0x00, 0x5f, 0x00] { - continue; - } - // Constructors must be a contiguous flattened run with contiguous bytes. - for pair in run.windows(2) { - if pair[1].0 != pair[0].0 + 1 { - continue 'roots; - } - let left = &entries[pair[0].0 as usize]; - let right = &entries[pair[1].0 as usize]; - if left.end != right.start { - continue 'roots; - } - } - let first = run[0].0; - if first >= 64 { - continue; - } - let mut ctors = Vec::new(); - for (idx, payload) in &run { - let shape = match payload { - None => DeclaredCtor { - idx: *idx, - shape: DeclaredCtorShape::Unit, - target: 0, - }, - Some((0xfe, false)) => DeclaredCtor { - idx: *idx, - shape: DeclaredCtorShape::FloatBox, - target: 0, - }, - Some((0xff, false)) => DeclaredCtor { - idx: *idx, - shape: DeclaredCtorShape::BoolBox, - target: 0, - }, - Some((t, true)) => { - let target = u32::from(*t); - let shape = if Some(target) == carrier { - DeclaredCtorShape::Hit - } else if i8_arrays.contains(&target) { - DeclaredCtorShape::StrBox - } else if struct_field_counts.get(&target) == Some(&2) { - DeclaredCtorShape::ListBox - } else { - DeclaredCtorShape::MapBox - }; - DeclaredCtor { - idx: *idx, - shape, - target, - } - } - Some((_, false)) => continue 'roots, - }; - ctors.push(shape); - } - let Some(carrier_idx) = carrier else { - // Envelopes are only declarable against a byte-derived Int carrier. - continue; - }; - if carrier_idx >= 64 { - continue; - } - let type_prefix = - wasm_bytes[entries_start..entries[first as usize].start].to_vec(); - let envelope = DeclaredEnvelope { - root, - carrier: carrier_idx, - ctors, - type_prefix, - }; - for ctor in &envelope.ctors { - result.ctor_to_root.insert(ctor.idx, root); - } - result.by_root.insert(root, envelope); - } - Ok(result) -} diff --git a/aver-cert/src/engine/disasm.rs b/aver-cert/src/engine/disasm.rs deleted file mode 100644 index 52d23c680..000000000 --- a/aver-cert/src/engine/disasm.rs +++ /dev/null @@ -1,4 +0,0 @@ -// ---- disassembly --------------------------------------------------------- - -include!("disasm_module.rs"); -include!("disasm_hosts.rs"); diff --git a/aver-cert/src/engine/disasm_hosts.rs b/aver-cert/src/engine/disasm_hosts.rs deleted file mode 100644 index ea0f4ba0e..000000000 --- a/aver-cert/src/engine/disasm_hosts.rs +++ /dev/null @@ -1,275 +0,0 @@ -fn host_op(op: &wasmparser::Operator<'_>) -> HostOp { - match op { - wasmparser::Operator::LocalGet { local_index } => HostOp::LocalGet(*local_index), - wasmparser::Operator::LocalSet { local_index } => HostOp::LocalSet(*local_index), - wasmparser::Operator::I32Const { value } => HostOp::I32Const(*value), - wasmparser::Operator::ArrayLen => HostOp::ArrayLen, - wasmparser::Operator::ArrayGetU { array_type_index } => { - HostOp::ArrayGetU(*array_type_index) - } - wasmparser::Operator::ArrayGet { array_type_index } => HostOp::ArrayGet(*array_type_index), - wasmparser::Operator::ArrayNewDefault { array_type_index } => { - HostOp::ArrayNewDefault(*array_type_index) - } - wasmparser::Operator::ArrayCopy { - array_type_index_dst, - array_type_index_src, - } => HostOp::ArrayCopy(*array_type_index_dst, *array_type_index_src), - wasmparser::Operator::I32Ne => HostOp::I32Ne, - wasmparser::Operator::I32GeU => HostOp::I32GeU, - wasmparser::Operator::I32Add => HostOp::I32Add, - wasmparser::Operator::If { .. } => HostOp::If, - wasmparser::Operator::Block { .. } => HostOp::Block, - wasmparser::Operator::Loop { .. } => HostOp::Loop, - wasmparser::Operator::Br { relative_depth } => HostOp::Br(*relative_depth), - wasmparser::Operator::BrIf { relative_depth } => HostOp::BrIf(*relative_depth), - wasmparser::Operator::Return => HostOp::Return, - wasmparser::Operator::End => HostOp::End, - _ => HostOp::Other, - } -} - -fn string_host_roles( - host_roles: &std::collections::HashMap, -) -> StringHostRoles { - let mut roles = host_roles - .iter() - .filter_map(|(idx, role)| match role { - HostRole::StringEq => Some((*idx, StringHostRole::Eq)), - HostRole::StringConcat => Some((*idx, StringHostRole::Concat)), - HostRole::Add | HostRole::Mul | HostRole::Sub => None, - }) - .collect::>(); - roles.sort_by_key(|entry| entry.0); - roles -} - -fn is_string_eq_host( - entry: &CodeEntry, - params: &[TyKind], - result: Option, - string_byte_array_types: &std::collections::HashSet, -) -> bool { - let [TyKind::Ref { idx: lhs, .. }, TyKind::Ref { idx: rhs, .. }] = params else { - return false; - }; - if lhs != rhs || result != Some(TyKind::I32) || entry.nlocals != 2 || !entry.calls.is_empty() { - return false; - } - use HostOp::*; - let t = *lhs; - if !string_byte_array_types.contains(&t) { - return false; - } - let expected = [ - LocalGet(0), - ArrayLen, - LocalGet(1), - ArrayLen, - I32Ne, - If, - I32Const(0), - Return, - End, - LocalGet(0), - ArrayLen, - LocalSet(2), - I32Const(0), - LocalSet(3), - Block, - Loop, - LocalGet(3), - LocalGet(2), - I32GeU, - BrIf(1), - LocalGet(0), - LocalGet(3), - ArrayGetU(t), - LocalGet(1), - LocalGet(3), - ArrayGetU(t), - I32Ne, - If, - I32Const(0), - Return, - End, - LocalGet(3), - I32Const(1), - I32Add, - LocalSet(3), - Br(0), - End, - End, - I32Const(1), - End, - ]; - entry.host_ops.as_slice() == expected -} - -/// Identify the `String.concat` runtime helper by its byte-exact opcode shape. -/// -/// The compiler lowers `String.concat` (and the `[s1, ..., sN].join` pattern) -/// to a fixed two-loop helper: the first loop sums the byte-lengths of every -/// element array, `array.new_default` allocates the result, and the second -/// loop `array.copy`s each element into place. The helper takes ONE argument -/// (the container array of string-arrays) and returns the byte-concatenated -/// array. As with [`is_string_eq_host`], the match is byte-exact — a helper -/// with the right signature but a different body is NOT recognised, so a -/// tampered helper fails re-derivation at verify time. -/// -/// `container_ty` is the type index of the container array (array of -/// string-arrays); `byte_ty` is the type index of both the element string -/// arrays and the result byte array. Both must be `(array (mut i8))` -/// composites — pinned by membership in `string_byte_array_types`. -fn is_string_concat_host( - entry: &CodeEntry, - params: &[TyKind], - result: Option, - string_byte_array_types: &std::collections::HashSet, -) -> bool { - // Signature: `(ref null container_ty) -> (ref null byte_ty)`, one arg. - let [TyKind::Ref { idx: container_ty, .. }] = params else { - return false; - }; - let Some(TyKind::Ref { idx: result_ty, .. }) = result else { - return false; - }; - // The helper has exactly 7 locals (i32 i32 i32 ref i32 ref i32) and no - // outgoing calls — everything it does is inline loops + array ops. - if entry.nlocals != 7 || !entry.calls.is_empty() { - return false; - } - let container = *container_ty; - let byte = result_ty; - // Both the result/element type and the container type must be byte arrays. - // (The container is an array of byte-arrays, so its element type is the - // byte array type; we check the byte type membership directly, and below - // we pin the container type into the array.get/len operands.) - if !string_byte_array_types.contains(&byte) { - return false; - } - use HostOp::*; - // First loop: total length = sum of element array lengths. - // Second loop: allocate result, array.copy each element in place. - let expected = [ - // --- length-accumulation loop --- - LocalGet(0), - ArrayLen, - LocalSet(3), - I32Const(0), - LocalSet(1), - I32Const(0), - LocalSet(2), - Block, - Loop, - LocalGet(2), - LocalGet(3), - I32GeU, - BrIf(1), - LocalGet(1), - LocalGet(0), - LocalGet(2), - ArrayGet(container), - ArrayLen, - I32Add, - LocalSet(1), - LocalGet(2), - I32Const(1), - I32Add, - LocalSet(2), - Br(0), - End, - End, - // --- allocation + copy loop --- - LocalGet(1), - ArrayNewDefault(byte), - LocalSet(6), - I32Const(0), - LocalSet(7), - I32Const(0), - LocalSet(2), - Block, - Loop, - LocalGet(2), - LocalGet(3), - I32GeU, - BrIf(1), - LocalGet(0), - LocalGet(2), - ArrayGet(container), - LocalSet(4), - LocalGet(4), - ArrayLen, - LocalSet(5), - LocalGet(6), - LocalGet(7), - LocalGet(4), - I32Const(0), - LocalGet(5), - ArrayCopy(byte, byte), - LocalGet(7), - LocalGet(5), - I32Add, - LocalSet(7), - LocalGet(2), - I32Const(1), - I32Add, - LocalSet(2), - Br(0), - End, - End, - LocalGet(6), - End, - ]; - entry.host_ops.as_slice() == expected -} - -fn resolve_data_ops(ops: Vec, data_segments: &[Option>]) -> Vec { - ops.into_iter() - .map(|op| match op { - Op::ArrayNewDataUnresolved { - type_idx, - data_idx, - offset, - len, - } if offset == 0 && len >= 0 => { - let Some(Some(bytes)) = data_segments.get(data_idx as usize) else { - return Op::Other; - }; - if bytes.len() == len as usize { - Op::ArrayNewData { - type_idx, - data_idx, - bytes: bytes.clone(), - } - } else { - Op::Other - } - } - Op::ArrayNewDataUnresolved { .. } => Op::Other, - other => other, - }) - .collect() -} - -/// The name of an instruction the opcode vocabulary does not model, for the -/// decline reason. `wasmparser`'s `Debug` prints the instruction first and its -/// operands after (`I32Sub`, `LocalTee { local_index: 3 }`), so the leading -/// identifier is exactly the instruction and nothing else. Diagnostic only: no -/// admission decision ever reads this string. -fn operator_name(op: &wasmparser::Operator<'_>) -> String { - format!("{op:?}") - .split(|c: char| !c.is_ascii_alphanumeric()) - .next() - .unwrap_or_default() - .to_string() -} - -fn heap_type_index(hty: wasmparser::HeapType) -> Option { - match hty { - wasmparser::HeapType::Concrete(idx) => idx.as_module_index(), - // Kernel parity: exact references are not plain 0x63 s33 refs. - wasmparser::HeapType::Exact(_) => None, - wasmparser::HeapType::Abstract { .. } => None, - } -} diff --git a/aver-cert/src/engine/disasm_module.rs b/aver-cert/src/engine/disasm_module.rs deleted file mode 100644 index d3046a3ae..000000000 --- a/aver-cert/src/engine/disasm_module.rs +++ /dev/null @@ -1,829 +0,0 @@ -type DisasmResult = ( - Vec, - // Int box helper (`__rt_aint_from_i64`) export index. `None` when the - // module does not export it — a legal module shape (no Int arithmetic); - // every integer-family recognizer then declines fail-closed instead of - // aborting the whole analysis. - Option, - std::collections::HashSet, - Option, - std::collections::HashMap, - FragHostTable, - // Byte-derived struct context: module struct type index -> field count. - // The plan checker validates every `struct.get.user` node against it. - std::collections::HashMap, -); - -/// The first `i64` arithmetic operator in a helper body. Strictly narrower -/// than the other host-shape evidence: the plan-first host-role table binds -/// behavioural add, subtract, and multiply to distinct byte-derived helpers. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -enum FirstI64Arith { - Add, - Sub, - Mul, -} - -/// Byte-for-byte mirror of the certificate decoder's first-arith body scan. -/// -/// The Lean decoder walks raw instruction boundaries with a fixed vocabulary -/// and fails closed on any encoding outside it. The producer runs this exact -/// mirror over every carrier-binop-signature body so a module whose role scan -/// the decoder cannot complete is refused at certification time — no package -/// is ever emitted whose module-wide role pin can close against no manifest -/// value. Returns `None` when the decoder's scan would fail, `Some(first)` -/// with the first `i64` add/sub/mul marker (or `Some(None)` for none) when it -/// succeeds. -fn kernel_first_arith_scan(bytes: &[u8]) -> Option> { - // Canonical unsigned LEB128, at most `fuel` bytes, overlong-zero rejected. - fn skip_uleb(bytes: &[u8], cursor: &mut usize) -> Option { - let mut value: u64 = 0; - let mut shift: u32 = 0; - for _ in 0..5 { - let byte = *bytes.get(*cursor)?; - *cursor += 1; - value |= u64::from(byte & 0x7f) << shift; - if byte < 128 { - if shift != 0 && byte == 0 { - return None; - } - return Some(value); - } - shift += 7; - } - None - } - // Signed LEB128, at most 10 bytes; only the cursor movement matters here. - fn skip_sleb(bytes: &[u8], cursor: &mut usize) -> Option<()> { - for _ in 0..10 { - let byte = *bytes.get(*cursor)?; - *cursor += 1; - if byte < 128 { - return Some(()); - } - } - None - } - fn skip_block_type(bytes: &[u8], cursor: &mut usize) -> Option<()> { - let byte = *bytes.get(*cursor)?; - if byte == 0x40 || matches!(byte, 0x7b..=0x7f) { - *cursor += 1; - Some(()) - } else if byte == 0x63 || byte == 0x64 { - *cursor += 1; - skip_sleb(bytes, cursor) - } else { - skip_sleb(bytes, cursor) - } - } - - let mut cursor = 0usize; - loop { - if cursor == bytes.len() { - return Some(None); - } - let op = bytes[cursor]; - cursor += 1; - match op { - 0x7c => return Some(Some(FirstI64Arith::Add)), - 0x7d => return Some(Some(FirstI64Arith::Sub)), - 0x7e => return Some(Some(FirstI64Arith::Mul)), - // Single-byte numeric / comparison / conversion opcodes. - 0x45..=0xc4 => {} - // Immediate-free control and parametric opcodes. - 0x0b | 0x05 | 0x0f | 0x00 | 0x01 | 0x1a | 0x1b | 0xd1 => {} - // One index immediate. - 0x20 | 0x21 | 0x22 | 0x23 | 0x24 | 0x0c | 0x0d | 0x10 | 0x12 => { - skip_uleb(bytes, &mut cursor)?; - } - // br_table: count, then count+1 label indices. - 0x0e => { - let count = skip_uleb(bytes, &mut cursor)?; - for _ in 0..count.checked_add(1)? { - skip_uleb(bytes, &mut cursor)?; - } - } - // call_indirect: type index + table index. - 0x11 => { - skip_uleb(bytes, &mut cursor)?; - skip_uleb(bytes, &mut cursor)?; - } - // block / loop / if. - 0x02..=0x04 => skip_block_type(bytes, &mut cursor)?, - // i32.const / i64.const. - 0x41 | 0x42 => skip_sleb(bytes, &mut cursor)?, - 0x43 => { - if bytes.len() - cursor < 4 { - return None; - } - cursor += 4; - } - 0x44 => { - if bytes.len() - cursor < 8 { - return None; - } - cursor += 8; - } - // ref.null . - 0xd0 => skip_sleb(bytes, &mut cursor)?, - // ref.func . - 0xd2 => { - skip_uleb(bytes, &mut cursor)?; - } - // GC prefix: the decoder's admitted subset only. - 0xfb => { - let sub = skip_uleb(bytes, &mut cursor)?; - match sub { - 0x00 | 0x01 | 0x06 | 0x07 | 0x0b | 0x0c | 0x0d | 0x0e => { - skip_uleb(bytes, &mut cursor)?; - } - 0x02 | 0x05 | 0x08 | 0x09 => { - skip_uleb(bytes, &mut cursor)?; - skip_uleb(bytes, &mut cursor)?; - } - 0x0f => {} - 0x14..=0x17 => skip_sleb(bytes, &mut cursor)?, - _ => return None, - } - } - _ => return None, - } - } -} - -fn disassemble(wasm_bytes: &[u8]) -> Result { - use wasmparser::{ - CompositeInnerType, DataKind, Operator, Parser, Payload, StorageType, ValType, - }; - - // Admission gate: never trust a byte-derived fact from a module that is not - // well-typed wasm. Full validation runs BEFORE any rederivation reads a - // section, so a forged result type, a nullability-mismatched signature, or - // malformed/trailing section bytes are all rejected up front rather than - // slipping past the relevant-subset slicer. `Validator::new()` enables the - // GC / tail-call / function-reference proposals the backend emits (all - // default-on), matching the emitter's own feature set. - wasmparser::Validator::new() - .validate_all(wasm_bytes) - .map_err(|e| format!("wasm module failed validation: {e}"))?; - - let mut num_imported_funcs: u32 = 0; - // `module.name` of every FUNCTION import, in index order. Purely diagnostic: - // a call into one of these is a call into the host capability surface, which - // no certified template admits, and the decline reason names it. - let mut imported_func_names: Vec = Vec::new(); - // defined-function index -> declared type index - let mut func_type_idx: Vec = Vec::new(); - // type index -> byte-level signature (param kinds, FULL result-kind vector) - // for func types. The complete result vector is retained (not just the first - // result) so a verbatim route can require EXACTLY one result of the - // recognized kind — a zero-result or two-result declaration is rejected. - let mut type_sigs: std::collections::HashMap, Vec)> = - std::collections::HashMap::new(); - // type index -> struct field count - let mut struct_field_counts: std::collections::HashMap = - std::collections::HashMap::new(); - // type indices for the string byte-array carrier `(array (mut i8))`. - let mut string_byte_array_types: std::collections::HashSet = - std::collections::HashSet::new(); - // export name -> func index - let mut exports: Vec<(String, u32)> = Vec::new(); - let mut code_entries: Vec = Vec::new(); - let mut next_code_entry_start: Option = None; - let mut data_segments: Vec>> = Vec::new(); - let mut carrier: Option = None; - // The limb array type index the Int carrier's middle field references. The - // arith helper bodies read/write this array type, so the acceptance pin - // needs it declared alongside the carrier. - let mut limb: Option = None; - let mut next_type_idx: u32 = 0; - // The certificate decoder's whole-module role scan declines any - // non-function import; record the fact so a module that also carries the - // Int box helper is refused instead of certified into an unverifiable - // package. - let mut has_non_function_import = false; - - for payload in Parser::new(0).parse_all(wasm_bytes) { - let payload = payload.map_err(|e| format!("wasm parse: {e}"))?; - match payload { - Payload::TypeSection(reader) => { - for rg in reader { - let rg = rg.map_err(|e| format!("type read: {e}"))?; - for sub in rg.into_types() { - let idx = next_type_idx; - next_type_idx += 1; - match &sub.composite_type.inner { - CompositeInnerType::Func(ft) => { - let kind = |vt: &ValType| match vt { - ValType::I64 => TyKind::I64, - ValType::I32 => TyKind::I32, - ValType::F64 => TyKind::F64, - ValType::Ref(rt) => match heap_type_index(rt.heap_type()) { - Some(t) => TyKind::Ref { - nullable: rt.is_nullable(), - idx: t, - }, - None => match rt.heap_type() { - wasmparser::HeapType::Abstract { - ty: wasmparser::AbstractHeapType::Eq, - .. - } => TyKind::Eqref, - // Kernel parity: exact references are not plain 0x63 s33 refs. - wasmparser::HeapType::Exact(_) => TyKind::Other, - _ => TyKind::Other, - }, - }, - _ => TyKind::Other, - }; - type_sigs.insert( - idx, - ( - ft.params().iter().map(kind).collect(), - ft.results().iter().map(kind).collect(), - ), - ); - } - // Int carrier: 3 fields, {i64, ref, i32}. - CompositeInnerType::Struct(st) - if carrier.is_none() - && st.fields.len() == 3 - && matches!( - st.fields[0].element_type, - StorageType::Val(ValType::I64) - ) - && matches!( - st.fields[2].element_type, - StorageType::Val(ValType::I32) - ) => - { - carrier = Some(idx); - struct_field_counts.insert(idx, st.fields.len() as u32); - // The middle field is `(ref null $mag)`; capture - // the declared limb array type index it targets. - if let StorageType::Val(ValType::Ref(rt)) = - st.fields[1].element_type - { - limb = heap_type_index(rt.heap_type()); - } - } - CompositeInnerType::Struct(st) => { - struct_field_counts.insert(idx, st.fields.len() as u32); - } - CompositeInnerType::Array(at) - if matches!(at.0.element_type, StorageType::I8) => - { - string_byte_array_types.insert(idx); - } - _ => {} - } - } - } - } - Payload::ImportSection(reader) => { - // Compact import encoding groups imports; iterate each group. - for group in reader { - let group = group.map_err(|e| format!("import read: {e}"))?; - for imp in group { - let (_, imp) = imp.map_err(|e| format!("import read: {e}"))?; - if let wasmparser::TypeRef::Func(_) = imp.ty { - num_imported_funcs += 1; - imported_func_names.push(format!("{}.{}", imp.module, imp.name)); - } else { - has_non_function_import = true; - } - } - } - } - Payload::FunctionSection(reader) => { - for t in reader { - func_type_idx.push(t.map_err(|e| format!("func read: {e}"))?); - } - } - Payload::ExportSection(reader) => { - for ex in reader { - let ex = ex.map_err(|e| format!("export read: {e}"))?; - if ex.kind == wasmparser::ExternalKind::Func { - exports.push((ex.name.to_string(), ex.index)); - } - } - } - Payload::CodeSectionStart { range, size, .. } => { - next_code_entry_start = Some( - range - .end - .checked_sub(size as usize) - .ok_or_else(|| "code section size is outside its byte range".to_string())?, - ); - } - Payload::CodeSectionEntry(body) => { - let entry_start = next_code_entry_start - .ok_or_else(|| "code entry appeared before code section start".to_string())?; - let entry_end = body.range().end; - let code_entry_bytes = wasm_bytes - .get(entry_start..entry_end) - .ok_or_else(|| { - format!( - "code entry byte range {entry_start}..{entry_end} is outside wasm module" - ) - })? - .to_vec(); - next_code_entry_start = Some(entry_end); - let mut nlocals = 0usize; - let mut lr = body - .get_locals_reader() - .map_err(|e| format!("locals reader: {e}"))?; - for _ in 0..lr.get_count() { - let (n, _ty) = lr.read().map_err(|e| format!("locals read: {e}"))?; - nlocals += n as usize; - } - let mut ops = Vec::new(); - let mut calls = Vec::new(); - let mut has_loop_or_branch = false; - let mut saw_i64_add = false; - let mut saw_i64_mul = false; - let mut saw_i64_sub = false; - let mut first_i64_arith = None; - let mut first_arith_strict = None; - let mut first_unsupported_op: Option = None; - let mut host_ops = Vec::new(); - let mut opr = body - .get_operators_reader() - .map_err(|e| format!("ops reader: {e}"))?; - // Body bytes after the locals vector — the exact slice the - // certificate decoder's first-arith scan walks. - let arith_scan_start = opr.original_position(); - let kernel_arith_scan = wasm_bytes - .get(arith_scan_start..entry_end) - .and_then(kernel_first_arith_scan); - while !opr.eof() { - let op = opr.read().map_err(|e| format!("op read: {e}"))?; - host_ops.push(host_op(&op)); - let mapped = match op { - Operator::LocalGet { local_index } => Op::LocalGet(local_index), - Operator::LocalSet { local_index } => Op::LocalSet(local_index), - Operator::I64Const { value } => Op::I64Const(value), - Operator::I32Const { value } => Op::I32Const(value), - Operator::F64Const { value } => Op::F64Const(value.bits()), - Operator::RefTestNonNull { hty } | Operator::RefTestNullable { hty } => { - heap_type_index(hty).map(Op::RefTest).unwrap_or(Op::Other) - } - Operator::RefCastNonNull { hty } | Operator::RefCastNullable { hty } => { - heap_type_index(hty).map(Op::RefCast).unwrap_or(Op::Other) - } - Operator::StructNew { struct_type_index } => Op::StructNew( - struct_type_index, - struct_field_counts - .get(&struct_type_index) - .copied() - .unwrap_or(0), - ), - Operator::StructGet { - struct_type_index, - field_index, - } => Op::StructGet(struct_type_index, field_index), - Operator::ArrayNewData { - array_type_index, - array_data_index, - } => { - let literal_operands = - match (ops.get(ops.len().wrapping_sub(2)), ops.last()) { - (Some(Op::I32Const(0)), Some(Op::I32Const(len))) => Some(*len), - _ => None, - }; - if let Some(len) = literal_operands { - Op::ArrayNewDataUnresolved { - type_idx: array_type_index, - data_idx: array_data_index, - offset: 0, - len, - } - } else { - Op::Other - } - } - Operator::RefNull { hty } => Op::RefNull(heap_type_index(hty)), - Operator::RefIsNull => Op::RefIsNull, - Operator::I64Eq => Op::I64Eq, - Operator::I64LeS => Op::I64LeS, - Operator::I64LtS => Op::I64LtS, - Operator::I64GeS => Op::I64GeS, - Operator::I64GtS => Op::I64GtS, - Operator::F64Add => Op::F64Add, - Operator::F64Mul => Op::F64Mul, - Operator::F64Le => Op::F64Le, - Operator::F64Ge => Op::F64Ge, - Operator::F64Lt => Op::F64Lt, - Operator::F64Gt => Op::F64Gt, - Operator::F64Eq => Op::F64Eq, - Operator::I64Add => { - saw_i64_add = true; - first_i64_arith.get_or_insert(HostRole::Add); - first_arith_strict.get_or_insert(FirstI64Arith::Add); - Op::Other - } - Operator::I64Sub => { - saw_i64_sub = true; - first_i64_arith.get_or_insert(HostRole::Sub); - first_arith_strict.get_or_insert(FirstI64Arith::Sub); - Op::Other - } - Operator::I64Mul => { - saw_i64_mul = true; - first_i64_arith.get_or_insert(HostRole::Mul); - first_arith_strict.get_or_insert(FirstI64Arith::Mul); - Op::Other - } - Operator::I32Eq => Op::I32Eq, - Operator::I32LtS => Op::I32LtS, - Operator::I32GtS => Op::I32GtS, - Operator::I32LtU => Op::I32LtU, - Operator::I32GeS => Op::I32GeS, - Operator::I32And => Op::I32And, - Operator::ArrayLen => Op::ArrayLen, - Operator::ArrayGet { array_type_index } => { - Op::ArrayGet(array_type_index) - } - Operator::If { .. } => Op::If, - Operator::Else => Op::Else, - Operator::End => Op::End, - Operator::Call { function_index } => { - calls.push(function_index); - Op::Call(function_index) - } - Operator::ReturnCall { function_index } => { - calls.push(function_index); - Op::ReturnCall(function_index) - } - Operator::Loop { .. } - | Operator::Block { .. } - | Operator::Br { .. } - | Operator::BrIf { .. } - | Operator::BrTable { .. } => { - has_loop_or_branch = true; - Op::Other - } - Operator::ArrayNewFixed { - array_type_index, - array_size, - } => Op::ArrayNewFixed(array_type_index, array_size), - _ => { - // Record what the body actually used, so the - // decline reason names the instruction instead of - // guessing at a family. Reading `op` here is free: - // no arm above moves anything out of it. - if first_unsupported_op.is_none() { - first_unsupported_op = Some(operator_name(&op)); - } - Op::Other - } - }; - ops.push(mapped); - } - let host_role = match (saw_i64_add, saw_i64_mul, saw_i64_sub) { - (true, false, false) => Some(HostRole::Add), - (false, true, false) => Some(HostRole::Mul), - (false, false, true) => Some(HostRole::Sub), - _ => first_i64_arith, - }; - code_entries.push(CodeEntry { - nlocals, - code_entry_bytes, - ops, - calls, - has_loop_or_branch, - first_unsupported_op, - host_role, - first_arith_strict, - kernel_arith_scan, - host_ops, - }); - } - Payload::DataSection(reader) => { - for data in reader { - let data = data.map_err(|e| format!("data read: {e}"))?; - match data.kind { - DataKind::Passive => data_segments.push(Some(data.data.to_vec())), - DataKind::Active { .. } => data_segments.push(None), - } - } - } - _ => {} - } - } - - // Runtime helper names never certified as code. `__aint_to_index` is the - // named host-role export the fused vector-read contract binds, exactly - // like `__rt_aint_from_i64` for box; `__aint_cmp` and `__aint_eq` are the - // same kind of named export for the two Int comparison host roles. - let is_runtime = |name: &str| { - name.starts_with("__rt_") - || name.starts_with("__caller") - || name == "__aint_to_index" - || name == "__aint_cmp" - || name == "__aint_eq" - || name == "_start" - || name == "memory" - }; - - // Int box helper, exact by export name. A module without Int arithmetic - // legitimately has no such export: keep it `None` so the integer-family - // recognizers never match (fail-closed decline per export), while the - // carrier-free classes still get their shot at certification. - let box_idx = exports - .iter() - .find(|(n, _)| n == "__rt_aint_from_i64") - .map(|(_, i)| *i); - - // `__aint_to_index` helper, exact by export name (mirror of `box`; twin - // of `CertDecode.AddSub.toIndexIdx`). Absent in modules with no fused - // vector read; `None` keeps the fused-read recognizer fail-closed. - let to_index_idx = exports - .iter() - .find(|(n, _)| n == "__aint_to_index") - .map(|(_, i)| *i); - - // The two Int comparison helpers, likewise exact by export name (twins of - // `CertDecode.AddSub.cmpIdx`/`eqIdx`). They are NOT derived from body shape - // like add/sub/mul: both declare the same function type and return a raw - // `i32`, so `is_carrier_binop` rightly excludes them and nothing but the - // export name separates the three-way helper from the equality one. - let cmp_idx = exports - .iter() - .find(|(n, _)| n == "__aint_cmp") - .map(|(_, i)| *i); - let eq_idx = exports - .iter() - .find(|(n, _)| n == "__aint_eq") - .map(|(_, i)| *i); - - // No behavioural (body-shape) scan is added for `cmp`/`eq`, and the - // carrier-binop signature test below deliberately keeps excluding them: - // both return a raw `i32` rather than a carrier, so they are not carrier - // binops, and their two bodies would need a role classifier of their own. - // Their roles are export-name-derived instead, which is also what the - // wall's `cmpIdx`/`eqIdx` decoders read. Nothing else is needed for the - // refusal path either: the two exports only ever appear alongside the Int - // box helper, so the `box_idx.is_some()` block below already refuses every - // module whose role table the certificate decoder cannot resolve. - let is_carrier_binop = |def_idx: usize| -> bool { - let Some(c) = carrier else { - return false; - }; - let Some((params, results)) = func_type_idx.get(def_idx).and_then(|ti| type_sigs.get(ti)) - else { - return false; - }; - let is_carrier_ref = |t: &TyKind| matches!(t, TyKind::Ref { idx, .. } if *idx == c); - matches!(params.as_slice(), [a, b] if is_carrier_ref(a) && is_carrier_ref(b)) - && matches!(results.as_slice(), [r] if is_carrier_ref(r)) - }; - - // Producer-side mirror of the verifier's module-wide role decode. A module - // that carries the Int box helper must let the certificate decoder resolve - // its whole host-role table; when the decoder's scan would fail, NO - // manifest value can satisfy the acceptance pin, so emitting a package - // would only defer the failure to `aver cert verify`. Refuse honestly here - // instead, naming the reason. - if box_idx.is_some() { - if carrier.is_none() { - return Err( - "module exports the Int box helper `__rt_aint_from_i64` but declares no Int \ - carrier struct type; the certificate decoder cannot resolve its host-role \ - table, so no certificate for this module can verify" - .to_string(), - ); - } - if has_non_function_import { - return Err( - "module exports the Int box helper `__rt_aint_from_i64` and also declares a \ - non-function import; the certificate decoder declines such modules, so no \ - certificate for this module can verify" - .to_string(), - ); - } - for (def_idx, entry) in code_entries.iter().enumerate() { - if !is_carrier_binop(def_idx) { - continue; - } - let strict = entry.first_arith_strict; - match entry.kernel_arith_scan { - Some(first) if first == strict => {} - Some(_) | None => { - return Err(format!( - "module exports the Int box helper `__rt_aint_from_i64` but function \ - index {} has the Int carrier-binop signature and a body the \ - certificate decoder's role scan cannot classify; the module-wide \ - host-role table is undecodable, so no certificate for this module \ - can verify", - num_imported_funcs + def_idx as u32, - )); - } - } - } - } - - // user export name -> wasm func index - let mut user_exports: Vec<(String, u32)> = exports - .iter() - .filter(|(n, _)| !is_runtime(n)) - .cloned() - .collect(); - user_exports.sort_by_key(|(_, i)| *i); - - let user_idx_set: std::collections::HashSet = - user_exports.iter().map(|(_, i)| *i).collect(); - - let host_roles = code_entries - .iter() - .enumerate() - .filter_map(|(def_idx, entry)| { - let sig = func_type_idx - .get(def_idx) - .and_then(|ti| type_sigs.get(ti)) - .cloned() - .unwrap_or((Vec::new(), Vec::new())); - let result0 = sig.1.first().copied(); - let role = if is_string_eq_host(entry, &sig.0, result0, &string_byte_array_types) { - Some(HostRole::StringEq) - } else if is_string_concat_host(entry, &sig.0, result0, &string_byte_array_types) { - Some(HostRole::StringConcat) - } else { - entry.host_role - }; - role.map(|role| (num_imported_funcs + def_idx as u32, role)) - }) - .collect::>(); - - // A table entry binds the behavioural role, so a candidate must have the - // exact carrier-binop signature (`[ref carrier, ref carrier] -> ref carrier`) - // AND the corresponding i64 operator as the FIRST arithmetic operator in - // its body. The `mul` helper's umag loops also contain `i64.add`, but its - // fast path multiplies first. If the module - // does not determine a UNIQUE candidate, the role stays unbound (`None`) - // and every plan citing it declines fail-closed — never guess by index - // order. `box` is the exported `__rt_aint_from_i64`, exact by name - // (unbound when the module has no such export). `sub` - // is derived exactly like `add` and `mul`, each with its own uniqueness - // check. All four roles are surfaced to Lean and bound in the artifact. - let frag_host_table = { - let strict_binop_candidates = |arith: FirstI64Arith| -> Vec { - code_entries - .iter() - .enumerate() - .filter(|(def_idx, entry)| { - entry.first_arith_strict == Some(arith) && is_carrier_binop(*def_idx) - }) - .map(|(def_idx, _)| num_imported_funcs + def_idx as u32) - .collect() - }; - let unique = |candidates: Vec| -> Option { - match candidates.as_slice() { - [only] => Some(*only), - _ => None, - } - }; - let add_idx = unique(strict_binop_candidates(FirstI64Arith::Add)); - let mul_idx = unique(strict_binop_candidates(FirstI64Arith::Mul)); - let sub_idx = unique(strict_binop_candidates(FirstI64Arith::Sub)); - // The add/sub/mul helpers call the four bignum sub-routines by function - // index; read those indices out of the add helper's call sites and - // bucket them by their distinct signatures. The producer only needs the - // honest indices — the checker template-pins them, so a misread fails - // closed rather than certifying a wrong body. Signatures: - // decompose: 1 param -> 2 results; normalize: 2 params -> 1 result; - // strip: 1 param -> 1 result; umagCmp: 4 params -> 1 result. - let mut decompose_idx = None; - let mut normalize_idx = None; - let mut strip_idx = None; - let mut umag_cmp_idx = None; - let add_entry = add_idx - .and_then(|add_fn| add_fn.checked_sub(num_imported_funcs)) - .and_then(|add_def| code_entries.get(add_def as usize)); - if let Some(entry) = add_entry { - let mut seen = std::collections::HashSet::new(); - for &callee in &entry.calls { - if !seen.insert(callee) { - continue; - } - let Some(callee_def) = callee.checked_sub(num_imported_funcs) else { - continue; - }; - let Some(type_idx) = func_type_idx.get(callee_def as usize).copied() else { - continue; - }; - let Some((params, results)) = type_sigs.get(&type_idx) else { - continue; - }; - match (params.len(), results.len()) { - (1, 2) => decompose_idx = decompose_idx.or(Some(callee)), - (2, 1) => normalize_idx = normalize_idx.or(Some(callee)), - (1, 1) => strip_idx = strip_idx.or(Some(callee)), - (4, _) => umag_cmp_idx = umag_cmp_idx.or(Some(callee)), - _ => {} - } - } - } - FragHostTable { - box_idx, - add_idx, - mul_idx, - sub_idx, - to_index_idx, - cmp_idx, - eq_idx, - limb_idx: limb, - decompose_idx, - normalize_idx, - strip_idx, - umag_cmp_idx, - } - }; - - // Which `(array (mut i8))` type is this module's `String`. A byte-sequence - // record — the `exposes opaque` `Bytes` of `stdlib/bytes.av` above all — - // gets the SAME packed representation `String` gets, so the wasm type alone - // does not separate the two and calling every packed array a `String` told - // `Bytes_octets(bytes: Bytes)` that its parameter was a String. The module's - // own string bridge names the string one: `__rt_string_to_lm` takes exactly - // that array type. When the bridge is absent nothing is named and every - // packed array keeps reading as `String`, as before. Diagnostic only. - let string_array_type = exports - .iter() - .find(|(n, _)| n == "__rt_string_to_lm") - .and_then(|(_, idx)| idx.checked_sub(num_imported_funcs)) - .and_then(|def_idx| func_type_idx.get(def_idx as usize)) - .and_then(|ti| type_sigs.get(ti)) - .and_then(|(params, _)| match params.as_slice() { - [TyKind::Ref { idx, .. }] => Some(*idx), - _ => None, - }) - .filter(|idx| string_byte_array_types.contains(idx)); - - // Resolve one declared wasm type against this module's own type section so - // a decline reason can name the source-level shape. Diagnostic only. - let value_shape = |ty: &TyKind| match ty { - TyKind::Ref { idx, .. } if Some(*idx) == carrier => ValShape::Int, - TyKind::Ref { idx, .. } if string_byte_array_types.contains(idx) => { - match string_array_type { - Some(string_ty) if string_ty != *idx => ValShape::BytePayload, - _ => ValShape::Str, - } - } - TyKind::Ref { .. } | TyKind::Eqref => ValShape::UserRef, - TyKind::I64 | TyKind::I32 | TyKind::F64 => ValShape::Scalar, - TyKind::Other => ValShape::Raw, - }; - - let mut user_fns = Vec::new(); - for (name, wasm_idx) in user_exports { - let Some(def_idx) = wasm_idx.checked_sub(num_imported_funcs) else { - continue; - }; - let Some(entry) = code_entries.get(def_idx as usize).cloned() else { - continue; - }; - let ops = resolve_data_ops(entry.ops, &data_segments); - let Some(type_idx) = func_type_idx.get(def_idx as usize).copied() else { - continue; - }; - let (params, results) = type_sigs - .get(&type_idx) - .cloned() - .unwrap_or((Vec::new(), Vec::new())); - let result = results.first().copied(); - let param_shapes = params.iter().map(&value_shape).collect(); - let result_shapes = results.iter().map(&value_shape).collect(); - user_fns.push(UserFn { - name, - wasm_idx, - type_idx, - arity: params.len(), - params, - result, - results, - nlocals: entry.nlocals, - code_entry_bytes: entry.code_entry_bytes, - ops, - host_capability_calls: entry - .calls - .iter() - .filter_map(|c| imported_func_names.get(*c as usize).cloned()) - .collect(), - param_shapes, - result_shapes, - first_unsupported_op: entry.first_unsupported_op, - calls: entry.calls, - has_loop_or_branch: entry.has_loop_or_branch, - }); - } - - Ok(( - user_fns, - box_idx, - user_idx_set, - carrier, - host_roles, - frag_host_table, - struct_field_counts, - )) -} diff --git a/aver-cert/src/engine/expr_fragment_defs.rs b/aver-cert/src/engine/expr_fragment_defs.rs deleted file mode 100644 index 823ea601f..000000000 --- a/aver-cert/src/engine/expr_fragment_defs.rs +++ /dev/null @@ -1,1082 +0,0 @@ -/// Model-facing type used by representation-level `ExprFragment` obligations. -/// This is not the source-level `SymPlan` type system: raw representation limbs -/// stay `WVal` when the source grammar has no corresponding value. -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum FragModelTy { - Float, - Bool, - Int, - WVal, -} - -impl FragModelTy { - #[cfg(feature = "engine")] - fn display_name(self) -> &'static str { - match self { - FragModelTy::Float => "Float", - FragModelTy::Bool => "Bool", - FragModelTy::Int => "Int", - FragModelTy::WVal => "WVal", - } - } - - #[cfg(feature = "engine")] - fn lean_dom_type(self) -> &'static str { - match self { - FragModelTy::Float => "UInt64", - FragModelTy::Bool => "Bool", - FragModelTy::Int => "Int", - FragModelTy::WVal => "WVal", - } - } -} - -/// Typed, ordered non-recursive expression fragment. The producer renders this -/// as untrusted `Plans.lean` data; the Lean wall checks and canonically lowers it -/// before using it as a certificate witness. Every value has an explicit -/// representation type and a defining node. -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum FragTy { - F64, - BoolI32, - IntCarrier, - I64, - RawI32, - Ref, - /// Opaque user-ADT / record reference. Unlike `Ref` (a carrier limb), this - /// is a whole user struct/array reference read verbatim (`model_ty = WVal`). - /// The concrete wasm type index is never part of the type: it lives on the - /// projecting node (`StructGetUser`) and is bound to bytes by the byte-exact - /// gate, mirroring how `HostCall` carries its resolved `func_idx`. - AdtRef, -} - -impl FragTy { - #[cfg(feature = "engine")] - fn model_ty(self) -> FragModelTy { - match self { - FragTy::F64 => FragModelTy::Float, - FragTy::BoolI32 => FragModelTy::Bool, - FragTy::IntCarrier => FragModelTy::Int, - FragTy::I64 | FragTy::RawI32 | FragTy::Ref | FragTy::AdtRef => FragModelTy::WVal, - } - } - - fn plan_tag(self) -> &'static str { - match self { - FragTy::F64 => "f64", - FragTy::BoolI32 => "bool-i32", - FragTy::IntCarrier => "int-carrier", - FragTy::I64 => "i64", - FragTy::RawI32 => "raw-i32", - FragTy::Ref => "ref", - FragTy::AdtRef => "adt-ref", - } - } - - #[cfg(feature = "engine")] - fn lean_plan_ctor(self) -> &'static str { - match self { - FragTy::F64 => ".f64", - FragTy::BoolI32 => ".boolI32", - FragTy::IntCarrier => ".intCarrier", - FragTy::I64 => ".i64", - FragTy::RawI32 => ".rawI32", - FragTy::Ref => ".ref", - FragTy::AdtRef => ".adtRef", - } - } - - #[cfg(feature = "engine")] - fn source_name(self) -> &'static str { - self.model_ty().display_name() - } - - #[cfg(feature = "engine")] - fn lean_dom_type(self) -> &'static str { - self.model_ty().lean_dom_type() - } - - #[cfg(feature = "engine")] - fn lean_arg_repr(self, name: &str, carrier: &str) -> String { - match self { - FragTy::F64 => format!(".f64v {name}"), - FragTy::BoolI32 => format!("b32 {name}"), - FragTy::IntCarrier => format!("carrierSmall {carrier} {name}"), - FragTy::I64 | FragTy::RawI32 | FragTy::Ref | FragTy::AdtRef => name.to_string(), - } - } -} - -/// Runtime host-helper role admitted by `expr-fragment-v1`. Each role fixes a -/// representation-level type signature; the resolved wasm function index is -/// carried on the node and bound to the module bytes and decoded role table by -/// artifact acceptance. -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum FragHostRole { - Box, - Add, - Mul, - /// The strict integer-subtraction contract (`carrier sub`). Admitted by the - /// Lean `HostRole` grammar for the fuel-recursion descent `sub(n, box(1))`. - Sub, - /// The `__aint_to_index` index-extraction contract: a represented integer - /// in `[0, 2^31)` passes through as its i32 value, anything else collapses - /// to the `-1` out-of-bounds sentinel. Consumed only inside the monolithic - /// fused vector-read node, never as a standalone `hostCall`. - ToIndex, - /// The `__aint_cmp` three-way comparison contract: two CANONICAL carriers - /// in, the raw `i32` sentinel `-1`/`0`/`1` out. The result is NOT a Boolean - /// — the emitter always follows the call with `i32.const 0` and a signed - /// relational operator — so its node type is `RawI32`. The assumed law is - /// quantified over a canonical carrier pair; see section 4.3 of - /// `docs/certificate-format.md` for why dropping canonicity is unsound. - Cmp, - /// The `__aint_eq` equality contract: two canonical carriers in, the - /// `0`/`1` wasm Boolean out. Unlike `Cmp` the result IS the source-level - /// Boolean, so its node type is `BoolI32` and no comparison tail follows. - /// Same canonical scoping as `Cmp`, and here the unscoped form is - /// refutable: the helper compares a small against a limb-carrying operand - /// structurally. - Eq, -} - -impl FragHostRole { - #[cfg(feature = "engine")] - fn plan_tag(self) -> &'static str { - match self { - FragHostRole::Box => "box", - FragHostRole::Add => "add", - FragHostRole::Mul => "mul", - FragHostRole::Sub => "sub", - FragHostRole::ToIndex => "to_index", - FragHostRole::Cmp => "cmp", - FragHostRole::Eq => "eq", - } - } - - #[cfg(feature = "engine")] - fn lean_ctor(self) -> &'static str { - match self { - FragHostRole::Box => ".box", - FragHostRole::Add => ".add", - FragHostRole::Mul => ".mul", - FragHostRole::Sub => ".sub", - FragHostRole::ToIndex => ".toIndex", - FragHostRole::Cmp => ".cmp", - FragHostRole::Eq => ".eq", - } - } - - pub fn from_plan_tag(tag: &str) -> Option { - match tag { - "box" => Some(FragHostRole::Box), - "add" => Some(FragHostRole::Add), - "mul" => Some(FragHostRole::Mul), - "sub" => Some(FragHostRole::Sub), - "to_index" => Some(FragHostRole::ToIndex), - "cmp" => Some(FragHostRole::Cmp), - "eq" => Some(FragHostRole::Eq), - _ => None, - } - } - - /// Static registry of representation-level role signatures: argument types - /// and result type. Twin of `PlanCheck.hostCallResultTy?`. - pub fn signature(self) -> (&'static [FragTy], FragTy) { - match self { - FragHostRole::Box => (&[FragTy::I64], FragTy::IntCarrier), - FragHostRole::Add => (&[FragTy::IntCarrier, FragTy::IntCarrier], FragTy::IntCarrier), - FragHostRole::Mul => (&[FragTy::IntCarrier, FragTy::IntCarrier], FragTy::IntCarrier), - FragHostRole::Sub => (&[FragTy::IntCarrier, FragTy::IntCarrier], FragTy::IntCarrier), - // Twin of `PlanCheck.hostCallResultTy?` returning `none`: the - // to-index role has no standalone `hostCall` signature. - FragHostRole::ToIndex => (&[], FragTy::RawI32), - // Both comparison helpers leave the carrier: two represented - // integers in, a raw i32 verdict out. The three-way one is NOT a - // Boolean (`-1` is a legitimate result), the equality one is. - FragHostRole::Cmp => (&[FragTy::IntCarrier, FragTy::IntCarrier], FragTy::RawI32), - FragHostRole::Eq => (&[FragTy::IntCarrier, FragTy::IntCarrier], FragTy::BoolI32), - } - } -} - -/// The byte-derived host-role table: which wasm function index realises each -/// admitted host role in THIS module. Derived from the audited disassembler -/// (`box` = the exported `__rt_aint_from_i64`; arithmetic = body-shape roles), -/// never from a plan or sidecar. Plans must cite exactly these indices. -#[derive(Clone, Copy, Debug, Default, PartialEq, Eq)] -pub struct FragHostTable { - pub box_idx: Option, - pub add_idx: Option, - pub mul_idx: Option, - /// The strict `sub` binding (byte-derived exactly like add/mul: - /// carrier-binop signature + first arithmetic operator + uniqueness). - pub sub_idx: Option, - /// The `__aint_to_index` binding, byte-derived from the named helper - /// export exactly like `box`. - pub to_index_idx: Option, - /// The `__aint_cmp` and `__aint_eq` bindings, byte-derived from their named - /// helper exports exactly like `box` and `to_index`. The two helpers - /// declare the SAME function type, so the export name is the only thing - /// that tells them apart — which is why neither is derived by body shape. - pub cmp_idx: Option, - pub eq_idx: Option, - /// The limb array type index the Int carrier's middle field references. - pub limb_idx: Option, - /// The four bignum sub-routine FUNCTION indices the arith helper bodies - /// call, read out of the add helper's call sites and disambiguated by their - /// distinct signatures. Declared so the acceptance pin can synthesize the - /// canonical helper bodies; a wrong index fails the template equality. - pub decompose_idx: Option, - pub normalize_idx: Option, - pub strip_idx: Option, - pub umag_cmp_idx: Option, -} - -/// Public differential surface for the seven module-level roles, in fixed -/// `(box, add, mul, sub, toIndex, cmp, eq)` order. -pub type FragHostRoleIndices = ( - Option, - Option, - Option, - Option, - Option, - Option, - Option, -); - -impl FragHostTable { - pub fn lookup(&self, role: FragHostRole) -> Option { - match role { - FragHostRole::Box => self.box_idx, - FragHostRole::Add => self.add_idx, - FragHostRole::Mul => self.mul_idx, - FragHostRole::Sub => self.sub_idx, - FragHostRole::ToIndex => self.to_index_idx, - FragHostRole::Cmp => self.cmp_idx, - FragHostRole::Eq => self.eq_idx, - } - } - - /// The `List (HostRole × Nat)` literal the Lean encoder and artifact claims - /// consume, in fixed role order (box, add, mul, sub). - pub fn lean_value(&self) -> String { - let mut entries = Vec::new(); - if let Some(idx) = self.box_idx { - entries.push(format!("(.box, {idx})")); - } - if let Some(idx) = self.add_idx { - entries.push(format!("(.add, {idx})")); - } - if let Some(idx) = self.mul_idx { - entries.push(format!("(.mul, {idx})")); - } - if let Some(idx) = self.sub_idx { - entries.push(format!("(.sub, {idx})")); - } - if let Some(idx) = self.to_index_idx { - entries.push(format!("(.toIndex, {idx})")); - } - if let Some(idx) = self.cmp_idx { - entries.push(format!("(.cmp, {idx})")); - } - if let Some(idx) = self.eq_idx { - entries.push(format!("(.eq, {idx})")); - } - format!("[{}]", entries.join(", ")) - } - - /// Module-level manifest value. Unlike `lean_value`, which renders the - /// plan grammar's present entries, this preserves all four classifier - /// outcomes (including `none`) for the in-kernel whole-module equality. - pub fn roles_lean_value(&self) -> String { - let option = |index: Option| match index { - Some(index) => format!("some {index}"), - None => "none".to_string(), - }; - format!( - "({{ box := {}, add := {}, mul := {}, sub := {}, toIndex := {}, \ - cmp := {}, eq := {} }} : \ - CertDecode.AddSub.Roles)", - option(self.box_idx), - option(self.add_idx), - option(self.mul_idx), - option(self.sub_idx), - option(self.to_index_idx), - option(self.cmp_idx), - option(self.eq_idx), - ) - } - - /// A placeholder table for producer-side encodability gating at MIR time, - /// before any wasm indices exist. Encoding shape does not depend on the - /// index values, so gating with placeholders is exact; real byte-derived - /// indices are always used wherever bytes are available. - pub fn placeholder() -> Self { - FragHostTable { - // Distinct placeholder indices: face recognisers may require - // distinct role bindings (e.g. the fused vector read's - // to-index/box distinctness), and real byte-derived tables are - // always distinct, so the shape gate must be too. - box_idx: Some(0), - add_idx: Some(1), - mul_idx: Some(2), - sub_idx: Some(3), - to_index_idx: Some(4), - cmp_idx: Some(5), - eq_idx: Some(6), - limb_idx: Some(0), - decompose_idx: Some(0), - normalize_idx: Some(0), - strip_idx: Some(0), - umag_cmp_idx: Some(0), - } - } - - /// The six declared arith helper indices (`ArithHostParams`) as - /// `Some((carrier, limb, decompose, normalize, strip, umag_cmp))` when every - /// index is known and the module carries the Int box helper, or `None`. The - /// declaration and the host-role table are `Some`/`None` together, so the - /// acceptance pin's three-state consistency holds. - pub fn arith_params(&self, carrier: Option) -> Option<(u32, u32, u32, u32, u32, u32)> { - // A `None` box index means the module has no Int carrier helper, so no - // arith parameters are declared. - self.box_idx?; - Some(( - carrier?, - self.limb_idx?, - self.decompose_idx?, - self.normalize_idx?, - self.strip_idx?, - self.umag_cmp_idx?, - )) - } - - /// Lean `Option ArithTemplateDerisk.ArithHostParams` literal for the subject. - pub fn arith_params_lean_value(&self, carrier: Option) -> String { - match self.arith_params(carrier) { - Some((carrier, limb, decompose, normalize, strip, umag_cmp)) => { - format!("some {}", arith_params_record_lean(carrier, limb, decompose, normalize, strip, umag_cmp)) - } - None => "(none : Option ArithTemplateDerisk.ArithHostParams)".to_string(), - } - } - - /// The bare `ArithHostParams` record literal (no `some` wrapper), or `None` - /// for a carrierless module. This is the exact `p` the whole-module - /// `arithTableCheck` match binds from `arithParams := some p`; the per-role - /// leaf theorems that prove `arithRoleCheck … p = true` need it verbatim so - /// the recombine `simp only` rewrite matches after the projections reduce. - pub fn arith_params_record_lean_value(&self, carrier: Option) -> Option { - self.arith_params(carrier).map( - |(carrier, limb, decompose, normalize, strip, umag_cmp)| { - arith_params_record_lean(carrier, limb, decompose, normalize, strip, umag_cmp) - }, - ) - } -} - -/// The canonical `ArithHostParams` record literal shared by the subject -/// manifest value and the per-role leaf theorems, so both render the same -/// bytes and the leaf rewrites match the manifest-derived `p`. -fn arith_params_record_lean( - carrier: u32, - limb: u32, - decompose: u32, - normalize: u32, - strip: u32, - umag_cmp: u32, -) -> String { - format!( - "({{ carrier := {carrier}, limb := {limb}, decompose := {decompose}, \ - normalize := {normalize}, strip := {strip}, umagCmp := {umag_cmp} }} : \ - ArithTemplateDerisk.ArithHostParams)" - ) -} - -/// The struct-binding table: which wasm struct type index realises each source -/// record/ADT type name in THIS module. On the producer side it is resolved -/// from the emitter's type registry; on the verifier side it is re-derived from -/// the export's own byte-derived `struct.get` instructions and validated -/// against the module's struct context. Plans never carry these indices as -/// trusted data: a wrong table encodes to canonical bytes that cannot match -/// the module, so the claim fail-closes at the byte-exact gate. -#[derive(Clone, Debug, Default, PartialEq, Eq)] -pub struct FragStructTable { - /// `(source type name, wasm struct type index)`, sorted by name for - /// deterministic rendering. - pub entries: Vec<(String, u32)>, -} - -impl FragStructTable { - pub fn lookup(&self, name: &str) -> Option { - self.entries - .iter() - .find(|(entry, _)| entry == name) - .map(|(_, idx)| *idx) - } - - /// Insert one binding; `false` when the name is already bound to a - /// DIFFERENT index (an inconsistent table must fail-close). - pub fn insert(&mut self, name: &str, idx: u32) -> bool { - match self.lookup(name) { - Some(existing) => existing == idx, - None => { - self.entries.push((name.to_string(), idx)); - self.entries.sort(); - true - } - } - } - - /// The Lean `List (String × Nat)` literal claims and witnesses consume. - #[cfg(feature = "engine")] - pub fn lean_value(&self) -> String { - format!( - "[{}]", - self.entries - .iter() - .map(|(name, idx)| format!("({}, {idx})", lean_str(name))) - .collect::>() - .join(", ") - ) - } - - /// A placeholder table for producer-side encodability gating at MIR time, - /// before any wasm type indices exist: every projected type name maps to 0. - /// Encoding shape does not depend on the index values. - pub fn placeholder_for(plan: &SymPlan) -> Self { - let mut names = sym_plan_project_type_names(plan); - names.sort(); - FragStructTable { - entries: names.into_iter().map(|name| (name, 0)).collect(), - } - } -} - -/// The Lean `List (String × Nat)` literal of a module-wide struct table: the -/// consistent union of per-export entries. An inconsistent union (one name -/// bound to two indices) fail-closes. -#[cfg(feature = "engine")] -pub fn frag_struct_table_lean_from_entries<'a>( - entries: impl IntoIterator, -) -> Result { - let mut table = FragStructTable::default(); - for (name, idx) in entries { - if !table.insert(name, *idx) { - return Err(format!( - "inconsistent byte-derived struct table: `{name}` binds to both {} and {idx}", - table.lookup(name).unwrap_or(0) - )); - } - } - Ok(table.lean_value()) -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub struct FragValueId(pub usize); - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum FragPrim { - F64Add, - F64Mul, - F64Le, - F64Ge, - F64Lt, - F64Gt, - F64Eq, - I64Eq, - I64LeS, - I64LtS, - I64GeS, - I64GtS, - I32Eq, - I32LtS, - I32GtS, - /// `i32.ge_s`: the tail the emitter appends to a `__aint_cmp` call for a - /// source-level `>=`. Twin of the wall's `FragPrim.i32GeS`; `i32.le_s` is - /// deliberately absent on both sides, since no admitted plan produces it. - I32GeS, - /// `i32.and` restricted to the Boolean domain: the checker types it only - /// over two `BoolI32` operands, because bitwise AND of arbitrary raw i32 - /// values can produce a non-Boolean result (`2 and 2 = 2`). - I32And, -} - -impl FragPrim { - #[cfg(feature = "engine")] - fn lean_plan_ctor(self) -> &'static str { - match self { - FragPrim::F64Add => ".f64Add", - FragPrim::F64Mul => ".f64Mul", - FragPrim::F64Le => ".f64Le", - FragPrim::F64Ge => ".f64Ge", - FragPrim::F64Lt => ".f64Lt", - FragPrim::F64Gt => ".f64Gt", - FragPrim::F64Eq => ".f64Eq", - FragPrim::I64Eq => ".i64Eq", - FragPrim::I64LeS => ".i64LeS", - FragPrim::I64LtS => ".i64LtS", - FragPrim::I64GeS => ".i64GeS", - FragPrim::I64GtS => ".i64GtS", - FragPrim::I32Eq => ".i32Eq", - FragPrim::I32LtS => ".i32LtS", - FragPrim::I32GtS => ".i32GtS", - FragPrim::I32GeS => ".i32GeS", - FragPrim::I32And => ".i32And", - } - } -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub enum FragNodeKind { - Local { index: u32 }, - ConstBool(bool), - ConstI64(i64), - ConstI32(i32), - ConstF64(u64), - StructGet { - field: u32, - receiver: FragValueId, - }, - /// Projection of `field` out of a user struct of wasm type `ty_idx` (a whole - /// record/ADT, not the Int carrier). Lowers to `struct.get ty_idx field` - /// with the type index taken from the node (bound to bytes by the byte-exact - /// gate; validated against the byte-derived struct context by the checker). - StructGetUser { - ty_idx: u32, - field: u32, - value: FragValueId, - }, - RefIsNull { - value: FragValueId, - }, - Prim { - op: FragPrim, - args: Vec, - }, - HostCall { - role: FragHostRole, - func_idx: u32, - args: Vec, - }, - /// A self-recursive call to the function being certified. `tail` selects - /// `return_call` (`0x12`) over `call` (`0x10`). `func_idx` is the resolved - /// self index, bound to the module bytes by the byte-exact gate. - SelfCall { - tail: bool, - func_idx: u32, - args: Vec, - }, - If { - cond: FragValueId, - then_block: Box, - else_block: Box, - }, - /// Monolithic fused bounds-checked vector read - /// (`Option.withDefault(Vector.get(p0, p1), default)`): the exact emitter - /// template over pinned locals 0 (vector) and 1 (index). Consumes no - /// operand stack values. Twin of `FragNodeKind.vectorGetOrDefault`. - VectorGetOrDefault { - arr_ty: u32, - to_index_idx: u32, - box_idx: u32, - default: i64, - }, - /// Construction of a user struct of wasm type `ty_idx` from `args` (source - /// field order). Lowers to `struct.new ty_idx`; the type index is bound to - /// the module bytes by the byte-exact gate, mirroring `StructGetUser`. - /// Twin of `FragNodeKind.structNew` (added LAST in the Lean inductive so - /// existing `next`-goal order in the wall induction is untouched). - StructNew { - ty_idx: u32, - args: Vec, - }, - /// The emitter's monolithic sign template for comparing a COMPUTED Int - /// carrier against an i64 literal without calling `__aint_cmp` - /// (`from_mir/builtins.rs::emit_aint_cmp_const`). The operand is popped off - /// the stack into `scratch` — the one declared scratch local, pinned to - /// `params.length` by the plan checker — and the `limbs = null` test picks - /// either the native i64 compare of the `small` field or, for a canonical - /// limb-carrying operand, the sign field alone. Twin of - /// `FragNodeKind.intSignCmp` (added LAST in the Lean inductive). - IntSignCmp { - op: SymIntCmp, - constant: i64, - scratch: u32, - value: FragValueId, - }, -} - -/// The i64 comparison the sign template's SMALL arm performs against the -/// literal. Twin of `PlanLower.intSignCmpSmallPrim`. -fn int_sign_cmp_small_prim(op: SymIntCmp) -> FragPrim { - match op { - SymIntCmp::Eq => FragPrim::I64Eq, - SymIntCmp::Lt => FragPrim::I64LtS, - SymIntCmp::Le => FragPrim::I64LeS, - SymIntCmp::Ge => FragPrim::I64GeS, - SymIntCmp::Gt => FragPrim::I64GtS, - } -} - -/// The i32 comparison the sign template's LIMB-CARRYING arm performs against -/// `i32.const 0`, or `None` for equality — which reads no sign field at all, -/// because a canonical limb-carrying carrier never equals an i64 literal. -/// Twin of `PlanLower.intSignCmpBigArm`. -fn int_sign_cmp_sign_prim(op: SymIntCmp) -> Option { - match op { - SymIntCmp::Eq => None, - SymIntCmp::Lt | SymIntCmp::Le => Some(FragPrim::I32LtS), - SymIntCmp::Ge | SymIntCmp::Gt => Some(FragPrim::I32GtS), - } -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct FragNode { - pub id: FragValueId, - pub ty: FragTy, - pub kind: FragNodeKind, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct FragBlock { - pub nodes: Vec, - pub result: FragValueId, -} - -impl FragBlock { - fn node(&self, id: FragValueId) -> Option<&FragNode> { - self.nodes.get(id.0).filter(|node| node.id == id) - } - - pub fn result_ty(&self) -> Option { - self.node(self.result).map(|node| node.ty) - } -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct ExprFragmentPlan { - pub params: Vec, - pub result: FragTy, - pub body: FragBlock, -} - -impl ExprFragmentPlan { - #[cfg(feature = "engine")] - fn arity(&self) -> usize { - self.params.len() - } - - #[cfg(feature = "engine")] - fn source_dom(&self) -> String { - self.params - .iter() - .map(|ty| ty.source_name()) - .collect::>() - .join(" x ") - } - - #[cfg(feature = "engine")] - fn source_cod(&self) -> String { - self.result.source_name().to_string() - } -} - -#[cfg(feature = "engine")] -fn expr_fragment_plan_lean_value(plan: &ExprFragmentPlan) -> String { - format!( - "{{ profile := \"expr-fragment-v1\", params := [{}], result := {}, body := {} }}", - plan.params - .iter() - .map(|ty| ty.lean_plan_ctor()) - .collect::>() - .join(", "), - plan.result.lean_plan_ctor(), - expr_fragment_block_lean_value(&plan.body) - ) -} - -#[cfg(feature = "engine")] -fn expr_fragment_block_lean_value(block: &FragBlock) -> String { - format!( - "({{ nodes := [{}], result := {} }} : FragBlock)", - block - .nodes - .iter() - .map(expr_fragment_node_lean_value) - .collect::>() - .join(", "), - block.result.0 - ) -} - -#[cfg(feature = "engine")] -fn expr_fragment_node_lean_value(node: &FragNode) -> String { - format!( - "{{ id := {}, ty := {}, kind := {} }}", - node.id.0, - node.ty.lean_plan_ctor(), - expr_fragment_node_kind_lean_value(&node.kind) - ) -} - -#[cfg(feature = "engine")] -fn expr_fragment_node_kind_lean_value(kind: &FragNodeKind) -> String { - match kind { - FragNodeKind::Local { index } => format!(".local {index}"), - FragNodeKind::ConstBool(value) => format!(".constBool {value}"), - FragNodeKind::ConstI64(value) => format!(".constI64 ({value} : Int)"), - FragNodeKind::ConstI32(value) => format!(".constI32 ({value} : Int)"), - FragNodeKind::ConstF64(bits) => format!(".constF64Bits 0x{bits:016x}"), - FragNodeKind::StructGet { field, receiver } => { - format!(".structGet {field} {}", receiver.0) - } - FragNodeKind::StructGetUser { - ty_idx, - field, - value, - } => format!(".structGetUser {ty_idx} {field} {}", value.0), - FragNodeKind::RefIsNull { value } => format!(".refIsNull {}", value.0), - FragNodeKind::StructNew { ty_idx, args } => format!( - ".structNew {ty_idx} [{}]", - args.iter() - .map(|id| id.0.to_string()) - .collect::>() - .join(", ") - ), - FragNodeKind::IntSignCmp { - op, - constant, - scratch, - value, - } => format!( - ".intSignCmp {} ({constant} : Int) {scratch} {}", - op.lean_plan_ctor(), - value.0 - ), - FragNodeKind::Prim { op, args } => format!( - ".prim {} [{}]", - op.lean_plan_ctor(), - args.iter() - .map(|id| id.0.to_string()) - .collect::>() - .join(", ") - ), - FragNodeKind::HostCall { - role, - func_idx, - args, - } => format!( - ".hostCall {} {func_idx} [{}]", - role.lean_ctor(), - args.iter() - .map(|id| id.0.to_string()) - .collect::>() - .join(", ") - ), - FragNodeKind::SelfCall { - tail, - func_idx, - args, - } => format!( - ".selfCall {tail} {func_idx} [{}]", - args.iter() - .map(|id| id.0.to_string()) - .collect::>() - .join(", ") - ), - FragNodeKind::VectorGetOrDefault { - arr_ty, - to_index_idx, - box_idx, - default, - } => format!(".vectorGetOrDefault {arr_ty} {to_index_idx} {box_idx} ({default} : Int)"), - FragNodeKind::If { - cond, - then_block, - else_block, - } => format!( - ".ifElse {} {} {}", - cond.0, - expr_fragment_block_lean_value(then_block), - expr_fragment_block_lean_value(else_block) - ), - } -} - -#[cfg(feature = "engine")] -fn expr_fragment_dom_type(params: &[FragTy]) -> String { - match params { - [] => "Unit".to_string(), - [single] => single.lean_dom_type().to_string(), - many => many - .iter() - .map(|ty| ty.lean_dom_type()) - .collect::>() - .join(" × "), - } -} - -#[cfg(feature = "engine")] -fn expr_fragment_dom_accessor(root: &str, index: usize, len: usize) -> String { - if len <= 1 { - return root.to_string(); - } - if index == 0 { - return format!("{root}.1"); - } - expr_fragment_dom_accessor(&format!("{root}.2"), index - 1, len - 1) -} - -#[cfg(feature = "engine")] -fn expr_fragment_dom_repr_list(params: &[FragTy], root: &str, carrier: &str) -> String { - let args = params - .iter() - .enumerate() - .map(|(i, ty)| { - let access = expr_fragment_dom_accessor(root, i, params.len()); - ty.lean_arg_repr(&access, carrier) - }) - .collect::>(); - format!("[{}]", args.join(", ")) -} - -#[cfg(all(test, feature = "engine"))] -mod expr_fragment_sem_ty_tests { - use super::*; - - /// Concrete heap-type indices are SIGNED s33 LEB128: 63 is the last index - /// whose signed encoding coincides with the unsigned one; 64 has bit 6 set - /// in its low group, so signed encoding needs a continuation (`c0 00`). - #[test] - fn heap_type_indices_use_signed_s33_leb() { - let enc = |idx: u32| { - let mut out = Vec::new(); - push_s33_heap_idx(&mut out, idx); - out - }; - assert_eq!(enc(0), vec![0x00]); - assert_eq!(enc(2), vec![0x02]); - assert_eq!(enc(63), vec![0x3f]); - assert_eq!(enc(64), vec![0xc0, 0x00]); - assert_eq!(enc(127), vec![0xff, 0x00]); - assert_eq!(enc(128), vec![0x80, 0x01]); - } - - /// The carrier local declaration and the Int-carrier `if` block type both - /// carry a concrete heap-type index; at carrier 64 they must use the s33 - /// continuation encoding, at 63 the single byte. - #[test] - fn carrier_local_decl_and_blocktype_are_s33_at_boundary() { - // Local declaration prefix of the canonical body: `01 01 63 `. - let plan = add_two_hostcall_plan(); - let bytes63 = lower_expr_fragment_plan_code_entry_bytes(&plan, 63).expect("carrier 63"); - assert_eq!(&bytes63[1..5], &[0x01, 0x01, 0x63, 0x3f]); - let bytes64 = lower_expr_fragment_plan_code_entry_bytes(&plan, 64).expect("carrier 64"); - assert_eq!(&bytes64[1..6], &[0x01, 0x01, 0x63, 0xc0, 0x00]); - - // Value-if block type `04 63 ` in a recursion-shaped body. - let rec63 = recursion_plan_recursive( - 10, - (FragHostRole::Add, 11), - 12, - 1, - 7, - false, - BodyOperand::Input, - ); - let rb63 = lower_expr_fragment_plan_code_entry_bytes(&rec63, 63).expect("rec carrier 63"); - assert!( - rb63.windows(3).any(|w| w == [0x04, 0x63, 0x3f]), - "carrier-63 value-if block type missing: {rb63:02x?}" - ); - let rb64 = lower_expr_fragment_plan_code_entry_bytes(&rec63, 64).expect("rec carrier 64"); - assert!( - rb64.windows(4).any(|w| w == [0x04, 0x63, 0xc0, 0x00]), - "carrier-64 value-if block type missing: {rb64:02x?}" - ); - } - - #[test] - fn frag_ty_keeps_model_face_separate_from_wasm_repr() { - assert_eq!(FragTy::F64.model_ty(), FragModelTy::Float); - assert_eq!(FragTy::BoolI32.model_ty(), FragModelTy::Bool); - assert_eq!(FragTy::IntCarrier.model_ty(), FragModelTy::Int); - assert_eq!(FragTy::I64.model_ty(), FragModelTy::WVal); - assert_eq!(FragTy::RawI32.model_ty(), FragModelTy::WVal); - assert_eq!(FragTy::Ref.model_ty(), FragModelTy::WVal); - - assert_eq!(FragTy::IntCarrier.plan_tag(), "int-carrier"); - assert_eq!(FragTy::IntCarrier.source_name(), "Int"); - assert_eq!(FragTy::IntCarrier.lean_dom_type(), "Int"); - } - - fn add_two_hostcall_plan() -> ExprFragmentPlan { - ExprFragmentPlan { - params: vec![FragTy::IntCarrier], - result: FragTy::IntCarrier, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::IntCarrier, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::I64, - kind: FragNodeKind::ConstI64(2), - }, - FragNode { - id: FragValueId(2), - ty: FragTy::IntCarrier, - kind: FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: 6, - args: vec![FragValueId(1)], - }, - }, - FragNode { - id: FragValueId(3), - ty: FragTy::IntCarrier, - kind: FragNodeKind::HostCall { - role: FragHostRole::Add, - func_idx: 7, - args: vec![FragValueId(0), FragValueId(2)], - }, - }, - ], - result: FragValueId(3), - }, - } - } - - #[test] - fn hostcall_plan_lowers_to_addtwo_bytes_and_ops() { - let plan = add_two_hostcall_plan(); - // Byte lowering reproduces the empirically pinned addTwo code-entry - // `0d 01 01 63 02 20 00 42 02 10 06 10 07 0b`. - let bytes = lower_expr_fragment_plan_code_entry_bytes(&plan, 2).expect("lower bytes"); - assert_eq!( - bytes, - vec![13, 1, 1, 99, 2, 32, 0, 66, 2, 16, 6, 16, 7, 11] - ); - // Op lowering matches the straight-line body the checker re-derives. - let ops = lower_expr_fragment_plan(&plan, 2).expect("lower ops"); - assert_eq!( - ops, - vec![Op::LocalGet(0), Op::I64Const(2), Op::Call(6), Op::Call(7)] - ); - } - - #[test] - fn hostcall_plan_lean_value_uses_host_call_ctor() { - let lean = expr_fragment_plan_lean_value(&add_two_hostcall_plan()); - assert!(lean.contains(".hostCall .box 6 [1]"), "lean = {lean}"); - assert!(lean.contains(".hostCall .add 7 [0, 2]"), "lean = {lean}"); - } - - /// The field-projection plan shape for `userName(u: User) -> String` = `u.name`. - /// Param 0 is the User reference (`AdtRef`); the body projects field 0 of the - /// user struct (wasm type index 15) verbatim. Carrier scratch-local type = 18. - fn user_name_projection_plan() -> ExprFragmentPlan { - ExprFragmentPlan { - params: vec![FragTy::AdtRef], - result: FragTy::AdtRef, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::AdtRef, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::AdtRef, - kind: FragNodeKind::StructGetUser { - ty_idx: 15, - field: 0, - value: FragValueId(0), - }, - }, - ], - result: FragValueId(1), - }, - } - } - - #[test] - fn user_struct_projection_plan_lowers_to_username_bytes_and_ops() { - let plan = user_name_projection_plan(); - // Byte lowering reproduces the empirically pinned userName code-entry - // `0b 01 01 63 12 20 00 fb 02 0f 00 0b` (carrier scratch local type 18, - // `struct.get 15 0`). - let bytes = lower_expr_fragment_plan_code_entry_bytes(&plan, 18).expect("lower bytes"); - assert_eq!( - bytes, - vec![0x0b, 0x01, 0x01, 0x63, 0x12, 0x20, 0x00, 0xfb, 0x02, 0x0f, 0x00, 0x0b] - ); - // Op lowering matches the `[local.get 0, struct.get 15 0]` body the - // checker re-derives (struct type index from the node, not the carrier). - let ops = lower_expr_fragment_plan(&plan, 18).expect("lower ops"); - assert_eq!(ops, vec![Op::LocalGet(0), Op::StructGet(15, 0)]); - } - - fn sign_template_plan(op: SymIntCmp, constant: i64) -> ExprFragmentPlan { - ExprFragmentPlan { - params: vec![FragTy::IntCarrier], - result: FragTy::BoolI32, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::IntCarrier, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::BoolI32, - kind: FragNodeKind::IntSignCmp { - op, - constant, - scratch: 1, - value: FragValueId(0), - }, - }, - ], - result: FragValueId(1), - }, - } - } - - /// The plan-text renderer emits `int.sign_cmp`, so the plan-text parser - /// must read it back — including a NEGATIVE literal, whose minus sign is - /// the one character an attribute scanner is most likely to drop. - #[test] - fn bool_renderer_reads_the_sign_template_instead_of_panicking() { - let local = |index: u32, _ty: FragTy| format!("a{index}"); - for (op, constant, expected) in [ - (SymIntCmp::Ge, 0_i64, "(0) <= (a0)"), - (SymIntCmp::Gt, 0, "(0) < (a0)"), - (SymIntCmp::Le, 0, "(a0) <= (0)"), - (SymIntCmp::Lt, -5, "(a0) < ((-5))"), - (SymIntCmp::Eq, 7, "(a0) = (7)"), - ] { - let plan = sign_template_plan(op, constant); - let rendered = - expr_fragment_bool_expr(&plan.body, plan.body.result, &local); - assert_eq!(rendered, expected); - } - } - - #[test] - fn user_struct_projection_plan_lean_renders_the_user_node() { - let plan = user_name_projection_plan(); - let lean = expr_fragment_plan_lean_value(&plan); - assert!(lean.contains(".structGetUser 15 0 0"), "lean = {lean}"); - assert!(lean.contains("params := [.adtRef]"), "lean = {lean}"); - assert!(lean.contains("result := .adtRef"), "lean = {lean}"); - } -} diff --git a/aver-cert/src/engine/expr_fragment_faces.rs b/aver-cert/src/engine/expr_fragment_faces.rs deleted file mode 100644 index 92716e5b2..000000000 --- a/aver-cert/src/engine/expr_fragment_faces.rs +++ /dev/null @@ -1,921 +0,0 @@ -// Recognised proof faces of expression-fragment plans. These are pure plan -// pattern-matchers (no byte analysis), shared between the producer's MIR -// adapter — which gates plan emission on a face existing — and the engine's -// classifier, so they live in the `plans` layer. - -/// The verbatim field-projection face of an ADT-ref expr fragment: exactly -/// `struct.get ty field∈{0,1}` of the single reference parameter, returned -/// unchanged. This is the only fragment shape admitting `AdtRef` values today; -/// any other ADT-ref plan fail-closes on producer and verifier alike. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct FragProjectFace { - pub struct_idx: u32, - pub field_idx: u32, -} - -pub fn expr_fragment_project_face(plan: &ExprFragmentPlan) -> Option { - if plan.params.as_slice() != [FragTy::AdtRef] || plan.result != FragTy::AdtRef { - return None; - } - let [n0, n1] = plan.body.nodes.as_slice() else { - return None; - }; - if plan.body.result != FragValueId(1) { - return None; - } - let FragNodeKind::Local { index: 0 } = n0.kind else { - return None; - }; - let FragNodeKind::StructGetUser { - ty_idx, - field, - value, - } = n1.kind - else { - return None; - }; - if value != FragValueId(0) || field > 1 { - return None; - } - if n0.ty != FragTy::AdtRef || n1.ty != FragTy::AdtRef { - return None; - } - Some(FragProjectFace { - struct_idx: ty_idx, - field_idx: field, - }) -} - -/// The stage-1 record field-read result types — exactly the range of the wall's -/// `SchemaCore.scalarLeafFragTy?` (`PlanCheck.fragTyIsRecordScalar`): the boxed -/// Int carrier, the Boolean i32, or the raw f64. Broadening this breaks the -/// producer/wall encode agreement (`encode… = some {name}Plan := rfl`). -pub fn frag_ty_is_record_scalar(ty: FragTy) -> bool { - matches!(ty, FragTy::BoolI32 | FragTy::IntCarrier | FragTy::F64) -} - -/// The scalar record-projection face of an ADT-ref expr fragment: exactly -/// `struct.get structIdx field` of the single opaque record reference, yielding -/// a stage-1 scalar leaf. Unlike `expr_fragment_project_face` the projected -/// result is a SCALAR (`frag_ty_is_record_scalar`) and the field index is NOT -/// capped — the wall record face's type-section equality pin fixes the whole -/// ordered field list. Exact Rust twin of `WasmSlice.exprRecordProjFace?`. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct FragRecordProjFace { - pub struct_idx: u32, - pub field_idx: u32, -} - -pub fn expr_fragment_record_proj_face(plan: &ExprFragmentPlan) -> Option { - if plan.params.as_slice() != [FragTy::AdtRef] - || !frag_ty_is_record_scalar(plan.result) - || plan.body.result != FragValueId(1) - { - return None; - } - let [n0, n1] = plan.body.nodes.as_slice() else { - return None; - }; - if n0.id != FragValueId(0) || n1.id != FragValueId(1) { - return None; - } - let FragNodeKind::Local { index: 0 } = n0.kind else { - return None; - }; - let FragNodeKind::StructGetUser { - ty_idx, - field, - value, - } = n1.kind - else { - return None; - }; - if value != FragValueId(0) || n0.ty != FragTy::AdtRef || n1.ty != plan.result { - return None; - } - Some(FragRecordProjFace { - struct_idx: ty_idx, - field_idx: field, - }) -} - -/// Exact Rust twin of `StandardFace.classifyTagDispatch` in the frozen wall. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct FragTagDispatchFace { - pub opt_idx: u32, - pub box_idx: u32, - pub tag: i64, - pub then_c: i64, - pub else_c: i64, -} - -fn expr_fragment_tag_dispatch_arm(block: &FragBlock) -> Option<(u32, i64)> { - let [n0, n1] = block.nodes.as_slice() else { - return None; - }; - if block.result != FragValueId(1) - || n0.id != FragValueId(0) - || n1.id != FragValueId(1) - || n0.ty != FragTy::I64 - || n1.ty != FragTy::IntCarrier - { - return None; - } - let FragNodeKind::ConstI64(constant) = n0.kind else { - return None; - }; - let FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx, - ref args, - } = n1.kind - else { - return None; - }; - (args.as_slice() == [FragValueId(0)]).then_some((func_idx, constant)) -} - -pub fn expr_fragment_tag_dispatch_face(plan: &ExprFragmentPlan) -> Option { - if plan.params.as_slice() != [FragTy::AdtRef] - || plan.result != FragTy::IntCarrier - || plan.body.result != FragValueId(4) - { - return None; - } - let [n0, n1, n2, n3, n4] = plan.body.nodes.as_slice() else { - return None; - }; - if [n0.id.0, n1.id.0, n2.id.0, n3.id.0, n4.id.0] != [0, 1, 2, 3, 4] - || n0.ty != FragTy::AdtRef - || n1.ty != FragTy::RawI32 - || n2.ty != FragTy::RawI32 - || n3.ty != FragTy::BoolI32 - || n4.ty != FragTy::IntCarrier - { - return None; - } - let FragNodeKind::Local { index: 0 } = n0.kind else { - return None; - }; - let FragNodeKind::StructGetUser { - ty_idx: opt_idx, - field: 0, - value: FragValueId(0), - } = n1.kind - else { - return None; - }; - let FragNodeKind::ConstI32(tag) = n2.kind else { - return None; - }; - let FragNodeKind::Prim { - op: FragPrim::I32Eq, - ref args, - } = n3.kind - else { - return None; - }; - let FragNodeKind::If { - cond: FragValueId(3), - ref then_block, - ref else_block, - } = n4.kind - else { - return None; - }; - if args.as_slice() != [FragValueId(1), FragValueId(2)] { - return None; - } - let (box_idx, then_c) = expr_fragment_tag_dispatch_arm(then_block)?; - let (else_box_idx, else_c) = expr_fragment_tag_dispatch_arm(else_block)?; - (box_idx == else_box_idx).then_some(FragTagDispatchFace { - opt_idx, - box_idx, - tag: i64::from(tag), - then_c, - else_c, - }) -} - -/// Exact Rust twin of `StandardFace.classifyVectorGetOrDefault` in the wall: -/// the plan is the single monolithic fused vector-read node over the pinned -/// `(vector, index)` params, with distinct helper indices. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct FragVectorGetOrDefaultFace { - pub arr_ty: u32, - pub to_index_idx: u32, - pub box_idx: u32, - pub default: i64, -} - -pub fn expr_fragment_vector_get_face( - plan: &ExprFragmentPlan, -) -> Option { - if plan.params.as_slice() != [FragTy::AdtRef, FragTy::IntCarrier] - || plan.result != FragTy::IntCarrier - || plan.body.result != FragValueId(0) - { - return None; - } - let [n0] = plan.body.nodes.as_slice() else { - return None; - }; - if n0.id != FragValueId(0) || n0.ty != FragTy::IntCarrier { - return None; - } - let FragNodeKind::VectorGetOrDefault { - arr_ty, - to_index_idx, - box_idx, - default, - } = n0.kind - else { - return None; - }; - (to_index_idx != box_idx).then_some(FragVectorGetOrDefaultFace { - arr_ty, - to_index_idx, - box_idx, - default, - }) -} - -/// The comparison operator of an admitted Int value-versus-value face. Exact -/// Rust twin of the wall's `StandardFace.IntCmpOp`: `le` is absent by -/// construction, because the plan grammar has no `i32.le_s` to lower it to. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub enum FragIntCmpOp { - Lt, - Gt, - Ge, - Eq, -} - -impl FragIntCmpOp { - /// The wall constructor naming this operator (`StandardFace.IntCmpOp`). - pub fn lean_ctor(self) -> &'static str { - match self { - FragIntCmpOp::Lt => ".lt", - FragIntCmpOp::Gt => ".gt", - FragIntCmpOp::Ge => ".ge", - FragIntCmpOp::Eq => ".eq", - } - } -} - -/// Face data of both Int comparison shapes: which operator, and the resolved -/// index of the single runtime helper it reads (`__aint_cmp` for the three -/// relational operators, `__aint_eq` for equality). Exact Rust twin of -/// `StandardFace.IntCmpFace`. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct FragIntCmpFace { - pub op: FragIntCmpOp, - pub helper_idx: u32, -} - -/// Twin of `StandardFace.intCmpOfPrim?`: the signed relational primitive each -/// operator's tail uses. Every other primitive declines, which keeps an -/// `i32.and`- or `i32.eq`-tailed body out of these faces. -fn frag_int_cmp_of_prim(op: FragPrim) -> Option { - match op { - FragPrim::I32LtS => Some(FragIntCmpOp::Lt), - FragPrim::I32GtS => Some(FragIntCmpOp::Gt), - FragPrim::I32GeS => Some(FragIntCmpOp::Ge), - _ => None, - } -} - -/// The pinned comparison prefix shared by both faces: `local 0`, `local 1`, and -/// either the `__aint_eq` call alone (3 nodes) or the `__aint_cmp` call plus -/// `i32.const 0` plus a signed relational operator (5 nodes). Returns the face -/// and the number of nodes the prefix occupies. -fn frag_int_cmp_prefix(nodes: &[FragNode]) -> Option<(FragIntCmpFace, usize)> { - let [n0, n1, rest @ ..] = nodes else { - return None; - }; - if n0.id != FragValueId(0) - || n1.id != FragValueId(1) - || n0.ty != FragTy::IntCarrier - || n1.ty != FragTy::IntCarrier - { - return None; - } - let (FragNodeKind::Local { index: 0 }, FragNodeKind::Local { index: 1 }) = (&n0.kind, &n1.kind) - else { - return None; - }; - let [n2, tail @ ..] = rest else { - return None; - }; - if n2.id != FragValueId(2) { - return None; - } - match &n2.kind { - FragNodeKind::HostCall { - role: FragHostRole::Eq, - func_idx, - args, - } if n2.ty == FragTy::BoolI32 - && args.as_slice() == [FragValueId(0), FragValueId(1)] => - { - Some(( - FragIntCmpFace { - op: FragIntCmpOp::Eq, - helper_idx: *func_idx, - }, - 3, - )) - } - FragNodeKind::HostCall { - role: FragHostRole::Cmp, - func_idx, - args, - } if n2.ty == FragTy::RawI32 - && args.as_slice() == [FragValueId(0), FragValueId(1)] => - { - let [n3, n4, ..] = tail else { - return None; - }; - if n3.id != FragValueId(3) - || n4.id != FragValueId(4) - || n3.ty != FragTy::RawI32 - || n4.ty != FragTy::BoolI32 - { - return None; - } - let FragNodeKind::ConstI32(0) = n3.kind else { - return None; - }; - let FragNodeKind::Prim { op, args } = &n4.kind else { - return None; - }; - if args.as_slice() != [FragValueId(2), FragValueId(3)] { - return None; - } - Some(( - FragIntCmpFace { - op: frag_int_cmp_of_prim(*op)?, - helper_idx: *func_idx, - }, - 5, - )) - } - _ => None, - } -} - -/// One arm of the selection: a bare argument read, no box and no host call. -/// Twin of `StandardFace.intSelectArm`. -fn frag_int_select_arm(block: &FragBlock, local: u32) -> bool { - let [node] = block.nodes.as_slice() else { - return false; - }; - block.result == FragValueId(0) - && node.id == FragValueId(0) - && node.ty == FragTy::IntCarrier - && node.kind == FragNodeKind::Local { index: local } -} - -/// Exact Rust twin of `StandardFace.classifyIntSelect`: the comparison above -/// followed by an `if` whose two arms are the bare reads of parameter 0 and -/// parameter 1 in that order — so the result is a passthrough of an input, never -/// a freshly boxed value. -pub fn expr_fragment_int_select_face(plan: &ExprFragmentPlan) -> Option { - if plan.params.as_slice() != [FragTy::IntCarrier, FragTy::IntCarrier] - || plan.result != FragTy::IntCarrier - { - return None; - } - let (face, len) = frag_int_cmp_prefix(&plan.body.nodes)?; - if plan.body.nodes.len() != len + 1 || plan.body.result != FragValueId(len) { - return None; - } - let node = &plan.body.nodes[len]; - if node.id != FragValueId(len) || node.ty != FragTy::IntCarrier { - return None; - } - let FragNodeKind::If { - cond, - then_block, - else_block, - } = &node.kind - else { - return None; - }; - (*cond == FragValueId(len - 1) - && frag_int_select_arm(then_block, 0) - && frag_int_select_arm(else_block, 1)) - .then_some(face) -} - -fn frag_block_has_user_struct_get(block: &FragBlock) -> bool { - block.nodes.iter().any(|node| match &node.kind { - FragNodeKind::StructGetUser { .. } => true, - FragNodeKind::If { - then_block, - else_block, - .. - } => { - frag_block_has_user_struct_get(then_block) - || frag_block_has_user_struct_get(else_block) - } - _ => false, - }) -} - -/// Rust twin of the wall's broad `exprFragmentIsTagDispatch` discriminator: -/// an ADT-ref argument, an Int-carrier result, and at least one user-struct -/// field read in the encoded plan. The wall's classifier later checks the -/// exact canonical tag-dispatch node shape. -pub fn expr_fragment_is_tag_dispatch(plan: &ExprFragmentPlan) -> bool { - plan.params.as_slice() == [FragTy::AdtRef] - && plan.result == FragTy::IntCarrier - && frag_block_has_user_struct_get(&plan.body) -} - -fn frag_block_touches_adt_ref(block: &FragBlock) -> bool { - block.nodes.iter().any(|node| { - node.ty == FragTy::AdtRef - || match &node.kind { - FragNodeKind::StructGetUser { .. } => true, - FragNodeKind::If { - then_block, - else_block, - .. - } => { - frag_block_touches_adt_ref(then_block) || frag_block_touches_adt_ref(else_block) - } - _ => false, - } - }) -} - -/// Whether a plan involves opaque user-ADT references anywhere (params, result -/// or body). Such plans are admitted ONLY through the field-projection face. -pub fn expr_fragment_plan_touches_adt_ref(plan: &ExprFragmentPlan) -> bool { - plan.params.contains(&FragTy::AdtRef) - || plan.result == FragTy::AdtRef - || frag_block_touches_adt_ref(&plan.body) -} - -fn frag_block_has_host_call_where(block: &FragBlock, want: &dyn Fn(FragHostRole) -> bool) -> bool { - block.nodes.iter().any(|node| match &node.kind { - FragNodeKind::HostCall { role, .. } => want(*role), - FragNodeKind::If { - then_block, - else_block, - .. - } => { - frag_block_has_host_call_where(then_block, want) - || frag_block_has_host_call_where(else_block, want) - } - _ => false, - }) -} - -/// Whether a plan calls a runtime host helper anywhere in its body. Such plans -/// are admitted ONLY through an exact recognised face: a host call is a claim -/// about a runtime contract, and the generic expression-fragment gate in the -/// wall (`genericFragmentAllowedFuel`) rejects every `.hostCall` node outright. -/// Producer and verifier read this same predicate so the two gates cannot drift. -pub fn expr_fragment_plan_has_host_calls(plan: &ExprFragmentPlan) -> bool { - frag_block_has_host_call_where(&plan.body, &|_| true) -} - -/// Whether a plan calls one PARTICULAR host role. The producer reads this to -/// decide whether the module it is about to emit really calls a helper, which -/// is what gates the helper's named export (and with it the role's certificate -/// binding) — a plan is the exact body its canonical lowering emits, so the -/// roles it names are the calls the bytes will carry. -pub fn expr_fragment_plan_calls_host_role(plan: &ExprFragmentPlan, role: FragHostRole) -> bool { - frag_block_has_host_call_where(&plan.body, &|candidate| candidate == role) -} - -#[cfg(all(test, feature = "engine"))] -mod record_proj_face_tests { - use super::*; - - /// A record scalar field read: `struct.get struct_idx field` of the single - /// record reference, yielding `result`. This is the shape person's - /// `readMember`/`readAge` compile to. - fn record_proj_plan(struct_idx: u32, field: u32, result: FragTy) -> ExprFragmentPlan { - ExprFragmentPlan { - params: vec![FragTy::AdtRef], - result, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::AdtRef, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: result, - kind: FragNodeKind::StructGetUser { - ty_idx: struct_idx, - field, - value: FragValueId(0), - }, - }, - ], - result: FragValueId(1), - }, - } - } - - #[test] - fn frag_ty_is_record_scalar_is_exactly_the_three_leaves() { - assert!(frag_ty_is_record_scalar(FragTy::BoolI32)); - assert!(frag_ty_is_record_scalar(FragTy::IntCarrier)); - assert!(frag_ty_is_record_scalar(FragTy::F64)); - for ty in [FragTy::I64, FragTy::RawI32, FragTy::Ref, FragTy::AdtRef] { - assert!(!frag_ty_is_record_scalar(ty), "{ty:?} must not be a record leaf"); - } - } - - #[test] - fn recognizes_person_field_reads() { - // `readMember`: Bool field 1 of struct 0. `readAge`: Int field 0. - assert_eq!( - expr_fragment_record_proj_face(&record_proj_plan(0, 1, FragTy::BoolI32)), - Some(FragRecordProjFace { struct_idx: 0, field_idx: 1 }) - ); - assert_eq!( - expr_fragment_record_proj_face(&record_proj_plan(0, 0, FragTy::IntCarrier)), - Some(FragRecordProjFace { struct_idx: 0, field_idx: 0 }) - ); - // The field index is not capped (unlike the verbatim projection face). - assert_eq!( - expr_fragment_record_proj_face(&record_proj_plan(7, 5, FragTy::F64)), - Some(FragRecordProjFace { struct_idx: 7, field_idx: 5 }) - ); - } - - #[test] - fn declines_whole_reference_projection() { - // An `AdtRef` result is the verbatim field-projection face, NOT a record - // scalar leaf — it must decline here (and route to `expr_fragment_project_face`). - assert_eq!( - expr_fragment_record_proj_face(&record_proj_plan(0, 0, FragTy::AdtRef)), - None - ); - } - - #[test] - fn declines_non_scalar_leaf_result() { - for ty in [FragTy::I64, FragTy::RawI32, FragTy::Ref] { - assert_eq!(expr_fragment_record_proj_face(&record_proj_plan(0, 0, ty)), None); - } - } - - #[test] - fn declines_wrong_parameter_shape() { - // Not a single opaque record reference. - let mut plan = record_proj_plan(0, 1, FragTy::BoolI32); - plan.params = vec![FragTy::IntCarrier]; - assert_eq!(expr_fragment_record_proj_face(&plan), None); - let mut plan = record_proj_plan(0, 1, FragTy::BoolI32); - plan.params = vec![FragTy::AdtRef, FragTy::AdtRef]; - assert_eq!(expr_fragment_record_proj_face(&plan), None); - } - - #[test] - fn declines_node_type_mismatch_and_wrong_body_shape() { - // The projection node's declared type must equal the plan result. - let mut plan = record_proj_plan(0, 1, FragTy::BoolI32); - plan.body.nodes[1].ty = FragTy::IntCarrier; - assert_eq!(expr_fragment_record_proj_face(&plan), None); - - // The projected value must be the single parameter local, not a re-read. - let mut plan = record_proj_plan(0, 1, FragTy::BoolI32); - plan.body.nodes[1].kind = FragNodeKind::StructGetUser { - ty_idx: 0, - field: 1, - value: FragValueId(1), - }; - assert_eq!(expr_fragment_record_proj_face(&plan), None); - - // An extra node breaks the exact two-node shape. - let mut plan = record_proj_plan(0, 1, FragTy::BoolI32); - plan.body.nodes.push(FragNode { - id: FragValueId(2), - ty: FragTy::BoolI32, - kind: FragNodeKind::ConstBool(true), - }); - assert_eq!(expr_fragment_record_proj_face(&plan), None); - - // The first node must read parameter local 0. - let mut plan = record_proj_plan(0, 1, FragTy::BoolI32); - plan.body.nodes[0].kind = FragNodeKind::Local { index: 1 }; - assert_eq!(expr_fragment_record_proj_face(&plan), None); - } -} - - -/// The record projection-compute face: k opaque record parameters of ONE -/// pinned struct type, a body over the v1 compute node set (projections, -/// construction, box/add/sub/mul/cmp/eq host calls, i64 and raw i32 literals, -/// the three signed relational primitives that read a comparison verdict, and -/// the inline sign template), and a record/Int/Bool result. Twin of -/// `StandardFace.classifyRecordCompute`. -#[derive(Clone, Copy, Debug, PartialEq, Eq)] -pub struct FragRecordComputeFace { - pub struct_idx: u32, -} - -/// Twin of the wall's `RecordComputeBridge.nodeTypedB` arm for `.intSignCmp`, -/// the ONE node this face's typing scaffold pins beyond the node's own kind. -/// Mirroring it here is fail-closed symmetry: without it the producer can plan -/// a body the wall's classifier then rejects, and the export silently drops to -/// source-level-only at verify time instead of at emit time. -/// -/// Three conjuncts, all three load-bearing: -/// * the operand is an Int carrier — the template reads the carrier's limb -/// and sign fields, so anything else has no meaning to read; -/// * the written slot is exactly `params.length`, the ONE declared scratch -/// local, so the template can never clobber a parameter (the lockstep -/// locals invariant of the bridge's `agreement` rests on this); -/// * the node itself is a Boolean verdict. -/// -/// The wall's fourth conjunct, `PlanCheck.inI64Band constant`, needs no code -/// here: `constant` is an `i64`, so the band is carried by the type. -fn record_compute_sign_template_ok( - params_len: usize, - nodes: &[FragNode], - node: &FragNode, - scratch: u32, - value: FragValueId, -) -> bool { - nodes.get(value.0).map(|n| n.ty) == Some(FragTy::IntCarrier) - && scratch as usize == params_len - && node.ty == FragTy::BoolI32 -} - -fn record_compute_node_ok( - host_table: &FragHostTable, - params_len: usize, - nodes: &[FragNode], - node: &FragNode, -) -> bool { - match &node.kind { - // The wall additionally decides the i64 band of the two literals - // below; here the `i64` type of the payload already carries it. - FragNodeKind::Local { .. } - | FragNodeKind::ConstI64(_) - | FragNodeKind::ConstI32(_) - | FragNodeKind::StructGetUser { .. } - | FragNodeKind::StructNew { .. } => true, - FragNodeKind::IntSignCmp { - scratch, value, .. - } => record_compute_sign_template_ok(params_len, nodes, node, *scratch, *value), - FragNodeKind::Prim { op, args } => { - matches!( - op, - FragPrim::I32LtS | FragPrim::I32GtS | FragPrim::I32GeS - ) && args.len() == 2 - } - FragNodeKind::HostCall { - role, - func_idx, - args, - } => { - host_table.lookup(*role) == Some(*func_idx) - && match role { - FragHostRole::Box => args.len() == 1, - FragHostRole::Add - | FragHostRole::Sub - | FragHostRole::Mul - | FragHostRole::Cmp - | FragHostRole::Eq => args.len() == 2, - FragHostRole::ToIndex => false, - } - } - _ => false, - } -} - -/// Twin of the wall's `WasmSlice.fragNodeComputes` (which `StandardFace` -/// exports rather than redefining): the nodes that make a -/// body COMPUTE rather than merely project. A construction, ANY host call -/// (`cmp`/`eq` included — they leave the carrier and decide an order), and the -/// inline sign template, which is the emitter's open-coded comparison of a -/// computed carrier against a literal. The two-node projection faces carry -/// none of the three, which is what keeps them out of this face. -fn frag_node_computes(node: &FragNode) -> bool { - matches!( - node.kind, - FragNodeKind::StructNew { .. } - | FragNodeKind::HostCall { .. } - | FragNodeKind::IntSignCmp { .. } - ) -} - -fn frag_node_struct_idx(kind: &FragNodeKind) -> Option { - match kind { - FragNodeKind::StructGetUser { ty_idx, .. } => Some(*ty_idx), - FragNodeKind::StructNew { ty_idx, .. } => Some(*ty_idx), - _ => None, - } -} - -/// Twin of the wall's `recordComputeUsesStruct`: whether the plan speaks about -/// the ONE user struct type at all. A plan for which this is false names no -/// record, carries the reserved struct index `0`, and its face reads no -/// type-section entry. -pub fn expr_fragment_plan_uses_struct(plan: &ExprFragmentPlan) -> bool { - plan.params.contains(&FragTy::AdtRef) - || plan.result == FragTy::AdtRef - || plan - .body - .nodes - .iter() - .any(|n| frag_node_struct_idx(&n.kind).is_some()) -} - -/// Twin of the wall's `recordComputeShapeOk`: a record-shaped plan keeps the -/// all-`AdtRef` parameter list its nominal signature pin speaks about; a plan -/// that names no struct takes SCALAR parameters instead. Mixing the two is -/// deliberately not admitted — the byte-side nominal gate speaks one repeated -/// type, so a mixed list has no pin there. -fn record_compute_shape_ok(plan: &ExprFragmentPlan) -> bool { - if expr_fragment_plan_uses_struct(plan) { - plan.params.iter().all(|ty| *ty == FragTy::AdtRef) - } else { - plan.params - .iter() - .all(|ty| matches!(ty, FragTy::IntCarrier | FragTy::BoolI32)) - } -} - -/// Twin of the wall's `classifyRecordCompute`: fires only when the parameter -/// list is one of the two admitted shapes, every node is in the admitted set -/// with host calls citing the byte-derived role table and the sign template -/// passing the wall's typing pins, at least one node computes -/// (`frag_node_computes`, which rules the two-node projection faces out), the -/// result is a record/Int/Bool, and every cited user-struct index agrees. A -/// plan citing no struct at all is admitted with the reserved index `0`, and -/// only when it names no record anywhere. -pub fn expr_fragment_record_compute_face( - plan: &ExprFragmentPlan, - host_table: &FragHostTable, -) -> Option { - if !record_compute_shape_ok(plan) { - return None; - } - if !plan - .body - .nodes - .iter() - .all(|n| record_compute_node_ok(host_table, plan.params.len(), &plan.body.nodes, n)) - { - return None; - } - if !plan.body.nodes.iter().any(frag_node_computes) { - return None; - } - if !matches!( - plan.result, - FragTy::AdtRef | FragTy::IntCarrier | FragTy::BoolI32 - ) { - return None; - } - let mut idxs = plan - .body - .nodes - .iter() - .filter_map(|n| frag_node_struct_idx(&n.kind)); - let Some(first) = idxs.next() else { - // No node cites a struct: admitted only when the plan names no record - // anywhere, so an opaque parameter can never reach a face with no - // type-section pin. - return (!expr_fragment_plan_uses_struct(plan)) - .then_some(FragRecordComputeFace { struct_idx: 0 }); - }; - if idxs.all(|i| i == first) { - Some(FragRecordComputeFace { struct_idx: first }) - } else { - None - } -} - -#[cfg(all(test, feature = "engine"))] -mod record_compute_face_tests { - use super::*; - - /// `isNonNegField(f: Frac) -> Bool = f.num >= 0`: read one Int leaf of the - /// pinned struct and decide its sign with the emitter's inline template. - /// No host call anywhere in the body — this is the shape that used to be - /// silently non-admitted. - fn sign_only_plan(struct_idx: u32) -> ExprFragmentPlan { - ExprFragmentPlan { - params: vec![FragTy::AdtRef], - result: FragTy::BoolI32, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::AdtRef, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::IntCarrier, - kind: FragNodeKind::StructGetUser { - ty_idx: struct_idx, - field: 0, - value: FragValueId(0), - }, - }, - FragNode { - id: FragValueId(2), - ty: FragTy::BoolI32, - kind: FragNodeKind::IntSignCmp { - op: SymIntCmp::Ge, - constant: 0, - scratch: 1, - value: FragValueId(1), - }, - }, - ], - result: FragValueId(2), - }, - } - } - - fn table() -> FragHostTable { - FragHostTable::placeholder() - } - - /// The sign template is a COMPUTING node, so a projection-only sign test - /// reaches the compute face instead of falling through to no face at all. - #[test] - fn sign_template_alone_is_a_computing_body() { - assert_eq!( - expr_fragment_record_compute_face(&sign_only_plan(4), &table()), - Some(FragRecordComputeFace { struct_idx: 4 }) - ); - } - - /// The two-node projection body still carries no computing node, so the - /// projection faces keep their own route. - #[test] - fn a_bare_projection_still_computes_nothing() { - let mut plan = sign_only_plan(4); - plan.body.nodes.pop(); - plan.body.result = FragValueId(1); - plan.result = FragTy::IntCarrier; - assert_eq!(expr_fragment_record_compute_face(&plan, &table()), None); - } - - /// Pin 1 of the wall's `nodeTypedB` arm: the written slot is exactly the - /// one declared scratch local, `params.length`. A parameter slot would let - /// the template clobber an input. - #[test] - fn declines_a_sign_template_that_writes_a_parameter_slot() { - let mut plan = sign_only_plan(4); - let FragNodeKind::IntSignCmp { scratch, .. } = &mut plan.body.nodes[2].kind else { - panic!("node 2 is the sign template"); - }; - *scratch = 0; - assert_eq!(expr_fragment_record_compute_face(&plan, &table()), None); - } - - /// Pin 2: the operand is an Int carrier. The template reads the carrier's - /// limb and sign fields, so anything else has no meaning to read. - #[test] - fn declines_a_sign_template_over_a_non_carrier_operand() { - let mut plan = sign_only_plan(4); - plan.body.nodes[1].ty = FragTy::I64; - assert_eq!(expr_fragment_record_compute_face(&plan, &table()), None); - } - - /// Pin 3: the template node is a Boolean verdict. - #[test] - fn declines_a_sign_template_that_is_not_a_boolean() { - let mut plan = sign_only_plan(4); - plan.body.nodes[2].ty = FragTy::RawI32; - plan.result = FragTy::IntCarrier; - assert_eq!(expr_fragment_record_compute_face(&plan, &table()), None); - } - - /// Pin 4, carried by the type rather than by code: the literal is an - /// `i64`, which IS the wall's `PlanCheck.inI64Band` conjunct. Both band - /// edges are admitted. - #[test] - fn admits_both_edges_of_the_i64_band() { - for constant in [i64::MIN, i64::MAX] { - let mut plan = sign_only_plan(4); - let FragNodeKind::IntSignCmp { constant: k, .. } = &mut plan.body.nodes[2].kind - else { - panic!("node 2 is the sign template"); - }; - *k = constant; - assert_eq!( - expr_fragment_record_compute_face(&plan, &table()), - Some(FragRecordComputeFace { struct_idx: 4 }), - "literal {constant} must stay inside the band" - ); - } - } -} diff --git a/aver-cert/src/engine/field_projection_plan_defs.rs b/aver-cert/src/engine/field_projection_plan_defs.rs deleted file mode 100644 index 88880a342..000000000 --- a/aver-cert/src/engine/field_projection_plan_defs.rs +++ /dev/null @@ -1,138 +0,0 @@ -// Byte-first `field-projection-v1` plan builder for tuple-destructuring -// projections. The plan names only the selected field. Every representation -// fact used by lowering is recovered from validated module bytes and carried by -// the claim: struct index/count, selected result-reference shape, Int carrier, -// function binding, and exact code entry. - -#[derive(Clone, Copy, PartialEq, Eq)] -enum FieldProjectionResultTy { - Eqref, - NullableRef(u32), -} - -#[derive(Clone, Copy, PartialEq, Eq)] -struct FieldProjectionRawPlan { - field_idx: u32, -} - -fn field_projection_result_ty(ty: TyKind) -> Option { - match ty { - TyKind::Eqref => Some(FieldProjectionResultTy::Eqref), - TyKind::Ref { - nullable: true, - idx, - } => Some(FieldProjectionResultTy::NullableRef(idx)), - _ => None, - } -} - -fn field_projection_plan_from_cert( - c: &Cert, -) -> Option<(FieldProjectionRawPlan, FieldProjectionResultTy)> { - let Cert::FieldProjection { - nlocals, - carrier, - struct_idx, - field_count, - field_idx, - result_ty, - code_entry_bytes, - ops, - .. - } = c.inner() - else { - return None; - }; - let result_ty = field_projection_result_ty(*result_ty)?; - let plan = FieldProjectionRawPlan { - field_idx: *field_idx, - }; - if *field_count != 2 || *field_idx >= *field_count || *nlocals != 3 { - return None; - } - if lower_field_projection_ops(&plan, *struct_idx) != *ops { - return None; - } - if lower_field_projection_code_entry(&plan, *carrier, *struct_idx, result_ty) - != *code_entry_bytes - { - return None; - } - Some((plan, result_ty)) -} - -fn lower_field_projection_ops(plan: &FieldProjectionRawPlan, struct_idx: u32) -> Vec { - vec![ - Op::LocalGet(0), - Op::LocalSet(2), - Op::LocalGet(2), - Op::RefCast(struct_idx), - Op::StructGet(struct_idx, plan.field_idx), - Op::LocalSet(1), - Op::LocalGet(1), - ] -} - -fn push_field_projection_ref_ty(out: &mut Vec, ty: FieldProjectionResultTy) { - match ty { - FieldProjectionResultTy::Eqref => out.push(0x6d), - FieldProjectionResultTy::NullableRef(idx) => { - out.push(0x63); - push_s33_heap_idx(out, idx); - } - } -} - -fn lower_field_projection_code_entry( - plan: &FieldProjectionRawPlan, - carrier: u32, - struct_idx: u32, - result_ty: FieldProjectionResultTy, -) -> Vec { - let mut body = vec![0x03, 0x01]; - push_field_projection_ref_ty(&mut body, result_ty); - body.extend_from_slice(&[0x01, 0x6d, 0x01, 0x63]); - push_s33_heap_idx(&mut body, carrier); - body.extend_from_slice(&[0x20, 0x00, 0x21, 0x02, 0x20, 0x02, 0xfb, 0x16]); - push_s33_heap_idx(&mut body, struct_idx); - body.extend_from_slice(&[0xfb, 0x02]); - push_u32_leb(&mut body, struct_idx); - push_u32_leb(&mut body, plan.field_idx); - body.extend_from_slice(&[0x21, 0x01, 0x20, 0x01, 0x0b]); - let mut out = Vec::new(); - push_u32_leb(&mut out, body.len() as u32); - out.extend_from_slice(&body); - out -} - -fn field_projection_plan_lean_value(plan: &FieldProjectionRawPlan) -> String { - format!( - "({{ profile := \"field-projection-v1\", fieldIdx := {} }} : FieldProjectionRawPlan)", - plan.field_idx - ) -} - -fn field_projection_result_ty_lean_value(ty: FieldProjectionResultTy) -> String { - match ty { - FieldProjectionResultTy::Eqref => "(.eqref)".to_string(), - FieldProjectionResultTy::NullableRef(idx) => format!("(.nullableRef {idx})"), - } -} - -#[cfg(test)] -mod field_projection_plan_tests { - use super::*; - - #[test] - fn canonical_projection_has_three_locals_and_exact_body() { - let plan = FieldProjectionRawPlan { field_idx: 1 }; - let bytes = lower_field_projection_code_entry( - &plan, - 2, - 3, - FieldProjectionResultTy::NullableRef(2), - ); - assert_eq!(bytes[1], 3, "three local declaration groups"); - assert_eq!(lower_field_projection_ops(&plan, 3).len(), 7); - } -} diff --git a/aver-cert/src/engine/int_dispatch_plan_defs.rs b/aver-cert/src/engine/int_dispatch_plan_defs.rs deleted file mode 100644 index a2d717992..000000000 --- a/aver-cert/src/engine/int_dispatch_plan_defs.rs +++ /dev/null @@ -1,669 +0,0 @@ -// Byte-first `int-dispatch-v1` plan builder. -// -// An Int-face `ref.test`-dispatch body (the ADT-match `Cod := Int` shapes: -// `Cert::VariantDispatch` / `Cert::WidenedIntMatch`) reconstructs losslessly -// from the byte-derived cert holes into a DEDICATED grammar (NOT the ANF -// `FragBlock`: like the verbatim family, the multi-use scrutinee and each -// arm's projected payload are spilled to scratch locals, which pure ANF cannot -// express). The plan lowers, byte-for-byte, to the emitted code entry; it -// carries no source-level meaning and never changes the `cases`-spine proof -// face or the Int-valued model — it only moves the match body's byte-origin -// into hash-pinned Lean. Unlike the verbatim family the arms consume -// contracted host helpers; their indices are NEVER plan data — the lowerers -// take the byte-derived host-role table as a parameter and the plan names -// roles only, so a plan cannot invent a callee. -// -// The scratch-local layout is a fixed function of the arm count (Stage-0 -// pinned on `boxInt`/`evalOp`/`gauge`): arm `i` (0-based, dispatch order) -// spills its projected payload to local `i+1`, the scrutinee is spilled to -// local `armCount + 1`, and one trailing unused Int-carrier scratch local is -// always declared — `armCount + 2` single-local declaration groups. - -/// The host-helper role an Int-face arm combines through. Rust twin of Lean -/// `Schema.IntDispatchRole` — deliberately narrower than `HostRole` (no box). -#[derive(Clone, Copy, PartialEq)] -enum IntDispatchRole { - Add, - Sub, -} - -/// One hit arm of an Int-face dispatch. Rust twin of Lean -/// `Schema.IntDispatchLeaf`. -#[derive(Clone, PartialEq)] -enum IntDispatchLeaf { - /// Return the projected payload: `… local.set F; local.get F`. - Proj, - /// Combine the projected payload with the boxed constant `k` through the - /// `role` helper; `const_first` selects `k ⊕ x` vs `x ⊕ k`. - HostOp { - role: IntDispatchRole, - k: i64, - const_first: bool, - }, - /// Return the constant `k` without reading a field (a nullary constructor's - /// arm): `i64.const k; call box`, NO projection prefix, NO per-arm spill. - Const { k: i64 }, -} - -/// A right-nested Int-face `ref.test` dispatch cascade. Rust twin of Lean -/// `Schema.IntDispatchCascade`. -#[derive(Clone, PartialEq)] -enum IntDispatchCascade { - /// The terminal else: a boxed integer constant (`i64.const k; call box`). - Default(i64), - Test { - ty_idx: u32, - hit: IntDispatchLeaf, - rest: Box, - }, -} - -/// Raw, untrusted Int-face `ref.test`-dispatch plan (`int-dispatch-v1`). Rust -/// twin of Lean `Schema.IntDispatchRawPlan` (the `profile` field is hard-coded -/// by the Lean renderer, so it is not carried here). -#[derive(Clone, PartialEq)] -struct IntDispatchRawPlan { - body: IntDispatchCascade, -} - -/// The byte-derived host indices the lowering is parameterized by (the Rust -/// counterpart of the Lean host-role table parameter). `add`/`sub` are absent -/// when the cert consumes no such contract; a leaf citing an absent role -/// fail-closes the lowering. -#[derive(Clone, Copy)] -struct IntDispatchHostTable { - box_idx: u32, - add_idx: Option, - sub_idx: Option, -} - -impl IntDispatchHostTable { - fn role_idx(&self, role: IntDispatchRole) -> Option { - match role { - IntDispatchRole::Add => self.add_idx, - IntDispatchRole::Sub => self.sub_idx, - } - } -} - -/// The number of PAYLOAD-BINDING (`Proj`/`HostOp`) arms. A `Const` (nullary) arm -/// spills no per-arm payload local, so the scratch-local layout is a function of -/// this count, not the total arm count: the `i`-th binding arm spills to local -/// `i+1`, the scrutinee is local `bind_arm_count + 1`. Twin of Lean -/// `PlanCheck.bindArmCount`. -fn int_dispatch_bind_arm_count(c: &IntDispatchCascade) -> usize { - match c { - IntDispatchCascade::Default(_) => 0, - IntDispatchCascade::Test { - hit: IntDispatchLeaf::Const { .. }, - rest, - .. - } => int_dispatch_bind_arm_count(rest), - IntDispatchCascade::Test { rest, .. } => int_dispatch_bind_arm_count(rest) + 1, - } -} - -/// Build the byte-first `int-dispatch-v1` plan for a variant-dispatch or -/// widened-Int-match cert. Returns `None` for any other class, and — -/// fail-closed — for a certified body whose REAL code entry does not equal the -/// canonical plan lowering (a body byte-noisier than the canonical template, -/// e.g. a widened match recognised past a non-empty prefix, stays on the -/// legacy witness route; an artifact must never carry a byte-origin claim its -/// own bytes cannot prove). -fn int_dispatch_plan_from_cert(c: &Cert, strict: FragHostTable) -> Option { - let (plan, carrier, hosts, code_entry_bytes) = match c.inner() { - Cert::WidenedIntMatch { - hit_variant_idx, - carrier, - box_idx, - code_entry_bytes, - .. - } => { - let plan = IntDispatchRawPlan { - body: IntDispatchCascade::Test { - ty_idx: *hit_variant_idx, - hit: IntDispatchLeaf::Proj, - rest: Box::new(IntDispatchCascade::Default(0)), - }, - }; - let hosts = IntDispatchHostTable { - box_idx: *box_idx, - add_idx: None, - sub_idx: None, - }; - (plan, *carrier, hosts, code_entry_bytes) - } - Cert::VariantDispatch { - carrier, - box_idx, - add_idx, - sub_idx, - arms, - default_k, - code_entry_bytes, - .. - } => { - let mut body = IntDispatchCascade::Default(*default_k); - for (tag, leaf) in arms.iter().rev() { - let hit = match leaf { - ArmLeaf::Proj => IntDispatchLeaf::Proj, - ArmLeaf::Const { k } => IntDispatchLeaf::Const { k: *k }, - ArmLeaf::HostOp { - role, - k, - const_first, - } => IntDispatchLeaf::HostOp { - role: match role { - HostRole::Add => IntDispatchRole::Add, - HostRole::Sub => IntDispatchRole::Sub, - HostRole::Mul | HostRole::StringEq | HostRole::StringConcat => { - return None; - } - }, - k: *k, - const_first: *const_first, - }, - }; - body = IntDispatchCascade::Test { - ty_idx: *tag, - hit, - rest: Box::new(body), - }; - } - let plan = IntDispatchRawPlan { body }; - let hosts = IntDispatchHostTable { - box_idx: *box_idx, - add_idx: *add_idx, - sub_idx: *sub_idx, - }; - (plan, *carrier, hosts, code_entry_bytes) - } - _ => return None, - }; - // Role provenance: every host index the claim would cite must be confirmed - // by the STRICT byte-derived role table (carrier-binop signature + strict - // first-i64-arith + uniqueness, fail-closed per role). The classifier's - // coarse marker map assigns a both-ops helper by its first arithmetic; a - // role the strict table leaves unbound (ambiguous candidates) or binds to - // a different index must not carry a plan claim — certification declines, - // fail-closed. - if strict.box_idx != Some(hosts.box_idx) { - return None; - } - if let Some(a) = hosts.add_idx - && strict.add_idx != Some(a) - { - return None; - } - if let Some(sub) = hosts.sub_idx - && strict.sub_idx != Some(sub) - { - return None; - } - let lowered = lower_int_dispatch_code_entry(&plan, carrier, &hosts)?; - if &lowered != code_entry_bytes { - return None; - } - Some(plan) -} - -/// The byte-derived host table of an Int-face dispatch cert, for claim -/// rendering and lowering. `None` for any other class. -fn int_dispatch_host_table_from_cert(c: &Cert) -> Option { - match c.inner() { - Cert::WidenedIntMatch { box_idx, .. } => Some(IntDispatchHostTable { - box_idx: *box_idx, - add_idx: None, - sub_idx: None, - }), - Cert::VariantDispatch { - box_idx, - add_idx, - sub_idx, - .. - } => Some(IntDispatchHostTable { - box_idx: *box_idx, - add_idx: *add_idx, - sub_idx: *sub_idx, - }), - _ => None, - } -} - -/// Exact code-entry bytes of an Int-face dispatch plan. Twin of Lean -/// `PlanBytes.lowerIntDispatchCodeEntry` (heap indices s33-signed; -/// `struct.get` type/field indices uleb32; constants sleb64). -fn lower_int_dispatch_code_entry( - plan: &IntDispatchRawPlan, - carrier: u32, - hosts: &IntDispatchHostTable, -) -> Option> { - let body = lower_int_dispatch_body_bytes(plan, carrier, hosts)?; - let mut out = Vec::new(); - push_u32_leb(&mut out, body.len() as u32); - out.extend_from_slice(&body); - Some(out) -} - -fn lower_int_dispatch_body_bytes( - plan: &IntDispatchRawPlan, - carrier: u32, - hosts: &IntDispatchHostTable, -) -> Option> { - let arm_count = int_dispatch_bind_arm_count(&plan.body); - let s = (arm_count + 1) as u32; - let mut out = Vec::new(); - // Local declarations: per-binding-arm payload spills, the eqref scrutinee, - // the unused carrier scratch — `bind_arm_count + 2` single-local groups. A - // const (nullary) arm declares no spill group. - push_u32_leb(&mut out, (arm_count + 2) as u32); - for _ in 0..arm_count { - out.extend_from_slice(&[0x01, 0x63]); - push_s33_heap_idx(&mut out, carrier); - } - out.extend_from_slice(&[0x01, 0x6d, 0x01, 0x63]); - push_s33_heap_idx(&mut out, carrier); - // Expression: spill the scrutinee, then the dispatch cascade. - out.extend_from_slice(&[0x20, 0x00, 0x21]); - push_u32_leb(&mut out, s); - out.push(0x20); - push_u32_leb(&mut out, s); - int_dispatch_cascade_bytes(&mut out, carrier, hosts, s, 0, true, &plan.body)?; - out.push(0x0b); - Some(out) -} - -fn int_dispatch_cascade_bytes( - out: &mut Vec, - carrier: u32, - hosts: &IntDispatchHostTable, - s: u32, - pos: u32, - first: bool, - cascade: &IntDispatchCascade, -) -> Option<()> { - match cascade { - IntDispatchCascade::Default(k) => { - out.push(0x42); - push_i64_leb(out, *k); - out.push(0x10); - push_u32_leb(out, hosts.box_idx); - Some(()) - } - IntDispatchCascade::Test { ty_idx, hit, rest } => { - if !first { - out.push(0x20); - push_u32_leb(out, s); - } - out.extend_from_slice(&[0xfb, 0x14]); - push_s33_heap_idx(out, *ty_idx); - out.extend_from_slice(&[0x04, 0x63]); - push_s33_heap_idx(out, carrier); - // A const (nullary) arm emits the boxed constant inline (no projection - // prefix) and does NOT advance the binding position; a binding arm - // spills its payload to local `pos + 1` and advances. - let next_pos = match hit { - IntDispatchLeaf::Const { k } => { - out.push(0x42); - push_i64_leb(out, *k); - out.push(0x10); - push_u32_leb(out, hosts.box_idx); - pos - } - _ => { - int_dispatch_arm_bytes(out, hosts, s, pos + 1, *ty_idx, hit)?; - pos + 1 - } - }; - out.push(0x05); - int_dispatch_cascade_bytes(out, carrier, hosts, s, next_pos, false, rest)?; - out.push(0x0b); - Some(()) - } - } -} - -fn int_dispatch_arm_bytes( - out: &mut Vec, - hosts: &IntDispatchHostTable, - s: u32, - f: u32, - ty_idx: u32, - leaf: &IntDispatchLeaf, -) -> Option<()> { - // The shared arm prefix: project field 0 of the tested variant out of the - // spilled scrutinee and spill it to this arm's scratch local. - out.push(0x20); - push_u32_leb(out, s); - out.extend_from_slice(&[0xfb, 0x16]); - push_s33_heap_idx(out, ty_idx); - out.extend_from_slice(&[0xfb, 0x02]); - push_u32_leb(out, ty_idx); - out.push(0x00); - out.push(0x21); - push_u32_leb(out, f); - match leaf { - // A const arm is lowered inline by the cascade (no projection prefix); it - // never reaches this projection-based arm lowering. - IntDispatchLeaf::Const { .. } => None, - IntDispatchLeaf::Proj => { - out.push(0x20); - push_u32_leb(out, f); - Some(()) - } - IntDispatchLeaf::HostOp { - role, - k, - const_first, - } => { - let host_idx = hosts.role_idx(*role)?; - if *const_first { - out.push(0x42); - push_i64_leb(out, *k); - out.push(0x10); - push_u32_leb(out, hosts.box_idx); - out.push(0x20); - push_u32_leb(out, f); - } else { - out.push(0x20); - push_u32_leb(out, f); - out.push(0x42); - push_i64_leb(out, *k); - out.push(0x10); - push_u32_leb(out, hosts.box_idx); - } - out.push(0x10); - push_u32_leb(out, host_idx); - Some(()) - } - } -} - -/// The per-export byte-derived host-role table an Int-face dispatch claim -/// carries: the box helper always, the add/sub helpers exactly when the cert's -/// obligation wires them. Rendered identically by producer and verifier so the -/// artifact data pin stays byte-exact. -fn int_dispatch_host_table_lean_value(hosts: &IntDispatchHostTable) -> String { - let mut entries = vec![format!("(.box, {})", hosts.box_idx)]; - if let Some(a) = hosts.add_idx { - entries.push(format!("(.add, {a})")); - } - if let Some(s) = hosts.sub_idx { - entries.push(format!("(.sub, {s})")); - } - format!("[{}]", entries.join(", ")) -} - -/// The Lean `IntDispatchLeaf` literal. -fn int_dispatch_leaf_lean_value(l: &IntDispatchLeaf) -> String { - match l { - IntDispatchLeaf::Proj => ".proj".to_string(), - IntDispatchLeaf::Const { k } => format!(".const ({k})"), - IntDispatchLeaf::HostOp { - role, - k, - const_first, - } => format!( - ".hostOp .{} ({k}) {const_first}", - match role { - IntDispatchRole::Add => "add", - IntDispatchRole::Sub => "sub", - } - ), - } -} - -/// The Lean `IntDispatchCascade` literal. -fn int_dispatch_cascade_lean_value(c: &IntDispatchCascade) -> String { - match c { - IntDispatchCascade::Default(k) => format!(".default ({k})"), - IntDispatchCascade::Test { ty_idx, hit, rest } => format!( - ".test {ty_idx} ({}) ({})", - int_dispatch_leaf_lean_value(hit), - int_dispatch_cascade_lean_value(rest) - ), - } -} - -/// The Lean `IntDispatchRawPlan` literal (profile `int-dispatch-v1`), rendered -/// on ONE line (a multi-line anonymous-constructor literal misparses). -fn int_dispatch_plan_lean_value(plan: &IntDispatchRawPlan) -> String { - format!( - "{{ profile := \"int-dispatch-v1\", body := {} }}", - int_dispatch_cascade_lean_value(&plan.body) - ) -} - -#[cfg(test)] -mod int_dispatch_plan_gate_tests { - use super::*; - - /// The `boxInt` cert (widened Int match, func 12): tests struct type 3, - /// projects the carrier payload, boxed-`0` default. carrier 18, box 34. - fn box_int_cert(code_entry_bytes: Vec) -> Cert { - Cert::WidenedIntMatch { - name: "boxInt".to_string(), - self_idx: 12, - nlocals: 3, - carrier: 18, - hit_variant_idx: 3, - box_idx: 34, - code_entry_bytes, - ops: vec![ - Op::LocalGet(0), - Op::LocalSet(2), - Op::LocalGet(2), - Op::RefTest(3), - Op::If, - Op::LocalGet(2), - Op::RefCast(3), - Op::StructGet(3, 0), - Op::LocalSet(1), - Op::LocalGet(1), - Op::Else, - Op::I64Const(0), - Op::Call(34), - Op::End, - ], - } - } - - /// The `gauge` cert (general variant dispatch, func 15): Lo -> `0 - x` - /// (sub, const first), Hi -> `x + 9` (add, payload first), Mid -> `x` - /// (proj), Off -> boxed `7`. Tags 11/12/13, carrier 18, box 34, add 35, - /// sub 36. - fn gauge_cert(code_entry_bytes: Vec) -> Cert { - Cert::VariantDispatch { - name: "gauge".to_string(), - self_idx: 15, - nlocals: 5, - carrier: 18, - box_idx: 34, - add_idx: Some(35), - sub_idx: Some(36), - arms: vec![ - ( - 11, - ArmLeaf::HostOp { - role: HostRole::Sub, - k: 0, - const_first: true, - }, - ), - ( - 12, - ArmLeaf::HostOp { - role: HostRole::Add, - k: 9, - const_first: false, - }, - ), - (13, ArmLeaf::Proj), - ], - default_k: 7, - code_entry_bytes, - ops: Vec::new(), - } - } - - /// The strict byte-derived role table matching the fixture's honest - /// helpers (box 34, add 35, sub 36). - fn strict_table() -> FragHostTable { - FragHostTable { - box_idx: Some(34), - add_idx: Some(35), - mul_idx: Some(37), - sub_idx: Some(36), - ..Default::default() - } - } - - /// Stage-0 pins: the exact code entries of `boxInt` (widened match) and - /// `gauge` (three-arm dispatch, all leaf kinds) as emitted for - /// `tools/certkit/fixtures/cert_goals.av`. - #[test] - fn int_dispatch_plan_reproduces_stage0_pins() { - let box_int_entry: Vec = vec![ - 0x29, 0x03, 0x01, 0x63, 0x12, 0x01, 0x6d, 0x01, 0x63, 0x12, 0x20, 0x00, 0x21, 0x02, - 0x20, 0x02, 0xfb, 0x14, 0x03, 0x04, 0x63, 0x12, 0x20, 0x02, 0xfb, 0x16, 0x03, 0xfb, - 0x02, 0x03, 0x00, 0x21, 0x01, 0x20, 0x01, 0x05, 0x42, 0x00, 0x10, 0x22, 0x0b, 0x0b, - ]; - let gauge_entry: Vec = vec![ - 0x69, 0x05, 0x01, 0x63, 0x12, 0x01, 0x63, 0x12, 0x01, 0x63, 0x12, 0x01, 0x6d, 0x01, - 0x63, 0x12, 0x20, 0x00, 0x21, 0x04, 0x20, 0x04, 0xfb, 0x14, 0x0b, 0x04, 0x63, 0x12, - 0x20, 0x04, 0xfb, 0x16, 0x0b, 0xfb, 0x02, 0x0b, 0x00, 0x21, 0x01, 0x42, 0x00, 0x10, - 0x22, 0x20, 0x01, 0x10, 0x24, 0x05, 0x20, 0x04, 0xfb, 0x14, 0x0c, 0x04, 0x63, 0x12, - 0x20, 0x04, 0xfb, 0x16, 0x0c, 0xfb, 0x02, 0x0c, 0x00, 0x21, 0x02, 0x20, 0x02, 0x42, - 0x09, 0x10, 0x22, 0x10, 0x23, 0x05, 0x20, 0x04, 0xfb, 0x14, 0x0d, 0x04, 0x63, 0x12, - 0x20, 0x04, 0xfb, 0x16, 0x0d, 0xfb, 0x02, 0x0d, 0x00, 0x21, 0x03, 0x20, 0x03, 0x05, - 0x42, 0x07, 0x10, 0x22, 0x0b, 0x0b, 0x0b, 0x0b, - ]; - let box_plan = int_dispatch_plan_from_cert(&box_int_cert(box_int_entry.clone()), strict_table()) - .expect("boxInt plan"); - let hosts = IntDispatchHostTable { - box_idx: 34, - add_idx: None, - sub_idx: None, - }; - assert_eq!( - lower_int_dispatch_code_entry(&box_plan, 18, &hosts).unwrap(), - box_int_entry, - "boxInt canonical lowering must equal the Stage-0 pin" - ); - assert!( - int_dispatch_plan_from_cert(&gauge_cert(gauge_entry.clone()), strict_table()).is_some(), - "byte-exact gauge must carry a plan claim" - ); - - // Byte-noisy body: an extra byte -> no claim; certification declines, fail-closed. - let mut noisy = gauge_entry.clone(); - noisy.push(0x00); - noisy[0] += 1; - assert!( - int_dispatch_plan_from_cert(&gauge_cert(noisy), strict_table()).is_none(), - "a body the canonical plan cannot reproduce must not carry a claim" - ); - // Empty code entry: no claim. - assert!( - int_dispatch_plan_from_cert(&box_int_cert(Vec::new()), strict_table()).is_none(), - "empty code entry cannot equal the canonical lowering" - ); - } - - /// Role provenance: a plan claim is withheld unless the STRICT role table - /// (signature + strict first-i64-arith + uniqueness, fail-closed) confirms - /// every host index the claim would cite. An ambiguous helper (both add and - /// sub candidates in one body) leaves the strict role unbound (`None`), so - /// the coarse first-arith marker alone must never mint a plan — the export - /// stays on the legacy witness route. - #[test] - fn int_dispatch_plan_requires_strict_role_provenance() { - let gauge_entry: Vec = vec![ - 0x69, 0x05, 0x01, 0x63, 0x12, 0x01, 0x63, 0x12, 0x01, 0x63, 0x12, 0x01, 0x6d, 0x01, - 0x63, 0x12, 0x20, 0x00, 0x21, 0x04, 0x20, 0x04, 0xfb, 0x14, 0x0b, 0x04, 0x63, 0x12, - 0x20, 0x04, 0xfb, 0x16, 0x0b, 0xfb, 0x02, 0x0b, 0x00, 0x21, 0x01, 0x42, 0x00, 0x10, - 0x22, 0x20, 0x01, 0x10, 0x24, 0x05, 0x20, 0x04, 0xfb, 0x14, 0x0c, 0x04, 0x63, 0x12, - 0x20, 0x04, 0xfb, 0x16, 0x0c, 0xfb, 0x02, 0x0c, 0x00, 0x21, 0x02, 0x20, 0x02, 0x42, - 0x09, 0x10, 0x22, 0x10, 0x23, 0x05, 0x20, 0x04, 0xfb, 0x14, 0x0d, 0x04, 0x63, 0x12, - 0x20, 0x04, 0xfb, 0x16, 0x0d, 0xfb, 0x02, 0x0d, 0x00, 0x21, 0x03, 0x20, 0x03, 0x05, - 0x42, 0x07, 0x10, 0x22, 0x0b, 0x0b, 0x0b, 0x0b, - ]; - // Confirmed table -> plan. - assert!( - int_dispatch_plan_from_cert(&gauge_cert(gauge_entry.clone()), strict_table()).is_some(), - "strict-confirmed roles must carry a plan claim" - ); - // Ambiguous sub candidates: the strict derivation fail-closed to None - // even though the coarse marker map still tagged index 36 as Sub. - assert!( - int_dispatch_plan_from_cert( - &gauge_cert(gauge_entry.clone()), - FragHostTable { - box_idx: Some(34), - add_idx: Some(35), - mul_idx: Some(37), - sub_idx: None, - ..Default::default() - } - ) - .is_none(), - "an ambiguous (strict-unbound) sub role must not carry a plan claim" - ); - // Strict table binding a role to a DIFFERENT index than the cert cites. - assert!( - int_dispatch_plan_from_cert( - &gauge_cert(gauge_entry.clone()), - FragHostTable { - box_idx: Some(34), - add_idx: Some(99), - mul_idx: Some(37), - sub_idx: Some(36), - ..Default::default() - } - ) - .is_none(), - "a strict-table disagreement on the add index must not carry a plan claim" - ); - // Unconfirmed box helper. - assert!( - int_dispatch_plan_from_cert( - &gauge_cert(gauge_entry), - FragHostTable { - box_idx: Some(1), - add_idx: Some(35), - mul_idx: Some(37), - sub_idx: Some(36), - ..Default::default() - } - ) - .is_none(), - "a strict-table disagreement on the box index must not carry a plan claim" - ); - } - - /// A leaf citing a host role the table lacks fail-closes the lowering (the - /// plan cannot conjure a callee out of a missing contract). - #[test] - fn int_dispatch_lowering_fail_closes_on_missing_role() { - let plan = IntDispatchRawPlan { - body: IntDispatchCascade::Test { - ty_idx: 3, - hit: IntDispatchLeaf::HostOp { - role: IntDispatchRole::Sub, - k: 0, - const_first: true, - }, - rest: Box::new(IntDispatchCascade::Default(0)), - }, - }; - let no_sub = IntDispatchHostTable { - box_idx: 34, - add_idx: Some(35), - sub_idx: None, - }; - assert!( - lower_int_dispatch_code_entry(&plan, 18, &no_sub).is_none(), - "a sub leaf with no sub contract must not lower" - ); - } -} diff --git a/aver-cert/src/engine/law_claims.rs b/aver-cert/src/engine/law_claims.rs index 5a03ea408..856c4b9ce 100644 --- a/aver-cert/src/engine/law_claims.rs +++ b/aver-cert/src/engine/law_claims.rs @@ -59,58 +59,22 @@ impl LawClaim { /// derive it from the claim's label. pub const LAW_BRIDGED_COROLLARY_SUFFIX: &str = "_bridged"; -/// Mirror of the checker's `validate_law_candidate` gates, kept as a -/// DEFENSIVE check on the rendered statement even though the claim now arrives -/// as structure: the producer must never write a manifest entry its own -/// checker hard-rejects — one refused entry fails candidate parsing for the -/// WHOLE package before Lean even runs. Legitimate compiler output can trip -/// the gates (a record literal `{ field := value }` in a statement carries -/// `:=`; a reserved-word module escapes to `Type'`), so such a law is simply -/// not claimed — the surface is additive and omitting a claim is fail-closed. +/// The checker's `validate_law_candidate` gates, applied through the SAME +/// functions the checker calls (`lean_gate::law_claim_identifiers` and +/// `bridge_statement::statement_is_single_plain_line` at the checker's own +/// length cap): the producer must never write a manifest entry its checker +/// hard-rejects — one refused entry fails candidate parsing for the WHOLE +/// package before Lean even runs. Legitimate compiler output can trip the +/// gates (a record literal `{ field := value }` in a statement carries `:=`), +/// so such a law is simply not claimed — the surface is additive and omitting +/// a claim is fail-closed. fn claim_survives_checker_gates(claim: &LawClaim) -> bool { - let plain_dotted = |value: &str| { - !value.is_empty() - && value.len() <= 200 - && value.split('.').all(|segment| { - let mut chars = segment.chars(); - matches!(chars.next(), Some(first) if first.is_ascii_alphabetic() || first == '_') - && chars.all(|c| c.is_ascii_alphanumeric() || c == '_') - }) - }; - if !plain_dotted(&claim.label) - || !plain_dotted(&claim.qualified()) - || !plain_dotted(&claim.corollary()) - { - return false; - } - let statement = &claim.statement; - if statement.is_empty() - || statement.len() > 2000 - || statement.contains('\n') - || statement.contains(":=") - || statement.contains("--") - || statement.contains("/-") - { - return false; - } - let mut depth: Vec = Vec::new(); - for character in statement.chars() { - let matched = match character { - '(' | '[' | '{' | '⟨' => { - depth.push(character); - true - } - ')' => depth.pop() == Some('('), - ']' => depth.pop() == Some('['), - '}' => depth.pop() == Some('{'), - '⟩' => depth.pop() == Some('⟨'), - _ => true, - }; - if !matched { - return false; - } - } - depth.is_empty() + crate::lean_gate::law_claim_identifiers(&claim.label, &claim.qualified(), &claim.corollary()) + .is_ok() + && crate::bridge_statement::statement_is_single_plain_line( + &claim.statement, + crate::bridge_statement::MAX_BRIDGE_STATEMENT_LEN, + ) } /// Admit the law-claims the producer handed over. @@ -144,14 +108,11 @@ pub fn admit_law_claims(claims: Vec) -> (Vec, Vec<(String, S /// the model theorem and `AverCert.Final.cert`. One kernel-checked name per /// claim ties the law to exactly the certified bytes. /// -/// The statement is re-elaborated INSIDE the model theorem's own namespace, -/// not under an `open in` at root. Those two contexts do not agree: -/// inside `namespace Json`, `Json.jsonInt` resolves to the constructor -/// `Json.Json.jsonInt`, while at root the same text reaches the accessor -/// `Json.jsonInt` that an `open` only adds an alias beside. Reproducing the -/// namespace makes the claim text mean exactly what it meant where the -/// emitter wrote it — the namespace is `theorem` minus its last segment, so -/// the manifest names the context it is read in. +/// Every corollary is declared at the root namespace, the context the +/// checker's witness reads the statement in. The statement arrives +/// root-qualified ([`root_qualify_statement`]): every model name in it is +/// spelled `_root_.`, so it means at the root what the emitter's text +/// meant inside the model theorem's namespace. /// /// Everything the certificate owns is spelled `_root_.`-qualified, so a model /// module that declares an `AverCert` sub-namespace cannot shadow the fact @@ -172,7 +133,11 @@ pub fn admit_law_claims(claims: Vec) -> (Vec, Vec<(String, S /// function — a claim about the SOURCE model, which the bridge has no part in /// proving. Split, a `sorry` in a bridge costs the bridge and the bridged /// corollary, and the plain law keeps its credit. -pub fn render_laws_lean(claims: &[LawClaim], bridge_statements: &[Vec<(String, String)>]) -> String { +pub fn render_laws_lean( + claims: &[LawClaim], + bridge_statements: &[Vec<(String, String)>], + model_roots: &[String], +) -> String { let any_bridged = bridge_statements.iter().any(|entry| !entry.is_empty()); let mut s = String::new(); s.push_str( @@ -183,11 +148,16 @@ pub fn render_laws_lean(claims: &[LawClaim], bridge_statements: &[Vec<(String, S -- bridge gets a second `_bridged` corollary conjoining those bridges,\n\ -- kept apart from the law's own so an unfinished bridge cannot cost\n\ -- the law its credit.\n\ - -- Each statement is elaborated inside the namespace its model theorem was\n\ - -- emitted in, so the claim text means there what it means in the model.\n\ + -- Every statement is read at the root and names each model constant\n\ + -- `_root_.`-qualified, as the checker reads it.\n\ import Manifest\n\ import Final\n", ); + for root in model_roots { + s.push_str("import "); + s.push_str(root); + s.push('\n'); + } if any_bridged { s.push_str("import Bridge\n"); } @@ -199,11 +169,6 @@ pub fn render_laws_lean(claims: &[LawClaim], bridge_statements: &[Vec<(String, S .unwrap_or_default(); // Concatenated, never interpolated into a format string: a statement // carrying `{`/`}` must stay inert text. - if !claim.prefix.is_empty() { - s.push_str("namespace "); - s.push_str(&claim.prefix); - s.push_str("\n\n"); - } s.push_str("/-- law-claim `"); s.push_str(&claim.label); s.push_str("` -/\ntheorem _root_.AverCert.Laws."); @@ -239,11 +204,489 @@ pub fn render_laws_lean(claims: &[LawClaim], bridge_statements: &[Vec<(String, S } s.push_str("⟩\n\n"); } - if !claim.prefix.is_empty() { - s.push_str("end "); - s.push_str(&claim.prefix); - s.push_str("\n\n"); - } } s } + +// ---- root-qualified law statements -------------------------------------------- + +/// Every public name the model modules declare, fully qualified, with whether +/// it is `protected`: definitions, theorems, structures with their fields and +/// constructor, inductive types with their constructors, classes and named +/// instances. Private names are left out; no other module can name them. +/// +/// This is what [`root_qualify_statement`] resolves a law's names against. A +/// name it misses leaves the statement meaning something else at the root, or +/// nothing; either way the law's corollary does not check against its model +/// theorem and only that law loses its credit. +#[derive(Debug, Default)] +pub struct ModelNames { + names: std::collections::BTreeMap, +} + +impl ModelNames { + /// Collect the names of every `.lean` file of the model. + pub fn from_files<'a>(files: impl IntoIterator) -> Self { + let mut names = Self::default(); + for (path, content) in files { + if path.ends_with(".lean") { + names.collect(content); + } + } + names + } + + fn insert(&mut self, qualified: String, protected: bool) { + self.names.entry(qualified).or_insert(protected); + } + + fn collect(&mut self, content: &str) { + // A `namespace` contributes to the current namespace; a `section` or + // `mutual` block only has to be closed by its `end`. + let mut scopes: Vec<(bool, String)> = Vec::new(); + let lines: Vec<&str> = content.lines().collect(); + let mut comment_depth = 0usize; + let mut at = 0; + while at < lines.len() { + let line = lines[at]; + let in_comment = comment_depth > 0; + comment_depth = block_comment_depth_after(line, comment_depth); + at += 1; + if in_comment { + continue; + } + let trimmed = line.split("--").next().unwrap_or_default().trim(); + let mut words = trimmed.split_whitespace(); + let Some(first) = words.next() else { continue }; + match first { + "namespace" => { + if let Some(name) = words.next() { + scopes.push((true, name.to_string())); + } + continue; + } + "section" | "mutual" => { + scopes.push((false, words.next().unwrap_or_default().to_string())); + continue; + } + "end" => { + let name = words.next().unwrap_or_default(); + if scopes.last().is_some_and(|(_, open)| open == name) { + scopes.pop(); + } + continue; + } + _ => {} + } + let Some((keyword, name, private, protected)) = declaration_head(trimmed) else { + continue; + }; + if private { + continue; + } + let namespace = scopes + .iter() + .filter(|(is_namespace, _)| *is_namespace) + .map(|(_, name)| name.as_str()) + .collect::>() + .join("."); + let qualified = match name.strip_prefix(crate::bridge_statement::ROOT_PREFIX) { + Some(absolute) => absolute.to_string(), + None if namespace.is_empty() => name.to_string(), + None => format!("{namespace}.{name}"), + }; + self.insert(qualified.clone(), protected); + match keyword { + "structure" | "class" => { + let mut constructor = "mk".to_string(); + while let Some(member) = lines.get(at) { + if !member.starts_with(" ") || member.trim().is_empty() { + break; + } + at += 1; + let member = member.trim(); + if let Some(ctor) = member.strip_suffix("::") { + constructor = ctor.trim().to_string(); + continue; + } + if let Some((fields, _)) = member.split_once(':') + && !fields.contains('(') + { + for field in fields.split_whitespace() { + if is_declared_name(field) { + self.insert(format!("{qualified}.{field}"), false); + } + } + } + } + self.insert(format!("{qualified}.{constructor}"), false); + } + "inductive" => { + let mut ctor_lines: Vec<&str> = trimmed + .split_once(" where") + .map(|(_, rest)| vec![rest]) + .unwrap_or_default(); + while let Some(member) = lines.get(at) { + if !member.trim_start().starts_with('|') { + break; + } + at += 1; + ctor_lines.push(member); + } + for ctor_line in ctor_lines { + for alternative in ctor_line.split('|').skip(1) { + if let Some(ctor) = alternative.split_whitespace().next() + && is_declared_name(ctor) + { + self.insert(format!("{qualified}.{ctor}"), false); + } + } + } + } + _ => {} + } + } + } + + /// Resolve `written` the way Lean does inside `namespace`, among the + /// model's names: the innermost enclosing namespace first, then the root. + /// An atomic name does not reach a `protected` declaration through a + /// namespace. + fn resolve(&self, namespace: &str, written: &str) -> Option { + let mut scope: Vec<&str> = namespace.split('.').filter(|s| !s.is_empty()).collect(); + loop { + let candidate = if scope.is_empty() { + written.to_string() + } else { + format!("{}.{written}", scope.join(".")) + }; + if let Some(protected) = self.names.get(&candidate) + && !(*protected && !scope.is_empty() && !written.contains('.')) + { + return Some(candidate); + } + scope.pop()?; + } + } +} + +/// The nesting depth of `/- … -/` block comments after `line`, given the +/// depth before it. String literals and `--` line comments are skipped. +fn block_comment_depth_after(line: &str, mut depth: usize) -> usize { + let chars: Vec = line.chars().collect(); + let mut at = 0; + while at < chars.len() { + let next = chars.get(at + 1).copied(); + if depth == 0 && chars[at] == '"' { + at += 1; + while at < chars.len() && chars[at] != '"' { + at += if chars[at] == '\\' { 2 } else { 1 }; + } + } else if depth == 0 && chars[at] == '-' && next == Some('-') { + break; + } else if chars[at] == '/' && next == Some('-') { + depth += 1; + at += 1; + } else if depth > 0 && chars[at] == '-' && next == Some('/') { + depth -= 1; + at += 1; + } + at += 1; + } + depth +} + +/// A declaration line's keyword and declared name, and whether it is +/// `private` or `protected`: `@[…]` attributes and the modifiers are skipped. +/// An instance without a name declares nothing a statement spells. +fn declaration_head(line: &str) -> Option<(&str, &str, bool, bool)> { + let mut rest = line; + while let Some(attributed) = rest.strip_prefix("@[") { + rest = attributed.split_once(']')?.1.trim_start(); + } + let (mut private, mut protected) = (false, false); + loop { + let (word, tail) = rest.split_once(char::is_whitespace)?; + let tail = tail.trim_start(); + match word { + "private" => private = true, + "protected" => protected = true, + "noncomputable" | "partial" | "unsafe" | "nonrec" => {} + "def" | "theorem" | "lemma" | "abbrev" | "opaque" | "axiom" | "instance" + | "structure" | "class" | "inductive" => { + let (keyword, tail) = match tail.strip_prefix("inductive ") { + Some(after) if word == "class" => ("inductive", after.trim_start()), + _ => (word, tail), + }; + let end = tail + .find(|c: char| c.is_whitespace() || "({[⦃:".contains(c)) + .unwrap_or(tail.len()); + let name = &tail[..end]; + return is_declared_name(name).then_some((keyword, name, private, protected)); + } + _ => return None, + } + rest = tail; + } +} + +/// A plain dotted identifier as a declaration writes it. +fn is_declared_name(name: &str) -> bool { + !name.is_empty() + && name.split('.').all(|segment| { + segment + .chars() + .next() + .is_some_and(|c| c.is_alphabetic() || c == '_') + && segment + .chars() + .all(|c| c.is_alphanumeric() || matches!(c, '_' | '\'' | '!' | '?')) + }) +} + +/// Identifiers that are keywords of the term language, never names. +const STATEMENT_KEYWORDS: [&str; 20] = [ + "fun", "λ", "if", "then", "else", "match", "with", "let", "have", "show", "from", "by", "do", + "at", "in", "Type", "Prop", "Sort", "forall", "exists", +]; + +/// One lexical item of a statement: an identifier with its byte offset, or +/// any other character. +enum StatementItem<'a> { + Ident(&'a str, usize), + Other(char), +} + +fn is_ident_char(c: char) -> bool { + c.is_ascii_alphanumeric() + || matches!(c, '_' | '\'' | '.' | '!' | '?') + || (!c.is_ascii() && c.is_alphanumeric() && !matches!(c, 'λ' | 'Π' | 'Σ')) +} + +/// The items of a statement, with string and character literals skipped. +fn statement_items(statement: &str) -> Vec> { + let mut items = Vec::new(); + let mut chars = statement.char_indices().peekable(); + while let Some((at, c)) = chars.next() { + if c == '"' || c == '\'' { + // A string or character literal: an identifier never starts + // with `'`, so a leading one opens a character. + let mut escaped = false; + for (_, inner) in chars.by_ref() { + if escaped { + escaped = false; + } else if inner == '\\' { + escaped = true; + } else if inner == c { + break; + } + } + items.push(StatementItem::Other(c)); + } else if is_ident_char(c) { + let mut end = at + c.len_utf8(); + while let Some(&(next_at, next)) = chars.peek() { + if !is_ident_char(next) { + break; + } + end = next_at + next.len_utf8(); + chars.next(); + } + items.push(StatementItem::Ident(&statement[at..end], at)); + } else { + items.push(StatementItem::Other(c)); + } + } + items +} + +/// The names a statement binds: in the binder list of every `∀`, `∃`, `fun` +/// or `λ`, each undotted identifier before the `:` of its group (or of the +/// whole list), up to the `,` or `=>` that ends the list. +fn statement_binders<'a>(items: &[StatementItem<'a>]) -> Vec<&'a str> { + let mut binders = Vec::new(); + let mut at = 0; + while at < items.len() { + let opens = match &items[at] { + StatementItem::Other('∀' | '∃' | 'λ' | 'Π' | 'Σ') => true, + StatementItem::Ident(word, _) => matches!(*word, "fun" | "forall" | "exists"), + _ => false, + }; + at += 1; + if !opens { + continue; + } + let mut depth = 0usize; + let mut typed = false; + while at < items.len() { + match &items[at] { + StatementItem::Other('(' | '{' | '[' | '⦃') => { + depth += 1; + typed = false; + } + StatementItem::Other(')' | '}' | ']' | '⦄') => { + depth = depth.saturating_sub(1); + typed = false; + } + StatementItem::Other(':') => typed = true, + StatementItem::Other(',' | '↦') if depth == 0 => break, + StatementItem::Other('=') + if depth == 0 && matches!(items.get(at + 1), Some(StatementItem::Other('>'))) => + { + break; + } + StatementItem::Ident(name, _) if !typed && !name.contains('.') => { + binders.push(*name); + } + _ => {} + } + at += 1; + } + } + binders +} + +/// Rewrite a law statement the emitter wrote for `namespace` so it means the +/// same at the root: every name that resolves, inside `namespace`, to a name +/// the model declares is replaced by `_root_.`, with the rest of a +/// dotted name kept as field accesses. Binders, keywords, numerals, +/// projections (`.length`) and names the model does not declare (core names +/// such as `Int` or `Option.some`) are left as written. +/// +/// The checker reads every law statement at the root, never inside the +/// namespace the package names, since a package constant there could capture +/// a name. This rewrite is how the producer keeps each statement's meaning +/// across that change. +pub fn root_qualify_statement(statement: &str, namespace: &str, names: &ModelNames) -> String { + let items = statement_items(statement); + let binders = statement_binders(&items); + let mut out = String::with_capacity(statement.len() + 64); + let mut copied = 0; + for item in &items { + let StatementItem::Ident(token, at) = item else { + continue; + }; + if token.starts_with('.') + || token.starts_with(crate::bridge_statement::ROOT_PREFIX) + || token.starts_with(|c: char| c.is_ascii_digit()) + || STATEMENT_KEYWORDS.contains(token) + { + continue; + } + let written = token.trim_end_matches('.'); + let segments: Vec<&str> = written.split('.').collect(); + if segments.iter().any(|segment| segment.is_empty()) || binders.contains(&segments[0]) { + continue; + } + let resolved = (1..=segments.len()).rev().find_map(|length| { + names + .resolve(namespace, &segments[..length].join(".")) + .map(|found| (found, &segments[length..])) + }); + if let Some((found, fields)) = resolved { + out.push_str(&statement[copied..*at]); + out.push_str(crate::bridge_statement::ROOT_PREFIX); + out.push_str(&found); + for field in fields { + out.push('.'); + out.push_str(field); + } + copied = at + written.len(); + } + } + out.push_str(&statement[copied..]); + out +} + +/// Every claim with its statement rewritten by [`root_qualify_statement`] for +/// the namespace its theorem was emitted in. +pub fn root_qualify_law_claims(claims: &[LawClaim], names: &ModelNames) -> Vec { + claims + .iter() + .map(|claim| LawClaim { + statement: root_qualify_statement(&claim.statement, &claim.prefix, names), + ..claim.clone() + }) + .collect() +} + +#[cfg(test)] +mod root_qualify_tests { + use super::*; + + const JSON: &str = "import AverCommon\n\nopen Bytes\n\nnamespace Json\n\n\ + inductive Json where\n | jsonNull\n | jsonString (_ : String)\n\n\ + inductive ParseResult where\n | ok (_ : Json) (_ : Int)\n | err (_ : String)\n\n\ + /-- doc\ndef notADecl : Int := 0\n-/\n\ + def escape (s : String) : String :=\n s\n\n\ + private def hidden (s : String) : String :=\n s\n\n\ + mutual\n def parse (s : String) (n : Int) : ParseResult :=\n ParseResult.err s\nend\n\n\ + theorem escape_law_id : ∀ (s : String), escape s = s := by\n rfl\n\nend Json\n"; + + const COMMON: &str = "namespace Except\n\nprotected def map (x : Int) : Int :=\n x\n\nend Except\n\n\ + structure BranchPath where\n dewey : String\n deriving BEq\n\n\ + def toString' (n : Int) : String :=\n \"\"\n"; + + fn names() -> ModelNames { + ModelNames::from_files([("AverModel/Json.lean", JSON), ("AverModel/AverCommon.lean", COMMON)]) + } + + #[test] + fn model_names_are_collected_with_their_namespace() { + let names = names(); + for name in [ + "Json.Json", + "Json.Json.jsonString", + "Json.ParseResult.ok", + "Json.escape", + "Json.parse", + "Json.escape_law_id", + "Except.map", + "BranchPath.dewey", + "BranchPath.mk", + "toString'", + ] { + assert!(names.names.contains_key(name), "{name}: {:?}", names.names); + } + assert!(!names.names.contains_key("Json.hidden")); + assert!(!names.names.contains_key("Json.notADecl")); + } + + /// The rewrite resolves each name where the emitter's namespace put it, + /// and leaves binders, core names, literals and projections alone. + #[test] + fn statements_are_qualified_as_their_namespace_reads_them() { + let names = names(); + assert_eq!( + root_qualify_statement( + "∀ (s : String), parse ((\"\\\"\" + escape s) + \"escape\") 1 = \ + ParseResult.ok (Json.jsonString s) (((escape s).length : Int) + 2)", + "Json", + &names + ), + "∀ (s : String), _root_.Json.parse ((\"\\\"\" + _root_.Json.escape s) + \"escape\") 1 = \ + _root_.Json.ParseResult.ok (_root_.Json.Json.jsonString s) \ + (((_root_.Json.escape s).length : Int) + 2)" + ); + // A binder that shares a model name stays the binder, and so does a + // field read through it. + assert_eq!( + root_qualify_statement( + "∀ (escape : String), escape.length = (toString' 0).length", + "Json", + &names + ), + "∀ (escape : String), escape.length = (_root_.toString' 0).length" + ); + // An atomic name does not reach a protected declaration through its + // namespace; the dotted spelling does. + assert_eq!( + root_qualify_statement("map 1 = Except.map 1", "Except", &names), + "map 1 = _root_.Except.map 1" + ); + // An already qualified name and a character literal are kept. + assert_eq!( + root_qualify_statement("_root_.Json.escape 'e' = escape \"e\"", "Json", &names), + "_root_.Json.escape 'e' = _root_.Json.escape \"e\"" + ); + } +} diff --git a/aver-cert/src/engine/layout.rs b/aver-cert/src/engine/layout.rs new file mode 100644 index 000000000..b1e4627c7 --- /dev/null +++ b/aver-cert/src/engine/layout.rs @@ -0,0 +1,359 @@ +// ---- the declared module layout --------------------------------------------- +// +// A package declares where the wall finds each planned function's facts in +// the module, so that its checks read them instead of searching for them: +// every defined function's type index and code-entry offset and length (as +// packed tables), the exact function type of every planned function, and +// each planned function's export position. `DeclaredLayout.layoutConfirmed` +// and `fnTypesConfirmed` confirm the declarations against the wall's own +// decoders, and a plan check compares its own function's facts with them; a +// wrong declaration fails those equalities and the package declines. + +/// Bits per entry of a packed layout table. +const LAYOUT_WIDTH: u32 = 32; + +/// The layout facts of a core module, read by plain byte walking. +struct ModuleLayout { + imports: u32, + func_types: Vec, + code_offsets: Vec, + code_lengths: Vec, + /// Plain (no `sub` prefix) function types by type index, as Lean + /// `CertDecode.ValType` terms. + fn_types: BTreeMap, Vec)>, + /// Position of each function export in the export section. + export_positions: HashMap, + /// Byte length of each top-level entry (rec group or subtype) of the type + /// section, of each export entry, and (`code_lengths`) of each code entry: + /// the cuts at which the wall decodes each section one entry at a time. + type_cuts: Vec, + export_cuts: Vec, +} + +struct Cursor<'a> { + bytes: &'a [u8], + at: usize, +} + +impl Cursor<'_> { + fn byte(&mut self) -> Result { + let b = *self.bytes.get(self.at).ok_or("layout: truncated module")?; + self.at += 1; + Ok(b) + } + + fn uleb(&mut self) -> Result { + let (mut value, mut shift) = (0u64, 0u32); + loop { + let b = self.byte()?; + if shift >= 64 { + return Err("layout: overlong LEB".into()); + } + value |= u64::from(b & 0x7f) << shift; + shift += 7; + if b < 0x80 { + return Ok(value); + } + } + } + + fn sleb(&mut self) -> Result { + let (mut value, mut shift) = (0i64, 0u32); + loop { + let b = self.byte()?; + if shift >= 64 { + return Err("layout: overlong LEB".into()); + } + value |= i64::from(b & 0x7f) << shift; + shift += 7; + if b < 0x80 { + if b & 0x40 != 0 && shift < 64 { + value |= -1i64 << shift; + } + return Ok(value); + } + } + } + + fn skip(&mut self, n: usize) -> Result<(), String> { + if self.at + n > self.bytes.len() { + return Err("layout: truncated module".into()); + } + self.at += n; + Ok(()) + } + + fn val_type(&mut self) -> Result { + let tag = self.byte()?; + match tag { + 0x63 | 0x64 => { + let heap = self.sleb()?; + let heap = if heap >= 0 { + format!("Int.ofNat {heap}") + } else { + format!("Int.negSucc {}", -heap - 1) + }; + Ok(format!(".ref {tag} ({heap})")) + } + 0x7b..=0x7f => Ok(format!(".numeric {tag}")), + 0x6a..=0x73 => Ok(format!(".abstract {tag}")), + _ => Err(format!("layout: value type {tag:#x} outside the profile")), + } + } + + fn storage(&mut self) -> Result<(), String> { + match self.bytes.get(self.at) { + Some(0x78 | 0x77) => self.skip(1), + _ => self.val_type().map(|_| ()), + } + } +} + +impl ModuleLayout { + fn parse(bytes: &[u8]) -> Result { + let mut layout = ModuleLayout { + imports: 0, + func_types: Vec::new(), + code_offsets: Vec::new(), + code_lengths: Vec::new(), + fn_types: BTreeMap::new(), + export_positions: HashMap::new(), + type_cuts: Vec::new(), + export_cuts: Vec::new(), + }; + let mut c = Cursor { bytes, at: 8 }; + while c.at < bytes.len() { + let id = c.byte()?; + let size = c.uleb()? as usize; + let end = c.at + size; + let mut s = Cursor { + bytes: bytes.get(..end).ok_or("layout: truncated section")?, + at: c.at, + }; + match id { + 1 => layout.parse_types(&mut s)?, + 2 => { + for _ in 0..s.uleb()? { + for _ in 0..2 { + let n = s.uleb()? as usize; + s.skip(n)?; + } + if s.byte()? != 0 { + return Err("layout: a non-function import".into()); + } + s.uleb()?; + layout.imports += 1; + } + } + 3 => { + for _ in 0..s.uleb()? { + layout.func_types.push(s.uleb()? as u32); + } + } + 7 => { + for position in 0..s.uleb()? as usize { + let start = s.at; + let n = s.uleb()? as usize; + let name = bytes + .get(s.at..s.at + n) + .and_then(|name| std::str::from_utf8(name).ok()) + .ok_or("layout: export name is not UTF-8")? + .to_string(); + s.skip(n)?; + let kind = s.byte()?; + s.uleb()?; + layout.export_cuts.push(s.at - start); + if kind == 0 { + layout.export_positions.entry(name).or_insert(position); + } + } + } + 10 => { + for _ in 0..s.uleb()? { + let start = s.at; + let n = s.uleb()? as usize; + s.skip(n)?; + layout.code_offsets.push(start); + layout.code_lengths.push(s.at - start); + } + } + _ => {} + } + c.at = end; + } + Ok(layout) + } + + fn parse_types(&mut self, s: &mut Cursor<'_>) -> Result<(), String> { + let mut index = 0u32; + for _ in 0..s.uleb()? { + let start = s.at; + let group = if s.bytes.get(s.at) == Some(&0x4e) { + s.skip(1)?; + s.uleb()? + } else { + 1 + }; + for _ in 0..group { + let mut plain = true; + if matches!(s.bytes.get(s.at), Some(0x50 | 0x4f)) { + plain = false; + s.skip(1)?; + for _ in 0..s.uleb()? { + s.uleb()?; + } + } + match s.byte()? { + 0x60 => { + let params = (0..s.uleb()?) + .map(|_| s.val_type()) + .collect::, _>>()?; + let results = (0..s.uleb()?) + .map(|_| s.val_type()) + .collect::, _>>()?; + if plain { + self.fn_types.insert(index, (params, results)); + } + } + 0x5f => { + for _ in 0..s.uleb()? { + s.storage()?; + s.skip(1)?; + } + } + 0x5e => { + s.storage()?; + s.skip(1)?; + } + tag => return Err(format!("layout: composite type {tag:#x}")), + } + index += 1; + } + self.type_cuts.push(s.at - start); + } + Ok(()) + } +} + +/// A table of small numbers packed into one hex numeral, entry 0 lowest. +fn packed_hex(values: impl DoubleEndedIterator) -> Result { + let digits = (LAYOUT_WIDTH / 4) as usize; + let mut hex = String::from("0x0"); + for value in values.rev() { + if value >> LAYOUT_WIDTH != 0 { + return Err("layout: a value does not fit the packed width".into()); + } + hex.push_str(&format!("{value:0digits$x}")); + } + Ok(hex) +} + +/// A list of lengths as a Lean list literal body, twenty to a line. +fn nat_list(values: &[usize]) -> String { + values + .chunks(20) + .map(|line| line.iter().map(usize::to_string).collect::>().join(", ")) + .collect::>() + .join(",\n ") +} + +/// `ArtifactLayout.lean`: the declared layout, the planned functions' types +/// and export positions, and the proof that the layout is the module's. +fn render_artifact_layout(core_bytes: &[u8], analysis: &Analysis) -> Result { + let layout = ModuleLayout::parse(core_bytes)?; + let type_of = |func_idx: u32| { + func_idx + .checked_sub(layout.imports) + .and_then(|k| layout.func_types.get(k as usize).copied()) + .ok_or_else(|| format!("layout: function {func_idx} is not defined")) + }; + let mut planned_types = BTreeSet::new(); + for e in &analysis.entries { + planned_types.insert(type_of(e.func_idx)?); + } + let planned_types: Vec = planned_types.into_iter().collect(); + let fn_types = planned_types + .iter() + .map(|t| { + let (params, results) = layout + .fn_types + .get(t) + .ok_or_else(|| format!("layout: type {t} is not a plain function type"))?; + Ok(format!( + "({t}, [{}], [{}])", + params.join(", "), + results.join(", ") + )) + }) + .collect::, String>>()?; + let decls = analysis + .entries + .iter() + .map(|e| { + let t = type_of(e.func_idx)?; + let sig_pos = planned_types.binary_search(&t).expect("collected above"); + let export_pos = if e.exported { + *layout + .export_positions + .get(&e.name) + .ok_or_else(|| format!("layout: no function export named {}", e.name))? + } else { + 0 + }; + Ok(format!( + "⟨{}, {export_pos}, {sig_pos}⟩", + lean_char_list(&e.name) + )) + }) + .collect::, String>>()?; + Ok(format!( + "-- The declared module layout: every defined function's type index and\n\ + -- code entry (packed tables, {LAYOUT_WIDTH} bits per entry), the function types\n\ + -- of the planned functions, and each planned function's name and export\n\ + -- position. Producer data: `layout_ok` confirms the layout against the\n\ + -- staged bytes, and the plan checks confirm the rest.\n\ + import DeclaredLayout\n\ + import ByteWindow\n\ + import ArtifactBytes\n\n\ + set_option maxRecDepth 200000\n\n\ + namespace AverCert.Artifact\n\ + open AverCert.DeclaredLayout\n\n\ + def layout : Layout :=\n \ + {{ imports := {imports}, count := {count}, width := {LAYOUT_WIDTH},\n \ + types := {types},\n \ + offsets := {offsets},\n \ + lengths := {lengths} }}\n\n\ + def fnTypes : List FnType :=\n [{fn_types}]\n\n\ + def fnDecls : List FnDecl :=\n [{decls}]\n\n\ + -- The section cuts: the byte length of every top-level entry of the\n\ + -- type section, of every export and of every code entry. Each cut is\n\ + -- confirmed once below (every entry decodes alone and exactly fills its\n\ + -- window), and every later check reads the section through its cut.\n\ + def typeCuts : List Nat :=\n [{type_cuts}]\n\n\ + def exportCuts : List Nat :=\n [{export_cuts}]\n\n\ + def codeCuts : List Nat :=\n [{code_cuts}]\n\n\ + theorem types_cut : CertDecode.decodeTypes {bytes} =\n \ + AverCert.ByteWindow.typesLazy {bytes} typeCuts :=\n \ + AverCert.ByteWindow.decodeTypes_eq_lazy (by decide +kernel)\n\n\ + theorem exports_cut : CertDecode.decodeRawExports {bytes} =\n \ + AverCert.ByteWindow.exportsLazy {bytes} exportCuts :=\n \ + AverCert.ByteWindow.decodeRawExports_eq_lazy (by decide +kernel)\n\n\ + theorem code_cut : CertDecode.codeLocs {bytes} =\n \ + AverCert.ByteWindow.codeLazy {bytes} codeCuts :=\n \ + AverCert.ByteWindow.codeLocs_eq_lazy (by decide +kernel)\n\n\ + theorem layout_ok : layoutConfirmed {bytes} layout = true := by\n \ + rw [layoutConfirmed, code_cut]; decide +kernel\n\n\ + end AverCert.Artifact\n", + imports = layout.imports, + count = layout.func_types.len(), + types = packed_hex(layout.func_types.iter().map(|&t| u64::from(t)))?, + offsets = packed_hex(layout.code_offsets.iter().map(|&o| o as u64))?, + lengths = packed_hex(layout.code_lengths.iter().map(|&l| l as u64))?, + fn_types = fn_types.join(",\n "), + decls = decls.join(",\n "), + type_cuts = nat_list(&layout.type_cuts), + export_cuts = nat_list(&layout.export_cuts), + code_cuts = nat_list(&layout.code_lengths), + bytes = "AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen", + )) +} diff --git a/aver-cert/src/engine/mod.rs b/aver-cert/src/engine/mod.rs index ac3e6cbef..04681ade4 100644 --- a/aver-cert/src/engine/mod.rs +++ b/aver-cert/src/engine/mod.rs @@ -8,29 +8,22 @@ //! Everything else is FAIL-CLOSED: listed in `cert-manifest.json` as //! `source-level-only` with a reason. No weaker theorem is ever emitted. //! -//! Certified-function bodies are read back from the module bytes the compiler -//! just emitted, checked against the admitted profiles, and re-rendered as -//! `CertPrelude.WInstr` data. Any body that cannot be bound to an admitted -//! obligation is declined rather than assigned a weaker theorem. -//! -//! `aver cert verify` performs standard Wasm validation, then the accepted- -//! artifact witness uses `CertDecode` to compute code/carrier/struct facts from -//! `ArtifactBytes` in-kernel. Rust classification and rederivation remain -//! producer diagnostics only. Expression plans are emitted once, -//! as Lean data in `Plans.lean`; the checker-owned wall validates and lowers -//! that data against the exact artifact bytes. Redundant text sidecars are not -//! part of the public certificate package. +//! The compiler prints every emitted function's optimized MIR body 1:1 into +//! the one plan grammar (`plan.rs`); the producer here checks each plan +//! against the exact module bytes (`plan_check.rs` twins of the wall's +//! lowering) and declines per function whatever does not match. The offered +//! plans are rendered as Lean data in `Plans.lean`; the checker-owned wall +//! lowers them again and pins the result to the artifact bytes. -// This module compiles in two layers. With only the `plans` feature the -// plan-surface files below are compiled: the fragment/sym plan IR types and -// the canonical byte lowering the wasm-gc emitter needs in every build. The -// full certificate engine — byte classifier, rederiver, Lean renderer, and -// the embedded soundness wall re-export — is additionally compiled under the -// `engine` feature (which implies `plans`). External paths are unchanged: -// everything stays a flat `aver_cert::*` item. +// Two layers: with only the `plans` feature, the plan data types the compiler +// prints into; under `engine` (which implies `plans`), the byte facts, the +// producer, the Lean renderer and the embedded wall re-export. Everything +// stays a flat `aver_cert::*` item. #[cfg(feature = "engine")] use sha2::{Digest, Sha256}; #[cfg(feature = "engine")] +use std::collections::{BTreeMap, BTreeSet, HashMap}; +#[cfg(feature = "engine")] use std::path::Path; #[cfg(feature = "engine")] @@ -47,6 +40,10 @@ pub const PROFILE_ID: &str = crate::format::PROFILE_ID; pub const RUNTIME_ABI: &str = crate::format::RUNTIME_ABI_WASM_GC; /// Conditional simulation under the runtime contracts named by the claim. pub const CERT_LEVEL: &str = "L1"; +/// The one report class of a certified export. +pub const PLAN_CLASS: &str = crate::format::PLAN_CLASS; +/// The discharge theorem every certified export names. +pub const FN_CLAIM_DISCHARGE_THEOREM: &str = crate::format::FN_CLAIM_DISCHARGE_THEOREM; pub const CERT_SCHEMA_VERSION: u32 = crate::format::CERT_SCHEMA_VERSION; pub const BOX_CONTRACT: &str = "__rt_aint_from_i64 (box i64 -> carrier)"; pub const INT_ADD_CONTRACT: &str = @@ -71,6 +68,9 @@ pub const CMP_CONTRACT: &str = "__aint_cmp (canonical carrier pair -> i32 sign; -1 less, 0 equal, 1 greater)"; pub const EQ_CONTRACT: &str = "__aint_eq (canonical carrier pair -> i32 boolean; 1 when equal, else 0)"; +/// The Euclidean division helper contract; byte-identical twin of +/// `ClaimAxes.divmodContract`. +pub const DIVMOD_CONTRACT: &str = "__aint_divmod (canonical carrier pair, nonzero divisor, want_mod 0 or 1 -> canonical Euclidean quotient (0) or remainder in [0, |b|) (1))"; /// The one approved final-theorem statement line. `aver cert verify` confirms /// this exact line is present in `Final.lean` (name + `Holds manifest`), which /// is what pins the statement without matching arbitrary Lean syntax. @@ -89,59 +89,27 @@ pub fn sha256_hex(bytes: &[u8]) -> String { hex(&h.finalize()) } -// Plan surface (`plans` feature): plan IR types, the SymPlan -> ExprFragmentPlan -// encoder, and the canonical byte lowering the wasm-gc emitter calls at emit -// time. -include!("expr_fragment_defs.rs"); -include!("expr_fragment_faces.rs"); -include!("sym_plan_defs.rs"); -include!("sym_plan_encode.rs"); -include!("classify_expr_fragment_lower.rs"); - -// Full certificate engine (`engine` feature): byte-derived classification, -// rederivation, Lean rendering, and everything that references the wall. -#[cfg(feature = "engine")] -include!("core_wasm.rs"); -#[cfg(feature = "engine")] -include!("core_shapes.rs"); -#[cfg(feature = "engine")] -include!("sym_plan_render.rs"); -#[cfg(feature = "engine")] -include!("cert_defs.rs"); -#[cfg(feature = "engine")] -include!("recursion_plan_defs.rs"); -#[cfg(feature = "engine")] -include!("mutual_plan_defs.rs"); -#[cfg(feature = "engine")] -include!("composition_plan_defs.rs"); -#[cfg(feature = "engine")] -include!("verbatim_plan_defs.rs"); -#[cfg(feature = "engine")] -include!("int_dispatch_plan_defs.rs"); #[cfg(feature = "engine")] -include!("string_plan_defs.rs"); -#[cfg(feature = "engine")] -include!("construct_plan_defs.rs"); +fn hex(bytes: &[u8]) -> String { + bytes.iter().map(|b| format!("{b:02x}")).collect() +} + +// Plan surface (`plans` feature): the one-grammar plan data. +include!("plan.rs"); + +// The producer (`engine` feature). #[cfg(feature = "engine")] -include!("field_projection_plan_defs.rs"); +include!("module_facts.rs"); #[cfg(feature = "engine")] -include!("cert_methods.rs"); +include!("plan_check.rs"); #[cfg(feature = "engine")] -include!("analysis.rs"); +include!("produce.rs"); #[cfg(feature = "engine")] include!("module_envelope.rs"); #[cfg(feature = "engine")] -include!("declared_envelope.rs"); -include!("law_claims.rs"); -#[cfg(feature = "engine")] -include!("rederive.rs"); -#[cfg(feature = "engine")] -include!("disasm.rs"); -#[cfg(feature = "engine")] -include!("classification.rs"); -#[cfg(feature = "engine")] -include!("model_eval.rs"); -#[cfg(feature = "engine")] include!("source_bridges.rs"); #[cfg(feature = "engine")] -include!("render.rs"); +include!("layout.rs"); +#[cfg(feature = "engine")] +include!("render_package.rs"); +include!("law_claims.rs"); diff --git a/aver-cert/src/engine/model_eval.rs b/aver-cert/src/engine/model_eval.rs deleted file mode 100644 index 765c143bb..000000000 --- a/aver-cert/src/engine/model_eval.rs +++ /dev/null @@ -1,620 +0,0 @@ -// ---- model evaluation (anti-vacuity guard values) ------------------------ -// The descent (`n-1`) is the pinned shape; the base is data and the combinator -// (`+` or `*`) is read from the model — so these compute the model value for any -// admitted base and operator without a per-function evaluator. - -/// `f n = if n≤0 then base else other f (n-1)` (body-consumed self-recursion), -/// where `` is `+` or `*`. Both combinators commute, so operand order does not -/// affect the value; only the operator and the non-recursive operand do. Computed -/// with checked `i128`: a large multiplier or base can exceed the range, and the -/// caller declines fail-closed rather than emit a wrong (or overflowing) guard. -fn eval_body_recursion( - n: i64, - base: i64, - other: BodyOperand, - combinator: Combinator, -) -> Option { - if n <= 0 { - Some(base as i128) - } else { - let o = match other { - BodyOperand::Input => n as i128, - BodyOperand::Const(k) => k as i128, - }; - let rec = eval_body_recursion(n - 1, base, other, combinator)?; - match combinator { - Combinator::Add => o.checked_add(rec), - Combinator::Mul => o.checked_mul(rec), - } - } -} - -#[derive(Default)] -struct ModelInfo { - /// Keyed by the FLAT (wasm-export-space) name: for a def inside - /// `namespace P` the key is `P` with dots replaced by underscores, - /// joined to the bare name with `_` — exactly the compiler's dependency - /// flattening. Definitions in the entry module's namespace are keyed by - /// their bare export name because the compiler does not flatten that prefix. - fns: std::collections::HashMap, - /// Keyed by the qualified Lean name (`P.Ty` inside `namespace P`). - inductives: std::collections::HashMap, - /// Record (`structure`) declarations, keyed by the qualified Lean name. - /// Read by the plan-equals-source bridge renderer, which needs the source - /// field ACCESSORS in declaration order to encode a record argument. - structures: std::collections::HashMap, - /// Signatures of PARAMETERLESS model defs (`def zeroFraction : Fraction :=`), - /// keyed like `fns`. They are deliberately kept out of `fns`: that map - /// backs `model_lean_name`, whose resolution decides which exports survive - /// the model-citation gate, so admitting a new shape there would widen the - /// certified set of every existing package. The plan-equals-source bridge - /// needs only the signature, so it reads both maps and nothing else moves. - nullary_fns: std::collections::HashMap, - /// Flat keys two DIFFERENT parameterless defs claim. Kept apart from - /// `ambiguous` for the same reason `nullary_fns` is kept apart from `fns`: - /// `model_lean_name` reads `ambiguous`, so recording a nullary collision - /// there could turn an export that resolves today into one that declines. - nullary_ambiguous: std::collections::HashSet, - /// Flat forms (dots replaced by underscores) of every dependency namespace. - /// An export name shaped like `_` for one of these prefixes - /// may be a dependency function, so its Lean identifier cannot be assumed - /// to be the export name itself. - module_prefix_flats: Vec, - /// Flat keys claimed by two DIFFERENT qualified names. A lookup on such a - /// key must fail (fail-closed): citing either candidate would be a guess. - ambiguous: std::collections::HashSet, -} - -struct FnSig { - /// Fully qualified Lean identifier of this def (`P.name`). - lean_name: String, - /// Dotted namespace prefix the def was parsed under. - prefix: String, - params: Vec, - ret: String, -} - -struct InductiveInfo { - ctors: Vec, -} - -/// One transpiled `structure` declaration: its fields in DECLARATION order, -/// each as `(accessor name, type as written)`. Declaration order is the order -/// the emitter packs the wasm struct in, so it is the order a bridge encoder -/// must list the record's Int leaves in. -struct StructureInfo { - fields: Vec<(String, String)>, -} - -struct CtorInfo { - name: String, - fields: Vec, -} - -/// The compiler prelude, emitted into every model tree alongside the user's -/// own modules (`AverCommon.lean` plus the build files). It carries its own -/// namespaces (`AverString`, `AverMap`, `AverFloat`, …) and dotted top-level -/// defs (`String.charAtAv`, `Float.fromInt`, …), none of which is ever a user -/// export's model. -/// -/// Reading it into the name space would be actively wrong, not just noisy: -/// its namespaces would populate `module_prefix_flats` even for a program with -/// no dependency modules at all, and a user export whose name happens to -/// collide with a prelude def's flattened key (`AverList_get`) would be marked -/// ambiguous and DECLINE. The certificate cites only user models, so only user -/// model files may define the name space. -fn is_user_model_file(path: &str) -> bool { - path.ends_with(".lean") && path != "AverCommon.lean" && path != "lakefile.lean" -} - -fn entry_model_root(model_files: &[(String, String)]) -> Option { - let lakefile = model_files - .iter() - .find_map(|(path, contents)| (path == "lakefile.lean").then_some(contents))?; - lakefile.lines().find_map(|line| { - let rest = line.trim().strip_prefix("roots := #[`")?; - let root = rest.split([',', ']']).next()?.trim(); - (!root.is_empty()).then(|| root.to_string()) - }) -} - -fn model_file_root(path: &str) -> Option { - path.strip_suffix(".lean").map(|stem| stem.replace('/', ".")) -} - -impl ModelInfo { - /// Parse the USER model modules only — see `is_user_model_file`. - fn from_files(model_files: &[(String, String)]) -> Self { - let mut info = Self::default(); - let entry_root = entry_model_root(model_files); - for (path, content) in model_files { - if !is_user_model_file(path) { - continue; - } - let entry_namespace = if model_file_root(path).as_ref() == entry_root.as_ref() { - entry_root.as_deref() - } else { - None - }; - info.parse_lean(content, entry_namespace); - } - info - } - - /// The Lean identifier the generated certificate must cite for the model - /// of export `name`, or `None` when it cannot be derived (then the export - /// must decline rather than cite a guess). - /// - /// - A parsed model def with this flat key resolves to its qualified name. - /// - Two distinct defs flattening to the same key are ambiguous: `None`. - /// - With no parsed def, the export name itself is citable only when no - /// model namespace flattens to a prefix of it — otherwise the export may - /// be a dependency-module function whose bare-underscore name does not - /// exist in Lean, so `None`. - fn model_lean_name(&self, name: &str) -> Option { - if self.ambiguous.contains(name) { - return None; - } - if let Some(sig) = self.fns.get(name) { - return Some(sig.lean_name.clone()); - } - let may_be_dep_fn = self.module_prefix_flats.iter().any(|prefix| { - name.len() > prefix.len() + 1 - && name.starts_with(prefix.as_str()) - && name.as_bytes()[prefix.len()] == b'_' - }); - if may_be_dep_fn { - None - } else { - Some(name.to_string()) - } - } - - /// Resolve a type name AS WRITTEN in a model def signature (relative to - /// that def's namespace) to the qualified inductive it denotes: first in - /// the def's own namespace, then as a fully qualified / entry-level name. - fn resolve_inductive<'a>( - &'a self, - prefix: &str, - written: &str, - ) -> Option<(String, &'a InductiveInfo)> { - if !prefix.is_empty() { - let qualified = format!("{prefix}.{written}"); - if let Some(ind) = self.inductives.get(&qualified) { - return Some((qualified, ind)); - } - } - self.inductives - .get(written) - .map(|ind| (written.to_string(), ind)) - } - - /// Resolve a type name AS WRITTEN in a model def signature (relative to - /// that def's namespace) to the qualified `structure` it denotes. Same - /// two-step lookup as [`Self::resolve_inductive`]. - fn resolve_structure<'a>( - &'a self, - prefix: &str, - written: &str, - ) -> Option<(String, &'a StructureInfo)> { - if !prefix.is_empty() - && let Some(found) = self.structures.get(&format!("{prefix}.{written}")) - { - return Some((format!("{prefix}.{written}"), found)); - } - self.structures - .get(written) - .map(|found| (written.to_string(), found)) - } - - /// Whether `qualified` is the fully qualified name of a def the user model - /// modules declare. Read by the law/bridge coverage scan. - fn is_model_fn(&self, qualified: &str) -> bool { - self.fns - .values() - .chain(self.nullary_fns.values()) - .any(|sig| sig.lean_name == qualified) - } - - /// Whether a parameterless model def collided on its flat key. Kept for the - /// symmetry the bridge gate relies on: an ambiguous nullary key must not - /// resolve, and it must not disturb `model_lean_name` either. - #[cfg(test)] - fn nullary_is_ambiguous(&self, flat: &str) -> bool { - self.nullary_ambiguous.contains(flat) - } - - /// The parsed signature of the model def a certified export cites, when it - /// resolves unambiguously. `None` keeps the caller fail-closed. - fn model_fn_sig(&self, name: &str) -> Option<&FnSig> { - if self.ambiguous.contains(name) { - return None; - } - self.fns.get(name).or_else(|| { - if self.nullary_ambiguous.contains(name) { - None - } else { - self.nullary_fns.get(name) - } - }) - } - - fn parse_lean(&mut self, content: &str, entry_namespace: Option<&str>) { - let lines: Vec<&str> = content.lines().collect(); - // Namespace stack: `namespace X` pushes (X may be dotted), a matching - // `end X` pops. A bare `end` (a `mutual` block) never pops. - let mut ns_stack: Vec = Vec::new(); - let mut i = 0usize; - while i < lines.len() { - let line = lines[i].trim(); - if let Some(rest) = line.strip_prefix("namespace ") - && let Some(name) = rest.split_whitespace().next() - && rest.trim() == name - { - ns_stack.push(name.to_string()); - let prefix = ns_stack.join("."); - if entry_namespace != Some(prefix.as_str()) { - let flat = prefix.replace('.', "_"); - if !self.module_prefix_flats.contains(&flat) { - self.module_prefix_flats.push(flat); - } - } - i += 1; - continue; - } - if let Some(rest) = line.strip_prefix("end ") - && ns_stack.last().map(String::as_str) == Some(rest.trim()) - { - ns_stack.pop(); - i += 1; - continue; - } - let prefix = ns_stack.join("."); - // `structure X where` followed by one indented `field : Type` line - // per field, in declaration order. Anything else about the block - // (a different header shape, a field line that is not exactly - // `name : Type`) ends the field walk, so a shape this parser does - // not understand yields a partial or absent record rather than a - // wrong one — and the bridge renderer that reads it cross-checks - // the field count against the byte-derived record declaration. - if let Some(name) = line - .strip_prefix("structure ") - .and_then(|rest| rest.strip_suffix(" where")) - .map(str::trim) - .filter(|name| !name.is_empty() && !name.contains(char::is_whitespace)) - { - let qualified = qualify(&prefix, name); - i += 1; - let mut fields = Vec::new(); - while i < lines.len() { - let raw = lines[i]; - if !raw.starts_with(' ') { - break; - } - let Some((field, ty)) = raw.trim().split_once(" : ") else { - break; - }; - let field = field.trim(); - let plain_field = !field.is_empty() - && field - .chars() - .all(|c| c.is_ascii_alphanumeric() || c == '_' || c == '\''); - if !plain_field { - break; - } - fields.push((field.to_string(), ty.trim().to_string())); - i += 1; - } - self.structures.insert(qualified, StructureInfo { fields }); - continue; - } - if let Some(name) = line - .strip_prefix("inductive ") - .and_then(|s| s.split_whitespace().next()) - { - let qualified = qualify(&prefix, name); - i += 1; - let mut ctors = Vec::new(); - while i < lines.len() { - let l = lines[i].trim(); - if !l.starts_with('|') { - break; - } - let rest = l.trim_start_matches('|').trim(); - let ctor_name = rest.split_whitespace().next().unwrap_or("").to_string(); - let mut fields = Vec::new(); - let mut tail = rest[ctor_name.len()..].trim(); - while let Some(start) = tail.find("(_ : ") { - let after = &tail[start + 5..]; - if let Some(end) = after.find(')') { - fields.push(after[..end].trim().to_string()); - tail = &after[end + 1..]; - } else { - break; - } - } - ctors.push(CtorInfo { - name: ctor_name, - fields, - }); - i += 1; - } - self.inductives.insert(qualified, InductiveInfo { ctors }); - continue; - } - if line.starts_with("def ") - && line.contains(" : ") - && line.ends_with(":=") - && let Some((name, mut sig, nullary)) = parse_def_sig(line) - { - let qualified = qualify(&prefix, &name); - let flat = if entry_namespace == Some(prefix.as_str()) { - name.clone() - } else { - qualified.replace('.', "_") - }; - sig.lean_name = qualified; - sig.prefix = prefix.clone(); - if self.ambiguous.contains(&flat) { - i += 1; - continue; - } - let (table, ambiguous) = if nullary { - (&mut self.nullary_fns, &mut self.nullary_ambiguous) - } else { - (&mut self.fns, &mut self.ambiguous) - }; - match table.get(&flat) { - Some(existing) if existing.lean_name != sig.lean_name => { - // Two distinct qualified names collide on one flat - // key: neither may ever resolve (fail-closed). - table.remove(&flat); - ambiguous.insert(flat); - } - _ => { - table.insert(flat, sig); - } - } - } - i += 1; - } - } -} - -fn qualify(prefix: &str, name: &str) -> String { - if prefix.is_empty() { - name.to_string() - } else { - format!("{prefix}.{name}") - } -} - -/// Parse one single-line def signature. `lean_name`/`prefix` are filled by the -/// caller, which knows the namespace the line was parsed under. The third -/// component says whether the def takes NO parameters, which the caller keys a -/// separate table on — see `ModelInfo::nullary_fns`. -fn parse_def_sig(line: &str) -> Option<(String, FnSig, bool)> { - let rest = line.strip_prefix("def ")?; - let name = rest.split_whitespace().next()?.to_string(); - let after_name = rest[name.len()..].trim(); - let before_assign = after_name.strip_suffix(":=")?.trim(); - // `def f (a : Int) : Int :=` splits at the LAST ` : `; a parameterless - // `def zero : Fraction :=` has no such separator and starts at the colon. - let (params_part, ret, nullary) = match before_assign.rfind(" : ") { - Some(at) => ( - before_assign[..at].trim(), - before_assign[at + 3..].trim().to_string(), - false, - ), - None => ( - "", - before_assign.strip_prefix(':')?.trim().to_string(), - true, - ), - }; - if ret.is_empty() { - return None; - } - let mut params = Vec::new(); - let mut tail = params_part; - while let Some(start) = tail.find('(') { - let after = &tail[start + 1..]; - let mut depth = 1usize; - let mut end = None; - for (at, ch) in after.char_indices() { - match ch { - '(' => depth += 1, - ')' => { - depth -= 1; - if depth == 0 { - end = Some(at); - break; - } - } - _ => {} - } - } - let end = end?; - let param = &after[..end]; - if let Some((_, ty)) = param.split_once(" : ") { - params.push(ty.trim().to_string()); - } - tail = &after[end + 1..]; - } - let nullary = nullary && params.is_empty(); - Some(( - name.clone(), - FnSig { - lean_name: name, - prefix: String::new(), - params, - ret, - }, - nullary, - )) -} - -#[cfg(test)] -mod model_name_space_tests { - /// A single-file (no dependency module) program's model tree still ships - /// the compiler prelude, which carries its own namespaces and dotted - /// top-level defs. None of it may enter the dependency name space: a flat - /// program has no dependency prefixes, and its bare Wasm exports resolve to - /// definitions in the entry module namespace. - #[test] - fn prelude_namespaces_stay_out_of_the_flat_key_space() { - // Abridged from a real `AverCommon.lean`: a namespace block and the - // dotted top-level defs the prelude actually emits. - let prelude = "\ -def String.charAtAv (s : String) (i : Int) : Option String :=\n\ - none\n\ -namespace AverList\n\ -def get (xs : List Int) (i : Int) : Int :=\n\ - 0\n\ -end AverList\n\ -namespace AverMap\n\ -def get (m : Int) (k : Int) : Int :=\n\ - 0\n\ -end AverMap\n"; - let entry = "\ -namespace Program -\ -def addTwo (n : Int) : Int :=\n\ - n + 2\n\ -end Program\n"; - let info = super::ModelInfo::from_files(&[ - ("AverCommon.lean".to_string(), prelude.to_string()), - ( - "lakefile.lean".to_string(), - "roots := #[`Program, `AverCommon]\n".to_string(), - ), - ("Program.lean".to_string(), entry.to_string()), - ]); - - assert!( - info.module_prefix_flats.is_empty(), - "a program with no dependency modules must have no module prefixes, got {:?}", - info.module_prefix_flats - ); - assert!( - info.ambiguous.is_empty(), - "the prelude must not make any key ambiguous, got {:?}", - info.ambiguous - ); - for prelude_key in ["AverList_get", "AverMap_get", "String_charAtAv"] { - assert!( - !info.fns.contains_key(prelude_key), - "prelude def leaked into the flat key space as `{prelude_key}`" - ); - } - assert_eq!( - info.model_lean_name("addTwo").as_deref(), - Some("Program.addTwo"), - "an entry export resolves to its module-qualified Lean name" - ); - // The regression this guards: an export colliding with a prelude def's - // flattened key must still resolve, not decline as ambiguous. - assert_eq!( - info.model_lean_name("AverList_get").as_deref(), - Some("AverList_get"), - "a flat export must not be shadowed by a prelude namespace" - ); - } - - /// The bridge renderer needs a record's field ACCESSORS in declaration - /// order, and a parameterless def's return type. Neither may disturb - /// `model_lean_name`, whose resolution decides the certified set. - #[test] - fn structures_and_parameterless_defs_are_read_without_widening_model_names() { - // Written as one escaped literal on purpose: a `\`-continued Rust - // string eats the following line's indentation, and this parser reads - // exactly that indentation to find a structure's field lines. - let dep = concat!( - "namespace Domain.Rational\n", - "structure Fraction where\n", - " top : Int\n", - " bottom : Int\n", - "instance : Inhabited Fraction := mk\n", - "def zeroFraction : Fraction :=\n", - " { top := 0, bottom := 1 : Fraction }\n", - "def plus (a : Fraction) (b : Fraction) : Fraction :=\n", - " a\n", - "end Domain.Rational\n", - ); - let info = super::ModelInfo::from_files(&[ - ( - "AverCommon.lean".to_string(), - "def unrelated : Int := 0\n".to_string(), - ), - ("Domain/Rational.lean".to_string(), dep.to_string()), - ( - "lakefile.lean".to_string(), - "roots := #[`Main, `AverCommon]\n".to_string(), - ), - ]); - - let (qualified, record) = info - .resolve_structure("Domain.Rational", "Fraction") - .expect("the transpiled structure is read"); - assert_eq!(qualified, "Domain.Rational.Fraction"); - assert_eq!( - record.fields, - vec![ - ("top".to_string(), "Int".to_string()), - ("bottom".to_string(), "Int".to_string()), - ], - "fields must keep declaration order — it is the wasm packing order" - ); - - let nullary = info - .model_fn_sig("Domain_Rational_zeroFraction") - .expect("a parameterless def has a readable signature"); - assert!(nullary.params.is_empty()); - assert_eq!(nullary.ret, "Fraction"); - assert_eq!(nullary.lean_name, "Domain.Rational.zeroFraction"); - assert!(info.is_model_fn("Domain.Rational.zeroFraction")); - - // The regression this guards: reading parameterless defs must NOT make - // `model_lean_name` resolve a name it declined before, because that - // gate decides which exports survive certification. - assert_eq!( - info.model_lean_name("Domain_Rational_zeroFraction"), - None, - "a parameterless def must stay outside the model-citation name space" - ); - assert_eq!( - info.model_lean_name("Domain_Rational_plus").as_deref(), - Some("Domain.Rational.plus"), - ); - assert!(!info.nullary_is_ambiguous("Domain_Rational_zeroFraction")); - } - - /// A real dependency module DOES define the name space: its namespace is a - /// module prefix, and its functions resolve to their qualified names. - #[test] - fn dependency_module_namespaces_define_the_flat_key_space() { - let dep = "\ -namespace Nested.Deep.Util\n\ -def bump (n : Int) : Int :=\n\ - n + 2\n\ -end Nested.Deep.Util\n"; - let info = super::ModelInfo::from_files(&[ - ("AverCommon.lean".to_string(), "def unrelated : Int := 0\n".to_string()), - ("Nested/Deep/Util.lean".to_string(), dep.to_string()), - ]); - - assert_eq!(info.module_prefix_flats, vec!["Nested_Deep_Util".to_string()]); - assert_eq!( - info.model_lean_name("Nested_Deep_Util_bump").as_deref(), - Some("Nested.Deep.Util.bump"), - "a dependency-module export resolves to its qualified name" - ); - // Fail-closed: an export shaped like this module's prefix but with no - // parsed definition must NOT fall back to citing itself. - assert_eq!( - info.model_lean_name("Nested_Deep_Util_missing"), - None, - "an unresolvable dependency-shaped export must decline" - ); - } -} diff --git a/aver-cert/src/engine/module_envelope.rs b/aver-cert/src/engine/module_envelope.rs index ca8f27c77..fd206a753 100644 --- a/aver-cert/src/engine/module_envelope.rs +++ b/aver-cert/src/engine/module_envelope.rs @@ -1,4 +1,4 @@ -use std::collections::{BTreeMap, BTreeSet, VecDeque}; +use std::collections::VecDeque; #[derive(Clone, Debug, PartialEq, Eq)] pub struct ModuleExportFact { @@ -205,12 +205,12 @@ mod module_envelope_tests { ("WASIP2_CAPABILITY_REGISTRY", crate::format::WASIP2_CAPABILITIES), ] { let marker = format!("def {name} : List (String × String) := ["); - let body = super::CERT_SCHEMA_CORE + let body = super::CERT_SCHEMA_BASE .split_once(&marker) - .unwrap_or_else(|| panic!("SchemaCore is missing {name}")) + .unwrap_or_else(|| panic!("SchemaBase is missing {name}")) .1 .split_once("\n]") - .unwrap_or_else(|| panic!("SchemaCore.{name} is not a closed list")) + .unwrap_or_else(|| panic!("SchemaBase.{name} is not a closed list")) .0; let lean_pairs = body .lines() @@ -221,10 +221,10 @@ mod module_envelope_tests { let pair = row .strip_prefix("(\"") .and_then(|line| line.strip_suffix("\")")) - .unwrap_or_else(|| panic!("invalid SchemaCore.{name} row `{line}`")); + .unwrap_or_else(|| panic!("invalid SchemaBase.{name} row `{line}`")); let (module, field) = pair .split_once("\", \"") - .unwrap_or_else(|| panic!("invalid SchemaCore.{name} pair `{pair}`")); + .unwrap_or_else(|| panic!("invalid SchemaBase.{name} pair `{pair}`")); ( module.to_string(), field.to_string(), @@ -237,7 +237,7 @@ mod module_envelope_tests { .collect::>(); assert_eq!( lean_pairs, rust_pairs, - "SchemaCore.{name} must exactly match the Rust registry" + "SchemaBase.{name} must exactly match the Rust registry" ); } } @@ -249,6 +249,42 @@ mod module_envelope_tests { .expect("valid imported module") } + #[test] + fn work_v1_imports_are_admitted_exactly_and_only_on_wasm_gc() { + for field in ["submit", "take", "task", "complete"] { + let bytes = module_with_import("aver:work/v1", field); + let facts = super::collect_module_envelope_facts( + &bytes, + &[], + crate::format::TARGET_WASM_GC, + ) + .expect("the aver:work/v1 import is admitted on wasm-gc"); + assert_eq!(facts.capabilities, [("aver:work/v1".into(), field.into())]); + let error = super::collect_module_envelope_facts( + &bytes, + &[], + crate::format::TARGET_WASIP2, + ) + .expect_err("wasip2 has no aver:work/v1 imports"); + assert!(error.contains("target `wasip2`")); + } + for (module, field) in [ + ("aver:work/v2", "submit"), + ("aver:work/v1", "cancel"), + ("aver:work", "submit"), + ("aver", "submit"), + ] { + let bytes = module_with_import(module, field); + let error = super::collect_module_envelope_facts( + &bytes, + &[], + crate::format::TARGET_WASM_GC, + ) + .expect_err("a near-miss job import must fail closed"); + assert!(error.contains("target `wasm-gc`")); + } + } + #[test] fn wasip2_registry_accepts_only_the_exact_target_and_version() { let bytes = module_with_import("wasi:cli/stdout@0.2.4", "get-stdout"); diff --git a/aver-cert/src/engine/module_facts.rs b/aver-cert/src/engine/module_facts.rs new file mode 100644 index 000000000..30da5f7d6 --- /dev/null +++ b/aver-cert/src/engine/module_facts.rs @@ -0,0 +1,946 @@ +// ---- byte-derived module facts --------------------------------------------- +// +// Everything the producer reads off the exact module bytes: the type section +// (for the type-table self-check), function types, exports, every code entry +// (for the plan self-check and the closure), passive data segments, the Int +// carrier and the runtime helper roles. None of it is authority: the wall +// re-derives or pins every fact from `ArtifactBytes.modBytes`. + +/// A value type as the wall's decoder distinguishes it. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +enum ValT { + I32, + I64, + F64, + Eqref, + /// `(ref null idx)`, concrete. + RefNull(u32), + Other, +} + +/// A field storage type. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +enum StorT { + I8, + Val(ValT), + Other, +} + +#[derive(Clone, Debug, PartialEq, Eq)] +enum CompT { + Func(Vec, Vec), + Struct(Vec), + Array(StorT), +} + +#[derive(Clone, Debug)] +struct TypeFact { + comp: CompT, + is_final: bool, + supertype: Option, +} + +#[derive(Clone, Copy, PartialEq, Eq)] +enum HostOp { + LocalGet(u32), + LocalSet(u32), + I32Const(i32), + ArrayLen, + ArrayGetU(u32), + ArrayGet(u32), + ArrayNewDefault(u32), + ArrayCopy(u32, u32), + I32Ne, + I32GeU, + I32Add, + If, + Block, + Loop, + Br(u32), + BrIf(u32), + Return, + End, + Other, +} + +/// The first `i64` arithmetic operator of a helper body. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +enum FirstI64Arith { + Add, + Sub, + Mul, +} + +#[derive(Clone)] +struct CodeFact { + /// The exact code entry, size prefix included. + entry: Vec, + nlocals: usize, + calls: Vec, + host_ops: Vec, + first_arith: Option, + kernel_arith_scan: Option>, +} + +/// The runtime helper indices the subject declares (`CertDecode.AddSub.Roles` +/// plus the `ArithHostParams` the helper templates are synthesized from). +#[derive(Clone, Copy, Debug, Default, PartialEq, Eq)] +pub struct HostRoles { + pub box_idx: Option, + pub add_idx: Option, + pub mul_idx: Option, + pub sub_idx: Option, + pub to_index_idx: Option, + pub cmp_idx: Option, + pub eq_idx: Option, + /// `__aint_divmod`: not exported; declared only at the one function + /// whose body is the wall's template (`divmod_template_body`). + pub divmod_idx: Option, + pub limb_idx: Option, + pub decompose_idx: Option, + pub normalize_idx: Option, + pub strip_idx: Option, + pub umag_cmp_idx: Option, +} + +impl HostRoles { + /// `(carrier, limb, decompose, normalize, strip, umagCmp)` for a carriered + /// module, `None` for a carrierless one. + pub fn arith_params(&self, carrier: Option) -> Option<(u32, u32, u32, u32, u32, u32)> { + self.box_idx?; + Some(( + carrier?, + self.limb_idx?, + self.decompose_idx?, + self.normalize_idx?, + self.strip_idx?, + self.umag_cmp_idx?, + )) + } + + fn lean_option(index: Option) -> String { + index.map_or_else(|| "none".to_string(), |i| format!("some {i}")) + } + + /// The `CertDecode.AddSub.Roles` literal. + pub fn roles_lean_value(&self) -> String { + format!( + "({{ box := {}, add := {}, mul := {}, sub := {}, toIndex := {}, cmp := {}, eq := {}, divmod := {} }} : CertDecode.AddSub.Roles)", + Self::lean_option(self.box_idx), + Self::lean_option(self.add_idx), + Self::lean_option(self.mul_idx), + Self::lean_option(self.sub_idx), + Self::lean_option(self.to_index_idx), + Self::lean_option(self.cmp_idx), + Self::lean_option(self.eq_idx), + Self::lean_option(self.divmod_idx), + ) + } + + pub fn arith_params_record_lean(&self, carrier: Option) -> Option { + self.arith_params(carrier).map(|(carrier, limb, decompose, normalize, strip, umag)| { + format!( + "({{ carrier := {carrier}, limb := {limb}, decompose := {decompose}, normalize := {normalize}, strip := {strip}, umagCmp := {umag} }} : ArithTemplateDerisk.ArithHostParams)" + ) + }) + } +} + +/// `ArithTemplateDerisk.divmodTemplateBody`: hex literal bytes, and each +/// declared index as `` (unsigned LEB) or `` (signed heap +/// type). +const DIVMOD_TEMPLATE: &str = concat!( + "0b047e0163017f0163037f0263017f0263097f077e0163", + "2000fb0201d12001fb0201d1712000fb0200428080", + "808080808080807f512001fb0200427f5171457104632000fb02", + "0021032001fb02002104200320048121062006420053044020062004420053", + "047e420020047d0520040b7c21060b200204632006d04100fb0005", + "200320047f210520032004812106200642005304402004420055047e200542017d05200542017c0b2105", + "0b2005d04100fb000b0520001021082107200110", + "210a2109200710210b200910210c200b45047f410105200b0bfb", + "07210d200c41016afb07210e4100210f200c410146044020094100fb0b21", + "0442002106200b41016b21170240034020174100480d01200642208620072017fb0b84211c20", + "0d2017201c200480fb0e201c2004822106201741016b21170c000b0b200e41002006fb0e", + "0502402007200b2009200c10211920194100480440200e410020074100200bfb", + "110c010b200c41016b210f200b200f6b2115200e410020072015200ffb11", + "201541206c41016b21140240034020144100480d01200f200c49047f200f05200c0b41016a21", + "0f4200211b41002117024003402017200f4f0d01200e2017fb0b42018642ffffffff0f83201b", + "84211c200e2017fb0b421f88211b200e2017201cfb0e201741016a21170c000b0b20", + "1441206e21152014412070211620072015fb0b2016ad884201834200520440200e4100200e41", + "00fb0b420184fb0e0b02400340200f450d01200e200f41016bfb0b420052", + "0d01200f41016b210f0c000b0b200e200f2009200c102119201941004e04404200211d41", + "002117024003402017200c41016a4f0d01200e2017fb0b2017200c49047e20092017fb0b", + "0542000b7d201d7d211e201e4200530440201e4280808080107c211e4201211d054200211d0b", + "200e2017201e42ffffffff0f83fb0e201741016a21170c000b0b200d2015200d2015fb0b", + "42012016ad8684fb0e0b201441016b21140c000b0b0b0b200c41016a210f02400340", + "200f450d01200e200f41016bfb0b4200520d01200f41016b210f0c000b0b2008410048200f41", + "004771211a20020463201a0440200cfb0721104200211d410021170240034020", + "17200c4f0d0120092017fb0b2017200f49047e200e2017fb0b0542000b7d201d7d21", + "1e201e4200530440201e4280808080107c211e4201211d054200211d0b20102017201e42ffffffff0f83", + "fb0e201741016a21170c000b0b2010211105200e21110b410121122011201210", + "052008200a6c2112201a0440200b41016afb07211041002117024003402017", + "200b4f0d0120102017200d2017fb0bfb0e201741016a21170c000b0b4201211b4100", + "211702400340201b500d0120102017fb0b201b7c211c20102017201c42ffffffff0f83fb0e", + "201c422088211b201741016a21170c000b0b2010211105200d21110b2011201210", + "0b0b0b", +); + +/// The canonical `__aint_divmod` body (locals and code, no size prefix) over +/// the declared indices, exactly as the wall synthesizes it. +fn divmod_template_body(p: (u32, u32, u32, u32, u32, u32)) -> Option> { + let (carrier, limb, decompose, normalize, strip, umag_cmp) = p; + let mut out = Vec::new(); + let mut rest = DIVMOD_TEMPLATE; + while !rest.is_empty() { + if let Some(tail) = rest.strip_prefix('<') { + let (tok, after) = tail.split_once('>')?; + let (enc, name) = tok.split_once(':')?; + let v = u64::from(match name { + "carrier" => carrier, + "limb" => limb, + "decompose" => decompose, + "normalize" => normalize, + "strip" => strip, + "umagCmp" => umag_cmp, + _ => return None, + }); + match enc { + "u" => uleb(v, &mut out)?, + "s" => s33(v, &mut out)?, + _ => return None, + } + rest = after; + } else { + out.push(u8::from_str_radix(rest.get(..2)?, 16).ok()?); + rest = &rest[2..]; + } + } + Some(out) +} + +/// The body of a code entry: the bytes after its size prefix. +fn entry_body(entry: &[u8]) -> Option<&[u8]> { + let mut size = 0usize; + let mut shift = 0; + for (i, b) in entry.iter().enumerate() { + size |= usize::from(b & 0x7f) << shift; + shift += 7; + if b & 0x80 == 0 { + return entry.get(i + 1..i + 1 + size); + } + } + None +} + +/// A byte-exact String helper role. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum StringHostRole { + Eq, + Concat, +} + +impl StringHostRole { + fn lean_value(self) -> &'static str { + match self { + StringHostRole::Eq => ".eq", + StringHostRole::Concat => ".concat", + } + } + + fn manifest_value(self) -> &'static str { + match self { + StringHostRole::Eq => "stringEq", + StringHostRole::Concat => "stringConcat", + } + } +} + +pub type StringHostRoles = Vec<(u32, StringHostRole)>; + +struct ModuleFacts { + nimports: u32, + types: Vec, + /// Entries of the explicit rec group that opens the type section. + first_group_len: usize, + func_types: Vec, + exports: Vec<(String, u8, u32)>, + code: Vec, + /// Passive data segments by index (`None` for an active one). + data: Vec>>, + carrier: Option, + roles: HostRoles, + string_roles: StringHostRoles, +} + +fn val_t(vt: &wasmparser::ValType) -> ValT { + use wasmparser::{AbstractHeapType, HeapType, ValType}; + match vt { + ValType::I32 => ValT::I32, + ValType::I64 => ValT::I64, + ValType::F64 => ValT::F64, + ValType::Ref(rt) if rt.is_nullable() => match rt.heap_type() { + HeapType::Concrete(idx) => idx.as_module_index().map_or(ValT::Other, ValT::RefNull), + HeapType::Abstract { + shared: false, + ty: AbstractHeapType::Eq, + } => ValT::Eqref, + _ => ValT::Other, + }, + _ => ValT::Other, + } +} + +fn stor_t(st: &wasmparser::StorageType) -> StorT { + match st { + wasmparser::StorageType::I8 => StorT::I8, + wasmparser::StorageType::Val(v) => StorT::Val(val_t(v)), + wasmparser::StorageType::I16 => StorT::Other, + } +} + +fn host_op(op: &wasmparser::Operator<'_>) -> HostOp { + use wasmparser::Operator as O; + match op { + O::LocalGet { local_index } => HostOp::LocalGet(*local_index), + O::LocalSet { local_index } => HostOp::LocalSet(*local_index), + O::I32Const { value } => HostOp::I32Const(*value), + O::ArrayLen => HostOp::ArrayLen, + O::ArrayGetU { array_type_index } => HostOp::ArrayGetU(*array_type_index), + O::ArrayGet { array_type_index } => HostOp::ArrayGet(*array_type_index), + O::ArrayNewDefault { array_type_index } => HostOp::ArrayNewDefault(*array_type_index), + O::ArrayCopy { + array_type_index_dst, + array_type_index_src, + } => HostOp::ArrayCopy(*array_type_index_dst, *array_type_index_src), + O::I32Ne => HostOp::I32Ne, + O::I32GeU => HostOp::I32GeU, + O::I32Add => HostOp::I32Add, + O::If { .. } => HostOp::If, + O::Block { .. } => HostOp::Block, + O::Loop { .. } => HostOp::Loop, + O::Br { relative_depth } => HostOp::Br(*relative_depth), + O::BrIf { relative_depth } => HostOp::BrIf(*relative_depth), + O::Return => HostOp::Return, + O::End => HostOp::End, + _ => HostOp::Other, + } +} + +/// Byte-for-byte mirror of the certificate decoder's first-arith body scan +/// (`CertDecode.AddSub`): `None` when the decoder's scan would fail. +fn kernel_first_arith_scan(bytes: &[u8]) -> Option> { + fn skip_uleb(bytes: &[u8], cursor: &mut usize) -> Option { + let mut value: u64 = 0; + let mut shift: u32 = 0; + for _ in 0..5 { + let byte = *bytes.get(*cursor)?; + *cursor += 1; + value |= u64::from(byte & 0x7f) << shift; + if byte < 128 { + if shift != 0 && byte == 0 { + return None; + } + return Some(value); + } + shift += 7; + } + None + } + fn skip_sleb(bytes: &[u8], cursor: &mut usize) -> Option<()> { + for _ in 0..10 { + let byte = *bytes.get(*cursor)?; + *cursor += 1; + if byte < 128 { + return Some(()); + } + } + None + } + fn skip_block_type(bytes: &[u8], cursor: &mut usize) -> Option<()> { + let byte = *bytes.get(*cursor)?; + if byte == 0x40 || matches!(byte, 0x7b..=0x7f) { + *cursor += 1; + Some(()) + } else if byte == 0x63 || byte == 0x64 { + *cursor += 1; + skip_sleb(bytes, cursor) + } else { + skip_sleb(bytes, cursor) + } + } + let mut cursor = 0usize; + loop { + if cursor == bytes.len() { + return Some(None); + } + let op = bytes[cursor]; + cursor += 1; + match op { + 0x7c => return Some(Some(FirstI64Arith::Add)), + 0x7d => return Some(Some(FirstI64Arith::Sub)), + 0x7e => return Some(Some(FirstI64Arith::Mul)), + 0x45..=0xc4 => {} + 0x0b | 0x05 | 0x0f | 0x00 | 0x01 | 0x1a | 0x1b | 0xd1 => {} + 0x20 | 0x21 | 0x22 | 0x23 | 0x24 | 0x0c | 0x0d | 0x10 | 0x12 => { + skip_uleb(bytes, &mut cursor)?; + } + 0x0e => { + let count = skip_uleb(bytes, &mut cursor)?; + for _ in 0..count.checked_add(1)? { + skip_uleb(bytes, &mut cursor)?; + } + } + 0x11 => { + skip_uleb(bytes, &mut cursor)?; + skip_uleb(bytes, &mut cursor)?; + } + 0x02..=0x04 => skip_block_type(bytes, &mut cursor)?, + 0x41 | 0x42 => skip_sleb(bytes, &mut cursor)?, + 0x43 => { + if bytes.len() - cursor < 4 { + return None; + } + cursor += 4; + } + 0x44 => { + if bytes.len() - cursor < 8 { + return None; + } + cursor += 8; + } + 0xd0 => skip_sleb(bytes, &mut cursor)?, + 0xd2 => { + skip_uleb(bytes, &mut cursor)?; + } + 0xfb => { + let sub = skip_uleb(bytes, &mut cursor)?; + match sub { + 0x00 | 0x01 | 0x06 | 0x07 | 0x0b | 0x0c | 0x0d | 0x0e => { + skip_uleb(bytes, &mut cursor)?; + } + 0x02 | 0x05 | 0x08 | 0x09 => { + skip_uleb(bytes, &mut cursor)?; + skip_uleb(bytes, &mut cursor)?; + } + 0x0f => {} + 0x14..=0x17 => skip_sleb(bytes, &mut cursor)?, + _ => return None, + } + } + _ => return None, + } + } +} + +/// `__wasmgc_string_eq`, by its byte-exact opcode shape (the wall classifies +/// the same shape in `CertDecode.StringHost`). +fn is_string_eq_host( + code: &CodeFact, + sig: &CompT, + strings: &std::collections::HashSet, +) -> bool { + let CompT::Func(params, results) = sig else { + return false; + }; + let [ValT::RefNull(lhs), ValT::RefNull(rhs)] = params.as_slice() else { + return false; + }; + if lhs != rhs + || results.as_slice() != [ValT::I32] + || code.nlocals != 2 + || !code.calls.is_empty() + { + return false; + } + let t = *lhs; + if !strings.contains(&t) { + return false; + } + use HostOp::*; + let expected = [ + LocalGet(0), + ArrayLen, + LocalGet(1), + ArrayLen, + I32Ne, + If, + I32Const(0), + Return, + End, + LocalGet(0), + ArrayLen, + LocalSet(2), + I32Const(0), + LocalSet(3), + Block, + Loop, + LocalGet(3), + LocalGet(2), + I32GeU, + BrIf(1), + LocalGet(0), + LocalGet(3), + ArrayGetU(t), + LocalGet(1), + LocalGet(3), + ArrayGetU(t), + I32Ne, + If, + I32Const(0), + Return, + End, + LocalGet(3), + I32Const(1), + I32Add, + LocalSet(3), + Br(0), + End, + End, + I32Const(1), + End, + ]; + code.host_ops.as_slice() == expected +} + +/// `__wasmgc_concat_n`, by its byte-exact opcode shape. +fn is_string_concat_host( + code: &CodeFact, + sig: &CompT, + strings: &std::collections::HashSet, +) -> bool { + let CompT::Func(params, results) = sig else { + return false; + }; + let [ValT::RefNull(container)] = params.as_slice() else { + return false; + }; + let [ValT::RefNull(byte)] = results.as_slice() else { + return false; + }; + if code.nlocals != 7 || !code.calls.is_empty() || !strings.contains(byte) { + return false; + } + let (container, byte) = (*container, *byte); + use HostOp::*; + let expected = [ + LocalGet(0), + ArrayLen, + LocalSet(3), + I32Const(0), + LocalSet(1), + I32Const(0), + LocalSet(2), + Block, + Loop, + LocalGet(2), + LocalGet(3), + I32GeU, + BrIf(1), + LocalGet(1), + LocalGet(0), + LocalGet(2), + ArrayGet(container), + ArrayLen, + I32Add, + LocalSet(1), + LocalGet(2), + I32Const(1), + I32Add, + LocalSet(2), + Br(0), + End, + End, + LocalGet(1), + ArrayNewDefault(byte), + LocalSet(6), + I32Const(0), + LocalSet(7), + I32Const(0), + LocalSet(2), + Block, + Loop, + LocalGet(2), + LocalGet(3), + I32GeU, + BrIf(1), + LocalGet(0), + LocalGet(2), + ArrayGet(container), + LocalSet(4), + LocalGet(4), + ArrayLen, + LocalSet(5), + LocalGet(6), + LocalGet(7), + LocalGet(4), + I32Const(0), + LocalGet(5), + ArrayCopy(byte, byte), + LocalGet(7), + LocalGet(5), + I32Add, + LocalSet(7), + LocalGet(2), + I32Const(1), + I32Add, + LocalSet(2), + Br(0), + End, + End, + LocalGet(6), + End, + ]; + code.host_ops.as_slice() == expected +} + +impl ModuleFacts { + fn parse(wasm_bytes: &[u8]) -> Result { + use wasmparser::{CompositeInnerType, DataKind, Operator, Parser, Payload}; + + wasmparser::Validator::new() + .validate_all(wasm_bytes) + .map_err(|e| format!("wasm module failed validation: {e}"))?; + + let mut facts = ModuleFacts { + nimports: 0, + types: Vec::new(), + first_group_len: 0, + func_types: Vec::new(), + exports: Vec::new(), + code: Vec::new(), + data: Vec::new(), + carrier: None, + roles: HostRoles::default(), + string_roles: Vec::new(), + }; + let mut has_non_function_import = false; + let mut next_entry_start: Option = None; + let mut first_group = true; + let mut limb = None; + for payload in Parser::new(0).parse_all(wasm_bytes) { + match payload.map_err(|e| format!("wasm parse: {e}"))? { + Payload::TypeSection(reader) => { + for rg in reader { + let rg = rg.map_err(|e| format!("type read: {e}"))?; + let explicit = rg.is_explicit_rec_group(); + let mut count = 0usize; + for sub in rg.into_types() { + count += 1; + let idx = facts.types.len() as u32; + let comp = match &sub.composite_type.inner { + CompositeInnerType::Func(ft) => CompT::Func( + ft.params().iter().map(val_t).collect(), + ft.results().iter().map(val_t).collect(), + ), + CompositeInnerType::Struct(st) => CompT::Struct( + st.fields.iter().map(|f| stor_t(&f.element_type)).collect(), + ), + CompositeInnerType::Array(at) => { + CompT::Array(stor_t(&at.0.element_type)) + } + _ => CompT::Array(StorT::Other), + }; + if let CompT::Struct(fields) = &comp + && facts.carrier.is_none() + && fields.len() == 3 + && fields[0] == StorT::Val(ValT::I64) + && fields[2] == StorT::Val(ValT::I32) + { + facts.carrier = Some(idx); + if let StorT::Val(ValT::RefNull(l)) = fields[1] { + limb = Some(l); + } + } + facts.types.push(TypeFact { + comp, + is_final: sub.is_final, + supertype: sub.supertype_idx.and_then(|p| p.as_module_index()), + }); + } + if first_group { + first_group = false; + if explicit { + facts.first_group_len = count; + } + } + } + } + Payload::ImportSection(reader) => { + for group in reader { + let group = group.map_err(|e| format!("import read: {e}"))?; + for imp in group { + let (_, imp) = imp.map_err(|e| format!("import read: {e}"))?; + if let wasmparser::TypeRef::Func(_) = imp.ty { + facts.nimports += 1; + } else { + has_non_function_import = true; + } + } + } + } + Payload::FunctionSection(reader) => { + for t in reader { + facts + .func_types + .push(t.map_err(|e| format!("func read: {e}"))?); + } + } + Payload::ExportSection(reader) => { + for ex in reader { + let ex = ex.map_err(|e| format!("export read: {e}"))?; + facts.exports.push(( + ex.name.to_string(), + external_kind_byte(ex.kind), + ex.index, + )); + } + } + Payload::CodeSectionStart { range, size, .. } => { + next_entry_start = Some( + range + .end + .checked_sub(size as usize) + .ok_or("code section size is outside its byte range")?, + ); + } + Payload::CodeSectionEntry(body) => { + let start = next_entry_start.ok_or("code entry before code section start")?; + let end = body.range().end; + let entry = wasm_bytes + .get(start..end) + .ok_or("code entry outside the module")? + .to_vec(); + next_entry_start = Some(end); + let mut nlocals = 0usize; + let mut lr = body + .get_locals_reader() + .map_err(|e| format!("locals: {e}"))?; + for _ in 0..lr.get_count() { + let (n, _) = lr.read().map_err(|e| format!("locals: {e}"))?; + nlocals += n as usize; + } + let mut opr = body + .get_operators_reader() + .map_err(|e| format!("ops: {e}"))?; + let scan_start = opr.original_position(); + let kernel_arith_scan = wasm_bytes + .get(scan_start..end) + .and_then(kernel_first_arith_scan); + let mut calls = Vec::new(); + let mut host_ops = Vec::new(); + let mut first_arith = None; + while !opr.eof() { + let op = opr.read().map_err(|e| format!("op read: {e}"))?; + host_ops.push(host_op(&op)); + match op { + Operator::Call { function_index } + | Operator::ReturnCall { function_index } => calls.push(function_index), + Operator::I64Add => { + first_arith.get_or_insert(FirstI64Arith::Add); + } + Operator::I64Sub => { + first_arith.get_or_insert(FirstI64Arith::Sub); + } + Operator::I64Mul => { + first_arith.get_or_insert(FirstI64Arith::Mul); + } + _ => {} + } + } + facts.code.push(CodeFact { + entry, + nlocals, + calls, + host_ops, + first_arith, + kernel_arith_scan, + }); + } + Payload::DataSection(reader) => { + for data in reader { + let data = data.map_err(|e| format!("data read: {e}"))?; + facts.data.push(match data.kind { + DataKind::Passive => Some(data.data.to_vec()), + DataKind::Active { .. } => None, + }); + } + } + _ => {} + } + } + facts.derive_roles(limb, has_non_function_import)?; + Ok(facts) + } + + fn export_idx(&self, name: &str) -> Option { + self.exports + .iter() + .find(|(n, kind, _)| n == name && *kind == 0) + .map(|(_, _, i)| *i) + } + + fn fn_sig(&self, func_idx: u32) -> Option<&CompT> { + let def = func_idx.checked_sub(self.nimports)? as usize; + let ty = *self.func_types.get(def)?; + Some(&self.types.get(ty as usize)?.comp) + } + + fn code_of(&self, func_idx: u32) -> Option<&CodeFact> { + self.code.get(func_idx.checked_sub(self.nimports)? as usize) + } + + /// The runtime helper roles, derived exactly as the wall's decoders and + /// template pins read them. A module whose role table the wall cannot + /// resolve is refused here, naming the reason. + fn derive_roles( + &mut self, + limb: Option, + has_non_function_import: bool, + ) -> Result<(), String> { + let box_idx = self.export_idx("__rt_aint_from_i64"); + let carrier = self.carrier; + let is_carrier_binop = |this: &Self, func_idx: u32| -> bool { + let (Some(c), Some(CompT::Func(params, results))) = (carrier, this.fn_sig(func_idx)) + else { + return false; + }; + params.as_slice() == [ValT::RefNull(c), ValT::RefNull(c)] + && results.as_slice() == [ValT::RefNull(c)] + }; + if box_idx.is_some() { + if carrier.is_none() { + return Err("module exports the Int box helper `__rt_aint_from_i64` but declares no Int carrier struct type; the certificate decoder cannot resolve its host-role table".into()); + } + if has_non_function_import { + return Err("module exports the Int box helper `__rt_aint_from_i64` and also declares a non-function import; the certificate decoder declines such modules".into()); + } + for (def, code) in self.code.iter().enumerate() { + let func_idx = self.nimports + def as u32; + if !is_carrier_binop(self, func_idx) { + continue; + } + match code.kernel_arith_scan { + Some(first) if first == code.first_arith => {} + _ => { + return Err(format!( + "function index {func_idx} has the Int carrier-binop signature and a body the certificate decoder's role scan cannot classify; the module-wide host-role table is undecodable" + )); + } + } + } + } + let unique = |arith: FirstI64Arith| -> Option { + let hits: Vec = self + .code + .iter() + .enumerate() + .map(|(def, code)| (self.nimports + def as u32, code)) + .filter(|(idx, code)| { + code.first_arith == Some(arith) && is_carrier_binop(self, *idx) + }) + .map(|(idx, _)| idx) + .collect(); + match hits.as_slice() { + [only] => Some(*only), + _ => None, + } + }; + let add_idx = unique(FirstI64Arith::Add); + let mut roles = HostRoles { + box_idx, + add_idx, + mul_idx: unique(FirstI64Arith::Mul), + sub_idx: unique(FirstI64Arith::Sub), + to_index_idx: self.export_idx("__aint_to_index"), + cmp_idx: self.export_idx("__aint_cmp"), + eq_idx: self.export_idx("__aint_eq"), + limb_idx: limb, + ..HostRoles::default() + }; + // The add helper calls the four bignum sub-routines; bucket its + // callees by signature. The wall template-pins every index. + if let Some(code) = add_idx.and_then(|i| self.code_of(i)) { + let mut seen = std::collections::HashSet::new(); + for &callee in &code.calls { + if !seen.insert(callee) { + continue; + } + if let Some(CompT::Func(params, results)) = self.fn_sig(callee) { + match (params.len(), results.len()) { + (1, 2) => roles.decompose_idx = roles.decompose_idx.or(Some(callee)), + (2, 1) => roles.normalize_idx = roles.normalize_idx.or(Some(callee)), + (1, 1) => roles.strip_idx = roles.strip_idx.or(Some(callee)), + (4, _) => roles.umag_cmp_idx = roles.umag_cmp_idx.or(Some(callee)), + _ => {} + } + } + } + } + // A range-refined user function whose raw `i64` body happens to open + // with the same operator shares the carrier-binop signature, and then + // the scan above finds no unique helper. The helper is the candidate + // that calls the bignum sub-routines (the template pins the choice). + if let Some(decompose) = roles.decompose_idx { + let calling = |arith: FirstI64Arith| -> Option { + let hits: Vec = self + .code + .iter() + .enumerate() + .map(|(def, code)| (self.nimports + def as u32, code)) + .filter(|(idx, code)| { + code.first_arith == Some(arith) + && is_carrier_binop(self, *idx) + && code.calls.contains(&decompose) + }) + .map(|(idx, _)| idx) + .collect(); + match hits.as_slice() { + [only] => Some(*only), + _ => None, + } + }; + if roles.sub_idx.is_none() { + roles.sub_idx = calling(FirstI64Arith::Sub); + } + if roles.mul_idx.is_none() { + roles.mul_idx = calling(FirstI64Arith::Mul); + } + } + // `__aint_divmod` is not exported: declare it only at the one function + // whose body is the template the wall pins it by. + if let Some(tmpl) = roles.arith_params(carrier).and_then(divmod_template_body) { + let hits: Vec = self + .code + .iter() + .enumerate() + .filter(|(_, code)| entry_body(&code.entry) == Some(tmpl.as_slice())) + .map(|(def, _)| self.nimports + def as u32) + .collect(); + if let [only] = hits.as_slice() { + roles.divmod_idx = Some(*only); + } + } + self.roles = roles; + let strings: std::collections::HashSet = self + .types + .iter() + .enumerate() + .filter(|(_, t)| t.comp == CompT::Array(StorT::I8)) + .map(|(i, _)| i as u32) + .collect(); + let mut string_roles = Vec::new(); + for (def, code) in self.code.iter().enumerate() { + let func_idx = self.nimports + def as u32; + let Some(sig) = self.fn_sig(func_idx) else { + continue; + }; + if is_string_eq_host(code, sig, &strings) { + string_roles.push((func_idx, StringHostRole::Eq)); + } else if is_string_concat_host(code, sig, &strings) { + string_roles.push((func_idx, StringHostRole::Concat)); + } + } + self.string_roles = string_roles; + Ok(()) + } +} diff --git a/aver-cert/src/engine/mutual_plan_defs.rs b/aver-cert/src/engine/mutual_plan_defs.rs deleted file mode 100644 index 0e2f619eb..000000000 --- a/aver-cert/src/engine/mutual_plan_defs.rs +++ /dev/null @@ -1,229 +0,0 @@ -// Byte-first `mutual-plan-v1` plan builder. -// -// One member of a mutually-recursive SCC reconstructs losslessly from the -// byte-derived `Cert::MutualRecursion` holes into the same ANF `FragBlock` -// grammar the recursion plan uses, generalising the `selfCall` node to a TAIL -// member-call whose target is a SIBLING member of the SCC. The plan lowers, -// byte-for-byte, to that member's emitted code entry inside the SCC's shared -// code table; it carries no source-level meaning and never changes the -// conjunction fuel-induction proof face — it only moves the member body's -// byte-origin into hash-pinned Lean. Reuses the recursion plan's shared sign -// predicate and base-arm block builders. - -/// The mutual step arm `n - 1; g(n-1)`: `local.get 0; i64.const 1; box; sub; -/// return_call cross`. Identical to the recursion descent-self except the call -/// is a TAIL call to the SCC sibling `cross_idx`, not a non-tail self-call. -fn mut_step_block(box_idx: u32, sub_idx: u32, cross_idx: u32) -> FragBlock { - let mut b = RecBlockBuilder::new(); - let n = b.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let one = b.push(FragTy::I64, FragNodeKind::ConstI64(1)); - let boxed = b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: box_idx, - args: vec![one], - }, - ); - let dec = b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Sub, - func_idx: sub_idx, - args: vec![n, boxed], - }, - ); - let call = b.push( - FragTy::IntCarrier, - FragNodeKind::SelfCall { - tail: true, - func_idx: cross_idx, - args: vec![dec], - }, - ); - b.finish(call) -} - -/// Full plan for one mutual-recursion member `f n = if n≤0 then base else -/// g(n-1)` (a tail cross-call to the next SCC member). Arity 1. -fn mutual_member_plan(box_idx: u32, sub_idx: u32, base_k: i64, cross_idx: u32) -> ExprFragmentPlan { - let mut top = RecBlockBuilder::new(); - let sign = rec_push_sign_predicate(&mut top); - let value = top.push( - FragTy::IntCarrier, - FragNodeKind::If { - cond: sign, - then_block: Box::new(rec_base_const_block(base_k, box_idx)), - else_block: Box::new(mut_step_block(box_idx, sub_idx, cross_idx)), - }, - ); - ExprFragmentPlan { - params: vec![FragTy::IntCarrier], - result: FragTy::IntCarrier, - body: top.finish(value), - } -} - -/// Build the byte-first `mutual-plan-v1` plan for THIS member of a mutual- -/// recursion cert (the member at `position` in the byte-derived SCC). Returns -/// `None` for any other class, and — fail-closed — for a certified member whose -/// REAL code entry does not equal the canonical plan lowering (a member body -/// byte-noisier than the canonical template stays on the legacy witness route; -/// an artifact must never carry a byte-origin claim its own bytes cannot prove). -fn mutual_plan_from_cert(c: &Cert) -> Option { - let Cert::MutualRecursion { - carrier, - box_idx, - sub_idx, - position, - scc, - .. - } = c.inner() - else { - return None; - }; - let m = scc.get(*position)?; - let plan = mutual_member_plan(*box_idx, *sub_idx, m.base_k, m.cross_idx); - let lowered = lower_expr_fragment_plan_code_entry_bytes(&plan, *carrier).ok()?; - if lowered != m.code_entry_bytes { - return None; - } - Some(plan) -} - -/// The per-member byte-derived host-role table a mutual claim carries: the box -/// helper and the strict `sub` helper the SCC's shared host wires (no -/// combinator — mutual members never combine, they tail-call). Rendered -/// identically by producer and verifier so the artifact data pin stays exact. -fn mutual_host_table_lean_value(box_idx: u32, sub_idx: u32) -> String { - format!("[(.box, {box_idx}), (.sub, {sub_idx})]") -} - -/// The byte-derived SCC member-index set (each member's `self_idx`, in the -/// sorted SCC order) as the Lean `List Nat` literal the mutual claim threads as -/// the member-call binding context. -fn mutual_member_set_lean_value(scc: &[MutualMember]) -> String { - format!( - "[{}]", - scc.iter() - .map(|m| m.self_idx.to_string()) - .collect::>() - .join(", ") - ) -} - -/// The Lean `MutualRawPlan` literal for a byte-first mutual member plan (profile -/// `mutual-plan-v1`; reuses the shared block/node renderers). -fn mutual_plan_lean_value(plan: &ExprFragmentPlan) -> String { - format!( - "{{ profile := \"mutual-plan-v1\", params := [{}], result := {}, body := {} }}", - plan.params - .iter() - .map(|ty| ty.lean_plan_ctor()) - .collect::>() - .join(", "), - plan.result.lean_plan_ctor(), - expr_fragment_block_lean_value(&plan.body) - ) -} - -#[cfg(test)] -mod mutual_plan_gate_tests { - use super::*; - - /// A canonical k=2 mutual cert (the `isEven`/`isOdd` shape from `mutual.av`: - /// box=7, sub=9, carrier=2; isEven self 1 base 1 cross→2, isOdd self 2 base - /// 0 cross→1) whose members carry either their exact canonical plan bytes - /// (the honest case) or a byte-noisy variant, to prove the byte-equality - /// gate fail-closes a member whose canonical plan cannot reproduce its bytes. - fn mutual_cert(position: usize, member_bytes: Vec>) -> Cert { - let scc = vec![ - MutualMember { - name: "isEven".to_string(), - self_idx: 1, - type_idx: 4, - nlocals: 1, - base_k: 1, - cross_idx: 2, - code_entry_bytes: member_bytes[0].clone(), - }, - MutualMember { - name: "isOdd".to_string(), - self_idx: 2, - type_idx: 4, - nlocals: 1, - base_k: 0, - cross_idx: 1, - code_entry_bytes: member_bytes[1].clone(), - }, - ]; - Cert::MutualRecursion { - name: scc[position].name.clone(), - self_idx: scc[position].self_idx, - carrier: 2, - box_idx: 7, - sub_idx: 9, - position, - scc, - } - } - - #[test] - fn mutual_plan_requires_exact_code_entry_bytes() { - let even_plan = mutual_member_plan(7, 9, 1, 2); - let odd_plan = mutual_member_plan(7, 9, 0, 1); - let even_bytes = - lower_expr_fragment_plan_code_entry_bytes(&even_plan, 2).expect("isEven lowering"); - let odd_bytes = - lower_expr_fragment_plan_code_entry_bytes(&odd_plan, 2).expect("isOdd lowering"); - - // Honest members: bytes equal the canonical lowering -> plan emitted. - assert!( - mutual_plan_from_cert(&mutual_cert(0, vec![even_bytes.clone(), odd_bytes.clone()])) - .is_some(), - "byte-exact isEven member must carry a plan claim" - ); - assert!( - mutual_plan_from_cert(&mutual_cert(1, vec![even_bytes.clone(), odd_bytes.clone()])) - .is_some(), - "byte-exact isOdd member must carry a plan claim" - ); - - // The canonical member bytes decode to the pinned mutual template: base - // `42 10 07`, step `20 00 42 01 10 07 10 09 12 `. - assert!( - even_bytes.windows(2).any(|w| w == [0x12, 0x02]), - "isEven step tail must be return_call isOdd (2): {even_bytes:02x?}" - ); - assert!( - odd_bytes.windows(2).any(|w| w == [0x12, 0x01]), - "isOdd step tail must be return_call isEven (1): {odd_bytes:02x?}" - ); - - // Byte-noisy member: an extra scratch local classifies identically but - // its raw bytes differ -> NO plan claim; certification declines, fail-closed. - let mut noisy = even_bytes.clone(); - noisy.push(0x00); - noisy[0] += 1; - assert!( - mutual_plan_from_cert(&mutual_cert(0, vec![noisy, odd_bytes])).is_none(), - "a member the canonical plan cannot reproduce must not carry a claim" - ); - } - - #[test] - fn mutual_total_promotion_is_atomic_per_scc() { - for position in 0..2 { - let mut cert = mutual_cert(position, vec![Vec::new(), Vec::new()]); - let Cert::MutualRecursion { scc, .. } = &mut cert else { - unreachable!() - }; - // One member no longer belongs to the closed descent cycle. Even - // when inspecting the untouched sibling export, the shared SCC - // fails eligibility and no per-member witness can be attached. - scc[0].cross_idx = 99; - assert_eq!(cert.termination_witness(), None); - assert_eq!(cert.policy(), CertificationPolicy::SimulatesModel); - } - } -} diff --git a/aver-cert/src/engine/plan.rs b/aver-cert/src/engine/plan.rs new file mode 100644 index 000000000..d94a48753 --- /dev/null +++ b/aver-cert/src/engine/plan.rs @@ -0,0 +1,768 @@ +// ---- the one-grammar plan (schema 9) -------------------------------------- +// +// A Rust mirror of `Grammar.lean`: the plan IS the optimized MIR function +// body, printed 1:1 by the compiler (`src/codegen/cert/plan_from_mir.rs`). +// This file only holds the data and its Lean rendering; nothing here decides +// anything the wall does not re-derive. + +/// `Grammar.Ty`. +#[derive(Clone, Debug, PartialEq, Eq, Hash, PartialOrd, Ord)] +pub enum PlanTy { + Int, + Bool, + Record(u32), + Sum(u32), + Option(Box), + Result(Box, Box), + Eqref, + Float, + Str, + Vec(Box), + List(Box), + Opaque(u32), +} + +/// `Grammar.Lit`. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum PlanLit { + Int(i64), + Bool(bool), + Float(u64), + Str(Vec), +} + +/// `Grammar.BinOp` (`ast::BinOp` without `Div`). +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum PlanBinOp { + Add, + Sub, + Mul, + Eq, + Neq, + Lt, + Gt, + Lte, + Gte, +} + +/// `Grammar.Builtin`. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum PlanBuiltin { + BoolAnd, + BoolOr, + BoolNot, + ListPrepend, + VecGet, + /// `Int.div` / `Int.mod`, admitted only fused under `Result.withDefault` + /// with an Int literal default. + IntDiv, + IntMod, +} + +/// `Grammar.Intrinsic`: the resolver's Euclidean discharge of `Int.div` / +/// `Int.mod` by a nonzero literal divisor. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum PlanIntrinsic { + IntDivEuclid, + IntModEuclid, +} + +/// `Grammar.LazyBuiltin`. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum PlanLazy { + OptWithDefault, + ResWithDefault, +} + +/// `Grammar.MirCallee`; `Fn` carries the callee's wasm function index. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum PlanCallee { + Fn(u32), + Builtin(PlanBuiltin), + Lazy(PlanLazy), + Intrinsic(PlanIntrinsic), +} + +/// `Grammar.CtorTag`. +#[derive(Clone, Copy, Debug, PartialEq, Eq)] +pub enum PlanCtor { + User(u32, u32), + Some, + None, + Ok, + Err, +} + +/// The resolver's slot for an ignored binder (`Grammar.noSlot`). +pub const PLAN_NO_SLOT: u32 = 65535; + +/// `Grammar.Pat`. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum PlanPat { + Wild, + LitInt(i64), + LitBool(bool), + Bind(u32), + Ctor(PlanCtor, Vec), + LitStr(Vec), + Tuple(Vec), +} + +/// `Grammar.Expr`; `Match` arms are `Grammar.Arms` in source order. +#[derive(Clone, Debug, PartialEq, Eq)] +pub enum PlanExpr { + Literal(PlanLit), + Local(u32), + Let(u32, Box, Box), + Call(PlanCallee, Vec), + TailCall(u32, Vec), + BinOp(PlanBinOp, Box, Box), + Neg(Box), + If(Box, Box, Box), + RecordCreate(u32, Vec), + Project(u32, u32, Box), + Match(Box, Vec<(PlanPat, PlanExpr)>), + Construct(PlanCtor, PlanTy, Vec), + Interp(Vec), + List(PlanTy, Vec), +} + +/// `Grammar.FnPlan`. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct FnPlan { + pub params: Vec, + pub ret: PlanTy, + /// Resolver slot count (parameters and every binder). + pub nslots: u32, + /// Declared locals past the parameters, as the emitter declares them. + pub locals: Vec, + pub body: PlanExpr, +} + +/// `Schema.RecordDecl`. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct PlanRecordDecl { + pub tid: u32, + pub struct_idx: u32, + pub fields: Vec, +} + +/// `Schema.SumDecl`. +#[derive(Clone, Debug, PartialEq, Eq)] +pub struct PlanSumDecl { + pub tid: u32, + pub root: u32, + pub ctors: Vec<(u32, Vec)>, +} + +/// `Schema.TypeTable`: declared layout, confirmed by the wall against the +/// type and data sections. +#[derive(Clone, Debug, Default, PartialEq, Eq)] +pub struct PlanTypeTable { + pub carrier: Option, + pub mag: Option, + pub str_: Option, + pub str_vec: Option, + pub records: Vec, + pub sums: Vec, + pub options: Vec<(PlanTy, u32)>, + pub results: Vec<(PlanTy, PlanTy, u32)>, + pub vecs: Vec<(PlanTy, u32)>, + pub lists: Vec<(PlanTy, u32)>, + pub opaques: Vec<(u32, u32)>, + pub str_segs: Vec<(Vec, u32)>, +} + +/// One user function as the compiler printed it: its wasm function index, its +/// source name (diagnostics only), and its plan or the reason it has none. +#[derive(Clone, Debug)] +pub struct PlannedFn { + pub name: String, + pub func_idx: u32, + pub plan: Result, +} + +/// Everything the compiler hands the certificate producer: one entry per +/// emitted user function, the type table the plans' type ids refer to, and +/// the `__aint_eq` helper's function index (the helper is pinned by template, +/// so the index is producer data the wall confirms). +#[derive(Clone, Debug, Default)] +pub struct ModulePlans { + pub fns: Vec, + pub types: PlanTypeTable, + pub aint_eq_idx: Option, +} + +// ---- Lean rendering --------------------------------------------------------- + +fn lean_nat_list(xs: &[u32]) -> String { + format!( + "[{}]", + xs.iter().map(u32::to_string).collect::>().join(", ") + ) +} + +fn lean_bytes(xs: &[u8]) -> String { + format!( + "[{}]", + xs.iter().map(u8::to_string).collect::>().join(", ") + ) +} + +fn lean_int(k: i64) -> String { + if k < 0 { + format!("({k})") + } else { + k.to_string() + } +} + +impl PlanTy { + pub fn lean(&self) -> String { + match self { + PlanTy::Int => ".int".into(), + PlanTy::Bool => ".bool".into(), + PlanTy::Record(t) => format!("(.record {t})"), + PlanTy::Sum(t) => format!("(.sum {t})"), + PlanTy::Option(t) => format!("(.option {})", t.lean()), + PlanTy::Result(t, e) => format!("(.result {} {})", t.lean(), e.lean()), + PlanTy::Eqref => ".eqref".into(), + PlanTy::Float => ".float".into(), + PlanTy::Str => ".string".into(), + PlanTy::Vec(t) => format!("(.vec {})", t.lean()), + PlanTy::List(t) => format!("(.list {})", t.lean()), + PlanTy::Opaque(t) => format!("(.opaque {t})"), + } + } +} + +fn lean_ty_list(ts: &[PlanTy]) -> String { + format!( + "[{}]", + ts.iter().map(PlanTy::lean).collect::>().join(", ") + ) +} + +impl PlanLit { + fn lean(&self) -> String { + match self { + PlanLit::Int(k) => format!("(.int {})", lean_int(*k)), + PlanLit::Bool(b) => format!("(.bool {b})"), + PlanLit::Float(bits) => format!("(.float {bits})"), + PlanLit::Str(bytes) => format!("(.str {})", lean_bytes(bytes)), + } + } +} + +impl PlanBinOp { + fn lean(self) -> &'static str { + match self { + PlanBinOp::Add => ".add", + PlanBinOp::Sub => ".sub", + PlanBinOp::Mul => ".mul", + PlanBinOp::Eq => ".eq", + PlanBinOp::Neq => ".neq", + PlanBinOp::Lt => ".lt", + PlanBinOp::Gt => ".gt", + PlanBinOp::Lte => ".lte", + PlanBinOp::Gte => ".gte", + } + } +} + +impl PlanCallee { + fn lean(self) -> String { + match self { + PlanCallee::Fn(f) => format!("(.fn {f})"), + PlanCallee::Builtin(b) => format!( + "(.builtin {})", + match b { + PlanBuiltin::BoolAnd => ".boolAnd", + PlanBuiltin::BoolOr => ".boolOr", + PlanBuiltin::BoolNot => ".boolNot", + PlanBuiltin::ListPrepend => ".listPrepend", + PlanBuiltin::VecGet => ".vecGet", + PlanBuiltin::IntDiv => ".intDiv", + PlanBuiltin::IntMod => ".intMod", + } + ), + PlanCallee::Intrinsic(i) => format!( + "(.intrinsic {})", + match i { + PlanIntrinsic::IntDivEuclid => ".intDivEuclid", + PlanIntrinsic::IntModEuclid => ".intModEuclid", + } + ), + PlanCallee::Lazy(l) => format!( + "(.lazy {})", + match l { + PlanLazy::OptWithDefault => ".optWithDefault", + PlanLazy::ResWithDefault => ".resWithDefault", + } + ), + } + } +} + +impl PlanCtor { + fn lean(self) -> String { + match self { + PlanCtor::User(t, c) => format!("(.user {t} {c})"), + PlanCtor::Some => ".some".into(), + PlanCtor::None => ".none".into(), + PlanCtor::Ok => ".ok".into(), + PlanCtor::Err => ".err".into(), + } + } +} + +impl PlanPat { + fn lean(&self) -> String { + match self { + PlanPat::Wild => ".wild".into(), + PlanPat::LitInt(k) => format!("(.litInt {})", lean_int(*k)), + PlanPat::LitBool(b) => format!("(.litBool {b})"), + PlanPat::Bind(s) => format!("(.bind {s})"), + PlanPat::Ctor(c, bs) => format!("(.ctor {} {})", c.lean(), lean_nat_list(bs)), + PlanPat::LitStr(bytes) => format!("(.litStr {})", lean_bytes(bytes)), + PlanPat::Tuple(bs) => format!("(.tuple {})", lean_nat_list(bs)), + } + } +} + +impl PlanExpr { + pub fn lean(&self) -> String { + let mut out = String::new(); + self.write_lean(&mut out); + out + } + + fn write_list(items: &[PlanExpr], out: &mut String) { + out.push('['); + for (i, item) in items.iter().enumerate() { + if i > 0 { + out.push_str(", "); + } + item.write_lean(out); + } + out.push(']'); + } + + fn write_lean(&self, out: &mut String) { + match self { + PlanExpr::Literal(l) => { + out.push_str("(.literal "); + out.push_str(&l.lean()); + out.push(')'); + } + PlanExpr::Local(i) => out.push_str(&format!("(.local {i})")), + PlanExpr::Let(b, v, body) => { + out.push_str(&format!("(.let_ {b} ")); + v.write_lean(out); + out.push(' '); + body.write_lean(out); + out.push(')'); + } + PlanExpr::Call(c, args) => { + out.push_str(&format!("(.call {} ", c.lean())); + Self::write_list(args, out); + out.push(')'); + } + PlanExpr::TailCall(f, args) => { + out.push_str(&format!("(.tailCall {f} ")); + Self::write_list(args, out); + out.push(')'); + } + PlanExpr::BinOp(op, l, r) => { + out.push_str(&format!("(.binOp {} ", op.lean())); + l.write_lean(out); + out.push(' '); + r.write_lean(out); + out.push(')'); + } + PlanExpr::Neg(e) => { + out.push_str("(.neg "); + e.write_lean(out); + out.push(')'); + } + PlanExpr::If(c, t, e) => { + out.push_str("(.ifThenElse "); + c.write_lean(out); + out.push(' '); + t.write_lean(out); + out.push(' '); + e.write_lean(out); + out.push(')'); + } + PlanExpr::RecordCreate(tid, fs) => { + out.push_str(&format!("(.recordCreate {tid} ")); + Self::write_list(fs, out); + out.push(')'); + } + PlanExpr::Project(tid, i, b) => { + out.push_str(&format!("(.project {tid} {i} ")); + b.write_lean(out); + out.push(')'); + } + PlanExpr::Match(s, arms) => { + out.push_str("(.match_ "); + s.write_lean(out); + out.push(' '); + for (p, b) in arms { + out.push_str(&format!("(.cons {} ", p.lean())); + b.write_lean(out); + out.push(' '); + } + out.push_str(".nil"); + for _ in arms { + out.push(')'); + } + out.push(')'); + } + PlanExpr::Construct(c, ty, args) => { + out.push_str(&format!("(.construct {} {} ", c.lean(), ty.lean())); + Self::write_list(args, out); + out.push(')'); + } + PlanExpr::Interp(parts) => { + out.push_str("(.interp "); + Self::write_list(parts, out); + out.push(')'); + } + PlanExpr::List(t, items) => { + out.push_str(&format!("(.list {} ", t.lean())); + Self::write_list(items, out); + out.push(')'); + } + } + } +} + +impl FnPlan { + /// The Lean `Grammar.FnPlan` term. + pub fn lean(&self) -> String { + format!( + "{{ sig := ⟨{}, {}⟩, nslots := {}, locals := {},\n body := {} }}", + lean_ty_list(&self.params), + self.ret.lean(), + self.nslots, + lean_ty_list(&self.locals), + self.body.lean() + ) + } +} + +fn lean_opt_nat(v: Option) -> String { + match v { + Some(v) => format!("some {v}"), + None => "none".into(), + } +} + +/// The longest list literal the type table writes in one piece. Lean +/// elaborates a list literal as one nested `List.cons` term, and a term deeper +/// than `maxRecDepth` (512 by default) fails to elaborate; btc-listener's +/// string segments (151 entries, the longest 570 bytes) went past it. A longer +/// list is written as literals of at most this many elements joined by `++`. +pub const LEAN_LIST_CHUNK: usize = 64; + +/// The most rendered text one producer declaration carries in a list field. +/// Elaboration is paid per declaration (`maxHeartbeats`), so a field longer +/// than this, or with more than [`LEAN_LIST_CHUNK`] entries, is split into +/// its own declarations of at most this much text each, which the table joins +/// with `++`. The split denotes the same list: the wall reads the value, never +/// the spelling, and `decide`/`rfl` reduce the append. +pub const LEAN_TABLE_PIECE_CHARS: usize = 4096; + +/// Rendered elements as one Lean list term, split by `++` into literals of at +/// most [`LEAN_LIST_CHUNK`] elements. A short list is the plain literal. +fn lean_list_chunked(items: &[String], separator: &str) -> String { + if items.is_empty() { + return "[]".into(); + } + items + .chunks(LEAN_LIST_CHUNK) + .map(|chunk| format!("[{}]", chunk.join(separator))) + .collect::>() + .join(" ++ ") +} + +/// Split rendered list entries into pieces of at most [`LEAN_LIST_CHUNK`] +/// entries and [`LEAN_TABLE_PIECE_CHARS`] of text; an entry longer than the +/// text budget is a piece of its own. +fn table_pieces(items: &[String]) -> Vec<&[String]> { + let mut pieces = Vec::new(); + let mut start = 0; + let mut chars = 0; + for (i, item) in items.iter().enumerate() { + let full = i - start == LEAN_LIST_CHUNK || chars + item.len() > LEAN_TABLE_PIECE_CHARS; + if i > start && full { + pieces.push(&items[start..i]); + start = i; + chars = 0; + } + chars += item.len(); + } + if start < items.len() { + pieces.push(&items[start..]); + } + pieces +} + +/// A list of rendered Lean terms of type `ty`, as the term that denotes it: +/// the plain literal when it fits one piece (see [`LEAN_TABLE_PIECE_CHARS`]), +/// else the `++` of declarations `{prefix}_{k}`, one per piece, which are +/// appended to `decls`. +pub(crate) fn lean_list_in_pieces( + decls: &mut String, + prefix: &str, + ty: &str, + items: &[String], +) -> String { + let pieces = table_pieces(items); + if pieces.len() <= 1 { + return format!("[{}]", items.join(", ")); + } + pieces + .iter() + .enumerate() + .map(|(k, piece)| { + let piece_name = format!("{prefix}_{k}"); + decls.push_str(&format!( + "def {piece_name} : List ({ty}) :=\n [{}]\n\n", + piece.join(",\n ") + )); + piece_name + }) + .collect::>() + .join(" ++ ") +} + +impl PlanTypeTable { + /// The Lean declaration `def {name} : Schema.TypeTable`, preceded by the + /// declarations `{name}_{field}_{k}` of every list field too big to write + /// inline (see [`LEAN_TABLE_PIECE_CHARS`]); every byte list longer than + /// [`LEAN_LIST_CHUNK`] is written in `++`-joined literals. + pub fn lean_decls(&self, name: &str) -> String { + let records = self + .records + .iter() + .map(|r| format!("⟨{}, {}, {}⟩", r.tid, r.struct_idx, lean_ty_list(&r.fields))) + .collect::>(); + let sums = self + .sums + .iter() + .map(|s| { + format!( + "⟨{}, {}, [{}]⟩", + s.tid, + s.root, + s.ctors + .iter() + .map(|(idx, fs)| format!("({idx}, {})", lean_ty_list(fs))) + .collect::>() + .join(", ") + ) + }) + .collect::>(); + let pairs = |xs: &[(PlanTy, u32)]| { + xs.iter() + .map(|(t, i)| format!("({}, {i})", t.lean())) + .collect::>() + }; + let results = self + .results + .iter() + .map(|(t, e, i)| format!("({}, {}, {i})", t.lean(), e.lean())) + .collect::>(); + let opaques = self + .opaques + .iter() + .map(|(t, i)| format!("({t}, {i})")) + .collect::>(); + let segs = self + .str_segs + .iter() + .map(|(b, i)| { + let bytes = b.iter().map(u8::to_string).collect::>(); + format!("({}, {i})", lean_list_chunked(&bytes, ", ")) + }) + .collect::>(); + + let mut decls = String::new(); + let mut field = |field: &str, ty: &str, items: &[String]| -> String { + lean_list_in_pieces(&mut decls, &format!("{name}_{field}"), ty, items) + }; + let records = field("records", "RecordDecl", &records); + let sums = field("sums", "SumDecl", &sums); + let options = field("options", "Ty × Nat", &pairs(&self.options)); + let results = field("results", "Ty × Ty × Nat", &results); + let vecs = field("vecs", "Ty × Nat", &pairs(&self.vecs)); + let lists = field("lists", "Ty × Nat", &pairs(&self.lists)); + let opaques = field("opaques", "Nat × Nat", &opaques); + let segs = field("strSegs", "List Nat × Nat", &segs); + format!( + "{decls}def {name} : TypeTable :=\n {{ carrier := {}, mag := {}, str := {}, strVec := {},\n records := {records},\n sums := {sums},\n options := {options}, results := {results},\n vecs := {vecs}, lists := {lists}, opaques := {opaques},\n strSegs := {segs} }}\n\n", + lean_opt_nat(self.carrier), + lean_opt_nat(self.mag), + lean_opt_nat(self.str_), + lean_opt_nat(self.str_vec), + ) + } +} + +#[cfg(test)] +mod tests { + use super::*; + + /// Every list literal in `text`, as the count of its top-level elements. + fn literal_lengths(text: &str) -> Vec { + // Per open `[`: (commas at its own level, saw an element, open + // parentheses/anonymous constructors inside it). + let mut open: Vec<(usize, bool, usize)> = Vec::new(); + let mut lengths = Vec::new(); + for c in text.chars() { + match c { + '[' => { + if let Some(top) = open.last_mut() { + top.1 = true; + } + open.push((0, false, 0)); + } + ']' => { + let (commas, any, _) = open.pop().expect("balanced brackets"); + lengths.push(if any { commas + 1 } else { 0 }); + } + '(' | '⟨' => { + if let Some(top) = open.last_mut() { + top.1 = true; + top.2 += 1; + } + } + ')' | '⟩' => { + if let Some(top) = open.last_mut() { + top.2 -= 1; + } + } + ',' => { + if let Some(top) = open.last_mut() + && top.2 == 0 + { + top.0 += 1; + } + } + c if !c.is_whitespace() => { + if let Some(top) = open.last_mut() { + top.1 = true; + } + } + _ => {} + } + } + lengths + } + + /// The numerals of `text` in order. + fn numerals(text: &str) -> Vec { + text.split(|c: char| !c.is_ascii_digit()) + .filter(|s| !s.is_empty()) + .map(|s| s.parse().unwrap()) + .collect() + } + + /// The bodies of the piece declarations of one field, in order. + fn piece_bodies(text: &str, field: &str) -> Vec { + let prefix = format!("def types_{field}_"); + text.split("\n\n") + .filter(|d| d.starts_with(&prefix)) + .map(|d| d.split_once(":=").unwrap().1.to_string()) + .collect() + } + + /// Regression: btc-listener's type table (151 string segments, the + /// longest 570 bytes) was one list literal past Lean's `maxRecDepth` and + /// one declaration past `maxHeartbeats`. A table far bigger than that is + /// written with no literal longer than `LEAN_LIST_CHUNK`, no piece longer + /// than `LEAN_TABLE_PIECE_CHARS` beyond its one oversized entry, and the + /// same value: `++` only concatenates, so every numeral appears once and + /// in the original order. + #[test] + fn a_big_type_table_is_written_in_pieces_with_the_same_value() { + let segs: Vec<(Vec, u32)> = (0..300u32) + .map(|i| { + let len = (i * 7 % 900) as usize; + ((0..len).map(|b| (b % 251) as u8).collect(), i) + }) + .collect(); + let records: Vec = (0..200u32) + .map(|tid| PlanRecordDecl { + tid, + struct_idx: tid + 1000, + fields: vec![PlanTy::Int, PlanTy::Str], + }) + .collect(); + let tt = PlanTypeTable { + records: records.clone(), + str_segs: segs.clone(), + ..PlanTypeTable::default() + }; + let text = tt.lean_decls("types"); + + let longest = literal_lengths(&text).into_iter().max().unwrap_or(0); + assert!(longest <= LEAN_LIST_CHUNK, "a literal has {longest} elements"); + + let seg_pieces = piece_bodies(&text, "strSegs"); + assert!(seg_pieces.len() > 1); + for body in &seg_pieces { + let entries = body.matches("),\n").count() + 1; + assert!( + body.len() <= LEAN_TABLE_PIECE_CHARS + 16 || entries == 1, + "a piece of {entries} entries has {} chars", + body.len() + ); + } + let expected: Vec = segs + .iter() + .flat_map(|(bytes, idx)| bytes.iter().map(|b| *b as u64).chain([*idx as u64])) + .collect(); + assert_eq!(numerals(&seg_pieces.concat()), expected); + + let join = text + .lines() + .find_map(|l| l.trim_start().strip_prefix("strSegs := ")) + .unwrap(); + let joined: Vec<&str> = join.trim_end_matches(" }").split(" ++ ").collect(); + let declared: Vec = (0..seg_pieces.len()) + .map(|k| format!("types_strSegs_{k}")) + .collect(); + assert_eq!(joined, declared); + + let expected: Vec = records + .iter() + .flat_map(|r| [r.tid as u64, r.struct_idx as u64]) + .collect(); + assert_eq!(numerals(&piece_bodies(&text, "records").concat()), expected); + } + + /// A table that fits one piece is written as one declaration with one + /// inline literal per field. + #[test] + fn a_small_type_table_is_one_declaration() { + let tt = PlanTypeTable { + carrier: Some(3), + records: vec![PlanRecordDecl { + tid: 0, + struct_idx: 5, + fields: vec![PlanTy::Int, PlanTy::Bool], + }], + str_segs: vec![(b"hi".to_vec(), 2)], + ..PlanTypeTable::default() + }; + assert_eq!( + tt.lean_decls("types"), + "def types : TypeTable :=\n { carrier := some 3, mag := none, str := none, strVec := none,\n \ + records := [⟨0, 5, [.int, .bool]⟩],\n sums := [],\n options := [], results := [],\n \ + vecs := [], lists := [], opaques := [],\n strSegs := [([104, 105], 2)] }\n\n" + ); + } +} diff --git a/aver-cert/src/engine/plan_check.rs b/aver-cert/src/engine/plan_check.rs new file mode 100644 index 000000000..d8cb0afc6 --- /dev/null +++ b/aver-cert/src/engine/plan_check.rs @@ -0,0 +1,1907 @@ +// ---- producer-side twins of the wall's plan functions ---------------------- +// +// Rust ports of `Grammar.tyOf`, `GrammarLower.lowerB`/`codeEntryBytes`, +// `TypeTable.typeTableConfirmed`, `GrammarTotal.checkTermGroup` and the +// `ClaimAxes` report functions. They are PRODUCER-ONLY: they decide which +// functions the producer offers (a plan whose lowering is not its code entry +// is declined per function instead of failing the whole package in Lean) and +// fill the report fields the checker witness pins. The wall re-derives every +// one of them; a disagreement fails closed there. + +/// `TypeTable.absent k`: an index outside the u32 space, which every encoder +/// rejects. +fn absent(k: u64) -> u64 { + 4_294_967_296 + k +} + +fn idx_or(k: u64, v: Option) -> u64 { + v.map_or(absent(k), u64::from) +} + +/// `Grammar.MCtx`, as `TypeTable.mctxOf` builds it. +struct MCtx<'a> { + carrier: u64, + box_: u64, + add: u64, + sub: u64, + mul: u64, + neg: u64, + cmp: u64, + eq: u64, + mag: u64, + str_: u64, + str_vec: u64, + concat: u64, + streq: u64, + to_index: u64, + divmod: u64, + tt: &'a PlanTypeTable, + sigs: HashMap, PlanTy)>, +} + +impl<'a> MCtx<'a> { + fn new( + roles: Option<&HostRoles>, + strings: &StringHostRoles, + tt: &'a PlanTypeTable, + fns: &[(u32, &FnPlan)], + ) -> Self { + let role = |pick: fn(&HostRoles) -> Option| roles.and_then(pick); + let string_role = |r: StringHostRole| strings.iter().find(|x| x.1 == r).map(|x| x.0); + let mut sigs = HashMap::new(); + for (f, p) in fns { + sigs.entry(*f) + .or_insert_with(|| (p.params.clone(), p.ret.clone())); + } + MCtx { + carrier: idx_or(0, tt.carrier), + box_: idx_or(1, role(|r| r.box_idx)), + add: idx_or(2, role(|r| r.add_idx)), + sub: idx_or(3, role(|r| r.sub_idx)), + mul: idx_or(4, role(|r| r.mul_idx)), + neg: absent(5), + cmp: idx_or(6, role(|r| r.cmp_idx)), + eq: idx_or(7, role(|r| r.eq_idx)), + mag: idx_or(13, tt.mag), + str_: idx_or(14, tt.str_), + str_vec: idx_or(16, tt.str_vec), + concat: idx_or(17, string_role(StringHostRole::Concat)), + streq: idx_or(18, string_role(StringHostRole::Eq)), + to_index: idx_or(19, role(|r| r.to_index_idx)), + divmod: idx_or(23, role(|r| r.divmod_idx)), + tt, + sigs, + } + } + + fn record(&self, tid: u32) -> Option<&PlanRecordDecl> { + self.tt.records.iter().find(|r| r.tid == tid) + } + + fn sum(&self, tid: u32) -> Option<&PlanSumDecl> { + self.tt.sums.iter().find(|s| s.tid == tid) + } + + fn rec_fields(&self, tid: u32) -> Option<&[PlanTy]> { + self.record(tid).map(|r| r.fields.as_slice()) + } + + fn struct_of(&self, tid: u32) -> u64 { + idx_or(8, self.record(tid).map(|r| r.struct_idx)) + } + + fn ctor_fields(&self, tid: u32, c: u32) -> Option<&[PlanTy]> { + self.sum(tid)?.ctors.get(c as usize).map(|x| x.1.as_slice()) + } + + fn ctor_struct(&self, tid: u32, c: u32) -> u64 { + idx_or( + 9, + self.sum(tid) + .and_then(|s| s.ctors.get(c as usize)) + .map(|x| x.0), + ) + } + + fn sum_root(&self, tid: u32) -> u64 { + idx_or(10, self.sum(tid).map(|s| s.root)) + } + + fn opt_struct(&self, t: &PlanTy) -> u64 { + idx_or(11, self.tt.options.iter().find(|o| &o.0 == t).map(|o| o.1)) + } + + fn res_struct(&self, t: &PlanTy, e: &PlanTy) -> u64 { + idx_or( + 12, + self.tt + .results + .iter() + .find(|r| &r.0 == t && &r.1 == e) + .map(|r| r.2), + ) + } + + fn str_seg(&self, bytes: &[u8]) -> u64 { + idx_or( + 15, + self.tt.str_segs.iter().find(|s| s.0 == bytes).map(|s| s.1), + ) + } + + fn vec_struct(&self, t: &PlanTy) -> u64 { + idx_or(20, self.tt.vecs.iter().find(|v| &v.0 == t).map(|v| v.1)) + } + + fn list_struct(&self, t: &PlanTy) -> u64 { + idx_or(21, self.tt.lists.iter().find(|l| &l.0 == t).map(|l| l.1)) + } + + fn opaque_struct(&self, tid: u32) -> u64 { + idx_or(22, self.tt.opaques.iter().find(|o| o.0 == tid).map(|o| o.1)) + } + + fn sum_ok(&self, tid: u32) -> bool { + let Some(s) = self.sum(tid) else { + return false; + }; + let cs = &s.ctors; + let newtype = cs.len() == 1 && cs[0].1.len() == 1; + if newtype { + return false; + } + (0..cs.len()).all(|a| { + (0..cs.len()).all(|b| { + a == b || self.ctor_struct(tid, a as u32) != self.ctor_struct(tid, b as u32) + }) + }) + } + + fn arith_idx(&self, op: PlanBinOp) -> u64 { + match op { + PlanBinOp::Add => self.add, + PlanBinOp::Sub => self.sub, + _ => self.mul, + } + } +} + +fn has_default(t: &PlanTy) -> bool { + matches!( + t, + PlanTy::Int + | PlanTy::Bool + | PlanTy::Record(_) + | PlanTy::Sum(_) + | PlanTy::Option(_) + | PlanTy::Result(_, _) + | PlanTy::Str + | PlanTy::Float + | PlanTy::List(_) + | PlanTy::Vec(_) + ) +} + +type Gamma = BTreeMap; + +fn upd(g: &Gamma, b: u32, t: PlanTy) -> Gamma { + let mut g = g.clone(); + g.insert(b, t); + g +} + +fn bind_tys(n: u32, g: &Gamma, bs: &[u32], ts: &[PlanTy]) -> Option { + if bs.len() != ts.len() { + return None; + } + let mut g = g.clone(); + for (b, t) in bs.iter().zip(ts) { + if *b == PLAN_NO_SLOT { + continue; + } + if *b < n && !g.contains_key(b) { + g.insert(*b, t.clone()); + } else { + return None; + } + } + Some(g) +} + +fn bind_one(n: u32, g: &Gamma, b: u32, t: &PlanTy) -> Option { + bind_tys(n, g, &[b], std::slice::from_ref(t)) +} + +fn opt_pick(p1: &PlanPat, p2: &PlanPat) -> Option<(bool, u32)> { + match (p1, p2) { + (PlanPat::Ctor(PlanCtor::Some, b), PlanPat::Ctor(PlanCtor::None, n)) + if b.len() == 1 && n.is_empty() => + { + Some((false, b[0])) + } + (PlanPat::Ctor(PlanCtor::Some, b), PlanPat::Wild) if b.len() == 1 => Some((false, b[0])), + (PlanPat::Ctor(PlanCtor::None, n), PlanPat::Ctor(PlanCtor::Some, b)) + if b.len() == 1 && n.is_empty() => + { + Some((true, b[0])) + } + (PlanPat::Ctor(PlanCtor::None, n), PlanPat::Wild) if n.is_empty() => { + Some((true, PLAN_NO_SLOT)) + } + _ => None, + } +} + +fn res_pick(p1: &PlanPat, p2: &PlanPat) -> Option<(bool, u32, u32)> { + match (p1, p2) { + (PlanPat::Ctor(PlanCtor::Ok, a), PlanPat::Ctor(PlanCtor::Err, b)) + if a.len() == 1 && b.len() == 1 => + { + Some((false, a[0], b[0])) + } + (PlanPat::Ctor(PlanCtor::Ok, a), PlanPat::Wild) if a.len() == 1 => { + Some((false, a[0], PLAN_NO_SLOT)) + } + (PlanPat::Ctor(PlanCtor::Err, b), PlanPat::Ctor(PlanCtor::Ok, a)) + if a.len() == 1 && b.len() == 1 => + { + Some((true, a[0], b[0])) + } + (PlanPat::Ctor(PlanCtor::Err, b), PlanPat::Wild) if b.len() == 1 => { + Some((true, PLAN_NO_SLOT, b[0])) + } + _ => None, + } +} + +/// `Grammar.vecGetOr?`. +fn vec_get_or(lb: PlanLazy, o: &PlanExpr, d: &PlanExpr) -> Option<(u32, u32)> { + match (lb, o, d) { + ( + PlanLazy::OptWithDefault, + PlanExpr::Call(PlanCallee::Builtin(PlanBuiltin::VecGet), args), + PlanExpr::Literal(_), + ) => match args.as_slice() { + [PlanExpr::Local(v), PlanExpr::Local(i)] => Some((*v, *i)), + _ => None, + }, + _ => None, + } +} + +/// `Grammar.divOr?`: the fused `Result.withDefault(Int.div/mod(a, b), )`, as `(is_mod, a, b)`. +fn div_or<'e>( + lb: PlanLazy, + o: &'e PlanExpr, + d: &PlanExpr, +) -> Option<(bool, &'e PlanExpr, &'e PlanExpr)> { + match (lb, o, d) { + ( + PlanLazy::ResWithDefault, + PlanExpr::Call(PlanCallee::Builtin(b @ (PlanBuiltin::IntDiv | PlanBuiltin::IntMod)), args), + PlanExpr::Literal(PlanLit::Int(_)), + ) => match args.as_slice() { + [a, bb] => Some((*b == PlanBuiltin::IntMod, a, bb)), + _ => None, + }, + _ => None, + } +} + +fn all_str(ts: &[PlanTy]) -> bool { + !ts.is_empty() && ts.iter().all(|t| *t == PlanTy::Str) +} + +fn builtin_ty(b: PlanBuiltin, ts: &[PlanTy]) -> Option { + match (b, ts) { + (PlanBuiltin::BoolAnd | PlanBuiltin::BoolOr, [PlanTy::Bool, PlanTy::Bool]) => { + Some(PlanTy::Bool) + } + (PlanBuiltin::BoolNot, [PlanTy::Bool]) => Some(PlanTy::Bool), + (PlanBuiltin::ListPrepend, [t, PlanTy::List(t2)]) if t == t2.as_ref() => { + Some(PlanTy::List(Box::new(t.clone()))) + } + _ => None, + } +} + +fn lazy_ty(lb: PlanLazy, to: &PlanTy, td: &PlanTy) -> Option { + match (lb, to) { + (PlanLazy::OptWithDefault, PlanTy::Option(t)) + | (PlanLazy::ResWithDefault, PlanTy::Result(t, _)) + if t.as_ref() == td && has_default(t) => + { + Some(td.clone()) + } + _ => None, + } +} + +fn is_arith(op: PlanBinOp) -> bool { + matches!(op, PlanBinOp::Add | PlanBinOp::Sub | PlanBinOp::Mul) +} + +fn is_equality(op: PlanBinOp) -> bool { + matches!(op, PlanBinOp::Eq | PlanBinOp::Neq) +} + +fn is_float_cmp(op: PlanBinOp) -> bool { + matches!( + op, + PlanBinOp::Eq | PlanBinOp::Lt | PlanBinOp::Gt | PlanBinOp::Lte | PlanBinOp::Gte + ) +} + +impl MCtx<'_> { + fn ctor_ty(&self, c: PlanCtor, ty: &PlanTy, ts: &[PlanTy]) -> Option { + match (c, ty) { + (PlanCtor::User(tid, k), PlanTy::Sum(tid2)) => { + (tid == *tid2 && self.sum_ok(tid) && self.ctor_fields(tid, k) == Some(ts)) + .then_some(PlanTy::Sum(tid)) + } + (PlanCtor::Some, PlanTy::Option(t)) => { + (ts == [t.as_ref().clone()] && has_default(t)).then(|| ty.clone()) + } + (PlanCtor::None, PlanTy::Option(t)) => { + (ts.is_empty() && has_default(t)).then(|| ty.clone()) + } + (PlanCtor::Ok, PlanTy::Result(t, e)) => { + (ts == [t.as_ref().clone()] && has_default(t) && has_default(e)).then(|| ty.clone()) + } + (PlanCtor::Err, PlanTy::Result(t, e)) => { + (ts == [e.as_ref().clone()] && has_default(t) && has_default(e)).then(|| ty.clone()) + } + _ => None, + } + } + + fn tys_of(&self, n: u32, g: &Gamma, es: &[PlanExpr]) -> Option> { + es.iter().map(|e| self.ty_of(n, g, false, e)).collect() + } + + /// `Grammar.tyOf`. + fn ty_of(&self, n: u32, g: &Gamma, tail: bool, e: &PlanExpr) -> Option { + match e { + PlanExpr::Literal(PlanLit::Int(_)) => Some(PlanTy::Int), + PlanExpr::Literal(PlanLit::Bool(_)) => Some(PlanTy::Bool), + PlanExpr::Literal(PlanLit::Float(_)) => Some(PlanTy::Float), + PlanExpr::Literal(PlanLit::Str(_)) => Some(PlanTy::Str), + PlanExpr::Local(i) => g.get(i).cloned(), + PlanExpr::Let(b, v, body) => { + if *b < n && !g.contains_key(b) { + let t = self.ty_of(n, g, false, v)?; + self.ty_of(n, &upd(g, *b, t), tail, body) + } else { + None + } + } + PlanExpr::Call(PlanCallee::Fn(f), args) | PlanExpr::TailCall(f, args) => { + if matches!(e, PlanExpr::TailCall(..)) && !tail { + return None; + } + let (params, ret) = self.sigs.get(f)?; + let ts = self.tys_of(n, g, args)?; + (&ts == params).then(|| ret.clone()) + } + PlanExpr::Call(PlanCallee::Builtin(b), args) => { + builtin_ty(*b, &self.tys_of(n, g, args)?) + } + PlanExpr::Call(PlanCallee::Lazy(lb), args) => match args.as_slice() { + [o, d] => match vec_get_or(*lb, o, d) { + Some((v, i)) => match (g.get(&v), g.get(&i), self.ty_of(n, g, false, d)) { + (Some(PlanTy::Vec(t)), Some(PlanTy::Int), Some(td)) if td == **t => { + Some(td) + } + _ => None, + }, + None => match div_or(*lb, o, d) { + Some((_, a, b)) => (self.ty_of(n, g, false, a)? == PlanTy::Int + && self.ty_of(n, g, false, b)? == PlanTy::Int + && self.ty_of(n, g, false, d)? == PlanTy::Int) + .then_some(PlanTy::Int), + None => lazy_ty( + *lb, + &self.ty_of(n, g, false, o)?, + &self.ty_of(n, g, false, d)?, + ), + }, + }, + _ => None, + }, + PlanExpr::Call(PlanCallee::Intrinsic(_), args) => match args.as_slice() { + [a, PlanExpr::Literal(PlanLit::Int(k))] if *k != 0 => { + (self.ty_of(n, g, false, a)? == PlanTy::Int).then_some(PlanTy::Int) + } + _ => None, + }, + PlanExpr::BinOp(op, l, r) => { + match (self.ty_of(n, g, false, l)?, self.ty_of(n, g, false, r)?) { + (PlanTy::Int, PlanTy::Int) => Some(if is_arith(*op) { + PlanTy::Int + } else { + PlanTy::Bool + }), + (PlanTy::Bool, PlanTy::Bool) => is_equality(*op).then_some(PlanTy::Bool), + (PlanTy::Float, PlanTy::Float) => is_float_cmp(*op).then_some(PlanTy::Bool), + (PlanTy::Str, PlanTy::Str) => match op { + PlanBinOp::Add => Some(PlanTy::Str), + PlanBinOp::Eq | PlanBinOp::Neq => Some(PlanTy::Bool), + _ => None, + }, + _ => None, + } + } + PlanExpr::Neg(x) => (self.ty_of(n, g, false, x)? == PlanTy::Int).then_some(PlanTy::Int), + PlanExpr::If(c, t, el) => { + match ( + self.ty_of(n, g, false, c)?, + self.ty_of(n, g, tail, t)?, + self.ty_of(n, g, tail, el)?, + ) { + (PlanTy::Bool, a, b) if a == b => Some(a), + _ => None, + } + } + PlanExpr::RecordCreate(tid, fs) => { + let fts = self.rec_fields(*tid)?; + let ts = self.tys_of(n, g, fs)?; + (fts.len() >= 2 && ts == fts).then_some(PlanTy::Record(*tid)) + } + PlanExpr::Project(tid, i, base) => { + match (self.ty_of(n, g, false, base)?, self.rec_fields(*tid)) { + (PlanTy::Record(t2), Some(fts)) if t2 == *tid && fts.len() >= 2 => { + fts.get(*i as usize).cloned() + } + _ => None, + } + } + PlanExpr::Construct(c, ty, args) => self.ctor_ty(*c, ty, &self.tys_of(n, g, args)?), + PlanExpr::Interp(parts) => all_str(&self.tys_of(n, g, parts)?).then_some(PlanTy::Str), + PlanExpr::List(t, items) => items.is_empty().then(|| PlanTy::List(Box::new(t.clone()))), + PlanExpr::Match(s, arms) => match self.ty_of(n, g, false, s)? { + PlanTy::Int => { + matches!(arms.first(), Some((PlanPat::LitInt(_), _))).then_some(())?; + self.ty_int_arms(n, g, tail, arms) + } + PlanTy::Bool => self.ty_bool_arms(n, g, tail, arms), + PlanTy::Option(t) => self.ty_opt_arms(n, g, tail, &t, arms), + PlanTy::Result(t, er) => self.ty_res_arms(n, g, tail, &t, &er, arms), + PlanTy::Sum(tid) => { + (self.sum_ok(tid) && self.var_exhaustive(tid, arms) && arms.len() >= 2) + .then_some(())?; + self.ty_var_arms(n, g, tail, tid, arms) + } + PlanTy::Str => self.ty_str_arms(n, g, tail, arms), + PlanTy::Record(tid) => self.ty_tup_arms(n, g, tail, tid, arms), + _ => None, + }, + } + } + + fn ty_int_arms( + &self, + n: u32, + g: &Gamma, + tail: bool, + arms: &[(PlanPat, PlanExpr)], + ) -> Option { + let ((p, b), rest) = arms.split_first()?; + match p { + PlanPat::LitInt(_) => { + let t = self.ty_of(n, g, tail, b)?; + let t2 = self.ty_int_arms(n, g, tail, rest)?; + (t == t2).then_some(t) + } + PlanPat::Wild if rest.is_empty() => self.ty_of(n, g, tail, b), + PlanPat::Bind(s) if rest.is_empty() => { + (*s < n && !g.contains_key(s) && *s != PLAN_NO_SLOT).then_some(())?; + self.ty_of(n, &upd(g, *s, PlanTy::Int), tail, b) + } + _ => None, + } + } + + fn ty_bool_arms( + &self, + n: u32, + g: &Gamma, + tail: bool, + arms: &[(PlanPat, PlanExpr)], + ) -> Option { + match arms { + [(PlanPat::LitBool(v), t), (p, e)] + if *p == PlanPat::LitBool(!v) || *p == PlanPat::Wild => + { + let a = self.ty_of(n, g, tail, t)?; + let b = self.ty_of(n, g, tail, e)?; + (a == b).then_some(a) + } + _ => None, + } + } + + fn ty_opt_arms( + &self, + n: u32, + g: &Gamma, + tail: bool, + t: &PlanTy, + arms: &[(PlanPat, PlanExpr)], + ) -> Option { + let [(p1, b1), (p2, b2)] = arms else { + return None; + }; + let (swap, sb) = opt_pick(p1, p2)?; + let gs = bind_one(n, g, sb, t)?; + let (a, b) = if swap { + (self.ty_of(n, &gs, tail, b2)?, self.ty_of(n, g, tail, b1)?) + } else { + (self.ty_of(n, &gs, tail, b1)?, self.ty_of(n, g, tail, b2)?) + }; + (a == b).then_some(a) + } + + fn ty_res_arms( + &self, + n: u32, + g: &Gamma, + tail: bool, + t: &PlanTy, + er: &PlanTy, + arms: &[(PlanPat, PlanExpr)], + ) -> Option { + let [(p1, b1), (p2, b2)] = arms else { + return None; + }; + let (swap, ob, eb) = res_pick(p1, p2)?; + let go = bind_one(n, g, ob, t)?; + let ge = bind_one(n, g, eb, er)?; + let (a, b) = if swap { + (self.ty_of(n, &go, tail, b2)?, self.ty_of(n, &ge, tail, b1)?) + } else { + (self.ty_of(n, &go, tail, b1)?, self.ty_of(n, &ge, tail, b2)?) + }; + (a == b).then_some(a) + } + + fn covers(c: u32, arms: &[(PlanPat, PlanExpr)]) -> bool { + for (p, _) in arms { + match p { + PlanPat::Wild => return true, + PlanPat::Ctor(PlanCtor::User(_, c2), _) if *c2 == c => return true, + _ => {} + } + } + false + } + + fn var_exhaustive(&self, tid: u32, arms: &[(PlanPat, PlanExpr)]) -> bool { + match self.sum(tid) { + Some(s) => (0..s.ctors.len() as u32).all(|c| Self::covers(c, arms)), + None => false, + } + } + + fn var_arm_gamma(&self, n: u32, g: &Gamma, tid: u32, p: &PlanPat) -> Option { + match p { + PlanPat::Ctor(PlanCtor::User(t2, c), bs) if *t2 == tid => { + bind_tys(n, g, bs, self.ctor_fields(tid, *c)?) + } + PlanPat::Wild => Some(g.clone()), + _ => None, + } + } + + fn ty_var_arms( + &self, + n: u32, + g: &Gamma, + tail: bool, + tid: u32, + arms: &[(PlanPat, PlanExpr)], + ) -> Option { + match arms { + [] => None, + [(p, b)] => self.ty_of(n, &self.var_arm_gamma(n, g, tid, p)?, tail, b), + [(p, b), rest @ ..] => { + if *p == PlanPat::Wild { + return None; + } + let g2 = self.var_arm_gamma(n, g, tid, p)?; + let a = self.ty_of(n, &g2, tail, b)?; + let c = self.ty_var_arms(n, g, tail, tid, rest)?; + (a == c).then_some(a) + } + } + } + + fn ty_str_arms( + &self, + n: u32, + g: &Gamma, + tail: bool, + arms: &[(PlanPat, PlanExpr)], + ) -> Option { + let ((p, b), rest) = arms.split_first()?; + match p { + PlanPat::LitStr(_) => { + let t = self.ty_of(n, g, tail, b)?; + let t2 = self.ty_str_arms(n, g, tail, rest)?; + (t == t2).then_some(t) + } + PlanPat::Wild if rest.is_empty() => self.ty_of(n, g, tail, b), + _ => None, + } + } + + fn ty_tup_arms( + &self, + n: u32, + g: &Gamma, + tail: bool, + tid: u32, + arms: &[(PlanPat, PlanExpr)], + ) -> Option { + let [(PlanPat::Tuple(bs), b)] = arms else { + return None; + }; + let fts = self.rec_fields(tid)?; + (fts.len() >= 2 && bs.iter().any(|x| *x != PLAN_NO_SLOT)).then_some(())?; + self.ty_of(n, &bind_tys(n, g, bs, fts)?, tail, b) + } +} + +fn params_gamma(ps: &[PlanTy]) -> Gamma { + ps.iter() + .enumerate() + .map(|(i, t)| (i as u32, t.clone())) + .collect() +} + +/// `Grammar.planTyped`. +fn plan_typed(m: &MCtx<'_>, p: &FnPlan) -> bool { + let np = p.params.len(); + np <= p.nslots as usize + && (p.nslots as usize) <= np + p.locals.len() + && m.ty_of(p.nslots, ¶ms_gamma(&p.params), true, &p.body) == Some(p.ret.clone()) +} + +// ---- `TypeTable.declsWellFormed`: no vacuous obligation ---- + +/// `TypeTable.noEqref`. +fn no_eqref(t: &PlanTy) -> bool { + match t { + PlanTy::Eqref => false, + PlanTy::Option(x) | PlanTy::Vec(x) | PlanTy::List(x) => no_eqref(x), + PlanTy::Result(x, e) => no_eqref(x) && no_eqref(e), + _ => true, + } +} + +/// `TypeTable.planEqrefOk`: `eqref` only as the subject-scratch local. +fn plan_eqref_ok(p: &FnPlan) -> bool { + let scratch = (p.nslots as usize).saturating_sub(p.params.len()); + p.params.iter().all(no_eqref) + && no_eqref(&p.ret) + && p.locals + .iter() + .enumerate() + .all(|(i, t)| no_eqref(t) || (i == scratch && *t == PlanTy::Eqref)) +} + +/// `TypeTable.inhabTy`. +fn inhab_ty(r: &BTreeSet, s: &BTreeSet, t: &PlanTy) -> bool { + match t { + PlanTy::Int + | PlanTy::Bool + | PlanTy::Float + | PlanTy::Str + | PlanTy::Opaque(_) + | PlanTy::Option(_) + | PlanTy::List(_) + | PlanTy::Vec(_) => true, + PlanTy::Result(x, e) => inhab_ty(r, s, x) || inhab_ty(r, s, e), + PlanTy::Record(tid) => r.contains(tid), + PlanTy::Sum(tid) => s.contains(tid), + PlanTy::Eqref => false, + } +} + +/// `TypeTable.inhabSets`: the record and sum ids with a finite value (the +/// least fixpoint of `inhabStep`). +fn inhab_sets(tt: &PlanTypeTable) -> (BTreeSet, BTreeSet) { + let mut r: BTreeSet = BTreeSet::new(); + let mut s: BTreeSet = BTreeSet::new(); + for _ in 0..=(tt.records.len() + tt.sums.len()) { + let nr: BTreeSet = tt + .records + .iter() + .filter(|d| { + tt.records + .iter() + .find(|x| x.tid == d.tid) + .is_some_and(|x| x.fields.iter().all(|f| inhab_ty(&r, &s, f))) + }) + .map(|d| d.tid) + .collect(); + let ns: BTreeSet = tt + .sums + .iter() + .filter(|d| { + tt.sums.iter().find(|x| x.tid == d.tid).is_some_and(|x| { + x.ctors + .iter() + .any(|c| c.1.iter().all(|f| inhab_ty(&r, &s, f))) + }) + }) + .map(|d| d.tid) + .collect(); + r = nr; + s = ns; + } + (r, s) +} + +/// `TypeTable.ntGrounded` from a record id: its chain of one-field records +/// ends at a type that is not one. +fn newtype_grounded(tt: &PlanTypeTable, tid: u32) -> bool { + let mut cur = PlanTy::Record(tid); + for _ in 0..=tt.records.len() { + let PlanTy::Record(t) = cur else { + return true; + }; + match tt.records.iter().find(|r| r.tid == t) { + Some(r) if r.fields.len() == 1 => cur = r.fields[0].clone(), + _ => return true, + } + } + false +} + +/// `Grammar.LCtx`. +struct LCtx { + n: u32, + cmp: u32, + subj: u32, +} + +fn lctx(p: &FnPlan) -> LCtx { + let at = (p.nslots as usize).checked_sub(p.params.len()); + if at.and_then(|i| p.locals.get(i)) == Some(&PlanTy::Eqref) { + LCtx { + n: p.nslots, + cmp: p.nslots + 1, + subj: p.nslots, + } + } else { + LCtx { + n: p.nslots, + cmp: p.nslots, + subj: p.nslots, + } + } +} + +/// `CertPrelude.WInstr`, the admitted part. +#[derive(Clone, Debug, PartialEq)] +enum WI { + LocalGet(u32), + LocalSet(u32), + I64Const(i64), + I32Const(i64), + Call(u64), + ReturnCall(u64), + StructNew(u64), + StructGet(u64, u32), + RefIsNull, + I64Eqz, + I32Eqz, + I32Eq, + I32Ne, + I32LtS, + I32GtS, + I32LeS, + I32GeS, + I64Eq, + I64Ne, + I64LtS, + I64GtS, + I64LeS, + I64GeS, + I32And, + I32Or, + I32LtU, + F64Const(u64), + F64Eq, + F64Lt, + F64Gt, + F64Le, + F64Ge, + ArrayLen, + ArrayGet(u64), + ArrayNewFixed(u64, u32), + RefTest(u64), + RefCast(u64), +} + +/// `GrammarLower.BI`. +#[derive(Clone, Debug, PartialEq)] +enum BI { + Op(WI), + If(Option, Vec, Vec), + NullOf(u64), + NewData(u64, u64), + CastNull(u64), +} + +fn flip(op: PlanBinOp) -> PlanBinOp { + match op { + PlanBinOp::Lt => PlanBinOp::Gt, + PlanBinOp::Gt => PlanBinOp::Lt, + PlanBinOp::Lte => PlanBinOp::Gte, + PlanBinOp::Gte => PlanBinOp::Lte, + other => other, + } +} + +fn small_cmp(op: PlanBinOp) -> WI { + match op { + PlanBinOp::Eq => WI::I64Eq, + PlanBinOp::Neq => WI::I64Ne, + PlanBinOp::Lt => WI::I64LtS, + PlanBinOp::Gt => WI::I64GtS, + PlanBinOp::Lte => WI::I64LeS, + _ => WI::I64GeS, + } +} + +fn big_cmp(c: u64, s: u32, op: PlanBinOp) -> Vec { + match op { + PlanBinOp::Lt | PlanBinOp::Lte => vec![ + WI::LocalGet(s), + WI::StructGet(c, 2), + WI::I32Const(0), + WI::I32LtS, + ], + PlanBinOp::Gt | PlanBinOp::Gte => vec![ + WI::LocalGet(s), + WI::StructGet(c, 2), + WI::I32Const(0), + WI::I32GtS, + ], + PlanBinOp::Eq => vec![WI::I32Const(0)], + PlanBinOp::Neq => vec![WI::I32Const(1)], + _ => vec![], + } +} + +fn cmp_arm(c: u64, s: u32, op: PlanBinOp, k: i64) -> Vec { + vec![ + BI::Op(WI::LocalGet(s)), + BI::Op(WI::StructGet(c, 1)), + BI::Op(WI::RefIsNull), + BI::If( + Some(PlanTy::Bool), + vec![ + BI::Op(WI::LocalGet(s)), + BI::Op(WI::StructGet(c, 0)), + BI::Op(WI::I64Const(k)), + BI::Op(small_cmp(op)), + ], + big_cmp(c, s, op).into_iter().map(BI::Op).collect(), + ), + ] +} + +fn ops(is: Vec) -> Vec { + is.into_iter().map(BI::Op).collect() +} + +impl MCtx<'_> { + fn int_cmp_tail(&self, op: PlanBinOp) -> Vec { + match op { + PlanBinOp::Eq => vec![WI::Call(self.eq)], + PlanBinOp::Neq => vec![WI::Call(self.eq), WI::I32Eqz], + PlanBinOp::Lt => vec![WI::Call(self.cmp), WI::I32Const(0), WI::I32LtS], + PlanBinOp::Gt => vec![WI::Call(self.cmp), WI::I32Const(0), WI::I32GtS], + PlanBinOp::Lte => vec![WI::Call(self.cmp), WI::I32Const(0), WI::I32LeS], + _ => vec![WI::Call(self.cmp), WI::I32Const(0), WI::I32GeS], + } + } + + fn str_lit(&self, bytes: &[u8]) -> Vec { + vec![ + BI::Op(WI::I32Const(0)), + BI::Op(WI::I32Const(bytes.len() as i64)), + BI::NewData(self.str_, self.str_seg(bytes)), + ] + } + + fn concat(&self, n: usize) -> Vec { + vec![ + BI::Op(WI::ArrayNewFixed(self.str_vec, n as u32)), + BI::Op(WI::Call(self.concat)), + ] + } + + fn dflt(&self, t: &PlanTy) -> Vec { + match t { + PlanTy::Int => vec![ + BI::Op(WI::I64Const(0)), + BI::NullOf(self.mag), + BI::Op(WI::I32Const(0)), + BI::Op(WI::StructNew(self.carrier)), + ], + PlanTy::Bool => vec![BI::Op(WI::I32Const(0))], + PlanTy::Record(tid) => vec![BI::NullOf(self.struct_of(*tid))], + PlanTy::Sum(tid) => vec![BI::NullOf(self.sum_root(*tid))], + PlanTy::Option(x) => vec![BI::NullOf(self.opt_struct(x))], + PlanTy::Result(x, e) => vec![BI::NullOf(self.res_struct(x, e))], + PlanTy::Str => vec![BI::NullOf(self.str_)], + PlanTy::Float => vec![BI::Op(WI::F64Const(0))], + PlanTy::List(x) => vec![BI::NullOf(self.list_struct(x))], + PlanTy::Vec(x) => vec![BI::NullOf(self.vec_struct(x))], + _ => vec![], + } + } + + fn lower_args(&self, x: &LCtx, g: &Gamma, es: &[PlanExpr]) -> Vec { + es.iter().flat_map(|e| self.lower(x, g, false, e)).collect() + } + + /// `GrammarLower.lowerB`. + fn lower(&self, x: &LCtx, g: &Gamma, tail: bool, e: &PlanExpr) -> Vec { + let n = x.n; + match e { + PlanExpr::Literal(PlanLit::Int(k)) => ops(vec![WI::I64Const(*k), WI::Call(self.box_)]), + PlanExpr::Literal(PlanLit::Bool(b)) => ops(vec![WI::I32Const(i64::from(*b))]), + PlanExpr::Literal(PlanLit::Float(bits)) => ops(vec![WI::F64Const(*bits)]), + PlanExpr::Literal(PlanLit::Str(bytes)) => self.str_lit(bytes), + PlanExpr::Local(i) => ops(vec![WI::LocalGet(*i)]), + PlanExpr::Let(b, v, body) => { + let mut out = self.lower(x, g, false, v); + out.push(BI::Op(WI::LocalSet(*b))); + let g2 = match self.ty_of(n, g, false, v) { + Some(t) => upd(g, *b, t), + None => g.clone(), + }; + out.extend(self.lower(x, &g2, tail, body)); + out + } + PlanExpr::Call(PlanCallee::Fn(f), args) => { + let mut out = self.lower_args(x, g, args); + out.push(BI::Op(WI::Call(u64::from(*f)))); + out + } + PlanExpr::Call(PlanCallee::Builtin(b), args) => { + let mut out = self.lower_args(x, g, args); + match (b, self.tys_of(n, g, args).as_deref()) { + (PlanBuiltin::BoolAnd, _) => out.push(BI::Op(WI::I32And)), + (PlanBuiltin::BoolOr, _) => out.push(BI::Op(WI::I32Or)), + (PlanBuiltin::BoolNot, _) => out.push(BI::Op(WI::I32Eqz)), + (PlanBuiltin::ListPrepend, Some([_, PlanTy::List(t)])) => { + out.push(BI::Op(WI::StructNew(self.list_struct(t)))) + } + _ => {} + } + out + } + PlanExpr::Call(PlanCallee::Intrinsic(i), args) => { + let mut out = self.lower_args(x, g, args); + out.extend(ops(vec![ + WI::I32Const(i64::from(*i == PlanIntrinsic::IntModEuclid)), + WI::Call(self.divmod), + ])); + out + } + PlanExpr::TailCall(f, args) => { + let mut out = self.lower_args(x, g, args); + out.push(BI::Op(WI::ReturnCall(u64::from(*f)))); + out + } + PlanExpr::BinOp(op, l, r) => { + let lt = self.ty_of(n, g, false, l); + match lt { + Some(PlanTy::Bool) => { + let mut out = self.lower(x, g, false, l); + out.extend(self.lower(x, g, false, r)); + out.push(BI::Op(if *op == PlanBinOp::Eq { + WI::I32Eq + } else { + WI::I32Ne + })); + out + } + Some(PlanTy::Float) => { + let mut out = self.lower(x, g, false, l); + out.extend(self.lower(x, g, false, r)); + out.push(BI::Op(match op { + PlanBinOp::Eq => WI::F64Eq, + PlanBinOp::Lt => WI::F64Lt, + PlanBinOp::Gt => WI::F64Gt, + PlanBinOp::Lte => WI::F64Le, + _ => WI::F64Ge, + })); + out + } + Some(PlanTy::Str) => { + let mut out = self.lower(x, g, false, l); + out.extend(self.lower(x, g, false, r)); + match op { + PlanBinOp::Add => out.extend(self.concat(2)), + PlanBinOp::Eq => out.push(BI::Op(WI::Call(self.streq))), + _ => out.extend(ops(vec![WI::Call(self.streq), WI::I32Eqz])), + } + out + } + _ => { + if is_arith(*op) { + let mut out = self.lower(x, g, false, l); + out.extend(self.lower(x, g, false, r)); + out.push(BI::Op(WI::Call(self.arith_idx(*op)))); + return out; + } + let lit = |ex: &PlanExpr| match ex { + PlanExpr::Literal(PlanLit::Int(k)) => Some(*k), + _ => None, + }; + let slot = |ex: &PlanExpr| match ex { + PlanExpr::Local(i) => Some(*i), + _ => None, + }; + match (lit(l), lit(r)) { + (Some(k), _) => match slot(r) { + Some(i) => cmp_arm(self.carrier, i, flip(*op), k), + None => { + let mut out = self.lower(x, g, false, r); + out.push(BI::Op(WI::LocalSet(x.cmp))); + out.extend(cmp_arm(self.carrier, x.cmp, flip(*op), k)); + out + } + }, + (None, Some(k)) => match slot(l) { + Some(i) => cmp_arm(self.carrier, i, *op, k), + None => { + let mut out = self.lower(x, g, false, l); + out.push(BI::Op(WI::LocalSet(x.cmp))); + out.extend(cmp_arm(self.carrier, x.cmp, *op, k)); + out + } + }, + (None, None) => { + let mut out = self.lower(x, g, false, l); + out.extend(self.lower(x, g, false, r)); + out.extend(ops(self.int_cmp_tail(*op))); + out + } + } + } + } + } + PlanExpr::Neg(ex) => { + let mut out = self.lower(x, g, false, ex); + out.push(BI::Op(WI::Call(self.neg))); + out + } + PlanExpr::If(c, t, el) => { + let mut out = self.lower(x, g, false, c); + out.push(BI::If( + self.ty_of(n, g, tail, t), + self.lower(x, g, tail, t), + self.lower(x, g, tail, el), + )); + out + } + PlanExpr::RecordCreate(tid, fs) => { + let mut out = self.lower_args(x, g, fs); + out.push(BI::Op(WI::StructNew(self.struct_of(*tid)))); + out + } + PlanExpr::Project(tid, i, base) => { + let mut out = self.lower(x, g, false, base); + out.push(BI::Op(WI::StructGet(self.struct_of(*tid), *i))); + out + } + PlanExpr::Call(PlanCallee::Lazy(lb), args) => { + let [o, d] = args.as_slice() else { + return vec![]; + }; + if let Some((v, i)) = vec_get_or(*lb, o, d) { + let Some(PlanTy::Vec(t)) = g.get(&v) else { + return vec![]; + }; + let ti = self.to_index; + let mut out = ops(vec![ + WI::LocalGet(i), + WI::Call(ti), + WI::I32Const(0), + WI::I32GeS, + WI::LocalGet(i), + WI::Call(ti), + WI::LocalGet(v), + WI::ArrayLen, + WI::I32LtU, + WI::I32And, + ]); + out.push(BI::If( + Some(t.as_ref().clone()), + ops(vec![ + WI::LocalGet(v), + WI::LocalGet(i), + WI::Call(ti), + WI::ArrayGet(self.vec_struct(t)), + ]), + self.lower(x, g, false, d), + )); + return out; + } + if let Some((is_mod, _, _)) = div_or(*lb, o, d) { + // `o`'s own lowering is its two operands. + let c = x.cmp; + let mut out = self.lower(x, g, false, o); + out.extend(self.lower(x, g, false, d)); + out.extend(ops(vec![ + WI::LocalSet(c + 3), + WI::LocalSet(c + 2), + WI::LocalSet(c + 1), + WI::LocalGet(c + 2), + WI::StructGet(self.carrier, 1), + WI::RefIsNull, + WI::LocalGet(c + 2), + WI::StructGet(self.carrier, 0), + WI::I64Eqz, + WI::I32And, + ])); + out.push(BI::If( + Some(PlanTy::Int), + ops(vec![WI::LocalGet(c + 3)]), + ops(vec![ + WI::LocalGet(c + 1), + WI::LocalGet(c + 2), + WI::I32Const(i64::from(is_mod)), + WI::Call(self.divmod), + ]), + )); + return out; + } + let (st, payload_ty) = match (lb, self.ty_of(n, g, false, o)) { + (PlanLazy::OptWithDefault, Some(PlanTy::Option(t))) => { + (self.opt_struct(&t), *t) + } + (PlanLazy::ResWithDefault, Some(PlanTy::Result(t, er))) => { + (self.res_struct(&t, &er), *t) + } + _ => return vec![], + }; + let mut out = self.lower(x, g, false, o); + out.push(BI::Op(WI::LocalSet(x.subj))); + out.extend(tag_test(x.subj, st)); + out.push(BI::If( + Some(payload_ty), + ops(vec![ + WI::LocalGet(x.subj), + WI::RefCast(st), + WI::StructGet(st, 1), + ]), + self.lower(x, g, false, d), + )); + out + } + PlanExpr::Construct(c, ty, args) => match (c, ty) { + (PlanCtor::User(tid, k), _) => { + let mut out = self.lower_args(x, g, args); + out.push(BI::Op(WI::StructNew(self.ctor_struct(*tid, *k)))); + out + } + (PlanCtor::Some, PlanTy::Option(t)) => { + let mut out = ops(vec![WI::I32Const(1)]); + out.extend(self.lower_args(x, g, args)); + out.push(BI::Op(WI::StructNew(self.opt_struct(t)))); + out + } + (PlanCtor::None, PlanTy::Option(t)) => { + let mut out = ops(vec![WI::I32Const(0)]); + out.extend(self.dflt(t)); + out.extend(self.lower_args(x, g, args)); + out.push(BI::Op(WI::StructNew(self.opt_struct(t)))); + out + } + (PlanCtor::Ok, PlanTy::Result(t, er)) => { + let mut out = ops(vec![WI::I32Const(1)]); + out.extend(self.lower_args(x, g, args)); + out.extend(self.dflt(er)); + out.push(BI::Op(WI::StructNew(self.res_struct(t, er)))); + out + } + (PlanCtor::Err, PlanTy::Result(t, er)) => { + let mut out = ops(vec![WI::I32Const(0)]); + out.extend(self.dflt(t)); + out.extend(self.lower_args(x, g, args)); + out.push(BI::Op(WI::StructNew(self.res_struct(t, er)))); + out + } + _ => vec![], + }, + PlanExpr::Match(s, arms) => { + let bt = self.ty_of(n, g, tail, e); + let sc = self.lower(x, g, false, s); + match self.ty_of(n, g, false, s) { + Some(PlanTy::Int) => self.lower_int_arms(x, g, tail, &sc, &bt, arms), + Some(PlanTy::Bool) => { + let mut out = sc; + if let [(PlanPat::LitBool(v), t), (_, el), ..] = arms.as_slice() { + let (a, b) = if *v { (t, el) } else { (el, t) }; + out.push(BI::If( + bt, + self.lower(x, g, tail, a), + self.lower(x, g, tail, b), + )); + } + out + } + Some(PlanTy::Option(t)) => { + let mut out = sc; + out.push(BI::Op(WI::LocalSet(x.subj))); + if let [(p1, b1), (p2, b2), ..] = arms.as_slice() + && let Some((swap, sb)) = opt_pick(p1, p2) + { + let st = self.opt_struct(&t); + let (some_b, none_b) = if swap { (b2, b1) } else { (b1, b2) }; + let gs = bind_one(n, g, sb, &t).unwrap_or_else(|| g.clone()); + out.extend(tag_test(x.subj, st)); + let mut then_b = bind_field(x.subj, st, 1, sb); + then_b.extend(self.lower(x, &gs, tail, some_b)); + out.push(BI::If(bt, then_b, self.lower(x, g, tail, none_b))); + } + out + } + Some(PlanTy::Result(t, er)) => { + let mut out = sc; + out.push(BI::Op(WI::LocalSet(x.subj))); + if let [(p1, b1), (p2, b2), ..] = arms.as_slice() + && let Some((swap, ob, eb)) = res_pick(p1, p2) + { + let st = self.res_struct(&t, &er); + let (ok_b, err_b) = if swap { (b2, b1) } else { (b1, b2) }; + let go = bind_one(n, g, ob, &t).unwrap_or_else(|| g.clone()); + let ge = bind_one(n, g, eb, &er).unwrap_or_else(|| g.clone()); + out.extend(tag_test(x.subj, st)); + let mut then_b = bind_field(x.subj, st, 1, ob); + then_b.extend(self.lower(x, &go, tail, ok_b)); + let mut else_b = bind_field(x.subj, st, 2, eb); + else_b.extend(self.lower(x, &ge, tail, err_b)); + out.push(BI::If(bt, then_b, else_b)); + } + out + } + Some(PlanTy::Sum(tid)) => { + let mut out = sc; + out.push(BI::Op(WI::LocalSet(x.subj))); + out.extend(self.lower_var_arms(x, g, tail, &bt, tid, arms)); + out + } + Some(PlanTy::Str) => { + let mut out = sc; + out.push(BI::Op(WI::LocalSet(x.subj))); + out.extend(self.lower_str_arms(x, g, tail, &bt, arms)); + out + } + Some(PlanTy::Record(tid)) => { + let mut out = sc; + out.push(BI::Op(WI::LocalSet(x.subj))); + if let [(PlanPat::Tuple(bs), b), ..] = arms.as_slice() { + out.extend(extract(x.subj, self.struct_of(tid), bs)); + let g2 = self + .rec_fields(tid) + .and_then(|fts| bind_tys(n, g, bs, fts)) + .unwrap_or_else(|| g.clone()); + out.extend(self.lower(x, &g2, tail, b)); + } + out + } + _ => vec![], + } + } + PlanExpr::Interp(parts) => { + let mut out = self.lower_args(x, g, parts); + out.extend(self.concat(parts.len())); + out + } + PlanExpr::List(t, _) => vec![BI::NullOf(self.list_struct(t))], + } + } + + fn lower_int_arms( + &self, + x: &LCtx, + g: &Gamma, + tail: bool, + sc: &[BI], + bt: &Option, + arms: &[(PlanPat, PlanExpr)], + ) -> Vec { + let Some(((p, b), rest)) = arms.split_first() else { + return vec![]; + }; + match p { + PlanPat::LitInt(k) => { + let mut out = sc.to_vec(); + out.extend(ops(vec![ + WI::I64Const(*k), + WI::Call(self.box_), + WI::Call(self.eq), + ])); + out.push(BI::If( + bt.clone(), + self.lower(x, g, tail, b), + self.lower_int_arms(x, g, tail, sc, bt, rest), + )); + out + } + PlanPat::Wild => self.lower(x, g, tail, b), + PlanPat::Bind(s) => { + let mut out = sc.to_vec(); + out.push(BI::Op(WI::LocalSet(*s))); + out.extend(self.lower(x, &upd(g, *s, PlanTy::Int), tail, b)); + out + } + _ => vec![], + } + } + + fn lower_var_arms( + &self, + x: &LCtx, + g: &Gamma, + tail: bool, + bt: &Option, + tid: u32, + arms: &[(PlanPat, PlanExpr)], + ) -> Vec { + match arms { + [] => vec![], + [(p, b)] => match p { + PlanPat::Ctor(PlanCtor::User(t2, c), bs) => { + let mut out = extract(x.subj, self.ctor_struct(*t2, *c), bs); + let g2 = self + .var_arm_gamma(x.n, g, tid, p) + .unwrap_or_else(|| g.clone()); + out.extend(self.lower(x, &g2, tail, b)); + out + } + _ => self.lower(x, g, tail, b), + }, + [(p, b), rest @ ..] => match p { + PlanPat::Ctor(PlanCtor::User(t2, c), bs) => { + let st = self.ctor_struct(*t2, *c); + let mut then_b = extract(x.subj, st, bs); + let g2 = self + .var_arm_gamma(x.n, g, tid, p) + .unwrap_or_else(|| g.clone()); + then_b.extend(self.lower(x, &g2, tail, b)); + vec![ + BI::Op(WI::LocalGet(x.subj)), + BI::Op(WI::RefTest(st)), + BI::If( + bt.clone(), + then_b, + self.lower_var_arms(x, g, tail, bt, tid, rest), + ), + ] + } + PlanPat::Wild => self.lower(x, g, tail, b), + _ => vec![], + }, + } + } + + fn lower_str_arms( + &self, + x: &LCtx, + g: &Gamma, + tail: bool, + bt: &Option, + arms: &[(PlanPat, PlanExpr)], + ) -> Vec { + let Some(((p, b), rest)) = arms.split_first() else { + return vec![]; + }; + match p { + PlanPat::LitStr(k) => { + let mut out = vec![BI::Op(WI::LocalGet(x.subj)), BI::CastNull(self.str_)]; + out.extend(self.str_lit(k)); + out.push(BI::Op(WI::Call(self.streq))); + out.push(BI::If( + bt.clone(), + self.lower(x, g, tail, b), + self.lower_str_arms(x, g, tail, bt, rest), + )); + out + } + _ => self.lower(x, g, tail, b), + } + } +} + +fn tag_test(ss: u32, idx: u64) -> Vec { + ops(vec![ + WI::LocalGet(ss), + WI::RefCast(idx), + WI::StructGet(idx, 0), + WI::I32Const(1), + WI::I32Eq, + ]) +} + +fn bind_field(ss: u32, idx: u64, i: u32, b: u32) -> Vec { + if b == PLAN_NO_SLOT { + vec![] + } else { + ops(vec![ + WI::LocalGet(ss), + WI::RefCast(idx), + WI::StructGet(idx, i), + WI::LocalSet(b), + ]) + } +} + +fn extract(ss: u32, idx: u64, bs: &[u32]) -> Vec { + bs.iter() + .enumerate() + .flat_map(|(i, b)| bind_field(ss, idx, i as u32, *b)) + .collect() +} + +// ---- the byte image ---- + +fn uleb(v: u64, out: &mut Vec) -> Option<()> { + if v >= 4_294_967_296 { + return None; + } + let mut v = v; + loop { + let byte = (v & 0x7f) as u8; + v >>= 7; + if v == 0 { + out.push(byte); + return Some(()); + } + out.push(byte | 0x80); + } +} + +fn sleb(v: i64, out: &mut Vec) { + let mut v = v; + loop { + let byte = (v & 0x7f) as u8; + v >>= 7; + let done = (v == 0 && byte & 0x40 == 0) || (v == -1 && byte & 0x40 != 0); + if done { + out.push(byte); + return; + } + out.push(byte | 0x80); + } +} + +fn s33(idx: u64, out: &mut Vec) -> Option<()> { + if idx >= 4_294_967_296 { + return None; + } + sleb(idx as i64, out); + Some(()) +} + +impl MCtx<'_> { + /// `GrammarLower.valTy`. + fn val_ty(&self, t: &PlanTy, out: &mut Vec) -> Option<()> { + let heap = |i: u64, out: &mut Vec| { + out.push(0x63); + s33(i, out) + }; + match t { + PlanTy::Int => heap(self.carrier, out), + PlanTy::Bool => { + out.push(0x7f); + Some(()) + } + PlanTy::Record(tid) => heap(self.struct_of(*tid), out), + PlanTy::Sum(tid) => heap(self.sum_root(*tid), out), + PlanTy::Option(x) => heap(self.opt_struct(x), out), + PlanTy::Result(x, e) => heap(self.res_struct(x, e), out), + PlanTy::Eqref => { + out.push(0x6d); + Some(()) + } + PlanTy::Float => { + out.push(0x7c); + Some(()) + } + PlanTy::Str => heap(self.str_, out), + PlanTy::Vec(x) => heap(self.vec_struct(x), out), + PlanTy::List(x) => heap(self.list_struct(x), out), + PlanTy::Opaque(tid) => heap(self.opaque_struct(*tid), out), + } + } + + fn enc_w(&self, i: &WI, out: &mut Vec) -> Option<()> { + match i { + WI::LocalGet(x) => { + out.push(0x20); + uleb(u64::from(*x), out)? + } + WI::LocalSet(x) => { + out.push(0x21); + uleb(u64::from(*x), out)? + } + WI::I64Const(k) => { + out.push(0x42); + sleb(*k, out) + } + WI::I32Const(k) => { + if *k < i64::from(i32::MIN) || *k > i64::from(i32::MAX) { + return None; + } + out.push(0x41); + sleb(*k, out) + } + WI::Call(f) => { + out.push(0x10); + uleb(*f, out)? + } + WI::ReturnCall(f) => { + out.push(0x12); + uleb(*f, out)? + } + WI::StructNew(t) => { + out.extend([0xfb, 0x00]); + uleb(*t, out)? + } + WI::StructGet(t, fld) => { + out.extend([0xfb, 0x02]); + uleb(*t, out)?; + uleb(u64::from(*fld), out)? + } + WI::RefIsNull => out.push(0xd1), + WI::I64Eqz => out.push(0x50), + WI::I32Eqz => out.push(0x45), + WI::I32Eq => out.push(0x46), + WI::I32Ne => out.push(0x47), + WI::I32LtS => out.push(0x48), + WI::I32GtS => out.push(0x4a), + WI::I32LeS => out.push(0x4c), + WI::I32GeS => out.push(0x4e), + WI::I64Eq => out.push(0x51), + WI::I64Ne => out.push(0x52), + WI::I64LtS => out.push(0x53), + WI::I64GtS => out.push(0x55), + WI::I64LeS => out.push(0x57), + WI::I64GeS => out.push(0x59), + WI::I32And => out.push(0x71), + WI::I32Or => out.push(0x72), + WI::I32LtU => out.push(0x49), + WI::F64Const(bits) => { + out.push(0x44); + out.extend(bits.to_le_bytes()) + } + WI::F64Eq => out.push(0x61), + WI::F64Lt => out.push(0x63), + WI::F64Gt => out.push(0x64), + WI::F64Le => out.push(0x65), + WI::F64Ge => out.push(0x66), + WI::ArrayLen => out.extend([0xfb, 0x0f]), + WI::ArrayGet(t) => { + out.extend([0xfb, 0x0b]); + uleb(*t, out)? + } + WI::ArrayNewFixed(t, n) => { + out.extend([0xfb, 0x08]); + uleb(*t, out)?; + uleb(u64::from(*n), out)? + } + WI::RefTest(t) => { + out.extend([0xfb, 0x14]); + s33(*t, out)? + } + WI::RefCast(t) => { + out.extend([0xfb, 0x16]); + s33(*t, out)? + } + } + Some(()) + } + + fn enc(&self, bs: &[BI], out: &mut Vec) -> Option<()> { + for b in bs { + match b { + BI::Op(i) => self.enc_w(i, out)?, + BI::If(bt, t, e) => { + out.push(0x04); + self.val_ty(bt.as_ref()?, out)?; + self.enc(t, out)?; + out.push(0x05); + self.enc(e, out)?; + out.push(0x0b); + } + BI::NullOf(ht) => { + out.push(0xd0); + s33(*ht, out)? + } + BI::NewData(ty, seg) => { + out.extend([0xfb, 0x09]); + uleb(*ty, out)?; + uleb(*seg, out)? + } + BI::CastNull(ht) => { + out.extend([0xfb, 0x17]); + s33(*ht, out)? + } + } + } + Some(()) + } + + fn lower_plan(&self, p: &FnPlan) -> Vec { + self.lower(&lctx(p), ¶ms_gamma(&p.params), true, &p.body) + } + + /// `GrammarLower.codeEntryBytes`. + fn code_entry_bytes(&self, p: &FnPlan) -> Option> { + let mut entry = Vec::new(); + uleb(p.locals.len() as u64, &mut entry)?; + for t in &p.locals { + entry.push(0x01); + self.val_ty(t, &mut entry)?; + } + self.enc(&self.lower_plan(p), &mut entry)?; + entry.push(0x0b); + let mut out = Vec::new(); + uleb(entry.len() as u64, &mut out)?; + out.extend(entry); + Some(out) + } + + /// `TypeTable.valTyD` against the decoded value type. + fn val_t(&self, t: &PlanTy) -> Option { + let r = |i: u64| (i < 4_294_967_296).then_some(ValT::RefNull(i as u32)); + match t { + PlanTy::Int => r(self.carrier), + PlanTy::Bool => Some(ValT::I32), + PlanTy::Float => Some(ValT::F64), + PlanTy::Eqref => Some(ValT::Eqref), + PlanTy::Record(tid) => r(self.struct_of(*tid)), + PlanTy::Sum(tid) => r(self.sum_root(*tid)), + PlanTy::Option(x) => r(self.opt_struct(x)), + PlanTy::Result(x, e) => r(self.res_struct(x, e)), + PlanTy::Str => r(self.str_), + PlanTy::Vec(x) => r(self.vec_struct(x)), + PlanTy::List(x) => r(self.list_struct(x)), + PlanTy::Opaque(tid) => r(self.opaque_struct(*tid)), + } + } +} + +/// Every function index a lowered body calls (`ClaimAxes.wCallsL`). +fn lowered_calls(bs: &[BI], out: &mut Vec) { + for b in bs { + match b { + BI::Op(WI::Call(f)) | BI::Op(WI::ReturnCall(f)) => out.push(*f), + BI::If(_, t, e) => { + lowered_calls(t, out); + lowered_calls(e, out); + } + _ => {} + } + } +} + +/// `AcceptedArtifact.callTargets`. +fn call_targets(e: &PlanExpr, out: &mut Vec) { + match e { + PlanExpr::Literal(_) | PlanExpr::Local(_) | PlanExpr::List(_, _) => {} + PlanExpr::Let(_, v, b) => { + call_targets(v, out); + call_targets(b, out); + } + PlanExpr::Call(PlanCallee::Fn(f), args) | PlanExpr::TailCall(f, args) => { + out.push(*f); + args.iter().for_each(|a| call_targets(a, out)); + } + PlanExpr::Call(_, args) + | PlanExpr::RecordCreate(_, args) + | PlanExpr::Construct(_, _, args) + | PlanExpr::Interp(args) => args.iter().for_each(|a| call_targets(a, out)), + PlanExpr::BinOp(_, l, r) => { + call_targets(l, out); + call_targets(r, out); + } + PlanExpr::Neg(x) | PlanExpr::Project(_, _, x) => call_targets(x, out), + PlanExpr::If(c, t, el) => { + call_targets(c, out); + call_targets(t, out); + call_targets(el, out); + } + PlanExpr::Match(s, arms) => { + call_targets(s, out); + arms.iter().for_each(|(_, b)| call_targets(b, out)); + } + } +} + +/// `GrammarLower.exprLits`: every string literal a plan lowers to +/// `array.new_data`. +fn string_lits<'e>(e: &'e PlanExpr, out: &mut Vec<&'e [u8]>) { + match e { + PlanExpr::Literal(PlanLit::Str(b)) => out.push(b), + PlanExpr::Literal(_) | PlanExpr::Local(_) => {} + PlanExpr::Let(_, v, b) => { + string_lits(v, out); + string_lits(b, out); + } + PlanExpr::Call(_, args) + | PlanExpr::TailCall(_, args) + | PlanExpr::RecordCreate(_, args) + | PlanExpr::Construct(_, _, args) + | PlanExpr::Interp(args) + | PlanExpr::List(_, args) => args.iter().for_each(|a| string_lits(a, out)), + PlanExpr::BinOp(_, l, r) => { + string_lits(l, out); + string_lits(r, out); + } + PlanExpr::Neg(x) | PlanExpr::Project(_, _, x) => string_lits(x, out), + PlanExpr::If(c, t, el) => { + string_lits(c, out); + string_lits(t, out); + string_lits(el, out); + } + PlanExpr::Match(s, arms) => { + string_lits(s, out); + for (p, b) in arms { + if let PlanPat::LitStr(k) = p { + out.push(k); + } + string_lits(b, out); + } + } + } +} + +// ---- totality (`GrammarTotal`) ---- + +fn is_descent(e: &PlanExpr) -> bool { + matches!(e, PlanExpr::BinOp(PlanBinOp::Sub, l, r) + if **l == PlanExpr::Local(0) && **r == PlanExpr::Literal(PlanLit::Int(1))) +} + +fn tot_e(mem: &BTreeSet, mul_ok: bool, calls: bool, e: &PlanExpr) -> bool { + match e { + PlanExpr::Literal(PlanLit::Int(_) | PlanLit::Bool(_)) | PlanExpr::Local(_) => true, + PlanExpr::BinOp(op, l, r) => { + (matches!(op, PlanBinOp::Add | PlanBinOp::Sub) || (*op == PlanBinOp::Mul && mul_ok)) + && tot_e(mem, mul_ok, calls, l) + && tot_e(mem, mul_ok, calls, r) + } + PlanExpr::Call(PlanCallee::Fn(g), args) | PlanExpr::TailCall(g, args) => { + calls + && mem.contains(g) + && args.first().is_some_and(is_descent) + && args.iter().all(|a| tot_e(mem, mul_ok, calls, a)) + } + _ => false, + } +} + +fn has_call(e: &PlanExpr) -> bool { + match e { + PlanExpr::BinOp(_, l, r) => has_call(l) || has_call(r), + PlanExpr::Call(PlanCallee::Fn(_), _) | PlanExpr::TailCall(_, _) => true, + _ => false, + } +} + +fn uses_mul(e: &PlanExpr) -> bool { + match e { + PlanExpr::BinOp(op, l, r) => *op == PlanBinOp::Mul || uses_mul(l) || uses_mul(r), + PlanExpr::Call(_, args) | PlanExpr::TailCall(_, args) => args.iter().any(uses_mul), + PlanExpr::If(c, t, el) => uses_mul(c) || uses_mul(t) || uses_mul(el), + _ => false, + } +} + +fn tot_body(mem: &BTreeSet, mul_ok: bool, e: &PlanExpr) -> bool { + match e { + PlanExpr::If(c, base, step) => { + matches!(c.as_ref(), PlanExpr::BinOp(PlanBinOp::Lte, l, r) + if **l == PlanExpr::Local(0) && **r == PlanExpr::Literal(PlanLit::Int(0))) + && tot_e(mem, mul_ok, false, base) + && tot_e(mem, mul_ok, true, step) + && has_call(step) + } + _ => false, + } +} + +/// `GrammarTotal.checkTermGroup`: `Some(uses_mul)` when the group is L3. +fn check_term_group(members: &[(u32, &FnPlan)]) -> Option { + let mem: BTreeSet = members.iter().map(|m| m.0).collect(); + let mul = members.iter().any(|m| uses_mul(&m.1.body)); + let ok = !members.is_empty() + && members.iter().all(|(_, p)| { + !p.params.is_empty() + && p.params.iter().all(|t| *t == PlanTy::Int) + && matches!(p.ret, PlanTy::Int | PlanTy::Bool) + && tot_body(&mem, mul, &p.body) + }); + ok.then_some(mul) +} + +// ---- report facets (`ClaimAxes.facetsE`) ---- + +fn facets_e(e: &PlanExpr, out: &mut BTreeSet<&'static str>) { + match e { + PlanExpr::Literal(PlanLit::Str(_)) => { + out.insert("strings"); + } + PlanExpr::Literal(PlanLit::Float(_)) => { + out.insert("floats"); + } + PlanExpr::Literal(_) | PlanExpr::Local(_) => {} + PlanExpr::Let(_, v, b) => { + facets_e(v, out); + facets_e(b, out); + } + PlanExpr::Call(PlanCallee::Fn(_), args) | PlanExpr::TailCall(_, args) => { + out.insert("calls"); + args.iter().for_each(|a| facets_e(a, out)); + } + PlanExpr::Call(_, args) | PlanExpr::List(_, args) => { + args.iter().for_each(|a| facets_e(a, out)) + } + PlanExpr::BinOp(_, l, r) => { + facets_e(l, out); + facets_e(r, out); + } + PlanExpr::Neg(x) => facets_e(x, out), + PlanExpr::If(c, t, el) => { + facets_e(c, out); + facets_e(t, out); + facets_e(el, out); + } + PlanExpr::RecordCreate(_, fs) => { + out.insert("records"); + fs.iter().for_each(|a| facets_e(a, out)); + } + PlanExpr::Project(_, _, b) => { + out.insert("records"); + facets_e(b, out); + } + PlanExpr::Match(s, arms) => { + facets_e(s, out); + for (p, b) in arms { + match p { + PlanPat::Ctor(..) => { + out.insert("variants"); + } + PlanPat::LitStr(_) => { + out.insert("strings"); + } + PlanPat::Tuple(_) => { + out.insert("records"); + } + _ => {} + } + facets_e(b, out); + } + } + PlanExpr::Construct(_, _, args) => { + out.insert("variants"); + args.iter().for_each(|a| facets_e(a, out)); + } + PlanExpr::Interp(parts) => { + out.insert("strings"); + parts.iter().for_each(|a| facets_e(a, out)); + } + } +} diff --git a/aver-cert/src/engine/produce.rs b/aver-cert/src/engine/produce.rs new file mode 100644 index 000000000..5c569c3c4 --- /dev/null +++ b/aver-cert/src/engine/produce.rs @@ -0,0 +1,1176 @@ +// ---- the schema-9 producer --------------------------------------------------- +// +// Takes the compiler's printed plans (`ModulePlans`) and the exact module bytes, +// and decides which functions the certificate OFFERS: a function is offered +// when its plan types, lowers to exactly its code entry, has exactly its +// declared function type, cites only confirmed layout, and calls only offered +// functions. Everything else is declined per function with a reason. The +// offered set is grouped into call SCCs (callees first) and rendered; the +// wall re-checks all of it. + +/// One planned function of the package, in `fnPlans` order. +pub struct PackageEntry { + /// Export name, or `#` for an internal callee. + pub name: String, + pub exported: bool, + pub func_idx: u32, + pub group: u32, + pub plan: FnPlan, +} + +/// The report data of one certified export, as the wall derives it +/// (`AcceptedArtifact.obligationsOf`, `ClaimAxes.reportFacets`). The checker +/// witness pins every field. +pub struct CertifiedExport { + pub name: String, + pub func_idx: u32, + pub total: bool, + pub facets: Vec<&'static str>, +} + +pub struct Analysis { + carrier: Option, + /// The compiler's name of every printed function (the flattened wasm + /// name), by function index: the key of its Lean source definition. + fn_names: BTreeMap, + roles: Option, + string_roles: StringHostRoles, + entries: Vec, + types: PlanTypeTable, + certified: Vec, + declined: Vec<(String, String)>, + contracts: Vec, + module_envelope: ModuleEnvelopeFacts, +} + +impl Analysis { + pub fn certified_names(&self) -> Vec { + self.certified.iter().map(|c| c.name.clone()).collect() + } + + pub fn declined(&self) -> &[(String, String)] { + &self.declined + } + + pub fn entries(&self) -> &[PackageEntry] { + &self.entries + } + + pub fn certified(&self) -> &[CertifiedExport] { + &self.certified + } +} + +/// A decline reason the checker's display gate admits: printable ASCII +/// without quotes or backslashes, within the candidate length. +fn clean_reason(reason: &str) -> String { + let mut out: String = reason + .chars() + .map(|c| { + if c.is_ascii() && (' '..='~').contains(&c) && c != '"' && c != '\\' { + c + } else { + '?' + } + }) + .collect(); + let max = crate::format::MAX_CANDIDATE_LEN; + if out.len() > max { + out.truncate(max - 3); + out.push_str("..."); + } + out +} + +fn is_runtime_export(name: &str) -> bool { + name.starts_with("__") + || name == "_start" + || name == "memory" + || name.contains('#') + || name.contains(':') +} + +// ---- type table confirmation (`TypeTable.typeTableConfirmed`) ---- + +impl ModuleFacts { + fn group_entry(&self, idx: u64) -> Option<&TypeFact> { + (idx < self.first_group_len as u64).then(|| &self.types[idx as usize]) + } + + fn struct_is(&self, m: &MCtx<'_>, idx: u64, ts: &[PlanTy]) -> bool { + let Some(TypeFact { + comp: CompT::Struct(fields), + .. + }) = self.group_entry(idx) + else { + return false; + }; + let want: Option> = ts.iter().map(|t| m.val_t(t).map(StorT::Val)).collect(); + want.as_deref() == Some(fields.as_slice()) + } + + fn array_is(&self, idx: u64, st: StorT) -> bool { + matches!(self.group_entry(idx), Some(TypeFact { comp: CompT::Array(s), .. }) if *s == st) + } +} + +/// Drop every type-table entry the type section does not confirm, until the +/// table is stable (a dropped entry makes the entries that name it fail too). +fn confirm_type_table(facts: &ModuleFacts, tt: &mut PlanTypeTable) { + if facts.first_group_len == 0 { + *tt = PlanTypeTable::default(); + return; + } + // The carrier declaration is the byte carrier and its limb array. + let carrier_ok = match (facts.carrier, tt.carrier, tt.mag) { + (Some(c), Some(c2), Some(m)) => { + c == c2 + && facts.array_is(u64::from(m), StorT::Val(ValT::I64)) + && matches!(facts.group_entry(u64::from(c)), + Some(TypeFact { comp: CompT::Struct(fs), .. }) if fs.get(1) == Some(&StorT::Val(ValT::RefNull(m)))) + } + (None, None, None) => true, + _ => false, + }; + if !carrier_ok { + tt.carrier = None; + tt.mag = None; + } + if let Some(s) = tt.str_ + && !facts.array_is(u64::from(s), StorT::I8) + { + tt.str_ = None; + } + match (tt.str_vec, tt.str_) { + (Some(v), Some(s)) if facts.array_is(u64::from(v), StorT::Val(ValT::RefNull(s))) => {} + _ => tt.str_vec = None, + } + loop { + let snapshot = tt.clone(); + let m = MCtx::new(None, &Vec::new(), &snapshot, &[]); + let before = ( + tt.records.len(), + tt.sums.len(), + tt.options.len(), + tt.results.len(), + tt.vecs.len(), + tt.lists.len(), + tt.opaques.len(), + ); + tt.records.retain(|r| match r.fields.as_slice() { + [f] => m.val_t(f) == Some(ValT::RefNull(r.struct_idx)), + fs => fs.len() >= 2 && facts.struct_is(&m, u64::from(r.struct_idx), fs), + }); + tt.sums.retain(|d| { + let root_ok = matches!(facts.group_entry(u64::from(d.root)), + Some(TypeFact { comp: CompT::Struct(fs), is_final: false, supertype: None }) if fs.is_empty()); + root_ok + && m.sum_ok(d.tid) + && d.ctors.iter().all(|(idx, fs)| { + facts.struct_is(&m, u64::from(*idx), fs) + && matches!(facts.group_entry(u64::from(*idx)), + Some(TypeFact { is_final: true, supertype: Some(root), .. }) if *root == d.root) + }) + }); + tt.options + .retain(|(t, idx)| facts.struct_is(&m, u64::from(*idx), &[PlanTy::Bool, t.clone()])); + tt.results.retain(|(t, e, idx)| { + facts.struct_is(&m, u64::from(*idx), &[PlanTy::Bool, t.clone(), e.clone()]) + }); + tt.lists.retain(|(t, idx)| { + facts.struct_is( + &m, + u64::from(*idx), + &[t.clone(), PlanTy::List(Box::new(t.clone()))], + ) + }); + tt.vecs.retain(|(t, idx)| match m.val_t(t) { + Some(v) => facts.array_is(u64::from(*idx), StorT::Val(v)), + None => false, + }); + tt.opaques + .retain(|(_, idx)| (*idx as usize) < facts.first_group_len); + // `TypeTable.declsWellFormed`: `eqref` never in a declaration, no + // newtype cycle, every declared record and sum inhabited. + tt.records.retain(|r| r.fields.iter().all(no_eqref)); + tt.sums + .retain(|d| d.ctors.iter().all(|c| c.1.iter().all(no_eqref))); + tt.options.retain(|o| no_eqref(&o.0)); + tt.results.retain(|r| no_eqref(&r.0) && no_eqref(&r.1)); + tt.vecs.retain(|v| no_eqref(&v.0)); + tt.lists.retain(|l| no_eqref(&l.0)); + let grounded: Vec = tt + .records + .iter() + .map(|r| newtype_grounded(tt, r.tid)) + .collect(); + let mut g = grounded.into_iter(); + tt.records.retain(|_| g.next().unwrap_or(false)); + let (inhab_r, inhab_s) = inhab_sets(tt); + tt.records.retain(|r| inhab_r.contains(&r.tid)); + tt.sums.retain(|d| inhab_s.contains(&d.tid)); + // No struct index serves two declarations: keep the first. + let mut owned = BTreeSet::new(); + if let Some(c) = tt.carrier { + owned.insert(c); + } + for x in [tt.mag, tt.str_, tt.str_vec].into_iter().flatten() { + owned.insert(x); + } + tt.records + .retain(|r| r.fields.len() < 2 || owned.insert(r.struct_idx)); + tt.sums.retain(|d| { + let mine: Vec = std::iter::once(d.root) + .chain(d.ctors.iter().map(|c| c.0)) + .collect(); + if mine.iter().all(|x| !owned.contains(x)) + && mine.iter().collect::>().len() == mine.len() + { + owned.extend(mine); + true + } else { + false + } + }); + tt.options.retain(|o| owned.insert(o.1)); + tt.results.retain(|r| owned.insert(r.2)); + tt.lists.retain(|l| owned.insert(l.1)); + tt.vecs.retain(|v| owned.insert(v.1)); + tt.opaques.retain(|o| owned.insert(o.1)); + tt.str_segs + .retain(|(b, seg)| facts.data.get(*seg as usize) == Some(&Some(b.clone()))); + let after = ( + tt.records.len(), + tt.sums.len(), + tt.options.len(), + tt.results.len(), + tt.vecs.len(), + tt.lists.len(), + tt.opaques.len(), + ); + if before == after { + return; + } + } +} + +// ---- which types a plan cites ---- + +#[derive(Default)] +struct Cited { + tys: BTreeSet, + segs: BTreeSet>, +} + +impl Cited { + fn ty(&mut self, t: &PlanTy) { + if !self.tys.insert(t.clone()) { + return; + } + match t { + PlanTy::Option(x) | PlanTy::Vec(x) | PlanTy::List(x) => self.ty(x), + PlanTy::Result(x, e) => { + self.ty(x); + self.ty(e); + } + _ => {} + } + } + + fn expr(&mut self, e: &PlanExpr) { + match e { + PlanExpr::Literal(PlanLit::Str(b)) => { + self.segs.insert(b.clone()); + self.ty(&PlanTy::Str); + } + PlanExpr::Literal(PlanLit::Int(_)) => self.ty(&PlanTy::Int), + PlanExpr::Literal(_) | PlanExpr::Local(_) => {} + PlanExpr::Let(_, v, b) => { + self.expr(v); + self.expr(b); + } + PlanExpr::Call(_, args) | PlanExpr::TailCall(_, args) | PlanExpr::Interp(args) => { + args.iter().for_each(|a| self.expr(a)) + } + PlanExpr::BinOp(_, l, r) => { + self.expr(l); + self.expr(r); + } + PlanExpr::Neg(x) => self.expr(x), + PlanExpr::If(c, t, el) => { + self.expr(c); + self.expr(t); + self.expr(el); + } + PlanExpr::RecordCreate(tid, fs) => { + self.ty(&PlanTy::Record(*tid)); + fs.iter().for_each(|a| self.expr(a)); + } + PlanExpr::Project(tid, _, b) => { + self.ty(&PlanTy::Record(*tid)); + self.expr(b); + } + PlanExpr::Match(s, arms) => { + self.expr(s); + for (p, b) in arms { + match p { + PlanPat::LitStr(k) => { + self.segs.insert(k.clone()); + } + PlanPat::Ctor(PlanCtor::User(tid, _), _) => self.ty(&PlanTy::Sum(*tid)), + _ => {} + } + self.expr(b); + } + } + PlanExpr::Construct(c, ty, args) => { + if let PlanCtor::User(tid, _) = c { + self.ty(&PlanTy::Sum(*tid)); + } + self.ty(ty); + args.iter().for_each(|a| self.expr(a)); + } + PlanExpr::List(t, items) => { + self.ty(&PlanTy::List(Box::new(t.clone()))); + items.iter().for_each(|a| self.expr(a)); + } + } + } + + fn plan(&mut self, p: &FnPlan) { + p.params.iter().for_each(|t| self.ty(t)); + self.ty(&p.ret); + p.locals.iter().for_each(|t| self.ty(t)); + self.expr(&p.body); + } + + /// Close over the declarations: a record's and a constructor's field + /// types are cited too. + fn close(&mut self, tt: &PlanTypeTable) { + loop { + let before = self.tys.len(); + let snapshot: Vec = self.tys.iter().cloned().collect(); + for t in snapshot { + match t { + PlanTy::Record(tid) => { + if let Some(r) = tt.records.iter().find(|r| r.tid == tid) { + r.fields.iter().for_each(|f| self.ty(f)); + } + } + PlanTy::Sum(tid) => { + if let Some(s) = tt.sums.iter().find(|s| s.tid == tid) { + s.ctors + .iter() + .flat_map(|c| c.1.iter()) + .for_each(|f| self.ty(f)); + } + } + _ => {} + } + } + if self.tys.len() == before { + return; + } + } + } + + /// The table restricted to what is cited. + fn restrict(&self, tt: &PlanTypeTable) -> PlanTypeTable { + let has = |t: PlanTy| self.tys.contains(&t); + PlanTypeTable { + carrier: tt.carrier, + mag: tt.mag, + str_: tt.str_, + str_vec: tt.str_vec, + records: tt + .records + .iter() + .filter(|r| has(PlanTy::Record(r.tid))) + .cloned() + .collect(), + sums: tt + .sums + .iter() + .filter(|s| has(PlanTy::Sum(s.tid))) + .cloned() + .collect(), + options: tt + .options + .iter() + .filter(|o| has(PlanTy::Option(Box::new(o.0.clone())))) + .cloned() + .collect(), + results: tt + .results + .iter() + .filter(|r| has(PlanTy::Result(Box::new(r.0.clone()), Box::new(r.1.clone())))) + .cloned() + .collect(), + vecs: tt + .vecs + .iter() + .filter(|v| has(PlanTy::Vec(Box::new(v.0.clone())))) + .cloned() + .collect(), + lists: tt + .lists + .iter() + .filter(|l| has(PlanTy::List(Box::new(l.0.clone())))) + .cloned() + .collect(), + opaques: tt + .opaques + .iter() + .filter(|o| has(PlanTy::Opaque(o.0))) + .cloned() + .collect(), + str_segs: tt + .str_segs + .iter() + .filter(|s| self.segs.contains(&s.0)) + .cloned() + .collect(), + } + } +} + +/// Tarjan's SCCs over `nodes` (call edges restricted to `nodes`), emitted +/// callees first. +fn call_sccs(nodes: &[u32], edges: &BTreeMap>) -> Vec> { + struct St<'a> { + edges: &'a BTreeMap>, + index: BTreeMap, + low: BTreeMap, + stack: Vec, + on: BTreeSet, + next: usize, + out: Vec>, + } + fn visit(st: &mut St<'_>, v: u32) { + st.index.insert(v, st.next); + st.low.insert(v, st.next); + st.next += 1; + st.stack.push(v); + st.on.insert(v); + for w in st.edges.get(&v).cloned().unwrap_or_default() { + if !st.index.contains_key(&w) { + visit(st, w); + let lw = st.low[&w]; + let lv = st.low[&v]; + st.low.insert(v, lv.min(lw)); + } else if st.on.contains(&w) { + let iw = st.index[&w]; + let lv = st.low[&v]; + st.low.insert(v, lv.min(iw)); + } + } + if st.low[&v] == st.index[&v] { + let mut comp = Vec::new(); + loop { + let w = st.stack.pop().expect("tarjan stack"); + st.on.remove(&w); + comp.push(w); + if w == v { + break; + } + } + comp.sort_unstable(); + st.out.push(comp); + } + } + let mut st = St { + edges, + index: BTreeMap::new(), + low: BTreeMap::new(), + stack: Vec::new(), + on: BTreeSet::new(), + next: 0, + out: Vec::new(), + }; + for &v in nodes { + if !st.index.contains_key(&v) { + visit(&mut st, v); + } + } + st.out +} + +/// Check one candidate against the bytes: typing, the code entry, the +/// function type, the string literals, and that every call targets a +/// candidate. `None` means offered. +fn check_candidate( + facts: &ModuleFacts, + m: &MCtx<'_>, + func_idx: u32, + plan: &FnPlan, + candidates: &BTreeSet, +) -> Option { + let mut targets = Vec::new(); + call_targets(&plan.body, &mut targets); + if let Some(t) = targets.iter().find(|t| !candidates.contains(t)) { + return Some(format!("calls function {t}, which has no certified plan")); + } + if !plan_typed(m, plan) { + return Some("plan does not type in the one grammar".into()); + } + if !plan_eqref_ok(plan) { + return Some("plan cites `eqref` outside the subject-scratch local".into()); + } + let (inhab_r, inhab_s) = inhab_sets(m.tt); + if !plan + .params + .iter() + .chain(std::iter::once(&plan.ret)) + .all(|t| inhab_ty(&inhab_r, &inhab_s, t)) + { + return Some( + "a parameter or result type has no finite value, so the obligation would be vacuous" + .into(), + ); + } + let Some(bytes) = m.code_entry_bytes(plan) else { + return Some("plan lowering cites an undeclared index or type".into()); + }; + let Some(code) = facts.code_of(func_idx) else { + return Some("no code entry at the function index".into()); + }; + if code.entry != bytes { + let at = code + .entry + .iter() + .zip(&bytes) + .take_while(|(a, b)| a == b) + .count(); + return Some(format!( + "plan lowering differs from the emitted code entry at byte {at} ({} vs {} bytes)", + bytes.len(), + code.entry.len() + )); + } + let sig_ok = match ( + plan.params + .iter() + .map(|t| m.val_t(t)) + .collect::>>(), + m.val_t(&plan.ret), + facts.fn_sig(func_idx), + ) { + (Some(ps), Some(r), Some(CompT::Func(fp, fr))) => &ps == fp && fr.as_slice() == [r], + _ => false, + }; + if !sig_ok { + return Some("declared function type is not the plan's signature".into()); + } + let mut lits = Vec::new(); + string_lits(&plan.body, &mut lits); + for b in lits { + let seg = m.str_seg(b); + if seg >= 4_294_967_296 || facts.data.get(seg as usize) != Some(&Some(b.to_vec())) { + return Some("a string literal's data segment is not confirmed".into()); + } + } + None +} + +/// Analyze one core module against the compiler's plans. +pub fn analyze( + core_bytes: &[u8], + plans: &ModulePlans, + artifact_target: &str, +) -> Result { + let facts = ModuleFacts::parse(core_bytes)?; + let carrier = facts.carrier; + let mut roles = facts.roles; + let carriered = roles.box_idx.is_some(); + if carriered && roles.arith_params(carrier).is_none() { + return Err("module exports the Int box helper but its arithmetic helper indices do not resolve; the host-role table cannot be declared".into()); + } + // `__aint_eq` is pinned by template, so a module that does not export it + // may still declare it: the index is the compiler's (producer data). + let eq_from_hint = carriered && roles.eq_idx.is_none() && plans.aint_eq_idx.is_some(); + if eq_from_hint { + roles.eq_idx = plans.aint_eq_idx; + } + let role_table = carriered.then_some(roles); + + let mut export_name: BTreeMap = BTreeMap::new(); + for (name, kind, idx) in &facts.exports { + if *kind == 0 && !is_runtime_export(name) && name.is_ascii() { + export_name.entry(*idx).or_insert_with(|| name.clone()); + } + } + + let mut types = plans.types.clone(); + confirm_type_table(&facts, &mut types); + + let mut reasons: BTreeMap = BTreeMap::new(); + let mut plan_of: BTreeMap = BTreeMap::new(); + for f in &plans.fns { + match &f.plan { + Ok(p) => { + plan_of.insert(f.func_idx, p); + } + Err(reason) => { + reasons.insert(f.func_idx, reason.clone()); + } + } + } + let mut candidates: BTreeSet = plan_of.keys().copied().collect(); + loop { + let fns: Vec<(u32, &FnPlan)> = candidates.iter().map(|f| (*f, plan_of[f])).collect(); + let m = MCtx::new(role_table.as_ref(), &facts.string_roles, &types, &fns); + let mut dropped = Vec::new(); + for (f, p) in &fns { + if let Some(reason) = check_candidate(&facts, &m, *f, p, &candidates) { + dropped.push((*f, reason)); + } + } + if dropped.is_empty() { + break; + } + for (f, reason) in dropped { + candidates.remove(&f); + reasons.insert(f, reason); + } + } + + // Offered: every exported candidate, plus the internal candidates it + // reaches. + let mut edges: BTreeMap> = BTreeMap::new(); + for f in &candidates { + let mut t = Vec::new(); + call_targets(&plan_of[f].body, &mut t); + t.sort_unstable(); + t.dedup(); + edges.insert(*f, t); + } + let mut included: BTreeSet = BTreeSet::new(); + let mut work: Vec = candidates + .iter() + .copied() + .filter(|f| export_name.contains_key(f)) + .collect(); + while let Some(f) = work.pop() { + if included.insert(f) { + work.extend(edges[&f].iter().copied()); + } + } + let nodes: Vec = included.iter().copied().collect(); + let sccs = call_sccs(&nodes, &edges); + let mut entries = Vec::new(); + for (group, comp) in sccs.iter().enumerate() { + for f in comp { + let exported = export_name.get(f); + entries.push(PackageEntry { + name: exported.cloned().unwrap_or_else(|| format!("#{f}")), + exported: exported.is_some(), + func_idx: *f, + group: group as u32, + plan: plan_of[f].clone(), + }); + } + } + + // Lowered helper calls (for the contracts and the eq role). + let fns: Vec<(u32, &FnPlan)> = entries.iter().map(|e| (e.func_idx, &e.plan)).collect(); + let mut role_table = role_table; + let m = MCtx::new(role_table.as_ref(), &facts.string_roles, &types, &fns); + let mut calls = Vec::new(); + for e in &entries { + lowered_calls(&m.lower_plan(&e.plan), &mut calls); + } + if eq_from_hint + && !calls.contains(&m.eq) + && let Some(r) = role_table.as_mut() + { + r.eq_idx = None; + } + + // Policies per call group. + let mut group_total: BTreeMap> = BTreeMap::new(); + for (group, comp) in sccs.iter().enumerate() { + let members: Vec<(u32, &FnPlan)> = comp.iter().map(|f| (*f, plan_of[f])).collect(); + group_total.insert(group as u32, check_term_group(&members)); + } + let mut certified = Vec::new(); + for e in entries.iter().filter(|e| e.exported) { + let members: Vec<&PackageEntry> = entries.iter().filter(|x| x.group == e.group).collect(); + let member_idx: BTreeSet = members.iter().map(|x| x.func_idx).collect(); + let recursive = members.iter().any(|x| { + let mut t = Vec::new(); + call_targets(&x.plan.body, &mut t); + t.iter().any(|t| member_idx.contains(t)) + }); + let mut body = BTreeSet::new(); + facets_e(&e.plan.body, &mut body); + let facets = [ + "recursive", + "mutual", + "calls", + "records", + "variants", + "strings", + "floats", + ] + .into_iter() + .filter(|f| match *f { + "recursive" => recursive, + "mutual" => recursive && members.len() >= 2, + other => body.contains(other), + }) + .collect(); + certified.push(CertifiedExport { + name: e.name.clone(), + func_idx: e.func_idx, + total: group_total[&e.group].is_some(), + facets, + }); + } + + // Contracts (`ClaimAxes.contractUse`). + let any_total = certified.iter().any(|c| c.total); + let any_total_mul = entries + .iter() + .filter(|e| e.exported) + .any(|e| group_total[&e.group] == Some(true)); + let has = |i: u64| calls.contains(&i); + let mut contracts = Vec::new(); + for (used, name) in [ + (has(m.box_), BOX_CONTRACT), + (has(m.add), INT_ADD_CONTRACT), + (has(m.sub), INT_SUB_CONTRACT), + (has(m.mul), INT_MUL_CONTRACT), + (has(m.streq), STRING_EQ_CONTRACT), + (has(m.concat), STRING_CONCAT_CONTRACT), + (has(m.to_index), TO_INDEX_CONTRACT), + (has(m.cmp), CMP_CONTRACT), + (has(m.eq), EQ_CONTRACT), + (has(m.divmod), DIVMOD_CONTRACT), + (any_total, INT_ADD_TOTAL_CONTRACT), + (any_total, INT_SUB_TOTAL_CONTRACT), + (any_total_mul, INT_MUL_TOTAL_CONTRACT), + ] { + if used { + contracts.push(name.to_string()); + } + } + + let mut cited = Cited::default(); + entries.iter().for_each(|e| cited.plan(&e.plan)); + cited.close(&types); + let types = cited.restrict(&types); + + let declined: Vec<(String, String)> = export_name + .iter() + .filter(|(f, _)| !included.contains(f)) + .map(|(f, name)| { + let reason = reasons + .get(f) + .cloned() + .unwrap_or_else(|| "no plan was printed for this function".to_string()); + (name.clone(), clean_reason(&reason)) + }) + .collect(); + + let certified_pairs: Vec<(String, u32)> = certified + .iter() + .map(|c| (c.name.clone(), c.func_idx)) + .collect(); + let module_envelope = + collect_module_envelope_facts(core_bytes, &certified_pairs, artifact_target)?; + + Ok(Analysis { + carrier, + fn_names: plans + .fns + .iter() + .map(|f| (f.func_idx, f.name.clone())) + .collect(), + roles: role_table, + string_roles: facts.string_roles.clone(), + entries, + types, + certified, + declined, + contracts, + module_envelope, + }) +} + +#[cfg(test)] +mod produce_tests { + use super::*; + + /// A wasm-gc module the compiler emitted, kept byte-for-byte under + /// `tests/fixtures/one-grammar/`. The plans below are written against + /// these exact bytes (function indices, helper slots), so the fixtures + /// are committed rather than rebuilt: a new compiler would move them. + fn fixture(name: &str) -> Vec { + let path = format!( + "{}/tests/fixtures/one-grammar/{name}.wasm", + env!("CARGO_MANIFEST_DIR") + ); + std::fs::read(&path).unwrap_or_else(|e| panic!("read {path}: {e}")) + } + + fn l(i: u32) -> PlanExpr { + PlanExpr::Local(i) + } + + fn k(v: i64) -> PlanExpr { + PlanExpr::Literal(PlanLit::Int(v)) + } + + fn bin(op: PlanBinOp, a: PlanExpr, b: PlanExpr) -> PlanExpr { + PlanExpr::BinOp(op, Box::new(a), Box::new(b)) + } + + fn rec(params: usize, base: PlanExpr, step: PlanExpr) -> FnPlan { + FnPlan { + params: vec![PlanTy::Int; params], + ret: PlanTy::Int, + nslots: params as u32, + locals: vec![PlanTy::Int], + body: PlanExpr::If( + Box::new(bin(PlanBinOp::Lte, l(0), k(0))), + Box::new(base), + Box::new(step), + ), + } + } + + fn desc() -> PlanExpr { + bin(PlanBinOp::Sub, l(0), k(1)) + } + + fn int_table() -> PlanTypeTable { + PlanTypeTable { + carrier: Some(2), + mag: Some(1), + str_: Some(0), + ..PlanTypeTable::default() + } + } + + /// The two certprobe2 plans, exactly as the compiler prints them. + fn certprobe2_plans(sum_to: FnPlan) -> ModulePlans { + let count_down = rec( + 2, + l(1), + PlanExpr::TailCall(2, vec![desc(), bin(PlanBinOp::Add, l(1), l(0))]), + ); + ModulePlans { + fns: vec![ + PlannedFn { + name: "sumTo".into(), + func_idx: 1, + plan: Ok(sum_to), + }, + PlannedFn { + name: "countDown".into(), + func_idx: 2, + plan: Ok(count_down), + }, + ], + types: int_table(), + aint_eq_idx: None, + } + } + + fn sum_to() -> FnPlan { + rec( + 1, + k(0), + bin( + PlanBinOp::Add, + l(0), + PlanExpr::Call(PlanCallee::Fn(1), vec![desc()]), + ), + ) + } + + #[test] + fn twin_lowering_reproduces_the_certprobe2_code_entries() { + let analysis = analyze( + &fixture("certprobe2"), + &certprobe2_plans(sum_to()), + crate::format::TARGET_WASM_GC, + ) + .expect("certprobe2 analyzes"); + assert_eq!(analysis.certified_names(), ["sumTo", "countDown"]); + assert!(analysis.certified().iter().all(|c| c.total)); + assert_eq!(analysis.certified()[0].facets, ["recursive", "calls"]); + assert_eq!( + analysis.contracts, + [ + BOX_CONTRACT, + INT_ADD_CONTRACT, + INT_SUB_CONTRACT, + INT_ADD_TOTAL_CONTRACT, + INT_SUB_TOTAL_CONTRACT + ] + ); + let roles = analysis.roles.expect("carriered"); + assert_eq!( + (roles.box_idx, roles.add_idx, roles.sub_idx), + (Some(7), Some(8), Some(9)) + ); + assert_eq!(analysis.module_envelope.closure.roots, [1, 2]); + assert!(analysis.declined().is_empty()); + } + + #[test] + fn a_plan_that_is_not_the_code_entry_declines_with_the_byte_offset() { + // A descent by two: the plan types, but its lowering is not the bytes. + let bad = rec( + 1, + k(0), + bin( + PlanBinOp::Add, + l(0), + PlanExpr::Call(PlanCallee::Fn(1), vec![bin(PlanBinOp::Sub, l(0), k(2))]), + ), + ); + let analysis = analyze( + &fixture("certprobe2"), + &certprobe2_plans(bad), + crate::format::TARGET_WASM_GC, + ) + .expect("analyzes"); + assert_eq!(analysis.certified_names(), ["countDown"]); + let (name, reason) = &analysis.declined()[0]; + assert_eq!(name, "sumTo"); + assert!( + reason.contains("differs from the emitted code entry at byte"), + "{reason}" + ); + } + + #[test] + fn a_call_to_a_declined_function_declines_the_caller() { + let mut plans = certprobe2_plans(sum_to()); + plans.fns[1].plan = Err("Neg (no Int negation helper template)".into()); + // `sumTo` still stands alone; make `countDown`'s plan call `sumTo` + // and decline `sumTo` instead. + let mut plans2 = certprobe2_plans(sum_to()); + plans2.fns[0].plan = Err("printer declined".into()); + plans2.fns[1].plan = Ok(rec( + 1, + k(0), + PlanExpr::Call(PlanCallee::Fn(1), vec![desc()]), + )); + let analysis = analyze( + &fixture("certprobe2"), + &plans2, + crate::format::TARGET_WASM_GC, + ) + .expect("analyzes"); + assert!(analysis.certified_names().is_empty()); + let reasons: BTreeMap = analysis.declined().iter().cloned().collect(); + assert_eq!(reasons["sumTo"], "printer declined"); + assert_eq!( + reasons["countDown"], + "calls function 1, which has no certified plan" + ); + let analysis = analyze( + &fixture("certprobe2"), + &plans, + crate::format::TARGET_WASM_GC, + ) + .expect("analyzes"); + assert_eq!(analysis.certified_names(), ["sumTo"]); + } + + #[test] + fn variant_plans_and_their_sum_layout_are_confirmed() { + let shape = PlanTy::Sum(0); + let arm = |c: u32, bs: Vec| PlanPat::Ctor(PlanCtor::User(0, c), bs); + let mk_circle = FnPlan { + params: vec![PlanTy::Int], + ret: shape.clone(), + nslots: 1, + locals: vec![PlanTy::Int], + body: PlanExpr::Construct(PlanCtor::User(0, 0), shape.clone(), vec![l(0)]), + }; + let area = FnPlan { + params: vec![shape.clone()], + ret: PlanTy::Int, + nslots: 4, + locals: vec![ + PlanTy::Int, + PlanTy::Int, + PlanTy::Int, + PlanTy::Eqref, + PlanTy::Int, + ], + body: PlanExpr::Match( + Box::new(l(0)), + vec![ + (arm(0, vec![1]), bin(PlanBinOp::Mul, l(1), l(1))), + (arm(1, vec![2, 3]), bin(PlanBinOp::Mul, l(2), l(3))), + (arm(2, vec![]), k(0)), + ], + ), + }; + let is_dot = FnPlan { + params: vec![shape.clone()], + ret: PlanTy::Bool, + nslots: 1, + locals: vec![PlanTy::Eqref, PlanTy::Int], + body: PlanExpr::Match( + Box::new(l(0)), + vec![ + (arm(2, vec![]), PlanExpr::Literal(PlanLit::Bool(true))), + (PlanPat::Wild, PlanExpr::Literal(PlanLit::Bool(false))), + ], + ), + }; + let types = PlanTypeTable { + carrier: Some(6), + mag: Some(5), + str_: Some(4), + sums: vec![PlanSumDecl { + tid: 0, + root: 0, + ctors: vec![ + (1, vec![PlanTy::Int]), + (2, vec![PlanTy::Int, PlanTy::Int]), + (3, vec![]), + ], + }], + ..PlanTypeTable::default() + }; + let plans = ModulePlans { + fns: vec![ + PlannedFn { + name: "mkCircle".into(), + func_idx: 1, + plan: Ok(mk_circle), + }, + PlannedFn { + name: "area".into(), + func_idx: 4, + plan: Ok(area), + }, + PlannedFn { + name: "isDot".into(), + func_idx: 5, + plan: Ok(is_dot), + }, + ], + types, + aint_eq_idx: None, + }; + let analysis = + analyze(&fixture("variants"), &plans, crate::format::TARGET_WASM_GC).expect("analyzes"); + assert_eq!(analysis.certified_names(), ["mkCircle", "area", "isDot"]); + assert!( + analysis + .certified() + .iter() + .all(|c| c.facets == ["variants"]) + ); + assert_eq!(analysis.types.sums.len(), 1); + + // A constructor declared on another constructor's struct is not + // confirmed, so every plan citing the sum declines. + let mut shared = plans.clone(); + shared.types.sums[0].ctors[2].0 = 1; + let analysis = analyze(&fixture("variants"), &shared, crate::format::TARGET_WASM_GC) + .expect("analyzes"); + assert!(analysis.certified_names().is_empty()); + assert!(analysis.types.sums.is_empty()); + } + + #[test] + fn string_interpolation_plans_cite_their_data_segments() { + let s = |b: &[u8]| PlanExpr::Literal(PlanLit::Str(b.to_vec())); + let greet = FnPlan { + params: vec![PlanTy::Str], + ret: PlanTy::Str, + nslots: 1, + locals: vec![], + body: PlanExpr::Interp(vec![s(b"Hello, "), l(0)]), + }; + let shout = FnPlan { + params: vec![PlanTy::Str], + ret: PlanTy::Str, + nslots: 1, + locals: vec![], + body: PlanExpr::Interp(vec![l(0), s(b"!!!")]), + }; + let types = PlanTypeTable { + str_: Some(0), + str_vec: Some(1), + str_segs: vec![(b"Hello, ".to_vec(), 0), (b"!!!".to_vec(), 1)], + ..PlanTypeTable::default() + }; + let plans = ModulePlans { + fns: vec![ + PlannedFn { + name: "greet".into(), + func_idx: 2, + plan: Ok(greet), + }, + PlannedFn { + name: "shout".into(), + func_idx: 3, + plan: Ok(shout), + }, + ], + types, + aint_eq_idx: None, + }; + let analysis = + analyze(&fixture("hello"), &plans, crate::format::TARGET_WASM_GC).expect("analyzes"); + assert_eq!(analysis.certified_names(), ["greet", "shout"]); + assert!(analysis.roles.is_none(), "carrier-free module"); + assert_eq!(analysis.contracts, [STRING_CONCAT_CONTRACT]); + // A literal named at the wrong segment is not confirmed. + let mut wrong = plans.clone(); + wrong.types.str_segs[1].1 = 0; + let analysis = + analyze(&fixture("hello"), &wrong, crate::format::TARGET_WASM_GC).expect("analyzes"); + assert_eq!(analysis.certified_names(), ["greet"]); + } + + #[test] + fn the_rendered_plans_are_the_lean_grammar_terms() { + assert_eq!( + sum_to().lean(), + "{ sig := ⟨[.int], .int⟩, nslots := 1, locals := [.int],\n body := (.ifThenElse (.binOp .lte (.local 0) (.literal (.int 0))) (.literal (.int 0)) (.binOp .add (.local 0) (.call (.fn 1) [(.binOp .sub (.local 0) (.literal (.int 1)))]))) }" + ); + let m = PlanExpr::Match( + Box::new(l(0)), + vec![(PlanPat::LitInt(-3), k(1)), (PlanPat::Wild, k(2))], + ); + assert_eq!( + m.lean(), + "(.match_ (.local 0) (.cons (.litInt (-3)) (.literal (.int 1)) (.cons .wild (.literal (.int 2)) .nil)))" + ); + } + + #[test] + fn twin_termination_matches_the_wall_check() { + let p = sum_to(); + assert_eq!(check_term_group(&[(1, &p)]), Some(false)); + let wild = rec( + 1, + k(0), + bin( + PlanBinOp::Mul, + k(3), + PlanExpr::Call(PlanCallee::Fn(1), vec![desc()]), + ), + ); + assert_eq!(check_term_group(&[(1, &wild)]), Some(true)); + let by_two = rec( + 1, + k(0), + PlanExpr::Call(PlanCallee::Fn(1), vec![bin(PlanBinOp::Sub, l(0), k(2))]), + ); + assert_eq!(check_term_group(&[(1, &by_two)]), None); + let no_call = rec(1, k(0), l(0)); + assert_eq!(check_term_group(&[(1, &no_call)]), None); + } +} diff --git a/aver-cert/src/engine/recursion_plan_defs.rs b/aver-cert/src/engine/recursion_plan_defs.rs deleted file mode 100644 index 9599804f9..000000000 --- a/aver-cert/src/engine/recursion_plan_defs.rs +++ /dev/null @@ -1,472 +0,0 @@ -// Byte-first `recursion-plan-v1` plan builder. -// -// A fuel-recursion body reconstructs losslessly from the byte-derived -// `Cert::Recursive` / `Cert::AccumulatorRecursive` holes into the same ANF -// `FragBlock` grammar the expr-fragment plans use, plus the `selfCall` node. -// The plan lowers, byte-for-byte, to the emitted self-recursive code entry; -// it carries no source-level meaning and never changes the proof face — it -// only moves the recursive body's byte-origin into hash-pinned Lean. - -/// ANF block builder: appends nodes with sequential ids. -struct RecBlockBuilder { - nodes: Vec, -} - -impl RecBlockBuilder { - fn new() -> Self { - RecBlockBuilder { nodes: Vec::new() } - } - - fn push(&mut self, ty: FragTy, kind: FragNodeKind) -> FragValueId { - let id = FragValueId(self.nodes.len()); - self.nodes.push(FragNode { id, ty, kind }); - id - } - - fn finish(self, result: FragValueId) -> FragBlock { - FragBlock { - nodes: self.nodes, - result, - } - } -} - -/// The small-limb sign test `struct.get 0; i64.const 0; i64.le_s` (`n ≤ 0`). -fn rec_small_cmp_block() -> FragBlock { - let mut b = RecBlockBuilder::new(); - let l = b.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let s = b.push(FragTy::I64, FragNodeKind::StructGet { field: 0, receiver: l }); - let z = b.push(FragTy::I64, FragNodeKind::ConstI64(0)); - let r = b.push( - FragTy::BoolI32, - FragNodeKind::Prim { - op: FragPrim::I64LeS, - args: vec![s, z], - }, - ); - b.finish(r) -} - -/// The big-limb sign test `struct.get 2; i32.const 0; i32.lt_s` (`sign < 0`). -fn rec_big_cmp_block() -> FragBlock { - let mut b = RecBlockBuilder::new(); - let l = b.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let s = b.push(FragTy::RawI32, FragNodeKind::StructGet { field: 2, receiver: l }); - let z = b.push(FragTy::BoolI32, FragNodeKind::ConstBool(false)); - let r = b.push( - FragTy::BoolI32, - FragNodeKind::Prim { - op: FragPrim::I32LtS, - args: vec![s, z], - }, - ); - b.finish(r) -} - -/// The carrier discriminator `local.get 0; struct.get 1; ref.is_null` plus the -/// small-vs-big sign predicate `if` — shared by both recursion shapes. -fn rec_push_sign_predicate(top: &mut RecBlockBuilder) -> FragValueId { - let l = top.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let mag = top.push( - FragTy::Ref, - FragNodeKind::StructGet { - field: 1, - receiver: l, - }, - ); - let is_small = top.push(FragTy::BoolI32, FragNodeKind::RefIsNull { value: mag }); - top.push( - FragTy::BoolI32, - FragNodeKind::If { - cond: is_small, - then_block: Box::new(rec_small_cmp_block()), - else_block: Box::new(rec_big_cmp_block()), - }, - ) -} - -/// Materialise the descent operand `n - 1` and the self-call `f(n-1)`: -/// `local.get 0; i64.const 1; box; sub; call self`. Returns the self-call id. -fn rec_push_descent_self( - b: &mut RecBlockBuilder, - box_idx: u32, - sub_idx: u32, - self_idx: u32, -) -> FragValueId { - let n = b.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let one = b.push(FragTy::I64, FragNodeKind::ConstI64(1)); - let boxed = b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: box_idx, - args: vec![one], - }, - ); - let dec = b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Sub, - func_idx: sub_idx, - args: vec![n, boxed], - }, - ); - b.push( - FragTy::IntCarrier, - FragNodeKind::SelfCall { - tail: false, - func_idx: self_idx, - args: vec![dec], - }, - ) -} - -/// Materialise the non-recursive combinator operand: the descending input `n` -/// (`local.get 0`) or a boxed integer constant (`i64.const k; box`). -fn rec_push_other(b: &mut RecBlockBuilder, other: BodyOperand, box_idx: u32) -> FragValueId { - match other { - BodyOperand::Input => b.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }), - BodyOperand::Const(k) => { - let c = b.push(FragTy::I64, FragNodeKind::ConstI64(k)); - b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: box_idx, - args: vec![c], - }, - ) - } - } -} - -/// The base arm `i64.const base_k; box`. -fn rec_base_const_block(base_k: i64, box_idx: u32) -> FragBlock { - let mut b = RecBlockBuilder::new(); - let k = b.push(FragTy::I64, FragNodeKind::ConstI64(base_k)); - let boxed = b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: box_idx, - args: vec![k], - }, - ); - b.finish(boxed) -} - -/// The step arm of single-argument recursion: descent + self-call combined with -/// the other operand by the byte-derived combinator helper. `rec_first` -/// selects the operand order `f(n-1) + other` vs `other + f(n-1)`. -fn rec_step_block( - box_idx: u32, - combine_role: FragHostRole, - combine_idx: u32, - sub_idx: u32, - self_idx: u32, - rec_first: bool, - other: BodyOperand, -) -> FragBlock { - let mut b = RecBlockBuilder::new(); - let comb = if rec_first { - let self_id = rec_push_descent_self(&mut b, box_idx, sub_idx, self_idx); - let other_id = rec_push_other(&mut b, other, box_idx); - b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: combine_role, - func_idx: combine_idx, - args: vec![self_id, other_id], - }, - ) - } else { - let other_id = rec_push_other(&mut b, other, box_idx); - let self_id = rec_push_descent_self(&mut b, box_idx, sub_idx, self_idx); - b.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: combine_role, - func_idx: combine_idx, - args: vec![other_id, self_id], - }, - ) - }; - b.finish(comb) -} - -/// Full plan for `Cert::Recursive` (single-argument fuel self-recursion). -fn recursion_plan_recursive( - box_idx: u32, - combine: (FragHostRole, u32), - sub_idx: u32, - self_idx: u32, - base_k: i64, - rec_first: bool, - other: BodyOperand, -) -> ExprFragmentPlan { - let (combine_role, combine_idx) = combine; - let mut top = RecBlockBuilder::new(); - let sign = rec_push_sign_predicate(&mut top); - let value = top.push( - FragTy::IntCarrier, - FragNodeKind::If { - cond: sign, - then_block: Box::new(rec_base_const_block(base_k, box_idx)), - else_block: Box::new(rec_step_block( - box_idx, - combine_role, - combine_idx, - sub_idx, - self_idx, - rec_first, - other, - )), - }, - ); - ExprFragmentPlan { - params: vec![FragTy::IntCarrier], - result: FragTy::IntCarrier, - body: top.finish(value), - } -} - -/// Full plan for `Cert::AccumulatorRecursive` (countDown-shape two-argument -/// tail accumulator: base returns the accumulator, step tail-calls -/// `f(n-1, acc+n)`). -fn recursion_plan_accumulator( - box_idx: u32, - add_idx: u32, - sub_idx: u32, - self_idx: u32, -) -> ExprFragmentPlan { - // base arm: return the accumulator local. - let mut base = RecBlockBuilder::new(); - let acc = base.push(FragTy::IntCarrier, FragNodeKind::Local { index: 1 }); - let base = base.finish(acc); - // step arm: descent n-1, then acc+n, then tail-call f(n-1, acc+n). - let mut step = RecBlockBuilder::new(); - let n = step.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let one = step.push(FragTy::I64, FragNodeKind::ConstI64(1)); - let boxed = step.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: box_idx, - args: vec![one], - }, - ); - let dec = step.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Sub, - func_idx: sub_idx, - args: vec![n, boxed], - }, - ); - let acc_operand = step.push(FragTy::IntCarrier, FragNodeKind::Local { index: 1 }); - let n_operand = step.push(FragTy::IntCarrier, FragNodeKind::Local { index: 0 }); - let acc_next = step.push( - FragTy::IntCarrier, - FragNodeKind::HostCall { - role: FragHostRole::Add, - func_idx: add_idx, - args: vec![acc_operand, n_operand], - }, - ); - let call = step.push( - FragTy::IntCarrier, - FragNodeKind::SelfCall { - tail: true, - func_idx: self_idx, - args: vec![dec, acc_next], - }, - ); - let step = step.finish(call); - - let mut top = RecBlockBuilder::new(); - let sign = rec_push_sign_predicate(&mut top); - let value = top.push( - FragTy::IntCarrier, - FragNodeKind::If { - cond: sign, - then_block: Box::new(base), - else_block: Box::new(step), - }, - ); - ExprFragmentPlan { - params: vec![FragTy::IntCarrier, FragTy::IntCarrier], - result: FragTy::IntCarrier, - body: top.finish(value), - } -} - -/// Build the byte-first `recursion-plan-v1` plan for a fuel-recursion cert. -/// Returns `None` for any other class, and — fail-closed — for a certified -/// recursion whose REAL code entry does not equal the canonical plan lowering: -/// the recognizer normalizes local-alias hops before classification, so a -/// legitimately certified body can be byte-noisier than the canonical -/// template. Such exports keep the legacy witness route (byte-derived -/// obligation, no plan claim); an artifact must never carry a byte-origin -/// claim its own bytes cannot prove. -fn recursion_plan_from_cert(c: &Cert) -> Option { - let (plan, carrier, code_entry_bytes) = match c.inner() { - Cert::Recursive { - box_idx, - add_idx, - sub_idx, - self_idx, - base_k, - rec_first, - other, - combinator, - carrier, - code_entry_bytes, - .. - } => ( - recursion_plan_recursive( - *box_idx, - ( - match combinator { - Combinator::Add => FragHostRole::Add, - Combinator::Mul => FragHostRole::Mul, - }, - *add_idx, - ), - *sub_idx, - *self_idx, - *base_k, - *rec_first, - *other, - ), - *carrier, - code_entry_bytes, - ), - Cert::AccumulatorRecursive { - box_idx, - add_idx, - sub_idx, - self_idx, - carrier, - code_entry_bytes, - .. - } => ( - recursion_plan_accumulator(*box_idx, *add_idx, *sub_idx, *self_idx), - *carrier, - code_entry_bytes, - ), - _ => return None, - }; - let lowered = lower_expr_fragment_plan_code_entry_bytes(&plan, carrier).ok()?; - if &lowered != code_entry_bytes { - return None; - } - Some(plan) -} - -/// The per-export byte-derived host-role table a recursion claim carries: the -/// Per-export byte-derived host roles, rendered identically by producer and -/// verifier. Multiplicative recursion carries `.mul`, never an `.add` alias. -fn recursion_host_table_lean_value(c: &Cert) -> String { - match c.inner() { - Cert::Recursive { - box_idx, - add_idx, - sub_idx, - combinator, - .. - } => { - let role = match combinator { - Combinator::Add => ".add", - Combinator::Mul => ".mul", - }; - format!("[(.box, {box_idx}), ({role}, {add_idx}), (.sub, {sub_idx})]") - } - Cert::AccumulatorRecursive { - box_idx, - add_idx, - sub_idx, - .. - } => format!("[(.box, {box_idx}), (.add, {add_idx}), (.sub, {sub_idx})]"), - _ => unreachable!("recursion host table requires a recursion certificate"), - } -} - -/// The Lean `RecursionRawPlan` literal for a byte-first recursion plan (profile -/// `recursion-plan-v1`; reuses the shared block/node renderers). -fn recursion_plan_lean_value(plan: &ExprFragmentPlan) -> String { - format!( - "{{ profile := \"recursion-plan-v1\", params := [{}], result := {}, body := {} }}", - plan.params - .iter() - .map(|ty| ty.lean_plan_ctor()) - .collect::>() - .join(", "), - plan.result.lean_plan_ctor(), - expr_fragment_block_lean_value(&plan.body) - ) -} - -#[cfg(test)] -mod recursion_plan_gate_tests { - use super::*; - - /// A canonical single-argument recursion cert whose carried code-entry - /// bytes are exactly the canonical plan lowering (the honest case), plus a - /// byte-noisy variant simulating a normalized body: the recognizer strips - /// local-alias hops before classification, so a body with (say) an extra - /// declared local classifies identically while its raw bytes differ. - /// No current Aver source shape reaches that emission (there is no - /// statement-level binding), so the noisy body is injected directly; the - /// gate must fail-close it to the legacy route rather than emit a claim - /// the artifact cannot prove. - fn recursive_cert(code_entry_bytes: Vec) -> Cert { - Cert::Recursive { - name: "sumFrom".to_string(), - self_idx: 1, - type_idx: 4, - nlocals: 1, - carrier: 2, - box_idx: 10, - add_idx: 11, - sub_idx: 12, - base_k: 7, - rec_first: false, - other: BodyOperand::Input, - combinator: Combinator::Add, - code_entry_bytes, - } - } - - #[test] - fn recursion_plan_requires_exact_code_entry_bytes() { - let plan = recursion_plan_recursive( - 10, - (FragHostRole::Add, 11), - 12, - 1, - 7, - false, - BodyOperand::Input, - ); - let canonical = - lower_expr_fragment_plan_code_entry_bytes(&plan, 2).expect("canonical lowering"); - - // Honest body: bytes equal the canonical lowering -> plan emitted. - assert!( - recursion_plan_from_cert(&recursive_cert(canonical.clone())).is_some(), - "byte-exact recursion body must carry a plan claim" - ); - - // Normalized body: an extra (alias) local classifies identically but - // its raw bytes differ -> NO plan claim; certification declines, fail-closed. - let mut noisy = canonical.clone(); - assert_eq!(noisy[1..4], [0x01, 0x01, 0x63], "locals decl prefix moved"); - noisy[2] = 0x02; // declare two scratch locals instead of one - noisy[0] += 1; // keep the size prefix consistent - noisy.insert(4, 0x63); // second local group type byte placeholder - assert!( - recursion_plan_from_cert(&recursive_cert(noisy)).is_none(), - "a body the canonical plan cannot reproduce must not carry a claim" - ); - } -} diff --git a/aver-cert/src/engine/rederive.rs b/aver-cert/src/engine/rederive.rs deleted file mode 100644 index 72d3de8a9..000000000 --- a/aver-cert/src/engine/rederive.rs +++ /dev/null @@ -1,590 +0,0 @@ -/// Producer-side analysis of one candidate obligation. It records the plan and -/// byte-derived facts needed to render package data. The verifier does not trust -/// this value: the Lean wall decodes and binds the relevant facts from -/// `ArtifactBytes` again. -pub struct RederivedObligation { - pub name: String, - /// Position in the module's byte-derived user-function list, used by the - /// producer to keep claims in artifact order. - pub func_order: usize, - /// The `fun fn => ...` `CodeTbl` value (`render_code_value`). - pub code: String, - /// `Obligation.self`: the self function index in the module. - pub self_idx: u32, - /// `Obligation.carrier`: the Int carrier struct type index. - pub carrier: u32, - /// Producer candidates for policy and termination. `ClaimAxes` derives the - /// accepted values again from the checked plan. - pub policy: CertificationPolicy, - pub termination_witness: Option, - /// For expression fragments, the byte-derived function-section type index. - /// This connects export/function routing to the actual declared function - /// signature slot; the Lean wall decodes and checks it independently. - pub fragment_type_idx: Option, - /// For expression fragments, the byte-derived local count recorded in the - /// `WCode` body. The current plan-first lowering emits one scratch carrier - /// local; artifact acceptance also binds it to the decoded code table. - pub fragment_nlocals: Option, - /// The expression plan rendered as an `ExprFragmentRawPlan` term. - pub fragment_plan_lean: Option, - /// For expression fragments whose checked representation plan can be - /// projected into the source-level symbolic grammar, the corresponding - /// `SymRawPlan` term. Representation-only fragments leave it absent. - pub fragment_sym_plan_lean: Option, - /// For field-projection fragments, the byte-derived struct-table entries - /// (`source type name -> wasm struct type index`) this export pins. The - /// producer unions these into the module-wide struct table cited by the - /// artifact claims; empty for non-projection fragments. - pub fragment_struct_entries: Vec<(String, u32)>, - /// Producer-computed `List WInstr` body used as an emission consistency - /// check. Lean lowers the plan independently. - pub fragment_lowered_body_lean: Option, - /// Producer-computed canonical code-entry bytes used as an emission - /// consistency check. Lean lowers and compares independently. - pub fragment_lowered_code_entry_lean: Option, - /// The string-concat plan rendered as a `StringConcatRawPlan` term. - pub string_concat_plan_lean: Option, - /// The source-level `SymRawPlan` view of the same byte-derived string - /// concat shape. The checker witness requires this to explain the - /// target-bound `StringConcatRawPlan`. - pub string_concat_sym_plan_lean: Option, - /// For `string-concat-v1`, the byte-derived function-section type index. - pub string_concat_type_idx: Option, - /// For `string-concat-v1`, the producer-computed `List WInstr` body. - pub string_concat_lowered_body_lean: Option, - /// For `string-concat-v1`, the producer-computed canonical code-entry bytes. - pub string_concat_lowered_code_entry_lean: Option, - /// The string byte-array type used by `array.new_data` and returned by the - /// concat helper. - pub string_concat_result_ty: Option, - /// The array-of-string-arrays container type used by `array.new_fixed`. - pub string_concat_container_ty: Option, - /// The wasm function index of the `String.concat` host helper. - pub string_concat_func_idx: Option, - /// The same checked String.eq plan rendered as a Lean `StringEqRawPlan` term. - pub string_eq_plan_lean: Option, - /// The source-level `SymRawPlan` view of the same byte-derived String.eq shape. - pub string_eq_sym_plan_lean: Option, - /// For `string-eq-v1`, the byte-derived function-section type index. - pub string_eq_type_idx: Option, - /// For `string-eq-v1`, the producer-computed `List WInstr` body. - pub string_eq_lowered_body_lean: Option, - /// For `string-eq-v1`, the producer-computed canonical code-entry bytes. - pub string_eq_lowered_code_entry_lean: Option, - /// The string byte-array type used by the String.eq dispatch. - pub string_eq_string_ty: Option, - /// The wasm function index of the `String.eq` host helper. - pub string_eq_func_idx: Option, - /// The same checked construct plan rendered as a Lean `ConstructRawPlan` - /// term. - pub construct_plan_lean: Option, - /// The source-level `SymRawPlan` view of the same byte-derived constructor - /// shape. - pub construct_sym_plan_lean: Option, - /// For `construct-v1`, the byte-derived function-section type index. - pub construct_type_idx: Option, - pub construct_struct_idx: Option, - pub construct_field_count: Option, - pub construct_elem_ty_lean: Option, - /// True only when the producer-reconstructed source result is `List`; - /// only those claims require the cons-cell-specific type-section guards. - pub construct_is_list: bool, - /// For `construct-v1`, the producer-computed `List WInstr` body that the - /// checked constructor plan canonically lowers to. - pub construct_lowered_body_lean: Option, - /// For `construct-v1`, the producer-computed canonical raw code-entry bytes - /// that the checked constructor plan lowers to. - pub construct_lowered_code_entry_lean: Option, - /// For `recursion-plan-v1` (fuel-recursion), the byte-derived recursion plan - /// rendered as a Lean `RecursionRawPlan` term. - pub recursion_plan_lean: Option, - /// For `recursion-plan-v1`, the per-export byte-derived host-role table - /// (box/combinator/sub) rendered as the Lean `List (HostRole × Nat)` - /// literal the recursion claim carries. - pub recursion_host_table_lean: Option, - /// For `recursion-plan-v1`, the byte-derived function-section type index. - pub recursion_type_idx: Option, - /// For `recursion-plan-v1`, the producer-computed `List WInstr` body the - /// checked recursion plan canonically lowers to (equal to `Module.lean`). - pub recursion_lowered_body_lean: Option, - /// For `recursion-plan-v1`, the producer-computed canonical raw code-entry - /// bytes the checked recursion plan lowers to. - pub recursion_lowered_code_entry_lean: Option, - /// For `mutual-plan-v1` (mutual-recursion member), the byte-derived member - /// plan rendered as a Lean `MutualRawPlan` term. - pub mutual_plan_lean: Option, - /// For `mutual-plan-v1`, the byte-derived SCC box/sub host-role table - /// rendered as the Lean `List (HostRole × Nat)` literal the claim carries. - pub mutual_host_table_lean: Option, - /// For `mutual-plan-v1`, the byte-derived SCC member-index set rendered as - /// the Lean `List Nat` literal the claim threads as member-call context. - pub mutual_member_set_lean: Option, - /// For `mutual-plan-v1`, this member's byte-derived function-section type index. - pub mutual_type_idx: Option, - /// For `mutual-plan-v1`, the producer-computed `List WInstr` body this - /// member's checked plan lowers to (equal to its arm of the shared table). - pub mutual_lowered_body_lean: Option, - /// For `mutual-plan-v1`, the producer-computed canonical raw code-entry - /// bytes this member's checked plan lowers to. - pub mutual_lowered_code_entry_lean: Option, - /// For `verbatim-plan-v1` (a `Cod := WVal` verbatim `ref.test`-dispatch - /// match), the byte-derived plan rendered as a Lean `VerbatimRawPlan` term. - /// There is no host/self call to bind, so no host-table/member-set/ - /// lowered-body/code-entry companion fields are needed: the byte-equality - /// gate is the whole soundness binding and the claim's witness is anonymous. - pub verbatim_plan_lean: Option, - /// For `int-dispatch-v1` (a `Cod := Int` ADT-match: general variant - /// dispatch or widened Int match), the byte-derived plan rendered as a Lean - /// `IntDispatchRawPlan` term. The claim's - /// witness is anonymous like the verbatim family's (no code/type index is - /// carried); unlike it the arms consume host contracts, so the claim also - /// carries the byte-derived role table below. - pub int_dispatch_plan_lean: Option, - /// For `int-dispatch-v1`, the per-export byte-derived host-role table - /// (box, plus add/sub exactly when wired) rendered as the Lean - /// `List (HostRole × Nat)` literal the claim carries. - pub int_dispatch_host_table_lean: Option, - /// `field-projection-v1` plan and byte-derived type context. The plan names - /// only the field; struct identity/count and selected result type are - /// reconstructed from validated module bytes. - pub field_projection_plan_lean: Option, - pub field_projection_struct_idx: Option, - pub field_projection_field_count: Option, - pub field_projection_result_ty_lean: Option, - /// Plan-backed composition closure members. Each member carries the - /// rendered shape/name plan plus byte-derived binding facts. - pub composition_members: Vec, - /// Strict byte-derived singleton add-role table. - pub composition_host_table_lean: Option, - /// Exact byte-derived reachable closure names for this root. - pub composition_member_names_lean: Option, -} - -#[derive(Clone)] -pub struct RederivedCompositionMember { - pub name: String, - pub self_idx: u32, - pub type_idx: u32, - pub plan_lean: String, - pub lowered_body_lean: String, - pub lowered_code_entry_lean: String, -} - -pub struct RederivedCertificate { - pub obligations: Vec, - pub contracts: Vec, -} - -/// Re-derive one [`RederivedObligation`] per user function that classifies into -/// a certified template, in module (obligation) order. The order and length -/// match `render_manifest_lean`'s `obligations` list, so the checker's -/// list-equality `rfl`s bind position for position. -pub fn rederive_obligations( - wasm_bytes: &[u8], - model_files: &[(String, String)], -) -> Result, String> { - Ok(rederive_certificate(wasm_bytes, model_files)?.obligations) -} - -/// Re-derive the byte-bound certificate face: obligations plus the runtime -/// contracts those byte-classified obligations actually consume. -pub fn rederive_certificate( - wasm_bytes: &[u8], - model_files: &[(String, String)], -) -> Result { - rederive_certificate_inner(wasm_bytes, model_files) -} - -fn rederive_certificate_inner( - wasm_bytes: &[u8], - model_files: &[(String, String)], -) -> Result { - let (user_fns, box_idx, user_idx_set, carrier, host_roles, frag_host_table, struct_field_counts) = - disassemble(wasm_bytes)?; - let model_ops = model_step_ops(model_files); - let model_info = ModelInfo::from_files(model_files); - let fns: std::collections::HashMap = - user_fns.iter().map(|f| (f.wasm_idx, f)).collect(); - let mut certs = Vec::new(); - for (func_order, f) in user_fns.iter().enumerate() { - let classified = classify_without_expr_fragment( - f, - box_idx, - carrier, - &user_idx_set, - &fns, - &ClassifierContext { - host_roles: &host_roles, - struct_field_counts: &struct_field_counts, - model_ops: &model_ops, - }, - ); - if let Ok(c) = classified { - certs.push((func_order, c)); - } - } - let contracts = runtime_contracts_for_certs(certs.iter().map(|(_, c)| c)); - let obligations = certs - .iter() - .map(|(func_order, c)| RederivedObligation { - name: c.name().to_string(), - func_order: *func_order, - code: render_code_value(c), - self_idx: c.self_idx(), - carrier: c.carrier(), - policy: c.policy(), - termination_witness: c.termination_witness(), - fragment_type_idx: match c.inner() { - Cert::ExprFragment { type_idx, .. } => Some(*type_idx), - _ => None, - }, - fragment_nlocals: match c.inner() { - Cert::ExprFragment { nlocals, .. } => Some(*nlocals as u32), - _ => None, - }, - fragment_plan_lean: match c.inner() { - Cert::ExprFragment { plan, .. } => Some(expr_fragment_plan_lean_value(plan)), - _ => None, - }, - fragment_sym_plan_lean: match c.inner() { - Cert::ExprFragment { - source_plan, plan, .. - } => expr_fragment_source_plan(source_plan, plan).map(|sym| sym_plan_lean_value(&sym)), - _ => None, - }, - fragment_struct_entries: match c.inner() { - Cert::ExprFragment { - source_plan: Some(source_plan), - plan, - .. - } => expr_fragment_struct_table_entries(source_plan, plan).unwrap_or_default(), - _ => Vec::new(), - }, - fragment_lowered_body_lean: match c.inner() { - Cert::ExprFragment { ops, .. } => Some(render_ops_value(ops)), - _ => None, - }, - fragment_lowered_code_entry_lean: match c.inner() { - Cert::ExprFragment { carrier, plan, .. } => { - lower_expr_fragment_plan_code_entry_bytes(plan, *carrier) - .ok() - .map(|bytes| render_byte_list(&bytes)) - } - _ => None, - }, - string_concat_plan_lean: match c.inner() { - Cert::StringConcatVerbatimMatch { .. } => { - string_concat_plan_from_cert(c).map(|plan| string_concat_plan_lean_value(&plan)) - } - _ => None, - }, - string_concat_sym_plan_lean: match c.inner() { - Cert::StringConcatVerbatimMatch { .. } => { - string_concat_sym_plan_from_cert(c).map(|plan| sym_plan_lean_value(&plan)) - } - _ => None, - }, - string_concat_type_idx: match c.inner() { - Cert::StringConcatVerbatimMatch { type_idx, .. } => Some(*type_idx), - _ => None, - }, - string_concat_lowered_body_lean: match c.inner() { - Cert::StringConcatVerbatimMatch { - result_ty, - container_ty, - string_concat_idx, - .. - } => string_concat_plan_from_cert(c) - .and_then(|plan| { - lower_string_concat_plan( - &plan, - *result_ty, - *container_ty, - *string_concat_idx, - ) - .ok() - }) - .map(|ops| render_ops_value(&ops)), - _ => None, - }, - string_concat_lowered_code_entry_lean: match c.inner() { - Cert::StringConcatVerbatimMatch { - carrier, - result_ty, - container_ty, - string_concat_idx, - .. - } => string_concat_plan_from_cert(c) - .and_then(|plan| { - lower_string_concat_plan_code_entry_bytes( - &plan, - *carrier, - *result_ty, - *container_ty, - *string_concat_idx, - ) - .ok() - }) - .map(|bytes| render_byte_list(&bytes)), - _ => None, - }, - string_concat_result_ty: match c.inner() { - Cert::StringConcatVerbatimMatch { result_ty, .. } => Some(*result_ty), - _ => None, - }, - string_concat_container_ty: match c.inner() { - Cert::StringConcatVerbatimMatch { container_ty, .. } => Some(*container_ty), - _ => None, - }, - string_concat_func_idx: match c.inner() { - Cert::StringConcatVerbatimMatch { - string_concat_idx, .. - } => Some(*string_concat_idx), - _ => None, - }, - string_eq_plan_lean: match c.inner() { - Cert::StringEqVerbatimMatch { .. } => { - string_eq_plan_from_cert(c).map(|plan| string_eq_plan_lean_value(&plan)) - } - _ => None, - }, - string_eq_sym_plan_lean: match c.inner() { - Cert::StringEqVerbatimMatch { .. } => { - string_eq_sym_plan_from_cert(c).map(|plan| sym_plan_lean_value(&plan)) - } - _ => None, - }, - string_eq_type_idx: match c.inner() { - Cert::StringEqVerbatimMatch { type_idx, .. } => Some(*type_idx), - _ => None, - }, - string_eq_lowered_body_lean: match c.inner() { - Cert::StringEqVerbatimMatch { string_eq_idx, .. } => { - string_eq_string_ty_from_cert(c).and_then(|string_ty| { - string_eq_plan_from_cert(c) - .and_then(|plan| { - lower_string_eq_plan(&plan, string_ty, *string_eq_idx).ok() - }) - .map(|ops| render_ops_value(&ops)) - }) - } - _ => None, - }, - string_eq_lowered_code_entry_lean: match c.inner() { - Cert::StringEqVerbatimMatch { - carrier, - string_eq_idx, - .. - } => { - string_eq_string_ty_from_cert(c).and_then(|string_ty| { - string_eq_plan_from_cert(c) - .and_then(|plan| { - lower_string_eq_plan_code_entry_bytes( - &plan, - *carrier, - string_ty, - *string_eq_idx, - ) - .ok() - }) - .map(|bytes| render_byte_list(&bytes)) - }) - } - _ => None, - }, - string_eq_string_ty: match c.inner() { - Cert::StringEqVerbatimMatch { .. } => string_eq_string_ty_from_cert(c), - _ => None, - }, - string_eq_func_idx: match c.inner() { - Cert::StringEqVerbatimMatch { string_eq_idx, .. } => Some(*string_eq_idx), - _ => None, - }, - construct_plan_lean: match c.inner() { - Cert::AdtConstructor { .. } => { - construct_plan_from_cert(c).map(|plan| construct_plan_lean_value(&plan)) - } - _ => None, - }, - construct_sym_plan_lean: match c.inner() { - Cert::AdtConstructor { .. } => adt_constructor_sym_plan_from_cert(c, &model_info) - .map(|plan| sym_plan_lean_value(&plan)), - _ => None, - }, - construct_type_idx: match c.inner() { - Cert::AdtConstructor { type_idx, .. } => Some(*type_idx), - _ => None, - }, - construct_struct_idx: match c.inner() { - Cert::AdtConstructor { struct_idx, .. } => Some(*struct_idx), - _ => None, - }, - construct_field_count: match c.inner() { - Cert::AdtConstructor { field_count, .. } => Some(*field_count), - _ => None, - }, - construct_elem_ty_lean: match c.inner() { - Cert::AdtConstructor { elem_ty, .. } => construct_val_type_lean_value(*elem_ty), - _ => None, - }, - construct_is_list: match c.inner() { - Cert::AdtConstructor { .. } => adt_constructor_sym_plan_from_cert(c, &model_info) - .is_some_and(|plan| sym_plan_is_list_construct(&plan)), - _ => false, - }, - construct_lowered_body_lean: match c.inner() { - Cert::AdtConstructor { struct_idx, .. } => construct_plan_from_cert(c) - .and_then(|plan| lower_construct_plan(&plan, *struct_idx).ok()) - .map(|ops| render_ops_value(&ops)), - _ => None, - }, - construct_lowered_code_entry_lean: match c.inner() { - Cert::AdtConstructor { carrier, struct_idx, .. } => construct_plan_from_cert(c) - .and_then(|plan| lower_construct_plan_code_entry_bytes(&plan, *carrier, *struct_idx).ok()) - .map(|bytes| render_byte_list(&bytes)), - _ => None, - }, - recursion_plan_lean: recursion_plan_from_cert(c) - .map(|plan| recursion_plan_lean_value(&plan)), - recursion_host_table_lean: match c.inner() { - Cert::Recursive { .. } | Cert::AccumulatorRecursive { .. } => { - Some(recursion_host_table_lean_value(c)) - } - _ => None, - }, - recursion_type_idx: match c.inner() { - Cert::Recursive { type_idx, .. } | Cert::AccumulatorRecursive { type_idx, .. } => { - Some(*type_idx) - } - _ => None, - }, - recursion_lowered_body_lean: match c.inner() { - Cert::Recursive { carrier, .. } | Cert::AccumulatorRecursive { carrier, .. } => { - recursion_plan_from_cert(c) - .and_then(|plan| lower_expr_fragment_plan(&plan, *carrier).ok()) - .map(|ops| render_ops_value(&ops)) - } - _ => None, - }, - recursion_lowered_code_entry_lean: match c.inner() { - Cert::Recursive { carrier, .. } | Cert::AccumulatorRecursive { carrier, .. } => { - recursion_plan_from_cert(c) - .and_then(|plan| { - lower_expr_fragment_plan_code_entry_bytes(&plan, *carrier).ok() - }) - .map(|bytes| render_byte_list(&bytes)) - } - _ => None, - }, - mutual_plan_lean: mutual_plan_from_cert(c).map(|plan| mutual_plan_lean_value(&plan)), - mutual_host_table_lean: match c.inner() { - Cert::MutualRecursion { - box_idx, sub_idx, .. - } => Some(mutual_host_table_lean_value(*box_idx, *sub_idx)), - _ => None, - }, - mutual_member_set_lean: match c.inner() { - Cert::MutualRecursion { scc, .. } => Some(mutual_member_set_lean_value(scc)), - _ => None, - }, - mutual_type_idx: match c.inner() { - Cert::MutualRecursion { position, scc, .. } => { - scc.get(*position).map(|m| m.type_idx) - } - _ => None, - }, - mutual_lowered_body_lean: match c.inner() { - Cert::MutualRecursion { carrier, .. } => mutual_plan_from_cert(c) - .and_then(|plan| lower_expr_fragment_plan(&plan, *carrier).ok()) - .map(|ops| render_ops_value(&ops)), - _ => None, - }, - mutual_lowered_code_entry_lean: match c.inner() { - Cert::MutualRecursion { carrier, .. } => mutual_plan_from_cert(c) - .and_then(|plan| { - lower_expr_fragment_plan_code_entry_bytes(&plan, *carrier).ok() - }) - .map(|bytes| render_byte_list(&bytes)), - _ => None, - }, - verbatim_plan_lean: verbatim_plan_from_cert(c) - .map(|plan| verbatim_plan_lean_value(&plan)), - int_dispatch_plan_lean: int_dispatch_plan_from_cert(c, frag_host_table) - .map(|plan| int_dispatch_plan_lean_value(&plan)), - int_dispatch_host_table_lean: match int_dispatch_plan_from_cert(c, frag_host_table) { - Some(_) => int_dispatch_host_table_from_cert(c) - .map(|hosts| int_dispatch_host_table_lean_value(&hosts)), - None => None, - }, - field_projection_plan_lean: field_projection_plan_from_cert(c) - .map(|(plan, _)| field_projection_plan_lean_value(&plan)), - field_projection_struct_idx: match c.inner() { - Cert::FieldProjection { struct_idx, .. } - if field_projection_plan_from_cert(c).is_some() => Some(*struct_idx), - _ => None, - }, - field_projection_field_count: match c.inner() { - Cert::FieldProjection { field_count, .. } - if field_projection_plan_from_cert(c).is_some() => Some(*field_count), - _ => None, - }, - field_projection_result_ty_lean: field_projection_plan_from_cert(c) - .map(|(_, ty)| field_projection_result_ty_lean_value(ty)), - composition_members: match c.inner() { - Cert::Composition { carrier, closure, .. } => { - let funcs = composition_func_table(closure); - let add_idx = frag_host_table.add_idx; - composition_plans_from_cert(c, frag_host_table) - .unwrap_or_default() - .into_iter() - .filter_map(|(entry, plan)| { - let add_idx = add_idx?; - Some(RederivedCompositionMember { - name: entry.name, - self_idx: entry.self_idx, - type_idx: entry.type_idx, - plan_lean: composition_plan_lean_value(&plan), - lowered_body_lean: render_ops_value( - &lower_composition_plan(&plan, add_idx, &funcs)?, - ), - lowered_code_entry_lean: render_byte_list( - &composition_code_entry_bytes( - &plan, *carrier, add_idx, &funcs, - )?, - ), - }) - }) - .collect() - } - _ => Vec::new(), - }, - composition_host_table_lean: match c.inner() { - Cert::Composition { .. } - if composition_plans_from_cert(c, frag_host_table).is_some() => - { - frag_host_table.add_idx.map(composition_host_table_lean_value) - } - _ => None, - }, - composition_member_names_lean: match c.inner() { - Cert::Composition { closure, .. } - if composition_plans_from_cert(c, frag_host_table).is_some() => - { - Some(format!( - "[{}]", - closure - .iter() - .map(|entry| lean_str(&entry.name)) - .collect::>() - .join(", ") - )) - } - _ => None, - }, - }) - .collect(); - Ok(RederivedCertificate { - obligations, - contracts, - }) -} diff --git a/aver-cert/src/engine/render.rs b/aver-cert/src/engine/render.rs deleted file mode 100644 index 3a3d55cd4..000000000 --- a/aver-cert/src/engine/render.rs +++ /dev/null @@ -1,11 +0,0 @@ -include!("render_project.rs"); -include!("render_code.rs"); -include!("render_certificate.rs"); -include!("render_integer.rs"); -include!("render_composition.rs"); -include!("render_expr_fragment.rs"); -include!("render_expr_fragment_bridge.rs"); -include!("render_model_support.rs"); -include!("render_mutual.rs"); -include!("render_side_conditions.rs"); -include!("render_manifest.rs"); diff --git a/aver-cert/src/engine/render_certificate.rs b/aver-cert/src/engine/render_certificate.rs deleted file mode 100644 index 742084e61..000000000 --- a/aver-cert/src/engine/render_certificate.rs +++ /dev/null @@ -1,86 +0,0 @@ -fn render_certificate( - analysis: &Analysis, - model_roots: &[String], - model_info: &ModelInfo, -) -> String { - let mut s = String::new(); - s.push_str( - "import CertPrelude\nimport Module\nimport Schema\nimport Manifest\nimport IntDispatchSoundness\nimport DischargeComposition\nimport DischargeExprFragment\nimport DischargeRecursion\n", - ); - for r in model_roots { - s.push_str(&format!("import {r}\n")); - } - s.push_str( - "\nset_option linter.unusedSimpArgs false\n\ - set_option linter.unusedVariables false\n\ - set_option maxRecDepth 1000000\n\ - set_option maxHeartbeats 1600000\n\n\ - namespace CertProofs\nopen CertPrelude CertModule AverCert AverCert.Schema\n\n", - ); - let struct_table_lean = emit_frag_struct_table_lean(analysis) - .expect("certified fragment struct table remains consistent"); - // Mutual option-(b) bridges share one concrete SCC/acceptance package. - // Emit those packages first so source/export order cannot create a forward - // reference when a non-primary member appears before its primary. - for c in &analysis.certs { - if matches!(c.inner(), Cert::MutualRecursion { .. }) { - s.push_str(&render_mutual_shared_bridge_data(c)); - } - } - for c in &analysis.certs { - match c.inner() { - // `recursion_uses_audited_generic` holds for both variants, so the - // audited generic bridge is the only renderer either can take; the - // bridge re-asserts that in a debug build. The fuel-ladder renderer - // that used to stand behind the guard was unreachable and is gone. - Cert::Recursive { .. } | Cert::AccumulatorRecursive { .. } => { - s.push_str(&render_recursion_semantic_bridge(c, model_info)) - } - // Constructor packs (verbatim and named-ADT) are discharged in - // `Final.cert`: verbatim packs by the canonical option-(c) leaf, - // named constructors by the declared-envelope face transport. - Cert::AdtConstructor { .. } => {} - // The field-projection family is discharged in `Final.cert` by the - // audited generic theorem plus its canonical option-(c) leaf bridge. - // Its plan, obligation and claim data remain emitted unchanged. - Cert::FieldProjection { .. } => {} - // Int-face dispatch is discharged in `Final.cert` by the - // declared-envelope face transport; no bespoke bridge is emitted. - Cert::WidenedIntMatch { .. } | Cert::VariantDispatch { .. } => {} - // Selection-faced and compute-faced fragments are discharged - // inside the wall from their checked face; they contribute no - // semantic bridge, so they must be routed away from the - // audited-generic bridge renderer even though their source types - // sit inside its gate. - Cert::ExprFragment { .. } - if c.int_cmp_face().is_some() || c.record_compute_face().is_some() => {} - Cert::ExprFragment { .. } - if expr_fragment_uses_audited_generic(c) || c.tag_dispatch_face().is_some() => - { - s.push_str(&render_expr_fragment_semantic_bridge( - c, - analysis.frag_host_table, - &struct_table_lean, - model_info, - )) - } - Cert::ExprFragment { .. } => s.push_str(&render_expr_fragment_cert(c)), - // Verbatim and String families are discharged by their audited - // canonical leaf bridges. Their plans/claims/data remain emitted. - Cert::VerbatimWidenedMatch { .. } - | Cert::VerbatimVariantDispatch { .. } - | Cert::StringEqVerbatimMatch { .. } - | Cert::StringConcatVerbatimMatch { .. } => {} - Cert::Composition { .. } => { - s.push_str(&render_composition_semantic_bridge(c, analysis, model_info)) - } - Cert::MutualRecursion { .. } => { - s.push_str(&render_mutual_semantic_bridge(c, model_info)) - } - Cert::NonRecursive { .. } => unreachable!(), - } - s.push('\n'); - } - s.push_str("end CertProofs\n"); - s -} diff --git a/aver-cert/src/engine/render_code.rs b/aver-cert/src/engine/render_code.rs deleted file mode 100644 index f518e0e44..000000000 --- a/aver-cert/src/engine/render_code.rs +++ /dev/null @@ -1,2 +0,0 @@ -include!("render_code_tables.rs"); -include!("render_code_instrs.rs"); diff --git a/aver-cert/src/engine/render_code_instrs.rs b/aver-cert/src/engine/render_code_instrs.rs deleted file mode 100644 index e92b81f6e..000000000 --- a/aver-cert/src/engine/render_code_instrs.rs +++ /dev/null @@ -1,161 +0,0 @@ -enum LeanInstr { - Simple(String), - IfElse(Vec, Vec), -} - -fn render_ops_value(ops: &[Op]) -> String { - let mut pos = 0usize; - let instrs = parse_lean_instrs(ops, &mut pos, false).unwrap_or_default(); - render_lean_instr_list(&instrs) -} - -fn parse_lean_instrs(ops: &[Op], pos: &mut usize, nested: bool) -> Option> { - let mut out = Vec::new(); - while *pos < ops.len() { - match &ops[*pos] { - Op::Else | Op::End if nested => break, - Op::If => { - *pos += 1; - let then_b = parse_lean_instrs(ops, pos, true)?; - if !matches!(ops.get(*pos), Some(Op::Else)) { - return None; - } - *pos += 1; - let else_b = parse_lean_instrs(ops, pos, true)?; - if !matches!(ops.get(*pos), Some(Op::End)) { - return None; - } - *pos += 1; - out.push(LeanInstr::IfElse(then_b, else_b)); - } - Op::Else | Op::End => return None, - op => { - out.push(LeanInstr::Simple(render_simple_op(op)?)); - *pos += 1; - } - } - } - Some(out) -} - -fn render_simple_op(op: &Op) -> Option { - Some(match op { - Op::LocalGet(i) => format!(".localGet {i}"), - Op::LocalSet(i) => format!(".localSet {i}"), - Op::I64Const(n) => format!(".i64Const ({n})"), - Op::I32Const(n) => format!(".i32Const ({n})"), - Op::F64Const(bits) => format!(".f64Const 0x{bits:016x}"), - Op::RefTest(t) => format!(".refTest {t}"), - Op::RefCast(t) => format!(".refCast {t}"), - Op::StructNew(t, n) => format!(".structNew {t} {n}"), - Op::StructGet(t, f) => format!(".structGet {t} {f}"), - Op::ArrayNewData { - type_idx, bytes, .. - } => format!(".arrayNewData {type_idx} {}", render_nat_list(bytes)), - Op::ArrayNewFixed(t, n) => format!(".arrayNewFixed {t} {n}"), - // The heap-type payload is deliberately NOT rendered: Lean's - // `CoreInstr.refNull` is a unit constructor, so emitting the index - // would change the audited artifact bytes. The index is carried only - // for Rust-side re-lowering in the S2 grammar leg. - Op::RefNull(_) => ".refNull".to_string(), - Op::RefIsNull => ".refIsNull".to_string(), - Op::I64Eq => ".i64Eq".to_string(), - Op::I64LeS => ".i64LeS".to_string(), - Op::I64LtS => ".i64LtS".to_string(), - Op::I64GeS => ".i64GeS".to_string(), - Op::I64GtS => ".i64GtS".to_string(), - Op::F64Add => ".f64Add".to_string(), - Op::F64Mul => ".f64Mul".to_string(), - Op::F64Le => ".f64Le".to_string(), - Op::F64Ge => ".f64Ge".to_string(), - Op::F64Lt => ".f64Lt".to_string(), - Op::F64Gt => ".f64Gt".to_string(), - Op::F64Eq => ".f64Eq".to_string(), - Op::I32Eq => ".i32Eq".to_string(), - Op::I32LtS => ".i32LtS".to_string(), - Op::I32GtS => ".i32GtS".to_string(), - Op::I32LtU => ".i32LtU".to_string(), - Op::I32GeS => ".i32GeS".to_string(), - Op::I32And => ".i32And".to_string(), - Op::ArrayLen => ".arrayLen".to_string(), - Op::ArrayGet(t) => format!(".arrayGet {t}"), - Op::Call(f) => format!(".call {f}"), - Op::ReturnCall(f) => format!(".returnCall {f}"), - Op::ArrayNewDataUnresolved { .. } | Op::If | Op::Else | Op::End | Op::Other => { - return None; - } - }) -} - -fn render_nat_list(bytes: &[u8]) -> String { - let parts = bytes - .iter() - .map(|b| b.to_string()) - .collect::>() - .join(", "); - format!("[{parts}]") -} - -fn render_wval(default: &VerbatimDefault) -> String { - match default { - VerbatimDefault::Null => ".null".to_string(), - VerbatimDefault::F64Bits(bits) => format!(".f64v 0x{bits:016x}"), - VerbatimDefault::Array { - type_idx, bytes, .. - } => { - format!(".arr {type_idx} {}", render_array_elements(bytes)) - } - } -} - -fn render_wval_qualified(default: &VerbatimDefault) -> String { - match default { - VerbatimDefault::Null => "WVal.null".to_string(), - VerbatimDefault::F64Bits(bits) => format!("WVal.f64v 0x{bits:016x}"), - VerbatimDefault::Array { - type_idx, bytes, .. - } => { - format!("WVal.arr {type_idx} {}", render_array_elements(bytes)) - } - } -} - -fn render_wval_arg(default: &VerbatimDefault) -> String { - format!("({})", render_wval(default)) -} - -fn render_string_eq_default(default: &StringEqDefault, input: &str) -> String { - match default { - StringEqDefault::Input => input.to_string(), - StringEqDefault::Verbatim(k) => render_wval(k), - } -} - -fn render_array_elements(bytes: &[u8]) -> String { - let parts = bytes - .iter() - .map(|b| format!(".i32v {}", *b as i32)) - .collect::>() - .join(", "); - format!("[{parts}]") -} - -fn render_lean_instr_list(instrs: &[LeanInstr]) -> String { - let parts = instrs - .iter() - .map(render_lean_instr) - .collect::>() - .join(", "); - format!("[{parts}]") -} - -fn render_lean_instr(instr: &LeanInstr) -> String { - match instr { - LeanInstr::Simple(s) => s.clone(), - LeanInstr::IfElse(t, e) => format!( - ".ifElse {} {}", - render_lean_instr_list(t), - render_lean_instr_list(e) - ), - } -} diff --git a/aver-cert/src/engine/render_code_tables.rs b/aver-cert/src/engine/render_code_tables.rs deleted file mode 100644 index 900305b58..000000000 --- a/aver-cert/src/engine/render_code_tables.rs +++ /dev/null @@ -1,211 +0,0 @@ -/// An `Int` literal for Lean source: negatives parenthesised so `.i64Const -7` -/// does not misparse; non-negatives bare (byte-identical to the shipped `0`). -fn lean_int_lit(k: i64) -> String { - if k < 0 { - format!("({k})") - } else { - k.to_string() - } -} - -/// The `CodeTbl` VALUE (the `fun fn => ...` lambda, no `def` wrapper) a -/// certified body decodes to. This is the term the checker splices, verbatim, -/// into `CheckerWitness.lean` and pins with `rfl` against -/// `manifest.obligations.map (·.code)`, so a `{name}Code` def in the cert's -/// `Module.lean` that diverges from the bytes fails the kernel witness. Kept -/// byte-identical to the RHS `render_code_def` emits so the emitted `Module.lean` -/// is unchanged. -fn render_code_value(c: &Cert) -> String { - match c.inner() { - Cert::Recursive { - self_idx, - nlocals, - carrier, - box_idx, - add_idx, - sub_idx, - base_k, - rec_first, - other, - .. - } => { - let base = lean_int_lit(*base_k); - // The step arm pushes the two `add` operands (the recursive result and - // the other operand) in their recognised order, then calls `add`. - let rec_ops = format!( - ".localGet 0, .i64Const 1, .call {box_idx}, .call {sub_idx}, .call {self_idx}" - ); - let other_ops = match other { - BodyOperand::Input => ".localGet 0".to_string(), - BodyOperand::Const(k) => format!(".i64Const {}, .call {box_idx}", lean_int_lit(*k)), - }; - let (a_ops, b_ops) = if *rec_first { - (&rec_ops, &other_ops) - } else { - (&other_ops, &rec_ops) - }; - let step = format!("{a_ops}, {b_ops}, .call {add_idx}"); - format!( - "fun fn =>\n \ - if fn = {self_idx} then some ⟨1, {nlocals},\n \ - [ .localGet 0, .structGet {carrier} 1, .refIsNull,\n \ - .ifElse [.localGet 0, .structGet {carrier} 0, .i64Const 0, .i64LeS]\n \ - [.localGet 0, .structGet {carrier} 2, .i32Const 0, .i32LtS],\n \ - .ifElse [.i64Const {base}, .call {box_idx}]\n \ - [{step}] ]⟩\n else none", - ) - } - Cert::AccumulatorRecursive { - self_idx, - nlocals, - carrier, - box_idx, - add_idx, - sub_idx, - .. - } => format!( - "fun fn =>\n \ - if fn = {self_idx} then some ⟨2, {nlocals},\n \ - [ .localGet 0, .structGet {carrier} 1, .refIsNull,\n \ - .ifElse [.localGet 0, .structGet {carrier} 0, .i64Const 0, .i64LeS]\n \ - [.localGet 0, .structGet {carrier} 2, .i32Const 0, .i32LtS],\n \ - .ifElse [.localGet 1]\n \ - [.localGet 0, .i64Const 1, .call {box_idx}, .call {sub_idx}, \ - .localGet 1, .localGet 0, .call {add_idx}, .returnCall {self_idx}] ]⟩\n else none", - ), - Cert::AdtConstructor { - self_idx, - nlocals, - ops, - .. - } - | Cert::FieldProjection { - self_idx, - nlocals, - ops, - .. - } - | Cert::WidenedIntMatch { - self_idx, - nlocals, - ops, - .. - } - | Cert::VerbatimWidenedMatch { - self_idx, - nlocals, - ops, - .. - } - | Cert::VerbatimVariantDispatch { - self_idx, - nlocals, - ops, - .. - } - | Cert::StringEqVerbatimMatch { - self_idx, - nlocals, - ops, - .. - } - | Cert::StringConcatVerbatimMatch { - self_idx, - nlocals, - ops, - .. - } - | Cert::ExprFragment { - self_idx, - nlocals, - ops, - .. - } - | Cert::VariantDispatch { - self_idx, - nlocals, - ops, - .. - } => format!( - "fun fn =>\n \ - if fn = {self_idx} then some ⟨{arity}, {nlocals}, {body}⟩ else none", - arity = c.arity(), - body = render_ops_value(ops), - ), - Cert::Composition { closure, .. } => render_closure_code_value(closure), - // Shared code table over the whole SCC: one `if fn = self then …` arm per - // member, in `self_idx` order. Each arm is the fixed mutual body shape - // (base boxes the member's literal; the else tail-calls the member's - // cross target on `n-1`) — the same lossless template `Cert::Recursive` - // uses, so it is byte-identical to the recognised bytes and to the term - // the checker re-derives. - Cert::MutualRecursion { - scc, - carrier, - box_idx, - sub_idx, - .. - } => { - let mut s = String::from("fun fn =>\n "); - for (i, m) in scc.iter().enumerate() { - let kw = if i == 0 { "if" } else { "else if" }; - let base = lean_int_lit(m.base_k); - s.push_str(&format!( - "{kw} fn = {self_idx} then some ⟨1, {nlocals},\n \ - [ .localGet 0, .structGet {carrier} 1, .refIsNull,\n \ - .ifElse [.localGet 0, .structGet {carrier} 0, .i64Const 0, .i64LeS]\n \ - [.localGet 0, .structGet {carrier} 2, .i32Const 0, .i32LtS],\n \ - .ifElse [.i64Const {base}, .call {box_idx}]\n \ - [.localGet 0, .i64Const 1, .call {box_idx}, .call {sub_idx}, .returnCall {cross}] ]⟩\n ", - self_idx = m.self_idx, - nlocals = m.nlocals, - cross = m.cross_idx, - )); - } - s.push_str("else none"); - s - } - Cert::NonRecursive { .. } => unreachable!(), - } -} - -/// The multi-entry `CodeTbl` VALUE for a composition: one `if fn = i then …` -/// arm per function in the caller's whole call closure, in `self_idx` order. -/// The checker re-derives this from the bytes and pins the WHOLE table with one -/// `rfl`, so every callee body the caller's proof reduces through is byte-bound. -fn render_closure_code_value(closure: &[ClosureEntry]) -> String { - let mut s = String::from("fun fn =>\n "); - for (i, e) in closure.iter().enumerate() { - let kw = if i == 0 { "if" } else { "else if" }; - s.push_str(&format!( - "{kw} fn = {idx} then some ⟨1, {nlocals}, {body}⟩\n ", - idx = e.self_idx, - nlocals = e.nlocals, - body = render_ops_value(&e.ops), - )); - } - s.push_str("else none"); - s -} - -/// The host-table arms for a composition closure: each carrier-`add` helper the -/// closure calls wired to the `add` contract parameter, terminated by `none`. -/// v1 leaves consume only `add`; the arms grow with the leaf vocabulary. -fn compose_host_arms(closure: &[ClosureEntry]) -> String { - let mut adds: Vec = closure - .iter() - .filter_map(|e| match e.shape { - LeafShape::SelfSum { add_idx } => Some(add_idx), - LeafShape::Chain { .. } => None, - }) - .collect(); - adds.sort_unstable(); - adds.dedup(); - let mut s = String::new(); - for (i, a) in adds.iter().enumerate() { - let kw = if i == 0 { "if" } else { "else if" }; - s.push_str(&format!("{kw} fn = {a} then some (2, add)\n ")); - } - s.push_str("else none"); - s -} diff --git a/aver-cert/src/engine/render_composition.rs b/aver-cert/src/engine/render_composition.rs deleted file mode 100644 index ffe3dc6ff..000000000 --- a/aver-cert/src/engine/render_composition.rs +++ /dev/null @@ -1,430 +0,0 @@ -/// Post-order (callees-before-callers) topological order of a composition -/// closure, starting the DFS at the caller so the caller comes last. Every -/// closure is an acyclic user-call DAG (enforced by `collect_closure`). -fn compose_topo_order(caller_idx: u32, closure: &[ClosureEntry]) -> Vec { - let by_idx: std::collections::HashMap = - closure.iter().map(|e| (e.self_idx, e)).collect(); - let mut order = Vec::new(); - let mut seen = std::collections::HashSet::new(); - fn dfs( - idx: u32, - by_idx: &std::collections::HashMap, - seen: &mut std::collections::HashSet, - order: &mut Vec, - ) { - if !seen.insert(idx) { - return; - } - if let Some(e) = by_idx.get(&idx) - && let LeafShape::Chain { calls } = &e.shape - { - for c in calls { - dfs(*c, by_idx, seen, order); - } - } - order.push(idx); - } - dfs(caller_idx, &by_idx, &mut seen, &mut order); - order -} - -fn composition_member_claim_lean_value(entry: &ClosureEntry) -> String { - format!( - "({{ exportNameBytes := {}, exportName := {}, \ - plan := AverCert.Plans.{}CompositionPlan }} : \ - AverCert.AcceptedArtifact.CompositionMemberClaim)", - render_byte_list(entry.name.as_bytes()), - lean_str(&entry.name), - entry.name, - ) -} - -fn composition_members_lean_value(closure: &[ClosureEntry]) -> String { - format!( - "[{}]", - closure - .iter() - .map(composition_member_claim_lean_value) - .collect::>() - .join(", ") - ) -} - -fn composition_claim_lean_value(c: &Cert, add_idx: u32) -> String { - let Cert::Composition { - name, - carrier, - closure, - .. - } = c.inner() - else { - unreachable!() - }; - let member_names = closure - .iter() - .map(|entry| lean_str(&entry.name)) - .collect::>() - .join(", "); - format!( - "({{ exportName := {}, carrier := {carrier}, hostTable := {}, \ - memberNames := [{member_names}], obligation := AverCert.{name}Ob }} : \ - AverCert.AcceptedArtifact.CompositionClaim)", - lean_str(name), - composition_host_table_lean_value(add_idx), - ) -} - -/// Render the companion `{name}_compositionClaimAccepted` acceptance as a SPLIT -/// proof, mirroring `render_composition_claim_bundles` in `render_project.rs`. -/// -/// Returns `(declarations, aggregate_proof)`: the per-member witness `def`s and -/// leaf theorems to emit before the aggregate theorem, and the aggregate proof -/// term the theorem's `exact` uses. This bridge module re-proves acceptance in a -/// standalone file, so it carried the same monolithic member tuple the artifact -/// root did; naming each member's body/code-entry/binding and hoisting the -/// member `modBytes` walks into leaves keeps the module's per-claim peak bounded. -fn composition_bridge_claim_accepted(c: &Cert, strict: FragHostTable) -> (String, String) { - let Cert::Composition { - name, - carrier, - closure, - .. - } = c.inner() - else { - unreachable!() - }; - let plans = composition_plans_from_cert(c, strict) - .expect("audited composition has byte-derived member plans"); - let add_idx = strict - .add_idx - .expect("plan-backed composition has strict add host"); - let host_table = composition_host_table_lean_value(add_idx); - let funcs = composition_func_table(closure); - let host_types = format!("{name}CompositionHostTypes"); - // Shared host-table type pin; one leaf serves the claim and every member. - let mut declarations = format!( - "-- Claim-level host-table declared-function-type pin, shared by the claim\n\ - -- and every member (a `modBytes` type-section walk).\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table} = true := by\n \ - rfl\n\n" - ); - let mut named_proof = "trivial".to_string(); - for (member_index, (entry, plan)) in plans.iter().enumerate().rev() { - let body = render_ops_value( - &lower_composition_plan(plan, add_idx, &funcs) - .expect("composition member lowers against closure table"), - ); - let code_entry = render_byte_list( - &composition_code_entry_bytes(plan, *carrier, add_idx, &funcs) - .expect("composition member byte-lowers against closure table"), - ); - let export_name_bytes = render_byte_list(entry.name.as_bytes()); - let body_def = format!("{name}CompositionMember{member_index}Body"); - let code_def = format!("{name}CompositionMember{member_index}CodeEntry"); - let binding_def = format!("{name}CompositionMember{member_index}Binding"); - let func_binding = format!("{name}CompositionMember{member_index}FuncBinding"); - let func_type = format!("{name}CompositionMember{member_index}FuncType"); - declarations = format!( - "-- Member `{member_index}` witness data as named constants.\n\ - def {body_def} : List CertPrelude.WInstr := {body}\n\n\ - def {code_def} : AverCert.WasmSlice.ByteSeq := {code_entry}\n\n\ - def {binding_def} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_def} }}\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_def} = some {binding_def} := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding_def}.typeIdx 1 {carrier} = true := by\n \ - rfl\n\n{declarations}", - self_idx = entry.self_idx, - type_idx = entry.type_idx, - ); - let member_proof = format!( - "⟨rfl, ⟨{body_def}, {code_def}, {binding_def}, rfl, rfl, {func_binding}, {func_type}, {host_types}, rfl⟩⟩" - ); - named_proof = format!("⟨{member_proof}, {named_proof}⟩"); - } - let aggregate_proof = format!( - "⟨rfl, ⟨rfl, ⟨rfl, ⟨{host_types}, ⟨rfl, ⟨rfl, ⟨rfl, {named_proof}⟩⟩⟩⟩⟩⟩⟩" - ); - (declarations, aggregate_proof) -} - -/// Option-(b) composition bridge. Root glue is discharged by the audited -/// generic; generated lemmas remain only for the non-root member semantics -/// that the generic deliberately consumes through `MemberFact`. -fn render_composition_semantic_bridge( - c: &Cert, - analysis: &Analysis, - model_info: &ModelInfo, -) -> String { - let Cert::Composition { - name, - self_idx, - carrier, - closure, - .. - } = c.inner() - else { - unreachable!() - }; - // Qualified model identifiers: the root and every closure member. - // `model_citation_gate` covers a composition's root AND its whole closure, - // and both `analyze` and `write_project` enforce it, so each resolves. - let member_model = |entry: &ClosureEntry| -> String { - model_info - .model_lean_name(&entry.name) - .expect("model-citing certificate passed the qualified-name gate") - }; - let root_model = c.model_lean_name(model_info); - let add_idx = analysis - .frag_host_table - .add_idx - .expect("composition bridge has strict add host"); - let by_idx: std::collections::HashMap = - closure.iter().map(|e| (e.self_idx, e)).collect(); - let root = by_idx[self_idx]; - let LeafShape::Chain { calls: root_calls } = &root.shape else { - unreachable!("composition root is a chain") - }; - let callees = root_calls - .iter() - .map(|idx| lean_str(&by_idx[idx].name)) - .collect::>(); - let callees_lean = format!("[{}]", callees.join(", ")); - let lemma_name = |idx: u32| -> String { format!("{name}__compositionMember_{idx}") }; - let model_name = format!("{name}CompositionModel"); - let sig = |concl_model: &str| -> String { - format!( - " (S : CarrierSpec {carrier}) (add sub : List WVal → Option WVal)\n\ - \x20 (hadd : ∀ a b va vb w, S.Repr a va → S.Repr b vb → add [va, vb] = some w → S.Repr (a + b) w)\n\ - \x20 (hsub : ∀ a b va vb w, S.Repr a va → S.Repr b vb → sub [va, vb] = some w → S.Repr (a - b) w) :\n\ - \x20 ∀ (fuel : Nat) (x : Int) (v w : WVal), S.Repr x v →\n\ - \x20 wFuncN {name}Code ({name}Host add sub) fuel {{IDX}} [v] = some w → S.Repr ({concl_model}) w" - ) - }; - - let mut s = format!( - "/-! ### {name} — option-(b) composition semantic bridge (carrier type {carrier}) -/\n\n" - ); - s.push_str(&format!( - "def {model_name} (member : String) (x : Int) : Int :=\n {}\n\n", - closure - .iter() - .map(|entry| format!( - "if member = {} then {} x else", - lean_str(&entry.name), - member_model(entry) - )) - .chain(std::iter::once("x".to_string())) - .collect::>() - .join(" ") - )); - let model_simp = closure - .iter() - .map(&member_model) - .collect::>() - .join(", "); - - for idx in compose_topo_order(*self_idx, closure) { - if idx == *self_idx { - continue; - } - let e = by_idx[&idx]; - let head = format!( - "theorem {}\n{}", - lemma_name(idx), - sig(&format!("{model_name} {} x", lean_str(&e.name))) - ) - .replace("{IDX}", &idx.to_string()); - match &e.shape { - LeafShape::SelfSum { .. } => { - s.push_str(&format!( - "-- callee `{ename}`: self-sum leaf, over the shared closure table.\n{head} := by\n \ - intro fuel x v w hv hrun\n \ - cases fuel with\n \ - | zero => simp only [wFuncN, reduceCtorEq] at hrun\n \ - | succ f =>\n \ - rcases hc : add [v, v] with _ | r <;>\n \ - simp [wFuncN, wRunF, {name}Code, {name}Host, boxRef, popArgs, initLocals, hc] at hrun\n \ - subst hrun\n \ - simpa [{model_name}, {model_simp}] using hadd x x v v r hv hv hc\n\n", - ename = e.name, - )); - } - LeafShape::Chain { calls } => { - let mut body = String::new(); - // one `rcases … <;> simp … at hrun` per call site (threading m1, m2, …). - for (i, c_idx) in calls.iter().enumerate() { - let arg = if i == 0 { - "[v]".to_string() - } else { - format!("[m{i}]") - }; - body.push_str(&format!( - " rcases h{h} : wFuncN {name}Code ({name}Host add sub) f {c_idx} {arg} with _ | m{h} <;>\n \ - simp [wFuncN, wRunF, {name}Code, {name}Host, popArgs, initLocals, h{h}] at hrun\n", - h = i + 1, - )); - } - body.push_str(" subst hrun\n"); - // cite the callee simulation lemma at each site, threading the model. - let mut model_arg = "x".to_string(); - for (i, c_idx) in calls.iter().enumerate() { - let (vin, hrepr) = if i == 0 { - ("v".to_string(), "hv".to_string()) - } else { - (format!("m{i}"), format!("r{i}")) - }; - body.push_str(&format!( - " have r{h} := {lem} S add sub hadd hsub f ({model_arg}) {vin} m{h} {hrepr} h{h}\n", - h = i + 1, - lem = lemma_name(*c_idx), - )); - model_arg = format!( - "{model_name} {} ({model_arg})", - lean_str(&by_idx[c_idx].name) - ); - } - body.push_str(&format!( - " simpa [{model_name}, {model_simp}] using r{}\n\n", - calls.len() - )); - s.push_str(&format!( - "-- callee `{ename}`: unary user-call chain; cites each member lemma.\n{head} := by\n \ - intro fuel x v w hv hrun\n \ - cases fuel with\n \ - | zero => simp only [wFuncN, reduceCtorEq] at hrun\n \ - | succ f =>\n{body}", - ename = e.name, - )); - } - } - } - - let members = composition_members_lean_value(closure); - let all_members = format!( - "[{}]", - composition_member_plans(analysis) - .iter() - .map(|(entry, _)| composition_member_claim_lean_value(entry)) - .collect::>() - .join(", ") - ); - let claim = composition_claim_lean_value(c, add_idx); - let (claim_decls, acceptance) = - composition_bridge_claim_accepted(c, analysis.frag_host_table); - s.push_str(&format!( - "def {name}CompositionMembers : List AverCert.AcceptedArtifact.CompositionMemberClaim :=\n \ - {members}\n\n\ - def {name}CompositionClaim : AverCert.AcceptedArtifact.CompositionClaim :=\n \ - {claim}\n\n\ - {claim_decls}\ - theorem {name}_compositionClaimAccepted :\n \ - AverCert.AcceptedArtifact.compositionClaimAccepted\n \ - AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen\n \ - {name}CompositionMembers {name}CompositionClaim := by\n \ - dsimp [{name}CompositionMembers, {name}CompositionClaim,\n \ - AverCert.AcceptedArtifact.compositionClaimAccepted,\n \ - AverCert.AcceptedArtifact.compositionFuncTable,\n \ - AverCert.AcceptedArtifact.compositionMemberBinding,\n \ - AverCert.AcceptedArtifact.compositionNamedMembersAccepted,\n \ - AverCert.AcceptedArtifact.compositionMemberPlanAccepted,\n \ - AverCert.AcceptedArtifact.compositionMemberForName,\n \ - AverCert.AcceptedArtifact.compositionClosureBound,\n \ - AverCert.AcceptedArtifact.compositionEdges,\n \ - AverCert.AcceptedArtifact.compositionPlanCallees,\n \ - AverCert.AcceptedArtifact.compositionEdgesDescend,\n \ - AverCert.AcceptedArtifact.compositionReachClosure,\n \ - AverCert.AcceptedArtifact.compositionReachStep,\n \ - AverCert.AcceptedArtifact.stringListNodup,\n \ - AverCert.AcceptedArtifact.stringListSetEq]\n \ - exact {acceptance}\n\n" - )); - - let direct_callee = by_idx[root_calls - .first() - .expect("composition root has a direct callee")]; - let direct_member = composition_member_claim_lean_value(direct_callee); - let direct_plan = composition_plan_for_entry( - direct_callee, - &closure - .iter() - .map(|entry| (entry.self_idx, entry.name.clone())) - .collect(), - ) - .expect("direct composition member has a plan"); - let funcs = composition_func_table(closure); - let direct_body = render_ops_value( - &lower_composition_plan(&direct_plan, add_idx, &funcs) - .expect("direct composition member lowers"), - ); - let direct_code_entry = render_byte_list( - &composition_code_entry_bytes(&direct_plan, *carrier, add_idx, &funcs) - .expect("direct composition member byte-lowers"), - ); - let direct_binding = format!( - "({{ funcIdx := {}, typeIdx := {}, codeEntry := {} }} : \ - AverCert.WasmSlice.FuncBinding)", - direct_callee.self_idx, - direct_callee.type_idx, - direct_code_entry, - ); - s.push_str(&format!( - "theorem {name}_compositionSemanticBridge :\n \ - AcceptanceSoundness.compositionClaimSemanticBridge\n \ - ({{ modBytes := AverCert.ArtifactBytes.modBytes,\n \ - modLen := AverCert.ArtifactBytes.modLen, manifest := AverCert.manifest,\n \ - wasip2ComponentEnvelope := none,\n \ - symFragmentClaims := [], stringEqClaims := [], stringConcatClaims := [],\n \ - constructClaims := [], recursionClaims := [], mutualRecursionClaims := [],\n \ - verbatimClaims := [], intDispatchClaims := [], fieldProjectionClaims := [],\n \ - compositionMembers := {all_members},\n \ - compositionClaims := [{name}CompositionClaim], closureFuel := 0,\n \ - closureClaim := {{ roots := [], helpers := [], admitted := [] }} }} :\n \ - AverCert.AcceptedArtifact.ArtifactData)\n \ - {name}CompositionClaim {callees_lean} := by\n \ - refine ⟨rfl, ?_⟩\n \ - intro S add sub mul stringEq stringConcat toIndex cmp eq\n \ - hAdd hSub hMul hStringEq hStringConcat _hToIndex _hCmp _hEq ns vs hDom\n \ - dsimp [{name}CompositionClaim, AverCert.{name}Ob] at ns vs hDom ⊢\n \ - rcases hDom with ⟨hRepr, hLen⟩\n \ - cases hRepr with\n \ - | nil => simp at hLen\n \ - | cons hv htail =>\n \ - rename_i n v ns' vs'\n \ - cases htail with\n \ - | cons _ _ => simp at hLen\n \ - | nil =>\n \ - refine ⟨n, v, {model_name}, {root_model}, rfl, hv, ?_, ?_, ?_⟩\n \ - · intro input\n \ - simp [{model_name}, CompositionSoundness.evalCompositionCalls, {model_simp}]\n \ - · intro w hw\n \ - simpa [AverCert.Schema.intRepr] using hw\n \ - · intro funcTable hTable member hMember\n \ - have hMember' : member = {} := by simpa using hMember\n \ - subst member\n \ - exact ⟨⟨\n \ - {direct_member},\n \ - by rfl,\n \ - {},\n \ - AcceptanceSoundness.compositionFuncIdx_eq_binding\n \ - AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen\n \ - {all_members} funcTable {} {direct_member}\n \ - {direct_binding} hTable (by rfl) (by rfl),\n \ - by simp [CertModule.{name}Host],\n \ - {direct_body},\n \ - by rfl,\n \ - {} S add sub (AverCert.Schema.carrierContract_weaken hAdd)\n \ - (AverCert.Schema.carrierContract_weaken hSub)\n \ - ⟩⟩\n\n\ - #print axioms {name}_compositionSemanticBridge\n", - lean_str(&direct_callee.name), - direct_callee.self_idx, - lean_str(&direct_callee.name), - lemma_name(direct_callee.self_idx), - )); - - s -} diff --git a/aver-cert/src/engine/render_expr_fragment.rs b/aver-cert/src/engine/render_expr_fragment.rs deleted file mode 100644 index d0b9e86ba..000000000 --- a/aver-cert/src/engine/render_expr_fragment.rs +++ /dev/null @@ -1,592 +0,0 @@ -fn render_expr_fragment_cert(c: &Cert) -> String { - // The Int selection face discharges entirely inside the wall - // (`intSelect_claim_discharges`): the checked face pins its whole meaning, - // so there is no producer semantic premise and no bespoke proof - // declaration to emit. This test precedes the audited-generic one because - // its source types (Int, Int -> Int) sit inside that gate while its PLAN - // calls a runtime helper the generic fragment grammar refuses. - if c.int_cmp_face().is_some() { - return String::new(); - } - // Compute-face fragments discharge through the wall's checked face - // (`recordCompute_claim_discharges`) and emit no bespoke proof. This test - // precedes the audited-generic one for the same reason: a scalar-parameter - // compute plan (a boxed add-constant, a helper comparison) has Int/Bool - // source types but a plan the generic fragment grammar refuses. - if c.record_compute_face().is_some() { - return String::new(); - } - // Audited integer/Bool source fragments emit only their option-(b) - // semantic bridge in `Certificate.lean`. - if expr_fragment_uses_audited_generic(c) { - return String::new(); - } - // Projection-faced fragments are discharged in `Final.cert` through the - // audited direct-projection generic and emit no bespoke proof declarations. - if c.project_face().is_some() { - return String::new(); - } - // Record-parameter fragments discharge through the wall's checked record - // face (`recordParam_claim_discharges`) and emit no bespoke proof - // declarations. Falling to the generic body renderer would emit a bogus - // `{name}_simulates` over `verbatimRepr` (and, for an Int-carrier field - // read, panic in the value renderer on the user struct projection). - if c.record_param_face().is_some() { - return String::new(); - } - if let Some(face) = c.vector_get_face() { - return render_expr_fragment_vector_get_cert(c, face); - } - let c = c.inner(); - let Cert::ExprFragment { - name, - self_idx, - carrier, - plan, - .. - } = c - else { - unreachable!() - }; - let binders = plan - .params - .iter() - .enumerate() - .map(|(i, ty)| format!("(a{i} : {})", ty.lean_dom_type())) - .collect::>() - .join(" "); - let theorem_args = (0..plan.params.len()) - .map(|i| format!("a{i}")) - .collect::>(); - let input_list = expr_fragment_arg_list(plan, |i, ty| { - ty.lean_arg_repr(&format!("a{i}"), &carrier.to_string()) - }); - let result = expr_fragment_wval_expr(plan, &|idx, _ty| format!("a{idx}")); - let evalset = format!("wFuncN, wRunF, {name}Code, {name}Host, f, b32, popArgs, initLocals"); - let proof_tactic = expr_fragment_simp_tactic(plan, &evalset); - let model_args = (0..plan.params.len()) - .map(|i| expr_fragment_dom_accessor("p", i, plan.params.len())) - .collect::>() - .join(" "); - let model_args = if model_args.is_empty() { - String::new() - } else { - format!(" {model_args}") - }; - let cod_repr = expr_fragment_cod_repr(plan.result); - format!( - r#"/-! ### {name} — expr-fragment-v1 certificate (carrier type {carrier}) -/ - -/-- The verifier-checked plan is an `expr-fragment-v1`: a typed, ordered, - non-recursive wasm fragment with no runtime host calls. -/ -theorem {name}_wasm_certified (S : CarrierSpec {carrier}) : - ∀ (fuel : Nat) {binders}, - wFuncN {name}Code {name}Host (fuel + 1) {self_idx} {input_list} - = some ({result}) := by - intro fuel {intro_args} -{proof_tactic} - -#print axioms {name}_wasm_certified - -def {name}HostRef : HostTbl := {name}Host - -theorem {name}_simulates : AverCert.Schema.Obligation.holds {name}Ob := by - intro S add sub mul stringEq stringConcat toIndex cmp eq hadd hsub hmul hStringEq hStringConcat _hToIndex _hCmp _hEq fuel p vs w hrepr hrun - simp only [{name}Ob, AverCert.Schema.Obligation.holds] at hrun ⊢ - subst hrepr - cases fuel with - | zero => simp [wFuncN] at hrun - | succ f => - rw [{name}_wasm_certified S f{model_args}] at hrun - simp only [Option.some.injEq] at hrun - subst hrun - simp [{cod_repr}] -"#, - intro_args = theorem_args.join(" "), - ) -} - -/// The fused vector-read proof: the obligation discharges through the wall's -/// generic template theorem, specialised to this claim's byte-derived holes -/// and the plan-lowered code table. The to-index contract hypothesis comes -/// straight from the obligation denotation's sixth host-contract slot. -fn render_expr_fragment_vector_get_cert(c: &Cert, face: FragVectorGetOrDefaultFace) -> String { - let name = c.name(); - let carrier = c.carrier(); - let self_idx = c.self_idx(); - format!( - r#"/-! ### {name} — fused vector-read certificate (carrier type {carrier}) -/ - -theorem {name}_simulates : AverCert.Schema.Obligation.holds AverCert.{name}Ob := by - intro S add sub mul stringEq stringConcat toIndex cmp eq _hadd _hsub _hmul _hStringEq - _hStringConcat hToIndex _hCmp _hEq fuel p vs w hDom hRun - obtain ⟨v, i⟩ := p - exact AverCert.StandardFace.vectorGetOrDefault_simulates_model - {carrier} {to_index_idx} {box_idx} {arr_ty} ({d} : Int) (by decide) S toIndex hToIndex - CertModule.{name}Code {self_idx} rfl fuel v i vs w hDom hRun - -#print axioms {name}_simulates -"#, - to_index_idx = face.to_index_idx, - box_idx = face.box_idx, - arr_ty = face.arr_ty, - d = face.default, - ) -} - -fn expr_fragment_cod_repr(ty: FragTy) -> &'static str { - match ty { - FragTy::F64 => "AverCert.Schema.floatBitsRepr", - FragTy::BoolI32 => "AverCert.Schema.boolRepr", - FragTy::IntCarrier | FragTy::I64 | FragTy::RawI32 | FragTy::Ref | FragTy::AdtRef => { - "AverCert.Schema.verbatimRepr" - } - } -} - -fn expr_fragment_arg_list(plan: &ExprFragmentPlan, mut arg: F) -> String -where - F: FnMut(usize, FragTy) -> String, -{ - let args = plan - .params - .iter() - .enumerate() - .map(|(i, ty)| arg(i, *ty)) - .collect::>(); - format!("[{}]", args.join(", ")) -} - -fn expr_fragment_wval_expr(plan: &ExprFragmentPlan, local: &F) -> String -where - F: Fn(u32, FragTy) -> String, -{ - let root = plan.body.node(plan.body.result).expect("fragment root exists"); - let value = expr_fragment_value_expr(&plan.body, plan.body.result, local); - match root.ty { - FragTy::F64 => format!(".f64v ({value})"), - FragTy::BoolI32 => format!("b32 ({value})"), - FragTy::IntCarrier | FragTy::I64 | FragTy::RawI32 | FragTy::Ref | FragTy::AdtRef => { - unreachable!("expr-fragment root must be a certified result type") - } - } -} - -fn expr_fragment_value_expr(block: &FragBlock, id: FragValueId, local: &F) -> String -where - F: Fn(u32, FragTy) -> String, -{ - let node = block.node(id).expect("fragment node exists"); - match node.ty { - FragTy::BoolI32 => expr_fragment_bool_expr(block, id, local), - FragTy::RawI32 => expr_fragment_i32_expr(block, id, local), - _ => expr_fragment_typed_value_expr(block, id, local), - } -} - -fn expr_fragment_typed_value_expr(block: &FragBlock, id: FragValueId, local: &F) -> String -where - F: Fn(u32, FragTy) -> String, -{ - let node = block.node(id).expect("fragment node exists"); - match &node.kind { - FragNodeKind::Local { index } => local(*index, node.ty), - FragNodeKind::ConstBool(v) => v.to_string(), - FragNodeKind::ConstI64(k) => lean_int_lit(*k), - FragNodeKind::ConstI32(k) => k.to_string(), - FragNodeKind::ConstF64(bits) => lean_u64_hex(*bits), - FragNodeKind::StructGet { - field, receiver, .. - } => { - let recv = expr_fragment_value_expr(block, *receiver, local); - match field { - 0 => recv, - // `expr-fragment-v1`'s Int face is stated over canonical - // `carrierSmall`, whose limbs field is null and sign is 0. - 1 => "WVal.null".to_string(), - 2 => "0".to_string(), - _ => unreachable!("unsupported carrier field in fragment"), - } - } - FragNodeKind::StructGetUser { .. } => { - unreachable!("user struct projection is rendered by the projection face, not the generic value renderer") - } - FragNodeKind::VectorGetOrDefault { .. } => { - unreachable!("the fused vector read is rendered by its own face, not the generic value renderer") - } - FragNodeKind::StructNew { .. } => { - unreachable!("user struct construction is rendered by its own face, not the generic value renderer") - } - FragNodeKind::RefIsNull { value } => { - let v = expr_fragment_value_expr(block, *value, local); - format!("{v} = WVal.null") - } - FragNodeKind::Prim { op, args } => { - match op { - FragPrim::F64Add => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("(Float.ofBits ({lhs}) + Float.ofBits ({rhs})).toBits") - } - FragPrim::F64Mul => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("(Float.ofBits ({lhs}) * Float.ofBits ({rhs})).toBits") - } - FragPrim::F64Le => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({lhs}) <= Float.ofBits ({rhs})") - } - // `f64.ge` is stated as the swapped `<=`, exactly the shape the - // wall interpreter gives `.f64Ge` (`b32 (f b <= f a)`) and the - // same convention `i64.ge_s` already uses. It is an IEEE ordered - // comparison in both directions, so a NaN operand makes it false - // — the identical NaN posture as `f64.le`. - FragPrim::F64Ge => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({rhs}) <= Float.ofBits ({lhs})") - } - FragPrim::F64Lt => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({lhs}) < Float.ofBits ({rhs})") - } - // `f64.gt` is stated as the swapped `<`, matching the wall - // interpreter's `.f64Gt` clause (`b32 (f b < f a)`) and the - // swapped-relation convention `f64.ge`/`i64.ge_s` already use. - FragPrim::F64Gt => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({rhs}) < Float.ofBits ({lhs})") - } - // `f64.eq` is stated with Bool-valued `==` (`Float.beq`, the - // extern IEEE comparison), NEVER with propositional `=`: - // `Float` has no lawful `DecidableEq`, and `Float.ofBits b = - // Float.ofBits b` holds for a NaN pattern while `f64.eq` - // returns 0 for it. `==` is exactly the wall interpreter's - // `.f64Eq` clause (`b32 (f a == f b)`). - FragPrim::F64Eq => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({lhs}) == Float.ofBits ({rhs})") - } - FragPrim::I64Eq => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({lhs}) = ({rhs})") - } - FragPrim::I64LeS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({lhs}) <= ({rhs})") - } - FragPrim::I64LtS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({lhs}) < ({rhs})") - } - FragPrim::I64GeS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({rhs}) <= ({lhs})") - } - // Swapped `<`, the same convention `i64.ge_s` uses for `>=`, - // matching the wall interpreter's `.i64GtS` clause. - FragPrim::I64GtS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({rhs}) < ({lhs})") - } - FragPrim::I32Eq => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("(({lhs}) = ({rhs}))") - } - FragPrim::I32LtS => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("({lhs}) < ({rhs})") - } - FragPrim::I32GtS => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("({lhs}) > ({rhs})") - } - FragPrim::I32GeS => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("({lhs}) \u{2265} ({rhs})") - } - FragPrim::I32And => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("(({lhs}) \u{2227} ({rhs}))") - } - } - } - FragNodeKind::HostCall { .. } => { - unreachable!("host-free expr-fragment value renderer does not handle host calls") - } - FragNodeKind::SelfCall { .. } => { - unreachable!("self-call is rendered by the fuel-recursion face, not the generic value renderer") - } - FragNodeKind::IntSignCmp { .. } => { - unreachable!("the sign template is rendered by the record-compute face, not the generic value renderer") - } - FragNodeKind::If { - cond, - then_block, - else_block, - } => { - let c = expr_fragment_bool_expr(block, *cond, local); - let t = expr_fragment_value_expr(then_block, then_block.result, local); - let e = expr_fragment_value_expr(else_block, else_block.result, local); - format!("if ({c}) then ({t}) else ({e})") - } - } -} - -fn expr_fragment_bool_expr(block: &FragBlock, id: FragValueId, local: &F) -> String -where - F: Fn(u32, FragTy) -> String, -{ - let node = block.node(id).expect("fragment node exists"); - match &node.kind { - FragNodeKind::Local { index } => local(*index, node.ty), - FragNodeKind::ConstBool(v) => v.to_string(), - FragNodeKind::RefIsNull { value } => { - if matches!( - block.node(*value).map(|node| &node.kind), - Some(FragNodeKind::StructGet { field: 1, .. }) - ) { - "true".to_string() - } else { - let v = expr_fragment_value_expr(block, *value, local); - format!("{v} = WVal.null") - } - } - FragNodeKind::Prim { op, args } => match op { - FragPrim::F64Le => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({lhs}) <= Float.ofBits ({rhs})") - } - FragPrim::F64Ge => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({rhs}) <= Float.ofBits ({lhs})") - } - FragPrim::F64Lt => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({lhs}) < Float.ofBits ({rhs})") - } - FragPrim::F64Gt => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({rhs}) < Float.ofBits ({lhs})") - } - FragPrim::F64Eq => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("Float.ofBits ({lhs}) == Float.ofBits ({rhs})") - } - FragPrim::I64Eq => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({lhs}) = ({rhs})") - } - FragPrim::I64LeS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({lhs}) <= ({rhs})") - } - FragPrim::I64LtS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({lhs}) < ({rhs})") - } - FragPrim::I64GeS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({rhs}) <= ({lhs})") - } - FragPrim::I64GtS => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("({rhs}) < ({lhs})") - } - FragPrim::I32Eq => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("decide (({lhs}) = ({rhs}))") - } - FragPrim::I32LtS => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("({lhs}) < ({rhs})") - } - FragPrim::I32GtS => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("({lhs}) > ({rhs})") - } - FragPrim::I32GeS => { - let lhs = expr_fragment_i32_expr(block, args[0], local); - let rhs = expr_fragment_i32_expr(block, args[1], local); - format!("({lhs}) \u{2265} ({rhs})") - } - // Both operands are `BoolI32` by the checker's strict typing, so - // the source reading is plain conjunction of the operand readings - // (matching the wall interpreter's {0,1}-domain `.i32And` clause). - FragPrim::I32And => { - let lhs = expr_fragment_value_expr(block, args[0], local); - let rhs = expr_fragment_value_expr(block, args[1], local); - format!("(({lhs}) \u{2227} ({rhs}))") - } - FragPrim::F64Add | FragPrim::F64Mul => { - unreachable!("numeric primitive cannot produce BoolI32") - } - }, - FragNodeKind::If { - cond, - then_block, - else_block, - } => { - let c = expr_fragment_bool_expr(block, *cond, local); - let t = expr_fragment_bool_expr(then_block, then_block.result, local); - let e = expr_fragment_bool_expr(else_block, else_block.result, local); - format!("if ({c}) then ({t}) else ({e})") - } - // The inline sign template IS a `BoolI32` node, so it belongs here and - // not in the "not BoolI32" arm below. Its source meaning is the plain - // comparison of the operand against the literal — the wall's - // `RecordComputeBridge.symIntCmpDenote`. The record-compute face is - // the plan itself, so nothing in production reaches this renderer for - // this node; keeping the reading honest is what stops a later caller - // from getting a wrong-shape panic instead of an expression. - FragNodeKind::IntSignCmp { - op, - constant, - value, - .. - } => { - let v = expr_fragment_value_expr(block, *value, local); - let k = lean_int_lit(*constant); - match op { - SymIntCmp::Eq => format!("({v}) = ({k})"), - SymIntCmp::Lt => format!("({v}) < ({k})"), - SymIntCmp::Le => format!("({v}) <= ({k})"), - // Swapped `<=` / `<`, the convention `i64.ge_s` / `i64.gt_s` - // already use in this renderer. - SymIntCmp::Ge => format!("({k}) <= ({v})"), - SymIntCmp::Gt => format!("({k}) < ({v})"), - } - } - FragNodeKind::ConstI64(_) - | FragNodeKind::ConstI32(_) - | FragNodeKind::ConstF64(_) - | FragNodeKind::HostCall { .. } - | FragNodeKind::SelfCall { .. } - | FragNodeKind::StructGet { .. } - | FragNodeKind::StructGetUser { .. } - | FragNodeKind::StructNew { .. } - | FragNodeKind::VectorGetOrDefault { .. } => unreachable!("node is not BoolI32"), - } -} - -fn expr_fragment_i32_expr(block: &FragBlock, id: FragValueId, local: &F) -> String -where - F: Fn(u32, FragTy) -> String, -{ - let node = block.node(id).expect("fragment node exists"); - match node.ty { - FragTy::RawI32 => expr_fragment_typed_value_expr(block, id, local), - FragTy::BoolI32 => { - let b = expr_fragment_bool_expr(block, id, local); - format!("if ({b}) then (1 : Int) else (0 : Int)") - } - _ => unreachable!("node is not an i32 value"), - } -} - -fn expr_fragment_simp_tactic(plan: &ExprFragmentPlan, evalset: &str) -> String { - let mut steps = plan - .params - .iter() - .enumerate() - .filter(|(_, ty)| **ty == FragTy::BoolI32) - .map(|(i, _)| format!("cases a{i}")) - .collect::>(); - let mut conds = Vec::new(); - collect_expr_fragment_conditions(&plan.body, &|idx, _ty| format!("a{idx}"), &mut conds); - for (i, cond) in conds.iter().enumerate() { - steps.push(format!("by_cases h{i} : {cond}")); - } - let hints = if conds.is_empty() { - String::new() - } else { - format!( - ", {}", - (0..conds.len()) - .map(|i| format!("h{i}")) - .collect::>() - .join(", ") - ) - }; - if steps.is_empty() { - format!(" simp [{evalset}, carrierSmall, ge_iff_le]") - } else { - format!( - " {} <;> simp [{evalset}, carrierSmall, ge_iff_le{hints}]", - steps.join(" <;> ") - ) - } -} - -fn collect_expr_fragment_conditions(block: &FragBlock, local: &F, out: &mut Vec) -where - F: Fn(u32, FragTy) -> String, -{ - for node in &block.nodes { - match &node.kind { - FragNodeKind::Prim { - op: - FragPrim::F64Le - | FragPrim::F64Ge - | FragPrim::F64Lt - | FragPrim::F64Gt - | FragPrim::F64Eq - | FragPrim::I64Eq - | FragPrim::I64LeS - | FragPrim::I64LtS - | FragPrim::I64GeS - | FragPrim::I64GtS - | FragPrim::I32Eq - | FragPrim::I32LtS - | FragPrim::I32GtS, - .. - } => { - let cond = expr_fragment_value_expr(block, node.id, local); - if !out.contains(&cond) { - out.push(cond); - } - } - FragNodeKind::If { - then_block, - else_block, - .. - } => { - collect_expr_fragment_conditions(then_block, local, out); - collect_expr_fragment_conditions(else_block, local, out); - } - _ => {} - } - } -} - -fn lean_u64_hex(bits: u64) -> String { - format!("0x{bits:016x}") -} diff --git a/aver-cert/src/engine/render_expr_fragment_bridge.rs b/aver-cert/src/engine/render_expr_fragment_bridge.rs deleted file mode 100644 index 8888e864f..000000000 --- a/aver-cert/src/engine/render_expr_fragment_bridge.rs +++ /dev/null @@ -1,459 +0,0 @@ -/// Integer and Bool source fragments are within the audited symbolic fragment -/// grammar. Float fragments are deliberately excluded: their bit-level source -/// models remain bespoke because floating-point semantics are outside the -/// integer/Bool model. -fn expr_fragment_uses_audited_generic(c: &Cert) -> bool { - let Cert::ExprFragment { - source_plan: Some(source_plan), - plan, - .. - } = c.inner() - else { - return false; - }; - source_plan - .params - .iter() - .all(|ty| matches!(ty, SymTy::Int | SymTy::Bool)) - && matches!(source_plan.result, SymTy::Int | SymTy::Bool) - && plan - .params - .iter() - .all(|ty| matches!(ty, FragTy::IntCarrier | FragTy::BoolI32)) - && matches!(plan.result, FragTy::IntCarrier | FragTy::BoolI32) -} - -fn expr_fragment_source_model(c: &Cert, model_info: &ModelInfo) -> String { - debug_assert!(expr_fragment_uses_audited_generic(c)); - let model_name = c.model_lean_name(model_info); - match c.arity() { - 1 => model_name, - // The obligation domain is the right-nested product - // `FragParams.denote` builds, so the model uncurries the source - // function over the same `p.1, p.2.1, …, p.2…2` accessors the - // obligation emitter uses (`expr_fragment_dom_accessor`). - arity => { - let args = (0..arity) - .map(|index| format!(" {}", expr_fragment_dom_accessor("p", index, arity))) - .collect::(); - format!("fun p => {model_name}{args}") - } - } -} - -fn expr_fragment_claim_lean_value( - c: &Cert, - host_table: FragHostTable, - struct_table_lean: &str, -) -> String { - debug_assert!(expr_fragment_uses_audited_generic(c) || c.tag_dispatch_face().is_some()); - let name = c.name(); - format!( - "({{ exportNameBytes := {}, exportName := {}, carrier := {}, \ - hostTable := {}, structTable := {struct_table_lean}, \ - plan := AverCert.Plans.{name}SymPlan, obligation := AverCert.{name}Ob }} : \ - AverCert.AcceptedArtifact.SymFragmentClaim)", - render_byte_list(name.as_bytes()), - lean_str(name), - c.carrier(), - host_table.lean_value(), - ) -} - -/// Render the `{name}_exprFragmentClaimAccepted` theorem as a SPLIT proof: -/// witness data (the lowered `WInstr` body, code-entry bytes, function binding) -/// as named `def`s and each acceptance conjunct as its OWN leaf theorem, then an -/// aggregate that combines the already-checked constants. This mirrors -/// `render_sym_claim_bundles` in `render_project.rs` and exists for the SAME -/// reason: emitting one monolithic `exact ⟨…giant nested tuple…⟩` submits the -/// whole witness to the kernel in a single `addDecl` and holds it live, which -/// peaked `Certificate.lean` at ~6.5 GB — co-equal with, and independent of, the -/// artifact root's own peak. Splitting each piece into its own declaration drops -/// the peak to the largest single leaf (a `modBytes` decode / type-section walk, -/// each ≤ ~1.2 GB). The leaf conjuncts are stated over `AverCert.Plans.{name}Plan` -/// (the encoded plan), definitionally the value the aggregate reduces to, so the -/// aggregate re-runs no heavy reduction. -/// -/// `claim_target` is what `symFragmentClaimAccepted` is applied to — the `claim` -/// value inline, or a `{name}TagDispatchClaim` def the caller already emitted. -fn render_expr_fragment_claim_accepted_split( - c: &Cert, - claim_target: &str, - host_table_lean: &str, -) -> String { - let Cert::ExprFragment { - carrier, - self_idx, - type_idx, - plan, - .. - } = c.inner() - else { - unreachable!() - }; - let name = c.name(); - let carrier = *carrier; - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(plan, carrier) - .expect("generic expr-fragment plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_expr_fragment_plan(plan, carrier) - .map(|ops| render_ops_value(&ops)) - .expect("generic expr-fragment plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - let plan_ref = format!("AverCert.Plans.{name}Plan"); - let body = format!("{name}ClaimBody"); - let code_entry = format!("{name}ClaimCodeEntry"); - let binding = format!("{name}ClaimBinding"); - let carrier_bound = format!("{name}ClaimCarrierBound"); - let host_types = format!("{name}ClaimHostTableFuncTypes"); - let check_plan = format!("{name}ClaimCheckPlan"); - let lower_body = format!("{name}ClaimLowerBody"); - let lower_code = format!("{name}ClaimLowerCodeEntry"); - let func_binding = format!("{name}ClaimFuncBinding"); - let func_type = format!("{name}ClaimFuncTypeMatches"); - let nominal = format!("{name}ClaimNominalTypes"); - let accepted = format!("{name}_exprFragmentClaimAccepted"); - format!( - "-- Witness data as named constants so no large literal is baked into the\n\ - -- aggregate acceptance term (the source of this file's memory peak).\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct, each checked and freed in its\n\ - -- own `addDecl`.\n\ - theorem {carrier_bound} :\n \ - AverCert.AcceptedArtifact.symFragmentCarrierBound AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table_lean} {plan_ref} = true := by\n \ - rfl\n\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table_lean} = true := by\n \ - rfl\n\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkExprFragmentRawPlan {plan_ref} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerExprFragmentBody {carrier} {plan_ref} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerExprFragmentCodeEntry {carrier} {plan_ref} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.exprFragmentFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {carrier} {plan_ref}.params {plan_ref}.result = true := by\n \ - rfl\n\n\ - theorem {nominal} :\n \ - AverCert.WasmSlice.exprFragmentNominalTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {carrier} {plan_ref} = true := by\n \ - rfl\n\n\ - -- Aggregate: combine the already-checked leaf constants.\n\ - theorem {accepted} :\n \ - AverCert.AcceptedArtifact.symFragmentClaimAccepted\n \ - AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {claim_target} := by\n \ - unfold AverCert.AcceptedArtifact.symFragmentClaimAccepted\n \ - exact ⟨{carrier_bound}, {host_types}, rfl, rfl, ⟨{body}, {code_entry}, {binding}, ⟨⟨{check_plan}, {lower_body}, {lower_code}, {func_binding}⟩, {func_type}, {nominal}, rfl, rfl⟩⟩⟩\n" - ) -} - -fn render_expr_fragment_semantic_bridge( - c: &Cert, - host_table: FragHostTable, - struct_table_lean: &str, - model_info: &ModelInfo, -) -> String { - if let Some(face) = c.tag_dispatch_face() { - return render_expr_fragment_tag_dispatch_semantic_bridge( - c, - face, - host_table, - struct_table_lean, - ); - } - debug_assert!(expr_fragment_uses_audited_generic(c)); - render_expr_fragment_int_bool_semantic_bridge(c, host_table, struct_table_lean, model_info) -} - -fn render_expr_fragment_tag_dispatch_semantic_bridge( - c: &Cert, - face: FragTagDispatchFace, - host_table: FragHostTable, - struct_table_lean: &str, -) -> String { - let name = c.name(); - let carrier = c.carrier(); - let claim_name = format!("{name}TagDispatchClaim"); - let claim = expr_fragment_claim_lean_value(c, host_table, struct_table_lean); - let host_table_lean = host_table.lean_value(); - let claim_accepted = render_expr_fragment_claim_accepted_split(c, &claim_name, &host_table_lean); - let tag = lean_int_lit(face.tag); - let then_c = lean_int_lit(face.then_c); - let else_c = lean_int_lit(face.else_c); - let arm = |constant: &str| { - format!( - r#" · refine ⟨[.structv {opt_idx} [.i32v x.1, x.2]], [.structv {opt_idx} [.i32v x.1, x.2], .null], - carrierSmall {carrier} ({constant}), rfl, rfl, ?_, ?_, ?_⟩ - · simp [ExprFragmentSoundness.blockCallsOK, ExprFragmentSoundness.nodesCallsOK, - ExprFragmentSoundness.kindCallsOK, AverCert.Plans.{name}Plan, {claim_name}, AverCert.{name}Ob, - AverCert.StandardFace.tagDispatchHost] - · simp [ExprFragmentSemantics.evalSymRawPlan, {claim_name}, AverCert.{name}Ob, AverCert.StandardFace.tagDispatchHost, - show AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan {host_table_lean} {struct_table_lean} - AverCert.Plans.{name}SymPlan = some AverCert.Plans.{name}Plan from rfl, - AverCert.Plans.{name}Plan, ExprFragmentSemantics.runBlock, - AverCert.PlanLower.maxFuel, ExprFragmentSemantics.runBlockFuel, - ExprFragmentSemantics.runNodesFuel, ExprFragmentSemantics.finishWith, - AverCert.AcceptedArtifact.exprFragmentNLocals, initLocals, PlanLower.popExpected, - PlanLower.popExpectedAll, PlanLower.primInstr, ExprFragmentSemantics.runPrim, - wRunF, boxRef, popArgs, carrierSmall, b32, hx] - · simpa [{claim_name}, AverCert.{name}Ob, AverCert.Schema.intRepr, hx] - using S.smallIntro ({constant} : Int) -"#, - opt_idx = face.opt_idx, - ) - }; - let then_arm = arm(&then_c); - let else_arm = arm(&else_c); - format!( - r#"/-! ### {name} — operational tag-dispatch expr-fragment semantic bridge -/ - -def {claim_name} : AverCert.AcceptedArtifact.SymFragmentClaim := {claim} - -{claim_accepted} -theorem {name}_exprFragmentSemanticBridge : - AcceptanceSoundness.exprFragmentSemanticBridge {claim_name} - AverCert.Plans.{name}Plan := by - refine ⟨rfl, ?_⟩ - intro S add sub mul stringEq stringConcat toIndex cmp eq hAdd hSub hMul hStringEq hStringConcat - _hToIndex _hCmp _hEq fuel x vs w hDom hRun - dsimp only [{claim_name}, AverCert.{name}Ob] at x hDom ⊢ - subst hDom - by_cases hx : x.1 = {tag} -{then_arm}{else_arm} -#print axioms {name}_exprFragmentSemanticBridge -"# - ) -} - -/// `expr_fragment_bool_expr` with constant-condition `if`s folded away: the -/// canonical-input null guards render as `if (true) …`, and a `by_cases` -/// hypothesis must be stated in the same normal form simp leaves in the goal -/// (the folded branch), or it never matches as a rewrite. -fn expr_fragment_reduced_bool_expr(block: &FragBlock, id: FragValueId, local: &F) -> String -where - F: Fn(u32, FragTy) -> String, -{ - let node = block.node(id).expect("fragment node exists"); - if let FragNodeKind::If { - cond, - then_block, - else_block, - } = &node.kind - { - let c = expr_fragment_bool_expr(block, *cond, local); - if c == "true" { - return expr_fragment_reduced_bool_expr(then_block, then_block.result, local); - } - if c == "false" { - return expr_fragment_reduced_bool_expr(else_block, else_block.result, local); - } - } - expr_fragment_bool_expr(block, id, local) -} - -/// Conditions that steer the interpreter's `ifElse` branch selection and are -/// neither constant (the canonical-input null guards reduce to `true`) nor a -/// Bool parameter (those are split once by `cases a{i}`). Only these need a -/// case split: every other comparison flows through the run as a symbolic -/// `b32 P` value that simp's stock decide/ite lemmas normalize. -fn collect_expr_fragment_steering_conditions( - block: &FragBlock, - local: &F, - out: &mut Vec, -) where - F: Fn(u32, FragTy) -> String, -{ - for node in &block.nodes { - if let FragNodeKind::If { - cond, - then_block, - else_block, - } = &node.kind - { - let steering = match block.node(*cond).map(|n| &n.kind) { - // A local condition is covered elsewhere, not skipped: the - // checker types an `ifElse` condition as `BoolI32`, and a local - // carries its parameter's type, so such a condition is a - // Boolean parameter and the script already splits on it with - // `cases`. A constant one reduces away inside the single - // simplification step. - Some(FragNodeKind::Local { .. }) | Some(FragNodeKind::ConstBool(_)) | None => { - false - } - Some(_) => { - let rendered = expr_fragment_reduced_bool_expr(block, *cond, local); - rendered != "true" && rendered != "false" - } - }; - if steering { - let rendered = expr_fragment_reduced_bool_expr(block, *cond, local); - if !out.contains(&rendered) { - out.push(rendered); - } - } - collect_expr_fragment_steering_conditions(then_block, local, out); - collect_expr_fragment_steering_conditions(else_block, local, out); - } - } -} - -fn expr_fragment_bridge_eval_tactic( - plan: &ExprFragmentPlan, - name: &str, - host_table_lean: &str, - struct_table_lean: &str, - evalset: &str, -) -> String { - // Case splits are limited to what actually steers the interpreter's - // control flow: Bool params (split once by `cases`) and non-constant - // `ifElse` conditions (short-circuit encodings). Comparison atoms that - // only produce values — the whole eager-conjunction class, whose null - // guards are constant under the canonical `carrierSmall`/`b32` inputs — - // are never split: the interpreter's comparison and `.i32And` clauses - // return `b32 P` symbolically and simp's stock decide/ite lemmas close - // the payload equality. This keeps elaboration linear in the atom count - // for eager conjunctions, where the old every-atom `by_cases` 2^n split - // peaked past physical memory at six atoms. - let mut steps = plan - .params - .iter() - .enumerate() - .filter(|(_, ty)| **ty == FragTy::BoolI32) - .map(|(i, _)| format!("cases a{i}")) - .collect::>(); - let mut conds = Vec::new(); - collect_expr_fragment_steering_conditions( - &plan.body, - &|idx, _ty| format!("a{idx}"), - &mut conds, - ); - for (i, cond) in conds.iter().enumerate() { - steps.push(format!("by_cases h{i} : {cond}")); - } - let hints = if conds.is_empty() { - String::new() - } else { - format!( - ", {}", - (0..conds.len()) - .map(|i| format!("h{i}")) - .collect::>() - .join(", ") - ) - }; - let simp = format!( - "simp [{evalset}, PlanLower.popExpected, PlanLower.popExpectedAll, \ - PlanLower.primInstr, ExprFragmentSemantics.runPrim, carrierSmall, ge_iff_le{hints}]" - ); - let first = if steps.is_empty() { - simp - } else { - format!("{} <;> {simp}", steps.join(" <;> ")) - }; - format!( - " simp only [ExprFragmentSemantics.evalSymRawPlan]\n \ - rw [show AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan\n \ - {host_table_lean} {struct_table_lean} AverCert.Plans.{name}SymPlan =\n \ - some AverCert.Plans.{name}Plan by rfl]\n \ - {first}" - ) -} - -fn render_expr_fragment_int_bool_semantic_bridge( - c: &Cert, - host_table: FragHostTable, - struct_table_lean: &str, - model_info: &ModelInfo, -) -> String { - let Cert::ExprFragment { - name, - carrier, - plan, - .. - } = c.inner() - else { - unreachable!() - }; - let model_name = c.model_lean_name(model_info); - debug_assert_eq!(plan.result, FragTy::BoolI32); - let claim = expr_fragment_claim_lean_value(c, host_table, struct_table_lean); - let result = expr_fragment_wval_expr(plan, &|idx, _ty| format!("a{idx}")); - let input_values = plan - .params - .iter() - .enumerate() - .map(|(idx, ty)| match ty { - FragTy::IntCarrier => format!("carrierSmall {carrier} a{idx}"), - FragTy::BoolI32 => format!("b32 a{idx}"), - _ => unreachable!("generic integer/Bool fragment input"), - }) - .collect::>(); - let inputs = format!("[{}]", input_values.join(", ")); - let mut locals = input_values; - locals.push(".null".to_string()); - let locals = format!("[{}]", locals.join(", ")); - let (dom_name, unpack) = match plan.params.len() { - 1 => ("a0".to_string(), String::new()), - // Right-nested product domain: the flat anonymous-constructor - // pattern `⟨a0, a1, …⟩` destructures `A × (B × (…))` exactly, so - // one `rcases` unpacks any arity. - arity => ( - "p".to_string(), - format!( - " rcases p with ⟨{}⟩\n", - (0..arity) - .map(|index| format!("a{index}")) - .collect::>() - .join(", ") - ), - ), - }; - let evalset = format!( - "AverCert.Plans.{name}Plan, AverCert.PlanLower.maxFuel, \ - ExprFragmentSemantics.runBlock, ExprFragmentSemantics.runBlockFuel, \ - ExprFragmentSemantics.runNodesFuel, ExprFragmentSemantics.finishWith, \ - AverCert.AcceptedArtifact.exprFragmentNLocals, \ - CertModule.{name}Code, CertModule.{name}Host, wFuncN, wRunF, f, b32, \ - popArgs, initLocals, {model_name}" - ); - let host_table_lean = host_table.lean_value(); - let claim_accepted = render_expr_fragment_claim_accepted_split(c, &claim, &host_table_lean); - let eval_tactic = expr_fragment_bridge_eval_tactic( - plan, - name, - &host_table_lean, - struct_table_lean, - &evalset, - ); - format!( - r#"/-! ### {name} — option-(b) integer/Bool expr-fragment semantic bridge -/ - -{claim_accepted} -theorem {name}_exprFragmentSemanticBridge : - AcceptanceSoundness.exprFragmentSemanticBridge {claim} - AverCert.Plans.{name}Plan := by - refine ⟨rfl, ?_⟩ - intro S add sub mul stringEq stringConcat toIndex cmp eq - hAdd hSub hMul hStringEq hStringConcat _hToIndex _hCmp _hEq fuel {dom_name} vs out hDom hRun - dsimp [AverCert.{name}Ob] at {dom_name} vs hDom hRun ⊢ -{unpack} subst vs - refine ⟨{inputs}, {locals}, {result}, rfl, rfl, ?_, ?_, ?_⟩ - · simp [ExprFragmentSoundness.blockCallsOK, - ExprFragmentSoundness.nodesCallsOK, ExprFragmentSoundness.kindCallsOK, - AverCert.Plans.{name}Plan, CertModule.{name}Code, CertModule.{name}Host] - · -{eval_tactic} - · simp [{model_name}, AverCert.Schema.boolRepr, b32] - -#print axioms {name}_exprFragmentSemanticBridge -"# - ) -} diff --git a/aver-cert/src/engine/render_integer.rs b/aver-cert/src/engine/render_integer.rs deleted file mode 100644 index 41011b6ea..000000000 --- a/aver-cert/src/engine/render_integer.rs +++ /dev/null @@ -1 +0,0 @@ -include!("render_recursion_bridge.rs"); diff --git a/aver-cert/src/engine/render_manifest.rs b/aver-cert/src/engine/render_manifest.rs deleted file mode 100644 index b5f6f62cf..000000000 --- a/aver-cert/src/engine/render_manifest.rs +++ /dev/null @@ -1,1004 +0,0 @@ -fn render_obligation_def(c: &Cert, model_info: &ModelInfo, host_table_lean: &str) -> String { - let name = c.name(); - if let Some(face) = c.tag_dispatch_face() { - return format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := AverCert.StandardFace.tagDispatchHost {carrier} {box_idx}, self := {self_idx},\n \ - Dom := Int × WVal, Cod := Int,\n \ - domRepr := fun _S p vs => vs = [.structv {opt_idx} [.i32v p.1, p.2]],\n \ - codRepr := fun S v w => intRepr S v w,\n \ - model := fun p => if p.1 = {tag} then {then_c} else {else_c} }}\n\n", - carrier = c.carrier(), - box_idx = face.box_idx, - self_idx = c.self_idx(), - opt_idx = face.opt_idx, - tag = lean_int_lit(face.tag), - then_c = lean_int_lit(face.then_c), - else_c = lean_int_lit(face.else_c), - ); - } - // The fused vector-read face: the wall's face terms verbatim (domain is - // the represented vector with its in-relation length bound, model is the - // in-bounds read or the literal default). - if let Some(face) = c.vector_get_face() { - return format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := List Int × Int, Cod := Int,\n \ - domRepr := AverCert.StandardFace.vecDomRepr {carrier} {arr_ty},\n \ - codRepr := fun S n w => intRepr S n w,\n \ - model := AverCert.StandardFace.vecModel ({d} : Int) }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - arr_ty = face.arr_ty, - d = face.default, - ); - } - // The Int selection face: every meaning field is a wall term the checked - // face pins by `HEq` — the model included. Nothing here is read from the - // source model, which is why these claims cite no model name. - if let Some(face) = c.int_select_face() { - return format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := Int × Int, Cod := Int,\n \ - domRepr := AverCert.StandardFace.intPairSmallBandDomRepr {carrier},\n \ - codRepr := intRepr,\n \ - model := AverCert.StandardFace.intSelectModel {op} }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - op = face.op.lean_ctor(), - ); - } - // An ADT-ref expr fragment with the field-projection face states the SAME - // verbatim projection obligation the legacy field-projection class ships: - // a two-field struct in, the projected field out unchanged. - if let Some(face) = c.project_face() { - let model = if face.field_idx == 0 { "p.1" } else { "p.2" }; - return format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := WVal × WVal, Cod := WVal,\n \ - domRepr := fun _ p vs => vs = [.structv {struct_idx} [p.1, p.2]],\n \ - codRepr := fun S v w => verbatimRepr S v w,\n \ - model := fun p => {model} }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - struct_idx = face.struct_idx, - ); - } - // A stage-1 record scalar field read states the wall's record-parameter - // obligation: the domain is the record denotation, the codomain the - // projected scalar leaf under the single generic `ReprOf`, and the model the - // field read — every meaning field is the wall term the checked record face - // pins by `HEq`, exactly like `intDispatchDeclaredFace`. - if let Some(face) = c.record_compute_face() { - let name = c.name(); - return format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := AverCert.StandardFace.recordComputeHost {carrier} {host_table_lean}, self := {self_idx},\n \ - Dom := List RecordComputeBridge.SVal, Cod := Option RecordComputeBridge.SVal,\n \ - domRepr := AverCert.StandardFace.recordComputeDomRepr {carrier} {struct_idx} Plans.{name}Plan.params,\n \ - codRepr := AverCert.StandardFace.recordComputeCodRepr {carrier} {struct_idx},\n \ - model := AverCert.StandardFace.recordComputeModel Plans.{name}Plan.body }}\n\n", - carrier = c.carrier(), - self_idx = c.self_idx(), - struct_idx = face.struct_idx, - ); - } - if let Some(face) = c.record_param_face() { - return format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := AverCert.StandardFace.emptyHost, self := {self_idx},\n \ - Dom := AverCert.Schema.RecordFields Plans.{name}RecordFields,\n \ - Cod := AverCert.Schema.RecordVal (Plans.{name}RecordFields[{field}]'(by decide)),\n \ - domRepr := AverCert.StandardFace.recordParamDomRepr {carrier} {struct_idx} Plans.{name}RecordFields,\n \ - codRepr := AverCert.StandardFace.recordParamCodRepr {carrier} Plans.{name}RecordFields {field} (by decide),\n \ - model := AverCert.StandardFace.recordParamModel Plans.{name}RecordFields {field} (by decide) }}\n\n", - carrier = c.carrier(), - self_idx = c.self_idx(), - struct_idx = face.struct_idx, - field = face.field_idx, - ); - } - match c.inner() { - Cert::AdtConstructor { struct_idx, .. } - if adt_constructor_uses_model(c, model_info) => - { - format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := Int,\n \ - Cod := AverCert.DeclaredIndexEnvelope.DAdtVal Plans.{name}DeclaredEnvelope,\n \ - domRepr := AverCert.EnvelopeLowering.intArgDomRepr {carrier},\n \ - codRepr := AverCert.DeclaredIndexEnvelope.dEnvCodRepr Plans.{name}DeclaredEnvelope,\n \ - model := AverCert.DeclaredIndexEnvelope.dEnvCtorModel Plans.{name}DeclaredEnvelope {struct_idx} (by decide) }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - ) - } - Cert::AdtConstructor { - struct_idx, - arity, - fields, - .. - } => { - // Verbatim pack certificate (dual of the field projection): the body - // wraps its `field_count` arguments into variant `struct_idx`. No - // claim about a recursive model representation — `Cod := WVal` and - // `verbatimRepr` pin the output to the constructed struct byte-for-byte. - let (dom, pat, args) = verbatim_ctor_shape(*arity, fields); - format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := {dom}, Cod := WVal,\n \ - domRepr := fun _ p vs => vs = {pat},\n \ - codRepr := fun S v w => verbatimRepr S v w,\n \ - model := fun p => .structv {struct_idx} {args} }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - ) - } - Cert::FieldProjection { - struct_idx, - field_idx, - .. - } => { - let model = if *field_idx == 0 { "p.1" } else { "p.2" }; - format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := WVal × WVal, Cod := WVal,\n \ - domRepr := fun _ p vs => vs = [.structv {struct_idx} [p.1, p.2]],\n \ - codRepr := fun S v w => verbatimRepr S v w,\n \ - model := fun p => {model} }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - ) - } - Cert::VariantDispatch { .. } | Cert::WidenedIntMatch { .. } => format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := AverCert.DeclaredIndexEnvelope.DAdtVal Plans.{name}DeclaredEnvelope,\n \ - Cod := Int,\n \ - domRepr := AverCert.DeclaredIndexEnvelope.dEnvDomRepr Plans.{name}DeclaredEnvelope,\n \ - codRepr := fun S n w => intRepr S n w,\n \ - model := AverCert.DeclaredIndexEnvelope.dEnvStructModel Plans.{name}DeclaredEnvelope Plans.{name}IntDispatchPlan.body }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - ), - Cert::ExprFragment { carrier, plan, .. } => { - let dom = expr_fragment_dom_type(&plan.params); - let cod = plan.result.lean_dom_type(); - let dom_repr = - expr_fragment_dom_repr_list(&plan.params, "p", &carrier.to_string()); - let cod_repr = match plan.result { - FragTy::F64 => "fun S bits w => floatBitsRepr S bits w", - FragTy::BoolI32 => "fun S b w => boolRepr S b w", - FragTy::IntCarrier - | FragTy::I64 - | FragTy::RawI32 - | FragTy::Ref - | FragTy::AdtRef => "fun S v w => verbatimRepr S v w", - }; - let plan_model = - expr_fragment_value_expr(&plan.body, plan.body.result, &|idx, _ty| { - expr_fragment_dom_accessor("p", idx as usize, plan.params.len()) - }); - let model = if expr_fragment_uses_audited_generic(c) { - expr_fragment_source_model(c, model_info) - } else { - format!("fun p => {plan_model}") - }; - format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := {dom}, Cod := {cod},\n \ - domRepr := fun _S p vs => vs = {dom_repr},\n \ - codRepr := {cod_repr},\n \ - model := {model} }}\n\n", - host = c.host_expr(), - self_idx = c.self_idx(), - ) - } - Cert::VerbatimWidenedMatch { .. } - | Cert::VerbatimVariantDispatch { .. } - | Cert::StringEqVerbatimMatch { .. } - | Cert::StringConcatVerbatimMatch { .. } => format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := .simulatesModel, carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := WVal, Cod := WVal,\n \ - domRepr := fun _S v vs => vs = [v],\n \ - codRepr := fun S x w => verbatimRepr S x w,\n \ - model := {name}Model }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - ), - // Each SCC member is its own integer-simulation obligation, but the `code` - // and `host` fields point at the ONE shared table/host named after the - // primary member (`scc[0]`); the model is this member's own function. - Cert::MutualRecursion { scc, .. } => format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := {policy}, termination? := {termination}, carrier := {carrier},\n \ - code := CertModule.{primary}Code, host := {host}, self := {self_idx},\n \ - Dom := List Int, Cod := Int,\n \ - domRepr := fun S ns vs => ReprAll S.Repr ns vs ∧ ns.length = 1,\n \ - codRepr := fun S n w => intRepr S n w,\n \ - model := fun ns => {model_name} (ns.headD 0) }}\n\n", - primary = scc[0].name, - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - policy = c.policy().lean_value(), - termination = c - .termination_witness() - .map_or_else(|| "none".to_string(), |w| format!("some {}", w.lean_value())), - model_name = c.model_lean_name(model_info), - ), - _ => format!( - "abbrev {name}Ob : Schema.Obligation :=\n \ - {{ export_ := \"{name}\", policy := {policy}, termination? := {termination}, {totality_role}carrier := {carrier},\n \ - code := CertModule.{name}Code, host := {host}, self := {self_idx},\n \ - Dom := List Int, Cod := Int,\n \ - domRepr := fun S ns vs => ReprAll S.Repr ns vs ∧ ns.length = {arity},\n \ - codRepr := fun S n w => intRepr S n w,\n \ - model := {model} }}\n\n", - carrier = c.carrier(), - host = c.host_expr(), - self_idx = c.self_idx(), - model = c.model_expr(model_info), - arity = c.arity(), - policy = c.policy().lean_value(), - termination = c - .termination_witness() - .map(|w| format!("some {}", w.lean_value())) - .unwrap_or_else(|| "none".to_string()), - totality_role = if c.requires_mul_totality() { - "totalityRole := .mul, " - } else { - "" - }, - ), - } -} - -/// The generated manifest literal, mirroring `cert-manifest.json`: the subject -/// metadata plus one `Obligation` per certified export. This is the LITERAL the -/// consumer pins. -fn render_manifest_lean( - analysis: &Analysis, - model_roots: &[String], - model_info: &ModelInfo, - sha: &str, - target: &str, - abi: &str, -) -> String { - let mut s = String::new(); - s.push_str( - "import Schema\nimport Module\nimport PlanCheck\nimport PlanLower\nimport PlanBytes\nimport WasmSlice\nimport ExprFragmentAccepted\nimport ArtifactBytes\nimport Plans\nimport ConstructVerbatimSoundness\nimport StandardFace\n", - ); - for r in model_roots { - s.push_str(&format!("import {r}\n")); - } - s.push_str( - "\nset_option linter.unusedVariables false\n\n\ - namespace AverCert\nopen AverCert.Schema CertPrelude\n\n", - ); - s.push_str(&render_user_repr_defs(analysis, model_info)); - // One obligation def per certified export. - let host_table_lean = analysis.frag_host_table().lean_value(); - for c in &analysis.certs { - s.push_str(&render_obligation_def(c, model_info, &host_table_lean)); - } - // Subject + manifest. - let exports = analysis - .certs - .iter() - .map(|c| format!("\"{}\"", c.name())) - .collect::>() - .join(", "); - let contracts = analysis - .contracts - .iter() - .map(|c| lean_str(c)) - .collect::>() - .join(", "); - let declared_uncertified = analysis - .module_envelope - .declared_uncertified(analysis.certified_names(), &analysis.declined) - .iter() - .map(|(name, reason)| format!("({}, {})", lean_str(name), lean_str(reason))) - .collect::>() - .join(", "); - let capabilities = analysis - .module_envelope - .capabilities - .iter() - .map(|(module, field)| format!("({}, {})", lean_str(module), lean_str(field))) - .collect::>() - .join(", "); - let start = analysis - .module_envelope - .start - .map(|idx| format!("some {idx}")) - .unwrap_or_else(|| "none".to_string()); - // A module without the Int box helper export has no host-role table: the - // manifest says `none`, matching the strict byte decoder, which proves the - // `__rt_aint_from_i64` export absent and resolves the module-wide table to - // `some none`. A module with the helper always declares `some` table (the - // decoder resolves `some (some table)`), even when a role inside it is - // unbound; a module whose role scan the decoder cannot complete is refused - // at disassembly, so this branch never renders a table for it. - let host_role_table = if analysis.frag_host_table.box_idx.is_some() { - format!("some {}", analysis.frag_host_table.roles_lean_value()) - } else { - "none".to_string() - }; - let arith_params = analysis - .frag_host_table - .arith_params_lean_value(analysis.carrier); - let string_host_roles = string_host_roles_lean_value(&analysis.string_host_roles); - let obligations = analysis - .certs - .iter() - .map(|c| format!("{}Ob", c.name())) - .collect::>() - .join(", "); - let sym_expr_fragment_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::ExprFragment { - name, - source_plan, - plan, - .. - } if expr_fragment_source_plan(source_plan, plan).is_some() => { - Some(format!("({}, Plans.{name}Plan)", lean_str(name))) - } - _ => None, - }) - .collect::>(); - let fallback_expr_fragment_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::ExprFragment { - name, - source_plan, - plan, - .. - } if expr_fragment_source_plan(source_plan, plan).is_none() => { - Some(format!("({}, Plans.{name}Plan)", lean_str(name))) - } - _ => None, - }) - .collect::>(); - let expr_fragment_plans = sym_expr_fragment_plans - .into_iter() - .chain(fallback_expr_fragment_plans) - .collect::>() - .join(", "); - let expr_sym_fragment_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::ExprFragment { - name, - source_plan, - plan, - .. - } if expr_fragment_source_plan(source_plan, plan).is_some() => { - Some(format!("({}, Plans.{name}SymPlan)", lean_str(name))) - } - _ => None, - }) - .collect::>(); - let string_sym_fragment_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::StringEqVerbatimMatch { name, .. } => { - Some(format!("({}, Plans.{name}StringEqSymPlan)", lean_str(name))) - } - Cert::StringConcatVerbatimMatch { name, .. } => { - Some(format!("({}, Plans.{name}StringConcatSymPlan)", lean_str(name))) - } - _ => None, - }) - .collect::>(); - let construct_sym_fragment_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::AdtConstructor { name, .. } - if adt_constructor_sym_plan_from_cert(c, model_info).is_some() => - { - Some(format!("({}, Plans.{name}ConstructSymPlan)", lean_str(name))) - } - _ => None, - }) - .collect::>(); - let sym_fragment_plans = expr_sym_fragment_plans - .into_iter() - .chain(string_sym_fragment_plans) - .chain(construct_sym_fragment_plans) - .collect::>() - .join(", "); - let string_eq_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::StringEqVerbatimMatch { name, .. } => { - Some(format!("({}, Plans.{name}StringEqPlan)", lean_str(name))) - } - _ => None, - }) - .collect::>() - .join(", "); - let string_concat_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::StringConcatVerbatimMatch { name, .. } => { - Some(format!("({}, Plans.{name}StringConcatPlan)", lean_str(name))) - } - _ => None, - }) - .collect::>() - .join(", "); - let construct_plans = analysis - .certs - .iter() - .filter_map(|c| match c.inner() { - Cert::AdtConstructor { name, .. } - if construct_plan_from_cert(c).is_some() - && adt_constructor_sym_plan_from_cert(c, model_info).is_some() => - { - Some(format!("({}, Plans.{name}ConstructPlan)", lean_str(name))) - } - _ => None, - }) - .collect::>() - .join(", "); - let recursion_plans = analysis - .certs - .iter() - .filter_map(|c| { - recursion_plan_from_cert(c) - .map(|_| format!("({}, Plans.{}RecursionPlan)", lean_str(c.name()), c.name())) - }) - .collect::>() - .join(", "); - let mutual_plans = analysis - .certs - .iter() - .filter_map(|c| { - mutual_plan_from_cert(c) - .map(|_| format!("({}, Plans.{}MutualPlan)", lean_str(c.name()), c.name())) - }) - .collect::>() - .join(", "); - let composition_plans = composition_member_plans(analysis) - .iter() - .map(|(entry, _)| { - format!( - "({}, Plans.{}CompositionPlan)", - lean_str(&entry.name), - entry.name - ) - }) - .collect::>() - .join(", "); - let verbatim_plans = analysis - .certs - .iter() - .filter_map(|c| { - verbatim_plan_from_cert(c) - .map(|_| format!("({}, Plans.{}VerbatimPlan)", lean_str(c.name()), c.name())) - }) - .collect::>() - .join(", "); - let int_dispatch_plans = analysis - .certs - .iter() - .filter_map(|c| { - int_dispatch_plan_from_cert(c, analysis.frag_host_table) - .map(|_| format!("({}, Plans.{}IntDispatchPlan)", lean_str(c.name()), c.name())) - }) - .collect::>() - .join(", "); - let field_projection_plans = analysis - .certs - .iter() - .filter_map(|c| { - field_projection_plan_from_cert(c).map(|_| { - format!( - "({}, Plans.{}FieldProjectionPlan)", - lean_str(c.name()), - c.name() - ) - }) - }) - .collect::>() - .join(", "); - s.push_str(&format!( - "def manifest : Schema.Manifest :=\n \ - {{ subject :=\n \ - {{ artifactHash := \"{sha}\",\n \ - target := \"{target}\",\n \ - profile := \"{PROFILE_ID}\",\n \ - abi := \"{abi}\",\n \ - artifactRoot := \"{ARTIFACT_CERTIFICATE_ROOT}\",\n \ - exports := [{exports}],\n \ - declaredUncertified := [{declared_uncertified}],\n \ - capabilities := [{capabilities}],\n \ - start := {start},\n \ - hostRoleTable := {host_role_table},\n \ - arithParams := {arith_params},\n \ - stringHostRoles := {string_host_roles},\n \ - contracts := [{contracts}] }},\n \ - symFragmentPlans := [{sym_fragment_plans}],\n \ - stringEqPlans := [{string_eq_plans}],\n \ - stringConcatPlans := [{string_concat_plans}],\n \ - constructPlans := [{construct_plans}],\n \ - exprFragmentPlans := [{expr_fragment_plans}],\n \ - recursionPlans := [{recursion_plans}],\n \ - mutualPlans := [{mutual_plans}],\n \ - compositionPlans := [{composition_plans}],\n \ - verbatimPlans := [{verbatim_plans}],\n \ - intDispatchPlans := [{int_dispatch_plans}],\n \ - fieldProjectionPlans := [{field_projection_plans}],\n \ - obligations := [{obligations}] }}\n\n\ - end AverCert\n", - )); - s -} - -/// The single final theorem: `AverCert.Final.cert : Holds manifest`, proved by -/// composing audited generic discharges with the residual bespoke families. -/// No other final theorem is emitted; the checker pins this exact statement. -fn render_final() -> String { - format!( - "import Manifest\nimport ArtifactSoundness\n\n\ - set_option maxRecDepth 1000000\n\n\ - open AverCert AverCert.Schema\n\n\ - /-- THE single artifact certificate. All migrated families flow through\n\ - the audited accept-sound capstone; Artifact.dischargeSideConditions\n\ - isolates the float-only bespoke residual. -/\n\ - {FINAL_STATEMENT_LINE} :=\n \ - AverCert.ArtifactSoundness.accept_sound_holds\n \ - AverCert.Artifact.dischargeSideConditions\n\n\ - #print axioms {FINAL_THEOREM}\n" - ) -} - -/// One source-value encoder as the manifest transports it: a closed kind tag, -/// plus — for a record — the `_root_.`-qualified Lean type and its accessors in -/// declaration order. The checker parses exactly these shapes and refuses any -/// other kind, so the set of statements a package can be pinned at is the set -/// this encoding can describe. -fn json_source_encoder(encoder: &SourceEncoder) -> String { - match encoder { - SourceEncoder::Int | SourceEncoder::Bool => { - format!("{{\"kind\": {}}}", json_str(encoder.kind())) - } - SourceEncoder::Record { - lean_type, - accessors, - } => { - let fields = accessors - .iter() - .map(|accessor| json_str(accessor)) - .collect::>() - .join(", "); - format!( - "{{\"kind\": {}, \"type\": {}, \"fields\": [{fields}]}}", - json_str(encoder.kind()), - json_str(lean_type), - ) - } - } -} - -#[allow(clippy::too_many_arguments)] -fn render_manifest( - analysis: &Analysis, - model_info: &ModelInfo, - artifact_file_name: &str, - sha: &str, - target: &str, - abi: &str, - wasip2_component_envelope: Option, - law_claims: &[LawClaim], - law_bridges: &[Vec], - source_bridges: &[SourceBridge], - declined_source_bridges: &[(String, String)], -) -> String { - let mut s = String::new(); - let has_total = analysis - .certs - .iter() - .any(|c| c.policy() == CertificationPolicy::SimulatesModelTotally); - let has_partial = analysis - .certs - .iter() - .any(|c| c.policy() == CertificationPolicy::SimulatesModel); - let artifact_level = match (has_partial, has_total) { - (true, true) => "mixed L1/L3", - (false, true) => "L3", - _ => CERT_LEVEL, - }; - s.push_str("{\n"); - s.push_str(&format!(" \"schema_version\": {CERT_SCHEMA_VERSION},\n")); - s.push_str(&format!( - " \"format\": {{\"version\": {}, \"wall_id\": {}}},\n", - wall::FORMAT_VERSION, - json_str(wall::current_id()), - )); - s.push_str(&format!(" \"wasm\": {},\n", json_str(artifact_file_name))); - s.push_str(&format!(" \"wasm_sha256\": \"{sha}\",\n")); - s.push_str(&format!(" \"target\": {},\n", json_str(target))); - s.push_str(&format!(" \"level\": \"{artifact_level}\",\n")); - s.push_str(&format!(" \"profile\": \"{PROFILE_ID}\",\n")); - s.push_str(&format!(" \"abi\": {},\n", json_str(abi))); - if let Some(envelope) = wasip2_component_envelope { - s.push_str(&format!( - " \"{}\": {{\"{}\": {}, \"{}\": {}, \"{}\": {}, \"{}\": {}}},\n", - crate::format::WASIP2_COMPONENT_ENVELOPE_FIELD, - crate::format::WASIP2_COMPONENT_ENVELOPE_KIND_FIELD, - json_str(envelope.kind()), - crate::format::WASIP2_COMPONENT_ENVELOPE_PREFIX_LEN_FIELD, - envelope.prefix_len, - crate::format::WASIP2_COMPONENT_ENVELOPE_CORE_LEN_FIELD, - envelope.embedded_core_module_len, - crate::format::WASIP2_COMPONENT_ENVELOPE_SUFFIX_LEN_FIELD, - envelope.suffix_len, - )); - } - s.push_str(&format!(" \"final_theorem\": \"{FINAL_THEOREM}\",\n")); - s.push_str(&format!( - " \"artifact_certificate_root\": \"{ARTIFACT_CERTIFICATE_ROOT}\",\n" - )); - if let Some(c) = analysis.carrier { - s.push_str(&format!(" \"carrier_type_index\": {c},\n")); - } else { - s.push_str(" \"carrier_type_index\": null,\n"); - } - s.push_str(" \"runtime_contracts\": ["); - for (i, c) in analysis.contracts.iter().enumerate() { - if i > 0 { - s.push(','); - } - s.push_str(&format!("\n {}", json_str(c))); - } - if !analysis.contracts.is_empty() { - s.push_str("\n "); - } - s.push_str("],\n"); - // Law-claims surface (schema 7): one entry per universal model law, with - // the verbatim statement the checker-owned witness re-elaborates the - // `Laws.lean` corollary at. `bridges` (schema 8) names the certified - // exports whose plan-equals-source bridges the corollary also conjoins: - // every model function the statement mentions, or empty when one of them - // has no bridge. - s.push_str(" \"laws\": ["); - for (i, claim) in law_claims.iter().enumerate() { - if i > 0 { - s.push(','); - } - let bridges = law_bridges - .get(i) - .map(Vec::as_slice) - .unwrap_or_default() - .iter() - .map(|export| json_str(export)) - .collect::>() - .join(", "); - s.push_str(&format!( - "\n {{\"label\": {}, \"theorem\": {}, \"statement\": {}, \"corollary\": {}, \"bridges\": [{bridges}]}}", - json_str(&claim.label), - json_str(&claim.qualified()), - json_str(&claim.statement), - json_str(&claim.corollary()), - )); - } - if !law_claims.is_empty() { - s.push_str("\n "); - } - s.push_str("],\n"); - // Plan-equals-source bridge surface (schema 8): one entry per bridged - // export, carrying the STRUCTURE the checker renders the pinned statement - // from — the plan is the export's, and the encoders are a closed set — so - // no statement text this package writes is ever read as a claim. - s.push_str(" \"sourceBridges\": ["); - for (i, bridge) in source_bridges.iter().enumerate() { - if i > 0 { - s.push(','); - } - let params = bridge - .params - .iter() - .map(json_source_encoder) - .collect::>() - .join(", "); - s.push_str(&format!( - "\n {{\"export\": {}, \"theorem\": {}, \"corollary\": {}, \"model\": {}, \"params\": [{params}], \"result\": {}}}", - json_str(&bridge.export), - json_str(&bridge.theorem), - json_str(&bridge.corollary), - json_str(&bridge.model), - json_source_encoder(&bridge.result), - )); - } - if !source_bridges.is_empty() { - s.push_str("\n "); - } - s.push_str("],\n"); - // Declared-only: why a compute-face export carries no bridge. The producer - // used to say this on stdout alone, which left the package itself silent - // about the export whose model stays the plan. `explain` prints it back. - s.push_str(" \"sourceBridgesDeclined\": ["); - for (i, (export, reason)) in declined_source_bridges.iter().enumerate() { - if i > 0 { - s.push(','); - } - s.push_str(&format!( - "\n {{\"export\": {}, \"reason\": {}}}", - json_str(export), - json_str(reason), - )); - } - if !declined_source_bridges.is_empty() { - s.push_str("\n "); - } - s.push_str("],\n"); - let declared_uncertified = analysis - .module_envelope - .declared_uncertified(analysis.certified_names(), &analysis.declined); - s.push_str(" \"declaredUncertified\": ["); - for (i, (name, reason)) in declared_uncertified.iter().enumerate() { - if i > 0 { - s.push(','); - } - s.push_str(&format!( - "\n {{\"name\": {}, \"reason\": {}}}", - json_str(name), - json_str(reason) - )); - } - if !declared_uncertified.is_empty() { - s.push_str("\n "); - } - s.push_str("],\n"); - s.push_str(" \"capabilities\": ["); - for (i, (module, field)) in analysis.module_envelope.capabilities.iter().enumerate() { - if i > 0 { - s.push(','); - } - s.push_str(&format!( - "\n {{\"module\": {}, \"name\": {}}}", - json_str(module), - json_str(field) - )); - } - if !analysis.module_envelope.capabilities.is_empty() { - s.push_str("\n "); - } - s.push_str("],\n"); - match analysis.module_envelope.start { - Some(index) => s.push_str(&format!( - " \"start\": {{\"present\": true, \"function_index\": {index}}},\n" - )), - None => s.push_str( - " \"start\": {\"present\": false, \"function_index\": null},\n", - ), - } - let json_role = |index: Option| { - index - .map(|index| index.to_string()) - .unwrap_or_else(|| "null".to_string()) - }; - // Mirror of the Lean manifest: `null` when the module has no Int box - // helper export (and therefore no host-role table), the exact role object - // otherwise. - if analysis.frag_host_table.box_idx.is_some() { - s.push_str(&format!( - " \"hostRoleTable\": {{\"box\": {}, \"add\": {}, \"mul\": {}, \"sub\": {}, \"toIndex\": {}, \"cmp\": {}, \"eq\": {}}},\n", - json_role(analysis.frag_host_table.box_idx), - json_role(analysis.frag_host_table.add_idx), - json_role(analysis.frag_host_table.mul_idx), - json_role(analysis.frag_host_table.sub_idx), - json_role(analysis.frag_host_table.to_index_idx), - json_role(analysis.frag_host_table.cmp_idx), - json_role(analysis.frag_host_table.eq_idx), - )); - } else { - s.push_str(" \"hostRoleTable\": null,\n"); - } - s.push_str(" \"stringHostRoles\": ["); - for (index, (function_index, role)) in analysis.string_host_roles.iter().enumerate() { - if index > 0 { - s.push(','); - } - s.push_str(&format!( - "{{\"function_index\": {function_index}, \"role\": {}}}", - json_str(role.manifest_value()) - )); - } - s.push_str("],\n"); - s.push_str(" \"certified\": ["); - for (i, c) in analysis.certs.iter().enumerate() { - if i > 0 { - s.push(','); - } - let kind = match c.inner() { - Cert::Recursive { .. } => "self-recursive", - Cert::AccumulatorRecursive { .. } => "multi-argument self-recursive", - Cert::AdtConstructor { .. } => "adt-constructor", - Cert::FieldProjection { .. } => "field-projection", - Cert::WidenedIntMatch { .. } | Cert::VariantDispatch { .. } => "int-dispatch", - Cert::VerbatimWidenedMatch { .. } | Cert::VerbatimVariantDispatch { .. } => { - "verbatim-dispatch" - } - Cert::StringEqVerbatimMatch { .. } => "verbatim-string-eq", - Cert::StringConcatVerbatimMatch { .. } => "verbatim-string-concat", - Cert::ExprFragment { .. } => "expr-fragment-v1", - Cert::Composition { .. } => "cross-function-composition", - Cert::MutualRecursion { .. } => "mutual-recursive", - Cert::NonRecursive { .. } => unreachable!(), - }; - let (dom, cod) = c.source_dom_cod(model_info); - let policy = c.policy(); - let termination_json = match c.termination_witness() { - Some(TerminationWitness { - measure: TerminationMeasure::IntNatAbs { param_idx }, - descent, - }) => format!( - ", \"termination_witness\": {{\"measure\": {{\"kind\": \"intNatAbs\", \"param_index\": {param_idx}}}, \"descent\": {descent}}}" - ), - None => String::new(), - }; - let theorem = if matches!(c.inner(), Cert::Composition { .. }) { - "AcceptanceSoundness.composition_claim_discharges_with_bridge".to_string() - } else if c.int_select_face().is_some() { - "AcceptanceSoundness.intSelect_claim_discharges".to_string() - } else if c.record_compute_face().is_some() { - // Ahead of the audited-generic test: a scalar-parameter compute - // plan has Int/Bool source types but a plan the generic fragment - // grammar refuses, so the compute face owns it. - crate::format::RECORD_COMPUTE_DISCHARGE_THEOREM.to_string() - } else if expr_fragment_uses_audited_generic(c) { - "AcceptanceSoundness.exprFragment_claim_discharges".to_string() - } else if c.vector_get_face().is_some() { - "AverCert.StandardFace.vectorGetOrDefault_simulates_model".to_string() - } else if c.project_face().is_some() { - "AcceptanceSoundness.fieldProjection_direct_canonical_discharges".to_string() - } else if c.record_param_face().is_some() { - "AcceptanceSoundness.recordParam_claim_discharges".to_string() - } else if matches!(c.inner(), Cert::FieldProjection { .. }) { - "AcceptanceSoundness.fieldProjection_canonical_discharges".to_string() - } else if matches!(c.inner(), Cert::AdtConstructor { .. }) - && adt_constructor_uses_model(c, model_info) - { - "AcceptanceSoundness.construct_canonical_discharges".to_string() - } else if let Cert::AdtConstructor { arity, .. } = c.inner() - && !adt_constructor_uses_model(c, model_info) - { - if *arity == 1 { - "AcceptanceSoundness.constructUnary_canonical_discharges".to_string() - } else { - "AcceptanceSoundness.constructBinary_canonical_discharges".to_string() - } - } else if matches!( - c.inner(), - Cert::VerbatimWidenedMatch { .. } | Cert::VerbatimVariantDispatch { .. } - ) { - "AcceptanceSoundness.verbatim_canonical_discharges".to_string() - } else if matches!(c.inner(), Cert::StringEqVerbatimMatch { .. }) { - "AcceptanceSoundness.stringEq_canonical_discharges".to_string() - } else if matches!(c.inner(), Cert::StringConcatVerbatimMatch { .. }) { - "AcceptanceSoundness.stringConcat_canonical_discharges".to_string() - } else if matches!( - c.inner(), - Cert::VariantDispatch { .. } | Cert::WidenedIntMatch { .. } - ) { - "AcceptanceSoundness.intDispatch_canonical_discharges".to_string() - } else if recursion_uses_audited_generic(c) { - "AcceptanceSoundness.recursion_claim_discharges".to_string() - } else if matches!(c.inner(), Cert::MutualRecursion { .. }) { - "AcceptanceSoundness.mutual_claim_discharges".to_string() - } else { - let theorem_suffix = if policy == CertificationPolicy::SimulatesModelTotally { - "wasm_total" - } else { - "wasm_certified" - }; - format!("CertProofs.{}_{theorem_suffix}", c.name()) - }; - s.push_str(&format!( - "\n {{\"name\": {}, \"class\": \"{}\", \"policy\": \"{}\", \ - \"level\": \"{}\", \"dom\": {}, \"cod\": {}, \ - \"theorem\": {}{}}}", - json_str(c.name()), - kind, - policy.manifest_name(), - policy.level(), - json_str(&dom), - json_str(&cod), - json_str(&theorem), - termination_json, - )); - } - if !analysis.certs.is_empty() { - s.push_str("\n "); - } - s.push_str("],\n"); - s.push_str(" \"source_level_only\": ["); - for (i, (name, reason)) in analysis.declined.iter().enumerate() { - if i > 0 { - s.push(','); - } - s.push_str(&format!( - "\n {{\"name\": {}, \"reason\": {}}}", - json_str(name), - json_str(reason) - )); - } - if !analysis.declined.is_empty() { - s.push_str("\n "); - } - s.push_str("]\n}\n"); - s -} - -/// A Lean string literal (escapes `"` and `\`); contract descriptions never -/// contain control characters. -fn lean_str(s: &str) -> String { - let mut out = String::with_capacity(s.len() + 2); - out.push('"'); - for ch in s.chars() { - match ch { - '"' => out.push_str("\\\""), - '\\' => out.push_str("\\\\"), - _ => out.push(ch), - } - } - out.push('"'); - out -} - -fn json_str(s: &str) -> String { - let mut out = String::with_capacity(s.len() + 2); - out.push('"'); - for ch in s.chars() { - match ch { - '"' => out.push_str("\\\""), - '\\' => out.push_str("\\\\"), - '\n' => out.push_str("\\n"), - _ => out.push(ch), - } - } - out.push('"'); - out -} diff --git a/aver-cert/src/engine/render_model_support.rs b/aver-cert/src/engine/render_model_support.rs deleted file mode 100644 index 05e47009e..000000000 --- a/aver-cert/src/engine/render_model_support.rs +++ /dev/null @@ -1,321 +0,0 @@ -fn render_user_repr_defs(analysis: &Analysis, model_info: &ModelInfo) -> String { - let mut out = String::new(); - let mut emitted = std::collections::HashSet::new(); - for c in &analysis.certs { - let Some((ty, indices)) = adt_repr_indices(c, model_info) else { - continue; - }; - let Some(ind) = model_info.inductives.get(&ty) else { - continue; - }; - // `ty` is the qualified inductive name (identity for entry-level - // models). The def NAME flattens its dots so it stays one atomic - // identifier inside the AverCert namespace; the type POSITION cites - // the qualified name the imported model module actually declares. - // - // Dedupe on the EMITTED identifier, not on `ty`: two distinct - // qualified types can flatten onto one def name (`A.B` + type `C` and - // `A` + type `B_C` both yield `A_B_CRepr`), and emitting both would be - // a duplicate declaration that fails the package build. - let ty_def = ty.replace('.', "_"); - if !emitted.insert(ty_def.clone()) { - continue; - } - out.push_str(&format!( - "def {ty_def}Repr (S : CarrierSpec {}) : {ty} → WVal → Prop\n", - c.carrier() - )); - for (i, ctor) in ind.ctors.iter().enumerate() { - let idx = indices.get(i).copied().unwrap_or(i as u32); - if ctor.fields.is_empty() { - out.push_str(&format!(" | .{}, v => v = .structv {idx} []\n", ctor.name)); - } else if ctor.fields.len() == 1 && ctor.fields[0] == "Int" { - out.push_str(&format!( - " | .{} x, v => ∃ cx, v = .structv {idx} [cx] ∧ S.Repr x cx\n", - ctor.name - )); - } else { - out.push_str(&render_unsupported_user_repr_arm(ctor)); - } - } - out.push('\n'); - } - // Per-function domain-representation relations for widened Int matches. Each - // is keyed on the projected variant's byte-derived struct index: the hit - // constructor is represented as that struct carrying a single Int carrier, - // every other constructor as any struct of a DIFFERENT type — enough to make - // the projection theorem provable and non-vacuous. This is a read - // declaration (the ADT face is not kernel-re-derived), so its exact shape is - // untrusted; the checker pins only `Cod = Int`, `codRepr = intRepr` and - // `Nonempty Dom`. - for c in &analysis.certs { - let c = c.inner(); - let Cert::WidenedIntMatch { - hit_variant_idx, .. - } = c - else { - continue; - }; - let Some((ty, ind, hit_ctor)) = widened_match_info(c, model_info) else { - continue; - }; - out.push_str(&format!( - "def {name}DomRepr (S : CarrierSpec {carrier}) : {ty} → WVal → Prop\n", - name = c.name(), - carrier = c.carrier(), - )); - for ctor in &ind.ctors { - let binders = " _".repeat(ctor.fields.len()); - if ctor.name == hit_ctor { - out.push_str(&format!( - " | .{ctor} x, v => ∃ cx, v = .structv {hit_variant_idx} [cx] ∧ S.Repr x cx\n", - ctor = ctor.name, - )); - } else { - out.push_str(&format!( - " | .{ctor}{binders}, v => ∃ t fs, v = .structv t fs ∧ t ≠ {hit_variant_idx}\n", - ctor = ctor.name, - )); - } - } - out.push('\n'); - } - // Canonical model definitions for both verbatim dispatch shapes. The model - // is the audited evaluator applied to the plan emitted from recognized wasm - // structure/data segments; the checker independently re-renders that plan - // literal and pins this face with `HEq.rfl`. - for c in &analysis.certs { - let c = c.inner(); - if !matches!( - c, - Cert::VerbatimWidenedMatch { .. } | Cert::VerbatimVariantDispatch { .. } - ) { - continue; - } - out.push_str(&format!( - "def {name}Model (v : CertPrelude.WVal) : CertPrelude.WVal :=\n \ - ConstructVerbatimSoundness.verbatimModel Plans.{name}VerbatimPlan v\n\n", - name = c.name(), - )); - } - // Model for String-literal dispatch: the String.eq helper is a host - // contract, so the model uses the audited prelude's byte-array equality - // predicate over raw `WVal` arrays and returns byte-derived constants. - for c in &analysis.certs { - let c = c.inner(); - let Cert::StringEqVerbatimMatch { arms, default, .. } = c else { - continue; - }; - let mut body = String::new(); - for (needle, hit) in arms { - body.push_str(&format!( - " if stringEqW v {} then {}\n else", - render_wval_arg(needle), - render_wval(hit) - )); - } - body.push_str(&format!(" {}\n", render_string_eq_default(default, "v"))); - out.push_str(&format!( - "def {name}Model (v : CertPrelude.WVal) : CertPrelude.WVal :=\n{body}\n", - name = c.name(), - )); - } - // Model for String.concat verbatim match: use the audited prelude's - // contract face on the exact container the emitted wasm body builds. - for c in &analysis.certs { - let Cert::StringConcatVerbatimMatch { - name, - container_ty, - result_ty, - prefixes, - suffixes, - .. - } = c.inner() - else { - continue; - }; - let prefix_parts: Vec = prefixes.iter().map(render_wval_qualified).collect(); - let suffix_parts: Vec = suffixes.iter().map(render_wval_qualified).collect(); - let mut container_parts = String::new(); - for p in &prefix_parts { - container_parts.push_str(&format!("{p}, ")); - } - container_parts.push('v'); - for s in &suffix_parts { - container_parts.push_str(&format!(", {s}")); - } - let body = format!( - " (stringConcatW {result_ty} (WVal.arr {container_ty} [{container_parts}])).getD WVal.null\n" - ); - out.push_str(&format!( - "def {name}Model (v : CertPrelude.WVal) : CertPrelude.WVal :=\n{body}\n", - )); - } - out -} - -/// A constructor outside the currently supported representation vocabulary -/// still needs one wildcard for every payload field. Omitting those binders -/// makes Lean interpret the constructor itself as the pattern and reject the -/// generated Manifest before the intended fail-closed `False` can apply. -fn render_unsupported_user_repr_arm(ctor: &CtorInfo) -> String { - let binders = " _".repeat(ctor.fields.len()); - format!(" | .{}{binders}, _ => False\n", ctor.name) -} - -/// For a widened Int match: the model inductive's QUALIFIED name, its -/// constructor list, and the name of the single integer-payload constructor -/// the body projects (the unique `fields == ["Int"]` constructor). `None` — so -/// the class declines by a failed render — if the model type is unknown or the -/// projected constructor is not unique. -fn widened_match_info<'a>( - c: &Cert, - model_info: &'a ModelInfo, -) -> Option<(String, &'a InductiveInfo, String)> { - let c = c.inner(); - let Cert::WidenedIntMatch { name, .. } = c else { - return None; - }; - let sig = model_info.fns.get(name)?; - let written = sig.params.first()?; - let (ty, ind) = model_info.resolve_inductive(&sig.prefix, written)?; - let mut int_ctors = ind.ctors.iter().filter(|ct| ct.fields == ["Int"]); - let hit = int_ctors.next()?.name.clone(); - if int_ctors.next().is_some() { - return None; - } - Some((ty, ind, hit)) -} - -/// Whether an ADT constructor certificate can name its real model type: a -/// single-field constructor whose codomain is a user inductive (so -/// `render_user_repr_defs` emits a `Repr` and the model is `.`). -/// Anything else — a multi-field constructor, or a constructor over a builtin -/// compound codomain like `List (String × Json)` that has no user Repr — is -/// certified as a verbatim pack instead (the dual of a field projection), which -/// makes no claim about a recursive representation (deferred, see the model -/// stop-loss on recursive-type Repr). -fn adt_constructor_uses_model(c: &Cert, model_info: &ModelInfo) -> bool { - let c = c.inner(); - let Cert::AdtConstructor { - name, - field_count, - arity, - fields, - .. - } = c - else { - return false; - }; - *field_count == 1 - && *arity == 1 - && fields.as_slice() == [ConstructorField::Local(0)] - && model_info - .fns - .get(name) - .map(|s| model_info.resolve_inductive(&s.prefix, &s.ret).is_some()) - .unwrap_or(false) -} - -/// `(Dom type, `vs`-shape, struct-field list)` for a verbatim pack constructor -/// of the given field count. The domain is the raw argument `WVal`s (a single -/// value or a pair), and the model packs them into the variant struct verbatim. -fn verbatim_ctor_shape( - arity: usize, - fields: &[ConstructorField], -) -> (&'static str, String, String) { - let args = fields - .iter() - .map(|field| match field { - ConstructorField::Local(0) if arity == 1 => "p".to_string(), - ConstructorField::Local(0) => "p.1".to_string(), - ConstructorField::Local(1) => "p.2".to_string(), - ConstructorField::Local(i) => format!("p.{i}"), - ConstructorField::Null => ".null".to_string(), - }) - .collect::>() - .join(", "); - if arity == 1 { - ("WVal", "[p]".to_string(), format!("[{args}]")) - } else { - ("WVal × WVal", "[p.1, p.2]".to_string(), format!("[{args}]")) - } -} - -/// The QUALIFIED model inductive name and per-constructor struct indices for a -/// user-ADT cert (identity qualification for entry-level models). -fn adt_repr_indices(c: &Cert, model_info: &ModelInfo) -> Option<(String, Vec)> { - match c.inner() { - Cert::VariantDispatch { name, arms, .. } => { - let sig = model_info.fns.get(name)?; - let written = sig.params.first()?; - let (ty, ind) = model_info.resolve_inductive(&sig.prefix, written)?; - // Struct tags are assigned per constructor in declaration order; - // anchor the base on the smallest dispatched tag. A mis-anchored - // base renders an unprovable `Repr` and fails the lake build — - // never a false certificate. - let base = arms.iter().map(|(t, _)| *t).min()?; - Some((ty, (0..ind.ctors.len()).map(|i| base + i as u32).collect())) - } - Cert::AdtConstructor { - name, struct_idx, .. - } => { - let sig = model_info.fns.get(name)?; - let (ty, ind) = model_info.resolve_inductive(&sig.prefix, &sig.ret)?; - let base = *struct_idx; - let mut indices = Vec::new(); - for i in 0..ind.ctors.len() { - indices.push(base + i as u32); - } - Some((ty, indices)) - } - _ => None, - } -} - -/// The `And` projection selecting conjunct `pos` of a right-nested `k`-way -/// conjunction: `.1` for the first, `.2.…​.2.1` for the middle, `.2.…​.2` for the -/// last. For the two-member SCC this is `.1` / `.2`. -fn conjunct_proj(pos: usize, k: usize) -> String { - let mut s = String::new(); - for _ in 0..pos { - s.push_str(".2"); - } - if pos + 1 < k { - s.push_str(".1"); - } - s -} - -// Mutual-recursion proof rendering lives in render_mutual.rs. - -#[cfg(test)] -mod render_model_support_tests { - use super::{CtorInfo, render_unsupported_user_repr_arm}; - - #[test] - fn unsupported_user_repr_constructor_binds_its_refined_record_payload() { - let ctor = CtorInfo { - name: "raw".to_string(), - fields: vec!["Natural".to_string()], - }; - - assert_eq!( - render_unsupported_user_repr_arm(&ctor), - " | .raw _, _ => False\n" - ); - } - - #[test] - fn unsupported_user_repr_constructor_binds_every_payload_field() { - let ctor = CtorInfo { - name: "many".to_string(), - fields: vec!["Natural".to_string(), "String".to_string()], - }; - - assert_eq!( - render_unsupported_user_repr_arm(&ctor), - " | .many _ _, _ => False\n" - ); - } -} diff --git a/aver-cert/src/engine/render_mutual.rs b/aver-cert/src/engine/render_mutual.rs deleted file mode 100644 index 10b2c00f3..000000000 --- a/aver-cert/src/engine/render_mutual.rs +++ /dev/null @@ -1,382 +0,0 @@ -/// The concrete mutual claim fed to the audited generic discharge. The SCC -/// member set and host-role table are byte-derived data shared with the -/// accepted-artifact witness. -fn mutual_claim_lean_value(c: &Cert) -> String { - let Cert::MutualRecursion { - name, - carrier, - box_idx, - sub_idx, - scc, - .. - } = c.inner() - else { - unreachable!("audited mutual claim has a mutual-recursion shape") - }; - format!( - "({{ exportNameBytes := {}, exportName := {}, carrier := {carrier}, \ - memberSet := {}, hostTable := {}, obligation := AverCert.{name}Ob }} : \ - AverCert.AcceptedArtifact.MutualRecursionClaim)", - render_byte_list(name.as_bytes()), - lean_str(name), - mutual_member_set_lean_value(scc), - mutual_host_table_lean_value(*box_idx, *sub_idx), - ) -} - -/// Render one SCC member's `{name}_mutualClaimAccepted` companion theorem as a -/// SPLIT proof, mirroring `render_mutual_claim_bundles` in `render_project.rs`. -/// -/// This shared bridge module re-proves acceptance for every SCC member in a -/// standalone file, so it carried the same monolithic witness tuple the artifact -/// root did. Emitting the lowered body, code-entry bytes and function binding as -/// named `def`s and each byte-walking conjunct as its own leaf theorem keeps the -/// per-member kernel peak at the largest single leaf. The leaves are stated over -/// `AverCert.Plans.{name}MutualPlan`, so the aggregate re-runs no decode work. -fn render_mutual_bridge_claim_accepted(c: &Cert) -> String { - let Cert::MutualRecursion { - name, - carrier, - box_idx, - sub_idx, - position, - scc, - .. - } = c.inner() - else { - unreachable!("audited mutual acceptance has a mutual-recursion shape") - }; - let member = &scc[*position]; - let plan_cert = mutual_plan_from_cert(c).expect("audited mutual member has a canonical plan"); - let lowered_body = lower_expr_fragment_plan(&plan_cert, *carrier) - .map(|ops| render_ops_value(&ops)) - .expect("audited mutual plan lowers to WInstr"); - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(&plan_cert, *carrier) - .expect("audited mutual plan lowers to exact code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let export_name_bytes = render_byte_list(name.as_bytes()); - let host_table = mutual_host_table_lean_value(*box_idx, *sub_idx); - let member_set = mutual_member_set_lean_value(scc); - - let body = format!("{name}MutualClaimBody"); - let code_entry = format!("{name}MutualClaimCodeEntry"); - let binding = format!("{name}MutualClaimBinding"); - let check_plan = format!("{name}MutualClaimCheckPlan"); - let lower_body = format!("{name}MutualClaimLowerBody"); - let lower_code = format!("{name}MutualClaimLowerCode"); - let func_binding = format!("{name}MutualClaimFuncBinding"); - let check_shape = format!("{name}MutualClaimCheckShape"); - let func_type = format!("{name}MutualClaimFuncType"); - let host_types = format!("{name}MutualClaimHostTypes"); - let plan = format!("AverCert.Plans.{name}MutualPlan"); - format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkMutualRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerMutualBody {carrier} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerMutualCodeEntry {carrier} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {check_shape} :\n \ - AverCert.PlanCheck.checkMutualPlanShape {member_set} {host_table} {plan} = true := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {plan}.params.length {carrier} = true := by\n \ - rfl\n\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table} = true := by\n \ - rfl\n\n\ - theorem {name}_mutualClaimAccepted :\n \ - AverCert.AcceptedArtifact.mutualRecursionClaimAccepted\n \ - AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest\n \ - {name}_mutualClaim := by\n \ - dsimp [{name}_mutualClaim,\n \ - AverCert.AcceptedArtifact.mutualRecursionClaimAccepted,\n \ - AverCert.AcceptedArtifact.mutualPlanForExport,\n \ - AverCert.AcceptedArtifact.mutualPlanAccepted]\n \ - exact ⟨rfl, rfl, rfl, {check_plan}, rfl, ⟨{body}, {code_entry}, {binding}, ⟨{lower_body}, {lower_code}, {func_binding}, rfl, {check_shape}, {func_type}, {host_types}, rfl⟩⟩⟩\n", - self_idx = member.self_idx, - type_idx = member.type_idx, - ) -} - -/// Right-nested constructor for a conjunction of `count` reflexive facts. -fn mutual_rfl_conjunction(count: usize) -> String { - debug_assert!(count >= 2); - (0..count - 2).fold("⟨rfl, rfl⟩".to_string(), |tail, _| { - format!("⟨rfl, {tail}⟩") - }) -} - -/// Exhaust a concrete `Fin k` by `Fin.cases`, closing each inhabited branch -/// with `rfl`. The final successor branch is `Fin 0` and closes by elimination. -fn render_mutual_fin_rfl_cases(k: usize, initial_indent: &str) -> String { - debug_assert!(k >= 2); - let mut out = String::new(); - let mut indent = initial_indent.to_string(); - for _ in 0..k { - out.push_str(&format!("{indent}refine Fin.cases ?_ ?_ i\n")); - out.push_str(&format!("{indent}· rfl\n")); - out.push_str(&format!("{indent}· intro i\n")); - indent.push_str(" "); - } - out.push_str(&format!("{indent}exact Fin.elim0 i")); - out -} - -/// Definitions shared by every option-(b) bridge in one SCC: concrete members, -/// plans, raw edges, the audited `AdmittedScc`, claims, and byte acceptance. -/// Emitted once by the primary (lowest-self-index) member. -fn render_mutual_shared_bridge_data(c: &Cert) -> String { - let Cert::MutualRecursion { - position, - carrier, - box_idx, - sub_idx, - scc, - .. - } = c.inner() - else { - unreachable!() - }; - if *position != 0 { - return String::new(); - } - let primary = &scc[0].name; - let k = scc.len(); - let member_set = mutual_member_set_lean_value(scc); - let members = scc - .iter() - .map(|member| { - let cross = scc - .iter() - .position(|candidate| candidate.self_idx == member.cross_idx) - .expect("mutual cross target is an SCC member"); - format!( - "({{ self := {}, base := {}, cross := ⟨{cross}, by omega⟩ }} : \ - MutualRecursionSoundness.MemberU {k})", - member.self_idx, - lean_int_lit(member.base_k), - ) - }) - .collect::>() - .join(",\n "); - let plans = scc - .iter() - .map(|member| format!("AverCert.Plans.{}MutualPlan", member.name)) - .collect::>() - .join(", "); - let edges = scc - .iter() - .map(|member| format!("({}, {}, {member_set})", member.self_idx, member.cross_idx)) - .collect::>() - .join(", "); - let claims = scc - .iter() - .map(|member| format!("{}_mutualClaim", member.name)) - .collect::>() - .join(", "); - let accepted = scc.iter().rev().fold("trivial".to_string(), |tail, member| { - format!("⟨{}_mutualClaimAccepted, {tail}⟩", member.name) - }); - let lowered = render_mutual_fin_rfl_cases(k, " "); - - let mut out = format!( - r#"/-! ### {primary} — option-(b) mutual SCC data -/ - -def {primary}_mutualMembers : Fin {k} → MutualRecursionSoundness.MemberU {k} := fun i => - [{members}].get i - -def {primary}_mutualPlans : Fin {k} → MutualRawPlan := fun i => - [{plans}].get i - -def {primary}_mutualEdges : List (Nat × Nat × List Nat) := - [{edges}] - -def {primary}_mutualScc : MutualRecursionSoundness.AdmittedScc {k} {carrier} {box_idx} {sub_idx} := - {{ members := {primary}_mutualMembers - plans := {primary}_mutualPlans - rawEdges := {primary}_mutualEdges - edgesBound := by decide - closed := by decide - checked := by decide - shaped := by decide - lowered := by - intro i -{lowered} }} - -"#, - ); - for member in scc { - let member_cert = Cert::MutualRecursion { - name: member.name.clone(), - self_idx: member.self_idx, - carrier: *carrier, - box_idx: *box_idx, - sub_idx: *sub_idx, - position: scc - .iter() - .position(|candidate| candidate.self_idx == member.self_idx) - .expect("member belongs to SCC"), - scc: scc.clone(), - }; - let wrapped = Cert::NonRecursive { - inner: Box::new(member_cert), - }; - let claim = mutual_claim_lean_value(&wrapped); - let claim_accepted = render_mutual_bridge_claim_accepted(&wrapped); - out.push_str(&format!( - r#"def {name}_mutualClaim : AverCert.AcceptedArtifact.MutualRecursionClaim := - {claim} - -{claim_accepted} -"#, - name = member.name, - )); - } - out.push_str(&format!( - r#"def {primary}_mutualClaims : List AverCert.AcceptedArtifact.MutualRecursionClaim := - [{claims}] - -def {primary}_mutualArtifact : AverCert.AcceptedArtifact.ArtifactData := - {{ modBytes := AverCert.ArtifactBytes.modBytes, - modLen := AverCert.ArtifactBytes.modLen, manifest := AverCert.manifest, - wasip2ComponentEnvelope := none, - symFragmentClaims := [], stringEqClaims := [], stringConcatClaims := [], - constructClaims := [], recursionClaims := [], - mutualRecursionClaims := {primary}_mutualClaims, - verbatimClaims := [], intDispatchClaims := [], fieldProjectionClaims := [], - compositionMembers := [], compositionClaims := [], closureFuel := 0, - closureClaim := {{ roots := [], helpers := [], admitted := [] }} }} - -theorem {primary}_mutualFragmentsAccepted : - AverCert.AcceptedArtifact.acceptedMutualRecursionFragments - {primary}_mutualArtifact := by - dsimp [AverCert.AcceptedArtifact.acceptedMutualRecursionFragments, - AverCert.AcceptedArtifact.mutualRecursionClaimsAccepted, - AverCert.AcceptedArtifact.allClaims, - AverCert.AcceptedArtifact.mutualClaimsFormClosedSccs, - AverCert.AcceptedArtifact.mutualClaimEdges, - AverCert.AcceptedArtifact.mutualClaimEdge, - AverCert.AcceptedArtifact.mutualPlanForExport, - AverCert.AcceptedArtifact.mutualPlanTarget, - AverCert.AcceptedArtifact.mutualMembersFormClosedSccs, - AverCert.AcceptedArtifact.followSccCycle, - AverCert.AcceptedArtifact.natEdgeLookup, - AverCert.AcceptedArtifact.natListNodup, - AverCert.AcceptedArtifact.natListSetEq, - {primary}_mutualArtifact, {primary}_mutualClaims] - exact ⟨{accepted}, rfl⟩ - -"#, - )); - out -} - -/// Option-(b) residual for one mutual export. A simultaneous fuel induction -/// relates every source member to the plan-derived k-generic evaluator; the -/// selected member then supplies the represented-domain relation required by -/// `mutualSemanticBridge`. Wasm execution and totality stay in the audited wall. -fn render_mutual_semantic_bridge(c: &Cert, model_info: &ModelInfo) -> String { - let Cert::MutualRecursion { - name, - position, - box_idx, - sub_idx, - scc, - .. - } = c.inner() - else { - unreachable!() - }; - let model_name = c.model_lean_name(model_info); - // Every member's model function, by its qualified Lean identifier. - // `model_citation_gate` covers every member of the SCC, and both `analyze` - // and `write_project` enforce it, so each resolves. - let member_model = |member: &MutualMember| -> String { - model_info - .model_lean_name(&member.name) - .expect("model-citing certificate passed the qualified-name gate") - }; - let primary = &scc[0].name; - let k = scc.len(); - let model_fuel = scc - .iter() - .enumerate() - .map(|(member_pos, member)| { - format!( - "MutualRecursionSoundness.evalMutualUFuel {primary}_mutualMembers fuel \ - ⟨{member_pos}, by omega⟩ n = {}__fuel fuel n", - member_model(member), - ) - }) - .collect::>() - .join(" ∧\n "); - let source_fuels = scc - .iter() - .map(|member| format!("{}__fuel", member_model(member))) - .collect::>() - .join(", "); - let zero = mutual_rfl_conjunction(k); - let projection = conjunct_proj(*position, k); - let fin_cases = render_mutual_fin_rfl_cases(k, " "); - format!( - r#"/-! ### {name} — option-(b) mutual semantic bridge -/ - -theorem {name}_mutualSemanticBridge : - AcceptanceSoundness.mutualSemanticBridge {primary}_mutualArtifact - {name}_mutualClaim AverCert.Plans.{name}MutualPlan := by - have hModelFuel : ∀ fuel n, - {model_fuel} := by - intro fuel - induction fuel with - | zero => intro n; exact {zero} - | succ fuel ih => - intro n - simp only [MutualRecursionSoundness.evalMutualUFuel, {source_fuels}] - split <;> simp_all [{primary}_mutualMembers] - have hModel : ∀ n, - MutualRecursionSoundness.evalMutualU {primary}_mutualMembers - ⟨{position}, by omega⟩ n = {model_name} n := by - intro n - simpa [MutualRecursionSoundness.evalMutualU, {model_name}] using - (hModelFuel (n.natAbs + 1) n){projection} - refine ⟨{k}, {box_idx}, {sub_idx}, {primary}_mutualScc, - ⟨{position}, by omega⟩, rfl, rfl, rfl, rfl, ?_, ?_, ?_⟩ - · intro i _hi -{fin_cases} - · intro add sub mul stringEq stringConcat toIndex cmp eq - refine ⟨rfl, rfl, ?_⟩ - intro i -{fin_cases} - · intro S ns vs hDom - rcases hDom with ⟨hRepr, hLen⟩ - cases hRepr with - | nil => simp at hLen - | cons hv htail => - rename_i n v ns vs - cases htail with - | nil => - refine ⟨n, v, rfl, hv, ?_⟩ - intro w hw - change S.Repr (MutualRecursionSoundness.evalMutualU {primary}_mutualMembers - ⟨{position}, by omega⟩ n) w at hw - rw [hModel n] at hw - simpa [{name}_mutualClaim, AverCert.{name}Ob, - AverCert.Schema.intRepr] using hw - | cons _ _ => simp at hLen -#print axioms {name}_mutualSemanticBridge -"#, - ) -} diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs new file mode 100644 index 000000000..1e78ea560 --- /dev/null +++ b/aver-cert/src/engine/render_package.rs @@ -0,0 +1,1074 @@ +// ---- rendering the schema-9 package ----------------------------------------- + +/// Target artifact whose delivered bytes are bound by a certificate package. +/// +/// The certificate engine always analyzes and renders facts about a core Wasm +/// module. For raw wasm-gc the delivered artifact and that core are the same +/// bytes. For wasip2 they are deliberately distinct: the component is hashed +/// as the delivered artifact, while the wall consumes the exact core-module +/// payload declared inside that component. +pub enum CertificateArtifact<'a> { + WasmGc { + file_name: &'a str, + module_bytes: &'a [u8], + }, + Wasip2 { + file_name: &'a str, + component_bytes: &'a [u8], + embedded_core_module: &'a [u8], + envelope: crate::format::Wasip2ComponentEnvelopeDeclaration, + }, +} + +impl CertificateArtifact<'_> { + fn validate(&self) -> Result<(), String> { + match self { + Self::WasmGc { module_bytes, .. } => { + if module_bytes.is_empty() { + return Err("cannot certify an empty wasm-gc module".to_string()); + } + } + Self::Wasip2 { + component_bytes, + embedded_core_module, + envelope, + .. + } => { + let (_, declared_core, _) = envelope.split_component(component_bytes).ok_or_else(|| { + "wasip2 certificate envelope does not split the delivered component by its declared lengths" + .to_string() + })?; + if declared_core != *embedded_core_module { + return Err( + "wasip2 certificate core bytes do not equal the envelope-declared component slice" + .to_string(), + ); + } + } + } + Ok(()) + } + + pub fn file_name(&self) -> &str { + match self { + Self::WasmGc { file_name, .. } | Self::Wasip2 { file_name, .. } => file_name, + } + } + + fn delivered_bytes(&self) -> &[u8] { + match self { + Self::WasmGc { module_bytes, .. } => module_bytes, + Self::Wasip2 { + component_bytes, .. + } => component_bytes, + } + } + + pub fn core_module_bytes(&self) -> &[u8] { + match self { + Self::WasmGc { module_bytes, .. } => module_bytes, + Self::Wasip2 { + embedded_core_module, + .. + } => embedded_core_module, + } + } + + pub fn target(&self) -> &'static str { + match self { + Self::WasmGc { .. } => crate::format::TARGET_WASM_GC, + Self::Wasip2 { .. } => crate::format::TARGET_WASIP2, + } + } + + fn abi(&self) -> &'static str { + match self { + Self::WasmGc { .. } => crate::format::RUNTIME_ABI_WASM_GC, + Self::Wasip2 { .. } => crate::format::RUNTIME_ABI_WASIP2, + } + } + + fn wasip2_component_envelope( + &self, + ) -> Option { + match self { + Self::WasmGc { .. } => None, + Self::Wasip2 { envelope, .. } => Some(*envelope), + } + } +} + +/// What the producer refused to declare, by surface. Each entry is +/// `(name, reason)`; neither kind changes which exports are certified. +#[derive(Debug, Default)] +pub struct ProjectDeclines { + pub law_claims: Vec<(String, String)>, + pub source_bridges: Vec<(String, String)>, +} + +fn lean_str(s: &str) -> String { + let mut out = String::with_capacity(s.len() + 2); + out.push('"'); + for ch in s.chars() { + match ch { + '"' => out.push_str("\\\""), + '\\' => out.push_str("\\\\"), + _ => out.push(ch), + } + } + out.push('"'); + out +} + +fn json_str(s: &str) -> String { + let mut out = String::with_capacity(s.len() + 2); + out.push('"'); + for ch in s.chars() { + match ch { + '"' => out.push_str("\\\""), + '\\' => out.push_str("\\\\"), + '\n' => out.push_str("\\n"), + c if (c as u32) < 0x20 => out.push_str(&format!("\\u{:04x}", c as u32)), + _ => out.push(ch), + } + } + out.push('"'); + out +} + +fn write(dir: &Path, name: &str, content: &str) -> Result<(), String> { + let path = dir.join(name); + std::fs::write(&path, content).map_err(|e| format!("write {}: {e}", path.display())) +} + +/// A String as the Lean list of its characters. A String literal is +/// definitionally `String.ofList` of exactly this list, which the kernel +/// checks without building the String's bytes. Printable ASCII other than +/// the quote and escape characters stays a plain literal (so the checker's +/// lexical gate sees no string opener); every other character is spelled by +/// its code point. +fn lean_char_list(s: &str) -> String { + let chars = s + .chars() + .map(|c| { + if (' '..='~').contains(&c) && !matches!(c, '\'' | '\\' | '"') { + format!("'{c}'") + } else { + format!("(Char.ofNat {})", c as u32) + } + }) + .collect::>() + .join(", "); + format!("[{chars}]") +} + +/// A list of Strings as the Lean list of their character lists, one per +/// line after `separator`. +fn lean_char_lists(items: &[String], separator: &str) -> String { + let lists = items + .iter() + .map(|item| lean_char_list(item)) + .collect::>() + .join(&format!(",{separator}")); + format!("[{lists}]") +} + +/// Pairs of Strings as the Lean list of pairs of their character lists. +fn lean_char_pairs(items: &[(String, String)]) -> String { + let pairs = items + .iter() + .map(|(a, b)| format!("({}, {})", lean_char_list(a), lean_char_list(b))) + .collect::>() + .join(",\n "); + format!("[{pairs}]") +} + +fn plan_def_name(func_idx: u32) -> String { + format!("fn{func_idx}") +} + +fn render_plans(analysis: &Analysis) -> String { + let mut s = String::from( + "-- The certificate's plans: every planned function's optimized MIR body,\n\ + -- printed 1:1 into the one plan grammar, and the declared type layout.\n\ + -- Producer data: the wall lowers each plan and pins the result to the\n\ + -- function's code entry, and confirms the layout against the bytes.\n\ + import SchemaCore\n\n\ + namespace AverCert.Plans\n\ + open AverCert.Schema AverCert.Grammar\n\n", + ); + s.push_str(&analysis.types.lean_decls("types")); + for e in &analysis.entries { + s.push_str(&format!( + "/-- `{}` (function {}). -/\ndef {} : FnPlan :=\n {}\n\n", + e.name.replace('-', "_"), + e.func_idx, + plan_def_name(e.func_idx), + e.plan.lean() + )); + } + let entries = analysis + .entries + .iter() + .map(|e| { + format!( + "⟨{}, {}, {}, {}, {}⟩", + lean_str(&e.name), + e.exported, + e.func_idx, + e.group, + plan_def_name(e.func_idx) + ) + }) + .collect::>() + .join(",\n "); + s.push_str(&format!("def fnPlans : List FnEntry :=\n [{entries}]\n\n")); + s.push_str("end AverCert.Plans\n"); + s +} + +fn declared_uncertified(analysis: &Analysis) -> Vec<(String, String)> { + analysis + .module_envelope + .declared_uncertified(analysis.certified_names(), &analysis.declined) +} + +fn render_manifest_lean(analysis: &Analysis, sha: &str, target: &str, abi: &str) -> String { + let roles = match &analysis.roles { + Some(r) => format!("some {}", r.roles_lean_value()), + None => "(none : Option CertDecode.AddSub.Roles)".to_string(), + }; + let params = match analysis + .roles + .as_ref() + .and_then(|r| r.arith_params_record_lean(analysis.carrier)) + { + Some(p) => format!("some {p}"), + None => "(none : Option ArithTemplateDerisk.ArithHostParams)".to_string(), + }; + let strings = format!( + "[{}]", + analysis + .string_roles + .iter() + .map(|(idx, role)| format!("({idx}, {})", role.lean_value())) + .collect::>() + .join(", ") + ); + let start = match analysis.module_envelope.start { + Some(i) => format!("some {i}"), + None => "none".to_string(), + }; + // A big module's export lists do not fit one declaration: they are + // written in pieces (`lean_list_in_pieces`) ahead of `subject`. The pieces + // live under `AverCert.Plans`, not under `AverCert.subject`: the checker's + // audit refuses a package name that extends another declared constant. + let mut pieces = String::new(); + let string_items = |items: &[String]| items.iter().map(|x| lean_str(x)).collect::>(); + let pair_items = |items: &[(String, String)]| { + items + .iter() + .map(|(a, b)| format!("({}, {})", lean_str(a), lean_str(b))) + .collect::>() + }; + let exports = lean_list_in_pieces( + &mut pieces, + "Plans.subject_exports", + "String", + &string_items(&analysis.certified_names()), + ); + let declared = lean_list_in_pieces( + &mut pieces, + "Plans.subject_declaredUncertified", + "String × String", + &pair_items(&declared_uncertified(analysis)), + ); + let capabilities = lean_list_in_pieces( + &mut pieces, + "Plans.subject_capabilities", + "String × String", + &pair_items(&analysis.module_envelope.capabilities), + ); + let contracts = lean_list_in_pieces( + &mut pieces, + "Plans.subject_contracts", + "String", + &string_items(&analysis.contracts), + ); + format!( + "-- The certificate's manifest: the subject (artifact identity, exports,\n\ + -- helper indices and the contracts it is conditional on), the plans and\n\ + -- the obligations, which are exactly the ones the wall derives.\n\ + import SchemaCore\n\ + import AcceptedArtifactCore\n\ + import Plans\n\n\ + namespace AverCert\n\ + open AverCert.Schema\n\n\ + {pieces}\ + def subject : Subject :=\n \ + {{ artifactHash := {sha}\n \ + target := {target}, profile := {profile}, abi := {abi}\n \ + artifactRoot := {root}\n \ + exports := {exports}\n \ + declaredUncertified := {declared}\n \ + capabilities := {capabilities}\n \ + start := {start}\n \ + hostRoleTable := {roles}\n \ + arithParams := {params}\n \ + stringHostRoles := {strings}\n \ + contracts := {contracts} }}\n\n\ + def manifest : Manifest :=\n \ + {{ subject := subject, types := Plans.types, fnPlans := Plans.fnPlans,\n \ + obligations := AverCert.AcceptedArtifact.obligationsOf subject Plans.types Plans.fnPlans }}\n\n\ + end AverCert\n", + sha = lean_str(sha), + target = lean_str(target), + profile = lean_str(PROFILE_ID), + abi = lean_str(abi), + root = lean_str(ARTIFACT_CERTIFICATE_ROOT), + ) +} + +fn render_artifact_host_roles(analysis: &Analysis, params: &str, layout: bool) -> String { + let roles = analysis.roles.expect("a carriered module declares roles"); + // With a declared layout, each helper body is read from it (one slice) + // instead of decoding the code section in every declaration. + let proof = if layout { + "by\n rw [AverCert.DeclaredLayout.arithRoleCheck_of_layout layout_ok] <;> decide +kernel" + } else { + "by decide +kernel" + }; + let leaf = |name: &str, idx: Option| { + let idx = idx.map_or_else(|| "none".to_string(), |idx| format!("(some {idx})")); + format!( + "theorem decodedHostRole_{name} : AverCert.AcceptedArtifact.arithRoleCheck \ + AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen \ + ArithTemplateDerisk.ArithRole.{name} {idx} {params} = true := {proof}" + ) + }; + let leaves = [ + leaf("box", roles.box_idx), + leaf("toIndex", roles.to_index_idx), + leaf("add", roles.add_idx), + leaf("sub", roles.sub_idx), + leaf("mul", roles.mul_idx), + leaf("cmp", roles.cmp_idx), + leaf("eq", roles.eq_idx), + leaf("divmod", roles.divmod_idx), + ] + .join("\n\n"); + format!( + "-- Per-role helper template pins, each in its own `decide +kernel`\n\ + -- declaration, in a separate compilation unit.\n\ + import AcceptedArtifact\n\ + import ArtifactBytes\n\ + {layout_import}\n\ + set_option maxRecDepth 200000\n\n\ + namespace AverCert.Artifact\n\n\ + {leaves}\n\n\ + end AverCert.Artifact\n", + layout_import = if layout { "import ArtifactLayout\n" } else { "" }, + ) +} + +/// Plans checked per kernel declaration in `ArtifactPlans.lean`. +const PLAN_CHUNK: usize = 32; + +/// The per-entry plan checks (`entryAccepted`), `PLAN_CHUNK` entries per +/// declaration, chained from the last chunk back to the whole list. With a +/// declared layout (`ArtifactLayout.lean`) a chunk proves them through +/// `DeclaredLayout.entries_of_fast`: every module fact of a plan is read from +/// the confirmed declaration (its code entry by offset, its type index and +/// function type, its export entry by position), so no chunk decodes a +/// section other than the export section or searches for an export. Without +/// one (a package with no plans) each chunk is decided directly. +fn render_artifact_plans(analysis: &Analysis, layout: bool) -> Vec<(String, String)> { + let n = analysis.entries.len(); + let header = format!( + "set_option maxRecDepth 200000\n\ + set_option maxHeartbeats 1600000\n\n\ + namespace AverCert.Artifact\n\ + open AverCert AverCert.Schema AverCert.AcceptedArtifact AverCert.TypeTable{}\n\n", + if layout { " AverCert.DeclaredLayout" } else { "" } + ); + let split = splits_artifact_modules(analysis); + let mut plan_ok = "/-- One plan's acceptance check against the staged artifact bytes. -/\n\ + noncomputable abbrev planOk : FnEntry → Bool :=\n \ + entryAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen\n \ + (mctxOf AverCert.manifest.subject AverCert.manifest.types AverCert.manifest.fnPlans)\n \ + AverCert.manifest.fnPlans\n\n" + .to_string(); + if layout { + plan_ok.push_str( + "theorem types_ok : fnTypesConfirmed AverCert.ArtifactBytes.modBytes\n \ + AverCert.ArtifactBytes.modLen fnTypes = true := by\n \ + rw [fnTypesConfirmed, types_cut]; decide +kernel\n\n\ + theorem names_ok : exportNamesDistinct AverCert.ArtifactBytes.modBytes\n \ + AverCert.ArtifactBytes.modLen = true :=\n ", + ); + // A split package proves the export accounting in its own module, and + // the accounting decides the names distinct; a small one decides them. + plan_ok.push_str(if split { + "AverCert.SortedKeys.exportNamesDistinct_of_accounted exports_ok\n\n" + } else { + "by rw [exportNamesDistinct, exports_cut]; decide +kernel\n\n" + }); + } + let proof = |decls: &str| { + if layout { + format!( + ":=\n entries_of_fast layout_ok types_ok names_ok (ds := {decls}) rfl\n \ + (by rw [entriesFast, exports_cut]; decide +kernel)\n\n" + ) + } else { + ":= by\n decide +kernel\n\n".to_string() + } + }; + let starts: Vec = (0..n.max(1)).step_by(PLAN_CHUNK).collect(); + let last = *starts.last().expect("at least one chunk"); + let from_last = format!( + "theorem plans_from_{last} : (AverCert.manifest.fnPlans.drop {last}).all planOk = true {}", + proof(&format!("fnDecls.drop {last}")) + ); + let chunk = |k: usize| { + format!( + "theorem plans_chunk_{k} :\n \ + ((AverCert.manifest.fnPlans.drop {k}).take {PLAN_CHUNK}).all planOk = true {}", + proof(&format!("(fnDecls.drop {k}).take {PLAN_CHUNK}")) + ) + }; + let chain = |k: usize, next: usize| { + format!( + "theorem plans_from_{k} : (AverCert.manifest.fnPlans.drop {k}).all planOk = true := by\n \ + rw [← List.take_append_drop {PLAN_CHUNK} (AverCert.manifest.fnPlans.drop {k}),\n \ + List.all_append, plans_chunk_{k}, List.drop_drop]\n \ + simpa only [Nat.reduceAdd, Bool.true_and] using plans_from_{next}\n\n" + ) + }; + let imports = format!( + "import AcceptedArtifact\nimport ArtifactBytes\nimport Manifest\n{}{}\n", + if layout { "import ArtifactLayout\n" } else { "" }, + if layout && split { "import ArtifactInterface\n" } else { "" } + ); + let mut body = String::new(); + let mut chained = String::new(); + for (i, k) in starts.iter().enumerate().rev().skip(1) { + body.push_str(&chunk(*k)); + chained.push_str(&chain(*k, starts[i + 1])); + } + let end = "theorem plans_all : AverCert.manifest.fnPlans.all planOk = true := plans_from_0\n\n\ + end AverCert.Artifact\n"; + if !split { + return vec![( + "ArtifactPlans.lean".to_string(), + format!( + "-- The per-plan acceptance checks, a few plans per declaration,\n\ + -- chained into the check over every plan.\n\ + {imports}{header}{plan_ok}{from_last}{body}{chained}{end}" + ), + )]; + } + // One module per chunk, so a parallel Lake checks the chunks at once. + let mut files = vec![( + "ArtifactPlanCheck.lean".to_string(), + format!( + "-- The per-plan acceptance check the chunk modules decide.\n\ + {imports}{header}{plan_ok}end AverCert.Artifact\n" + ), + )]; + let mut chunk_imports = String::new(); + for k in &starts { + let theorem = if *k == last { from_last.clone() } else { chunk(*k) }; + files.push(( + format!("ArtifactPlans{k}.lean"), + format!( + "-- One chunk of the per-plan acceptance checks.\n\ + import ArtifactPlanCheck\n\n\ + {header}{theorem}end AverCert.Artifact\n" + ), + )); + chunk_imports.push_str(&format!("import ArtifactPlans{k}\n")); + } + files.push(( + "ArtifactPlans.lean".to_string(), + format!( + "-- The per-plan acceptance checks of the chunk modules, chained into\n\ + -- the check over every plan.\n\ + {chunk_imports}\n{header}{chained}{end}" + ), + )); + files +} + +/// Whether the package spreads its byte facts over several modules: a module +/// with more plans than one chunk checks the chunks, and the heaviest whole- +/// module facts, in modules of their own, which Lake builds in parallel when +/// it is given more than one worker (`AVER_CERT_BUILD_JOBS`). A smaller +/// package keeps one module per step, since each module pays its imports. +fn splits_artifact_modules(analysis: &Analysis) -> bool { + analysis.entries.len() > PLAN_CHUNK +} + +const ARTIFACT_HEADER: &str = "set_option maxRecDepth 200000\n\ + -- Elaboration cost grows with the artifact; this moves a resource\n\ + -- limit only (no axiom, no hypothesis, nothing the kernel accepts).\n\ + set_option maxHeartbeats 1600000\n\n\ + namespace AverCert.Artifact\n\ + open AverCert AverCert.Schema AverCert.AcceptedArtifact\n\n"; + +/// `Artifact.lean` (and, for a split package, the modules it imports): the +/// artifact data and the byte facts of its acceptance. +fn render_artifact( + analysis: &Analysis, + envelope: Option, + layout: bool, +) -> Vec<(String, String)> { + let envelope = match envelope { + None => "none".to_string(), + Some(env) => format!( + "some {{ prefixLen := {}, embeddedCoreModuleLen := {}, suffixLen := {} }}", + env.prefix_len, env.embedded_core_module_len, env.suffix_len + ), + }; + let closure = &analysis.module_envelope.closure; + let nats = |xs: &[u32]| { + format!( + "[{}]", + xs.iter().map(u32::to_string).collect::>().join(", ") + ) + }; + let (roles_import, roles_proof) = match ( + &analysis.roles, + analysis + .roles + .as_ref() + .and_then(|r| r.arith_params_record_lean(analysis.carrier)), + ) { + (Some(r), Some(params)) => ( + "import ArtifactHostRoles\n".to_string(), + format!( + "theorem roles_ok : decodedHostRoleTable data := by\n \ + dsimp only [decodedHostRoleTable, data]\n \ + rw [show AverCert.manifest.subject.hostRoleTable = some {} from rfl,\n \ + show AverCert.manifest.subject.arithParams = some {params} from rfl]\n \ + simp only [arithTableCheck, decodedHostRole_box, decodedHostRole_toIndex, \ + decodedHostRole_add, decodedHostRole_sub, decodedHostRole_mul, decodedHostRole_cmp, \ + decodedHostRole_eq, decodedHostRole_divmod, Bool.and_true, Bool.true_and,\n \ + AverCert.DeclaredLayout.Chars.carrierHelperAbsent_eq,\n \ + AverCert.DeclaredLayout.Chars.boxIdx_eq, AverCert.DeclaredLayout.Chars.toIndexIdx_eq,\n \ + AverCert.DeclaredLayout.Chars.cmpIdx_eq{cuts}]\n \ + decide +kernel", + r.roles_lean_value(), + cuts = if layout { + ", CertDecode.carrierState, types_cut, exports_cut" + } else { + "" + }, + ), + ), + _ => ( + String::new(), + "theorem roles_ok : decodedHostRoleTable data := by\n \ + unfold decodedHostRoleTable; decide +kernel" + .to_string(), + ), + }; + let data = format!( + "noncomputable def data : ArtifactData :=\n \ + {{ modBytes := AverCert.ArtifactBytes.modBytes, modLen := AverCert.ArtifactBytes.modLen,\n \ + manifest := AverCert.manifest, wasip2ComponentEnvelope := {envelope},\n \ + closureFuel := {fuel},\n \ + closureClaim := ⟨{roots}, {helpers}, {admitted}⟩ }}\n\n", + fuel = analysis.module_envelope.closure_fuel, + roots = nats(&closure.roots), + helpers = nats(&closure.helpers), + admitted = nats(&closure.admitted), + ); + // The String roles are decided through `roleTableFast`, which reads a + // function's signature only when its type has a helper's shape. + // With a declared layout they read the type and code sections through + // their confirmed cuts. + let strings = if layout { + "theorem strings_ok : decodedStringHostRoles data := by\n \ + dsimp only [decodedStringHostRoles, data]\n \ + rw [← AverCert.DeclaredLayout.StringFast.roleTableFast_eq,\n \ + AverCert.DeclaredLayout.StringFast.roleTableFast, CertDecode.StringHost.decodeTypeSigs,\n \ + CertDecode.StringHost.bodyLocs, types_cut, code_cut]\n \ + decide +kernel\n\n" + } else { + "theorem strings_ok : decodedStringHostRoles data := by\n \ + unfold decodedStringHostRoles\n \ + rw [← AverCert.DeclaredLayout.StringFast.roleTableFast_eq]; decide +kernel\n\n" + }; + // With a declared layout the closure scan reads each member's code entry + // from it (one slice) instead of decoding the code section per member. + let closure_ok = if layout { + "theorem closure_ok : closureIsolation data = true :=\n \ + AverCert.DeclaredLayout.closureIsolation_of_layout layout_ok\n \ + (AverCert.SortedKeys.closureIsolationL_of_S (by decide +kernel))\n\n" + } else { + "theorem closure_ok : closureIsolation data = true := by decide +kernel\n\n" + }; + let layout_import = if layout { + "import ArtifactLayout\nimport SortedKeys\n" + } else { + "" + }; + let exports = format!( + "theorem framing_ok : CertDecode.moduleFramingValid data.modBytes data.modLen = true := by\n \ + decide +kernel\n\n\ + theorem exports_ok : exportsAccounted data = true :=\n \ + exportsAccounted_of_chars data\n \ + {obligation_names}\n \ + {declared_names}\n \ + rfl rfl {exports_proof}\n\n\ + theorem imports_ok : importsWithinCapabilities data = true :=\n \ + AverCert.DeclaredLayout.Chars.importsWithinCapabilities_of_chars data\n \ + {capabilities}\n \ + rfl (by decide +kernel)\n\n\ + theorem start_ok : startAccounted data = true := by decide +kernel\n\n", + obligation_names = lean_char_lists( + &analysis + .entries + .iter() + .filter(|e| e.exported) + .map(|e| e.name.clone()) + .collect::>(), + "\n " + ), + // With a declared layout the export section is read through its cut. + exports_proof = if layout { + "(AverCert.SortedKeys.exportsAccountedOf_of_fast exports_cut (by decide +kernel))" + } else { + "(by decide +kernel)" + }, + capabilities = lean_char_pairs(&analysis.module_envelope.capabilities), + declared_names = lean_char_lists( + &declared_uncertified(analysis) + .into_iter() + .map(|(name, _)| name) + .collect::>(), + "\n " + ), + ); + // With a declared layout the helper types are read from it. + let rest_proof = if layout { + "(AverCert.DeclaredLayout.plansAcceptedRest_of_layout layout_ok (by\n \ + dsimp only [AverCert.DeclaredLayout.plansAcceptedRestL, data]\n \ + simp only [AverCert.TypeTable.typeTableConfirmed, AverCert.TypeTable.carrierConfirmed,\n \ + CertDecode.carrierState, AverCert.DeclaredLayout.roleTypesPinnedL,\n \ + AverCert.DeclaredLayout.roleTypePinnedL, AverCert.WasmSlice.typeSectionMatches, types_cut]\n \ + decide +kernel))" + } else { + "(by decide +kernel)" + }; + let rest = format!( + "theorem plans_ok : plansAccepted data = true :=\n \ + plansAccepted_of_parts data plans_all {rest_proof}\n\n\ + {roles_proof}\n\n\ + theorem axes_ok : AverCert.ClaimAxes.checked data = true := by decide +kernel\n\n" + ); + let tail = "theorem whole_ok : acceptedWholeModule data :=\n \ + ⟨framing_ok, exports_ok, imports_ok, start_ok, closure_ok⟩\n\n\ + theorem envelope_ok : artifactEnvelopeAccepted AverCert.ArtifactComponentBytes.componentBytes\n \ + AverCert.ArtifactComponentBytes.componentLen data = true := by decide +kernel\n\n\ + end AverCert.Artifact\n"; + let base_imports = + "import AcceptedArtifact\nimport DeclaredLayout\nimport ArtifactBytes\nimport Manifest\n"; + if !splits_artifact_modules(analysis) { + return vec![( + "Artifact.lean".to_string(), + format!( + "-- The artifact data and the byte facts of its acceptance, each by\n\ + -- `decide +kernel` against the checker-staged `ArtifactBytes`.\n\ + {base_imports}\ + import ArtifactPlans\n\ + {layout_import}\ + {roles_import}\n\ + {ARTIFACT_HEADER}\ + {data}{rest}{strings}{exports}{closure_ok}{tail}" + ), + )]; + } + let part = |comment: &str, imports: &str, body: &str| { + format!( + "-- {comment}\n\ + import ArtifactData\n\ + {imports}\n\ + {ARTIFACT_HEADER}\ + {body}\ + end AverCert.Artifact\n" + ) + }; + vec![ + ( + "ArtifactData.lean".to_string(), + format!( + "-- The artifact data the byte facts speak about.\n\ + {base_imports}\n\ + {ARTIFACT_HEADER}\ + {data}\ + end AverCert.Artifact\n" + ), + ), + ( + "ArtifactStrings.lean".to_string(), + part("The String helper roles, decoded from the module.", layout_import, strings), + ), + ( + "ArtifactClosure.lean".to_string(), + part("The certified closure's isolation.", layout_import, closure_ok), + ), + ( + "ArtifactInterface.lean".to_string(), + part( + "The module's framing, exports, imports and start function.", + layout_import, + &exports, + ), + ), + ( + "Artifact.lean".to_string(), + format!( + "-- The remaining byte facts of the artifact's acceptance, joined with\n\ + -- the ones proved in the modules imported below.\n\ + import ArtifactData\n\ + import ArtifactStrings\n\ + import ArtifactClosure\n\ + import ArtifactInterface\n\ + import ArtifactPlans\n\ + {roles_import}\n\ + {ARTIFACT_HEADER}\ + {rest}{tail}" + ), + ), + ] +} + +fn render_final() -> String { + format!( + "import Artifact\nimport AcceptanceSoundness\n\n\ + open AverCert AverCert.Schema\n\n\ + /-- THE certificate theorem: every certified export's emitted function\n\ + simulates its plan's model, from the acceptance's byte facts. -/\n\ + {FINAL_STATEMENT_LINE} :=\n \ + AcceptanceSoundness.accept_sound CertModule.wasmSha256 AverCert.Artifact.data\n \ + rfl rfl rfl rfl AverCert.Artifact.plans_ok\n\n\ + #print axioms {FINAL_THEOREM}\n" + ) +} + +fn render_artifact_certificate() -> String { + "import Artifact\nimport Final\n\n\ + namespace AverCert.Artifact\n\n\ + theorem certificate : AverCert.AcceptedArtifact.accepted data :=\n \ + ⟨AverCert.Final.cert, envelope_ok, rfl, rfl, plans_ok, roles_ok, strings_ok, axes_ok, whole_ok⟩\n\n\ + #print axioms AverCert.Artifact.certificate\n\n\ + end AverCert.Artifact\n" + .to_string() +} + +fn json_list(items: &[T], render: impl Fn(&T) -> String) -> String { + if items.is_empty() { + return "[]".to_string(); + } + format!( + "[\n{}\n ]", + items + .iter() + .map(|x| format!(" {}", render(x))) + .collect::>() + .join(",\n") + ) +} + +fn render_manifest_json( + analysis: &Analysis, + artifact_file_name: &str, + sha: &str, + target: &str, + abi: &str, + envelope: Option, + surfaces: &Surfaces, +) -> String { + let laws = &surfaces.law_claims; + let law_bridges = &surfaces.law_bridge_exports; + let bridges = surfaces.packaged_bridges(); + let declined_bridges = &surfaces.declined_bridges; + let any_total = analysis.certified.iter().any(|c| c.total); + let any_partial = analysis.certified.iter().any(|c| !c.total); + let level = match (any_partial, any_total) { + (true, true) => "mixed L1/L3", + (false, true) => "L3", + _ => CERT_LEVEL, + }; + let mut s = String::from("{\n"); + s.push_str(&format!(" \"schema_version\": {CERT_SCHEMA_VERSION},\n")); + s.push_str(&format!( + " \"format\": {{\"version\": {}, \"wall_id\": {}}},\n", + wall::FORMAT_VERSION, + json_str(wall::current_id()) + )); + s.push_str(&format!(" \"wasm\": {},\n", json_str(artifact_file_name))); + s.push_str(&format!(" \"wasm_sha256\": \"{sha}\",\n")); + s.push_str(&format!(" \"target\": {},\n", json_str(target))); + s.push_str(&format!(" \"level\": \"{level}\",\n")); + s.push_str(&format!(" \"profile\": \"{PROFILE_ID}\",\n")); + s.push_str(&format!(" \"abi\": {},\n", json_str(abi))); + if let Some(envelope) = envelope { + s.push_str(&format!( + " \"{}\": {{\"{}\": {}, \"{}\": {}, \"{}\": {}, \"{}\": {}}},\n", + crate::format::WASIP2_COMPONENT_ENVELOPE_FIELD, + crate::format::WASIP2_COMPONENT_ENVELOPE_KIND_FIELD, + json_str(envelope.kind()), + crate::format::WASIP2_COMPONENT_ENVELOPE_PREFIX_LEN_FIELD, + envelope.prefix_len, + crate::format::WASIP2_COMPONENT_ENVELOPE_CORE_LEN_FIELD, + envelope.embedded_core_module_len, + crate::format::WASIP2_COMPONENT_ENVELOPE_SUFFIX_LEN_FIELD, + envelope.suffix_len, + )); + } + s.push_str(&format!(" \"final_theorem\": \"{FINAL_THEOREM}\",\n")); + s.push_str(&format!( + " \"artifact_certificate_root\": \"{ARTIFACT_CERTIFICATE_ROOT}\",\n" + )); + match analysis.carrier { + Some(c) => s.push_str(&format!(" \"carrier_type_index\": {c},\n")), + None => s.push_str(" \"carrier_type_index\": null,\n"), + } + s.push_str(&format!( + " \"runtime_contracts\": {},\n", + json_list(&analysis.contracts, |c| json_str(c)) + )); + // A law cites the bridges only when its bridged corollary is declared, + // which needs every cited bridge in the package. + let bridge_exports: Vec<&str> = bridges.iter().map(|b| b.export.as_str()).collect(); + s.push_str(&format!( + " \"laws\": {},\n", + json_list( + &laws.iter().zip(law_bridges).collect::>(), + |(claim, cited)| { + let cited: Vec<&String> = if cited.iter().all(|e| bridge_exports.contains(&e.as_str())) { + cited.iter().collect() + } else { + Vec::new() + }; + format!( + "{{\"label\": {}, \"theorem\": {}, \"statement\": {}, \"corollary\": {}, \"bridges\": [{}]}}", + json_str(&claim.label), + json_str(&claim.qualified()), + json_str(&claim.statement), + json_str(&claim.corollary()), + cited.iter().map(|e| json_str(e)).collect::>().join(", ") + ) + } + ) + )); + s.push_str(&format!( + " \"sourceBridges\": {},\n", + json_list(bridges, SourceBridge::to_json) + )); + s.push_str(&format!( + " \"sourceBridgesDeclined\": {},\n", + json_list(declined_bridges, |(e, r)| format!( + "{{\"export\": {}, \"reason\": {}}}", + json_str(e), + json_str(r) + )) + )); + s.push_str(&format!( + " \"declaredUncertified\": {},\n", + json_list(&declared_uncertified(analysis), |(n, r)| format!( + "{{\"name\": {}, \"reason\": {}}}", + json_str(n), + json_str(r) + )) + )); + s.push_str(&format!( + " \"capabilities\": {},\n", + json_list(&analysis.module_envelope.capabilities, |(m, n)| format!( + "{{\"module\": {}, \"name\": {}}}", + json_str(m), + json_str(n) + )) + )); + match analysis.module_envelope.start { + Some(i) => s.push_str(&format!( + " \"start\": {{\"present\": true, \"function_index\": {i}}},\n" + )), + None => s.push_str(" \"start\": {\"present\": false, \"function_index\": null},\n"), + } + let role = |i: Option| i.map_or_else(|| "null".to_string(), |i| i.to_string()); + match &analysis.roles { + Some(r) => s.push_str(&format!( + " \"hostRoleTable\": {{\"box\": {}, \"add\": {}, \"mul\": {}, \"sub\": {}, \"toIndex\": {}, \"cmp\": {}, \"eq\": {}, \"divmod\": {}}},\n", + role(r.box_idx), + role(r.add_idx), + role(r.mul_idx), + role(r.sub_idx), + role(r.to_index_idx), + role(r.cmp_idx), + role(r.eq_idx), + role(r.divmod_idx), + )), + None => s.push_str(" \"hostRoleTable\": null,\n"), + } + s.push_str(&format!( + " \"stringHostRoles\": [{}],\n", + analysis + .string_roles + .iter() + .map(|(i, r)| format!( + "{{\"function_index\": {i}, \"role\": {}}}", + json_str(r.manifest_value()) + )) + .collect::>() + .join(", ") + )); + s.push_str(&format!( + " \"certified\": {},\n", + json_list(&analysis.certified, |c| { + let (policy, level, termination) = if c.total { + ( + "simulatesModelTotally", + "L3", + ", \"termination_witness\": {\"measure\": {\"kind\": \"intNatAbs\", \"param_index\": 0}, \"descent\": -1}", + ) + } else { + ("simulatesModel", "L1", "") + }; + format!( + "{{\"name\": {}, \"class\": \"{PLAN_CLASS}\", \"facets\": [{}], \"policy\": \"{policy}\", \"level\": \"{level}\", \"theorem\": \"{FN_CLAIM_DISCHARGE_THEOREM}\"{termination}}}", + json_str(&c.name), + c.facets.iter().map(|f| json_str(f)).collect::>().join(", ") + ) + }) + )); + s.push_str(&format!( + " \"source_level_only\": {}\n", + json_list(&analysis.declined, |(n, r)| format!( + "{{\"name\": {}, \"reason\": {}}}", + json_str(n), + json_str(r) + )) + )); + s.push_str("}\n"); + s +} + +/// Write the artifact-specific `cert/` package: the plans, the manifest, the +/// artifact data with its byte-fact proofs, the final theorem, and the JSON +/// manifest the checker reads. Any existing `cert/` directory is replaced. +/// +/// Every law-claim or source bridge the producer refused to declare comes back +/// in [`ProjectDeclines`] with its reason (the bridge list is also written to +/// the manifest as `sourceBridgesDeclined`). +pub fn write_project( + out_dir: &Path, + artifact: CertificateArtifact<'_>, + analysis: &Analysis, + model: &SourceModel, +) -> Result { + artifact.validate()?; + let cert_dir = out_dir.join("cert"); + match std::fs::remove_dir_all(&cert_dir) { + Ok(()) => {} + Err(error) if error.kind() == std::io::ErrorKind::NotFound => {} + Err(error) => return Err(format!("replace cert dir: {error}")), + } + std::fs::create_dir_all(&cert_dir).map_err(|e| format!("create cert dir: {e}"))?; + let sha = sha256_hex(artifact.delivered_bytes()); + let target = artifact.target(); + let abi = artifact.abi(); + let envelope = artifact.wasip2_component_envelope(); + + // `Module.lean` (the artifact hash `Schema.Holds` reads) is not written: + // the wall imports it, so the checker renders it from the bytes it reads. + write(&cert_dir, "Plans.lean", &render_plans(analysis))?; + // A package with plans declares the module layout its byte checks read. + let layout = !analysis.entries.is_empty(); + if layout { + write( + &cert_dir, + "ArtifactLayout.lean", + &render_artifact_layout(artifact.core_module_bytes(), analysis)?, + )?; + } + write( + &cert_dir, + "Manifest.lean", + &render_manifest_lean(analysis, &sha, target, abi), + )?; + if let Some(params) = analysis + .roles + .as_ref() + .and_then(|r| r.arith_params_record_lean(analysis.carrier)) + { + write( + &cert_dir, + "ArtifactHostRoles.lean", + &render_artifact_host_roles(analysis, ¶ms, layout), + )?; + } + for (name, text) in render_artifact_plans(analysis, layout) { + write(&cert_dir, &name, &text)?; + } + for (name, text) in render_artifact(analysis, envelope, layout) { + write(&cert_dir, &name, &text)?; + } + write(&cert_dir, "Final.lean", &render_final())?; + write( + &cert_dir, + "ArtifactCertificate.lean", + &render_artifact_certificate(), + )?; + + // The source model, the plan-equals-source bridges and the law-claims. + // The model files ship only when a bridge or a law-claim speaks about + // them: a package without either builds no model at all. + let surfaces = plan_surfaces(analysis, model); + if surfaces.bridge_lean.is_some() || surfaces.laws_lean.is_some() { + for (path, content) in &surfaces.model.files { + write_nested(&cert_dir, path, content)?; + } + } + if let Some((proofs, corollaries, parts)) = &surfaces.bridge_lean { + for (name, text) in parts { + write(&cert_dir, name, text)?; + } + write(&cert_dir, &format!("{BRIDGE_PROOF_MODULE}.lean"), proofs)?; + write(&cert_dir, "Bridge.lean", corollaries)?; + } + if let Some(laws_lean) = &surfaces.laws_lean { + write(&cert_dir, "Laws.lean", laws_lean)?; + } + std::fs::write( + cert_dir.join("cert-manifest.json"), + render_manifest_json( + analysis, + artifact.file_name(), + &sha, + target, + abi, + envelope, + &surfaces, + ), + ) + .map_err(|e| format!("write manifest: {e}"))?; + Ok(ProjectDeclines { + law_claims: surfaces.declined_laws, + source_bridges: surfaces.declined_bridges, + }) +} + +/// Write a model file, which may sit in a module subdirectory +/// (`Domain/Rational.lean`). +fn write_nested(dir: &Path, name: &str, content: &str) -> Result<(), String> { + let path = dir.join(name); + if let Some(parent) = path.parent() { + std::fs::create_dir_all(parent) + .map_err(|e| format!("create directory for {name}: {e}"))?; + } + std::fs::write(&path, content).map_err(|e| format!("write {}: {e}", path.display())) +} diff --git a/aver-cert/src/engine/render_project.rs b/aver-cert/src/engine/render_project.rs deleted file mode 100644 index d6afcf996..000000000 --- a/aver-cert/src/engine/render_project.rs +++ /dev/null @@ -1,3883 +0,0 @@ -// ---- rendering ----------------------------------------------------------- - -/// Target artifact whose delivered bytes are bound by a certificate package. -/// -/// The certificate engine always analyzes and renders facts about a core Wasm -/// module. For raw wasm-gc the delivered artifact and that core are the same -/// bytes. For wasip2 they are deliberately distinct: the component is hashed -/// as the delivered artifact, while the existing Wasm wall consumes the exact -/// core-module payload declared inside that component. -pub enum CertificateArtifact<'a> { - WasmGc { - file_name: &'a str, - module_bytes: &'a [u8], - }, - Wasip2 { - file_name: &'a str, - component_bytes: &'a [u8], - embedded_core_module: &'a [u8], - envelope: crate::format::Wasip2ComponentEnvelopeDeclaration, - }, -} - -impl CertificateArtifact<'_> { - fn validate(&self) -> Result<(), String> { - match self { - Self::WasmGc { module_bytes, .. } => { - if module_bytes.is_empty() { - return Err("cannot certify an empty wasm-gc module".to_string()); - } - } - Self::Wasip2 { - component_bytes, - embedded_core_module, - envelope, - .. - } => { - let (_, declared_core, _) = envelope - .split_component(component_bytes) - .ok_or_else(|| { - "wasip2 certificate envelope does not split the delivered component by its declared lengths" - .to_string() - })?; - if declared_core != *embedded_core_module { - return Err( - "wasip2 certificate core bytes do not equal the envelope-declared component slice" - .to_string(), - ); - } - } - } - Ok(()) - } - - pub fn file_name(&self) -> &str { - match self { - Self::WasmGc { file_name, .. } | Self::Wasip2 { file_name, .. } => file_name, - } - } - - fn delivered_bytes(&self) -> &[u8] { - match self { - Self::WasmGc { module_bytes, .. } => module_bytes, - Self::Wasip2 { - component_bytes, .. - } => component_bytes, - } - } - - pub fn core_module_bytes(&self) -> &[u8] { - match self { - Self::WasmGc { module_bytes, .. } => module_bytes, - Self::Wasip2 { - embedded_core_module, - .. - } => embedded_core_module, - } - } - - pub fn target(&self) -> &'static str { - match self { - Self::WasmGc { .. } => crate::format::TARGET_WASM_GC, - Self::Wasip2 { .. } => crate::format::TARGET_WASIP2, - } - } - - fn abi(&self) -> &'static str { - match self { - Self::WasmGc { .. } => crate::format::RUNTIME_ABI_WASM_GC, - Self::Wasip2 { .. } => crate::format::RUNTIME_ABI_WASIP2, - } - } - - fn wasip2_component_envelope( - &self, - ) -> Option { - match self { - Self::WasmGc { .. } => None, - Self::Wasip2 { envelope, .. } => Some(*envelope), - } - } -} - -#[cfg(test)] -mod certificate_artifact_tests { - use super::CertificateArtifact; - - #[test] - fn wasip2_artifact_requires_the_exact_declared_core_slice() { - let component = [0x10, 0x20, 0x21, 0x30]; - let envelope = crate::format::Wasip2ComponentEnvelopeDeclaration::from_lengths(1, 2, 1); - assert!( - CertificateArtifact::Wasip2 { - file_name: "app.component.wasm", - component_bytes: &component, - embedded_core_module: &component[1..3], - envelope, - } - .validate() - .is_ok() - ); - - let wrong_core = [0x20, 0x22]; - let error = CertificateArtifact::Wasip2 { - file_name: "app.component.wasm", - component_bytes: &component, - embedded_core_module: &wrong_core, - envelope, - } - .validate() - .expect_err("a core different from the declared component slice must fail"); - assert!(error.contains("do not equal")); - } - - #[test] - fn wasip2_artifact_rejects_a_length_declaration_outside_the_component() { - let component = [0x10, 0x20, 0x21, 0x30]; - let error = CertificateArtifact::Wasip2 { - file_name: "app.component.wasm", - component_bytes: &component, - embedded_core_module: &component[1..3], - envelope: crate::format::Wasip2ComponentEnvelopeDeclaration::from_lengths(1, 2, 2), - } - .validate() - .expect_err("a declaration whose lengths do not total the component must fail"); - assert!(error.contains("does not split")); - } -} - -/// Write the artifact-specific `cert/` package. `model_files` are the -/// `(path, content)` pairs from the reused `aver proof` Lean emission. The -/// checker-owned wall and build configuration are resolved from `wall_id`. -/// Any existing `cert/` directory is removed first so a reused output path -/// cannot retain files from an older package format. -/// -/// PRECONDITION: `model_files` must be the SAME emission `analysis` was -/// derived from. The renderers cite each certified export's model by the -/// qualified Lean name resolved from these files, and `analyze` already -/// declined every export whose name it could not resolve — so a mismatched -/// pair would leave a renderer with a citation the gate never approved. This -/// is checked here rather than assumed: a mismatch returns an error and no -/// package is written. -/// -/// `law_claims` are the universal law-claims the SAME emission recorded while -/// it wrote those theorems. They arrive as structure rather than being scanned -/// back out of `model_files`, so the package's `Laws.lean` and the manifest's -/// `laws` array cannot drift from what the emitter actually stated. -/// -/// The returned [`ProjectDeclines`] names every law-claim and every -/// plan-equals-source bridge the producer's defensive gates refused to declare, -/// with the reason, so the caller can say what it declined instead of losing it -/// silently. Neither kind of decline changes which exports are certified. -pub fn write_project( - out_dir: &Path, - artifact: CertificateArtifact<'_>, - analysis: &Analysis, - model_files: &[(String, String)], - law_claims: Vec, -) -> Result { - artifact.validate()?; - - // Enforce the model-file precondition BEFORE touching the output - // directory, so a mismatched call leaves any existing package intact. - let model_info = ModelInfo::from_files(model_files); - for c in &analysis.certs { - model_citation_gate(c, &model_info).map_err(|reason| { - format!( - "model files passed to write_project do not match the analysis: {reason}" - ) - })?; - } - - let cert_dir = out_dir.join("cert"); - match std::fs::remove_dir_all(&cert_dir) { - Ok(()) => {} - Err(error) if error.kind() == std::io::ErrorKind::NotFound => {} - Err(error) => return Err(format!("replace cert dir: {error}")), - } - std::fs::create_dir_all(&cert_dir).map_err(|e| format!("create cert dir: {e}"))?; - - // Copy the model files (AverCommon + .lean) verbatim. - let mut model_roots: Vec = Vec::new(); - for (path, content) in model_files { - if path == "lakefile.lean" || path == "lean-toolchain" { - continue; - } - write(&cert_dir, path, &sanitize_model_for_cert(content))?; - if let Some(stem) = path.strip_suffix(".lean") { - model_roots.push(model_root_from_stem(stem)?); - } - } - - let artifact_sha = { - let mut h = Sha256::new(); - h.update(artifact.delivered_bytes()); - hex(&h.finalize()) - }; - - write(&cert_dir, "Contracts.lean", &render_contracts(analysis))?; - write( - &cert_dir, - "Module.lean", - &render_module(analysis, artifact.file_name(), &artifact_sha), - )?; - // Checker-owned Lean sources are identified by `format.wall_id` and are - // materialized by the verifier. They are not duplicated in the package. - // Byte-derived host-role table for source-plan encoding. One module-wide - // value: every sym-plan encode example and artifact claim consumes it, so - // plan-supplied indices can never enter the encoder. - let host_table_lean = byte_derived_frag_host_table_lean(artifact.core_module_bytes())?; - // Struct-binding table for field projections: one module-wide value, - // unioned from the per-export (source plan, encoded plan) pairs the - // byte-exact gate already pinned. Like the host-role table, plan-supplied - // indices can never enter the encoder. - let struct_table_lean = emit_frag_struct_table_lean(analysis)?; - - write( - &cert_dir, - "Plans.lean", - &without_plan_examples(&render_expr_fragment_plans( - analysis, - &model_info, - &host_table_lean, - &struct_table_lean, - )), - )?; - write( - &cert_dir, - "Manifest.lean", - &render_manifest_lean( - analysis, - &model_roots, - &model_info, - &artifact_sha, - artifact.target(), - artifact.abi(), - ), - )?; - write( - &cert_dir, - "Certificate.lean", - &render_certificate(analysis, &model_roots, &model_info), - )?; - write( - &cert_dir, - "Final.lean", - &render_final(), - )?; - // Per-role arith host-table leaves, in their own compilation unit so their - // `decide +kernel` reductions do not stack onto `Artifact.lean`'s peak. - // Emitted only for a carriered module (the only kind with a table to split); - // `render_artifact` adds the matching `import ArtifactHostRoles` and the - // recombining proof when it is present. - if analysis.frag_host_table.box_idx.is_some() { - write( - &cert_dir, - "ArtifactHostRoles.lean", - &render_artifact_host_roles(analysis), - )?; - } - write( - &cert_dir, - "Artifact.lean", - &render_artifact( - analysis, - &model_info, - &host_table_lean, - &struct_table_lean, - artifact.wasip2_component_envelope(), - ), - )?; - write( - &cert_dir, - "ArtifactCertificate.lean", - &render_artifact_certificate(), - )?; - write( - &cert_dir, - "ArtifactSoundness.lean", - &render_artifact_soundness(), - )?; - // Plan-equals-source bridges: one theorem per record projection-compute - // export identifying the plan its obligation evaluates with the transpiled - // source function, plus the corollary that ties it to `Final.cert`. - let (bridge_plans, declined_source_bridges) = plan_source_bridges(analysis, &model_info); - let source_bridges: Vec = bridge_plans - .iter() - .map(|plan| plan.bridge.clone()) - .collect(); - if !bridge_plans.is_empty() { - write(&cert_dir, "Bridge.lean", &render_bridge_lean(&bridge_plans))?; - } - // Law-claims surface: the universal law theorems the model modules carry, - // each tied to the artifact by a `Laws.lean` corollary citing `Final.cert`, - // and to the source functions it mentions by their bridges when all of them - // have one. - let (law_claims, declined_law_claims) = admit_law_claims(law_claims); - let law_bridges: Vec> = law_claims - .iter() - .map(|claim| { - law_bridge_coverage(&claim.statement, &model_info, &source_bridges).unwrap_or_default() - }) - .collect(); - let law_bridge_terms: Vec> = law_bridges - .iter() - .map(|indices| { - indices - .iter() - .map(|index| { - ( - source_bridges[*index].corollary.clone(), - source_bridges[*index].statement(), - ) - }) - .collect() - }) - .collect(); - if !law_claims.is_empty() { - write( - &cert_dir, - "Laws.lean", - &render_laws_lean(&law_claims, &law_bridge_terms), - )?; - } - let law_bridge_exports: Vec> = law_bridges - .iter() - .map(|indices| { - indices - .iter() - .map(|index| source_bridges[*index].export.clone()) - .collect() - }) - .collect(); - std::fs::write( - cert_dir.join("cert-manifest.json"), - render_manifest( - analysis, - &model_info, - artifact.file_name(), - &artifact_sha, - artifact.target(), - artifact.abi(), - artifact.wasip2_component_envelope(), - &law_claims, - &law_bridge_exports, - &source_bridges, - &declined_source_bridges, - ), - ) - .map_err(|e| format!("write manifest: {e}"))?; - Ok(ProjectDeclines { - law_claims: declined_law_claims, - source_bridges: declined_source_bridges, - }) -} - -/// What the producer's defensive gates refused to declare, by surface. Each -/// entry is `(name, reason)`; the name is a law label or a certified export. -#[derive(Debug, Default)] -pub struct ProjectDeclines { - pub law_claims: Vec<(String, String)>, - pub source_bridges: Vec<(String, String)>, -} - -/// The Lean module name a model file is imported by. A module declared as -/// `Data.Fibonacci` transpiles to the file `Data/Fibonacci.lean`; the import -/// lines in `Manifest.lean` and `Certificate.lean` need the dotted form back -/// (`import Data/Fibonacci` is not Lean syntax). Every path segment must be a -/// plain identifier so a model path can never smuggle stray syntax into an -/// interpolated import line. -fn model_root_from_stem(stem: &str) -> Result { - let segments: Vec<&str> = stem.split('/').collect(); - let valid = segments.iter().all(|segment| { - let mut chars = segment.chars(); - matches!(chars.next(), Some(first) if first.is_ascii_alphabetic()) - && chars.all(|character| character.is_ascii_alphanumeric() || character == '_') - }); - if valid { - Ok(segments.join(".")) - } else { - Err(format!( - "model file stem `{stem}` is not a Lean module path (each segment must match ^[A-Za-z][A-Za-z0-9_]*$)" - )) - } -} - -/// The module-wide struct table rendered at emit time: the consistent union of -/// every projection cert's byte-pinned entries. -fn emit_frag_struct_table_lean(analysis: &Analysis) -> Result { - let mut entries: Vec<(String, u32)> = Vec::new(); - for c in &analysis.certs { - if let Cert::ExprFragment { - source_plan: Some(source_plan), - plan, - .. - } = c.inner() - { - let plan_entries = - expr_fragment_struct_table_entries(source_plan, plan).ok_or_else(|| { - format!("inconsistent struct bindings in `{}` fragment plan", c.name()) - })?; - entries.extend(plan_entries); - } - } - frag_struct_table_lean_from_entries(entries.iter()) -} - -/// Drop the anonymous `example` declarations from a rendered `Plans.lean`. -/// -/// `Plans.lean` carries two kinds of top-level declaration: the plan `def`s, -/// which `Manifest.lean`, `Artifact.lean` and `Certificate.lean` reference by -/// name and which acceptance therefore rests on, and `example`s that re-state -/// — through the same audited checkers, encoders, lowerers and byte slicer — -/// equalities the acceptance predicates already state themselves. The examples -/// are anonymous, so nothing can cite them; they were an early-failure signal -/// for the producer, never part of the verdict (see docs/certificate-format.md -/// section 2.2, "`Plans.lean` is not load-bearing"). -/// -/// They are also the package's elaboration cost. Each byte-slicer example -/// re-runs `exactFuncBindingForExport` over the whole module, and past roughly -/// a hundred kilobytes of wasm that exhausts Lean's per-declaration heartbeat -/// budget — `workflow_engine` built a package no verifier could check, failing -/// on eight `Plans.lean` timeouts while every predicate the verdict rests on -/// was fine. -/// -/// The filter is fail-safe toward KEEPING: a blank-line-separated block is -/// dropped only when it opens a top-level `example` and carries no other -/// top-level declaration, so a block this renderer does not expect survives -/// verbatim. -fn without_plan_examples(rendered: &str) -> String { - /// Top-level keywords whose declaration must never be dropped. - const KEEP: [&str; 9] = [ - "def ", - "abbrev ", - "theorem ", - "instance ", - "namespace ", - "end ", - "open ", - "import ", - "set_option ", - ]; - let mut kept: Vec<&str> = Vec::new(); - for block in rendered.split("\n\n") { - let opens_example = block - .lines() - .any(|line| line.starts_with("example ") || line.starts_with("example:")); - let carries_other = block - .lines() - .any(|line| KEEP.iter().any(|kw| line.starts_with(kw))); - if opens_example && !carries_other { - continue; - } - kept.push(block); - } - kept.join("\n\n") -} - -fn render_expr_fragment_plans( - analysis: &Analysis, - model_info: &ModelInfo, - host_table_lean: &str, - struct_table_lean: &str, -) -> String { - let mut s = String::new(); - s.push_str( - "-- Compiler-emitted source/fragment plans as Lean data.\n\ - -- This is the package's sole authoritative plan representation. The\n\ - -- checker-owned wall validates and lowers it against the actual artifact.\n\ - import Schema\n\ - import PlanCheck\n\n\ - import PlanLower\n\ - import PlanBytes\n\ - import WasmSlice\n\ - import ExprFragmentAccepted\n\ - import ArtifactBytes\n\ - import Module\n\ - import DeclaredEnvelopeAcceptTransport\n\n\ - set_option maxRecDepth 200000\n\n\ - namespace AverCert.Plans\n\ - open AverCert.Schema\n\n", - ); - let mut any = false; - for c in &analysis.certs { - let Cert::ExprFragment { - name, - carrier, - self_idx, - type_idx, - source_plan, - plan, - .. - } = c.inner() - else { - continue; - }; - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(plan, *carrier) - .expect("certified expr-fragment plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_expr_fragment_plan(plan, *carrier) - .map(|ops| render_ops_value(&ops)) - .expect("certified expr-fragment plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - let func_binding = format!( - "({{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry_bytes} }} : AverCert.WasmSlice.FuncBinding)" - ); - let sym_plan = expr_fragment_source_plan(source_plan, plan) - .map(|sym| { - format!( - "/-- Source-level `SymPlan` projection for `{name}`. Artifact-level\n\ - acceptance prefers this claim when the fragment has a direct\n\ - Aver-level meaning; the encoder below still binds it to `{name}Plan`. -/\n\ - def {name}SymPlan : SymRawPlan := {sym_plan}\n\n\ - /-- The audited Lean-side source-plan checker accepts `{name}`'s `SymPlan`. -/\n\ - example : AverCert.PlanCheck.checkSymRawPlan {name}SymPlan = true := rfl\n\n\ - /-- The audited Lean-side source encoder maps `{name}`'s `SymPlan`,\n\ - under the byte-derived host-role and struct tables, to the\n\ - representation plan that is bound to bytes below. -/\n\ - example : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan {host_table_lean} {struct_table_lean} {name}SymPlan =\n \ - some {name}Plan := rfl\n\n", - sym_plan = sym_plan_lean_value(&sym) - ) - }) - .unwrap_or_else(|| { - format!( - "-- `{name}` has no source-level `SymPlan` projection yet;\n\ - -- its current fragment uses representation-only nodes.\n\n" - ) - }); - any = true; - s.push_str(&format!( - "/-- Raw `expr-fragment-v1` plan for `{name}`. -/\n\ - def {name}Plan : ExprFragmentRawPlan := {plan_value}\n\n\ - {sym_plan}\ - /-- The audited Lean-side structural checker accepts `{name}`'s raw plan. -/\n\ - example : AverCert.PlanCheck.checkExprFragmentRawPlan {name}Plan = true := rfl\n\n\ - /-- The audited Lean-side canonical lowerer maps `{name}`'s raw plan\n\ - to the same instruction body emitted in `Module.lean`. -/\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerExprFragmentBody {carrier} {name}Plan := rfl\n\n\ - /-- The audited Lean-side byte lowerer maps `{name}`'s raw plan\n\ - to the exact canonical code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerExprFragmentCodeEntry {carrier} {name}Plan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The audited Lean-side Wasm slicer binds `{name}` to its function\n\ - index, type index and exact expected code-entry bytes. -/\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes} =\n \ - some {func_binding} := rfl\n\n\ - /-- The audited Lean-side expr-fragment acceptance predicate aggregates\n\ - plan checking, semantic lowering, byte lowering and byte-origin binding. -/\n\ - example : AverCert.ExprFragmentAccepted.accepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen\n \ - {export_name_bytes} {carrier} {name}Plan\n \ - {lowered_body}\n \ - {code_entry_bytes}\n \ - {func_binding} := by dsimp [AverCert.ExprFragmentAccepted.accepted]; exact ⟨rfl, rfl, rfl, rfl⟩\n\n", - plan_value = expr_fragment_plan_lean_value(plan), - sym_plan = sym_plan, - )); - // Stage-1 record scalar field read: the record's ordered scalar-leaf - // declaration as `Plans` data. The wall re-derives the same layout from - // the bytes and pins it by equality inside the checked record face; the - // obligation and face both read these defs, and the recognizer pin below - // documents that the encoded plan fires the record recognizer. - if let (Some(face), Some((_struct_idx, leaves))) = - (c.record_param_face(), c.record_decl()) - { - s.push_str(&format!( - "/-- The Plan record declaration for `{name}` as ordered scalar leaves. -/\n\ - def {name}RecordFields : List TypeDecl := {fields_value}\n\n\ - def {name}RecordDecl : TypeDecl := .record {struct_idx} {name}RecordFields\n\n\ - /-- The shared record-projection recognizer fires on `{name}`'s encoded plan. -/\n\ - example : AverCert.WasmSlice.exprRecordProjFace? {name}Plan = some ({struct_idx}, {field}) := rfl\n\n", - fields_value = record_leaves_lean_value(leaves), - struct_idx = face.struct_idx, - field = face.field_idx, - )); - } - if let Some(face) = c.record_compute_face() { - match c.record_decl() { - Some((_struct_idx, leaves)) => s.push_str(&format!( - "/-- The Plan record declaration for `{name}` as ordered scalar leaves. -/\n\ - def {name}RecordFields : List TypeDecl := {fields_value}\n\n\ - def {name}RecordDecl : TypeDecl := .record {struct_idx} {name}RecordFields\n\n", - fields_value = record_leaves_lean_value(leaves), - struct_idx = face.struct_idx, - )), - // A scalar-parameter compute plan names no record at all: the - // wall's declared face demands no type-section entry for it, - // and the empty list is the unused witness slot the guarded - // declaration conjunct still takes. - None => s.push_str(&format!( - "/-- `{name}` names no record; the declared face's declaration slot is empty. -/\n\ - def {name}RecordFields : List TypeDecl := []\n\n" - )), - } - } - } - for c in &analysis.certs { - let Cert::FieldProjection { - name, - self_idx, - type_idx, - carrier, - struct_idx, - field_count, - .. - } = c.inner() - else { - continue; - }; - let Some((plan, result_ty)) = field_projection_plan_from_cert(c) else { - continue; - }; - let code_entry = lower_field_projection_code_entry( - &plan, - *carrier, - *struct_idx, - result_ty, - ); - let code_entry = render_byte_list(&code_entry); - let result_ty_lean = field_projection_result_ty_lean_value(result_ty); - let export_name_bytes = render_byte_list(name.as_bytes()); - let binding = format!( - "({{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }} : AverCert.WasmSlice.FuncBinding)" - ); - any = true; - s.push_str(&format!( - "/-- Byte-origin plan for bare tuple/record projection `{name}`. -/\n\ - def {name}FieldProjectionPlan : FieldProjectionRawPlan := {plan_value}\n\n\ - example : AverCert.PlanCheck.checkFieldProjectionRawPlan {field_count} {name}FieldProjectionPlan = true := rfl\n\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerFieldProjectionBody {struct_idx} {field_count} {name}FieldProjectionPlan := rfl\n\n\ - example : AverCert.PlanBytes.lowerFieldProjectionCodeEntry {carrier} {struct_idx} {field_count} {result_ty_lean} {name}FieldProjectionPlan =\n \ - some {code_entry} := rfl\n\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} =\n \ - some {binding} := rfl\n\n\ - example : AverCert.WasmSlice.projectionStructTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {struct_idx} {field_count} {field_idx} {result_ty_lean} = true := rfl\n\n\ - example : AverCert.WasmSlice.projectionFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {type_idx} {struct_idx} {result_ty_lean} = true := rfl\n\n", - plan_value = field_projection_plan_lean_value(&plan), - field_idx = plan.field_idx, - )); - } - for c in &analysis.certs { - let Cert::AdtConstructor { - name, - self_idx, - type_idx, - carrier, - struct_idx, - elem_ty, - .. - } = c.inner() - else { - continue; - }; - let Some(sym_plan) = adt_constructor_sym_plan_from_cert(c, model_info) else { - continue; - }; - let Some(construct_plan) = construct_plan_from_cert(c) else { - continue; - }; - let Ok(code_entry_bytes) = - lower_construct_plan_code_entry_bytes(&construct_plan, *carrier, *struct_idx) - else { - continue; - }; - let lowered_body = lower_construct_plan(&construct_plan, *struct_idx) - .map(|ops| render_ops_value(&ops)) - .expect("checked construct plan lowers to WInstr body"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let export_name_bytes = render_byte_list(name.as_bytes()); - let elem_ty = construct_val_type_lean_value(*elem_ty) - .expect("certified constructor has a supported byte-level element type"); - let type_match_pins = if sym_plan_is_list_construct(&sym_plan) { - format!( - "/-- The byte-derived list struct binds `{name}`'s element representation. -/\n\ - theorem {name}ConstructStructTypeMatches :\n \ - AverCert.WasmSlice.listConstructStructTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {struct_idx} ({elem_ty}) = true := rfl\n\n\ - /-- The byte-derived exported signature binds `{name}`'s element representation. -/\n\ - theorem {name}ConstructFuncTypeMatches :\n \ - AverCert.WasmSlice.listConstructFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {type_idx} {name}ConstructPlan.arity {struct_idx} ({elem_ty}) = true := rfl\n\n" - ) - } else { - String::new() - }; - let func_binding = format!( - "({{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry_bytes} }} : AverCert.WasmSlice.FuncBinding)" - ); - any = true; - s.push_str(&format!( - "/-- Source-level constructor `SymPlan` for legacy ADT constructor `{name}`.\n\ - This says what source value is being constructed; the target-bound\n\ - `ConstructRawPlan` below pins the wasm-gc `struct.new` layout. -/\n\ - def {name}ConstructSymPlan : SymRawPlan := {sym_plan_value}\n\n\ - /-- Target-bound constructor witness for `{name}`. -/\n\ - def {name}ConstructPlan : ConstructRawPlan := {construct_plan_value}\n\n\ - /-- The audited Lean-side source-plan checker accepts `{name}`'s constructor plan. -/\n\ - example : AverCert.PlanCheck.checkSymRawPlan {name}ConstructSymPlan = true := rfl\n\n\ - /-- The audited Lean-side structural checker accepts `{name}`'s target constructor plan. -/\n\ - example : AverCert.PlanCheck.checkConstructRawPlan {name}ConstructPlan = true := rfl\n\n\ - /-- The audited Lean-side source/target matcher confirms that `{name}`'s\n\ - source constructor plan explains the byte-bound constructor witness. -/\n\ - example : AverCert.PlanCheck.constructPlanMatchesSymRawPlan\n \ - {name}ConstructSymPlan {name}ConstructPlan = true := rfl\n\n\ - /-- `construct` is not yet part of the v1 source-to-fragment encoder. -/\n\ - example : AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan {host_table_lean} {struct_table_lean} {name}ConstructSymPlan = none := rfl\n\n\ - /-- The audited Lean-side canonical lowerer maps `{name}`'s constructor plan\n\ - to the exact instruction body. -/\n\ - example : AverCert.PlanLower.lowerConstructBody {struct_idx} {name}ConstructPlan =\n \ - some {lowered_body} := rfl\n\n\ - /-- The audited Lean-side canonical lowerer maps `{name}`'s constructor plan\n\ - to the same instruction body emitted in `Module.lean`. -/\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerConstructBody {struct_idx} {name}ConstructPlan := rfl\n\n\ - /-- The audited Lean-side byte lowerer maps `{name}`'s constructor plan\n\ - to the exact canonical code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerConstructCodeEntry {carrier} {struct_idx} {name}ConstructPlan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The audited Lean-side Wasm slicer binds `{name}` to its function\n\ - index, type index and exact expected code-entry bytes. -/\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes} =\n \ - some {func_binding} := rfl\n\n\ - {type_match_pins}", - sym_plan_value = sym_plan_lean_value(&sym_plan), - construct_plan_value = construct_plan_lean_value(&construct_plan), - lowered_body = lowered_body, - )); - } - for c in &analysis.certs { - let Cert::StringConcatVerbatimMatch { - name, - self_idx, - type_idx, - carrier, - string_concat_idx, - container_ty, - result_ty, - .. - } = c.inner() - else { - continue; - }; - let plan = string_concat_plan_from_cert(c) - .expect("certified String.concat should project to a source plan"); - let sym_plan = string_concat_sym_plan_from_plan(&plan); - let code_entry_bytes = lower_string_concat_plan_code_entry_bytes( - &plan, - *carrier, - *result_ty, - *container_ty, - *string_concat_idx, - ) - .expect("certified String.concat plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let export_name_bytes = render_byte_list(name.as_bytes()); - let func_binding = format!( - "({{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry_bytes} }} : AverCert.WasmSlice.FuncBinding)" - ); - any = true; - s.push_str(&format!( - "/-- Source-level `SymPlan` view of `{name}`'s string concatenation. -/\n\ - def {name}StringConcatSymPlan : SymRawPlan := {sym_plan_value}\n\n\ - /-- Target-bound `string-concat-v1` encoder witness for `{name}`. -/\n\ - def {name}StringConcatPlan : StringConcatRawPlan := {plan_value}\n\n\ - /-- The audited Lean-side source-plan checker accepts `{name}`'s string `SymPlan`. -/\n\ - example : AverCert.PlanCheck.checkSymRawPlan {name}StringConcatSymPlan = true := rfl\n\n\ - /-- The audited Lean-side source/target matcher confirms that `{name}`'s\n\ - string `SymPlan` explains the byte-bound String.concat plan below. -/\n\ - example : AverCert.PlanCheck.stringConcatPlanMatchesSymRawPlan\n \ - {name}StringConcatSymPlan {name}StringConcatPlan = true := rfl\n\n\ - /-- The audited Lean-side structural checker accepts `{name}`'s String.concat plan. -/\n\ - example : AverCert.PlanCheck.checkStringConcatRawPlan {name}StringConcatPlan = true := rfl\n\n\ - /-- The audited Lean-side canonical lowerer maps `{name}`'s String.concat plan\n\ - to the same instruction body emitted in `Module.lean`. -/\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerStringConcatBody {result_ty} {container_ty} {string_concat_idx} {name}StringConcatPlan := rfl\n\n\ - /-- The audited Lean-side byte lowerer maps `{name}`'s String.concat plan\n\ - to the exact canonical code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerStringConcatCodeEntry {carrier_state} {result_ty} {container_ty} {string_concat_idx} {name}StringConcatPlan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The audited Lean-side Wasm slicer binds `{name}` to its function\n\ - index, type index and exact expected code-entry bytes. -/\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes} =\n \ - some {func_binding} := rfl\n\n\ - \n", - sym_plan_value = sym_plan_lean_value(&sym_plan), - plan_value = string_concat_plan_lean_value(&plan), - carrier_state = render_carrier_state(*carrier), - )); - } - // The carrier state is a property of the MODULE, not of an export, so its - // audit line is emitted once for the whole package rather than repeated - // identically per concatenation. Acceptance pins it per claim anyway - // (`stringConcatPlanAccepted`); this is the readable restatement. - if let Some(carrier) = analysis - .certs - .iter() - .find_map(|c| match c.inner() { - Cert::StringConcatVerbatimMatch { carrier, .. } => Some(*carrier), - _ => None, - }) - { - s.push_str(&format!( - "/-- The module's byte-derived carrier state: the value that selects the\n\ - locals prelude of every `string-concat-v1` code entry above.\n\ - Recomputed from the artifact bytes, so no claim can declare a\n\ - prelude the type section does not license. -/\n\ - example : CertDecode.carrierState AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen =\n \ - some {carrier_state} := rfl\n\n", - carrier_state = render_carrier_state(carrier), - )); - } - for c in &analysis.certs { - let Cert::StringEqVerbatimMatch { - name, - self_idx, - type_idx, - carrier, - string_eq_idx, - .. - } = c.inner() - else { - continue; - }; - let plan = string_eq_plan_from_cert(c) - .expect("certified String.eq should project to a source plan"); - let sym_plan = string_eq_sym_plan_from_plan(&plan); - let string_ty = - string_eq_string_ty_from_cert(c).expect("certified String.eq should use string arrays"); - let code_entry_bytes = - lower_string_eq_plan_code_entry_bytes(&plan, *carrier, string_ty, *string_eq_idx) - .expect("certified String.eq plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let export_name_bytes = render_byte_list(name.as_bytes()); - let func_binding = format!( - "({{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry_bytes} }} : AverCert.WasmSlice.FuncBinding)" - ); - any = true; - s.push_str(&format!( - "/-- Source-level `SymPlan` view of `{name}`'s String.eq dispatch. -/\n\ - def {name}StringEqSymPlan : SymRawPlan := {sym_plan_value}\n\n\ - /-- Target-bound `string-eq-v1` encoder witness for `{name}`. -/\n\ - def {name}StringEqPlan : StringEqRawPlan := {plan_value}\n\n\ - /-- The audited Lean-side source-plan checker accepts `{name}`'s String.eq `SymPlan`. -/\n\ - example : AverCert.PlanCheck.checkSymRawPlan {name}StringEqSymPlan = true := rfl\n\n\ - /-- The audited Lean-side source/target matcher confirms that `{name}`'s\n\ - string `SymPlan` explains the byte-bound String.eq plan below. -/\n\ - example : AverCert.PlanCheck.stringEqPlanMatchesSymRawPlan\n \ - {name}StringEqSymPlan {name}StringEqPlan = true := rfl\n\n\ - /-- The audited Lean-side structural checker accepts `{name}`'s String.eq plan. -/\n\ - example : AverCert.PlanCheck.checkStringEqRawPlan {name}StringEqPlan = true := rfl\n\n\ - /-- The audited Lean-side canonical lowerer maps `{name}`'s String.eq plan\n\ - to the same instruction body emitted in `Module.lean`. -/\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerStringEqBody {string_ty} {string_eq_idx} {name}StringEqPlan := rfl\n\n\ - /-- The audited Lean-side byte lowerer maps `{name}`'s String.eq plan\n\ - to the exact canonical code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerStringEqCodeEntry {carrier} {string_ty} {string_eq_idx} {name}StringEqPlan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The audited Lean-side Wasm slicer binds `{name}` to its function\n\ - index, type index and exact expected code-entry bytes. -/\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes} =\n \ - some {func_binding} := rfl\n\n\ - \n", - sym_plan_value = sym_plan_lean_value(&sym_plan), - plan_value = string_eq_plan_lean_value(&plan), - )); - } - for c in &analysis.certs { - let (name, self_idx, type_idx, carrier) = match c.inner() { - Cert::Recursive { - name, - self_idx, - type_idx, - carrier, - .. - } - | Cert::AccumulatorRecursive { - name, - self_idx, - type_idx, - carrier, - .. - } => (name, *self_idx, *type_idx, *carrier), - _ => continue, - }; - let Some(plan) = recursion_plan_from_cert(c) else { - continue; - }; - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(&plan, carrier) - .expect("certified recursion plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let export_name_bytes = render_byte_list(name.as_bytes()); - let func_binding = format!( - "({{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry_bytes} }} : AverCert.WasmSlice.FuncBinding)" - ); - let host_table = recursion_host_table_lean_value(c); - let totality_role = c.totality_role_lean_value(); - let wrong_totality_role = if c.requires_mul_totality() { - ".addSub" - } else { - ".mul" - }; - let arity = plan.params.len(); - any = true; - s.push_str(&format!( - "/-- Byte-derived `recursion-plan-v1` plan for `{name}` (fuel-recursive). -/\n\ - def {name}RecursionPlan : RecursionRawPlan := {plan_value}\n\n\ - /-- The audited recursion-plan checker accepts `{name}`'s byte-derived plan. -/\n\ - example : AverCert.PlanCheck.checkRecursionRawPlan {name}RecursionPlan = true := rfl\n\n\ - /-- The context-sensitive recursion grammar accepts `{name}`'s plan: the\n\ - self-call targets the export's own byte-derived function index and every\n\ - host call cites the byte-derived role table. -/\n\ - example : AverCert.PlanCheck.checkRecursionPlanShape {self_idx} {host_table} {totality_role} {name}RecursionPlan = true := rfl\n\n\ - /-- The opposite totality role is rejected by the same byte-pinned grammar. -/\n\ - example : AverCert.PlanCheck.checkRecursionPlanShape {self_idx} {host_table} {wrong_totality_role} {name}RecursionPlan = false := rfl\n\n\ - /-- The declared function type of `{name}` is the canonical certified\n\ - signature over the Int carrier. -/\n\ - example : AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {type_idx} {arity} {carrier} = true := rfl\n\n\ - /-- The audited recursion lowerer maps `{name}`'s plan to the exact `Module.lean` body. -/\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerRecursionBody {carrier} {name}RecursionPlan := rfl\n\n\ - /-- The audited recursion byte lowerer reproduces `{name}`'s exact code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerRecursionCodeEntry {carrier} {name}RecursionPlan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The Wasm slicer finds `{name}`'s exact code-entry bytes by export name. -/\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes} =\n \ - some {func_binding} := rfl\n\n", - plan_value = recursion_plan_lean_value(&plan), - )); - } - for c in &analysis.certs { - let Cert::MutualRecursion { - name, - self_idx, - carrier, - box_idx, - sub_idx, - position, - scc, - } = c.inner() - else { - continue; - }; - let Some(plan) = mutual_plan_from_cert(c) else { - continue; - }; - let member = &scc[*position]; - let type_idx = member.type_idx; - let primary = &scc[0].name; - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(&plan, *carrier) - .expect("certified mutual member plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let export_name_bytes = render_byte_list(name.as_bytes()); - let func_binding = format!( - "({{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry_bytes} }} : AverCert.WasmSlice.FuncBinding)" - ); - let host_table = mutual_host_table_lean_value(*box_idx, *sub_idx); - let member_set = mutual_member_set_lean_value(scc); - any = true; - s.push_str(&format!( - "/-- Byte-derived `mutual-plan-v1` plan for `{name}` (one member of the\n\ - mutually-recursive SCC whose shared code table `{primary}Code` emits). -/\n\ - def {name}MutualPlan : MutualRawPlan := {plan_value}\n\n\ - /-- The audited mutual-plan checker accepts `{name}`'s byte-derived plan. -/\n\ - example : AverCert.PlanCheck.checkMutualRawPlan {name}MutualPlan = true := rfl\n\n\ - /-- The context-sensitive mutual grammar accepts `{name}`'s plan: the\n\ - member-call targets an index in the byte-derived SCC member set and every\n\ - host call cites the byte-derived box/sub role table. -/\n\ - example : AverCert.PlanCheck.checkMutualPlanShape {member_set} {host_table} {name}MutualPlan = true := rfl\n\n\ - /-- The declared function type of `{name}` is the canonical certified\n\ - signature over the Int carrier. -/\n\ - example : AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {type_idx} 1 {carrier} = true := rfl\n\n\ - /-- The audited mutual lowerer maps `{name}`'s plan to its arm of the shared\n\ - `{primary}Code` table (the exact `Module.lean` body). -/\n\ - example : (CertModule.{primary}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerMutualBody {carrier} {name}MutualPlan := rfl\n\n\ - /-- The audited mutual byte lowerer reproduces `{name}`'s exact code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerMutualCodeEntry {carrier} {name}MutualPlan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The Wasm slicer finds `{name}`'s exact code-entry bytes by export name. -/\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes} =\n \ - some {func_binding} := rfl\n\n", - plan_value = mutual_plan_lean_value(&plan), - )); - } - for c in &analysis.certs { - let (name, self_idx, carrier) = match c.inner() { - Cert::VerbatimWidenedMatch { - name, - self_idx, - carrier, - .. - } - | Cert::VerbatimVariantDispatch { - name, - self_idx, - carrier, - .. - } => (name, *self_idx, *carrier), - _ => continue, - }; - let Some(plan) = verbatim_plan_from_cert(c) else { - continue; - }; - let code_entry_bytes = render_byte_list(&lower_verbatim_code_entry(&plan, carrier)); - let export_name_bytes = render_byte_list(name.as_bytes()); - let nlocals = if verbatim_dispatch_has_projection(&plan.body) { - 3 - } else { - 2 - }; - any = true; - s.push_str(&format!( - "/-- Byte-derived `verbatim-plan-v1` plan for `{name}` (a `Cod := WVal`\n\ - verbatim `ref.test`-dispatch match; no host, no representation). -/\n\ - def {name}VerbatimPlan : VerbatimRawPlan := {plan_value}\n\n\ - /-- The audited verbatim-plan admission checker accepts `{name}`'s\n\ - byte-derived plan with its canonical local count. -/\n\ - example : AverCert.PlanCheck.checkVerbatimPlan {nlocals} {name}VerbatimPlan = true := rfl\n\n\ - /-- The audited verbatim lowerer maps `{name}`'s plan to the exact `Module.lean` body. -/\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - some (AverCert.PlanLower.lowerVerbatimBody {name}VerbatimPlan) := rfl\n\n\ - /-- The audited verbatim byte lowerer reproduces `{name}`'s exact code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerVerbatimCodeEntry {carrier} {name}VerbatimPlan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The Wasm slicer finds `{name}`'s export binding with the exact code-entry bytes. -/\n\ - example : (AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes}).isSome = true := rfl\n\n", - plan_value = verbatim_plan_lean_value(&plan), - )); - } - for c in &analysis.certs { - let (name, self_idx, carrier) = match c.inner() { - Cert::VariantDispatch { - name, - self_idx, - carrier, - .. - } - | Cert::WidenedIntMatch { - name, - self_idx, - carrier, - .. - } => (name, *self_idx, *carrier), - _ => continue, - }; - let Some(plan) = int_dispatch_plan_from_cert(c, analysis.frag_host_table) else { - continue; - }; - let hosts = int_dispatch_host_table_from_cert(c) - .expect("Int-face dispatch cert carries its host table"); - let code_entry_bytes = render_byte_list( - &lower_int_dispatch_code_entry(&plan, carrier, &hosts) - .expect("certified Int-face dispatch plan lowers to code-entry bytes"), - ); - let export_name_bytes = render_byte_list(name.as_bytes()); - let host_table = int_dispatch_host_table_lean_value(&hosts); - any = true; - s.push_str(&format!( - "/-- Byte-derived `int-dispatch-v1` plan for `{name}` (a `Cod := Int`\n\ - ADT-match; host helpers are cited by ROLE — the byte-derived role\n\ - table below parameterizes the lowerers, so the plan carries no\n\ - function index). -/\n\ - def {name}IntDispatchPlan : IntDispatchRawPlan := {plan_value}\n\n\ - /-- The audited int-dispatch checker accepts `{name}`'s byte-derived plan. -/\n\ - example : AverCert.PlanCheck.checkIntDispatchRawPlan {name}IntDispatchPlan = true := rfl\n\n\ - /-- The byte-derived role table maps roles to pairwise distinct indices\n\ - (so the byte-equality gate distinguishes an arm's role). -/\n\ - example : AverCert.PlanCheck.hostTableIndicesDistinct {host_table} = true := rfl\n\n\ - /-- The audited int-dispatch lowerer maps `{name}`'s plan to the exact `Module.lean` body. -/\n\ - example : (CertModule.{name}Code {self_idx}).map (fun c => c.body) =\n \ - AverCert.PlanLower.lowerIntDispatchBody {host_table} {name}IntDispatchPlan := rfl\n\n\ - /-- The audited int-dispatch byte lowerer reproduces `{name}`'s exact code-entry bytes. -/\n\ - example : AverCert.PlanBytes.lowerIntDispatchCodeEntry {carrier} {host_table} {name}IntDispatchPlan =\n \ - some {code_entry_bytes} := rfl\n\n\ - /-- The Wasm slicer finds `{name}`'s export binding with the exact code-entry bytes. -/\n\ - example : (AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry_bytes}).isSome = true := rfl\n\n", - plan_value = int_dispatch_plan_lean_value(&plan), - )); - } - for (entry, plan) in composition_member_plans(analysis) { - let Cert::Composition { carrier, closure, .. } = analysis - .certs - .iter() - .find(|cert| match cert.inner() { - Cert::Composition { closure, .. } => { - closure.iter().any(|candidate| candidate.name == entry.name) - } - _ => false, - }) - .expect("composition member belongs to a composition cert") - .inner() - else { - unreachable!() - }; - let add_idx = analysis - .frag_host_table - .add_idx - .expect("plan-backed composition has strict add host"); - let funcs = composition_func_table(closure); - let lowered = lower_composition_plan(&plan, add_idx, &funcs) - .expect("composition member plan lowers"); - let code_entry = composition_code_entry_bytes(&plan, *carrier, add_idx, &funcs) - .expect("composition member plan byte-lowers"); - let host_table = composition_host_table_lean_value(add_idx); - let func_table = composition_func_table_lean_value(closure); - let export_name_bytes = render_byte_list(entry.name.as_bytes()); - let binding = format!( - "({{ funcIdx := {}, typeIdx := {}, codeEntry := {} }} : AverCert.WasmSlice.FuncBinding)", - entry.self_idx, - entry.type_idx, - render_byte_list(&code_entry), - ); - any = true; - s.push_str(&format!( - "/-- Byte-derived composition shape for `{name}`. Callees are named;\n\ - numeric indices come from the byte-derived function table. -/\n\ - def {name}CompositionPlan : CompositionRawPlan := {plan_value}\n\n\ - example : AverCert.PlanCheck.checkCompositionRawPlan {name}CompositionPlan = true := rfl\n\n\ - example : AverCert.PlanLower.lowerCompositionBody {host_table} {func_table} {name}CompositionPlan =\n \ - some {body} := rfl\n\n\ - example : AverCert.PlanBytes.lowerCompositionCodeEntry {carrier} {host_table} {func_table} {name}CompositionPlan =\n \ - some {code_entry} := rfl\n\n\ - example : AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} =\n \ - some {binding} := rfl\n\n", - name = entry.name, - plan_value = composition_plan_lean_value(&plan), - body = render_ops_value(&lowered), - code_entry = render_byte_list(&code_entry), - binding = binding, - )); - } - for c in &analysis.certs { - let Some(envelope) = declared_envelope_for_cert(c, model_info, analysis) else { - continue; - }; - any = true; - s.push_str(&format!( - "/-- Declared ADT envelope for `{name}`: root, carrier and every constructor's\n\ - flattened type index, shape and payload target. The wall confirms the whole\n\ - declaration against the module bytes with one type-section walk-match\n\ - traversal (`DeclaredIndexEnvelope.dWalkPinned`). -/\n\ - def {name}DeclaredEnvelope : AverCert.DeclaredIndexEnvelope.DIdxEnvelope :=\n \ - {env}\n\n\ - /-- Opaque declared type-section bytes before `{name}`'s constructor entries. -/\n\ - def {name}TypePrefix : List Nat :=\n \ - {prefix}\n\n", - name = c.name(), - env = envelope.lean_env(), - prefix = envelope.lean_prefix(), - )); - } - if analysis.certs.iter().any(|c| { - declared_envelope_for_cert(c, model_info, analysis).is_some() - || matches!(c.inner(), Cert::StringConcatVerbatimMatch { .. }) - }) { - any = true; - s.push_str( - "/-- Located type-section entry cursor: the section payload found by\n\ - `modulePayload 1`, advanced past the vector-count LEB. A framing\n\ - locate only — no type entry is parsed. -/\n\ - def declaredTypeCur : Nat × Nat :=\n \ - (AverCert.DeclaredIndexEnvelope.typeSectionCursor AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen).getD (0, 0)\n\n", - ); - } - if !any { - s.push_str("-- This artifact contains no source/fragment plans.\n\n"); - } - s.push_str("end AverCert.Plans\n"); - s -} - -/// The declared envelope backing a user-ADT claim, when the certificate must -/// carry one: Int-face dispatch (keyed by the first tested variant) and -/// model-bearing named-ADT constructors (keyed by the constructed variant). -/// Analysis keeps only certs whose envelope is extractable, so a `None` here -/// means the cert simply carries no envelope. -fn declared_envelope_for_cert<'a>( - c: &Cert, - model_info: &ModelInfo, - analysis: &'a Analysis, -) -> Option<&'a DeclaredEnvelope> { - match c.inner() { - Cert::VariantDispatch { .. } | Cert::WidenedIntMatch { .. } => { - let plan = int_dispatch_plan_from_cert(c, analysis.frag_host_table)?; - let first = int_dispatch_test_tags(&plan.body).first().copied()?; - analysis.declared_envelopes.for_ctor(first) - } - Cert::AdtConstructor { struct_idx, .. } - if adt_constructor_uses_model(c, model_info) => - { - analysis.declared_envelopes.for_ctor(*struct_idx) - } - _ => None, - } -} - -struct RenderedArtifactClaims { - sym_claims: String, - string_eq_claims: String, - string_claims: String, - construct_claims: String, - recursion_claims: String, - mutual_claims: String, - verbatim_claims: String, - int_dispatch_claims: String, - field_projection_claims: String, - composition_members: String, - composition_claims: String, - claim_proof_bundles: String, - obligation_proof: String, - sym_proof: String, - string_eq_proof: String, - string_proof: String, - construct_proof: String, - recursion_proof: String, - mutual_proof: String, - verbatim_proof: String, - int_dispatch_proof: String, - field_projection_proof: String, - composition_proof: String, - string_concat_face_proof: String, - construct_face_proof: String, - int_dispatch_face_proof: String, - /// Aggregate proof of the `sym` family's `symFragmentMatches` face slot. Only - /// meaningful when `sym_faces_have_record` is set; otherwise the slot keeps - /// its inline `repeat' constructor` and this stays empty. - sym_face_proof: String, - /// Whether any `sym` claim carries a record-parameter face, so the face slot - /// must route through `sym_face_proof` instead of `repeat' constructor`. - sym_faces_have_record: bool, -} - -/// Render one opaque declared-envelope face theorem per claim plus the -/// aggregate spine `standardFacesChecked` consumes for the family slot. -/// `None` elements are known-face claims closed inline by `repeat' constructor`. -fn render_face_bundles( - family: &str, - face_def: &str, - claims_def: &str, - extra_unfolds: &str, - host_table_conj: bool, - elements: &[Option<(String, String, String)>], -) -> (String, String) { - let mut theorems = String::new(); - let mut parts = Vec::with_capacity(elements.len()); - for (index, element) in elements.iter().enumerate() { - match element { - Some((element_face, plan_ref, proof)) => { - let face_def = if element_face.is_empty() { - face_def - } else { - element_face.as_str() - }; - let theorem = format!("{family}Claim{index}Face"); - theorems.push_str(&format!( - "theorem {theorem} :\n \ - AverCert.StandardFace.{face_def} AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen ({claims_def}.get ⟨{index}, by decide⟩) {plan_ref} := by\n \ - dsimp [{claims_def}, AverCert.StandardFace.{face_def}{extra_unfolds}]\n \ - exact {proof}\n\n" - )); - if host_table_conj { - parts.push(format!("⟨rfl, {theorem}⟩")); - } else { - parts.push(theorem); - } - } - None => parts.push("(by repeat' constructor)".to_string()), - } - } - let aggregate = parts - .into_iter() - .rev() - .fold("trivial".to_string(), |rest, part| { - format!("⟨{part}, {rest}⟩") - }); - (theorems, aggregate) -} - -/// Render, per claim, the SPLIT acceptance proof: `per_claim(index)` supplies -/// the already-numbered witness `def`s and per-conjunct leaf theorems as one -/// text block plus the aggregate proof term that combines those constants. The -/// aggregate `{family}Claim{index}Accepted` theorem is stated exactly like the -/// opaque tuple it replaces — it indexes the same family -/// list and `dsimp`s the same predicate — but -/// its `exact` references the leaf constants instead of inlining one monolithic -/// witness tuple. -/// -/// This is the mechanism the expr-fragment beachhead established generalized to -/// the other data-carrying families: emitting the heavy `WInstr` body, the -/// code-entry bytes, and the function binding as their OWN top-level `def`s (so -/// no large literal is duplicated into the aggregate term) and each acceptance -/// conjunct that walks the module bytes as its OWN leaf theorem means every -/// `addDecl` completes and frees before the next is elaborated. The per-claim -/// kernel peak becomes the largest single leaf (a `modBytes` type-section walk) -/// rather than the whole witness tuple held live at once. The leaf conjuncts are -/// stated over the encoded plan `def` the aggregate reduces to, so the -/// aggregate re-runs no byte-decode or lowering work. -fn render_split_bundles( - family: &str, - predicate: &str, - claims_def: &str, - unfolds: &str, - count: usize, - per_claim: impl Fn(usize) -> (String, String), -) -> (String, String) { - let mut theorems = String::new(); - let mut names = Vec::with_capacity(count); - for index in 0..count { - let (declarations, aggregate_proof) = per_claim(index); - let accepted = format!("{family}Claim{index}Accepted"); - theorems.push_str(&declarations); - theorems.push_str(&format!( - "theorem {accepted} :\n {predicate} ({claims_def}.get ⟨{index}, by decide⟩) := by\n dsimp [{claims_def}, {unfolds}]\n exact {aggregate_proof}\n\n" - )); - names.push(accepted); - } - let aggregate = names - .into_iter() - .rev() - .fold("trivial".to_string(), |rest, theorem| { - format!("⟨{theorem}, {rest}⟩") - }); - (theorems, aggregate) -} - -/// Structured inputs for one expr-fragment (`sym`) claim's split acceptance -/// proof. The heavy witness data (lowered body, code-entry bytes, function -/// binding) and each acceptance conjunct are emitted as their OWN top-level -/// declarations by `render_sym_claim_bundles`. -struct SymClaimParts { - name: String, - lowered_body: String, - code_entry_bytes: String, - export_name_bytes: String, - self_idx: u32, - type_idx: u32, - carrier: u32, -} - -/// Render, per `sym` claim, named data `def`s + per-conjunct leaf theorems + -/// the aggregate `symFragmentClaim{i}Accepted` theorem that combines the -/// already-checked constants. -/// -/// The former shape emitted ONE theorem per claim whose proof was -/// `dsimp [...]; exact ⟨…giant nested tuple…⟩`. A `theorem` submits its entire -/// proof term to the kernel in a single `addDecl`, so the whole witness tuple -/// (the large `WInstr` body list, the code-entry bytes, the binding record, and -/// every conjunct's `isDefEq`) was held live at once — the affine verify peaked -/// at ~6.7 GB there. Splitting the data into `def`s and each conjunct into its -/// own `theorem` means every `addDecl` completes and frees before the next is -/// elaborated, so the per-claim peak becomes the largest single leaf (the -/// `modBytes` decode / type-section walks, each measured ≤ ~1.24 GB) rather -/// than the whole tuple. The aggregate then only references the constants, so -/// its own `exact` re-runs no heavy reduction: the encoded plan the conjuncts -/// are stated over is `AverCert.Plans.{name}Plan`, definitionally the value the -/// aggregate's `dsimp` computes, so unifying them is a structural plan compare, -/// not a byte-carrier walk. -/// -/// Every data-carrying claim family is split this way; this sym builder and the -/// generic `render_split_bundles` below share the same leaf-plus-aggregate shape. -fn render_sym_claim_bundles( - parts: &[SymClaimParts], - host_table_lean: &str, - struct_table_lean: &str, -) -> (String, String) { - let mut theorems = String::new(); - let mut names = Vec::with_capacity(parts.len()); - for (index, part) in parts.iter().enumerate() { - let SymClaimParts { - name, - lowered_body, - code_entry_bytes, - export_name_bytes, - self_idx, - type_idx, - carrier, - } = part; - let body = format!("symFragmentClaim{index}Body"); - let code_entry = format!("symFragmentClaim{index}CodeEntry"); - let binding = format!("symFragmentClaim{index}Binding"); - let export_name = lean_str(name); - let encoded_plan = format!("symFragmentClaim{index}EncodedPlan"); - let carrier_bound = format!("symFragmentClaim{index}CarrierBound"); - let host_types = format!("symFragmentClaim{index}HostTableFuncTypes"); - let check_plan = format!("symFragmentClaim{index}CheckPlan"); - let lower_body = format!("symFragmentClaim{index}LowerBody"); - let lower_code = format!("symFragmentClaim{index}LowerCodeEntry"); - let func_binding = format!("symFragmentClaim{index}FuncBinding"); - let func_type = format!("symFragmentClaim{index}FuncTypeMatches"); - let nominal = format!("symFragmentClaim{index}NominalTypes"); - let accepted = format!("symFragmentClaim{index}Accepted"); - let plan = format!("AverCert.Plans.{name}Plan"); - theorems.push_str(&format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct. Each is checked and freed in\n\ - -- its own `addDecl`; the heavy ones are the `modBytes` type-section walks\n\ - -- and the function-binding decode.\n\ - -- Pin the symbolic encoding before transporting byte-derived leaf proofs.\n\ - -- A mismatched role table must fail here, without comparing byte decoders.\n\ - theorem {encoded_plan} :\n \ - AverCert.PlanCheck.encodeSymRawPlanToExprFragmentRawPlan {host_table_lean} {struct_table_lean} AverCert.Plans.{name}SymPlan = some {plan} := by\n \ - rfl\n\n\ - theorem {carrier_bound} :\n \ - AverCert.AcceptedArtifact.symFragmentCarrierBound AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table_lean} {plan} = true := by\n \ - rfl\n\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table_lean} = true := by\n \ - rfl\n\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkExprFragmentRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerExprFragmentBody {carrier} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerExprFragmentCodeEntry {carrier} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.exprFragmentFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {carrier} {plan}.params {plan}.result = true := by\n \ - rfl\n\n\ - theorem {nominal} :\n \ - AverCert.WasmSlice.exprFragmentNominalTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {carrier} {plan} = true := by\n \ - rfl\n\n\ - -- Aggregate: combine the already-checked leaf constants. `dsimp` only\n\ - -- prepares the goal shape; the `exact` holds no heavy reduction.\n\ - theorem {accepted} :\n \ - AverCert.AcceptedArtifact.symFragmentClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen (symFragmentClaims.get ⟨{index}, by decide⟩) := by\n \ - change AverCert.AcceptedArtifact.symFragmentPlanAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {export_name} {carrier} {host_table_lean} {struct_table_lean} AverCert.Plans.{name}SymPlan AverCert.{name}Ob\n \ - dsimp only [AverCert.AcceptedArtifact.symFragmentPlanAccepted]\n \ - rw [{encoded_plan}]\n \ - dsimp [symFragmentClaims, AverCert.AcceptedArtifact.exprFragmentPlanAccepted, AverCert.ExprFragmentAccepted.accepted]\n \ - exact ⟨{carrier_bound}, {host_types}, rfl, rfl, ⟨{body}, {code_entry}, {binding}, ⟨⟨{check_plan}, {lower_body}, {lower_code}, {func_binding}⟩, {func_type}, {nominal}, rfl, rfl⟩⟩⟩\n\n" - )); - names.push(accepted); - } - let aggregate = names - .into_iter() - .rev() - .fold("trivial".to_string(), |rest, theorem| { - format!("⟨{theorem}, {rest}⟩") - }); - (theorems, aggregate) -} - -/// Structured inputs for one fuel-recursion claim's split acceptance proof. -struct RecursionParts { - name: String, - lowered_body: String, - code_entry_bytes: String, - export_name_bytes: String, - host_table: String, - self_idx: u32, - type_idx: u32, - carrier: u32, -} - -/// Split the fuel-recursion family exactly as `render_sym_claim_bundles` splits -/// the expr-fragment family: the lowered body, code-entry bytes and function -/// binding become named `def`s, each byte-walking conjunct of -/// `recursionPlanAccepted` becomes its own leaf theorem over -/// `AverCert.Plans.{name}RecursionPlan`, and the aggregate combines them. -fn render_recursion_claim_bundles(parts: &[RecursionParts]) -> (String, String) { - render_split_bundles( - "recursion", - "AverCert.AcceptedArtifact.recursionClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "recursionClaims", - "AverCert.AcceptedArtifact.recursionClaimAccepted, AverCert.AcceptedArtifact.recursionPlanForExport, AverCert.AcceptedArtifact.recursionPlanAccepted", - parts.len(), - |index| { - let RecursionParts { - name, - lowered_body, - code_entry_bytes, - export_name_bytes, - host_table, - self_idx, - type_idx, - carrier, - } = &parts[index]; - let body = format!("recursionClaim{index}Body"); - let code_entry = format!("recursionClaim{index}CodeEntry"); - let binding = format!("recursionClaim{index}Binding"); - let check_plan = format!("recursionClaim{index}CheckPlan"); - let lower_body = format!("recursionClaim{index}LowerBody"); - let lower_code = format!("recursionClaim{index}LowerCode"); - let func_binding = format!("recursionClaim{index}FuncBinding"); - let check_shape = format!("recursionClaim{index}CheckShape"); - let func_type = format!("recursionClaim{index}FuncType"); - let host_types = format!("recursionClaim{index}HostTypes"); - let plan = format!("AverCert.Plans.{name}RecursionPlan"); - let obligation = format!("AverCert.{name}Ob"); - let declarations = format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy ones are the\n\ - -- `modBytes` binding decode and type-section walks.\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkRecursionRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerRecursionBody {carrier} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerRecursionCodeEntry {carrier} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {check_shape} :\n \ - AverCert.PlanCheck.checkRecursionPlanShape {binding}.funcIdx {host_table} {obligation}.totalityRole {plan} = true := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {plan}.params.length {carrier} = true := by\n \ - rfl\n\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table} = true := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, rfl, {check_plan}, rfl, ⟨{body}, {code_entry}, {binding}, ⟨{lower_body}, {lower_code}, {func_binding}, rfl, {check_shape}, {func_type}, {host_types}, rfl⟩⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// Structured inputs for one mutual-recursion member claim's split proof. -struct MutualParts { - name: String, - lowered_body: String, - code_entry_bytes: String, - export_name_bytes: String, - host_table: String, - member_set: String, - self_idx: u32, - type_idx: u32, - carrier: u32, -} - -/// Split the mutual-recursion family the same way as the fuel-recursion family. -fn render_mutual_claim_bundles(parts: &[MutualParts]) -> (String, String) { - render_split_bundles( - "mutual", - "AverCert.AcceptedArtifact.mutualRecursionClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "mutualRecursionClaims", - "AverCert.AcceptedArtifact.mutualRecursionClaimAccepted, AverCert.AcceptedArtifact.mutualPlanForExport, AverCert.AcceptedArtifact.mutualPlanAccepted", - parts.len(), - |index| { - let MutualParts { - name, - lowered_body, - code_entry_bytes, - export_name_bytes, - host_table, - member_set, - self_idx, - type_idx, - carrier, - } = &parts[index]; - let body = format!("mutualClaim{index}Body"); - let code_entry = format!("mutualClaim{index}CodeEntry"); - let binding = format!("mutualClaim{index}Binding"); - let check_plan = format!("mutualClaim{index}CheckPlan"); - let lower_body = format!("mutualClaim{index}LowerBody"); - let lower_code = format!("mutualClaim{index}LowerCode"); - let func_binding = format!("mutualClaim{index}FuncBinding"); - let check_shape = format!("mutualClaim{index}CheckShape"); - let func_type = format!("mutualClaim{index}FuncType"); - let host_types = format!("mutualClaim{index}HostTypes"); - let plan = format!("AverCert.Plans.{name}MutualPlan"); - let declarations = format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy ones are the\n\ - -- `modBytes` binding decode and type-section walks.\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkMutualRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerMutualBody {carrier} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerMutualCodeEntry {carrier} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {check_shape} :\n \ - AverCert.PlanCheck.checkMutualPlanShape {member_set} {host_table} {plan} = true := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {plan}.params.length {carrier} = true := by\n \ - rfl\n\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table} = true := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, rfl, rfl, {check_plan}, rfl, ⟨{body}, {code_entry}, {binding}, ⟨{lower_body}, {lower_code}, {func_binding}, rfl, {check_shape}, {func_type}, {host_types}, rfl⟩⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// Structured inputs for one String.concat claim's split acceptance proof. -struct StringConcatParts { - name: String, - lowered_body: String, - code_entry_bytes: String, - export_name_bytes: String, - carrier_state: String, - result_ty: u32, - container_ty: u32, - concat_func_idx: u32, - self_idx: u32, - type_idx: u32, -} - -/// Split the String.concat family. Beyond the shared body/code-entry/binding -/// data, the heavy conjuncts are the carrier-state decode and the function -/// binding decode, both `modBytes` walks; the plan/sym checks and the two -/// lowerings are leaves stated over `Plans.{name}StringConcat{Sym}Plan`. -fn render_string_concat_claim_bundles(parts: &[StringConcatParts]) -> (String, String) { - render_split_bundles( - "stringConcat", - "AverCert.AcceptedArtifact.stringConcatClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "stringConcatClaims", - "AverCert.AcceptedArtifact.stringConcatClaimAccepted, AverCert.AcceptedArtifact.stringConcatPlanForExport, AverCert.AcceptedArtifact.stringConcatPlanAccepted, AverCert.AcceptedArtifact.stringConcatCanonicalHost", - parts.len(), - |index| { - let StringConcatParts { - name, - lowered_body, - code_entry_bytes, - export_name_bytes, - carrier_state, - result_ty, - container_ty, - concat_func_idx, - self_idx, - type_idx, - } = &parts[index]; - let body = format!("stringConcatClaim{index}Body"); - let code_entry = format!("stringConcatClaim{index}CodeEntry"); - let binding = format!("stringConcatClaim{index}Binding"); - let carrier_dec = format!("stringConcatClaim{index}CarrierState"); - let check_sym = format!("stringConcatClaim{index}CheckSym"); - let match_sym = format!("stringConcatClaim{index}MatchSym"); - let check_plan = format!("stringConcatClaim{index}CheckPlan"); - let lower_body = format!("stringConcatClaim{index}LowerBody"); - let lower_code = format!("stringConcatClaim{index}LowerCode"); - let func_binding = format!("stringConcatClaim{index}FuncBinding"); - let export_func_type = format!("stringConcatClaim{index}ExportFuncType"); - let helper_func_type = format!("stringConcatClaim{index}HelperFuncType"); - let sym_plan = format!("AverCert.Plans.{name}StringConcatSymPlan"); - let plan = format!("AverCert.Plans.{name}StringConcatPlan"); - let declarations = format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy ones are the\n\ - -- `modBytes` carrier-state decode and the binding decode.\n\ - theorem {carrier_dec} :\n \ - CertDecode.carrierState AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen = some {carrier_state} := by\n \ - rfl\n\n\ - theorem {check_sym} :\n \ - AverCert.PlanCheck.checkSymRawPlan {sym_plan} = true := by\n \ - rfl\n\n\ - theorem {match_sym} :\n \ - AverCert.PlanCheck.stringConcatPlanMatchesSymRawPlan {sym_plan} {plan} = true := by\n \ - rfl\n\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkStringConcatRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerStringConcatBody {result_ty} {container_ty} {concat_func_idx} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerStringConcatCodeEntry {carrier_state} {result_ty} {container_ty} {concat_func_idx} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {export_func_type} :\n \ - AverCert.WasmSlice.stringConcatExportFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {result_ty} = true := by\n \ - rfl\n\n\ - theorem {helper_func_type} :\n \ - AverCert.WasmSlice.stringConcatHelperFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {concat_func_idx} {container_ty} {result_ty} = true := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, {carrier_dec}, rfl, rfl, rfl, ⟨{body}, {code_entry}, {binding}, ⟨{check_sym}, {match_sym}, {check_plan}, {lower_body}, {lower_code}, {func_binding}, {export_func_type}, {helper_func_type}, rfl, rfl⟩⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// Structured inputs for one String.eq claim's split acceptance proof. -struct StringEqParts { - name: String, - lowered_body: String, - code_entry_bytes: String, - export_name_bytes: String, - string_ty: u32, - string_eq_idx: u32, - self_idx: u32, - type_idx: u32, - carrier: u32, -} - -/// Split the String.eq family. The only `modBytes` walk is the function binding -/// decode; the sym/plan checks and the two lowerings are leaves stated over -/// `Plans.{name}StringEq{Sym}Plan`. -fn render_string_eq_claim_bundles(parts: &[StringEqParts]) -> (String, String) { - render_split_bundles( - "stringEq", - "AverCert.AcceptedArtifact.stringEqClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "stringEqClaims", - "AverCert.AcceptedArtifact.stringEqClaimAccepted, AverCert.AcceptedArtifact.stringEqPlanForExport, AverCert.AcceptedArtifact.stringEqPlanAccepted, AverCert.AcceptedArtifact.stringEqCanonicalHost", - parts.len(), - |index| { - let StringEqParts { - name, - lowered_body, - code_entry_bytes, - export_name_bytes, - string_ty, - string_eq_idx, - self_idx, - type_idx, - carrier, - } = &parts[index]; - let body = format!("stringEqClaim{index}Body"); - let code_entry = format!("stringEqClaim{index}CodeEntry"); - let binding = format!("stringEqClaim{index}Binding"); - let check_sym = format!("stringEqClaim{index}CheckSym"); - let match_sym = format!("stringEqClaim{index}MatchSym"); - let check_plan = format!("stringEqClaim{index}CheckPlan"); - let lower_body = format!("stringEqClaim{index}LowerBody"); - let lower_code = format!("stringEqClaim{index}LowerCode"); - let func_binding = format!("stringEqClaim{index}FuncBinding"); - let sym_plan = format!("AverCert.Plans.{name}StringEqSymPlan"); - let plan = format!("AverCert.Plans.{name}StringEqPlan"); - let declarations = format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy one is the\n\ - -- `modBytes` binding decode.\n\ - theorem {check_sym} :\n \ - AverCert.PlanCheck.checkSymRawPlan {sym_plan} = true := by\n \ - rfl\n\n\ - theorem {match_sym} :\n \ - AverCert.PlanCheck.stringEqPlanMatchesSymRawPlan {sym_plan} {plan} = true := by\n \ - rfl\n\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkStringEqRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerStringEqBody {string_ty} {string_eq_idx} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerStringEqCodeEntry {carrier} {string_ty} {string_eq_idx} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, rfl, rfl, rfl, {check_sym}, {match_sym}, {check_plan}, ⟨{body}, {code_entry}, {binding}, ⟨{lower_body}, {lower_code}, {func_binding}, rfl, rfl⟩⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// Structured inputs for one ADT-constructor claim's split acceptance proof. -struct ConstructParts { - name: String, - lowered_body: String, - code_entry_bytes: String, - export_name_bytes: String, - struct_type_proof: String, - func_type_proof: String, - struct_idx: u32, - self_idx: u32, - type_idx: u32, - carrier: u32, -} - -/// Split the ADT-constructor family. The sym/plan checks and the two lowerings -/// are leaves over `Plans.{name}Construct{Sym}Plan`, and the function binding -/// decode is the `modBytes` walk. The list-constructor struct/func-type -/// conjuncts already reference the hoisted `Plans.{name}Construct…Matches` -/// lemmas, so they stay as-is (constants, not re-run literals). -fn render_construct_claim_bundles(parts: &[ConstructParts]) -> (String, String) { - render_split_bundles( - "construct", - "AverCert.AcceptedArtifact.constructClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "constructClaims", - "AverCert.AcceptedArtifact.constructClaimAccepted, AverCert.AcceptedArtifact.constructPlanForExport, AverCert.AcceptedArtifact.constructPlanAccepted", - parts.len(), - |index| { - let ConstructParts { - name, - lowered_body, - code_entry_bytes, - export_name_bytes, - struct_type_proof, - func_type_proof, - struct_idx, - self_idx, - type_idx, - carrier, - } = &parts[index]; - let body = format!("constructClaim{index}Body"); - let code_entry = format!("constructClaim{index}CodeEntry"); - let binding = format!("constructClaim{index}Binding"); - let check_sym = format!("constructClaim{index}CheckSym"); - let match_sym = format!("constructClaim{index}MatchSym"); - let check_plan = format!("constructClaim{index}CheckPlan"); - let lower_body = format!("constructClaim{index}LowerBody"); - let lower_code = format!("constructClaim{index}LowerCode"); - let func_binding = format!("constructClaim{index}FuncBinding"); - let sym_plan = format!("AverCert.Plans.{name}ConstructSymPlan"); - let plan = format!("AverCert.Plans.{name}ConstructPlan"); - let declarations = format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy one is the\n\ - -- `modBytes` binding decode.\n\ - theorem {check_sym} :\n \ - AverCert.PlanCheck.checkSymRawPlan {sym_plan} = true := by\n \ - rfl\n\n\ - theorem {match_sym} :\n \ - AverCert.PlanCheck.constructPlanMatchesSymRawPlan {sym_plan} {plan} = true := by\n \ - rfl\n\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkConstructRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerConstructBody {struct_idx} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerConstructCodeEntry {carrier} {struct_idx} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, rfl, {check_sym}, {match_sym}, {check_plan}, rfl, ⟨{body}, {code_entry}, {binding}, ⟨{lower_body}, {lower_code}, {func_binding}, rfl, {struct_type_proof}, {func_type_proof}, rfl⟩⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// One composition member's witness data for the split proof. -struct CompositionMemberData { - export_name_bytes: String, - body: String, - code_entry: String, - self_idx: u32, - type_idx: u32, -} - -/// Structured inputs for one composition-root claim's split acceptance proof. -struct CompositionParts { - carrier: u32, - host_table: String, - members: Vec, -} - -/// Split the cross-function composition family. Each member's lowered body and -/// code-entry bytes become named `def`s, and the member `modBytes` walks (the -/// binding decode and the declared-function-type pin) plus the claim-level -/// host-table type pin become their own leaf theorems. The member lowerings and -/// the closure/root conjuncts stay inline: they read the byte-derived -/// `funcTable`, which the aggregate must reduce to enter the `some` branch in -/// any case, so isolating them would not remove that one walk. -fn render_composition_claim_bundles(parts: &[CompositionParts]) -> (String, String) { - render_split_bundles( - "composition", - "AverCert.AcceptedArtifact.compositionClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen compositionMembers", - "compositionClaims", - "AverCert.AcceptedArtifact.compositionClaimAccepted, AverCert.AcceptedArtifact.compositionFuncTable, AverCert.AcceptedArtifact.compositionMemberBinding, AverCert.AcceptedArtifact.compositionNamedMembersAccepted, AverCert.AcceptedArtifact.compositionMemberPlanAccepted, AverCert.AcceptedArtifact.compositionMemberForName, AverCert.AcceptedArtifact.compositionClosureBound, AverCert.AcceptedArtifact.compositionEdges, AverCert.AcceptedArtifact.compositionPlanCallees, AverCert.AcceptedArtifact.compositionEdgesDescend, AverCert.AcceptedArtifact.compositionReachClosure, AverCert.AcceptedArtifact.compositionReachStep, AverCert.AcceptedArtifact.stringListNodup, AverCert.AcceptedArtifact.stringListSetEq", - parts.len(), - |index| { - let CompositionParts { - carrier, - host_table, - members, - } = &parts[index]; - let host_types = format!("compositionClaim{index}HostTypes"); - // Shared host-table type pin: the same statement is the claim-level - // conjunct and every member's host-type conjunct, so one leaf serves - // both and no member re-runs the walk. - let mut declarations = format!( - "-- Claim-level host-table declared-function-type pin (a `modBytes`\n\ - -- type-section walk), shared by the claim and every member.\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table} = true := by\n \ - rfl\n\n" - ); - let mut named_proof = "trivial".to_string(); - for (member_index, member) in members.iter().enumerate().rev() { - let CompositionMemberData { - export_name_bytes, - body, - code_entry, - self_idx, - type_idx, - } = member; - let body_def = format!("compositionClaim{index}Member{member_index}Body"); - let code_def = format!("compositionClaim{index}Member{member_index}CodeEntry"); - let binding_def = format!("compositionClaim{index}Member{member_index}Binding"); - let func_binding = format!("compositionClaim{index}Member{member_index}FuncBinding"); - let func_type = format!("compositionClaim{index}Member{member_index}FuncType"); - declarations = format!( - "-- Member `{member_index}` witness data as named constants.\n\ - def {body_def} : List CertPrelude.WInstr := {body}\n\n\ - def {code_def} : AverCert.WasmSlice.ByteSeq := {code_entry}\n\n\ - def {binding_def} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_def} }}\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_def} = some {binding_def} := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding_def}.typeIdx 1 {carrier} = true := by\n \ - rfl\n\n{declarations}" - ); - let member_proof = format!( - "⟨rfl, ⟨{body_def}, {code_def}, {binding_def}, rfl, rfl, {func_binding}, {func_type}, {host_types}, rfl⟩⟩" - ); - named_proof = format!("⟨{member_proof}, {named_proof}⟩"); - } - let aggregate_proof = format!( - "⟨rfl, ⟨rfl, ⟨rfl, ⟨{host_types}, ⟨rfl, ⟨rfl, ⟨rfl, {named_proof}⟩⟩⟩⟩⟩⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// Structured inputs for one field-projection claim's split acceptance proof. -struct FieldProjectionParts { - name: String, - body: String, - code_entry: String, - export_name_bytes: String, - result_ty: String, - struct_idx: u32, - field_count: u32, - self_idx: u32, - type_idx: u32, - carrier: u32, -} - -/// Split the field-projection family. The former proof left the body, -/// code-entry and binding as `_`; elaboration solves them to the same large -/// literals the byte lowerers produce, so they still bloated the single proof -/// term. Emit them as named `def`s (the `Cert` already carries the exact bytes -/// and ops the wall lowerers reproduce) and each byte-walking conjunct as its -/// own leaf theorem over `Plans.{name}FieldProjectionPlan`. -fn render_field_projection_claim_bundles(parts: &[FieldProjectionParts]) -> (String, String) { - render_split_bundles( - "fieldProjection", - "AverCert.AcceptedArtifact.fieldProjectionClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "fieldProjectionClaims", - "AverCert.AcceptedArtifact.fieldProjectionClaimAccepted, AverCert.AcceptedArtifact.fieldProjectionPlanForExport, AverCert.AcceptedArtifact.fieldProjectionPlanAccepted", - parts.len(), - |index| { - let FieldProjectionParts { - name, - body, - code_entry, - export_name_bytes, - result_ty, - struct_idx, - field_count, - self_idx, - type_idx, - carrier, - } = &parts[index]; - let body_def = format!("fieldProjectionClaim{index}Body"); - let code_def = format!("fieldProjectionClaim{index}CodeEntry"); - let binding_def = format!("fieldProjectionClaim{index}Binding"); - let check_plan = format!("fieldProjectionClaim{index}CheckPlan"); - let lower_body = format!("fieldProjectionClaim{index}LowerBody"); - let lower_code = format!("fieldProjectionClaim{index}LowerCode"); - let func_binding = format!("fieldProjectionClaim{index}FuncBinding"); - let struct_type = format!("fieldProjectionClaim{index}StructType"); - let func_type = format!("fieldProjectionClaim{index}FuncType"); - let plan = format!("AverCert.Plans.{name}FieldProjectionPlan"); - let declarations = format!( - "-- Witness data for `{name}` as named constants so the byte lowerings\n\ - -- are not solved into large literals inside one proof term.\n\ - def {body_def} : List CertPrelude.WInstr := {body}\n\n\ - def {code_def} : AverCert.WasmSlice.ByteSeq := {code_entry}\n\n\ - def {binding_def} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_def} }}\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy ones are the\n\ - -- `modBytes` binding decode and type-section walks.\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkFieldProjectionRawPlan {field_count} {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerFieldProjectionBody {struct_idx} {field_count} {plan} = some {body_def} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerFieldProjectionCodeEntry {carrier} {struct_idx} {field_count} {result_ty} {plan} = some {code_def} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_def} = some {binding_def} := by\n \ - rfl\n\n\ - theorem {struct_type} :\n \ - AverCert.WasmSlice.projectionStructTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {struct_idx} {field_count} {plan}.fieldIdx {result_ty} = true := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.projectionFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding_def}.typeIdx {struct_idx} {result_ty} = true := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, rfl, {check_plan}, ⟨{body_def}, {code_def}, {binding_def}, {lower_body}, {lower_code}, {func_binding}, {struct_type}, {func_type}, rfl, rfl⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// Structured inputs for one verbatim `ref.test`-dispatch claim's split proof. -struct VerbatimParts { - name: String, - export_name_bytes: String, - carrier: u32, -} - -/// Split the verbatim family. Its `Cert` carries no code/type index (the binding -/// is recovered from the module by name), so rather than rendering literals the -/// witnesses are named `def`s whose VALUE is the wall lowerer / byte decoder -/// applied to the encoded plan. The stored definition body is small, so the -/// theorems that reference it hold no large literal; each byte walk is -/// materialized transiently inside its own leaf `addDecl` and freed. -fn render_verbatim_claim_bundles(parts: &[VerbatimParts]) -> (String, String) { - render_split_bundles( - "verbatim", - "AverCert.AcceptedArtifact.verbatimClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "verbatimClaims", - "AverCert.AcceptedArtifact.verbatimClaimAccepted, AverCert.AcceptedArtifact.verbatimPlanForExport, AverCert.AcceptedArtifact.verbatimPlanAccepted", - parts.len(), - |index| { - let VerbatimParts { - name, - export_name_bytes, - carrier, - } = &parts[index]; - let code_entry = format!("verbatimClaim{index}CodeEntry"); - let binding = format!("verbatimClaim{index}Binding"); - let check_plan = format!("verbatimClaim{index}CheckPlan"); - let lower_code = format!("verbatimClaim{index}LowerCode"); - let func_binding = format!("verbatimClaim{index}FuncBinding"); - let func_type = format!("verbatimClaim{index}FuncType"); - let payloads = format!("verbatimClaim{index}Payloads"); - let plan = format!("AverCert.Plans.{name}VerbatimPlan"); - let declarations = format!( - "-- Witness data for `{name}` as named `def`s computed by the wall\n\ - -- lowerer / decoder, so no large literal is baked into the aggregate.\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq :=\n \ - (AverCert.PlanBytes.lowerVerbatimCodeEntry {carrier} {plan}).getD []\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - (AverCert.WasmSlice.funcBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes}).getD ⟨0, 0, []⟩\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy ones are the\n\ - -- `modBytes` binding decode and type-section walk.\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkVerbatimPlan (AverCert.AcceptedArtifact.verbatimNLocals {plan}) {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerVerbatimCodeEntry {carrier} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.verbatimFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {plan}.resultSig = true := by\n \ - rfl\n\n\ - theorem {payloads} :\n \ - AverCert.AcceptedArtifact.verbatimPayloadsBound AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {plan}.body = true := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, rfl, {check_plan}, ⟨{code_entry}, {binding}, {lower_code}, {func_binding}, rfl, {func_type}, {payloads}, rfl⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -/// Structured inputs for one Int-face `ref.test`-dispatch claim's split proof. -struct IntDispatchParts { - name: String, - export_name_bytes: String, - host_table: String, - carrier: u32, -} - -/// Split the Int-face dispatch family the same way as the verbatim family: the -/// body, code entry and binding — formerly inferred `_` witnesses solved into -/// large literals — become named `def`s computed by the wall lowerers and byte -/// decoder, and each byte-walking conjunct becomes its own leaf theorem. -fn render_int_dispatch_claim_bundles(parts: &[IntDispatchParts]) -> (String, String) { - render_split_bundles( - "intDispatch", - "AverCert.AcceptedArtifact.intDispatchClaimAccepted AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen AverCert.manifest", - "intDispatchClaims", - "AverCert.AcceptedArtifact.intDispatchClaimAccepted, AverCert.AcceptedArtifact.intDispatchPlanForExport, AverCert.AcceptedArtifact.intDispatchPlanAccepted", - parts.len(), - |index| { - let IntDispatchParts { - name, - export_name_bytes, - host_table, - carrier, - } = &parts[index]; - let body = format!("intDispatchClaim{index}Body"); - let code_entry = format!("intDispatchClaim{index}CodeEntry"); - let binding = format!("intDispatchClaim{index}Binding"); - let check_plan = format!("intDispatchClaim{index}CheckPlan"); - let host_types = format!("intDispatchClaim{index}HostTypes"); - let lower_body = format!("intDispatchClaim{index}LowerBody"); - let lower_code = format!("intDispatchClaim{index}LowerCode"); - let func_binding = format!("intDispatchClaim{index}FuncBinding"); - let func_type = format!("intDispatchClaim{index}FuncType"); - let plan = format!("AverCert.Plans.{name}IntDispatchPlan"); - let declarations = format!( - "-- Witness data for `{name}` as named `def`s computed by the wall\n\ - -- lowerers / decoder, so no large literal is baked into the aggregate.\n\ - def {body} : List CertPrelude.WInstr :=\n \ - (AverCert.PlanLower.lowerIntDispatchBody {host_table} {plan}).getD []\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq :=\n \ - (AverCert.PlanBytes.lowerIntDispatchCodeEntry {carrier} {host_table} {plan}).getD []\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - (AverCert.WasmSlice.funcBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes}).getD ⟨0, 0, []⟩\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy ones are the\n\ - -- `modBytes` binding decode and type-section walks.\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkIntDispatchRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerIntDispatchBody {host_table} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerIntDispatchCodeEntry {carrier} {host_table} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.verbatimFuncTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx (.refNull {carrier}) = true := by\n \ - rfl\n\n" - ); - let aggregate_proof = format!( - "⟨rfl, rfl, {check_plan}, rfl, {host_types}, rfl, ⟨{body}, {code_entry}, {binding}, {lower_body}, {lower_code}, {func_binding}, rfl, {func_type}, rfl⟩⟩" - ); - (declarations, aggregate_proof) - }, - ) -} - -fn render_artifact_expr_fragment_claims( - analysis: &Analysis, - model_info: &ModelInfo, - host_table_lean: &str, - struct_table_lean: &str, -) -> RenderedArtifactClaims { - let mut sym_claims = Vec::new(); - let mut string_eq_claims = Vec::new(); - let mut string_claims = Vec::new(); - let mut construct_claims = Vec::new(); - let mut recursion_claims = Vec::new(); - let mut mutual_claims = Vec::new(); - let mut verbatim_claims = Vec::new(); - let mut int_dispatch_claims = Vec::new(); - let mut field_projection_claims = Vec::new(); - let mut composition_claims = Vec::new(); - let mut sym_parts: Vec = Vec::new(); - let mut string_eq_parts: Vec = Vec::new(); - let mut string_parts: Vec = Vec::new(); - let mut construct_parts: Vec = Vec::new(); - let mut recursion_parts: Vec = Vec::new(); - let mut mutual_parts: Vec = Vec::new(); - let mut verbatim_parts: Vec = Vec::new(); - let mut int_dispatch_parts: Vec = Vec::new(); - let mut field_projection_parts: Vec = Vec::new(); - let mut composition_parts: Vec = Vec::new(); - let mut string_concat_faces: Vec> = Vec::new(); - let mut construct_faces: Vec> = Vec::new(); - let mut int_dispatch_faces: Vec> = Vec::new(); - // One entry per `sym` claim, in `symFragmentClaims` order: `Some` carries a - // record-parameter face witness, `None` is a known-face claim closed inline - // by `repeat' constructor`. - let mut sym_faces: Vec> = Vec::new(); - for c in &analysis.certs { - match c.inner() { - Cert::ExprFragment { - name, - carrier, - self_idx, - type_idx, - source_plan, - plan, - .. - } => { - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(plan, *carrier) - .expect("certified expr-fragment plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_expr_fragment_plan(plan, *carrier) - .map(|ops| render_ops_value(&ops)) - .expect("certified expr-fragment plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - if expr_fragment_source_plan(source_plan, plan).is_some() { - sym_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier}, hostTable := {host_table_lean}, structTable := {struct_table_lean}, plan := AverCert.Plans.{name}SymPlan, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.SymFragmentClaim)", - export_name = lean_str(name), - )); - // Structured inputs for this claim's SPLIT acceptance proof: - // the witness data and every conjunct become their own - // top-level declarations (see `render_sym_claim_bundles`), so - // the kernel checks and frees each in a separate `addDecl` - // instead of holding one monolithic witness tuple live. - sym_parts.push(SymClaimParts { - name: name.clone(), - lowered_body, - code_entry_bytes, - export_name_bytes, - self_idx: *self_idx, - type_idx: *type_idx, - carrier: *carrier, - }); - // A stage-1 record scalar field read routes through the - // wall's record-parameter face: `symFragmentFace` yields - // `none` on the recognized record plan (proved once and for - // all by `symFragmentFace_none_of_recordProj`), so this arm - // is the record shape's only route. The witness pins the - // Plan declaration, the equality pin against the decoded - // type entry, the export's parameter binding, and the `HEq` - // meaning fields — the exact structure of the hand-checked - // `PersonBeachhead.isMemberFace`. - if let Some(face) = c.record_compute_face() { - let val_ty = |ty: FragTy| match ty { - FragTy::AdtRef => format!( - "(AverCert.WasmSlice.nullableRefType {})", - face.struct_idx - ), - FragTy::IntCarrier => format!( - "(AverCert.WasmSlice.nullableRefType {carrier})" - ), - _ => "(CertDecode.ValType.numeric 0x7f)".to_string(), - }; - let result_ty = val_ty(plan.result); - let param_tys = format!( - "[{}]", - plan.params - .iter() - .map(|ty| val_ty(*ty)) - .collect::>() - .join(", ") - ); - // A plan that names no record discharges the guarded - // declaration conjunct vacuously: the guard evaluates - // to `false` by kernel reduction on the plan itself. - let decl_witness = if expr_fragment_plan_uses_struct(plan) { - "fun _ => ⟨by decide, by decide, rfl, rfl⟩".to_string() - } else { - "fun h => absurd h (by decide)".to_string() - }; - let witness = format!( - "⟨rfl, rfl, rfl, rfl, AverCert.Plans.{name}RecordFields, {param_tys}, {result_ty}, {decl_witness}, rfl, rfl, rfl, ⟨rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl, rfl, HEq.rfl⟩⟩" - ); - sym_faces.push(Some(( - "recordComputeDeclaredFace".to_string(), - format!( - "AverCert.Plans.{name}Plan {{ structIdx := {} }}", - face.struct_idx - ), - witness, - ))); - } else { - sym_faces.push(c.record_param_face().map(|face| { - // The three byte pins (carrier state, type-section - // equality, parameter binding) discharge by kernel `rfl`, - // never `native_decide`: the checker-owned witness admits - // only `[propext, Classical.choice, Quot.sound]`, so a - // compiled-reduction axiom would be rejected. The - // accepted-conjunction's byte scans reduce by `rfl` the - // same way. - let witness = format!( - "⟨rfl, rfl, rfl, AverCert.Plans.{name}RecordDecl, {si}, {fi}, \ - AverCert.Plans.{name}RecordFields, by decide, rfl, rfl, rfl, rfl, \ - fun _ => by rfl, by rfl, by rfl, \ - HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl⟩", - si = face.struct_idx, - fi = face.field_idx, - ); - ( - String::new(), - format!("AverCert.Plans.{name}Plan"), - witness, - ) - })); - } - } - } - Cert::StringConcatVerbatimMatch { - name, - self_idx, - type_idx, - carrier, - string_concat_idx, - container_ty, - result_ty, - .. - } => { - let plan = string_concat_plan_from_cert(c) - .expect("certified String.concat should project to a source plan"); - let code_entry_bytes = lower_string_concat_plan_code_entry_bytes( - &plan, - *carrier, - *result_ty, - *container_ty, - *string_concat_idx, - ) - .expect("certified String.concat plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_string_concat_plan( - &plan, - *result_ty, - *container_ty, - *string_concat_idx, - ) - .map(|ops| render_ops_value(&ops)) - .expect("certified String.concat plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - let carrier_state = render_carrier_state(*carrier); - // The obligation declares what `decodedCarrierIndex` forces: - // the real carrier index, or the reserved `0` in a module that - // provably has no Int carrier struct. - let obligation_carrier = carrier.unwrap_or(0); - string_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier_state}, resultTy := {result_ty}, containerTy := {container_ty}, concatFuncIdx := {string_concat_idx}, symPlan := AverCert.Plans.{name}StringConcatSymPlan, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.StringConcatClaim)", - export_name = lean_str(name), - )); - // Split acceptance proof; see `render_string_concat_claim_bundles`. - string_parts.push(StringConcatParts { - name: name.clone(), - lowered_body, - code_entry_bytes, - export_name_bytes, - carrier_state, - result_ty: *result_ty, - container_ty: *container_ty, - concat_func_idx: *string_concat_idx, - self_idx: *self_idx, - type_idx: *type_idx, - }); - string_concat_faces.push(Some(( - String::new(), - format!("AverCert.Plans.{name}StringConcatPlan"), - format!( - "⟨rfl, rfl, ([] : List Nat), (⟨0, {obligation_carrier}, []⟩ : AverCert.DeclaredIndexEnvelope.DIdxEnvelope), \ - rfl, rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl⟩" - ), - ))); - } - Cert::StringEqVerbatimMatch { - name, - self_idx, - type_idx, - carrier, - string_eq_idx, - .. - } => { - let plan = string_eq_plan_from_cert(c) - .expect("certified String.eq should project to a source plan"); - let string_ty = string_eq_string_ty_from_cert(c) - .expect("certified String.eq should use string arrays"); - let code_entry_bytes = - lower_string_eq_plan_code_entry_bytes(&plan, *carrier, string_ty, *string_eq_idx) - .expect("certified String.eq plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_string_eq_plan(&plan, string_ty, *string_eq_idx) - .map(|ops| render_ops_value(&ops)) - .expect("certified String.eq plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - string_eq_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier}, stringTy := {string_ty}, stringEqFuncIdx := {string_eq_idx}, symPlan := AverCert.Plans.{name}StringEqSymPlan, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.StringEqClaim)", - export_name = lean_str(name), - )); - // Split acceptance proof; see `render_string_eq_claim_bundles`. - string_eq_parts.push(StringEqParts { - name: name.clone(), - lowered_body, - code_entry_bytes, - export_name_bytes, - string_ty, - string_eq_idx: *string_eq_idx, - self_idx: *self_idx, - type_idx: *type_idx, - carrier: *carrier, - }); - } - Cert::AdtConstructor { - name, - self_idx, - type_idx, - carrier, - struct_idx, - field_count, - elem_ty, - .. - } => { - let Some(sym_plan) = adt_constructor_sym_plan_from_cert(c, model_info) else { - continue; - }; - let Some(plan) = construct_plan_from_cert(c) else { - continue; - }; - let code_entry_bytes = - lower_construct_plan_code_entry_bytes(&plan, *carrier, *struct_idx) - .expect("certified constructor plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_construct_plan(&plan, *struct_idx) - .map(|ops| render_ops_value(&ops)) - .expect("certified constructor plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - let elem_ty = construct_val_type_lean_value(*elem_ty) - .expect("certified constructor has a supported byte-level element type"); - let (struct_type_proof, func_type_proof) = - if sym_plan_is_list_construct(&sym_plan) { - ( - format!("Or.inr AverCert.Plans.{name}ConstructStructTypeMatches"), - format!("Or.inr AverCert.Plans.{name}ConstructFuncTypeMatches"), - ) - } else { - ("Or.inl rfl".to_string(), "Or.inl rfl".to_string()) - }; - construct_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier}, structIdx := {struct_idx}, fieldCount := {field_count}, elemTy := {elem_ty}, symPlan := AverCert.Plans.{name}ConstructSymPlan, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.ConstructClaim)", - export_name = lean_str(name), - )); - // Split acceptance proof; see `render_construct_claim_bundles`. - construct_parts.push(ConstructParts { - name: name.clone(), - lowered_body, - code_entry_bytes, - export_name_bytes, - struct_type_proof, - func_type_proof, - struct_idx: *struct_idx, - self_idx: *self_idx, - type_idx: *type_idx, - carrier: *carrier, - }); - if adt_constructor_uses_model(c, model_info) { - construct_faces.push(Some(( - String::new(), - format!("AverCert.Plans.{name}ConstructPlan"), - "⟨rfl, rfl, rfl, AverCert.Plans.{name}TypePrefix, AverCert.Plans.{name}DeclaredEnvelope, \ - by decide, by decide, rfl, rfl, \ - ⟨AverCert.Plans.declaredTypeCur, rfl, by decide +kernel⟩, \ - rfl, rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl⟩" - .replace("{name}", name), - ))); - } else { - construct_faces.push(None); - } - } - Cert::Recursive { - name, - self_idx, - type_idx, - carrier, - .. - } - | Cert::AccumulatorRecursive { - name, - self_idx, - type_idx, - carrier, - .. - } => { - // Analysis declines a normalized body whose canonical plan - // cannot reproduce its exact bytes. Keep this guard as a - // fail-closed invariant. - let Some(plan) = recursion_plan_from_cert(c) else { - continue; - }; - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(&plan, *carrier) - .expect("certified recursion plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_expr_fragment_plan(&plan, *carrier) - .map(|ops| render_ops_value(&ops)) - .expect("certified recursion plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - let host_table = recursion_host_table_lean_value(c); - recursion_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier}, hostTable := {host_table}, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.RecursionClaim)", - export_name = lean_str(name), - )); - // Split acceptance proof: the witness data and every byte-walking - // conjunct become their own top-level declarations (see - // `render_recursion_claim_bundles`) so the kernel checks and frees - // each separately instead of holding one monolithic witness tuple. - recursion_parts.push(RecursionParts { - name: name.clone(), - lowered_body, - code_entry_bytes, - export_name_bytes, - host_table, - self_idx: *self_idx, - type_idx: *type_idx, - carrier: *carrier, - }); - } - Cert::MutualRecursion { - name, - self_idx, - carrier, - box_idx, - sub_idx, - position, - scc, - } => { - // Analysis declines any member whose canonical plan cannot - // reproduce its exact bytes. Keep this guard as a fail-closed - // invariant. - let Some(plan) = mutual_plan_from_cert(c) else { - continue; - }; - let member = &scc[*position]; - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(&plan, *carrier) - .expect("certified mutual member plan lowers to code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let lowered_body = lower_expr_fragment_plan(&plan, *carrier) - .map(|ops| render_ops_value(&ops)) - .expect("certified mutual member plan lowers to WInstr body"); - let export_name_bytes = render_byte_list(name.as_bytes()); - let host_table = mutual_host_table_lean_value(*box_idx, *sub_idx); - let member_set = mutual_member_set_lean_value(scc); - mutual_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier}, memberSet := {member_set}, hostTable := {host_table}, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.MutualRecursionClaim)", - export_name = lean_str(name), - )); - // Split acceptance proof; see `render_mutual_claim_bundles`. - mutual_parts.push(MutualParts { - name: name.clone(), - lowered_body, - code_entry_bytes, - export_name_bytes, - host_table, - member_set, - self_idx: *self_idx, - type_idx: member.type_idx, - carrier: *carrier, - }); - } - Cert::VerbatimWidenedMatch { - name, carrier, .. - } - | Cert::VerbatimVariantDispatch { - name, carrier, .. - } => { - // Analysis declines a body whose canonical verbatim plan cannot - // reproduce its exact bytes. Keep this guard as a fail-closed - // invariant. - if verbatim_plan_from_cert(c).is_none() { - continue; - } - let export_name_bytes = render_byte_list(name.as_bytes()); - verbatim_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier}, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.VerbatimClaim)", - export_name = lean_str(name), - )); - // Split acceptance proof; see `render_verbatim_claim_bundles`. - verbatim_parts.push(VerbatimParts { - name: name.clone(), - export_name_bytes, - carrier: *carrier, - }); - } - Cert::VariantDispatch { name, carrier, .. } - | Cert::WidenedIntMatch { name, carrier, .. } => { - // Analysis declines a body whose canonical Int-face plan cannot - // reproduce its exact bytes. Keep this guard as a fail-closed - // invariant. - if int_dispatch_plan_from_cert(c, analysis.frag_host_table).is_none() { - continue; - } - let hosts = int_dispatch_host_table_from_cert(c) - .expect("Int-face dispatch cert carries its host table"); - let host_table = int_dispatch_host_table_lean_value(&hosts); - let export_name_bytes = render_byte_list(name.as_bytes()); - int_dispatch_claims.push(format!( - "({{ exportNameBytes := {export_name_bytes}, exportName := {export_name}, carrier := {carrier}, hostTable := {host_table}, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.IntDispatchClaim)", - export_name = lean_str(name), - )); - // Split acceptance proof; see `render_int_dispatch_claim_bundles`. - int_dispatch_parts.push(IntDispatchParts { - name: name.clone(), - export_name_bytes, - host_table, - carrier: *carrier, - }); - int_dispatch_faces.push(Some(( - String::new(), - format!("AverCert.Plans.{name}IntDispatchPlan"), - "⟨rfl, rfl, AverCert.Plans.{name}TypePrefix, AverCert.Plans.{name}DeclaredEnvelope, \ - by decide, by decide, \ - ⟨AverCert.Plans.declaredTypeCur, rfl, by decide +kernel⟩, \ - rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl, HEq.rfl⟩" - .replace("{name}", name), - ))); - } - Cert::FieldProjection { - name, - self_idx, - type_idx, - carrier, - struct_idx, - field_count, - code_entry_bytes, - ops, - .. - } => { - let Some((_plan, result_ty)) = field_projection_plan_from_cert(c) else { - continue; - }; - let result_ty = field_projection_result_ty_lean_value(result_ty); - field_projection_claims.push(format!( - "({{ exportNameBytes := {bytes}, exportName := {export_name}, carrier := {carrier}, structIdx := {struct_idx}, fieldCount := {field_count}, resultTy := {result_ty}, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.FieldProjectionClaim)", - bytes = render_byte_list(name.as_bytes()), - export_name = lean_str(name), - )); - // Split acceptance proof; the `Cert` already carries the exact - // ops and code-entry bytes the wall lowerers reproduce, so no `_` - // witness is solved into a large literal. See - // `render_field_projection_claim_bundles`. - field_projection_parts.push(FieldProjectionParts { - name: name.clone(), - body: render_ops_value(ops), - code_entry: render_byte_list(code_entry_bytes), - export_name_bytes: render_byte_list(name.as_bytes()), - result_ty, - struct_idx: *struct_idx, - field_count: *field_count, - self_idx: *self_idx, - type_idx: *type_idx, - carrier: *carrier, - }); - } - _ => {} - } - } - let composition_members_data = composition_member_plans(analysis); - let composition_members = composition_members_data - .iter() - .map(|(entry, _)| { - format!( - "({{ exportNameBytes := {bytes}, exportName := {name}, plan := AverCert.Plans.{ident}CompositionPlan }} : AverCert.AcceptedArtifact.CompositionMemberClaim)", - bytes = render_byte_list(entry.name.as_bytes()), - name = lean_str(&entry.name), - ident = entry.name, - ) - }) - .collect::>(); - let global_func_table = composition_members_data - .iter() - .map(|(entry, _)| (entry.name.clone(), entry.self_idx)) - .collect::>(); - for cert in &analysis.certs { - let Cert::Composition { - name, - self_idx, - carrier, - closure, - .. - } = cert.inner() - else { - continue; - }; - let Some(plans) = composition_plans_from_cert(cert, analysis.frag_host_table) else { - continue; - }; - let add_idx = analysis - .frag_host_table - .add_idx - .expect("plan-backed composition has strict add host"); - let host_table = composition_host_table_lean_value(add_idx); - let member_names = format!( - "[{}]", - closure - .iter() - .map(|entry| lean_str(&entry.name)) - .collect::>() - .join(", ") - ); - composition_claims.push(format!( - "({{ exportName := {export_name}, carrier := {carrier}, hostTable := {host_table}, memberNames := {member_names}, obligation := AverCert.{name}Ob }} : AverCert.AcceptedArtifact.CompositionClaim)", - export_name = lean_str(name), - )); - // Collect each member's witness data for the split acceptance proof; - // see `render_composition_claim_bundles`. - let members = plans - .iter() - .map(|(entry, plan)| { - let body = render_ops_value( - &lower_composition_plan(plan, add_idx, &global_func_table) - .expect("composition member lowers against global byte table"), - ); - let code_entry = render_byte_list( - &composition_code_entry_bytes(plan, *carrier, add_idx, &global_func_table) - .expect("composition member byte-lowers against global byte table"), - ); - CompositionMemberData { - export_name_bytes: render_byte_list(entry.name.as_bytes()), - body, - code_entry, - self_idx: entry.self_idx, - type_idx: entry.type_idx, - } - }) - .collect::>(); - let _ = self_idx; - composition_parts.push(CompositionParts { - carrier: *carrier, - host_table, - members, - }); - } - let sym_claims = if sym_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", sym_claims.join(",\n ")) - }; - let string_claims = if string_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", string_claims.join(",\n ")) - }; - let string_eq_claims = if string_eq_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", string_eq_claims.join(",\n ")) - }; - let construct_claims = if construct_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", construct_claims.join(",\n ")) - }; - let recursion_claims = if recursion_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", recursion_claims.join(",\n ")) - }; - let mutual_claims = if mutual_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", mutual_claims.join(",\n ")) - }; - let verbatim_claims = if verbatim_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", verbatim_claims.join(",\n ")) - }; - let int_dispatch_claims = if int_dispatch_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", int_dispatch_claims.join(",\n ")) - }; - let field_projection_claims = if field_projection_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", field_projection_claims.join(",\n ")) - }; - let composition_members = if composition_members.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", composition_members.join(",\n ")) - }; - let composition_claims = if composition_claims.is_empty() { - "[]".to_string() - } else { - format!("[\n {}\n]", composition_claims.join(",\n ")) - }; - let obligation_proof_count = sym_parts.len() - + string_eq_parts.len() - + string_parts.len() - + construct_parts.len() - + recursion_parts.len() - + mutual_parts.len() - + verbatim_parts.len() - + int_dispatch_parts.len() - + field_projection_parts.len() - + composition_parts.len(); - let obligation_proof = (0..obligation_proof_count).fold("trivial".to_string(), |acc, _| { - format!("⟨rfl, {acc}⟩") - }); - // The expr-fragment (`sym`) family emits a SPLIT proof: witness data as - // named `def`s and each acceptance conjunct as its own leaf theorem, with - // the aggregate combining the already-checked constants. This keeps the - // per-claim kernel peak at the largest single leaf instead of the whole - // witness tuple. The other nine families still emit one opaque theorem. - let (sym_bundles, sym_proof) = - render_sym_claim_bundles(&sym_parts, host_table_lean, struct_table_lean); - let (string_bundles, string_proof) = render_string_concat_claim_bundles(&string_parts); - let (string_eq_bundles, string_eq_proof) = render_string_eq_claim_bundles(&string_eq_parts); - let construct_claim_count = construct_parts.len(); - let (construct_bundles, construct_claims_proof) = render_construct_claim_bundles(&construct_parts); - // `acceptedConstructFragments` conjoins per-claim acceptance with unique - // export-name coverage. Build the `Nodup` proof one list cell at a time so - // Lean never runs a whole-list decision procedure inside the already deep - // artifact acceptance term. - let construct_nodup_proof = (0..construct_claim_count).fold( - "List.nodup_nil".to_string(), - |acc, _| format!("List.nodup_cons.mpr ⟨by decide, {acc}⟩"), - ); - let construct_proof = format!("⟨{construct_claims_proof}, {construct_nodup_proof}⟩"); - let (recursion_bundles, recursion_proof) = render_recursion_claim_bundles(&recursion_parts); - let (mutual_bundles, mutual_proof) = render_mutual_claim_bundles(&mutual_parts); - let (verbatim_bundles, verbatim_proof) = render_verbatim_claim_bundles(&verbatim_parts); - let (int_dispatch_bundles, int_dispatch_proof) = - render_int_dispatch_claim_bundles(&int_dispatch_parts); - let (field_projection_bundles, field_projection_proof) = - render_field_projection_claim_bundles(&field_projection_parts); - let (composition_bundles, composition_claims_proof) = - render_composition_claim_bundles(&composition_parts); - // `acceptedCompositionFragments` conjoins the per-claim acceptance with the - // artifact-wide member coverage, manifest-obligation coverage, and unique - // obligation-export bounds. Each is a decidable `Bool = true` over concrete - // artifact literals, closed by `rfl`. - let composition_proof = format!("⟨{composition_claims_proof}, rfl, rfl, rfl⟩"); - let (string_concat_face_bundles, string_concat_face_proof) = render_face_bundles( - "stringConcat", - "stringConcatDeclaredFace", - "stringConcatClaims", - ", AverCert.AcceptedArtifact.stringConcatCanonicalHost", - false, - &string_concat_faces, - ); - let (construct_face_bundles, construct_face_proof) = render_face_bundles( - "construct", - "constructNamedFace", - "constructClaims", - ", AverCert.StandardFace.emptyHost", - false, - &construct_faces, - ); - let (int_dispatch_face_bundles, int_dispatch_face_proof) = render_face_bundles( - "intDispatch", - "intDispatchDeclaredFace", - "intDispatchClaims", - ", AverCert.AcceptedArtifact.intDispatchCanonicalHost, AverCert.AcceptedArtifact.intDispatchCanonicalSlots", - true, - &int_dispatch_faces, - ); - // The `sym` family's face slot (`symFragmentMatches`). Every known-face - // claim closes inline by `repeat' constructor` (a `None` element); a - // record-parameter claim carries an explicit `recordParamDeclaredFace` - // witness, routed exactly like the declared-index envelope faces. The slot - // only switches away from the inline `repeat' constructor` when at least one - // record claim is present, so non-record modules render byte-for-byte as - // before. - let sym_faces_have_record = sym_faces.iter().any(Option::is_some); - let (sym_face_bundles, sym_face_proof) = if sym_faces_have_record { - render_face_bundles( - "symFragment", - "recordParamDeclaredFace", - "symFragmentClaims", - "", - true, - &sym_faces, - ) - } else { - (String::new(), String::new()) - }; - let claim_proof_bundles = [ - sym_bundles, - string_eq_bundles, - string_bundles, - construct_bundles, - recursion_bundles, - mutual_bundles, - verbatim_bundles, - int_dispatch_bundles, - field_projection_bundles, - composition_bundles, - string_concat_face_bundles, - construct_face_bundles, - int_dispatch_face_bundles, - sym_face_bundles, - ] - .concat(); - RenderedArtifactClaims { - sym_claims, - string_eq_claims, - string_claims, - construct_claims, - recursion_claims, - mutual_claims, - verbatim_claims, - int_dispatch_claims, - field_projection_claims, - composition_members, - composition_claims, - claim_proof_bundles, - obligation_proof, - sym_proof, - string_eq_proof, - string_proof, - construct_proof, - recursion_proof, - mutual_proof, - verbatim_proof, - int_dispatch_proof, - field_projection_proof, - composition_proof, - string_concat_face_proof, - construct_face_proof, - int_dispatch_face_proof, - sym_face_proof, - sym_faces_have_record, - } -} - -fn render_artifact( - analysis: &Analysis, - model_info: &ModelInfo, - host_table_lean: &str, - struct_table_lean: &str, - wasip2_component_envelope: Option, -) -> String { - let claims = render_artifact_expr_fragment_claims( - analysis, - model_info, - host_table_lean, - struct_table_lean, - ); - let nat_list = |values: &[u32]| { - format!( - "[{}]", - values - .iter() - .map(u32::to_string) - .collect::>() - .join(", ") - ) - }; - let closure_claim = format!( - "({{ roots := {}, helpers := {}, admitted := {} }} : AverCert.AcceptedArtifact.ClosureClaim)", - nat_list(&analysis.module_envelope.closure.roots), - nat_list(&analysis.module_envelope.closure.helpers), - nat_list(&analysis.module_envelope.closure.admitted), - ); - let wasip2_component_envelope = wasip2_component_envelope - .map(|envelope| { - format!( - "some ({{ prefixLen := {}, embeddedCoreModuleLen := {}, suffixLen := {} }} : AverCert.Wasip2Envelope.ComponentEnvelope)", - envelope.prefix_len, - envelope.embedded_core_module_len, - envelope.suffix_len, - ) - }) - .unwrap_or_else(|| "none".to_string()); - // Shared source-side rendering for the few cross-family reductions. Each - // proof family below gets its own opaque theorem instead of contributing - // an inline branch to one enormous `acceptedWithFinal` proof term. The - // expansion deliberately contains no Lean `macro`: Artifact.lean is data - // from the verifier's perspective and must pass the elaboration-code wall. - let artifact_dsimp = concat!( - " dsimp [data, closureClaim, symFragmentClaims, stringEqClaims, stringConcatClaims, constructClaims, recursionClaims, mutualRecursionClaims, verbatimClaims, intDispatchClaims, fieldProjectionClaims, compositionMembers, compositionClaims, AverCert.AcceptedArtifact.accepted,\n", - " AverCert.AcceptedArtifact.subjectMatchesArtifactRoot,\n", - " AverCert.AcceptedArtifact.expectedArtifactRoot,\n", - " AverCert.AcceptedArtifact.fragmentClaimObligationsInManifest,\n", - " AverCert.AcceptedArtifact.claimObligations,\n", - " AverCert.AcceptedArtifact.claimObligationsInManifest,\n", - " AverCert.AcceptedArtifact.claimObligationExports,\n", - " AverCert.AcceptedArtifact.claimsMatchManifest,\n", - " AverCert.AcceptedArtifact.decodedNonExprFacts,\n", - " AverCert.AcceptedArtifact.decodedNonExprClaimFacts,\n", - " AverCert.AcceptedArtifact.decodedStringHostRoles,\n", - " AverCert.AcceptedArtifact.stringEqCanonicalHost,\n", - " AverCert.AcceptedArtifact.stringConcatCanonicalHost,\n", - " AverCert.AcceptedArtifact.decodedClaims,\n", - " AverCert.AcceptedArtifact.decodedObligationFacts,\n", - " AverCert.AcceptedArtifact.decodedCodeAtAll,\n", - " AverCert.AcceptedArtifact.decodedCodeAt,\n", - " AverCert.AcceptedArtifact.decodedConstructStructFields,\n", - " AverCert.AcceptedArtifact.decodedProjectionStructFields,\n", - " AverCert.AcceptedArtifact.decodedCompositionClaims,\n", - " AverCert.AcceptedArtifact.decodedCompositionNames,\n", - " AverCert.AcceptedArtifact.symFragmentClaimPlanPairs,\n", - " AverCert.AcceptedArtifact.symFragmentClaimEncodedPlanPairs,\n", - " AverCert.AcceptedArtifact.symFragmentClaimEncodedPlanPair?,\n", - " AverCert.AcceptedArtifact.stringEqClaimExportNames,\n", - " AverCert.AcceptedArtifact.stringEqManifestPlanNames,\n", - " AverCert.AcceptedArtifact.stringEqClaimSymPlanPairs,\n", - " AverCert.AcceptedArtifact.stringConcatClaimExportNames,\n", - " AverCert.AcceptedArtifact.stringConcatManifestPlanNames,\n", - " AverCert.AcceptedArtifact.stringConcatClaimSymPlanPairs,\n", - " AverCert.AcceptedArtifact.constructClaimExportNames,\n", - " AverCert.AcceptedArtifact.constructManifestPlanNames,\n", - " AverCert.AcceptedArtifact.constructClaimSymPlanPairs,\n", - " AverCert.AcceptedArtifact.recursionClaimExportNames,\n", - " AverCert.AcceptedArtifact.recursionManifestPlanNames,\n", - " AverCert.AcceptedArtifact.mutualRecursionClaimExportNames,\n", - " AverCert.AcceptedArtifact.mutualManifestPlanNames,\n", - " AverCert.AcceptedArtifact.verbatimClaimExportNames,\n", - " AverCert.AcceptedArtifact.verbatimManifestPlanNames,\n", - " AverCert.AcceptedArtifact.intDispatchClaimExportNames,\n", - " AverCert.AcceptedArtifact.intDispatchManifestPlanNames,\n", - " AverCert.AcceptedArtifact.fieldProjectionClaimExportNames,\n", - " AverCert.AcceptedArtifact.fieldProjectionManifestPlanNames,\n", - " AverCert.AcceptedArtifact.compositionMemberPlanPairs,\n", - " AverCert.AcceptedArtifact.acceptedFragments,\n", - " AverCert.AcceptedArtifact.acceptedSymFragments,\n", - " AverCert.AcceptedArtifact.acceptedStringEqFragments,\n", - " AverCert.AcceptedArtifact.acceptedStringConcatFragments,\n", - " AverCert.AcceptedArtifact.acceptedConstructFragments,\n", - " AverCert.AcceptedArtifact.acceptedRecursionFragments,\n", - " AverCert.AcceptedArtifact.acceptedMutualRecursionFragments,\n", - " AverCert.AcceptedArtifact.acceptedVerbatimFragments,\n", - " AverCert.AcceptedArtifact.acceptedIntDispatchFragments,\n", - " AverCert.AcceptedArtifact.acceptedFieldProjectionFragments,\n", - " AverCert.AcceptedArtifact.acceptedCompositionFragments,\n", - " AverCert.AcceptedArtifact.acceptedWholeModule,\n", - " AverCert.AcceptedArtifact.allClaims,\n", - " AverCert.AcceptedArtifact.symFragmentClaimsAccepted,\n", - " AverCert.AcceptedArtifact.symFragmentClaimAccepted,\n", - " AverCert.AcceptedArtifact.symFragmentPlanAccepted,\n", - " AverCert.AcceptedArtifact.stringEqClaimsAccepted,\n", - " AverCert.AcceptedArtifact.stringEqClaimAccepted,\n", - " AverCert.AcceptedArtifact.stringEqPlanForExport,\n", - " AverCert.AcceptedArtifact.stringEqPlanAccepted,\n", - " AverCert.AcceptedArtifact.stringConcatClaimsAccepted,\n", - " AverCert.AcceptedArtifact.stringConcatClaimAccepted,\n", - " AverCert.AcceptedArtifact.stringConcatPlanForExport,\n", - " AverCert.AcceptedArtifact.stringConcatPlanAccepted,\n", - " AverCert.AcceptedArtifact.constructClaimsAccepted,\n", - " AverCert.AcceptedArtifact.constructClaimAccepted,\n", - " AverCert.AcceptedArtifact.constructPlanForExport,\n", - " AverCert.AcceptedArtifact.constructPlanAccepted,\n", - " AverCert.AcceptedArtifact.recursionClaimsAccepted,\n", - " AverCert.AcceptedArtifact.recursionClaimAccepted,\n", - " AverCert.AcceptedArtifact.recursionPlanForExport,\n", - " AverCert.AcceptedArtifact.recursionPlanAccepted,\n", - " AverCert.AcceptedArtifact.mutualRecursionClaimsAccepted,\n", - " AverCert.AcceptedArtifact.mutualRecursionClaimAccepted,\n", - " AverCert.AcceptedArtifact.mutualPlanForExport,\n", - " AverCert.AcceptedArtifact.mutualPlanAccepted,\n", - " AverCert.AcceptedArtifact.verbatimClaimsAccepted,\n", - " AverCert.AcceptedArtifact.verbatimClaimAccepted,\n", - " AverCert.AcceptedArtifact.verbatimPlanForExport,\n", - " AverCert.AcceptedArtifact.verbatimPlanAccepted,\n", - " AverCert.AcceptedArtifact.intDispatchClaimsAccepted,\n", - " AverCert.AcceptedArtifact.intDispatchClaimAccepted,\n", - " AverCert.AcceptedArtifact.intDispatchPlanForExport,\n", - " AverCert.AcceptedArtifact.intDispatchPlanAccepted,\n", - " AverCert.AcceptedArtifact.fieldProjectionClaimsAccepted,\n", - " AverCert.AcceptedArtifact.fieldProjectionClaimAccepted,\n", - " AverCert.AcceptedArtifact.fieldProjectionPlanForExport,\n", - " AverCert.AcceptedArtifact.fieldProjectionPlanAccepted,\n", - " AverCert.AcceptedArtifact.compositionClaimsAccepted,\n", - " AverCert.AcceptedArtifact.compositionClaimAccepted,\n", - " AverCert.AcceptedArtifact.compositionFuncTable,\n", - " AverCert.AcceptedArtifact.compositionMemberBinding,\n", - " AverCert.AcceptedArtifact.compositionNamedMembersAccepted,\n", - " AverCert.AcceptedArtifact.compositionMemberPlanAccepted,\n", - " AverCert.AcceptedArtifact.compositionMemberForName,\n", - " AverCert.AcceptedArtifact.compositionClosureBound,\n", - " AverCert.AcceptedArtifact.compositionEdges,\n", - " AverCert.AcceptedArtifact.compositionPlanCallees,\n", - " AverCert.AcceptedArtifact.compositionEdgesDescend,\n", - " AverCert.AcceptedArtifact.compositionReachClosure,\n", - " AverCert.AcceptedArtifact.compositionReachStep,\n", - " AverCert.AcceptedArtifact.stringListNodup,\n", - " AverCert.AcceptedArtifact.stringListSetEq,\n", - " AverCert.AcceptedArtifact.manifestObligationsClaimed,\n", - " AverCert.AcceptedArtifact.manifestObligationExportsUnique,\n", - " AverCert.AcceptedArtifact.intDispatchCanonicalHost,\n", - " AverCert.AcceptedArtifact.intDispatchCanonicalSlots,\n", - " AverCert.AcceptedArtifact.exprFragmentPlanAccepted,\n", - " AverCert.ExprFragmentAccepted.accepted]\n" - ); - let face_dsimp = concat!( - " dsimp [AverCert.StandardFace.checkedFaces,\n", - " AverCert.Schema.Subject.hostRoles,\n", - " AverCert.StandardFace.claimExportsUnique,\n", - " AverCert.StandardFace.hostTableBound,\n", - " AverCert.StandardFace.decodedRoleIdx,\n", - " AverCert.StandardFace.symFragmentMatches,\n", - " AverCert.StandardFace.symFragmentFace,\n", - " AverCert.StandardFace.stringEqMatches,\n", - " AverCert.StandardFace.stringConcatMatches,\n", - " AverCert.StandardFace.constructMatches,\n", - " AverCert.StandardFace.recursionMatches,\n", - " AverCert.StandardFace.mutualMatches,\n", - " AverCert.StandardFace.verbatimMatches,\n", - " AverCert.StandardFace.intDispatchMatches,\n", - " AverCert.StandardFace.fieldProjectionMatches,\n", - " AverCert.StandardFace.compositionMatches,\n", - " AverCert.StandardFace.StandardFace.Matches,\n", - " AverCert.AcceptedArtifact.claimObligationExports,\n", - " AverCert.AcceptedArtifact.allClaims,\n", - " AverCert.AcceptedArtifact.namedPlanForExport,\n", - " AverCert.AcceptedArtifact.stringEqPlanForExport,\n", - " AverCert.AcceptedArtifact.stringConcatPlanForExport,\n", - " AverCert.AcceptedArtifact.constructPlanForExport,\n", - " AverCert.AcceptedArtifact.recursionPlanForExport,\n", - " AverCert.AcceptedArtifact.mutualPlanForExport,\n", - " AverCert.AcceptedArtifact.verbatimPlanForExport,\n", - " AverCert.AcceptedArtifact.intDispatchPlanForExport,\n", - " AverCert.AcceptedArtifact.fieldProjectionPlanForExport,\n", - " AverCert.AcceptedArtifact.compositionMemberForName,\n", - " data, symFragmentClaims, stringEqClaims, stringConcatClaims,\n", - " constructClaims, recursionClaims, mutualRecursionClaims,\n", - " verbatimClaims, intDispatchClaims, fieldProjectionClaims,\n", - " compositionMembers, compositionClaims]\n" - ); - // `dsimp` closes a reduced `True` goal immediately. Do not emit a - // trailing `exact trivial` for an empty family: Lean correctly reports a - // tactic after goal closure as an error. - let family_exact = |proof: &str| { - if proof == "trivial" { - String::new() - } else { - format!(" exact {proof}\n") - } - }; - // `claimObligationsBound` is the exception to the rule above: its goal - // unfolds through `claimObligations`, which wraps every family list in - // `List.map … ++ …`. Under the pinned 4.33.1 wall `dsimp` leaves that - // chain unreduced, so the empty-claims goal stays open — - // `claimObligationsInManifest obs (List.map _ [] ++ …)` — and needs the - // `exact trivial` the family proofs must omit. It holds definitionally - // (the chain reduces to `[]` and the match on `[]` is `True`), so the - // same `exact` discharges every claim count. - let obligation_proof_step = format!(" exact {}\n", claims.obligation_proof); - let proof_bundles = format!( - concat!( - "theorem claimObligationsBound : AverCert.AcceptedArtifact.fragmentClaimObligationsInManifest data := by\n", - "{artifact_dsimp}", - "{obligation_proof_step}\n", - "theorem claimsMatchManifest : AverCert.AcceptedArtifact.claimsMatchManifest data := by\n", - "{artifact_dsimp}", - " exact ⟨rfl, ⟨rfl, ⟨rfl, ⟨rfl, ⟨rfl, ⟨rfl, ⟨rfl, ⟨rfl, ⟨rfl, ⟨rfl, rfl⟩⟩⟩⟩⟩⟩⟩⟩⟩⟩\n\n", - "theorem standardFacesChecked : AverCert.StandardFace.checkedFaces data := by\n", - "{face_dsimp}", - " refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩\n", - "{sym_face_step}", - " · repeat' constructor\n", - " · exact {string_concat_face_proof}\n", - " · exact {construct_face_proof}\n", - " · repeat' constructor\n", - " · repeat' constructor\n", - " · repeat' constructor\n", - " · exact {int_dispatch_face_proof}\n", - " · repeat' constructor\n", - " · repeat' constructor\n\n", - "theorem claimAxesChecked : AverCert.ClaimAxes.checked data = true := rfl\n\n", - "theorem decodedNonExprClaimFacts : AverCert.AcceptedArtifact.decodedNonExprClaimFacts data := by\n", - "{artifact_dsimp}", - " repeat' constructor\n\n", - "theorem decodedNonExprFacts : AverCert.AcceptedArtifact.decodedNonExprFacts data := by\n", - " dsimp [AverCert.AcceptedArtifact.decodedNonExprFacts]\n", - " exact ⟨decodedHostRoles, decodedStringHostRoles, decodedNonExprClaimFacts⟩\n\n", - "theorem symFragmentsAccepted : AverCert.AcceptedArtifact.acceptedSymFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedSymFragments, AverCert.AcceptedArtifact.symFragmentClaimsAccepted, AverCert.AcceptedArtifact.allClaims, data, symFragmentClaims]\n", - "{sym_proof_step}\n", - "theorem stringEqFragmentsAccepted : AverCert.AcceptedArtifact.acceptedStringEqFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedStringEqFragments, AverCert.AcceptedArtifact.stringEqClaimsAccepted, AverCert.AcceptedArtifact.allClaims, data, stringEqClaims]\n", - "{string_eq_proof_step}\n", - "theorem stringConcatFragmentsAccepted : AverCert.AcceptedArtifact.acceptedStringConcatFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedStringConcatFragments, AverCert.AcceptedArtifact.stringConcatClaimsAccepted, AverCert.AcceptedArtifact.allClaims, data, stringConcatClaims]\n", - "{string_proof_step}\n", - "theorem constructFragmentsAccepted : AverCert.AcceptedArtifact.acceptedConstructFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedConstructFragments, AverCert.AcceptedArtifact.constructClaimsAccepted, AverCert.AcceptedArtifact.allClaims, AverCert.AcceptedArtifact.constructClaimExportNames, data, constructClaims]\n", - " exact {construct_proof}\n\n", - "theorem recursionFragmentsAccepted : AverCert.AcceptedArtifact.acceptedRecursionFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedRecursionFragments, AverCert.AcceptedArtifact.recursionClaimsAccepted, AverCert.AcceptedArtifact.allClaims, data, recursionClaims]\n", - "{recursion_proof_step}\n", - "theorem mutualFragmentsAccepted : AverCert.AcceptedArtifact.acceptedMutualRecursionFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedMutualRecursionFragments, AverCert.AcceptedArtifact.mutualRecursionClaimsAccepted, AverCert.AcceptedArtifact.allClaims, AverCert.AcceptedArtifact.mutualClaimsFormClosedSccs, AverCert.AcceptedArtifact.mutualClaimEdges, AverCert.AcceptedArtifact.mutualClaimEdge, AverCert.AcceptedArtifact.mutualPlanForExport, AverCert.AcceptedArtifact.mutualPlanTarget, AverCert.AcceptedArtifact.mutualMembersFormClosedSccs, AverCert.AcceptedArtifact.followSccCycle, AverCert.AcceptedArtifact.natEdgeLookup, AverCert.AcceptedArtifact.natListNodup, AverCert.AcceptedArtifact.natListSetEq, data, mutualRecursionClaims]\n", - " exact ⟨{mutual_proof}, rfl⟩\n\n", - "theorem verbatimFragmentsAccepted : AverCert.AcceptedArtifact.acceptedVerbatimFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedVerbatimFragments, AverCert.AcceptedArtifact.verbatimClaimsAccepted, AverCert.AcceptedArtifact.allClaims, data, verbatimClaims]\n", - "{verbatim_proof_step}\n", - "theorem intDispatchFragmentsAccepted : AverCert.AcceptedArtifact.acceptedIntDispatchFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedIntDispatchFragments, AverCert.AcceptedArtifact.intDispatchClaimsAccepted, AverCert.AcceptedArtifact.allClaims, data, intDispatchClaims]\n", - "{int_dispatch_proof_step}\n", - "theorem fieldProjectionFragmentsAccepted : AverCert.AcceptedArtifact.acceptedFieldProjectionFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedFieldProjectionFragments, AverCert.AcceptedArtifact.fieldProjectionClaimsAccepted, AverCert.AcceptedArtifact.allClaims, data, fieldProjectionClaims]\n", - "{field_projection_proof_step}\n", - "theorem compositionFragmentsAccepted : AverCert.AcceptedArtifact.acceptedCompositionFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedCompositionFragments, AverCert.AcceptedArtifact.compositionClaimsAccepted, AverCert.AcceptedArtifact.allClaims, AverCert.AcceptedArtifact.compositionMembersCovered, AverCert.AcceptedArtifact.compositionClaimedNames, AverCert.AcceptedArtifact.manifestObligationsClaimed, AverCert.AcceptedArtifact.claimObligationExports, AverCert.AcceptedArtifact.manifestObligationExportsUnique, AverCert.AcceptedArtifact.stringListNodup, data, compositionMembers, compositionClaims]\n", - " exact {composition_proof}\n\n", - "theorem wholeModuleAccepted : AverCert.AcceptedArtifact.acceptedWholeModule data := by\n", - "{artifact_dsimp}", - " exact ⟨rfl, rfl, rfl, rfl, rfl⟩\n\n", - "theorem fragmentsAccepted : AverCert.AcceptedArtifact.acceptedFragments data := by\n", - " dsimp [AverCert.AcceptedArtifact.acceptedFragments]\n", - " exact ⟨symFragmentsAccepted, stringEqFragmentsAccepted, stringConcatFragmentsAccepted, constructFragmentsAccepted, recursionFragmentsAccepted, mutualFragmentsAccepted, verbatimFragmentsAccepted, intDispatchFragmentsAccepted, fieldProjectionFragmentsAccepted, compositionFragmentsAccepted, wholeModuleAccepted⟩\n\n", - "theorem acceptedWithFinal\n", - " (finalCert : AverCert.Schema.Holds AverCert.manifest) :\n", - " AverCert.AcceptedArtifact.accepted data := by\n", - " dsimp [AverCert.AcceptedArtifact.accepted, AverCert.AcceptedArtifact.subjectMatchesArtifactRoot, AverCert.AcceptedArtifact.expectedArtifactRoot]\n", - " exact ⟨finalCert, artifactEnvelopeAccepted, rfl, claimObligationsBound, claimsMatchManifest, standardFacesChecked, claimAxesChecked, decodedNonExprFacts, fragmentsAccepted⟩\n" - ), - obligation_proof_step = obligation_proof_step, - sym_proof_step = family_exact(&claims.sym_proof), - string_eq_proof_step = family_exact(&claims.string_eq_proof), - string_proof_step = family_exact(&claims.string_proof), - construct_proof = claims.construct_proof, - recursion_proof_step = family_exact(&claims.recursion_proof), - mutual_proof = claims.mutual_proof, - verbatim_proof_step = family_exact(&claims.verbatim_proof), - int_dispatch_proof_step = family_exact(&claims.int_dispatch_proof), - field_projection_proof_step = family_exact(&claims.field_projection_proof), - composition_proof = claims.composition_proof, - artifact_dsimp = artifact_dsimp, - face_dsimp = face_dsimp, - string_concat_face_proof = claims.string_concat_face_proof, - construct_face_proof = claims.construct_face_proof, - int_dispatch_face_proof = claims.int_dispatch_face_proof, - sym_face_step = if claims.sym_faces_have_record { - format!(" · exact {}\n", claims.sym_face_proof) - } else { - " · repeat' constructor\n".to_string() - }, - ); - // The whole-module arith host-role pin (`decodedHostRoleTable`) is the one - // per-module conjunct whose `decide +kernel` reduction sits well above the - // import floor: it materialises five decoded function bodies and five - // synthesised helper bodies in a single kernel term. A carriered module - // proves each role in its own freed leaf theorem in a SEPARATE compilation - // unit (`ArtifactHostRoles.lean`) and recombines them here with a cheap - // rewrite, so neither the leaf peak nor this module's other theorems pay - // for the monolith. A carrierless module has no table to split — its - // `arithTableCheck` is the floor-cost `carrierHelperAbsent` scan — so it - // keeps the single-tactic proof and emits no leaf file. - let (host_roles_import, decoded_host_roles_proof) = render_decoded_host_roles(analysis); - format!( - "-- Artifact-carried acceptance root.\n\ - -- This file is useful metadata, not verifier authority: `aver cert verify`\n\ - -- pins its bytes and manifest to checker-owned inputs and\n\ - -- audits `AverCert.Artifact.certificate` through the Lean axiom collector.\n\ - import AcceptedArtifact\n\ - import ArtifactBytes\n\ - import ArtifactComponentBytes\n\ - import Certificate\n\ - import Manifest\n\ - import Plans\n\ - {host_roles_import}\ - import AcceptanceSoundness\n\n\ - -- The whole-module big-Nat closure fold is kernel reduction. This\n\ - -- explicit depth budget affects kernel reduction limits only, not soundness or axioms.\n\ - set_option maxRecDepth 200000\n\ - -- Companion budget for the elaborator, matching the one Certificate.lean\n\ - -- already carries. Precautionary rather than a fix for an observed\n\ - -- failure: this proof is one fixed shape repeated per claim, so its\n\ - -- elaboration cost grows with the size of the artifact, and the stock\n\ - -- allowance is the only thing here that was never stated explicitly.\n\ - -- Like the depth budget above it moves a resource limit only: no axiom,\n\ - -- no trusted hypothesis, no change to what the kernel must accept.\n\ - set_option maxHeartbeats 1600000\n\ - set_option linter.unusedSimpArgs false\n\n\ - namespace AverCert.Artifact\n\n\ - def symFragmentClaims : List AverCert.AcceptedArtifact.SymFragmentClaim := {sym_claims_list}\n\n\ - def stringEqClaims : List AverCert.AcceptedArtifact.StringEqClaim := {string_eq_claims_list}\n\n\ - def stringConcatClaims : List AverCert.AcceptedArtifact.StringConcatClaim := {string_claims_list}\n\n\ - def constructClaims : List AverCert.AcceptedArtifact.ConstructClaim := {construct_claims_list}\n\n\ - def recursionClaims : List AverCert.AcceptedArtifact.RecursionClaim := {recursion_claims_list}\n\n\ - def mutualRecursionClaims : List AverCert.AcceptedArtifact.MutualRecursionClaim := {mutual_claims_list}\n\n\ - def verbatimClaims : List AverCert.AcceptedArtifact.VerbatimClaim := {verbatim_claims_list}\n\n\ - def intDispatchClaims : List AverCert.AcceptedArtifact.IntDispatchClaim := {int_dispatch_claims_list}\n\n\ - def fieldProjectionClaims : List AverCert.AcceptedArtifact.FieldProjectionClaim := {field_projection_claims_list}\n\n\ - def compositionMembers : List AverCert.AcceptedArtifact.CompositionMemberClaim := {composition_members_list}\n\n\ - def compositionClaims : List AverCert.AcceptedArtifact.CompositionClaim := {composition_claims_list}\n\n\ - def closureClaim : AverCert.AcceptedArtifact.ClosureClaim := {closure_claim}\n\n\ - {mutual_scc_closure_pins}\ - def data : AverCert.AcceptedArtifact.ArtifactData :=\n \ - ({{ modBytes := AverCert.ArtifactBytes.modBytes, modLen := AverCert.ArtifactBytes.modLen, manifest := AverCert.manifest, wasip2ComponentEnvelope := {wasip2_component_envelope}, symFragmentClaims := symFragmentClaims, stringEqClaims := stringEqClaims, stringConcatClaims := stringConcatClaims, constructClaims := constructClaims, recursionClaims := recursionClaims, mutualRecursionClaims := mutualRecursionClaims, verbatimClaims := verbatimClaims, intDispatchClaims := intDispatchClaims, fieldProjectionClaims := fieldProjectionClaims, compositionMembers := compositionMembers, compositionClaims := compositionClaims, closureFuel := {closure_fuel}, closureClaim := closureClaim }} : AverCert.AcceptedArtifact.ArtifactData)\n\n\ - theorem artifactEnvelopeAccepted : AverCert.AcceptedArtifact.artifactEnvelopeAccepted AverCert.ArtifactComponentBytes.componentBytes AverCert.ArtifactComponentBytes.componentLen data = true := by\n \ - dsimp [AverCert.AcceptedArtifact.artifactEnvelopeAccepted, data]\n \ - rfl\n\n\ - {decoded_host_roles_proof}\n\n\ - theorem decodedStringHostRoles : CertDecode.StringHost.roleTable AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen = some AverCert.manifest.subject.stringHostRoles := by change AverCert.AcceptedArtifact.decodedStringHostRoles data; dsimp [AverCert.AcceptedArtifact.decodedStringHostRoles, data]; rfl\n\n\ - {claim_proof_bundles}\ - {proof_bundles}\n\n\ - {side_conditions}\n\ - end AverCert.Artifact\n", - sym_claims_list = claims.sym_claims, - string_eq_claims_list = claims.string_eq_claims, - string_claims_list = claims.string_claims, - construct_claims_list = claims.construct_claims, - recursion_claims_list = claims.recursion_claims, - mutual_claims_list = claims.mutual_claims, - verbatim_claims_list = claims.verbatim_claims, - int_dispatch_claims_list = claims.int_dispatch_claims, - field_projection_claims_list = claims.field_projection_claims, - composition_members_list = claims.composition_members, - composition_claims_list = claims.composition_claims, - closure_claim = closure_claim, - closure_fuel = analysis.module_envelope.closure_fuel, - wasip2_component_envelope = wasip2_component_envelope, - mutual_scc_closure_pins = render_mutual_scc_closure_pins(analysis), - claim_proof_bundles = claims.claim_proof_bundles, - proof_bundles = proof_bundles, - side_conditions = render_discharge_side_conditions(analysis, model_info), - host_roles_import = host_roles_import, - decoded_host_roles_proof = decoded_host_roles_proof, - ) -} - -/// The `import` line for the per-role leaf module and the proof of the -/// whole-module `decodedHostRoles` theorem. -/// -/// * Carriered module — the leaf theorems live in `ArtifactHostRoles.lean` -/// (emitted by `render_project`); the aggregate rewrites the manifest -/// projections to their literals, unfolds `arithTableCheck`, and rewrites the -/// seven `arithRoleCheck` subterms to `true` from the imported leaves, leaving -/// only the floor-cost carrier/index conjuncts for a final `decide +kernel`. -/// The statement is byte-identical to the monolith; only the proof changes. -/// * Carrierless module — no table, no leaf file, and the original single -/// `decide +kernel` (its `arithTableCheck` is the floor-cost -/// `carrierHelperAbsent` scan). -fn render_decoded_host_roles(analysis: &Analysis) -> (String, String) { - let carriered = analysis.frag_host_table.box_idx.is_some(); - if !carriered { - return ( - String::new(), - "theorem decodedHostRoles : AverCert.AcceptedArtifact.decodedHostRoleTable data := \ - by dsimp [AverCert.AcceptedArtifact.decodedHostRoleTable, data]; decide +kernel" - .to_string(), - ); - } - let roles_literal = analysis.frag_host_table.roles_lean_value(); - let params_literal = analysis - .frag_host_table - .arith_params_record_lean_value(analysis.carrier) - .expect("a carriered module declares arith params"); - let proof = format!( - "theorem decodedHostRoles : AverCert.AcceptedArtifact.decodedHostRoleTable data := by\n \ - dsimp only [AverCert.AcceptedArtifact.decodedHostRoleTable, data]\n \ - rw [show AverCert.manifest.subject.hostRoleTable = some {roles_literal} from rfl,\n \ - show AverCert.manifest.subject.arithParams = some {params_literal} from rfl]\n \ - simp only [AverCert.AcceptedArtifact.arithTableCheck, decodedHostRole_box, \ - decodedHostRole_toIndex, decodedHostRole_add, decodedHostRole_sub, decodedHostRole_mul, \ - decodedHostRole_cmp, decodedHostRole_eq, \ - Bool.and_true, Bool.true_and]\n \ - decide +kernel" - ); - ("import ArtifactHostRoles\n".to_string(), proof) -} - -/// The separate compilation unit that proves each declared arith host role in -/// its own freed `decide +kernel` leaf theorem. Isolating them from the rest of -/// `Artifact.lean` keeps the module peak at the shared import/whole-module-fold -/// shelf instead of stacking the per-role reductions on top of it. Emitted only -/// for a carriered module; the aggregate in `Artifact.lean` recombines these. -fn render_artifact_host_roles(analysis: &Analysis) -> String { - let params_literal = analysis - .frag_host_table - .arith_params_record_lean_value(analysis.carrier) - .expect("a carriered module declares arith params"); - let table = &analysis.frag_host_table; - let leaf = |name: &str, role: &str, idx: Option| { - let idx = idx.map_or_else(|| "none".to_string(), |idx| format!("(some {idx})")); - format!( - "theorem decodedHostRole_{name} : \ - AverCert.AcceptedArtifact.arithRoleCheck AverCert.ArtifactBytes.modBytes \ - AverCert.ArtifactBytes.modLen ArithTemplateDerisk.ArithRole.{role} {idx} \ - {params_literal} = true := by decide +kernel" - ) - }; - let leaves = [ - leaf("box", "box", table.box_idx), - leaf("toIndex", "toIndex", table.to_index_idx), - leaf("add", "add", table.add_idx), - leaf("sub", "sub", table.sub_idx), - leaf("mul", "mul", table.mul_idx), - leaf("cmp", "cmp", table.cmp_idx), - leaf("eq", "eq", table.eq_idx), - ] - .join("\n\n"); - format!( - "-- Per-role arith host-table leaves for `Artifact.decodedHostRoles`.\n\ - -- Each role's template equality is checked and freed in its own\n\ - -- `decide +kernel` declaration, in this separate compilation unit, so\n\ - -- the whole-module proof never materialises all seven at once.\n\ - import AcceptedArtifact\n\ - import ArtifactBytes\n\n\ - set_option maxRecDepth 200000\n\n\ - namespace AverCert.Artifact\n\n\ - {leaves}\n\n\ - end AverCert.Artifact\n" - ) -} - -/// Final acceptance wrapper kept separate from artifact data so `Final.lean` -/// can consume the byte/plan acceptance facts without an import cycle. -fn render_artifact_certificate() -> String { - r#"import Artifact -import Final - -namespace AverCert.Artifact - -theorem certificate : AverCert.AcceptedArtifact.accepted data := - acceptedWithFinal AverCert.Final.cert - -#print axioms AverCert.Artifact.certificate - -end AverCert.Artifact -"# - .to_string() -} - -/// Per-artifact glue from the hash-parametric audited wall to the real schema. -/// This module deliberately remains outside the sha-pinned wall because its -/// conclusion mentions the generated `CertModule.wasmSha256` through -/// `AverCert.Schema.Holds`. -fn render_artifact_soundness() -> String { - r#"import Artifact -import AcceptanceSoundness - -namespace AverCert.ArtifactSoundness - -/-- Instantiate the artifact-independent acceptance wall at this artifact's real -wasm hash. The remaining semantic bridge assumptions are still explicit. -/ -theorem accept_sound_holds - (hSide : AcceptanceSoundness.dischargeSideConditions AverCert.Artifact.data) : - AverCert.Schema.Holds AverCert.Artifact.data.manifest := by - exact AcceptanceSoundness.accept_sound CertModule.wasmSha256 AverCert.Artifact.data - rfl rfl rfl - AverCert.Artifact.claimObligationsBound - AverCert.Artifact.standardFacesChecked - AverCert.Artifact.fragmentsAccepted hSide - -end AverCert.ArtifactSoundness -"# - .to_string() -} - -/// One redundant-but-honest closure pin per mutual-recursion SCC (emitted for the -/// primary member so each SCC appears once): the byte-derived -/// `(self, cross-target, memberSet)` triples the artifact's claims carry, -/// asserted to form a single closed cycle by the audited -/// `mutualMembersFormClosedSccs`. The artifact's `acceptedWithFinal` proof -/// already binds this closure over the real claims; this concrete pin documents -/// the byte-derived SCC group and gives the checker a self-contained surface -/// that fails closed if the group is not one closed cycle (a member's declared -/// set diverging, an extra/omitted/duplicate member, or a broken cross-edge). -fn render_mutual_scc_closure_pins(analysis: &Analysis) -> String { - let mut out = String::new(); - for c in &analysis.certs { - let Cert::MutualRecursion { - position, scc, name, .. - } = c.inner() - else { - continue; - }; - if *position != 0 { - continue; - } - if mutual_plan_from_cert(c).is_none() { - continue; - } - let member_set = mutual_member_set_lean_value(scc); - let members = scc - .iter() - .map(|m| format!("({}, {}, {member_set})", m.self_idx, m.cross_idx)) - .collect::>() - .join(", "); - out.push_str(&format!( - "/-- The byte-derived `{name}` SCC forms one closed mutual-recursion cycle. -/\n\ - example : AverCert.AcceptedArtifact.mutualMembersFormClosedSccs [{members}] = true := rfl\n\n", - )); - } - out -} - -/// Render a module carrier state as a Lean `Option Nat` literal. `none` is the -/// byte-proved carrierless state, not a missing value. -fn render_carrier_state(carrier: Option) -> String { - match carrier { - Some(idx) => format!("(some {idx})"), - None => "none".to_string(), - } -} - -fn render_byte_list(bytes: &[u8]) -> String { - let parts = bytes - .iter() - .map(|b| b.to_string()) - .collect::>() - .join(", "); - format!("[{parts}]") -} - -pub fn render_artifact_bytes_lean(wasm_bytes: &[u8]) -> String { - crate::wall::render_artifact_bytes(wasm_bytes) -} - -pub fn render_artifact_component_bytes_lean(artifact_bytes: &[u8]) -> String { - crate::wall::render_artifact_component_bytes(artifact_bytes) -} - -/// Write one file of the certificate project. -/// -/// `name` may be a nested path: a module declared as `Data.Fibonacci` transpiles -/// to `Data/Fibonacci.lean`. The certificate directory is cleared and recreated -/// at the start of rendering, so intermediate directories never survive from a -/// previous run and have to be made here — without this, every project with a -/// dotted module dependency failed to emit a certificate at all. -fn write(dir: &Path, name: &str, content: &str) -> Result<(), String> { - let path = dir.join(name); - if let Some(parent) = path.parent() { - std::fs::create_dir_all(parent) - .map_err(|e| format!("create directory for {name}: {e}"))?; - } - std::fs::write(path, content).map_err(|e| format!("write {name}: {e}")) -} - -fn sanitize_model_for_cert(content: &str) -> String { - let mut out = String::with_capacity(content.len()); - for line in content.lines() { - if line.trim_start().starts_with("deriving ") { - continue; - } - out.push_str(line); - out.push('\n'); - } - out -} - -fn hex(bytes: &[u8]) -> String { - let mut s = String::with_capacity(bytes.len() * 2); - for b in bytes { - s.push_str(&format!("{b:02x}")); - } - s -} - -fn render_contracts(analysis: &Analysis) -> String { - let mut s = String::new(); - s.push_str( - "/-\n Named runtime-layer contracts consumed by the certificates in this project.\n\n\ - Each is threaded as an explicit HYPOTHESIS of the certificate theorems (the\n\ - `hadd` / `hAdd` / `hSub` / `boxRef` faces in `Certificate.lean`), never as a\n\ - Lean `axiom`, so `#print axioms` on every certificate theorem stays on the\n\ - core whitelist `[propext, Classical.choice, Quot.sound]`. The obligations\n\ - below are the \"prove once per toolchain release\" runtime layer; the\n\ - machine-readable list is `cert-manifest.json`.\n\n", - ); - if analysis.contracts.is_empty() { - s.push_str(" (no user function was certified — no runtime contracts consumed)\n"); - } else { - for c in &analysis.contracts { - s.push_str(&format!(" * {c}\n")); - } - } - s.push_str("-/\n"); - s -} - -fn render_module(analysis: &Analysis, artifact_file_name: &str, sha: &str) -> String { - let mut s = String::new(); - s.push_str(&format!( - "-- Emitted user-function bodies as `CertPrelude.WInstr` data, plus the\n\ - -- sha256 of the final `{artifact_file_name}` bytes (pinned).\n\ - import CertPrelude\n\nnamespace CertModule\nopen CertPrelude\n\n", - )); - s.push_str(&format!( - "/-- sha256 of the certified `{artifact_file_name}` artifact bytes. -/\n\ - def wasmSha256 : String := \"{sha}\"\n\n", - )); - for c in &analysis.certs { - s.push_str(&render_code_def(c)); - s.push('\n'); - s.push_str(&render_host_def(c)); - s.push('\n'); - } - s.push_str("end CertModule\n"); - s -} - -/// The runtime host-contract wiring for a certified body, as data in -/// `CertModule` so both the certificate proofs and the manifest reference the -/// one definition. -fn render_host_def(c: &Cert) -> String { - match c.inner() { - Cert::Recursive { - name, - carrier, - box_idx, - add_idx, - sub_idx, - combinator, - .. - } => { - let cp = combinator.param(); - format!( - "/-- Runtime host wiring for `{name}` (box + {cp} + sub contracts). -/\n\ - def {name}Host ({cp} sub : List WVal → Option WVal) : HostTbl := fun fn =>\n \ - if fn = {box_idx} then some (1, boxRef {carrier})\n \ - else if fn = {add_idx} then some (2, {cp})\n \ - else if fn = {sub_idx} then some (2, sub)\n else none\n", - ) - } - Cert::AccumulatorRecursive { - name, - carrier, - box_idx, - add_idx, - sub_idx, - .. - } => format!( - "/-- Runtime host wiring for `{name}` (box + add + sub contracts). -/\n\ - def {name}Host (add sub : List WVal → Option WVal) : HostTbl := fun fn =>\n \ - if fn = {box_idx} then some (1, boxRef {carrier})\n \ - else if fn = {add_idx} then some (2, add)\n \ - else if fn = {sub_idx} then some (2, sub)\n else none\n", - ), - Cert::AdtConstructor { name, .. } - | Cert::FieldProjection { name, .. } - | Cert::VerbatimWidenedMatch { name, .. } - | Cert::VerbatimVariantDispatch { name, .. } - | Cert::ExprFragment { name, .. } => format!( - "/-- Runtime host wiring for `{name}` (no host calls). -/\n\ - def {name}Host : HostTbl := fun _ => none\n", - ), - Cert::StringEqVerbatimMatch { - name, - string_eq_idx, - .. - } => format!( - "/-- Runtime host wiring for `{name}` (String.eq contract). -/\n\ - def {name}Host (stringEq : List WVal → Option WVal) : HostTbl := fun fn =>\n \ - if fn = {string_eq_idx} then some (2, stringEq)\n else none\n", - ), - Cert::StringConcatVerbatimMatch { - name, - string_concat_idx, - result_ty, - .. - } => format!( - "/-- Runtime host wiring for `{name}` (String.concat contract). -/\n\ - def {name}Host (stringConcat : Nat → List WVal → Option WVal) : HostTbl := fun fn =>\n \ - if fn = {string_concat_idx} then some (1, stringConcat {result_ty})\n else none\n", - ), - Cert::WidenedIntMatch { - name, - carrier, - box_idx, - .. - } => format!( - "/-- Runtime host wiring for `{name}` (box contract for the default `0`). -/\n\ - def {name}Host : HostTbl := fun fn =>\n \ - if fn = {box_idx} then some (1, boxRef {carrier})\n else none\n", - ), - Cert::VariantDispatch { - name, - carrier, - box_idx, - add_idx, - sub_idx, - .. - } => { - let a = if add_idx.is_some() { "add" } else { "_add" }; - let s = if sub_idx.is_some() { "sub" } else { "_sub" }; - let mut chain = format!("if fn = {box_idx} then some (1, boxRef {carrier})"); - if let Some(i) = add_idx { - chain.push_str(&format!("\n else if fn = {i} then some (2, add)")); - } - if let Some(i) = sub_idx { - chain.push_str(&format!("\n else if fn = {i} then some (2, sub)")); - } - format!( - "/-- Runtime host wiring for `{name}` (box + contracted arithmetic). -/\n\ - def {name}Host ({a} {s} : List WVal → Option WVal) : HostTbl := fun fn =>\n \ - {chain}\n else none\n", - ) - } - Cert::Composition { name, closure, .. } => format!( - "/-- Runtime host wiring for `{name}`'s call closure (add contract). -/\n\ - def {name}Host (add _sub : List WVal → Option WVal) : HostTbl := fun fn =>\n {}\n", - compose_host_arms(closure), - ), - // The whole SCC shares ONE host, emitted once by the primary member. - Cert::MutualRecursion { - scc, - position, - carrier, - box_idx, - sub_idx, - .. - } => { - if *position != 0 { - String::new() - } else { - let primary = &scc[0].name; - format!( - "/-- Runtime host wiring for the mutual-recursive SCC `{primary}` (box + sub). -/\n\ - def {primary}Host (sub : List WVal → Option WVal) : HostTbl := fun fn =>\n \ - if fn = {box_idx} then some (1, boxRef {carrier})\n \ - else if fn = {sub_idx} then some (2, sub)\n else none\n", - ) - } - } - Cert::NonRecursive { .. } => unreachable!(), - } -} - -fn render_code_def(c: &Cert) -> String { - // The SCC shares ONE code table (all members' arms), named after the primary - // (lowest-`self_idx`) member and emitted once by it. - if let Cert::MutualRecursion { scc, position, .. } = c.inner() { - if *position != 0 { - return String::new(); - } - let primary = &scc[0].name; - return format!( - "/-- Verbatim shared code table for the mutual-recursive SCC `{primary}` \ - (one arm per member). -/\n\ - def {primary}Code : CodeTbl := {value}\n", - value = render_code_value(c), - ); - } - let doc = match c.inner() { - Cert::Recursive { .. } => "self-recursive", - Cert::AccumulatorRecursive { .. } => "accumulator self-recursive", - Cert::AdtConstructor { .. } => "ADT constructor", - Cert::FieldProjection { .. } => "field projection", - Cert::WidenedIntMatch { .. } => "widened Int variant match", - Cert::VerbatimWidenedMatch { .. } => "verbatim widened variant match", - Cert::VerbatimVariantDispatch { .. } => "verbatim variant dispatch", - Cert::StringEqVerbatimMatch { .. } => "verbatim String equality match", - Cert::StringConcatVerbatimMatch { .. } => "verbatim String concatenation match", - Cert::ExprFragment { .. } => "expr-fragment-v1", - Cert::VariantDispatch { .. } => "general variant dispatch", - Cert::Composition { .. } => "cross-function composition, whole call closure", - Cert::MutualRecursion { .. } => "mutual-recursive SCC", - Cert::NonRecursive { .. } => unreachable!(), - }; - format!( - "/-- Verbatim emitted body of `{name}` ({doc}). -/\n\ - def {name}Code : CodeTbl := {value}\n", - name = c.name(), - value = render_code_value(c), - ) -} - -// Code-value helpers live in render_code.rs. - -#[cfg(test)] -mod render_project_tests { - use super::model_root_from_stem; - - #[test] - fn model_roots_become_dotted_lean_module_names() { - assert_eq!(model_root_from_stem("AverCommon").unwrap(), "AverCommon"); - assert_eq!( - model_root_from_stem("Apps/Notepad/Store").unwrap(), - "Apps.Notepad.Store" - ); - assert!(model_root_from_stem("Apps/../Store").is_err()); - assert!(model_root_from_stem("Apps/Bad Name").is_err()); - assert!(model_root_from_stem("").is_err()); - } - - /// The plan `def`s carry the package's authority and every other emitted - /// file cites them by name; the `example`s are anonymous restatements of - /// equalities the acceptance predicates already state. Only the latter go. - #[test] - fn plan_examples_are_dropped_and_plan_definitions_are_not() { - let rendered = "\ -import Schema - -set_option maxRecDepth 200000 - -namespace AverCert.Plans - -/-- Byte-derived plan for `f`. -/ -def fPlan : ExprFragmentRawPlan := { profile := \"v1\" } - -/-- The audited checker accepts `f`'s plan. -/ -example : AverCert.PlanCheck.checkExprFragmentRawPlan fPlan = true := rfl - -/-- The Wasm slicer finds `f`'s export binding. -/ -example : (AverCert.WasmSlice.exactFuncBindingForExport modBytes modLen [102] c) = - some binding := rfl - -/-- Byte-derived plan for `g`. -/ -def gPlan : ExprFragmentRawPlan := { profile := \"v1\" } - -end AverCert.Plans -"; - let filtered = super::without_plan_examples(rendered); - assert!(!filtered.contains("example"), "no example survives:\n{filtered}"); - assert!(!filtered.contains("audited checker accepts")); - assert!(!filtered.contains("Wasm slicer finds")); - for kept in [ - "import Schema", - "set_option maxRecDepth 200000", - "namespace AverCert.Plans", - "/-- Byte-derived plan for `f`. -/\ndef fPlan : ExprFragmentRawPlan := { profile := \"v1\" }", - "/-- Byte-derived plan for `g`. -/\ndef gPlan : ExprFragmentRawPlan := { profile := \"v1\" }", - "end AverCert.Plans", - ] { - assert!(filtered.contains(kept), "`{kept}` must survive:\n{filtered}"); - } - } - - /// The filter is fail-safe toward keeping: a block that carries a real - /// declaration alongside the word `example` is not this renderer's shape, - /// and survives verbatim rather than being guessed away. - #[test] - fn a_block_carrying_a_declaration_survives() { - let rendered = "def keepMe : Nat := 1\nexample : keepMe = 1 := rfl\n"; - assert_eq!(super::without_plan_examples(rendered), rendered); - } -} diff --git a/aver-cert/src/engine/render_recursion_bridge.rs b/aver-cert/src/engine/render_recursion_bridge.rs deleted file mode 100644 index 11a7c7d4a..000000000 --- a/aver-cert/src/engine/render_recursion_bridge.rs +++ /dev/null @@ -1,287 +0,0 @@ -/// The audited `RecursionSoundness` generic covers the four unary descent-by-one operand -/// shapes with either the `Int.add` or `Int.mul` semantic combinator. The -/// two-argument accumulator has its own arity-pinned audited shape. -fn recursion_uses_audited_generic(c: &Cert) -> bool { - matches!( - c.inner(), - Cert::Recursive { .. } | Cert::AccumulatorRecursive { .. } - ) -} - -fn recursion_shape_lean_value(c: &Cert) -> String { - let Cert::Recursive { - base_k, - rec_first, - other, - .. - } = c.inner() - else { - unreachable!("only unary recursion has a RecursionSoundness shape") - }; - let step = match (*rec_first, *other) { - (false, BodyOperand::Input) => ".inputSecond".to_string(), - (false, BodyOperand::Const(k)) => { - format!(".constSecond ({})", lean_int_lit(k)) - } - (true, BodyOperand::Input) => ".inputFirst".to_string(), - (true, BodyOperand::Const(k)) => { - format!(".constFirst ({})", lean_int_lit(k)) - } - }; - format!( - "({{ base := {}, step := {step} }} : RecursionSoundness.RecShapeU)", - lean_int_lit(*base_k) - ) -} - -fn recursion_combine_lean_value(c: &Cert) -> &'static str { - let Cert::Recursive { combinator, .. } = c.inner() else { - unreachable!("only unary recursion has a RecursionSoundness combinator") - }; - match combinator { - Combinator::Add => ".add", - Combinator::Mul => ".mul", - } -} - -fn recursion_claim_lean_value(c: &Cert) -> String { - let (name, carrier) = match c.inner() { - Cert::Recursive { name, carrier, .. } - | Cert::AccumulatorRecursive { name, carrier, .. } => (name, carrier), - _ => unreachable!("audited recursion claim has a recursion shape"), - }; - format!( - "({{ exportNameBytes := {}, exportName := {}, carrier := {carrier}, \ - hostTable := {}, obligation := AverCert.{name}Ob }} : \ - AverCert.AcceptedArtifact.RecursionClaim)", - render_byte_list(name.as_bytes()), - lean_str(name), - recursion_host_table_lean_value(c), - ) -} - -/// Render the companion `{name}_recursionClaimAccepted` theorem as a SPLIT -/// proof, mirroring `render_recursion_claim_bundles` in `render_project.rs`. -/// -/// This bridge module re-proves acceptance for its export in a STANDALONE file, -/// so the same monolithic witness tuple that inflated the artifact root also -/// inflated this module. Emitting the lowered body, code-entry bytes and -/// function binding as named `def`s and each byte-walking conjunct as its own -/// leaf theorem keeps this module's per-claim peak at the largest single leaf. -/// The leaves are stated over `AverCert.Plans.{name}RecursionPlan`, so the -/// aggregate re-runs no byte-decode work. -fn render_recursion_bridge_claim_accepted(c: &Cert) -> String { - let (name, self_idx, type_idx, carrier) = match c.inner() { - Cert::Recursive { - name, - self_idx, - type_idx, - carrier, - .. - } - | Cert::AccumulatorRecursive { - name, - self_idx, - type_idx, - carrier, - .. - } => (name, self_idx, type_idx, carrier), - _ => unreachable!("audited recursion acceptance has a recursion shape"), - }; - let plan_cert = recursion_plan_from_cert(c).expect("audited recursion has a canonical plan"); - let lowered_body = lower_expr_fragment_plan(&plan_cert, *carrier) - .map(|ops| render_ops_value(&ops)) - .expect("audited recursion plan lowers to WInstr"); - let code_entry_bytes = lower_expr_fragment_plan_code_entry_bytes(&plan_cert, *carrier) - .expect("audited recursion plan lowers to exact code-entry bytes"); - let code_entry_bytes = render_byte_list(&code_entry_bytes); - let export_name_bytes = render_byte_list(name.as_bytes()); - let host_table = recursion_host_table_lean_value(c); - let claim = recursion_claim_lean_value(c); - - let body = format!("{name}RecursionClaimBody"); - let code_entry = format!("{name}RecursionClaimCodeEntry"); - let binding = format!("{name}RecursionClaimBinding"); - let check_plan = format!("{name}RecursionClaimCheckPlan"); - let lower_body = format!("{name}RecursionClaimLowerBody"); - let lower_code = format!("{name}RecursionClaimLowerCode"); - let func_binding = format!("{name}RecursionClaimFuncBinding"); - let check_shape = format!("{name}RecursionClaimCheckShape"); - let func_type = format!("{name}RecursionClaimFuncType"); - let host_types = format!("{name}RecursionClaimHostTypes"); - let plan = format!("AverCert.Plans.{name}RecursionPlan"); - let obligation = format!("AverCert.{name}Ob"); - format!( - "-- Witness data for `{name}` as named constants so no large literal is\n\ - -- duplicated across the leaf statements or baked into the aggregate term.\n\ - def {body} : List CertPrelude.WInstr := {lowered_body}\n\n\ - def {code_entry} : AverCert.WasmSlice.ByteSeq := {code_entry_bytes}\n\n\ - def {binding} : AverCert.WasmSlice.FuncBinding :=\n \ - {{ funcIdx := {self_idx}, typeIdx := {type_idx}, codeEntry := {code_entry} }}\n\n\ - -- One leaf theorem per acceptance conjunct; the heavy ones are the\n\ - -- `modBytes` binding decode and type-section walks.\n\ - theorem {check_plan} :\n \ - AverCert.PlanCheck.checkRecursionRawPlan {plan} = true := by\n \ - rfl\n\n\ - theorem {lower_body} :\n \ - AverCert.PlanLower.lowerRecursionBody {carrier} {plan} = some {body} := by\n \ - rfl\n\n\ - theorem {lower_code} :\n \ - AverCert.PlanBytes.lowerRecursionCodeEntry {carrier} {plan} = some {code_entry} := by\n \ - rfl\n\n\ - theorem {func_binding} :\n \ - AverCert.WasmSlice.exactFuncBindingForExport AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {export_name_bytes} {code_entry} = some {binding} := by\n \ - rfl\n\n\ - theorem {check_shape} :\n \ - AverCert.PlanCheck.checkRecursionPlanShape {binding}.funcIdx {host_table} {obligation}.totalityRole {plan} = true := by\n \ - rfl\n\n\ - theorem {func_type} :\n \ - AverCert.WasmSlice.funcTypeMatches AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {binding}.typeIdx {plan}.params.length {carrier} = true := by\n \ - rfl\n\n\ - theorem {host_types} :\n \ - AverCert.WasmSlice.hostTableFuncTypesMatch AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen {carrier} {host_table} = true := by\n \ - rfl\n\n\ - theorem {name}_recursionClaimAccepted :\n \ - AverCert.AcceptedArtifact.recursionClaimAccepted\n \ - AverCert.ArtifactBytes.modBytes AverCert.ArtifactBytes.modLen\n \ - AverCert.manifest {claim} := by\n \ - dsimp [AverCert.AcceptedArtifact.recursionClaimAccepted,\n \ - AverCert.AcceptedArtifact.recursionPlanForExport,\n \ - AverCert.AcceptedArtifact.recursionPlanAccepted]\n \ - exact ⟨rfl, rfl, {check_plan}, rfl, ⟨{body}, {code_entry}, {binding}, ⟨{lower_body}, {lower_code}, {func_binding}, rfl, {check_shape}, {func_type}, {host_types}, rfl⟩⟩⟩\n" - ) -} - -/// Option-(b) residual for one unary additive or multiplicative recursion obligation. The -/// generated proof identifies the byte-derived parsed shape and relates the -/// generated source model to the independent `RecursionSoundness.evalRecU` evaluator in -/// the represented obligation domain. Fuel induction and Wasm execution stay in the -/// sha-pinned `RecursionSoundness` / `DischargeRecursion` wall. -fn render_unary_recursion_semantic_bridge(c: &Cert, model_info: &ModelInfo) -> String { - let Cert::Recursive { - name, - box_idx, - add_idx, - sub_idx, - .. - } = c.inner() - else { - unreachable!() - }; - debug_assert!(recursion_uses_audited_generic(c)); - let model_name = c.model_lean_name(model_info); - let shape = recursion_shape_lean_value(c); - let combine = recursion_combine_lean_value(c); - let claim = recursion_claim_lean_value(c); - let claim_accepted = render_recursion_bridge_claim_accepted(c); - format!( - r#"/-! ### {name} — option-(b) recursion semantic bridge -/ - -{claim_accepted} -theorem {name}_recursionSemanticBridge : - AcceptanceSoundness.recursionSemanticBridge {claim} - AverCert.Plans.{name}RecursionPlan := by - have hModelFuel : ∀ fuel n, - RecursionSoundness.evalRecUFuel {combine} {shape} fuel n = {model_name}__fuel fuel n := by - intro fuel - induction fuel with - | zero => intro n; rfl - | succ fuel ih => - intro n - simp only [RecursionSoundness.evalRecUFuel, {model_name}__fuel] - split <;> simp_all [RecursionSoundness.stepEval, RecursionSoundness.combineEval] - have hModel : ∀ n, RecursionSoundness.evalRecU {combine} {shape} n = {model_name} n := by - intro n - simpa [RecursionSoundness.evalRecU, {model_name}] using hModelFuel (n.natAbs + 1) n - refine Or.inl ?_ - refine ⟨{combine}, {box_idx}, {add_idx}, {sub_idx}, {shape}, - rfl, rfl, ?_, ?_⟩ - · intro add sub mul stringEq stringConcat toIndex cmp eq - simpa [AverCert.{name}Ob, CertModule.{name}Host] - · intro S ns vs hDom - rcases hDom with ⟨hRepr, hLen⟩ - cases ns with - | nil => simp at hLen - | cons n ns => - cases ns with - | nil => - cases hRepr with - | cons hv htail => - cases htail - refine ⟨n, _, rfl, hv, ?_⟩ - intro w hw - simpa [AverCert.Schema.intRepr, hModel n] using hw - | cons _ _ => simp at hLen -#print axioms {name}_recursionSemanticBridge -"# - ) -} - -fn render_accumulator_recursion_semantic_bridge(c: &Cert, model_info: &ModelInfo) -> String { - let Cert::AccumulatorRecursive { - name, - box_idx, - add_idx, - sub_idx, - .. - } = c.inner() - else { - unreachable!() - }; - let model_name = c.model_lean_name(model_info); - let claim = recursion_claim_lean_value(c); - let claim_accepted = render_recursion_bridge_claim_accepted(c); - format!( - r#"/-! ### {name} — option-(b) accumulator recursion semantic bridge -/ - -{claim_accepted} -theorem {name}_recursionSemanticBridge : - AcceptanceSoundness.recursionSemanticBridge {claim} - AverCert.Plans.{name}RecursionPlan := by - have hModelFuel : ∀ fuel n acc, - RecursionSoundness.evalRecAFuel fuel n acc = {model_name}__fuel fuel n acc := by - intro fuel - induction fuel with - | zero => intro n acc; rfl - | succ fuel ih => - intro n acc - simp only [RecursionSoundness.evalRecAFuel, {model_name}__fuel] - split <;> simp_all - have hModel : ∀ n acc, RecursionSoundness.evalRecA n acc = {model_name} n acc := by - intro n acc - simpa [RecursionSoundness.evalRecA, {model_name}] using hModelFuel (n.natAbs + 1) n acc - refine Or.inr ?_ - refine ⟨{box_idx}, {add_idx}, {sub_idx}, .accumulator, - rfl, rfl, ?_, ?_⟩ - · intro add sub mul stringEq stringConcat toIndex cmp eq - simpa [AverCert.{name}Ob, CertModule.{name}Host] - · intro S ns vs hDom - rcases hDom with ⟨hRepr, hLen⟩ - cases hRepr with - | nil => simp at hLen - | cons hvn htail => - rename_i n vn ns1 vs1 - cases htail with - | nil => simp at hLen - | cons hvacc htail2 => - rename_i acc vacc ns2 vs2 - cases htail2 with - | nil => - refine ⟨n, acc, vn, vacc, rfl, hvn, hvacc, ?_⟩ - intro w hw - simpa [AverCert.Schema.intRepr, hModel n acc] using hw - | cons _ _ => simp at hLen -#print axioms {name}_recursionSemanticBridge -"# - ) -} - -fn render_recursion_semantic_bridge(c: &Cert, model_info: &ModelInfo) -> String { - match c.inner() { - Cert::Recursive { .. } => render_unary_recursion_semantic_bridge(c, model_info), - Cert::AccumulatorRecursive { .. } => { - render_accumulator_recursion_semantic_bridge(c, model_info) - } - _ => unreachable!(), - } -} diff --git a/aver-cert/src/engine/render_side_conditions.rs b/aver-cert/src/engine/render_side_conditions.rs deleted file mode 100644 index 01a1b2c3b..000000000 --- a/aver-cert/src/engine/render_side_conditions.rs +++ /dev/null @@ -1,280 +0,0 @@ -fn render_claim_cases( - certs: &[&Cert], - claims_def: &str, - mut render_arm: impl FnMut(&Cert) -> String, -) -> String { - if certs.is_empty() { - return format!( - " intro claim hClaim\n simp [data, {claims_def}] at hClaim\n" - ); - } - let pattern = std::iter::repeat_n("rfl", certs.len()) - .collect::>() - .join(" | "); - let mut out = format!( - " intro claim hClaim\n dsimp [data, {claims_def}] at hClaim\n \ - simp only [List.mem_cons, List.mem_singleton, List.mem_nil_iff,\n \ - List.not_mem_nil, or_false] at hClaim\n \ - rcases hClaim with {pattern}\n" - ); - for cert in certs { - out.push_str(" · "); - let arm = render_arm(cert); - let mut lines = arm.lines(); - if let Some(first) = lines.next() { - out.push_str(first); - out.push('\n'); - } - for line in lines { - out.push_str(" "); - out.push_str(line); - out.push('\n'); - } - } - out -} - -fn render_expr_side_arm(c: &Cert) -> String { - let name = c.name(); - // The selection arm sits at position seven of eight. Its side condition is - // purely the routing discriminator plus the family's partial-correctness - // policy; the discharge derives the obligation from the checked face, so - // no producer semantic premise participates. It is tested before the - // audited-generic arm: its source types sit inside that gate but its plan - // calls a runtime helper the generic grammar refuses. - if c.int_select_face().is_some() { - return String::from( - "exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨rfl, rfl⟩))))))", - ); - } - // The compute arm sits at position eight of eight: pure routing, the - // discharge derives the obligation from the checked compute face. It too - // is tested before the audited-generic arm — a scalar-parameter compute - // plan has Int/Bool source types and a plan the generic grammar refuses. - if c.record_compute_face().is_some() { - return String::from( - "exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inr rfl))))))", - ); - } - if expr_fragment_uses_audited_generic(c) { - return format!( - "exact Or.inl ⟨rfl, by\n intro plan hPlan\n injection hPlan with hPlan\n \ - subst plan\n exact CertProofs.{name}_exprFragmentSemanticBridge⟩" - ); - } - if c.tag_dispatch_face().is_some() { - return format!( - "exact Or.inr (Or.inl ⟨rfl, fun plan hp => by\n \ - have hpe : plan = AverCert.Plans.{name}Plan := by\n \ - have : (some AverCert.Plans.{name}Plan : Option AverCert.Schema.ExprFragmentRawPlan) = some plan := by\n \ - rw [← hp]; rfl\n exact (Option.some.inj this).symm\n \ - subst hpe\n exact CertProofs.{name}_exprFragmentSemanticBridge⟩)" - ); - } - if c.vector_get_face().is_some() { - return format!( - "exact Or.inr (Or.inr (Or.inl ⟨rfl, CertProofs.{name}_simulates⟩))" - ); - } - if let Some(face) = c.project_face() { - return format!( - "exact Or.inr (Or.inr (Or.inr (Or.inl ⟨rfl, by\n exact \ - AcceptanceSoundness.fieldProjection_direct_canonical_discharges \ - \"{name}\" {} {} {} {} CertModule.{name}Code \ - (fun _ _ _ _ _ _ _ _ => CertModule.{name}Host) (by decide) (by rfl)⟩)))", - c.carrier(), - face.struct_idx, - c.self_idx(), - face.field_idx, - ); - } - // The record-parameter arm sits at position six of eight: its side condition - // is purely the routing discriminator `exprFragmentIsRecordParam claim`, and - // the discharge derives the obligation from the checked record face — no - // producer semantic premise participates. - if c.record_param_face().is_some() { - return String::from( - "exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inr (Or.inl rfl)))))", - ); - } - let Cert::ExprFragment { plan, .. } = c.inner() else { - unreachable!() - }; - assert!( - plan.params.contains(&FragTy::F64) || plan.result == FragTy::F64, - "only float expression claims may use the bespoke residual: {name}" - ); - // The float arm sits at position five of eight: three arms were appended - // after it, so the float payload keeps its `Or.inl`. - format!( - "exact Or.inr (Or.inr (Or.inr (Or.inr (Or.inl ⟨rfl, CertProofs.{name}_simulates⟩))))" - ) -} - -fn render_string_side_arm(_c: &Cert) -> String { - String::from( - "intro plan hPlan\ninjection hPlan with hPlan\nsubst plan\nrefine ⟨rfl, ?_⟩\n\ - intro S x vs hDom\nrefine ⟨x, hDom, ?_⟩\nrfl" - ) -} - -fn render_construct_side_arm(c: &Cert, model_info: &ModelInfo) -> String { - if adt_constructor_uses_model(c, model_info) { - // Named-ADT constructor bridges are derived in the wall from the - // checked declared-envelope face; the residual list-slice hypothesis - // excludes this claim by its named result. - let ret = model_info - .fns - .get(c.name()) - .map(|sig| sig.ret.clone()) - .expect("model-bearing ADT constructor has a source signature"); - return format!( - "intro hNamed\nexact absurd rfl (hNamed \"{ret}\")" - ); - } - String::from( - "intro _hNamed plan hPlan\ninjection hPlan with hPlan\nsubst plan\nrefine ⟨rfl, ?_⟩\n\ - intro S x args hDom\nsubst args\nconstructor <;> rfl", - ) -} - -fn render_recursion_side_arm(c: &Cert) -> String { - let name = c.name(); - format!( - "intro plan hPlan\n\ - dsimp [AverCert.AcceptedArtifact.recursionPlanForExport] at hPlan\n\ - injection hPlan with hPlan\nsubst plan\n\ - exact CertProofs.{name}_recursionSemanticBridge" - ) -} - -fn render_mutual_side_arm(c: &Cert) -> String { - let Cert::MutualRecursion { name, scc, .. } = c.inner() else { - unreachable!() - }; - let primary = &scc[0].name; - let claim_defs = scc - .iter() - .map(|member| format!("CertProofs.{}_mutualClaim", member.name)) - .collect::>() - .join(", "); - format!( - "intro plan hPlan\n\ - dsimp [AverCert.AcceptedArtifact.mutualPlanForExport] at hPlan\n\ - injection hPlan with hPlan\nsubst plan\n\ - simpa [AcceptanceSoundness.mutualSemanticBridge, data, mutualRecursionClaims, \ - CertProofs.{primary}_mutualArtifact, \ - CertProofs.{primary}_mutualClaims, \ - {claim_defs}] using \ - CertProofs.{name}_mutualSemanticBridge" - ) -} - -fn render_verbatim_side_arm(_c: &Cert) -> String { - String::from( - "intro plan hPlan\ninjection hPlan with hPlan\nsubst plan\n\ - refine ⟨rfl, ?_⟩\nintro S x vs hDom\n\ - exact ⟨x, hDom, by rfl⟩" - ) -} - -fn render_field_projection_side_arm(_c: &Cert) -> String { - String::from( - "intro plan hPlan\ninjection hPlan with hPlan\nsubst plan\n\ - refine ⟨rfl, rfl, ?_⟩\nintro S x vs hDom\n\ - exact ⟨x.1, x.2, hDom, by rfl⟩" - ) -} - -fn render_composition_side_arm(c: &Cert) -> String { - let name = c.name(); - format!( - "intro rootMember hRoot callees hShape\n\ - dsimp [data, compositionMembers, CertProofs.{name}CompositionClaim, \ - CertProofs.{name}CompositionMembers] at hRoot hShape ⊢\n\ - simp [AverCert.AcceptedArtifact.compositionMemberForName] at hRoot\n\ - subst rootMember\ninjection hShape with hShape\nsubst callees\n\ - exact CertProofs.{name}_compositionSemanticBridge" - ) -} - -fn render_discharge_side_conditions(analysis: &Analysis, model_info: &ModelInfo) -> String { - let sym = analysis - .certs - .iter() - .filter(|c| matches!(c.inner(), Cert::ExprFragment { source_plan, plan, .. } - if expr_fragment_source_plan(source_plan, plan).is_some())) - .collect::>(); - let string_eq = analysis - .certs - .iter() - .filter(|c| matches!(c.inner(), Cert::StringEqVerbatimMatch { .. })) - .collect::>(); - let construct = analysis - .certs - .iter() - .filter(|c| { - matches!(c.inner(), Cert::AdtConstructor { .. }) - && construct_plan_from_cert(c).is_some() - && adt_constructor_sym_plan_from_cert(c, model_info).is_some() - }) - .collect::>(); - let recursion = analysis - .certs - .iter() - .filter(|c| matches!(c.inner(), Cert::Recursive { .. } | Cert::AccumulatorRecursive { .. })) - .collect::>(); - let mutual = analysis - .certs - .iter() - .filter(|c| matches!(c.inner(), Cert::MutualRecursion { .. })) - .collect::>(); - let verbatim = analysis - .certs - .iter() - .filter(|c| matches!(c.inner(), Cert::VerbatimWidenedMatch { .. } | Cert::VerbatimVariantDispatch { .. })) - .collect::>(); - let field_projection = analysis - .certs - .iter() - .filter(|c| matches!(c.inner(), Cert::FieldProjection { .. })) - .collect::>(); - let composition = analysis - .certs - .iter() - .filter(|c| matches!(c.inner(), Cert::Composition { .. })) - .collect::>(); - - let mut out = String::new(); - out.push_str("/-! ### Artifact semantic side conditions consumed by AcceptanceSoundness.accept_sound -/\n\n"); - out.push_str("theorem exprFragmentSideConditions :\n AcceptanceSoundness.exprFragmentSemanticBridges data := by\n"); - out.push_str(&render_claim_cases(&sym, "symFragmentClaims", render_expr_side_arm)); - out.push_str("\ntheorem stringEqSideConditions :\n AcceptanceSoundness.stringEqSemanticBridges data := by\n"); - out.push_str(&render_claim_cases( - &string_eq, - "stringEqClaims", - render_string_side_arm, - )); - out.push_str("\ntheorem constructSideConditions :\n AcceptanceSoundness.constructListSemanticBridges data := by\n"); - out.push_str(&render_claim_cases(&construct, "constructClaims", |c| { - render_construct_side_arm(c, model_info) - })); - out.push_str("\ntheorem recursionSideConditions :\n AcceptanceSoundness.recursionSemanticBridges data := by\n"); - out.push_str(&render_claim_cases(&recursion, "recursionClaims", render_recursion_side_arm)); - out.push_str("\ntheorem mutualSideConditions :\n AcceptanceSoundness.mutualSemanticBridges data := by\n"); - out.push_str(&render_claim_cases(&mutual, "mutualRecursionClaims", render_mutual_side_arm)); - out.push_str("\ntheorem verbatimSideConditions :\n AcceptanceSoundness.verbatimSemanticBridges data := by\n"); - out.push_str(&render_claim_cases(&verbatim, "verbatimClaims", render_verbatim_side_arm)); - out.push_str("\ntheorem fieldProjectionSideConditions :\n AcceptanceSoundness.fieldProjectionSemanticBridges data := by\n"); - out.push_str(&render_claim_cases(&field_projection, "fieldProjectionClaims", render_field_projection_side_arm)); - out.push_str("\ntheorem compositionSideConditions :\n AcceptanceSoundness.compositionClaimSemanticBridges data := by\n"); - out.push_str(&render_claim_cases(&composition, "compositionClaims", render_composition_side_arm)); - out.push_str( - "\ntheorem dischargeSideConditions : AcceptanceSoundness.dischargeSideConditions data := by\n \ - exact ⟨exprFragmentSideConditions, stringEqSideConditions, constructSideConditions,\n \ - recursionSideConditions, mutualSideConditions, verbatimSideConditions,\n \ - fieldProjectionSideConditions, compositionSideConditions⟩\n\n\ - #print axioms AverCert.Artifact.dischargeSideConditions\n", - ); - out -} diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index fbe8f45e7..cb56fba12 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -1,114 +1,139 @@ // Included from engine/mod.rs (engine feature) — see the include! list there. -// The plan-equals-source bridge: the kernel-checked identification of the -// plan a record projection-compute obligation evaluates with the transpiled -// source function the model modules and the law-claims speak about. +// ---- plan-equals-source bridges (schema 9) ------------------------------------ // -// Before this surface the two halves of a certificate met only "by -// construction": `Holds` says the bytes simulate `recordComputeModel -// Plans.Plan.body`, while `Laws.lean` and `aver proof` speak about -// `.`. Nothing in the kernel said those are the same function. -// One theorem per bridged export now does, at exactly the encoders the face's -// representation relation uses. - -// The statement itself is rendered — here and in the checker — by the module -// both features share, so the emitted `Bridge.lean` and the checker's pin are -// the same text by construction rather than by comparison. +// Every certified export's obligation is stated over its plan. A bridge is the +// kernel-checked identification of that plan with the transpiled SOURCE +// function the model modules and the law-claims speak about. The statement is +// rendered from structure by `crate::bridge_statement` (the checker renders it +// again and pins it); this file decides which exports get one, derives the +// encoders from the plan's types and the emitted Lean model, and writes the +// proofs. +// +// The proofs follow the wall's two engines (`GrammarBridge.lean`): +// +// * per bridged function, ONE step lemma (`Step`): its plan body, with every +// call answered by the callees' source images, returns its own source image. +// The script unfolds the source function once (its equation lemma), expands +// the argument shapes the decoder recognises, and evaluates symbolically; +// * per export, `exact_of_step` (a call closure without recursion) or +// `bridge_of_step` (any closure) assembles the step lemmas of its closure. +// +// Nothing here is trusted. A name that does not exist fails the build (and so +// the package, which is why every name comes from the emitted Lean text); a +// proof that does not close falls to `sorry`, which the checker's per-bridge +// axiom audit turns into a not-credited bridge — never a failed package. + use crate::bridge_statement::{ - MAX_BRIDGE_STATEMENT_LEN, ROOT_PREFIX, SourceEncoder, binder_names, encoded_args, - is_plain_dotted_name, render_bridge_statement, source_call, statement_is_root_qualified, - statement_is_single_plain_line, + BridgeKind, MAX_BRIDGE_STATEMENT_LEN, ROOT_PREFIX, SourceEncoder, binder_names, + is_plain_dotted_name, param_binders, pinned_from_expanded, render_bridge_statement, + render_bridge_statement_expanded, statement_is_root_qualified, + statement_is_single_plain_line, tuple_components, }; -/// One declared plan-equals-source bridge, as the manifest transports it. -/// -/// The manifest carries STRUCTURE, never the statement text: the checker -/// renders the statement from `(export, model, params, result)` with -/// [`crate::bridge_statement::render_bridge_statement`] and pins the package's -/// corollary at exactly that type. The producer writes the same rendered text -/// into `Bridge.lean` through the same function, so the two agree by -/// construction. A package cannot declare a statement of its own choosing — a -/// tautology, another export's plan, a permuted accessor list — because no -/// statement it writes is ever read. +/// The Lean source model of the certified module, as the compiler emitted it +/// (the `aver proof` model files and the law-claims its emitter recorded). +#[derive(Debug, Clone, Default)] +pub struct SourceModel { + /// Model files `(relative path, content)`, lakefile and toolchain excluded. + pub files: Vec<(String, String)>, + /// The Lean namespace of the entry module's definitions. + pub entry_namespace: String, + /// Every dependency module as `(Aver module path, Lean namespace)`. A + /// dependency function's wasm name is its Aver path flattened with `_`. + pub dependency_namespaces: Vec<(String, String)>, + pub law_claims: Vec, + /// Why there is no usable model at all (the emission panicked); every + /// bridge and law-claim is then declined with this reason. + pub failure: Option, +} + +impl SourceModel { + pub fn failed(reason: String) -> Self { + Self { + failure: Some(reason), + ..Self::default() + } + } +} + +/// One declared plan-equals-source bridge, as the manifest transports it: +/// STRUCTURE, never statement text. #[derive(Debug, Clone, PartialEq, Eq)] pub struct SourceBridge { - /// The certified export this bridge is about (`Domain_Rational_plus`). pub export: String, - /// Fully qualified name of the package's bridge theorem. pub theorem: String, - /// Fully qualified name of the package's corollary, which conjoins the - /// bridge with the artifact-level `Holds` fact. pub corollary: String, - /// Fully qualified Lean name of the source function the bridge identifies - /// the plan with. Reported by `explain`; never on the verdict line. + /// Fully qualified Lean name of the source function (no `_root_.`). pub model: String, - /// Parameter encoders in declaration order. + pub kind: BridgeKind, pub params: Vec, - /// Result encoder. pub result: SourceEncoder, } -/// Lean namespace every bridge theorem, corollary and helper lemma lives in. +/// Lean namespace every bridge theorem, corollary and helper lives in. pub const BRIDGE_NAMESPACE: &str = "AverCert.Bridge"; - /// The suffix the corollary name carries over the export name. pub const BRIDGE_COROLLARY_SUFFIX: &str = "_certified"; impl SourceBridge { - /// The theorem name a bridge for `export` must declare. pub fn theorem_name(export: &str) -> String { format!("{BRIDGE_NAMESPACE}.{export}") } - /// The corollary name a bridge for `export` must declare. pub fn corollary_name(export: &str) -> String { format!("{BRIDGE_NAMESPACE}.{export}{BRIDGE_COROLLARY_SUFFIX}") } - /// The statement this bridge makes, rendered from its declared structure by - /// the module producer and checker share. + /// The pinned statement (what the checker renders and pins). pub fn statement(&self) -> String { - render_bridge_statement(&self.export, &self.model, &self.params, &self.result) + render_bridge_statement( + &self.export, + &self.model, + self.kind, + &self.params, + &self.result, + ) } -} -/// Whether an encoder is the source image of the plan-level type the -/// byte-checked face carries at the same position. -fn encoder_matches(encoder: &SourceEncoder, ty: FragTy) -> bool { - matches!( - (encoder, ty), - (SourceEncoder::Int, FragTy::IntCarrier) - | (SourceEncoder::Bool, FragTy::BoolI32) - | (SourceEncoder::Record { .. }, FragTy::AdtRef) - ) + /// The producer's own proof target, restated as [`Self::statement`] by the + /// `_certified` corollary. + pub fn expanded_statement(&self) -> String { + render_bridge_statement_expanded( + &self.export, + &self.model, + self.kind, + &self.params, + &self.result, + ) + } + + /// The manifest JSON entry. + pub fn to_json(&self) -> String { + format!( + "{{\"export\": {}, \"theorem\": {}, \"corollary\": {}, \"model\": {}, \"kind\": {}, \"params\": [{}], \"result\": {}}}", + json_str(&self.export), + json_str(&self.theorem), + json_str(&self.corollary), + json_str(&self.model), + json_str(self.kind.tag()), + self.params + .iter() + .map(SourceEncoder::to_json) + .collect::>() + .join(", "), + self.result.to_json() + ) + } } -/// Everything the renderer needs for one bridged export. The manifest-facing -/// subset is [`SourceBridge`]; the rest is rendering data derived from the -/// same analysis and never transported. -struct BridgePlan { - bridge: SourceBridge, - /// Index of this export's obligation in `manifest.obligations`, which is - /// how the corollary reaches `Ob.holds` out of `HoldsCore`. - obligation_index: usize, -} - -/// Mirror of the checker's `validate_source_bridge_candidate`, kept as a -/// DEFENSIVE gate for the same reason the law surface keeps one: a single -/// entry the checker would hard-reject fails candidate parsing for the WHOLE -/// package before Lean runs, so a bridge the gates refuse is simply not -/// declared. Declining a bridge is fail-closed — the export stays certified, -/// its model just stays the plan. +/// Mirror of the checker's `validate_source_bridge_candidate`: a bridge the +/// checker would hard-reject fails candidate parsing for the WHOLE package +/// before Lean runs, so such a bridge is simply not declared. fn bridge_survives_checker_gates(bridge: &SourceBridge) -> bool { - if !is_plain_dotted_name(&bridge.export) - || bridge.export.contains('.') - || !is_plain_dotted_name(&bridge.theorem) - || !is_plain_dotted_name(&bridge.corollary) + if !crate::bridge_statement::is_plain_export_name(&bridge.export) || !is_plain_dotted_name(&bridge.model) - { - return false; - } - if bridge.theorem != SourceBridge::theorem_name(&bridge.export) + || bridge.theorem != SourceBridge::theorem_name(&bridge.export) || bridge.corollary != SourceBridge::corollary_name(&bridge.export) { return false; @@ -126,415 +151,2522 @@ fn bridge_survives_checker_gates(bridge: &SourceBridge) -> bool { && statement_is_root_qualified(&statement) } -/// The source encoder a written model type denotes, or `None` when the type -/// has no `SVal` image in the v1 face. Names come out `_root_.`-qualified, -/// which is the form the manifest carries and the renderer splices verbatim. -fn source_encoding( - model_info: &ModelInfo, - prefix: &str, - written: &str, -) -> Option { - match written { - "Int" => Some(SourceEncoder::Int), - "Bool" => Some(SourceEncoder::Bool), - _ => { - let (qualified, info) = model_info.resolve_structure(prefix, written)?; - // Only an all-Int record has an `SVal.r` image: `takeInts` pops - // boxed integers, so a Bool or nested field is unrepresentable - // there. Refuse rather than invent an encoding. - if info.fields.is_empty() || info.fields.iter().any(|(_, ty)| ty != "Int") { +// ---- reading the emitted Lean model ------------------------------------------ + +/// A parsed Lean type expression of a model signature. +#[derive(Debug, Clone, PartialEq, Eq)] +enum LTy { + /// A head applied to arguments (`Int`, `Option Int`, `Except String Int`). + App(String, Vec), + /// `A × B × C`. + Prod(Vec), +} + +fn parse_lean_ty(text: &str) -> Option { + let mut tokens = Vec::new(); + let mut chars = text.chars().peekable(); + while let Some(&c) = chars.peek() { + if c.is_whitespace() { + chars.next(); + } else if c == '(' || c == ')' || c == '×' { + tokens.push(c.to_string()); + chars.next(); + } else if c.is_alphanumeric() || c == '_' || c == '.' || c == '\'' { + let mut ident = String::new(); + while let Some(&d) = chars.peek() { + if d.is_alphanumeric() || d == '_' || d == '.' || d == '\'' { + ident.push(d); + chars.next(); + } else { + break; + } + } + tokens.push(ident); + } else { + return None; + } + } + let mut at = 0; + let ty = parse_prod(&tokens, &mut at)?; + (at == tokens.len()).then_some(ty) +} + +fn parse_prod(tokens: &[String], at: &mut usize) -> Option { + let mut parts = vec![parse_app(tokens, at)?]; + while tokens.get(*at).map(String::as_str) == Some("×") { + *at += 1; + parts.push(parse_app(tokens, at)?); + } + if parts.len() == 1 { + parts.pop() + } else { + // `×` nests to the right; flatten a right-nested product. + let mut flat = Vec::new(); + let last = parts.pop()?; + flat.extend(parts); + match last { + LTy::Prod(rest) => flat.extend(rest), + other => flat.push(other), + } + Some(LTy::Prod(flat)) + } +} + +fn parse_app(tokens: &[String], at: &mut usize) -> Option { + let head = match parse_atom(tokens, at)? { + LTy::App(head, args) if args.is_empty() => head, + other => return Some(other), + }; + let mut args = Vec::new(); + while let Some(token) = tokens.get(*at) { + if token == ")" || token == "×" { + break; + } + args.push(parse_atom(tokens, at)?); + } + Some(LTy::App(head, args)) +} + +fn parse_atom(tokens: &[String], at: &mut usize) -> Option { + let token = tokens.get(*at)?; + *at += 1; + if token == "(" { + let inner = parse_prod(tokens, at)?; + if tokens.get(*at).map(String::as_str) != Some(")") { + return None; + } + *at += 1; + Some(inner) + } else if token == ")" || token == "×" { + None + } else { + Some(LTy::App(token.clone(), Vec::new())) + } +} + +/// One `def` of the model: its namespace, parameter types and result type, +/// as written, and its body text (the lines up to the next blank line). +#[derive(Debug, Clone)] +struct LeanDef { + qualified: String, + namespace: String, + params: Vec, + ret: String, + body: String, +} + +#[derive(Debug, Clone)] +struct LeanStructure { + namespace: String, + fields: Vec<(String, String)>, +} + +#[derive(Debug, Clone)] +struct LeanInductive { + namespace: String, + ctors: Vec<(String, Vec)>, +} + +/// What the producer reads off the emitted model files: single-line `def` +/// signatures, `structure` fields and `inductive` constructors, by fully +/// qualified name. `partial` defs are opaque to Lean and are left out. +#[derive(Debug, Default)] +struct ModelInfo { + defs: BTreeMap, + structures: BTreeMap, + inductives: BTreeMap, + /// Flat wasm name → qualified defs that flatten to it. + by_flat: BTreeMap>, +} + +fn qualify(namespace: &str, name: &str) -> String { + if namespace.is_empty() { + name.to_string() + } else { + format!("{namespace}.{name}") + } +} + +/// `(p : T) (q : U) : R :=` — the parameter types and the result type. +fn parse_def_tail(tail: &str) -> Option<(Vec, String)> { + let before = tail.trim().strip_suffix(":=")?.trim_end(); + let mut params = Vec::new(); + let mut rest = before; + loop { + let trimmed = rest.trim_start(); + if let Some(inner_start) = trimmed.strip_prefix('(') { + let mut depth = 1usize; + let mut end = None; + for (at, ch) in inner_start.char_indices() { + match ch { + '(' => depth += 1, + ')' => { + depth -= 1; + if depth == 0 { + end = Some(at); + break; + } + } + _ => {} + } + } + let end = end?; + let binder = &inner_start[..end]; + let (_, ty) = binder.split_once(" : ")?; + params.push(ty.trim().to_string()); + rest = &inner_start[end + 1..]; + } else { + let ret = trimmed.strip_prefix(':')?.trim(); + if ret.is_empty() { return None; } - let lean_type = format!("{ROOT_PREFIX}{qualified}"); - let accessors = info - .fields - .iter() - .map(|(name, _)| format!("{lean_type}.{name}")) - .collect(); - Some(SourceEncoder::Record { - lean_type, - accessors, - }) + return Some((params, ret.to_string())); } } } -/// Derive one export's bridge plan, or the reason it gets none. -/// -/// Every step is a cross-check between the SOURCE signature the model modules -/// declare and the byte-checked plan the face already pinned: same arity, same -/// per-position kind (record / Int carrier / Bool), and — for a record — the -/// same number of Int leaves as the byte-derived record declaration. A -/// disagreement means the producer would be guessing at the encoders, so it -/// declares no bridge. -fn bridge_plan_for( - c: &Cert, - obligation_index: usize, - model_info: &ModelInfo, -) -> Result { - if c.record_compute_face().is_none() { - return Err("export is not certified through the record projection-compute face".into()); - } - let Cert::ExprFragment { plan, .. } = c.inner() else { - return Err("export carries no expression-fragment plan".into()); +impl ModelInfo { + fn from_model(model: &SourceModel) -> Self { + let mut info = Self::default(); + for (path, content) in &model.files { + if path.ends_with(".lean") { + info.parse(content); + } + } + // Flat wasm names: the entry module's functions keep their bare name, + // a dependency module's are its Aver path flattened with `_`. + let mut flats: Vec<(String, String)> = Vec::new(); + for (qualified, def) in &info.defs { + let bare = qualified + .rsplit('.') + .next() + .unwrap_or(qualified) + .trim_end_matches('\'') + .to_string(); + if def.namespace == model.entry_namespace { + flats.push((bare.clone(), qualified.clone())); + } + for (aver_path, lean_ns) in &model.dependency_namespaces { + if def.namespace == *lean_ns { + flats.push(( + format!("{}_{bare}", aver_path.replace('.', "_")), + qualified.clone(), + )); + } + } + } + for (flat, qualified) in flats { + info.by_flat.entry(flat).or_default().push(qualified); + } + info + } + + fn parse(&mut self, content: &str) { + let mut namespaces: Vec = Vec::new(); + let lines: Vec<&str> = content.lines().collect(); + let mut i = 0; + while i < lines.len() { + let line = lines[i]; + let trimmed = line.trim_start(); + let ns = namespaces.join("."); + if let Some(name) = line.strip_prefix("namespace ") { + namespaces.push(name.trim().to_string()); + } else if let Some(name) = line.strip_prefix("end ") { + if namespaces.last().map(String::as_str) == Some(name.trim()) { + namespaces.pop(); + } + } else if let Some(rest) = line.strip_prefix("structure ") { + if let Some(name) = rest.strip_suffix(" where") { + let mut fields = Vec::new(); + let mut j = i + 1; + while j < lines.len() && lines[j].starts_with(" ") { + let field = lines[j].trim(); + if let Some((fname, fty)) = field.split_once(" : ") + && is_plain_dotted_name(fname) + && !fname.contains('.') + { + fields.push((fname.to_string(), fty.trim().to_string())); + } + j += 1; + } + self.structures.insert( + qualify(&ns, name.trim()), + LeanStructure { + namespace: ns.clone(), + fields, + }, + ); + i = j; + continue; + } + } else if let Some(rest) = line.strip_prefix("inductive ") { + if let Some(name) = rest.strip_suffix(" where") { + let mut ctors = Vec::new(); + let mut j = i + 1; + while j < lines.len() && lines[j].starts_with(" | ") { + let ctor = lines[j].trim_start().trim_start_matches("| ").trim(); + let cname = ctor.split_whitespace().next().unwrap_or("").to_string(); + let fields = parse_def_tail(&format!( + "{} : Unit :=", + &ctor[cname.len()..] + )) + .map(|(params, _)| params); + if let Some(fields) = fields { + ctors.push((cname, fields)); + } else { + ctors.clear(); + break; + } + j += 1; + } + if !ctors.is_empty() { + self.inductives.insert( + qualify(&ns, name.trim()), + LeanInductive { + namespace: ns.clone(), + ctors, + }, + ); + } + i = j; + continue; + } + } else if let Some(rest) = trimmed.strip_prefix("def ") { + let name = rest.split_whitespace().next().unwrap_or(""); + if !name.is_empty() + && is_plain_dotted_name(name) + && let Some((params, ret)) = parse_def_tail(&rest[name.len()..]) + { + let qualified = qualify(&ns, name); + let body = lines[i + 1..] + .iter() + .take_while(|l| !l.trim().is_empty()) + .copied() + .collect::>() + .join("\n"); + self.defs.insert( + qualified.clone(), + LeanDef { + qualified, + namespace: ns.clone(), + params, + ret, + body, + }, + ); + } + } + i += 1; + } + } + + /// The model def a wasm function name denotes, when exactly one does. + fn def_for(&self, flat: &str) -> Result<&LeanDef, String> { + match self.by_flat.get(flat).map(Vec::as_slice) { + Some([one]) => Ok(&self.defs[one]), + Some([]) | None => Err("the Lean source model has no definition for this function".into()), + Some(_) => Err("several Lean source definitions flatten to this function's name".into()), + } + } + + /// The nullary definitions `def`'s body mentions, fully qualified. The + /// optimized plan carries such a constant as its value, so a step proof + /// unfolds it on the source side. + fn inlined_constants(&self, def: &LeanDef) -> Vec { + let mut out = Vec::new(); + for token in crate::bridge_statement::statement_tokens(&def.body) { + let found = self.resolve(&self.defs, &def.namespace, token); + if let Some((qualified, target)) = found + && target.params.is_empty() + && qualified != def.qualified + && !out.contains(&qualified) + { + out.push(qualified); + } + } + out.sort(); + out + } + + /// Resolve a type name as written inside namespace `ns` the way Lean + /// does: the innermost enclosing namespace first. + fn resolve<'a, T>(&self, map: &'a BTreeMap, ns: &str, written: &str) -> Option<(String, &'a T)> { + let mut scope: Vec<&str> = if ns.is_empty() { Vec::new() } else { ns.split('.').collect() }; + loop { + let candidate = if scope.is_empty() { + written.to_string() + } else { + format!("{}.{written}", scope.join(".")) + }; + if let Some(found) = map.get(&candidate) { + return Some((candidate, found)); + } + scope.pop()?; + } + } + + /// Derive the encoder of a source value whose plan type is `pty` and + /// whose Lean type is written `lty` inside namespace `ns`. Every step + /// cross-checks the byte-pinned layout (the type table) against the + /// emitted Lean declaration; a disagreement declines. + fn encoder( + &self, + pty: &PlanTy, + lty: <y, + ns: &str, + tt: &PlanTypeTable, + stack: &mut Vec, + ) -> Result { + let head = |name: &str| matches!(lty, LTy::App(h, a) if h == name && a.is_empty()); + let app1 = |name: &str| match lty { + LTy::App(h, a) if h == name && a.len() == 1 => Some(&a[0]), + _ => None, + }; + match pty { + PlanTy::Int if head("Int") => Ok(SourceEncoder::Int), + PlanTy::Bool if head("Bool") => Ok(SourceEncoder::Bool), + PlanTy::Float if head("Float") => Ok(SourceEncoder::Float), + PlanTy::Str if head("String") => Ok(SourceEncoder::Str), + PlanTy::Option(t) => match app1("Option") { + Some(inner) => Ok(SourceEncoder::Option(Box::new( + self.encoder(t, inner, ns, tt, stack)?, + ))), + None => Err(format!("plan type Option has Lean type `{lty:?}`")), + }, + PlanTy::Result(t, e) => match lty { + LTy::App(h, a) if h == "Except" && a.len() == 2 => Ok(SourceEncoder::Result { + ok: Box::new(self.encoder(t, &a[1], ns, tt, stack)?), + err: Box::new(self.encoder(e, &a[0], ns, tt, stack)?), + }), + _ => Err("plan type Result has no matching `Except` Lean type".into()), + }, + PlanTy::List(t) => match app1("List") { + Some(inner) => Ok(SourceEncoder::List(Box::new( + self.encoder(t, inner, ns, tt, stack)?, + ))), + None => Err("plan type List has no matching Lean `List`".into()), + }, + PlanTy::Vec(t) => match app1("Array") { + Some(inner) => Ok(SourceEncoder::Vector(Box::new( + self.encoder(t, inner, ns, tt, stack)?, + ))), + None => Err("plan type Vector has no matching Lean `Array`".into()), + }, + PlanTy::Record(tid) => { + let decl = tt + .records + .iter() + .find(|r| r.tid == *tid) + .ok_or("the plan cites a record the type table does not declare")?; + match lty { + LTy::Prod(elems) => { + if elems.len() != decl.fields.len() { + return Err("tuple arity differs from the byte-pinned layout".into()); + } + let elems = decl + .fields + .iter() + .zip(elems) + .map(|(p, l)| self.encoder(p, l, ns, tt, stack)) + .collect::, _>>()?; + Ok(SourceEncoder::Tuple { tid: *tid, elems }) + } + LTy::App(name, args) if args.is_empty() => { + let (qualified, info) = self + .resolve(&self.structures, ns, name) + .ok_or_else(|| format!("`{name}` is not a Lean structure of the model"))?; + if stack.contains(&qualified) { + return Err(format!("`{qualified}` is a recursive type")); + } + if info.fields.len() != decl.fields.len() { + return Err(format!( + "`{qualified}` has {} fields, the byte-pinned layout {}", + info.fields.len(), + decl.fields.len() + )); + } + stack.push(qualified.clone()); + let mut fields = Vec::new(); + for ((fname, fty), pfield) in info.fields.iter().zip(&decl.fields) { + let lfield = parse_lean_ty(fty) + .ok_or_else(|| format!("unreadable field type `{fty}`"))?; + fields.push(( + format!("{ROOT_PREFIX}{qualified}.{fname}"), + self.encoder(pfield, &lfield, &info.namespace, tt, stack)?, + )); + } + stack.pop(); + Ok(SourceEncoder::Record { + tid: *tid, + lean_type: format!("{ROOT_PREFIX}{qualified}"), + fields, + }) + } + _ => Err("plan record type has no matching Lean structure".into()), + } + } + PlanTy::Sum(tid) => { + let decl = tt + .sums + .iter() + .find(|s| s.tid == *tid) + .ok_or("the plan cites a sum the type table does not declare")?; + let LTy::App(name, args) = lty else { + return Err("plan sum type has no matching Lean inductive".into()); + }; + if !args.is_empty() { + return Err("plan sum type has no matching Lean inductive".into()); + } + let (qualified, info) = self + .resolve(&self.inductives, ns, name) + .ok_or_else(|| format!("`{name}` is not a Lean inductive of the model"))?; + if stack.contains(&qualified) { + return Err(format!("`{qualified}` is a recursive type")); + } + if info.ctors.len() != decl.ctors.len() { + return Err(format!( + "`{qualified}` has {} constructors, the byte-pinned layout {}", + info.ctors.len(), + decl.ctors.len() + )); + } + stack.push(qualified.clone()); + let mut ctors = Vec::new(); + for ((cname, ftys), (_, pfields)) in info.ctors.iter().zip(&decl.ctors) { + if ftys.len() != pfields.len() { + return Err(format!("`{qualified}.{cname}` field count differs from the layout")); + } + let mut fields = Vec::new(); + for (fty, pfield) in ftys.iter().zip(pfields) { + let lfield = parse_lean_ty(fty) + .ok_or_else(|| format!("unreadable field type `{fty}`"))?; + fields.push(self.encoder(pfield, &lfield, &info.namespace, tt, stack)?); + } + ctors.push((format!("{ROOT_PREFIX}{qualified}.{cname}"), fields)); + } + stack.pop(); + Ok(SourceEncoder::Sum { + tid: *tid, + lean_type: format!("{ROOT_PREFIX}{qualified}"), + ctors, + }) + } + _ => Err(format!("plan type {pty:?} has no source encoding for Lean `{lty:?}`")), + } + } +} + +// ---- decoders: the argument shapes a step lemma expands --------------------- + +/// One argument shape a decoder recognises: its pattern binders, the `SVal` +/// pattern over them, and the source value it denotes. +#[derive(Debug, Clone)] +struct Alt { + /// Atomic values the shape binds as a whole `SVal` and decodes by the + /// wall's decoder: `(SVal variable, source variable)`. + binds: Vec<(String, String)>, + pattern: String, + source: String, +} + +/// Most argument shapes one function's decoder may expand into. +const MAX_ALTS: usize = 64; + +fn product(parts: Vec>) -> Result>, String> { + let mut out: Vec> = vec![Vec::new()]; + for part in parts { + let mut next = Vec::new(); + for prefix in &out { + for alt in &part { + let mut row = prefix.clone(); + row.push(alt.clone()); + next.push(row); + if next.len() > MAX_ALTS { + return Err(format!("more than {MAX_ALTS} argument shapes to expand")); + } + } + } + out = next; + } + Ok(out) +} + +fn join_row(row: &[Alt]) -> (Vec<(String, String)>, Vec, Vec) { + let mut binders = Vec::new(); + let mut patterns = Vec::new(); + let mut sources = Vec::new(); + for alt in row { + binders.extend(alt.binds.iter().cloned()); + patterns.push(alt.pattern.clone()); + sources.push(alt.source.clone()); + } + (binders, patterns, sources) +} + +fn alts(enc: &SourceEncoder, fresh: &mut usize) -> Result, String> { + const SVAL: &str = "_root_.AverCert.Grammar.SVal"; + let leaf = |ctor: &str, fresh: &mut usize| { + let name = format!("t{fresh}"); + *fresh += 1; + vec![Alt { + binds: Vec::new(), + pattern: format!("{SVAL}.{ctor} {name}"), + source: name, + }] }; - let export = c.name().to_string(); - let Some(sig) = model_info.model_fn_sig(&export) else { - return Err("no unambiguous transpiled model signature for this export".into()); + match enc { + SourceEncoder::Int => Ok(leaf("i", fresh)), + SourceEncoder::Bool => Ok(leaf("b", fresh)), + // A String is matched as a whole value and decoded by the wall's + // `decodeStr` (the inverse of its injective byte encoding). + SourceEncoder::Str => { + let v = format!("v{fresh}"); + let t = format!("t{fresh}"); + *fresh += 1; + Ok(vec![Alt { + binds: vec![(v.clone(), t.clone())], + pattern: v, + source: t, + }]) + } + SourceEncoder::Float | SourceEncoder::List(_) | SourceEncoder::Vector(_) => { + Err(format!("a `{}` argument has no decoder in this version", enc.kind())) + } + SourceEncoder::Record { + tid, + lean_type, + fields, + } => { + let parts = fields + .iter() + .map(|(_, f)| alts(f, fresh)) + .collect::, _>>()?; + Ok(product(parts)? + .into_iter() + .map(|row| { + let (binds, patterns, sources) = join_row(&row); + Alt { + binds, + pattern: format!("{SVAL}.record {tid} [{}]", patterns.join(", ")), + source: format!("(⟨{}⟩ : {lean_type})", sources.join(", ")), + } + }) + .collect()) + } + SourceEncoder::Tuple { tid, elems } => { + let parts = elems + .iter() + .map(|f| alts(f, fresh)) + .collect::, _>>()?; + Ok(product(parts)? + .into_iter() + .map(|row| { + let (binds, patterns, sources) = join_row(&row); + Alt { + binds, + pattern: format!("{SVAL}.record {tid} [{}]", patterns.join(", ")), + source: format!("({})", sources.join(", ")), + } + }) + .collect()) + } + SourceEncoder::Sum { tid, ctors, .. } => { + let mut out = Vec::new(); + for (index, (ctor, fields)) in ctors.iter().enumerate() { + let parts = fields + .iter() + .map(|f| alts(f, fresh)) + .collect::, _>>()?; + for row in product(parts)? { + let (binds, patterns, sources) = join_row(&row); + let source = if sources.is_empty() { + ctor.clone() + } else { + format!("({ctor} {})", sources.join(" ")) + }; + out.push(Alt { + binds, + pattern: format!("{SVAL}.variant {tid} {index} [{}]", patterns.join(", ")), + source, + }); + } + if out.len() > MAX_ALTS { + return Err(format!("more than {MAX_ALTS} argument shapes to expand")); + } + } + Ok(out) + } + SourceEncoder::Option(elem) => { + let ty = elem.grammar_ty(); + let mut out = vec![Alt { + binds: Vec::new(), + pattern: format!("{SVAL}.none {ty}"), + source: "_root_.Option.none".into(), + }]; + for alt in alts(elem, fresh)? { + out.push(Alt { + binds: alt.binds, + pattern: format!("{SVAL}.some {ty} ({})", alt.pattern), + source: format!("(_root_.Option.some {})", alt.source), + }); + } + Ok(out) + } + SourceEncoder::Result { ok, err } => { + let (t, e) = (ok.grammar_ty(), err.grammar_ty()); + let mut out = Vec::new(); + for alt in alts(ok, fresh)? { + out.push(Alt { + binds: alt.binds, + pattern: format!("{SVAL}.ok {t} {e} ({})", alt.pattern), + source: format!("(_root_.Except.ok {})", alt.source), + }); + } + for alt in alts(err, fresh)? { + out.push(Alt { + binds: alt.binds, + pattern: format!("{SVAL}.err {t} {e} ({})", alt.pattern), + source: format!("(_root_.Except.error {})", alt.source), + }); + } + Ok(out) + } + } +} + +/// The `rcases` pattern that splits a parameter into the constructors its +/// encoding matches on (a sum, option or result, at any depth inside records +/// and tuples), or `None` when the encoding reduces without a split. +fn rcases_pattern(enc: &SourceEncoder) -> Option { + let sub = |e: &SourceEncoder| rcases_pattern(e).unwrap_or_else(|| "_".to_string()); + match enc { + SourceEncoder::Record { fields, .. } => fields + .iter() + .any(|(_, f)| rcases_pattern(f).is_some()) + .then(|| { + format!( + "⟨{}⟩", + fields.iter().map(|(_, f)| sub(f)).collect::>().join(", ") + ) + }), + SourceEncoder::Tuple { elems, .. } => elems.iter().any(|f| rcases_pattern(f).is_some()).then(|| { + format!("⟨{}⟩", elems.iter().map(sub).collect::>().join(", ")) + }), + SourceEncoder::Sum { ctors, .. } => Some(format!( + "({})", + ctors + .iter() + .map(|(_, fields)| format!( + "⟨{}⟩", + fields.iter().map(sub).collect::>().join(", ") + )) + .collect::>() + .join(" | ") + )), + SourceEncoder::Option(e) => Some(format!("(⟨⟩ | {})", sub(e))), + SourceEncoder::Result { ok, err } => Some(format!("({} | {})", sub(err), sub(ok))), + _ => None, + } +} + +// ---- planning --------------------------------------------------------------- + +/// Everything the renderer needs for one bridged function (exported or an +/// internal callee). +#[derive(Debug, Clone)] +struct BridgedFn { + func_idx: u32, + model: String, + params: Vec, + result: SourceEncoder, + /// Direct callees, deduplicated. + callees: Vec, + /// Whether the model definition is a fuel wrapper (`f x = f__fuel + /// (natAbs x + 1) x`, the transpiler's shape for mutual recursion): the + /// step unfolds both, and callers unfold the wrapper. + fuel: bool, + /// The decoder's argument shapes. + shapes: Vec, + /// The String literals its plan mentions (literal nodes and patterns). + literals: BTreeSet>, + /// Whether its plan calls itself (self recursion). + recursive: bool, + /// Nullary source definitions its model definition mentions, fully + /// qualified: the plan carries them inlined as their values. + constants: Vec, +} + +/// One decoder argument shape: the atomic values it decodes, its argument +/// patterns, and the source arguments it denotes. +type DecoderShape = (Vec<(String, String)>, Vec, Vec); + +/// The outcome of bridge planning. +struct BridgePlan { + fns: BTreeMap, + /// Exported bridges in certified-export order. + bridges: Vec<(SourceBridge, u32)>, + declined: Vec<(String, String)>, + /// Depth of each function whose call closure has no recursion. + depth: BTreeMap, + /// The String literals of the bridged plans, whose bytes the step proofs + /// rewrite `strBytes "…"` to. + literals: BTreeSet>, + /// Some bridged plan calls `Result.withDefault`, so the models spell it + /// `Except.withDefault` (and the model prelude defines it). + with_default: bool, + /// Per planned function: its position in `Plans.fnPlans` and its entry + /// exactly as `Plans.lean` spells it. + entries: BTreeMap, + /// The export names of the obligations, in `Plans.fnPlans` order. + obligation_names: Vec, +} + +/// The largest plan a bridge is attempted for. A step proof unfolds the +/// whole body and its callees' images at once, and its heartbeat cap does not +/// bound every tactic it runs: on k5's 247-node `divideBang` family one step +/// ran for minutes and the package's bridge build past any phase limit. +const MAX_BRIDGE_PLAN_NODES: usize = 100; + +/// The number of nodes of a plan body (patterns not counted). +fn plan_nodes(e: &PlanExpr) -> usize { + 1 + match e { + PlanExpr::Literal(_) | PlanExpr::Local(_) => 0, + PlanExpr::Let(_, v, b) => plan_nodes(v) + plan_nodes(b), + PlanExpr::Call(_, args) + | PlanExpr::TailCall(_, args) + | PlanExpr::RecordCreate(_, args) + | PlanExpr::Construct(_, _, args) + | PlanExpr::Interp(args) + | PlanExpr::List(_, args) => args.iter().map(plan_nodes).sum(), + PlanExpr::BinOp(_, l, r) => plan_nodes(l) + plan_nodes(r), + PlanExpr::Neg(x) | PlanExpr::Project(_, _, x) => plan_nodes(x), + PlanExpr::If(c, t, el) => plan_nodes(c) + plan_nodes(t) + plan_nodes(el), + PlanExpr::Match(s, arms) => plan_nodes(s) + arms.iter().map(|(_, b)| plan_nodes(b)).sum::(), + } +} + +/// Every String literal a plan mentions (literal nodes and literal +/// patterns), as bytes. +fn string_literals(e: &PlanExpr, out: &mut BTreeSet>) { + match e { + PlanExpr::Literal(PlanLit::Str(bytes)) => { + out.insert(bytes.clone()); + } + PlanExpr::Literal(_) | PlanExpr::Local(_) => {} + PlanExpr::List(_, items) => items.iter().for_each(|a| string_literals(a, out)), + PlanExpr::Let(_, v, b) => { + string_literals(v, out); + string_literals(b, out); + } + PlanExpr::Call(_, args) + | PlanExpr::TailCall(_, args) + | PlanExpr::RecordCreate(_, args) + | PlanExpr::Construct(_, _, args) + | PlanExpr::Interp(args) => args.iter().for_each(|a| string_literals(a, out)), + PlanExpr::BinOp(_, l, r) => { + string_literals(l, out); + string_literals(r, out); + } + PlanExpr::Neg(x) | PlanExpr::Project(_, _, x) => string_literals(x, out), + PlanExpr::If(c, t, el) => { + string_literals(c, out); + string_literals(t, out); + string_literals(el, out); + } + PlanExpr::Match(subject, arms) => { + string_literals(subject, out); + for (pat, body) in arms { + if let PlanPat::LitStr(bytes) = pat { + out.insert(bytes.clone()); + } + string_literals(body, out); + } + } + } +} + +/// A Lean string literal denoting exactly `bytes`, or `None` when they are +/// not UTF-8. +fn lean_string_literal(bytes: &[u8]) -> Option { + let text = std::str::from_utf8(bytes).ok()?; + let mut out = String::from("\""); + for ch in text.chars() { + match ch { + '"' => out.push_str("\\\""), + '\\' => out.push_str("\\\\"), + '\n' => out.push_str("\\n"), + '\t' => out.push_str("\\t"), + c if (c as u32) < 0x20 || c as u32 == 0x7f => { + out.push_str(&format!("\\x{:02x}", c as u32)) + } + c => out.push(c), + } + } + out.push('"'); + Some(out) +} + +fn direct_callees(body: &PlanExpr) -> Vec { + let mut targets = Vec::new(); + call_targets(body, &mut targets); + targets.sort_unstable(); + targets.dedup(); + targets +} + +fn closure_of(start: u32, fns: &BTreeMap) -> Vec { + let mut seen = BTreeSet::new(); + let mut work = vec![start]; + while let Some(f) = work.pop() { + if seen.insert(f) + && let Some(b) = fns.get(&f) + { + work.extend(b.callees.iter().copied()); + } + } + seen.into_iter().collect() +} + +fn plan_bridges(analysis: &Analysis, model: &SourceModel) -> BridgePlan { + let mut declined: Vec<(String, String)> = Vec::new(); + let mut plan = BridgePlan { + fns: BTreeMap::new(), + bridges: Vec::new(), + declined: Vec::new(), + depth: BTreeMap::new(), + literals: BTreeSet::new(), + with_default: false, + entries: analysis + .entries + .iter() + .enumerate() + .map(|(index, e)| { + let entry = format!( + "⟨{}, {}, {}, {}, AverCert.Plans.{}⟩", + lean_str(&e.name), + e.exported, + e.func_idx, + e.group, + plan_def_name(e.func_idx) + ); + (e.func_idx, (index, entry)) + }) + .collect(), + obligation_names: analysis + .entries + .iter() + .filter(|e| e.exported) + .map(|e| e.name.clone()) + .collect(), }; - if sig.params.len() != plan.params.len() { - return Err(format!( - "source arity {} does not match the plan's {}", - sig.params.len(), - plan.params.len() - )); + if let Some(reason) = &model.failure { + for c in &analysis.certified { + declined.push((c.name.clone(), reason.clone())); + } + plan.declined = declined; + return plan; } - let mut params = Vec::with_capacity(sig.params.len()); - for (index, written) in sig.params.iter().enumerate() { - let Some(encoding) = source_encoding(model_info, &sig.prefix, written) else { - return Err(format!( - "parameter {index} has source type `{written}`, which has no source-value \ - encoding in this face (only Int, Bool and all-Int records do)" + let info = ModelInfo::from_model(model); + // Candidate functions: every planned function whose source definition + // and encoders resolve. + let mut reasons: BTreeMap = BTreeMap::new(); + for e in &analysis.entries { + let flat = analysis + .fn_names + .get(&e.func_idx) + .cloned() + .unwrap_or_else(|| e.name.clone()); + let derived = (|| -> Result { + if plan_nodes(&e.plan.body) > MAX_BRIDGE_PLAN_NODES { + return Err(format!( + "the plan has more than {MAX_BRIDGE_PLAN_NODES} nodes, beyond what the \ + one-step bridge proof unfolds in bounded time" + )); + } + let def = info.def_for(&flat)?; + if def.params.len() != e.plan.params.len() { + return Err(format!( + "source arity {} differs from the plan's {}", + def.params.len(), + e.plan.params.len() + )); + } + let mut params = Vec::new(); + for (pty, written) in e.plan.params.iter().zip(&def.params) { + let lty = parse_lean_ty(written) + .ok_or_else(|| format!("unreadable Lean parameter type `{written}`"))?; + params.push(info.encoder(pty, <y, &def.namespace, &analysis.types, &mut Vec::new())?); + } + let lret = parse_lean_ty(&def.ret) + .ok_or_else(|| format!("unreadable Lean result type `{}`", def.ret))?; + let result = info.encoder(&e.plan.ret, &lret, &def.namespace, &analysis.types, &mut Vec::new())?; + let mut fresh = 0; + let parts = params + .iter() + .map(|p| alts(p, &mut fresh)) + .collect::, _>>()?; + let shapes = product(parts)?.iter().map(|row| join_row(row)).collect(); + let mut literals = BTreeSet::new(); + string_literals(&e.plan.body, &mut literals); + let callees = direct_callees(&e.plan.body); + Ok(BridgedFn { + func_idx: e.func_idx, + model: def.qualified.clone(), + params, + result, + recursive: callees.contains(&e.func_idx), + callees, + fuel: info.defs.contains_key(&format!("{}__fuel", def.qualified)), + shapes, + literals, + constants: info.inlined_constants(def), + }) + })(); + match derived { + Ok(b) => { + string_literals(&e.plan.body, &mut plan.literals); + plan.with_default |= e.plan.body.lean().contains("(.lazy .resWithDefault)"); + plan.fns.insert(e.func_idx, b); + } + Err(reason) => { + reasons.insert(e.func_idx, reason); + } + } + } + // A function whose callee has no bridge has none either (its step lemma + // needs the callee's image). + loop { + let missing: Vec<(u32, u32)> = plan + .fns + .values() + .filter_map(|b| { + b.callees + .iter() + .find(|c| !plan.fns.contains_key(c)) + .map(|c| (b.func_idx, *c)) + }) + .collect(); + if missing.is_empty() { + break; + } + for (f, c) in missing { + plan.fns.remove(&f); + let callee = analysis + .fn_names + .get(&c) + .cloned() + .unwrap_or_else(|| format!("#{c}")); + reasons.insert(f, format!("callee `{callee}` has no source bridge")); + } + } + // Depth over the functions whose closure has no recursion. + fn depth_of( + f: u32, + fns: &BTreeMap, + memo: &mut BTreeMap>, + onpath: &mut BTreeSet, + ) -> Option { + if let Some(d) = memo.get(&f) { + return *d; + } + if !onpath.insert(f) { + return None; + } + let mut d = Some(0u32); + for c in &fns[&f].callees { + match depth_of(*c, fns, memo, onpath) { + Some(cd) => d = d.map(|x| x.max(cd + 1)), + None => d = None, + } + } + onpath.remove(&f); + memo.insert(f, d); + d + } + let mut memo = BTreeMap::new(); + for f in plan.fns.keys().copied().collect::>() { + if let Some(d) = depth_of(f, &plan.fns, &mut memo, &mut BTreeSet::new()) { + plan.depth.insert(f, d); + } + } + for c in &analysis.certified { + let Some(b) = plan.fns.get(&c.func_idx) else { + declined.push(( + c.name.clone(), + reasons + .get(&c.func_idx) + .cloned() + .unwrap_or_else(|| "no source function".to_string()), )); + continue; }; - if !encoder_matches(&encoding, plan.params[index]) { - return Err(format!( - "parameter {index} source type `{written}` does not match the plan's type" + let kind = if plan.depth.contains_key(&c.func_idx) { + BridgeKind::Exact + } else { + BridgeKind::Adequate + }; + let bridge = SourceBridge { + export: c.name.clone(), + theorem: SourceBridge::theorem_name(&c.name), + corollary: SourceBridge::corollary_name(&c.name), + model: b.model.clone(), + kind, + params: b.params.clone(), + result: b.result.clone(), + }; + if !bridge_survives_checker_gates(&bridge) { + declined.push(( + c.name.clone(), + "statement or identifiers would be refused by the checker's source-bridge gates" + .into(), )); + continue; } - params.push(encoding); + plan.bridges.push((bridge, c.func_idx)); } - let Some(result) = source_encoding(model_info, &sig.prefix, &sig.ret) else { - return Err(format!( - "result type `{}` has no source-value encoding in this face \ - (only Int, Bool and all-Int records do)", - sig.ret - )); - }; - if !encoder_matches(&result, plan.result) { - return Err(format!( - "result source type `{}` does not match the plan's type", - sig.ret - )); + plan.declined = declined + .into_iter() + .map(|(name, reason)| (name, clean_reason(&reason))) + .collect(); + plan +} + +// ---- rendering `Bridge.lean` -------------------------------------------------- + +const TYPING_SIMPS: &str = "AverCert.GrammarBridge.ArgsTyped, AverCert.Grammar.HasTyL, \ + AverCert.Grammar.HasTy, AverCert.Grammar.HasTyAll, AverCert.AcceptedArtifact.obligationOf, \ + AverCert.TypeTable.mctxOf, AverCert.TypeTable.recordOf, AverCert.TypeTable.sumOf, \ + AverCert.Grammar.ctorFields, AverCert.Plans.types"; + +fn arg_type(params: &[SourceEncoder]) -> String { + match params.len() { + 0 => "_root_.Unit".into(), + 1 => params[0].binder_type(), + _ => format!( + "({})", + params + .iter() + .map(SourceEncoder::binder_type) + .collect::>() + .join(" × ") + ), } - // A record encoding lists exactly the leaves the byte-derived record - // declaration carries, all of them Int carriers. This is the one place the - // source-side field list meets the byte side. - let record_arity = params - .iter() - .chain(std::iter::once(&result)) - .filter_map(|encoding| match encoding { - SourceEncoder::Record { accessors, .. } => Some(accessors.len()), - _ => None, - }) - .collect::>(); - if !record_arity.is_empty() { - let Some((_, leaves)) = c.record_decl() else { - return Err("the plan names a record but carries no record declaration".into()); +} + +fn source_args(value: &str, n: usize) -> Vec { + match n { + 0 => Vec::new(), + 1 => vec![format!("({value})")], + _ => tuple_components(value, n), + } +} + +fn render_fn_defs(b: &BridgedFn, s: &mut String) { + let f = b.func_idx; + // The decoder. + s.push_str(&format!( + "/-- The argument shapes `{}` is expanded at. -/\nnoncomputable def dec_{f} : \ + _root_.List _root_.AverCert.Grammar.SVal → _root_.Option {} := fun a =>\n match a with\n", + b.model, + arg_type(&b.params) + )); + for (binds, patterns, sources) in &b.shapes { + let value = match sources.len() { + 0 => "()".to_string(), + 1 => sources[0].clone(), + _ => format!("({})", sources.join(", ")), }; - if leaves.iter().any(|leaf| *leaf != RecordLeaf::IntCarrier) { - return Err("the record declaration carries a non-Int leaf".into()); - } - if record_arity.iter().any(|count| *count != leaves.len()) { - return Err(format!( - "source record field count does not match the {} byte-derived leaves", - leaves.len() - )); + let mut rhs = format!("_root_.Option.some {value}"); + for (v, t) in binds.iter().rev() { + rhs = format!("(AverCert.GrammarBridge.decodeStr {v}).bind (fun {t} => {rhs})"); } + s.push_str(&format!(" | [{}] => {rhs}\n", patterns.join(", "))); } - let bridge_plan = BridgePlan { - bridge: SourceBridge { - theorem: SourceBridge::theorem_name(&export), - corollary: SourceBridge::corollary_name(&export), - model: sig.lean_name.clone(), - export: export.clone(), - params, - result, - }, - obligation_index, + s.push_str(" | _ => _root_.Option.none\n\n"); + // The image. + let args = source_args("y", b.params.len()); + let call = if args.is_empty() { + format!("{ROOT_PREFIX}{}", b.model) + } else { + format!("{ROOT_PREFIX}{} {}", b.model, args.join(" ")) }; - if !bridge_survives_checker_gates(&bridge_plan.bridge) { - return Err( - "statement or identifiers would be refused by the checker's source-bridge gates".into(), - ); + let mut fresh = 0; + s.push_str(&format!( + "/-- The encoded source result of `{}`. -/\ndef img_{f} (y : {}) : \ + _root_.AverCert.Grammar.SVal :=\n {}\n\n", + b.model, + arg_type(&b.params), + b.result.encode(&call, &mut fresh) + )); +} + +fn render_image_table(fns: &BTreeMap, s: &mut String) { + s.push_str( + "/-- The source image of every bridged function. -/\n\ + noncomputable def I : AverCert.GrammarBridge.Table := fun g a =>\n match g with\n", + ); + for f in fns.keys() { + s.push_str(&format!( + " | {f} => (dec_{f} a).map img_{f}\n" + )); + } + s.push_str(" | _ => _root_.Option.none\n\n"); + // One unfolding lemma per entry: the step proofs of another module + // rewrite with these, since `simp` unfolding the whole table there + // rebuilds its equations and runs out of recursion depth on a large one. + for f in fns.keys() { + s.push_str(&format!( + "theorem I_{f} (a : _root_.List _root_.AverCert.Grammar.SVal) :\n \ + I {f} a = (dec_{f} a).map img_{f} := rfl\n" + )); } - Ok(bridge_plan) + s.push('\n'); } -/// Plan one bridge per record projection-compute export, in obligation order. -/// The second component names every export that got no bridge and why, so the -/// producer can say what it declined instead of losing it silently. -fn plan_source_bridges( - analysis: &Analysis, - model_info: &ModelInfo, -) -> (Vec, Vec<(String, String)>) { - let mut planned = Vec::new(); - let mut declined = Vec::new(); - for (index, c) in analysis.certs.iter().enumerate() { - if c.record_compute_face().is_none() { - continue; +/// The fixed lemmas every step proof rewrites with, rendered once into +/// `BridgeDefs.lean`: arm-by-arm evaluation of a match (one rewrite per +/// pattern kind, so a symbolic subject never unfolds `patMatch`), a plan `if` +/// as a Lean `if`, splitting an `if` without naming its condition, and the +/// normal forms that meet the source's spelling (`==`, `!=`, String `+`, +/// interpolation). Producer data like every bridge proof: the kernel checks +/// each one. +const STEP_LEMMAS: &str = r#"section StepLemmas +open AverCert.Grammar + +/-! Arm-by-arm evaluation of a match: one rewrite per pattern kind, so a + step proof evaluates a match without unfolding `patMatch`/`bindVals` + under a symbolic subject. -/ + +theorem arms_nil (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (v : SVal) : + evalArms F env v .nil = none := by simp [evalArms] + +theorem arms_wild (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (v : SVal) (b : Expr) (rest : Arms) : + evalArms F env v (.cons .wild b rest) = eval F env b := by simp [evalArms, patMatch, bindVals] + +theorem arms_bind (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (v : SVal) (s : Nat) (b : Expr) (rest : Arms) : + evalArms F env v (.cons (.bind s) b rest) = + eval F (if s = noSlot then env else upd env s v) b := by + by_cases h : s = noSlot <;> simp [evalArms, patMatch, bindVals, h] + +theorem arms_litInt (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (x k : Int) (b : Expr) (rest : Arms) : + evalArms F env (.i x) (.cons (.litInt k) b rest) = + if x = k then eval F env b else evalArms F env (.i x) rest := by + by_cases h : x = k <;> simp [evalArms, patMatch, bindVals, h] + +theorem arms_litStr (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (x k : List Nat) (b : Expr) (rest : Arms) : + evalArms F env (.s x) (.cons (.litStr k) b rest) = + if x = k then eval F env b else evalArms F env (.s x) rest := by + by_cases h : x = k <;> simp [evalArms, patMatch, bindVals, h] + +theorem arms_litBool (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (x k : Bool) (b : Expr) (rest : Arms) : + evalArms F env (.b x) (.cons (.litBool k) b rest) = + if x = k then eval F env b else evalArms F env (.b x) rest := by + by_cases h : x = k <;> simp [evalArms, patMatch, bindVals, h] + +/-- The plan decides a comparison; the source spells it with `==`/`!=`. -/ +theorem dec_eq_beq {α : Type} [DecidableEq α] (a b : α) : decide (a = b) = (a == b) := rfl + +theorem dec_ne_bne {α : Type} [DecidableEq α] (a b : α) : decide (a ≠ b) = (a != b) := by + cases h : decide (a = b) <;> simp_all [bne] + +/-- A plan `if` as a Lean `if` on its evaluated condition. -/ +theorem eval_ite (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (c t e : Expr) : + eval F env (.ifThenElse c t e) = + match eval F env c with + | some (.b b) => if b = true then eval F env t else eval F env e + | _ => none := by + simp only [eval]; split <;> simp_all + +/-- Split an `if` on the left of an equation without naming its condition. -/ +theorem ite_eq_of {α : Type} {c : Prop} [Decidable c] {A B R : α} (h1 : c → A = R) (h2 : ¬c → B = R) : + (if c then A else B) = R := by + by_cases h : c <;> simp [h, h1, h2] + +/-- Two encoded Strings are equal exactly when the Strings are. -/ +theorem strBytes_eq_iff (x y : String) : + AverCert.GrammarBridge.strBytes x = AverCert.GrammarBridge.strBytes y ↔ x = y := + ⟨AverCert.GrammarBridge.strBytes_inj, fun h => h ▸ rfl⟩ + +/-- A model's String interpolation renders a String part as itself. -/ +theorem str_toString (s : String) : toString s = s := rfl + +theorem arms_ctor (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (v : SVal) (c : CtorTag) + (bs : List Nat) (b : Expr) (rest : Arms) : + evalArms F env v (.cons (.ctor c bs) b rest) = + match patMatch (.ctor c bs) v with + | some (bs', vs) => + match bindVals env bs' vs with + | some env' => eval F env' b + | none => none + | none => evalArms F env v rest := by + simp only [evalArms]; rfl + +theorem arms_tuple (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (v : SVal) + (bs : List Nat) (b : Expr) (rest : Arms) : + evalArms F env v (.cons (.tuple bs) b rest) = + match patMatch (.tuple bs) v with + | some (bs', vs) => + match bindVals env bs' vs with + | some env' => eval F env' b + | none => none + | none => evalArms F env v rest := by + simp only [evalArms]; rfl + +/-- A model's `+` on Strings is `++`. The instance is spelled out: a model + declares it only when it uses it, and this block must elaborate in every + package. -/ +theorem str_hadd (a b : String) : + @HAdd.hAdd String String String ⟨String.append⟩ a b = a ++ b := rfl + +/-- A plan compares two Strings by their bytes; the source compares the Strings. -/ +theorem strBytes_beq (a b : String) : + (AverCert.GrammarBridge.strBytes a == AverCert.GrammarBridge.strBytes b) = (a == b) := + (AverCert.GrammarBridge.string_beq a b).symm + +/-- `Option.withDefault` / `Result.withDefault` on an evaluated subject, as a + function, so an `if` in the subject can be pulled out. -/ +def optDefault (x d : Option SVal) : Option SVal := + match x with + | some (.some _ v) => some v + | some (.none _) => d + | _ => none + +def resDefault (x d : Option SVal) : Option SVal := + match x with + | some (.ok _ _ v) => some v + | some (.err _ _ _) => d + | _ => none + +theorem eval_optDefault (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (o d : Expr) : + eval F env (.call (.lazy .optWithDefault) [o, d]) = optDefault (eval F env o) (eval F env d) := by + simp only [eval, optDefault]; split <;> simp_all + +theorem eval_resDefault (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) (o d : Expr) : + eval F env (.call (.lazy .resWithDefault) [o, d]) = resDefault (eval F env o) (eval F env d) := by + simp only [eval, resDefault]; split <;> simp_all + +theorem optDefault_ite {c : Prop} [Decidable c] (a b d : Option SVal) : + optDefault (if c then a else b) d = if c then optDefault a d else optDefault b d := by + split <;> rfl + +theorem resDefault_ite {c : Prop} [Decidable c] (a b d : Option SVal) : + resDefault (if c then a else b) d = if c then resDefault a d else resDefault b d := by + split <;> rfl + +theorem optDefault_some (t : Ty) (v : SVal) (d : Option SVal) : optDefault (some (.some t v)) d = some v := rfl +theorem optDefault_none (t : Ty) (d : Option SVal) : optDefault (some (.none t)) d = d := rfl +theorem resDefault_ok (t e : Ty) (v : SVal) (d : Option SVal) : resDefault (some (.ok t e v)) d = some v := rfl +theorem resDefault_err (t e : Ty) (v : SVal) (d : Option SVal) : resDefault (some (.err t e v)) d = d := rfl + +end StepLemmas +"#; + +/// Evaluation lemmas of a step proof: the plan's equations with a match +/// taken arm by arm, and `if` / `withDefault` as Lean functions of their +/// subject (pre-rewrites, so they win over `eval`'s own equations), the +/// callee table, and the normal forms the source spells (`==`, `!=`, decided +/// comparisons, literal indices, String parts folded into one `strBytes`). +const STEP_EVAL: &str = "AverCert.Grammar.eval, AverCert.Grammar.evalArgs, arms_nil, arms_wild, \ + arms_bind, arms_litInt, arms_litStr, arms_litBool, arms_ctor, arms_tuple, ↓eval_ite, \ + ↓eval_optDefault, ↓eval_resDefault, optDefault_ite, resDefault_ite, optDefault_some, \ + optDefault_none, resDefault_ok, resDefault_err, AverCert.Grammar.argsEnv, \ + AverCert.Grammar.upd, AverCert.Grammar.intBin, AverCert.Grammar.boolBin, \ + AverCert.Grammar.strBin, AverCert.Grammar.strCat, AverCert.Grammar.builtinEval, \ + AverCert.Grammar.intrinsicEval, AverCert.Grammar.ctorVal, AverCert.Grammar.patMatch, \ + AverCert.Grammar.bindVals, AverCert.Grammar.noSlot, AverCert.GrammarBridge.over, \ + _root_.decide_eq_true_eq, _root_.List.getElem?_cons_zero, _root_.List.getElem?_cons_succ, \ + _root_.List.mem_cons, _root_.List.mem_singleton, _root_.List.not_mem_nil, \ + _root_.Option.map_some, _root_.Option.map_none, _root_.true_or, _root_.or_true, \ + _root_.ite_true, _root_.ite_false, ↓reduceIte, dec_eq_beq, dec_ne_bne, \ + _root_.eq_self_iff_true, _root_.and_self, _root_.and_true, _root_.true_and, \ + _root_.false_and, _root_.and_false, AverCert.GrammarBridge.decodeStr_strBytes, \ + _root_.Option.bind_some, _root_.Function.comp_apply, strBytes_eq_iff, strBytes_beq, \ + Nat.reduceEqDiff, Int.reduceEq, ← AverCert.GrammarBridge.strBytes_append, \ + _root_.List.append_nil, str_toString, str_hadd"; + +/// Normal forms a leaf closes with, on top of the source definition. +const STEP_NORM: &str = "_root_.bne, dec_eq_beq, dec_ne_bne, strBytes_eq_iff, str_toString, \ + str_hadd, _root_.String.append_assoc"; + +/// One step lemma, proved by construction rather than by search. The +/// decoder's argument shapes are expanded; the plan body is evaluated by +/// `simp only` over an exact lemma list (every `if` becomes a Lean `if`, +/// every match is taken arm by arm, every String literal is read back as the +/// `strBytes` of its text, whole list at once); each `if` on the plan side is +/// split without naming its condition; and each leaf meets the source +/// function unfolded once (on the right only, for a self-recursive one). No +/// rung searches: each is bounded by the plan's size, so a leaf that does not +/// close fails fast and falls to `sorry`. +fn render_step( + b: &BridgedFn, + fns: &BTreeMap, + lit_index: &BTreeMap, usize>, + with_default: bool, + s: &mut String, +) { + let f = b.func_idx; + let callees = b + .callees + .iter() + .map(u32::to_string) + .collect::>() + .join(", "); + let mut callee_simps = String::new(); + for c in &b.callees { + if let Some(callee) = fns.get(c) { + callee_simps.push_str(&format!(", I_{c}, dec_{c}, img_{c}")); + if callee.fuel { + callee_simps.push_str(&format!(", _root_.{}", callee.model)); + } } - match bridge_plan_for(c, index, model_info) { - Ok(plan) => planned.push(plan), - Err(reason) => declined.push((c.name().to_string(), reason)), + } + // Forward (`strBytes "…" = [bytes]`) for the leaves; backward, and as a + // pre-rewrite so a literal whose bytes end another's never rewrites + // inside it, for the plan's evaluation. + let mut forward = String::new(); + let mut backward = String::new(); + let mut empty = String::new(); + for bytes in &b.literals { + if let Some(k) = lit_index.get(bytes) { + forward.push_str(&format!(", strLit_{k}")); + if bytes.is_empty() { + empty = format!(", strLit_{k}"); + } else { + backward.push_str(&format!(", ↓ ← strLit_{k}")); + } } } - (planned, declined) + let constants: String = b + .constants + .iter() + .map(|c| format!(", _root_.{c}")) + .collect(); + let model = format!("_root_.{}", b.model); + let (unfold_list, unfold_words) = if b.fuel { + ( + format!("{model}, {model}__fuel"), + format!("{model} {model}__fuel"), + ) + } else { + (model.clone(), model.clone()) + }; + let with_default = if with_default { + ", _root_.Except.withDefault, withDefault_ite" + } else { + "" + }; + let norm = format!("{STEP_NORM}{empty}{constants}{with_default}"); + // A self-recursive source function is unfolded once, on the right: `simp` + // with its equation would unfold the recursive call on the left as well. + // The last rung of the other leaves meets a constant the source writes by + // name and the plan carries as a numeral: equal only up to the numeral's + // instance, which `rfl` sees and `simp` does not. A fuel wrapper's leaf + // meets its callee at two fuel spellings (`natAbs (n - 1) + 1` against + // `natAbs n` under `0 < n`): equal arguments, by `omega`. + let fuel = if b.fuel { + format!("\n | (simp [{unfold_list}, {norm}, *] <;> congr 1 <;> omega)") + } else { + String::new() + }; + let leaf = if b.recursive && !b.fuel { + format!( + "(with_reducible rfl)\n \ + | (symm; rw [{model}]; simp [{norm}, *]; done)\n \ + | (symm; rw [{model}]; simp_all [{norm}]; done)\n \ + | (symm; rw [{model}]; simp_all [{norm}] <;> omega)" + ) + } else { + format!( + "(with_reducible rfl)\n \ + | (simp only [{unfold_list}{forward}{constants}]; done)\n \ + | (simp [{unfold_list}, {norm}, *]; done){fuel}\n \ + | (simp_all [{unfold_list}, {norm}]; done)\n \ + | (simp_all [{unfold_list}, {norm}] <;> omega)\n \ + | (unfold {unfold_words}; split <;> simp_all [{norm}])\n \ + | (simp only [{unfold_list}{forward}{constants}]; rfl)" + ) + }; + s.push_str(&format!( + "/-- One step of `{m}`: its plan body, with every call answered by the\n \ + callees' images, returns its own image. -/\n\ + theorem step_{f} : AverCert.GrammarBridge.Step AverCert.Plans.fnPlans I [{callees}] {f} := by\n \ + first\n \ + | (set_option maxHeartbeats {cap} in\n \ + (refine ⟨AverCert.Plans.fn{f}, rfl, ?_⟩\n \ + intro F a w h\n \ + simp only [I_{f}, _root_.Option.map_eq_some_iff] at h\n \ + obtain ⟨y, hy, rfl⟩ := h\n \ + unfold dec_{f} at hy\n \ + split at hy <;> simp only [_root_.Option.bind_eq_some_iff, _root_.Option.some.injEq, \ + reduceCtorEq, AverCert.GrammarBridge.decodeStr_eq_some] at hy\n \ + all_goals (repeat (obtain ⟨_, rfl, hy⟩ := hy))\n \ + all_goals (try subst hy)\n \ + all_goals simp only [AverCert.Plans.fn{f}, eval_ite, eval_optDefault, eval_resDefault]\n \ + all_goals simp only [img_{f}, {STEP_EVAL}, I_{f}{callee_simps}{backward}]\n \ + all_goals (repeat' (refine ite_eq_of (fun h => ?_) (fun h => ?_)))\n \ + all_goals (try subst_vars)\n \ + all_goals\n \ + first\n \ + | {leaf}\n \ + done))\n \ + | sorry\n\n", + m = b.model, + cap = STEP_HEARTBEATS, + )); } -/// The eight named host contracts `Obligation.holds` threads, spelled at the -/// obligation's own carrier specification. The composed corollary restates -/// them because it restates `holds` itself with the model replaced. -const BRIDGE_HOST_CONTRACTS: &str = concat!( - " (∀ a b va vb w, S.Repr a va → S.Repr b vb → add [va, vb] = _root_.Option.some w → S.Repr (a + b) w ∧ S.Canon w) →\n", - " (∀ a b va vb w, S.Repr a va → S.Repr b vb → sub [va, vb] = _root_.Option.some w → S.Repr (a - b) w ∧ S.Canon w) →\n", - " (∀ a b va vb w, S.Repr a va → S.Repr b vb → mul [va, vb] = _root_.Option.some w → S.Repr (a * b) w ∧ S.Canon w) →\n", - " (∀ a b w, stringEq [a, b] = _root_.Option.some w → w = _root_.CertPrelude.b32 (_root_.CertPrelude.stringEqW a b)) →\n", - " (∀ resultTy parts c, stringConcat resultTy [parts] = _root_.Option.some c → _root_.CertPrelude.stringConcatW resultTy parts = _root_.Option.some c) →\n", - " (∀ n v r, S.Repr n v → toIndex [v] = _root_.Option.some r → r = _root_.CertPrelude.WVal.i32v (_root_.CertPrelude.toIndexW n)) →\n", - " (∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → cmp [va, vb] = _root_.Option.some r → r = _root_.CertPrelude.WVal.i32v (_root_.CertPrelude.cmpW a b)) →\n", - " (∀ a b va vb r, S.Repr a va → S.Repr b vb → S.Canon va → S.Canon vb → eq [va, vb] = _root_.Option.some r → r = _root_.CertPrelude.WVal.i32v (_root_.CertPrelude.eqW a b)) →\n", -); +/// Per-attempt heartbeat cap. The declaration as a whole carries the file's +/// larger budget, so a step that gives up leaves headroom for the `sorry` +/// beside it: a not-credited bridge instead of a failed build (heartbeats +/// count from the start of each declaration). A step proof does no search, +/// so its cap is small; an export theorem assembles a whole call closure. +const STEP_HEARTBEATS: u32 = 400_000; +const EXPORT_HEARTBEATS: u32 = 1_000_000; +const FILE_HEARTBEATS: u32 = 4_000_000; -/// The named hypotheses the corollary's proof re-applies, in `holds` order. -const BRIDGE_HOST_BINDERS: &str = - "S add sub mul stringEq stringConcat toIndex cmp eq hAdd hSub hMul hStringEq \ - hStringConcat hToIndex hCmp hEq"; +/// The `∀ g ∈ D, ∃ Cs, … ∧ Step …` argument both engines take: one +/// conjunct per closure member, in order, citing that member's step lemma +/// (the callee side condition is decided). +fn render_steps_proof(closure: &[u32]) -> String { + // One `List.forall_mem_cons` per member, in closure order: each member + // cites its own step lemma directly (trying every lemma on every member + // costs a failed unification per pair). + closure.iter().rev().fold( + "(fun _ h => nomatch h)".to_string(), + |rest, f| format!("(List.forall_mem_cons.2 ⟨⟨_, by decide, step_{f}⟩, {rest}⟩)"), + ) +} -/// `manifest.obligations` membership for the obligation at `index`, as an -/// explicit `List.Mem` term. `decide` is not available here (an `Obligation` -/// carries `Type` fields), and the index is exactly what the renderer knows. -fn obligation_membership_term(index: usize) -> String { - let mut term = "_root_.List.Mem.head _".to_string(); - for _ in 0..index { - term = format!("_root_.List.Mem.tail _ ({term})"); - } - term +fn render_export( + bridge: &SourceBridge, + func_idx: u32, + plan: &BridgePlan, + s: &mut String, + corollaries: &mut String, +) { + let b = &plan.fns[&func_idx]; + let closure = closure_of(func_idx, &plan.fns); + let members = closure + .iter() + .map(u32::to_string) + .collect::>() + .join(", "); + let binders = binder_names(b.params.len()); + let intro = if binders.is_empty() { + String::new() + } else { + format!("intro {}; ", binders.join(" ")) + }; + // Splitting every sum, option or result the encoding matches on (at any + // depth) into its constructors lets the encoded argument reduce. + // Every split applies to every goal the earlier ones left (`<;>`): with + // `;` the second parameter was split in the first goal only. + let splits: Vec = b + .params + .iter() + .enumerate() + .filter_map(|(i, p)| rcases_pattern(p).map(|pat| format!("rcases x{i} with {pat}"))) + .collect(); + let split_cases = if splits.is_empty() { + String::new() + } else { + format!("{}; ", splits.join(" <;> ")) + }; + // The image may leave an equation between two copies of the encoder's + // match (the statement's and `img_f`'s), or a conjunction of such for a + // record: equal by unfolding, so `rfl` on each conjunct. + let image_simps = format!( + "I_{func_idx}, dec_{func_idx}, img_{func_idx}, AverCert.GrammarBridge.decodeStr_strBytes" + ); + let image = format!( + "(by {split_cases}all_goals first | rfl | (simp [{image_simps}]; done) | \ + (simp [{image_simps}] <;> (repeat' apply And.intro) <;> rfl))" + ); + let steps = render_steps_proof(&closure); + let kind_proof = match bridge.kind { + BridgeKind::Exact => { + let depth = plan.depth[&func_idx]; + format!( + "refine ⟨{bound}, ?_⟩; \ + intro fuel hk{bs}; \ + exact AverCert.GrammarBridge.exact_of_step AverCert.Plans.fnPlans I [{members}] depth \ + {steps} \ + fuel {func_idx} (by decide) (Nat.lt_of_lt_of_le (by decide +kernel) hk) _ _ {image}", + bound = depth + 1, + bs = if binders.is_empty() { + String::new() + } else { + format!(" {}", binders.join(" ")) + }, + ) + } + BridgeKind::Adequate => format!( + "intro fuel{bs} v h; \ + exact AverCert.GrammarBridge.bridge_of_step AverCert.Plans.fnPlans I [{members}] \ + {steps} \ + fuel {func_idx} (by decide) _ v _ h {image}", + bs = if binders.is_empty() { + String::new() + } else { + format!(" {}", binders.join(" ")) + }, + ), + }; + let typing = format!( + "{intro}{split_cases}all_goals simp [{TYPING_SIMPS}, AverCert.Plans.fn{func_idx}]" + ); + let statement = bridge.expanded_statement(); + s.push_str(&format!( + "/-- plan-equals-source bridge for `{export}` ({kind}): the plan its obligation\n \ + evaluates computes `{model}`. -/\n\ + theorem _root_.{theorem} :\n ", + export = bridge.export, + kind = bridge.kind.tag(), + model = bridge.model, + theorem = bridge.theorem, + )); + // Concatenated, never interpolated into a format string: a statement + // carrying `{`/`}` must stay inert text. + s.push_str(&statement); + // The obligation is selected by its entry and the package's distinct + // export names, never by deciding `exportObligation` (String equality + // against every earlier export, which the kernel evaluates slowly). + let (entry_index, entry) = &plan.entries[&func_idx]; + s.push_str(" := by\n first\n | (set_option maxHeartbeats "); + s.push_str(&EXPORT_HEARTBEATS.to_string()); + s.push_str(&format!( + " in\n (refine ⟨_, AverCert.GrammarBridge.exportObligation_of_entry \ + (s := AverCert.subject) (tt := AverCert.Plans.types) (fns := AverCert.Plans.fnPlans) \ + rfl export_names_nodup (e := {entry}) \ + (List.getElem_mem (l := AverCert.Plans.fnPlans) (n := {entry_index}) (by decide)) rfl, \ + ?_, ?_⟩\n next => " + )); + s.push_str(&typing); + s.push_str("\n next => "); + s.push_str(&kind_proof); + s.push_str("\n done))\n | sorry\n\n"); + let c = corollaries; + c.push_str("/-- The claim the manifest names: the bridge conjoined with the\n \ + artifact-level `Holds` fact, so one kernel-checked name ties the\n \ + plan-equals-source identity to exactly the certified bytes. -/\n\ + theorem _root_."); + c.push_str(&bridge.corollary); + c.push_str(" :\n ("); + c.push_str(&bridge.statement()); + c.push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) :=\n ⟨"); + c.push_str(&pinned_from_expanded( + &format!("_root_.{}", bridge.theorem), + bridge.kind, + bridge.params.len(), + )); + c.push_str(", _root_.AverCert.Final.cert⟩\n\n"); + let _ = param_binders; } -/// Render the package's `Bridge.lean`. -/// -/// Per bridged export it emits three declarations: +/// `export_names_nodup`: the obligations' export names are pairwise +/// distinct, decided once for the package on the names' characters (each +/// literal is definitionally `String.ofList` of them). A failure costs every +/// bridge its credit, never the package. +fn render_export_names_nodup(names: &[String]) -> String { + let chars = lean_char_lists(names, "\n "); + format!( + "{ISOLATE_DECLARATION}\n\ + theorem export_names_nodup :\n \ + (AverCert.manifest.obligations.map (·.export_)).Nodup := by\n \ + first\n \ + | exact AverCert.GrammarBridge.names_nodup_of_chars\n \ + {chars}\n \ + rfl (by decide +kernel)\n \ + | sorry\n\n" + ) +} + +/// The package module that carries the bridge proofs themselves. +pub const BRIDGE_PROOF_MODULE: &str = "BridgeProof"; +/// The decoders, images and rewrite lemmas every step slice imports. +pub const BRIDGE_DEFS_MODULE: &str = "BridgeDefs"; +/// The step lemma slices, `BridgeSteps0`, `BridgeSteps1`, …. +pub const BRIDGE_STEPS_MODULE: &str = "BridgeSteps"; +/// Step lemmas per slice module. +const BRIDGE_STEPS_PER_MODULE: usize = 24; + +/// Render the package's bridge surface: `BridgeDefs.lean` (decoders, images +/// and rewrite lemmas), the step lemmas in slices `BridgeSteps.lean`, +/// `BridgeProof.lean` (one bridge theorem per export) and `Bridge.lean` (the +/// `_certified` corollaries the manifest names). /// -/// * `AverCert.Bridge.` — the bridge itself, the plan's model at the -/// encoded arguments equals the encoded source result. Its proof is a FIXED -/// tactic script (the producer cannot run Lean): definitional `rfl` closes -/// every arithmetic and inline-sign-template shape, and the three `cmpW` -/// lemmas below close the host-comparison shapes. A shape no alternative -/// closes falls through to `sorry`, which costs that bridge its credit and -/// nothing else. -/// * `AverCert.Bridge._sourceModel` — the reader-facing composition: -/// the obligation restated with the plan model replaced by the source -/// function, conjoined with `Holds`. -/// * `AverCert.Bridge._certified` — the corollary the manifest names -/// and the checker's pin cites. Its `Holds` conjunct is taken from -/// `_sourceModel`, so the checker's axiom audit of the pin walks the composed -/// corollary too instead of leaving it an unaudited theorem beside the claim. -fn render_bridge_lean(plans: &[BridgePlan]) -> String { - let mut s = String::new(); - s.push_str( +/// Only the corollaries cite `AverCert.Final.cert`, and `Final` sits behind +/// `Artifact.lean`, the byte-level proof whose build time grows with the +/// module. Kept apart from it, the bridge proofs — the other long build of a +/// large package — no longer wait for `Artifact.lean` (on btc-listener's +/// 117 KB module the two took about eleven and five minutes, one after the +/// other). +/// `Bridge.lean` still imports every model root, since the checker admits a +/// nested model file only on an import line of `Bridge.lean` or `Laws.lean`. +fn render_bridge_lean( + plan: &BridgePlan, + model_roots: &[String], +) -> (String, String, Vec<(String, String)>) { + let mut s = String::from( "-- Plan-equals-source bridges of this certificate. Each bridge identifies\n\ -- the plan an export's obligation evaluates with the transpiled source\n\ - -- function the model modules and the law-claims speak about, at exactly\n\ - -- the encoders the face's representation relation uses. Every name is\n\ - -- `_root_`-qualified so the statement means the same here and in the\n\ - -- checker-authored pin.\n\ + -- function the model modules and the law-claims speak about, through\n\ + -- the source-value encoders the checker renders. Producer data: the\n\ + -- checker re-states every bridge from structure and audits its axioms.\n\ import Manifest\n\ - import Final\n\n\ - set_option autoImplicit false\n\n\ - set_option maxRecDepth 200000\n\n\ - -- Two explicit heartbeat budgets rather than the ambient default.\n\ - -- Each fallible step below runs under the SMALLER inner cap while the\n\ - -- declaration as a whole carries this larger one, so a step that\n\ - -- gives up leaves headroom for the `first | … | sorry` beside it to\n\ - -- close the goal — a NOT-CREDITED bridge instead of a failed build,\n\ - -- which would decline the whole package. Heartbeats are counted from\n\ - -- the start of each declaration, so the headroom is per theorem.\n\ - set_option maxHeartbeats 4000000\n\n\ - /-- `__aint_cmp`'s three-way verdict decides the source strict order. -/\n\ - theorem AverCert.Bridge.cmpLtDecide (a b : Int) :\n \ - decide (_root_.CertPrelude.cmpW a b < 0) = decide (a < b) := by\n \ - simp [_root_.AverCert.StandardFace.cmpW_lt_iff]\n\n\ - theorem AverCert.Bridge.cmpGtDecide (a b : Int) :\n \ - decide (_root_.CertPrelude.cmpW a b > 0) = decide (b < a) := by\n \ - simp [_root_.AverCert.StandardFace.cmpW_gt_iff]\n\n\ - theorem AverCert.Bridge.cmpGeDecide (a b : Int) :\n \ - decide (_root_.CertPrelude.cmpW a b ≥ 0) = decide (b ≤ a) := by\n \ - simp [_root_.AverCert.StandardFace.cmpW_ge_iff]\n\n", + import GrammarBridge\n", ); - for plan in plans { - let export = &plan.bridge.export; - let params = &plan.bridge.params; - let statement = plan.bridge.statement(); - let encoded_args = encoded_args(params); - let binders = binder_names(params.len()).join(" "); - let intro = if binders.is_empty() { - String::new() - } else { - format!(" intro {binders}\n") + for root in model_roots { + s.push_str(&format!("import {root}\n")); + } + s.push_str(&format!( + "\nset_option autoImplicit false\n\ + set_option maxRecDepth 200000\n\ + set_option linter.unusedSimpArgs false\n\ + set_option linter.unusedVariables false\n\ + set_option maxHeartbeats {FILE_HEARTBEATS}\n\n\ + namespace AverCert.Bridge\n\n" + )); + for b in plan.fns.values() { + render_fn_defs(b, &mut s); + } + render_image_table(&plan.fns, &mut s); + s.push_str(STEP_LEMMAS); + s.push('\n'); + // The depth of every function whose call closure has no recursion. + s.push_str("/-- Call depth over the acyclic part of the call graph. -/\ndef depth : _root_.Nat → _root_.Nat := fun g =>\n match g with\n"); + for (f, d) in &plan.depth { + s.push_str(&format!(" | {f} => {d}\n")); + } + s.push_str(" | _ => 0\n\n"); + // The bytes of every String literal the plans mention, as rewrite + // lemmas: `simp` cannot evaluate `strBytes "…"` itself. + let mut lit_index: BTreeMap, usize> = BTreeMap::new(); + for (index, bytes) in plan.literals.iter().enumerate() { + let Some(text) = lean_string_literal(bytes) else { + continue; + }; + let list = bytes + .iter() + .map(u8::to_string) + .collect::>() + .join(", "); + s.push_str(&format!( + "theorem strLit_{index} : AverCert.GrammarBridge.strBytes {text} = [{list}] := by\n \ + first | decide | rfl | sorry\n\n" + )); + lit_index.insert(bytes.clone(), index); + } + // `Result.withDefault` over an `if`: the models' `Except.withDefault` + // does not reduce under `simp` until the `if` is pulled out. + if plan.with_default { + s.push_str( + "theorem withDefault_ite {α ε : Type} (c : Prop) [Decidable c] (e : ε) (v d : α) :\n \ + _root_.Except.withDefault (if c then _root_.Except.error e else _root_.Except.ok v) d =\n \ + if c then d else v := by\n \ + split <;> rfl\n\n", + ); + } + s.push_str("end AverCert.Bridge\n"); + // The step lemmas, a slice per module: independent proofs, so Lake builds + // the slices in parallel; one module of every step took over an hour on + // k5's 260 bridges. + let mut parts = vec![(format!("{BRIDGE_DEFS_MODULE}.lean"), s)]; + let steps: Vec<&BridgedFn> = plan.fns.values().collect(); + let mut s = String::from( + "-- Plan-equals-source bridges of this certificate: the export theorems,\n\ + -- over the step lemmas of the slices imported below.\n", + ); + for (i, slice) in steps.chunks(BRIDGE_STEPS_PER_MODULE).enumerate() { + let name = format!("{BRIDGE_STEPS_MODULE}{i}"); + let mut part = format!( + "-- One slice of the bridge step lemmas.\n\ + import {BRIDGE_DEFS_MODULE}\n\n\ + set_option autoImplicit false\n\ + set_option maxRecDepth 200000\n\ + set_option linter.unusedSimpArgs false\n\ + set_option linter.unusedVariables false\n\ + set_option maxHeartbeats {FILE_HEARTBEATS}\n\n\ + namespace AverCert.Bridge\n\n" + ); + for b in slice { + render_step(b, &plan.fns, &lit_index, plan.with_default, &mut part); + } + part.push_str("end AverCert.Bridge\n"); + parts.push((format!("{name}.lean"), part)); + s.push_str(&format!("import {name}\n")); + } + s.push_str(&format!( + "\nset_option autoImplicit false\n\ + set_option maxRecDepth 200000\n\ + set_option linter.unusedSimpArgs false\n\ + set_option linter.unusedVariables false\n\ + set_option maxHeartbeats {FILE_HEARTBEATS}\n\n\ + namespace AverCert.Bridge\n\n" + )); + s.push_str(&render_export_names_nodup(&plan.obligation_names)); + let mut corollaries = String::new(); + for (bridge, func_idx) in &plan.bridges { + render_export(bridge, *func_idx, plan, &mut s, &mut corollaries); + } + s.push_str("end AverCert.Bridge\n"); + let mut bridge = format!( + "-- The plan-equals-source claims of this certificate: each bridge theorem\n\ + -- of `{BRIDGE_PROOF_MODULE}` conjoined with the artifact-level `Holds` fact.\n\ + import {BRIDGE_PROOF_MODULE}\n\ + import Final\n" + ); + for root in model_roots { + bridge.push_str(&format!("import {root}\n")); + } + bridge.push_str("\nset_option autoImplicit false\n\n"); + bridge.push_str(&corollaries); + (s, bridge, parts) +} + +// ---- law coverage ------------------------------------------------------------- + +/// Every source function a law statement mentions, in first-appearance +/// order: a token is a maximal run of Lean identifier characters, and it +/// counts when it is `_root_.` followed by the qualified name of a def the +/// model declares (the statement is root-qualified by then, and that is the +/// only spelling the checker counts). A def spelled any other way would be a +/// mention the checker refuses in a bridged law, so it costs the law its +/// bridged corollary. Over-recognition only adds a TRUE conjunct; +/// under-recognition only costs the law its bridged corollary — fail-closed +/// for the claim either way. +fn law_statement_model_fns(statement: &str, info: &ModelInfo) -> Option> { + let mut fns = Vec::new(); + for token in crate::bridge_statement::statement_tokens(statement) { + match token.strip_prefix(crate::bridge_statement::ROOT_PREFIX) { + Some(named) if info.defs.contains_key(named) => fns.push(named.to_string()), + Some(_) => {} + None => { + if info.defs.keys().any(|def| { + crate::bridge_statement::token_names_model_unqualified(token, def) + }) { + return None; + } + } + } + } + Some(fns) +} + +/// The bridges covering every source function a law mentions (`None` when +/// some mentioned function has no bridge; empty when it mentions none). The +/// list itself is the checker's rule +/// ([`crate::bridge_statement::law_mentioned_bridges`]), so the checker finds +/// exactly the list the manifest carries. +fn law_bridge_coverage(statement: &str, info: &ModelInfo, bridges: &[SourceBridge]) -> Option> { + for model in law_statement_model_fns(statement, info)? { + bridges.iter().position(|bridge| bridge.model == model)?; + } + let models: Vec<&str> = bridges.iter().map(|bridge| bridge.model.as_str()).collect(); + Some(crate::bridge_statement::law_mentioned_bridges(statement, &models)) +} + +/// The directory every model file ships under, and the first segment of every +/// model module root. +/// +/// The model modules are named after the user's Aver modules, and nothing +/// stops a user from naming one `Laws`, `Bridge`, `Manifest`, `Final`, +/// `Grammar` or `Schema` — names the package itself or the checker's wall +/// already own. Shipped flat, one such module used to shadow a certificate +/// file, and the producer then had to leave out the whole model, declining +/// every bridge and every law. Nested under this one reserved directory, a +/// model root can never equal or case-insensitively prefix a package, wall or +/// toolchain root (none of them starts with it), whatever the user named the +/// module. Only the FILE location moves: the Lean namespaces inside, and so +/// every name a bridge or a law-claim cites, stay exactly as emitted. +pub const MODEL_PACKAGE_DIR: &str = "AverModel"; + +/// The model as the package ships it: the module roots `Bridge.lean` and +/// `Laws.lean` import, and the files under [`MODEL_PACKAGE_DIR`]. +#[derive(Debug, Default)] +struct PackagedModel { + roots: Vec, + files: Vec<(String, String)>, +} + +/// Prepare the model files for the package, or say why none can ship. +/// +/// Every check here is one the checker applies to the staged tree, run with +/// the checker's own code (`lean_gate`), so a model the checker would refuse +/// — and with it the WHOLE package, byte certificate included — is declined +/// here instead, costing only the bridges and law-claims that needed it. +fn package_model(model: &SourceModel) -> Result { + let mut roots = Vec::new(); + for (path, _) in &model.files { + let root = crate::lean_gate::lean_module_root(path) + .map_err(|_| format!("model file `{path}` is not a plain Lean module path"))?; + roots.push(root); + } + let wall_roots: Vec<&str> = wall::SOURCES + .iter() + .filter_map(|source| source.name.strip_suffix(".lean")) + .collect(); + let mut packaged = PackagedModel::default(); + let mut seen_paths = std::collections::BTreeSet::new(); + for (path, content) in &model.files { + let package_path = format!("{MODEL_PACKAGE_DIR}/{path}"); + if !seen_paths.insert(package_path.to_ascii_lowercase()) { + return Err(format!( + "model files collide case-insensitively at `{package_path}`" + )); + } + let text = rewrite_model_imports(content, &roots, &wall_roots)?; + let text = isolate_theorems(&keep_admitted_deriving(&text)); + if let Some(token) = crate::lean_gate::code_exec_token(&text) { + return Err(format!( + "model file `{path}` carries `{token}`, which the checker's token gate refuses" + )); + } + packaged.files.push((package_path, text)); + } + packaged.roots = roots + .iter() + .map(|root| format!("{MODEL_PACKAGE_DIR}.{root}")) + .collect(); + Ok(packaged) +} + +/// Point every model-to-model import at the model's package location +/// (`import Domain.Rational` becomes `import AverModel.Domain.Rational`). +/// Imports of a checker-owned wall module (the model prelude) and of the +/// toolchain stay as they are; any other import names a module the package +/// would not contain, so the model is declined rather than shipped broken. +fn rewrite_model_imports( + content: &str, + model_roots: &[String], + wall_roots: &[&str], +) -> Result { + let mut out = String::with_capacity(content.len() + 64); + for line in content.lines() { + if let Some(module) = line.strip_prefix("import ") { + let module = module.trim(); + let first = module.split('.').next().unwrap_or_default(); + if model_roots.iter().any(|root| root == module) { + out.push_str(&format!("import {MODEL_PACKAGE_DIR}.{module}\n")); + continue; + } + if !(wall_roots.contains(&module) || matches!(first, "Init" | "Std")) { + return Err(format!( + "a model file imports `{module}`, which is neither a model module nor a \ + checker-owned one" + )); + } + } + out.push_str(line); + out.push('\n'); + } + Ok(out) +} + +/// Keep, of every `deriving` line, only the classes the checker's gate admits +/// (`lean_gate::DERIVING_CLASSES`, and `DERIVING_INSTANCE_CLASSES` for the +/// stand-alone `deriving instance … for T` form); a line left with none is +/// dropped. The emitter already writes the certificate model's clauses from +/// the admitted classes; this also covers the fixed prelude records whose +/// clauses name `Repr`, which the model never needs. +fn keep_admitted_deriving(content: &str) -> String { + let mut out = String::with_capacity(content.len()); + for line in content.lines() { + let trimmed = line.trim_start(); + let Some(rest) = trimmed.strip_prefix("deriving ") else { + out.push_str(line); + out.push('\n'); + continue; + }; + let indent = &line[..line.len() - trimmed.len()]; + let keep = |classes: &str, admitted: &[&str]| -> Vec { + classes + .split(',') + .map(str::trim) + .filter(|class| admitted.contains(class)) + .map(str::to_string) + .collect() }; - let bridge_at = if binders.is_empty() { - format!("_root_.AverCert.Bridge.{export}") + let rewritten = if let Some(instance) = rest.strip_prefix("instance ") { + instance.split_once(" for ").and_then(|(classes, types)| { + let kept = keep(classes, &crate::lean_gate::DERIVING_INSTANCE_CLASSES); + (!kept.is_empty()) + .then(|| format!("{indent}deriving instance {} for {}", kept.join(", "), types.trim())) + }) } else { - format!("_root_.AverCert.Bridge.{export} {binders}") + let kept = keep(rest, &crate::lean_gate::DERIVING_CLASSES); + (!kept.is_empty()).then(|| format!("{indent}deriving {}", kept.join(", "))) }; - let source_binders = params + if let Some(rewritten) = rewritten { + out.push_str(&rewritten); + out.push('\n'); + } + } + out +} + +/// The command prefix that confines a declaration's elaboration errors to +/// that declaration. +const ISOLATE_DECLARATION: &str = "#guard_msgs (drop error) in"; + +/// Put every theorem of a certificate Lean file behind +/// [`ISOLATE_DECLARATION`]. +/// +/// A proof that fails — including the deterministic `maxHeartbeats` timeout, +/// which no `first | … | sorry` ladder can catch because Lean re-throws +/// resource-limit exceptions past every tactic combinator — is an elaboration +/// ERROR, and one error anywhere used to fail `lake build` and with it the +/// whole package. Lean's error recovery already closes the failed goal with +/// `sorryAx` (or leaves the constant undeclared, in which case every +/// declaration citing it recovers to `sorryAx` in turn); the error MESSAGE is +/// all that fails the build. `#guard_msgs (drop error) in` drops exactly that +/// message for exactly that one command, so the build goes on and the +/// checker's per-claim axiom audit reports every claim resting on the failed +/// proof as not credited. It changes no declaration and admits nothing the +/// kernel did not check; warnings (`declaration uses 'sorry'`) still pass +/// through to the build log. +/// +/// The prefix goes before the command's whole preamble — `set_option … in`, +/// `open … in` and a doc comment — since a doc comment right before +/// `#guard_msgs` would become its expected output. A theorem inside a +/// `mutual … end` block isolates the block, the one command it belongs to. +pub fn isolate_theorems(content: &str) -> String { + let lines: Vec<&str> = content.lines().collect(); + let is_theorem = |line: &str| { + ["theorem ", "private theorem ", "protected theorem "] .iter() - .enumerate() - .map(|(index, encoder)| format!("(x{index} : {}) ", encoder.binder_type())) - .collect::(); - let applied_binders = if binders.is_empty() { - String::new() + .any(|keyword| line.starts_with(keyword)) + }; + // Which lines start a command to isolate. + let mut starts: Vec = Vec::new(); + let mut index = 0; + while index < lines.len() { + if lines[index] == "mutual" { + let end = (index + 1..lines.len()) + .find(|at| lines[*at] == "end") + .unwrap_or(lines.len() - 1); + if lines[index..=end].iter().any(|line| is_theorem(line.trim_start())) { + starts.push(index); + } + index = end + 1; + continue; + } + if is_theorem(lines[index]) { + starts.push(command_preamble_start(&lines, index)); + } + index += 1; + } + let mut out = String::with_capacity(content.len() + starts.len() * 32); + let mut next = starts.iter().peekable(); + for (at, line) in lines.iter().enumerate() { + if next.peek() == Some(&&at) { + next.next(); + out.push_str(ISOLATE_DECLARATION); + out.push('\n'); + } + out.push_str(line); + out.push('\n'); + } + out +} + +/// The first line of the preamble of the declaration at `keyword_line`: the +/// `set_option … in` / `open … in` lines and the doc comment in front of it, +/// looking past blank lines and `--` comments between them. +fn command_preamble_start(lines: &[&str], keyword_line: usize) -> usize { + let mut start = keyword_line; + let mut at = keyword_line; + while at > 0 { + let line = lines[at - 1]; + let trimmed = line.trim(); + if trimmed.is_empty() || trimmed.starts_with("--") { + at -= 1; + continue; + } + if (line.starts_with("set_option ") || line.starts_with("open ")) && trimmed.ends_with(" in") { + at -= 1; + start = at; + continue; + } + if trimmed.ends_with("-/") { + let Some(open) = (0..at).rev().find(|j| lines[*j].trim_start().starts_with("/-")) else { + break; + }; + if lines[open].trim_start().starts_with("/--") { + at = open; + start = at; + continue; + } + } + break; + } + start +} + +/// The rendered bridge Lean: the proofs module, the `Bridge.lean` +/// corollaries, and the named part files the proofs import. +type BridgeLean = (String, String, Vec<(String, String)>); + +/// What `write_project` needs to render the bridge and law surfaces. +struct Surfaces { + model: PackagedModel, + bridge_lean: Option, + laws_lean: Option, + bridges: Vec, + law_claims: Vec, + law_bridge_exports: Vec>, + declined_bridges: Vec<(String, String)>, + declined_laws: Vec<(String, String)>, +} + +impl Surfaces { + /// The bridges the package ships: none unless their Lean is written. + fn packaged_bridges(&self) -> &[SourceBridge] { + if self.bridge_lean.is_some() { + &self.bridges } else { - format!("{binders} ") + &[] + } + } +} + +fn plan_surfaces(analysis: &Analysis, model: &SourceModel) -> Surfaces { + let decline_all = |reason: String| Surfaces { + model: PackagedModel::default(), + bridge_lean: None, + laws_lean: None, + bridges: Vec::new(), + law_claims: Vec::new(), + law_bridge_exports: Vec::new(), + declined_bridges: analysis + .certified + .iter() + .map(|c| (c.name.clone(), clean_reason(&reason))) + .collect(), + declined_laws: model + .law_claims + .iter() + .map(|claim| (claim.label.clone(), clean_reason(&reason))) + .collect(), + }; + if let Some(reason) = &model.failure { + return decline_all(reason.clone()); + } + let packaged = match package_model(model) { + Ok(packaged) => packaged, + Err(reason) => return decline_all(reason), + }; + let roots = packaged.roots.clone(); + let plan = plan_bridges(analysis, model); + let bridges: Vec = plan.bridges.iter().map(|(b, _)| b.clone()).collect(); + let bridge_lean = (!plan.fns.is_empty() && !bridges.is_empty()) + .then(|| { + let (proofs, corollaries, parts) = render_bridge_lean(&plan, &roots); + let parts = parts + .into_iter() + .map(|(name, text)| (name, isolate_theorems(&text))) + .collect(); + (isolate_theorems(&proofs), isolate_theorems(&corollaries), parts) + }); + let info = ModelInfo::from_model(model); + // The checker reads every law statement at the root, so each is rewritten + // from the emitter's namespace-relative text to `_root_.`-qualified names + // before the gates see it. + let names = ModelNames::from_files( + model + .files + .iter() + .map(|(path, content)| (path.as_str(), content.as_str())), + ); + let (law_claims, declined_laws) = + admit_law_claims(root_qualify_law_claims(&model.law_claims, &names)); + let law_bridges: Vec> = law_claims + .iter() + .map(|claim| law_bridge_coverage(&claim.statement, &info, &bridges).unwrap_or_default()) + .collect(); + let law_bridge_terms: Vec> = law_bridges + .iter() + .map(|indices| { + indices + .iter() + .map(|index| (bridges[*index].corollary.clone(), bridges[*index].statement())) + .collect() + }) + .collect(); + let laws_lean = (!law_claims.is_empty()) + .then(|| isolate_theorems(&render_laws_lean(&law_claims, &law_bridge_terms, &roots))); + let law_bridge_exports = law_bridges + .iter() + .map(|indices| indices.iter().map(|i| bridges[*i].export.clone()).collect()) + .collect(); + Surfaces { + model: packaged, + bridge_lean, + laws_lean, + bridges, + law_claims, + law_bridge_exports, + declined_bridges: plan.declined, + declined_laws, + } +} + +#[cfg(test)] +mod source_bridge_tests { + use super::*; + + #[test] + fn lean_types_parse_into_trees() { + assert_eq!( + parse_lean_ty("Except String (List Int)"), + Some(LTy::App( + "Except".into(), + vec![ + LTy::App("String".into(), vec![]), + LTy::App("List".into(), vec![LTy::App("Int".into(), vec![])]) + ] + )) + ); + assert_eq!( + parse_lean_ty("(Int × Bool × Fraction)"), + Some(LTy::Prod(vec![ + LTy::App("Int".into(), vec![]), + LTy::App("Bool".into(), vec![]), + LTy::App("Fraction".into(), vec![]) + ])) + ); + assert_eq!(parse_lean_ty("(Int"), None); + } + + fn model(files: Vec<(&str, &str)>, entry: &str, deps: Vec<(&str, &str)>) -> SourceModel { + SourceModel { + files: files + .into_iter() + .map(|(p, c)| (p.to_string(), c.to_string())) + .collect(), + entry_namespace: entry.to_string(), + dependency_namespaces: deps + .into_iter() + .map(|(a, b)| (a.to_string(), b.to_string())) + .collect(), + law_claims: Vec::new(), + failure: None, + } + } + + const RATIONAL: &str = "import AverCommon\n\nnamespace Domain.Rational\n\nstructure Fraction where\n top : Int\n bottom : Int\n\ninductive Op where\n | add (_ : Int)\n | zero\n\nset_option smartUnfolding false in\n/-- doc -/\ndef plus (a : Fraction) (b : Fraction) : Fraction :=\n a\n\ndef zeroFraction : Fraction :=\n a\n\nmutual\n def isEven__fuel (fuel : Nat) (n : Int) : Int :=\n 0\nend\n\nend Domain.Rational\n"; + + #[test] + fn model_defs_resolve_by_their_flat_wasm_name() { + let m = model( + vec![("Domain/Rational.lean", RATIONAL)], + "Main", + vec![("Domain.Rational", "Domain.Rational")], + ); + let info = ModelInfo::from_model(&m); + let plus = info.def_for("Domain_Rational_plus").expect("resolves"); + assert_eq!(plus.qualified, "Domain.Rational.plus"); + assert_eq!(plus.params, vec!["Fraction", "Fraction"]); + assert_eq!(plus.ret, "Fraction"); + let zero = info.def_for("Domain_Rational_zeroFraction").expect("nullary"); + assert!(zero.params.is_empty()); + assert!(info.def_for("plus").is_err()); + assert!(info.def_for("Domain_Rational_isEven__fuel").is_ok()); + assert_eq!( + info.structures["Domain.Rational.Fraction"].fields, + vec![("top".into(), "Int".into()), ("bottom".into(), "Int".into())] + ); + assert_eq!( + info.inductives["Domain.Rational.Op"].ctors, + vec![("add".into(), vec!["Int".into()]), ("zero".into(), vec![])] + ); + } + + #[test] + fn encoders_follow_the_byte_pinned_layout() { + let m = model( + vec![("Domain/Rational.lean", RATIONAL)], + "Main", + vec![("Domain.Rational", "Domain.Rational")], + ); + let info = ModelInfo::from_model(&m); + let tt = PlanTypeTable { + records: vec![PlanRecordDecl { + tid: 0, + struct_idx: 5, + fields: vec![PlanTy::Int, PlanTy::Int], + }], + sums: vec![PlanSumDecl { + tid: 1, + root: 6, + ctors: vec![(7, vec![PlanTy::Int]), (8, vec![])], + }], + ..PlanTypeTable::default() }; - // Concatenated rather than interpolated wherever a statement is - // involved: a source type or accessor carrying `{`/`}` must stay inert - // text, exactly as in `render_laws_lean`. - s.push_str("/-- plan-equals-source bridge for `"); - s.push_str(export); - s.push_str("`: the plan this export's obligation evaluates IS `"); - s.push_str(&plan.bridge.model); - s.push_str("`. -/\ntheorem _root_.AverCert.Bridge."); - s.push_str(export); - s.push_str(" :\n "); - s.push_str(&statement); - s.push_str(" := by\n"); - s.push_str(&intro); - s.push_str( - " first\n \ - | (set_option maxHeartbeats 1000000 in rfl)\n \ - | exact congrArg (fun v => _root_.Option.some (_root_.RecordComputeBridge.SVal.b v))\n \ - (_root_.AverCert.Bridge.cmpLtDecide _ _)\n \ - | exact congrArg (fun v => _root_.Option.some (_root_.RecordComputeBridge.SVal.b v))\n \ - (_root_.AverCert.Bridge.cmpGtDecide _ _)\n \ - | exact congrArg (fun v => _root_.Option.some (_root_.RecordComputeBridge.SVal.b v))\n \ - (_root_.AverCert.Bridge.cmpGeDecide _ _)\n \ - | sorry\n\n", + let ns = "Domain.Rational"; + let fraction = info + .encoder(&PlanTy::Record(0), &parse_lean_ty("Fraction").unwrap(), ns, &tt, &mut Vec::new()) + .expect("record"); + assert_eq!(fraction.kind(), "record"); + assert!(fraction.is_well_formed()); + let op = info + .encoder(&PlanTy::Sum(1), &parse_lean_ty("Op").unwrap(), ns, &tt, &mut Vec::new()) + .expect("sum"); + assert!(op.is_well_formed()); + // A plan type that disagrees with the Lean type declines. + assert!( + info.encoder(&PlanTy::Bool, &parse_lean_ty("Int").unwrap(), ns, &tt, &mut Vec::new()) + .is_err() ); - s.push_str("/-- `"); - s.push_str(export); - s.push_str("`'s obligation with the plan model replaced by `"); - s.push_str(&plan.bridge.model); - s.push_str( - "`:\n the emitted body, run on a represented argument under the named host\n \ - contracts, yields a represented result of the SOURCE function. -/\n\ - theorem _root_.AverCert.Bridge.", + // A layout with a different field count declines. + let narrow = PlanTypeTable { + records: vec![PlanRecordDecl { + tid: 0, + struct_idx: 5, + fields: vec![PlanTy::Int], + }], + ..PlanTypeTable::default() + }; + assert!( + info.encoder(&PlanTy::Record(0), &parse_lean_ty("Fraction").unwrap(), ns, &narrow, &mut Vec::new()) + .is_err() ); - s.push_str(export); - s.push_str("_sourceModel :\n (∀ (S : _root_.AverCert.Schema.CarrierSpec _root_.AverCert."); - s.push_str(export); - s.push_str( - "Ob.carrier)\n \ - (add sub mul stringEq : List _root_.CertPrelude.WVal → Option _root_.CertPrelude.WVal)\n \ - (stringConcat : Nat → List _root_.CertPrelude.WVal → Option _root_.CertPrelude.WVal)\n \ - (toIndex cmp eq : List _root_.CertPrelude.WVal → Option _root_.CertPrelude.WVal),\n", + // Decoder shapes: a sum expands per constructor. + let mut fresh = 0; + let shapes = alts(&op, &mut fresh).expect("alts"); + assert_eq!(shapes.len(), 2); + assert_eq!(shapes[0].source, "(_root_.Domain.Rational.Op.add t0)"); + assert_eq!(shapes[1].source, "_root_.Domain.Rational.Op.zero"); + // A String is matched whole and decoded by the wall's `decodeStr`. + let strs = alts(&SourceEncoder::Str, &mut fresh).expect("a String decodes"); + assert_eq!(strs.len(), 1); + assert_eq!(strs[0].binds, vec![("v1".to_string(), "t1".to_string())]); + assert!(alts(&SourceEncoder::Float, &mut fresh).is_err()); + assert!(alts(&SourceEncoder::List(Box::new(SourceEncoder::Int)), &mut fresh).is_err()); + } + + #[test] + fn string_literals_render_as_lean_literals_and_sums_split_structurally() { + assert_eq!(lean_string_literal(b"a\"b\\c\n"), Some("\"a\\\"b\\\\c\\n\"".to_string())); + assert_eq!(lean_string_literal(b"\x01"), Some("\"\\x01\"".to_string())); + assert_eq!(lean_string_literal(&[0xff]), None); + let op = SourceEncoder::Sum { + tid: 1, + lean_type: "_root_.M.Op".to_string(), + ctors: vec![ + ("_root_.M.Op.add".to_string(), vec![SourceEncoder::Int]), + ("_root_.M.Op.zero".to_string(), Vec::new()), + ], + }; + let record = SourceEncoder::Record { + tid: 0, + lean_type: "_root_.M.R".to_string(), + fields: vec![ + ("_root_.M.R.a".to_string(), SourceEncoder::Int), + ("_root_.M.R.op".to_string(), op.clone()), + ], + }; + assert_eq!(rcases_pattern(&SourceEncoder::Int), None); + assert_eq!(rcases_pattern(&op).as_deref(), Some("(⟨_⟩ | ⟨⟩)")); + assert_eq!(rcases_pattern(&record).as_deref(), Some("⟨_, (⟨_⟩ | ⟨⟩)⟩")); + assert_eq!( + rcases_pattern(&SourceEncoder::Option(Box::new(SourceEncoder::Int))).as_deref(), + Some("(⟨⟩ | _)") ); - s.push_str(BRIDGE_HOST_CONTRACTS); - s.push_str(" ∀ (fuel : Nat) "); - s.push_str(&source_binders); - s.push_str("(vs : List _root_.CertPrelude.WVal) (w : _root_.CertPrelude.WVal),\n _root_.AverCert."); - s.push_str(export); - s.push_str("Ob.domRepr S "); - s.push_str(&encoded_args); - s.push_str(" vs →\n _root_.CertPrelude.wFuncN _root_.AverCert."); - s.push_str(export); - s.push_str("Ob.code (_root_.AverCert."); - s.push_str(export); - s.push_str("Ob.host add sub mul stringEq stringConcat toIndex cmp eq) fuel _root_.AverCert."); - s.push_str(export); - s.push_str("Ob.self vs = _root_.Option.some w →\n _root_.AverCert."); - s.push_str(export); - s.push_str("Ob.codRepr S (_root_.Option.some ("); - s.push_str( - &plan - .bridge - .result - .encode(&source_call(&plan.bridge.model, params.len())), + } + + /// A user module named like a package or wall file (`Laws`, `Grammar`) used + /// to shadow it, and the producer then left the whole model out. Nested + /// under the reserved model directory, every model root is one no package, + /// wall or toolchain root can equal or prefix, and the model's own imports + /// follow it there while the wall prelude's import stays put. + #[test] + fn model_modules_named_like_certificate_files_ship_nested() { + let m = model( + vec![ + ("AverCommon.lean", "import ModelPrelude\n\nset_option autoImplicit false\n"), + ("Laws.lean", "import AverCommon\n\nnamespace Laws\ndef f (x : Int) : Int := x\nend Laws\n"), + ("Grammar.lean", "import AverCommon\nimport Laws\n\nnamespace Grammar\nend Grammar\n"), + ], + "Laws", + vec![], ); - s.push_str(")) w)\n ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) := by\n \ - refine ⟨?_, _root_.AverCert.Final.cert⟩\n intro "); - s.push_str(BRIDGE_HOST_BINDERS); - s.push_str(" fuel "); - s.push_str(&applied_binders); - s.push_str("vs w hDom hRun\n have hHolds : _root_.AverCert."); - s.push_str(export); - s.push_str("Ob.holds :=\n _root_.AverCert.Final.cert.2.2.2 _root_.AverCert."); - s.push_str(export); - s.push_str("Ob ("); - s.push_str(&obligation_membership_term(plan.obligation_index)); - s.push_str(")\n have hSim := hHolds "); - s.push_str(BRIDGE_HOST_BINDERS); - s.push_str(" fuel "); - s.push_str(&encoded_args); - // The composition step is the one place a shape the fixed script does - // not close could otherwise fail the BUILD, and a failed build declines - // the whole package. Wrapping it in `first | … | sorry` turns that into - // a not-credited bridge: the `sorry` flows into `_certified.2` through - // `_sourceModel`, so it costs this bridge its credit and nothing else. - s.push_str( - " vs w hDom hRun\n first\n \ - | (set_option maxHeartbeats 1000000 in simpa only [_root_.AverCert.", + let packaged = package_model(&m).expect("the model ships"); + assert_eq!( + packaged.roots, + vec!["AverModel.AverCommon", "AverModel.Laws", "AverModel.Grammar"] ); - s.push_str(export); - s.push_str("Ob, "); - s.push_str(&bridge_at); - s.push_str("] using hSim)\n | sorry\n\n"); - s.push_str("/-- The claim the manifest names: the bridge conjoined with the\n \ - artifact-level `Holds` fact, so one kernel-checked name ties the\n \ - plan-equals-source identity to exactly the certified bytes. -/\n\ - theorem _root_.AverCert.Bridge."); - s.push_str(export); - s.push_str(BRIDGE_COROLLARY_SUFFIX); - s.push_str(" :\n ("); - s.push_str(&statement); - s.push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) :=\n ⟨_root_.AverCert.Bridge."); - s.push_str(export); - s.push_str(", (_root_.AverCert.Bridge."); - s.push_str(export); - s.push_str("_sourceModel).2⟩\n\n#print axioms _root_.AverCert.Bridge."); - s.push_str(export); - s.push_str(BRIDGE_COROLLARY_SUFFIX); - s.push_str("\n\n"); - } - s -} - -/// Every model function a law statement mentions, in first-appearance order. -/// -/// The scan is textual over the statement the emitter itself wrote: a token is -/// a maximal run of Lean identifier characters, and it counts when it is the -/// qualified name of a def the model modules declare. Over-recognition is -/// harmless (an extra TRUE conjunct); under-recognition only costs the law its -/// bridge upgrade, so the direction of failure is fail-closed for the claim. -fn law_statement_model_fns(statement: &str, model_info: &ModelInfo) -> Vec { - let mut found: Vec = Vec::new(); - for token in statement.split(|c: char| !(c.is_ascii_alphanumeric() || c == '_' || c == '.')) { - let token = token.trim_matches('.'); - if token.is_empty() || !model_info.is_model_fn(token) { - continue; - } - if !found.iter().any(|seen| seen == token) { - found.push(token.to_string()); + let files: std::collections::BTreeMap<_, _> = packaged.files.into_iter().collect(); + assert!(files["AverModel/AverCommon.lean"].starts_with("import ModelPrelude\n")); + assert!(files["AverModel/Grammar.lean"].starts_with("import AverModel.AverCommon\nimport AverModel.Laws\n")); + for root in &packaged.roots { + let first = root.split('.').next().unwrap(); + assert!(wall::SOURCES.iter().all(|s| !s.name.eq_ignore_ascii_case(&format!("{first}.lean")))); + assert!(!["Init", "Lean", "Lake", "Std", "Laws", "Bridge", "Manifest"].contains(&first)); } + // Namespaces — the names bridges and laws cite — are untouched. + assert!(files["AverModel/Laws.lean"].contains("namespace Laws\ndef f")); } - found -} -/// The bridges that cover every model function a law mentions, or `None` when -/// some mentioned function has no bridge. `Some(vec![])` means the law -/// mentions no model function at all and is left exactly as it was. -fn law_bridge_coverage( - statement: &str, - model_info: &ModelInfo, - bridges: &[SourceBridge], -) -> Option> { - let mut covering = Vec::new(); - for model in law_statement_model_fns(statement, model_info) { - let index = bridges.iter().position(|bridge| bridge.model == model)?; - if !covering.contains(&index) { - covering.push(index); + /// Everything the checker would refuse in a model file declines the model + /// (every bridge and law-claim) at the producer instead of shipping a + /// package the checker refuses whole. + #[test] + fn a_model_the_checker_would_refuse_is_declined_by_the_producer() { + for (content, why) in [ + ("@[simp] theorem t : True := trivial\n", "@["), + ("syntax \"x\" : tactic\n", "syntax"), + ("import Mathlib\n", "Mathlib"), + ] { + let m = model(vec![("M.lean", content)], "M", vec![]); + let reason = package_model(&m).expect_err(why); + assert!(reason.contains(why), "{reason}"); } + let m = model(vec![("M.lean", ""), ("m.lean", "")], "M", vec![]); + assert!(package_model(&m).unwrap_err().contains("case-insensitively")); + let m = model(vec![("Type'.lean", "")], "M", vec![]); + assert!(package_model(&m).is_err()); + } + + #[test] + fn deriving_clauses_keep_only_the_admitted_classes() { + let text = "structure P where\n a : Int\n deriving Repr, BEq, Inhabited, DecidableEq\n\ + structure Q where\n deriving Repr\n\ + deriving instance ReflBEq, LawfulBEq for P\n\ + deriving instance Repr for Q\n"; + let kept = keep_admitted_deriving(text); + assert_eq!( + kept, + "structure P where\n a : Int\n deriving BEq, Inhabited, DecidableEq\n\ + structure Q where\n\ + deriving instance ReflBEq, LawfulBEq for P\n" + ); + assert_eq!(crate::lean_gate::code_exec_token(&kept), None); + } + + /// Every theorem sits behind `#guard_msgs (drop error) in`, placed before + /// its whole preamble: a doc comment left in front of `#guard_msgs` would + /// become its expected output. A `mutual` block holding a theorem is + /// isolated as the one command it is; definitions are left alone. + #[test] + fn theorems_are_isolated_before_their_preamble() { + let text = "def f (x : Int) : Int := x\n\ + \n\ + set_option maxHeartbeats 800000 in\n\ + /-- doc\n more -/\n\ + -- aver:law-class t universal M.f.l\n\ + theorem t : True := by\n trivial\n\ + /- plain comment -/\n\ + private theorem u : True := trivial\n\ + mutual\n theorem a : True := trivial\n theorem b : True := trivial\nend\n\ + mutual\n def g : Nat → Nat\n | _ => 0\nend\n"; + let isolated = isolate_theorems(text); + assert_eq!( + isolated, + "def f (x : Int) : Int := x\n\ + \n\ + #guard_msgs (drop error) in\n\ + set_option maxHeartbeats 800000 in\n\ + /-- doc\n more -/\n\ + -- aver:law-class t universal M.f.l\n\ + theorem t : True := by\n trivial\n\ + /- plain comment -/\n\ + #guard_msgs (drop error) in\n\ + private theorem u : True := trivial\n\ + #guard_msgs (drop error) in\n\ + mutual\n theorem a : True := trivial\n theorem b : True := trivial\nend\n\ + mutual\n def g : Nat → Nat\n | _ => 0\nend\n" + ); + assert_eq!(crate::lean_gate::code_exec_token(&isolated), None); + } + + /// The decoder of a function with an Int and a String parameter binds the + /// String by `decodeStr`, and the steps argument of an export cites every + /// member of its call closure. + #[test] + fn decoders_and_steps_render_their_exact_text() { + let mut fresh = 0; + let parts = vec![ + alts(&SourceEncoder::Int, &mut fresh).unwrap(), + alts(&SourceEncoder::Str, &mut fresh).unwrap(), + ]; + let shapes = product(parts).unwrap().iter().map(|row| join_row(row)).collect(); + let b = BridgedFn { + func_idx: 7, + model: "M.greet".to_string(), + params: vec![SourceEncoder::Int, SourceEncoder::Str], + result: SourceEncoder::Str, + callees: Vec::new(), + fuel: false, + shapes, + literals: BTreeSet::new(), + recursive: false, + constants: Vec::new(), + }; + let mut s = String::new(); + render_fn_defs(&b, &mut s); + assert!( + s.contains( + " | [_root_.AverCert.Grammar.SVal.i t0, v1] => \ + (AverCert.GrammarBridge.decodeStr v1).bind (fun t1 => _root_.Option.some (t0, t1))\n" + ), + "{s}" + ); + assert!(s.contains("noncomputable def dec_7 : _root_.List _root_.AverCert.Grammar.SVal → _root_.Option (_root_.Int × _root_.String)"), "{s}"); + assert!( + s.contains("def img_7 (y : (_root_.Int × _root_.String)) : _root_.AverCert.Grammar.SVal :=\n _root_.AverCert.Grammar.SVal.s (_root_.AverCert.GrammarBridge.strBytes (_root_.M.greet (_root_.Prod.fst (y)) (_root_.Prod.snd (y))))"), + "{s}" + ); + assert_eq!( + render_steps_proof(&[3, 9]), + "(List.forall_mem_cons.2 ⟨⟨_, by decide, step_3⟩, \ + (List.forall_mem_cons.2 ⟨⟨_, by decide, step_9⟩, (fun _ h => nomatch h)⟩)⟩)" + ); + let nodup = render_export_names_nodup(&["ab".to_string(), "a'\"".to_string()]); + assert!( + nodup.contains("[['a', 'b'],\n ['a', (Char.ofNat 39), (Char.ofNat 34)]]"), + "{nodup}" + ); + } + + /// A step lemma is proved by construction: the plan is evaluated by + /// `simp only` (String literals read back whole, before their bytes can + /// match inside a longer literal), each plan-side `if` is split by + /// `ite_eq_of`, and a self-recursive source unfolds on the right only. + /// No rung runs the default simp set over the plan. + #[test] + fn step_lemmas_are_constructive_and_self_recursion_unfolds_once() { + let mut literals = BTreeSet::new(); + literals.insert(b" ".to_vec()); + literals.insert(Vec::new()); + let b = BridgedFn { + func_idx: 9, + model: "M.spaces".to_string(), + params: vec![SourceEncoder::Int, SourceEncoder::Str], + result: SourceEncoder::Str, + callees: vec![9], + fuel: false, + shapes: Vec::new(), + literals, + recursive: true, + constants: vec!["M.width".to_string()], + }; + let lit_index: BTreeMap, usize> = + [(Vec::new(), 0), (b" ".to_vec(), 1)].into_iter().collect(); + let mut fns = BTreeMap::new(); + fns.insert(9, b.clone()); + let mut s = String::new(); + render_step(&b, &fns, &lit_index, false, &mut s); + assert!(s.contains("all_goals simp only [AverCert.Plans.fn9, eval_ite, eval_optDefault, eval_resDefault]\n"), "{s}"); + assert!(s.contains(", ↓ ← strLit_1]"), "{s}"); + assert!(!s.contains("↓ ← strLit_0"), "the empty literal is never read back: {s}"); + assert!(s.contains("all_goals (repeat' (refine ite_eq_of (fun h => ?_) (fun h => ?_)))"), "{s}"); + assert!(s.contains("| (symm; rw [_root_.M.spaces]; simp [_root_.bne"), "{s}"); + assert!(s.contains(", strLit_0, _root_.M.width"), "{s}"); + assert!(!s.contains("simp [_root_.M.spaces"), "a recursive source never unfolds by simp: {s}"); + assert!(!s.contains("simp [AverCert.Plans.fn9"), "{s}"); + assert!(s.contains(" | sorry\n"), "{s}"); + assert!(STEP_LEMMAS.contains("theorem ite_eq_of")); + assert!(STEP_LEMMAS.contains("theorem arms_litInt")); } - Some(covering) } diff --git a/aver-cert/src/engine/string_plan_defs.rs b/aver-cert/src/engine/string_plan_defs.rs deleted file mode 100644 index c686a272f..000000000 --- a/aver-cert/src/engine/string_plan_defs.rs +++ /dev/null @@ -1,708 +0,0 @@ -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct StringConcatChunkPlan { - pub data_idx: u32, - pub bytes: Vec, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct StringConcatPlan { - pub prefixes: Vec, - pub suffixes: Vec, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct StringEqChunkPlan { - pub data_idx: u32, - pub bytes: Vec, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub enum StringEqResultPlan { - Input, - Literal(StringEqChunkPlan), -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct StringEqPlan { - pub needle: StringEqChunkPlan, - pub hit: StringEqResultPlan, - pub default: StringEqResultPlan, -} - -fn string_eq_plan_from_cert(c: &Cert) -> Option { - let Cert::StringEqVerbatimMatch { arms, default, .. } = c.inner() else { - return None; - }; - let [(needle, hit)] = arms.as_slice() else { - return None; - }; - Some(StringEqPlan { - needle: verbatim_string_eq_chunk(needle)?, - hit: string_eq_result_from_verbatim(hit)?, - default: match default { - StringEqDefault::Input => StringEqResultPlan::Input, - StringEqDefault::Verbatim(value) => string_eq_result_from_verbatim(value)?, - }, - }) -} - -fn string_eq_string_ty_from_cert(c: &Cert) -> Option { - let Cert::StringEqVerbatimMatch { arms, default, .. } = c.inner() else { - return None; - }; - let [(needle, hit)] = arms.as_slice() else { - return None; - }; - let string_ty = verbatim_array_type(needle)?; - if verbatim_array_type(hit)? != string_ty { - return None; - } - match default { - StringEqDefault::Input => {} - StringEqDefault::Verbatim(value) => { - if verbatim_array_type(value)? != string_ty { - return None; - } - } - } - Some(string_ty) -} - -fn verbatim_array_type(value: &VerbatimDefault) -> Option { - match value { - VerbatimDefault::Array { type_idx, .. } => Some(*type_idx), - VerbatimDefault::Null | VerbatimDefault::F64Bits(_) => None, - } -} - -fn verbatim_string_eq_chunk(value: &VerbatimDefault) -> Option { - match value { - VerbatimDefault::Array { - data_idx, bytes, .. - } => Some(StringEqChunkPlan { - data_idx: *data_idx, - bytes: bytes.clone(), - }), - VerbatimDefault::Null | VerbatimDefault::F64Bits(_) => None, - } -} - -fn string_eq_result_from_verbatim(value: &VerbatimDefault) -> Option { - Some(StringEqResultPlan::Literal(verbatim_string_eq_chunk(value)?)) -} - -fn string_eq_sym_plan_from_cert(c: &Cert) -> Option { - string_eq_plan_from_cert(c).map(|plan| string_eq_sym_plan_from_plan(&plan)) -} - -fn string_eq_sym_plan_from_plan(plan: &StringEqPlan) -> SymPlan { - let mut nodes = Vec::new(); - let input = push_sym_string_node(&mut nodes, SymNodeKind::Param { index: 0 }); - let needle = push_sym_string_node( - &mut nodes, - SymNodeKind::ConstStringBytes(plan.needle.bytes.clone()), - ); - let cond = SymValueId(nodes.len()); - nodes.push(SymNode { - id: cond, - ty: SymTy::Bool, - kind: SymNodeKind::Prim { - op: SymPrim::StringEq, - args: vec![input, needle], - }, - }); - let then_block = string_eq_result_sym_block(&plan.hit); - let else_block = string_eq_result_sym_block(&plan.default); - let result = SymValueId(nodes.len()); - nodes.push(SymNode { - id: result, - ty: SymTy::String, - kind: SymNodeKind::If { - cond, - then_block: Box::new(then_block), - else_block: Box::new(else_block), - }, - }); - SymPlan { - params: vec![SymTy::String], - result: SymTy::String, - body: SymBlock { nodes, result }, - } -} - -fn string_eq_result_sym_block(result: &StringEqResultPlan) -> SymBlock { - let kind = match result { - StringEqResultPlan::Input => SymNodeKind::Param { index: 0 }, - StringEqResultPlan::Literal(chunk) => SymNodeKind::ConstStringBytes(chunk.bytes.clone()), - }; - let node = SymNode { - id: SymValueId(0), - ty: SymTy::String, - kind, - }; - SymBlock { - nodes: vec![node], - result: SymValueId(0), - } -} - -fn string_concat_plan_from_cert(c: &Cert) -> Option { - let Cert::StringConcatVerbatimMatch { - prefixes, suffixes, .. - } = c.inner() - else { - return None; - }; - Some(StringConcatPlan { - prefixes: prefixes - .iter() - .map(verbatim_array_chunk) - .collect::>>()?, - suffixes: suffixes - .iter() - .map(verbatim_array_chunk) - .collect::>>()?, - }) -} - -fn verbatim_array_chunk(value: &VerbatimDefault) -> Option { - match value { - VerbatimDefault::Array { - data_idx, bytes, .. - } => Some(StringConcatChunkPlan { - data_idx: *data_idx, - bytes: bytes.clone(), - }), - VerbatimDefault::Null | VerbatimDefault::F64Bits(_) => None, - } -} - -fn string_concat_sym_plan_from_cert(c: &Cert) -> Option { - string_concat_plan_from_cert(c).map(|plan| string_concat_sym_plan_from_plan(&plan)) -} - -fn string_concat_sym_plan_from_plan(plan: &StringConcatPlan) -> SymPlan { - let mut nodes = Vec::new(); - let mut args = Vec::new(); - for chunk in &plan.prefixes { - args.push(push_sym_string_node( - &mut nodes, - SymNodeKind::ConstStringBytes(chunk.bytes.clone()), - )); - } - args.push(push_sym_string_node( - &mut nodes, - SymNodeKind::Param { index: 0 }, - )); - for chunk in &plan.suffixes { - args.push(push_sym_string_node( - &mut nodes, - SymNodeKind::ConstStringBytes(chunk.bytes.clone()), - )); - } - let result = push_sym_string_node( - &mut nodes, - SymNodeKind::Prim { - op: SymPrim::StringConcat, - args, - }, - ); - SymPlan { - params: vec![SymTy::String], - result: SymTy::String, - body: SymBlock { nodes, result }, - } -} - -fn push_sym_string_node(nodes: &mut Vec, kind: SymNodeKind) -> SymValueId { - let id = SymValueId(nodes.len()); - nodes.push(SymNode { - id, - ty: SymTy::String, - kind, - }); - id -} - -fn string_concat_plan_lean_value(plan: &StringConcatPlan) -> String { - fn chunks(chunks: &[StringConcatChunkPlan]) -> String { - chunks - .iter() - .map(|chunk| { - format!( - "({{ dataIdx := {}, bytes := {} }} : StringConcatChunk)", - chunk.data_idx, - render_byte_list(&chunk.bytes) - ) - }) - .collect::>() - .join(", ") - } - - format!( - "({{ profile := \"string-concat-v1\", prefixes := [{}], suffixes := [{}] }} : StringConcatRawPlan)", - chunks(&plan.prefixes), - chunks(&plan.suffixes) - ) -} - -fn string_eq_plan_lean_value(plan: &StringEqPlan) -> String { - fn chunk(chunk: &StringEqChunkPlan) -> String { - format!( - "({{ dataIdx := {}, bytes := {} }} : StringEqChunk)", - chunk.data_idx, - render_byte_list(&chunk.bytes) - ) - } - - fn result(result: &StringEqResultPlan) -> String { - match result { - StringEqResultPlan::Input => ".input".to_string(), - StringEqResultPlan::Literal(value) => format!(".literal {}", chunk(value)), - } - } - - format!( - "({{ profile := \"string-eq-v1\", needle := {}, hit := {}, default := {} }} : StringEqRawPlan)", - chunk(&plan.needle), - result(&plan.hit), - result(&plan.default) - ) -} - -pub fn parse_string_concat_plan(text: &str) -> Result { - let mut lines = text.lines(); - expect_plan_line(&mut lines, "aver.string-fragment.plan.v1")?; - expect_plan_line(&mut lines, "profile string-concat-v1")?; - expect_plan_line(&mut lines, "params string")?; - expect_plan_line(&mut lines, "result string")?; - expect_plan_line(&mut lines, "concat")?; - - let mut prefixes = Vec::new(); - let mut suffixes = Vec::new(); - let mut seen_input = false; - let mut seen_end = false; - for raw in lines.by_ref() { - let line = raw.trim(); - if line == "end" { - seen_end = true; - break; - } - if line == "input index=0" { - if seen_input { - return Err("string-concat plan contains more than one input marker".to_string()); - } - seen_input = true; - continue; - } - if let Some(rest) = line.strip_prefix("prefix data=") { - if seen_input { - return Err("string-concat plan has a prefix after the input marker".to_string()); - } - prefixes.push(parse_plan_chunk(rest)?); - continue; - } - if let Some(rest) = line.strip_prefix("suffix data=") { - if !seen_input { - return Err("string-concat plan has a suffix before the input marker".to_string()); - } - suffixes.push(parse_plan_chunk(rest)?); - continue; - } - return Err(format!("unexpected string-concat plan line `{line}`")); - } - if !seen_end { - return Err("string-concat plan is missing `end`".to_string()); - } - if !seen_input { - return Err("string-concat plan is missing `input index=0`".to_string()); - } - if lines.any(|line| !line.trim().is_empty()) { - return Err("string-concat plan has trailing content after `end`".to_string()); - } - Ok(StringConcatPlan { prefixes, suffixes }) -} - -pub fn parse_string_eq_plan(text: &str) -> Result { - let mut lines = text.lines(); - expect_plan_line(&mut lines, "aver.string-fragment.plan.v1")?; - expect_plan_line(&mut lines, "profile string-eq-v1")?; - expect_plan_line(&mut lines, "params string")?; - expect_plan_line(&mut lines, "result string")?; - expect_plan_line(&mut lines, "match")?; - - let needle = parse_required_string_eq_chunk_line(&mut lines, "needle")?; - let hit = parse_required_string_eq_result_line(&mut lines, "hit")?; - let default = parse_required_string_eq_result_line(&mut lines, "default")?; - expect_plan_line(&mut lines, "end")?; - if lines.any(|line| !line.trim().is_empty()) { - return Err("string-eq plan has trailing content after `end`".to_string()); - } - Ok(StringEqPlan { - needle, - hit, - default, - }) -} - -fn lower_string_eq_plan( - plan: &StringEqPlan, - string_ty: u32, - string_eq_idx: u32, -) -> Result, String> { - let mut ops = vec![ - Op::LocalGet(0), - Op::LocalSet(1), - Op::LocalGet(1), - Op::RefCast(string_ty), - ]; - push_string_eq_chunk_ops(&mut ops, string_ty, &plan.needle)?; - ops.push(Op::Call(string_eq_idx)); - ops.push(Op::If); - push_string_eq_result_ops(&mut ops, string_ty, &plan.hit)?; - ops.push(Op::Else); - push_string_eq_result_ops(&mut ops, string_ty, &plan.default)?; - ops.push(Op::End); - Ok(ops) -} - -fn lower_string_eq_plan_code_entry_bytes( - plan: &StringEqPlan, - carrier: u32, - string_ty: u32, - string_eq_idx: u32, -) -> Result, String> { - let body = lower_string_eq_plan_body_bytes(plan, carrier, string_ty, string_eq_idx)?; - let body_len = u32::try_from(body.len()) - .map_err(|_| "string-eq body is too large to encode".to_string())?; - let mut out = Vec::new(); - push_u32_leb(&mut out, body_len); - out.extend(body); - Ok(out) -} - -fn lower_string_eq_plan_body_bytes( - plan: &StringEqPlan, - carrier: u32, - string_ty: u32, - string_eq_idx: u32, -) -> Result, String> { - let mut out = Vec::new(); - out.push(0x02); - push_u32_leb(&mut out, 1); - out.push(0x6d); // eqref scratch local used before the checked ref.cast. - push_u32_leb(&mut out, 1); - out.push(0x63); - push_s33_heap_idx(&mut out, carrier); - out.push(0x20); - push_u32_leb(&mut out, 0); - out.push(0x21); - push_u32_leb(&mut out, 1); - out.push(0x20); - push_u32_leb(&mut out, 1); - out.push(0xfb); - push_u32_leb(&mut out, 0x17); - push_s33_heap_idx(&mut out, string_ty); - push_string_eq_chunk_bytes(&mut out, string_ty, &plan.needle)?; - out.push(0x10); - push_u32_leb(&mut out, string_eq_idx); - out.push(0x04); - out.push(0x63); - push_s33_heap_idx(&mut out, string_ty); - push_string_eq_result_bytes(&mut out, string_ty, &plan.hit)?; - out.push(0x05); - push_string_eq_result_bytes(&mut out, string_ty, &plan.default)?; - out.push(0x0b); - out.push(0x0b); - Ok(out) -} - -fn lower_string_concat_plan( - plan: &StringConcatPlan, - result_ty: u32, - container_ty: u32, - concat_func_idx: u32, -) -> Result, String> { - let mut ops = Vec::new(); - for chunk in &plan.prefixes { - push_string_concat_chunk_ops(&mut ops, result_ty, chunk)?; - } - ops.push(Op::LocalGet(0)); - for chunk in &plan.suffixes { - push_string_concat_chunk_ops(&mut ops, result_ty, chunk)?; - } - let part_count = plan.prefixes.len() + 1 + plan.suffixes.len(); - let part_count = u32::try_from(part_count) - .map_err(|_| "string-concat plan has too many parts".to_string())?; - ops.push(Op::ArrayNewFixed(container_ty, part_count)); - ops.push(Op::Call(concat_func_idx)); - Ok(ops) -} - -fn lower_string_concat_plan_code_entry_bytes( - plan: &StringConcatPlan, - carrier: Option, - result_ty: u32, - container_ty: u32, - concat_func_idx: u32, -) -> Result, String> { - let body = lower_string_concat_plan_body_bytes( - plan, - carrier, - result_ty, - container_ty, - concat_func_idx, - )?; - let body_len = u32::try_from(body.len()) - .map_err(|_| "string-concat body is too large to encode".to_string())?; - let mut out = Vec::new(); - push_u32_leb(&mut out, body_len); - out.extend(body); - Ok(out) -} - -/// Twin of the wall's `PlanBytes.lowerStringConcatBodyBytes`. The locals -/// prelude follows the module's carrier state: one nullable carrier-reference -/// local when the module has an Int carrier struct, an empty declaration vector -/// when it has none. The expression that follows is identical in both states. -fn lower_string_concat_plan_body_bytes( - plan: &StringConcatPlan, - carrier: Option, - result_ty: u32, - container_ty: u32, - concat_func_idx: u32, -) -> Result, String> { - let mut out = Vec::new(); - match carrier { - Some(carrier) => { - push_u32_leb(&mut out, 1); - push_u32_leb(&mut out, 1); - out.push(0x63); - push_s33_heap_idx(&mut out, carrier); - } - None => push_u32_leb(&mut out, 0), - } - for chunk in &plan.prefixes { - push_string_concat_chunk_bytes(&mut out, result_ty, chunk)?; - } - out.push(0x20); - push_u32_leb(&mut out, 0); - for chunk in &plan.suffixes { - push_string_concat_chunk_bytes(&mut out, result_ty, chunk)?; - } - let part_count = plan.prefixes.len() + 1 + plan.suffixes.len(); - let part_count = u32::try_from(part_count) - .map_err(|_| "string-concat plan has too many parts".to_string())?; - out.push(0xfb); - push_u32_leb(&mut out, 0x08); - push_u32_leb(&mut out, container_ty); - push_u32_leb(&mut out, part_count); - out.push(0x10); - push_u32_leb(&mut out, concat_func_idx); - out.push(0x0b); - Ok(out) -} - -fn push_string_concat_chunk_ops( - ops: &mut Vec, - result_ty: u32, - chunk: &StringConcatChunkPlan, -) -> Result<(), String> { - let len = i32::try_from(chunk.bytes.len()) - .map_err(|_| "string-concat literal chunk is too large".to_string())?; - ops.push(Op::I32Const(0)); - ops.push(Op::I32Const(len)); - ops.push(Op::ArrayNewData { - type_idx: result_ty, - data_idx: chunk.data_idx, - bytes: chunk.bytes.clone(), - }); - Ok(()) -} - -fn push_string_eq_chunk_ops( - ops: &mut Vec, - string_ty: u32, - chunk: &StringEqChunkPlan, -) -> Result<(), String> { - let len = i32::try_from(chunk.bytes.len()) - .map_err(|_| "string-eq literal chunk is too large".to_string())?; - ops.push(Op::I32Const(0)); - ops.push(Op::I32Const(len)); - ops.push(Op::ArrayNewData { - type_idx: string_ty, - data_idx: chunk.data_idx, - bytes: chunk.bytes.clone(), - }); - Ok(()) -} - -fn push_string_eq_result_ops( - ops: &mut Vec, - string_ty: u32, - result: &StringEqResultPlan, -) -> Result<(), String> { - match result { - StringEqResultPlan::Input => ops.push(Op::LocalGet(0)), - StringEqResultPlan::Literal(chunk) => push_string_eq_chunk_ops(ops, string_ty, chunk)?, - } - Ok(()) -} - -fn push_string_concat_chunk_bytes( - out: &mut Vec, - result_ty: u32, - chunk: &StringConcatChunkPlan, -) -> Result<(), String> { - let len = i32::try_from(chunk.bytes.len()) - .map_err(|_| "string-concat literal chunk is too large".to_string())?; - out.push(0x41); - push_i32_leb(out, 0); - out.push(0x41); - push_i32_leb(out, len); - out.push(0xfb); - push_u32_leb(out, 0x09); - push_u32_leb(out, result_ty); - push_u32_leb(out, chunk.data_idx); - Ok(()) -} - -fn push_string_eq_chunk_bytes( - out: &mut Vec, - string_ty: u32, - chunk: &StringEqChunkPlan, -) -> Result<(), String> { - let len = i32::try_from(chunk.bytes.len()) - .map_err(|_| "string-eq literal chunk is too large".to_string())?; - out.push(0x41); - push_i32_leb(out, 0); - out.push(0x41); - push_i32_leb(out, len); - out.push(0xfb); - push_u32_leb(out, 0x09); - push_u32_leb(out, string_ty); - push_u32_leb(out, chunk.data_idx); - Ok(()) -} - -fn push_string_eq_result_bytes( - out: &mut Vec, - string_ty: u32, - result: &StringEqResultPlan, -) -> Result<(), String> { - match result { - StringEqResultPlan::Input => { - out.push(0x20); - push_u32_leb(out, 0); - } - StringEqResultPlan::Literal(chunk) => push_string_eq_chunk_bytes(out, string_ty, chunk)?, - } - Ok(()) -} - -fn expect_plan_line<'a>( - lines: &mut std::str::Lines<'a>, - expected: &str, -) -> Result<(), String> { - let actual = lines - .next() - .ok_or_else(|| format!("expected string-concat plan line `{expected}`"))? - .trim(); - if actual == expected { - Ok(()) - } else { - Err(format!( - "expected string-concat plan line `{expected}`, got `{actual}`" - )) - } -} - -fn parse_hex_bytes(raw: &str) -> Result, String> { - if (raw.len() & 1) != 0 { - return Err(format!("hex byte string has odd length: `{raw}`")); - } - let mut bytes = Vec::with_capacity(raw.len() / 2); - let (pairs, remainder) = raw.as_bytes().as_chunks::<2>(); - debug_assert!(remainder.is_empty()); - for pair in pairs { - let hi = hex_nibble(pair[0]) - .ok_or_else(|| format!("hex byte string contains non-hex digit: `{raw}`"))?; - let lo = hex_nibble(pair[1]) - .ok_or_else(|| format!("hex byte string contains non-hex digit: `{raw}`"))?; - bytes.push((hi << 4) | lo); - } - Ok(bytes) -} - -fn parse_plan_chunk(raw: &str) -> Result { - let Some((data_idx, hex_bytes)) = raw.split_once(" hex=") else { - return Err(format!( - "string-concat chunk must use `data= hex=`, got `{raw}`" - )); - }; - let data_idx = data_idx - .parse::() - .map_err(|_| format!("string-concat chunk has invalid data index `{data_idx}`"))?; - Ok(StringConcatChunkPlan { - data_idx, - bytes: parse_hex_bytes(hex_bytes)?, - }) -} - -fn parse_required_string_eq_chunk_line<'a>( - lines: &mut std::str::Lines<'a>, - label: &str, -) -> Result { - let raw = lines - .next() - .ok_or_else(|| format!("expected string-eq plan `{label}` line"))? - .trim(); - let rest = raw - .strip_prefix(label) - .and_then(|rest| rest.strip_prefix(' ')) - .ok_or_else(|| format!("expected string-eq plan `{label}` line, got `{raw}`"))?; - parse_string_eq_chunk(rest) -} - -fn parse_required_string_eq_result_line<'a>( - lines: &mut std::str::Lines<'a>, - label: &str, -) -> Result { - let raw = lines - .next() - .ok_or_else(|| format!("expected string-eq plan `{label}` line"))? - .trim(); - let rest = raw - .strip_prefix(label) - .and_then(|rest| rest.strip_prefix(' ')) - .ok_or_else(|| format!("expected string-eq plan `{label}` line, got `{raw}`"))?; - if rest == "input index=0" { - return Ok(StringEqResultPlan::Input); - } - Ok(StringEqResultPlan::Literal(parse_string_eq_chunk(rest)?)) -} - -fn parse_string_eq_chunk(raw: &str) -> Result { - let Some((data_idx, hex_bytes)) = raw.split_once(" hex=") else { - return Err(format!( - "string-eq chunk must use `data= hex=`, got `{raw}`" - )); - }; - let data_idx = data_idx - .strip_prefix("data=") - .unwrap_or(data_idx) - .parse::() - .map_err(|_| format!("string-eq chunk has invalid data index `{data_idx}`"))?; - Ok(StringEqChunkPlan { - data_idx, - bytes: parse_hex_bytes(hex_bytes)?, - }) -} - -fn hex_nibble(b: u8) -> Option { - match b { - b'0'..=b'9' => Some(b - b'0'), - b'a'..=b'f' => Some(b - b'a' + 10), - _ => None, - } -} diff --git a/aver-cert/src/engine/sym_plan_defs.rs b/aver-cert/src/engine/sym_plan_defs.rs deleted file mode 100644 index 168286fca..000000000 --- a/aver-cert/src/engine/sym_plan_defs.rs +++ /dev/null @@ -1,1229 +0,0 @@ -/// Source-level certificate plan. Unlike `ExprFragmentPlan`, this IR talks in -/// Aver semantic types and operations first; target representation only enters -/// later through a checked encoder/lowerer. -#[derive(Clone, Debug, PartialEq, Eq, Hash)] -pub enum SymTy { - Int, - Float, - Bool, - String, - Named(String), - App(String, Vec), -} - -impl SymTy { - /// Canonical source spelling used by the wasm-gc monomorphisation - /// registry. This is representation metadata only; it does not turn an - /// operational tag dispatch into a source-constructor claim. - pub fn canonical_name(&self) -> String { - match self { - SymTy::Int => "Int".to_string(), - SymTy::Float => "Float".to_string(), - SymTy::Bool => "Bool".to_string(), - SymTy::String => "String".to_string(), - SymTy::Named(name) => name.clone(), - SymTy::App(name, args) => format!( - "{name}<{}>", - args.iter() - .map(SymTy::canonical_name) - .collect::>() - .join(",") - ), - } - } - - /// The Aver surface spelling of a producer-asserted source type name, for - /// decline reasons only. - /// - /// A `named:` name is untrusted producer text (see the note on - /// `check_sym_plan_named_consistency`): nothing is admitted or refused on - /// its spelling, so this rendering can only make a message clearer, never - /// certify anything, and the anchor rule keeps comparing the RAW name. The - /// rendering exists because one of the producer's two feeds spells a type - /// with the Rust `Debug` derive of the Aver compiler's own type - /// representation (`aver`'s `mir::lower` stores `format!("{ty:?}")`), so a - /// name can arrive as `List(Named { id: Some(TypeId(…)), name: "Task" })`. - /// Echoing that into a reason leaks a foreign implementation detail at the - /// reader; `List` is the same fact in the language the reason is - /// about. A name that is not such a rendering is returned unchanged. - pub fn display_source_type_name(name: &str) -> String { - aver_name_from_debug_rendering(name, 0).unwrap_or_else(|| name.to_string()) - } - - fn from_frag_ty(value: FragTy) -> Option { - match value { - FragTy::F64 => Some(SymTy::Float), - FragTy::BoolI32 => Some(SymTy::Bool), - FragTy::IntCarrier => Some(SymTy::Int), - FragTy::I64 | FragTy::RawI32 | FragTy::Ref | FragTy::AdtRef => None, - } - } - - fn to_frag_ty(&self) -> Option { - match self { - SymTy::Int => Some(FragTy::IntCarrier), - SymTy::Float => Some(FragTy::F64), - SymTy::Bool => Some(FragTy::BoolI32), - // Strings and named user types are whole references at the - // representation level: both encode to the opaque `adtRef` (twin - // of the Lean `encodeSymTy?`). String OPERATIONS still do not - // encode; this only lets reference-typed values flow verbatim - // through the field-projection face. - SymTy::String | SymTy::Named(_) | SymTy::App(_, _) => Some(FragTy::AdtRef), - } - } - - #[cfg(feature = "engine")] - fn plan_tag(&self) -> String { - match self { - SymTy::Int => "int".to_string(), - SymTy::Float => "float".to_string(), - SymTy::Bool => "bool".to_string(), - SymTy::String => "string".to_string(), - SymTy::Named(name) => format!("named:{name}"), - SymTy::App(name, args) => format!( - "app:{name}[{}]", - args.iter().map(SymTy::plan_tag).collect::>().join(";") - ), - } - } - -} - -/// Nesting a source type name may carry before the display renderer gives up -/// and shows it verbatim. A name is producer text of unbounded length, and -/// this renderer walks it recursively; real Aver types nest a handful deep. -const MAX_TYPE_RENDER_DEPTH: usize = 16; - -/// Render the Rust `Debug` derive of the Aver compiler's type representation as -/// the Aver surface type name it stands for, mirroring that compiler's own -/// `Type::display`: `Named { id: …, name: "T" }` is `T`, `List(Str)` is -/// `List`, `Tuple([Int, Bool])` is `Tuple`. -/// -/// `None` for anything this renderer does not recognise — including every name -/// that is already Aver surface syntax, which is the common case and must pass -/// through untouched, and any nesting past [`MAX_TYPE_RENDER_DEPTH`]. Display -/// only; see `SymTy::display_source_type_name`. -fn aver_name_from_debug_rendering(name: &str, depth: usize) -> Option { - if depth > MAX_TYPE_RENDER_DEPTH { - return None; - } - let name = name.trim(); - match name { - "Int" | "Bool" | "Float" | "Unit" => return Some(name.to_string()), - "Str" => return Some("String".to_string()), - _ => {} - } - // `Named { id: , name: "T" }` — the only variant with a payload - // the derive prints as a struct. - if let Some(rest) = name.strip_prefix("Named {").and_then(|r| r.strip_suffix('}')) { - let at = rest.find("name: \"")?; - let after = rest.get(at + 7..)?; - let inner = after.get(..after.find('"')?)?; - if inner.is_empty() || inner.chars().any(char::is_whitespace) || inner.contains('=') { - return None; - } - return Some(inner.to_string()); - } - // `Ctor(arg, …)` — every parameterised variant. - let open = name.find('(')?; - let ctor = name.get(..open)?; - if ctor.is_empty() || !ctor.chars().all(|ch| ch.is_ascii_alphanumeric()) { - return None; - } - let inner = name.get(open + 1..)?.strip_suffix(')')?.trim(); - // `Tuple` carries a `Vec`, so the derive brackets its arguments. - let inner = inner - .strip_prefix('[') - .and_then(|rest| rest.strip_suffix(']')) - .unwrap_or(inner); - let args = split_debug_args(inner) - .into_iter() - .map(|arg| aver_name_from_debug_rendering(arg, depth + 1)) - .collect::>>()?; - if args.is_empty() { - return None; - } - Some(format!("{ctor}<{}>", args.join(", "))) -} - -/// Split a `Debug` argument list on its top-level commas. Every bracket kind -/// opens nesting, so the comma inside `Named { id: Some(TypeId(1)), name: "T" }` -/// does not split the list. -fn split_debug_args(value: &str) -> Vec<&str> { - let mut parts = Vec::new(); - let mut depth = 0i32; - let mut start = 0usize; - for (at, ch) in value.char_indices() { - match ch { - '(' | '<' | '[' | '{' => depth += 1, - ')' | '>' | ']' | '}' => depth -= 1, - ',' if depth == 0 => { - parts.push(value[start..at].trim()); - start = at + ch.len_utf8(); - } - _ => {} - } - } - parts.push(value[start..].trim()); - parts -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub struct SymValueId(pub usize); - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum SymPrim { - FloatAdd, - FloatMul, - FloatLe, - FloatGe, - FloatLt, - FloatGt, - FloatEq, - IntAdd, - IntSub, - IntMul, - StringEq, - StringConcat, - /// Source-level `Bool.and` (eager conjunction); encodes to the - /// representation `i32.and` over two Boolean operands. - BoolAnd, -} - -#[derive(Clone, Copy, Debug, PartialEq, Eq, Hash)] -pub enum SymIntCmp { - Eq, - Lt, - Le, - Ge, - Gt, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub enum SymNodeKind { - Param { index: u32 }, - ConstBool(bool), - ConstInt(i64), - ConstFloatBits(u64), - ConstStringBytes(Vec), - Prim { - op: SymPrim, - args: Vec, - }, - Construct { - type_name: String, - ctor_name: String, - args: Vec, - }, - EmptyList { elem_ty: SymTy }, - /// Source-level record/ADT field projection: read declared field `field` - /// (source declaration order) of a value of the named user type. - /// `field_ty` is the field's source type; encoding binds the projection to - /// the exact wasm struct type index through the byte-derived struct table. - ProjectField { - type_name: String, - field: u32, - field_ty: SymTy, - value: SymValueId, - }, - IntConstCmp { - op: SymIntCmp, - value: SymValueId, - constant: i64, - }, - /// Source-level comparison of two Int VALUES (`a >= b`, `a == b`). Unlike - /// `IntConstCmp`, which compares one parameter against a LITERAL and - /// encodes to a carrier-shape test, this encodes to the runtime helper call - /// the emitter really produces: `__aint_cmp` plus a signed relational tail, - /// or `__aint_eq` alone. `Le` has no admitted encoding (the plan grammar - /// has no `i32.le_s`), so it fail-closes. Twin of `SymNodeKind.intCmp`. - IntCmp { - op: SymIntCmp, - lhs: SymValueId, - rhs: SymValueId, - }, - /// Operational discriminant dispatch over an ADT value. The encoded plan - /// reads field 0 of the struct named by `type_name`, compares it with - /// `tag`, and evaluates `hit` on equality or `miss` otherwise. This does - /// not assert any source-constructor-to-tag relationship. - TagMatch { - type_name: String, - scrutinee: SymValueId, - tag: i64, - hit: Box, - miss: Box, - }, - If { - cond: SymValueId, - then_block: Box, - else_block: Box, - }, - /// Monolithic fused `Option.withDefault(Vector.get(p0, p1), default)`: - /// read the `type_name` vector in param 0 at the Int index in param 1, - /// yielding the element in bounds and the literal `default` otherwise. - /// The vector and index are pinned to params 0 and 1. Twin of - /// `SymNodeKind.vectorGetOrDefault`. - VectorGetOrDefault { - type_name: String, - default: i64, - }, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct SymNode { - pub id: SymValueId, - pub ty: SymTy, - pub kind: SymNodeKind, -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct SymBlock { - pub nodes: Vec, - pub result: SymValueId, -} - -impl SymBlock { - pub fn result_ty(&self) -> Option { - self.nodes - .get(self.result.0) - .filter(|node| node.id == self.result) - .map(|node| node.ty.clone()) - } -} - -#[derive(Clone, Debug, PartialEq, Eq)] -pub struct SymPlan { - pub params: Vec, - pub result: SymTy, - pub body: SymBlock, -} - -impl SymPlan { - /// Project the current representation-level expression fragment into the - /// source-level subset when every node already has a direct Aver meaning. - /// Representation-only nodes (`struct.get`, carrier limbs, raw i32/i64 - /// comparisons) deliberately fail here; they need explicit source - /// constructors before they can become `SymPlan`. - pub fn from_expr_fragment_source_subset(plan: &ExprFragmentPlan) -> Option { - Some(Self { - params: plan - .params - .iter() - .copied() - .map(SymTy::from_frag_ty) - .collect::>>()?, - result: SymTy::from_frag_ty(plan.result)?, - body: sym_block_from_frag_source_subset(&plan.body)?, - }) - } - - /// Encode to the representation-level plan. `host_table` supplies the - /// byte-derived wasm indices for host-bound source operations (Int - /// literals box; `intAdd` calls the carrier `add`); a role the table - /// lacks fail-closes the encoding. Twin of the audited Lean - /// `PlanCheck.encodeSymRawPlanToExprFragmentRawPlan`. - pub fn to_expr_fragment_plan( - &self, - host_table: &FragHostTable, - struct_table: &FragStructTable, - ) -> Option { - let params = self - .params - .iter() - .map(SymTy::to_frag_ty) - .collect::>>()?; - let nparams = u32::try_from(params.len()).ok()?; - Some(ExprFragmentPlan { - params, - result: self.result.to_frag_ty()?, - body: expr_fragment_block_from_sym(&self.body, nparams, host_table, struct_table)?, - }) - } -} - -#[derive(Clone, Debug)] -pub enum FragmentPlan { - Sym(SymPlan), - Expr(ExprFragmentPlan), -} - -impl FragmentPlan { - pub fn to_expr_fragment_plan( - &self, - host_table: &FragHostTable, - struct_table: &FragStructTable, - ) -> Option { - match self { - FragmentPlan::Sym(plan) => plan.to_expr_fragment_plan(host_table, struct_table), - FragmentPlan::Expr(plan) => Some(plan.clone()), - } - } -} - -#[cfg(feature = "engine")] -fn expr_fragment_source_plan( - source_plan: &Option, - plan: &ExprFragmentPlan, -) -> Option { - source_plan - .clone() - .or_else(|| SymPlan::from_expr_fragment_source_subset(plan)) -} - -#[cfg(feature = "engine")] -fn adt_constructor_sym_plan_from_cert(c: &Cert, model_info: &ModelInfo) -> Option { - let Cert::AdtConstructor { - name, - arity, - fields, - .. - } = c.inner() - else { - return None; - }; - let sig = model_info.fns.get(name)?; - if sig.params.len() != *arity { - return None; - } - let params = sig - .params - .iter() - .map(|ty| sym_ty_from_source_type_name(ty)) - .collect::>>()?; - let result = sym_ty_from_source_type_name(&sig.ret)?; - let (type_name, ctor_name, source_args) = match &result { - SymTy::Named(type_name) if adt_constructor_uses_model(c, model_info) => { - let (_, ind) = model_info.resolve_inductive(&sig.prefix, &sig.ret)?; - let ctor = ind.ctors.first()?; - if ctor.fields != sig.params || !sym_plan_simple_token(&ctor.name) { - return None; - } - (type_name.clone(), ctor.name.clone(), None) - } - SymTy::App(type_name, type_args) if type_name == "List" && type_args.len() == 1 => { - let elem_ty = type_args[0].clone(); - let source_args = match (params.as_slice(), fields.as_slice()) { - ([head], [ConstructorField::Local(0), ConstructorField::Null]) - if *head == elem_ty => Some(true), - ([head, tail], [ConstructorField::Local(0), ConstructorField::Local(1)]) - if *head == elem_ty && *tail == result => Some(false), - _ => return None, - }; - ("List".to_string(), "::".to_string(), source_args) - } - _ => return None, - }; - if !sym_plan_simple_token(&type_name) { - return None; - } - let mut nodes = params - .iter() - .enumerate() - .map(|(i, ty)| SymNode { - id: SymValueId(i), - ty: ty.clone(), - kind: SymNodeKind::Param { index: i as u32 }, - }) - .collect::>(); - let args = if source_args == Some(true) { - let empty_id = SymValueId(nodes.len()); - nodes.push(SymNode { - id: empty_id, - ty: result.clone(), - kind: SymNodeKind::EmptyList { - elem_ty: match &result { - SymTy::App(_, args) => args[0].clone(), - _ => unreachable!(), - }, - }, - }); - vec![SymValueId(0), empty_id] - } else { - fields - .iter() - .map(|field| match field { - ConstructorField::Local(i) if (*i as usize) < params.len() => { - Some(SymValueId(*i as usize)) - } - ConstructorField::Local(_) | ConstructorField::Null => None, - }) - .collect::>>()? - }; - let result_id = SymValueId(nodes.len()); - nodes.push(SymNode { - id: result_id, - ty: result, - kind: SymNodeKind::Construct { - type_name, - ctor_name, - args, - }, - }); - Some(SymPlan { - params, - result: sym_ty_from_source_type_name(&sig.ret)?, - body: SymBlock { - nodes, - result: result_id, - }, - }) -} - -#[cfg(feature = "engine")] -fn sym_plan_is_list_construct(plan: &SymPlan) -> bool { - matches!(&plan.result, SymTy::App(name, args) if name == "List" && args.len() == 1) -} - -#[cfg(feature = "engine")] -fn sym_ty_from_source_type_name(ty: &str) -> Option { - let ty = strip_balanced_outer_parens(ty.trim()); - match ty { - "Int" => Some(SymTy::Int), - "Float" => Some(SymTy::Float), - "Bool" => Some(SymTy::Bool), - "String" => Some(SymTy::String), - _ if let Some(rest) = ty.strip_prefix("List ") => Some(SymTy::App( - "List".to_string(), - vec![sym_ty_from_source_type_name(rest)?], - )), - _ if let Some((left, right)) = split_top_level(ty, '×') => Some(SymTy::App( - "Tuple".to_string(), - vec![ - sym_ty_from_source_type_name(left)?, - sym_ty_from_source_type_name(right)?, - ], - )), - _ if sym_plan_simple_token(ty) => Some(SymTy::Named(ty.to_string())), - _ => None, - } -} - -#[cfg(feature = "engine")] -fn strip_balanced_outer_parens(mut value: &str) -> &str { - loop { - let Some(inner) = value.strip_prefix('(').and_then(|v| v.strip_suffix(')')) else { - return value; - }; - let mut depth = 0i32; - let balanced = inner.chars().all(|ch| { - match ch { - '(' => depth += 1, - ')' => depth -= 1, - _ => {} - } - depth >= 0 - }) && depth == 0; - if !balanced { - return value; - } - value = inner.trim(); - } -} - -#[cfg(feature = "engine")] -fn split_top_level(value: &str, needle: char) -> Option<(&str, &str)> { - let mut depth = 0i32; - for (at, ch) in value.char_indices() { - match ch { - '(' | '<' => depth += 1, - ')' | '>' => depth -= 1, - _ if ch == needle && depth == 0 => { - return Some((value[..at].trim(), value[at + ch.len_utf8()..].trim())); - } - _ => {} - } - } - None -} - -#[cfg(feature = "engine")] -fn sym_plan_simple_token(value: &str) -> bool { - !value.is_empty() && !value.chars().any(char::is_whitespace) && !value.contains('=') -} - -#[derive(Clone, Debug)] -pub struct FragmentPlanArtifact { - pub export_name: String, - pub plan: FragmentPlan, -} - -fn sym_block_struct_names_in_order(block: &SymBlock, out: &mut Vec) { - for node in &block.nodes { - match &node.kind { - SymNodeKind::ProjectField { type_name, .. } => out.push(type_name.clone()), - // Record construction anchors its type the same way a projection - // does; List cells keep their dedicated constructor family and - // never bind a struct index here. - SymNodeKind::Construct { type_name, .. } if type_name != "List" => { - out.push(type_name.clone()) - } - SymNodeKind::VectorGetOrDefault { type_name, .. } => out.push(type_name.clone()), - SymNodeKind::TagMatch { - type_name, - hit, - miss, - .. - } => { - out.push(type_name.clone()); - sym_block_struct_names_in_order(hit, out); - sym_block_struct_names_in_order(miss, out); - } - SymNodeKind::If { - then_block, - else_block, - .. - } => { - sym_block_struct_names_in_order(then_block, out); - sym_block_struct_names_in_order(else_block, out); - } - _ => {} - } - } -} - -/// The distinct source type names whose wasm struct identity is needed by a -/// projection or operational tag dispatch, in first appearance order. -pub(crate) fn sym_plan_project_type_names(plan: &SymPlan) -> Vec { - let mut all = Vec::new(); - sym_block_struct_names_in_order(&plan.body, &mut all); - let mut out = Vec::new(); - for name in all { - if !out.contains(&name) { - out.push(name); - } - } - out -} - -#[cfg(feature = "engine")] -fn frag_block_struct_get_user_tys_in_order(block: &FragBlock, out: &mut Vec) { - for node in &block.nodes { - match &node.kind { - FragNodeKind::StructGetUser { ty_idx, .. } => out.push(*ty_idx), - FragNodeKind::StructNew { ty_idx, .. } => out.push(*ty_idx), - FragNodeKind::VectorGetOrDefault { arr_ty, .. } => out.push(*arr_ty), - FragNodeKind::If { - then_block, - else_block, - .. - } => { - frag_block_struct_get_user_tys_in_order(then_block, out); - frag_block_struct_get_user_tys_in_order(else_block, out); - } - _ => {} - } - } -} - -/// The struct-table entries a source plan and its encoded representation plan -/// pin together: each `project.field` type name paired with the wasm struct -/// index its `struct.get.user` encoding resolved to (deterministic node -/// order). `None` when the pairing is inconsistent — fail-closed. -#[cfg(feature = "engine")] -fn expr_fragment_struct_table_entries( - source_plan: &SymPlan, - plan: &ExprFragmentPlan, -) -> Option> { - let mut names = Vec::new(); - sym_block_struct_names_in_order(&source_plan.body, &mut names); - let mut indices = Vec::new(); - frag_block_struct_get_user_tys_in_order(&plan.body, &mut indices); - if names.len() != indices.len() { - return None; - } - let mut table = FragStructTable::default(); - for (name, idx) in names.into_iter().zip(indices) { - if !table.insert(&name, idx) { - return None; - } - } - Some(table.entries) -} - -/// Resolve the struct table a producer fragment plan needs at emit time, from -/// the emitter's own type registry (`resolve`: record type name -> wasm struct -/// type index). Fail-closed on any unknown name. -pub fn frag_struct_table_for_plan( - plan: &FragmentPlan, - resolve: &dyn Fn(&str, &SymTy) -> Option, -) -> Option { - let bindings = match plan { - FragmentPlan::Sym(plan) => sym_plan_struct_bindings(plan)?, - FragmentPlan::Expr(_) => Vec::new(), - }; - let mut table = FragStructTable::default(); - for (name, ty) in bindings { - let idx = resolve(&name, &ty)?; - if !table.insert(&name, idx) { - return None; - } - } - Some(table) -} - -fn sym_block_struct_bindings(block: &SymBlock, out: &mut Vec<(String, SymTy)>) -> Option<()> { - for node in &block.nodes { - match &node.kind { - SymNodeKind::ProjectField { - type_name, value, .. - } => { - let ty = block.nodes.get(value.0)?.ty.clone(); - out.push((type_name.clone(), ty)); - } - // Record construction binds its type at emit time the same way a - // projection does; List cells keep their dedicated family. - SymNodeKind::Construct { type_name, .. } if type_name != "List" => { - out.push((type_name.clone(), node.ty.clone())); - } - SymNodeKind::TagMatch { - type_name, - scrutinee, - hit, - miss, - .. - } => { - let ty = block.nodes.get(scrutinee.0)?.ty.clone(); - out.push((type_name.clone(), ty)); - sym_block_struct_bindings(hit, out)?; - sym_block_struct_bindings(miss, out)?; - } - SymNodeKind::VectorGetOrDefault { type_name, .. } => { - // The fused read is pinned to the `Vector` in param 0. - out.push(( - type_name.clone(), - SymTy::App("Vector".to_string(), vec![SymTy::Int]), - )); - } - SymNodeKind::If { - then_block, - else_block, - .. - } => { - sym_block_struct_bindings(then_block, out)?; - sym_block_struct_bindings(else_block, out)?; - } - _ => {} - } - } - Some(()) -} - -fn sym_plan_struct_bindings(plan: &SymPlan) -> Option> { - let mut all = Vec::new(); - sym_block_struct_bindings(&plan.body, &mut all)?; - let mut out = Vec::<(String, SymTy)>::new(); - for (name, ty) in all { - if let Some((_, existing)) = out.iter().find(|(existing, _)| existing == &name) { - if existing != &ty { - return None; - } - } else { - out.push((name, ty)); - } - } - Some(out) -} - -fn sym_block_from_frag_source_subset(block: &FragBlock) -> Option { - let nodes = block - .nodes - .iter() - .map(sym_node_from_frag_source_subset) - .collect::>>()?; - Some(SymBlock { - nodes, - result: SymValueId(block.result.0), - }) -} - -fn sym_node_from_frag_source_subset(node: &FragNode) -> Option { - let ty = SymTy::from_frag_ty(node.ty)?; - let kind = match &node.kind { - FragNodeKind::Local { index } => SymNodeKind::Param { index: *index }, - FragNodeKind::ConstBool(value) => SymNodeKind::ConstBool(*value), - FragNodeKind::ConstF64(bits) => SymNodeKind::ConstFloatBits(*bits), - FragNodeKind::Prim { op, args } => SymNodeKind::Prim { - op: match op { - FragPrim::F64Add => SymPrim::FloatAdd, - FragPrim::F64Mul => SymPrim::FloatMul, - FragPrim::F64Le => SymPrim::FloatLe, - FragPrim::F64Ge => SymPrim::FloatGe, - FragPrim::F64Lt => SymPrim::FloatLt, - FragPrim::F64Gt => SymPrim::FloatGt, - FragPrim::F64Eq => SymPrim::FloatEq, - FragPrim::I64Eq - | FragPrim::I64LeS - | FragPrim::I64LtS - | FragPrim::I64GeS - | FragPrim::I64GtS - | FragPrim::I32Eq - | FragPrim::I32LtS - | FragPrim::I32GtS - | FragPrim::I32GeS - // The source-subset lift stays float-only; `Bool.and` certs - // carry their SymPlan forward from the producer instead. - | FragPrim::I32And => return None, - }, - args: args.iter().map(|id| SymValueId(id.0)).collect(), - }, - FragNodeKind::VectorGetOrDefault { .. } => return None, - FragNodeKind::StructNew { .. } => return None, - // The sign template is a REPRESENTATION shape (scratch slot, limb - // test); its source form is an `IntConstCmp` the producer already - // carries forward, so there is nothing to recover here. - FragNodeKind::IntSignCmp { .. } => return None, - FragNodeKind::If { - cond, - then_block, - else_block, - } => SymNodeKind::If { - cond: SymValueId(cond.0), - then_block: Box::new(sym_block_from_frag_source_subset(then_block)?), - else_block: Box::new(sym_block_from_frag_source_subset(else_block)?), - }, - // `StructGetUser` deliberately does NOT project back to source here: - // the source meaning (type name, field) cannot be recovered from the - // representation node alone. Projection certs carry their SymPlan - // forward from the producer instead. - FragNodeKind::ConstI64(_) - | FragNodeKind::ConstI32(_) - | FragNodeKind::HostCall { .. } - | FragNodeKind::SelfCall { .. } - | FragNodeKind::StructGet { .. } - | FragNodeKind::StructGetUser { .. } - | FragNodeKind::RefIsNull { .. } => return None, - }; - Some(SymNode { - id: SymValueId(node.id.0), - ty, - kind, - }) -} - -#[cfg(all(test, feature = "engine"))] -mod sym_plan_defs_tests { - use super::*; - - fn int_const_block(value: i64) -> SymBlock { - SymBlock { - nodes: vec![SymNode { - id: SymValueId(0), - ty: SymTy::Int, - kind: SymNodeKind::ConstInt(value), - }], - result: SymValueId(0), - } - } - - fn slot_count_sym_plan() -> SymPlan { - let option_int = SymTy::App("Option".to_string(), vec![SymTy::Int]); - SymPlan { - params: vec![option_int.clone()], - result: SymTy::Int, - body: SymBlock { - nodes: vec![ - SymNode { - id: SymValueId(0), - ty: option_int, - kind: SymNodeKind::Param { index: 0 }, - }, - SymNode { - id: SymValueId(1), - ty: SymTy::Int, - kind: SymNodeKind::TagMatch { - type_name: "Option".to_string(), - scrutinee: SymValueId(0), - tag: 1, - hit: Box::new(int_const_block(1)), - miss: Box::new(int_const_block(0)), - }, - }, - ], - result: SymValueId(1), - }, - } - } - - #[test] - fn slot_count_tag_match_encoder_is_node_for_node_fixture_twin() { - let sym = slot_count_sym_plan(); - let host_table = FragHostTable { - box_idx: Some(6), - ..FragHostTable::default() - }; - let struct_table = FragStructTable { - entries: vec![("Option".to_string(), 2)], - }; - let actual = sym - .to_expr_fragment_plan(&host_table, &struct_table) - .expect("slotCount symbolic plan encodes"); - let boxed_const = |value| FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::I64, - kind: FragNodeKind::ConstI64(value), - }, - FragNode { - id: FragValueId(1), - ty: FragTy::IntCarrier, - kind: FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: 6, - args: vec![FragValueId(0)], - }, - }, - ], - result: FragValueId(1), - }; - let expected = ExprFragmentPlan { - params: vec![FragTy::AdtRef], - result: FragTy::IntCarrier, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::AdtRef, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::RawI32, - kind: FragNodeKind::StructGetUser { - ty_idx: 2, - field: 0, - value: FragValueId(0), - }, - }, - FragNode { - id: FragValueId(2), - ty: FragTy::RawI32, - kind: FragNodeKind::ConstI32(1), - }, - FragNode { - id: FragValueId(3), - ty: FragTy::BoolI32, - kind: FragNodeKind::Prim { - op: FragPrim::I32Eq, - args: vec![FragValueId(1), FragValueId(2)], - }, - }, - FragNode { - id: FragValueId(4), - ty: FragTy::IntCarrier, - kind: FragNodeKind::If { - cond: FragValueId(3), - then_block: Box::new(boxed_const(1)), - else_block: Box::new(boxed_const(0)), - }, - }, - ], - result: FragValueId(4), - }, - }; - assert_eq!(actual, expected); - } - - #[test] - fn slot_count_tag_match_lean_render_is_fixture_twin() { - let actual = sym_plan_lean_value(&slot_count_sym_plan()); - let expected = "{ profile := \"sym-fragment-v1\", params := [(.app1 \"Option\" .int)], result := .int, body := ({ nodes := [{ id := 0, ty := (.app1 \"Option\" .int), kind := .param 0 }, { id := 1, ty := .int, kind := .tagMatch \"Option\" 0 (1 : Int) ({ nodes := [{ id := 0, ty := .int, kind := .constInt (1 : Int) }], result := 0 } : SymBlock) ({ nodes := [{ id := 0, ty := .int, kind := .constInt (0 : Int) }], result := 0 } : SymBlock) }], result := 1 } : SymBlock) }"; - assert_eq!(actual, expected); - } - - #[test] - fn sym_plan_projects_direct_float_fragment() { - let plan = ExprFragmentPlan { - params: vec![FragTy::F64, FragTy::F64], - result: FragTy::F64, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::F64, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::F64, - kind: FragNodeKind::Local { index: 1 }, - }, - FragNode { - id: FragValueId(2), - ty: FragTy::F64, - kind: FragNodeKind::Prim { - op: FragPrim::F64Add, - args: vec![FragValueId(0), FragValueId(1)], - }, - }, - ], - result: FragValueId(2), - }, - }; - - let sym = SymPlan::from_expr_fragment_source_subset(&plan).expect("source subset"); - assert_eq!(sym.params, vec![SymTy::Float, SymTy::Float]); - assert_eq!(sym.result, SymTy::Float); - assert!(matches!( - sym.body.nodes[2].kind, - SymNodeKind::Prim { - op: SymPrim::FloatAdd, - .. - } - )); - let lean = sym_plan_lean_value(&sym); - assert!(lean.contains("profile := \"sym-fragment-v1\"")); - assert!(lean.contains("result := .float")); - assert!(lean.contains(".prim .floatAdd [0, 1]")); - } - - #[test] - fn sym_plan_rejects_representation_only_int_limb_fragment() { - let plan = ExprFragmentPlan { - params: vec![FragTy::IntCarrier], - result: FragTy::BoolI32, - body: FragBlock { - nodes: vec![ - FragNode { - id: FragValueId(0), - ty: FragTy::IntCarrier, - kind: FragNodeKind::Local { index: 0 }, - }, - FragNode { - id: FragValueId(1), - ty: FragTy::I64, - kind: FragNodeKind::StructGet { - field: 0, - receiver: FragValueId(0), - }, - }, - ], - result: FragValueId(1), - }, - }; - - assert!(SymPlan::from_expr_fragment_source_subset(&plan).is_none()); - } - - #[test] - fn sym_plan_rejects_raw_wasm_value_fragment() { - let plan = ExprFragmentPlan { - params: vec![FragTy::I64], - result: FragTy::I64, - body: FragBlock { - nodes: vec![FragNode { - id: FragValueId(0), - ty: FragTy::I64, - kind: FragNodeKind::Local { index: 0 }, - }], - result: FragValueId(0), - }, - }; - - assert!(SymPlan::from_expr_fragment_source_subset(&plan).is_none()); - } - - #[test] - fn sym_plan_named_types_render_but_do_not_encode_to_expr_fragment() { - let named = SymTy::Named("User".to_string()); - assert_eq!(named.plan_tag(), "named:User"); - // Named types encode to the opaque `adtRef` representation type; the - // plan below still does NOT encode because its body carries a string - // literal (no representation-level constructor). - assert_eq!(named.to_frag_ty(), Some(FragTy::AdtRef)); - - let plan = SymPlan { - params: vec![named.clone()], - result: SymTy::String, - body: SymBlock { - nodes: vec![ - SymNode { - id: SymValueId(0), - ty: named, - kind: SymNodeKind::Param { index: 0 }, - }, - SymNode { - id: SymValueId(1), - ty: SymTy::String, - kind: SymNodeKind::ConstStringBytes(b"Ada".to_vec()), - }, - ], - result: SymValueId(1), - }, - }; - let lean = sym_plan_lean_value(&plan); - assert!(lean.contains("params := [(.named \"User\")]")); - assert!(plan.to_expr_fragment_plan(&FragHostTable::placeholder(), &FragStructTable::default()).is_none()); - } - - #[test] - fn sym_plan_construct_renders_in_lean_but_does_not_encode_to_expr_fragment() { - let plan = SymPlan { - params: vec![SymTy::Int], - result: SymTy::Named("Op".to_string()), - body: SymBlock { - nodes: vec![ - SymNode { - id: SymValueId(0), - ty: SymTy::Int, - kind: SymNodeKind::Param { index: 0 }, - }, - SymNode { - id: SymValueId(1), - ty: SymTy::Named("Op".to_string()), - kind: SymNodeKind::Construct { - type_name: "Op".to_string(), - ctor_name: "Add".to_string(), - args: vec![SymValueId(0)], - }, - }, - ], - result: SymValueId(1), - }, - }; - - let lean = sym_plan_lean_value(&plan); - assert!(lean.contains("result := (.named \"Op\")")); - assert!(lean.contains(".construct \"Op\" \"Add\" [0]")); - assert!(plan.to_expr_fragment_plan(&FragHostTable::placeholder(), &FragStructTable::default()).is_none()); - } - - #[test] - fn adt_constructor_cert_projects_to_source_construct_plan() { - let cert = Cert::AdtConstructor { - name: "mkOp".to_string(), - self_idx: 1, - type_idx: 1, - nlocals: 0, - carrier: 0, - struct_idx: 3, - field_count: 1, - elem_ty: TyKind::Ref { nullable: true, idx: 3 }, - arity: 1, - fields: vec![ConstructorField::Local(0)], - ops: Vec::new(), - }; - let mut model_info = ModelInfo::default(); - model_info.fns.insert( - "mkOp".to_string(), - FnSig { - lean_name: "mkOp".to_string(), - prefix: String::new(), - params: vec!["Int".to_string()], - ret: "Op".to_string(), - }, - ); - model_info.inductives.insert( - "Op".to_string(), - InductiveInfo { - ctors: vec![CtorInfo { - name: "Add".to_string(), - fields: vec!["Int".to_string()], - }], - }, - ); - - let plan = adt_constructor_sym_plan_from_cert(&cert, &model_info) - .expect("project constructor to SymPlan"); - assert_eq!(plan.params, vec![SymTy::Int]); - assert_eq!(plan.result, SymTy::Named("Op".to_string())); - assert!(matches!( - &plan.body.nodes[1].kind, - SymNodeKind::Construct { - type_name, - ctor_name, - args, - } if type_name == "Op" && ctor_name == "Add" && args == &[SymValueId(0)] - )); - } - - #[test] - fn list_cons_constructor_projects_generic_source_types_and_empty_tail() { - let cert = Cert::AdtConstructor { - name: "singletonEntry".to_string(), - self_idx: 1, - type_idx: 1, - nlocals: 1, - carrier: 18, - struct_idx: 25, - field_count: 2, - elem_ty: TyKind::Ref { nullable: true, idx: 3 }, - arity: 1, - fields: vec![ConstructorField::Local(0), ConstructorField::Null], - ops: vec![ - Op::LocalGet(0), - Op::RefNull(Some(25)), - Op::StructNew(25, 2), - ], - }; - let mut model_info = ModelInfo::default(); - model_info.fns.insert( - "singletonEntry".to_string(), - FnSig { - lean_name: "singletonEntry".to_string(), - prefix: String::new(), - params: vec!["(String × Json)".to_string()], - ret: "List (String × Json)".to_string(), - }, - ); - - let plan = adt_constructor_sym_plan_from_cert(&cert, &model_info) - .expect("List cons projects to a generic SymPlan"); - let elem = SymTy::App( - "Tuple".to_string(), - vec![SymTy::String, SymTy::Named("Json".to_string())], - ); - assert_eq!(plan.params, vec![elem.clone()]); - assert_eq!( - plan.result, - SymTy::App("List".to_string(), vec![elem.clone()]) - ); - assert!(matches!( - &plan.body.nodes[1].kind, - SymNodeKind::EmptyList { elem_ty } if elem_ty == &elem - )); - assert!(matches!( - &plan.body.nodes[2].kind, - SymNodeKind::Construct { type_name, ctor_name, args } - if type_name == "List" && ctor_name == "::" - && args == &[SymValueId(0), SymValueId(1)] - )); - } - - #[test] - fn sym_plan_models_string_concat_without_expr_encoding() { - let plan = SymPlan { - params: vec![SymTy::String], - result: SymTy::String, - body: SymBlock { - nodes: vec![ - SymNode { - id: SymValueId(0), - ty: SymTy::String, - kind: SymNodeKind::Param { index: 0 }, - }, - SymNode { - id: SymValueId(1), - ty: SymTy::String, - kind: SymNodeKind::ConstStringBytes(vec![33]), - }, - SymNode { - id: SymValueId(2), - ty: SymTy::String, - kind: SymNodeKind::Prim { - op: SymPrim::StringConcat, - args: vec![SymValueId(0), SymValueId(1)], - }, - }, - ], - result: SymValueId(2), - }, - }; - - let lean = sym_plan_lean_value(&plan); - assert!(lean.contains(".constStringBytes [33]")); - assert!(lean.contains(".prim .stringConcat [0, 1]")); - assert!(plan.to_expr_fragment_plan(&FragHostTable::placeholder(), &FragStructTable::default()).is_none()); - } -} diff --git a/aver-cert/src/engine/sym_plan_encode.rs b/aver-cert/src/engine/sym_plan_encode.rs deleted file mode 100644 index b0d948d2a..000000000 --- a/aver-cert/src/engine/sym_plan_encode.rs +++ /dev/null @@ -1,469 +0,0 @@ -impl SymPrim { - fn to_frag_prim(self) -> Option { - match self { - SymPrim::FloatAdd => Some(FragPrim::F64Add), - SymPrim::FloatMul => Some(FragPrim::F64Mul), - SymPrim::FloatLe => Some(FragPrim::F64Le), - SymPrim::FloatGe => Some(FragPrim::F64Ge), - SymPrim::FloatLt => Some(FragPrim::F64Lt), - SymPrim::FloatGt => Some(FragPrim::F64Gt), - SymPrim::FloatEq => Some(FragPrim::F64Eq), - // `IntAdd` has no representation-level primitive: the encoder - // binds it to a `hostCall add` node through the role table. - SymPrim::IntAdd | SymPrim::IntSub | SymPrim::IntMul => None, - SymPrim::StringEq => None, - SymPrim::StringConcat => None, - SymPrim::BoolAnd => Some(FragPrim::I32And), - } - } -} - -/// `nparams` is the enclosing plan's parameter count, threaded so the sign -/// template can name the ONE declared scratch local (slot `nparams`); nested -/// blocks share the enclosing plan's parameters, so it is constant. -fn expr_fragment_block_from_sym( - block: &SymBlock, - nparams: u32, - host_table: &FragHostTable, - struct_table: &FragStructTable, -) -> Option { - let mut encoder = SymToFragEncoder { - source_nodes: &block.nodes, - nparams, - host_table, - struct_table, - nodes: Vec::new(), - sym_to_frag: Vec::new(), - }; - for node in &block.nodes { - encoder.encode_node(node)?; - } - let result = *encoder.sym_to_frag.get(block.result.0)?; - Some(FragBlock { - nodes: encoder.nodes, - result, - }) -} - -struct SymToFragEncoder<'a> { - source_nodes: &'a [SymNode], - nparams: u32, - host_table: &'a FragHostTable, - struct_table: &'a FragStructTable, - nodes: Vec, - sym_to_frag: Vec, -} - -impl SymToFragEncoder<'_> { - fn encode_node(&mut self, node: &SymNode) -> Option<()> { - if node.id.0 != self.sym_to_frag.len() { - return None; - } - let ty = node.ty.to_frag_ty()?; - let result = match &node.kind { - SymNodeKind::Param { index } => self.push_node(ty, FragNodeKind::Local { index: *index }), - SymNodeKind::ConstBool(value) => self.push_node(ty, FragNodeKind::ConstBool(*value)), - SymNodeKind::ConstInt(value) => { - // A source Int literal is representation-boxed at the point of - // appearance: raw i64 const, then the byte-derived `box` host - // call. The source node maps to the boxed carrier value. - let box_idx = self.host_table.lookup(FragHostRole::Box)?; - let const_id = self.push_node(FragTy::I64, FragNodeKind::ConstI64(*value)); - self.push_node( - ty, - FragNodeKind::HostCall { - role: FragHostRole::Box, - func_idx: box_idx, - args: vec![const_id], - }, - ) - } - SymNodeKind::ConstFloatBits(bits) => self.push_node(ty, FragNodeKind::ConstF64(*bits)), - SymNodeKind::ConstStringBytes(_) => return None, - SymNodeKind::Prim { - op: op @ (SymPrim::IntAdd | SymPrim::IntSub | SymPrim::IntMul), - args, - } => { - let role = match op { - SymPrim::IntAdd => FragHostRole::Add, - SymPrim::IntSub => FragHostRole::Sub, - _ => FragHostRole::Mul, - }; - let role_idx = self.host_table.lookup(role)?; - let args = args - .iter() - .map(|id| self.sym_to_frag.get(id.0).copied()) - .collect::>>()?; - self.push_node( - ty, - FragNodeKind::HostCall { - role, - func_idx: role_idx, - args, - }, - ) - } - SymNodeKind::Prim { op, args } => { - let args = args - .iter() - .map(|id| self.sym_to_frag.get(id.0).copied()) - .collect::>>()?; - self.push_node( - ty, - FragNodeKind::Prim { - op: op.to_frag_prim()?, - args, - }, - ) - } - SymNodeKind::Construct { - type_name, - ctor_name: _, - args, - } => { - // Record construction: bind the declared type name to its - // byte-derived struct index and pack the planned field values - // in declaration order (`struct.new`). - let ty_idx = self.struct_table.lookup(type_name)?; - let args = args - .iter() - .map(|id| self.sym_to_frag.get(id.0).copied()) - .collect::>>()?; - self.push_node(ty, FragNodeKind::StructNew { ty_idx, args }) - } - SymNodeKind::EmptyList { .. } => return None, - SymNodeKind::ProjectField { - type_name, - field, - field_ty: _, - value, - } => { - // Opaque reference fields flow verbatim through the - // field-projection face; stage-1 scalar leaves - // (Bool/Int/Float, `frag_ty_is_record_scalar`) flow through the - // record-parameter face. Any other field type has no rendered - // proof face yet, so it fail-closes the encoding (twin of the - // Lean encoder arm at `PlanCheck.lean:949`). - if ty != FragTy::AdtRef && !frag_ty_is_record_scalar(ty) { - return None; - } - let ty_idx = self.struct_table.lookup(type_name)?; - let value = *self.sym_to_frag.get(value.0)?; - self.push_node( - ty, - FragNodeKind::StructGetUser { - ty_idx, - field: *field, - value, - }, - ) - } - SymNodeKind::IntConstCmp { - op, - value, - constant, - } => self.encode_int_const_cmp(*op, *value, *constant)?, - SymNodeKind::IntCmp { op, lhs, rhs } => self.encode_int_cmp(*op, *lhs, *rhs)?, - SymNodeKind::TagMatch { - type_name, - scrutinee, - tag, - hit, - miss, - } => { - let ty_idx = self.struct_table.lookup(type_name)?; - let scrutinee = *self.sym_to_frag.get(scrutinee.0)?; - let tag_value = self.push_node( - FragTy::RawI32, - FragNodeKind::StructGetUser { - ty_idx, - field: 0, - value: scrutinee, - }, - ); - let constant = self.push_node( - FragTy::RawI32, - FragNodeKind::ConstI32(i32::try_from(*tag).ok()?), - ); - let cond = self.push_node( - FragTy::BoolI32, - FragNodeKind::Prim { - op: FragPrim::I32Eq, - args: vec![tag_value, constant], - }, - ); - self.push_node( - ty, - FragNodeKind::If { - cond, - then_block: Box::new(expr_fragment_block_from_sym( - hit, - self.nparams, - self.host_table, - self.struct_table, - )?), - else_block: Box::new(expr_fragment_block_from_sym( - miss, - self.nparams, - self.host_table, - self.struct_table, - )?), - }, - ) - } - SymNodeKind::VectorGetOrDefault { type_name, default } => { - // Twin of the Lean encoder arm: resolve the vector's array - // type through the byte-derived struct table and both helpers - // through the byte-derived role table; a missing binding - // fail-closes the encoding. - let arr_ty = self.struct_table.lookup(type_name)?; - let to_index_idx = self.host_table.lookup(FragHostRole::ToIndex)?; - let box_idx = self.host_table.lookup(FragHostRole::Box)?; - self.push_node( - ty, - FragNodeKind::VectorGetOrDefault { - arr_ty, - to_index_idx, - box_idx, - default: *default, - }, - ) - } - SymNodeKind::If { - cond, - then_block, - else_block, - } => { - let cond = *self.sym_to_frag.get(cond.0)?; - self.push_node( - ty, - FragNodeKind::If { - cond, - then_block: Box::new(expr_fragment_block_from_sym( - then_block, - self.nparams, - self.host_table, - self.struct_table, - )?), - else_block: Box::new(expr_fragment_block_from_sym( - else_block, - self.nparams, - self.host_table, - self.struct_table, - )?), - }, - ) - } - }; - self.sym_to_frag.push(result); - Some(()) - } - - fn push_node(&mut self, ty: FragTy, kind: FragNodeKind) -> FragValueId { - let id = FragValueId(self.nodes.len()); - self.nodes.push(FragNode { id, ty, kind }); - id - } - - /// Twin of the wall's `.intCmp` encoder arm: read both operands, call the - /// helper the operator names, and — for the three relational operators — - /// compare the raw verdict against `i32.const 0`. Equality reads - /// `__aint_eq`, whose `0`/`1` result IS the source Boolean and carries no - /// tail. A missing role binding or the unadmitted `<=` fail-closes. - fn encode_int_cmp( - &mut self, - op: SymIntCmp, - lhs: SymValueId, - rhs: SymValueId, - ) -> Option { - let lhs = *self.sym_to_frag.get(lhs.0)?; - let rhs = *self.sym_to_frag.get(rhs.0)?; - if op == SymIntCmp::Eq { - let eq_idx = self.host_table.eq_idx?; - return Some(self.push_node( - FragTy::BoolI32, - FragNodeKind::HostCall { - role: FragHostRole::Eq, - func_idx: eq_idx, - args: vec![lhs, rhs], - }, - )); - } - let prim = sym_int_cmp_tail_prim(op)?; - let cmp_idx = self.host_table.cmp_idx?; - let verdict = self.push_node( - FragTy::RawI32, - FragNodeKind::HostCall { - role: FragHostRole::Cmp, - func_idx: cmp_idx, - args: vec![lhs, rhs], - }, - ); - let zero = self.push_node(FragTy::RawI32, FragNodeKind::ConstI32(0)); - Some(self.push_node( - FragTy::BoolI32, - FragNodeKind::Prim { - op: prim, - args: vec![verdict, zero], - }, - )) - } - - /// Twin of the wall's `.intConstCmp` encoder arm. A PARAM operand keeps - /// the historical two-arm expansion: both arms re-read the parameter's - /// local slot, so no scratch is needed and the emitted bytes are - /// unchanged. Any COMPUTED operand cannot be re-read, so it encodes to the - /// emitter's real monolithic template (`intSignCmp`), which stashes the - /// value in the declared scratch local (slot `nparams`). - fn encode_int_const_cmp( - &mut self, - op: SymIntCmp, - value: SymValueId, - constant: i64, - ) -> Option { - let carrier = *self.sym_to_frag.get(value.0)?; - let param_index = match self.source_nodes.get(value.0)? { - SymNode { - ty: SymTy::Int, - kind: SymNodeKind::Param { index }, - .. - } => Some(*index), - _ => None, - }; - let Some(param_index) = param_index else { - return Some(self.push_node( - FragTy::BoolI32, - FragNodeKind::IntSignCmp { - op, - constant, - scratch: self.nparams, - value: carrier, - }, - )); - }; - let magf = self.push_node( - FragTy::Ref, - FragNodeKind::StructGet { - field: 1, - receiver: carrier, - }, - ); - let is_small = self.push_node(FragTy::BoolI32, FragNodeKind::RefIsNull { value: magf }); - let then_block = sym_int_small_const_cmp_block(param_index, op, constant)?; - let else_block = sym_int_big_const_cmp_block(param_index, op)?; - Some(self.push_node( - FragTy::BoolI32, - FragNodeKind::If { - cond: is_small, - then_block: Box::new(then_block), - else_block: Box::new(else_block), - }, - )) - } -} - -fn sym_int_small_const_cmp_block(index: u32, op: SymIntCmp, k: i64) -> Option { - let mut nodes = Vec::new(); - let carrier = push_frag_node(&mut nodes, FragTy::IntCarrier, FragNodeKind::Local { index }); - let small = push_frag_node( - &mut nodes, - FragTy::I64, - FragNodeKind::StructGet { - field: 0, - receiver: carrier, - }, - ); - let constant = push_frag_node(&mut nodes, FragTy::I64, FragNodeKind::ConstI64(k)); - let result = push_frag_node( - &mut nodes, - FragTy::BoolI32, - FragNodeKind::Prim { - op: sym_int_small_const_cmp_prim(op)?, - args: vec![small, constant], - }, - ); - Some(FragBlock { nodes, result }) -} - -fn sym_int_big_const_cmp_block(index: u32, op: SymIntCmp) -> Option { - let mut nodes = Vec::new(); - match sym_int_big_const_cmp_kind(op)? { - SymBigIntConstCmpKind::Always(value) => { - let result = push_frag_node(&mut nodes, FragTy::BoolI32, FragNodeKind::ConstBool(value)); - Some(FragBlock { nodes, result }) - } - SymBigIntConstCmpKind::SignLtZero | SymBigIntConstCmpKind::SignGtZero => { - let carrier = - push_frag_node(&mut nodes, FragTy::IntCarrier, FragNodeKind::Local { index }); - let sign = push_frag_node( - &mut nodes, - FragTy::RawI32, - FragNodeKind::StructGet { - field: 2, - receiver: carrier, - }, - ); - let zero = push_frag_node(&mut nodes, FragTy::BoolI32, FragNodeKind::ConstBool(false)); - let prim = match sym_int_big_const_cmp_kind(op)? { - SymBigIntConstCmpKind::SignLtZero => FragPrim::I32LtS, - SymBigIntConstCmpKind::SignGtZero => FragPrim::I32GtS, - SymBigIntConstCmpKind::Always(_) => unreachable!(), - }; - let result = push_frag_node( - &mut nodes, - FragTy::BoolI32, - FragNodeKind::Prim { - op: prim, - args: vec![sign, zero], - }, - ); - Some(FragBlock { nodes, result }) - } - } -} - -fn push_frag_node(nodes: &mut Vec, ty: FragTy, kind: FragNodeKind) -> FragValueId { - let id = FragValueId(nodes.len()); - nodes.push(FragNode { id, ty, kind }); - id -} - -#[derive(Clone, Copy)] -enum SymBigIntConstCmpKind { - Always(bool), - SignLtZero, - SignGtZero, -} - -/// Twin of `PlanCheck.symIntCmpTailPrim?`: the signed relational primitive that -/// reads the three-way `__aint_cmp` verdict. `Eq` is absent because it reads a -/// DIFFERENT helper, `Le` because the plan grammar has no `i32.le_s`. -fn sym_int_cmp_tail_prim(op: SymIntCmp) -> Option { - match op { - SymIntCmp::Lt => Some(FragPrim::I32LtS), - SymIntCmp::Gt => Some(FragPrim::I32GtS), - SymIntCmp::Ge => Some(FragPrim::I32GeS), - SymIntCmp::Eq | SymIntCmp::Le => None, - } -} - -fn sym_int_small_const_cmp_prim(op: SymIntCmp) -> Option { - match op { - SymIntCmp::Eq => Some(FragPrim::I64Eq), - SymIntCmp::Lt => Some(FragPrim::I64LtS), - SymIntCmp::Le => Some(FragPrim::I64LeS), - SymIntCmp::Ge => Some(FragPrim::I64GeS), - SymIntCmp::Gt => Some(FragPrim::I64GtS), - } -} - -fn sym_int_big_const_cmp_kind(op: SymIntCmp) -> Option { - match op { - SymIntCmp::Eq => Some(SymBigIntConstCmpKind::Always(false)), - SymIntCmp::Lt | SymIntCmp::Le => Some(SymBigIntConstCmpKind::SignLtZero), - // A Big carrier lies strictly outside the i64 range, so `> k` and - // `>= k` are both decided by the sign limb alone (a Big never equals - // an i64 literal) — the mirror of `Lt | Le` sharing `SignLtZero`. - SymIntCmp::Ge | SymIntCmp::Gt => Some(SymBigIntConstCmpKind::SignGtZero), - } -} diff --git a/aver-cert/src/engine/sym_plan_render.rs b/aver-cert/src/engine/sym_plan_render.rs deleted file mode 100644 index d5b1ce310..000000000 --- a/aver-cert/src/engine/sym_plan_render.rs +++ /dev/null @@ -1,182 +0,0 @@ -fn sym_plan_lean_value(plan: &SymPlan) -> String { - format!( - "{{ profile := \"sym-fragment-v1\", params := [{}], result := {}, body := {} }}", - plan.params - .iter() - .map(|ty| ty.lean_plan_ctor()) - .collect::>() - .join(", "), - plan.result.lean_plan_ctor(), - sym_block_lean_value(&plan.body) - ) -} - -impl SymTy { - fn lean_plan_ctor(&self) -> String { - match self { - SymTy::Int => ".int".to_string(), - SymTy::Float => ".float".to_string(), - SymTy::Bool => ".bool".to_string(), - SymTy::String => ".string".to_string(), - SymTy::Named(name) => format!("(.named {})", lean_str(name)), - SymTy::App(name, args) if args.len() == 1 => format!( - "(.app1 {} {})", - lean_str(name), - args[0].lean_plan_ctor() - ), - SymTy::App(name, args) if args.len() == 2 => format!( - "(.app2 {} {} {})", - lean_str(name), - args[0].lean_plan_ctor(), - args[1].lean_plan_ctor() - ), - SymTy::App(_, _) => unreachable!("source type parser emits unary/binary apps only"), - } - } -} - -impl SymPrim { - fn lean_plan_ctor(self) -> &'static str { - match self { - SymPrim::FloatAdd => ".floatAdd", - SymPrim::FloatMul => ".floatMul", - SymPrim::FloatLe => ".floatLe", - SymPrim::FloatGe => ".floatGe", - SymPrim::FloatLt => ".floatLt", - SymPrim::FloatGt => ".floatGt", - SymPrim::FloatEq => ".floatEq", - SymPrim::IntAdd => ".intAdd", - SymPrim::IntSub => ".intSub", - SymPrim::IntMul => ".intMul", - SymPrim::StringEq => ".stringEq", - SymPrim::StringConcat => ".stringConcat", - SymPrim::BoolAnd => ".boolAnd", - } - } -} - -impl SymIntCmp { - fn lean_plan_ctor(self) -> &'static str { - match self { - SymIntCmp::Eq => ".eq", - SymIntCmp::Lt => ".lt", - SymIntCmp::Le => ".le", - SymIntCmp::Ge => ".ge", - SymIntCmp::Gt => ".gt", - } - } -} - -fn sym_block_lean_value(block: &SymBlock) -> String { - format!( - "({{ nodes := [{}], result := {} }} : SymBlock)", - block - .nodes - .iter() - .map(sym_node_lean_value) - .collect::>() - .join(", "), - block.result.0 - ) -} - -fn sym_node_lean_value(node: &SymNode) -> String { - format!( - "{{ id := {}, ty := {}, kind := {} }}", - node.id.0, - node.ty.lean_plan_ctor(), - sym_node_kind_lean_value(&node.kind) - ) -} - -fn sym_node_kind_lean_value(kind: &SymNodeKind) -> String { - match kind { - SymNodeKind::Param { index } => format!(".param {index}"), - SymNodeKind::ConstBool(value) => format!(".constBool {value}"), - SymNodeKind::ConstInt(value) => format!(".constInt ({value} : Int)"), - SymNodeKind::ConstFloatBits(bits) => format!(".constFloatBits 0x{bits:016x}"), - SymNodeKind::ConstStringBytes(bytes) => { - format!(".constStringBytes {}", render_byte_list(bytes)) - } - SymNodeKind::Prim { op, args } => format!( - ".prim {} [{}]", - op.lean_plan_ctor(), - args.iter() - .map(|id| id.0.to_string()) - .collect::>() - .join(", ") - ), - SymNodeKind::Construct { - type_name, - ctor_name, - args, - } => format!( - ".construct {} {} [{}]", - lean_str(type_name), - lean_str(ctor_name), - args.iter() - .map(|id| id.0.to_string()) - .collect::>() - .join(", ") - ), - SymNodeKind::EmptyList { elem_ty } => { - format!(".emptyList {}", elem_ty.lean_plan_ctor()) - } - SymNodeKind::ProjectField { - type_name, - field, - field_ty, - value, - } => format!( - ".projectField {} {field} {} {}", - lean_str(type_name), - field_ty.lean_plan_ctor(), - value.0 - ), - SymNodeKind::IntConstCmp { - op, - value, - constant, - } => format!( - ".intConstCmp {} {} ({} : Int)", - op.lean_plan_ctor(), - value.0, - constant - ), - SymNodeKind::IntCmp { op, lhs, rhs } => format!( - ".intCmp {} {} {}", - op.lean_plan_ctor(), - lhs.0, - rhs.0 - ), - SymNodeKind::TagMatch { - type_name, - scrutinee, - tag, - hit, - miss, - } => format!( - ".tagMatch {} {} ({} : Int) {} {}", - lean_str(type_name), - scrutinee.0, - tag, - sym_block_lean_value(hit), - sym_block_lean_value(miss) - ), - SymNodeKind::VectorGetOrDefault { type_name, default } => format!( - ".vectorGetOrDefault {} ({} : Int)", - lean_str(type_name), - default - ), - SymNodeKind::If { - cond, - then_block, - else_block, - } => format!( - ".ifElse {} {} {}", - cond.0, - sym_block_lean_value(then_block), - sym_block_lean_value(else_block) - ), - } -} diff --git a/aver-cert/src/engine/verbatim_plan_defs.rs b/aver-cert/src/engine/verbatim_plan_defs.rs deleted file mode 100644 index b80a89ad5..000000000 --- a/aver-cert/src/engine/verbatim_plan_defs.rs +++ /dev/null @@ -1,578 +0,0 @@ -// Byte-first `verbatim-plan-v1` plan builder. -// -// A verbatim `ref.test`-dispatch body (the ADT-match `Cod := WVal` shapes: -// `Cert::VerbatimWidenedMatch` / `Cert::VerbatimVariantDispatch`) reconstructs -// losslessly from the byte-derived cert holes into a DEDICATED grammar (NOT the -// ANF `FragBlock`: the multi-use scrutinee is spilled to a scratch local, which -// pure ANF cannot express). The plan lowers, byte-for-byte, to the emitted code -// entry; it carries no source-level meaning and never changes the -// `verbatimRepr` proof face — it only moves the match body's byte-origin into -// hash-pinned Lean. There are no host/self calls to bind, so the byte-equality -// gate IS the whole soundness binding; the plan is otherwise only structural. - -/// One terminal leaf of a verbatim dispatch arm. Rust twin of Lean -/// `Schema.VerbatimLeaf`. -#[derive(Clone, PartialEq)] -enum VerbatimLeaf { - /// Project field `field` of the scrutinee cast to user struct type `ty_idx`. - Project { ty_idx: u32, field: u32 }, - /// A String literal built by `array.new_data arr_ty data_idx` over `bytes`. - ArrayNewData { - arr_ty: u32, - data_idx: u32, - bytes: Vec, - }, - /// The null reference default (`ref.null result_heap_ty`). - RefNull, - /// A float-bits constant (`f64.const bits`). - F64Bits(u64), -} - -/// A right-nested `ref.test` dispatch cascade. Rust twin of Lean -/// `Schema.VerbatimDispatch`. -#[derive(Clone, PartialEq)] -enum VerbatimDispatch { - Leaf(VerbatimLeaf), - Test { - ty_idx: u32, - hit: VerbatimLeaf, - rest: Box, - }, -} - -/// Exact result signature claimed by a verbatim plan. The kernel matches this -/// against the result kind recovered from the module's type-section bytes. -#[derive(Clone, Copy, PartialEq)] -enum VerbatimResultSig { - RefNull(u32), - F64Scalar, -} - -/// Raw, untrusted verbatim `ref.test`-dispatch plan (`verbatim-plan-v1`). Rust -/// twin of Lean `Schema.VerbatimRawPlan` (the `profile` field is hard-coded by -/// the Lean renderer, so it is not carried here). -#[derive(Clone, PartialEq)] -struct VerbatimRawPlan { - scrutinee_local: u32, - field_local: u32, - result_sig: VerbatimResultSig, - body: VerbatimDispatch, -} - -fn verbatim_leaf_has_projection(l: &VerbatimLeaf) -> bool { - matches!(l, VerbatimLeaf::Project { .. }) -} - -fn verbatim_dispatch_has_projection(d: &VerbatimDispatch) -> bool { - match d { - VerbatimDispatch::Leaf(l) => verbatim_leaf_has_projection(l), - VerbatimDispatch::Test { hit, rest, .. } => { - verbatim_leaf_has_projection(hit) || verbatim_dispatch_has_projection(rest) - } - } -} - -/// The dispatch leaf a byte-derived `VerbatimDefault` constant lowers to. -fn verbatim_leaf_from_default(d: &VerbatimDefault) -> VerbatimLeaf { - match d { - VerbatimDefault::Null => VerbatimLeaf::RefNull, - VerbatimDefault::F64Bits(bits) => VerbatimLeaf::F64Bits(*bits), - VerbatimDefault::Array { - type_idx, - data_idx, - bytes, - } => VerbatimLeaf::ArrayNewData { - arr_ty: *type_idx, - data_idx: *data_idx, - bytes: bytes.clone(), - }, - } -} - -/// The dispatch result signature read from the byte-derived default: an -/// `array.new_data` default names its nullable-ref heap type directly, a null -/// default names it through the threaded `ref.null` body op, and an `f64` -/// default selects the disjoint scalar variant. The byte-equality and -/// type-section gates re-check whatever this returns. -fn verbatim_result_sig(default: &VerbatimDefault, ops: &[Op]) -> Option { - match default { - VerbatimDefault::Array { type_idx, .. } => Some(VerbatimResultSig::RefNull(*type_idx)), - VerbatimDefault::Null => ops.iter().find_map(|op| match op { - Op::RefNull(Some(h)) => Some(VerbatimResultSig::RefNull(*h)), - _ => None, - }), - VerbatimDefault::F64Bits(_) => Some(VerbatimResultSig::F64Scalar), - } -} - -/// Build the byte-first `verbatim-plan-v1` plan for a verbatim widened-match or -/// variant-dispatch cert. Returns `None` for any other class, and — fail-closed -/// — for a certified body whose REAL code entry does not equal the canonical -/// plan lowering (a body byte-noisier than the canonical template stays on the -/// legacy witness route; an artifact must never carry a byte-origin claim its -/// own bytes cannot prove). The scrutinee/field scratch locals are fixed by the -/// ADT-match lowering layout (projecting => S=2, F=1; non-projecting => S=1), -/// exactly what the Lean locals encoder assumes. -fn verbatim_plan_from_cert(c: &Cert) -> Option { - let (plan, carrier, code_entry_bytes) = match c.inner() { - Cert::VerbatimWidenedMatch { - hit_variant_idx, - default, - carrier, - code_entry_bytes, - ops, - .. - } => { - let result_sig = verbatim_result_sig(default, ops)?; - let body = VerbatimDispatch::Test { - ty_idx: *hit_variant_idx, - hit: VerbatimLeaf::Project { - ty_idx: *hit_variant_idx, - field: 0, - }, - rest: Box::new(VerbatimDispatch::Leaf(verbatim_leaf_from_default(default))), - }; - let plan = VerbatimRawPlan { - scrutinee_local: 2, - field_local: 1, - result_sig, - body, - }; - (plan, *carrier, code_entry_bytes) - } - Cert::VerbatimVariantDispatch { - arms, - default, - carrier, - code_entry_bytes, - ops, - .. - } => { - let result_sig = verbatim_result_sig(default, ops)?; - let mut body = VerbatimDispatch::Leaf(verbatim_leaf_from_default(default)); - for (tag, konst) in arms.iter().rev() { - body = VerbatimDispatch::Test { - ty_idx: *tag, - hit: verbatim_leaf_from_default(konst), - rest: Box::new(body), - }; - } - let plan = VerbatimRawPlan { - scrutinee_local: 1, - field_local: 0, - result_sig, - body, - }; - (plan, *carrier, code_entry_bytes) - } - _ => return None, - }; - let lowered = lower_verbatim_code_entry(&plan, carrier); - if &lowered != code_entry_bytes { - return None; - } - Some(plan) -} - -/// Exact code-entry bytes of a verbatim plan. Twin of Lean -/// `PlanBytes.lowerVerbatimCodeEntry` (heap indices s33-signed; -/// struct.get/array.new_data type+field+data indices uleb32). -fn lower_verbatim_code_entry(plan: &VerbatimRawPlan, carrier: u32) -> Vec { - let body = lower_verbatim_body_bytes(plan, carrier); - let mut out = Vec::new(); - push_u32_leb(&mut out, body.len() as u32); - out.extend_from_slice(&body); - out -} - -fn lower_verbatim_body_bytes(plan: &VerbatimRawPlan, carrier: u32) -> Vec { - let mut out = Vec::new(); - // Local declarations. - if verbatim_dispatch_has_projection(&plan.body) { - out.extend_from_slice(&[0x03, 0x01]); - match plan.result_sig { - VerbatimResultSig::RefNull(heap_ty) => { - out.push(0x63); - push_s33_heap_idx(&mut out, heap_ty); - } - VerbatimResultSig::F64Scalar => out.push(0x7c), - } - out.extend_from_slice(&[0x01, 0x6d, 0x01, 0x63]); - push_s33_heap_idx(&mut out, carrier); - } else { - out.extend_from_slice(&[0x02, 0x01, 0x6d, 0x01, 0x63]); - push_s33_heap_idx(&mut out, carrier); - } - // Expression: spill the scrutinee, then the dispatch cascade. - out.extend_from_slice(&[0x20, 0x00, 0x21]); - push_u32_leb(&mut out, plan.scrutinee_local); - out.push(0x20); - push_u32_leb(&mut out, plan.scrutinee_local); - verbatim_dispatch_bytes( - &mut out, - plan.scrutinee_local, - plan.field_local, - plan.result_sig, - true, - &plan.body, - ); - out.push(0x0b); - out -} - -fn verbatim_dispatch_bytes( - out: &mut Vec, - s: u32, - f: u32, - result_sig: VerbatimResultSig, - first: bool, - disp: &VerbatimDispatch, -) { - match disp { - VerbatimDispatch::Leaf(l) => verbatim_leaf_bytes(out, s, f, result_sig, l), - VerbatimDispatch::Test { ty_idx, hit, rest } => { - if !first { - out.push(0x20); - push_u32_leb(out, s); - } - out.extend_from_slice(&[0xfb, 0x14]); - push_s33_heap_idx(out, *ty_idx); - out.push(0x04); - match result_sig { - VerbatimResultSig::RefNull(heap_ty) => { - out.push(0x63); - push_s33_heap_idx(out, heap_ty); - } - VerbatimResultSig::F64Scalar => out.push(0x7c), - } - verbatim_leaf_bytes(out, s, f, result_sig, hit); - out.push(0x05); - verbatim_dispatch_bytes(out, s, f, result_sig, false, rest); - out.push(0x0b); - } - } -} - -fn verbatim_leaf_bytes( - out: &mut Vec, - s: u32, - f: u32, - result_sig: VerbatimResultSig, - leaf: &VerbatimLeaf, -) { - match leaf { - VerbatimLeaf::Project { ty_idx, field } => { - out.push(0x20); - push_u32_leb(out, s); - out.extend_from_slice(&[0xfb, 0x16]); - push_s33_heap_idx(out, *ty_idx); - out.extend_from_slice(&[0xfb, 0x02]); - push_u32_leb(out, *ty_idx); - push_u32_leb(out, *field); - out.push(0x21); - push_u32_leb(out, f); - out.push(0x20); - push_u32_leb(out, f); - } - VerbatimLeaf::ArrayNewData { - arr_ty, - data_idx, - bytes, - } => { - out.push(0x41); - push_i32_leb(out, 0); - out.push(0x41); - push_i32_leb(out, bytes.len() as i32); - out.extend_from_slice(&[0xfb, 0x09]); - push_u32_leb(out, *arr_ty); - push_u32_leb(out, *data_idx); - } - VerbatimLeaf::RefNull => { - out.push(0xd0); - let VerbatimResultSig::RefNull(heap_ty) = result_sig else { - unreachable!("f64 verbatim plan cannot contain ref.null") - }; - push_s33_heap_idx(out, heap_ty); - } - VerbatimLeaf::F64Bits(bits) => { - out.push(0x44); - out.extend_from_slice(&bits.to_le_bytes()); - } - } -} - -/// The Lean `VerbatimLeaf` literal. -fn verbatim_leaf_lean_value(l: &VerbatimLeaf) -> String { - match l { - VerbatimLeaf::Project { ty_idx, field } => format!(".project {ty_idx} {field}"), - VerbatimLeaf::ArrayNewData { - arr_ty, - data_idx, - bytes, - } => format!(".arrayNewData {arr_ty} {data_idx} {}", render_byte_list(bytes)), - VerbatimLeaf::RefNull => ".refNull".to_string(), - VerbatimLeaf::F64Bits(bits) => format!(".f64Bits {bits}"), - } -} - -/// The Lean `VerbatimDispatch` literal. -fn verbatim_dispatch_lean_value(d: &VerbatimDispatch) -> String { - match d { - VerbatimDispatch::Leaf(l) => format!(".leaf ({})", verbatim_leaf_lean_value(l)), - VerbatimDispatch::Test { ty_idx, hit, rest } => format!( - ".test {ty_idx} ({}) ({})", - verbatim_leaf_lean_value(hit), - verbatim_dispatch_lean_value(rest) - ), - } -} - -/// The Lean `VerbatimRawPlan` literal (profile `verbatim-plan-v1`), rendered on -/// ONE line (a multi-line anonymous-constructor literal misparses). -fn verbatim_plan_lean_value(plan: &VerbatimRawPlan) -> String { - let result_sig = match plan.result_sig { - VerbatimResultSig::RefNull(heap_ty) => format!(".refNull {heap_ty}"), - VerbatimResultSig::F64Scalar => ".f64Scalar".to_string(), - }; - format!( - "{{ profile := \"verbatim-plan-v1\", scrutineeLocal := {}, fieldLocal := {}, resultSig := {}, body := {} }}", - plan.scrutinee_local, - plan.field_local, - result_sig, - verbatim_dispatch_lean_value(&plan.body) - ) -} - -#[cfg(test)] -mod verbatim_plan_gate_tests { - use super::*; - - /// The `wrapItems` cert (verbatim widened match, func 13): tests struct - /// type 6, projects field 0, defaults to `ref.null 20`. carrier 18. - fn wrap_items_cert(code_entry_bytes: Vec) -> Cert { - Cert::VerbatimWidenedMatch { - name: "wrapItems".to_string(), - self_idx: 13, - nlocals: 3, - carrier: 18, - hit_variant_idx: 6, - default: VerbatimDefault::Null, - code_entry_bytes, - ops: vec![ - Op::LocalGet(0), - Op::LocalSet(2), - Op::LocalGet(2), - Op::RefTest(6), - Op::If, - Op::LocalGet(2), - Op::RefCast(6), - Op::StructGet(6, 0), - Op::LocalSet(1), - Op::LocalGet(1), - Op::Else, - Op::RefNull(Some(20)), - Op::End, - ], - } - } - - /// The `tagName` cert (verbatim variant dispatch, func 14): tests struct - /// types 8, 9 -> String literals in array type 16, else -> "gamma". - fn tag_name_cert(code_entry_bytes: Vec) -> Cert { - let arr = |data_idx: u32, bytes: &[u8]| VerbatimDefault::Array { - type_idx: 16, - data_idx, - bytes: bytes.to_vec(), - }; - Cert::VerbatimVariantDispatch { - name: "tagName".to_string(), - self_idx: 14, - nlocals: 2, - carrier: 18, - arms: vec![ - (8, arr(0, &[97, 108, 112, 104, 97])), - (9, arr(1, &[98, 101, 116, 97])), - ], - default: arr(2, &[103, 97, 109, 109, 97]), - code_entry_bytes, - ops: vec![Op::LocalGet(0), Op::LocalSet(1), Op::LocalGet(1)], - } - } - - fn json_float_cert(code_entry_bytes: Vec, bits: u64) -> Cert { - Cert::VerbatimWidenedMatch { - name: "jsonFloat".to_string(), - self_idx: 15, - nlocals: 3, - carrier: 18, - hit_variant_idx: 6, - default: VerbatimDefault::F64Bits(bits), - code_entry_bytes, - ops: vec![Op::F64Const(bits)], - } - } - - #[test] - fn verbatim_plan_reproduces_stage0_pins() { - // wrapItems: the pinned code entry (size 0x27) from the spike. - let wrap_plan = verbatim_plan_from_cert(&wrap_items_cert(Vec::new())); - assert!( - wrap_plan.is_none(), - "empty code entry cannot equal the canonical lowering" - ); - let wrap_plan = VerbatimRawPlan { - scrutinee_local: 2, - field_local: 1, - result_sig: VerbatimResultSig::RefNull(20), - body: VerbatimDispatch::Test { - ty_idx: 6, - hit: VerbatimLeaf::Project { - ty_idx: 6, - field: 0, - }, - rest: Box::new(VerbatimDispatch::Leaf(VerbatimLeaf::RefNull)), - }, - }; - let wrap_bytes = lower_verbatim_code_entry(&wrap_plan, 18); - // size prefix + locals `03 01 63 14 01 6d 01 63 12` + body. - assert_eq!(wrap_bytes[0] as usize, wrap_bytes.len() - 1); - assert_eq!( - &wrap_bytes[1..10], - &[0x03, 0x01, 0x63, 0x14, 0x01, 0x6d, 0x01, 0x63, 0x12], - "wrapItems locals decl" - ); - assert!( - verbatim_plan_from_cert(&wrap_items_cert(wrap_bytes.clone())).is_some(), - "byte-exact wrapItems must carry a plan claim" - ); - // Byte-noisy body: an extra byte -> no claim; certification declines, fail-closed. - let mut noisy = wrap_bytes.clone(); - noisy.push(0x00); - noisy[0] += 1; - assert!( - verbatim_plan_from_cert(&wrap_items_cert(noisy)).is_none(), - "a body the canonical plan cannot reproduce must not carry a claim" - ); - - // tagName: three String literals, right-nested cascade. - let tag_plan = VerbatimRawPlan { - scrutinee_local: 1, - field_local: 0, - result_sig: VerbatimResultSig::RefNull(16), - body: VerbatimDispatch::Test { - ty_idx: 8, - hit: VerbatimLeaf::ArrayNewData { - arr_ty: 16, - data_idx: 0, - bytes: vec![97, 108, 112, 104, 97], - }, - rest: Box::new(VerbatimDispatch::Test { - ty_idx: 9, - hit: VerbatimLeaf::ArrayNewData { - arr_ty: 16, - data_idx: 1, - bytes: vec![98, 101, 116, 97], - }, - rest: Box::new(VerbatimDispatch::Leaf(VerbatimLeaf::ArrayNewData { - arr_ty: 16, - data_idx: 2, - bytes: vec![103, 97, 109, 109, 97], - })), - }), - }, - }; - let tag_bytes = lower_verbatim_code_entry(&tag_plan, 18); - assert_eq!( - &tag_bytes[1..7], - &[0x02, 0x01, 0x6d, 0x01, 0x63, 0x12], - "tagName locals decl (non-projecting)" - ); - assert!( - verbatim_plan_from_cert(&tag_name_cert(tag_bytes)).is_some(), - "byte-exact tagName must carry a plan claim" - ); - } - - #[test] - fn f64_scalar_plan_binds_locals_block_type_and_constant_bits() { - let bits = 0x3ff0_0000_0000_0000; - let plan = VerbatimRawPlan { - scrutinee_local: 2, - field_local: 1, - result_sig: VerbatimResultSig::F64Scalar, - body: VerbatimDispatch::Test { - ty_idx: 6, - hit: VerbatimLeaf::Project { - ty_idx: 6, - field: 0, - }, - rest: Box::new(VerbatimDispatch::Leaf(VerbatimLeaf::F64Bits(bits))), - }, - }; - let bytes = lower_verbatim_code_entry(&plan, 18); - assert_eq!( - &bytes[1..9], - &[0x03, 0x01, 0x7c, 0x01, 0x6d, 0x01, 0x63, 0x12], - "projecting f64 plans retain the exact three-local layout" - ); - assert!(bytes.windows(2).any(|w| w == [0x04, 0x7c])); - assert!(bytes - .windows(9) - .any(|w| w[0] == 0x44 && w[1..] == bits.to_le_bytes())); - assert!( - verbatim_plan_from_cert(&json_float_cert(bytes.clone(), bits)).is_some(), - "byte-exact f64 widened match must carry a plan claim" - ); - - let wrong_bits = bits ^ 1; - assert!( - verbatim_plan_from_cert(&json_float_cert(bytes, wrong_bits)).is_none(), - "the code-entry equality must bind all eight f64 immediate bytes" - ); - } - - /// FIX 1 belt: `verbatim_results_ok` requires EXACTLY one result of the kind - /// the fall-through default implies and rejects a forged zero/two-result - /// declaration or a non-nullable reference before the in-kernel signature - /// check. Each negative assertion fails only if the belt itself is weakened. - #[test] - fn verbatim_results_ok_binds_the_result_signature() { - use TyKind::*; - let f64_default = VerbatimDefault::F64Bits(0); - let null_default = VerbatimDefault::Null; - let arr_default = VerbatimDefault::Array { - type_idx: 5, - data_idx: 0, - bytes: vec![97], - }; - let null_ref = Ref { - nullable: true, - idx: 5, - }; - let non_null_ref = Ref { - nullable: false, - idx: 5, - }; - // Honest shapes: scalar f64 route returns exactly `[f64]`; every - // reference-producing default returns exactly one NULLABLE reference. - assert!(verbatim_results_ok(&[F64], &f64_default)); - assert!(verbatim_results_ok(&[null_ref], &null_default)); - assert!(verbatim_results_ok(&[null_ref], &arr_default)); - // Zero results (forged empty signature) — rejected on every route. - assert!(!verbatim_results_ok(&[], &f64_default)); - assert!(!verbatim_results_ok(&[], &null_default)); - // Two results (the exact HIGH-1 attack: a second result the first-only - // summary hid) — rejected on every route. - assert!(!verbatim_results_ok(&[F64, F64], &f64_default)); - assert!(!verbatim_results_ok(&[null_ref, null_ref], &null_default)); - // Wrong scalar kind on the f64 route. - assert!(!verbatim_results_ok(&[I64], &f64_default)); - assert!(!verbatim_results_ok(&[I32], &f64_default)); - // Route/kind must agree: no ref on the f64 route, no f64 on the ref route. - assert!(!verbatim_results_ok(&[null_ref], &f64_default)); - assert!(!verbatim_results_ok(&[F64], &null_default)); - // FIX 2 belt: a NON-nullable reference is rejected on the ref route. - assert!(!verbatim_results_ok(&[non_null_ref], &null_default)); - assert!(!verbatim_results_ok(&[non_null_ref], &arr_default)); - } -} diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index bef549ee3..e39d66fdb 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -149,7 +149,18 @@ impl Wasip2ComponentEnvelopeDeclaration { /// A law-claim listing bridges carries a second corollary conjoining them, /// pinned apart from its own so an unfinished bridge cannot cost the law its /// credit. -pub const CERT_SCHEMA_VERSION: u32 = 8; +/// +/// Schema 9 states every obligation over the one plan grammar: the manifest +/// carries one `fnPlans` list (each planned function's optimized MIR body, +/// printed 1:1), the declared type layout, and obligations the wall derives +/// from the plans. Every certified export reports the one class +/// [`PLAN_CLASS`] with facets derived in the wall. Schema 9 declares no +/// law-claims and no source bridges yet; a package declaring either is +/// refused. +pub const CERT_SCHEMA_VERSION: u32 = 9; + +/// The one report class of a certified export (schema 9). +pub const PLAN_CLASS: &str = "source-plan-v1"; /// Longest a transported display string may be. Every declared-only candidate /// the manifest carries — export names, class and domain labels, runtime @@ -163,31 +174,19 @@ pub const MAX_CANDIDATE_LEN: usize = 200; /// Named theorem audited by the checker-owned witness. pub const ARTIFACT_CERTIFICATE_ROOT: &str = "AverCert.Artifact.certificate"; -/// Discharge theorem the producer names for the record projection-compute -/// face. Like every `theorem` field it is manifest-declared and informational -/// (section 4.2) — acceptance consumes the single artifact root, not per-export -/// theorem names — but it is the one signal on the render side that tells which -/// certified exports carry that face's NARROWER certified domain, so producer -/// and verifier share the literal here rather than spelling it twice. -pub const RECORD_COMPUTE_DISCHARGE_THEOREM: &str = - "AcceptanceSoundness.recordCompute_claim_discharges"; - -/// The domain disclosure `aver-cert explain` prints under a record -/// projection-compute export. Its content is section 4.3(ii): that face's -/// `StandardFace.recordComputeDomRepr` requires every Int carrier it is handed -/// — arguments and record fields alike — to be in the runtime's normal form. -pub const RECORD_COMPUTE_DOMAIN_LINE: &str = - "domain: Int leaves assumed in the runtime's normal form (canonical carriers)"; +/// The discharge theorem every certified export names (informational; the +/// acceptance consumes the single artifact root). +pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_discharges"; /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:a3c0e76722eee7a09f0fb85eab10d94657be52ffe059e541645c0a9c80167dd5"; + "sha256:ed89b143414bdff0bfadb49a49bc1e7d8c537365b69549c65f7e82fbccf73cef"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// -/// This list is verifier-owned. `aver-lang` tests its `EffectName` lowering -/// against it, so adding a compiler import cannot silently broaden what the -/// independent verifier accepts. +/// This list is verifier-owned. `aver-lang` tests its `EffectName` lowering and +/// its `aver:work/v1` job-scheduling imports against it, so adding a compiler +/// import cannot silently broaden what the independent verifier accepts. pub const WASM_GC_CAPABILITIES: &[(&str, &str)] = &[ ("aver", "console_print"), ("aver", "console_error"), @@ -277,6 +276,10 @@ pub const WASM_GC_CAPABILITIES: &[(&str, &str)] = &[ ("aver", "work_cancel"), ("aver", "work_begin"), ("aver", "work_take"), + ("aver:work/v1", "submit"), + ("aver:work/v1", "take"), + ("aver:work/v1", "task"), + ("aver:work/v1", "complete"), ]; /// Complete standard host-import surface admitted for a wasip2 embedded core. @@ -513,7 +516,7 @@ mod tests { ); assert_eq!(WASIP2_COMPONENT_ENVELOPE_SUFFIX_LEN_FIELD, "suffix_len"); assert_eq!(WASIP2_COMPONENT_ENVELOPE_KIND, "prefix-core-suffix/v1"); - assert_eq!(CERT_SCHEMA_VERSION, 8); + assert_eq!(CERT_SCHEMA_VERSION, 9); } #[test] diff --git a/aver-cert/src/lean_gate.rs b/aver-cert/src/lean_gate.rs new file mode 100644 index 000000000..0be788ade --- /dev/null +++ b/aver-cert/src/lean_gate.rs @@ -0,0 +1,957 @@ +//! Lexical gates the certificate producer and the checker share. +//! +//! Every rule here is applied by the checker to untrusted package text, and by +//! the producer to the text it is about to ship. Keeping ONE implementation is +//! the point: when the two sides disagreed (a trailing-prime identifier the +//! producer wrote and the checker refused, a token the producer kept and the +//! checker scanned for), one law or one bridge could make the checker refuse +//! the WHOLE package — byte certificate included — for a defect that should +//! have cost only that claim. With one rule, the producer drops or declines +//! exactly what the checker would refuse, before it ships. + +/// Words a package `.lean` file may not carry in code position (checker +/// stage 7), matched against every `.`-separated component of every +/// identifier token, so `Foo.elab` is refused like `elab`. +/// +/// Three groups. Commands that run code while a file elaborates or register +/// code that later elaboration runs (`run_cmd`, `initialize`, `macro`, +/// `elab`, `simproc`, …). Commands that change how LATER text parses or +/// resolves — the checker's witness re-elaborates package statements, so a +/// package that could add a notation, a mixfix operator, a binder predicate, +/// a syntax category, a unification hint, an exported alias or a scoped +/// declaration could change what a pinned statement means (`notation`, +/// `infix`, `prefix`, `binder_predicate`, `declare_syntax_cat`, `unif_hint`, +/// `export`, `scoped`, `attribute`). And the name prefix the checker reserves +/// for its own witness (`AverCertChecker`). +/// +/// `deriving` is the one word with an admitted form: the closed clause +/// [`admitted_deriving_end`] accepts. `instance` is not refused here: the +/// model needs a few, and which ones a package may declare is decided on the +/// ELABORATED instance by the checker's out-of-process audit, where a name +/// alias or a class parent projection cannot disguise the class. +pub const REFUSED_WORDS: [&str; 37] = [ + "run_cmd", + "run_elab", + "run_meta", + "run_tac", + "initialize", + "builtin_initialize", + "macro", + "macro_rules", + "elab", + "elab_rules", + "syntax", + "notation", + "infix", + "infixl", + "infixr", + "prefix", + "postfix", + "binder_predicate", + "declare_syntax_cat", + "unif_hint", + "export", + "scoped", + "unsafe", + "implemented_by", + "extern", + "attribute", + "simproc", + "dsimproc", + "simproc_decl", + "dsimproc_decl", + "builtin_simproc", + "builtin_dsimproc", + "register_simp_attr", + "register_option", + "register_builtin_option", + "deriving", + "AverCertChecker", +]; + +/// The `#`-commands a package may carry. Every other one (`#eval`, `#exit`, +/// …) is refused. +pub const ADMITTED_HASH_COMMANDS: [&str; 3] = ["#guard_msgs", "#print", "#check"]; + +/// Options a package may set, exactly: the resource limits and elaboration +/// switches the producer writes. Any `linter.` option is admitted as well (a +/// linter only reports). Nothing under `debug.` — `debug.skipKernelTC` adds +/// declarations the kernel never checked — nor any other option is admitted. +pub const ADMITTED_OPTIONS: [&str; 7] = [ + "autoImplicit", + "relaxedAutoImplicit", + "maxHeartbeats", + "maxRecDepth", + "smartUnfolding", + "synthInstance.maxSize", + "synthInstance.maxHeartbeats", +]; + +/// Namespaces a package may not `open` or enter with `namespace`: the +/// metaprogramming API (the checker's own audit is written against it) and +/// the build system. +pub const REFUSED_OPEN_ROOTS: [&str; 2] = ["Lean", "Lake"]; + +/// Whether `set_option ` is admitted. +pub fn option_admitted(name: &str) -> bool { + ADMITTED_OPTIONS.contains(&name) + || name + .strip_prefix("linter.") + .is_some_and(|rest| !rest.is_empty()) +} + +/// The first refused construct in code position, if any, named by the word or +/// symbol that opens it (`set_option` for a refused option, `open Lean` for an +/// open of a refused namespace, `#command` for a refused `#`-command other +/// than `#eval`). +/// +/// This is a fail-closed trust-boundary defense. The file is TOKENIZED — the +/// rules below look at identifier and symbol tokens, never at substrings — so +/// whitespace, line breaks and comments between the words of a construct +/// (`open Lean`, `open /- -/ Lean`, `set_option\n debug.x`) change nothing. +/// The notion of "this span is an inert string or comment" is a deliberate +/// SOUND OVER-APPROXIMATION of code: on any lexical ambiguity it defaults to +/// code, so a token Lean would elaborate is never skipped as inert. It may +/// over-reject but must never under-reject. +/// +/// Inert spans recognized (and only these): normal string literals `"..."` +/// with `\` escapes, line comments `-- ... \n`, and nested block comments +/// `/- ... -/` (which also covers the `/--`/`/-!` doc-comment openers). Char +/// literals are consumed just far enough that a `"` inside `'"'` / `'\"'` +/// cannot open a phantom string. The string parts of an `s!` interpolated +/// string are inert and its `{…}` terms are code (see +/// [`interpolated_string_end`]). Raw string prefixes (`r"`, `r#"`), other +/// interpolation prefixes (`m!"`), an interpolation the lexer cannot read +/// exactly, and unterminated strings/comments switch the rest of the file to +/// pure code: their contents are tokenized like everything else. +pub fn code_exec_token(text: &str) -> Option<&'static str> { + let chars: Vec = text.chars().collect(); + let tokens = tokenize(&chars); + first_refused(&chars, &tokens) +} + +/// The classes a `deriving` clause on a type declaration may name. +/// +/// A `deriving` clause runs the derive handler registered under each class +/// name. A package cannot register a handler (`initialize`, `elab` and every +/// other registration route stay banned), so the handlers reachable are the +/// pinned toolchain's own, and each of the ones admitted here produces +/// ordinary definitions and proofs the kernel checks — the same kind of +/// declaration a hand-written `instance`, which the gate has always admitted, +/// produces. The list is closed to what the model needs: `==` on a record or +/// a sum (`BEq`), decidable equality (`DecidableEq`), and a default value for +/// fuel-exhausted branches (`Inhabited`). +pub const DERIVING_CLASSES: [&str; 3] = ["BEq", "DecidableEq", "Inhabited"]; + +/// The classes the stand-alone `deriving instance … for T` command may name: +/// the lawfulness of a derived `BEq`, which the model's law proofs rewrite +/// `==` to `=` with. +pub const DERIVING_INSTANCE_CLASSES: [&str; 2] = ["ReflBEq", "LawfulBEq"]; + +/// Recognize an admitted `deriving` clause starting at `chars[start]` and +/// return the index of the end of its line. +/// +/// Exactly two shapes, each alone on the rest of its line: +/// +/// * `deriving C, C, …` with every `C` in [`DERIVING_CLASSES`]; +/// * `deriving instance C, C, … for T, T, …` with every `C` in +/// [`DERIVING_INSTANCE_CLASSES`] and every `T` a plain dotted identifier. +/// +/// Lean's parser is whitespace-insensitive, so the line end alone does not end +/// the clause: a `,` on a later line would add a class, and `with` would pass +/// the handler an option term. The next significant token after the line +/// (comments skipped) is therefore required to be neither; an unterminated +/// comment there is refused outright. +pub fn admitted_deriving_end(chars: &[char], start: usize) -> Option { + const KEYWORD: &str = "deriving"; + let mut at = start + KEYWORD.chars().count(); + let spaces = |at: &mut usize| { + let from = *at; + while chars.get(*at) == Some(&' ') { + *at += 1; + } + *at > from + }; + let word = |at: &mut usize| -> Option { + let from = *at; + match chars.get(*at) { + Some(first) if first.is_ascii_alphabetic() || *first == '_' => {} + _ => return None, + } + while matches!(chars.get(*at), Some(c) if c.is_ascii_alphanumeric() || *c == '_' || *c == '.' || *c == '\'') + { + *at += 1; + } + Some(chars[from..*at].iter().collect()) + }; + // `C, C, …` (or `T, T, …`), each item passing `accept`. + let list = |at: &mut usize, accept: &dyn Fn(&str) -> bool| -> Option<()> { + loop { + let item = word(at)?; + if !accept(&item) { + return None; + } + let resume = *at; + spaces(at); + if chars.get(*at) == Some(&',') { + *at += 1; + spaces(at); + continue; + } + *at = resume; + return Some(()); + } + }; + if !spaces(&mut at) { + return None; + } + let resume = at; + if word(&mut at).as_deref() == Some("instance") && spaces(&mut at) { + list(&mut at, &|class| DERIVING_INSTANCE_CLASSES.contains(&class))?; + if !spaces(&mut at) || word(&mut at).as_deref() != Some("for") || !spaces(&mut at) { + return None; + } + list(&mut at, &|name| { + crate::bridge_statement::is_plain_dotted_name(name) + })?; + } else { + at = resume; + list(&mut at, &|class| DERIVING_CLASSES.contains(&class))?; + } + spaces(&mut at); + let line_end = at; + match chars.get(at) { + None => return Some(line_end), + Some('\n') => {} + _ => return None, + } + // The clause must not continue past its line. + let mut next = at; + loop { + match chars.get(next) { + Some(c) if c.is_whitespace() => next += 1, + Some('-') if chars.get(next + 1) == Some(&'-') => { + while matches!(chars.get(next), Some(c) if *c != '\n') { + next += 1; + } + } + Some('/') if chars.get(next + 1) == Some(&'-') => { + next = block_comment_end(chars, next)?; + } + _ => break, + } + } + if chars.get(next) == Some(&',') { + return None; + } + let mut probe = next; + if word(&mut probe).as_deref() == Some("with") { + return None; + } + Some(line_end) +} + +/// Validate a package file path and return its Lean module root. A flat +/// `Store.lean` yields `Store`; a nested `Apps/Notepad/Store.lean` yields the +/// dotted `Apps.Notepad.Store`. Every `/`-separated segment must match +/// `^[A-Za-z][A-Za-z0-9_]*$` (the last one before its `.lean` suffix). The rule +/// is simultaneously the traversal guard — an accepted segment cannot be `.`, +/// `..`, empty, absolute, or anything other than a plain +/// `std::path::Component::Normal` — and the lakefile-injection guard: the +/// checker interpolates the returned root unescaped into its lakefile, so only +/// validated segments may become roots. +pub fn lean_module_root(name: &str) -> Result { + let stem = name + .strip_suffix(".lean") + .ok_or_else(|| format!("cert file `{name}` is not a Lean file"))?; + let segments: Vec<&str> = stem.split('/').collect(); + let valid = segments.iter().all(|segment| { + let mut chars = segment.chars(); + matches!(chars.next(), Some(first) if first.is_ascii_alphabetic()) + && chars.all(|character| character.is_ascii_alphanumeric() || character == '_') + }); + if valid { + Ok(segments.join(".")) + } else { + Err(format!( + "cert file name `{name}` must match ^[A-Za-z][A-Za-z0-9_]*\\.lean$ in every path segment" + )) + } +} + +/// A law-claim label or corollary: a plain dotted identifier with no primes +/// (the label is the source-level `module.fn.law` identity, and the corollary +/// its `_` flattening). +fn is_plain_unprimed_name(value: &str) -> bool { + !value.contains('\'') && crate::bridge_statement::is_plain_dotted_name(value) +} + +/// The identifier gate of one law-claim, shared by the producer and the +/// checker: `Err(field)` names the first field the checker refuses. +/// +/// The model theorem may carry the transpiler's prime escape of a Lean +/// keyword (a law of a function `at` is the theorem `at'_law_…`); the label +/// and the corollary never do, since the corollary is the label's flattening +/// and the label is a source identity. +pub fn law_claim_identifiers( + label: &str, + theorem: &str, + corollary: &str, +) -> Result<(), &'static str> { + if !is_plain_unprimed_name(label) { + return Err("label"); + } + if !crate::bridge_statement::is_plain_dotted_name(theorem) { + return Err("theorem"); + } + if !is_plain_unprimed_name(corollary) { + return Err("corollary"); + } + Ok(()) +} + +/// Index just past the closing `"` of the normal string literal opening at +/// `chars[open]`, or `None` if the string never closes before EOF (an +/// unterminated string is a lexer error in Lean; the caller then defaults to +/// scanning the region as code). +fn string_literal_end(chars: &[char], open: usize) -> Option { + let mut j = open + 1; + while j < chars.len() { + match chars[j] { + '\\' => j += 2, // the escaped character cannot close the string + '"' => return Some(j + 1), + _ => j += 1, + } + } + None +} + +/// Index just past the matching `-/` of the (nesting) block comment opening at +/// `chars[open]` (`/-`), or `None` if it never closes before EOF. +fn block_comment_end(chars: &[char], open: usize) -> Option { + let mut depth = 1usize; + let mut j = open + 2; + while j < chars.len() { + if chars[j] == '/' && j + 1 < chars.len() && chars[j + 1] == '-' { + depth += 1; + j += 2; + } else if chars[j] == '-' && j + 1 < chars.len() && chars[j + 1] == '/' { + depth -= 1; + j += 2; + if depth == 0 { + return Some(j); + } + } else { + j += 1; + } + } + None +} + +/// Index just past a char literal opening at `chars[open]` (`'`), or `None` if +/// `chars[open]` is not the start of a char literal we recognize. Recognition is +/// deliberately minimal: its only soundness duty is to consume the `"` inside +/// `'"'` and `'\"'` so it cannot open a phantom string. Every char literal that +/// can contain a raw `"` byte matches one of those two shapes; other char +/// literals (`'\n'`, `'\u{22}'`, identifier primes) may go unrecognized, which +/// is harmless because they carry no `"`. +fn char_literal_end(chars: &[char], open: usize) -> Option { + if chars.get(open + 1) == Some(&'\\') { + // '\X' (escaped single char, e.g. '\"', '\n', '\\', '\'') + if chars.get(open + 2).is_some() && chars.get(open + 3) == Some(&'\'') { + return Some(open + 4); + } + return None; + } + match chars.get(open + 1) { + Some('\'') | None => None, // "''" is not a char literal; nor is a trailing ' + Some(_) => { + // 'X' (single unescaped char, including 'X' == '"') + if chars.get(open + 2) == Some(&'\'') { + Some(open + 3) + } else { + None + } + } + } +} + +/// One token of a package file in code position. +#[derive(Debug, Clone, PartialEq, Eq)] +enum Token { + /// An identifier, dotted segments included (`Foo.bar'`), with the index + /// of its first character. + Ident(String, usize), + /// A `#`-command word (`#eval`), with its start. + Hash(String, usize), + /// Any other significant character or symbol (`@[` is one symbol), with + /// its start. + Symbol(String, usize), +} + +impl Token { + fn start(&self) -> usize { + match self { + Token::Ident(_, at) | Token::Hash(_, at) | Token::Symbol(_, at) => *at, + } + } +} + +/// A character that may start an identifier segment: ASCII letters and `_`, +/// and every non-ASCII alphabetic character (Lean admits Greek and other +/// letter-like characters). Over-admitting here only makes more text an +/// identifier, which the rules then inspect. +fn is_ident_start(c: char) -> bool { + c.is_ascii_alphabetic() || c == '_' || (!c.is_ascii() && c.is_alphabetic()) +} + +/// A character that may continue an identifier segment. Lean continues an +/// identifier with `'`, `!` and `?` too, so `prefix'` is one identifier and +/// never the refused word `prefix`. +fn is_ident_continue(c: char) -> bool { + is_ident_start(c) + || c.is_ascii_digit() + || c == '\'' + || c == '!' + || c == '?' + || (!c.is_ascii() && c.is_alphanumeric()) +} + +/// Where the `s!` interpolated string whose `"` is at `chars[open]` ends, and +/// the ranges of its `{…}` terms, or `None` when it cannot be lexed exactly. +/// +/// The string parts are inert: a `\` escapes the next character and `{` opens +/// a term. Each term runs to the `}` that closes it at brace depth zero, +/// skipping the normal strings, nested `s!` strings and char literals inside +/// it the way Lean's term parser does. A comment, a raw string or an +/// unterminated construct inside a term makes the whole string `None`, and +/// the caller then reads the rest of the file as code. +/// +/// Only `s!` is recognized. It is a token of Lean's prelude, so `s!"` always +/// opens an interpolated string; `m!` and `f!` are tokens only when their +/// modules are imported, and without them `m!"…"` is an identifier and a +/// NORMAL string, whose quotes pair differently. +fn interpolated_string_end(chars: &[char], open: usize) -> Option<(usize, Vec<(usize, usize)>)> { + let mut terms = Vec::new(); + let mut j = open + 1; + loop { + match *chars.get(j)? { + '\\' => j += 2, + '"' => return Some((j + 1, terms)), + '{' => { + let end = interpolation_term_end(chars, j + 1)?; + terms.push((j + 1, end)); + j = end + 1; + } + _ => j += 1, + } + } +} + +/// The index of the `}` closing the interpolation term that starts at +/// `start`; see [`interpolated_string_end`]. +fn interpolation_term_end(chars: &[char], start: usize) -> Option { + let mut depth = 0usize; + let mut j = start; + loop { + let c = *chars.get(j)?; + let previous = j.checked_sub(1).map(|p| chars[p]); + match c { + '{' => depth += 1, + '}' if depth == 0 => return Some(j), + '}' => depth -= 1, + '"' if is_interpolation_prefix(chars, j) => { + j = interpolated_string_end(chars, j)?.0; + continue; + } + '"' if matches!(previous, Some('r' | '#' | '!')) => return None, + '"' => { + j = string_literal_end(chars, j)?; + continue; + } + '\'' if !previous.is_some_and(is_ident_continue) => { + if let Some(end) = char_literal_end(chars, j) { + j = end; + continue; + } + } + '-' if chars.get(j + 1) == Some(&'-') => return None, + '/' if chars.get(j + 1) == Some(&'-') => return None, + _ => {} + } + j += 1; + } +} + +/// Whether the `"` at `chars[at]` opens an `s!` interpolated string: it is +/// preceded by exactly `s!`, and the `s` does not continue an identifier. +fn is_interpolation_prefix(chars: &[char], at: usize) -> bool { + at >= 2 + && chars[at - 1] == '!' + && chars[at - 2] == 's' + && !(at >= 3 && is_ident_continue(chars[at - 3])) +} + +/// Tokenize the code positions of a package file. Strings, comments and char +/// literals are skipped; everything else becomes a token. The terms of an +/// `s!` interpolated string are code and are tokenized; its string parts are +/// skipped. After a raw string prefix, an interpolation this lexer cannot +/// read exactly, or an unterminated string or comment, the rest of the file is +/// tokenized as pure code (no span is skipped any more). +fn tokenize(chars: &[char]) -> Vec { + let mut tokens = Vec::new(); + tokenize_range(chars, 0, chars.len(), &mut tokens); + tokens +} + +/// [`tokenize`] over `chars[start..n]`, appending to `tokens`. Token positions +/// are indices into the whole of `chars`. +fn tokenize_range(chars: &[char], start: usize, n: usize, tokens: &mut Vec) { + let mut pure_code = false; + let mut i = start; + while i < n { + let c = chars[i]; + if c.is_whitespace() { + i += 1; + continue; + } + if !pure_code { + if c == '"' { + // An `s!` string: its string parts are inert, its terms code. + // Any other `"` after a raw/interpolated prefix (`r"`, `r#"`, + // `m!"`) is ambiguous for a normal-string scan: default to code. + if is_interpolation_prefix(chars, i) { + match interpolated_string_end(chars, i) { + Some((end, terms)) if end <= n => { + for (term_start, term_end) in terms { + tokenize_range(chars, term_start, term_end, tokens); + } + i = end; + continue; + } + _ => pure_code = true, + } + } else if i > 0 && matches!(chars[i - 1], 'r' | '#' | '!') { + pure_code = true; + } else if let Some(end) = string_literal_end(chars, i) { + i = end; + continue; + } else { + pure_code = true; + } + } else if c == '-' && chars.get(i + 1) == Some(&'-') { + while i < n && chars[i] != '\n' { + i += 1; + } + continue; + } else if c == '/' && chars.get(i + 1) == Some(&'-') { + match block_comment_end(chars, i) { + Some(end) => { + i = end; + continue; + } + None => pure_code = true, + } + } else if c == '\'' + && !matches!(i.checked_sub(1).map(|p| chars[p]), Some(p) if is_ident_continue(p)) + && let Some(end) = char_literal_end(chars, i) + { + i = end; + continue; + } + } + if is_ident_start(c) { + let start = i; + loop { + while i < n && is_ident_continue(chars[i]) { + i += 1; + } + if i + 1 < n && chars[i] == '.' && is_ident_start(chars[i + 1]) { + i += 1; + continue; + } + break; + } + tokens.push(Token::Ident(chars[start..i].iter().collect(), start)); + continue; + } + if c.is_ascii_digit() { + while i < n && (chars[i].is_ascii_alphanumeric() || chars[i] == '_') { + i += 1; + } + continue; + } + if c == '#' && chars.get(i + 1).is_some_and(|next| is_ident_start(*next)) { + let start = i; + i += 1; + while i < n && is_ident_continue(chars[i]) { + i += 1; + } + tokens.push(Token::Hash(chars[start..i].iter().collect(), start)); + continue; + } + if c == '@' && chars.get(i + 1) == Some(&'[') { + tokens.push(Token::Symbol("@[".to_string(), i)); + i += 2; + continue; + } + tokens.push(Token::Symbol(c.to_string(), i)); + i += 1; + } +} + +/// Command keywords that end the argument list of an `open`. +const COMMAND_WORDS: [&str; 26] = [ + "def", + "theorem", + "lemma", + "abbrev", + "instance", + "structure", + "inductive", + "class", + "namespace", + "section", + "end", + "open", + "set_option", + "variable", + "universe", + "noncomputable", + "private", + "protected", + "partial", + "mutual", + "example", + "opaque", + "axiom", + "import", + "in", + "where", +]; + +/// Apply the rules to the token stream; the first refused construct wins. +fn first_refused(chars: &[char], tokens: &[Token]) -> Option<&'static str> { + let mut at = 0; + while at < tokens.len() { + match &tokens[at] { + Token::Symbol(symbol, _) => { + if symbol == "@[" { + return Some("@["); + } + if symbol == "«" || symbol == "»" { + return Some("«"); + } + } + Token::Hash(command, _) => { + if command == "#eval" { + return Some("#eval"); + } + if !ADMITTED_HASH_COMMANDS.contains(&command.as_str()) { + return Some("#command"); + } + } + Token::Ident(name, start) => { + if name == "deriving" { + // The admitted clause resumes past its own line: skip every + // token it covers. + let Some(end) = admitted_deriving_end(chars, *start) else { + return Some("deriving"); + }; + at += 1; + while tokens.get(at).is_some_and(|token| token.start() < end) { + at += 1; + } + continue; + } + if let Some(word) = name + .split('.') + .find_map(|segment| REFUSED_WORDS.iter().find(|word| **word == segment)) + { + return Some(word); + } + if name == "set_option" { + match tokens.get(at + 1) { + Some(Token::Ident(option, _)) if option_admitted(option) => {} + _ => return Some("set_option"), + } + } + // Declaring inside `Lean` or `Lake` resolves their names + // unqualified exactly as an `open` would, so the namespace is + // refused on the same roots. + if name == "namespace" + && let Some(Token::Ident(entered, _)) = tokens.get(at + 1) + { + let entered = entered.strip_prefix("_root_.").unwrap_or(entered.as_str()); + let root = entered.split('.').next().unwrap_or_default(); + if REFUSED_OPEN_ROOTS.contains(&root) { + return Some("namespace Lean"); + } + } + if name == "open" { + let mut next = at + 1; + while let Some(token) = tokens.get(next) { + match token { + Token::Ident(opened, _) => { + if COMMAND_WORDS.contains(&opened.as_str()) { + break; + } + // `open _root_.Lean` opens `Lean` too. + let opened = + opened.strip_prefix("_root_.").unwrap_or(opened.as_str()); + let root = opened.split('.').next().unwrap_or_default(); + if REFUSED_OPEN_ROOTS.contains(&root) { + return Some("open Lean"); + } + } + Token::Symbol(symbol, _) + if matches!(symbol.as_str(), "(" | ")" | ",") => {} + _ => break, + } + next += 1; + } + } + } + } + at += 1; + } + None +} + +#[cfg(test)] +mod tests { + use super::*; + + fn refused(text: &str) -> Option<&'static str> { + code_exec_token(text) + } + + #[test] + fn deriving_clauses_of_the_closed_classes_are_admitted() { + let structure = "structure P where\n a : Int\n deriving BEq, DecidableEq\n\ndef x := 0\n"; + assert_eq!(refused(structure), None); + assert_eq!( + refused("inductive O where\n | a\n deriving BEq, Inhabited, DecidableEq\n"), + None + ); + assert_eq!( + refused("deriving instance ReflBEq, LawfulBEq for Domain.Rational.Fraction\n"), + None + ); + assert_eq!(refused("deriving instance LawfulBEq for Op, Type'\n"), None); + // At end of file, with no newline. + assert_eq!(refused(" deriving BEq"), None); + } + + #[test] + fn every_other_deriving_shape_is_refused() { + for text in [ + // A class outside the closed list. + " deriving Repr, BEq\n", + " deriving BEq, ToJson\n", + " deriving Lean.ToJson\n", + // The instance classes are not type-clause classes, and back. + " deriving LawfulBEq\n", + "deriving instance BEq for T\n", + // Anything else on the line. + " deriving BEq -- note\n", + " deriving BEq; def x := 0\n", + " deriving BEq with {}\n", + "deriving instance LawfulBEq for T with x\n", + // A continuation on a later line (Lean's parser ignores the newline). + " deriving BEq\n , Evil\n", + " deriving BEq\n-- c\n/- c -/ , Evil\n", + " deriving BEq\n with { x := 1 }\n", + "deriving instance LawfulBEq for T\n, U\n", + " deriving BEq\n/- never closed", + // A trailing comma, an empty list, a bare keyword. + " deriving BEq,\n", + " deriving\n", + " deriving instance for T\n", + "deriving instance LawfulBEq\n", + ] { + assert_eq!(refused(text), Some("deriving"), "{text:?}"); + } + // The keyword stays refused in the raw-scan fallback too, and an admitted + // clause there does not hide a later token. + assert_eq!( + refused("def x := r\"a\"\n deriving Repr\n"), + Some("deriving") + ); + assert_eq!( + refused("def x := r\"a\"\n deriving BEq\n#eval 1\n"), + Some("#eval") + ); + // An admitted clause does not hide the tokens after it. + assert_eq!( + refused(" deriving BEq\n@[simp] theorem t : True := trivial\n"), + Some("@[") + ); + } + + /// The gate reads tokens, so spacing, line breaks and comments between the + /// words of a construct do not hide it. + #[test] + fn refused_constructs_are_found_whatever_the_spacing() { + for text in [ + "open Lean\n", + "open Lean in\n", + "open\tLean.Elab\n", + "open /- c -/ Lean\n", + "open Foo\n Lean\n", + "open Foo (bar) Lake\n", + "open _root_.Lean\n", + "open _root_.Lean.Elab in\n", + "open Foo _root_.Lake\n", + ] { + assert_eq!(refused(text), Some("open Lean"), "{text:?}"); + } + for text in [ + "namespace Lean\n", + "namespace Lean.Elab\n", + "namespace /- c -/\n _root_.Lean\n", + "namespace Lake\n", + "namespace _root_.Lake.Build\n", + ] { + assert_eq!(refused(text), Some("namespace Lean"), "{text:?}"); + } + for text in [ + "namespace Leaner\n", + "namespace Foo.Lean\n", + "namespace Json\n", + ] { + assert_eq!(refused(text), None, "{text:?}"); + } + for text in [ + "set_option debug.skipKernelTC true\n", + "set_option\n debug.skipKernelTC true in\ntheorem t : True := trivial\n", + "theorem t : True := by\n set_option /- x -/ debug.skipKernelTC true in\n trivial\n", + "set_option pp.all true\n", + "set_option trace.Meta.synthInstance true\n", + "set_option\n", + ] { + assert_eq!(refused(text), Some("set_option"), "{text:?}"); + } + for (text, word) in [ + ("infixl:65 \" +' \" => f\n", "infixl"), + ("local infix:50 \" ≤ \" => fun _ _ => False\n", "infix"), + ("prefix:max \"√\" => f\n", "prefix"), + ("postfix:max \"!\" => f\n", "postfix"), + ("scoped notation \"x\" => 1\n", "scoped"), + ( + "binder_predicate x \" > \" y:term => `($x > $y)\n", + "binder_predicate", + ), + ("export Foo (bar)\n", "export"), + ("declare_syntax_cat foo\n", "declare_syntax_cat"), + ("scoped instance : LE Nat := ⟨fun _ _ => False⟩\n", "scoped"), + ( + "unif_hint (n : Nat) where n =?= 0 ⊢ n + 1 =?= 1\n", + "unif_hint", + ), + ("attribute [instance] foo\n", "attribute"), + ("simproc foo (x) := fun e => pure .continue\n", "simproc"), + ("namespace AverCertChecker.AverCert\n", "AverCertChecker"), + ( + "def _root_.AverCertChecker.checked := 0\n", + "AverCertChecker", + ), + ("#exit\n", "#command"), + ("#eval 1\n", "#eval"), + ( + "theorem t : True := by\n native_decide\n@ [simp] def x := 0\n@[simp] def y := 0\n", + "@[", + ), + ] { + assert_eq!(refused(text), Some(word), "{text:?}"); + } + } + + /// What the producer writes passes: the admitted options, `#guard_msgs`, + /// `#print axioms`, opens of model namespaces, instances (their class is + /// judged on the elaborated declaration by the checker's audit), primed + /// identifiers spelling a refused word, and refused words inside strings + /// and comments. + #[test] + fn producer_text_is_admitted() { + for text in [ + "set_option maxHeartbeats 4000000\nset_option linter.unusedSimpArgs false\n", + "theorem t : True := by\n first\n | (set_option maxHeartbeats 1000000 in\n trivial)\n", + "set_option smartUnfolding false in\ndef f (x : Int) : Int := x\n", + "set_option synthInstance.maxSize 256\nset_option autoImplicit false\n", + "#guard_msgs (drop error) in\ntheorem t : True := trivial\n#print axioms t\n", + "open AverCert AverCert.Schema\nopen Classical in\ntheorem t : True := trivial\n", + "instance : Inhabited Op := ⟨Op.zero⟩\ninstance : HAdd String String String := ⟨String.append⟩\n", + "def prefix' (s : String) : String := s\ndef infix' := 0\n", + "def s := \"infix prefix open Lean set_option debug.x\"\n-- open Lean\n/- #eval -/\n", + "structure P where\n prefixLen : Nat\n deriving BEq\n", + ] { + assert_eq!(refused(text), None, "{text:?}"); + } + } + + /// An `s!` string's text is inert and its terms are code, so a refused + /// word after one (in a comment or a later string) no longer turns the + /// whole rest of the file into code, while a refused word inside a term is + /// still found. + #[test] + fn interpolated_strings_are_lexed_exactly() { + for text in [ + "def a (k : String) : String := s!\"case-{k}\"\n/-- payment-scoped filter -/\ndef b := 0\n", + "def a := s!\"[{x}] {y.z} \\{literal} {\"in\" ++ s!\"{w}\"}\"\n-- scoped\n", + "def a := s!\"{ { f := 1 }.f }\" ++ \"scoped\"\n", + "def a := s!\"{'}'}\"\n-- export\n", + ] { + assert_eq!(refused(text), None, "{text:?}"); + } + for (text, word) in [ + // A refused word inside a term is code. + ("def a := s!\"{scoped}\"\n", "scoped"), + ("def a := s!\"x {#eval 1} y\"\n", "#eval"), + // A comment or a raw string inside a term: the rest is code. + ("def a := s!\"{x -- }\"\n}\"\n-- export\n", "export"), + ("def a := s!\"{r\"}\"}\"\n-- export\n", "export"), + // Unterminated. + ("def a := s!\"{x\n-- export\n", "export"), + ("def a := s!\"abc\n-- export\n", "export"), + // Only `s!` opens an interpolated string. `m!"` is an identifier + // and a normal string without its module, whose quotes pair + // differently, so it stays code. + ("def a := m!\"{\"}\" scoped \"}\"\n", "scoped"), + ("def a := xs!\"{\"}\" scoped \"}\"\n", "scoped"), + ] { + assert_eq!(refused(text), Some(word), "{text:?}"); + } + } + + #[test] + fn module_roots_and_law_identifiers_follow_one_rule() { + assert_eq!( + lean_module_root("AverModel/Domain/Laws.lean").as_deref(), + Ok("AverModel.Domain.Laws") + ); + assert!(lean_module_root("Domain/Type'.lean").is_err()); + assert!(lean_module_root("../x.lean").is_err()); + assert_eq!(law_claim_identifiers("D.f.l", "D.f_law_l", "D_f_l"), Ok(())); + assert_eq!( + law_claim_identifiers("D.f.l", "D.none'.f_law_l", "D_f_l"), + Ok(()) + ); + assert_eq!( + law_claim_identifiers("D.at.l", "D.at'_law_l", "D_at_l"), + Ok(()) + ); + assert_eq!( + law_claim_identifiers("D.f.l", "D.'f_law_l", "D_f_l"), + Err("theorem") + ); + assert_eq!( + law_claim_identifiers("D.f'.l", "D.f_law_l", "D_f'_l"), + Err("label") + ); + assert_eq!( + law_claim_identifiers("D.f.l", "D.f law", "D_f_l"), + Err("theorem") + ); + } +} diff --git a/aver-cert/src/lib.rs b/aver-cert/src/lib.rs index 906ef5299..80e9eab8e 100644 --- a/aver-cert/src/lib.rs +++ b/aver-cert/src/lib.rs @@ -8,6 +8,7 @@ pub mod bridge_statement; pub mod format; +pub mod lean_gate; #[cfg(any(feature = "engine", feature = "verify"))] pub mod wall; diff --git a/aver-cert/src/prelude_cache.rs b/aver-cert/src/prelude_cache.rs index beade74af..059dfd352 100644 --- a/aver-cert/src/prelude_cache.rs +++ b/aver-cert/src/prelude_cache.rs @@ -82,6 +82,11 @@ impl PristineWallCache { } } +/// Whether `AVER_CERT_PRELUDE_CACHE` names a cache directory. +pub(crate) fn cache_configured() -> bool { + cache_store().is_some() +} + fn cache_store() -> Option { let value = std::env::var_os(CACHE_ENV)?; let text = value.to_string_lossy(); diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index 970f9b00c..a99556c6f 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -7,13 +7,15 @@ //! termination witness, host table, and runtime contracts. use crate::bridge_statement::{ - self, MAX_BRIDGE_STATEMENT_LEN, SourceEncoder, render_bridge_statement, + self, BridgeKind, MAX_BRIDGE_STATEMENT_LEN, SourceEncoder, render_bridge_statement, statement_is_root_qualified, }; -use crate::cache::{ArtifactBuildCache, KeyMaterial as ArtifactCacheKeyMaterial}; +use crate::cache::{ + ArtifactBuildCache, KeyMaterial as ArtifactCacheKeyMaterial, ModuleOutputCache, +}; use crate::lean_process::LeanRunner; use crate::prelude_cache::PristineWallCache; -use crate::{format, wall}; +use crate::{format, lean_gate, wall}; use colored::Colorize; use serde_json::Value; use sha2::{Digest, Sha256}; @@ -38,6 +40,10 @@ const LAW_BRIDGE_AUDIT_MARKER: &str = "AVER_LAW_BRIDGE_AUDIT"; const LAW_BRIDGED_COROLLARY_SUFFIX: &str = "_bridged"; /// Checker-owned name of the pin for manifest `sourceBridges[i]`. const BRIDGE_PIN_PREFIX: &str = "AverCertChecker.bridge_pin_"; +/// The checker's definitions of each pinned statement, elaborated alone +/// before a pin conjoins them. +const LAW_STATEMENT_PREFIX: &str = "AverCertChecker.law_statement_"; +const BRIDGE_STATEMENT_PREFIX: &str = "AverCertChecker.bridge_statement_"; /// Marker of the per-bridge axiom-audit line, read back exactly like the /// law one. const BRIDGE_AUDIT_MARKER: &str = "AVER_BRIDGE_AUDIT"; @@ -47,7 +53,19 @@ const BRIDGE_AUDIT_MARKER: &str = "AVER_BRIDGE_AUDIT"; const BRIDGE_NAMESPACE: &str = "AverCert.Bridge"; const BRIDGE_COROLLARY_SUFFIX: &str = "_certified"; const TOOLCHAIN_ROOTS: [&str; 4] = ["Init", "Lake", "Lean", "Std"]; -const FRESH_REPLAY_ARGS: [&str; 4] = ["env", "leanchecker", "--fresh", "ArtifactCertificate"]; +/// The final replay: every constant of the checker's witness module AND of +/// everything it imports — the wall, the artifact certificate, the model, the +/// law and bridge modules — re-checked by the kernel in a fresh environment. +/// A package module elaborated with the kernel check skipped therefore cannot +/// hand any credited claim an unchecked lemma. +const FRESH_REPLAY_ARGS: [&str; 4] = ["env", "leanchecker", "--fresh", WITNESS_MODULE]; +/// The checker-authored witness module (pins, the accepted root). +const WITNESS_MODULE: &str = "CheckerWitness"; +/// Report pins, `AverCertChecker.report_pin_`. +const REPORT_PIN_PREFIX: &str = "AverCertChecker.report_pin_"; +/// The audit program's decline line, and its success line. +const AUDIT_DECLINE_MARKER: &str = "AVER_AUDIT_DECLINE"; +const AUDIT_OK_MARKER: &str = "AVER_AUDIT_OK"; /// User-facing name of the `lake build` step in timeout and failure messages. const PROOF_BUILD_PHASE: &str = "certificate proof build"; @@ -57,29 +75,6 @@ const PROOF_BUILD_PHASE: &str = "certificate proof build"; pub const ARTIFACT_DECODE_LINE: &str = "artifact-check: exact bytes and manifest accepted by the checker-owned Lean predicate"; -const CODE_EXEC_TOKENS: [&str; 20] = [ - "#eval", - "run_cmd", - "run_elab", - "run_tac", - "initialize", - "builtin_initialize", - "macro", - "macro_rules", - "elab", - "elab_rules", - "syntax", - "notation", - "unsafe", - "implemented_by", - "extern", - "deriving", - "attribute", - "@[", - "«", - "open Lean", -]; - #[derive(Clone, Debug, Eq, PartialEq)] pub enum Verdict { Certified { @@ -134,15 +129,10 @@ struct CertifiedExport { name: String, policy: String, face: String, - /// Domain disclosure, present only for the faces whose certified domain is - /// narrower than "any represented value" (today: record projection-compute). - domain: Option, - manifest_face: String, - /// What the certified model IS, for the one face whose obligation model is - /// the PLAN rather than a source function: `plan`, or `plan ≡ ` once a - /// credited source-bridge identifies the two. `None` for every other face, - /// whose obligation already names the source model. - certified_model: Option, + /// What the certified model IS: under schema 9 always the export's plan + /// (its optimized MIR body), until a credited source bridge identifies + /// the plan with the transpiled source function. + certified_model: String, } /// The outcome of one declared law-claim. A claim whose pin elaborated but @@ -169,6 +159,8 @@ struct BridgeOutcome { export: String, /// Source function the bridge identifies the plan with. model: String, + /// Which of the two statement kinds the bridge claims. + kind: BridgeKind, /// The statement the CHECKER rendered from the declared structure and /// pinned the package's corollary at. `explain` prints this, never text the /// package supplied. @@ -195,16 +187,12 @@ struct TrustedReport { struct CertifiedCandidate { name: String, class: String, + /// Facets derived in the wall from the plan (`ClaimAxes.reportFacets`), + /// pinned by the witness. + facets: Vec, policy: String, policy_lean: &'static str, termination_lean: String, - dom: String, - cod: String, - /// The manifest's declared discharge theorem, read for ONE purpose: to - /// tell which exports carry the record projection-compute face, whose - /// certified domain is narrower than the other faces'. Declared-only, like - /// `dom`/`cod`, so it never reaches the CERTIFIED/CHECKED verdict line. - theorem: Option, } #[derive(Clone, Copy)] @@ -213,8 +201,8 @@ enum StringHostRole { Concat, } -/// The declared role indices in fixed `(box, add, mul, sub, toIndex, cmp, eq)` -/// order — the same order the producer's `FragHostRoleIndices` uses. +/// The declared role indices in fixed +/// `(box, add, mul, sub, toIndex, cmp, eq, divmod)` order. type HostRoleTable = ( Option, Option, @@ -223,6 +211,7 @@ type HostRoleTable = ( Option, Option, Option, + Option, ); struct ManifestIdentity { @@ -263,8 +252,10 @@ struct LawCandidate { statement: String, /// Corollary name inside `AverCert.Laws`. corollary: String, - /// Namespace to `open` so the statement elaborates (`theorem` minus its - /// last segment). + /// The model theorem's namespace (`theorem` minus its last segment). The + /// witness does NOT elaborate the statement in it; every statement is read + /// at the root. The audit refuses a package constant that this namespace, + /// or one of its prefixes, would make a bridged model's name resolve to. prefix: String, /// Indices into the declared `sourceBridges` whose statements the corollary /// conjoins — every model function this law mentions, when all of them are @@ -289,11 +280,17 @@ struct SourceBridgeCandidate { corollary: String, /// Fully qualified source function the bridge identifies the plan with. model: String, + /// Which of the two statement kinds the bridge claims. + kind: BridgeKind, /// The statement the checker RENDERED from the declared `(export, model, /// params, result)`. Nothing in the manifest contributes to it beyond /// those; the declared `theorem` name is checked and then discarded, /// because the pin cites the corollary. statement: String, + /// The declared encoders; the audit checks the records and sums they + /// read against the elaborated types. + params: Vec, + result: SourceEncoder, } struct Candidates { @@ -506,8 +503,8 @@ fn replay_args_for(mode: ReplayMode, override_binary: Option<&str>) -> Option vec![ "env".to_string(), binary.to_string(), - "ArtifactCertificate".to_string(), - "AverCert.Artifact.certificate".to_string(), + WITNESS_MODULE.to_string(), + CHECKED_ROOT.to_string(), "replay".to_string(), "8".to_string(), "32".to_string(), @@ -582,13 +579,24 @@ fn trusted_check( let candidates = read_candidates(&manifest, identity, target_envelope.map(|env| env.inner))?; let lean = LeanRunner::new(selected_wall.toolchain)?; + let stage_started = std::time::Instant::now(); let build = assemble_build( cert_dir, + &actual_hash, core_module_bytes, target_artifact_bytes, selected_wall, lean.memory_limit_mb(), )?; + // `verify` builds from the staged sources alone: a configured build cache + // is trusted local state, and the strict verdict does not rest on it. + let caches_allowed = replay_mode == ReplayMode::TrustBuiltOleans; + if !caches_allowed && crate::cache::any_cache_configured() { + eprintln!( + "note: aver-cert verify ignores AVER_CERT_DATA_CACHE and AVER_CERT_PRELUDE_CACHE; \ + only `check` uses a build cache" + ); + } let cache_pins = [("wasm_sha256", pinned_hash), ("wall_id", wall_id)]; let mut cache = ArtifactBuildCache::prepare( &build.path, @@ -597,16 +605,44 @@ fn trusted_check( pinned_sha256: &cache_pins, toolchain_version: selected_wall.toolchain.trim(), }, + caches_allowed, ); let data_cache_hit = cache.was_hit(); - let mut wall_cache = if data_cache_hit { + report_step_timing("staging and data cache", stage_started.elapsed(), &[]); + let wall_cache_started = std::time::Instant::now(); + let mut wall_cache = if data_cache_hit || !caches_allowed { PristineWallCache::disabled() } else { PristineWallCache::prepare(&build.path, selected_wall, &lean) }; + report_step_timing("wall cache restore", wall_cache_started.elapsed(), &[]); + // On a whole-package miss, restore the modules whose sources (and + // imported package modules) are unchanged; Lake revalidates each one. + let module_cache_started = std::time::Instant::now(); + let module_cache = if data_cache_hit || !caches_allowed { + ModuleOutputCache::disabled() + } else { + let wall_sources: Vec<&str> = selected_wall.sources.iter().map(|s| s.name).collect(); + ModuleOutputCache::prepare( + &build.path, + &[ + ("wall_id", wall_id), + ("toolchain_version", selected_wall.toolchain.trim()), + ("schema_version", &schema_version.to_string()), + ], + &wall_sources, + ) + }; + report_step_timing( + &format!("module cache restore ({} modules)", module_cache.restored()), + module_cache_started.elapsed(), + &[], + ); let mut data_build = run_lake(&lean, &build.path, PROOF_BUILD_PHASE, &["build"])?; - if !data_build.status.success() && (data_cache_hit || wall_cache.was_seeded()) { + if !data_build.status.success() + && (data_cache_hit || wall_cache.was_seeded() || module_cache.restored() > 0) + { if data_cache_hit { cache.invalidate(&build.path); } else { @@ -624,6 +660,7 @@ fn trusted_check( )); } cache.publish(&build.path); + module_cache.publish(&build.path); let witness = checker_witness(&actual_hash, &candidates); std::fs::write(build.path.join("CheckerWitness.lean"), witness) @@ -647,11 +684,46 @@ fn trusted_check( )); } // Every pin ELABORATED, so every declared statement is exactly what the - // package proves. What remains is per-pin credit, read from the witness's - // own audit trace: a missing or malformed line is a decline, never credit. - let laws = parse_law_audits(&elaborated.combined, &candidates.laws)?; - let bridged_laws = parse_bridged_law_audits(&elaborated.combined, &candidates.laws)?; - let source_bridges = parse_bridge_audits(&elaborated.combined, &candidates.source_bridges)?; + // package proves. The axiom audit and the audit of what the package + // declared run in the checker's own program, elaborated without the + // package; a decline there declines the package, and per-pin credit is + // read from its audit lines: a missing or malformed line is a decline, + // never credit. + std::fs::write( + build.path.join("CheckerAudit.lean"), + checker_audit(&candidates, &build.package_roots), + ) + .map_err(|error| format!("cannot write checker audit: {error}"))?; + let audited = run_lake( + &lean, + &build.path, + "artifact audit", + &["env", "lean", "--run", "CheckerAudit.lean"], + )?; + if let Some(reason) = audited + .combined + .lines() + .find_map(|line| line.trim().strip_prefix(AUDIT_DECLINE_MARKER)) + { + return Err(format!( + "certificate declined by the checker audit:{}", + display_safe(reason) + )); + } + if !audited.status.success() + || !audited + .combined + .lines() + .any(|line| line.trim() == AUDIT_OK_MARKER) + { + return Err(format!( + "the checker audit did not complete:\n{}", + tail(&audited.combined, 30) + )); + } + let laws = parse_law_audits(&audited.combined, &candidates.laws)?; + let bridged_laws = parse_bridged_law_audits(&audited.combined, &candidates.laws)?; + let source_bridges = parse_bridge_audits(&audited.combined, &candidates.source_bridges)?; if let Some(replay_args) = kernel_replay_args(replay_mode) { let replay_args: Vec<&str> = replay_args.iter().map(String::as_str).collect(); let replayed = run_lake(&lean, &build.path, "final kernel replay", &replay_args)?; @@ -670,8 +742,6 @@ fn trusted_check( name: candidate.name.clone(), policy: candidate.policy.clone(), face: report_face(candidate), - domain: record_compute_domain(candidate).map(str::to_string), - manifest_face: manifest_face(candidate), certified_model: certified_model_line(candidate, &source_bridges), }) .collect(); @@ -689,88 +759,42 @@ fn trusted_check( } /// The per-export line printed under a CERTIFIED/CHECKED verdict. Everything -/// on it must be kernel-pinned: the class is rfl-bound to -/// `StandardFace.reportEntries` by the checker witness (like the name, policy, -/// and termination). The manifest's `dom`/`cod` strings are NOT pinned by any -/// witness line, so they must never appear here — `explain` shows them, -/// explicitly labeled as manifest-declared. +/// on it is kernel-pinned: the class and the facets are bound to +/// `ClaimAxes.reportEntries` / `ClaimAxes.reportFacets` by the checker +/// witness (like the name, policy and termination). fn report_face(candidate: &CertifiedCandidate) -> String { - let label = match candidate.class.as_str() { - "expr-fragment-v1" => "expression fragment", - "verbatim-string-eq" => "String.eq leaf", - "verbatim-string-concat" => "String.concat leaf", - "adt-constructor" => "ADT constructor", - "self-recursive" => "integer recursion", - "multi-argument self-recursive" => "integer accumulator recursion", - "mutual-recursive" => "mutual integer recursion", - "verbatim-dispatch" => "verbatim dispatch", - "int-dispatch" => "integer ADT dispatch", - "field-projection" => "field projection", - "cross-function-composition" => "cross-function composition", - other => other, - }; - format!("class: {label}") + if candidate.facets.is_empty() { + format!("class: {}", candidate.class) + } else { + format!( + "class: {} ({})", + candidate.class, + candidate.facets.join(", ") + ) + } } -/// What the export's certified model IS, for the one face whose obligation -/// model is the plan rather than a source function. -/// -/// `plan` on its own is the disclosure this face has always owed a reader: the -/// theorem is about the evaluation of the declared plan. `plan ≡ ` is what -/// a CREDITED source-bridge adds — a kernel-checked theorem that the plan's -/// model is the transpiled source function at the face's own encoders. An -/// uncredited bridge says `plan` exactly like no bridge at all; credit is never -/// granted on a declaration. -/// -/// The line points at SOURCE-BRIDGES rather than calling itself kernel-checked -/// on its own. What the credit means is that the rendered statement printed -/// there is proven without foreign axioms, and that statement — its encoders -/// included — is what a reader has to read. A name plus a tick is not the -/// claim. -fn certified_model_line( - candidate: &CertifiedCandidate, - bridges: &[BridgeOutcome], -) -> Option { - record_compute_domain(candidate)?; +/// What the export's certified model IS. Schema 9 states every obligation +/// over the plan, so the line says `plan`; a credited source bridge (not +/// carried by schema 9 yet) would say `plan ≡ `. Credit is never granted +/// on a declaration. +fn certified_model_line(candidate: &CertifiedCandidate, bridges: &[BridgeOutcome]) -> String { let credited = bridges .iter() .find(|bridge| bridge.export == candidate.name && bridge.offending.is_empty()); - Some(match credited { - Some(bridge) => format!( - "model: plan ≡ {} (credited source-bridge; see SOURCE-BRIDGES)", - display_safe(&bridge.model) - ), - None => "model: plan".to_string(), - }) -} - -fn manifest_face(candidate: &CertifiedCandidate) -> String { - format!( - "manifest face (declared, not kernel-pinned): Dom {}, Cod {}", - display_safe(&candidate.dom), - display_safe(&candidate.cod) - ) -} - -/// The domain disclosure for the record projection-compute face, or `None` for -/// every other face. -/// -/// That face is the one place where canonicity — the runtime's normal form — -/// is a premise about the INPUTS and not only about the helpers: its -/// `StandardFace.recordComputeDomRepr` is built from `SReprAll`, and `SRepr` on -/// an Int carrier is "represented AND canonical", record fields included. A -/// reader of a verdict has to be told, so `explain` says it on the export's own -/// line (section 4.3 of the format spec carries the long form). -/// -/// The face is selected by the manifest's declared discharge theorem. That -/// field is informational, so a producer could in principle mislabel it; the -/// failure mode is a missing or a spurious disclosure line in `explain`, never -/// a weaker accepted claim — acceptance reads the single artifact root, and the -/// face itself is pinned in-kernel by `StandardFace.checkedFaces`. -fn record_compute_domain(candidate: &CertifiedCandidate) -> Option<&'static str> { - match candidate.theorem.as_deref() { - Some(format::RECORD_COMPUTE_DISCHARGE_THEOREM) => Some(format::RECORD_COMPUTE_DOMAIN_LINE), - _ => None, + match credited { + Some(bridge) => match bridge.kind { + BridgeKind::Exact => format!( + "model: plan ≡ {} (credited source-bridge; see SOURCE-BRIDGES)", + display_safe(&bridge.model) + ), + BridgeKind::Adequate => format!( + "model: plan ≡ {} wherever the plan returns (credited adequate \ + source-bridge, not a totality claim; see SOURCE-BRIDGES)", + display_safe(&bridge.model) + ), + }, + None => "model: plan (the export's optimized MIR body)".to_string(), } } @@ -787,6 +811,35 @@ fn bridged_law_indices(laws: &[LawCandidate]) -> Vec { .collect() } +/// `nat_lit n`: a raw natural-number literal. A pinned statement spells its +/// numerals this way so no `OfNat` instance takes part in what it means. +fn lean_nat(value: impl std::fmt::Display) -> String { + format!("(nat_lit {value})") +} + +/// An `Int` literal built from its constructors, instance-free. +fn lean_int(value: i64) -> String { + if value >= 0 { + format!("(_root_.Int.ofNat {})", lean_nat(value)) + } else { + format!( + "(_root_.Int.negSucc {})", + lean_nat(value.unsigned_abs() - 1) + ) + } +} + +/// The checker-owned witness module. +/// +/// It is PURE DATA for the kernel: theorems pinning each declared fact at a +/// checker-written statement, no `import Lean`, no command that runs code. +/// Everything it names is `_root_`-qualified — a package cannot place a +/// declaration where an unqualified name would resolve first — and every +/// numeral is a `nat_lit`, so neither a namespace nor an instance the package +/// declares takes part in what a pin says. The axiom audit of these pins runs +/// in a separate checker-owned program ([`checker_audit`]) elaborated without +/// the package, and the final fresh-environment replay replays this module and +/// everything it imports. fn checker_witness(sha: &str, candidates: &Candidates) -> String { let bridged_law_indices = bridged_law_indices(&candidates.laws); let names = lean_str_list( @@ -803,6 +856,19 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { .map(|candidate| (candidate.name.clone(), candidate.class.clone())) .collect::>(), ); + let report_facets = format!( + "[{}]", + candidates + .certified + .iter() + .map(|candidate| format!( + "(\"{}\", {})", + candidate.name, + lean_str_list(&candidate.facets) + )) + .collect::>() + .join(", ") + ); let policies = format!( "[{}]", candidates @@ -826,11 +892,20 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { let capabilities = lean_string_pair_list(&candidates.capabilities); let start = lean_option_nat(candidates.start); let roles = match candidates.host_role_table { - Some((box_role, add_role, mul_role, sub_role, to_index_role, cmp_role, eq_role)) => { + Some(( + box_role, + add_role, + mul_role, + sub_role, + to_index_role, + cmp_role, + eq_role, + divmod_role, + )) => { format!( - "some ({{ box := {}, add := {}, mul := {}, sub := {}, toIndex := {}, \ - cmp := {}, eq := {} }} : \ - CertDecode.AddSub.Roles)", + "_root_.Option.some ({{ box := {}, add := {}, mul := {}, sub := {}, toIndex := {}, \ + cmp := {}, eq := {}, divmod := {} }} : \ + _root_.CertDecode.AddSub.Roles)", lean_option_nat(box_role), lean_option_nat(add_role), lean_option_nat(mul_role), @@ -838,9 +913,10 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { lean_option_nat(to_index_role), lean_option_nat(cmp_role), lean_option_nat(eq_role), + lean_option_nat(divmod_role), ) } - None => "(none : Option CertDecode.AddSub.Roles)".to_string(), + None => "(_root_.Option.none : _root_.Option _root_.CertDecode.AddSub.Roles)".to_string(), }; let string_roles = format!( "[{}]", @@ -852,32 +928,33 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { StringHostRole::Eq => ".eq", StringHostRole::Concat => ".concat", }; - format!("({index}, {role})") + format!("({}, {role})", lean_nat(index)) }) .collect::>() .join(", ") ); let wasip2_component_envelope = lean_wasip2_component_envelope(candidates.wasip2_component_envelope); - let allowed = AXIOM_WHITELIST - .iter() - .map(|name| format!("`{name}")) - .collect::>() - .join(", "); // Law-claim surface: one type-pinning theorem per claim (built by // concatenation, never `format!`, so statement braces stay inert), the - // conditional `Laws` import, and the corollary roots the axiom audit - // walks. All fields were validated by `validate_law_candidate`. + // conditional `Laws` import, and the corollary roots the audit walks. All + // fields were validated by `validate_law_candidate`. // - // The statement is re-elaborated inside the model theorem's OWN namespace - // — the same context the package's `Laws.lean` uses — because `open - // in` at root does not reproduce it: inside `namespace Json` the - // text `Json.jsonInt` reaches the constructor `Json.Json.jsonInt`, while - // at root it reaches the accessor `Json.jsonInt` that `open` only adds an - // alias beside. The pins therefore sit OUTSIDE `namespace AverCertChecker` - // and name themselves `_root_.AverCertChecker.law_pin_`: nested inside - // it the current namespace would be `AverCertChecker.`, whose - // resolution is not the model's either. + // Every statement is elaborated at the ROOT namespace, never inside the + // model theorem's namespace. That namespace is the package's choice (the + // manifest's `theorem` minus its last segment), and Lean resolves a name + // in the innermost enclosing namespace first: inside `namespace Evil` the + // text `Tiny.addTwo` means a package constant `Evil.Tiny.addTwo` when one + // is declared, so a law whose text names the bridged `Tiny.addTwo` could + // be about a function the package slipped in. At the root, with no + // `open`, a dotted name means the root constant it spells or a field read + // of a binder the statement itself introduces. The producer writes every + // model name in a statement `_root_.`-qualified, and a law that lists + // bridges must name each bridged model exactly as `_root_.`, which + // no binder can capture. A law statement means what the MODEL's names and + // instances make it mean; the instances a package may declare at all are + // audited by `checker_audit`, which also checks that each bridged law's + // elaborated statement uses the bridged constants. let law_import = if candidates.laws.is_empty() { String::new() } else { @@ -897,16 +974,21 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { // function, and removed the credit of a claim about the source model that // the bridge plays no part in proving. let mut law_pins = String::new(); - let mut bridged_law_root_names = String::new(); for (index, law) in candidates.laws.iter().enumerate() { - if !law.prefix.is_empty() { - law_pins.push_str("namespace "); - law_pins.push_str(&law.prefix); - law_pins.push_str("\n\n"); - } - law_pins.push_str(&format!("theorem _root_.{LAW_PIN_PREFIX}{index} :\n (")); + // The statement is elaborated ALONE, as a definition of its own, and + // the pins conjoin that definition. However its text is spelled, it + // is one proposition, so it cannot re-associate the conjunction with + // `Holds` and the bridges that follow it. + law_pins.push_str(&format!( + "def _root_.{LAW_STATEMENT_PREFIX}{index} : Prop :=\n (" + )); law_pins.push_str(&law.statement); - law_pins.push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest)"); + law_pins.push_str(")\n\n"); + law_pins.push_str(&format!( + "theorem _root_.{LAW_PIN_PREFIX}{index} :\n \ + _root_.{LAW_STATEMENT_PREFIX}{index} ∧ \ + (_root_.AverCert.Schema.Holds _root_.AverCert.manifest)" + )); law_pins.push_str(" :=\n _root_.AverCert.Laws."); law_pins.push_str(&law.corollary); law_pins.push_str("\n\n"); @@ -916,68 +998,170 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { .position(|at| *at == index) .expect("every bridged law is enumerated"); law_pins.push_str(&format!( - "theorem _root_.{BRIDGED_LAW_PIN_PREFIX}{bridged_index} :\n (" + "theorem _root_.{BRIDGED_LAW_PIN_PREFIX}{bridged_index} :\n \ + _root_.{LAW_STATEMENT_PREFIX}{index} ∧ \ + (_root_.AverCert.Schema.Holds _root_.AverCert.manifest)" )); - law_pins.push_str(&law.statement); - law_pins.push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest)"); // The declared bridges, in the manifest's order. The pin's TYPE // forces the package's `_bridged` corollary to prove all of them, // and the audit that follows walks that whole closure. for bridge in &law.bridges { - law_pins.push_str(" ∧\n ("); - law_pins.push_str(&candidates.source_bridges[*bridge].statement); - law_pins.push(')'); + law_pins.push_str(&format!( + " ∧\n _root_.{BRIDGE_STATEMENT_PREFIX}{bridge}" + )); } law_pins.push_str(" :=\n _root_.AverCert.Laws."); law_pins.push_str(&law.corollary); law_pins.push_str(LAW_BRIDGED_COROLLARY_SUFFIX); law_pins.push_str("\n\n"); - bridged_law_root_names.push_str(&format!("`{BRIDGED_LAW_PIN_PREFIX}{bridged_index}, ")); - } - if !law.prefix.is_empty() { - law_pins.push_str("end "); - law_pins.push_str(&law.prefix); - law_pins.push_str("\n\n"); } } - let bridged_law_roots = bridged_law_root_names.trim_end_matches(", ").to_string(); - // Bridge pins need no namespace context: a bridge statement is rendered - // fully `_root_`-qualified by the producer and validated to be so here, so - // it means the same at the root as it does in the package's `Bridge.lean`. + // Bridge pins are at the root too: a bridge statement is rendered by the + // checker, fully `_root_`-qualified, so it means the same at the root as + // it does in the package's `Bridge.lean`. let mut bridge_pins = String::new(); for (index, bridge) in candidates.source_bridges.iter().enumerate() { bridge_pins.push_str(&format!( - "theorem _root_.{BRIDGE_PIN_PREFIX}{index} :\n (" + "def _root_.{BRIDGE_STATEMENT_PREFIX}{index} : Prop :=\n (" )); bridge_pins.push_str(&bridge.statement); - bridge_pins - .push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) :=\n _root_."); + bridge_pins.push_str(")\n\n"); + bridge_pins.push_str(&format!( + "theorem _root_.{BRIDGE_PIN_PREFIX}{index} :\n \ + _root_.{BRIDGE_STATEMENT_PREFIX}{index} ∧ \ + (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) :=\n _root_." + )); bridge_pins.push_str(&bridge.corollary); bridge_pins.push_str("\n\n"); } - // The audit walks the CHECKER-NAMED pins, never the package's bare - // corollary names: the pin's term cites `_root_.AverCert.Laws.` (so an - // `open `-shadowed decoy cannot be substituted), and auditing - // `AverCertChecker.law_pin_` covers exactly the closure the pin proved. - let law_roots = (0..candidates.laws.len()) - .map(|index| format!("`{LAW_PIN_PREFIX}{index}")) - .collect::>() - .join(", "); - let bridge_roots = (0..candidates.source_bridges.len()) - .map(|index| format!("`{BRIDGE_PIN_PREFIX}{index}")) - .collect::>() - .join(", "); - // The two audits are deliberately asymmetric. The accepted-artifact root - // THROWS: a non-whitelisted axiom under an export closure is a rejected - // certificate. A law pin instead LOGS its result, because a law that fails - // only its axiom audit loses its own credit and must not take the exports - // down with it — the pin still had to elaborate at the declared statement - // to get here, which is the integrity half of the claim. Rust reads the - // logged lines back; a pin with no line is a decline, so a parse miss can - // never become credit. + // The report pins bind every JSON report field to the Lean manifest and + // the artifact data. Each is a THEOREM the audit walks with the accepted + // root: a pin closed by `decide +kernel` through a package-declared + // decision procedure carries that procedure's axioms into the audit. + // + // Every field is read through the wall structure's own projection + // function, applied to a package constant named in full, never as a + // dotted path past a package constant. Lean resolves `A.b.c` to the + // longest prefix that is a declared constant, so + // `_root_.AverCert.manifest.subject.contracts` meant a package constant + // `AverCert.manifest.subject`, when one was declared, instead of the real + // manifest's field. A projection such as + // `_root_.AverCert.Schema.Subject.contracts` is a wall constant under a + // wall namespace, where the audit refuses every package constant except + // two kinds no reference can resolve to by a name the witness writes: a + // private constant, and an auxiliary Lean itself declares beside a + // constant (`leanAuxiliary` in `checker_audit.lean`: a reserved name, + // such as an equation lemma, realized for a constant the package does + // not declare, and, beside a package constant, an internal `_`-prefixed + // compiler constant or a numbered `proof_`, `match_` or `eq_`). + // None of those is a field name of a wall structure. + let data = "_root_.AverCert.Artifact.data"; + let manifest = "_root_.AverCert.manifest"; + let datum = + |field: &str| format!("(_root_.AverCert.AcceptedArtifact.ArtifactData.{field} {data})"); + let subject = |field: &str| { + format!( + "(_root_.AverCert.Schema.Subject.{field} \ + (_root_.AverCert.Schema.Manifest.subject {manifest}))" + ) + }; + let obligations = |field: &str| { + format!( + "_root_.List.map _root_.AverCert.Schema.Obligation.{field} \ + (_root_.AverCert.Schema.Manifest.obligations {manifest})" + ) + }; + let report_pins: Vec<(String, &str)> = vec![ + ( + format!( + "{} = _root_.AverCert.ArtifactBytes.modBytes", + datum("modBytes") + ), + "rfl", + ), + ( + format!("{} = _root_.AverCert.ArtifactBytes.modLen", datum("modLen")), + "rfl", + ), + (format!("{} = {manifest}", datum("manifest")), "rfl"), + ( + format!( + "{} = {wasip2_component_envelope}", + datum("wasip2ComponentEnvelope") + ), + "rfl", + ), + (format!("{} = \"{sha}\"", subject("artifactHash")), "rfl"), + ( + format!( + "{} = \"{}\"", + subject("artifactRoot"), + format::ARTIFACT_CERTIFICATE_ROOT + ), + "rfl", + ), + (format!("{} = {names}", obligations("export_")), "rfl"), + (format!("{} = {names}", subject("exports")), "rfl"), + ( + format!("_root_.AverCert.ClaimAxes.reportEntries {data} = {report_entries}"), + KERNEL_REPORT_PROOF, + ), + ( + format!("_root_.AverCert.ClaimAxes.reportFacets {data} = {report_facets}"), + KERNEL_REPORT_PROOF, + ), + ( + format!("{} = {policies}", obligations("policy")), + KERNEL_REPORT_PROOF, + ), + ( + format!("{} = {terminations}", obligations("termination?")), + KERNEL_REPORT_PROOF, + ), + (format!("{} = {contracts}", subject("contracts")), "rfl"), + ( + format!("{} = {declared}", subject("declaredUncertified")), + "rfl", + ), + ( + format!("{} = {capabilities}", subject("capabilities")), + "rfl", + ), + (format!("{} = {start}", subject("start")), "rfl"), + (format!("{} = {roles}", subject("hostRoleTable")), "rfl"), + ( + format!("{} = {string_roles}", subject("stringHostRoles")), + "rfl", + ), + ( + format!("{} = \"{}\"", subject("target"), candidates.target), + "rfl", + ), + ( + format!("{} = \"{}\"", subject("profile"), candidates.profile), + "rfl", + ), + ( + format!("{} = \"{}\"", subject("abi"), candidates.abi), + "rfl", + ), + ]; + assert_eq!( + report_pins.len(), + REPORT_PIN_COUNT, + "the audit walks exactly the report pins the witness writes" + ); + let mut report = String::new(); + for (index, (statement, proof)) in report_pins.iter().enumerate() { + if *proof == KERNEL_REPORT_PROOF { + report.push_str("set_option maxHeartbeats 4000000 in\n"); + } + report.push_str(&format!( + "theorem _root_.{REPORT_PIN_PREFIX}{index} :\n {statement} :=\n {proof}\n\n" + )); + } format!( "-- Authored by aver-cert; never accepted from the certificate.\n\ - import Lean\n\ import AcceptedArtifact\n\ import ArtifactBytes\n\ import Manifest\n\ @@ -989,71 +1173,255 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { set_option autoImplicit false\n\n\ {bridge_pins}\ {law_pins}\ - namespace AverCertChecker\n\n\ - example : AverCert.Artifact.data.modBytes = AverCert.ArtifactBytes.modBytes := rfl\n\ - example : AverCert.Artifact.data.modLen = AverCert.ArtifactBytes.modLen := rfl\n\ - example : AverCert.Artifact.data.manifest = AverCert.manifest := rfl\n\ - example : AverCert.Artifact.data.wasip2ComponentEnvelope = {wasip2_component_envelope} := rfl\n\n\ - example : AverCert.manifest.subject.artifactHash = \"{sha}\" := rfl\n\ - example : AverCert.manifest.subject.artifactRoot = \"{}\" := rfl\n\ - example : AverCert.manifest.obligations.map (fun o => o.export_) = {names} := rfl\n\ - example : AverCert.manifest.subject.exports = {names} := rfl\n\ - example : AverCert.StandardFace.reportEntries AverCert.Artifact.data = some {report_entries} := rfl\n\ - example : AverCert.manifest.obligations.map (fun o => o.policy) = {policies} := rfl\n\ - example : AverCert.manifest.obligations.map (fun o => o.termination?) = {terminations} := rfl\n\ - example : AverCert.manifest.subject.contracts = {contracts} := rfl\n\ - example : AverCert.manifest.subject.declaredUncertified = {declared} := rfl\n\ - example : AverCert.manifest.subject.capabilities = {capabilities} := rfl\n\ - example : AverCert.manifest.subject.start = {start} := rfl\n\ - example : AverCert.manifest.subject.hostRoleTable = {roles} := rfl\n\ - example : AverCert.manifest.subject.stringHostRoles = {string_roles} := rfl\n\ - example : AverCert.manifest.subject.target = \"{}\" := rfl\n\ - example : AverCert.manifest.subject.profile = \"{}\" := rfl\n\ - example : AverCert.manifest.subject.abi = \"{}\" := rfl\n\n\ - theorem checked : AverCert.AcceptedArtifact.accepted AverCert.Artifact.data :=\n\ - AverCert.Artifact.certificate\n\n\ - end AverCertChecker\n\n\ - open Lean in\n\ - run_cmd do\n \ - let allowed : List Lean.Name := [{allowed}]\n \ - let axioms ← Lean.collectAxioms `{CHECKED_ROOT}\n \ - for usedAxiom in axioms do\n \ - unless allowed.contains usedAxiom do\n \ - throwError s!\"non-whitelisted axiom: {{usedAxiom}}\"\n \ - let lawRoots : List Lean.Name := [{law_roots}]\n \ - for lawRoot in lawRoots do\n \ - let lawAxioms ← Lean.collectAxioms lawRoot\n \ - let offending := lawAxioms.filter (fun used => not (allowed.contains used))\n \ - if offending.isEmpty then\n \ - logInfo s!\"{LAW_AUDIT_MARKER} {{lawRoot}} ok\"\n \ - else\n \ - let names := String.intercalate \",\" (offending.toList.map (fun used => used.toString))\n \ - logInfo s!\"{LAW_AUDIT_MARKER} {{lawRoot}} axioms {{names}}\"\n \ - let bridgedLawRoots : List Lean.Name := [{bridged_law_roots}]\n \ - for bridgedLawRoot in bridgedLawRoots do\n \ - let bridgedLawAxioms ← Lean.collectAxioms bridgedLawRoot\n \ - let offending := bridgedLawAxioms.filter (fun used => not (allowed.contains used))\n \ - if offending.isEmpty then\n \ - logInfo s!\"{LAW_BRIDGE_AUDIT_MARKER} {{bridgedLawRoot}} ok\"\n \ - else\n \ - let names := String.intercalate \",\" (offending.toList.map (fun used => used.toString))\n \ - logInfo s!\"{LAW_BRIDGE_AUDIT_MARKER} {{bridgedLawRoot}} axioms {{names}}\"\n \ - let bridgeRoots : List Lean.Name := [{bridge_roots}]\n \ - for bridgeRoot in bridgeRoots do\n \ - let bridgeAxioms ← Lean.collectAxioms bridgeRoot\n \ - let offending := bridgeAxioms.filter (fun used => not (allowed.contains used))\n \ - if offending.isEmpty then\n \ - logInfo s!\"{BRIDGE_AUDIT_MARKER} {{bridgeRoot}} ok\"\n \ - else\n \ - let names := String.intercalate \",\" (offending.toList.map (fun used => used.toString))\n \ - logInfo s!\"{BRIDGE_AUDIT_MARKER} {{bridgeRoot}} axioms {{names}}\"\n", - format::ARTIFACT_CERTIFICATE_ROOT, - candidates.target, - candidates.profile, - candidates.abi, + {report}\ + theorem _root_.{CHECKED_ROOT} :\n \ + _root_.AverCert.AcceptedArtifact.accepted _root_.AverCert.Artifact.data :=\n \ + _root_.AverCert.Artifact.certificate\n" + ) +} + +/// The proof of a report pin whose left side the wall computes from every +/// plan (report entries and facets, policies, termination witnesses). The +/// kernel decides it; the elaborator's defeq check on a large module runs past +/// its default budget before it reaches the kernel, so the budget is raised +/// for the pin's declaration alone. It moves a resource limit only: the kernel still checks +/// the equation, and a runaway is stopped by the step's time limit. +const KERNEL_REPORT_PROOF: &str = "by first | decide +kernel | rfl"; + +/// Number of report pins [`checker_witness`] writes (they are numbered +/// `report_pin_0 ..`); the audit walks every one of them. +const REPORT_PIN_COUNT: usize = 21; + +/// A Lean `Name` literal list: `` [`A.b, `C] ``. Every name is checker-chosen +/// or a validated package module root. +fn lean_name_list(names: &[String]) -> String { + format!( + "[{}]", + names + .iter() + .map(|name| format!("`{name}")) + .collect::>() + .join(", ") ) } +/// The checker-owned audit program, run as `lake env lean --run +/// CheckerAudit.lean` after the witness is built. +/// +/// It is elaborated with ONLY the Lean toolchain in scope — no package module +/// is imported while its code is elaborated — so no instance, notation or +/// declaration a package ships can change what it computes. At run time it +/// loads the built witness environment and: +/// +/// 1. walks the axioms of the accepted root and of every report pin; any name +/// outside the whitelist declines the package; +/// 2. refuses a package that declares anything under the reserved +/// `AverCertChecker` prefix or a wall namespace, a name under `AverCert` +/// outside the producer's exact shapes or extending another declared +/// constant's name, any scoped instance, any parser extension +/// entry (notation, syntax, mixfix operators), or an instance outside the +/// admitted forms (see [`AUDIT_INSTANCE_RULES`]); +/// 3. logs one line per law, bridged-law and bridge pin with its own axiom +/// audit, which Rust reads back for per-claim credit. +/// +/// A decline is a line `AVER_AUDIT_DECLINE ` and a nonzero exit. +fn checker_audit(candidates: &Candidates, package_modules: &[String]) -> String { + let strict_roots: Vec = std::iter::once(CHECKED_ROOT.to_string()) + .chain((0..REPORT_PIN_COUNT).map(|index| format!("{REPORT_PIN_PREFIX}{index}"))) + .collect(); + let law_roots: Vec = (0..candidates.laws.len()) + .map(|index| format!("{LAW_PIN_PREFIX}{index}")) + .collect(); + let bridged_law_roots: Vec = (0..bridged_law_indices(&candidates.laws).len()) + .map(|index| format!("{BRIDGED_LAW_PIN_PREFIX}{index}")) + .collect(); + let bridge_roots: Vec = (0..candidates.source_bridges.len()) + .map(|index| format!("{BRIDGE_PIN_PREFIX}{index}")) + .collect(); + let law_model_uses = law_model_uses(candidates); + let allowed: Vec = AXIOM_WHITELIST + .iter() + .map(|name| name.to_string()) + .collect(); + let mut records: Vec<(String, Vec)> = Vec::new(); + let mut sums: Vec<(String, Vec<(String, usize)>)> = Vec::new(); + for bridge in &candidates.source_bridges { + for encoder in bridge.params.iter().chain(std::iter::once(&bridge.result)) { + collect_encoder_shapes(encoder, &mut records, &mut sums); + } + } + let records = format!( + "[{}]", + records + .iter() + .map(|(ty, fields)| format!("(`{ty}, {})", lean_name_list(fields))) + .collect::>() + .join(", ") + ); + let sums = format!( + "[{}]", + sums.iter() + .map(|(ty, ctors)| format!( + "(`{ty}, [{}])", + ctors + .iter() + .map(|(ctor, fields)| format!("(`{ctor}, {})", lean_nat(fields))) + .collect::>() + .join(", ") + )) + .collect::>() + .join(", ") + ); + AUDIT_TEMPLATE + .replace("@RECORDS@", &records) + .replace("@SUMS@", &sums) + .replace("@PACKAGE_MODULES@", &lean_name_list(package_modules)) + .replace( + "@WALL_ROOTS@", + &lean_name_list(&WALL_NAMESPACE_ROOTS.map(str::to_string)), + ) + .replace( + "@PACKAGE_AVERCERT_CHILDREN@", + &lean_name_list(&PACKAGE_AVERCERT_CHILDREN.map(str::to_string)), + ) + .replace( + "@PACKAGE_AVERCERT_LEAVES@", + &lean_name_list(&PACKAGE_AVERCERT_LEAVES.map(str::to_string)), + ) + .replace("@ALLOWED@", &lean_name_list(&allowed)) + .replace("@STRICT_ROOTS@", &lean_name_list(&strict_roots)) + .replace("@LAW_MODEL_USES@", &law_model_uses) + .replace("@LAW_ROOTS@", &lean_name_list(&law_roots)) + .replace("@BRIDGED_LAW_ROOTS@", &lean_name_list(&bridged_law_roots)) + .replace("@BRIDGE_ROOTS@", &lean_name_list(&bridge_roots)) + .replace("@LAW_MARKER@", LAW_AUDIT_MARKER) + .replace("@BRIDGED_LAW_MARKER@", LAW_BRIDGE_AUDIT_MARKER) + .replace("@BRIDGE_MARKER@", BRIDGE_AUDIT_MARKER) + .replace("@DECLINE_MARKER@", AUDIT_DECLINE_MARKER) + .replace("@OK_MARKER@", AUDIT_OK_MARKER) +} + +/// Per bridged law, `(law_statement_, [models of its bridges])` as a Lean +/// literal: the audit refuses a bridged law whose elaborated statement does +/// not use each of those constants. +fn law_model_uses(candidates: &Candidates) -> String { + let uses = candidates + .laws + .iter() + .enumerate() + .filter(|(_, law)| !law.bridges.is_empty()) + .map(|(index, law)| { + let models: Vec = law + .bridges + .iter() + .map(|bridge| candidates.source_bridges[*bridge].model.clone()) + .collect(); + format!( + "(`{LAW_STATEMENT_PREFIX}{index}, {})", + lean_name_list(&models) + ) + }) + .collect::>() + .join(", "); + format!("[{uses}]") +} + +/// Every record and sum a bridge encoder reads, with the members it lists +/// (names without `_root_.`; a record's fields by their last segment). Each +/// type is listed once, at its first encoder. +fn collect_encoder_shapes( + encoder: &SourceEncoder, + records: &mut Vec<(String, Vec)>, + sums: &mut Vec<(String, Vec<(String, usize)>)>, +) { + let bare = |name: &str| { + name.strip_prefix(bridge_statement::ROOT_PREFIX) + .unwrap_or(name) + .to_string() + }; + match encoder { + SourceEncoder::Int | SourceEncoder::Bool | SourceEncoder::Float | SourceEncoder::Str => {} + SourceEncoder::Record { + lean_type, fields, .. + } => { + let ty = bare(lean_type); + let listed: Vec = fields + .iter() + .map(|(accessor, _)| { + accessor + .rsplit_once('.') + .map_or(accessor.clone(), |(_, field)| field.to_string()) + }) + .collect(); + if !records.iter().any(|(seen, _)| *seen == ty) { + records.push((ty, listed)); + } + for (_, field) in fields { + collect_encoder_shapes(field, records, sums); + } + } + SourceEncoder::Sum { + lean_type, ctors, .. + } => { + let ty = bare(lean_type); + if !sums.iter().any(|(seen, _)| *seen == ty) { + sums.push(( + ty, + ctors + .iter() + .map(|(ctor, fields)| (bare(ctor), fields.len())) + .collect(), + )); + } + for field in ctors.iter().flat_map(|(_, fields)| fields) { + collect_encoder_shapes(field, records, sums); + } + } + SourceEncoder::Option(inner) + | SourceEncoder::List(inner) + | SourceEncoder::Vector(inner) => collect_encoder_shapes(inner, records, sums), + SourceEncoder::Result { ok, err } => { + collect_encoder_shapes(ok, records, sums); + collect_encoder_shapes(err, records, sums); + } + SourceEncoder::Tuple { elems, .. } => { + for elem in elems { + collect_encoder_shapes(elem, records, sums); + } + } + } +} + +/// Every namespace root the wall, the checker-rendered modules and the +/// witness declare in, apart from `AverCert` itself. The audit program +/// declines a package constant under any of them. +const WALL_NAMESPACE_ROOTS: [&str; 9] = [ + "AcceptanceSoundness", + "ArithTemplateDerisk", + "AverBits", + "AverCertChecker", + "CertDecode", + "CertModule", + "CertPrelude", + "InterpreterSequencing", + "AverCertAudit", +]; + +/// The namespaces under `AverCert` that the producer declares in (`Plans`, +/// the `Artifact*` byte facts, `Final`, `Bridge*`, `Laws`). A package name +/// under one of them is at least one component deeper; every other +/// `AverCert.*` name belongs to the wall. +const PACKAGE_AVERCERT_CHILDREN: [&str; 5] = ["Artifact", "Bridge", "Final", "Laws", "Plans"]; + +/// The manifest's two definitions, the only package constants directly under +/// `AverCert`. Nothing is declared under them: the audit refuses a package +/// name that extends a declared constant. +const PACKAGE_AVERCERT_LEAVES: [&str; 2] = ["manifest", "subject"]; + +/// The audit program's source; `@…@` placeholders are filled by +/// [`checker_audit`]. +const AUDIT_TEMPLATE: &str = include_str!("checker_audit.lean"); + fn read_manifest(cert_dir: &Path) -> Result { let path = cert_dir.join("cert-manifest.json"); let text = std::fs::read_to_string(&path) @@ -1312,18 +1680,38 @@ fn read_candidates( } _ => unreachable!(), } + if class != format::PLAN_CLASS { + return Err(format!( + "certified export `{}` reports class `{}`; schema {} has the one class `{}`", + display_safe(&name), + display_safe(&class), + format::CERT_SCHEMA_VERSION, + format::PLAN_CLASS + )); + } + let facets = entry + .get("facets") + .and_then(Value::as_array) + .ok_or_else(|| { + format!( + "certified export `{}` is missing `facets`", + display_safe(&name) + ) + })? + .iter() + .map(|facet| { + facet.as_str().map(str::to_string).ok_or_else(|| { + "cert-manifest.json `certified[].facets[]` is not a string".to_string() + }) + }) + .collect::, _>>()?; certified.push(CertifiedCandidate { name, class, + facets, policy, policy_lean, termination_lean, - dom: required_string(entry, "dom", "certified[]")?, - cod: required_string(entry, "cod", "certified[]")?, - theorem: entry - .get("theorem") - .and_then(Value::as_str) - .map(str::to_string), }); } @@ -1349,10 +1737,18 @@ fn read_candidates( "theorem", "corollary", "model", + "kind", "params", "result", ], )?; + let kind_tag = required_string(entry, "kind", &context)?; + let kind = BridgeKind::from_tag(&kind_tag).ok_or_else(|| { + format!( + "cert-manifest.json `{context}.kind` is not a bridge statement kind: `{}`", + display_safe(&kind_tag) + ) + })?; let declared_params = entry["params"] .as_array() .ok_or_else(|| format!("cert-manifest.json `{context}.params` is not an array"))?; @@ -1368,6 +1764,7 @@ fn read_candidates( theorem: required_string(entry, "theorem", &context)?, corollary: required_string(entry, "corollary", &context)?, model: required_string(entry, "model", &context)?, + kind, params, result: read_source_encoder(&entry["result"], &format!("{context}.result"))?, }; @@ -1438,6 +1835,34 @@ fn read_candidates( } law.bridges.push(at); } + // The bridges a law conjoins are those of the functions its statement + // names — all of them, in first-appearance order — and nothing else. + // A law that lists bridges names each model `_root_.`-qualified and in + // no other spelling, so the text the bridges are matched on is the + // text that elaborates to the bridged constants. + if !law.bridges.is_empty() { + let models: Vec<&str> = source_bridges + .iter() + .map(|bridge| bridge.model.as_str()) + .collect(); + if let Some(model) = + bridge_statement::law_names_model_unqualified(&law.statement, &models) + { + return Err(format!( + "law-claim `{}` names the bridged model `{}` without `_root_.`", + display_safe(&law.label), + display_safe(model) + )); + } + let mentioned = bridge_statement::law_mentioned_bridges(&law.statement, &models); + if law.bridges != mentioned { + return Err(format!( + "law-claim `{}` cites bridges that are not exactly those of the functions \ + its statement names", + display_safe(&law.label) + )); + } + } laws.push(law); } // The label→corollary underscore flattening is not injective; a duplicate @@ -1487,7 +1912,7 @@ fn read_candidates( exact_object_fields( host_roles, "hostRoleTable", - &["box", "add", "mul", "sub", "toIndex", "cmp", "eq"], + &["box", "add", "mul", "sub", "toIndex", "cmp", "eq", "divmod"], )?; let optional_index = |key: &str| -> Result, String> { match &host_roles[key] { @@ -1503,6 +1928,7 @@ fn read_candidates( optional_index("toIndex")?, optional_index("cmp")?, optional_index("eq")?, + optional_index("divmod")?, )) }; @@ -1555,30 +1981,19 @@ fn read_candidates( /// Validate one manifest law-claim before any of its fields reach the /// checker-authored Lean witness. The names must be plain dotted Lean /// identifiers, the corollary must be exactly the label's underscore -/// flattening, and the statement — which the witness re-elaborates verbatim -/// inside one `example` type — must stay a single term-position line: no -/// newline, no `:=`, no comment openers, so a crafted statement cannot -/// terminate the pin early or smuggle in a further declaration. +/// flattening, and the statement — which the witness re-elaborates verbatim, +/// at the root, as the body of its own `def law_statement_ : Prop` — must +/// stay a single term-position line: no newline, no `:=`, no comment openers, +/// no `set_option` or `open`, so a crafted statement cannot terminate the +/// definition early, smuggle in a further declaration, or change the options +/// and names it is elaborated with. fn validate_law_candidate(mut law: LawCandidate) -> Result { - let plain_dotted = |value: &str, field: &str| -> Result<(), String> { - let ok = - !value.is_empty() && value.len() <= 200 && value.split('.').all(|segment| { - let mut chars = segment.chars(); - matches!(chars.next(), Some(first) if first.is_ascii_alphabetic() || first == '_') - && chars.all(|c| c.is_ascii_alphanumeric() || c == '_') - }); - if ok { - Ok(()) - } else { - Err(format!( - "law-claim `{}` field `{field}` is not a plain dotted Lean identifier", - law.label - )) - } - }; - plain_dotted(&law.label, "label")?; - plain_dotted(&law.theorem, "theorem")?; - plain_dotted(&law.corollary, "corollary")?; + if let Err(field) = lean_gate::law_claim_identifiers(&law.label, &law.theorem, &law.corollary) { + return Err(format!( + "law-claim `{}` field `{field}` is not a plain dotted Lean identifier", + law.label + )); + } if law.corollary != law.label.replace('.', "_") { return Err(format!( "law-claim `{}` corollary `{}` is not the label's flattening", @@ -1605,7 +2020,7 @@ const MAX_STATEMENT_LEN: usize = MAX_BRIDGE_STATEMENT_LEN; /// The statement gate every pinned claim surface applies: one plain /// term-position line — no newline or other control character, no `:=`, no -/// comment opener — with balanced `()[]{}⟨⟩` whose depth never goes negative. +/// comment opener, no `set_option` or `open` — with balanced `()[]{}⟨⟩` whose depth never goes negative. /// /// Balance is load-bearing, not cosmetic: the witness wraps the statement in /// one `(...)`, so a statement whose delimiters close more than they open could @@ -1621,6 +2036,7 @@ struct RawSourceBridge { theorem: String, corollary: String, model: String, + kind: BridgeKind, params: Vec, result: SourceEncoder, } @@ -1640,22 +2056,17 @@ struct RawSourceBridge { fn validate_source_bridge_candidate( bridge: RawSourceBridge, ) -> Result { - let plain = |value: &str| { - !value.is_empty() - && value.len() <= crate::format::MAX_CANDIDATE_LEN - && value.split('.').all(|segment| { - let mut chars = segment.chars(); - matches!(chars.next(), Some(first) if first.is_ascii_alphabetic() || first == '_') - && chars.all(|c| c.is_ascii_alphanumeric() || c == '_') - }) - }; - if !plain(&bridge.export) || bridge.export.contains('.') { + // The same two identifier rules the producer applies before it declares a + // bridge (`bridge_statement`), so a model name the producer writes — the + // transpiler's trailing-prime escape of a reserved word included — is + // never one this gate refuses for the whole package. + if !bridge_statement::is_plain_export_name(&bridge.export) { return Err(format!( "source-bridge export `{}` is not a plain Lean identifier", display_safe(&bridge.export) )); } - if !plain(&bridge.model) { + if !bridge_statement::is_plain_dotted_name(&bridge.model) { return Err(format!( "source-bridge `{}` model `{}` is not a plain dotted Lean identifier", display_safe(&bridge.export), @@ -1688,7 +2099,7 @@ fn validate_source_bridge_candidate( }; return Err(format!( "source-bridge `{}` {what} encoder does not name a `_root_`-qualified type \ - and its own accessors", + and its own accessors and constructors, or exceeds the encoder caps", display_safe(&bridge.export) )); } @@ -1696,6 +2107,7 @@ fn validate_source_bridge_candidate( let statement = render_bridge_statement( &bridge.export, &bridge.model, + bridge.kind, &bridge.params, &bridge.result, ); @@ -1717,52 +2129,147 @@ fn validate_source_bridge_candidate( export: bridge.export, corollary: bridge.corollary, model: bridge.model, + kind: bridge.kind, statement, + params: bridge.params, + result: bridge.result, }) } /// Read one declared encoder. The kind set is CLOSED and matched exactly, so an -/// unknown kind — or a record entry missing its type or accessors — declines the -/// package instead of being rendered into some default shape. +/// unknown kind — or an entry missing a key, or carrying an extra one — +/// declines the package instead of being rendered into some default shape. +/// Nesting is bounded before recursion, so a hostile manifest cannot exhaust +/// the stack. fn read_source_encoder(value: &Value, context: &str) -> Result { + read_source_encoder_at(value, context, 0) +} + +fn read_source_encoder_at( + value: &Value, + context: &str, + depth: usize, +) -> Result { + if depth >= bridge_statement::MAX_ENCODER_DEPTH { + return Err(format!( + "cert-manifest.json `{context}` nests encoders deeper than {}", + bridge_statement::MAX_ENCODER_DEPTH + )); + } let kind = value .get(bridge_statement::ENCODER_KIND_KEY) .and_then(Value::as_str) .ok_or_else(|| format!("cert-manifest.json `{context}.kind` is not a string"))?; + let tid = |value: &Value| -> Result { + value + .get("tid") + .and_then(Value::as_u64) + .and_then(|t| u32::try_from(t).ok()) + .ok_or_else(|| format!("cert-manifest.json `{context}.tid` is not a type id")) + }; + let child = |key: &str| -> Result, String> { + Ok(Box::new(read_source_encoder_at( + &value[key], + &format!("{context}.{key}"), + depth + 1, + )?)) + }; + let array = |key: &str| -> Result<&Vec, String> { + value[key] + .as_array() + .ok_or_else(|| format!("cert-manifest.json `{context}.{key}` is not an array")) + }; match kind { - bridge_statement::ENCODER_KIND_INT => { + bridge_statement::ENCODER_KIND_INT + | bridge_statement::ENCODER_KIND_BOOL + | bridge_statement::ENCODER_KIND_FLOAT + | bridge_statement::ENCODER_KIND_STRING => { exact_object_fields(value, context, &[bridge_statement::ENCODER_KIND_KEY])?; - Ok(SourceEncoder::Int) - } - bridge_statement::ENCODER_KIND_BOOL => { - exact_object_fields(value, context, &[bridge_statement::ENCODER_KIND_KEY])?; - Ok(SourceEncoder::Bool) + Ok(match kind { + bridge_statement::ENCODER_KIND_INT => SourceEncoder::Int, + bridge_statement::ENCODER_KIND_BOOL => SourceEncoder::Bool, + bridge_statement::ENCODER_KIND_FLOAT => SourceEncoder::Float, + _ => SourceEncoder::Str, + }) } bridge_statement::ENCODER_KIND_RECORD => { - exact_object_fields( - value, - context, - &[ - bridge_statement::ENCODER_KIND_KEY, - bridge_statement::ENCODER_TYPE_KEY, - bridge_statement::ENCODER_FIELDS_KEY, - ], - )?; - let lean_type = required_string(value, bridge_statement::ENCODER_TYPE_KEY, context)?; - let declared = value[bridge_statement::ENCODER_FIELDS_KEY] - .as_array() - .ok_or_else(|| format!("cert-manifest.json `{context}.fields` is not an array"))?; - let mut accessors = Vec::with_capacity(declared.len()); - for field in declared { - accessors.push(field.as_str().map(str::to_string).ok_or_else(|| { - format!("cert-manifest.json `{context}.fields[]` is not a string") - })?); + exact_object_fields(value, context, &["kind", "tid", "type", "fields"])?; + let mut fields = Vec::new(); + for (index, field) in array("fields")?.iter().enumerate() { + let at = format!("{context}.fields[{index}]"); + exact_object_fields(field, &at, &["accessor", "encoder"])?; + fields.push(( + required_string(field, "accessor", &at)?, + read_source_encoder_at(&field["encoder"], &format!("{at}.encoder"), depth + 1)?, + )); } Ok(SourceEncoder::Record { - lean_type, - accessors, + tid: tid(value)?, + lean_type: required_string(value, "type", context)?, + fields, + }) + } + bridge_statement::ENCODER_KIND_SUM => { + exact_object_fields(value, context, &["kind", "tid", "type", "ctors"])?; + let mut ctors = Vec::new(); + for (index, ctor) in array("ctors")?.iter().enumerate() { + let at = format!("{context}.ctors[{index}]"); + exact_object_fields(ctor, &at, &["ctor", "fields"])?; + let mut fields = Vec::new(); + for (position, field) in ctor["fields"] + .as_array() + .ok_or_else(|| format!("cert-manifest.json `{at}.fields` is not an array"))? + .iter() + .enumerate() + { + fields.push(read_source_encoder_at( + field, + &format!("{at}.fields[{position}]"), + depth + 1, + )?); + } + ctors.push((required_string(ctor, "ctor", &at)?, fields)); + } + Ok(SourceEncoder::Sum { + tid: tid(value)?, + lean_type: required_string(value, "type", context)?, + ctors, }) } + bridge_statement::ENCODER_KIND_OPTION => { + exact_object_fields(value, context, &["kind", "elem"])?; + Ok(SourceEncoder::Option(child("elem")?)) + } + bridge_statement::ENCODER_KIND_RESULT => { + exact_object_fields(value, context, &["kind", "ok", "err"])?; + Ok(SourceEncoder::Result { + ok: child("ok")?, + err: child("err")?, + }) + } + bridge_statement::ENCODER_KIND_TUPLE => { + exact_object_fields(value, context, &["kind", "tid", "elems"])?; + let mut elems = Vec::new(); + for (index, elem) in array("elems")?.iter().enumerate() { + elems.push(read_source_encoder_at( + elem, + &format!("{context}.elems[{index}]"), + depth + 1, + )?); + } + Ok(SourceEncoder::Tuple { + tid: tid(value)?, + elems, + }) + } + bridge_statement::ENCODER_KIND_LIST => { + exact_object_fields(value, context, &["kind", "elem"])?; + Ok(SourceEncoder::List(child("elem")?)) + } + bridge_statement::ENCODER_KIND_VECTOR => { + exact_object_fields(value, context, &["kind", "elem"])?; + Ok(SourceEncoder::Vector(child("elem")?)) + } other => Err(format!( "cert-manifest.json `{context}` declares unknown source-bridge encoder kind `{}`", display_safe(other) @@ -1874,6 +2381,7 @@ fn parse_bridge_audits( outcomes.push(BridgeOutcome { export: bridge.export.clone(), model: bridge.model.clone(), + kind: bridge.kind, statement: bridge.statement.clone(), offending, }); @@ -1935,7 +2443,7 @@ fn parse_pin_audits( fn parse_termination(value: Option<&Value>, export: &str) -> Result { let Some(value) = value else { - return Ok("none".to_string()); + return Ok("_root_.Option.none".to_string()); }; let measure = value .get("measure") @@ -1956,7 +2464,9 @@ fn parse_termination(value: Option<&Value>, export: &str) -> Result Result<(), String> { for candidate in &candidates.certified { gate_candidate("certified export name", &candidate.name)?; gate_candidate("certified class", &candidate.class)?; - gate_candidate("source domain", &candidate.dom)?; - gate_candidate("source codomain", &candidate.cod)?; + for facet in &candidate.facets { + gate_candidate("certified facet", facet)?; + } } for contract in &candidates.contracts { gate_candidate("runtime contract", contract)?; @@ -2071,19 +2582,22 @@ fn is_checker_owned(name: &str, selected_wall: &wall::Wall) -> bool { name, "ArtifactBytes.lean" | "ArtifactComponentBytes.lean" + | "Module.lean" | "lakefile.lean" | "CheckerWitness.lean" + | "CheckerAudit.lean" ) } fn assemble_build( cert_dir: &Path, + artifact_hash: &str, core_module_bytes: &[u8], target_artifact_bytes: &[u8], selected_wall: &wall::Wall, memory_limit_mb: u64, ) -> Result { - let build = BuildDir::new()?; + let mut build = BuildDir::new()?; let mut roots = Vec::new(); let mut flat_files: Vec<(String, PathBuf)> = Vec::new(); let mut subdirectories: Vec<(String, PathBuf)> = Vec::new(); @@ -2128,7 +2642,10 @@ fn assemble_build( let contents = std::fs::read(path) .map_err(|error| format!("cannot read cert file {name}: {error}"))?; scan_for_code_exec(name, &contents)?; - if name == "Manifest.lean" || name == "Certificate.lean" { + if matches!( + name.as_str(), + "Manifest.lean" | "Certificate.lean" | "Bridge.lean" | "Laws.lean" + ) { collect_import_lines(&String::from_utf8_lossy(&contents), &mut admitted); } std::fs::write(build.path.join(name), contents) @@ -2176,6 +2693,7 @@ fn assemble_build( .map_err(|error| format!("cannot stage {relative}: {error}"))?; roots.push(root); } + build.package_roots = roots.clone(); for source in selected_wall.sources { std::fs::write(build.path.join(source.name), source.contents) .map_err(|error| format!("cannot stage {}: {error}", source.name))?; @@ -2199,6 +2717,15 @@ fn assemble_build( ) .map_err(|error| format!("cannot stage ArtifactComponentBytes.lean: {error}"))?; roots.push("ArtifactComponentBytes".to_string()); + // The wall's `Schema` imports `Module`, so it is rendered here from the + // hash of the bytes read, never staged from the package: no package + // module may sit inside the wall's own import closure. + std::fs::write( + build.path.join("Module.lean"), + wall::render_module(artifact_hash), + ) + .map_err(|error| format!("cannot stage Module.lean: {error}"))?; + roots.push("Module".to_string()); roots.sort(); roots.dedup(); std::fs::write( @@ -2221,22 +2748,7 @@ fn assemble_build( /// the returned root is interpolated unescaped into the checker-authored /// lakefile, so only validated segments may become roots. fn lean_module_root(name: &str) -> Result { - let stem = name - .strip_suffix(".lean") - .ok_or_else(|| format!("cert file `{name}` is not a Lean file"))?; - let segments: Vec<&str> = stem.split('/').collect(); - let valid = segments.iter().all(|segment| { - let mut chars = segment.chars(); - matches!(chars.next(), Some(first) if first.is_ascii_alphabetic()) - && chars.all(|character| character.is_ascii_alphanumeric() || character == '_') - }); - if valid { - Ok(segments.join(".")) - } else { - Err(format!( - "cert file name `{name}` must match ^[A-Za-z][A-Za-z0-9_]*\\.lean$ in every path segment" - )) - } + lean_gate::lean_module_root(name) } /// Reject a package module root that would shadow a checker-owned or @@ -2259,7 +2771,9 @@ fn reject_shadowed_root(root: &str, selected_wall: &wall::Wall) -> Result<(), St }) || [ "ArtifactBytes", "ArtifactComponentBytes", + "Module", "CheckerWitness", + "CheckerAudit", "lakefile", ] .iter() @@ -2359,219 +2873,20 @@ fn collect_nested_lean_files( } /// Reject a cert data file that carries an elaboration-executing token in -/// *code* position. This is a fail-closed trust-boundary defense: the scanner's -/// notion of "this span is an inert string or comment" is a deliberate SOUND -/// OVER-APPROXIMATION of code — on any lexical ambiguity it defaults to code and -/// scans, so a token Lean would elaborate is never skipped as inert. It may -/// over-reject (treat inert bytes as code) but must never under-reject. -/// -/// Inert spans recognized (and only these): normal string literals `"..."` with -/// `\` escapes, line comments `-- ... \n`, and nested block comments -/// `/- ... -/` (which also covers the `/--`/`/-!` doc-comment openers). Char -/// literals are consumed as code just far enough that a `"` inside `'"'` / `'\"'` -/// cannot open a phantom string. Raw / interpolated string prefixes (`r"`, -/// `r#"`, `s!"`) and unterminated strings/comments fall back to scanning the -/// remainder as pure code. +/// *code* position. The lexer and the token list live in +/// [`crate::lean_gate`], which the producer runs over its own model files +/// with the very same code, so a package the producer ships never fails this +/// gate on a file it could have left out. fn scan_for_code_exec(name: &str, contents: &[u8]) -> Result<(), String> { let text = String::from_utf8_lossy(contents); - let chars: Vec = text.chars().collect(); - if let Some(token) = find_code_exec_token(&chars) { + if let Some(token) = lean_gate::code_exec_token(&text) { return Err(format!( - "cert data file `{name}` contains elaboration-executing token `{token}`" + "cert data file `{name}` contains refused construct `{token}`" )); } Ok(()) } -/// A Lean identifier-continuation character, narrowed to ASCII alphanumerics and -/// `_`. This is intentionally an UNDER-approximation of Lean's identifier -/// alphabet: it is used only for the word-boundary check, and treating fewer -/// characters as identifier-continuation makes the scanner *more* likely to -/// reject (fail-closed), never less. -fn is_ident_continuation(c: char) -> bool { - c.is_ascii_alphanumeric() || c == '_' -} - -/// A forbidden token is treated as a whole *word* (boundary-checked so `elab` -/// does not fire inside `relabel`) exactly when every one of its bytes is an -/// ASCII identifier-continuation character. Tokens carrying punctuation, spaces, -/// or non-ASCII bytes (`#eval`, `@[`, `«`, `open Lean`) are matched as raw -/// substrings in code position, where a word boundary has no meaning. -fn token_is_word(token: &str) -> bool { - token - .bytes() - .all(|b| b.is_ascii_alphanumeric() || b == b'_') -} - -/// Returns the offending token if one starts, in code position, at `chars[i]`. -fn token_at( - tokens: &[(&'static str, Vec, bool)], - chars: &[char], - i: usize, -) -> Option<&'static str> { - for (token, needle, is_word) in tokens { - let len = needle.len(); - if i + len > chars.len() || &chars[i..i + len] != needle.as_slice() { - continue; - } - if *is_word { - let left_boundary = i == 0 || !is_ident_continuation(chars[i - 1]); - let right_boundary = i + len == chars.len() || !is_ident_continuation(chars[i + len]); - if left_boundary && right_boundary { - return Some(token); - } - } else { - return Some(token); - } - } - None -} - -/// Index just past the closing `"` of the normal string literal opening at -/// `chars[open]`, or `None` if the string never closes before EOF (an -/// unterminated string is a lexer error in Lean; the caller then defaults to -/// scanning the region as code). -fn string_literal_end(chars: &[char], open: usize) -> Option { - let mut j = open + 1; - while j < chars.len() { - match chars[j] { - '\\' => j += 2, // the escaped character cannot close the string - '"' => return Some(j + 1), - _ => j += 1, - } - } - None -} - -/// Index just past the matching `-/` of the (nesting) block comment opening at -/// `chars[open]` (`/-`), or `None` if it never closes before EOF. -fn block_comment_end(chars: &[char], open: usize) -> Option { - let mut depth = 1usize; - let mut j = open + 2; - while j < chars.len() { - if chars[j] == '/' && j + 1 < chars.len() && chars[j + 1] == '-' { - depth += 1; - j += 2; - } else if chars[j] == '-' && j + 1 < chars.len() && chars[j + 1] == '/' { - depth -= 1; - j += 2; - if depth == 0 { - return Some(j); - } - } else { - j += 1; - } - } - None -} - -/// Index just past a char literal opening at `chars[open]` (`'`), or `None` if -/// `chars[open]` is not the start of a char literal we recognize. Recognition is -/// deliberately minimal: its only soundness duty is to consume the `"` inside -/// `'"'` and `'\"'` so it cannot open a phantom string. Every char literal that -/// can contain a raw `"` byte matches one of those two shapes; other char -/// literals (`'\n'`, `'\u{22}'`, identifier primes) may go unrecognized, which -/// is harmless because they carry no `"`. -fn char_literal_end(chars: &[char], open: usize) -> Option { - if chars.get(open + 1) == Some(&'\\') { - // '\X' (escaped single char, e.g. '\"', '\n', '\\', '\'') - if chars.get(open + 2).is_some() && chars.get(open + 3) == Some(&'\'') { - return Some(open + 4); - } - return None; - } - match chars.get(open + 1) { - Some('\'') | None => None, // "''" is not a char literal; nor is a trailing ' - Some(_) => { - // 'X' (single unescaped char, including 'X' == '"') - if chars.get(open + 2) == Some(&'\'') { - Some(open + 3) - } else { - None - } - } - } -} - -/// Scan `chars[start..]` as pure code (no string/comment skipping) and return -/// the first forbidden token. Used as the default-to-code fallback for -/// unterminated strings/comments and raw/interpolated string prefixes. -fn scan_remainder_as_code( - tokens: &[(&'static str, Vec, bool)], - chars: &[char], - start: usize, -) -> Option<&'static str> { - for i in start..chars.len() { - if let Some(token) = token_at(tokens, chars, i) { - return Some(token); - } - } - None -} - -/// The context-aware core of [`scan_for_code_exec`]: a mini Lean lexer that -/// walks the file, skips inert string/comment spans, and reports the first -/// forbidden token that appears in code position. -fn find_code_exec_token(chars: &[char]) -> Option<&'static str> { - let tokens: Vec<(&'static str, Vec, bool)> = CODE_EXEC_TOKENS - .iter() - .map(|token| (*token, token.chars().collect(), token_is_word(token))) - .collect(); - let n = chars.len(); - let mut i = 0; - while i < n { - let c = chars[i]; - // Inert-span openers take priority. None of them is a token start, so - // handling them here never skips over a forbidden token. - if c == '"' { - // A `"` preceded by a raw/interpolated string prefix (`r"`, `r#"`, - // `s!"`) is lexically ambiguous for a normal-string scan; default to - // code and scan the remainder rather than risk a desynced skip. - if i > 0 && matches!(chars[i - 1], 'r' | '#' | '!') { - return scan_remainder_as_code(&tokens, chars, i); - } - match string_literal_end(chars, i) { - Some(end) => { - i = end; - continue; - } - None => return scan_remainder_as_code(&tokens, chars, i), - } - } - if c == '-' && chars.get(i + 1) == Some(&'-') { - // Line comment through end of line (or EOF). - let mut j = i + 2; - while j < n && chars[j] != '\n' { - j += 1; - } - i = j; - continue; - } - if c == '/' && chars.get(i + 1) == Some(&'-') { - match block_comment_end(chars, i) { - Some(end) => { - i = end; - continue; - } - None => return scan_remainder_as_code(&tokens, chars, i), - } - } - // A `'` that opens a char literal is consumed; otherwise it is an - // identifier prime and falls through as ordinary code. - if c == '\'' - && let Some(end) = char_literal_end(chars, i) - { - i = end; - continue; - } - if let Some(token) = token_at(&tokens, chars, i) { - return Some(token); - } - i += 1; - } - None -} - /// The generated lakefile carries the checker's Lean heap ceiling into every /// `lake build` worker via `moreLeanArgs`: Lake 4.32 ignores `LEAN_OPTS`, so /// this is the only channel that reaches build-spawned lean processes. @@ -2609,18 +2924,24 @@ fn lean_string_pair_list(items: &[(String, String)]) -> String { } fn lean_option_nat(value: Option) -> String { - value.map_or_else(|| "none".to_string(), |value| format!("some {value}")) + value.map_or_else( + || "_root_.Option.none".to_string(), + |value| format!("(_root_.Option.some {})", lean_nat(value)), + ) } fn lean_wasip2_component_envelope( value: Option, ) -> String { value.map_or_else( - || "(none : Option AverCert.Wasip2Envelope.ComponentEnvelope)".to_string(), + || "(_root_.Option.none : _root_.Option _root_.AverCert.Wasip2Envelope.ComponentEnvelope)" + .to_string(), |value| { format!( - "some ({{ prefixLen := {}, embeddedCoreModuleLen := {}, suffixLen := {} }} : AverCert.Wasip2Envelope.ComponentEnvelope)", - value.prefix_len, value.embedded_core_module_len, value.suffix_len + "_root_.Option.some ({{ prefixLen := {}, embeddedCoreModuleLen := {}, suffixLen := {} }} : _root_.AverCert.Wasip2Envelope.ComponentEnvelope)", + lean_nat(value.prefix_len), + lean_nat(value.embedded_core_module_len), + lean_nat(value.suffix_len) ) }, ) @@ -2632,6 +2953,9 @@ fn sha256_hex(bytes: &[u8]) -> String { struct BuildDir { path: PathBuf, + /// Module roots of the staged certificate package (never wall or + /// checker-authored modules). + package_roots: Vec, } impl BuildDir { @@ -2650,7 +2974,10 @@ impl BuildDir { builder .create(&path) .map_err(|error| format!("cannot create checker build dir: {error}"))?; - Ok(Self { path }) + Ok(Self { + path, + package_roots: Vec::new(), + }) } } @@ -2711,9 +3038,11 @@ fn run_lake( ) -> Result { // Any step failure — including a timeout — fails the whole verify/check // closed; only the opt-in prelude cache may downgrade a step error. + let started = std::time::Instant::now(); let output = lean .run_lake(build_dir, phase, arguments) .map_err(|error| error.to_string())?; + report_step_timing(phase, started.elapsed(), &output.stdout); Ok(LakeOut { status: output.status, combined: format!( @@ -2724,6 +3053,21 @@ fn run_lake( }) } +/// Opt-in developer timing trace (`AVER_CERT_TIMINGS=1`): one stderr line per +/// Lean step, plus Lake's own per-module build lines. Diagnostic only; it +/// reads nothing the verdict depends on. +fn report_step_timing(phase: &str, elapsed: std::time::Duration, stdout: &[u8]) { + if std::env::var_os("AVER_CERT_TIMINGS").is_none_or(|value| value.is_empty() || value == "0") { + return; + } + for line in String::from_utf8_lossy(stdout).lines() { + if line.contains("Built ") || line.contains("Replayed ") { + eprintln!("aver-cert timing: {}", line.trim()); + } + } + eprintln!("aver-cert timing: {phase}: {:.1}s", elapsed.as_secs_f64()); +} + fn tail(text: &str, lines: usize) -> String { let all = text.lines().collect::>(); all[all.len().saturating_sub(lines)..].join("\n") @@ -2799,6 +3143,12 @@ fn display_safe(value: &str) -> String { .collect() } +/// Printed by `explain` under every certificate with a certified export. +const INT_INPUT_DOMAIN_LINE: &str = "domain: every Int input (an argument, or a field, \ + element or payload inside one) is assumed to be a canonical carrier word, the \ + runtime's normal form; a non-canonical word is outside the certified domain. Every \ + Int result is proved canonical."; + pub fn explain(artifact: &Path, cert_dir: &Path) -> Result { let report = trusted_check(artifact, cert_dir, ReplayMode::Fresh)?; println!("{}", "Artifact certificate".bold()); @@ -2817,14 +3167,15 @@ pub fn explain(artifact: &Path, cert_dir: &Path) -> Result println!(" {}", export.name.bold()); println!(" policy: {}", export.policy); println!(" {}", export.face); - if let Some(domain) = export.domain.as_deref() { - println!(" {domain}"); - } - if let Some(model) = export.certified_model.as_deref() { - println!(" {model}"); - } - println!(" {}", export.manifest_face); - } + println!(" {}", export.certified_model); + } + // The one assumption every certified theorem makes about its INPUTS rather + // than about a helper: the wall's value relation reads an Int through + // `CanonRepr`, so an Int carrier word the host passes in is taken to be in + // the runtime's normal form. It is the same for every export, so it is + // stated once. + println!("\n{}", "Certified domain".yellow().bold()); + println!(" {INT_INPUT_DOMAIN_LINE}"); if !report.contracts.is_empty() { println!("\n{}", "Runtime contracts".yellow().bold()); for contract in report.contracts { @@ -2871,9 +3222,10 @@ pub fn explain(artifact: &Path, cert_dir: &Path) -> Result ) }; println!( - " {} ≡ {} [{credit}]", + " {} ≡ {} ({}) [{credit}]", display_safe(&bridge.export).bold(), - display_safe(&bridge.model) + display_safe(&bridge.model), + bridge.kind.tag() ); println!(" {}", display_safe(&bridge.statement)); } @@ -3043,21 +3395,30 @@ mod tests { theorem: format!("{BRIDGE_NAMESPACE}.{export}"), corollary: format!("{BRIDGE_NAMESPACE}.{export}{BRIDGE_COROLLARY_SUFFIX}"), model: format!("Domain.{export}"), + kind: BridgeKind::Exact, params: vec![SourceEncoder::Int], result: SourceEncoder::Int, } } - fn fraction_encoder() -> SourceEncoder { + fn record_encoder(accessors: &[&str]) -> SourceEncoder { SourceEncoder::Record { + tid: 0, lean_type: "_root_.Domain.Fraction".to_string(), - accessors: vec![ - "_root_.Domain.Fraction.top".to_string(), - "_root_.Domain.Fraction.bottom".to_string(), - ], + fields: accessors + .iter() + .map(|accessor| (accessor.to_string(), SourceEncoder::Int)) + .collect(), } } + fn fraction_encoder() -> SourceEncoder { + record_encoder(&[ + "_root_.Domain.Fraction.top", + "_root_.Domain.Fraction.bottom", + ]) + } + fn bridge_candidates(exports: &[&str]) -> Vec { exports .iter() @@ -3158,18 +3519,60 @@ mod tests { // against whatever namespaces the package declares. let mut bare_names = raw_bridge("one"); bare_names.result = SourceEncoder::Record { + tid: 0, lean_type: "Domain.Fraction".to_string(), - accessors: vec!["Domain.Fraction.top".to_string()], + fields: vec![("Domain.Fraction.top".to_string(), SourceEncoder::Int)], }; assert!(validate_source_bridge_candidate(bare_names).is_err()); // An accessor of some other type is not a field of the declared one. let mut foreign_accessor = raw_bridge("one"); - foreign_accessor.result = SourceEncoder::Record { - lean_type: "_root_.Domain.Fraction".to_string(), - accessors: vec!["_root_.Other.Record.top".to_string()], - }; + foreign_accessor.result = record_encoder(&["_root_.Other.Record.top"]); assert!(validate_source_bridge_candidate(foreign_accessor).is_err()); + + // So is a constructor of some other sum. + let mut foreign_ctor = raw_bridge("one"); + foreign_ctor.params = vec![SourceEncoder::Sum { + tid: 1, + lean_type: "_root_.Domain.Op".to_string(), + ctors: vec![("_root_.Domain.Tag.a".to_string(), Vec::new())], + }]; + assert!(validate_source_bridge_candidate(foreign_ctor).is_err()); + } + + /// The transpiler escapes a source function named after a Lean keyword + /// with a trailing prime (`none` becomes `none'`), and the producer names + /// that model in its bridge entry. The checker used to refuse the primed + /// name as "not a plain dotted identifier" — for the whole package, since a + /// refused entry fails candidate parsing. Producer and checker now apply + /// the one rule of `bridge_statement`, which admits the escape in every + /// segment and nothing else. + #[test] + fn a_keyword_escaped_model_name_passes_the_bridge_gate() { + let mut escaped = raw_bridge("Domain_Policy_none"); + escaped.model = "Domain.Policy.none'".to_string(); + let candidate = + validate_source_bridge_candidate(escaped).expect("the escaped model name is admitted"); + assert!( + candidate.statement.contains("_root_.Domain.Policy.none'"), + "{}", + candidate.statement + ); + for refused in [ + "Domain.Policy.'none", + "Domain.Policy..none", + "Domain.Policy.none\u{ab}", + ] { + let mut entry = raw_bridge("Domain_Policy_none"); + entry.model = refused.to_string(); + assert!( + validate_source_bridge_candidate(entry).is_err(), + "{refused}" + ); + } + let mut primed_export = raw_bridge("Domain_Policy_none'"); + primed_export.model = "Domain.Policy.none'".to_string(); + assert!(validate_source_bridge_candidate(primed_export).is_err()); } /// The defect this surface was reshaped to close: a package used to declare @@ -3190,20 +3593,28 @@ mod tests { render_bridge_statement( "Domain_Rational_plus", "Domain.Rational.plus", + BridgeKind::Exact, &[fraction_encoder(), fraction_encoder()], &fraction_encoder(), ), "the pinned statement is the renderer's output and nothing else" ); assert!( - candidate.statement.starts_with('∀') - && candidate.statement.contains( - "_root_.AverCert.StandardFace.recordComputeModel \ - _root_.AverCert.Plans.Domain_Rational_plusPlan.body" - ), - "the claim's left-hand side is the export's own plan: {}", + candidate.statement.starts_with( + "_root_.AverCert.GrammarBridge.Exact _root_.AverCert.manifest \ + \"Domain_Rational_plus\"" + ), + "the claim's left-hand side is the export's own obligation model: {}", candidate.statement ); + // The weaker kind renders a different claim too. + let mut adequate = raw_bridge("Domain_Rational_plus"); + adequate.model = "Domain.Rational.plus".to_string(); + adequate.kind = BridgeKind::Adequate; + adequate.params = vec![fraction_encoder(), fraction_encoder()]; + adequate.result = fraction_encoder(); + let adequate = validate_source_bridge_candidate(adequate).expect("it still validates"); + assert_ne!(adequate.statement, candidate.statement); // Naming a different export renders a different claim, so the pin no // longer has the package corollary's type — a decline, not a credit. let mut renamed = raw_bridge("Domain_Rational_minus"); @@ -3213,13 +3624,10 @@ mod tests { let renamed = validate_source_bridge_candidate(renamed).expect("it still validates"); assert_ne!(renamed.statement, candidate.statement); // So does permuting a record's accessors. - let permuted = SourceEncoder::Record { - lean_type: "_root_.Domain.Fraction".to_string(), - accessors: vec![ - "_root_.Domain.Fraction.bottom".to_string(), - "_root_.Domain.Fraction.top".to_string(), - ], - }; + let permuted = record_encoder(&[ + "_root_.Domain.Fraction.bottom", + "_root_.Domain.Fraction.top", + ]); let mut swapped = raw_bridge("Domain_Rational_plus"); swapped.model = "Domain.Rational.plus".to_string(); swapped.params = vec![permuted, fraction_encoder()]; @@ -3244,25 +3652,59 @@ mod tests { read_source_encoder( &serde_json::json!({ "kind": "record", + "tid": 0, "type": "_root_.Domain.Fraction", - "fields": ["_root_.Domain.Fraction.top"], + "fields": [{"accessor": "_root_.Domain.Fraction.top", "encoder": {"kind": "int"}}], }), "e" ) .unwrap(), - SourceEncoder::Record { - lean_type: "_root_.Domain.Fraction".to_string(), - accessors: vec!["_root_.Domain.Fraction.top".to_string()], - } + record_encoder(&["_root_.Domain.Fraction.top"]) ); + // Every encoder the producer writes reads back to itself. + let op = SourceEncoder::Sum { + tid: 1, + lean_type: "_root_.Domain.Op".to_string(), + ctors: vec![ + ("_root_.Domain.Op.add".to_string(), vec![SourceEncoder::Int]), + ("_root_.Domain.Op.zero".to_string(), Vec::new()), + ], + }; + for encoder in [ + SourceEncoder::Float, + SourceEncoder::Str, + fraction_encoder(), + op.clone(), + SourceEncoder::Option(Box::new(op.clone())), + SourceEncoder::Result { + ok: Box::new(SourceEncoder::Int), + err: Box::new(SourceEncoder::Str), + }, + SourceEncoder::Tuple { + tid: 2, + elems: vec![SourceEncoder::Int, fraction_encoder()], + }, + SourceEncoder::List(Box::new(SourceEncoder::Bool)), + SourceEncoder::Vector(Box::new(SourceEncoder::Int)), + ] { + let json: Value = serde_json::from_str(&encoder.to_json()).expect("valid JSON"); + assert_eq!(read_source_encoder(&json, "e").unwrap(), encoder); + } + let mut deep = serde_json::json!({"kind": "int"}); + for _ in 0..bridge_statement::MAX_ENCODER_DEPTH { + deep = serde_json::json!({"kind": "option", "elem": deep}); + } for bad in [ - serde_json::json!({"kind": "float"}), - serde_json::json!({"kind": "string"}), + serde_json::json!({"kind": "decimal"}), serde_json::json!({}), serde_json::json!({"kind": "int", "type": "_root_.Domain.Fraction"}), - serde_json::json!({"kind": "record", "type": "_root_.Domain.Fraction"}), - serde_json::json!({"kind": "record", "type": "_root_.Domain.Fraction", "fields": "top"}), - serde_json::json!({"kind": "record", "type": "_root_.Domain.Fraction", "fields": [7]}), + serde_json::json!({"kind": "record", "tid": 0, "type": "_root_.Domain.Fraction"}), + serde_json::json!({"kind": "record", "tid": 0, "type": "_root_.Domain.Fraction", "fields": "top"}), + serde_json::json!({"kind": "record", "tid": 0, "type": "_root_.Domain.Fraction", "fields": [7]}), + serde_json::json!({"kind": "record", "type": "_root_.Domain.Fraction", "fields": []}), + serde_json::json!({"kind": "option"}), + serde_json::json!({"kind": "sum", "tid": 1, "type": "_root_.Domain.Op", "ctors": [{"ctor": "_root_.Domain.Op.a"}]}), + deep, ] { assert!( read_source_encoder(&bad, "e").is_err(), @@ -3280,6 +3722,7 @@ mod tests { "theorem", "corollary", "model", + "kind", "params", "result", ]; @@ -3288,6 +3731,7 @@ mod tests { "theorem": "AverCert.Bridge.one", "corollary": "AverCert.Bridge.one_certified", "model": "Domain.one", + "kind": "exact", "params": [], "result": {"kind": "int"}, }); @@ -3309,12 +3753,14 @@ mod tests { BridgeOutcome { export: "one".to_string(), model: "Domain.one".to_string(), + kind: BridgeKind::Exact, statement: "_root_.One".to_string(), offending: Vec::new(), }, BridgeOutcome { export: "two".to_string(), model: "Domain.two".to_string(), + kind: BridgeKind::Adequate, statement: "_root_.Two".to_string(), offending: vec!["sorryAx".to_string()], }, @@ -3478,46 +3924,26 @@ mod tests { #[test] fn report_face_prints_only_kernel_pinned_facts() { let candidate = CertifiedCandidate { - name: "addOne".to_string(), - class: "expr-fragment-v1".to_string(), - policy: "simulatesModel".to_string(), - policy_lean: ".simulatesModel", + name: "sumTo".to_string(), + class: format::PLAN_CLASS.to_string(), + facets: vec!["recursive".to_string(), "calls".to_string()], + policy: "simulatesModelTotally".to_string(), + policy_lean: ".simulatesModelTotally", termination_lean: "none".to_string(), - dom: "List Int".to_string(), - cod: "Int".to_string(), - theorem: Some("AcceptanceSoundness.exprFragment_claim_discharges".to_string()), }; - assert_eq!(report_face(&candidate), "class: expression fragment"); assert_eq!( - manifest_face(&candidate), - "manifest face (declared, not kernel-pinned): Dom List Int, Cod Int" + report_face(&candidate), + "class: source-plan-v1 (recursive, calls)" ); - // The generic face is unconditional over represented carriers, so it - // carries no domain restriction line. - assert_eq!(record_compute_domain(&candidate), None); - } - - /// The record projection-compute face is the one whose certified domain is - /// narrower — its inputs AND its record fields are assumed canonical — so - /// `explain` must say so on that export's line and only on that one. - #[test] - fn only_the_record_compute_face_discloses_a_narrower_domain() { - let mut candidate = CertifiedCandidate { - name: "Domain_Rational_plus".to_string(), - class: "expr-fragment-v1".to_string(), - policy: "simulatesModel".to_string(), - policy_lean: ".simulatesModel", - termination_lean: "none".to_string(), - dom: "Rational x Rational".to_string(), - cod: "Rational".to_string(), - theorem: Some(format::RECORD_COMPUTE_DISCHARGE_THEOREM.to_string()), - }; assert_eq!( - record_compute_domain(&candidate), - Some(format::RECORD_COMPUTE_DOMAIN_LINE) + certified_model_line(&candidate, &[]), + "model: plan (the export's optimized MIR body)" ); - candidate.theorem = None; - assert_eq!(record_compute_domain(&candidate), None); + let bare = CertifiedCandidate { + facets: Vec::new(), + ..candidate + }; + assert_eq!(report_face(&bare), "class: source-plan-v1"); } #[test] @@ -3597,6 +4023,43 @@ mod tests { assert_eq!(admitted.len(), 3); } + /// The audit's namespace rule is only as good as its list of wall roots: + /// every namespace a wall file opens at the top level is on it. + #[test] + fn audit_namespace_roots_cover_every_wall_namespace() { + let wall = wall::resolve(wall::current_id()).expect("embedded wall resolves"); + for source in wall.sources { + // Blocks closed by a bare or named `end`: namespaces, sections and + // `mutual` groups. Only a namespace opened outside all of them + // names a root. + let mut depth = 0usize; + for line in source.contents.lines() { + let words: Vec<&str> = line.split_whitespace().collect(); + match words.as_slice() { + ["namespace", name, ..] => { + if depth == 0 { + let root = name.split('.').next().unwrap(); + assert!( + root == "AverCert" || WALL_NAMESPACE_ROOTS.contains(&root), + "{} opens namespace {name}, whose root the audit does not reserve", + source.name + ); + } + depth += 1; + } + ["section", ..] | ["noncomputable", "section", ..] | ["mutual", ..] => { + depth += 1 + } + ["end", ..] => depth = depth.saturating_sub(1), + _ => {} + } + } + } + let rendered = wall::render_module(&"0".repeat(64)); + assert!(rendered.contains("namespace CertModule")); + assert!(WALL_NAMESPACE_ROOTS.contains(&"CertModule")); + } + #[test] fn nested_roots_shadowing_reserved_prefixes_are_rejected() { let wall = wall::resolve(wall::current_id()).expect("embedded wall resolves"); @@ -3608,6 +4071,8 @@ mod tests { assert!(reject_shadowed_root("Schema.Sub", wall).is_err()); assert!(reject_shadowed_root("ArtifactBytes.Decoy", wall).is_err()); assert!(reject_shadowed_root("ArtifactComponentBytes.Decoy", wall).is_err()); + assert!(reject_shadowed_root("Module", wall).is_err()); + assert!(reject_shadowed_root("Module.Decoy", wall).is_err()); assert!(reject_shadowed_root("CheckerWitness.X.Y", wall).is_err()); // A reserved name in non-prefix position does not shadow the import. assert!(reject_shadowed_root("Apps.Schema", wall).is_ok()); @@ -3858,8 +4323,16 @@ mod tests { #[test] fn artifact_bytes_are_little_endian_nat() { let rendered = wall::render_artifact_bytes(&[0x00, 0x61, 0x73, 0x6d]); - assert!(rendered.contains("def modBytes : Nat := 0x6d736100")); + assert!(rendered.contains("noncomputable def modBytes : Nat :=\n 0x6d736100\n")); assert!(rendered.contains("def modLen : Nat := 4")); + // Past one numeral chunk, each chunk sits at its byte offset. + let mut long = vec![0u8; 1025]; + long[0] = 0x01; + long[1024] = 0xab; + let rendered = wall::render_artifact_bytes(&long); + assert!(rendered.contains("noncomputable def modBytes : Nat :=\n 0x")); + assert!(rendered.contains("01 |||\n (0xab <<< 8192)\n")); + assert!(rendered.contains("def modLen : Nat := 1025")); } #[test] @@ -3958,4 +4431,214 @@ mod tests { let err = scan("elab_rules foo").unwrap_err(); assert!(err.contains("elab_rules"), "{err}"); } + + fn witness_candidates() -> Candidates { + let mut laws = law_candidates(&["Domain.plus.comm"]); + laws[0].bridges = vec![0]; + let mut bridge = raw_bridge("Domain_plus"); + bridge.model = "Domain.plus".to_string(); + bridge.params = vec![fraction_encoder(), fraction_encoder()]; + bridge.result = fraction_encoder(); + Candidates { + certified: vec![CertifiedCandidate { + name: "Domain_plus".to_string(), + class: format::PLAN_CLASS.to_string(), + facets: vec!["recursive".to_string()], + policy: "simulatesModelTotally".to_string(), + policy_lean: ".simulatesModelTotally", + termination_lean: parse_termination( + Some(&serde_json::json!({ + "measure": {"kind": "intNatAbs", "param_index": 1}, + "descent": -3 + })), + "Domain_plus", + ) + .unwrap(), + }], + laws, + source_bridges: vec![validate_source_bridge_candidate(bridge).unwrap()], + contracts: vec!["c".to_string()], + declared_uncertified: Vec::new(), + capabilities: Vec::new(), + start: Some(7), + host_role_table: Some((Some(7), Some(8), None, None, None, None, None, Some(13))), + string_host_roles: vec![(21, StringHostRole::Eq)], + target: "wasm-gc".to_string(), + profile: "AverUserProfile/v1".to_string(), + abi: "aver-wasm-gc/0".to_string(), + wasip2_component_envelope: None, + } + } + + /// The witness is pure pins: no `Lean` import, no command that runs code, + /// every wall or package name `_root_`-qualified (so a declaration under + /// `AverCertChecker.AverCert.…` is never reached), and no numeral an + /// `OfNat` instance could reinterpret. + #[test] + fn the_witness_names_everything_from_the_root() { + let witness = checker_witness("ab12", &witness_candidates()); + assert!(!witness.contains("import Lean"), "{witness}"); + assert!(!witness.contains("run_cmd") && !witness.contains("#eval")); + assert!(!witness.contains("namespace AverCertChecker")); + // No statement is read inside a namespace the package chose: the + // law's model namespace (`Domain`) is never opened. + assert!(!witness.contains("namespace "), "{witness}"); + for (at, _) in witness.match_indices("AverCert") { + let before = &witness[..at]; + assert!( + // A name, or the root's name inside a string literal. + before.ends_with("_root_.") || before.ends_with('"'), + "unqualified name at {at}: {}", + &witness[at.saturating_sub(40)..(at + 40).min(witness.len())] + ); + } + assert!(witness.contains(&format!( + "theorem _root_.{CHECKED_ROOT} :\n \ + _root_.AverCert.AcceptedArtifact.accepted _root_.AverCert.Artifact.data :=\n \ + _root_.AverCert.Artifact.certificate" + ))); + for index in 0..REPORT_PIN_COUNT { + assert!(witness.contains(&format!("theorem _root_.{REPORT_PIN_PREFIX}{index} :"))); + } + // No name continues past a package constant: a package constant + // `AverCert.manifest.subject` would be what such a path resolves to. + // Fields are read through the wall structures' projection functions. + for package_constant in [ + "_root_.AverCert.manifest.", + "_root_.AverCert.subject.", + "_root_.AverCert.Artifact.data.", + "_root_.AverCert.Artifact.certificate.", + ] { + assert!( + !witness.contains(package_constant), + "a dotted path past {package_constant}: {witness}" + ); + } + assert!(witness.contains( + "(_root_.AverCert.Schema.Subject.contracts \ + (_root_.AverCert.Schema.Manifest.subject _root_.AverCert.manifest)) = [\"c\"]" + )); + assert!(witness.contains( + "(_root_.AverCert.AcceptedArtifact.ArtifactData.manifest \ + _root_.AverCert.Artifact.data) = _root_.AverCert.manifest" + )); + assert!(witness.contains("(_root_.Option.some (nat_lit 7))")); + assert!(witness.contains("(_root_.Int.negSucc (nat_lit 2))")); + assert!(witness.contains("((nat_lit 21), .eq)")); + assert!(!witness.contains("some 7") && !witness.contains("≤")); + } + + /// Every pinned statement is elaborated alone, as a checker definition, + /// and the pins conjoin the definitions: no statement text sits beside the + /// `∧` that joins it to `Holds` or to a bridge, so no text can change how + /// the conjunction associates. + #[test] + fn the_witness_conjoins_statement_definitions_not_statement_text() { + let candidates = witness_candidates(); + let witness = checker_witness("ab12", &candidates); + let holds = "(_root_.AverCert.Schema.Holds _root_.AverCert.manifest)"; + assert!(witness.contains(&format!( + "def _root_.{LAW_STATEMENT_PREFIX}0 : Prop :=\n ({})\n", + candidates.laws[0].statement + ))); + assert!(witness.contains(&format!( + "def _root_.{BRIDGE_STATEMENT_PREFIX}0 : Prop :=\n ({})\n", + candidates.source_bridges[0].statement + ))); + assert!(witness.contains(&format!( + "theorem _root_.{LAW_PIN_PREFIX}0 :\n _root_.{LAW_STATEMENT_PREFIX}0 ∧ {holds} :=" + ))); + assert!(witness.contains(&format!( + "theorem _root_.{BRIDGED_LAW_PIN_PREFIX}0 :\n \ + _root_.{LAW_STATEMENT_PREFIX}0 ∧ {holds} ∧\n \ + _root_.{BRIDGE_STATEMENT_PREFIX}0 :=" + ))); + assert!(witness.contains(&format!( + "theorem _root_.{BRIDGE_PIN_PREFIX}0 :\n _root_.{BRIDGE_STATEMENT_PREFIX}0 ∧ {holds} :=" + ))); + // The statement text appears once per statement: in its definition. + assert_eq!( + witness + .matches(candidates.laws[0].statement.as_str()) + .count(), + 1 + ); + } + + /// The audit program is fully instantiated, walks the pins the witness + /// writes, and reads the encoder shapes the bridges declare. + #[test] + fn the_audit_program_walks_every_pin() { + let candidates = witness_candidates(); + let audit = checker_audit(&candidates, &["Manifest".to_string(), "Laws".to_string()]); + assert!(!audit.contains('@'), "an unfilled placeholder: {audit}"); + assert!(audit.contains("def packageModules : List Name := [`Manifest, `Laws]")); + assert!(audit.contains(&format!("`{CHECKED_ROOT}, `{REPORT_PIN_PREFIX}0,"))); + assert!(audit.contains(&format!("`{REPORT_PIN_PREFIX}{}]", REPORT_PIN_COUNT - 1))); + assert!(audit.contains(&format!("[`{LAW_PIN_PREFIX}0]"))); + assert!(audit.contains(&format!("[`{BRIDGED_LAW_PIN_PREFIX}0]"))); + assert!(audit.contains(&format!("[`{BRIDGE_PIN_PREFIX}0]"))); + assert!( + audit.contains("[(`Domain.Fraction, [`top, `bottom])]"), + "{audit}" + ); + } + + /// The final replay covers the witness module, so every module it imports + /// — laws, bridges and model included — is replayed. + #[test] + fn the_fresh_replay_replays_the_witness_closure() { + assert_eq!(FRESH_REPLAY_ARGS[3], "CheckerWitness"); + assert_eq!( + replay_args_for(ReplayMode::Fresh, None).unwrap(), + vec!["env", "leanchecker", "--fresh", "CheckerWitness"] + ); + } + + /// A law-claim's bridge list is exactly the bridges of the functions its + /// statement names. + #[test] + fn a_law_lists_exactly_the_bridges_its_statement_names() { + let models = ["Domain.plus", "Domain.times"]; + let qualified = "∀ (a : Int), _root_.Domain.times (_root_.Domain.plus a a) a = \ + _root_.Domain.plus a a"; + assert_eq!( + bridge_statement::law_mentioned_bridges(qualified, &models), + vec![1, 0] + ); + assert_eq!( + bridge_statement::law_names_model_unqualified(qualified, &models), + None + ); + assert!(bridge_statement::law_mentioned_bridges("∀ (a : Int), a = a", &models).is_empty()); + // A model spelled any other way is no mention, and is refused: bare, + // it could be a binder's field; under a prefix, a slipped-in constant. + for spelling in [ + "∀ (a : Int), Domain.plus a a = a", + "∀ (a : Int), Evil.Domain.plus a a = a", + ] { + assert!(bridge_statement::law_mentioned_bridges(spelling, &models).is_empty()); + assert_eq!( + bridge_statement::law_names_model_unqualified(spelling, &models), + Some("Domain.plus") + ); + } + } + + /// The audit is handed, per bridged law, the model constants its + /// elaborated statement must use. Nothing depends on the law's namespace: + /// the witness reads the statement at the root. + #[test] + fn the_audit_checks_what_each_law_statement_uses() { + let mut candidates = witness_candidates(); + candidates.laws[0].statement = "∀ (a : Int), _root_.Domain.plus a a = a".to_string(); + candidates.laws[0].prefix = "Evil.Inner".to_string(); + assert_eq!( + law_model_uses(&candidates), + format!("[(`{LAW_STATEMENT_PREFIX}0, [`Domain.plus])]") + ); + let audit = checker_audit(&candidates, &["Laws".to_string()]); + assert!(!audit.contains("Evil.Domain.plus"), "{audit}"); + assert!(!audit.contains("Evil.Inner.Domain.plus"), "{audit}"); + } } diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index 5fd506a61..8da5b4404 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -13,70 +13,38 @@ pub const LEAN_TOOLCHAIN: &str = include_str!("../assets/wall/current/lean-toolc pub const CERT_PRELUDE: &str = include_str!("../assets/wall/current/CertPrelude.lean"); pub const CERT_DECODE: &str = include_str!("../assets/wall/current/CertDecode.lean"); +pub const CERT_SCHEMA_BASE: &str = include_str!("../assets/wall/current/SchemaBase.lean"); pub const CERT_SCHEMA: &str = include_str!("../assets/wall/current/Schema.lean"); pub const CERT_SCHEMA_CORE: &str = include_str!("../assets/wall/current/SchemaCore.lean"); -pub const CERT_PLAN_CHECK: &str = include_str!("../assets/wall/current/PlanCheck.lean"); -pub const CERT_PLAN_LOWER: &str = include_str!("../assets/wall/current/PlanLower.lean"); -pub const CERT_PLAN_BYTES: &str = include_str!("../assets/wall/current/PlanBytes.lean"); pub const CERT_WASM_SLICE: &str = include_str!("../assets/wall/current/WasmSlice.lean"); pub const CERT_WASIP2_ENVELOPE: &str = include_str!("../assets/wall/current/Wasip2Envelope.lean"); -pub const CERT_EXPR_FRAGMENT_ACCEPTED: &str = - include_str!("../assets/wall/current/ExprFragmentAccepted.lean"); -pub const CERT_ACCEPTED_ARTIFACT: &str = - include_str!("../assets/wall/current/AcceptedArtifact.lean"); +pub const CERT_ARITH_TEMPLATE_DERISK: &str = + include_str!("../assets/wall/current/ArithTemplateDerisk.lean"); +pub const CERT_INTERPRETER_SEQUENCING: &str = + include_str!("../assets/wall/current/InterpreterSequencing.lean"); +pub const CERT_GRAMMAR: &str = include_str!("../assets/wall/current/Grammar.lean"); +pub const CERT_GRAMMAR_LOWER: &str = include_str!("../assets/wall/current/GrammarLower.lean"); +pub const CERT_GRAMMAR_SOUND: &str = include_str!("../assets/wall/current/GrammarSound.lean"); +pub const CERT_GRAMMAR_TOTAL: &str = include_str!("../assets/wall/current/GrammarTotal.lean"); +pub const CERT_TYPE_TABLE: &str = include_str!("../assets/wall/current/TypeTable.lean"); pub const CERT_ACCEPTED_ARTIFACT_CORE: &str = include_str!("../assets/wall/current/AcceptedArtifactCore.lean"); +pub const CERT_ACCEPTED_ARTIFACT: &str = + include_str!("../assets/wall/current/AcceptedArtifact.lean"); +pub const CERT_DECLARED_LAYOUT: &str = include_str!("../assets/wall/current/DeclaredLayout.lean"); +pub const CERT_BYTE_WINDOW: &str = include_str!("../assets/wall/current/ByteWindow.lean"); +pub const CERT_SORTED_KEYS: &str = include_str!("../assets/wall/current/SortedKeys.lean"); pub const CERT_CLAIM_AXES: &str = include_str!("../assets/wall/current/ClaimAxes.lean"); -pub const CERT_EXPR_FRAGMENT_SEMANTICS: &str = - include_str!("../assets/wall/current/ExprFragmentSemantics.lean"); -pub const CERT_INTERPRETER_SEQUENCING: &str = - include_str!("../assets/wall/current/InterpreterSequencing.lean"); -pub const CERT_EXPR_FRAGMENT_SOUNDNESS: &str = - include_str!("../assets/wall/current/ExprFragmentSoundness.lean"); -pub const CERT_RECORD_COMPUTE_BRIDGE: &str = - include_str!("../assets/wall/current/RecordComputeBridge.lean"); -pub const CERT_FIELD_PROJECTION_SOUNDNESS: &str = - include_str!("../assets/wall/current/FieldProjectionSoundness.lean"); -pub const CERT_CONSTRUCT_VERBATIM_SOUNDNESS: &str = - include_str!("../assets/wall/current/ConstructVerbatimSoundness.lean"); -pub const CERT_INT_DISPATCH_SOUNDNESS: &str = - include_str!("../assets/wall/current/IntDispatchSoundness.lean"); -pub const CERT_ENVELOPE_LOWERING: &str = - include_str!("../assets/wall/current/EnvelopeLowering.lean"); -pub const CERT_WIDENED_ENVELOPE: &str = include_str!("../assets/wall/current/WidenedEnvelope.lean"); -pub const CERT_DECLARED_INDEX_ENVELOPE: &str = - include_str!("../assets/wall/current/DeclaredIndexEnvelope.lean"); -pub const CERT_DECLARED_ENVELOPE_ACCEPT_TRANSPORT: &str = - include_str!("../assets/wall/current/DeclaredEnvelopeAcceptTransport.lean"); -pub const CERT_STRING_SOUNDNESS: &str = include_str!("../assets/wall/current/StringSoundness.lean"); -pub const CERT_STANDARD_FACE: &str = include_str!("../assets/wall/current/StandardFace.lean"); -pub const CERT_RECURSION_SOUNDNESS: &str = - include_str!("../assets/wall/current/RecursionSoundness.lean"); -pub const CERT_MUTUAL_RECURSION_SOUNDNESS: &str = - include_str!("../assets/wall/current/MutualRecursionSoundness.lean"); -pub const CERT_COMPOSITION_SOUNDNESS: &str = - include_str!("../assets/wall/current/CompositionSoundness.lean"); pub const CERT_ACCEPTANCE_SOUNDNESS_CORE: &str = include_str!("../assets/wall/current/AcceptanceSoundnessCore.lean"); -pub const CERT_DISCHARGE_EXPR_FRAGMENT: &str = - include_str!("../assets/wall/current/DischargeExprFragment.lean"); -pub const CERT_DISCHARGE_FIELD_PROJECTION: &str = - include_str!("../assets/wall/current/DischargeFieldProjection.lean"); -pub const CERT_DISCHARGE_CONSTRUCT: &str = - include_str!("../assets/wall/current/DischargeConstruct.lean"); -pub const CERT_DISCHARGE_VERBATIM: &str = - include_str!("../assets/wall/current/DischargeVerbatim.lean"); -pub const CERT_DISCHARGE_STRING: &str = include_str!("../assets/wall/current/DischargeString.lean"); -pub const CERT_DISCHARGE_INT_DISPATCH: &str = - include_str!("../assets/wall/current/DischargeIntDispatch.lean"); -pub const CERT_DISCHARGE_RECURSION: &str = - include_str!("../assets/wall/current/DischargeRecursion.lean"); -pub const CERT_DISCHARGE_COMPOSITION: &str = - include_str!("../assets/wall/current/DischargeComposition.lean"); pub const CERT_ACCEPTANCE_SOUNDNESS: &str = include_str!("../assets/wall/current/AcceptanceSoundness.lean"); -pub const CERT_ARITH_TEMPLATE_DERISK: &str = - include_str!("../assets/wall/current/ArithTemplateDerisk.lean"); +pub const CERT_GRAMMAR_BRIDGE: &str = include_str!("../assets/wall/current/GrammarBridge.lean"); + +/// The checker-owned pieces of the certificate source model (`AverBits` with +/// its `@[simp]` equations, the `aver_int_order` tactic): the constructs the +/// token gate refuses in package text, owned and pinned here instead. +pub const CERT_MODEL_PRELUDE: &str = include_str!("../assets/wall/current/ModelPrelude.lean"); #[derive(Clone, Copy, Debug, Eq, PartialEq)] pub struct Source { @@ -86,26 +54,30 @@ pub struct Source { /// Exact checker-owned source set. Ordering is not part of the identity: /// [`compute_id`] sorts by filename before hashing. -pub const SOURCES: [Source; 40] = [ +pub const SOURCES: [Source; 24] = [ Source { - name: "AcceptedArtifact.lean", - contents: CERT_ACCEPTED_ARTIFACT, + name: "AcceptanceSoundness.lean", + contents: CERT_ACCEPTANCE_SOUNDNESS, }, Source { - name: "ArithTemplateDerisk.lean", - contents: CERT_ARITH_TEMPLATE_DERISK, + name: "AcceptanceSoundnessCore.lean", + contents: CERT_ACCEPTANCE_SOUNDNESS_CORE, + }, + Source { + name: "AcceptedArtifact.lean", + contents: CERT_ACCEPTED_ARTIFACT, }, Source { name: "AcceptedArtifactCore.lean", contents: CERT_ACCEPTED_ARTIFACT_CORE, }, Source { - name: "AcceptanceSoundness.lean", - contents: CERT_ACCEPTANCE_SOUNDNESS, + name: "ArithTemplateDerisk.lean", + contents: CERT_ARITH_TEMPLATE_DERISK, }, Source { - name: "AcceptanceSoundnessCore.lean", - contents: CERT_ACCEPTANCE_SOUNDNESS_CORE, + name: "ByteWindow.lean", + contents: CERT_BYTE_WINDOW, }, Source { name: "CertDecode.lean", @@ -120,176 +92,92 @@ pub const SOURCES: [Source; 40] = [ contents: CERT_CLAIM_AXES, }, Source { - name: "CompositionSoundness.lean", - contents: CERT_COMPOSITION_SOUNDNESS, - }, - Source { - name: "ConstructVerbatimSoundness.lean", - contents: CERT_CONSTRUCT_VERBATIM_SOUNDNESS, + name: "DeclaredLayout.lean", + contents: CERT_DECLARED_LAYOUT, }, Source { - name: "DeclaredEnvelopeAcceptTransport.lean", - contents: CERT_DECLARED_ENVELOPE_ACCEPT_TRANSPORT, + name: "Grammar.lean", + contents: CERT_GRAMMAR, }, Source { - name: "DeclaredIndexEnvelope.lean", - contents: CERT_DECLARED_INDEX_ENVELOPE, + name: "GrammarBridge.lean", + contents: CERT_GRAMMAR_BRIDGE, }, Source { - name: "DischargeComposition.lean", - contents: CERT_DISCHARGE_COMPOSITION, + name: "GrammarLower.lean", + contents: CERT_GRAMMAR_LOWER, }, Source { - name: "DischargeConstruct.lean", - contents: CERT_DISCHARGE_CONSTRUCT, + name: "GrammarSound.lean", + contents: CERT_GRAMMAR_SOUND, }, Source { - name: "DischargeExprFragment.lean", - contents: CERT_DISCHARGE_EXPR_FRAGMENT, - }, - Source { - name: "DischargeFieldProjection.lean", - contents: CERT_DISCHARGE_FIELD_PROJECTION, - }, - Source { - name: "DischargeIntDispatch.lean", - contents: CERT_DISCHARGE_INT_DISPATCH, - }, - Source { - name: "DischargeRecursion.lean", - contents: CERT_DISCHARGE_RECURSION, - }, - Source { - name: "DischargeString.lean", - contents: CERT_DISCHARGE_STRING, - }, - Source { - name: "DischargeVerbatim.lean", - contents: CERT_DISCHARGE_VERBATIM, - }, - Source { - name: "EnvelopeLowering.lean", - contents: CERT_ENVELOPE_LOWERING, - }, - Source { - name: "ExprFragmentAccepted.lean", - contents: CERT_EXPR_FRAGMENT_ACCEPTED, - }, - Source { - name: "ExprFragmentSemantics.lean", - contents: CERT_EXPR_FRAGMENT_SEMANTICS, - }, - Source { - name: "ExprFragmentSoundness.lean", - contents: CERT_EXPR_FRAGMENT_SOUNDNESS, - }, - Source { - name: "RecordComputeBridge.lean", - contents: CERT_RECORD_COMPUTE_BRIDGE, - }, - Source { - name: "FieldProjectionSoundness.lean", - contents: CERT_FIELD_PROJECTION_SOUNDNESS, - }, - Source { - name: "IntDispatchSoundness.lean", - contents: CERT_INT_DISPATCH_SOUNDNESS, + name: "GrammarTotal.lean", + contents: CERT_GRAMMAR_TOTAL, }, Source { name: "InterpreterSequencing.lean", contents: CERT_INTERPRETER_SEQUENCING, }, Source { - name: "MutualRecursionSoundness.lean", - contents: CERT_MUTUAL_RECURSION_SOUNDNESS, - }, - Source { - name: "PlanBytes.lean", - contents: CERT_PLAN_BYTES, - }, - Source { - name: "PlanCheck.lean", - contents: CERT_PLAN_CHECK, - }, - Source { - name: "PlanLower.lean", - contents: CERT_PLAN_LOWER, - }, - Source { - name: "RecursionSoundness.lean", - contents: CERT_RECURSION_SOUNDNESS, + name: "ModelPrelude.lean", + contents: CERT_MODEL_PRELUDE, }, Source { name: "Schema.lean", contents: CERT_SCHEMA, }, Source { - name: "SchemaCore.lean", - contents: CERT_SCHEMA_CORE, + name: "SchemaBase.lean", + contents: CERT_SCHEMA_BASE, }, Source { - name: "StandardFace.lean", - contents: CERT_STANDARD_FACE, + name: "SchemaCore.lean", + contents: CERT_SCHEMA_CORE, }, Source { - name: "StringSoundness.lean", - contents: CERT_STRING_SOUNDNESS, + name: "SortedKeys.lean", + contents: CERT_SORTED_KEYS, }, Source { - name: "WasmSlice.lean", - contents: CERT_WASM_SLICE, + name: "TypeTable.lean", + contents: CERT_TYPE_TABLE, }, Source { name: "Wasip2Envelope.lean", contents: CERT_WASIP2_ENVELOPE, }, Source { - name: "WidenedEnvelope.lean", - contents: CERT_WIDENED_ENVELOPE, + name: "WasmSlice.lean", + contents: CERT_WASM_SLICE, }, ]; /// Roots whose complete import graph is artifact-independent and can therefore /// be cached before a certificate is seen. -pub const PRISTINE_ROOTS: [&str; 38] = [ +pub const PRISTINE_ROOTS: [&str; 22] = [ "CertPrelude", "CertDecode", + "ByteWindow", "ArithTemplateDerisk", "WasmSlice", "Wasip2Envelope", + "SchemaBase", "SchemaCore", - "PlanCheck", - "PlanLower", - "PlanBytes", - "ExprFragmentAccepted", + "InterpreterSequencing", + "Grammar", + "GrammarLower", + "GrammarSound", + "GrammarTotal", + "TypeTable", "AcceptedArtifactCore", + "DeclaredLayout", + "SortedKeys", "ClaimAxes", - "ExprFragmentSemantics", - "InterpreterSequencing", - "ExprFragmentSoundness", - "RecordComputeBridge", - "FieldProjectionSoundness", - "ConstructVerbatimSoundness", - "IntDispatchSoundness", - "StringSoundness", - "EnvelopeLowering", - "WidenedEnvelope", - "DeclaredIndexEnvelope", - "DeclaredEnvelopeAcceptTransport", - "StandardFace", - "RecursionSoundness", - "MutualRecursionSoundness", - "CompositionSoundness", "AcceptanceSoundnessCore", - "DischargeExprFragment", - "DischargeFieldProjection", - "DischargeConstruct", - "DischargeVerbatim", - "DischargeString", - "DischargeIntDispatch", - "DischargeRecursion", - "DischargeComposition", "AcceptanceSoundness", + "GrammarBridge", + "ModelPrelude", ]; #[derive(Debug)] @@ -376,6 +264,29 @@ pub fn render_artifact_component_bytes(bytes: &[u8]) -> String { ) } +/// Checker-authored `Module.lean`: the SHA-256 of the delivered artifact that +/// `Schema.Holds` compares the manifest's hash against. The wall's `Schema` +/// imports this module, so it must never come from a certificate package: a +/// package module in the wall's import closure could declare names that the +/// wall's own definitions resolve to. `sha` is the hash the verifier computed +/// from the bytes it read (64 lowercase hex digits). +pub fn render_module(sha: &str) -> String { + debug_assert!( + sha.len() == 64 && sha.bytes().all(|b| b.is_ascii_hexdigit()), + "render_module takes a hex SHA-256" + ); + format!( + "-- Authored by aver-cert from the artifact bytes; never accepted from the certificate.\n\ + namespace CertModule\n\n\ + /-- SHA-256 of the delivered artifact, computed by the verifier. -/\n\ + def wasmSha256 : String := \"{sha}\"\n\n\ + end CertModule\n" + ) +} + +/// Bytes per hex numeral in a checker-rendered byte module. +const BYTE_NUMERAL_CHUNK: usize = 1024; + fn render_byte_module( module: &str, bytes_name: &str, @@ -386,15 +297,31 @@ fn render_byte_module( let numeral = if bytes.is_empty() { "0".to_string() } else { - let mut numeral = String::with_capacity(2 + bytes.len() * 2); - numeral.push_str("0x"); - for byte in bytes.iter().rev() { - numeral.push_str(&format!("{byte:02x}")); - } - numeral + // Lean reads a numeral in time quadratic in its length (a 116 KiB + // module's single hex numeral took 20 s to elaborate, once per byte + // module). Chunks of `BYTE_NUMERAL_CHUNK` bytes, each shifted to its + // byte offset and joined by `|||`, denote the same number: the ranges + // are disjoint, and the kernel evaluates the join with its built-in + // `Nat` shift and `lor`. + bytes + .chunks(BYTE_NUMERAL_CHUNK) + .enumerate() + .map(|(index, chunk)| { + let mut hex = String::with_capacity(2 + chunk.len() * 2); + hex.push_str("0x"); + for byte in chunk.iter().rev() { + hex.push_str(&format!("{byte:02x}")); + } + match index { + 0 => hex, + _ => format!("({hex} <<< {})", 8 * BYTE_NUMERAL_CHUNK * index), + } + }) + .collect::>() + .join(" |||\n ") }; format!( - "import WasmSlice\n\nset_option maxRecDepth 200000\n\nnamespace AverCert.{module}\n\n/-- {description} -/\ndef {bytes_name} : Nat := {numeral}\ndef {len_name} : Nat := {}\n\nend AverCert.{module}\n", + "import WasmSlice\n\nset_option maxRecDepth 200000\n\nnamespace AverCert.{module}\n\n/-- {description} -/\nnoncomputable def {bytes_name} : Nat :=\n {numeral}\ndef {len_name} : Nat := {}\n\nend AverCert.{module}\n", bytes.len() ) } @@ -457,7 +384,7 @@ mod tests { /// wins and each silently re-bound `toIndex`; this is what caught them. #[test] fn lint_still_flags_the_historical_index_helper_gap() { - const NAME_PIN: &str = "(roles.toIndex == CertDecode.AddSub.toIndexIdx n len) &&"; + const NAME_PIN: &str = "(roles.toIndex == _root_.CertDecode.AddSub.toIndexIdx n len) &&"; const TEMPLATE_PIN: &str = "arithRoleCheck n len .toIndex roles.toIndex p &&"; let core = CERT_ACCEPTED_ARTIFACT_CORE; for pin in [NAME_PIN, TEMPLATE_PIN] { @@ -525,6 +452,114 @@ mod tests { ); } + /// The wall with one text replacement in `AcceptedArtifactCore.lean`. + fn wall_with_core_edit(old: &str, new: &str) -> String { + assert!( + CERT_ACCEPTED_ARTIFACT_CORE.contains(old), + "the edited text has moved ({old:?}); re-aim this regression test rather than \ + deleting it" + ); + CERT_ACCEPTED_ARTIFACT_CORE.replace(old, new) + } + + fn sources_with_core(core: &str) -> Vec<(&'static str, &str)> { + wall_sources() + .into_iter() + .map(|(name, text)| { + if name == "AcceptedArtifactCore.lean" { + (name, core) + } else { + (name, text) + } + }) + .collect() + } + + /// Removing the code-entry equality must leave the plan payload unbound. + /// + /// The equality `exactFuncBindingForExport n len name bytes` (and the + /// `codeEntry == bytes` filter for internal callees) is the one fact that + /// makes a plan's lowering the delivered code. An earlier lint counted + /// `planTyped M e.plan` and `callsOrdered fns e` as binding the plan, + /// because they sit in a definition whose `match` reads the bytes, and so + /// stayed green with the equality deleted. The function type pin + /// (`sigPinned`) is the control: it still binds the signature. + #[test] + fn lint_flags_the_removed_code_entry_pin() { + let core = wall_with_core_edit( + " _root_.AverCert.WasmSlice.exactFuncBindingForExport n len (stringBytes e.name) bytes\n else\n (_root_.AverCert.WasmSlice.funcBindingByFuncIndex n len e.funcIdx).filter\n (fun b => b.codeEntry == bytes)\n", + " AverCert.WasmSlice.funcBindingForExport n len (stringBytes e.name)\n else\n AverCert.WasmSlice.funcBindingByFuncIndex n len e.funcIdx\n", + ); + let sources = sources_with_core(&core); + let report = byte_binding_lint::analyse(&sources); + for field in ["body", "locals", "nslots"] { + assert!( + report.is_flagged("FnPlan", field), + "`FnPlan.{field}` is still considered bound with the code-entry equality \ + removed" + ); + } + assert!( + report.is_bound("Sig", "params") && report.is_bound("Sig", "ret"), + "control failed: the function type pin `sigPinned` must still bind the signature" + ); + assert!( + byte_binding_lint::check(&sources, FORMAT_DOC).is_err(), + "the lint gate passes a wall whose plans are not bound to their code" + ); + } + + /// Rule D must not accept a derivation that is a tautology. + /// + /// `startPin m := m.subject = subjectOfManifest m` with + /// `subjectOfManifest m := m.subject` has a producer value whole on one side + /// and a wall definition applied on the other, and its right-hand side does + /// not contain the text `m.subject`; a text-level rule D accepted it and so + /// bound every leaf of `Subject`, with the start-section pin deleted. The + /// argument `m` is an ancestor of the value, so D must not fire. + #[test] + fn lint_rejects_a_tautological_derivation() { + let core = wall_with_core_edit( + "def startAccounted (artifact : ArtifactData) : Bool :=\n _root_.AverCert.WasmSlice.startFuncIndex artifact.modBytes artifact.modLen ==\n some artifact.manifest.subject.start\n", + "def subjectOfManifest (m : AverCert.Schema.Manifest) : AverCert.Schema.Subject := m.subject\n\ndef startPin (m : AverCert.Schema.Manifest) : Prop :=\n m.subject = subjectOfManifest m\n\ndef startAccounted (artifact : ArtifactData) : Prop :=\n startPin artifact.manifest\n", + ); + let core = core.replace( + " startAccounted artifact = true ∧\n", + " startAccounted artifact ∧\n", + ); + let sources = sources_with_core(&core); + let report = byte_binding_lint::analyse(&sources); + assert!( + report.is_flagged("Subject", "start"), + "`Subject.start` is considered bound by a tautological derivation" + ); + assert!( + report + .bound + .values() + .all(|e| !(e.rule.starts_with('D') && e.decl.ends_with("startPin"))), + "rule D fired on `m.subject = subjectOfManifest m`" + ); + assert!( + byte_binding_lint::check(&sources, FORMAT_DOC).is_err(), + "the lint gate passes a wall whose start pin was replaced by a tautology" + ); + + // On the real wall, rule D fires exactly at `obligationsDerived`. + let clean = byte_binding_lint::analyse(&wall_sources()); + let d_sites: std::collections::BTreeSet<&str> = clean + .bound + .values() + .filter(|e| e.rule.starts_with('D')) + .map(|e| e.decl.as_str()) + .collect(); + assert_eq!( + d_sites.into_iter().collect::>(), + vec!["AverCert.AcceptedArtifact.obligationsDerived"], + "rule D fires somewhere other than the derived obligations" + ); + } + /// Point the lint at an external directory of `.lean` sources, for auditing a /// historical or candidate wall. Ignored by default because it needs a tree /// that is not in the repository: diff --git a/aver-cert/src/wall/byte_binding_lint.rs b/aver-cert/src/wall/byte_binding_lint.rs index cf1b67b76..6fe4d4d44 100644 --- a/aver-cert/src/wall/byte_binding_lint.rs +++ b/aver-cert/src/wall/byte_binding_lint.rs @@ -44,8 +44,15 @@ //! `CertDecode.AddSub.toIndexIdx` is an anchor and `decodedRoleIdx` is not — //! exactly the distinction the bug turned on. //! * **A1 — one-hop argument.** A producer value passed whole into a reachable -//! definition from an anchored conjunct, where the callee projects the field. -//! Depth one only; deeper propagation reinstates the historical false negative. +//! definition from an anchored conjunct, where the callee projects the field, +//! AND either the callee is itself a byte anchor or the conjunct meets the +//! bytes on its own (it names the byte stream, an anchor, or a name a `match` +//! on a byte-reading scrutinee binds). Sitting in a definition whose `match` +//! reads the bytes is not enough: that is how `planTyped M e.plan` and +//! `callsOrdered fns e` once counted as binding the whole plan with the +//! code-entry equality deleted. Depth one only; deeper propagation reinstates +//! the historical false negative. Under `xs.all (f a …)` every element of the +//! producer list `xs` counts as passed whole as `f`'s next parameter. //! * **B — pinned to a wall term.** The conjunct equates the field to a term //! mentioning no producer-supplied value at all (a wall literal, a wall //! constant, a byte decode). The producer then has no freedom in that field. @@ -54,6 +61,26 @@ //! every leaf field of that value is then determined. This is how the lowered //! plan payloads are constrained (`lowerX plan = `). //! +//! * **C2 — lowered, then equal to bytes.** `match f v … with | some x => …` +//! where `x` is then compared for equality with the module bytes: passed to +//! a byte anchor at a parameter the anchor compares (`exactFuncBindingForExport +//! n len name bytes`, whose `expectedCode` is compared with the code entry), +//! or compared in the arm next to a byte read. Every leaf of the producer +//! values `v` is then determined, as in C. This is the code-entry equality +//! that binds a plan to its function, and the only rule that binds the plan +//! payload. +//! * **D — derived by a wall function.** One side of the conjunct is a producer +//! value whole, the other is, as a parsed term, a wall definition applied to +//! arguments each of which is producer-free or a whole producer value that is +//! not the value, an ancestor or a part of it, cannot contain the value's +//! type, and has every leaf bound by the rules above (or a standing +//! allowance). The value then has no freedom beyond its inputs'. D runs after +//! every other rule. This is how the schema-9 obligations are pinned +//! (`obligationsDerived`: the manifest's obligations ARE `obligationsOf` of +//! its plans); a text-level version accepted `m.subject = subjectOfManifest +//! m` and bound all of `Subject`, which +//! `lint_rejects_a_tautological_derivation` now holds against. +//! //! Rules A1 and C are deliberately narrow. Blanket versions of both were tried //! and both silently re-bound `roles.toIndex` in the pre-fix tree, i.e. they //! reproduced the very blindness the lint exists to prevent. The regression test @@ -479,7 +506,9 @@ fn decl_header(line: &str) -> Option<(usize, Kind, String)> { } fn parse_file(name: &str, text: &str) -> Vec { - let stripped = strip_comments(text); + // A `_root_.`-qualified reference names the same declaration the lint's + // resolver reaches from the root, so the prefix carries nothing here. + let stripped = strip_comments(text).replace("_root_.", ""); let lines: Vec<&str> = stripped.split('\n').collect(); // namespace / open context per line @@ -930,6 +959,11 @@ fn local_env(w: &Wall, d: &Decl) -> Env { /// Type of an expression, when it is exactly an identifier or projection chain. fn expr_struct(w: &Wall, env: &Env, expr: &str) -> Option { let e = expr.trim(); + // A binder whose name carries Lean's `?` / `!` suffix (`roles?`) is keyed + // verbatim, so look it up before the identifier-shape test rejects it. + if let Some(t) = env.get(e) { + return Some(t.clone()); + } if e.chars().all(is_ident_char) && !e.is_empty() { return env.get(e).cloned(); } @@ -1139,6 +1173,52 @@ fn leaves_of( } } +/// `xs.all (f a1 a2 ...)` sites: the list chain, the callee and its explicit +/// arguments. +fn all_sites(c: &str) -> Vec<(String, String, Vec)> { + let mut out = Vec::new(); + for marker in [".all (", ".any ("] { + let mut rest = c; + while let Some(p) = rest.find(marker) { + let before = &rest[..p]; + let xs: String = before + .chars() + .rev() + .take_while(|ch| is_token_char(*ch)) + .collect::>() + .into_iter() + .rev() + .collect(); + let after = &rest[p + marker.len()..]; + let mut depth = 1i32; + let mut end = None; + for (i, ch) in after.char_indices() { + if ch == '(' { + depth += 1; + } else if ch == ')' { + depth -= 1; + if depth == 0 { + end = Some(i); + break; + } + } + } + if let Some(e) = end { + let inner = after[..e].trim(); + if !inner.starts_with("fun") && !xs.is_empty() { + let mut parts = inner.split_whitespace(); + if let Some(f) = parts.next() { + let args: Vec = parts.map(|x| x.to_string()).collect(); + out.push((xs, f.to_string(), args)); + } + } + } + rest = &rest[p + marker.len()..]; + } + } + out +} + /// Parameter names of a definition, in order. fn sig_params(d: &Decl) -> Vec { let head = match d.sig.find(":=") { @@ -1160,6 +1240,7 @@ fn call_sites(c: &str) -> Vec<(String, Vec)> { i += 1; } let name: String = chars[start..i].iter().collect(); + let name_end = i; let mut args = Vec::new(); loop { let mut j = i; @@ -1206,6 +1287,9 @@ fn call_sites(c: &str) -> Vec<(String, Vec)> { if !args.is_empty() { out.push((name, args)); } + // Resume right after the name, so a call nested in this one's + // arguments (`match f a with | some b => g b …`) is a site too. + i = name_end; } else { i += 1; } @@ -1213,6 +1297,213 @@ fn call_sites(c: &str) -> Vec<(String, Vec)> { out } +/// A `value = f args` conjunct, kept for the structural rule D. +struct DCandidate { + decl: String, + conjunct: String, + value: String, + rhs: String, + env: Env, +} + +/// `base.f1.f2` as its path of names; empty when the text is not exactly one +/// identifier or projection chain. +fn chain_path(text: &str) -> Vec { + let t = text.trim(); + let t = t + .strip_prefix('(') + .and_then(|r| r.strip_suffix(')')) + .unwrap_or(t) + .trim(); + if !t.is_empty() && t.chars().all(is_ident_char) && t.chars().next().is_some_and(is_ident_start) + { + return vec![t.to_string()]; + } + let cs = chains(t); + if cs.len() == 1 && cs[0].start == 0 && cs[0].end == t.chars().count() { + let mut out = vec![cs[0].base.clone()]; + out.extend(cs[0].fields.iter().cloned()); + return out; + } + Vec::new() +} + +/// Whether a value of producer structure `from` can hold a value of structure +/// `to` (itself included), through plain-data fields. +fn struct_reaches(w: &Wall, from: &str, to: &str) -> bool { + let mut seen = BTreeSet::new(); + let mut stack = vec![from.to_string()]; + while let Some(s) = stack.pop() { + if s == to { + return true; + } + if !seen.insert(s.clone()) { + continue; + } + let Some(sd) = w.structure(&s) else { continue }; + for (_f, ty) in &sd.fields { + if is_arrow(ty) { + continue; + } + if let Some(t) = w.resolve_struct(ty, &sd.ns, &sd.opens) { + stack.push(t); + } + } + } + false +} + +/// Parse `f a1 … aN` where the WHOLE text is the application: `f` a name, +/// each argument an atom or one parenthesised group. `None` otherwise. +fn parse_app(text: &str) -> Option<(String, Vec)> { + let chars: Vec = text.trim().chars().collect(); + let mut i = 0usize; + if chars.is_empty() || !is_ident_start(chars[0]) { + return None; + } + while i < chars.len() && is_token_char(chars[i]) { + i += 1; + } + let head: String = chars[..i].iter().collect(); + let mut args = Vec::new(); + loop { + while i < chars.len() && chars[i].is_whitespace() { + i += 1; + } + if i >= chars.len() { + break; + } + if chars[i] == '(' { + let mut depth = 0i32; + let mut k = i; + while k < chars.len() { + if chars[k] == '(' { + depth += 1; + } else if chars[k] == ')' { + depth -= 1; + if depth == 0 { + break; + } + } + k += 1; + } + if k >= chars.len() { + return None; + } + args.push(chars[i + 1..k].iter().collect::()); + i = k + 1; + } else if is_token_char(chars[i]) { + let start = i; + while i < chars.len() && is_token_char(chars[i]) { + i += 1; + } + args.push(chars[start..i].iter().collect::()); + } else { + return None; + } + } + Some((head, args)) +} + +/// Every `match S with` of a definition, with its arms as `(pattern, body)`. +/// An arm's body runs to the next `|` (a lint-grade cut, like the rest). +fn match_arms(body: &str) -> Vec<(String, Vec<(String, String)>)> { + let mut out = Vec::new(); + let mut rest = body; + while let Some(p) = rest.find("match ") { + let after = &rest[p + 6..]; + if let Some(wpos) = after.find(" with") { + let scrut = after[..wpos].trim().to_string(); + let tail = &after[wpos + 5..]; + let window = &tail[..tail.len().min(6000)]; + let mut arms = Vec::new(); + for arm in window.split('|').skip(1) { + let Some(ar) = arm.find("=>") else { continue }; + arms.push((arm[..ar].trim().to_string(), arm[ar + 2..].to_string())); + } + out.push((scrut, arms)); + } + rest = &rest[p + 6..]; + } + out +} + +/// Whether a piece of a definition names the byte stream or a byte anchor. +fn text_reads_bytes( + w: &Wall, + d: &Decl, + text: &str, + raw_bytes: bool, + anchors: &BTreeSet, +) -> bool { + let toks: Vec = tokens(text); + toks.iter().any(|t| { + let last = t.rsplit('.').next().unwrap_or(t); + ["modBytes", "modLen", "componentBytes", "componentLen"].contains(&last) + || w.resolve(t, &d.ns, &d.opens) + .is_some_and(|r| anchors.contains(&r)) + }) || (raw_bytes && toks.iter().any(|t| t == "n") && toks.iter().any(|t| t == "len")) +} + +/// Whether `x` sits on one side of an equality: `x == …`, `… = x`, …. +fn in_equality(text: &str, x: &str) -> bool { + let chars: Vec = text.chars().collect(); + let xc: Vec = x.chars().collect(); + let mut i = 0usize; + while i + xc.len() <= chars.len() { + let hit = chars[i..i + xc.len()] == xc[..] + && (i == 0 || !is_token_char(chars[i - 1])) + && (i + xc.len() == chars.len() || !is_token_char(chars[i + xc.len()])); + if hit { + let before: String = chars[..i].iter().collect(); + let after: String = chars[i + xc.len()..].iter().collect(); + let b = before.trim_end(); + let a = after.trim_start(); + if (b.ends_with('=') && !b.ends_with(":=") && !b.ends_with("!=")) + || (a.starts_with('=') && !a.starts_with("=>")) + { + return true; + } + } + i += 1; + } + false +} + +/// Whether the arm body compares the matched value `x` with the module bytes: +/// either `x` is passed to a byte anchor at a parameter the anchor compares +/// for equality, or the arm compares `x` itself and reads the bytes. +fn compared_with_bytes( + w: &Wall, + d: &Decl, + body: &str, + x: &str, + raw_bytes: bool, + anchors: &BTreeSet, +) -> bool { + for (name, args) in call_sites(body) { + let Some(full) = w.resolve(&name, &d.ns, &d.opens) else { + continue; + }; + if !anchors.contains(&full) { + continue; + } + let Some(g) = w.get(&full) else { continue }; + let params = sig_params(g); + for (i, a) in args.iter().enumerate() { + if a.trim() != x { + continue; + } + if let Some(pn) = params.get(i) + && in_equality(&g.body[g.sig.len().min(g.body.len())..], pn) + { + return true; + } + } + } + in_equality(body, x) && text_reads_bytes(w, d, body, raw_bytes, anchors) +} + // --------------------------------------------------------------------------- // Report // --------------------------------------------------------------------------- @@ -1315,6 +1606,8 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { }) }; + let mut d_cands: Vec = Vec::new(); + // per-declaration caches for the one-hop rule let mut env_cache: BTreeMap = BTreeMap::new(); let mut bound: BTreeMap = BTreeMap::new(); @@ -1376,8 +1669,74 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { } } + // Names a `match` on a byte-reading scrutinee binds (`| some grp =>` + // under `match firstRecGroup n len with`): their values come from the + // module, so a conjunct that mentions one meets the bytes itself. + let mut match_byte_locals: BTreeSet = BTreeSet::new(); + for (scrut, arms) in match_arms(&d.body) { + let parts = split_top(&scrut, &[","]); + let reads: Vec = parts + .iter() + .map(|p| text_reads_bytes(&w, d, &expand_lets(p, &lets), raw_bytes, &anchors)) + .collect(); + for (pat, _body) in &arms { + let pats = split_top(pat, &[","]); + if pats.len() != reads.len() { + continue; + } + for (pt, r) in pats.iter().zip(reads.iter()) { + if *r { + match_byte_locals.extend(pattern_binds(pt)); + } + } + } + } + + // Rule C2: a producer value lowered by a wall function, and the + // lowering then compared for equality with the module bytes: + // `match codeEntryBytes M e.plan with | some bytes => + // exactFuncBindingForExport n len name bytes`, where the anchor + // compares its `expectedCode` parameter with the code entry it reads. + // This, and only this, is what binds the plan payload to its code. + for (scrut, arms) in match_arms(&d.body) { + let Some((head, args)) = parse_app(&scrut) else { + continue; + }; + let Some(hfull) = w.resolve(&head, &d.ns, &d.opens) else { + continue; + }; + if !w.get(&hfull).is_some_and(|g| g.kind == Kind::Def) { + continue; + } + let compared = arms.iter().any(|(pat, body)| { + pattern_binds(pat) + .iter() + .any(|x| compared_with_bytes(&w, d, body, x, raw_bytes, &anchors)) + }); + if !compared { + continue; + } + for a in &args { + if let Some(st) = expr_struct(&w, &env, a) { + let mut seen = BTreeSet::new(); + let mut leaves = Vec::new(); + leaves_of(&w, &st, &slots, &mut seen, &mut leaves); + for leaf in leaves { + mark(&mut bound, leaf, "C2/lowered-equal-to-bytes", d, &scrut); + } + } + } + } + for c in &cjs { let cx = expand_lets(c, &lets); + // Does the conjunct ITSELF meet the bytes (not merely sit in a + // definition whose `match` scrutinee does)? + let own_bytes = text_reads_bytes(&w, d, &cx, raw_bytes, &anchors) + || tokens(&cx).iter().any(|t| { + let base = t.split('.').next().unwrap_or(t); + match_byte_locals.contains(base) || byte_locals.contains(base) + }); let mut toks: BTreeSet = scrut_toks.clone(); for t in tokens(&cx) { if let Some(r) = w.resolve(&t, &d.ns, &d.opens) { @@ -1405,13 +1764,32 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { mark(&mut bound, r, "A/byte-cooccurrence", d, c); } } - // Rule A1: one hop into a callee that projects the field. - for (name, args) in call_sites(&cx) { + // Rule A1: one hop into a callee that projects the field. A + // partial application under `xs.all (f a …)` passes every element + // of the producer list `xs` as `f`'s next parameter, so that + // parameter is typed by the list's element structure. + let mut sites = call_sites(&cx); + for (xs, name, args) in all_sites(c) { + let Some(el) = expr_struct(&w, &env, &xs) else { + continue; + }; + let mut args = args; + args.push(format!("\u{0}{el}")); + sites.push((name, args)); + } + for (name, args) in sites { let Some(full) = w.resolve(&name, &d.ns, &d.opens) else { continue; }; let Some(g) = w.get(&full) else { continue }; - if g.kind != Kind::Def { + // The callee must itself read the bytes, or the conjunct + // must meet them on its own. A conjunct that only sits in + // a definition whose `match` scrutinee reads the bytes + // hands the value to a check that never meets the module: + // that is how `planTyped M e.plan` and `callsOrdered fns e` + // once counted as binding every plan field while the + // code-entry equality was gone. + if g.kind != Kind::Def || !(anchors.contains(&full) || own_bytes) { continue; } let genv = env_cache @@ -1421,8 +1799,12 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { let params = sig_params(g); for (i, a) in args.iter().enumerate() { let Some(pname) = params.get(i) else { break }; - let Some(st) = expr_struct(&w, &env, a) else { - continue; + let st = match a.strip_prefix('\u{0}') { + Some(el) => el.to_string(), + None => match expr_struct(&w, &env, a) { + Some(st) => st, + None => continue, + }, }; let mut genv2 = genv.clone(); genv2.insert(pname.clone(), st); @@ -1443,6 +1825,23 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { // Rules B and C: equality with a producer-free counterpart. if let Some((l, r)) = eq_sides(c) { for (a, b) in [(l.clone(), r.clone()), (r, l)] { + // D candidates are resolved after every other rule has + // run, because D is only as good as the bindings of the + // derived value's inputs. + let stripped_a = strip_wrappers(&a); + let ca = chains(&stripped_a); + let a_whole = ca.len() == 1 + && ca[0].start == 0 + && ca[0].end == stripped_a.chars().count(); + if a_whole { + d_cands.push(DCandidate { + decl: d.full.clone(), + conjunct: c.clone(), + value: stripped_a.trim().to_string(), + rhs: strip_wrappers(&b), + env: env.clone(), + }); + } if !producer_free(&w, &env, &b) { continue; } @@ -1488,6 +1887,82 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { } } + // Rule D, structurally: `value = f arg1 … argN`, where `f` is a wall + // definition and every argument is either producer-free or a whole + // producer value that (1) is not the value itself, an ancestor of it, or a + // part of it, (2) cannot contain the value's type, and (3) has every leaf + // bound by the other rules above or covered by a standing allowance. The + // value then carries no freedom beyond its inputs'. The checks are on the + // parsed application, never on text containment: `m.subject = + // subjectOfManifest m` passes a text test and is a tautology. + let before_d: BTreeSet = bound.keys().cloned().collect(); + let allowed = |k: &FieldRef| { + ALLOWED + .iter() + .any(|a| a.structure == short_of(&k.0) && a.field == k.1) + }; + for cand in &d_cands { + let Some(d) = w.get(&cand.decl) else { continue }; + let Some(vt) = expr_struct(&w, &cand.env, &cand.value) else { + continue; + }; + let Some((head, args)) = parse_app(&cand.rhs) else { + continue; + }; + let head_is_wall_def = w + .resolve(&head, &d.ns, &d.opens) + .and_then(|r| w.get(&r)) + .is_some_and(|g| g.kind == Kind::Def); + if !head_is_wall_def || args.is_empty() { + continue; + } + let value_path = chain_path(&cand.value); + let mut ok = true; + let mut producer_args = 0usize; + for a in &args { + let a = a.trim(); + if producer_free(&w, &cand.env, a) { + continue; + } + let Some(at) = expr_struct(&w, &cand.env, a) else { + ok = false; + break; + }; + let ap = chain_path(a); + let related = ap.is_empty() + || value_path.is_empty() + || ap.starts_with(&value_path) + || value_path.starts_with(&ap); + if related || struct_reaches(&w, &at, &vt) { + ok = false; + break; + } + let mut seen = BTreeSet::new(); + let mut leaves = Vec::new(); + leaves_of(&w, &at, &slots, &mut seen, &mut leaves); + if leaves.iter().any(|l| !before_d.contains(l) && !allowed(l)) { + ok = false; + break; + } + producer_args += 1; + } + if !ok || producer_args == 0 { + continue; + } + let mut seen = BTreeSet::new(); + let mut leaves = Vec::new(); + leaves_of(&w, &vt, &slots, &mut seen, &mut leaves); + for leaf in leaves { + mark( + &mut bound, + leaf, + "D/derived-by-wall-function", + d, + &cand.conjunct, + ); + } + } + let flagged: Vec = slots .iter() .filter(|k| !bound.contains_key(*k)) @@ -1511,20 +1986,14 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { /// closed on purpose: a free-text category would become a synonym for "ignore". #[derive(Debug, Clone, Copy, PartialEq, Eq)] pub enum Category { - /// Transported for display, deliberately outside the verified claim. No - /// current member: the documented example (`certified[].dom` / `cod`) lives - /// in the JSON manifest, not in a Lean producer structure, so it is not a - /// slot this lint ranges over. The category stays because the policy has - /// four kinds and a reviewer needs the vocabulary to classify the next one. - #[allow(dead_code)] + /// A source-meaning declaration the binary cannot determine (a name the + /// plans use for a byte-confirmed layout), deliberately outside what the + /// bytes can pin. DeclaredOnlyByDesign, /// The value SHOULD be constrained and is not. Must be documented as such. KnownGap, /// Enforced by the Rust checker or the generated witness, not by `accepted`. PinnedOutsideTheWall, - /// Pinned to a value the wall itself computes, so the producer cannot - /// influence it, rather than to the artifact bytes. - WallOwnedConstraint, } impl Category { @@ -1533,7 +2002,6 @@ impl Category { Category::DeclaredOnlyByDesign => "declared-only by design", Category::KnownGap => "KNOWN GAP", Category::PinnedOutsideTheWall => "pinned outside the wall", - Category::WallOwnedConstraint => "wall-owned constraint", } } } @@ -1561,12 +2029,43 @@ pub struct Allowance { /// Every entry is printed on every run. Read them as a list of things the /// certificate does NOT prove about values it transports. pub const ALLOWED: &[Allowance] = &[ + Allowance { + structure: "RecordDecl", + field: "tid", + category: Category::DeclaredOnlyByDesign, + reason: "The source type id is the plans' own name for a record or tuple type: a read \ + declaration the binary cannot determine, like every source-meaning \ + declaration. What the name stands for IS byte-confirmed: \ + `TypeTable.recordConfirmed` pins the struct index and the storage of every \ + declared field against the rec group that opens the type section, and \ + `keysUnique` makes the id resolve to exactly that declaration. A wrong id \ + only renames a byte-confirmed layout; the plans typed against it are then \ + typed against that layout.", + doc_anchor: "", + }, + Allowance { + structure: "FnEntry", + field: "group", + category: Category::DeclaredOnlyByDesign, + reason: "The call grouping is not trusted, and no byte fact could pin it: it is a \ + statement about the source call graph. Soundness holds for any grouping. \ + The partial obligation of every planned function is one fuel induction over \ + ALL plans at once (`fns_certified` applies `fn_certified_group` to \ + `planOf fns`, never to a group), so the grouping plays no part in it. The \ + L3 totality check (`checkTermGroup`) runs in the wall over the plans of the \ + declared group and admits a recursive call only to a member of that group, \ + each member passing the same check (`totE`: `mem g`); a wrong grouping can \ + therefore only lose L3, never grant it. The only other reader is \ + `callsOrdered` (calls go to the same or an earlier group), a producer-side \ + discipline that no theorem depends on.", + doc_anchor: "", + }, Allowance { structure: "Subject", field: "exports", category: Category::PinnedOutsideTheWall, reason: "The wall never reads this field — its only occurrence in the whole wall is \ - its own declaration in SchemaCore.lean, and `exportsAccounted` does the \ + its own declaration in SchemaBase.lean, and `exportsAccounted` does the \ byte-level export accounting from `manifest.obligations` and \ `subject.declaredUncertified` instead. It is constrained by the \ checker-authored witness rather than by `accepted`: verifier.rs emits \ @@ -1579,18 +2078,6 @@ pub const ALLOWED: &[Allowance] = &[ defended only by review of verifier.rs.", doc_anchor: "", }, - Allowance { - structure: "SymBlock", - field: "result", - category: Category::WallOwnedConstraint, - reason: "Pinned by a wall-computed equality rather than by bytes directly: \ - `PlanCheck.checkSymBlockFuel` requires `block.result + 1 = block.nodes.length` \ - (PlanCheck.lean:323) and that the node at that index exists with a matching \ - id, so once `nodes` is byte-bound through the plan lowering the result index \ - carries no independent producer freedom. Reached from acceptance via \ - `PlanCheck.checkSymRawPlan`.", - doc_anchor: "", - }, ]; fn short_of(qualified: &str) -> &str { diff --git a/aver-cert/tests/fixtures/one-grammar/certprobe2.wasm b/aver-cert/tests/fixtures/one-grammar/certprobe2.wasm new file mode 100644 index 000000000..6967fbdea Binary files /dev/null and b/aver-cert/tests/fixtures/one-grammar/certprobe2.wasm differ diff --git a/aver-cert/tests/fixtures/one-grammar/hello.wasm b/aver-cert/tests/fixtures/one-grammar/hello.wasm new file mode 100644 index 000000000..1ce4ee2fd Binary files /dev/null and b/aver-cert/tests/fixtures/one-grammar/hello.wasm differ diff --git a/aver-cert/tests/fixtures/one-grammar/variants.wasm b/aver-cert/tests/fixtures/one-grammar/variants.wasm new file mode 100644 index 000000000..1368e4d6e Binary files /dev/null and b/aver-cert/tests/fixtures/one-grammar/variants.wasm differ diff --git a/aver-cert/tests/phase_timeout.rs b/aver-cert/tests/phase_timeout.rs index f73acbe23..43eb4916d 100644 --- a/aver-cert/tests/phase_timeout.rs +++ b/aver-cert/tests/phase_timeout.rs @@ -65,7 +65,7 @@ fn minimal_fixture() -> Fixture { "declaredUncertified": [], "capabilities": [], "start": {{ "present": false, "function_index": null }}, - "hostRoleTable": {{ "box": null, "add": null, "mul": null, "sub": null, "toIndex": null, "cmp": null, "eq": null }}, + "hostRoleTable": {{ "box": null, "add": null, "mul": null, "sub": null, "toIndex": null, "cmp": null, "eq": null, "divmod": null }}, "stringHostRoles": [] }} "#, diff --git a/decisions/architecture.av b/decisions/architecture.av index 1b7a5bd42..d361c7ce0 100644 --- a/decisions/architecture.av +++ b/decisions/architecture.av @@ -161,15 +161,15 @@ decision PlanFirstArtifactCertification rejected = ["TraceGuidedAcceptance", "AdHocWholeFunctionRecognizers", "TrustedCompilerMetadata"] impacts = ["Certification", "WasmGC", "Lean", "Verifier", "Codegen"] -decision PlanEmittedCanonicalCodegen - date = "2026-07-09" +decision MirEmitterIsTheOnlyEmitter + date = "2026-09-22" author = "Aver core team" reason = - "Plan-shaped functions lower through the canonical certification plan lowerer on every build, not only under `--certify`, because the certificate must certify the exact bytes users ship — gating canonical emission on the certify flag would let the sidecar describe a body the production build never emits." - "Lowering failure stays a loud compile error: a plan that cannot be canonical-lowered aborts the build rather than silently diverging into a separately-emitted MIR body, so the certified path and the shipped path can never disagree." - "The canonical plan shape carries a carrier scratch local, so plan emission engages only in modules that declare the Int carrier type (the `aint_struct_idx` gate) — a documented, semantics-neutral byte-shape dependency that a future carrier-free locals profile would remove." - chosen = "UnconditionalCanonicalPlanEmission" - rejected = ["CertifyGatedEmission", "SilentMirFallback"] + "Every user function is emitted by the MIR body emitter, in every build. This replaces the 2026-07-09 plan-emitted codegen decision, under which plan-shaped functions in modules with the Int carrier were lowered through the certification plan lowerer instead of the MIR emitter." + "The certificate must describe the exact bytes users ship. Two emitters kept that true only by routing certified functions around the one that emits everything else; one emitter keeps it true by construction, and the certificate wall ports that emitter's choices over the same MIR tree." + "`--certify` never selects a different emitter. When the MIR emitter changes without a matching wall change, the affected certificates decline loudly instead of the build switching emitters." + chosen = "MirEmitterOnly" + rejected = ["PlanDrivenEmission", "CertifyGatedEmission"] impacts = ["Codegen", "WasmGC", "Certification"] fn describeDecision(decName: String, pick: String) -> String diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 282fa5eaf..80429c5b4 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -1,388 +1,497 @@ # Aver Artifact Certificate Format Specification -This document is the normative specification of the Aver artifact certificate format: the on-disk `cert/` package emitted by `aver compile --target wasm-gc --certify` and the acceptance behavior required of a verifier that consumes it, together with the trust inventory (section 10) and the versioning and freeze policy (section 11). The intended audience is an independent reimplementor of the verifier. The reference implementation is the standalone `aver-cert` crate. This document separates **what acceptance requires** (enforced by the reference implementation and normative for any reimplementation) from **what the producer emits** (layout and naming conventions a verifier MUST NOT rely on); places where the reference implementation enforces less than a reader might expect are flagged inline as *known gap*. An appendix maps each section to the source files that define the behavior. This is the reference, the third tier of the certification documentation: [certification.md](certification.md) is the user guide (what a certificate is and how to produce and verify one), and [certification-architecture.md](certification-architecture.md) is the architecture document (how the verifier reaches its verdict and why the trust boundary sits where it does). +This document specifies the Aver artifact certificate format: the `cert/` package that `aver compile --target wasm-gc --certify` (or `--target wasip2 --certify`) writes, and what a verifier must do to accept it. It also holds the trust inventory (section 12) and the versioning policy (section 13). It is written for someone reimplementing the verifier. The reference implementation is the standalone `aver-cert` crate. The document separates what acceptance requires, which is normative, from what the producer happens to emit, which a verifier must not rely on. Places where the reference implementation enforces less than a reader might expect are marked *known gap*. Section 14 maps each section to its source files. [certification.md](certification.md) is the user guide and [certification-architecture.md](certification-architecture.md) explains the architecture. -The key words MUST, MUST NOT, and MAY are normative. Wherever this document says a value is *kernel-pinned*, the reference verifier proves the stated equality inside the Lean kernel (by `rfl` in a checker-authored witness or as a conjunct of the accepted-artifact proposition); a conforming verifier MUST NOT accept a package for which any pinned equality fails. Wherever this document says a value is *declared-only*, the value is transported for display and is deliberately not part of the verified claim; a conforming verifier MUST NOT present declared-only values as verified facts. +The key words MUST, MUST NOT, SHOULD and MAY are normative. A value is *kernel-pinned* when the reference verifier proves its equality inside the Lean kernel, either by `rfl` in the checker-authored witness or as a conjunct of the accepted-artifact proposition; a verifier MUST NOT accept a package for which a pinned equality fails. A value is *declared-only* when it is transported for display and is not part of the verified claim; a verifier MUST NOT present it as a verified fact. -> **TODO-decision: format name.** The format has no frozen public name. This document uses the descriptive phrase "Aver artifact certificate format"; a short stable name (for registries, media types, file signatures) is an open decision and MUST be settled before the format is declared frozen. +> **TODO-decision: format name.** The format has no frozen public name. A short stable name (for registries, media types, file signatures) is an open decision and MUST be settled before the format is declared frozen. ## 1. Versioning and identity -Three version-like identities govern acceptance: +Three identities govern acceptance: | Identity | Current value | Where it lives | What it versions | |---|---|---|---| | Package layout version | `1` (`FORMAT_VERSION`) | `cert-manifest.json` `format.version` | The `cert/` directory layout and the transport envelope | -| Statement schema version | `8` (`CERT_SCHEMA_VERSION`) | `cert-manifest.json` `schema_version` | The certificate statement schema: manifest fields, obligation shapes, plan grammars | -| Wall identity | `sha256:<64 lowercase hex>` | `cert-manifest.json` `format.wall_id` | The exact checker-owned Lean soundness wall plus its pinned Lean toolchain | +| Statement schema version | `9` (`CERT_SCHEMA_VERSION`) | `cert-manifest.json` `schema_version` | The statement: manifest fields, the plan grammar, the obligation shape | +| Wall identity | `sha256:<64 lowercase hex>` | `cert-manifest.json` `format.wall_id` | The exact checker-owned Lean wall plus its pinned Lean toolchain | -A conforming verifier MUST reject a package whose `schema_version` is not exactly the schema version it implements, whose `format.version` is not exactly `1`, or whose `format.wall_id` does not name a wall embedded in the verifier itself. There is no version negotiation, no downgrade path, and no filesystem, environment, or network fallback for resolving a wall. +A verifier MUST reject a package whose `schema_version` is not exactly the version it implements, whose `format.version` is not exactly `1`, or whose `format.wall_id` does not name a wall embedded in the verifier. There is no version negotiation, no downgrade path, and no filesystem, environment or network fallback for resolving a wall. -Schema version 2 differed from version 1 in exactly one point: the subject's `hostRoleTable` became optional. A module may declare `null`, and the acceptance proof pins that declaration against a byte-derived proof that the module's export section decodes strictly and contains no **function export** named `__rt_aint_from_i64` — exactly that fact and nothing stronger (see section 4.3 for what this does and does not prove). A version-2 verifier MUST NOT accept a `schema_version: 1` package. +Schema history, one line per bump. Each bump is exact-match, so a verifier of version N rejects every package of version N-1. -Schema version 3 differed from version 2 in exactly one point: the object form of `hostRoleTable` gained the required `toIndex` key. The fused vector-read face binds the `__aint_to_index` helper by its named function export, exactly like `box` (see section 4.3); because the nested role-table object is matched exactly, a version-2 verifier would reject every manifest carrying the new key, so the extension is a version bump rather than an additive field. A version-3 verifier MUST NOT accept a `schema_version: 2` package. +- 2: the subject's `hostRoleTable` became optional; `null` is pinned to a byte-derived proof that the module exports no `__rt_aint_from_i64` function. +- 3: `hostRoleTable` gained the `toIndex` key. +- 4: `hostRoleTable` gained the `cmp` and `eq` keys. +- 5: the manifest gained the `target` field, and `Schema.Holds` checks target, profile and ABI against wall constants. +- 6: `target = "wasip2"` with the component envelope of section 4.4. +- 7: the `laws` array (law-claims). +- 8: the `sourceBridges` array and the `bridges` key of every law entry. +- 9: every obligation is stated over one plan grammar. The Lean manifest carries one plan list (`fnPlans`), each entry a function's optimized MIR body printed 1:1, and a declared type layout (`types`) that the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans, and their model is the plan's fuel-indexed meaning. Every certified export reports the class `source-plan-v1` with wall-derived facets. `hostRoleTable` gained the `divmod` key. Source-bridges are restated over the plan grammar, in two statement kinds (section 9). -Schema version 4 differs from version 3 in exactly one point, of the same kind: the object form of `hostRoleTable` gained the required `cmp` and `eq` keys. The faces that read a comparison verdict bind the `__aint_cmp` and `__aint_eq` helpers by their named function exports, again exactly like `box` (see section 4.3), and again the nested object is matched exactly, so the two new keys are a version bump rather than an additive extension. A version-4 verifier MUST NOT accept a `schema_version: 3` package. +The wall identity is computed, not assigned. It is the SHA-256 of a domain-separated, sorted, length-framed encoding of every wall source file plus the toolchain pin, written as `sha256:` and 64 lowercase hex digits. The encoding is: the ASCII bytes `aver-certificate-wall\0v1\0`; the file count as a big-endian `u64`; then, for each file in ascending filename order, the filename length as a big-endian `u64`, the filename bytes, the contents length as a big-endian `u64`, and the contents. The file set is the 24 embedded `.lean` wall sources plus one synthetic file named `lean-toolchain`, whose contents are the embedded toolchain file verbatim: the ASCII bytes `leanprover/lean4:v4.34.0` and one trailing newline. The newline is hashed; a reimplementation that hashes the trimmed pin computes a different identity. The current embedded wall identity is `sha256:ed89b143414bdff0bfadb49a49bc1e7d8c537365b69549c65f7e82fbccf73cef` (`CURRENT_WALL_ID` in `format.rs`). The reference verifier recomputes the digest over its embedded sources on first use and aborts if it differs from the compiled-in constant. A reimplementation MUST resolve `format.wall_id` only against source sets whose recomputed identity matches byte for byte, never by name, path or prefix. -Schema version 5 differs from version 4 in two related points: the manifest gained the required top-level `target` field, and `Schema.Holds` now checks the target/profile/ABI identifiers against fixed checker-owned constants. The only target admitted by version 5 is `"wasm-gc"`; a version-5 verifier MUST NOT accept a `schema_version: 4` package. +> **TODO-decision: freeze criteria.** Neither `format.version = 1` nor `schema_version = 9` is frozen. What counts as a compatible extension, and whether a frozen schema admits additive optional fields, is open. Until a freeze, every schema change bumps `schema_version`, and verifiers reject non-matching versions exactly. -Schema version 6 differs from version 5 in one target-specific point: it admits `target = "wasip2"` with `abi = "aver-wasip2/0"` only when the package carries a `wasip2ComponentEnvelope` declaration whose length-driven split binds the caller-supplied component bytes to the embedded core-module bytes checked by the existing wasm wall. A version-6 verifier MUST NOT accept a `schema_version: 5` package. - -Schema version 7 differs from version 6 in one point: the manifest gained the required top-level `laws` array — the certificate's law-claims surface. Each entry carries the `label` (the source-level `module.fn.law` identity), the fully qualified model `theorem` name, the theorem's verbatim universal `statement`, and the name of its `corollary` in the package's `Laws.lean`, which conjoins that statement with `AverCert.Schema.Holds manifest` by citing the model theorem and `AverCert.Final.cert`. `Laws.lean` elaborates each statement inside the model theorem's own namespace (`namespace ` … `end `, the corollary declared as `theorem _root_.AverCert.Laws.` so it keeps its name) rather than under an `open` at the root, because only the namespace reproduces the name resolution the emitter wrote the statement under; `theorem` minus its last segment names that context, so the manifest says which namespace its statement text is read in. The checker-owned witness re-elaborates every corollary at exactly the manifest-declared statement and audits its axioms against the same kernel whitelist as the certificate root, so a law whose proof degraded to `sorry` (or leaned on `native_decide`) is DECLINED, and a package whose `Laws.lean` or model statement was edited no longer elaborates against the declared surface. An empty `laws` array is valid and emits no `Laws.lean`. A version-7 verifier MUST NOT accept a `schema_version: 6` package. - -Schema version 8 differs from version 7 in two related points: the manifest gained the required top-level `sourceBridges` array — the plan-equals-source surface of section 4.1 — and every `laws` entry gained the required `bridges` key naming the bridged exports a second, separately pinned corollary conjoins. A `sourceBridges` entry transports the STRUCTURE of a bridge, never its statement text: the verifier renders the pinned statement from the declared export, source function and encoders, so what a package can claim is bounded by what the verifier can write, not by what passes a syntactic gate. Both changes are exact-object extensions, so neither is additive: a version-7 verifier would reject a manifest carrying them, and a version-8 verifier MUST NOT accept a `schema_version: 7` package. - -The wall identity is computed, not assigned. It is the SHA-256 of a domain-separated, sorted, length-framed encoding of every wall source file plus the Lean toolchain pin, formatted as `sha256:` followed by 64 lowercase hex digits. The exact encoding: the ASCII bytes `aver-certificate-wall\0v1\0`, then the file count as a big-endian `u64`, then for each file in ascending filename order: the filename length as big-endian `u64`, the filename bytes, the contents length as big-endian `u64`, the contents bytes. The file set is the 40 embedded `.lean` wall sources plus one synthetic file named `lean-toolchain` whose contents are the embedded toolchain file hashed verbatim — currently the ASCII bytes `leanprover/lean4:v4.34.0` followed by one trailing newline (the file is embedded with `include_str!`, so the newline byte is part of the hashed contents; a reimplementation that hashes the trimmed pin computes a different identity). The current embedded wall identity is `sha256:a3c0e76722eee7a09f0fb85eab10d94657be52ffe059e541645c0a9c80167dd5` (`CURRENT_WALL_ID` in `format.rs`). The reference verifier recomputes this digest over its own embedded sources on first use and aborts if it disagrees with the compiled-in constant, so a verifier binary cannot silently ship a wall that does not match its advertised identity. A reimplementation MUST resolve `format.wall_id` only against wall source sets whose recomputed identity is byte-exact; it MUST NOT resolve a wall by name, path, or prefix. - -> **TODO-decision: freeze criteria.** Neither `format.version = 1` nor `schema_version = 8` is declared frozen yet. The criteria for freezing (what constitutes a compatible extension versus a version bump, and whether a frozen schema admits additive optional fields) are an open decision; section 11 states what bumps each identity today, the certificate-lifetime consequences, and the freeze proposal on the table. Until freeze, every schema change bumps `schema_version` and verifiers reject non-matching versions exactly. - -> **TODO-decision: wall registry policy.** The reference verifier embeds exactly one wall and resolves only that identity. Whether a released verifier may embed several walls (for grace-window verification of older packages), and the deprecation policy for retired walls, is an open decision; section 11 describes the re-certification path this forces today. +> **TODO-decision: wall registry policy.** The reference verifier embeds exactly one wall. Whether a release may embed several walls, for a grace window on older packages, is open; section 13 describes the re-certification this forces today. ## 2. Package layout ### 2.1 What the producer emits (convention, not acceptance) -A certificate package is one directory, conventionally named `cert/`, emitted next to `.wasm`. The producer removes any pre-existing `cert/` directory before writing, so an emitted package is always a complete, self-consistent emission. The table below is the producer's layout **convention**: it documents what `aver compile --certify` writes and where an auditor should look. Except for `cert-manifest.json`, no row of it is an acceptance invariant — section 2.2 states the (much smaller) file-level contract acceptance actually imposes. The emission contains: +A package is one directory, conventionally `cert/`, next to `.wasm`. The producer deletes any existing `cert/` first. Except for `cert-manifest.json`, no row below is an acceptance requirement; section 2.2 states the file-level contract. | File | Role | |---|---| -| `cert-manifest.json` | Transport and reporting envelope (section 4). The only non-Lean file. | -| `Plans.lean` | The producer's canonical plan serialization: every plan as a Lean value, and nothing else. Convention only — acceptance requires neither this file nor any particular declaration in it (section 2.2). | -| `Manifest.lean` | The Lean manifest literal (`AverCert.manifest : Schema.Manifest`): subject data, per-export obligation definitions, and the plan lists (section 5). | -| `Module.lean` | Certified function bodies re-rendered as `CertPrelude.WInstr` data (`CertModule.*Code`), host tables, and the pinned `CertModule.wasmSha256` string. Of these names the wall references only `CertModule.wasmSha256` (in `Schema.Holds`); the `CertModule.*Code` naming is convention (section 2.2). | -| `Contracts.lean` | Human-auditable restatement of the named runtime contracts. Contracts enter the certificate theorems as hypotheses, not as Lean `axiom`s. Note the staging scan of section 9 does not ban the `axiom` keyword; the guarantee that no extra axiom is **used** comes from the axiom guard over the accepted root's closure (section 8) — an unused axiom elsewhere in package files does not reject. | -| `Certificate.lean` | Per-export simulation proofs and their composition into the schema obligations. | -| `Final.lean` | The single final schema theorem `AverCert.Final.cert : AverCert.Schema.Holds manifest`. | -| `Artifact.lean` | The artifact claim data (`AverCert.Artifact.data : ArtifactData`), the per-family acceptance proof bundles, and `acceptedWithFinal`. | -| `ArtifactSoundness.lean` | Per-artifact glue instantiating the artifact-independent acceptance-soundness wall at the real module hash. | -| `ArtifactCertificate.lean` | The public proof root: `theorem AverCert.Artifact.certificate : AverCert.AcceptedArtifact.accepted AverCert.Artifact.data`, followed by `#print axioms`. | -| `Laws.lean` | One corollary per manifest `laws` entry, conjoining the law's universal statement with `Holds` (and, for a fully bridged law, with the bridge statements it declares). Emitted only when the `laws` array is nonempty. | -| `Bridge.lean` | One plan-equals-source bridge per manifest `sourceBridges` entry, the composed corollary restating that export's obligation with the plan model replaced by the source function, and the corollary the manifest names. Emitted only when the `sourceBridges` array is nonempty. | -| Model modules (`AverCommon.lean`, `.lean`, ...) | The `aver proof` Lean model emission, copied with every `deriving` line stripped (the staging token scan rejects `deriving`). These carry the source-model definitions the obligations reference. A dotted module dependency (`Data.Fibonacci`) ships its model at the corresponding nested path (`Data/Fibonacci.lean`) and is imported by `Manifest.lean` and `Certificate.lean` under its dotted module name (`import Data.Fibonacci`). | - -The producer never emits — and MUST NOT emit — `ArtifactBytes.lean` (checker-generated from the embedded core module bytes, section 7), `ArtifactComponentBytes.lean` (checker-generated from the delivered target artifact bytes, section 7), `CheckerWitness.lean` (checker-authored, section 8), `lakefile.lean`, `lean-toolchain`, any wall source file, any build cache, or plan sidecar files (`*.plan`, JSON plan ASTs). +| `cert-manifest.json` | Transport and report envelope (section 4). The only non-Lean file. | +| `Plans.lean` | `AverCert.Plans.types : TypeTable` and one `FnPlan` per planned function, collected in `AverCert.Plans.fnPlans : List FnEntry`. | +| `Manifest.lean` | `AverCert.subject` and `AverCert.manifest`, whose `obligations` field is literally `AcceptedArtifact.obligationsOf subject Plans.types Plans.fnPlans`. | +| `ArtifactLayout.lean` | The declared module layout (`DeclaredLayout.Layout`): the imported function count; for every defined function its type index and the byte offset and length of its code entry, as packed tables; the exact function type of every planned function; every plan entry's name, as characters, with its export position; and the section cuts, the byte length of every top-level entry of the type section, of every export and of every code entry. Producer data: `types_cut`, `exports_cut` and `code_cut` confirm the cuts and `layout_ok` the layout against the staged bytes (section 7.7). | +| `ArtifactHostRoles.lean` | Carriered modules only: one `decide +kernel` theorem per Int helper role, each proving `arithRoleCheck` for that role. | +| `ArtifactPlans.lean` | `plans_all`: every plan passes `entryAccepted`, proved 32 plans per `decide +kernel` declaration and chained. A package with more than 32 plans puts each chunk in its own `ArtifactPlans.lean` over `ArtifactPlanCheck.lean`. | +| `Artifact.lean` | `AverCert.Artifact.data : ArtifactData` and the byte facts of acceptance: `plans_ok`, `roles_ok`, `strings_ok`, `axes_ok`, `framing_ok`, `exports_ok`, `imports_ok`, `start_ok`, `closure_ok`, `whole_ok`, `envelope_ok`. A package with more than 32 plans moves the data and the heaviest facts to `ArtifactData.lean`, `ArtifactStrings.lean`, `ArtifactClosure.lean` and `ArtifactInterface.lean`, which Lake can build in parallel. | +| `Final.lean` | `theorem AverCert.Final.cert : AverCert.Schema.Holds manifest`, proved by `AcceptanceSoundness.accept_sound` from `plans_ok`. | +| `ArtifactCertificate.lean` | The public root `theorem AverCert.Artifact.certificate : AverCert.AcceptedArtifact.accepted data`, followed by `#print axioms`. | +| `AverModel/**.lean` | The `aver proof` Lean model of the source, in certificate mode. Shipped only when the package declares a source-bridge or a law-claim. | +| `BridgeDefs.lean`, `BridgeSteps.lean`, `BridgeProof.lean`, `Bridge.lean` | Source-bridge proofs (section 9). Emitted only when `sourceBridges` is nonempty. | +| `Laws.lean` | One corollary per `laws` entry (section 9). Emitted only when `laws` is nonempty. | + +Model files ship under the reserved directory `AverModel/`, whatever the Aver module is called, so no model root can equal or prefix a package, wall or toolchain root. The Lean namespaces inside stay as emitted. Certificate mode differs from `aver proof` export in three ways the staging gates require: the prelude pieces the token scan refuses (`AverBits` with its `@[simp]` equations, and the `syntax`/`macro_rules` tactic `aver_int_order`) are imported from the wall module `ModelPrelude` instead of emitted; a type keeps only the `deriving` clauses stage 7 admits and states its `Inhabited` instance explicitly; and every theorem is prefixed with `#guard_msgs (drop error) in`, so a proof that fails (a `maxHeartbeats` timeout included) leaves `sorryAx` for the axiom audit to find instead of failing the build. The wrapper changes no declaration and admits nothing the kernel did not check. Before shipping, the producer runs the checker's own file-name, case-collision and token rules (`aver-cert/src/lean_gate.rs`) over every model file; a model that would fail them is not shipped, and every bridge and law-claim is declined with the reason. + +The producer never emits, and MUST NOT emit, `ArtifactBytes.lean`, `ArtifactComponentBytes.lean`, `Module.lean`, `CheckerWitness.lean`, `CheckerAudit.lean`, `lakefile.lean`, `lean-toolchain`, any wall source, any build cache, or plan sidecars (`*.plan`, JSON plan trees). ### 2.2 What acceptance requires of the file set -Acceptance is deliberately indifferent to layout. The staging rules of section 9 (stages 5–7) are the complete file-level contract: every regular file directly in the package directory whose name ends in `.lean` (case-sensitively) is staged, unless its exact name is checker-owned — then it is silently ignored. A `.lean` file in a subdirectory (a nested model module such as `Apps/Notepad/Store.lean`) is staged at its relative path exactly when the staged top-level `Manifest.lean` or `Certificate.lean` carries an `import` line naming its dotted module name (`import Apps.Notepad.Store`) — the producer imports every model root from those two files, so admission is a one-level check with no transitive closure. That admission list is authored by the untrusted producer: it is build-set minimization, not a security boundary — every staged file, flat or nested, passes the same stage-6/7 gates, and the verdict rests on the checker-authored witness of section 8 (see stage 5 for the literal, comment-blind import-line scan a reimplementor must match). Every path segment of a nested file must pass the stage-6 identifier rule, dot-directories (`.lake`, `.git`) are skipped entirely at every depth, nesting is capped at 16 directory levels, and two staged paths equal ASCII-case-insensitively are rejected outright. Everything else (unimported nested `.lean` files, non-`.lean` files, sidecars) is ignored outright. Consequences a reimplementor MUST NOT get wrong: +Acceptance does not depend on layout. The staging rules of section 11 (stages 5 to 7) are the whole file-level contract. Every regular file directly in the package directory whose name ends in `.lean` (case-sensitively) is staged, unless its name is checker-owned, in which case it is ignored. A `.lean` file in a subdirectory is staged at its relative path only when the staged top-level `Manifest.lean`, `Certificate.lean`, `Bridge.lean` or `Laws.lean` has an `import` line naming its dotted module name. That admission list is written by the untrusted producer, so it limits the build set and is not a security boundary: every staged file passes the same gates, and the verdict rests on the checker-authored witness. + +Consequences a reimplementor MUST get right: -- **No closed file set.** Extra `.lean` roots beyond the conventional table are staged and built like any other package file, and a missing conventional file is not itself an error. The verdict comes from whether the staged set elaborates and the accepted root holds at its pinned type — not from which files exist. -- **`Plans.lean` is not load-bearing.** The checker witness imports `AcceptedArtifact`, `ArtifactBytes`, `ArtifactComponentBytes`, `Manifest`, `Artifact`, and `ArtifactCertificate` — plus `Laws` exactly when the manifest's `laws` array is nonempty and `Bridge` exactly when its `sourceBridges` array is nonempty — never `Plans` directly. The plan values the manifest and claims reference may be defined in any staged file, and the reference producer emits nothing in `Plans.lean` but those values: it used to also emit `rfl` examples restating each plan's passage through the audited checkers, lowerers and byte slicer, and those are not emitted any more, because the acceptance predicates state the same equalities themselves (section 6.4). Dropping them is not only redundancy removal. `Plans.lean` carries no `maxHeartbeats` raise, while `Artifact.lean` and `Certificate.lean` — the files acceptance does rest on — raise it eightfold, so past roughly a hundred kilobytes of wasm the examples' whole-module byte slices were the first and only declarations to exhaust Lean's default per-declaration budget, and a package could fail to build on the one file whose contents the verdict never reads. A verifier MUST NOT require the examples, and MUST NOT read a package's `Plans.lean` as a claim. -- **`Module.lean` names are not load-bearing.** Acceptance binds each lowered body to the obligation's `code` table and to the artifact bytes (section 6.4), not to definitions named `CertModule.*Code`; the wall references `CertModule` only for `wasmSha256` (`Schema.Holds`, section 5). -- Every staged `.lean` file is untrusted data. It participates in the verdict only after the staging gates of section 9 and only because the Lean kernel accepts the resulting proof against checker-pinned facts. +- There is no closed file set. Extra `.lean` roots are staged and built like any other package file, and a missing conventional file is not itself an error. The verdict depends on whether the staged set elaborates and the root holds at its pinned type. +- `Plans.lean` is not special. The witness imports `AcceptedArtifact`, `ArtifactBytes`, `Manifest`, `Artifact` and `ArtifactCertificate`, plus `Laws` when `laws` is nonempty and `Bridge` when `sourceBridges` is nonempty. The plans are whatever `AverCert.manifest.fnPlans` evaluates to, wherever the package defines them. +- Every staged `.lean` file is untrusted data. It affects the verdict only through the kernel accepting the witness. -Module roots that case-insensitively collide with a toolchain root, a wall source root, or a checker-owned root are rejected at staging (section 9, stage 6); for a nested file the check covers the dotted module name and every dotted prefix of it (`Lean/Extra.lean` is rejected like a flat `Lean.lean`). Two staged package paths that are equal ASCII-case-insensitively (`Foo.lean` and `foo.lean`, `Apps/Store.lean` and `apps/Store.lean`) are rejected outright, so the staged tree is identical on case-sensitive and case-insensitive filesystems. *Known gap:* the `.lean` suffix test itself is case-sensitive, so a file named `ArtifactBytes.LEAN` is silently ignored rather than rejected. +A module root that case-insensitively equals or has a dotted prefix equal to a toolchain root, a wall root or a checker-owned root is rejected (stage 6). Two staged paths equal ASCII-case-insensitively are rejected. *Known gap:* the `.lean` suffix test is case-sensitive, so `ArtifactBytes.LEAN` is ignored rather than rejected. -## 3. Trust vocabulary: kernel-pinned versus declared-only +## 3. Trust vocabulary -The manifest JSON is a transport envelope. The authoritative statement is the Lean value `AverCert.manifest` in `Manifest.lean` together with the claim data in `Artifact.lean`, and the verifier's checker witness pins the JSON's trust-bearing fields to that Lean value by `rfl` (section 8). Consequently every `cert-manifest.json` field is in one of two base classes (a few rows in section 4 carry a noted refinement: a pinned string whose *value* is not validated against any expected identifier, or a pinned pair whose name is byte-accounted while its prose is not): +The JSON manifest is a transport envelope. The authoritative statement is the Lean value `AverCert.manifest` together with `AverCert.Artifact.data`, and the checker witness pins the JSON's trust-bearing fields to that Lean data by `rfl` (section 10). Every JSON field is therefore one of: -- **Kernel-pinned**: the witness (or the accepted-artifact proposition itself) states an equality between the JSON-derived value and the Lean manifest/claim data, and the wall further binds that Lean data to the artifact bytes. Tampering with the JSON, the Lean data, or the bytes independently makes elaboration fail. -- **Declared-only**: transported for reporting. The reference verifier either never reads the field on the acceptance path or reads it only to print it with an explicit "declared" label. The `certified[].dom` / `certified[].cod` strings are the deliberate example: the source-facing domain/codomain prose is display-only and unpinned **by design**, because the pinned semantic face lives in the typed `Obligation` (Dom/Cod types and representation relations) and in `StandardFace`, not in a string. The CERTIFIED/CHECKED report MUST print only kernel-pinned facts; `explain` MAY print declared-only values with an explicit label. +- **Kernel-pinned**: the witness or the accepted-artifact proposition states an equality between the JSON-derived value and the Lean data, and the wall binds that Lean data to the bytes. Changing the JSON, the Lean data or the bytes on its own makes elaboration fail. +- **Declared-only**: transported for reporting. The verifier either never reads it on the acceptance path or prints it with an explicit "declared" label. The CERTIFIED and CHECKED report MUST print only kernel-pinned facts; `explain` MAY print declared-only values under a label. -## 4. `cert-manifest.json`, schema version 8 +## 4. `cert-manifest.json`, schema version 9 -The manifest is a single JSON object. The reference parser is strict about the fields it reads: a missing or mistyped required field is a hard error. String fields that are later interpolated into the checker witness pass a candidate gate first: at most 200 bytes, every byte in `0x20..=0x7E`, and neither `"` nor `\` (this makes Lean string-literal injection unrepresentable). The gated strings are: each certified export's `name`, `class`, `dom`, `cod`; every `runtime_contracts` entry; every `declaredUncertified` name and reason; every `capabilities` module and name; `target`; `profile`; and `abi`. +The manifest is one JSON object. The reference parser is strict about the fields it reads: a missing or mistyped required field is an error. Strings that the witness interpolates pass a candidate gate first: at most 200 bytes, every byte in `0x20..=0x7E`, and neither `"` nor `\`. The gated strings are each certified export's `name`, `class` and `facets`; every `runtime_contracts` entry; every `declaredUncertified` name and reason; every `capabilities` module and name; `target`; `profile`; and `abi`. -> **TODO-decision: top-level strictness.** Nested objects are matched exactly (an unexpected or missing key inside `start`, `hostRoleTable`, `stringHostRoles[]`, `declaredUncertified[]`, or `capabilities[]` is an error), but unknown top-level members are currently ignored by the reference verifier. Whether a frozen schema requires rejecting unknown top-level members is an open decision; producers MUST NOT rely on the current leniency. +> **TODO-decision: top-level strictness.** Nested objects are matched exactly, but unknown top-level members are ignored by the reference verifier. Whether a frozen schema rejects them is open; producers MUST NOT rely on the leniency. ### 4.1 Top-level fields | Field | Type | Trust class | Meaning and constraints | |---|---|---|---| -| `schema_version` | integer | verifier-checked | MUST be exactly `8`. | -| `format` | object `{version, wall_id}` | verifier-checked | `version` MUST be exactly `1`; `wall_id` MUST resolve to an embedded wall (section 1). | -| `wasm` | string | declared-only | The artifact filename the producer emitted next to the package. Never read on the acceptance path; the artifact identity is the file the caller passes to the verifier. | -| `wasm_sha256` | string, 64 lowercase hex | kernel-pinned | SHA-256 of the exact artifact bytes. The verifier MUST recompute the hash of the supplied `.wasm` and reject on mismatch; the witness additionally pins `manifest.subject.artifactHash` to the recomputed hash, and `Schema.Holds` conjoins `artifactHash = CertModule.wasmSha256` (section 7). | -| `target` | string | verifier-checked and kernel-pinned | Artifact-envelope target. In schema 8 this MUST be either `"wasm-gc"` or `"wasip2"`; the reference verifier reads it before WebAssembly validation and selects the target-specific artifact preparation path instead of reinterpreting bytes. The witness pins the JSON string to `subject.target`, and `Schema.Holds` checks the target/ABI pair against checker-owned constants. | -| `level` | string | declared-only | `"L1"`, `"L3"`, or `"mixed L1/L3"`. The verifier computes its own level banner from the pinned policies and never reads this field. | -| `profile` | string | verifier-checked and kernel-pinned | Emitted-fragment profile identifier. In schema 8 this MUST be exactly `"AverUserProfile/v1"`; the witness pins the JSON string to `subject.profile`, and `Schema.Holds` checks it against the wall constant `expectedProfile`. | -| `abi` | string | verifier-checked and kernel-pinned | Runtime ABI identifier. In schema 8 this MUST be `"aver-wasm-gc/0"` for `target = "wasm-gc"` and `"aver-wasip2/0"` for `target = "wasip2"`; the witness pins the JSON string to `subject.abi`, and `Schema.Holds` checks the target/ABI pair against checker-owned constants. | -| `final_theorem` | string | declared-only | `"AverCert.Final.cert"`. Informational; the checker consumes the artifact root below, not this name. | -| `artifact_certificate_root` | string | verifier-checked and kernel-pinned | MUST be exactly `"AverCert.Artifact.certificate"`. Checked in Rust, pinned to `subject.artifactRoot` by the witness, and re-checked in-kernel by `subjectMatchesArtifactRoot`. | -| `carrier_type_index` | integer or `null` | declared-only | The wasm type index of the Int carrier struct, `null` for carrierless modules. The kernel derives the carrier independently via `CertDecode.carrierState`; this field is reporting convenience. | -| `laws` | array of objects | kernel-pinned | REQUIRED (may be empty). The law-claims surface: one entry per claimed universal model law, each an exact object `{label, theorem, statement, corollary, bridges}`. `label` is the source `module.fn.law` identity; `theorem` the fully qualified model theorem; `statement` its verbatim single-line universal statement; `corollary` MUST be exactly the label with every `.` replaced by `_`, naming the package's `AverCert.Laws.` theorem. These strings pass a law-specific gate, not the printable-ASCII candidate gate: `label`/`theorem`/`corollary` must be plain dotted identifiers (`^[A-Za-z_][A-Za-z0-9_]*(\.[A-Za-z_][A-Za-z0-9_]*)*$`, ≤200 bytes); `statement` must be nonempty, ≤2000 bytes, contain no newline, `:=`, `--`, or `/-`, and have balanced `()[]{}⟨⟩` with depth never negative (statements are legitimately non-ASCII: `∀`, `∧`, `→`). `bridges` is REQUIRED (may be empty): an array of certified export names, each of which MUST appear in `sourceBridges`, listed at most once. The producer fills it with every model function the statement mentions when all of them are bridged, and leaves it empty otherwise. A claim with a non-empty `bridges` carries TWO pinned corollaries, not one: `AverCert.Laws.` at exactly `(statement) ∧ Holds`, and `AverCert.Laws._bridged` at that same conjunction plus the RENDERED bridge statements of the listed exports, in the declared order. The `_bridged` name is checker-derived and never transported. The split is normative rather than cosmetic: a bridge whose proof leaves the axiom whitelist taints every declaration that cites it, so a single wider corollary made one unfinished bridge remove the credit of every law that merely MENTIONS the bridged function — a claim about the source model that the bridge plays no part in proving. A conforming verifier MUST therefore pin and audit the two separately, and MUST NOT let bridge credit move law credit. Which bridges a claim lists is a producer CHOICE and is declared-only in that sense — its only effect is which further conjuncts the second pin carries and the package's `_bridged` corollary must prove. It can neither weaken the law conjunct nor add an unproven one: listing a bridge the package's `_bridged` corollary does not prove DECLINES the package (the pin has no such term), while listing fewer than it happens to prove simply leaves the claim out of the bridged surface, which claims less rather than more. A reader takes what a claim covers from the pinned statements, not from the export names in this list. The witness re-elaborates each corollary at exactly its declared type and audits its axioms (section 8). Each pin has exactly two outcomes: **credited**, when it elaborates and its axiom closure stays inside the whitelist; **not credited**, when the pin elaborates but its closure leaves the whitelist (`sorryAx`, `Lean.ofReduceBool`, any user axiom). Not-credited is the law-claim analogue of `declaredUncertified` for exports: the claim is reported as uncredited, naming the offending axioms, and the package verdict and exit code remain the exports' alone. A pin that does not ELABORATE is neither — the declared statement is then not what the package proves, and the whole package is DECLINED. An empty array means no `Laws.lean` is emitted. | -| `sourceBridges` | array of objects | kernel-pinned | REQUIRED (may be empty). The plan-equals-source surface: one entry per certified export whose obligation `model` is the evaluation of a declared plan (today: the record projection-compute face), each an exact object `{export, theorem, corollary, model, params, result}`. **The entry carries STRUCTURE, never statement text.** The verifier RENDERS the pinned statement from `(export, model, params, result)` and pins the package's corollary at exactly that rendered text; a conforming verifier MUST NOT accept a statement supplied by the package, and MUST reject an entry that carries one (the object is matched exactly). The reason is that a declared statement need only pass the syntactic gates to be pinned, audited clean and credited, and `_root_.M.f x = _root_.M.f x` passes every one of them while proving nothing. `export` MUST be a plain undotted identifier naming an entry of `certified[]`, listed at most once; it is also what fixes the plan the statement speaks about (`_root_.AverCert.Plans.Plan.body`), so an entry cannot point its claim at another export's plan. `theorem` MUST be exactly `AverCert.Bridge.` and `corollary` exactly `AverCert.Bridge._certified`, so a bridge entry can never point the pin at some other declaration. `model` is the fully qualified transpiled source function the bridge identifies the plan with, a plain dotted identifier of at most 200 bytes; it is SPLICED into the rendered statement, so an export's `model: plan ≡ ` line can never show a function the checked claim does not mention. `params` is an array of encoder specs in source declaration order, `result` a single encoder spec. An encoder spec is an exact object in one of exactly three closed forms: `{"kind": "int"}`, `{"kind": "bool"}`, or `{"kind": "record", "type": "<_root_.-qualified Lean type>", "fields": ["<_root_.-qualified accessor>", …]}`. Any other `kind`, an object with other members, or a record whose `type` is not a `_root_.`-qualified plain dotted identifier or whose `fields` are not a nonempty list of accessors OF that type, DECLINES the package. The rendered statement is exactly `∀ (x0 : T0) …, _root_.AverCert.StandardFace.recordComputeModel _root_.AverCert.Plans.Plan.body [enc(x0), …] = _root_.Option.some (encRes (_root_. x0 …))`, where `Int ↦ SVal.i`, `Bool ↦ SVal.b`, and a record ↦ `SVal.r` of its declared accessors applied to the binder, in the declared order; a nullary export renders without the quantifier and with the bare source name. The rendered text is still put through the law-claim statement gate (nonempty, ≤2000 bytes, no control character, no `:=`, `--` or `/-`, balanced delimiters) and one further gate of its own — every dotted name in it MUST be spelled `_root_.`-first, because the bridge pin elaborates at the root namespace with no `open` — which keeps the pin's shape independent of any encoder added later. The witness re-elaborates every corollary at exactly the rendered statement conjoined with `Holds` and audits its axioms (section 8), with the SAME two outcomes and the same credit semantics as a law-claim: **credited** when the pin elaborates and its axiom closure stays inside the whitelist, **not credited** when the closure leaves it (named on the report, exports and exit code untouched), and a pin that does not ELABORATE DECLINES the whole package. Only a credited bridge turns an export's `explain` model line from `model: plan` into `model: plan ≡ .`. An empty array means no `Bridge.lean` is emitted. | -| `sourceBridgesDeclined` | array of `{export, reason}` | declared-only | Compute-face exports the producer declared NO bridge for, with the reason it refused (an unsupported encoder shape, an unresolvable source signature). Never read on the acceptance path; `explain` prints it under an explicit informational heading so the package itself says why an export's model stays the plan, instead of leaving that on the producer's stdout. The reasons are producer prose and are neither pinned nor validated. | -| `runtime_contracts` | array of strings | kernel-pinned | The named runtime contracts every certificate is conditional on. Pinned to `subject.contracts`. This is an **ordered list, not a set**: the in-kernel `ClaimAxes` check independently derives the exact required contract list from the checked claims — assembled in the canonical order box, add, sub, mul, String.eq, String.concat, toIndex, cmp, eq, add-total, sub-total, mul-total — and compares by exact list equality, so permuting the same strings rejects. | -| `declaredUncertified` | array of `{name, reason}` | kernel-pinned (names); reasons pinned but unvalidated | Exports outside the claimed obligations, each with a reason. The `{name, reason}` pairs are pinned JSON-to-Lean to `subject.declaredUncertified`, but the byte-level accounting consumes only the **names**: the in-kernel `exportsAccounted` check requires that every byte-derived module export is either a claimed obligation (matching name, kind, and function index) or listed here by name, with both lists duplicate-free, disjoint, and free of phantom names. Each `reason` is transported prose — printable-gated and equality-pinned, but neither byte-derived nor semantically validated. | -| `capabilities` | array of `{module, name}` | kernel-pinned | The exact effect-import surface, in import-section order. Pinned to `subject.capabilities`; the in-kernel `importsWithinCapabilities` check requires the byte-derived import section to equal this list exactly and selects a closed registry from `subject.target`. `wasm-gc` admits the kernel-owned Aver host pairs mirrored by the verifier's `WASM_GC_CAPABILITIES`; `wasip2` admits the exact canonical-ABI pairs mirrored by `WASIP2_CAPABILITIES`, including pinned WASI interface versions. Both targets additionally admit only the exact contract-derived hashed custom-capability namespace grammar. | -| `start` | object `{present, function_index}` | kernel-pinned | Exactly these two keys. `present: false` MUST pair with `function_index: null`; `present: true` MUST pair with a `u32`. Pinned to `subject.start`; the in-kernel `startAccounted` check equates it with the byte-derived start-section decode. | -| `hostRoleTable` | `null` or object `{box, add, mul, sub, toIndex, cmp, eq}` | kernel-pinned | See section 4.3. | -| `stringHostRoles` | array of `{function_index, role}` | kernel-pinned | `role` MUST be `"stringEq"` or `"stringConcat"`; `function_index` a `u32`. Pinned to `subject.stringHostRoles` and bound in-kernel to `CertDecode.StringHost.roleTable` recomputed from the bytes. The decode classifies every defined function independently and emits matches in **defined-function order**, retaining duplicate roles at distinct indices; the bind is exact list equality, order and multiplicity included. | -| `certified` | array of objects | mixed; see 4.2 | One entry per certified export, in manifest-obligation order. | -| `wasip2ComponentEnvelope` | object `{kind, prefix_len, embedded_core_module_len, suffix_len}` | kernel-pinned when `target = "wasip2"` | Required for `target = "wasip2"` and rejected for `target = "wasm-gc"`. See section 4.5. | -| `source_level_only` | array of `{name, reason}` | declared-only | Functions the producer declined to certify, with reasons. Never read on the acceptance path. `explain` prints it under an explicit informational heading, but only for packages with at least one certified export, and from a second manifest read performed after the verdict (see the known gap in section 9, stage 12). The fail-closed emission policy — a declined function gets an entry here rather than a weaker theorem — is producer behavior, not an acceptance-checked fact; whole-module accounting relies on `declaredUncertified`, not on this list. | - -Declared-only rows describe producer output. The reference verifier never reads `wasm`, `level`, `final_theorem`, `carrier_type_index`, `certified[].level`, `certified[].theorem`, `sourceBridgesDeclined`, or `source_level_only` on the acceptance path — and therefore does not type-check them either. Their tabulated types and example values are producer conventions, not acceptance requirements; a package in which they are missing or mistyped still verifies. +| `schema_version` | integer | verifier-checked | MUST be exactly `9`. | +| `format` | object `{version, wall_id}` | verifier-checked | `version` MUST be `1`; `wall_id` MUST resolve to an embedded wall. | +| `wasm` | string | declared-only | The artifact file name the producer wrote. The artifact identity is the file passed to the verifier. | +| `wasm_sha256` | 64 lowercase hex | kernel-pinned | SHA-256 of the delivered artifact (the whole component for wasip2). The verifier MUST recompute it and reject a mismatch; the witness pins `subject.artifactHash` to the recomputed value, and `Schema.Holds` requires `artifactHash = CertModule.wasmSha256`, a string the verifier renders into the checker-owned `Module.lean` from the same hash. | +| `target` | string | verifier-checked, kernel-pinned | `"wasm-gc"` or `"wasip2"`. Read before WebAssembly validation to select the preparation path. Pinned to `subject.target`; `Schema.Holds` checks the target and ABI pair. | +| `level` | string | declared-only | `"L1"`, `"L3"` or `"mixed L1/L3"`. The verifier computes its own level from the pinned policies. | +| `profile` | string | verifier-checked, kernel-pinned | MUST be `"AverUserProfile/v1"`. Pinned to `subject.profile` and checked against `expectedProfile`. | +| `abi` | string | verifier-checked, kernel-pinned | `"aver-wasm-gc/0"` for `wasm-gc`, `"aver-wasip2/0"` for `wasip2`. Pinned to `subject.abi`. | +| `final_theorem` | string | declared-only | `"AverCert.Final.cert"`. | +| `artifact_certificate_root` | string | verifier-checked, kernel-pinned | MUST be `"AverCert.Artifact.certificate"`. Pinned to `subject.artifactRoot` and re-checked by `subjectMatchesArtifactRoot`. | +| `carrier_type_index` | integer or `null` | declared-only | The Int carrier struct index. The wall derives the carrier itself (`CertDecode.carrierState`, `TypeTable.carrierConfirmed`). | +| `runtime_contracts` | array of strings | kernel-pinned | Pinned to `subject.contracts`. The wall's `ClaimAxes.contractsMatch` requires exact list equality with the list it derives (section 7.4), so order matters. | +| `laws` | array of objects | kernel-pinned | REQUIRED, may be empty. Section 9.3. | +| `sourceBridges` | array of objects | kernel-pinned | REQUIRED, may be empty. Section 9.2. | +| `sourceBridgesDeclined` | array of `{export, reason}` | declared-only | Certified exports the producer declared no bridge for, with its reason. `explain` prints it under an informational heading. | +| `declaredUncertified` | array of `{name, reason}` | kernel-pinned (names); reasons pinned, not validated | Exports that are not obligations. Pinned to `subject.declaredUncertified`. `exportsAccounted` consumes the names only (section 7.5); each reason is transported prose. | +| `capabilities` | array of `{module, name}` | kernel-pinned | The import section, in order. Pinned to `subject.capabilities`; `importsWithinCapabilities` requires the byte-derived imports to equal it and each pair to be in the target's registry (`WASM_GC_CAPABILITIES`, `WASIP2_CAPABILITIES` with 80 pairs) or in the exact custom-capability namespace. | +| `start` | object `{present, function_index}` | kernel-pinned | `present: false` pairs with `function_index: null`, `present: true` with a `u32`. Pinned to `subject.start` and checked by `startAccounted`. | +| `hostRoleTable` | `null` or object `{box, add, mul, sub, toIndex, cmp, eq, divmod}` | kernel-pinned | Section 4.3. | +| `stringHostRoles` | array of `{function_index, role}` | kernel-pinned | `role` is `"stringEq"` or `"stringConcat"`. Pinned to `subject.stringHostRoles` and bound in the kernel to `CertDecode.StringHost.roleTable` recomputed from the bytes: every defined function is classified, matches are listed in defined-function order, duplicates kept, and the comparison is exact list equality. | +| `certified` | array of objects | mixed; section 4.2 | One entry per certified export, in obligation order. | +| `wasip2ComponentEnvelope` | object | kernel-pinned when `target = "wasip2"` | Required for wasip2, rejected for wasm-gc. Section 4.4. | +| `source_level_only` | array of `{name, reason}` | declared-only | Functions the producer declined, with reasons. `explain` prints it. | + +The reference verifier never reads `wasm`, `level`, `final_theorem`, `carrier_type_index`, `certified[].level`, `certified[].theorem`, `sourceBridgesDeclined` or `source_level_only` on the acceptance path, and does not type-check them. ### 4.2 `certified[]` entries | Field | Type | Trust class | Meaning and constraints | |---|---|---|---| -| `name` | string | kernel-pinned | The export name. Pinned three ways: `manifest.obligations.map export_`, `subject.exports`, and the first component of the `StandardFace.reportEntries` pairs. | -| `class` | string | kernel-pinned | The admitted family label. Pinned as the second component of `StandardFace.reportEntries`, which the **wall** derives from the checked claim family and plan — the producer cannot choose a more favourable label. Current labels: `expr-fragment-v1`, `verbatim-string-eq`, `verbatim-string-concat`, `adt-constructor`, `self-recursive`, `multi-argument self-recursive`, `mutual-recursive`, `verbatim-dispatch`, `int-dispatch`, `field-projection`, `cross-function-composition`. | -| `policy` | string | kernel-pinned | MUST be `"simulatesModel"` or `"simulatesModelTotally"`; anything else is rejected in Rust. Pinned to `manifest.obligations.map policy` and independently re-derived in-kernel by `ClaimAxes`. | -| `level` | string | declared-only | `"L1"` for `simulatesModel`, `"L3"` for `simulatesModelTotally`. Redundant with `policy`; not read by the verifier. | -| `dom`, `cod` | strings | **declared-only by design** | Source-facing domain/codomain prose. Never pinned by any witness line and MUST NOT appear on the CERTIFIED/CHECKED report; `explain` prints them labeled `manifest face (declared, not kernel-pinned)`. The verified face is the typed `Obligation.Dom`/`Cod` with their representation relations, enforced by `StandardFace`. | -| `theorem` | string | declared-only | The discharge theorem the producer used (e.g. `AcceptanceSoundness.exprFragment_claim_discharges`). Informational; acceptance consumes the single artifact root, not per-export theorem names. | -| `termination_witness` | object, optional | kernel-pinned | MUST be absent when `policy` is `"simulatesModel"` and present when `"simulatesModelTotally"` (both directions are hard errors). Shape: `{"measure": {"kind": "intNatAbs", "param_index": }, "descent": }`; `kind` MUST be `"intNatAbs"`. Pinned to `manifest.obligations.map termination?`. In-kernel, `ClaimAxes` accepts only the canonical witness `{measure := .intNatAbs 0, descent := -1}` and `Schema.checkTerm`/`checkTermMutual` verify it against the byte-bound recursion plan (floor guard at `n ≤ 0`, recursive argument exactly `sub(n, box 1)`). | +| `name` | string | kernel-pinned | The export name. Pinned as `manifest.obligations.map export_`, as `subject.exports`, and as the first component of `ClaimAxes.reportEntries` and `ClaimAxes.reportFacets`. | +| `class` | string | kernel-pinned | MUST be `"source-plan-v1"`; any other value is rejected in Rust. Pinned as the second component of `ClaimAxes.reportEntries`. | +| `facets` | array of strings | kernel-pinned | Pinned to `ClaimAxes.reportFacets`, which the wall derives from the plan and its call group, in the fixed order `recursive`, `mutual`, `calls`, `records`, `variants`, `strings`, `floats`. | +| `policy` | string | kernel-pinned | `"simulatesModel"` or `"simulatesModelTotally"`; anything else is rejected in Rust. Pinned to `manifest.obligations.map policy`, which the wall derives (section 8). | +| `level` | string | declared-only | `"L1"` or `"L3"`. | +| `theorem` | string | declared-only | `"AcceptanceSoundness.fn_claim_discharges"`. Informational. | +| `termination_witness` | object, conditional | kernel-pinned | MUST be absent for `simulatesModel` and present for `simulatesModelTotally`. Shape `{"measure": {"kind": "intNatAbs", "param_index": }, "descent": }`. Pinned to `manifest.obligations.map termination?`; the wall only ever derives the canonical witness `{measure := .intNatAbs 0, descent := -1}`. | -### 4.3 `hostRoleTable`: the declare-and-confirm host-helper pin +### 4.3 `hostRoleTable`: declared and confirmed Int helpers -`hostRoleTable` declares the module-wide box/add/mul/sub/toIndex/cmp/eq host-helper table used by plan lowering. Its JSON forms are: `null`, or an object with exactly the keys `box`, `add`, `mul`, `sub`, `toIndex`, `cmp`, `eq`, each a `u32` or `null`. The transport parser accepts all seven members as nullable, but in an **accepted** package the object form always has `box` bound: the object branch of the strict decode below is reachable only when the box-helper function export exists, so only `add`, `mul`, `sub`, `toIndex`, `cmp`, and `eq` may be `null` (an individual role may be unbound while the table as a whole exists). `toIndex`, `cmp`, and `eq` bind like `box`: by their named function exports — `__aint_to_index`, the fused vector-read index helper, and `__aint_cmp`/`__aint_eq`, the two Int value-comparison helpers — `null` exactly when no such export exists, and, like every other role, by an equality against the helper's actual code bytes. This maps to `Subject.hostRoleTable : Option CertDecode.AddSub.Roles` in the Lean manifest. +`hostRoleTable` declares the function index of each Int runtime helper: `box` (`__rt_aint_from_i64`), `add`, `sub`, `mul`, `toIndex` (`__aint_to_index`), `cmp` (`__aint_cmp`), `eq` (`__aint_eq`) and `divmod` (`__aint_divmod`). Its forms are `null`, or an object with exactly those eight keys, each a `u32` or `null`. It maps to `Subject.hostRoleTable : Option CertDecode.AddSub.Roles`. -The kernel binds the declaration to the module bytes with `AcceptedArtifact.arithTableCheck` — **declare-and-confirm**, not a byte fingerprint and not a role scan. The manifest states which function index carries each role; the wall synthesizes the canonical helper body from the declaration and pins the real code bytes equal to it, and for the four roles that also have a fixed runtime export name (`box`, `toIndex`, `cmp`, `eq`) it re-derives the index from the export section as well. Exactly two shapes close the pin, and mixing `null` with an object across `hostRoleTable`/`arithParams` fails closed. +The Lean manifest also carries `Subject.arithParams`, which has no JSON form: six declared indices (`carrier`, `limb`, `decompose`, `normalize`, `strip`, `umagCmp`) from which the wall synthesizes the helper bodies. Nothing in it is computed from bytes. -Note for reimplementors: unlike `hostRoleTable`, **`arithParams` has no JSON transport form**. It is `ArithTemplateDerisk.ArithHostParams` in the Lean manifest only — six declared indices (`carrier`, `limb`, `decompose`, `normalize`, `strip`, `umagCmp`) that the wall synthesizes helper bodies from. Nothing in it is computed from bytes; it is a declaration the template equality then confirms against the real code. **`arithParams.carrier` carries one further pin of its own**: a declared table requires `CertDecode.carrierState = some (some arithParams.carrier)`, so an admitted arith table implies the type section really holds an Int-carrier struct at exactly the index the synthesized helper bodies splice. Every other conjunct of this pin reads the export section or the code section, so without this one the declared carrier would be confirmed only by the bytes the wall itself synthesized from it, and a module whose type section holds no carrier-shaped struct at all could still present a table. That is reachable, not hypothetical: `isCarrier` requires the third field's storage tag to be `0x7f`, so a working carrier whose flag field is a packed `i8` (tag `0x78`) is invisible to it. A reimplementation MUST NOT drop this conjunct on the grounds that the template equality already constrains `carrier` — it constrains the helper bodies, not the type section. +`AcceptedArtifact.arithTableCheck` binds the declarations to the bytes. No byte is scanned to discover a role. Exactly two shapes pass, and mixing `null` with an object across the table and `arithParams` fails: -- **Carrierless** — `hostRoleTable: null` **and** `arithParams: null`, pinned by `CertDecode.AddSub.carrierHelperAbsent`: the export section decodes strictly and no **function export** is named `__rt_aint_from_i64`. A malformed or undecodable export section never certifies absence. This function-export-name absence is exactly what the pinned fact proves — no more. It does **not** by itself prove "the module has no Int carrier type" or "no Int runtime": an Int-carrier struct type, an unexported helper function, a differently named helper, or a non-function export bearing this name are all outside the pinned fact. A report or reimplementation MUST NOT present `hostRoleTable: null` as anything stronger; the operative consequence is the claim-matching rule below (no box/add/mul/sub/toIndex/cmp/eq role can be cited by any claim in such a module). -- **Carriered** — `hostRoleTable` present as an object, `arithParams` present, the `__rt_aint_from_i64` function export present, and all of: - - `box` equals the function index of the `__rt_aint_from_i64` export (**bound by export name**) **and** the code entry at that index equals the canonical `box` helper body synthesized from `arithParams` (**bound by template equality**, the same mechanism as `add`/`sub`/`mul`); - - `toIndex` equals the function index of the `__aint_to_index` export, and is `null` exactly when that export is absent (**bound by export name**, the same rule as `box`), **and** the code entry at that index equals the canonical `toIndex` helper body (**bound by template equality**). Unlike `box`, a carriered module may legitimately declare `toIndex: null`, because the producer emits that export only when a vector or list index extraction instantiated the helper. Both pins are kept because they answer different questions: the template equality is vacuous on `null`, so only the name binding makes `null` mean "the export is genuinely absent" rather than "no body was checked"; - - `cmp` and `eq` are bound by exactly the same two pins, against the `__aint_cmp` and `__aint_eq` exports and the canonical three-way-comparison and equality helper bodies. Like `toIndex` and unlike `box`, a carriered module may legitimately declare either as `null`, because the producer emits each of those exports only when a body it emitted resolved that helper, and each independently — an equality-only module exports `__aint_eq` and not `__aint_cmp`. (The signal is deliberately conservative: a body that resolves a helper and then falls back to a trap stub still raises it. The binding a verifier must enforce is unaffected either way — the role table is pinned two-way against the export section, whatever the producer's reason for exporting.) Nothing certifiable is lost by that: a comparison claim can only be made about a body that calls the helper, and such a body is exactly what makes the export appear. The export-name pin does more work on this pair than anywhere else: `cmp` and `eq` declare the **same** function type, so the declared-type conjunct of section 6.4 cannot separate them, and the template equalities separate them only where the declaration is `some`. Without the name equalities an artifact could swap the two roles outright, or export `__aint_cmp` while declaring `cmp: null` and thereby escape both pins; - - a note on what the template equality does and does not buy, since it is easy to read as more: it fixes WHICH code runs at those indices, not what that code computes. The wall never interprets these bodies. The runtime contracts for `box`, `toIndex`, `cmp`, and `eq` remain assumptions, disclosed through the claim axes exactly as before — what changes is that they now attach to a fixed, auditable constant instead of to whatever function the producer chose to export under that name; - - the `arithParams` indices lie inside the LEB regime the templates are written for (`checkArithHostParams`): all six indices are `< 2^32`, the whole u32 index space the wasm binary format admits. The template synthesis splices every index through the canonical LEB128 encoding wasm uses at that position — `call` targets and `struct.new`/`struct.get`/array-op type indices as **unsigned** u32 LEB (`CertPrelude.uleb32Bytes`), `ref.null` and `(ref null _)` heap-type positions as **signed** s33 LEB (`CertPrelude.s33Bytes`), where the sign bit makes 64 the first two-byte value (`64` encodes as `c0 00`, not `40`; unsigned positions grow their second byte at 128). Both encoders are total, fuel-bounded functions that are exact strictly beyond the u32 bound (unsigned below `2^35`, signed below `2^41`), so within the checked band every synthesized hole is the byte sequence a wasm encoder would emit. An earlier wall revision spliced each index as a single raw byte and bounded function indices below 128 and `limb` below 64; that made the synthesized body one byte short for any module whose helper indices need a two-byte LEB, i.e. large honest programs could not certify (a false negative, never a false accept); - - each non-`null` role — `box`, `toIndex`, `cmp`, `eq`, `add`, `sub`, `mul` — is pinned by **template equality**: the real code-section body at the declared function index equals the canonical helper body synthesized from `arithParams` alone. For `add`/`sub`/`mul` this is the whole binding; for `box`/`toIndex`/`cmp`/`eq` it is a second, independent pin on top of the export-name equality above. A `null` role is vacuously pinned — no claim can cite an unbound role, so no plan can use it. +- **Carrierless**: `hostRoleTable` and `arithParams` are both `null`, and `CertDecode.AddSub.carrierHelperAbsent` holds: the export section decodes strictly and has no function export named `__rt_aint_from_i64`. That is all the fact says. It does not prove the module has no Int carrier type or no Int code, and a verifier MUST NOT present it as more. +- **Carriered**: both are present, the `__rt_aint_from_i64` function export exists, and: + - `CertDecode.carrierState` finds a carrier struct at exactly `arithParams.carrier`, so the declared carrier is confirmed by the type section and not only by bodies the wall synthesized from it; + - `box`, `toIndex` and `cmp` equal the indices of their named function exports (`null` exactly when the export is absent); + - `checkArithHostParams` holds: every index is below `2^32`, the range in which the wall's LEB encoders are exact; + - every non-`null` role's code body equals the template `ArithTemplateDerisk.arithHelperBody` synthesizes for that role from `arithParams`. A `null` role passes vacuously; no plan can call it, because an undeclared index lowers to one no code entry can encode. -`box`, `toIndex`, `cmp`, and `eq` therefore carry **two** pins each, and a reimplementation MUST enforce both, because they constrain different things and neither implies the other: +`add`, `sub`, `mul`, `eq` and `divmod` are bound by template only. `eq` has no name pin because the emitter exports `__aint_eq` only when user code marks it live, while an Int literal match calls it anyway. `box`, `toIndex` and `cmp` carry both pins, and a reimplementation MUST enforce both: the name equality is the only pin with force on a `null` declaration, and the template equality is the only pin on the code behind an honestly named export. -- the **export-name** equality says at which index the role may be declared. It is the only pin with any force on a `null` declaration, since the template equality is vacuous there by construction. Drop it and "this module exports no `__aint_to_index`" stops being a byte-proved fact and becomes a producer's free choice. For `cmp` and `eq` it is additionally the only pin that tells the two roles apart, since they share a declared function type. -- the **template** equality says which bytes sit at that index. The export-name equality never reads the code behind the export, so without this a package could ship an honestly named `__rt_aint_from_i64`, `__aint_to_index`, `__aint_cmp`, or `__aint_eq` whose body is not the canonical helper at all. +The template equality fixes which code runs at a role index. It says nothing about what that code computes. The contracts of section 5.2 remain hypotheses of the theorem. -What the template equality does **not** establish is what that code computes. It identifies the code behind a role, never its meaning: the box, index-extraction, comparison and arithmetic contracts remain explicit hypotheses of `Obligation.holds` and remain disclosed by `ClaimAxes` (section 5.2). Pinning bytes narrows the artifact, not the trusted-computing base. +The declared function type of every present role is pinned separately (`roleTypesPinned`, section 7.2). -#### The canonical-carrier scope: what the helper contracts say, and what the projection-compute face therefore assumes about its inputs +### 4.4 Wasip2 component envelope -**(i) The contracts.** The three arithmetic contracts (`_hadd`/`_hsub`/`_hmul` in `Obligation.holds`) take represented operands with no canonicity premise and conclude `S.Repr (a ⊕ b) w ∧ S.Canon w` — a statement about the helper's **result** only, disclosed as `… result canonical`. The two comparison contracts (`_hCmp`/`_hEq`) are the other shape: they are **relational over a canonical pair**, quantified over two represented operands that are additionally `CarrierSpec.Canon`, and exact on the raw `i32` verdict they return. The disclosed strings say so: `__aint_cmp (canonical carrier pair -> i32 sign; …)`, `__aint_eq (canonical carrier pair -> i32 boolean; …)`. +Schema 6 and later admit `target = "wasip2"`, `abi = "aver-wasip2/0"` through the top-level field `wasip2ComponentEnvelope`. It is required for wasip2 and rejected for wasm-gc. It is a length-only object: -That scoping is forced, not stylistic. `CarrierSpec.smallIntro` admits `carrierSmall C k` as a representation of `k` for **every** `k`, so an unscoped relational premise would demand that the helper agree between a small carrier and a limb-carrying one denoting the same integer. `__aint_eq` decides that pair **structurally** — a `Small` against a `Big` is unequal outright — so the unscoped form is refutable at any carrier specification that models `Big` carriers at all, which would make every comparison obligation vacuous rather than strong. `__aint_cmp` branches first on the raw **sign fields**, which `CarrierSpec.bigElim` constrains only up to the sign/non-zero facts, so it is not satisfiable there either. Canonicity is the missing fact: `CarrierSpec.canonSmall` says a literal small carrier is canonical **exactly on** the i64 band (an iff — the backward direction is what puts every canonical `Small` inside the band), and `CarrierSpec.canonBig` says a canonical limb-carrying word denotes a value **outside** it with a non-zero sign. Together they rule out the pair that would break a structural decision: one integer denoted by both shapes at once. +```json +"wasip2ComponentEnvelope": { + "kind": "prefix-core-suffix/v1", + "prefix_len": 123, + "embedded_core_module_len": 456, + "suffix_len": 789 +} +``` -Be precise about what that buys, because it is easy to read as more. The two axioms do **not** establish that the real `__aint_cmp` and `__aint_eq` are exact on a canonical pair. Exactness is an **assumption** about those helpers at the runtime's own carrier specification, carried as an explicit hypothesis of `Obligation.holds` and validated empirically by `tests/cert_intcmp_differential.rs`; the `Canon` axioms are only what the proofs consume. `Obligation.holds` quantifies over **every** `CarrierSpec`, so a specification whose `Canon` marks words the runtime would never build satisfies this schema — it is simply not the instance a verdict is read at. The instance that matters is the runtime's, where `Canon` is the normal form described below. +The verifier splits the delivered component as `prefix ++ embedded_core_module ++ suffix` by those lengths, stages the whole component in checker-owned `ArtifactComponentBytes.lean` and the core in checker-owned `ArtifactBytes.lean`, and the wall's `artifactEnvelopeAccepted` checks that the split core equals the bytes the decoders read. The verifier MUST NOT parse, scan or navigate the component to find the core. The producer's `wit-component` wrapper may find the split while building the package; that is not an acceptance rule. -`SchemaSanity.lean` carries a concrete inhabitant of the extended `CarrierSpec` (`sanityCarrierSpec`, `#print axioms` = `[propext]`) whose `Canon` holds exactly for in-band small carriers and for limb-carrying words of out-of-band values with a sign of `-1` or `1`, so the six fields are known to be jointly satisfiable and `Canon` is neither `True` nor `False`. +## 5. The statement -**(ii) The certified domain of the record projection-compute face.** For that face — and for that face alone among the Int families — canonicity is **also a premise about the inputs**. Its domain representation is `StandardFace.recordComputeDomRepr`, built from `RecordComputeBridge.SReprAll`, and `SRepr` on an Int carrier is `S.Repr n w ∧ S.Canon w`. The claim is therefore stated about the carrier words handed to the exported function **and about the Int leaves of its record parameters**: all of them in the runtime's normal form. Since the face admits SCALAR parameters too (`recordComputeShapeOk`: either every parameter is a reference to the one pinned record, or every parameter is an Int carrier or a Bool), that premise now also covers plain `Int` arguments — the straight-line add-constant and value-versus-value comparison shapes, which used to carry their own faces, are compute claims and disclose this domain. A reimplementation MUST NOT report such an export as unconditional over arbitrary represented carriers, and MUST NOT present the canonical scope as a property of the helpers alone. The reason the face needs it is the same one the helpers need it for: the body decides on shape and fields — through `__aint_cmp`/`__aint_eq`, or through the inline sign template that reads the limb and sign fields directly — and only canonicity makes that agree with the integer order. +### 5.1 Manifest -**(iii) Why it holds of everything this runtime builds.** Every carrier the emitted module produces is in normal form, by **two** mechanisms, and a reimplementor who reads only the first will get the invariant wrong: +The Lean manifest (`SchemaCore.Manifest`) has four fields: -- the i64 fast paths build a `Small` **directly** with `struct.new`, without normalising anything: the box helper `builtins/wat/from_i64.wat` is exactly one `struct.new`, and so are the both-`Small` non-overflow arms of `builtins/wat/addsub.wat` and `builtins/wat/mul.wat`. Those words are normal because the value provably fits the i64 band; -- every arm that can produce a limb-carrying result ends in the normalisation epilogue, `builtins/wat/normalize.wat` — called as `__aint_normalize` where the shared helper is emitted, inlined otherwise — which strips leading limbs and demotes an in-band magnitude back to `Small`. +- `subject : Subject`: artifact hash, target, profile, ABI, artifact root, export names, declared-uncertified pairs, capabilities, start, `hostRoleTable`, `arithParams`, `stringHostRoles`, and the contract list; +- `types : TypeTable`: the declared layout (section 7.3); +- `fnPlans : List FnEntry`: every planned function. `FnEntry` is `{name, exported, funcIdx, group, plan}`; `name` is the export name, or `#` for an internal callee; `group` is the function's call group, callees first; +- `obligations : List Obligation`. -Earlier revisions of this document said the runtime "routes every carrier it builds through `__aint_normalize`", and concluded from that that canonicity was "not a restriction on the certified inputs". Both halves were wrong: the box helper and the arithmetic fast paths never call it, and the projection-compute face does restrict its inputs. The operative consequence for a reader of a verdict is unchanged in spirit but must be stated: a certified comparison or projection-compute export says nothing about a carrier that is not in normal form — the same epistemic position as `__aint_to_index`'s `-1` region, stated here rather than assumed away. An embedder that only ever passes back values this module produced is inside the certified domain; one that fabricates carrier words of its own is not. +An `Obligation` is `{export_, policy, termination?, totalityRole, carrier, layout, code, host, self, sig, model}`. The acceptance requires the obligations to be exactly `AcceptedArtifact.obligationsOf subject types fnPlans` (`obligationsDerived`), one per exported entry, so no field is a producer choice: `layout` is the lowering context the wall builds from the declarations (`TypeTable.mctxOf`), `code` maps each planned function index to the lowering of its plan, `host` wires the contract functions at their role indices, `sig` is the plan's signature, `model` is the fuel-indexed meaning of the plans (`groupModel`, where a body at fuel `k + 1` runs with every callee at fuel `k`, as the interpreter peels fuel), and the policy axes come from the totality check (section 8). -`tests/cert_intcmp_differential.rs` is the empirical tripwire: it runs the real helpers under wasmtime over a value set crossing every band edge, checks that the carriers produced by the boxing helper, by add/sub/mul, by Euclidean `Int.div`/`Int.mod`, and by the bitwise and power-of-two producers really are canonical, and asserts `__aint_cmp`/`__aint_eq` exact on every pair of runtime-produced values. The canonicity check decodes each limb-carrying carrier's magnitude array directly — non-empty, 32-bit digits, non-zero top limb, sign in `{-1, 1}` — and compares the reconstructed integer against an oracle computed outside the module, so a regression shared by a producer and by the two structural helpers cannot pass it. +### 5.2 Denotation -Reimplementor note: no byte is scanned to *discover* any role. A wrong declaration synthesizes different bytes and fails the equality. Earlier revisions of this document described the pin as an equality against a module-wide role *scan* (`roleTableStrict`); that scanner has been deleted from the wall, and only the five decoders named above (`boxIdx`, `toIndexIdx`, `cmpIdx`, `eqIdx`, `carrierHelperAbsent`) participate in binding this table. +`Obligation.holds` (policy `simulatesModel`, level L1): for every carrier specification `S`, every helper implementation `h` satisfying `HostContracts S h`, every fuel, every list of source values `svs` well-typed at the plan's parameters (`HasTyL`), and every list of wasm values `ws` representing them (`SReprL`), if the interpreter run `wFuncN code (host h) fuel self ws` returns `r`, then the model at that fuel returns some `sv` that `r` represents and that is well-typed at the plan's result. It is vacuous on a trap or on fuel exhaustion. -For claim matching, an absent table binds no roles at all (`Subject.hostRoles` maps `none` to the all-`none` table), so any claim citing a box/add/mul/sub/toIndex/cmp/eq role in a carrierless module fails to match — strictly fail-closed, never a default index. +Representation (`Grammar.SRepr`) reads values off the declared layout: an Int is a canonical carrier (`CanonRepr`: `S.Repr n w ∧ S.Canon w`); a Bool is `i32` 0 or 1; a record is the struct of its type, and a one-field record is its field's value; a variant is the struct of its constructor; `Option` and `Result` are the struct of their instantiation with the tag in field 0 and an arbitrary filler in the unused payload field; a Float is its `f64` bits; a String is the `$string` array of its bytes; a Vector is the array of its elements, fewer than `2^31`; a List is `null` or a `{head, tail}` cons struct; an opaque value is itself. -### 4.4 Target scoping: core fields versus the wasm envelope +`HostContracts S h` is the list of named runtime contracts, as hypotheses and never as Lean axioms: -The subject fields split along one criterion: what their kernel pin is stated against. Fields pinned against fixed constants or against other manifest data — `wasm_sha256`/`artifactHash` (the pin shape; the hash function itself is a target choice), `target`, `profile`, `abi`, `artifact_certificate_root`, the certified export names, `declaredUncertified`, and `runtime_contracts` — are **target-generic core**: they describe the claim structure and the selected envelope, not WebAssembly sections. Fields pinned against byte decoders over the embedded core module — `capabilities`, `start`, `hostRoleTable`, and `stringHostRoles` — are the **core wasm envelope**: facts about wasm sections (the import section, the start section, the Int-carrier helper exports, the string-helper function bodies) that only exist because the certified execution core is WebAssembly. Section 4.3 and the decode-bound rows above are envelope material, as are the byte-level mechanisms of sections 6–7 (the fragment IR, the byte lowering, the section framing and closure scan). Schema version 6 additionally has a target-artifact envelope for wasip2: it binds the delivered component bytes to the embedded core module bytes before the existing wasm envelope checks run. A future non-wasm execution core would keep the target-generic core — obligations, policies, plan-claim agreement, faces, axes, the whole-module accounting principles — and replace the wasm envelope with its own decoder-pinned facts. +- `add`, `sub`, `mul`: on represented operands, a returned result represents the exact sum, difference or product and is canonical; +- `cmp`, `eq`: on a canonical represented pair, the returned `i32` is the exact three-way sign or equality; +- `stringEq`: the result is byte equality of the two arrays; +- `stringConcat`: the result is the concatenation of the container's string arrays, at the declared result type; +- `toIndex`: the result is the `i32` index, or `-1` outside `[0, 2^31)`; +- `divmod`: on a canonical represented pair with a nonzero divisor and `want_mod` 0 or 1, the result represents Lean's `a / b` (`Int.ediv`) or `a % b` (`Int.emod`, in `[0, |b|)`) and is canonical. -### 4.5 Wasip2 component-envelope surface +A helper that returns nothing makes its premise vacuous; no contract demands trap-freedom. The box helper is not a contract: the obligation wires the wall's own `boxRef`, the model of the pinned box template. -Schema version 6 admits the target/ABI pair `target = "wasip2"`, `abi = "aver-wasip2/0"` through the top-level field `wasip2ComponentEnvelope`. The field is required for wasip2 and rejected for wasm-gc. +`Obligation.holdsTotal` (policy `simulatesModelTotally`, level L3): `holds`, and, under `HostTotal` (add and sub return on represented operands, and mul too when `totalityRole = .mul`), every well-typed represented input has an Int first argument `n`, the run at fuel `n.natAbs + 1` returns `r`, and the model at that fuel returns a value `r` represents. -The envelope declaration is a length-only object: +`HoldsCore m` says every obligation satisfies the denotation its policy selects. `Schema.Holds m` adds `m.subject.artifactHash = CertModule.wasmSha256`, `m.subject.profile = expectedProfile` and `artifactTargetAbiAccepted m.subject.target m.subject.abi = true`. -```json -"wasip2ComponentEnvelope": { - "kind": "prefix-core-suffix/v1", - "prefix_len": 123, - "embedded_core_module_len": 456, - "suffix_len": 789 -} -``` +### 5.3 The accepted artifact + +The root is `AverCert.Artifact.certificate : AverCert.AcceptedArtifact.accepted AverCert.Artifact.data`, where `ArtifactData` is `{modBytes, modLen, manifest, wasip2ComponentEnvelope, closureFuel, closureClaim}` and `accepted` is the conjunction of: + +1. `Schema.Holds artifact.manifest`; +2. `artifactEnvelopeAccepted` over the checker's `ArtifactComponentBytes` (identity for wasm-gc, the length split for wasip2); +3. `subjectMatchesArtifactRoot`; +4. `obligationsDerived`; +5. `plansAccepted` (section 7); +6. `decodedHostRoleTable` (section 4.3); +7. `decodedStringHostRoles`; +8. `ClaimAxes.checked`, which is `contractsMatch` (section 7.4); +9. `acceptedWholeModule` (section 7.5). + +`AcceptanceSoundness.accept_sound` proves the `Holds` conjunct from conjuncts 4 and 5 and the hash, profile and target premises, so a package derives `Holds` rather than asserting it. `AcceptanceSoundness.accepted_nonvacuous` shows that every certified export of an accepted artifact has well-typed arguments and an inhabited result type, so no obligation holds only because its hypothesis cannot be met. + +## 6. The plan + +### 6.1 Grammar + +A plan (`Grammar.FnPlan`) is `{sig, nslots, locals, body}`: the signature, the resolver slot count (parameters and every binder), the wasm types of the declared locals after the parameters, and the body. The body is the optimized MIR body (`src/ir/mir/expr.rs`, `MirExpr`) printed 1:1 into `Grammar.Expr`, which keeps MIR's node names. There is no hand-designed IR and no classifier. The printer (`src/codegen/cert/plan_from_mir.rs`) declines a whole function, naming the node, pattern or type, when anything falls outside the admitted subset: + +- `literal`: Int in the i64 range, Bool, Float by bit pattern, String by UTF-8 bytes; +- `local slot`, where the slot is the resolver `LocalId`, equal to the wasm local index; +- `let_ binding value body` for a named `Let`; +- `call (.fn idx)`, `call (.builtin b)` for `Bool.and`, `Bool.or`, `Bool.not` and `List.prepend`, `call (.lazy b)` for `Option.withDefault` and `Result.withDefault` (including the fused `Option.withDefault(Vector.get(v, i), )` and `Result.withDefault(Int.div|Int.mod(a, b), )`), and `call (.intrinsic i)` for Euclidean division or remainder by a nonzero literal; +- `tailCall target args`; +- `binOp` without `Div`: Int arithmetic and the six comparisons, Bool `==` and `!=`, Float comparisons except `!=`, String `+`, `==` and `!=`; +- `neg`, which the grammar has but the producer declines, because the negation helper has no wall template; +- `ifThenElse`; +- `recordCreate` with fields in declared order, and `project`, both for records of two or more fields; +- `match_` with the arm shapes the emitter lowers: an Int literal cascade with a catch-all last, a two-arm Bool match, a two-arm Option or Result match, a user-variant `ref.test` cascade of two or more arms covering every constructor, a String literal cascade with `_` last, and a single-arm flat tuple destructure; +- `construct` for user constructors and `Some`, `None`, `Ok`, `Err`, carrying the node's type; +- `interp` whose parts are all Strings; +- `list t []`, the empty list. + +The printer also declines a function that declares effects, uses raw i64 slots, has no MIR body, or whose parameters are not slots `0..n`. + +### 6.2 Typing and meaning + +`Grammar.tyOf` types a body over the slot environment and the lowering context. It admits only what `GrammarLower` can lower and `GrammarSound` covers, and it rejects arm shapes and operand types outside section 6.1. `planTyped` requires `tyOf` to return exactly `sig.ret` over the parameters, with the slot count consistent with the declared locals. The simulation theorem is false without typing: `struct.new` and the helpers accept operands the source would reject. + +`Grammar.eval` gives the source meaning, strict in every argument except the lazy default of `withDefault`. `groupModel` ties calls together by fuel. + +### 6.3 Lowering + +`GrammarLower` is a port of the wasm-gc MIR emitter (`src/codegen/wasm_gc/body/from_mir/`) for the admitted nodes. One lowering produces both the instruction tree the interpreter runs (`fnCode`) and the code-entry bytes the acceptance compares (`codeEntryBytes`, locals vector and size prefix included), so the proved code and the pinned bytes come from one tree. + +Every lowering choice is a function of the plan and the declarations, never a plan flag: an Int comparison against a literal looks for the literal on the left first and flips the operator, re-emits a bare local operand and stashes any other operand in the const-compare scratch local; the scratch locals sit after the resolver slots in the order the emitter reserves them; an `if` takes its block type from the then-branch type; a `tailCall` is `return_call` and a `call` is `call`, as MIR marked them. A reimplementation MUST compute both images inside the kernel and MUST NOT replace them with an out-of-kernel lowering. + +An index the declarations do not provide lowers to `TypeTable.absent k`, a value outside the u32 range that no encoder accepts, so a plan citing an undeclared type or helper cannot match any code entry. + +## 7. Pins + +`plansAccepted` is the conjunction of sections 7.1 to 7.3, evaluated inside the kernel against `ArtifactBytes`. + +### 7.1 Code entry + +For each `FnEntry` (`entryAccepted`): + +- `planTyped` holds; +- the function is found by its plan's own code entry: an exported entry through `WasmSlice.exactFuncBindingForExport` under its export name, an internal callee through `funcBindingByFuncIndex` at `funcIdx`, and either way the module's code entry MUST equal `codeEntryBytes` exactly; +- the bound function index equals `funcIdx`; +- the declared function type equals the plan's signature read through the layout (`sigPinned`); +- `callsOrdered`: every `call` and `tailCall` target is a planned function in the same call group or an earlier one. A call to an unplanned index declines. + +`indicesDistinct` requires the role indices and the planned function indices to be pairwise distinct, so every call resolves to one contract or one plan. + +`fn_claim_discharges` does not depend on the grouping: it applies `GrammarSound.fn_certified_group` to all plans at once by fuel induction. The grouping only affects L3 (section 8) and `callsOrdered`. + +### 7.2 Helper roles + +- `decodedHostRoleTable`: section 4.3. +- `decodedStringHostRoles`: section 4.1. +- `roleTypesPinned`: every present role's declared function type is exactly the type its role fixes: `box` `i64 -> carrier`; `add`, `sub`, `mul` `carrier carrier -> carrier`; `cmp` and `eq` `carrier carrier -> i32`; `toIndex` `carrier -> i32`; `divmod` `carrier carrier i32 -> carrier`; String equality `$string $string -> i32`; concatenation `Vector -> $string`. Body equality does not constrain the declared type, and a helper declared at a supertype still validates by subtyping, so this conjunct is required. + +### 7.3 Type table and data segments + +The type table (`Schema.TypeTable`) declares the carrier and its magnitude array, `$string`, `Vector`, records and tuples (`RecordDecl {tid, struct, fields}`), sums (`SumDecl {tid, root, ctors}`), `Option`, `Result`, `Vector` and `List` instantiations, opaque pass-through types, and the data segment of each string literal. `TypeTable.typeTableConfirmed` requires: + +- the type section decodes, and its first rectype is an explicit rec group (`0x4e`); every struct and array the table names is an entry of that group; +- `keysUnique`: record and sum type ids are unique; +- `carrierConfirmed`: the carrier is the one `CertDecode.carrierState` finds, or absent exactly when there is none, and a present carrier's field 1 is a nullable reference to the declared magnitude array, itself an `i64` array; +- no struct index serves two declarations; +- field storage: every record, tuple, constructor, `Option` (`{i32, T}`), `Result` (`{i32, T, E}`), `List` (`{T, ref null self}`) and `Vector` entry stores exactly the representation of its declared field types; `$string` is `(array (mut i8))` and `Vector` is `(array (ref null $string))`; a one-field record is represented by its field's value, whose heap type must be the record's declared index; +- every sum passes `Grammar.sumOk` (not a one-constructor, one-field newtype, and distinct constructor structs) and `GrammarLower.S3Pin`: the root is a non-final empty struct and every constructor struct is declared `sub final` under the root, read from the raw bytes of the opening rec group. This is what makes the interpreter's exact `ref.test` agree with the wasm subtype test (section 12). -The verifier uses those declared lengths to split the caller-supplied component as `prefix ++ embedded_core_module ++ suffix`, stages the full component bytes in checker-owned `ArtifactComponentBytes.lean`, stages the declared embedded core bytes in checker-owned `ArtifactBytes.lean`, and the wall's `artifactEnvelopeAccepted` predicate checks that the split's core byte list equals the bytes consumed by the existing wasm decoders. The split is driven only by the declared lengths; the trusted verifier path must not parse, scan, or navigate the delivered component to rediscover which core module is the Aver user core. The producer-side `wit-component` wrapper may discover the split while constructing the package, but that discovery is not an acceptance rule. +`TypeTable.dataConfirmed` requires every declared literal-to-segment entry to name a passive data segment holding exactly those bytes, and every string literal of every plan (literal nodes and literal match arms) to name such a segment (`GrammarLower.DataPin`). -## 5. Obligations, claims, and policies +`TypeTable.declsWellFormed` requires the declarations to be inhabited: `eqref` appears only as the subject-scratch local; no chain of one-field records loops; and every declared record and sum, and every parameter and result type of every plan, has a finite value (`inhabited`, proved sound by `inhabTy_sound`). Without it an obligation over an uninhabitable type would hold of any code. -The Lean manifest (`Schema.Manifest`) carries the subject, eleven per-family plan association lists keyed by export name (`symFragmentPlans`, `stringEqPlans`, `stringConcatPlans`, `constructPlans`, `exprFragmentPlans`, `recursionPlans`, `mutualPlans`, `compositionPlans`, `verbatimPlans`, `intDispatchPlans`, `fieldProjectionPlans`), and `obligations : List Obligation`. +A record's `tid` is the plans' own name for a type and is declared, not bound: a wrong id renames a confirmed layout and cannot change it. -An `Obligation` is the typed statement unit: export name, `policy`, optional `termination?` witness, `totalityRole` (default `.addSub`), the carrier type index, the emitted code table `code : CodeTbl` and host-table builder `host`, the export's own function index `self`, the source types `Dom`/`Cod`, the representation relations `domRepr : CarrierSpec carrier → Dom → List WVal → Prop` and `codRepr : CarrierSpec carrier → Cod → WVal → Prop`, and the source model `model : Dom → Cod`. +### 7.4 Runtime contracts -**`simulatesModel` (level L1, partial simulation).** `Obligation.holds` states: for every carrier specification `S`, every host implementation of add/sub/mul/String.eq/String.concat/`__aint_to_index`/`__aint_cmp`/`__aint_eq` satisfying the named contract laws (integer add/sub/mul preserve representation; String.eq computes byte equality; String.concat computes byte concatenation; the index extraction and the two comparisons return their exact `i32` verdicts), every fuel, and every represented domain value — if the emitted body evaluates to a result, that result represents `model x`. Vacuous on trap or fuel exhaustion. The contracts are explicit hypotheses of the theorem, never axioms. Their quantifier ranges differ and the difference is load-bearing: add/sub/mul are relational over `S.Repr` and additionally conclude that their **result** is canonical, the index extraction is relational on its argument and exact on its result, and the two comparisons are relational over a **canonical carrier pair** — two represented operands that are both in the runtime's normal form — and exact on their `i32` verdict, for the reason given in section 4.3. Section 4.3 also states which face carries canonicity as a premise **about its inputs** rather than only about the helpers. +`ClaimAxes.contractsMatch` requires `subject.contracts` to equal, as a list, the contracts the wall derives: a helper's contract appears when some plan's lowering calls that helper's index, and the totality contracts appear when some obligation is L3. The strings, in this canonical order, are: -**`simulatesModelTotally` (level L3, total simulation).** `Obligation.holdsTotal` additionally assumes totality of the host helpers selected by the obligation's `totalityRole` (`.addSub`: add and sub total on represented operands; `.mul`: additionally mul total, admitted only for a byte-pinned unary recursion whose combine role is mul) and promises an actual result at fuel `n.natAbs + 1`, where `n` is the checked integer counter (the first domain argument). The termination evidence is the canonical witness of section 4.2, checked against the byte-bound plan by `Schema.checkTerm` (unary and accumulator recursion) or `Schema.checkTermMutual` (mutual SCC members, whose recursive edge is a **tail** call pinned to the byte-derived SCC member set — not to the member's own index; the member's own index is in that set, so a legitimate two-cycle back-edge is admitted, and the byte-equality gate then forces the call to the member's actual target). +1. `__rt_aint_from_i64 (box i64 -> carrier)` +2. `Int.add (carrier add = exact integer addition on represented values; result canonical)` +3. `Int.sub (carrier sub = exact integer subtraction on represented values; result canonical)` +4. `Int.mul (carrier mul = exact integer multiplication on represented values; result canonical)` +5. `String.eq (WVal byte-array equality; non-arrays compare false)` +6. `String.concat (container-of-string-arrays -> byte-concatenated array)` +7. `__aint_to_index (carrier -> i32 array index; [0, 2^31) passes, else -1)` +8. `__aint_cmp (canonical carrier pair -> i32 sign; -1 less, 0 equal, 1 greater)` +9. `__aint_eq (canonical carrier pair -> i32 boolean; 1 when equal, else 0)` +10. `__aint_divmod (canonical carrier pair, nonzero divisor, want_mod 0 or 1 -> canonical Euclidean quotient (0) or remainder in [0, |b|) (1))` +11. `Int.add (carrier add = exact integer addition on represented values; result canonical); total on represented values` +12. `Int.sub (carrier sub = exact integer subtraction on represented values; result canonical); total on represented values` +13. `Int.mul (carrier mul = exact integer multiplication on represented values; result canonical); total on represented values` (only when an L3 obligation has role `.mul`) -The artifact-independent proposition is `HoldsCore m`: every obligation satisfies the denotation selected by its policy. The full schema proposition, `Schema.Holds m`, conjoins `m.subject.artifactHash = CertModule.wasmSha256`, binding the statement to the delivered artifact hash literal carried in `Module.lean` (which the witness in turn pins to the recomputed hash of the caller-supplied artifact bytes), `subject.profile = expectedProfile`, and `artifactTargetAbiAccepted subject.target subject.abi = true`. +The producer's copies live in `aver-cert/src/engine/mod.rs`, and a unit test compares them with the wall's. -The public proof root accepted by the verifier is `AverCert.Artifact.certificate : AverCert.AcceptedArtifact.accepted AverCert.Artifact.data`, where `accepted` conjoins: `Schema.Holds` of the manifest; `artifactEnvelopeAccepted ArtifactComponentBytes.componentBytes ArtifactComponentBytes.componentLen artifact = true` (the wasm-gc identity split or the wasip2 component envelope); `subjectMatchesArtifactRoot`; `fragmentClaimObligationsInManifest` (every claim's obligation literal is found in the manifest by export name); `claimsMatchManifest` (full plan-pair equality exactly where plans are claim-side data: the sym-plan pairs of the sym-fragment, String.eq, String.concat, and constructor claims — concatenated in that order — must equal `symFragmentPlans`, the encoder output of the sym-fragment claims must equal `exprFragmentPlans`, and the composition member pairs must equal `compositionPlans`; every **other** family is equated by its ordered export-name list only, with the plans themselves then looked up in the manifest lists and checked by that family's acceptance predicate); `StandardFace.checkedFaces` (section 5.1); `ClaimAxes.checked = true` (section 5.2); `decodedNonExprFacts` (module-wide host-role and string-role decodes plus per-claim code/carrier/struct-field decodes recomputed from bytes); and `acceptedFragments` (per-family byte acceptance plus the whole-module accounting of section 5.3). +### 7.5 Whole module -### 5.1 StandardFace: the admitted semantic face +`acceptedWholeModule` requires: -`StandardFace.checkedFaces` requires, per claim family, that the obligation's carrier, `Dom`, `Cod`, `domRepr`, `codRepr`, complete host builder, and (for reconstructible families) model equal the standard face selected by the checked family and plan. Faces bind the whole host function, not probe points, so an unmentioned input cannot turn a contract into a trap. Every role/index pair a claim cites must agree with the byte-decoded role table (`hostTableBound`), with pairwise-distinct indices. `claimExportsUnique` requires that one export is claimed by exactly one family across all families. User-ADT domain meaning, representation interpretation, and models that cannot be reconstructed from Wasm remain explicit read declarations: for those faces only the reconstructible parts are forced, and the theorem is conditional on the declared meaning (see section 10). +- `moduleFramingValid`: strict section framing; +- `exportsAccounted`: every export of the module is either an obligation (same name, kind and function index) or named in `declaredUncertified`; both lists are duplicate-free, disjoint, and name only real exports; +- `importsWithinCapabilities`: section 4.1; +- `startAccounted`: the start section equals `subject.start`; +- `closureIsolation`: the direct-call closure of the certified roots, recomputed from the code section, equals the declared roots plus helpers; the roots are exactly the obligations' function indices; a reachable import or a rejected instruction fails the scan; and the module declares no shared memory. -`StandardFace.reportEntries` derives the public `(export, class)` report pairs in manifest-obligation order from the checked claims — the class labels of section 4.2 are outputs of this function, and the checker witness pins the JSON report to them. +### 7.6 Artifact bytes and identity -### 5.2 ClaimAxes: policy, termination, totality, contracts +**Hash.** The verifier MUST hash the delivered artifact and reject unless it equals `wasm_sha256`. The witness pins `subject.artifactHash` to that hash by `rfl`. `Schema.Holds` also compares it with `CertModule.wasmSha256`, which the verifier renders into the checker-owned `Module.lean` from the hash it computed; a package `Module.lean` is ignored. The wall's `Schema` imports `Module`, so no package module is in the wall's import closure: a package declaration cannot become the target of a name the wall resolves. -`ClaimAxes.checked` recomputes, from the checked plans alone, the axis triple (policy, termination witness, totality role) each obligation must carry — every non-recursive family is forced to the partial axis; recursion families are forced to total with the role classified from the byte-bound plan shape — and the exact **ordered** runtime-contract list the manifest must disclose, assembled in the canonical order of section 4.1 and compared by exact list equality. A totality claim can therefore never be smuggled in through a JSON label, and a contract can never be omitted from (or reordered within) the disclosure. +**Byte injection.** The verifier MUST generate `ArtifactBytes.lean` from the bytes it read. The encoding is one little-endian natural, `modBytes = Σ bytes[i] · 256^i`, written as hex numerals of at most 1024 bytes each, each chunk shifted to its byte offset and joined with `|||`, in a `noncomputable` definition, plus `modLen`, the byte count. The length matters because trailing zero bytes do not show in the numeral. Every in-kernel decoder reads this pair. The witness pins `Artifact.data.modBytes` and `modLen` to the generated values. `ArtifactComponentBytes.lean` carries the delivered component the same way. -### 5.3 Whole-module accounting +**Wall.** `format.wall_id` names the exact wall source set and toolchain (section 1). The verifier writes the embedded wall into the build directory itself; package files with wall names are ignored. -`acceptedWholeModule` conjoins byte-derived checks over the entire module: `moduleFramingValid` (strict section framing); `exportsAccounted` and `importsWithinCapabilities` and `startAccounted` (section 4.1); and `closureIsolation` — the direct-call closure of all certified roots, recomputed from the code section by an in-kernel scanner, must equal the declared root/helper partition, with no imports reachable, no instruction channels outside the certified profile, and no shared memory declared. `manifestObligationsClaimed` and `manifestObligationExportsUnique` close the coverage direction: every manifest obligation is claimed by some family and obligation export names are pairwise distinct, so an unclaimed obligation cannot ride into the accepted artifact unchecked. +### 7.7 Declared layout and fast readings -## 6. Plan grammar and the canonical byte-lowering contract +The kernel is slow at searching and decoding bytes and at comparing Strings. Three devices make the checks cheaper. Each is proved equal to, or sufficient for, the check it replaces, so the statements of sections 7.1 to 7.5 do not change, and a wrong declaration only declines. -Plans are the producer's untrusted explanation of *why* a function body has its certified meaning. They are Lean values referenced by the manifest plan lists and the artifact claims; the producer serializes them once, in `Plans.lean` (namespace `AverCert.Plans`), but that location is convention — acceptance requires only that the referenced plan values are defined in some staged file (section 2.2). There is no JSON plan AST in the package; a JSON projection would be a second authority that must agree with the first, so it is deliberately absent. +**Declared layout.** The package declares where things are instead of the checks searching for them. `DeclaredLayout.layoutConfirmed` decodes the import, function and code sections once, in full, and requires every defined function's declared type index and code entry (the exact slice at the declared offset and length) to equal what the decoders read. `fnTypesConfirmed` requires every declared function type to be the type-section entry at its index. A plan entry then reads its code entry, type index and function type from the confirmed declarations, and an exported entry reads its export entry at its declared position; `exportNamesDistinct` (every export name distinct, decided on numeric name keys) makes that the one entry the name search of `entryAccepted` would find. `entries_of_fast`, `closureIsolation_of_layout`, `arithRoleCheck_of_layout` and `plansAcceptedRest_of_layout` connect the fast checks to the ones they replace. -### 6.1 Plan profiles +**Section cuts.** The decoders read a section as one little-endian numeral and a length, one byte at a time, and every byte read shifts the rest of the section. The kernel keeps each of those numerals until the declaration is checked, so decoding a section of `S` bytes costs memory quadratic in `S`: the export section of a 740 KB module ran past a 16 GB heap. The package therefore declares, for the type, export and code sections, the byte length of every entry (`typeCuts`, `exportCuts`, `codeCuts`). `ByteWindow` cuts the section at those lengths into one window per entry and decodes every window on its own, and `Ext` lemmas show that each entry reader returns on its window what it returns inside the section. One declaration per section (`types_cut`, `exports_cut`, `code_cut`) decides that every window decodes and fills its window exactly, and proves the section's decoder equal to a lazy reading of the windows (`typesLazy`, `exportsLazy`, `codeLazy`) that decodes an entry only when a check reads it. A wrong cut makes some window fail to decode or to fill its window, and the package declines. `SortedKeys` replaces the balanced-tree set checks of the export accounting and the closure isolation by merge sorts and walks over sorted numeric keys, with a proof that what they decide implies the tree-based checks (`exportsAccountedOf_of_fast`, `closureIsolationL_of_S`); the export names' distinctness is read from the accounting (`exportNamesDistinct_of_accounted`). None of this changes what is accepted: the acceptance statement still reads the decoders, and the cuts only choose how the kernel evaluates them. -Every raw-plan structure carries a `profile` string that MUST match the value its checker expects: +**String helper roles.** `StringHost.roleTable` classifies every defined function by the signature of its type. `StringFast.roleTableFast` first folds the signature list into a bitmap of the types an eq or concat helper can have (two reference parameters of one string-array type and an `i32` result, or one reference parameter and a string-array result), and reads a signature only for a function of such a type. `roleTableFast_eq` proves the two tables equal, so `decodedStringHostRoles` is decided through the fast one. -| Profile string | Lean type | Family | -|---|---|---| -| `sym-fragment-v1` | `SymRawPlan` | Source-level symbolic plan (SymPlan), the portable source-meaning IR | -| `expr-fragment-v1` | `ExprFragmentRawPlan` | Representation-level ANF fragment | -| `recursion-plan-v1` | `RecursionRawPlan` | Unary / accumulator integer fuel-recursion | -| `mutual-plan-v1` | `MutualRawPlan` | One member of a mutually-recursive integer SCC | -| `composition-plan-v1` | `CompositionRawPlan` | Cross-function direct-call composition shape | -| `verbatim-plan-v1` | `VerbatimRawPlan` | Verbatim `ref.test`-dispatch (`Cod := WVal`) | -| `int-dispatch-v1` | `IntDispatchRawPlan` | Int-valued ADT dispatch (`Cod := Int`) | -| `string-eq-v1` | `StringEqRawPlan` | One-literal `String.eq` match | -| `string-concat-v1` | `StringConcatRawPlan` | Literal-affix `String.concat` | -| `construct-v1` | `ConstructRawPlan` | ADT constructor `struct.new` witness | -| `field-projection-v1` | `FieldProjectionRawPlan` | Bare tuple/record field projection | +**Names as characters.** The kernel converts and compares String values by rebuilding their UTF-8 bytes, in time quadratic in their length. A package therefore states the capability names it declares as character lists, checked against the manifest's Strings by `rfl`, and `Chars.importsWithinCapabilities_of_chars` decides `importsWithinCapabilities` over their code points. `Chars.boxIdx_eq`, `toIndexIdx_eq`, `cmpIdx_eq` and `carrierHelperAbsent_eq` read the helper export names on the raw bytes of the export entries. -### 6.2 SymPlan: the source-level grammar +## 8. Policies and totality -`SymRawPlan` is `{profile, params : List SymTy, result : SymTy, body : SymBlock}`. A `SymBlock` is an ordered ANF node list plus a `result` node id; each `SymNode` is `{id, ty : SymTy, kind}` where `id` must equal the node's position in the block (checked before lowering). `SymTy` is `int | float | bool | string | named name | app1 name arg | app2 name left right` — deliberately with no raw-`WVal` escape hatch. `SymNodeKind` is: `param index`, `constBool`, `constInt`, `constFloatBits`, `constStringBytes`, `prim op args` (with `SymPrim` = `floatAdd | floatMul | floatLe | floatGe | floatLt | floatGt | floatEq | intAdd | stringEq | stringConcat`), `construct typeName ctorName args`, `emptyList elemTy`, `projectField typeName field fieldTy value`, `intConstCmp op value constant` (with `SymIntCmp` = `eq | lt | le | ge | gt`), and `ifElse cond thenBlock elseBlock`. +The policy of an obligation comes from `GrammarTotal.groupPolicy` over the plans of its call group: L3 (`simulatesModelTotally`, the canonical witness, and the group's role) when `checkTermGroup` passes, L1 (`simulatesModel`) otherwise. No manifest field can set it. -A SymPlan carries no wasm-level indices. For the generic sym-fragment family, the audited in-wall encoder `PlanCheck.encodeSymRawPlanToExprFragmentRawPlan` maps it to an `ExprFragmentRawPlan` **under the byte-derived host-role and struct tables**, and acceptance equates the encoder output with the manifest's `exprFragmentPlans` entry, so the source-level claim and the byte-level plan cannot drift apart. Two precision points a reimplementor MUST honor: +`checkTermGroup` admits a group when every member has only Int parameters (at least one), an Int or Bool result, and a body `if n <= 0 then base else step` over parameter 0, where `base` and `step` are built from Int and Bool literals, parameters, Int `+ - *` and calls to group members, every member call passes `n - 1` (literally `binOp .sub (local 0) (literal 1)`) as its first argument, and `step` makes at least one such call. The role is `.mul` when a member multiplies, else `.addSub`. Division, matches, records and calls outside the group keep a function at L1. `GrammarTotal.fn_certified_total_of_check` proves `holdsTotal` for every member of a passing group. -- **The encoder is only the generic-fragment bridge.** It fail-closes (returns `none`) on `constStringBytes`, `construct`, `emptyList`, the `stringEq`/`stringConcat` primitives, and any `projectField` whose encoded type is not an opaque reference. Those SymPlan shapes are not encoded at all; each is bound to its representation-level plan by a separate matching predicate checked inside the family acceptance: `stringEqPlanMatchesSymRawPlan` (one-literal `String.eq` match), `stringConcatPlanMatchesSymRawPlan` (literal-affix `String.concat`), and `constructPlanMatchesSymRawPlan` (ADT constructors, whose field matching also admits `emptyList` nodes — empty-list construction rides this family). Treating the encoder as the universal SymPlan semantics would wrongly reject valid packages in these families. -- **Index provenance splits by level.** Wasm-level indices — host-helper function indices (`hostRoleIdx?`) and struct type indices (`structTyIdx?`) — are always drawn from the byte-derived tables; the plan cannot cite them. Source-level ordinals remain plan data: parameter indices, the positional node ids, and the projected field ordinal (`projectField.field` is copied verbatim into the encoded `structGetUser` node). Those plan-supplied ordinals are subsequently forced by the byte-equality gate of section 6.4, not by the encoder. +## 9. Bridges and law-claims -### 6.3 Fragment IR: the representation-level grammar +### 9.1 Statement kinds -`ExprFragmentRawPlan` is `{profile, params : List FragTy, result : FragTy, body : FragBlock}` with the same positional-id ANF discipline. `FragTy` is `f64 | boolI32 | intCarrier | i64 | rawI32 | ref | adtRef`; `FragTy.sourceTy?` projects only `f64/boolI32/intCarrier` to source types, so raw limbs cannot silently acquire source meaning. `FragNodeKind` is: `local index`, `constBool`, `constI64`, `constI32`, `constF64Bits`, `structGet field receiver` (Int-carrier limb reads), `structGetUser tyIdx field value` (whole user-struct projection; the type index is node data bound to the bytes, mirroring `hostCall`), `refIsNull`, `prim op args` (with `FragPrim` = `f64Add | f64Mul | f64Le | f64Ge | f64Lt | f64Gt | f64Eq | i64Eq | i64LeS | i64LtS | i64GeS | i64GtS | i32Eq | i32LtS | i32GtS | i32GeS | i32And`), `hostCall role funcIdx args` (with `HostRole` = `box | add | mul | sub | toIndex | cmp | eq`, where `toIndex` is consumed only by the fused vector-read node, `cmp` calls the three-way comparison helper and yields the raw sign `-1`/`0`/`1` — so its node type is `rawI32` and the emitter always follows it with `i32.const 0` and a signed relational primitive — and `eq` yields the wasm Boolean directly and is typed `boolI32`; the resolved index is bound both to the bytes and to the decoded role table), `selfCall tail funcIdx args` (recursion families only; in the ordinary recursion family every self-call is bound to the current function's byte-derived index, while in the mutual family the recursive edge must be a tail call whose target is bound to the byte-derived SCC member set, the byte-equality gate then forcing the actual target), and `ifElse`. +Every obligation's model is the plan. A source-bridge states that this model computes a named transpiled source function through source-value encoders. `GrammarBridge.lean` defines the two kinds, with `o := exportObligation manifest ""`: -The dispatch-family grammars (`verbatim-plan-v1`, `int-dispatch-v1`) are separate because their multi-use scrutinee spills through scratch locals, which pure ANF cannot express; their leaf/cascade constructors, and the remaining per-family plan structures, are defined in `SchemaCore.lean` and are the normative reference for field-level detail. Two representative invariants: `IntDispatchRawPlan` arms name host helpers by **role** only (the byte-derived role table parameterizes the lowerers, so a plan cannot cite an index), and scratch-local numbering is a fixed function of the arm count rather than plan data. +- `Exact`: `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∃ k, ∀ fuel, k ≤ fuel → ∀ x…, o.model fuel [enc x…] = some (encRes ( x…)))`; +- `Adequate`: `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∀ fuel x… v, o.model fuel [enc x…] = some v → v = encRes ( x…))`. -### 6.4 The canonical byte-lowering contract +`ArgsTyped` says the encoded arguments are well-typed at the plan's parameters, so `holds` applies to them. `GrammarBridge.adequate_transfer` states what an adequate bridge gives for the bytes: a returning run on represented encoded arguments returns a represented image of the source result. An adequate bridge says nothing about termination; it holds vacuously of a model that never returns, and a verifier MUST NOT present it as a totality claim. -The load-bearing invariant of the whole format is: **the certified function's bytes are the canonical lowering of its checked plan, and both sides of that equality are computed inside the Lean kernel.** For every accepted plan the wall establishes, by definitional reduction (`rfl`): +The producer proves a bridge from one step lemma per function (`GrammarBridge.Step`): the plan body, with every call answered by the callees' source images, returns the function's own image. `exact_of_step` assembles exact bridges for a call closure without recursion; `bridge_of_step` assembles adequate bridges for any closure by one fuel induction. The producer attempts no bridge for a plan of more than 100 nodes. -1. **Structural check**: the family checker in `PlanCheck` accepts the raw plan (`checkSymRawPlan`, `checkExprFragmentRawPlan`, `checkRecursionRawPlan` + the context-sensitive `checkRecursionPlanShape` against the byte-derived self index and role table, `checkMutualRawPlan` + `checkMutualPlanShape` against the byte-derived SCC member set, `checkVerbatimPlan`, `checkIntDispatchRawPlan`, `checkStringEqRawPlan`, `checkStringConcatRawPlan`, `checkConstructRawPlan`, `checkFieldProjectionRawPlan`, `checkCompositionRawPlan`). -2. **Semantic lowering**: `PlanLower.lower*Body` maps the plan to the exact `CertPrelude.WInstr` body the obligation's `code` table must return at the bound function index — so the proved simulation is about precisely the lowered semantics. (The producer conventionally names these body literals `CertModule.*Code` in `Module.lean`; acceptance binds `obligation.code`, not any named definition — section 2.2.) -3. **Byte lowering**: `PlanBytes.lower*CodeEntry` maps the plan to the exact Wasm code-entry byte sequence (local declarations + expression body + ULEB128 body-size prefix; ULEB/SLEB encoders are defined in-wall). This is a plan-first byte **encoder** for the checked profiles, not a general Wasm assembler. -4. **Byte-origin binding**: `WasmSlice.exactFuncBindingForExport modBytes modLen exportNameBytes codeEntry` finds, in the actual artifact bytes, the export with that exact name and requires its code entry to equal the lowered bytes, returning the pinned `FuncBinding {funcIdx, typeIdx, codeEntry}`. Where the family needs signature or type facts, additional byte-derived matchers pin them (`funcTypeMatches`, `projectionStructTypeMatches`, `projectionFuncTypeMatches`, `listConstructStructTypeMatches`, ...). Every family whose claim carries a host-role table (sym-fragment, recursion, mutual recursion, Int-face dispatch, composition) additionally requires `WasmSlice.hostTableFuncTypesMatch`: each `(role, funcIdx)` entry's **declared** function type — resolved through the function section, imports failing closed — must be exactly the signature its role fixes over the claimed carrier (`box`: `[i64] → [(ref null carrier)]`, `toIndex`: `[(ref null carrier)] → [i32]`, `cmp` and `eq`: `[(ref null carrier), (ref null carrier)] → [i32]`, `add`/`sub`/`mul`: the canonical two-argument carrier signature). `cmp` and `eq` deliberately share one signature — the declared type cannot tell those two roles apart, which is why each of them additionally carries the export-name pin of section 4.3. Helper bodies are pinned by template byte equality elsewhere, but the body equality does not constrain the declared type: without this conjunct a helper declared at a strict supertype of the carrier reference still wasm-validates by subtyping while the proof faces model the exact claimed carrier. A reimplementation MUST NOT drop this conjunct on the grounds that the helper bodies are already byte-pinned. +### 9.2 `sourceBridges` - The expression-fragment family carries a **second, complementary** conjunct at the same site, `AcceptedArtifact.symFragmentCarrierBound`, and a reimplementation MUST NOT drop it either. The declared-type pin above compares each helper's declared type against the **claimed** carrier, and for expression fragments that carrier is claim data no decoder constrains (section 4.3's `decodedStrictCarrierIndex` scope note: sym-fragment claims are absent from the decoded-claim bindings). On that family the pin alone is therefore circular — a producer that declares the box helper AT a fake supertype and claims that same fake index satisfies it, while the template-pinned helper body still builds structs at the real carrier. `symFragmentCarrierBound` removes the free reference point: whenever the claim's own data can make a proof face read the carrier, `CertDecode.carrierState modBytes modLen` MUST equal `some (some carrier)` — a byte-provably carrierless module (`some none`) and an undecodable type section (`none`) both reject. +Each entry is an exact object `{export, theorem, corollary, model, kind, params, result}`. **The entry carries structure, never statement text.** The verifier renders the statement from `(export, model, kind, params, result)` with `aver-cert/src/bridge_statement.rs`, the renderer the producer also uses, and pins the package's corollary at exactly that text. A verifier MUST NOT accept a statement supplied by the package. - **The trigger is derived from the claim, not from a family list.** The binding applies when the claim's `hostTable` is non-empty **OR** the encoded `ExprFragmentRawPlan` names `intCarrier` anywhere — in the parameter list, in the result, or as the type of any node in the body or in any nested block. Keying it on the host table alone is unsound and MUST NOT be done: `StandardFace.fragment` states `domRepr := args = FragParams.encodeArgs carrier params values`, and `FragTy.encodeArg` sends an `intCarrier` parameter to `carrierSmall carrier value`, the concrete three-field struct `structv carrier [i64v k, null, i32v 0]` at the claimed index. A generic `Int -> Bool` fragment (the integer-versus-constant comparison shape) asserts that layout while citing no host role at all, so an empty table would exempt a carrier-sensitive face and admit a claim naming a struct the module declares with a different field count — a theorem quantified over states the module's own type section forbids, reported as a certified export. The residual permissive case is exactly "no role cited AND no `intCarrier` in the encoded plan", where no face can mention the index: that is what keeps projection and float/string-boundary fragments certifiable in carrierless modules. +- `export`: a plain undotted identifier naming an entry of `certified[]`, listed at most once. +- `theorem`: exactly `AverCert.Bridge.`; `corollary`: exactly `AverCert.Bridge._certified`. +- `model`: the fully qualified source function, a plain dotted identifier of at most 200 bytes, `'` allowed after a segment's first character. +- `kind`: `"exact"` or `"adequate"`. +- `params`: one encoder per parameter, in declaration order; `result`: one encoder. - The two conjuncts are **complementary, and neither subsumes the other**. The declared-type pin catches "claimed carrier right, helper type wrong", which no carrier equality can see; the carrier binding catches "both consistently fake" and the role-free claims whose plan names `intCarrier` — not every role-free claim, only those the trigger above selects — which no declared-type comparison can see (on an empty table it is vacuously true). A reimplementation that ships one without the other has exactly one of these two holes open. +An encoder is an exact object in one of eleven closed forms: `{"kind": "int"}`, `"bool"`, `"float"`, `"string"`; `{"kind": "record", "tid": n, "type": T, "fields": [{"accessor": A, "encoder": E}, …]}`; `{"kind": "sum", "tid": n, "type": T, "ctors": [{"ctor": C, "fields": [E, …]}, …]}`; `{"kind": "option", "elem": E}`; `{"kind": "result", "ok": E, "err": E}`; `{"kind": "tuple", "tid": n, "elems": [E, …]}` with two or more elements; `{"kind": "list", "elem": E}`; `{"kind": "vector", "elem": E}`. Names are `_root_.`-qualified plain dotted identifiers, every accessor is a field of its record type and every constructor a constructor of its sum type, and nesting is at most 8 deep and 256 nodes. Anything else declines the package. The encodings are `Int ↦ SVal.i`, `Bool ↦ SVal.b`, `Float ↦ SVal.f (Float.toBits x)`, `String ↦ SVal.s (GrammarBridge.strBytes x)`, a record ↦ `SVal.record tid` of its accessors in order, a sum ↦ `SVal.variant tid c` with `c` the constructor's position in `ctors`, `Option` ↦ `SVal.none`/`SVal.some`, `Result` (Lean `Except E T`) ↦ `SVal.ok`/`SVal.err`, a tuple ↦ `SVal.record tid` of its components, a list ↦ `SVal.nil`/`SVal.cons`, a vector ↦ `SVal.vec`. - *Known gap:* the carrier layout itself is pinned one field short of what the faces assert. `CertDecode.TypeEntry.isCarrier` — the predicate behind `carrierState`, and so behind both the binding above and every other family's carrier equality — requires exactly three fields with field 0 tagged `i64` and field 2 tagged `i32`, and says nothing about field 1, while `carrierSmall C k = structv C [i64v k, null, i32v 0]` places a null reference there. A module declaring `(struct (field i64) (field i32) (field i32))` therefore satisfies `isCarrier`, the binding accepts it, and the face still asserts a value no machine state of that type can hold — the vacuity this section's arity rule exists to prevent, surviving one field over. Closing it means deciding exactly which storage tags admit a null, which is a cross-family change; a reimplementation SHOULD pin field 1 to a nullable reference storage type and MUST NOT read the current predicate as confirming the full carrier layout. +The rendered statement is an application of the wall's own definitions: `_root_.AverCert.GrammarBridge.Exact _root_.AverCert.manifest "" (fun (x : X) => [enc x…]) (fun (x : X) => encRes ( x…))` for `exact`, and the same with `GrammarBridge.Adequate` for `adequate`. `X` is the parameter type for one parameter, `_root_.Prod T0 (_root_.Prod T1 …)` for several (each parameter read as its `Prod.fst`/`Prod.snd` component of `x`) and `_root_.Unit` for none. The order, quantifiers and numbers of section 9.1 therefore live in the wall, which was elaborated without the package. The parts the verifier renders contain no operator that resolves through an instance, and every type id and constructor position in an encoder is a `nat_lit`, so a package instance such as `LE Nat` cannot change what the pin says. The producer proves its own expanded form (one binder per parameter, ordinary numerals) and restates it at the pinned statement in its `_certified` corollary; an instance that changed what the expanded text means makes that restatement fail rather than weakening the pin. - **Faces that assert a fixed value layout carry a matching arity pin.** Where a standard face states its `domRepr` as a literal struct value, the field count in that literal is part of the claim and MUST be confirmed against the type section, or the obligation is quantified over states the module forbids while the report calls the export certified. Three faces are in this shape and all three are pinned, each by a different mechanism, and a reimplementation MUST supply all three: the field-projection face (`vs = [structv structIdx [p.1, p.2]]`, pinned by `fields.length == 2` in `checkExprProjectionTypes`); the tag-dispatch face (`vs = [structv optIdx [i32v tag, payload]]`, pinned by `fields.length == 2` in `checkTagDispatchTypes` alongside the i32 tag-field check); and the generic fragment face, whose `intCarrier` parameters encode to the three-field `carrierSmall carrier value` — pinned not by a dedicated arity term but by `isCarrier` inside the carrier binding above, which admits only a three-field struct, so a claim naming a struct of any other width is rejected there. That indirection is the whole reason the binding's trigger must follow the plan rather than the host table: drop the trigger and this face loses its only width pin. The fused vector-read face is deliberately NOT in this shape — its `vecDomRepr` quantifies the element list existentially, so it asserts no width and pins the element type instead. +The rendered text passes the statement gate (nonempty, at most 16000 bytes, no control character, no `:=`, `--`, `/-` or backtick, no identifier token outside a literal or `«…»` identifier with a `.`-separated segment `set_option` or `open` (a term-level `set_option … in` would bypass the option whitelist of stage 7, and a term-level `open … in` would change what the statement's names resolve to), no `s!`/`r` string, balanced `()[]{}⟨⟩` counted outside string literals, char literals and `«…»` identifiers, every literal terminated), and every dotted name in it MUST be `_root_.`-qualified, because the pin elaborates at the root namespace. - *Known gap, same rule, different fact:* the tag-dispatch face is the one ADT face whose scrutinee **type index** is not tied to the certified function's declared parameter type. Its two siblings do exactly that (`checkExprProjectionTypes` requires the parameter to be `nullableRefType structIdx`; `checkVectorGetTypes` requires it to be `nullableRefType arrTy`), while `exprTagDispatchTypesMatch` never receives the function's `typeIdx`. The face's width and tag-field type are confirmed; which nominal type the scrutinee is remains claim data. A reimplementation SHOULD add the parameter-type equality its siblings carry, and MUST NOT read the arity rule above as confirming the whole scrutinee shape for this face. +The checker's audit program (section 10) also holds every record and sum an encoder reads to its elaborated declaration. A record encoder MUST list exactly the structure's fields, in declaration order; the structure MUST NOT be a proposition and no field may be a proof. A sum encoder MUST list exactly the inductive's constructors in order, each with exactly its number of fields, none of them a proof. Without this, a record with an unlisted field such as `h : False` would let a bridge quantify over no value and hold vacuously. -**The locals prelude is a fact about the module, not a plan choice.** Most families lower to a code entry whose locals vector declares exactly one nullable Int-carrier reference, and the carrier type index inside it is claim data confirmed by the step-4 byte equality. `string-concat-v1` is the one family that also lowers in a module with **no** Int carrier struct at all: the compiler emits the carrier struct and its helpers only when some function touches `Int`, and in a module without them the emitted concatenation body opens with an **empty** locals vector. `PlanBytes.lowerStringConcatCodeEntry` therefore takes the module's carrier **state** (`Option Nat`) rather than an index, and `carrierLocalsBodyBytes` selects the one-local prelude for `some` and the zero-local prelude for `none`. Which one applies is never the producer's choice: `stringConcatPlanAccepted` pins that state by `CertDecode.carrierState modBytes modLen = some carrier`, a strict three-state decode of the type section — `some (some idx)` when a carrier struct is present, `some none` when the section decodes and holds none, and `none` (admitting no declaration at all) when the section does not decode. A carriered module can therefore present only the one-local body and a carrierless one only the zero-local body, and the same pinned state also fixes `stringConcatNLocals`, the locals count the semantic frame carries, which step 4 and the code decode then check against the real locals vector. Reimplementors MUST NOT treat the two preludes as alternatives a certificate may select between. +### 9.3 `laws` -Carrierless modules are admitted one step earlier as well, and the admission is scoped to one family. Obligations in the **String.concat** claim list pin their `carrier` field with `AcceptedArtifact.decodedCarrierIndex`, which matches on all three states of `CertDecode.carrierState`: a decoded carrier struct forces that exact index (the old `decodeCarrier` equality unchanged), a type section that decodes with no carrier struct forces the reserved index `0`, and a type section that does not decode admits nothing. **Every other non-expression-fragment family keeps `decodedStrictCarrierIndex`** — the unchanged `decodeCarrier … = some obligation.carrier` — which no module without a decodable Int-carrier struct can satisfy, so no claim in those families exists in a carrierless module at all. +Each entry is an exact object `{label, theorem, statement, corollary, bridges}`. `label` is the source `module.fn.law` identity and `theorem` the fully qualified model theorem; both are plain dotted identifiers of at most 200 bytes, and only `theorem` may carry `'` after a segment's first character. `corollary` MUST be the label with every `.` replaced by `_`, and corollaries are unique. `statement` is the theorem's universal statement on one line and passes the statement gate. `bridges` is an array of export names, each declared in `sourceBridges` and listed at most once. When nonempty it MUST be exactly the declared bridges whose `model` appears as `_root_.`, an identifier token of `statement` (a maximal run of ASCII alphanumerics, `_`, `.` and `'`, stripped of leading and trailing dots), each once, in first-appearance order, and the statement MUST NOT spell any declared bridge's `model` another way: neither the bare name nor a token ending in `.` that does not start with `_root_.` (`Evil.Tiny.addTwo`). Such a spelling is where a namespace or a binder could make the name mean another constant, so a law listing bridges that carries one declines the package. `law_mentioned_bridges` in `aver-cert/src/bridge_statement.rs` states that rule, and the producer and the verifier both apply it; any other nonempty list declines the package before Lean runs. The producer fills the list when every model function the statement mentions has a bridge, and leaves it empty otherwise. -The scoping is load-bearing, not tidiness. The reserved index is a placeholder, not a claim that type `0` is a carrier, and it is harmless only for a face that provably never consults the `CarrierSpec`: String.concat's `Dom`/`Cod` are `WVal`, its `domRepr` is `vs = [v]` and its `codRepr` is `verbatimRepr`, all of which discard the spec argument. Citing no arith role is NOT sufficient for that — String.eq, verbatim dispatch, field projection and named-ADT construction also reach acceptance with the host-role table absent, and `construct-v1`'s named face pins `HEq o.Dom Int` and `HEq o.domRepr (intArgDomRepr env.carrier)`, an Int-representation face, with `constructNamedFace` fixing `host = emptyHost` so neither the role table nor the `arithParams.carrier` pin of section 4.3 constrains it. A reimplementation that applies the three-state binding uniformly would admit a constructor claim whose representation face is stated over `CarrierSpec 0` in a module that provably has no carrier struct there. The two mechanisms are complementary: section 4.3's pin stops a role-citing family from wiring an Int runtime the type section does not corroborate, and this scoping stops a role-free but carrier-sensitive family from reaching the reserved index. +`statement` is read at the root namespace (section 10), not in the namespace of `theorem`, which the package chooses: inside `namespace Evil`, Lean would resolve the text `Tiny.addTwo` to a package constant `Evil.Tiny.addTwo` when one is declared. The compiler's emitter writes a law's statement for the namespace its theorem is emitted in, so the producer rewrites it before it ships it (`root_qualify_statement` in `aver-cert/src/engine/law_claims.rs`): every name that resolves there to a name the model modules declare becomes `_root_.`, and binders, keywords, literals, projections and core names stay as written. A name the rewrite resolves wrongly costs only that law's credit, since its corollary then no longer checks against the model theorem. The verifier cannot tell a model function without a bridge from any other identifier, so it cannot refuse an empty list on that ground; the pinned `_bridged` statement lists exactly which bridges the claim carries. -The acceptance predicates in `AcceptedArtifactCore.lean` / `ExprFragmentAccepted.lean` aggregate these equalities into the accepted-artifact proof, and that is the only place a verdict reads them. The producer used to also state each one as an `example : ... := rfl` line per export in `Plans.lean`; it no longer does, because that surface was redundant with the acceptance predicates and, on a large module, expensive enough to fail the package's build on its own (section 2.2). Adding such examples back, or serializing plans somewhere else entirely (section 2.2), can neither strengthen nor weaken acceptance. A conforming verifier MUST NOT substitute an out-of-kernel (e.g. Rust-side) reimplementation of any of these four steps on its acceptance path. +The package's `Laws.lean` proves `AverCert.Laws. : (statement) ∧ Holds manifest`, at the root namespace. A claim with a nonempty `bridges` also proves `AverCert.Laws._bridged`, the same conjunction plus the rendered statements of the listed bridges in order. The `_bridged` name is derived, never transported. -One name-binding subtlety in step 4: a claim carries both a display name (`exportName : String`, equated with `obligation.export_`) and the byte-level lookup key (`exportNameBytes : List Nat`), and no in-kernel equality relates the string to its byte encoding. What closes the gap is whole-module accounting (section 5.3): the binding forces `obligation.self` to the function index found under `exportNameBytes`, and `exportsAccounted` requires the UTF-8 encoding of `obligation.export_` to be an actual export of that same function index. With aliased exports a claim can therefore bind through one name while reporting the other — but both names provably export the same certified function. +### 9.4 Credit -## 7. Byte binding +Each law pin, bridged-law pin and bridge pin has two outcomes once it elaborates: **credited** when its axiom closure stays inside the whitelist, and **not credited** when it does not (`sorryAx`, `Lean.ofReduceBool`, a user axiom), with the offending axioms named in the report. A pin that does not elaborate means the package does not prove what it declared, and the whole package is declined. Credit never changes the verdict or the exit code; those belong to the exports. -Three mechanisms bind the certificate to one exact artifact: +The law pin and the bridged-law pin are separate on purpose. A bridge whose proof falls to `sorry` taints every declaration citing it, and one wider corollary would have removed the credit of every law that only mentions the bridged function. A verifier MUST audit the two separately and MUST NOT let bridge credit move law credit. -**Hash pinning.** The verifier MUST read the caller-supplied `.wasm`, compute its SHA-256, and reject unless it equals `wasm_sha256`. The witness pins `manifest.subject.artifactHash` to the recomputed hash string, and `Schema.Holds` conjoins `artifactHash = CertModule.wasmSha256`, so the JSON envelope, the Lean manifest, the packaged `Module.lean`, and the actual bytes must all agree. +## 10. Checker witness and audit program -**ArtifactBytes injection.** The verifier MUST generate `ArtifactBytes.lean` itself from the bytes it read — the package has no opportunity to supply a different numeral. The encoding is a single little-endian natural: `modBytes = Σ bytes[i] · 256^i` (rendered as one hex numeral with the byte sequence reversed), plus the explicit `modLen = `. The length is soundness-relevant because trailing `0x00` bytes are not represented in the numeral. Every in-kernel decode (`CertDecode`, `WasmSlice`) reads from this pair using shift/mask arithmetic; the witness pins `Artifact.data.modBytes` / `Artifact.data.modLen` to the checker-generated module's values, so the packaged claim data provably talks about the injected bytes. +After the package builds, the verifier writes `CheckerWitness.lean`, which is never read from the package. It is data for the kernel: theorems only, no `import Lean` and no command that runs code. It imports `AcceptedArtifact`, `ArtifactBytes`, `Manifest`, `Artifact`, `Laws` and `Bridge` when declared, and `ArtifactCertificate`. Every name in it is `_root_`-qualified, so a package declaration placed where an unqualified name would resolve first (for example `AverCertChecker.AverCert.AcceptedArtifact.accepted`, under the witness's own namespace) cannot be reached. `_root_` does not settle a dotted name on its own: Lean resolves `A.b.c` to the longest prefix that is a declared constant and reads the rest as field accesses, so `_root_.AverCert.manifest.subject.contracts` would mean a package constant `AverCert.manifest.subject`, or `AverCert.manifest.subject.contracts` itself, if one were declared. No name in the witness therefore continues past a package constant. The package constants it names, `AverCert.manifest`, `AverCert.Artifact.data`, `AverCert.Artifact.certificate` and the law and bridge corollaries, are named in full, and every field is read through the wall structure's projection function: `_root_.AverCert.Schema.Subject.contracts (_root_.AverCert.Schema.Manifest.subject _root_.AverCert.manifest)`, `_root_.AverCert.AcceptedArtifact.ArtifactData.manifest _root_.AverCert.Artifact.data`, `_root_.List.map _root_.AverCert.Schema.Obligation.policy (_root_.AverCert.Schema.Manifest.obligations _root_.AverCert.manifest)`. A projection is a wall constant under a wall namespace, where the audit refuses every package declaration other than a private or Lean-auxiliary one (item 1 below; none of those is a field name), and the audit also refuses a package constant that extends another declared constant's name (item 1 below). Every numeral is a `nat_lit` and every `Int` is built from `Int.ofNat` or `Int.negSucc`, so no `OfNat` instance takes part in what a pin says. It contains, in order: -**Wall identity.** `format.wall_id` names the exact audited Lean source set (plus toolchain) the proof must elaborate against, per section 1. The verifier materializes the embedded wall sources into the build directory itself; packaged files with wall-source names are ignored. Changing any audited wall source or the toolchain pin changes the identity, and a certificate naming an unknown identity MUST be rejected. +- one bridge pin per `sourceBridges` entry, at the root with no `open`: `def _root_.AverCertChecker.bridge_statement_ : Prop := ()`, then `theorem _root_.AverCertChecker.bridge_pin_ : _root_.AverCertChecker.bridge_statement_ ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) := _root_.AverCert.Bridge._certified`; +- one law pin per `laws` entry, at the root with no `open`: `def _root_.AverCertChecker.law_statement_ : Prop := ()`, then `theorem _root_.AverCertChecker.law_pin_ : _root_.AverCertChecker.law_statement_ ∧ (… Holds …) := _root_.AverCert.Laws.`, and, for a claim with bridges, `_root_.AverCertChecker.bridged_law_pin_` at `law_statement_ ∧ (… Holds …) ∧ bridge_statement_ ∧ …`, numbered over the bridged claims. Each statement is elaborated alone, as its own definition, and the pins conjoin the definitions, so no statement text can change how a conjunction associates; the package's corollary checks against the pin only if its own type is that conjunction. No statement is read inside the model theorem's namespace: the package names that namespace, and a package constant in it could capture a name of the statement; +- the report pins, each a theorem `_root_.AverCertChecker.report_pin_` (21 of them), every field read through its projection function as above: that `Artifact.data.modBytes`, `modLen`, `manifest` and `wasip2ComponentEnvelope` are the checker's bytes, `AverCert.manifest` and the declared envelope; that `subject.artifactHash` is the recomputed hash; that `artifactRoot`, the obligation export names, `subject.exports`, the policies, the termination witnesses, `contracts`, `declaredUncertified`, `capabilities`, `start`, `hostRoleTable`, `stringHostRoles`, `target`, `profile` and `abi` are their JSON values; and that `ClaimAxes.reportEntries` and `ClaimAxes.reportFacets` are the JSON's names, class and facets. Each is proved by `rfl`, the two report-entry pins by `first | rfl | decide +kernel`; +- `theorem _root_.AverCertChecker.checked : _root_.AverCert.AcceptedArtifact.accepted _root_.AverCert.Artifact.data := _root_.AverCert.Artifact.certificate`, which forces the package root to exist at exactly the accepted type. -## 8. The checker witness, the axiom whitelist, and the fail-closed guard +A pin that does not elaborate declines the package. -After the package builds, the verifier authors `CheckerWitness.lean` — never accepted from the package — containing, in order: `rfl` pins equating `Artifact.data.modBytes/modLen/manifest` with the checker-generated `ArtifactBytes` values and `AverCert.manifest`; `rfl` pins of every kernel-pinned manifest field of section 4 (`artifactHash` to the recomputed hash, `artifactRoot`, obligation export names, `subject.exports`, `StandardFace.reportEntries` to the exact `(name, class)` pair list, policies, termination witnesses, contracts, `declaredUncertified`, `capabilities`, `start`, `hostRoleTable` — rendered as `none` or `some {box, add, mul, sub, toIndex, cmp, eq}` mirroring the JSON — `stringHostRoles`, `target`, `profile`, `abi`); the theorem `AverCertChecker.checked : AverCert.AcceptedArtifact.accepted AverCert.Artifact.data := AverCert.Artifact.certificate`, which forces the packaged root to exist at exactly the accepted type; one law pin per manifest `laws` entry — `theorem _root_.AverCertChecker.law_pin_ : () ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) := _root_.AverCert.Laws.`, written inside `namespace ` … `end ` for the model theorem's own namespace (the same context the package's `Laws.lean` uses) and therefore placed before `namespace AverCertChecker` opens, since nesting it there would make the current namespace `AverCertChecker.` and resolve the statement differently; `open in` at the root is NOT that context either — inside `namespace Json` the text `Json.jsonInt` reaches the constructor `Json.Json.jsonInt`, while at the root it reaches the accessor `Json.jsonInt` that `open` only adds an alias beside. Its `_root_.` citation makes an `open`-shadowed decoy unrepresentable and its type forces the package corollary to exist at exactly the declared statement; one further pin per law-claim that declares `bridges` — `theorem _root_.AverCertChecker.bridged_law_pin_ : () ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) ∧ () ∧ … := _root_.AverCert.Laws._bridged`, numbered over the BRIDGED claims in manifest order and written in the same namespace as that claim's own pin, so a bridge that fails its audit costs this pin and never the law pin above it; one source-bridge pin per manifest `sourceBridges` entry — `theorem _root_.AverCertChecker.bridge_pin_ : () ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) := _root_.AverCert.Bridge.` — whose statement the checker RENDERS from the entry's declared structure rather than reading it out of the manifest (section 4.1), written at the ROOT with no surrounding namespace and no `open`, which is exactly why that rendered statement is `_root_.`-qualified throughout: the pin's meaning must not depend on the package's namespaces; and finally the axiom guard. +The axiom guard and the audit of what the package declared are a separate checker-authored program, `CheckerAudit.lean`, run as `lake env lean --run CheckerAudit.lean` after the witness is built. Its code is elaborated with only the Lean toolchain in scope, so no instance, notation or declaration a package ships can change what it computes. (An audit elaborated inside the package's environment could be subverted, for example by a package `BEq Lean.Name` instance that made every axiom compare equal to a whitelisted one.) At run time it loads the built `CheckerWitness` environment and, in order: -The axiom guard is a checker-authored `run_cmd` that collects the axiom closure of `AverCertChecker.checked` — and then of every `AverCertChecker.law_pin_`, every `AverCertChecker.bridged_law_pin_`, and every `AverCertChecker.bridge_pin_`, so the audit walks exactly the pins, never the package's bare corollary names — via `Lean.collectAxioms`, and requires every axiom to be in the whitelist `[propext, Classical.choice, Quot.sound]`. Matching is exact: fully qualified, case-sensitive `Lean.Name` equality with subset semantics — no prefix or namespace matching. The two audits differ in what a violation costs, and only there. The accepted-artifact root THROWS: a non-whitelisted axiom under an export closure fails the elaboration and rejects the certificate. A law pin instead LOGS its result, one machine-readable line per pin — `AVER_LAW_AUDIT AverCertChecker.law_pin_ ok` or `AVER_LAW_AUDIT AverCertChecker.law_pin_ axioms [,...]` — which the verifier parses back out of the witness elaboration output, because a law that fails only its axiom audit loses its own credit and does not take the exports down with it (section 4.1). A bridged law-claim pin logs the same two shapes under `AVER_LAW_BRIDGE_AUDIT AverCertChecker.bridged_law_pin_ …`, and a source-bridge pin under `AVER_BRIDGE_AUDIT AverCertChecker.bridge_pin_ …`; both are read back by the same rules. The three markers are distinct as whole strings, so no line of one surface can be read as a line of another. That readback is fail-closed in its own right: exactly one well-formed line per declared claim is required, and a missing, renamed, repeated, or malformed line DECLINES the package rather than crediting an unaudited claim. Only a well-formed `ok` line ever grants credit — hence `ok` is a keyword in its own field, so that an axiom literally named `ok` cannot render a not-credited line that reads like a credited one. A conforming verifier MUST NOT credit a claim on the strength of anything weaker than its own audit of that pin. The guard is fail-closed by construction: it runs at elaboration of the witness, any thrown error fails the build, and a failed build is a rejected certificate. The package cannot carry a competing or defanged guard because `run_cmd` is one of the twenty substrings the staging scan of section 9 rejects. That scan is an enumerated blacklist, not a semantic ban on every elaboration-executing construct — commands outside the list pass (the producer itself emits `#print axioms`) — so the soundness story rests on this checker-authored guard plus kernel acceptance, with the scan as a hardening layer. Two placement facts matter: the witness is authored after any cache restore and is never cached, so the guard runs on every `verify` and `check` invocation; and the stage-11 fresh replay re-checks every term in the import closure but does not itself enforce any axiom policy, so the guard's location in the always-fresh witness is load-bearing, not redundant. A conforming verifier MUST enforce the same whitelist on the axiom closure of the accepted root and MUST treat any additional axiom — including `sorryAx` — as rejection. +1. declines a package that declares any constant under the reserved `AverCertChecker` prefix; then any package constant under a wall or checker namespace root (`AcceptanceSoundness`, `ArithTemplateDerisk`, `AverBits`, `AverCertAudit`, `AverCertChecker`, `CertDecode`, `CertModule`, `CertPrelude`, `InterpreterSequencing`), any under `AverCert` other than exactly `AverCert.manifest` and `AverCert.subject` or a name inside the producer's own `AverCert.Artifact`, `AverCert.Bridge`, `AverCert.Final`, `AverCert.Laws` and `AverCert.Plans` (so `AverCert.manifest.subject` and `AverCert.Artifact` itself are refused), and any whose name has `AverCert` or `AverCertChecker` after its first component (`AverCert.AcceptedArtifact.AverCert.ClaimAxes.checked`). Lean resolves a dotted name in the innermost enclosing namespace first, so such a name is where a wall reference could land. It then declines any package constant under `AverCert` whose name extends another declared constant (`AverCert.Artifact.data.manifest` extends `AverCert.Artifact.data`), because Lean resolves a dotted name to the longest prefix that is a constant, so such a name is where a field read of that constant could land; the producer writes the pieces of a long subject list as `AverCert.Plans.subject__` for this reason. Exactly two kinds of package constant are exempt from both rules. One is a private constant, which no other module can name. The other is an auxiliary Lean declares beside a constant (`leanAuxiliary`): beside a constant the package does not declare, a reserved name such as an equation lemma, which Lean realizes in the package module that first unfolds that constant and which states its own fact (Lean refuses a user declaration of a reserved name whose parent exists, and such a parent exists before every package module); and, beside a package constant, an internal `_`-prefixed compiler constant, an abstracted `proof_`, a matcher `match_`, an equation `eq_`, or an unfolding lemma `eq_def` or `eq_unfold`, recognised by name. A reserved name beside a package constant is not exempt as such, because a package can declare `V.h.eq_1` itself before it declares `V.h`. None of the exempt names is a field name of a wall structure; +2. declines a package module that carries a parser extension (notation, syntax, a mixfix operator, a token), a scoped instance, or an instance outside the admitted forms. The class of an instance is read off its elaborated type, so an alias (`abbrev Order := LE`) or a class parent projection cannot disguise it. Admitted are: instances of `Decidable`, `DecidableEq`, `DecidableRel`, `DecidablePred`, `Nonempty`, `ReflBEq` and `LawfulBEq` at any type (they carry proofs, so they cannot make a proposition mean something else, and a false one needs an axiom the guard sees); `Inhabited`, `BEq` and `SizeOf` at an inductive type a package module declares; instances of a class a package module declares; and exactly two data instances over core types, `Coe Int Float` with value `⟨fun n => Float.ofInt n⟩` and `HAdd String String String` with value `⟨String.append⟩`, compared structurally. Anything else (`LE Nat`, `OfNat Nat n`, `BEq Lean.Name`, …) declines the package; +3. checks every record and sum a bridge encoder reads (section 9.2); then the law statements: the witness reads each one at the root, where a `_root_.` spelling means exactly the root constant whatever else the package declares (a package constant `Evil.Tiny.addTwo` beside the model `Tiny.addTwo` is harmless), and the audit declines when the value of `law_statement_` of a law with bridges does not use every listed bridge's `model` constant (`Expr.getUsedConstants`), which a `_root_.` spelled where elaboration drops it (a type ascription's type) would otherwise pass; +4. collects the axioms of `AverCertChecker.checked` and of every report pin with `Lean.collectAxioms`, and declines on any axiom outside `[propext, Classical.choice, Quot.sound]`. A report pin closed by `decide +kernel` through a `sorry`-backed package decision procedure carries `sorryAx` into this audit; +5. collects the axioms of every `law_pin_`, `bridged_law_pin_` and `bridge_pin_` (the pins, never the package's bare corollary names) and logs one line per pin: `AVER_LAW_AUDIT`, `AVER_LAW_BRIDGE_AUDIT` or `AVER_BRIDGE_AUDIT`, then the pin name, then `ok` or `axioms [,…]`. -*Known gap — the record-parameter face is fail-closed by axiom-clean unprovability, with no decidable backstop.* The record-parameter declared face (`StandardFace.recordParamDeclaredFace`) pins the module's type-section entry to the wall lowering of the plan's record declaration by decidable equality (`decide (lowerTypeDecl carrier fuel decl = some entry)`, covering form, ordered field list, storages and mutabilities), but it binds the obligation's meaning fields — `Dom`, `Cod`, `domRepr`, `codRepr`, `model` — to the wall terms over that declaration by `HEq`, not by any decidable check, exactly as `intDispatchDeclaredFace` does. A claim whose obligation `Dom` disagrees with the pinned declaration — an extra field, a permuted or cross-direction field list, a carrier doppelganger — is therefore rejected only because no Lean proof of the mismatched `HEq` exists, not because any conjunct evaluates to `false`. That non-existence is a theorem of axiom-clean Lean (an `HEq` between two distinct wall types is unprovable), so this face is fail-closed **only under this section's whitelist**: an admitted axiom deciding type equality — or `sorryAx` — would manufacture the missing proof and admit the mismatched claim while the equality pin still holds. A conforming verifier MUST run the `collectAxioms` scrub on the accepted root; a reimplementation that discharges these `HEq` pins with any admitted type-equality axiom breaks this face specifically. The equality pin itself needs no such assumption — it is decidable — and one hostile shape, a field whose mutability the byte-side scalar gate ignores, is caught by that decidable pin alone (a `decide +kernel`-false rejection); it is the extra-field and cross-direction shapes that rest on the `HEq`-unprovability above. The record-face guard-iso (`tests/fixtures/cert_record_decl_guard_iso.lean`) exercises both kinds. +A decline is the line `AVER_AUDIT_DECLINE ` and a nonzero exit. Completion is the line `AVER_AUDIT_OK`; a run that ends without it declines. Names are matched as exact, fully qualified `Lean.Name`s, with no prefix or namespace matching. The verifier reads the per-pin lines back and requires exactly one well-formed line per declared pin; a missing, renamed, repeated or malformed line declines the package. Only an `ok` line grants credit, and `ok` is a keyword in its own field, so an axiom literally named `ok` cannot pass for one. The two axiom audits differ only in what a violation costs: an axiom outside the whitelist under the accepted root or a report pin rejects the certificate, while a law or bridge pin loses only its own credit (section 9.4). -## 9. The verification pipeline +The witness and the audit run on every `verify` and `check`, after any cache restore, and are never cached. `collectAxioms` reads, for an imported declaration, the axiom data that the Lean process that built its module recorded in the `.olean`; the checker builds every module itself, so that data is its own. The final replay re-checks terms but enforces no axiom policy, so the audit is load-bearing. The token gate of stage 7 is a hardening layer in front of it; the audit and kernel acceptance are what the verdict rests on. -A conforming verifier MUST execute the following stages in order and MUST reject (nonzero exit, no CERTIFIED output) on the first failure. Stage numbers reference the reference implementation in `aver-cert/src/verifier.rs`. (For the one place the reference `explain` mode deviates from the no-CERTIFIED-output-on-failure requirement, see the known gap in stage 12.) +## 11. Verification pipeline -1. **Manifest target gate.** Read the artifact bytes and parse `cert-manifest.json`; require `schema_version = 8`, `format.version = 1`, `format.wall_id` resolving to an embedded wall, `artifact_certificate_root = "AverCert.Artifact.certificate"`, `profile = "AverUserProfile/v1"`, and one admitted target/ABI pair: (`target = "wasm-gc"`, `abi = "aver-wasm-gc/0"`) or (`target = "wasip2"`, `abi = "aver-wasip2/0"`). The target is read before byte validation so the verifier selects the component-envelope validator instead of trying to parse component bytes as a core module. -2. **Wasm validity gate.** For `target = "wasm-gc"`, run a complete standard WebAssembly validator over the artifact bytes (`wasmparser::Validator::validate_all` in the reference). This is the one retained Rust semantic gate: the Lean wall decodes every trust-bearing section and instruction it consumes, but it is not a complete Wasm validation algorithm (stack/control typing included), so artifact acceptance is only stated over validator-accepted modules. *Known gap:* the reference constructs `wasmparser::Validator::new()` with that crate's default feature set (pinned at `wasmparser 0.248`); the exact set of enabled Wasm proposals is inherited from the dependency version rather than declared normatively, which cross-vendor agreement will eventually require. -3. **Manifest parse and envelope checks.** Compute SHA-256 of the bytes; require `wasm_sha256` equal to the recomputed hash; then parse the remaining candidate fields of section 4 with the exact-object and policy/termination coupling rules and the printable-ASCII candidate gate. -4. **Build-directory assembly.** Create a fresh private build directory (mode `0700` on Unix, under a checker-selected temp root). -5. **Staging of package data.** For each regular file directly in the cert directory (non-files are skipped): ignore it unless its name ends in `.lean`; silently skip checker-owned names (`ArtifactBytes.lean`, `lakefile.lean`, `CheckerWitness.lean`, and every wall source name). Then walk subdirectories recursively, skipping every dot-directory (`.lake`, `.git`) outright at every depth — a shipped build cache can never join the staged tree — and rejecting nesting deeper than 16 directory levels (the package is the one tree whose recursion depth an untrusted party chooses). A nested `.lean` file found by the walk first passes the stage-6 name and shadow gates, and is then staged at its relative path exactly when the already-staged top-level `Manifest.lean` or `Certificate.lean` contains an import line for its dotted module name (`Apps/Notepad/Store.lean` requires `import Apps.Notepad.Store`); the import lines are collected from the exact bytes staged, never from a second read. The scan for those lines is LITERAL and normative: each line is trimmed, a leading `import ` prefix is stripped, and the trimmed remainder is the admitted module name — Lean comments are NOT parsed, so a line beginning with `import ` inside a block comment still admits a file, and a conforming reimplementation MUST match this scan exactly, or its build set diverges. The admission list is a one-level check with no transitive closure (the producer imports every model root from `Manifest.lean`, section 2.1), and because it is authored by the untrusted producer it is build-set minimization — it keeps decoy trees and sidecars out of the build — NOT a security boundary: what protects the verdict is that every staged file passes the stage-6/7 gates and that acceptance rests on the checker-authored witness and axiom guard of section 8. Nested files stage in sorted relative-path order, and staging any two paths (flat or nested) that are equal ASCII-case-insensitively is rejected outright — on a case-insensitive staging filesystem the two writes would silently merge into one nondeterministically-chosen file. A nested `.lean` file whose dotted name is not imported is ignored outright and never staged, scanned, or built. -6. **Name sanitation and shadow rejection.** A flat file name MUST match `^[A-Za-z][A-Za-z0-9_]*\.lean$`; for a nested file the same rule applies to every `/`-separated path segment (the `.lean` suffix on the last), and the dotted module root is the `.`-join of the segments. The per-segment rule is simultaneously the traversal guard (no `.` inside a segment, no `..`, no empty or absolute components — every accepted segment is a plain `Normal` path component) and the lakefile-injection guard (roots are interpolated into the checker-authored lakefile unescaped, so only validated segments may become roots). Reject any root whose dotted name — or any dotted prefix of it — case-insensitively collides with a toolchain root (`Init`, `Lake`, `Lean`, `Std`), a wall source root, or `ArtifactBytes`/`CheckerWitness`/`lakefile`. Additionally reject any two staged paths (flat or nested) that are equal ASCII-case-insensitively — stage 5 states the rationale. *Known gap:* stage 5's `.lean` suffix test is case-sensitive, so a file with an uppercase extension (`ArtifactBytes.LEAN`) is silently ignored there rather than rejected here. -7. **Elaboration-code scan.** Reject any staged file whose text contains any of the twenty tokens `#eval`, `run_cmd`, `run_elab`, `run_tac`, `initialize`, `builtin_initialize`, `macro`, `macro_rules`, `elab`, `elab_rules`, `syntax`, `notation`, `unsafe`, `implemented_by`, `extern`, `deriving`, `attribute`, `@[`, `«`, `open Lean`. The check is a plain case-sensitive substring scan over the whole file after lossy UTF-8 decoding — comments included — and within its enumeration it is deliberately overbroad: package Lean files are data and definitions only. Its guarantee is exactly this list of twenty substrings and nothing broader; it does not establish that every elaboration-executing construct is banned (`#print axioms`, which the producer itself emits, passes). The sound backstop is the checker-authored axiom guard and kernel acceptance (section 8); this scan is hardening. -8. **Checker-owned materialization.** Write the embedded wall sources, the generated `ArtifactBytes.lean` (section 7), a checker-authored `lakefile.lean` whose roots are the sorted, deduplicated union of the staged package roots, the wall source roots, and `ArtifactBytes`, and the pinned `lean-toolchain`. -9. **Hermetic Lean build.** Run `lake build` through the pinned toolchain: the canonical Elan installation (`ELAN_HOME` or `~/.elan`) is the single bootstrap trust anchor, invoked by absolute path as `elan run --install lake ...` with a **cleared environment** (no inherited `LEAN_PATH`/`LEAN_SRC_PATH`/`ELAN_TOOLCHAIN`/`PATH`/`HOME`), implicit Lake artifact caches disabled, and `TMPDIR`/`TMP`/`TEMP` redirected into a checker-owned directory. Every Lean toolchain subprocess — this build, the witness elaboration of stage 10, the kernel replay of stage 11, and the optional prelude-cache build — runs under a per-step wall-clock limit (15 minutes by default; `AVER_CERT_PHASE_TIMEOUT_SECS` replaces it, capped at one day), and on expiry the step's entire process tree is killed. For the mandatory steps a timeout is fail-closed — the certificate is declined — with one documented exception: a timeout of the opt-in prelude-cache build is downgraded to a loud warning and a cache miss, never an acceptance failure, because the mandatory proof build that follows re-does the same work under its own limit. Build caches are opt-in only and are trusted local state; a cache-assisted build that fails is retried once from clean before rejecting. The data cache (`AVER_CERT_DATA_CACHE`) is keyed on a SHA-256 over a cache-layout version, the schema version, the pinned artifact hash, the wall id, the toolchain version, **and the `/`-normalized relative name and contents of every freshly staged build-directory file, walked recursively** (nested model files included; dot-directories skipped; `CheckerWitness.lean` excluded) — a reimplementation keying only on schema/hash/wall/toolchain, or only on top-level files, could wrongly reuse stale `.olean` data after a package edit that leaves those pins untouched. `AVER_CERT_PRELUDE_CACHE` separately caches the artifact-independent wall prefix. -10. **Witness elaboration.** Author `CheckerWitness.lean` (section 8) and elaborate it (`lake env lean -o ... CheckerWitness.lean`). This runs on **every** invocation, outside any cache, so the manifest pins and the axiom guard can never be replayed from stale build products. Failure MUST be reported as the certificate not binding to this artifact. -11. **Fresh whole-closure kernel replay** (`verify`, `explain`, and `inspect`). Run `lake env leanchecker --fresh CheckerWitness`: the pinned toolchain's `leanchecker` re-checks the witness module and its entire import closure in a fresh declaration environment, so nothing is inherited from the elaboration environment of stage 10. The developer preflight `check` is the **only** mode that omits this stage; it trusts the freshly built or explicitly cached `.olean` closure and MUST report `CHECKED`, never `CERTIFIED`. `check` MUST NOT be used as a release or admission gate — note this is a requirement on consumers, not something the process status enforces: a successful `check` still exits zero. -12. **Verdict mapping.** Any failure above → nonzero exit with a mode-specific prefix: `verify` prints `DECLINED` with a reason, `check` prints `CHECK FAILED`, and `explain`/`inspect` print `error:`. Zero certified exports with everything passing → the **admission-only** verdict, a nonzero exit — a package that proves nothing about any export MUST NOT exit successfully, even though its whole-module accounting held — under a mode-specific banner: `NO CERTIFIED EXPORTS (admission only, no behavioral claims)` for `verify`, `NO CHECKED EXPORTS (developer preflight only, no behavioral claims)` for `check`, `NO CERTIFIED EXPORTS` for `explain`/`inspect`. Otherwise → `CERTIFIED`, exit zero, printing the artifact path, export count, level (`L1` / `L3` / `mixed L1/L3` computed from the pinned policies), and one line per export containing only kernel-pinned facts: name, policy, and the class label mapped from the pinned `reportEntries`. The verdict IS the exit code. When the manifest declares at least one law-claim, the verdict line additionally carries `; law-claims: of credited`, followed by one line per uncredited claim naming it and the axioms its proof depends on (`law-claim not credited: