From 98e6dc07167464d2312b044f53815543b7bbfb63 Mon Sep 17 00:00:00 2001 From: jasisz Date: Tue, 22 Sep 2026 23:46:43 +0200 Subject: [PATCH 01/89] Emit every function through the MIR body emitter Plan-shaped functions in modules with the Int carrier were lowered through the certification plan lowerer instead of the MIR emitter. That path is removed, so the wasm-gc backend has one body emitter. The producer still receives its MIR-derived plans as certificate input; a plan whose lowering no longer matches the emitted bytes declines. Across the certkit fixtures, the json and hello examples, the projects and btc-listener, 7 of 8139 code entries change (+125 bytes); four fixture exports (letnamed x3, cell_at) now decline. The PlanEmittedCanonicalCodegen decision is replaced by MirEmitterIsTheOnlyEmitter. The plan-path engagement test is dropped; the carrier on/off agreement test stays. Co-Authored-By: Claude Opus 5.5 (1M context) --- decisions/architecture.av | 14 +-- docs/decisions.md | 10 +- src/codegen/cert/expr_fragment_from_mir.rs | 9 +- src/codegen/wasm_gc/module.rs | 122 ++++-------------- tests/wasm_gc_plan_mir_equivalence.rs | 136 ++++----------------- 5 files changed, 64 insertions(+), 227 deletions(-) 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/decisions.md b/docs/decisions.md index 44e135d4a..525e5232a 100644 --- a/docs/decisions.md +++ b/docs/decisions.md @@ -2,7 +2,7 @@ _Generated by `aver context --decisions-only`_ -selection: mode: `auto`, budget: `20kb`, included_depth: `0`, selected: `15/15`, truncated: `false`, used: `10529b` +selection: mode: `auto`, budget: `20kb`, included_depth: `0`, selected: `15/15`, truncated: `false`, used: `10448b` ## HostLanguage (2024-01-10) @@ -144,13 +144,13 @@ Author: `Aver core team` Author: `Aver core team` -## PlanEmittedCanonicalCodegen (2026-07-09) +## MirEmitterIsTheOnlyEmitter (2026-09-22) -**Chosen:** "UnconditionalCanonicalPlanEmission" -**Rejected:** "CertifyGatedEmission", "SilentMirFallback" +**Chosen:** "MirEmitterOnly" +**Rejected:** "PlanDrivenEmission", "CertifyGatedEmission" **Impacts:** "Codegen", "WasmGC", "Certification" -> 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. +> 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. Author: `Aver core team` diff --git a/src/codegen/cert/expr_fragment_from_mir.rs b/src/codegen/cert/expr_fragment_from_mir.rs index 39aa12d44..48d495a5a 100644 --- a/src/codegen/cert/expr_fragment_from_mir.rs +++ b/src/codegen/cert/expr_fragment_from_mir.rs @@ -125,6 +125,7 @@ pub(crate) fn fragment_plan_from_mir_fn( /// against placeholder tables. Indices do not affect the encoding SHAPE, so /// this answers structural questions (which host roles does the body call?) /// without needing the module's byte-derived tables. +#[cfg(test)] fn placeholder_expr_fragment_plan(plan: &FragmentPlan) -> Option { let struct_table = match plan { FragmentPlan::Sym(sym) => FragStructTable::placeholder_for(sym), @@ -133,14 +134,6 @@ fn placeholder_expr_fragment_plan(plan: &FragmentPlan) -> Option bool { - placeholder_expr_fragment_plan(plan) - .is_some_and(|frag| expr_fragment_plan_calls_host_role(&frag, role)) -} - #[cfg(test)] pub(crate) fn expr_fragment_plan_from_mir_fn( mir_fn: &crate::ir::mir::MirFn, diff --git a/src/codegen/wasm_gc/module.rs b/src/codegen/wasm_gc/module.rs index 161ca1a8a..9f7cf3c42 100644 --- a/src/codegen/wasm_gc/module.rs +++ b/src/codegen/wasm_gc/module.rs @@ -12,12 +12,9 @@ //! 3. **Export section** — `_start` (always at fn idx 0) plus every //! user fn by name. //! 4. **Code section** — `_start` calls `main` and drops any return -//! value; user fns normally get their bodies from the MIR body emitter -//! (`body::emit_fn_body_via_mir`). Small host-free expression certificate -//! islands are first lowered from MIR into source-level `SymPlan` when -//! possible, otherwise representation-level `ExprFragmentPlan`, and then -//! emitted through the shared canonical plan lowerer, so codegen and the -//! verifier share one byte rule. A residual function gets an `unreachable` +//! value; every user fn gets its body from the MIR body emitter +//! (`body::emit_fn_body_via_mir`), the only body emitter (decision +//! `MirEmitterIsTheOnlyEmitter`). A residual function gets an `unreachable` //! trap stub for the rare shape MIR does not cover (a first-class fn value //! with no funcref-table slot — a builtin/variant `FnValue` or a let-bound //! fn-value call). @@ -3144,11 +3141,12 @@ pub(super) fn emit_module_with( // // `mir_fn_for[i]` is `Some(&MirFn)` when the i-th fn lowered to // MIR (always true on valid input — every resolved fn lowers). - // `fragment_plan_for[i]` is set when a small certified island - // can be emitted from `MIR -> FragmentPlan -> canonical Wasm`. + // `fragment_plan_for[i]` is the certificate producer's plan for the + // i-th fn, handed to `--certify` as input only: it never steers the + // bytes, and the producer declines a plan that does not match them. // `mir_dispatch[i]` is the final per-fn non-stub decision: `true` - // when either the plan path or the MIR body emitter rendered the fn, - // `false` when the fn got a trap-stub body. It is computed once in + // when the MIR body emitter rendered the fn, `false` when the fn got + // a trap-stub body. It is computed once in // the caller_fn pre-pass below and reused verbatim by the dry-run + // real code-emit loops, so all three see the same path per fn and // the discovered locals / caller_fn registration stay consistent. @@ -3156,10 +3154,10 @@ pub(super) fn emit_module_with( .iter() .map(|rfd| mir_program.fn_by_id(rfd.fn_id)) .collect(); - // Record layout resolver for the plan producer: field name -> (declared - // field index, field source type). Newtypes/carriers return `None` (their - // field reads are identity, not `struct.get`), so they never plan a - // projection the emitter would not have emitted. + // Record layout resolver for the certificate plan producer: field name -> + // (declared field index, field source type). Newtypes/carriers return + // `None` (their field reads are identity, not `struct.get`), so they never + // plan a projection the emitter does not emit. let record_field_lookup = |record: &str, field: &str| -> Option<(u32, String)> { if registry.newtype_underlying(record).is_some() { return None; @@ -3219,36 +3217,20 @@ pub(super) fn emit_module_with( // emit later in the code section calls `register` again with the // same names; the collector is idempotent so the idx assignment // matches what the call sites observed during this probe. This - // pass also decides plan/MIR-emit vs trap-stub per fn (`mir_dispatch`): - // the chosen emitter runs here so its caller_fn registrations match - // the real code-emit loop. Plan fragments and trap-stub bodies emit no - // calls, so the pre-pass simply skips caller_fn collection for those fns. + // pass also decides MIR-emit vs trap-stub per fn (`mir_dispatch`): + // the MIR emitter runs here so its caller_fn registrations match + // the real code-emit loop. Trap-stub bodies emit no calls. // // It doubles as the liveness signal for the two comparison helper - // exports. Both emit paths report through the body they are about to - // emit and nothing else: the MIR emitter sets a flag on `fn_map` at the - // one lookup every `__aint_cmp` / `__aint_eq` call site goes through, - // and a plan fragment is read for the host-call roles its canonical - // lowering will emit. Neither is a second reachability analysis over the - // module — a helper only reachable from another runtime helper (a + // exports. The MIR emitter reports through the body it is about to + // emit and nothing else: it sets a flag on `fn_map` at the one lookup + // every `__aint_cmp` / `__aint_eq` call site goes through. That is not + // a second reachability analysis over the module — a helper only + // reachable from another runtime helper (a // `List` element eq, say) is deliberately NOT live for this // purpose: no certified body cites it, so no certificate can bind it, // and `wasm-opt -Oz` is free to fold it away with its caller. - let mut aint_cmp_called = false; - let mut aint_eq_called = false; for (i, _fd) in fn_defs.iter().enumerate() { - if let Some(plan) = fragment_plan_for[i].as_ref() { - mir_dispatch[i] = true; - aint_cmp_called |= crate::codegen::cert::fragment_plan_calls_host_role( - plan, - crate::codegen::cert::FragHostRole::Cmp, - ); - aint_eq_called |= crate::codegen::cert::fragment_plan_calls_host_role( - plan, - crate::codegen::cert::FragHostRole::Eq, - ); - continue; - } let self_wasm_idx = import_count + 1 + (i as u32); let mut probe = Function::new([]); let used_mir = match mir_fn_for[i] { @@ -3274,8 +3256,8 @@ pub(super) fn emit_module_with( // put a `call` in front of it. A fn that later bails to a trap stub can // therefore leave the flag set for a call the module never ships; that // direction only keeps an export (and its helper) alive, never drops one. - aint_cmp_called |= fn_map.aint_cmp_called.get(); - aint_eq_called |= fn_map.aint_eq_called.get(); + let aint_cmp_called = fn_map.aint_cmp_called.get(); + let aint_eq_called = fn_map.aint_eq_called.get(); // `AVER_WASMGC_REQUIRE_MIR=1` turns the per-fn trap-stub fallback // into a hard error that lists every fn which did NOT emit from MIR @@ -3713,67 +3695,11 @@ pub(super) fn emit_module_with( codes.function(&start); } - // Host-bound plan nodes (Int literals box; `intAdd` calls the carrier - // add helper) encode against the module's own helper indices, which the - // classifier later re-derives from the emitted bytes as the host-role - // table. - let fragment_host_table = crate::codegen::cert::FragHostTable { - box_idx: registry.aint_from_i64_fn_idx, - add_idx: builtin_registry.lookup_wasm_fn_idx(BuiltinName::AintAdd), - mul_idx: builtin_registry.lookup_wasm_fn_idx(BuiltinName::AintMul), - sub_idx: builtin_registry.lookup_wasm_fn_idx(BuiltinName::AintSub), - to_index_idx: builtin_registry.lookup_wasm_fn_idx(BuiltinName::AintToIndex), - cmp_idx: builtin_registry.lookup_wasm_fn_idx(BuiltinName::AintCmp), - eq_idx: builtin_registry.lookup_wasm_fn_idx(BuiltinName::AintEq), - // The declared arith template indices matter only for the certificate - // manifest, which the checker re-derives from the emitted bytes; the - // plan encoder here needs only the call-target roles above. - ..Default::default() - }; for (i, _fd) in fn_defs.iter().enumerate() { let self_wasm_idx = import_count + 1 + (i as u32); - if let (Some(plan), Some(carrier)) = - (fragment_plan_for[i].as_ref(), registry.aint_struct_idx) - { - // Struct-binding table for the plan's projections, resolved from - // the same registry the MIR emitter would have used, so the - // plan-lowered `struct.get` cites exactly the emitter's type index. - let struct_table = crate::codegen::cert::frag_struct_table_for_plan( - plan, - &|name, source_ty| match name { - "Option" => registry.option_type_idx(&source_ty.canonical_name()), - "Result" => registry.result_type_idx(&source_ty.canonical_name()), - _ if name.starts_with("Vector<") => registry.vector_type_idx(name), - _ => registry.record_type_idx(name), - }, - ) - .ok_or_else(|| { - WasmGcError::Validation(format!( - "fragment plan struct binding for fn `{}` failed", - resolved_fn_defs[i].name - )) - })?; - let expr_plan = plan - .to_expr_fragment_plan(&fragment_host_table, &struct_table) - .ok_or_else(|| { - WasmGcError::Validation(format!( - "fragment plan encoding for fn `{}` failed", - resolved_fn_defs[i].name - )) - })?; - let func = crate::codegen::cert::lower_expr_fragment_plan_function(&expr_plan, carrier) - .map_err(|e| { - WasmGcError::Validation(format!( - "fragment plan lowering for fn `{}` failed: {e}", - resolved_fn_defs[i].name - )) - })?; - codes.function(&func); - continue; - } // Dry run: discover extra locals by emitting into a throwaway - // fn. Cheaper than threading a separate pre-pass. The plan/MIR - // decision (`mir_dispatch[i]` plus `fragment_plan_for[i]`) + // fn. Cheaper than threading a separate pre-pass. The MIR/stub + // decision (`mir_dispatch[i]`) // was fixed in the caller_fn pre-pass; reuse it here so the // discovered locals match the body the real emit produces below. // A fn the MIR walker doesn't cover (`mir_dispatch[i] == false`) diff --git a/tests/wasm_gc_plan_mir_equivalence.rs b/tests/wasm_gc_plan_mir_equivalence.rs index db448880f..fb258ef1a 100644 --- a/tests/wasm_gc_plan_mir_equivalence.rs +++ b/tests/wasm_gc_plan_mir_equivalence.rs @@ -1,32 +1,23 @@ -//! Plan-emitter vs MIR-emitter equivalence gate for the -//! `PlanEmittedCanonicalCodegen` decision (unconditional canonical plan -//! emission). +//! Carrier on/off agreement on the wasm-gc backend. //! -//! A plan-shaped pure float/bool function lowers through the canonical -//! certification plan lowerer (`lower_expr_fragment_plan_function`) in any -//! module that declares the Int carrier type (`registry.aint_struct_idx` is -//! `Some`), and through the ordinary MIR body emitter in a module with no Int -//! at all. Canonical plan emission is UNCONDITIONAL — it does not wait for -//! `--certify` — because the certificate must describe the exact bytes users -//! ship. The two emitters MUST therefore be observationally equal. +//! Every user function is emitted by the MIR body emitter +//! (`MirEmitterIsTheOnlyEmitter` in `decisions/architecture.av`). Until +//! 2026-09-22, plan-shaped functions in a module that declares the Int carrier +//! type were instead lowered through the certification plan lowerer; this file +//! was the gate that the two emitters agreed. It now pins that the same +//! float/bool functions give the same results whether or not the surrounding +//! module turns the Int carrier on. //! //! This test runs the SAME `floatLeGoal` / `boolAndGoal` source -//! (A) in a module WITH unrelated Int usage -> carrier declared -> plan-emitted body, and -//! (B) in a module WITHOUT any Int -> no carrier -> MIR-emitted body, +//! (A) in a module WITH unrelated Int usage -> carrier declared, and +//! (B) in a module WITHOUT any Int -> no carrier, //! on the wasm-gc backend and asserts identical results. //! -//! `floatLeGoal` (a `<=` comparison) and `boolAndGoal` (a pure `match`) are the -//! plan-shaped functions under comparison precisely because neither contains an -//! `+`/`-`/`*`/`/` operator or an Int literal, so neither one FORCES the carrier -//! on by itself (unlike e.g. `a + b`). Variant (A) turns the carrier on via a -//! separate, unrelated `unrelatedInt(x: Int)` helper; variant (B) has no Int -//! anywhere, so the very same functions go down the MIR path. -//! -//! It also asserts, via a `--certify` manifest, that variant (A)'s functions -//! actually took the plan path (class `expr-fragment-v1`). If canonical plan -//! emission silently disengaged and (A) quietly fell back to the MIR body, the -//! classifier would stop reporting `expr-fragment-v1` and this test would fail -//! loudly rather than letting the A==B check pass vacuously. +//! `floatLeGoal` (a `<=` comparison) and `boolAndGoal` (a pure `match`) are +//! used precisely because neither contains an `+`/`-`/`*`/`/` operator or an +//! Int literal, so neither one FORCES the carrier on by itself (unlike e.g. +//! `a + b`). Variant (A) turns the carrier on via a separate, unrelated +//! `unrelatedInt(x: Int)` helper; variant (B) has no Int anywhere. #![cfg(feature = "wasm")] @@ -77,14 +68,13 @@ const EXPECTED_REPORT: &str = "le=true/false and=true/false let=true/false pick=true/false prim=true/false"; /// Variant (A): the shared float/bool functions in a module that ALSO declares -/// Int (via `unrelatedInt`), which flips the `$AverInt` carrier on and routes -/// `floatLeGoal`/`boolAndGoal` through the canonical plan lowerer. `main` calls +/// Int (via `unrelatedInt`), which flips the `$AverInt` carrier on. `main` calls /// `unrelatedInt` so the Int usage is reachable, and prints it on a second line /// (ignored by the run comparison, which only reads line 1). fn variant_a_source() -> String { format!( r#"module PlanCarrierOn - intent = "plan-emitted float/bool functions in a module that also declares Int" + intent = "float/bool functions in a module that also declares Int" exposes [floatLeGoal, boolAndGoal, letBoolGoal, floatPickGoal, boolAndPrimGoal] effects [Console] {SHARED_BODY} @@ -100,11 +90,11 @@ fn main() -> Unit } /// Variant (B): the same float/bool functions in a module with NO Int anywhere, -/// so the carrier stays off and the functions go down the MIR body emitter. +/// so the carrier stays off. fn variant_b_source() -> String { format!( r#"module PlanCarrierOff - intent = "MIR-emitted float/bool functions in a module with no Int at all" + intent = "float/bool functions in a module with no Int at all" effects [Console] {SHARED_BODY} fn main() -> Unit @@ -146,53 +136,10 @@ fn run_wasm_gc(prefix: &str, source: &str) -> (bool, String) { ) } -/// `aver compile --target wasm-gc --certify -o ` and return the -/// parsed `cert/cert-manifest.json`. -fn certify_manifest(prefix: &str, source: &str) -> serde_json::Value { - let aver_bin = env!("CARGO_BIN_EXE_aver"); - let repo_root = PathBuf::from(env!("CARGO_MANIFEST_DIR")); - let path = temp_module(prefix, source); - let out_dir = path.parent().expect("temp module has parent").join("out"); - let out = Command::new(aver_bin) - .current_dir(&repo_root) - .arg("compile") - .arg(&path) - .arg("--target") - .arg("wasm-gc") - .arg("--certify") - .arg("-o") - .arg(&out_dir) - .output() - .expect("aver compile --certify executes"); - assert!( - out.status.success(), - "{prefix}: compile --certify failed:\n{}{}", - String::from_utf8_lossy(&out.stdout), - String::from_utf8_lossy(&out.stderr), - ); - let manifest_text = std::fs::read_to_string(out_dir.join("cert").join("cert-manifest.json")) - .expect("cert-manifest.json exists"); - let manifest: serde_json::Value = - serde_json::from_str(&manifest_text).expect("manifest is valid JSON"); - cleanup(&path); - manifest -} - -/// The certified class the manifest records for `name`, if any. -fn certified_class<'a>(manifest: &'a serde_json::Value, name: &str) -> Option<&'a str> { - manifest["certified"] - .as_array() - .expect("manifest has a certified array") - .iter() - .find(|c| c["name"].as_str() == Some(name)) - .and_then(|c| c["class"].as_str()) -} - -/// The core equivalence: the SAME plan-shaped float/bool functions produce the -/// SAME observable result whether the module declares Int (plan-emitted body) -/// or not (MIR-emitted body). +/// The core equivalence: the SAME float/bool functions produce the SAME +/// observable result whether the module declares Int or not. #[test] -fn plan_and_mir_emitters_agree_on_float_bool_functions() { +fn carrier_on_and_off_agree_on_float_bool_functions() { let (a_ok, a_out) = run_wasm_gc("plan-carrier-on", &variant_a_source()); let (b_ok, b_out) = run_wasm_gc("plan-carrier-off", &variant_b_source()); assert!(a_ok, "variant A (carrier on) run failed:\n{a_out}"); @@ -205,48 +152,19 @@ fn plan_and_mir_emitters_agree_on_float_bool_functions() { assert_eq!( a_report, b_report, - "plan-emitted (A) and MIR-emitted (B) bodies diverged for the same \ - float/bool functions:\n A(plan) = {a_report:?}\n B(mir) = {b_report:?}" + "carrier-on (A) and carrier-off (B) modules diverged for the same \ + float/bool functions:\n A = {a_report:?}\n B = {b_report:?}" ); assert_eq!( b_report, EXPECTED_REPORT, - "MIR-emitted report changed unexpectedly: {b_report:?}" + "report changed unexpectedly: {b_report:?}" ); // Sanity-check that variant A really did the reachable Int work (the thing - // that turns the carrier on), so the A==B agreement is between a genuine - // plan-emitted body and a genuine MIR-emitted body. + // that turns the carrier on), so the A==B agreement really compares a + // carrier-on module with a carrier-off one. assert_eq!( a_out.lines().nth(1), Some("int=42"), "variant A should also print its unrelated Int result:\n{a_out}" ); } - -/// Guard against silent disengagement: variant (A)'s functions must actually -/// take the canonical plan path, which the `--certify` manifest records as -/// class `expr-fragment-v1`. If plan emission regressed to a MIR fallback for a -/// carrier-declaring module, the classifier would stop reporting this class and -/// the assertion below would fail — so the equivalence test above cannot pass -/// vacuously with both variants secretly on the MIR path. -#[test] -fn variant_a_functions_take_the_plan_path() { - let manifest = certify_manifest("plan-carrier-certify", &variant_a_source()); - for name in [ - "floatLeGoal", - "boolAndGoal", - "letBoolGoal", - "floatPickGoal", - // The eager `Bool.and` builtin lowers through the `i32.and` fragment - // primitive; its plan path shipping real bytes is exactly what this - // gate protects. - "boolAndPrimGoal", - ] { - assert_eq!( - certified_class(&manifest, name), - Some("expr-fragment-v1"), - "{name} should be certified via the canonical plan path (expr-fragment-v1); \ - a different or missing class means plan emission silently disengaged for a \ - carrier-declaring module. manifest:\n{manifest:#}" - ); - } -} From dfb99c67564bc4abb708782b1f507047bfa4918e Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 00:13:27 +0200 Subject: [PATCH 02/89] cert wall: add i64.ne, i32.eqz, i32.ne and i32.or to the interpreter The MIR emitter lowers `!=` against an Int literal with `i64.ne`, `!=` over `__aint_eq` and `Bool.not` with `i32.eqz`, Bool `!=` with `i32.ne` and `Bool.or` with `i32.or`. The one-grammar lowering needs all four. `i64.ne`, `i32.eqz` and `i32.ne` follow the value convention of the existing `i64.eq` / `i32.eq` cases. `i32.or` is exact on 0/1 operands and stuck on anything else, so it never yields a value the bitwise wasm instruction would not. CertPreludeSanity gains edge-value examples for each, including the stuck cases. This changes the embedded wall sources, so the wall id no longer matches CURRENT_WALL_ID; the rotation is deferred to the end of the branch. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/CertPrelude.lean | 29 +++++++++++++++ .../wall/current/CertPreludeSanity.lean | 36 +++++++++++++++++++ 2 files changed, 65 insertions(+) diff --git a/aver-cert/assets/wall/current/CertPrelude.lean b/aver-cert/assets/wall/current/CertPrelude.lean index 5462cf393..b70aac942 100644 --- a/aver-cert/assets/wall/current/CertPrelude.lean +++ b/aver-cert/assets/wall/current/CertPrelude.lean @@ -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..f658488f0 100644 --- a/aver-cert/assets/wall/current/CertPreludeSanity.lean +++ b/aver-cert/assets/wall/current/CertPreludeSanity.lean @@ -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 From 3d7ffca4fe0eb0b3489f5be57b09be2bbeb90168 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 00:13:27 +0200 Subject: [PATCH 03/89] cert wall: add the one-grammar plan, its lowering and the simulation theorem Grammar.lean mirrors the admitted subset of MirExpr (literals, locals, named lets, calls to user functions and to Bool.and/or/not, tail calls, Int and Bool binary operators, Int negation, if/else, record create in declared order and field projection) with its typing and source semantics, including fuel-indexed group models for SCCs. GrammarLower ports the wasm-gc MIR emitter for exactly these nodes and makes the same choices from the same tree: the literal compare looks for the literal on the left first and flips the operator, re-emits a bare local and stashes anything else in the const-compare scratch local, and single-use let copies stay locals. One lowering yields both the instructions the interpreter runs and the code-entry bytes. GrammarSound proves `agreement` by structural induction over the grammar and `fn_certified_group`, which certifies every member of one group by fuel induction, with callees outside the group as FnCertified hypotheses. Axioms: propext, Classical.choice, Quot.sound. The files are built by the development lakefile only; they are not yet in the verifier's source set. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/assets/wall/current/Grammar.lean | 329 +++++ .../assets/wall/current/GrammarLower.lean | 271 ++++ .../assets/wall/current/GrammarSound.lean | 1210 +++++++++++++++++ aver-cert/assets/wall/current/lakefile.lean | 3 +- 4 files changed, 1812 insertions(+), 1 deletion(-) create mode 100644 aver-cert/assets/wall/current/Grammar.lean create mode 100644 aver-cert/assets/wall/current/GrammarLower.lean create mode 100644 aver-cert/assets/wall/current/GrammarSound.lean diff --git a/aver-cert/assets/wall/current/Grammar.lean b/aver-cert/assets/wall/current/Grammar.lean new file mode 100644 index 000000000..a0296c885 --- /dev/null +++ b/aver-cert/assets/wall/current/Grammar.lean @@ -0,0 +1,329 @@ +/- Grammar — the one-grammar certificate plan (P2a, not yet wired). + + 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(Int)` (always in the + i64 band; `Literal::BigInt` is declined) and `Literal(Bool)`. + * `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`. + * `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) or two `Bool` + operands (`==` and `!=`). + * `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. + + Values: `SVal` extends the scalar values with nested records + (`record tid fields`), so records with Int, Bool and record fields are all + covered. Variants, Option/Result, String, lists and Float are P2b. -/ +import RecordComputeBridge + +namespace AverCert.Grammar +open CertPrelude AverCert.Schema + +/-! ## Grammar -/ + +/-- Source types. `record tid` is a user record by its type id. -/ +inductive Ty where + | int + | bool + | record (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) +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 +deriving DecidableEq, Repr + +/-- `MirCallee`, admitted part. -/ +inductive MirCallee where + | fn (idx : Nat) + | builtin (b : Builtin) +deriving DecidableEq, Repr + +/-- `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) +deriving Repr + +def BinOp.isArith : BinOp → Bool + | .add | .sub | .mul => true + | _ => false + +def BinOp.isEquality : BinOp → Bool + | .eq | .neq => true + | _ => false + +/-- Module context: the byte-derived indices a lowering needs (Int carrier, + host helpers, struct index per record type id) and the declarations the + typing reads (record field types, callee signatures). -/ +structure MCtx where + carrier : Nat + box : Nat + add : Nat + sub : Nat + mul : Nat + neg : Nat + cmp : Nat + eq : Nat + structOf : Nat → Nat + recFields : Nat → Option (List Ty) + sigs : Nat → Option Sig + +/-- 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 + +/-! ## 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 + | _, _ => none + +mutual + def tyOf (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) : + Expr → Option Ty + | .literal (.int k) => if AverCert.PlanCheck.inI64Band k then some .int else none + | .literal (.bool _) => some .bool + | .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 + | _, _ => 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 + 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 +end + +/-! ## Source values -/ + +inductive SVal where + | i (n : Int) + | b (v : Bool) + | record (tid : Nat) (fields : List SVal) +deriving Repr + +mutual + /-- A source value inhabits a type, over the record declarations `R`. -/ + def HasTy (R : Nat → Option (List Ty)) : SVal → Ty → Prop + | .i _, .int => True + | .b _, .bool => True + | .record tid fs, .record tid' => tid = tid' ∧ ∃ fts, R tid = some fts ∧ HasTyL R fs fts + | _, _ => False + def HasTyL (R : Nat → Option (List Ty)) : List SVal → List Ty → Prop + | [], [] => True + | v :: vs, t :: ts => HasTy R v t ∧ HasTyL R vs ts + | _, _ => False +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 strict and pure. -/ + +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 + +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)) + | _, _ => 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) + | .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 + | .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 + | _, _ => 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 + 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 +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 typing and slot-layout checks one plan must pass: parameters sit + below the slot count, the scratch local at `nslots` is 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 + +end AverCert.Grammar diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean new file mode 100644 index 000000000..57eb6718f --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -0,0 +1,271 @@ +/- 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 (P2a, not yet wired). + + `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. + + 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 +import PlanBytes + +namespace AverCert.Grammar +open CertPrelude AverCert.Schema + +/-! ## Instructions with block types -/ + +inductive BI where + | op (i : WInstr) + | ifElse (bt : Option Ty) (thenB elseB : List BI) + +mutual + def eraseI : BI → WInstr + | .op i => i + | .ifElse _ t e => .ifElse (eraseL t) (eraseL e) + 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 + +def builtinInstr : Builtin → WInstr + | .boolAnd => .i32And + | .boolOr => .i32Or + | .boolNot => .i32Eqz + +/-! ## The lowering -/ + +mutual + def lowerB (M : MCtx) (n : Nat) (Γ : 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))] + | .local i => [.op (.localGet i)] + | .let_ b v body => + lowerB M n Γ false v ++ [.op (.localSet b)] ++ + lowerB M n (match tyOf M n Γ false v with + | some T => upd Γ b T + | none => Γ) tail body + | .call (.fn f) args => lowerArgsB M n Γ args ++ [.op (.call f)] + | .call (.builtin bi) args => lowerArgsB M n Γ args ++ [.op (builtinInstr bi)] + | .tailCall f args => lowerArgsB M n Γ args ++ [.op (.returnCall f)] + | .binOp op l r => + match tyOf M n Γ false l with + | some .bool => + lowerB M n Γ false l ++ lowerB M n Γ false r ++ [.op (boolCmpInstr op)] + | _ => + if op.isArith then + lowerB M n Γ false l ++ lowerB M n Γ 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 n Γ false r ++ [.op (.localSet n)] ++ + cmpArmB M.carrier n op.flip k + | none, some k => + match slot? l with + | some i => cmpArmB M.carrier i op k + | none => + lowerB M n Γ false l ++ [.op (.localSet n)] ++ cmpArmB M.carrier n op k + | none, none => + lowerB M n Γ false l ++ lowerB M n Γ false r ++ (intCmpTail M op).map .op + | .neg e => lowerB M n Γ false e ++ [.op (.call M.neg)] + | .ifThenElse c t e => + lowerB M n Γ false c ++ + [.ifElse (tyOf M n Γ tail t) (lowerB M n Γ tail t) (lowerB M n Γ tail e)] + | .recordCreate tid fs => + lowerArgsB M n Γ fs ++ [.op (.structNew (M.structOf tid) fs.length)] + | .project tid i base => lowerB M n Γ false base ++ [.op (.structGet (M.structOf tid) i)] + def lowerArgsB (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) : List Expr → List BI + | [] => [] + | e :: es => lowerB M n Γ false e ++ lowerArgsB M n Γ es +end + +/-- The instructions the interpreter runs. -/ +def lowerW (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) (e : Expr) : + List WInstr := + eraseL (lowerB M n Γ tail e) + +def lowerArgsW (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (es : List Expr) : List WInstr := + eraseL (lowerArgsB M n Γ 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.nslots (paramsΓ p.sig.params) true p.body } + +/-! ## The byte image -/ + +open AverCert.PlanBytes in +/-- 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] + | .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] + | _ => none + +open AverCert.PlanBytes in +/-- Value-type bytes of a source type: the Int carrier and records are + nullable concrete references, Bool is `i32`. -/ +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] ++ ·) + +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 + 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 + +open AverCert.PlanBytes in +/-- 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.nslots (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 + +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..691b82651 --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -0,0 +1,1210 @@ +/- GrammarSound — the simulation theorem for the one-grammar plan (P2a, not + yet wired). + + ONE statement, `agreement`, by structural induction over `Grammar.Expr`: + 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 with + pointwise represented fields. The locals relation `LRel` constrains only + the slots the source environment defines, and all of them sit below the + resolver slot count `n`; the const-compare scratch local at `n` is + therefore free for the stash template to overwrite. -/ +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 + +/-! ## Representation and relations -/ + +mutual + def SRepr {C : Nat} (S : CarrierSpec C) (so : Nat → Nat) : SVal → WVal → Prop + | .i n, w => RecordComputeBridge.CanonRepr S n w + | .b v, w => w = b32 v + | .record tid fs, w => ∃ ws, w = .structv (so tid) ws ∧ SReprL S so fs ws + def SReprL {C : Nat} (S : CarrierSpec C) (so : Nat → Nat) : + List SVal → List WVal → Prop + | [], [] => True + | v :: vs, w :: ws => SRepr S so v w ∧ SReprL S so vs ws + | _, _ => False +end + +/-- The source environment agrees with the typing environment. -/ +def EnvTy (R : Nat → Option (List Ty)) (env : Nat → Option SVal) (Γ : Nat → Option Ty) : + Prop := + ∀ i, (env i = none ∧ Γ i = none) ∨ + ∃ v T, env i = some v ∧ Γ i = some T ∧ HasTy R v T + +section Rel +variable {C : Nat} (S : CarrierSpec C) (so : Nat → Nat) (n : Nat) + +/-- Locals relation: the scratch slot `n` exists, and every defined source + slot sits below `n` and is represented at its own wasm local. -/ +def LRel (env : Nat → Option SVal) (wl : List WVal) : Prop := + n < wl.length ∧ + ∀ i v, env i = some v → i < n ∧ ∃ w, wl[i]? = some w ∧ SRepr S so 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 so sv w ∧ LRel S so n env wl' + | .ret w => tail = true ∧ SRepr S so sv w + +end Rel + +/-- 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) (so : Nat → Nat) (R : Nat → Option (List Ty)) + (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 R svs sig.params → SReprL S so svs ws → callee f ws = some r → + ∃ sv, model svs = some sv ∧ SRepr S so sv r ∧ HasTy R sv sig.ret + +/-- The certificate face of one function, with a fuel-indexed model. -/ +def FnCertified {C : Nat} (S : CarrierSpec C) (so : Nat → Nat) (R : Nat → Option (List Ty)) + (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 R svs sig.params → SReprL S so svs ws → + wFuncN code host fuel f ws = some r → + ∃ sv, model fuel svs = some sv ∧ SRepr S so sv r ∧ HasTy R sv sig.ret + +theorem FnCertified.contract {C : Nat} {S : CarrierSpec C} {so : Nat → Nat} + {R : Nat → Option (List Ty)} {code : CodeTbl} {host : HostTbl} {f : Nat} {sig : Sig} + {model : Nat → List SVal → Option SVal} + (h : FnCertified S so R code host f sig model) (fuel : Nat) : + Contract S so R 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 {R : Nat → Option (List Ty)} + +theorem hasTy_int {v : SVal} (h : HasTy R v .int) : ∃ n, v = .i n := by + cases v <;> simp_all [HasTy] + +theorem hasTy_bool {v : SVal} (h : HasTy R v .bool) : ∃ b, v = .b b := by + cases v <;> simp_all [HasTy] + +theorem hasTy_record {v : SVal} {tid : Nat} (h : HasTy R v (.record tid)) : + ∃ fs fts, v = .record tid fs ∧ R tid = some fts ∧ HasTyL R fs fts := by + cases v with + | i _ => simp [HasTy] at h + | b _ => simp [HasTy] at h + | record tid' fs => + simp only [HasTy] at h + obtain ⟨rfl, fts, hR, hfs⟩ := h + exact ⟨fs, fts, rfl, hR, hfs⟩ + +theorem hasTyL_length : ∀ {vs : List SVal} {ts : List Ty}, HasTyL R 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 R vs ts → + ∀ {i : Nat} {t : Ty}, ts[i]? = some t → ∃ v, vs[i]? = some v ∧ HasTy R 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 R vs ts → + ∀ {i : Nat} {v : SVal}, vs[i]? = some v → ∃ t, ts[i]? = some t ∧ HasTy R 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} {so : Nat → Nat} + +theorem sreprL_length : ∀ {vs : List SVal} {ws : List WVal}, SReprL S so 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 so vs ws → + ∀ {i : Nat} {v : SVal}, vs[i]? = some v → ∃ w, ws[i]? = some w ∧ SRepr S so 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 so (.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} {so : Nat → Nat} {n : Nat} + +/-- 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 so n env wl) (hj : n ≤ j) : LRel S so n 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 so n env wl) (hb : b < n) (hr : SRepr S so v w) : + LRel S so n (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 so n (upd env b v) wl) : LRel S so n 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 so n tail (upd env b v) st sv out) : Res S so n 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 so sv w) (hl : LRel S so n env wl') : + Res S so n 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 so n false env st sv out) : + ∃ wl' w, out = .ok wl' (w :: st) ∧ SRepr S so sv w ∧ LRel S so n 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 {R : Nat → Option (List Ty)} {env : Nat → Option SVal} + {Γ : Nat → Option Ty} {b : Nat} {v : SVal} {T : Ty} + (h : EnvTy R env Γ) (hv : HasTy R v T) : EnvTy R (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 {R : Nat → Option (List Ty)} {env : Nat → Option SVal} + {Γ : Nat → Option Ty} {i : Nat} {T : Ty} + (h : EnvTy R env Γ) (hT : Γ i = some T) : ∃ v, env i = some v ∧ HasTy R 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 {R : Nat → Option (List Ty)} {env : Nat → Option SVal} + {Γ : Nat → Option Ty} {i : Nat} + (h : EnvTy R 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 : AverCert.PlanCheck.inI64Band k = true) + (hget : locals[slot]? = some w) + (hR : RecordComputeBridge.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 [AverCert.PlanCheck.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 : RecordComputeBridge.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 : RecordComputeBridge.CanonRepr S a wa) (hb : RecordComputeBridge.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 (so : Nat → Nat) (R : Nat → Option (List Ty)) + (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 : RecordComputeBridge.CanonRepr S a wa) (hb : RecordComputeBridge.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 so (intBin op a b) w ∧ + HasTy R (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 {R : Nat → Option (List Ty)} {svs : List SVal} {t : Ty} + {ts : List Ty} (h : HasTyL R svs (t :: ts)) : + ∃ v vs, svs = v :: vs ∧ HasTy R v t ∧ HasTyL R 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 {R : Nat → Option (List Ty)} {svs : List SVal} + (h : HasTyL R svs []) : svs = [] := by + cases svs with + | nil => rfl + | cons _ _ => simp [HasTyL] at h + +theorem sreprL_cons_inv {C : Nat} {S : CarrierSpec C} {so : Nat → Nat} {v : SVal} + {vs : List SVal} {ws : List WVal} (h : SReprL S so (v :: vs) ws) : + ∃ w ws', ws = w :: ws' ∧ SRepr S so v w ∧ SReprL S so 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} {so : Nat → Nat} {ws : List WVal} + (h : SReprL S so [] ws) : ws = [] := by + cases ws with + | nil => rfl + | cons _ _ => simp [SReprL] at h + +theorem builtin_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) + {C : Nat} {S : CarrierSpec C} {so : Nat → Nat} {R : Nat → Option (List Ty)} + (bi : Builtin) (ts : List Ty) (T : Ty) (hty : builtinTy bi ts = some T) + (svs : List SVal) (ws : List WVal) (hT : HasTyL R svs ts) (hr : SReprL S so svs ws) + (wl st : List WVal) (out : Out) + (hrun : wRunF host ar callee [builtinInstr bi] wl (ws.reverse ++ st) = some out) : + ∃ v, builtinEval bi svs = some (.b v) ∧ T = .bool ∧ out = .ok wl (b32 v :: 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' + refine ⟨x && y, rfl, rfl, ?_⟩ + cases x <;> cases y <;> simp [builtinInstr, wRunF, b32] 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' + refine ⟨x || y, rfl, rfl, ?_⟩ + cases x <;> cases y <;> simp [builtinInstr, wRunF, b32] 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' + refine ⟨!x, rfl, rfl, ?_⟩ + cases x <;> simp [builtinInstr, wRunF, b32] at hrun ⊢ <;> exact hrun.symm + · simp at hty + +/-! ## 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) : + AverCert.PlanCheck.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) := 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 + split at h + · simp_all + · 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 ∧ 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, 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 ∧ 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, _⟩ := hc + exact ⟨hb, fts, hR, 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] + +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 + +/-! ## The agreement theorem + +ONE statement, by structural induction on the grammar (mutual over the nested +argument lists). 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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → + RecordComputeBridge.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)) + (F : Nat → List SVal → Option SVal) + (hCallees : ∀ f sig, M.sigs f = some sig → + Contract S M.structOf M.recFields host ar callee f sig (F f)) + (n : Nat) +include Ctr hNegC hCarrier hBox hAdd hSub hMul hNeg hCmp hEq hCallees + +mutual +theorem agreement : + ∀ (e : Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) + (wl st : List WVal) (out : Out), + tyOf M n Γ tail e = some T → + EnvTy M.recFields env Γ → + LRel S M.structOf n env wl → + wRunF host ar callee (lowerW M n Γ tail e) wl st = some out → + ∃ sv, eval F env e = some sv ∧ HasTy M.recFields sv T ∧ + Res S M.structOf n tail env st sv out + | .literal (.int k), Γ, 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 [AverCert.PlanCheck.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), Γ, 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⟩ + | .local i, Γ, 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, Γ, 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.recFields (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, Γ, 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, Γ, 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] 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, eraseL, eraseI] at hseq + obtain ⟨v, hbe, rfl, rfl⟩ := + builtin_step host ar callee bi ts T hbt svs ws hTs hrep wl1 st out hseq + exact ⟨.b v, by simp [eval, hevs, hbe], by simp [HasTy], res_ok (by simp [SRepr]) hl1⟩ + | .tailCall f args, Γ, 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + rcases tyOf_binOp_inv hty with ⟨htl, htr, hT⟩ | ⟨htl, htr, hop, rfl⟩ + · -- 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 n w1)[n]? = some w1 := List.getElem?_set_self hl1.1 + have hout := cmpArm_step S host ar callee op.flip (flip_isArith hA) kk n + (wl1.set n 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 (Nat.le_refl n))⟩ + · 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 n w1)[n]? = some w1 := List.getElem?_set_self hl1.1 + have hout := cmpArm_step S host ar callee op hA kk n (wl1.set n 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 (Nat.le_refl n))⟩ + · 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 + M.structOf M.recFields 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⟩ + | .neg e, Γ, 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' : RecordComputeBridge.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, Γ, 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨fts, hR, hts, 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⟩ + · simp only [SRepr] + exact ⟨ws, rfl, hrep⟩ + | .project tid i base, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨htb, fts, hR, 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 + simp only [SRepr] at hw1 + obtain ⟨ws, rfl, hws⟩ := 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⟩ + +theorem agreementArgs : + ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) + (wl st : List WVal) (out : Out), + tysOf M n Γ es = some Ts → + EnvTy M.recFields env Γ → + LRel S M.structOf n env wl → + wRunF host ar callee (lowerArgsW M n Γ es) wl st = some out → + ∃ svs ws wl', out = .ok wl' (ws.reverse ++ st) ∧ + evalArgs F env es = some svs ∧ HasTyL M.recFields svs Ts ∧ + SReprL S M.structOf svs ws ∧ LRel S M.structOf n env wl' + | [], Γ, 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, Γ, 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⟩ +end + +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 {R : Nat → Option (List Ty)} {svs : List SVal} {ts : List Ty} + (h : HasTyL R svs ts) : EnvTy R (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⟩ + +/-- 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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → + RecordComputeBridge.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)) + (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.structOf M.recFields 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.structOf M.recFields 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.recFields svs p.sig.params → SReprL S M.structOf svs ws → + wFuncN code host fuel f ws = some r → + ∃ sv, groupModel outer G fuel f svs = some sv ∧ SRepr S M.structOf sv r ∧ + HasTy M.recFields 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 + have hCallees : ∀ g sig, M.sigs g = some sig → + Contract S M.structOf M.recFields 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.structOf p.nslots (argsEnv svs) (initLocals (fnCode M p) ws) := by + refine ⟨by simp [initLocals, fnCode]; omega, ?_⟩ + intro i sv hs + 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 (groupModel outer G k) hCallees + p.nslots 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/lakefile.lean b/aver-cert/assets/wall/current/lakefile.lean index c84fac2f7..3a169b482 100644 --- a/aver-cert/assets/wall/current/lakefile.lean +++ b/aver-cert/assets/wall/current/lakefile.lean @@ -21,4 +21,5 @@ lean_lib «CertPrelude» where `CompositionSoundness, `AcceptanceSoundnessCore, `DischargeExprFragment, `DischargeFieldProjection, `DischargeConstruct, `DischargeVerbatim, `DischargeString, `DischargeIntDispatch, `DischargeRecursion, - `DischargeComposition, `AcceptanceSoundness, `ArithTemplateDerisk] + `DischargeComposition, `AcceptanceSoundness, `ArithTemplateDerisk, + `Grammar, `GrammarLower, `GrammarSound] From 8e78c9e6bd9168e50c324334b522ca642dce52dc Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 00:15:14 +0200 Subject: [PATCH 04/89] cert wall: rotate the wall id for the interpreter additions Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- .../cert_certify_spec__add_one_certificate_package.snap | 2 +- ...cert_certify_spec__wasip2_component_certificate_package.snap | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index bef549ee3..8ddca5413 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -181,7 +181,7 @@ pub const RECORD_COMPUTE_DOMAIN_LINE: &str = /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:a3c0e76722eee7a09f0fb85eab10d94657be52ffe059e541645c0a9c80167dd5"; + "sha256:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 282fa5eaf..7b973a45a 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -32,7 +32,7 @@ Schema version 7 differs from version 6 in one point: the manifest gained the re 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. +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:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25` (`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. diff --git a/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap b/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap index ef77fb428..a6cfc1eeb 100644 --- a/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap +++ b/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap @@ -5,7 +5,7 @@ expression: golden == cert-manifest.json == { "schema_version": 8, - "format": {"version": 1, "wall_id": "sha256:a3c0e76722eee7a09f0fb85eab10d94657be52ffe059e541645c0a9c80167dd5"}, + "format": {"version": 1, "wall_id": "sha256:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25"}, "wasm": "add_one.wasm", "wasm_sha256": "4b86ac5e745a7f0aeef0d24178a3f47ed09b4f98ffc36216aedf252c9cb20583", "target": "wasm-gc", diff --git a/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap b/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap index 0bed661b9..fe156d6b3 100644 --- a/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap +++ b/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap @@ -5,7 +5,7 @@ expression: golden == cert-manifest.json == { "schema_version": 8, - "format": {"version": 1, "wall_id": "sha256:a3c0e76722eee7a09f0fb85eab10d94657be52ffe059e541645c0a9c80167dd5"}, + "format": {"version": 1, "wall_id": "sha256:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25"}, "wasm": "wasip2_carrierless.component.wasm", "wasm_sha256": "0e7064150f82e180dff6f774a8f48711acd2ea21d183ee06576d4f7c9f135aed", "target": "wasip2", From 39c23b38f150385e855fb6cd6321297f0d6cee87 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 00:59:42 +0200 Subject: [PATCH 05/89] cert wall: add Match and Construct to the one-grammar plan The plan grammar mirrors MirExpr::Match and MirExpr::Construct: Int literal cascades with a catch-all last, the two-arm Bool match the if-rewrite keeps, the Option and Result tag dispatch with payload binders, and the user-variant ref.test cascade whose last arm is untested. Option.withDefault and Result.withDefault are admitted as lazy builtins, evaluated as the emitter lowers them. Source values gain variants and instantiation-carrying Option and Result values. The lowering ports the emitter for these nodes, including the subject scratch, the dead binder extraction and the default fillers; scratch positions are a function of the declared locals. The typing admits exactly the arm shapes whose emitted code has first-match meaning, and requires a variant cascade to cover every constructor and a sum to keep its constructor structs distinct. The agreement theorem and the group theorem extend to the new nodes with the same axioms. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/assets/wall/current/Grammar.lean | 434 ++++- .../assets/wall/current/GrammarLower.lean | 249 ++- .../assets/wall/current/GrammarSound.lean | 1473 +++++++++++++++-- 3 files changed, 1978 insertions(+), 178 deletions(-) diff --git a/aver-cert/assets/wall/current/Grammar.lean b/aver-cert/assets/wall/current/Grammar.lean index a0296c885..61f565411 100644 --- a/aver-cert/assets/wall/current/Grammar.lean +++ b/aver-cert/assets/wall/current/Grammar.lean @@ -1,4 +1,4 @@ -/- Grammar — the one-grammar certificate plan (P2a, not yet wired). +/- Grammar — the one-grammar certificate plan (P2a/P2b, not yet wired). 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 @@ -32,10 +32,28 @@ 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. - - Values: `SVal` extends the scalar values with nested records - (`record tid fields`), so records with Int, Bool and record fields are all - covered. Variants, Option/Result, String, lists and Float are P2b. -/ + * `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). + * `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`, `bind slot`, + `ctor c 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, and a user + variant `ref.test` cascade of two or more arms that covers every + constructor. + + Values: `SVal` has nested records (`record tid fields`), user variants + (`variant tid ctor fields`) and Option / Result values that carry their + instantiation, so records and sums with Int, Bool, record, variant, + Option and Result fields are all covered. String, lists, tuples and Float + are P2c. -/ import RecordComputeBridge namespace AverCert.Grammar @@ -43,11 +61,17 @@ open CertPrelude AverCert.Schema /-! ## Grammar -/ -/-- Source types. `record tid` is a user record by its type id. -/ +/-- 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 deriving DecidableEq, Repr structure Sig where @@ -71,25 +95,58 @@ inductive Builtin where | boolAnd | boolOr | boolNot 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) deriving DecidableEq, Repr -/-- `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) -deriving 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) +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) + /-- 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 @@ -100,8 +157,10 @@ def BinOp.isEquality : BinOp → Bool | _ => false /-- Module context: the byte-derived indices a lowering needs (Int carrier, - host helpers, struct index per record type id) and the declarations the - typing reads (record field types, callee signatures). -/ + 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 @@ -114,6 +173,12 @@ structure MCtx where 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 /-- One function's plan: signature, the resolver slot count (parameters and every binder; the const-compare scratch local sits at this index), the @@ -129,6 +194,97 @@ structure FnPlan where 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 type with a default filler value (the emitter's `emit_default_value`). -/ +def Ty.hasDefault : Ty → Bool + | .eqref => false + | _ => true + +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 + +/-- 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 @@ -142,6 +298,24 @@ def builtinTy : Builtin → List Ty → Option Ty | .boolNot, [.bool] => some .bool | _, _ => 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 @@ -190,39 +364,160 @@ mutual | 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 tyOf M n Γ false o, tyOf M n Γ false d with + | some to, some td => lazyTy lb to td + | _, _ => none + | _ => none + | .construct c ty args => + match tysOf M n Γ args with + | some ts => ctorTy M c ty ts + | none => 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 + | _ => 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 + /-- 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 AverCert.PlanCheck.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 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) deriving Repr mutual - /-- A source value inhabits a type, over the record declarations `R`. -/ - def HasTy (R : Nat → Option (List Ty)) : SVal → Ty → Prop + /-- 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, R tid = some fts ∧ HasTyL R fs fts + | .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 | _, _ => False - def HasTyL (R : Nat → Option (List Ty)) : List SVal → List Ty → Prop + def HasTyL (M : MCtx) : List SVal → List Ty → Prop | [], [] => True - | v :: vs, t :: ts => HasTy R v t ∧ HasTyL R vs ts + | v :: vs, t :: ts => HasTy M v t ∧ HasTyL M vs ts | _, _ => False 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 strict and pure. -/ +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) @@ -246,6 +541,37 @@ def builtinEval : Builtin → List SVal → Option SVal | .boolNot, [.b x] => some (.b (!x)) | _, _ => 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]) + | _, _ => 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 @@ -290,6 +616,24 @@ mutual 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 def evalArgs (F : Nat → List SVal → Option SVal) (env : Nat → Option SVal) : List Expr → Option (List SVal) | [] => some [] @@ -297,18 +641,48 @@ mutual 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 local at `nslots` is declared, and the - body has the declared result type in tail position. -/ + 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 (p.lctx.cmp < 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 diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean index 57eb6718f..9988b22e9 100644 --- a/aver-cert/assets/wall/current/GrammarLower.lean +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -1,6 +1,6 @@ /- 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 (P2a, not yet wired). + admitted nodes (P2a/P2b, not yet wired). `lowerB` makes the emitter's choices from the same tree, by the same predicates, and never from a plan flag: @@ -22,7 +22,21 @@ 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. + * `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`). ONE lowering carries both images: `lowerB` yields instructions whose `if` carries its block type. `eraseL` forgets the block types (the audited @@ -40,11 +54,15 @@ open CertPrelude AverCert.Schema 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) mutual def eraseI : BI → WInstr | .op i => i | .ifElse _ t e => .ifElse (eraseL t) (eraseL e) + | .nullOf _ => .refNull def eraseL : List BI → List WInstr | [] => [] | x :: xs => eraseI x :: eraseL xs @@ -129,67 +147,229 @@ def builtinInstr : Builtin → WInstr | .boolOr => .i32Or | .boolNot => .i32Eqz +/-- `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)] + | .eqref => [] + +/-- 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 lowering -/ mutual - def lowerB (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) : Expr → List BI + 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))] | .local i => [.op (.localGet i)] | .let_ b v body => - lowerB M n Γ false v ++ [.op (.localSet b)] ++ - lowerB M n (match tyOf M n Γ false v with + 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 n Γ args ++ [.op (.call f)] - | .call (.builtin bi) args => lowerArgsB M n Γ args ++ [.op (builtinInstr bi)] - | .tailCall f args => lowerArgsB M n Γ args ++ [.op (.returnCall f)] + | .call (.fn f) args => lowerArgsB M X Γ args ++ [.op (.call f)] + | .call (.builtin bi) args => lowerArgsB M X Γ args ++ [.op (builtinInstr bi)] + | .tailCall f args => lowerArgsB M X Γ args ++ [.op (.returnCall f)] | .binOp op l r => - match tyOf M n Γ false l with + match tyOf M X.n Γ false l with | some .bool => - lowerB M n Γ false l ++ lowerB M n Γ false r ++ [.op (boolCmpInstr op)] + lowerB M X Γ false l ++ lowerB M X Γ false r ++ [.op (boolCmpInstr op)] | _ => if op.isArith then - lowerB M n Γ false l ++ lowerB M n Γ false r ++ [.op (.call (M.arithIdx op))] + 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 n Γ false r ++ [.op (.localSet n)] ++ - cmpArmB M.carrier n op.flip k + 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 n Γ false l ++ [.op (.localSet n)] ++ cmpArmB M.carrier n op k + lowerB M X Γ false l ++ [.op (.localSet X.cmp)] ++ + cmpArmB M.carrier X.cmp op k | none, none => - lowerB M n Γ false l ++ lowerB M n Γ false r ++ (intCmpTail M op).map .op - | .neg e => lowerB M n Γ false e ++ [.op (.call M.neg)] + 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 n Γ false c ++ - [.ifElse (tyOf M n Γ tail t) (lowerB M n Γ tail t) (lowerB M n Γ tail 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 n Γ fs ++ [.op (.structNew (M.structOf tid) fs.length)] - | .project tid i base => lowerB M n Γ false base ++ [.op (.structGet (M.structOf tid) i)] - def lowerArgsB (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) : List Expr → List BI + 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 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)] + | _, _ => [] + | _ => [] + | .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 + | _ => [] + def lowerArgsB (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) : List Expr → List BI | [] => [] - | e :: es => lowerB M n Γ false e ++ lowerArgsB M n Γ es + | 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 + | _ => [] end /-- The instructions the interpreter runs. -/ -def lowerW (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) (e : Expr) : +def lowerW (M : MCtx) (X : LCtx) (Γ : Nat → Option Ty) (tail : Bool) (e : Expr) : List WInstr := - eraseL (lowerB M n Γ tail e) + eraseL (lowerB M X Γ tail e) -def lowerArgsW (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (es : List Expr) : List WInstr := - eraseL (lowerArgsB M n Γ es) +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.nslots (paramsΓ p.sig.params) true p.body } + body := lowerW M p.lctx (paramsΓ p.sig.params) true p.body } /-! ## The byte image -/ @@ -224,16 +404,24 @@ def encW : WInstr → Option (List Nat) | .i64GeS => some [0x59] | .i32And => some [0x71] | .i32Or => some [0x72] + | .refTest t => (s33HeapIdx t).map ([0xfb, 0x14] ++ ·) + | .refCast t => (s33HeapIdx t).map ([0xfb, 0x16] ++ ·) | _ => none open AverCert.PlanBytes in -/-- Value-type bytes of a source type: the Int carrier and records are - nullable concrete references, Bool is `i32`. -/ +/-- 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] +open AverCert.PlanBytes in mutual def encBI (M : MCtx) : BI → Option (List Nat) | .op i => encW i @@ -241,6 +429,7 @@ mutual 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] ++ ·) def encBL (M : MCtx) : List BI → Option (List Nat) | [] => some [] | x :: xs => @@ -262,7 +451,7 @@ open AverCert.PlanBytes in /-- 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.nslots (paramsΓ p.sig.params) true p.body) with + 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) diff --git a/aver-cert/assets/wall/current/GrammarSound.lean b/aver-cert/assets/wall/current/GrammarSound.lean index 691b82651..d5e52bef2 100644 --- a/aver-cert/assets/wall/current/GrammarSound.lean +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -1,7 +1,9 @@ -/- GrammarSound — the simulation theorem for the one-grammar plan (P2a, not - yet wired). +/- GrammarSound — the simulation theorem for the one-grammar plan (P2a/P2b, + not yet wired). - ONE statement, `agreement`, by structural induction over `Grammar.Expr`: + ONE statement, `agreement`, by structural induction over `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 @@ -11,11 +13,15 @@ `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 with - pointwise represented fields. The locals relation `LRel` constrains only - the slots the source environment defines, and all of them sit below the - resolver slot count `n`; the const-compare scratch local at `n` is - therefore free for the stash template to overwrite. -/ + existing wall), Bool is `i32` 0/1, a record is the struct of its type 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. 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. A match + reads its stashed subject only before any arm body runs, so a nested match + reusing the same scratch is harmless. -/ import GrammarLower import InterpreterSequencing @@ -30,97 +36,122 @@ open CertPrelude AverCert.Schema InterpreterSequencing /-! ## Representation and relations -/ mutual - def SRepr {C : Nat} (S : CarrierSpec C) (so : Nat → Nat) : SVal → WVal → Prop + /-- Representation, read off the module context's layout: a record is the + struct of its type, 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). -/ + def SRepr {C : Nat} (S : CarrierSpec C) (M : MCtx) : SVal → WVal → Prop | .i n, w => RecordComputeBridge.CanonRepr S n w | .b v, w => w = b32 v - | .record tid fs, w => ∃ ws, w = .structv (so tid) ws ∧ SReprL S so fs ws - def SReprL {C : Nat} (S : CarrierSpec C) (so : Nat → Nat) : + | .record tid fs, w => ∃ 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 + def SReprL {C : Nat} (S : CarrierSpec C) (M : MCtx) : List SVal → List WVal → Prop | [], [] => True - | v :: vs, w :: ws => SRepr S so v w ∧ SReprL S so vs ws + | v :: vs, w :: ws => SRepr S M v w ∧ SReprL S M vs ws | _, _ => False end /-- The source environment agrees with the typing environment. -/ -def EnvTy (R : Nat → Option (List Ty)) (env : Nat → Option SVal) (Γ : Nat → Option Ty) : +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 R v T + ∃ v T, env i = some v ∧ Γ i = some T ∧ HasTy M v T section Rel -variable {C : Nat} (S : CarrierSpec C) (so : Nat → Nat) (n : Nat) +variable {C : Nat} (S : CarrierSpec C) (M : MCtx) (X : LCtx) -/-- Locals relation: the scratch slot `n` exists, and every defined source - slot sits below `n` and is represented at its own wasm local. -/ +/-- Locals relation: both scratch locals exist, 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. -/ def LRel (env : Nat → Option SVal) (wl : List WVal) : Prop := - n < wl.length ∧ - ∀ i v, env i = some v → i < n ∧ ∃ w, wl[i]? = some w ∧ SRepr S so v w + (X.n ≤ X.cmp ∧ X.n ≤ X.subj ∧ X.cmp < wl.length ∧ X.subj < 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 so sv w ∧ LRel S so n env wl' - | .ret w => tail = true ∧ SRepr S so sv w + | .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 /-- 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) (so : Nat → Nat) (R : Nat → Option (List Ty)) +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 R svs sig.params → SReprL S so svs ws → callee f ws = some r → - ∃ sv, model svs = some sv ∧ SRepr S so sv r ∧ HasTy R sv sig.ret + ∀ 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) (so : Nat → Nat) (R : Nat → Option (List Ty)) +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 R svs sig.params → SReprL S so svs ws → + ∀ 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 so sv r ∧ HasTy R sv sig.ret + ∃ sv, model fuel svs = some sv ∧ SRepr S M sv r ∧ HasTy M sv sig.ret -theorem FnCertified.contract {C : Nat} {S : CarrierSpec C} {so : Nat → Nat} - {R : Nat → Option (List Ty)} {code : CodeTbl} {host : HostTbl} {f : Nat} {sig : Sig} +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 so R code host f sig model) (fuel : Nat) : - Contract S so R host (fun g => (code g).map (·.arity)) + (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 {R : Nat → Option (List Ty)} +variable {M : MCtx} -theorem hasTy_int {v : SVal} (h : HasTy R v .int) : ∃ n, v = .i n := by +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 R v .bool) : ∃ b, v = .b b := by +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 R v (.record tid)) : - ∃ fs fts, v = .record tid fs ∧ R tid = some fts ∧ HasTyL R fs fts := by - cases v with - | i _ => simp [HasTy] at h - | b _ => simp [HasTy] at h - | record tid' fs => - simp only [HasTy] at h - obtain ⟨rfl, fts, hR, hfs⟩ := h - exact ⟨fs, fts, rfl, hR, hfs⟩ - -theorem hasTyL_length : ∀ {vs : List SVal} {ts : List Ty}, HasTyL R vs ts → +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 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 R vs ts → - ∀ {i : Nat} {t : Ty}, ts[i]? = some t → ∃ v, vs[i]? = some v ∧ HasTy R v t +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 @@ -134,8 +165,8 @@ theorem hasTyL_get : ∀ {vs : List SVal} {ts : List Ty}, HasTyL R vs ts → | [], _ :: _, h, _, _, _ => by simp [HasTyL] at h | _ :: _, [], h, _, _, _ => by simp [HasTyL] at h -theorem hasTyL_get' : ∀ {vs : List SVal} {ts : List Ty}, HasTyL R vs ts → - ∀ {i : Nat} {v : SVal}, vs[i]? = some v → ∃ t, ts[i]? = some t ∧ HasTy R v t +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 @@ -152,17 +183,17 @@ theorem hasTyL_get' : ∀ {vs : List SVal} {ts : List Ty}, HasTyL R vs ts → end Small section SmallRepr -variable {C : Nat} {S : CarrierSpec C} {so : Nat → Nat} +variable {C : Nat} {S : CarrierSpec C} {M : MCtx} -theorem sreprL_length : ∀ {vs : List SVal} {ws : List WVal}, SReprL S so vs ws → +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 so vs ws → - ∀ {i : Nat} {v : SVal}, vs[i]? = some v → ∃ w, ws[i]? = some w ∧ SRepr S so v w +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 @@ -176,7 +207,7 @@ theorem sreprL_get : ∀ {vs : List SVal} {ws : List WVal}, SReprL S so vs ws | [], _ :: _, h, _, _, _ => by simp [SReprL] at h | _ :: _, [], h, _, _, _ => by simp [SReprL] at h -theorem srepr_b {v : Bool} {w : WVal} (h : SRepr S so (.b v) w) : w = b32 v := by +theorem srepr_b {v : Bool} {w : WVal} (h : SRepr S M (.b v) w) : w = b32 v := by simpa [SRepr] using h end SmallRepr @@ -227,12 +258,12 @@ theorem upd_ne {α : Type} (f : Nat → Option α) {i j : Nat} (a : α) (h : j /-! ## Locals-relation maintenance -/ section LRelLemmas -variable {C : Nat} {S : CarrierSpec C} {so : Nat → Nat} {n : Nat} +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 so n env wl) (hj : n ≤ j) : LRel S so n env (wl.set j w) := by + (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 @@ -242,8 +273,8 @@ theorem lrel_set_free {env : Nat → Option SVal} {wl : List WVal} {j : Nat} (w /-- 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 so n env wl) (hb : b < n) (hr : SRepr S so v w) : - LRel S so n (upd env b v) (wl.set b w) := by + (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 @@ -261,7 +292,7 @@ theorem lrel_bind {env : Nat → Option SVal} {wl : List WVal} {b : Nat} {v : SV /-- 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 so n (upd env b v) wl) : LRel S so n env wl := by + (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 @@ -270,7 +301,7 @@ theorem lrel_of_upd {env : Nat → Option SVal} {wl : List WVal} {b : Nat} {v : 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 so n tail (upd env b v) st sv out) : Res S so n tail env st sv out := by + (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 @@ -278,14 +309,14 @@ theorem res_of_upd {tail : Bool} {env : Nat → Option SVal} {st : List WVal} {s | ret w => exact h theorem res_ok {tail : Bool} {env : Nat → Option SVal} {st wl' : List WVal} {sv : SVal} - {w : WVal} (h : SRepr S so sv w) (hl : LRel S so n env wl') : - Res S so n tail env st sv (.ok wl' (w :: st)) := + {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 so n false env st sv out) : - ∃ wl' w, out = .ok wl' (w :: st) ∧ SRepr S so sv w ∧ LRel S so n env wl' := by + (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 @@ -294,9 +325,9 @@ theorem res_false {env : Nat → Option SVal} {st : List WVal} {sv : SVal} {out end LRelLemmas -theorem envTy_upd {R : Nat → Option (List Ty)} {env : Nat → Option SVal} +theorem envTy_upd {M : MCtx} {env : Nat → Option SVal} {Γ : Nat → Option Ty} {b : Nat} {v : SVal} {T : Ty} - (h : EnvTy R env Γ) (hv : HasTy R v T) : EnvTy R (upd env b v) (upd Γ b T) := by + (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 @@ -304,16 +335,16 @@ theorem envTy_upd {R : Nat → Option (List Ty)} {env : Nat → Option SVal} · rw [upd_ne _ _ hib, upd_ne _ _ hib] exact h i -theorem envTy_get {R : Nat → Option (List Ty)} {env : Nat → Option SVal} +theorem envTy_get {M : MCtx} {env : Nat → Option SVal} {Γ : Nat → Option Ty} {i : Nat} {T : Ty} - (h : EnvTy R env Γ) (hT : Γ i = some T) : ∃ v, env i = some v ∧ HasTy R v T := by + (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 {R : Nat → Option (List Ty)} {env : Nat → Option SVal} +theorem envTy_free {M : MCtx} {env : Nat → Option SVal} {Γ : Nat → Option Ty} {i : Nat} - (h : EnvTy R env Γ) (hT : Γ i = none) : env i = none := by + (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 @@ -443,15 +474,15 @@ theorem intCmpTail_step · simp [cmpDen, b32, h1, h2] <;> omega /-- Int arithmetic through the named helper contracts. -/ -theorem arith_step (so : Nat → Nat) (R : Nat → Option (List Ty)) +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 : RecordComputeBridge.CanonRepr S a wa) (hb : RecordComputeBridge.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 so (intBin op a b) w ∧ - HasTy R (intBin op a b) .int := by + ∃ 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 @@ -486,36 +517,36 @@ theorem boolCmp_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee cases x <;> cases y <;> simp [boolCmpInstr, wRunF, b32] at hrun ⊢ <;> exact hrun.symm -theorem hasTyL_cons_inv {R : Nat → Option (List Ty)} {svs : List SVal} {t : Ty} - {ts : List Ty} (h : HasTyL R svs (t :: ts)) : - ∃ v vs, svs = v :: vs ∧ HasTy R v t ∧ HasTyL R vs ts := by +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 {R : Nat → Option (List Ty)} {svs : List SVal} - (h : HasTyL R svs []) : svs = [] := by +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} {so : Nat → Nat} {v : SVal} - {vs : List SVal} {ws : List WVal} (h : SReprL S so (v :: vs) ws) : - ∃ w ws', ws = w :: ws' ∧ SRepr S so v w ∧ SReprL S so vs ws' := by +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} {so : Nat → Nat} {ws : List WVal} - (h : SReprL S so [] ws) : ws = [] := by +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 builtin_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) - {C : Nat} {S : CarrierSpec C} {so : Nat → Nat} {R : Nat → Option (List Ty)} + {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 R svs ts) (hr : SReprL S so svs ws) + (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 [builtinInstr bi] wl (ws.reverse ++ st) = some out) : ∃ v, builtinEval bi svs = some (.b v) ∧ T = .bool ∧ out = .ok wl (b32 v :: st) := by @@ -564,6 +595,166 @@ theorem builtin_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee cases x <;> simp [builtinInstr, wRunF, b32] at hrun ⊢ <;> exact hrun.symm · simp at hty +/-! ## 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 @@ -702,6 +893,55 @@ theorem tysOf_length : ∀ {es : List Expr} {ts : List Ty}, tysOf M n Γ es = so 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) : + ∃ to td, tyOf M n Γ false o = some to ∧ tyOf M n Γ false d = some td ∧ + lazyTy lb to td = some T := by + simp only [tyOf] at h + split at h + · rename_i to td ho hd + exact ⟨to, td, ho, hd, h⟩ + · 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)) := 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 ⟨tid, rfl, h1, h2, h3, h⟩)))⟩ + · cases h + · cases h + end TypingInv theorem litInt?_some {e : Expr} {k : Int} (h : litInt? e = some k) : e = .literal (.int k) := by @@ -712,6 +952,124 @@ theorem slot?_some {e : Expr} {i : Nat} (h : slot? e = some i) : e = .local i := 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] + /-! ## The agreement theorem ONE statement, by structural induction on the grammar (mutual over the nested @@ -733,20 +1091,20 @@ variable {C : Nat} (S : CarrierSpec C) (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) (F : Nat → List SVal → Option SVal) (hCallees : ∀ f sig, M.sigs f = some sig → - Contract S M.structOf M.recFields host ar callee f sig (F f)) - (n : Nat) + Contract S M host ar callee f sig (F f)) + (X : LCtx) include Ctr hNegC hCarrier hBox hAdd hSub hMul hNeg hCmp hEq hCallees mutual theorem agreement : ∀ (e : Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (tail : Bool) (T : Ty) (wl st : List WVal) (out : Out), - tyOf M n Γ tail e = some T → - EnvTy M.recFields env Γ → - LRel S M.structOf n env wl → - wRunF host ar callee (lowerW M n Γ tail e) wl st = some out → - ∃ sv, eval F env e = some sv ∧ HasTy M.recFields sv T ∧ - Res S M.structOf n tail env st sv 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), Γ, 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 @@ -779,7 +1137,7 @@ theorem agreement : 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.recFields (upd env b sv1) (upd Γ b Tv) := envTy_upd henv hT1 + 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' @@ -868,12 +1226,12 @@ theorem agreement : obtain ⟨m, rfl⟩ := hasTy_int hT1 simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append, wRunF] at hseq - have hget : (wl1.set n w1)[n]? = some w1 := List.getElem?_set_self hl1.1 - have hout := cmpArm_step S host ar callee op.flip (flip_isArith hA) kk n - (wl1.set n w1) st m w1 out hband hget hw1 hseq + have hget : (wl1.set X.cmp w1)[X.cmp]? = some w1 := List.getElem?_set_self hl1.1.2.2.1 + 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 (Nat.le_refl n))⟩ + res_ok ?_ (lrel_set_free w1 hl1 hl1.1.1)⟩ · simp [eval, hev1, intBin_cmp hA] · simp [SRepr, cmpDen_flip] | none => @@ -908,12 +1266,12 @@ theorem agreement : obtain ⟨m, rfl⟩ := hasTy_int hT1 simp only [seqOut, eraseL, eraseI, List.cons_append, List.nil_append, wRunF] at hseq - have hget : (wl1.set n w1)[n]? = some w1 := List.getElem?_set_self hl1.1 - have hout := cmpArm_step S host ar callee op hA kk n (wl1.set n w1) st m w1 + have hget : (wl1.set X.cmp w1)[X.cmp]? = some w1 := List.getElem?_set_self hl1.1.2.2.1 + 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 (Nat.le_refl n))⟩ + res_ok ?_ (lrel_set_free w1 hl1 hl1.1.1)⟩ · simp [eval, hev1, intBin_cmp hA] · simp [SRepr] | none => @@ -951,7 +1309,7 @@ theorem agreement : 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 - M.structOf M.recFields hAdd hSub hMul op hA x y wa wb hwa hwb wl2 st out hseq2 + 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 @@ -1046,16 +1404,351 @@ theorem agreement : subst hseq exact ⟨sv, by simp [eval, hev1, hsv], hTsv, res_ok hwr hl1⟩ + | .call (.lazy _) [], _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty + | .call (.lazy _) [_], _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty + | .call (.lazy _) (_ :: _ :: _ :: _), _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyOf] at hty + | .call (.lazy lb) [o, d], Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + obtain ⟨to, td, hto, htd, hlz⟩ := tyOf_lazy_inv hty + 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, 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 := + List.getElem?_set_self hl1.1.2.2.2 + 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, 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 := + List.getElem?_set_self hl1.1.2.2.2 + 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 + | .construct c ty args, Γ, 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 + | 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 + | 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 + | 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 + | 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 + | 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, Γ, 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, _, 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) ∧ RecordComputeBridge.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 := List.getElem?_set_self hl1.1.2.2.2 + 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 := List.getElem?_set_self hl1.1.2.2.2 + 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) := List.getElem?_set_self hl1.1.2.2.2 + 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⟩ + theorem agreementArgs : ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) (wl st : List WVal) (out : Out), - tysOf M n Γ es = some Ts → - EnvTy M.recFields env Γ → - LRel S M.structOf n env wl → - wRunF host ar callee (lowerArgsW M n Γ es) wl st = some 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.recFields svs Ts ∧ - SReprL S M.structOf svs ws ∧ LRel S M.structOf n env wl' + evalArgs F env es = some svs ∧ HasTyL M svs Ts ∧ + SReprL S M svs ws ∧ LRel S M X env wl' | [], Γ, env, Ts, wl, st, out, hty, henv, hl, hrun => by simp only [tysOf, Option.some.injEq] at hty subst hty @@ -1073,6 +1766,541 @@ theorem agreementArgs : 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⟩ + +/-- 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) ∧ RecordComputeBridge.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, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyIntArms] at hty + | .cons p b rest, Γ, 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 : AverCert.PlanCheck.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 [AverCert.PlanCheck.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 + +/-- 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 + | .nil, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyBoolArms] at hty + | .cons p _ .nil, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + cases p <;> simp [tyBoolArms] at hty + | .cons p _ (.cons _ _ (.cons _ _ _)), _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + cases p <;> simp [tyBoolArms] at hty + | .cons p t (.cons p2 e .nil), Γ, 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 + +/-- 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 + | .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOptArms] at hty + | .cons _ _ .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyOptArms] at hty + | .cons _ _ (.cons _ _ (.cons _ _ _)), _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, + _ => by simp [tyOptArms] at hty + | .cons p1 b1 (.cons p2 b2 .nil), Γ, 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 + +/-- 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 + | .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyResArms] at hty + | .cons _ _ .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyResArms] at hty + | .cons _ _ (.cons _ _ (.cons _ _ _)), _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, + _, _ => by simp [tyResArms] at hty + | .cons p1 b1 (.cons p2 b2 .nil), Γ, 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 + +/-- 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 + | .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyVarArms] at hty + | .cons p b .nil, Γ, 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 + | .cons p b (.cons p' b' r), Γ, 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 end end Agreement @@ -1091,8 +2319,8 @@ theorem groupModel_member (outer : Nat → Nat → List SVal → Option SVal) eval (groupModel outer G fuel) (argsEnv args) p.body := by simp [groupModel, hG] -theorem envTy_args {R : Nat → Option (List Ty)} {svs : List SVal} {ts : List Ty} - (h : HasTyL R svs ts) : EnvTy R (argsEnv svs) (paramsΓ ts) := by +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 => @@ -1108,6 +2336,12 @@ theorem envTy_args {R : Nat → Option (List Ty)} {svs : List SVal} {ts : List T 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 @@ -1126,18 +2360,18 @@ theorem fn_certified_group {C : Nat} (S : CarrierSpec C) (hCmp : host M.cmp = some (2, cmp)) (hEq : host M.eq = some (2, eq)) (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.structOf M.recFields code host f sig (fun fuel => outer fuel f)) + 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.structOf M.recFields code host f p.sig + 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.recFields svs p.sig.params → SReprL S M.structOf svs ws → + 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.structOf sv r ∧ - HasTy M.recFields sv p.sig.ret := by + ∃ 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 @@ -1146,8 +2380,10 @@ theorem fn_certified_group {C : Nat} (S : CarrierSpec C) 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.structOf M.recFields host (fun g => (code g).map (·.arity)) + 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 @@ -1166,9 +2402,10 @@ theorem fn_certified_group {C : Nat} (S : CarrierSpec C) 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.structOf p.nslots (argsEnv svs) (initLocals (fnCode M p) ws) := by + 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 @@ -1188,7 +2425,7 @@ theorem fn_certified_group {C : Nat} (S : CarrierSpec C) 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 (groupModel outer G k) hCallees - p.nslots p.body (paramsΓ p.sig.params) (argsEnv svs) true p.sig.ret + 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 From c043e3f2bc732cfe0f73cd2da253ac9db4573018 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 00:59:42 +0200 Subject: [PATCH 06/89] cert wall: pin the constructor struct finality the exact ref.test needs The audited interpreter compares type indices in ref.test while wasm GC tests subtyping. The variant cascade is sound only when no represented value has a struct type that is a strict subtype of another constructor's struct. S3Pin states the byte fact that rules this out: every constructor struct of a sum sits in the rec group that opens the type section and is declared sub final under the sum's root. ctor_refTest_exact shows that, under this pin and the two wasm GC subtyping facts it relies on, the exact test is the wasm test on every pair of constructors of one sum. The acceptance must check the pin against the type section bytes. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/GrammarLower.lean | 30 +++++++++ .../assets/wall/current/GrammarSound.lean | 64 ++++++++++++++++++- 2 files changed, 93 insertions(+), 1 deletion(-) diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean index 9988b22e9..76c86ccf8 100644 --- a/aver-cert/assets/wall/current/GrammarLower.lean +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -457,4 +457,34 @@ def codeEntryBytes (M : MCtx) (p : FnPlan) : Option (List Nat) := (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 (P4) must check `S3Pin` against the rec group's entries +by slice equality, together with `sumOk`. -/ + +open AverCert.PlanBytes in +/-- 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 + end AverCert.Grammar diff --git a/aver-cert/assets/wall/current/GrammarSound.lean b/aver-cert/assets/wall/current/GrammarSound.lean index d5e52bef2..66a4b562e 100644 --- a/aver-cert/assets/wall/current/GrammarSound.lean +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -21,7 +21,11 @@ count `X.n`; the scratch locals (subject scratch, const-compare scratch) sit at or above it and are free for the templates to overwrite. A match reads its stashed subject only before any arm body runs, so a nested match - reusing the same scratch is harmless. -/ + reusing the same scratch is harmless. + + 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 @@ -1070,6 +1074,64 @@ theorem run_localSet (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee wRunF host ar callee ys (wl.set j w) st := by simp [wRunF] +/-! ## 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 : AverCert.PlanBytes.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⟩ + /-! ## The agreement theorem ONE statement, by structural induction on the grammar (mutual over the nested From e3c94f8d73a466e8c8bd54a94c1a3d9efb5901d0 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 01:45:27 +0200 Subject: [PATCH 07/89] cert wall: add String, Float, Vector, List and tuple nodes to the one-grammar plan The plan grammar now covers every construct the old families certify: String literals (by data segment), concatenation (binary and interpolation), equality and literal matches; Float literals and comparisons (no arithmetic); the fused Option.withDefault over Vector.get with a literal default; the empty list and List.prepend; the flat tuple destructure; opaque pass-through fields; and one-field records represented as their field's value. The lowering ports the MIR emitter for these nodes, and the agreement theorem and the group theorem extend to them. The new helpers (concatenation, string equality, index conversion) are taken with the contracts the schema already assumes of them. Scratch locals no longer have to exist: every stash is read back at once, so a carrier-free function with no declared locals is certified too. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/assets/wall/current/Grammar.lean | 256 +++- .../assets/wall/current/GrammarLower.lean | 149 ++- .../assets/wall/current/GrammarSound.lean | 1081 ++++++++++++++--- 3 files changed, 1314 insertions(+), 172 deletions(-) diff --git a/aver-cert/assets/wall/current/Grammar.lean b/aver-cert/assets/wall/current/Grammar.lean index 61f565411..df97e6784 100644 --- a/aver-cert/assets/wall/current/Grammar.lean +++ b/aver-cert/assets/wall/current/Grammar.lean @@ -1,4 +1,4 @@ -/- Grammar — the one-grammar certificate plan (P2a/P2b, not yet wired). +/- Grammar — the one-grammar certificate plan (P2a-P2c, not yet wired). 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 @@ -12,19 +12,22 @@ Admitted subset (and how it maps to `MirExpr`): - * `literal (.int k)` / `literal (.bool b)` — `Literal(Int)` (always in the - i64 band; `Literal::BigInt` is declined) and `Literal(Bool)`. + * `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`. + 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) or two `Bool` - operands (`==` and `!=`). + `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 @@ -34,26 +37,33 @@ * `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). + is evaluated only on the `None` / `Err` side, as the emitter does), and + the fused `Option.withDefault(Vector.get(v, i), )` over two + bare locals (the emitter's bounds-checked `array.get`). + * `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`, `bind slot`, - `ctor c 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, and a user - variant `ref.test` cascade of two or more arms that covers every - constructor. - - Values: `SVal` has nested records (`record tid fields`), user variants - (`variant tid ctor fields`) and Option / Result values that carry their - instantiation, so records and sums with Int, Bool, record, variant, - Option and Result fields are all covered. String, lists, tuples and Float - are P2c. -/ + 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 RecordComputeBridge namespace AverCert.Grammar @@ -72,6 +82,15 @@ inductive Ty where | 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 @@ -83,6 +102,10 @@ deriving DecidableEq, Repr 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`. -/ @@ -93,6 +116,11 @@ 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 deriving DecidableEq, Repr /-- Builtins whose second argument the emitter evaluates only on one side @@ -125,6 +153,10 @@ inductive Pat where | 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 @@ -142,6 +174,12 @@ mutual | 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 @@ -156,6 +194,19 @@ 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 @@ -179,6 +230,21 @@ structure MCtx where 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 @@ -219,10 +285,18 @@ def sumOk (M : MCtx) (tid : Nat) : Bool := 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`). -/ def Ty.hasDefault : Ty → Bool - | .eqref => false - | _ => true + | .int | .bool | .record _ | .sum _ | .option _ | .result _ _ => true + | _ => false def Pat.isWild : Pat → Bool | .wild => true @@ -270,6 +344,21 @@ def resPick : Pat → Pat → Option (Bool × Nat × Nat) | .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 + +/-- 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] @@ -296,6 +385,7 @@ 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. -/ @@ -321,6 +411,8 @@ mutual Expr → Option Ty | .literal (.int k) => if AverCert.PlanCheck.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 @@ -346,6 +438,9 @@ mutual 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 @@ -367,14 +462,28 @@ mutual | .call (.lazy lb) args => match args with | [o, d] => - match tyOf M n Γ false o, tyOf M n Γ false d with - | some to, some td => lazyTy lb to td - | _, _ => none + 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 tyOf M n Γ false o, tyOf M n Γ false d with + | some to, some td => lazyTy lb to td + | _, _ => 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 @@ -385,6 +494,8 @@ mutual 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 [] @@ -474,6 +585,36 @@ mutual | 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 -/ @@ -489,6 +630,17 @@ inductive SVal where | 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 @@ -505,11 +657,21 @@ mutual | .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 @@ -535,10 +697,38 @@ def boolBin : BinOp → Bool → Bool → Option SVal | .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 + 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) | _, _ => none /-- The value a constructor node builds. -/ @@ -563,6 +753,8 @@ def patMatch : Pat → SVal → Option (List Nat × List SVal) | .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 @@ -577,6 +769,8 @@ mutual 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 @@ -598,6 +792,8 @@ mutual 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 @@ -634,6 +830,14 @@ mutual 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 [] @@ -682,7 +886,7 @@ def FnPlan.lctx (p : FnPlan) : LCtx := the declared result type in tail position. -/ def planTyped (M : MCtx) (p : FnPlan) : Bool := decide (p.sig.params.length ≤ p.nslots) && - decide (p.lctx.cmp < p.sig.params.length + p.locals.length) && + 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 diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean index 76c86ccf8..f0744c906 100644 --- a/aver-cert/assets/wall/current/GrammarLower.lean +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -1,6 +1,6 @@ /- 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 (P2a/P2b, not yet wired). + admitted nodes (P2a-P2c, not yet wired). `lowerB` makes the emitter's choices from the same tree, by the same predicates, and never from a plan flag: @@ -36,7 +36,20 @@ `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`). + 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`. ONE lowering carries both images: `lowerB` yields instructions whose `if` carries its block type. `eraseL` forgets the block types (the audited @@ -57,12 +70,21 @@ inductive BI where /-- `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 @@ -142,10 +164,52 @@ def boolCmpInstr : BinOp → WInstr | .eq => .i32Eq | _ => .i32Ne -def builtinInstr : Builtin → WInstr - | .boolAnd => .i32And - | .boolOr => .i32Or - | .boolNot => .i32Eqz +/-- 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 @@ -155,7 +219,7 @@ def dfltB (M : MCtx) : Ty → List BI | .sum tid => [.nullOf (M.sumRoot tid)] | .option t => [.nullOf (M.optStruct t)] | .result t e => [.nullOf (M.resStruct t e)] - | .eqref => [] + | _ => [] /-- Read field `i` of the struct `idx` held (as `eqref`) in the subject scratch `ss` into binder `b`; nothing for an ignored binder. -/ @@ -178,6 +242,8 @@ 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)] ++ @@ -185,12 +251,17 @@ mutual | 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 ++ [.op (builtinInstr bi)] + | .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))] @@ -220,6 +291,12 @@ mutual | .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 lb, tyOf M X.n Γ false o with | .optWithDefault, some (.option t) => lowerB M X Γ false o ++ [.op (.localSet X.subj)] ++ @@ -270,7 +347,15 @@ mutual | 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 @@ -356,6 +441,27 @@ mutual (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. -/ @@ -373,6 +479,10 @@ def fnCode (M : MCtx) (p : FnPlan) : WCode := /-! ## 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 + open AverCert.PlanBytes in /-- Opcode bytes of one instruction of the admitted fragment (`none` for any other instruction, so an unexpected instruction fails closed). -/ @@ -404,6 +514,19 @@ def encW : WInstr → Option (List Nat) | .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 @@ -420,6 +543,11 @@ def valTy (M : MCtx) : Ty → Option (List Nat) | .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] ++ ·) open AverCert.PlanBytes in mutual @@ -430,6 +558,11 @@ mutual | 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 => diff --git a/aver-cert/assets/wall/current/GrammarSound.lean b/aver-cert/assets/wall/current/GrammarSound.lean index 66a4b562e..213957bcf 100644 --- a/aver-cert/assets/wall/current/GrammarSound.lean +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -1,4 +1,4 @@ -/- GrammarSound — the simulation theorem for the one-grammar plan (P2a/P2b, +/- GrammarSound — the simulation theorem for the one-grammar plan (P2a-P2c, not yet wired). ONE statement, `agreement`, by structural induction over `Grammar.Expr` @@ -13,15 +13,23 @@ `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 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. 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. A match - reads its stashed subject only before any arm body runs, so a nested match - reusing the same scratch is harmless. + 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 @@ -39,20 +47,38 @@ open CertPrelude AverCert.Schema InterpreterSequencing /-! ## Representation and relations -/ +/-- 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 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). -/ + 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 => RecordComputeBridge.CanonRepr S n w | .b v, w => w = b32 v - | .record tid fs, w => ∃ ws, w = .structv (M.structOf tid) ws ∧ SReprL S M fs ws + | .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 @@ -69,12 +95,14 @@ def EnvTy (M : MCtx) (env : Nat → Option SVal) (Γ : Nat → Option Ty) : section Rel variable {C : Nat} (S : CarrierSpec C) (M : MCtx) (X : LCtx) -/-- Locals relation: both scratch locals exist, and every defined source +/-- 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. -/ + 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.cmp < wl.length ∧ X.subj < wl.length) ∧ + (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 @@ -86,6 +114,20 @@ def Res (tail : Bool) (env : Nat → Option SVal) (st : List WVal) (sv : SVal) : 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. -/ +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) + /-- 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) @@ -147,6 +189,31 @@ theorem hasTy_result {v : SVal} {t e : Ty} (h : HasTy M v (.result t e)) : · 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 @@ -547,13 +614,25 @@ theorem sreprL_nil_inv {C : Nat} {S : CarrierSpec C} {M : MCtx} {ws : List WVal} | 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 [builtinInstr bi] wl (ws.reverse ++ st) = some out) : - ∃ v, builtinEval bi svs = some (.b v) ∧ T = .bool ∧ out = .ok wl (b32 v :: st) := by + (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 @@ -569,8 +648,9 @@ theorem builtin_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee have hwa' := srepr_b hwa have hwb' := srepr_b hwb subst hwa' hwb' - refine ⟨x && y, rfl, rfl, ?_⟩ - cases x <;> cases y <;> simp [builtinInstr, wRunF, b32] at hrun ⊢ <;> exact hrun.symm + 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 @@ -584,8 +664,9 @@ theorem builtin_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee have hwa' := srepr_b hwa have hwb' := srepr_b hwb subst hwa' hwb' - refine ⟨x || y, rfl, rfl, ?_⟩ - cases x <;> cases y <;> simp [builtinInstr, wRunF, b32] at hrun ⊢ <;> exact hrun.symm + 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 @@ -595,9 +676,299 @@ theorem builtin_step (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee obtain ⟨x, rfl⟩ := hasTy_bool ha have hwa' := srepr_b hwa subst hwa' - refine ⟨!x, rfl, rfl, ?_⟩ - cases x <;> simp [builtinInstr, wRunF, b32] at hrun ⊢ <;> exact hrun.symm - · simp at hty + 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 + +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 @@ -829,7 +1200,11 @@ theorem tyOf_binOp_inv {op : BinOp} {l r : Expr} {T : Ty} (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) := by + 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 @@ -837,10 +1212,25 @@ theorem tyOf_binOp_inv {op : BinOp} {l r : Expr} {T : Ty} refine ⟨hl, hr, ?_⟩ split at h <;> simp_all · rename_i hl hr - right + 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} @@ -859,28 +1249,29 @@ theorem tyOf_ite_inv {c t e : Expr} {T : Ty} 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 ∧ T = .record tid := by + ∃ 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, h.symm⟩ + 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 ∧ fts[i]? = some T := by + ∃ 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, _⟩ := hc - exact ⟨hb, fts, hR, h⟩ + obtain ⟨rfl, h2⟩ := hc + exact ⟨hb, fts, hR, h2, h⟩ · simp at h · simp at h @@ -899,12 +1290,60 @@ theorem tysOf_length : ∀ {es : List Expr} {ts : List Ty}, tysOf M n Γ es = so theorem tyOf_lazy_inv {lb : LazyBuiltin} {o d : Expr} {T : Ty} (h : tyOf M n Γ tail (.call (.lazy lb) [o, d]) = some T) : - ∃ to td, tyOf M n Γ false o = some to ∧ tyOf M n Γ false d = some td ∧ - lazyTy lb to td = some T := by + (vecGetOr? 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) := by simp only [tyOf] at h split at h - · rename_i to td ho hd - exact ⟨to, td, ho, hd, h⟩ + · rename_i v i hvg + right + 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 + left + refine ⟨hvg, ?_⟩ + split at h + · rename_i to td ho hd + exact ⟨to, td, ho, hd, h⟩ + · simp 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} @@ -924,7 +1363,9 @@ theorem tyOf_match_inv {s : Expr} {arms : Arms} {T : Ty} (∃ 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)) := by + 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 @@ -942,8 +1383,12 @@ theorem tyOf_match_inv {s : Expr} {arms : Arms} {T : Ty} split at h · rename_i hc obtain ⟨h1, h2, h3⟩ := hc - exact ⟨_, hs, Or.inr (Or.inr (Or.inr (Or.inr ⟨tid, rfl, h1, h2, h3, h⟩)))⟩ + 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 @@ -1074,6 +1519,75 @@ theorem run_localSet (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee 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 @@ -1151,11 +1665,12 @@ variable {C : Nat} (S : CarrierSpec C) (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 hCallees +include Ctr hNegC hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R hCallees mutual theorem agreement : @@ -1185,6 +1700,19 @@ theorem agreement : 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), Γ, 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), Γ, 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by simp only [tyOf] at hty obtain ⟨sv, hsv, hT⟩ := envTy_get henv hty @@ -1225,14 +1753,14 @@ theorem agreement : exact ⟨sv, by simp [eval, hevs, hm], hT, res_ok hsv hl1⟩ | .call (.builtin bi) args, Γ, 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] at hrun + 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, eraseL, eraseI] at hseq - obtain ⟨v, hbe, rfl, rfl⟩ := + 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 ⟨.b v, by simp [eval, hevs, hbe], by simp [HasTy], res_ok (by simp [SRepr]) hl1⟩ + exact ⟨sv, by simp [eval, hevs, hbe], hT, res_ok hsw hl1⟩ | .tailCall f args, Γ, 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 @@ -1251,7 +1779,8 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by - rcases tyOf_binOp_inv hty with ⟨htl, htr, hT⟩ | ⟨htl, htr, hop, rfl⟩ + 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 @@ -1288,7 +1817,7 @@ theorem agreement : 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 := List.getElem?_set_self hl1.1.2.2.1 + 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 @@ -1328,7 +1857,7 @@ theorem agreement : 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 := List.getElem?_set_self hl1.1.2.2.1 + 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 @@ -1392,6 +1921,49 @@ theorem agreement : 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, Γ, 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 @@ -1432,7 +2004,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by - obtain ⟨fts, hR, hts, rfl⟩ := tyOf_rec_inv hty + 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⟩ := @@ -1445,10 +2017,9 @@ theorem agreement : refine ⟨.record tid svs, by simp [eval, hevs], ?_, res_ok ?_ hl1⟩ · simp only [HasTy, true_and] exact ⟨fts, hR, hTs⟩ - · simp only [SRepr] - exact ⟨ws, rfl, hrep⟩ + · exact (srepr_record hR h2 _ _).mpr ⟨ws, rfl, hrep⟩ | .project tid i base, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by - obtain ⟨htb, fts, hR, hi⟩ := tyOf_proj_inv hty + 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⟩ := @@ -1458,8 +2029,7 @@ theorem agreement : rw [hR] at hR' cases hR' obtain ⟨sv, hsv, hTsv⟩ := hasTyL_get hfs hi - simp only [SRepr] at hw1 - obtain ⟨ws, rfl, hws⟩ := hw1 + 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 @@ -1471,86 +2041,103 @@ theorem agreement : | .call (.lazy _) (_ :: _ :: _ :: _), _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty | .call (.lazy lb) [o, d], Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by - obtain ⟨to, td, hto, htd, hlz⟩ := tyOf_lazy_inv hty - 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, 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 := - List.getElem?_set_self hl1.1.2.2.2 - 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, 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 := - List.getElem?_set_self hl1.1.2.2.2 - 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 + rcases tyOf_lazy_inv hty with ⟨hvg, to, td, hto, htd, hlz⟩ | + ⟨v, i, t, hvg, hΓv, hΓi, 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, 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, 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] + | .construct c ty args, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by obtain ⟨ts, hts, hct⟩ := tyOf_construct_inv hty cases c with @@ -1562,6 +2149,11 @@ theorem agreement : | 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 @@ -1592,6 +2184,11 @@ theorem agreement : | 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 @@ -1623,6 +2220,11 @@ theorem agreement : | 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 @@ -1654,6 +2256,11 @@ theorem agreement : | 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 @@ -1690,6 +2297,11 @@ theorem agreement : | 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 @@ -1719,7 +2331,7 @@ theorem agreement : | .match_ s arms, Γ, 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, _, 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) @@ -1763,7 +2375,9 @@ theorem agreement : 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 := List.getElem?_set_self hl1.1.2.2.2 + 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 @@ -1776,7 +2390,9 @@ theorem agreement : 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 := List.getElem?_set_self hl1.1.2.2.2 + 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 @@ -1793,13 +2409,74 @@ theorem agreement : 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) := List.getElem?_set_self hl1.1.2.2.2 + 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, Γ, 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, Γ, 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 : ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) @@ -1929,6 +2606,8 @@ theorem agreementIntArms : · cases hty | litBool _ => simp [tyIntArms] at hty | ctor _ _ => simp [tyIntArms] at hty + | litStr _ => simp [tyIntArms] at hty + | tuple _ => simp [tyIntArms] at hty /-- The two-arm Bool match: one `if` on the subject's `i32`. -/ theorem agreementBoolArms : @@ -1990,6 +2669,8 @@ theorem agreementBoolArms : | 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 /-- The two-arm Option match over the subject held in the scratch. -/ theorem agreementOptArms : @@ -2286,6 +2967,8 @@ theorem agreementVarArms : | 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), Γ, 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 @@ -2363,6 +3046,127 @@ theorem agreementVarArms : | 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 + +/-- 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 + | .nil, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyStrArms] at hty + | .cons p b rest, Γ, 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 + +/-- 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 + | .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + simp [tyTupArms] at hty + | .cons p b rest, Γ, 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 end Agreement @@ -2420,6 +3224,7 @@ theorem fn_certified_group {C : Nat} (S : CarrierSpec C) (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)) @@ -2486,7 +3291,7 @@ theorem fn_certified_group {C : Nat} (S : CarrierSpec C) 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 (groupModel outer G k) hCallees + 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 From 220b7c0e53b4ea5c77cc1f7c5644663f5aee708f Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 01:45:28 +0200 Subject: [PATCH 08/89] cert wall: pin string literal bytes to their data segments A string literal lowers to array.new_data over a data segment, while the interpreter carries the literal's bytes. DataPin states the check the acceptance must make against the data section: every literal of a plan names a segment that holds exactly its bytes. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/GrammarLower.lean | 45 +++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean index f0744c906..c6ac7d228 100644 --- a/aver-cert/assets/wall/current/GrammarLower.lean +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -620,4 +620,49 @@ def S3Pin (M : MCtx) (tid ncs : Nat) (entries : List (List Nat)) : Bool := | 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 (P4) must check it +against the decoded data section, as it checks `S3Pin` against the type +section. -/ + +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 From d57d21a0cd09d59721657ca70a645e828a18dfe5 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 02:06:32 +0200 Subject: [PATCH 09/89] cert wall: add totality (L3) for the one-grammar plan GrammarTotal computes the termination check from the plan alone: every member of a group has Int parameters, an `n <= 0` guard over parameter 0, a call-free base arm, and a step arm of Int arithmetic whose member calls all pass `n - 1` first. The group role is `.mul` exactly when a member multiplies, and a literal multiplier keeps a plan at L1. fn_certified_total proves main's L3 promise for a checked group: at fuel `n.natAbs + 1` the run returns and the plan's model at that fuel is defined and represented by the result, under the partial contracts plus box, add and sub totality (and mul for the `.mul` role). Not yet wired into acceptance, so the wall id is unchanged. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/GrammarTotal.lean | 759 ++++++++++++++++++ aver-cert/assets/wall/current/lakefile.lean | 2 +- 2 files changed, 760 insertions(+), 1 deletion(-) create mode 100644 aver-cert/assets/wall/current/GrammarTotal.lean diff --git a/aver-cert/assets/wall/current/GrammarTotal.lean b/aver-cert/assets/wall/current/GrammarTotal.lean new file mode 100644 index 000000000..932666e9b --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarTotal.lean @@ -0,0 +1,759 @@ +/- GrammarTotal — totality (level L3) for the one-grammar plan (P3, not yet + wired). + + 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 (a `*` operand is never a literal); `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. It admits less in one place: main's wall accepted a boxed literal + as the operand of the `mul` combine (`k * f(n-1)`); the grammar keeps + literal multipliers out of L3, so `k * f(n-1)` stays at L1 (on main such a + plan was reached only when the producer's sampled i128 guard passed; + `recdecline`'s `wild` is the pinned instance that must not reach L3). + + 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 && (litInt? l).isNone && (litInt? r).isNone)) && + 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.1.1, h1.1.1.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 : RecordComputeBridge.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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → + RecordComputeBridge.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 [AverCert.PlanCheck.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, RecordComputeBridge.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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → + RecordComputeBridge.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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) + (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → + RecordComputeBridge.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/lakefile.lean b/aver-cert/assets/wall/current/lakefile.lean index 3a169b482..467dbe2d0 100644 --- a/aver-cert/assets/wall/current/lakefile.lean +++ b/aver-cert/assets/wall/current/lakefile.lean @@ -22,4 +22,4 @@ lean_lib «CertPrelude» where `DischargeFieldProjection, `DischargeConstruct, `DischargeVerbatim, `DischargeString, `DischargeIntDispatch, `DischargeRecursion, `DischargeComposition, `AcceptanceSoundness, `ArithTemplateDerisk, - `Grammar, `GrammarLower, `GrammarSound] + `Grammar, `GrammarLower, `GrammarSound, `GrammarTotal] From 47715f0f08993e48bdf9cdb1ae9b928d181af540 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 02:08:30 +0200 Subject: [PATCH 10/89] cert wall: admit literal multipliers in the one-grammar totality check A `*` with a literal operand is as total as any other Int product, and the L3 group theorem covers it without change, so `k * f(n-1)` now reaches L3 at role `.mul` like `n * f(n-1)`. A literal outside the i64 band is still declined, by the typing. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/assets/wall/current/GrammarTotal.lean | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/aver-cert/assets/wall/current/GrammarTotal.lean b/aver-cert/assets/wall/current/GrammarTotal.lean index 932666e9b..0e796264d 100644 --- a/aver-cert/assets/wall/current/GrammarTotal.lean +++ b/aver-cert/assets/wall/current/GrammarTotal.lean @@ -22,7 +22,7 @@ * 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 (a `*` operand is never a literal); `step` may also + `+`, `-`, `*` 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). @@ -30,11 +30,10 @@ 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. It admits less in one place: main's wall accepted a boxed literal - as the operand of the `mul` combine (`k * f(n-1)`); the grammar keeps - literal multipliers out of L3, so `k * f(n-1)` stays at L1 (on main such a - plan was reached only when the producer's sampled i128 guard passed; - `recdecline`'s `wild` is the pinned instance that must not reach L3). + 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 @@ -71,8 +70,7 @@ mutual | .literal (.bool _) => true | .local _ => true | .binOp op l r => - (op == .add || op == .sub || - (op == .mul && mulOk && (litInt? l).isNone && (litInt? r).isNone)) && + (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 @@ -256,7 +254,7 @@ theorem totE_binOp {mem : Nat → Bool} {mulOk calls : Bool} {op : BinOp} {l r : rcases hop with (h1 | h1) | h1 · exact Or.inl h1 · exact Or.inr (Or.inl h1) - · exact Or.inr (Or.inr ⟨h1.1.1.1, h1.1.1.2⟩) + · 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. -/ From 3c4ff02b009b00b59850cf29b6af5a33d049230b Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 02:53:45 +0200 Subject: [PATCH 11/89] cert wall: rebuild the acceptance on the one grammar (statement schema 9) The statement, the acceptance root and the soundness assembly are rewritten over the one plan grammar, and every family file is deleted. - SchemaBase: the registries, identities, subject, policy axes, carrier specification and the Int helper contracts, split out so the grammar can build on them. - SchemaCore: schema 9. The manifest carries the subject, a declared type table, one list of planned functions (the MIR bodies printed 1:1) and the obligations. An obligation is stated over the grammar: the model is the plan's fuel-indexed meaning and the face is the plan's signature read through the byte-pinned layout. L3 is the partial statement plus return at the checked fuel. - TypeTable: the lowering context of a manifest, and the declare-and-confirm pins of the type table against the rec group that opens the type section (field storage of every struct, constructor structs `sub final` under their root with S3Pin and sumOk, carrier and magnitude array, strings, vectors, lists, Option and Result instantiations, newtypes) and of every string literal against its data segment. - AcceptedArtifactCore: the obligations are derived by the wall (`obligationsOf`); every planned function is bound to its code entry by export name or function index, with its declared function type; calls go only to planned functions of the same or an earlier group; role and planned indices are distinct; present helpers have their role's function type. The helper-body pins and the whole-module accounting are kept. - ClaimAxes: contracts from the helper calls of the lowered code, one report class `source-plan-v1` with facets derived from the plans. - AcceptanceSoundness: `fn_claim_discharges` (one fuel induction over all plans, plus the group totality theorem for L3 groups) and `accept_sound`, axioms within [propext, Classical.choice, Quot.sound]; an S-3 corollary for accepted artifacts. - The Int negation role is declined: it has no wall template yet, so a plan with `neg` does not encode. - CertPreludeSanity uses `decide +kernel` instead of `native_decide`; SchemaSanity gains typing negatives and a contract witness. The wall goes from 47 files and 29497 lines to 22 files and 11492 lines. The Rust producer still emits schema-8 packages, which do not verify against this wall until the producer is rewritten. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../wall/current/AcceptanceSoundness.lean | 411 +-- .../wall/current/AcceptanceSoundnessCore.lean | 336 ++- .../assets/wall/current/AcceptedArtifact.lean | 16 +- .../wall/current/AcceptedArtifactCore.lean | 2213 ++--------------- .../wall/current/ArithTemplateDerisk.lean | 6 +- .../assets/wall/current/CertPrelude.lean | 6 +- .../wall/current/CertPreludeSanity.lean | 64 +- aver-cert/assets/wall/current/ClaimAxes.lean | 306 +-- .../wall/current/CompositionSoundness.lean | 167 -- .../current/ConstructVerbatimSoundness.lean | 451 ---- .../DeclaredEnvelopeAcceptTransport.lean | 289 --- .../wall/current/DeclaredIndexEnvelope.lean | 594 ----- .../wall/current/DischargeComposition.lean | 376 --- .../wall/current/DischargeConstruct.lean | 338 --- .../wall/current/DischargeExprFragment.lean | 818 ------ .../current/DischargeFieldProjection.lean | 281 --- .../wall/current/DischargeIntDispatch.lean | 306 --- .../wall/current/DischargeRecursion.lean | 422 ---- .../assets/wall/current/DischargeString.lean | 337 --- .../wall/current/DischargeVerbatim.lean | 154 -- .../assets/wall/current/EnvelopeLowering.lean | 409 --- .../wall/current/ExprFragmentAccepted.lean | 30 - .../wall/current/ExprFragmentSemantics.lean | 179 -- .../wall/current/ExprFragmentSoundness.lean | 554 ----- .../current/FieldProjectionSoundness.lean | 60 - aver-cert/assets/wall/current/Grammar.lean | 57 +- .../assets/wall/current/GrammarLower.lean | 62 +- .../assets/wall/current/GrammarSound.lean | 84 +- .../assets/wall/current/GrammarTotal.lean | 27 +- .../wall/current/IntDispatchSoundness.lean | 526 ---- .../current/MutualRecursionSoundness.lean | 324 --- aver-cert/assets/wall/current/PlanBytes.lean | 815 ------ aver-cert/assets/wall/current/PlanCheck.lean | 1467 ----------- aver-cert/assets/wall/current/PlanLower.lean | 400 --- .../wall/current/RecordComputeBridge.lean | 1767 ------------- .../wall/current/RecursionSoundness.lean | 1060 -------- aver-cert/assets/wall/current/SchemaBase.lean | 406 +++ aver-cert/assets/wall/current/SchemaCore.lean | 1772 ++----------- .../assets/wall/current/SchemaSanity.lean | 65 +- .../assets/wall/current/StandardFace.lean | 2120 ---------------- .../assets/wall/current/StringSoundness.lean | 288 --- aver-cert/assets/wall/current/TypeTable.lean | 286 +++ aver-cert/assets/wall/current/WasmSlice.lean | 662 ----- .../assets/wall/current/WidenedEnvelope.lean | 344 --- aver-cert/assets/wall/current/lakefile.lean | 21 +- 45 files changed, 1831 insertions(+), 19845 deletions(-) delete mode 100644 aver-cert/assets/wall/current/CompositionSoundness.lean delete mode 100644 aver-cert/assets/wall/current/ConstructVerbatimSoundness.lean delete mode 100644 aver-cert/assets/wall/current/DeclaredEnvelopeAcceptTransport.lean delete mode 100644 aver-cert/assets/wall/current/DeclaredIndexEnvelope.lean delete mode 100644 aver-cert/assets/wall/current/DischargeComposition.lean delete mode 100644 aver-cert/assets/wall/current/DischargeConstruct.lean delete mode 100644 aver-cert/assets/wall/current/DischargeExprFragment.lean delete mode 100644 aver-cert/assets/wall/current/DischargeFieldProjection.lean delete mode 100644 aver-cert/assets/wall/current/DischargeIntDispatch.lean delete mode 100644 aver-cert/assets/wall/current/DischargeRecursion.lean delete mode 100644 aver-cert/assets/wall/current/DischargeString.lean delete mode 100644 aver-cert/assets/wall/current/DischargeVerbatim.lean delete mode 100644 aver-cert/assets/wall/current/EnvelopeLowering.lean delete mode 100644 aver-cert/assets/wall/current/ExprFragmentAccepted.lean delete mode 100644 aver-cert/assets/wall/current/ExprFragmentSemantics.lean delete mode 100644 aver-cert/assets/wall/current/ExprFragmentSoundness.lean delete mode 100644 aver-cert/assets/wall/current/FieldProjectionSoundness.lean delete mode 100644 aver-cert/assets/wall/current/IntDispatchSoundness.lean delete mode 100644 aver-cert/assets/wall/current/MutualRecursionSoundness.lean delete mode 100644 aver-cert/assets/wall/current/PlanBytes.lean delete mode 100644 aver-cert/assets/wall/current/PlanCheck.lean delete mode 100644 aver-cert/assets/wall/current/PlanLower.lean delete mode 100644 aver-cert/assets/wall/current/RecordComputeBridge.lean delete mode 100644 aver-cert/assets/wall/current/RecursionSoundness.lean create mode 100644 aver-cert/assets/wall/current/SchemaBase.lean delete mode 100644 aver-cert/assets/wall/current/StandardFace.lean delete mode 100644 aver-cert/assets/wall/current/StringSoundness.lean create mode 100644 aver-cert/assets/wall/current/TypeTable.lean delete mode 100644 aver-cert/assets/wall/current/WidenedEnvelope.lean diff --git a/aver-cert/assets/wall/current/AcceptanceSoundness.lean b/aver-cert/assets/wall/current/AcceptanceSoundness.lean index d5fef45a0..a0f56eaa3 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundness.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundness.lean @@ -1,188 +1,197 @@ /- -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, 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⟩⟩ + 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, 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⟩⟩ + 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 +199,44 @@ 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 + +/-! ### 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 × 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.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 end AcceptanceSoundness diff --git a/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean b/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean index 4e9649d6e..6237681ef 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean @@ -1,208 +1,174 @@ /- 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) ∧ + ∀ 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]), ?_⟩ + 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..ed1463099 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifact.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifact.lean @@ -2,11 +2,13 @@ -- -- 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 @@ -16,11 +18,11 @@ def accepted (artifact : ArtifactData) : Prop := artifactEnvelopeAccepted AverCert.ArtifactComponentBytes.componentBytes AverCert.ArtifactComponentBytes.componentLen artifact = true ∧ subjectMatchesArtifactRoot artifact ∧ - fragmentClaimObligationsInManifest artifact ∧ - claimsMatchManifest artifact ∧ - AverCert.StandardFace.checkedFaces artifact ∧ + obligationsDerived artifact ∧ + plansAccepted artifact = true ∧ + decodedHostRoleTable artifact ∧ + decodedStringHostRoles artifact ∧ AverCert.ClaimAxes.checked artifact = true ∧ - decodedNonExprFacts artifact ∧ - acceptedFragments artifact + 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..1269b527f 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,193 @@ 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 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))] + +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] + +/-- 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) : 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 => + AverCert.WasmSlice.typeSectionMatches (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 AverCert.WasmSlice.FuncBinding := + match codeEntryBytes M e.plan with + | none => none + | some bytes => + if e.exported then + AverCert.WasmSlice.exactFuncBindingForExport n len (stringBytes e.name) bytes + else + (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 CertDecode.ValType) : Bool := + if idx < 4294967296 then + match AverCert.WasmSlice.funcBindingByFuncIndex n len idx with + | some b => + AverCert.WasmSlice.typeSectionMatches + (AverCert.WasmSlice.checkFuncTypeExact params results) n len b.typeIdx + | none => false + else true + +def refN (i : Nat) : 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`). -/ +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] + +/-- 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` @@ -1844,47 +264,10 @@ 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. + `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`, `cmp` and `eq` carry a SECOND pin, to their runtime export names (#736 for `box`), and both pins are kept because they constrain @@ -1897,7 +280,7 @@ 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 @@ -1905,7 +288,7 @@ def arithRoleCheck (n len : Nat) (role : ArithTemplateDerisk.ArithRole) 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 + also calls 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 @@ -1962,48 +345,11 @@ def decodedStringHostRoles (artifact : ArtifactData) : Prop := 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 +def stringListNodup (xs : List String) : Bool := + AverCert.WasmSlice.indexedNodup xs def lowerHexByte (byte : Nat) : Bool := (decide (48 ≤ byte) && decide (byte ≤ 57)) || @@ -2131,88 +477,28 @@ def acceptedWholeModule (artifact : ArtifactData) : Prop := 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 + +/-! ### 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. -/ +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 + +/-- 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) : AverCert.Wasip2Envelope.ByteSeq := AverCert.Wasip2Envelope.ComponentEnvelope.bytes artifact.modBytes artifact.modLen @@ -2255,58 +541,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..cc5490a36 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 diff --git a/aver-cert/assets/wall/current/CertPrelude.lean b/aver-cert/assets/wall/current/CertPrelude.lean index b70aac942..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 diff --git a/aver-cert/assets/wall/current/CertPreludeSanity.lean b/aver-cert/assets/wall/current/CertPreludeSanity.lean index f658488f0..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 diff --git a/aver-cert/assets/wall/current/ClaimAxes.lean b/aver-cert/assets/wall/current/ClaimAxes.lean index ffead7207..4d29cc727 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 @@ -96,114 +53,28 @@ structure ContractUse where 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 + addTotal := total + subTotal := total + mulTotal := totalMul } def boxContract : String := "__rt_aint_from_i64 (box i64 -> carrier)" @@ -244,16 +115,71 @@ def ContractUse.contracts (use : ContractUse) : List String := (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/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 index df97e6784..2fa26dd26 100644 --- a/aver-cert/assets/wall/current/Grammar.lean +++ b/aver-cert/assets/wall/current/Grammar.lean @@ -1,4 +1,4 @@ -/- Grammar — the one-grammar certificate plan (P2a-P2c, not yet wired). +/- 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 @@ -64,13 +64,17 @@ 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 RecordComputeBridge +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. -/ @@ -409,7 +413,7 @@ def ctorTy (M : MCtx) : CtorTag → Ty → List Ty → Option Ty mutual def tyOf (M : MCtx) (n : Nat) (Γ : Nat → Option Ty) (tail : Bool) : Expr → Option Ty - | .literal (.int k) => if AverCert.PlanCheck.inI64Band k then some .int else none + | .literal (.int k) => if inI64Band k then some .int else none | .literal (.bool _) => some .bool | .literal (.float _) => some .float | .literal (.str _) => some .string @@ -510,7 +514,7 @@ mutual | .cons p b rest => match p, rest with | .litInt k, _ => - if AverCert.PlanCheck.inI64Band k then + 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 @@ -904,4 +908,49 @@ def groupModel (outer : Nat → Nat → List SVal → Option SVal) | 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/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean index c6ac7d228..0b0ed5e1a 100644 --- a/aver-cert/assets/wall/current/GrammarLower.lean +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -1,6 +1,6 @@ /- 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 (P2a-P2c, not yet wired). + admitted nodes. `lowerB` makes the emitter's choices from the same tree, by the same predicates, and never from a plan flag: @@ -57,11 +57,54 @@ instructions the simulation theorem runs and the bytes a certificate pins come from the same tree by construction. -/ import Grammar -import PlanBytes 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 @@ -483,7 +526,6 @@ def fnCode (M : MCtx) (p : FnPlan) : WCode := def u64le (bits : UInt64) : List Nat := (List.range 8).map fun i => bits.toNat / 256 ^ i % 256 -open AverCert.PlanBytes in /-- 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) @@ -531,7 +573,6 @@ def encW : WInstr → Option (List Nat) | .refCast t => (s33HeapIdx t).map ([0xfb, 0x16] ++ ·) | _ => none -open AverCert.PlanBytes in /-- 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`. -/ @@ -549,7 +590,6 @@ def valTy (M : MCtx) : Ty → Option (List Nat) | .list t => (s33HeapIdx (M.listStruct t)).map ([0x63] ++ ·) | .opaque tid => (s33HeapIdx (M.opaqueStruct tid)).map ([0x63] ++ ·) -open AverCert.PlanBytes in mutual def encBI (M : MCtx) : BI → Option (List Nat) | .op i => encW i @@ -580,7 +620,6 @@ def localGroups (M : MCtx) : List Ty → Option (List Nat) | some a, some b => some ([0x01] ++ a ++ b) | _, _ => none -open AverCert.PlanBytes in /-- 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, @@ -601,10 +640,10 @@ 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 (P4) must check `S3Pin` against the rec group's entries -by slice equality, together with `sumOk`. -/ +test. The acceptance checks `S3Pin` against the raw entries of the rec group +that opens the type section, together with `sumOk` +(`TypeTable.sumConfirmed`). -/ -open AverCert.PlanBytes in /-- The type-section header of a constructor struct: `0x4f` (`sub final`), one supertype, the sum's root. -/ def ctorEntryHeader (root : Nat) : Option (List Nat) := @@ -628,9 +667,8 @@ 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 (P4) must check it -against the decoded data section, as it checks `S3Pin` against the type -section. -/ +(`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) diff --git a/aver-cert/assets/wall/current/GrammarSound.lean b/aver-cert/assets/wall/current/GrammarSound.lean index 213957bcf..9ebfb878a 100644 --- a/aver-cert/assets/wall/current/GrammarSound.lean +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -1,5 +1,4 @@ -/- GrammarSound — the simulation theorem for the one-grammar plan (P2a-P2c, - not yet wired). +/- GrammarSound — the simulation theorem for the one-grammar plan. ONE statement, `agreement`, by structural induction over `Grammar.Expr` (mutually with the argument lists and with one statement per admitted @@ -45,46 +44,7 @@ set_option linter.unusedSimpArgs false namespace AverCert.Grammar open CertPrelude AverCert.Schema InterpreterSequencing -/-! ## Representation and relations -/ - -/-- 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 => RecordComputeBridge.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 +/-! ## Relations -/ /-- The source environment agrees with the typing environment. -/ def EnvTy (M : MCtx) (env : Nat → Option SVal) (Γ : Nat → Option Ty) : @@ -449,13 +409,13 @@ 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 : AverCert.PlanCheck.inI64Band k = true) + (hband : inI64Band k = true) (hget : locals[slot]? = some w) - (hR : RecordComputeBridge.CanonRepr S n 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 [AverCert.PlanCheck.inI64Band, Bool.and_eq_true, decide_eq_true_eq] using hband + 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 @@ -497,7 +457,7 @@ theorem cmpArm_step {C : Nat} (S : CarrierSpec C) section Templates variable {C : Nat} (S : CarrierSpec C) (box add sub mul cmp eq : List WVal → Option WVal) - (Ctr : RecordComputeBridge.Contracts S box add sub mul cmp eq) + (Ctr : Contracts S box add sub mul cmp eq) (host : HostTbl) (ar : Nat → Option Nat) (callee : Callee) (M : MCtx) include Ctr @@ -506,7 +466,7 @@ include Ctr 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 : RecordComputeBridge.CanonRepr S a wa) (hb : RecordComputeBridge.CanonRepr S b wb) + (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 @@ -549,7 +509,7 @@ 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 : RecordComputeBridge.CanonRepr S a wa) (hb : RecordComputeBridge.CanonRepr S b wb) + (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 ∧ @@ -1137,7 +1097,7 @@ 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) : - AverCert.PlanCheck.inI64Band k = true ∧ T = .int := by + inI64Band k = true ∧ T = .int := by simp only [tyOf] at h split at h <;> simp_all @@ -1621,7 +1581,7 @@ theorem s3Pin_facts {M : MCtx} {tid ncs : Nat} {entries : List (List Nat)} · rename_i e hd he hh refine ⟨⟨e, he, ?_⟩, ?_⟩ · unfold ctorEntryHeader at hh - cases hu : AverCert.PlanBytes.uleb32 (M.sumRoot tid) with + 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 @@ -1656,9 +1616,9 @@ host contracts at their indices, an arbitrary opaque `callee`, and a section Agreement variable {C : Nat} (S : CarrierSpec C) (box add sub mul cmp eq neg : List WVal → Option WVal) - (Ctr : RecordComputeBridge.Contracts S box add sub mul cmp eq) - (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → - RecordComputeBridge.CanonRepr S (-x) r) + (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)) @@ -1685,7 +1645,7 @@ theorem agreement : | .literal (.int k), Γ, 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 [AverCert.PlanCheck.inI64Band, Bool.and_eq_true, decide_eq_true_eq] using hband + 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 => @@ -1977,7 +1937,7 @@ theorem agreement : | some r => simp [wRunF, hNeg, popArgs_one, hr] at hseq subst hseq - have hw1' : RecordComputeBridge.CanonRepr S x w1 := by simpa [SRepr] using hw1 + 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 @@ -2343,7 +2303,7 @@ theorem agreement : 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) ∧ RecordComputeBridge.CanonRepr S x w ∧ + ∃ 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 @@ -2513,7 +2473,7 @@ theorem agreementIntArms : (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) ∧ RecordComputeBridge.CanonRepr S x w ∧ + ∃ 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 → @@ -2525,7 +2485,7 @@ theorem agreementIntArms : cases p with | litInt k => simp only [tyIntArms] at hty - by_cases hband : AverCert.PlanCheck.inI64Band k = true + 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 @@ -2543,7 +2503,7 @@ theorem agreementIntArms : 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 [AverCert.PlanCheck.inI64Band, Bool.and_eq_true, decide_eq_true_eq] + 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 @@ -3215,9 +3175,9 @@ theorem FnPlan.lctx_spec (p : FnPlan) : 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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) - (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → - RecordComputeBridge.CanonRepr S (-x) r) + (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)) diff --git a/aver-cert/assets/wall/current/GrammarTotal.lean b/aver-cert/assets/wall/current/GrammarTotal.lean index 0e796264d..593f3e967 100644 --- a/aver-cert/assets/wall/current/GrammarTotal.lean +++ b/aver-cert/assets/wall/current/GrammarTotal.lean @@ -1,5 +1,4 @@ -/- GrammarTotal — totality (level L3) for the one-grammar plan (P3, not yet - wired). +/- 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 @@ -305,7 +304,7 @@ 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 : RecordComputeBridge.CanonRepr S n 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⟩ @@ -322,9 +321,9 @@ theorem guard_run {C : Nat} (S : CarrierSpec C) section Progress variable {C : Nat} (S : CarrierSpec C) (box add sub mul cmp eq neg : List WVal → Option WVal) - (Ctr : RecordComputeBridge.Contracts S box add sub mul cmp eq) - (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → - RecordComputeBridge.CanonRepr S (-x) r) + (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)) @@ -363,7 +362,7 @@ theorem progress : | .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 [AverCert.PlanCheck.inI64Band, Bool.and_eq_true, decide_eq_true_eq] using hband + 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 @@ -392,7 +391,7 @@ theorem progress : 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, RecordComputeBridge.CanonRepr] at hw1 hw2 + simp only [SRepr, CanonRepr] at hw1 hw2 rw [wRunF_append, wRunF_append] simp only [lowerW] at h1 h2 rw [h1] @@ -559,9 +558,9 @@ theorem paramsΓ_int {ts : List Ty} (h : ∀ t ∈ ts, t = .int) : 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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) - (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → - RecordComputeBridge.CanonRepr S (-x) r) + (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)) @@ -716,9 +715,9 @@ theorem fn_certified_total {C : Nat} (S : CarrierSpec C) 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 : RecordComputeBridge.Contracts S box add sub mul cmp eq) - (hNegC : ∀ x w r, RecordComputeBridge.CanonRepr S x w → neg [w] = some r → - RecordComputeBridge.CanonRepr S (-x) r) + (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)) 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/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/SchemaBase.lean b/aver-cert/assets/wall/current/SchemaBase.lean new file mode 100644 index 000000000..714baf59e --- /dev/null +++ b/aver-cert/assets/wall/current/SchemaBase.lean @@ -0,0 +1,406 @@ +-- 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. 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 + 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 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..72c7fea8a 100644 --- a/aver-cert/assets/wall/current/SchemaCore.lean +++ b/aver-cert/assets/wall/current/SchemaCore.lean @@ -1,1618 +1,194 @@ --- 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 + +/-- 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. 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) + +/-- 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..c18b621d6 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,64 @@ 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 } + +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 + 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/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..5326a812b --- /dev/null +++ b/aver-cert/assets/wall/current/TypeTable.lean @@ -0,0 +1,286 @@ +/- 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)) + 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). -/ +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 + +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 + +end AverCert.TypeTable diff --git a/aver-cert/assets/wall/current/WasmSlice.lean b/aver-cert/assets/wall/current/WasmSlice.lean index 603a3c46a..5e510e72b 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 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 467dbe2d0..97fc6d05b 100644 --- a/aver-cert/assets/wall/current/lakefile.lean +++ b/aver-cert/assets/wall/current/lakefile.lean @@ -7,19 +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, - `Grammar, `GrammarLower, `GrammarSound, `GrammarTotal] + roots := #[`CertPrelude, `CertPreludeSanity, `CertDecode, `SchemaBase, `SchemaCore, + `SchemaSanity, `WasmSlice, `Wasip2Envelope, `ArithTemplateDerisk, + `InterpreterSequencing, `Grammar, `GrammarLower, `GrammarSound, `GrammarTotal, + `TypeTable, `AcceptedArtifactCore, `ClaimAxes, `AcceptanceSoundnessCore, + `AcceptanceSoundness] From 15a2fbd9c905482c1989357a57478996d205bb2c Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 02:53:54 +0200 Subject: [PATCH 12/89] cert: embed the schema-9 wall and rotate the wall id - wall.rs: the embedded source set is the 19 files of the rebuilt wall, and the pristine roots are every module but the two artifact-dependent ones. - The wall id is rotated in format.rs, the format specification and the two package snapshots; the specification states the new source count. - The capability-registry test reads the registries from SchemaBase. - Byte-binding lint: a binder named with a `?` suffix is typed from its match scrutinee; under `xs.all (f a ...)` each element of a producer list counts as passed to `f`; a producer value equal to a wall function of other producer values is derived (rule D), which is how the obligations are now pinned. The source type id of a record is a declared-only name over a byte-confirmed layout. The historical index-helper regression still flags. - Trust inventory: the two wasm GC facts the exact `ref.test` relies on are stated as hypotheses of the S-3 argument, not axioms. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/module_envelope.rs | 12 +- aver-cert/src/format.rs | 2 +- aver-cert/src/wall.rs | 240 ++++-------------- aver-cert/src/wall/byte_binding_lint.rs | 148 +++++++++-- docs/certificate-format.md | 3 +- ...ify_spec__add_one_certificate_package.snap | 2 +- ..._wasip2_component_certificate_package.snap | 2 +- 7 files changed, 183 insertions(+), 226 deletions(-) diff --git a/aver-cert/src/engine/module_envelope.rs b/aver-cert/src/engine/module_envelope.rs index ca8f27c77..0ca9859ec 100644 --- a/aver-cert/src/engine/module_envelope.rs +++ b/aver-cert/src/engine/module_envelope.rs @@ -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" ); } } diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 8ddca5413..8d57b4730 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -181,7 +181,7 @@ pub const RECORD_COMPUTE_DOMAIN_LINE: &str = /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25"; + "sha256:8cf1d73ca42ca289b89064f08e18b985d4cdc255293a8183896d117289c4f0fa"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index 5fd506a61..5dc7b98cb 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -13,70 +13,29 @@ 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_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"); #[derive(Clone, Copy, Debug, Eq, PartialEq)] pub struct Source { @@ -86,26 +45,26 @@ 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; 19] = [ 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: "AcceptedArtifactCore.lean", - contents: CERT_ACCEPTED_ARTIFACT_CORE, + name: "AcceptedArtifact.lean", + contents: CERT_ACCEPTED_ARTIFACT, }, Source { - name: "AcceptanceSoundness.lean", - contents: CERT_ACCEPTANCE_SOUNDNESS, + name: "AcceptedArtifactCore.lean", + contents: CERT_ACCEPTED_ARTIFACT_CORE, }, Source { - name: "AcceptanceSoundnessCore.lean", - contents: CERT_ACCEPTANCE_SOUNDNESS_CORE, + name: "ArithTemplateDerisk.lean", + contents: CERT_ARITH_TEMPLATE_DERISK, }, Source { name: "CertDecode.lean", @@ -120,175 +79,70 @@ 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, - }, - Source { - name: "DeclaredEnvelopeAcceptTransport.lean", - contents: CERT_DECLARED_ENVELOPE_ACCEPT_TRANSPORT, - }, - Source { - name: "DeclaredIndexEnvelope.lean", - contents: CERT_DECLARED_INDEX_ENVELOPE, - }, - Source { - name: "DischargeComposition.lean", - contents: CERT_DISCHARGE_COMPOSITION, - }, - Source { - name: "DischargeConstruct.lean", - contents: CERT_DISCHARGE_CONSTRUCT, + name: "Grammar.lean", + contents: CERT_GRAMMAR, }, Source { - name: "DischargeExprFragment.lean", - contents: CERT_DISCHARGE_EXPR_FRAGMENT, + name: "GrammarLower.lean", + contents: CERT_GRAMMAR_LOWER, }, Source { - name: "DischargeFieldProjection.lean", - contents: CERT_DISCHARGE_FIELD_PROJECTION, + name: "GrammarSound.lean", + contents: CERT_GRAMMAR_SOUND, }, 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, - }, 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, - }, - Source { - name: "StringSoundness.lean", - contents: CERT_STRING_SOUNDNESS, + name: "SchemaCore.lean", + contents: CERT_SCHEMA_CORE, }, 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; 17] = [ "CertPrelude", "CertDecode", "ArithTemplateDerisk", "WasmSlice", "Wasip2Envelope", + "SchemaBase", "SchemaCore", - "PlanCheck", - "PlanLower", - "PlanBytes", - "ExprFragmentAccepted", + "InterpreterSequencing", + "Grammar", + "GrammarLower", + "GrammarSound", + "GrammarTotal", + "TypeTable", "AcceptedArtifactCore", "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", ]; diff --git a/aver-cert/src/wall/byte_binding_lint.rs b/aver-cert/src/wall/byte_binding_lint.rs index cf1b67b76..6755ba06c 100644 --- a/aver-cert/src/wall/byte_binding_lint.rs +++ b/aver-cert/src/wall/byte_binding_lint.rs @@ -46,6 +46,8 @@ //! * **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. +//! 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 +56,13 @@ //! every leaf field of that value is then determined. This is how the lowered //! plan payloads are constrained (`lowerX plan = `). //! +//! * **D — derived by a wall function.** One side of the conjunct is a producer +//! value whole, the other a wall definition applied to other producer values +//! (not to the value itself). The value then has no freedom of its own; its +//! inputs carry the freedom and need their own binding. This is how the +//! schema-9 obligations are pinned (`obligationsDerived`: the manifest's +//! obligations ARE `obligationsOf` of its plans). +//! //! 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 @@ -930,6 +939,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 +1153,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(":=") { @@ -1405,8 +1465,20 @@ 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; }; @@ -1421,8 +1493,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 +1519,33 @@ 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: a producer value WHOLE on one side, and on the other a + // wall definition applied to other producer values. The + // value then has no freedom of its own: it is whatever the + // wall computes from its inputs, and those inputs carry the + // freedom (and their own bindings). This is how the + // obligations are pinned to `obligationsOf` of the plans. + 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(); + let b_head = strip_wrappers(&b); + let head: String = b_head.chars().take_while(|c| is_token_char(*c)).collect(); + let head_is_wall_def = !head.is_empty() + && w.resolve(&head, &d.ns, &d.opens) + .and_then(|r| w.get(&r)) + .is_some_and(|g| g.kind == Kind::Def); + if a_whole && head_is_wall_def && !b.contains(stripped_a.trim()) { + for st in whole_producer_values(&w, &env, &stripped_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, "D/derived-by-wall-function", d, c); + } + } + } if !producer_free(&w, &env, &b) { continue; } @@ -1511,12 +1614,9 @@ 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, @@ -1561,12 +1661,26 @@ 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: "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 +1693,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/docs/certificate-format.md b/docs/certificate-format.md index 7b973a45a..23941375c 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -32,7 +32,7 @@ Schema version 7 differs from version 6 in one point: the manifest gained the re 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:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25` (`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. +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 19 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:8cf1d73ca42ca289b89064f08e18b985d4cdc255293a8183896d117289c4f0fa` (`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. @@ -352,6 +352,7 @@ What a positive verdict does trust — the honest TCB: - **SHA-256 collision resistance**, for both the artifact hash and the wall identity — the two bindings that make a certificate non-transferable. An adversary who can produce SHA-256 collisions can transplant a certificate onto different bytes or a different wall. - **The named runtime contracts** — the L1 theorems are conditional on the host helpers obeying the disclosed laws, and the L3 theorems additionally on the disclosed totality; proving the shipped runtime satisfies them is a per-toolchain-release obligation outside the certificate. - **The plan is the claim — for an export without a credited source-bridge.** For every export certified through the declared compute face (`recordCompute`), the obligation's `model` is the evaluation of the plan the manifest declares (`StandardFace.recordComputeModel Plans.Plan.body`), and the report line prints that plan. Since schema 8 the identification of that plan with the function the user wrote IS a kernel-checked theorem wherever the package declares a source-bridge and the verifier credits it (section 4.1): `AverCert.Bridge. : ∀ x, StandardFace.recordComputeModel Plans.Plan.body (encodeArgs x) = some (encodeResult (. x))`, pinned by `AverCertChecker.bridge_pin_` at a statement the VERIFIER rendered from the manifest's declared structure — not at one the package wrote — and axiom-audited like any other claim. A law-claim whose `bridges` list is non-empty therefore conjoins, under one kernel-checked name, the universal law of the source model, `Holds` about the plan, and the plan-equals-source identity of every function the law mentions — the three halves are no longer identified by construction. What remains trusted is narrower and must be stated as such: (i) the ENCODERS, which the producer chooses and which are part of the theorem's statement, so a reader must read the statement rather than the export name — the verifier constrains their SHAPE (a closed kind set, `_root_.`-qualified names, accessors of the type they claim to project) but not that they are the encoding the user meant; (ii) **the MODEL definition itself, which is producer-emitted.** `_root_..` is a definition the package's own model modules carry, so `plan ≡ ` is kernel-checked RELATIVE TO those modules: it says the plan and the transpiled definition agree, not that the transpilation of the user's source was faithful. That is the same trust boundary the law-claims surface already disclosed — a law is a theorem about the emitted model — and the bridge narrows the gap between the two halves of a certificate without closing this one; (iii) an export with NO declared or no credited bridge, where the old disclosure stands unchanged — the plan is the claim, and its correspondence to the source rests on the producer deriving the plan from the source program's MIR. Today the shapes without a bridge are exactly those whose source signature has no `SVal` image: a parameter or result that is a nested record, a record with a non-Int field, a Float, a String, or a user ADT; a source signature the producer cannot resolve unambiguously to a transpiled definition; and an export whose fixed bridge tactic script does not close, which is reported as an uncredited bridge rather than a silent one. A reimplementation MUST NOT present an UNCREDITED or undeclared bridge as establishing the identity, and MUST NOT present a law-claim with an empty `bridges` list as a kernel-checked statement about the bytes alone. +- **Two wasm GC facts behind the exact `ref.test` (S-3).** The audited interpreter's `ref.test` and `ref.cast` compare type indices exactly, while wasm GC tests subtyping, and a variant `match` lowers to a `ref.test` cascade over the constructor structs. The wall pins every constructor struct of every declared sum as `sub final` under the sum's root, inside the rec group that opens the type section (`TypeTable.sumConfirmed`, over the raw entries `GrammarLower.S3Pin` reads), and proves that under this pin the exact test IS the subtype test on those structs (`GrammarSound.ctor_refTest_exact`; for an accepted artifact, `AcceptanceSoundness.refTest_exact_of_accepted`). That proof rests on two facts of the wasm GC specification, carried as the explicit hypothesis `GrammarSound.GcTestSpec` and deliberately not as axioms: (i) subtyping is reflexive; (ii) a type declared final has no subtype in its own rec group other than itself (validation rejects a `sub` that names a final supertype, and distinct positions of one rec group are distinct types under iso-recursive type equivalence). A reimplementation MUST keep the pin, and relies on these two facts exactly as the reference verifier does. - **Explicit source read declarations** — user-ADT domain meaning, representation interpretation, and non-reconstructible models (section 5.1) are conditions of the theorem, not derived facts. - **Explicitly configured cache directories**, if any, as trusted local state: their integrity manifests detect accidental corruption, not an active writer able to replace `.olean` outputs and Lake traces together. diff --git a/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap b/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap index a6cfc1eeb..9090e4f56 100644 --- a/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap +++ b/tests/snapshots/cert_certify_spec__add_one_certificate_package.snap @@ -5,7 +5,7 @@ expression: golden == cert-manifest.json == { "schema_version": 8, - "format": {"version": 1, "wall_id": "sha256:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25"}, + "format": {"version": 1, "wall_id": "sha256:8cf1d73ca42ca289b89064f08e18b985d4cdc255293a8183896d117289c4f0fa"}, "wasm": "add_one.wasm", "wasm_sha256": "4b86ac5e745a7f0aeef0d24178a3f47ed09b4f98ffc36216aedf252c9cb20583", "target": "wasm-gc", diff --git a/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap b/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap index fe156d6b3..e1b0a3586 100644 --- a/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap +++ b/tests/snapshots/cert_certify_spec__wasip2_component_certificate_package.snap @@ -5,7 +5,7 @@ expression: golden == cert-manifest.json == { "schema_version": 8, - "format": {"version": 1, "wall_id": "sha256:4d9c7caf450e982d04c7937b531a09c3c318cb22d5313eb05801ae741217df25"}, + "format": {"version": 1, "wall_id": "sha256:8cf1d73ca42ca289b89064f08e18b985d4cdc255293a8183896d117289c4f0fa"}, "wasm": "wasip2_carrierless.component.wasm", "wasm_sha256": "0e7064150f82e180dff6f774a8f48711acd2ea21d183ee06576d4f7c9f135aed", "target": "wasip2", From 8a42ace305715020f8058043a863f9aaee7dd848 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 03:33:50 +0200 Subject: [PATCH 13/89] cert wall: pin the Int equality helper by its template only The emitter exports `__aint_eq` only when a user code path marks it live, while an Int literal match calls it regardless, so the export-name pin declined every module whose only equality use is such a match. The role is now pinned like add, sub and mul: a declared index must hold the equality template, and an undeclared role lowers to an index no code entry encodes. `cmp` keeps its name pin, so the two comparison helpers stay apart. The wall id is rotated in format.rs and the format specification. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../wall/current/AcceptedArtifactCore.lean | 29 +++++++++---------- aver-cert/assets/wall/current/CertDecode.lean | 7 ----- aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- 4 files changed, 16 insertions(+), 24 deletions(-) diff --git a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean index 1269b527f..b2e5fa1a3 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean @@ -269,7 +269,7 @@ def arithRoleCheck (n len : Nat) (role : ArithTemplateDerisk.ArithRole) same decoder (`TypeTable.carrierConfirmed`), so the helper bodies and the plans' representation agree about where the carrier lives. - `box`, `toIndex`, `cmp` and `eq` carry a SECOND pin, to their runtime export + `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 @@ -287,18 +287,18 @@ def arithRoleCheck (n len : Nat) (role : ArithTemplateDerisk.ArithRole) 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 - also calls 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 @@ -315,7 +315,6 @@ def arithTableCheck (n len : Nat) (roles? : Option CertDecode.AddSub.Roles) (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 && arithRoleCheck n len .box roles.box p && arithRoleCheck n len .toIndex roles.toIndex p && @@ -331,7 +330,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 := diff --git a/aver-cert/assets/wall/current/CertDecode.lean b/aver-cert/assets/wall/current/CertDecode.lean index ccb85c56f..f8746b97e 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 diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 8d57b4730..f578ae3a9 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -181,7 +181,7 @@ pub const RECORD_COMPUTE_DOMAIN_LINE: &str = /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:8cf1d73ca42ca289b89064f08e18b985d4cdc255293a8183896d117289c4f0fa"; + "sha256:c8232f4aa548014f86fda03ef7dfd4e9dd2b19c595001ba4a2c2dcf4773c1a3c"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 23941375c..c00400fb3 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -32,7 +32,7 @@ Schema version 7 differs from version 6 in one point: the manifest gained the re 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 19 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:8cf1d73ca42ca289b89064f08e18b985d4cdc255293a8183896d117289c4f0fa` (`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. +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 19 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:c8232f4aa548014f86fda03ef7dfd4e9dd2b19c595001ba4a2c2dcf4773c1a3c` (`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. From d65e1dcd7cd80b699a21c5b43f3a79774519e60d Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 03:43:42 +0200 Subject: [PATCH 14/89] cert: produce schema-9 packages from the printed MIR plans The compiler now prints every emitted function's optimized MIR body 1:1 into the one plan grammar, from the same compile the wasm-gc emitter consumed: `plan_from_mir.rs` maps each admitted MIR node to the grammar node of the same name and declines any other node, pattern or type by name. Types, struct indices, helper and data-segment indices come from the emitter's own registry through `wasm_gc/cert_layout.rs`, into one module-wide type table. The producer (`aver-cert/src/engine`) checks each plan against the exact module bytes before rendering: Rust twins of the wall's typing, lowering, type-table confirmation and totality check decline a plan whose lowering is not its code entry per function, instead of failing the whole package in Lean. The offered functions are grouped into call SCCs, callees first, and rendered as `Plans.lean`, `Manifest.lean` (obligations are the ones the wall derives), `Artifact.lean`, `Final.lean` and `ArtifactCertificate.lean`. The manifest moves to schema 9: every certified export reports the one class `source-plan-v1` with facets, which the checker witness pins against `ClaimAxes.reportEntries` and `ClaimAxes.reportFacets`. Law-claims and source bridges are not carried yet; the checker refuses a package declaring either, and the Lean model emission is no longer run. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/mod.rs | 95 +- aver-cert/src/engine/module_envelope.rs | 2 +- aver-cert/src/engine/module_facts.rs | 812 +++++++++++ aver-cert/src/engine/plan.rs | 501 +++++++ aver-cert/src/engine/plan_check.rs | 1734 +++++++++++++++++++++++ aver-cert/src/engine/produce.rs | 1128 +++++++++++++++ aver-cert/src/engine/render_package.rs | 668 +++++++++ aver-cert/src/format.rs | 33 +- aver-cert/src/verifier.rs | 240 ++-- docs/certificate-format.md | 8 +- src/codegen/cert/mod.rs | 7 +- src/codegen/cert/plan_from_mir.rs | 1104 +++++++++++++++ src/codegen/wasm_gc/cert_layout.rs | 147 ++ src/codegen/wasm_gc/mod.rs | 24 +- src/codegen/wasm_gc/module.rs | 81 +- src/main/commands.rs | 74 +- 16 files changed, 6304 insertions(+), 354 deletions(-) create mode 100644 aver-cert/src/engine/module_facts.rs create mode 100644 aver-cert/src/engine/plan.rs create mode 100644 aver-cert/src/engine/plan_check.rs create mode 100644 aver-cert/src/engine/produce.rs create mode 100644 aver-cert/src/engine/render_package.rs create mode 100644 src/codegen/cert/plan_from_mir.rs create mode 100644 src/codegen/wasm_gc/cert_layout.rs diff --git a/aver-cert/src/engine/mod.rs b/aver-cert/src/engine/mod.rs index ac3e6cbef..a3468c6fe 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 = @@ -89,59 +86,23 @@ 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!("render_package.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"); diff --git a/aver-cert/src/engine/module_envelope.rs b/aver-cert/src/engine/module_envelope.rs index 0ca9859ec..7661c1528 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 { diff --git a/aver-cert/src/engine/module_facts.rs b/aver-cert/src/engine/module_facts.rs new file mode 100644 index 000000000..55f4fad56 --- /dev/null +++ b/aver-cert/src/engine/module_facts.rs @@ -0,0 +1,812 @@ +// ---- 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, + 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 := {} }} : 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), + ) + } + + 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)" + ) + }) + } +} + +/// 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)), + _ => {} + } + } + } + } + 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/plan.rs b/aver-cert/src/engine/plan.rs new file mode 100644 index 000000000..bca8a07a3 --- /dev/null +++ b/aver-cert/src/engine/plan.rs @@ -0,0 +1,501 @@ +// ---- 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, +} + +/// `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), +} + +/// `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", + } + ), + 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(), + } +} + +impl PlanTypeTable { + /// The Lean `Schema.TypeTable` term. + pub fn lean(&self) -> String { + let records = self + .records + .iter() + .map(|r| format!("⟨{}, {}, {}⟩", r.tid, r.struct_idx, lean_ty_list(&r.fields))) + .collect::>() + .join(", "); + 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::>() + .join(", "); + let pairs = |xs: &[(PlanTy, u32)]| { + xs.iter() + .map(|(t, i)| format!("({}, {i})", t.lean())) + .collect::>() + .join(", ") + }; + let results = self + .results + .iter() + .map(|(t, e, i)| format!("({}, {}, {i})", t.lean(), e.lean())) + .collect::>() + .join(", "); + let opaques = self + .opaques + .iter() + .map(|(t, i)| format!("({t}, {i})")) + .collect::>() + .join(", "); + let segs = self + .str_segs + .iter() + .map(|(b, i)| format!("({}, {i})", lean_bytes(b))) + .collect::>() + .join(", "); + format!( + "{{ carrier := {}, mag := {}, str := {}, strVec := {},\n records := [{records}],\n sums := [{sums}],\n options := [{}], results := [{results}],\n vecs := [{}], lists := [{}], opaques := [{opaques}],\n strSegs := [{segs}] }}", + lean_opt_nat(self.carrier), + lean_opt_nat(self.mag), + lean_opt_nat(self.str_), + lean_opt_nat(self.str_vec), + pairs(&self.options), + pairs(&self.vecs), + pairs(&self.lists), + ) + } +} diff --git a/aver-cert/src/engine/plan_check.rs b/aver-cert/src/engine/plan_check.rs new file mode 100644 index 000000000..b12d53980 --- /dev/null +++ b/aver-cert/src/engine/plan_check.rs @@ -0,0 +1,1734 @@ +// ---- 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, + 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)), + 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(_, _) + ) +} + +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, + } +} + +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(|| 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 => lazy_ty( + *lb, + &self.ty_of(n, g, false, o)?, + &self.ty_of(n, g, false, d)?, + ), + }, + _ => 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()) +} + +/// `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, + 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))], + _ => 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::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; + } + 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::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(|| 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..1bce14fe0 --- /dev/null +++ b/aver-cert/src/engine/produce.rs @@ -0,0 +1,1128 @@ +// ---- 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, + 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); + // 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.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()); + } + 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), + (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, + roles: role_table, + string_roles: facts.string_roles.clone(), + entries, + types, + certified, + declined, + contracts, + module_envelope, + }) +} + +#[cfg(test)] +mod produce_tests { + use super::*; + + fn fixture(name: &str) -> Vec { + let path = format!( + "{}/../prompts/probe-artifacts/one-grammar-p4/fixture/{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/render_package.rs b/aver-cert/src/engine/render_package.rs new file mode 100644 index 000000000..4e31f2513 --- /dev/null +++ b/aver-cert/src/engine/render_package.rs @@ -0,0 +1,668 @@ +// ---- 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)>, +} + +/// Why a law-claim or a source bridge is not declared by a schema-9 package. +pub const SCHEMA9_BRIDGE_PENDING: &str = "schema 9 does not carry law-claims or source bridges yet: the certified model is the plan itself"; + +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())) +} + +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(&format!( + "def types : TypeTable :=\n {}\n\n", + analysis.types.lean() + )); + 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 lean_pairs(items: &[(String, String)]) -> String { + format!( + "[{}]", + items + .iter() + .map(|(a, b)| format!("({}, {})", lean_str(a), lean_str(b))) + .collect::>() + .join(", ") + ) +} + +fn lean_strings(items: &[String]) -> String { + format!( + "[{}]", + items + .iter() + .map(|x| lean_str(x)) + .collect::>() + .join(", ") + ) +} + +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(), + }; + 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\ + 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), + exports = lean_strings(&analysis.certified_names()), + declared = lean_pairs(&declared_uncertified(analysis)), + capabilities = lean_pairs(&analysis.module_envelope.capabilities), + contracts = lean_strings(&analysis.contracts), + ) +} + +fn render_artifact_host_roles(analysis: &Analysis, params: &str) -> String { + let roles = analysis.roles.expect("a carriered module declares roles"); + 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 := by decide +kernel" + ) + }; + 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), + ] + .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\n\ + set_option maxRecDepth 200000\n\n\ + namespace AverCert.Artifact\n\n\ + {leaves}\n\n\ + end AverCert.Artifact\n" + ) +} + +fn render_artifact( + analysis: &Analysis, + envelope: Option, +) -> 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, Bool.and_true, Bool.true_and]\n \ + decide +kernel", + r.roles_lean_value() + ), + ), + _ => ( + String::new(), + "theorem roles_ok : decodedHostRoleTable data := by\n \ + unfold decodedHostRoleTable; decide +kernel" + .to_string(), + ), + }; + format!( + "-- The artifact data and the byte facts of its acceptance, each by\n\ + -- `decide +kernel` against the checker-staged `ArtifactBytes`.\n\ + import AcceptedArtifact\n\ + import ArtifactBytes\n\ + import Manifest\n\ + {roles_import}\n\ + set_option maxRecDepth 200000\n\n\ + namespace AverCert.Artifact\n\ + open AverCert AverCert.Schema AverCert.AcceptedArtifact\n\n\ + 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\ + theorem plans_ok : plansAccepted data = true := by decide +kernel\n\n\ + {roles_proof}\n\n\ + theorem strings_ok : decodedStringHostRoles data := by\n \ + unfold decodedStringHostRoles; decide +kernel\n\n\ + theorem axes_ok : AverCert.ClaimAxes.checked data = true := by decide +kernel\n\n\ + theorem whole_ok : acceptedWholeModule data := by\n \ + unfold acceptedWholeModule; refine ⟨?_, ?_, ?_, ?_, ?_⟩ <;> decide +kernel\n\n\ + theorem envelope_ok : artifactEnvelopeAccepted AverCert.ArtifactComponentBytes.componentBytes\n \ + AverCert.ArtifactComponentBytes.componentLen data = true := by decide +kernel\n\n\ + end AverCert.Artifact\n", + fuel = analysis.module_envelope.closure_fuel, + roots = nats(&closure.roots), + helpers = nats(&closure.helpers), + admitted = nats(&closure.admitted), + ) +} + +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 render_module(file_name: &str, sha: &str) -> String { + format!( + "-- The sha256 of the certified `{}` bytes.\n\ + import CertPrelude\n\n\ + namespace CertModule\n\n\ + def wasmSha256 : String := {}\n\n\ + end CertModule\n", + file_name.replace('\n', " "), + lean_str(sha) + ) +} + +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, + declined_bridges: &[(String, String)], +) -> String { + 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)) + )); + s.push_str(" \"laws\": [],\n"); + s.push_str(" \"sourceBridges\": [],\n"); + 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\": {}}},\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), + )), + 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. +/// +/// Schema 9 declares no law-claims and no source bridges yet: each law the +/// model emission recorded comes back in [`ProjectDeclines`] with the reason. +pub fn write_project( + out_dir: &Path, + artifact: CertificateArtifact<'_>, + analysis: &Analysis, + law_claims: Vec, +) -> 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(); + + write( + &cert_dir, + "Module.lean", + &render_module(artifact.file_name(), &sha), + )?; + write(&cert_dir, "Plans.lean", &render_plans(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), + )?; + } + write( + &cert_dir, + "Artifact.lean", + &render_artifact(analysis, envelope), + )?; + write(&cert_dir, "Final.lean", &render_final())?; + write( + &cert_dir, + "ArtifactCertificate.lean", + &render_artifact_certificate(), + )?; + + let declined_bridges: Vec<(String, String)> = Vec::new(); + std::fs::write( + cert_dir.join("cert-manifest.json"), + render_manifest_json( + analysis, + artifact.file_name(), + &sha, + target, + abi, + envelope, + &declined_bridges, + ), + ) + .map_err(|e| format!("write manifest: {e}"))?; + Ok(ProjectDeclines { + law_claims: law_claims + .into_iter() + .map(|claim| (claim.label, SCHEMA9_BRIDGE_PENDING.to_string())) + .collect(), + source_bridges: declined_bridges, + }) +} diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index f578ae3a9..3763cb005 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,21 +174,9 @@ 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 = @@ -513,7 +512,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/verifier.rs b/aver-cert/src/verifier.rs index 970f9b00c..b7f8936d2 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -134,15 +134,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 @@ -195,16 +190,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)] @@ -670,8 +661,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 +678,35 @@ 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 { + 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, + None => "model: plan (the export's optimized MIR body)".to_string(), } } @@ -803,6 +739,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 @@ -998,7 +947,8 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { 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.ClaimAxes.reportEntries AverCert.Artifact.data = {report_entries} := by decide\n\ + example : AverCert.ClaimAxes.reportFacets AverCert.Artifact.data = {report_facets} := by decide\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\ @@ -1312,18 +1262,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), }); } @@ -1334,6 +1304,15 @@ fn read_candidates( .get("sourceBridges") .and_then(Value::as_array) .ok_or_else(|| "cert-manifest.json is missing array field `sourceBridges`".to_string())?; + // Schema 9 carries no source-bridge statement kind and no law-claims yet: + // the certified model is the plan itself. A package declaring either is + // refused rather than credited. + if !bridges_json.is_empty() { + return Err(format!( + "cert-manifest.json declares source bridges; schema {} carries none yet", + format::CERT_SCHEMA_VERSION + )); + } let certified_names: Vec<&str> = certified .iter() .map(|candidate| candidate.name.as_str()) @@ -1394,6 +1373,12 @@ fn read_candidates( .get("laws") .and_then(Value::as_array) .ok_or_else(|| "cert-manifest.json is missing array field `laws`".to_string())?; + if !laws_json.is_empty() { + return Err(format!( + "cert-manifest.json declares law-claims; schema {} carries none yet", + format::CERT_SCHEMA_VERSION + )); + } let mut laws = Vec::with_capacity(laws_json.len()); for (index, entry) in laws_json.iter().enumerate() { let context = format!("laws[{index}]"); @@ -2029,8 +2014,9 @@ fn gate_candidates(candidates: &Candidates) -> 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)?; @@ -2817,13 +2803,7 @@ 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); } if !report.contracts.is_empty() { println!("\n{}", "Runtime contracts".yellow().bold()); @@ -3478,46 +3458,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] diff --git a/docs/certificate-format.md b/docs/certificate-format.md index c00400fb3..8ad432034 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -13,7 +13,7 @@ Three version-like 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 | +| Statement schema version | `9` (`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 | 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. @@ -32,9 +32,11 @@ Schema version 7 differs from version 6 in one point: the manifest gained the re 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. +Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 carries no law-claims and no source bridges yet: a package declaring either is refused. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. + 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 19 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:c8232f4aa548014f86fda03ef7dfd4e9dd2b19c595001ba4a2c2dcf4773c1a3c` (`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: freeze criteria.** Neither `format.version = 1` nor `schema_version = 9` 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. @@ -316,7 +318,7 @@ The axiom guard is a checker-authored `run_cmd` that collects the axiom closure 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.) -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. +1. **Manifest target gate.** Read the artifact bytes and parse `cert-manifest.json`; require `schema_version = 9`, `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). diff --git a/src/codegen/cert/mod.rs b/src/codegen/cert/mod.rs index c0825e65b..a52e6cc87 100644 --- a/src/codegen/cert/mod.rs +++ b/src/codegen/cert/mod.rs @@ -1,9 +1,12 @@ //! Compatibility surface for certificate production in `aver-lang`. //! //! The compiler-independent engine and soundness wall live in `aver-cert`. -//! Only the MIR-to-plan adapter remains here because it necessarily depends on +//! Only the MIR-to-plan printer remains here because it necessarily depends on //! Aver's compiler IR. pub use aver_cert::*; -include!("expr_fragment_from_mir.rs"); +mod plan_from_mir; +pub use plan_from_mir::{ + PlanLayout, RecordLayout, SumLayout, TypeTableBuilder, print_fn, print_module, +}; diff --git a/src/codegen/cert/plan_from_mir.rs b/src/codegen/cert/plan_from_mir.rs new file mode 100644 index 000000000..8f8054db6 --- /dev/null +++ b/src/codegen/cert/plan_from_mir.rs @@ -0,0 +1,1104 @@ +//! The one-grammar plan printer: an optimized MIR function (exactly the tree +//! the wasm-gc MIR emitter consumed, in the same compile) printed 1:1 as a +//! `Grammar.FnPlan` (`aver_cert::FnPlan`). +//! +//! The printer is mechanical. Every admitted `MirExpr` node becomes the +//! grammar node of the same name with the same children; every other node, +//! pattern or type declines the whole function with the MIR node's name as +//! the reason. It makes no lowering choice: the wall's `GrammarLower` makes +//! those from the printed tree, and the producer checks the result against the +//! emitted code entry before anything is rendered. +//! +//! Types are printed through the emitter's own type registry (the same +//! indices the emitter wrote), into one module-wide type table whose type ids +//! the plans cite. The wall confirms every table entry against the type and +//! data sections; nothing the printer states is trusted. + +use std::collections::HashMap; + +use aver_cert::{ + FnPlan, ModulePlans, PLAN_NO_SLOT, PlanBinOp, PlanBuiltin, PlanCallee, PlanCtor, PlanExpr, + PlanLazy, PlanLit, PlanPat, PlanRecordDecl, PlanSumDecl, PlanTy, PlanTypeTable, PlannedFn, +}; + +use crate::ast::{BinOp, Literal, Spanned}; +use crate::ir::hir::{BuiltinCtor, ResolvedFnDef}; +use crate::ir::mir::{MirCallee, MirCtor, MirExpr, MirFn, MirPattern, MirStrPart}; +use crate::ir::{BuiltinId, CtorId, FnId}; + +/// A user sum as the emitter laid it out: its root struct and, per +/// constructor in declaration order, the constructor's struct and field +/// types. +pub struct SumLayout { + pub root: u32, + pub ctors: Vec<(u32, Vec)>, +} + +/// A user record as the emitter laid it out: its struct (absent for a +/// one-field newtype, which the emitter erases to its field) and its declared +/// fields in order. +pub struct RecordLayout { + pub struct_idx: Option, + pub fields: Vec<(String, String)>, +} + +/// The emitter's view the printer reads: the type registry, the function +/// index map and the interned builtin names of the same compile. +pub trait PlanLayout { + fn carrier(&self) -> Option; + fn mag(&self) -> Option; + fn string_array(&self) -> Option; + fn string_segment(&self, bytes: &[u8]) -> Option; + fn option(&self, canonical: &str) -> Option; + fn result(&self, canonical: &str) -> Option; + fn vector(&self, canonical: &str) -> Option; + fn list(&self, canonical: &str) -> Option; + fn tuple(&self, canonical: &str) -> Option; + fn map(&self, canonical: &str) -> Option; + /// A type name the emitter represents specially (packed sequence, + /// raw-`i64` carrier, capability resource): never printed. + fn special(&self, name: &str) -> bool; + fn record(&self, name: &str) -> Option; + fn sum(&self, name: &str) -> Option; + /// A user constructor: its owning sum's name and its index in + /// declaration order; `None` for a record's constructor. + fn user_ctor(&self, ctor: CtorId) -> Option<(String, u32)>; + fn fn_idx(&self, f: FnId) -> Option; + fn builtin_name(&self, b: BuiltinId) -> Option; +} + +/// The reason budget of a decline. +const REASON_BUDGET: usize = 200; + +fn clip(reason: String) -> String { + if reason.len() <= REASON_BUDGET { + return reason; + } + let mut end = REASON_BUDGET - 3; + while !reason.is_char_boundary(end) { + end -= 1; + } + format!("{}...", &reason[..end]) +} + +/// A parsed type string: `Head`; a tuple is `Tuple<..>`. +#[derive(Debug, PartialEq)] +struct TyTree { + head: String, + args: Vec, +} + +impl TyTree { + fn canonical(&self) -> String { + if self.args.is_empty() { + self.head.clone() + } else { + format!( + "{}<{}>", + self.head, + self.args + .iter() + .map(TyTree::canonical) + .collect::>() + .join(",") + ) + } + } +} + +fn parse_ty(text: &str) -> Option { + let compact: String = text.chars().filter(|c| !c.is_whitespace()).collect(); + let chars: Vec = compact.chars().collect(); + let mut at = 0; + let tree = parse_ty_at(&chars, &mut at)?; + (at == chars.len()).then_some(tree) +} + +fn parse_ty_at(chars: &[char], at: &mut usize) -> Option { + if chars.get(*at) == Some(&'(') { + *at += 1; + let args = parse_ty_args(chars, at, ')')?; + return Some(TyTree { + head: "Tuple".into(), + args, + }); + } + let start = *at; + while *at < chars.len() + && (chars[*at].is_alphanumeric() || chars[*at] == '_' || chars[*at] == '.') + { + *at += 1; + } + if start == *at { + return None; + } + let head: String = chars[start..*at].iter().collect(); + if chars.get(*at) == Some(&'<') { + *at += 1; + let args = parse_ty_args(chars, at, '>')?; + return Some(TyTree { head, args }); + } + Some(TyTree { + head, + args: Vec::new(), + }) +} + +fn parse_ty_args(chars: &[char], at: &mut usize, close: char) -> Option> { + let mut args = vec![parse_ty_at(chars, at)?]; + loop { + match chars.get(*at) { + Some(',') => { + *at += 1; + args.push(parse_ty_at(chars, at)?); + } + Some(c) if *c == close => { + *at += 1; + return Some(args); + } + _ => return None, + } + } +} + +/// The module-wide type table the plans cite, grown on demand. +#[derive(Default)] +pub struct TypeTableBuilder { + table: PlanTypeTable, + tids: HashMap, + next_tid: u32, + failed: HashMap, +} + +impl TypeTableBuilder { + pub fn new(layout: &dyn PlanLayout) -> Self { + Self { + table: PlanTypeTable { + carrier: layout.carrier(), + mag: layout.carrier().and(layout.mag()), + str_: layout.string_array(), + str_vec: layout.vector("Vector"), + ..PlanTypeTable::default() + }, + ..Self::default() + } + } + + pub fn finish(self) -> PlanTypeTable { + self.table + } + + fn tid(&mut self, key: String) -> (u32, bool) { + if let Some(t) = self.tids.get(&key) { + return (*t, false); + } + let t = self.next_tid; + self.next_tid += 1; + self.tids.insert(key, t); + (t, true) + } + + /// The heap type a representation of `ty` points at, for a newtype + /// record's declared struct. + fn heap_of(&self, ty: &PlanTy) -> Option { + let t = &self.table; + match ty { + PlanTy::Int => t.carrier, + PlanTy::Str => t.str_, + PlanTy::Record(tid) => t + .records + .iter() + .find(|r| r.tid == *tid) + .map(|r| r.struct_idx), + PlanTy::Sum(tid) => t.sums.iter().find(|s| s.tid == *tid).map(|s| s.root), + PlanTy::Option(x) => t.options.iter().find(|o| &o.0 == x.as_ref()).map(|o| o.1), + PlanTy::Result(x, e) => t + .results + .iter() + .find(|r| &r.0 == x.as_ref() && &r.1 == e.as_ref()) + .map(|r| r.2), + PlanTy::Vec(x) => t.vecs.iter().find(|v| &v.0 == x.as_ref()).map(|v| v.1), + PlanTy::List(x) => t.lists.iter().find(|l| &l.0 == x.as_ref()).map(|l| l.1), + PlanTy::Opaque(tid) => t.opaques.iter().find(|o| o.0 == *tid).map(|o| o.1), + PlanTy::Bool | PlanTy::Float | PlanTy::Eqref => None, + } + } + + pub fn ty(&mut self, layout: &dyn PlanLayout, text: &str) -> Result { + let tree = parse_ty(text).ok_or_else(|| format!("type `{text}` does not parse"))?; + self.ty_tree(layout, &tree) + } + + fn ty_tree(&mut self, layout: &dyn PlanLayout, tree: &TyTree) -> Result { + let canon = tree.canonical(); + let arg = |this: &mut Self, i: usize| -> Result { + let a = tree + .args + .get(i) + .ok_or_else(|| format!("type `{canon}` is missing an argument"))?; + this.ty_tree(layout, a) + }; + match (tree.head.as_str(), tree.args.len()) { + ("Int", 0) => match self.table.carrier { + Some(_) => Ok(PlanTy::Int), + None => Err("type Int without the Int carrier".into()), + }, + ("Bool", 0) => Ok(PlanTy::Bool), + ("Float", 0) => Ok(PlanTy::Float), + ("String", 0) => match self.table.str_ { + Some(_) => Ok(PlanTy::Str), + None => Err("type String without the string array".into()), + }, + ("Option", 1) => { + let t = arg(self, 0)?; + let idx = layout + .option(&canon) + .ok_or_else(|| format!("type `{canon}` is not registered"))?; + if !self.table.options.iter().any(|o| o.0 == t) { + self.table.options.push((t.clone(), idx)); + } + Ok(PlanTy::Option(Box::new(t))) + } + ("Result", 2) => { + let t = arg(self, 0)?; + let e = arg(self, 1)?; + let idx = layout + .result(&canon) + .ok_or_else(|| format!("type `{canon}` is not registered"))?; + if !self.table.results.iter().any(|r| r.0 == t && r.1 == e) { + self.table.results.push((t.clone(), e.clone(), idx)); + } + Ok(PlanTy::Result(Box::new(t), Box::new(e))) + } + ("Vector", 1) => { + let t = arg(self, 0)?; + let idx = layout + .vector(&canon) + .ok_or_else(|| format!("type `{canon}` is not registered"))?; + if !self.table.vecs.iter().any(|v| v.0 == t) { + self.table.vecs.push((t.clone(), idx)); + } + Ok(PlanTy::Vec(Box::new(t))) + } + ("List", 1) => { + let t = arg(self, 0)?; + let idx = layout + .list(&canon) + .ok_or_else(|| format!("type `{canon}` is not registered"))?; + if !self.table.lists.iter().any(|l| l.0 == t) { + self.table.lists.push((t.clone(), idx)); + } + Ok(PlanTy::List(Box::new(t))) + } + ("Tuple", n) if n >= 2 => self.record_like( + layout, + format!("tuple:{canon}"), + |layout| layout.tuple(&canon), + |this| (0..n).map(|i| arg(this, i)).collect(), + ), + ("Map", 2) => { + let key = format!("opaque:{canon}"); + let idx = layout + .map(&canon) + .ok_or_else(|| format!("type `{canon}` is not registered"))?; + let (tid, fresh) = self.tid(key); + if fresh { + self.table.opaques.push((tid, idx)); + } + Ok(PlanTy::Opaque(tid)) + } + (name, 0) => self.named(layout, name), + _ => Err(format!("type `{canon}`")), + } + } + + fn record_like( + &mut self, + layout: &dyn PlanLayout, + key: String, + struct_of: impl Fn(&dyn PlanLayout) -> Option, + fields: impl Fn(&mut Self) -> Result, String>, + ) -> Result { + if let Some(reason) = self.failed.get(&key) { + return Err(reason.clone()); + } + if let Some(t) = self.tids.get(&key) { + return Ok(PlanTy::Record(*t)); + } + let idx = struct_of(layout).ok_or_else(|| format!("type `{key}` is not registered"))?; + let (tid, _) = self.tid(key.clone()); + match fields(self) { + Ok(fs) => { + self.table.records.push(PlanRecordDecl { + tid, + struct_idx: idx, + fields: fs, + }); + Ok(PlanTy::Record(tid)) + } + Err(reason) => { + self.tids.remove(&key); + self.failed.insert(key, reason.clone()); + Err(reason) + } + } + } + + fn named(&mut self, layout: &dyn PlanLayout, name: &str) -> Result { + if layout.special(name) { + return Err(format!("type `{name}` has a special representation")); + } + if let Some(rec) = layout.record(name) { + let key = format!("rec:{name}"); + if let Some(reason) = self.failed.get(&key) { + return Err(reason.clone()); + } + if let Some(t) = self.tids.get(&key) { + return Ok(PlanTy::Record(*t)); + } + let (tid, _) = self.tid(key.clone()); + let mut fields = Vec::new(); + for (_, fty) in &rec.fields { + match self.ty(layout, fty) { + Ok(t) => fields.push(t), + Err(reason) => { + self.tids.remove(&key); + self.failed.insert(key, reason.clone()); + return Err(reason); + } + } + } + // A one-field record the emitter erases (a newtype) is represented + // by its field's value; any other record needs two or more fields. + let struct_idx = match (rec.struct_idx, fields.as_slice()) { + (None, [only]) => self.heap_of(only), + (Some(idx), fs) if fs.len() >= 2 => Some(idx), + _ => None, + }; + let Some(struct_idx) = struct_idx else { + let reason = format!("record `{name}` has no struct representation"); + self.tids.remove(&key); + self.failed.insert(key, reason.clone()); + return Err(reason); + }; + self.table.records.push(PlanRecordDecl { + tid, + struct_idx, + fields, + }); + return Ok(PlanTy::Record(tid)); + } + if let Some(sum) = layout.sum(name) { + let key = format!("sum:{name}"); + if let Some(reason) = self.failed.get(&key) { + return Err(reason.clone()); + } + if let Some(t) = self.tids.get(&key) { + return Ok(PlanTy::Sum(*t)); + } + let (tid, _) = self.tid(key.clone()); + let mut ctors = Vec::new(); + for (idx, ftys) in &sum.ctors { + let mut fields = Vec::new(); + for fty in ftys { + match self.ty(layout, fty) { + Ok(t) => fields.push(t), + Err(reason) => { + self.tids.remove(&key); + self.failed.insert(key, reason.clone()); + return Err(reason); + } + } + } + ctors.push((*idx, fields)); + } + self.table.sums.push(PlanSumDecl { + tid, + root: sum.root, + ctors, + }); + return Ok(PlanTy::Sum(tid)); + } + Err(format!("type `{name}`")) + } + + /// Declare the passive data segment holding a string literal's bytes. + fn str_seg(&mut self, layout: &dyn PlanLayout, bytes: &[u8]) -> Result<(), String> { + if self.table.str_segs.iter().any(|(b, _)| b == bytes) { + return Ok(()); + } + let seg = layout + .string_segment(bytes) + .ok_or("string literal without a data segment")?; + self.table.str_segs.push((bytes.to_vec(), seg)); + Ok(()) + } + + fn sum_tid(&mut self, layout: &dyn PlanLayout, name: &str) -> Result { + match self.named(layout, name)? { + PlanTy::Sum(t) => Ok(t), + _ => Err(format!("`{name}` is not a sum")), + } + } + + fn record_tid( + &mut self, + layout: &dyn PlanLayout, + text: &str, + ) -> Result<(u32, Vec), String> { + let tree = parse_ty(text).ok_or_else(|| format!("type `{text}` does not parse"))?; + match self.ty_tree(layout, &tree)? { + PlanTy::Record(t) => { + let names = if tree.args.is_empty() { + layout + .record(&tree.head) + .map(|r| r.fields.into_iter().map(|f| f.0).collect()) + .unwrap_or_default() + } else { + Vec::new() + }; + Ok((t, names)) + } + _ => Err(format!("`{text}` is not a record")), + } + } +} + +/// One function's printing context. +struct Printer<'a> { + layout: &'a dyn PlanLayout, + types: &'a mut TypeTableBuilder, +} + +fn stamped(expr: &Spanned) -> Result { + expr.ty() + .map(|t| t.display()) + .ok_or_else(|| format!("{} has no type stamp", node_name(&expr.node))) +} + +fn node_name(expr: &MirExpr) -> &'static str { + match expr { + MirExpr::Literal(_) => "Literal", + MirExpr::Local(_) => "Local", + MirExpr::Let(_) => "Let", + MirExpr::Call(_) => "Call", + MirExpr::TailCall(_) => "TailCall", + MirExpr::BinOp(_) => "BinOp", + MirExpr::Neg(_) => "Neg", + MirExpr::Match(_) => "Match", + MirExpr::Construct(_) => "Construct", + MirExpr::RecordCreate(_) => "RecordCreate", + MirExpr::RecordUpdate(_) => "RecordUpdate", + MirExpr::Project(_) => "Project", + MirExpr::IfThenElse(_) => "IfThenElse", + MirExpr::Try(_) => "Try", + MirExpr::List(_) => "List", + MirExpr::Tuple(_) => "Tuple", + MirExpr::MapLiteral(_) => "MapLiteral", + MirExpr::InterpolatedStr(_) => "InterpolatedStr", + MirExpr::IndependentProduct(_) => "IndependentProduct", + MirExpr::Return(_) => "Return", + MirExpr::FnValue(_) => "FnValue", + MirExpr::Box(_) => "Box", + MirExpr::Unbox(_) => "Unbox", + } +} + +fn bin_op(op: &BinOp) -> Result { + Ok(match op { + BinOp::Add => PlanBinOp::Add, + BinOp::Sub => PlanBinOp::Sub, + BinOp::Mul => PlanBinOp::Mul, + BinOp::Div => return Err("BinOp Div".into()), + BinOp::Eq => PlanBinOp::Eq, + BinOp::Neq => PlanBinOp::Neq, + BinOp::Lt => PlanBinOp::Lt, + BinOp::Gt => PlanBinOp::Gt, + BinOp::Lte => PlanBinOp::Lte, + BinOp::Gte => PlanBinOp::Gte, + }) +} + +fn builtin_ctor(bc: &BuiltinCtor) -> PlanCtor { + match bc { + BuiltinCtor::OptionSome => PlanCtor::Some, + BuiltinCtor::OptionNone => PlanCtor::None, + BuiltinCtor::ResultOk => PlanCtor::Ok, + BuiltinCtor::ResultErr => PlanCtor::Err, + } +} + +impl Printer<'_> { + fn ty(&mut self, text: &str) -> Result { + self.types.ty(self.layout, text) + } + + fn ctor(&mut self, ctor: &MirCtor) -> Result { + match ctor { + MirCtor::Builtin(bc) => Ok(builtin_ctor(bc)), + MirCtor::User(id) => { + let (parent, index) = self + .layout + .user_ctor(*id) + .ok_or("Construct of a record constructor")?; + let tid = self.types.sum_tid(self.layout, &parent)?; + Ok(PlanCtor::User(tid, index)) + } + } + } + + fn exprs(&mut self, items: &[Spanned]) -> Result, String> { + items.iter().map(|e| self.expr(e)).collect() + } + + fn pat(&mut self, pattern: &MirPattern) -> Result { + Ok(match pattern { + MirPattern::Wildcard => PlanPat::Wild, + MirPattern::Literal(Literal::Int(k)) => PlanPat::LitInt(*k), + MirPattern::Literal(Literal::Bool(b)) => PlanPat::LitBool(*b), + MirPattern::Literal(Literal::Str(s)) => { + self.types.str_seg(self.layout, s.as_bytes())?; + PlanPat::LitStr(s.as_bytes().to_vec()) + } + MirPattern::Literal(_) => { + return Err("Match pattern Literal (non Int/Bool/String)".into()); + } + MirPattern::Bind(slot, _) => PlanPat::Bind(slot.0), + MirPattern::Ctor { ctor, bindings, .. } => { + PlanPat::Ctor(self.ctor(ctor)?, bindings.iter().map(|b| b.0).collect()) + } + MirPattern::Tuple(items) => PlanPat::Tuple( + items + .iter() + .map(|p| match p { + MirPattern::Bind(slot, _) => Ok(slot.0), + MirPattern::Wildcard => Ok(PLAN_NO_SLOT), + _ => Err("Match pattern Tuple (nested)".to_string()), + }) + .collect::>()?, + ), + MirPattern::EmptyList => return Err("Match pattern EmptyList".into()), + MirPattern::Cons { .. } => return Err("Match pattern Cons".into()), + }) + } + + fn expr(&mut self, expr: &Spanned) -> Result { + Ok(match &expr.node { + MirExpr::Literal(lit) => PlanExpr::Literal(match &lit.node { + Literal::Int(k) => PlanLit::Int(*k), + Literal::Bool(b) => PlanLit::Bool(*b), + Literal::Float(f) => PlanLit::Float(f.to_bits()), + Literal::Str(s) => { + self.types.str_seg(self.layout, s.as_bytes())?; + PlanLit::Str(s.as_bytes().to_vec()) + } + Literal::BigInt(_) => return Err("Literal BigInt".into()), + Literal::Unit => return Err("Literal Unit".into()), + }), + MirExpr::Local(local) => PlanExpr::Local(local.node.slot.0), + MirExpr::Let(l) => { + let l = &l.node; + if l.binding_name.is_empty() { + return Err("Let (synthetic, unnamed)".into()); + } + PlanExpr::Let( + l.binding.0, + Box::new(self.expr(&l.value)?), + Box::new(self.expr(&l.body)?), + ) + } + MirExpr::Call(c) => { + let call = &c.node; + match &call.callee { + MirCallee::Fn(f) => { + let idx = self + .layout + .fn_idx(*f) + .ok_or("Call Fn (callee has no wasm function)")?; + PlanExpr::Call(PlanCallee::Fn(idx), self.exprs(&call.args)?) + } + MirCallee::Builtin(b) => { + let name = self.layout.builtin_name(*b).unwrap_or_default(); + let callee = match name.as_str() { + "Bool.and" => PlanCallee::Builtin(PlanBuiltin::BoolAnd), + "Bool.or" => PlanCallee::Builtin(PlanBuiltin::BoolOr), + "Bool.not" => PlanCallee::Builtin(PlanBuiltin::BoolNot), + "List.prepend" => PlanCallee::Builtin(PlanBuiltin::ListPrepend), + "Vector.get" => PlanCallee::Builtin(PlanBuiltin::VecGet), + "Option.withDefault" => PlanCallee::Lazy(PlanLazy::OptWithDefault), + "Result.withDefault" => PlanCallee::Lazy(PlanLazy::ResWithDefault), + other => return Err(format!("Call Builtin({other})")), + }; + PlanExpr::Call(callee, self.exprs(&call.args)?) + } + MirCallee::Intrinsic(i) => return Err(format!("Call Intrinsic({i:?})")), + MirCallee::LocalSlot { .. } => return Err("Call LocalSlot".into()), + } + } + MirExpr::TailCall(tc) => { + let idx = self + .layout + .fn_idx(tc.node.target) + .ok_or("TailCall (target has no wasm function)")?; + PlanExpr::TailCall(idx, self.exprs(&tc.node.args)?) + } + MirExpr::BinOp(b) => PlanExpr::BinOp( + bin_op(&b.node.op)?, + Box::new(self.expr(&b.node.lhs)?), + Box::new(self.expr(&b.node.rhs)?), + ), + MirExpr::Neg(_) => return Err("Neg (no Int negation helper template)".into()), + MirExpr::IfThenElse(ite) => PlanExpr::If( + Box::new(self.expr(&ite.node.cond)?), + Box::new(self.expr(&ite.node.then_branch)?), + Box::new(self.expr(&ite.node.else_branch)?), + ), + MirExpr::RecordCreate(r) => { + let rec = &r.node; + let (tid, declared) = self.types.record_tid(self.layout, &rec.type_name)?; + let written: Vec<&str> = rec.fields.iter().map(|f| f.name.as_str()).collect(); + if written != declared.iter().map(String::as_str).collect::>() { + return Err("RecordCreate (fields not in declared order)".into()); + } + let values: Vec> = + rec.fields.iter().map(|f| f.value.clone()).collect(); + PlanExpr::RecordCreate(tid, self.exprs(&values)?) + } + MirExpr::Project(p) => { + let base_ty = stamped(&p.node.base)?; + let (tid, declared) = self.types.record_tid(self.layout, &base_ty)?; + let field = declared + .iter() + .position(|f| f == &p.node.field) + .ok_or("Project (field not declared)")?; + PlanExpr::Project(tid, field as u32, Box::new(self.expr(&p.node.base)?)) + } + MirExpr::Match(m) => { + let subject = self.expr(&m.node.subject)?; + let mut arms = Vec::with_capacity(m.node.arms.len()); + for arm in &m.node.arms { + arms.push((self.pat(&arm.pattern)?, self.expr(&arm.body)?)); + } + PlanExpr::Match(Box::new(subject), arms) + } + MirExpr::Construct(c) => { + let ctor = self.ctor(&c.node.ctor)?; + let ty = self.ty(&stamped(expr)?)?; + PlanExpr::Construct(ctor, ty, self.exprs(&c.node.args)?) + } + MirExpr::InterpolatedStr(parts) => PlanExpr::Interp( + parts + .iter() + .map(|part| match part { + MirStrPart::Literal(s) => { + self.types.str_seg(self.layout, s.as_bytes())?; + Ok(PlanExpr::Literal(PlanLit::Str(s.as_bytes().to_vec()))) + } + MirStrPart::Expr(e) => self.expr(e), + }) + .collect::>()?, + ), + MirExpr::List(items) => { + if !items.is_empty() { + return Err("List (non-empty literal)".into()); + } + let ty = self.ty(&stamped(expr)?)?; + let PlanTy::List(elem) = ty else { + return Err("List (stamp is not a List)".into()); + }; + PlanExpr::List(*elem, Vec::new()) + } + other => return Err(node_name(other).to_string()), + }) + } +} + +/// Print one function. `extra_locals` is the emitter's declared locals vector +/// past the parameters, as the code entry declares it. +pub fn print_fn( + mir_fn: &MirFn, + rfd: &ResolvedFnDef, + extra_locals: &[wasm_encoder::ValType], + layout: &dyn PlanLayout, + types: &mut TypeTableBuilder, +) -> Result { + print_fn_inner(mir_fn, rfd, extra_locals, layout, types).map_err(clip) +} + +fn print_fn_inner( + mir_fn: &MirFn, + rfd: &ResolvedFnDef, + extra_locals: &[wasm_encoder::ValType], + layout: &dyn PlanLayout, + types: &mut TypeTableBuilder, +) -> Result { + if !mir_fn.effects.is_empty() { + return Err("fn declares effects".into()); + } + let repr = &mir_fn.repr; + if repr.bare_return + || !repr.bare_slots.is_empty() + || !repr.carrier_slots.is_empty() + || repr.bare_params.iter().any(|b| *b) + { + return Err("raw i64 slots (D5)".into()); + } + for (i, param) in mir_fn.params.iter().enumerate() { + if param.local.0 as usize != i { + return Err("parameter slots are not 0..n".into()); + } + } + let resolution = rfd.resolution.as_ref().ok_or("fn has no slot resolution")?; + let slot_types = resolution.local_slot_types.as_ref(); + let nparams = rfd.params.len(); + if nparams != mir_fn.params.len() || slot_types.len() < nparams { + return Err("parameter count mismatch".into()); + } + let mut printer = Printer { layout, types }; + let params = rfd + .params + .iter() + .map(|(_, t)| printer.ty(&t.display())) + .collect::, _>>()?; + let ret = printer.ty(&rfd.return_type.display())?; + let nslots = slot_types.len(); + let mut locals = Vec::with_capacity(extra_locals.len()); + for (j, vt) in extra_locals.iter().enumerate() { + let slot = nparams + j; + let ty = if slot < nslots { + let t = &slot_types[slot]; + let text = t.display(); + match text.as_str() { + // An `i32` placeholder the emitter keeps for index alignment. + "Unit" | "Invalid" => PlanTy::Bool, + _ => printer.ty(&text)?, + } + } else { + scratch_ty(vt, printer.types).ok_or("scratch local of an unprintable type")? + }; + locals.push(ty); + } + let body = printer.expr(&mir_fn.body)?; + Ok(FnPlan { + params, + ret, + nslots: nslots as u32, + locals, + body, + }) +} + +/// A scratch local (past the resolver slots) by its declared wasm type: the +/// subject scratch `eqref`, an Int carrier scratch, or an `i32`. +fn scratch_ty(vt: &wasm_encoder::ValType, types: &TypeTableBuilder) -> Option { + use wasm_encoder::{AbstractHeapType, HeapType, ValType}; + match vt { + ValType::I32 => Some(PlanTy::Bool), + ValType::F64 => Some(PlanTy::Float), + ValType::Ref(rt) if rt.nullable => match rt.heap_type { + HeapType::Abstract { + ty: AbstractHeapType::Eq, + shared: false, + } => Some(PlanTy::Eqref), + HeapType::Concrete(idx) if Some(idx) == types.table.carrier => Some(PlanTy::Int), + HeapType::Concrete(idx) if Some(idx) == types.table.str_ => Some(PlanTy::Str), + _ => None, + }, + _ => None, + } +} + +/// Print every emitted user function. `fns` lists, per user function, its +/// wasm function index, its MIR (when it lowered), its resolved definition +/// and its declared extra locals. +pub fn print_module( + fns: &[( + u32, + Option<&MirFn>, + &ResolvedFnDef, + Option<&[wasm_encoder::ValType]>, + )], + layout: &dyn PlanLayout, + aint_eq_idx: Option, +) -> ModulePlans { + let mut types = TypeTableBuilder::new(layout); + let mut out = Vec::with_capacity(fns.len()); + for (func_idx, mir_fn, rfd, extra) in fns { + let plan = match (mir_fn, extra) { + (Some(mir_fn), Some(extra)) => print_fn(mir_fn, rfd, extra, layout, &mut types), + _ => Err("fn has no MIR body (trap stub)".to_string()), + }; + out.push(PlannedFn { + name: rfd.name.clone(), + func_idx: *func_idx, + plan, + }); + } + ModulePlans { + fns: out, + types: types.finish(), + aint_eq_idx, + } +} + +#[cfg(test)] +mod tests { + use super::*; + + #[test] + fn type_strings_parse_into_trees() { + let t = parse_ty("Result, (Int, String)>").expect("parses"); + assert_eq!(t.canonical(), "Result,Tuple>"); + assert_eq!( + parse_ty("Map").unwrap().canonical(), + "Map" + ); + assert!(parse_ty("Option (HashMap>, PlanTypeTable) { + let mut items = crate::source::parse_source(src).expect("parse"); + use crate::ir::{PipelineConfig, TypecheckMode}; + let result = crate::ir::pipeline::run( + &mut items, + PipelineConfig { + typecheck: Some(TypecheckMode::Full { base_dir: None }), + run_interp_lower: false, + run_buffer_build: false, + ..Default::default() + }, + ); + if let Some(tc) = &result.typecheck { + assert!(tc.errors.is_empty(), "typecheck: {:?}", tc.errors); + } + let out = crate::codegen::wasm_gc::compile_to_wasm_gc_with_handler_and_cert_plans( + &items, None, None, + ) + .expect("compile"); + let map = out + .cert_plans + .fns + .into_iter() + .map(|f| (f.name, f.plan)) + .collect(); + (map, out.cert_plans.types) + } + + fn plan(map: &HashMap>, name: &str) -> FnPlan { + map.get(name) + .unwrap_or_else(|| panic!("no fn {name}")) + .clone() + .unwrap_or_else(|reason| panic!("{name} declined: {reason}")) + } + + fn reason(map: &HashMap>, name: &str) -> String { + match map.get(name).unwrap_or_else(|| panic!("no fn {name}")) { + Ok(_) => panic!("{name} was printed"), + Err(reason) => reason.clone(), + } + } + + const SRC: &str = r#" +module P + intent = "printer probes" + exposes [lit, add, cmpLit, andOr, named, pick, callee, caller, tail, mk, get, isNone, opt, shape, circle, area, greet, strMatch, intMatch, empty, pair, neg, divide, effectful, lst] + effects [Console] + +record Point + x: Int + y: Int + +type Shape + Circle(Int) + Square(Int) + +fn lit() -> Int + 7 + +fn add(a: Int, b: Int) -> Int + a + b + +fn cmpLit(a: Int) -> Bool + a > 5 + +fn andOr(p: Bool, q: Bool) -> Bool + Bool.or(Bool.and(p, q), Bool.not(p)) + +fn named(n: Int) -> Int + m = n + 2 + m * m + +fn pick(b: Bool, x: Int, y: Int) -> Int + match b + true -> x + false -> y + +fn callee(x: Int) -> Int + x + 1 + +fn caller(x: Int) -> Int + callee(callee(x)) + +fn tail(n: Int, acc: Int) -> Int + match n <= 0 + true -> acc + false -> tail(n - 1, acc + n) + +fn mk(a: Int, b: Int) -> Point + Point(x = a, y = b) + +fn get(p: Point) -> Int + p.y + +fn isNone(o: Option) -> Bool + match o + Option.Some(_) -> false + Option.None -> true + +fn opt(o: Option) -> Int + Option.withDefault(o, 0) + +fn circle(r: Int) -> Shape + Shape.Circle(r) + +fn area(s: Shape) -> Int + match s + Shape.Circle(r) -> r * r + Shape.Square(w) -> w * w + +fn shape(s: Shape) -> Bool + match s + Shape.Circle(_) -> true + _ -> false + +fn greet(name: String) -> String + "Hello, {name}" + +fn strMatch(s: String) -> String + match s + "ab" -> "b" + _ -> s + +fn intMatch(n: Int) -> Int + match n + 0 -> 10 + 1 -> 11 + _ -> 12 + +fn empty() -> List + [] + +fn pair(t: Tuple) -> Int + match t + (a, _) -> a + +fn neg(x: Int) -> Int + -x + +fn divide(a: Float, b: Float) -> Float + a / b + +fn effectful() -> Unit + ! [Console.print] + Console.print("x") + +fn lst(xs: List) -> Int + match xs + [] -> 0 + [h, ..t] -> h +"#; + + #[test] + fn every_admitted_node_prints_one_to_one() { + let (map, types) = plans(SRC); + use PlanExpr as E; + let l = E::Local; + let int = |k: i64| E::Literal(PlanLit::Int(k)); + let bin = |op, a, b| E::BinOp(op, Box::new(a), Box::new(b)); + assert_eq!(plan(&map, "lit").body, int(7)); + let add = plan(&map, "add"); + assert_eq!(add.params, [PlanTy::Int, PlanTy::Int]); + assert_eq!(add.body, bin(PlanBinOp::Add, l(0), l(1))); + assert_eq!(plan(&map, "cmpLit").body, bin(PlanBinOp::Gt, l(0), int(5))); + assert!(matches!( + plan(&map, "andOr").body, + E::Call(PlanCallee::Builtin(PlanBuiltin::BoolOr), _) + )); + assert!(matches!(plan(&map, "named").body, E::Let(1, _, _))); + assert!(matches!(plan(&map, "pick").body, E::If(..) | E::Match(..))); + let caller = plan(&map, "caller"); + let E::Call(PlanCallee::Fn(callee_idx), args) = &caller.body else { + panic!("caller body: {:?}", caller.body) + }; + assert!(matches!(&args[0], E::Call(PlanCallee::Fn(i), _) if i == callee_idx)); + assert!(format!("{:?}", plan(&map, "tail").body).contains("TailCall")); + assert!(matches!(plan(&map, "mk").body, E::RecordCreate(_, ref fs) if fs.len() == 2)); + assert!(matches!(plan(&map, "get").body, E::Project(_, 1, _))); + assert!(matches!( + plan(&map, "isNone").body, + E::Match(_, ref arms) if matches!(arms[0].0, PlanPat::Ctor(PlanCtor::Some, _)) + )); + assert!(matches!( + plan(&map, "opt").body, + E::Call(PlanCallee::Lazy(PlanLazy::OptWithDefault), _) + )); + assert!(matches!( + plan(&map, "circle").body, + E::Construct(PlanCtor::User(_, 0), PlanTy::Sum(_), _) + )); + let area = plan(&map, "area"); + assert!(matches!(area.body, E::Match(_, ref arms) if arms.len() == 2)); + assert!( + area.locals.contains(&PlanTy::Eqref), + "subject scratch declared" + ); + assert!(matches!( + plan(&map, "greet").body, + E::Interp(ref parts) if parts.len() == 2 + )); + assert!(matches!( + plan(&map, "strMatch").body, + E::Match(_, ref arms) if matches!(arms[0].0, PlanPat::LitStr(_)) + )); + assert!(matches!( + plan(&map, "intMatch").body, + E::Match(_, ref arms) if arms[0].0 == PlanPat::LitInt(0) && arms[2].0 == PlanPat::Wild + )); + assert_eq!(plan(&map, "empty").body, E::List(PlanTy::Int, vec![])); + assert!(matches!( + plan(&map, "pair").body, + E::Match(_, ref arms) if matches!(arms[0].0, PlanPat::Tuple(ref bs) if bs[1] == PLAN_NO_SLOT) + )); + // The type table names what the plans cite, from the emitter's registry. + assert!(types.carrier.is_some() && types.str_.is_some()); + assert!( + types + .records + .iter() + .any(|r| r.fields == [PlanTy::Int, PlanTy::Int]) + ); + assert!(types.sums.iter().any(|s| s.ctors.len() == 2)); + assert!(types.str_segs.iter().any(|(b, _)| b == b"Hello, ")); + } + + #[test] + fn unadmitted_nodes_decline_by_name() { + let (map, _) = plans(SRC); + assert_eq!(reason(&map, "neg"), "Neg (no Int negation helper template)"); + assert_eq!(reason(&map, "divide"), "BinOp Div"); + assert_eq!(reason(&map, "effectful"), "fn declares effects"); + assert_eq!(reason(&map, "lst"), "Match pattern EmptyList"); + } +} diff --git a/src/codegen/wasm_gc/cert_layout.rs b/src/codegen/wasm_gc/cert_layout.rs new file mode 100644 index 000000000..4b168fbad --- /dev/null +++ b/src/codegen/wasm_gc/cert_layout.rs @@ -0,0 +1,147 @@ +//! The emitter's view the certificate plan printer reads +//! (`crate::codegen::cert::PlanLayout`): the type registry, the symbol table, +//! the function index map and the interned builtin names of the SAME compile, +//! so every index a printed plan cites is the one the emitter wrote. + +use std::collections::HashMap; + +use crate::codegen::cert::{PlanLayout, RecordLayout, SumLayout}; +use crate::ir::{BuiltinId, CtorId, FnId, SymbolTable}; + +use super::types::TypeRegistry; + +pub(super) struct CertLayout<'a> { + pub(super) registry: &'a TypeRegistry, + pub(super) symbol_table: &'a SymbolTable, + pub(super) fn_idx: HashMap, + pub(super) builtins: &'a [String], +} + +impl CertLayout<'_> { + /// The sum type entry declared under `name` (exact, then the bare name), + /// when exactly one sum carries it. + fn sum_entry(&self, name: &str) -> Option<&crate::ir::TypeEntry> { + let find = |wanted: &str| { + let mut hits = self + .symbol_table + .types + .iter() + .filter(|t| !t.is_product && !t.variants.is_empty() && t.key.name == wanted); + let first = hits.next()?; + hits.next().is_none().then_some(first) + }; + find(name).or_else(|| name.rsplit_once('.').and_then(|(_, bare)| find(bare))) + } +} + +impl PlanLayout for CertLayout<'_> { + fn carrier(&self) -> Option { + if self.registry.bignum { + self.registry.aint_struct_idx + } else { + None + } + } + + fn mag(&self) -> Option { + self.registry.aint_mag_array_idx + } + + fn string_array(&self) -> Option { + self.registry.string_array_type_idx + } + + fn string_segment(&self, bytes: &[u8]) -> Option { + self.registry.string_literal_segment(bytes) + } + + fn option(&self, canonical: &str) -> Option { + self.registry.option_type_idx(canonical) + } + + fn result(&self, canonical: &str) -> Option { + self.registry.result_type_idx(canonical) + } + + fn vector(&self, canonical: &str) -> Option { + self.registry.vector_type_idx(canonical) + } + + fn list(&self, canonical: &str) -> Option { + self.registry.list_type_idx(canonical) + } + + fn tuple(&self, canonical: &str) -> Option { + self.registry.tuple_type_idx(canonical) + } + + fn map(&self, canonical: &str) -> Option { + self.registry.map_slots(canonical).map(|slots| slots.map) + } + + fn special(&self, name: &str) -> bool { + let registry = self.registry; + registry.packed_sequence(name).is_some() + || registry.is_eligible_carrier(name) + || registry.is_capability_resource(name) + || (self.sum_entry(name).is_some() && registry.newtype_underlying(name).is_some()) + } + + fn record(&self, name: &str) -> Option { + let registry = self.registry; + let canonical = registry.canonical_type_name(name); + let fields = registry.record_fields.get(canonical).or_else(|| { + canonical + .rsplit_once('.') + .and_then(|(_, bare)| registry.record_fields.get(bare)) + })?; + if fields + .iter() + .any(|(field, _)| registry.is_eligible_carrier_field(canonical, field)) + { + return None; + } + let struct_idx = if registry.newtype_underlying(canonical).is_some() { + None + } else { + Some(registry.record_type_idx(canonical)?) + }; + Some(RecordLayout { + struct_idx, + fields: fields.clone(), + }) + } + + fn sum(&self, name: &str) -> Option { + let registry = self.registry; + let canonical = registry.canonical_type_name(name); + let entry = self.sum_entry(canonical)?; + let parent = entry.key.name.as_str(); + let root = registry.sum_root_type_idx(parent)?; + let mut ctors = Vec::with_capacity(entry.variants.len()); + for ctor in &entry.variants { + let ctor_name = self.symbol_table.ctor_entry(*ctor).name.as_str(); + let info = registry.variant_in(parent, ctor_name)?; + ctors.push((info.type_idx, info.fields.clone())); + } + Some(SumLayout { root, ctors }) + } + + fn user_ctor(&self, ctor: CtorId) -> Option<(String, u32)> { + let entry = self.symbol_table.ctor_entry(ctor); + let owner = self.symbol_table.type_entry(entry.owning_type); + if owner.is_product { + return None; + } + let index = owner.variants.iter().position(|c| *c == ctor)?; + Some((owner.key.name.clone(), index as u32)) + } + + fn fn_idx(&self, f: FnId) -> Option { + self.fn_idx.get(&f).copied() + } + + fn builtin_name(&self, b: BuiltinId) -> Option { + self.builtins.get(b.0 as usize).cloned() + } +} diff --git a/src/codegen/wasm_gc/mod.rs b/src/codegen/wasm_gc/mod.rs index ef57be682..1679a3dce 100644 --- a/src/codegen/wasm_gc/mod.rs +++ b/src/codegen/wasm_gc/mod.rs @@ -63,6 +63,7 @@ mod bytes_bridge; mod capability_abi; mod capability_imports; mod capability_plan; +mod cert_layout; pub(crate) mod effects; mod flatten; mod jobs; @@ -74,9 +75,6 @@ mod packed_sequences; #[cfg(test)] mod tests; mod types; -pub mod work_abi; -mod work_manifest; -pub(crate) use types::{OPTION_SOME_TAG, RESULT_OK_TAG}; mod types_discovery; mod view; mod wasip2_capability_imports; @@ -88,6 +86,8 @@ mod wasip2_http_handler; mod wasip2_imports; mod wasip2_tcp; mod wat_helper; +pub mod work_abi; +mod work_manifest; pub use body::{CoverageReport, coverage_report}; pub use capability_plan::{ @@ -144,7 +144,7 @@ impl std::error::Error for WasmGcError {} pub struct WasmGcCompileOutput { pub bytes: Vec, pub mir_count: usize, - pub fragment_plans: Vec, + pub cert_plans: crate::codegen::cert::ModulePlans, } /// Compile post-pipeline IR (`items`) to a WebAssembly GC module @@ -231,10 +231,10 @@ pub fn compile_to_wasm_gc_flattened_with_options( None, packed_sequences_enabled, ) - .map(|(bytes, mir_count, fragment_plans)| WasmGcCompileOutput { + .map(|(bytes, mir_count, cert_plans)| WasmGcCompileOutput { bytes, mir_count, - fragment_plans, + cert_plans, }) } @@ -256,10 +256,10 @@ pub fn compile_to_wasm_gc_flattened_with_capabilities( None, true, ) - .map(|(bytes, mir_count, fragment_plans)| WasmGcCompileOutput { + .map(|(bytes, mir_count, cert_plans)| WasmGcCompileOutput { bytes, mir_count, - fragment_plans, + cert_plans, }) } @@ -279,10 +279,10 @@ pub fn compile_to_wasm_gc_with_handler_and_cert_plans( None, true, ) - .map(|(bytes, mir_count, fragment_plans)| WasmGcCompileOutput { + .map(|(bytes, mir_count, cert_plans)| WasmGcCompileOutput { bytes, mir_count, - fragment_plans, + cert_plans, }) } @@ -333,10 +333,10 @@ pub fn compile_to_wasm_gc_flattened_with_custom_capabilities( Some(capabilities), packed_sequences_enabled, ) - .map(|(bytes, mir_count, fragment_plans)| WasmGcCompileOutput { + .map(|(bytes, mir_count, cert_plans)| WasmGcCompileOutput { bytes, mir_count, - fragment_plans, + cert_plans, }) } diff --git a/src/codegen/wasm_gc/module.rs b/src/codegen/wasm_gc/module.rs index 9f7cf3c42..e1dbb332c 100644 --- a/src/codegen/wasm_gc/module.rs +++ b/src/codegen/wasm_gc/module.rs @@ -148,14 +148,7 @@ pub(super) fn emit_module_with( capability_wit_plan: Option<&crate::codegen::wasip2::CapabilityWitPlan>, capability_wasm_gc_plan: Option<&super::CapabilityWasmGcPlan>, packed_sequences_enabled: bool, -) -> Result< - ( - Vec, - usize, - Vec, - ), - WasmGcError, -> { +) -> Result<(Vec, usize, crate::codegen::cert::ModulePlans), WasmGcError> { let fn_defs: Vec<&FnDef> = items .iter() .filter_map(|it| match it { @@ -3141,9 +3134,6 @@ pub(super) fn emit_module_with( // // `mir_fn_for[i]` is `Some(&MirFn)` when the i-th fn lowered to // MIR (always true on valid input — every resolved fn lowers). - // `fragment_plan_for[i]` is the certificate producer's plan for the - // i-th fn, handed to `--certify` as input only: it never steers the - // bytes, and the producer declines a plan that does not match them. // `mir_dispatch[i]` is the final per-fn non-stub decision: `true` // when the MIR body emitter rendered the fn, `false` when the fn got // a trap-stub body. It is computed once in @@ -3154,19 +3144,6 @@ pub(super) fn emit_module_with( .iter() .map(|rfd| mir_program.fn_by_id(rfd.fn_id)) .collect(); - // Record layout resolver for the certificate plan producer: field name -> - // (declared field index, field source type). Newtypes/carriers return - // `None` (their field reads are identity, not `struct.get`), so they never - // plan a projection the emitter does not emit. - let record_field_lookup = |record: &str, field: &str| -> Option<(u32, String)> { - if registry.newtype_underlying(record).is_some() { - return None; - } - registry.record_type_idx(record)?; - let idx = registry.record_field_index(record, field)?; - let ty = registry.record_field_type(record, field)?.to_string(); - Some((idx, ty)) - }; // A trap stub is the right answer for a shape the MIR body emitter does // not cover — the fn lowered, and the module still ships. It is the // wrong answer for a fn that never lowered because a name inside it did @@ -3190,23 +3167,6 @@ pub(super) fn emit_module_with( } } - let fragment_plan_for: Vec> = - if registry.aint_struct_idx.is_some() { - mir_fn_for - .iter() - .map(|mir_fn| { - mir_fn.and_then(|mir_fn| { - crate::codegen::cert::fragment_plan_from_mir_fn( - mir_fn, - &record_field_lookup, - &mir_program.builtins, - ) - }) - }) - .collect() - } else { - vec![None; fn_defs.len()] - }; let mut mir_dispatch: Vec = vec![false; fn_defs.len()]; // Pre-pass over user fn bodies — populates `caller_fn_collector` @@ -3695,6 +3655,9 @@ pub(super) fn emit_module_with( codes.function(&start); } + // The declared locals of every MIR-emitted fn, for the certificate plan + // printer (which transcribes them; the code entry pins them). + let mut extra_locals_for: Vec>> = vec![None; fn_defs.len()]; for (i, _fd) in fn_defs.iter().enumerate() { let self_wasm_idx = import_count + 1 + (i as u32); // Dry run: discover extra locals by emitting into a throwaway @@ -3733,6 +3696,7 @@ pub(super) fn emit_module_with( }; let local_groups: Vec<(u32, ValType)> = extra_locals_dry.iter().map(|v| (1, *v)).collect(); + extra_locals_for[i] = mir_dispatch[i].then(|| extra_locals_dry.clone()); let mut func = Function::new(local_groups); if mir_dispatch[i] { emit_fn_body_via_mir( @@ -6094,18 +6058,37 @@ pub(super) fn emit_module_with( if std::env::var_os("AVER_WASMGC_MIR_COUNT").is_some() { eprintln!("AVER_WASMGC_MIR_EMITTED={mir_emitted}"); } - let fragment_plans = fragment_plan_for + // The certificate plans: every emitted user fn's MIR printed 1:1 against + // the registry and function indices of THIS compile. Read-only: printing + // never changes a byte. + let cert_layout = super::cert_layout::CertLayout { + registry: ®istry, + symbol_table: &symbol_table, + fn_idx: resolved_fn_defs + .iter() + .enumerate() + .map(|(i, rfd)| (rfd.fn_id, import_count + 1 + i as u32)) + .collect(), + builtins: &mir_program.builtins, + }; + let planned: Vec<_> = resolved_fn_defs .iter() .enumerate() - .filter_map(|(i, plan)| { - plan.clone() - .map(|plan| crate::codegen::cert::FragmentPlanArtifact { - export_name: resolved_fn_defs[i].name.clone(), - plan, - }) + .map(|(i, rfd)| { + ( + import_count + 1 + i as u32, + mir_fn_for[i], + rfd, + extra_locals_for[i].as_deref(), + ) }) .collect(); - Ok((bytes, mir_emitted, fragment_plans)) + let cert_plans = crate::codegen::cert::print_module( + &planned, + &cert_layout, + registry.aint_eq_fn_idx.filter(|_| registry.bignum), + ); + Ok((bytes, mir_emitted, cert_plans)) } fn emit_user_types( diff --git a/src/main/commands.rs b/src/main/commands.rs index f3a8386ab..e37765a3c 100644 --- a/src/main/commands.rs +++ b/src/main/commands.rs @@ -7028,15 +7028,12 @@ fn cmd_compile_wasm_gc( .and_then(|name| name.to_str()) .expect("generated wasm file name is UTF-8"); if let Err(error) = emit_artifact_certificate( - file, - project_name, - module_root_override, out_path, aver::codegen::cert::CertificateArtifact::WasmGc { file_name: artifact_file_name, module_bytes: &bytes, }, - &wasm_gc_output.fragment_plans, + &wasm_gc_output.cert_plans, ) { eprintln!("{}", format!("certificate: {error}").red()); process::exit(1); @@ -7282,64 +7279,26 @@ fn render_wasmtime_runtime_policy( .map_err(|error| format!("serialize Wasmtime runtime policy: {error}")) } -/// Emit the Stage-B artifact certificate: classify the emitted module, -/// reuse the `aver proof` Lean model emission, and write `cert/`. +/// Emit the artifact certificate: check the compiler's printed plans against +/// the emitted module and write `cert/`. /// /// Gated on `certify` (the aver-cert producer engine + `codegen::cert`). Both /// wasm-gc and wasip2 call this with an explicit description of the delivered -/// artifact and the core-module bytes consumed by the existing Wasm wall. +/// artifact and the core-module bytes consumed by the Wasm wall. The plans are +/// the optimized MIR the emitter consumed in the same compile. #[cfg(feature = "certify")] fn emit_artifact_certificate( - file: &str, - project_name: Option<&str>, - module_root_override: Option<&str>, out_path: &Path, artifact: aver::codegen::cert::CertificateArtifact<'_>, - fragment_plans: &[aver::codegen::cert::FragmentPlanArtifact], + cert_plans: &aver::codegen::cert::ModulePlans, ) -> Result<(), String> { use aver::codegen::cert; + // Schema 9 states every obligation over the plan and carries no + // law-claims or source bridges yet, so no Lean model is emitted. - // Reuse the `aver proof` Lean model emission for the model definitions. - // Built before `analyze` so the recursion classifier can read the combinator - // operator (`+`/`*`) from the model. - let (mut mctx, _mroot) = build_codegen_context( - file, - project_name, - module_root_override, - false, - &super::cli::CompilePolicyMode::Embed, - None, - false, - false, // apply_traversal_lowering — model wants source-level IR - true, // run_refinement_lower - true, // run_contract_lower - true, // run_law_lower - ); - let model_out = lean_codegen::transpile_for_cert_model(&mut mctx); - - let analysis = cert::analyze_for_target_with_fragment_plans( - artifact.core_module_bytes(), - &model_out.files, - fragment_plans, - artifact.target(), - )?; + let analysis = cert::analyze(artifact.core_module_bytes(), cert_plans, artifact.target())?; let artifact_file_name = artifact.file_name().to_string(); - - // Law-claims travel as STRUCTURE from the emitter that built each law - // theorem's statement to the package renderer — the producer never scans - // the emitted Lean text back for them. - let law_claims: Vec = model_out - .law_claims - .iter() - .map(|claim| cert::LawClaim { - label: claim.label.clone(), - prefix: claim.namespace.clone(), - theorem: claim.theorem.clone(), - statement: claim.statement.clone(), - }) - .collect(); - let declines = - cert::write_project(out_path, artifact, &analysis, &model_out.files, law_claims)?; + let declines = cert::write_project(out_path, artifact, &analysis, Vec::new())?; let cert_dir = out_path.join("cert"); let certified = analysis.certified_names(); @@ -7353,17 +7312,9 @@ fn emit_artifact_certificate( if !certified.is_empty() { println!(" certified: {}", certified.join(", ")); } - // A law-claim the package renderer refused is said out loud rather than - // dropped in silence: the law is still proved in the model modules, it - // just does not enter the certificate's claimed surface. for (label, reason) in &declines.law_claims { println!(" law-claim declined: {label} — {reason}"); } - // Same treatment for a record projection-compute export whose plan the - // producer could not identify with a source function: the export stays - // certified, its certified model just stays the plan. The same list also - // goes into the package as `sourceBridgesDeclined`, so the reason survives - // this terminal and `aver cert explain` can print it back. for (export, reason) in &declines.source_bridges { println!(" source-bridge declined: {export} — {reason}"); } @@ -7709,9 +7660,6 @@ fn cmd_compile_wasip2( .expect("generated component file name is UTF-8"); let envelope = component_artifact.envelope.declaration(); if let Err(error) = emit_artifact_certificate( - file, - project_name, - module_root_override, out_path, aver::codegen::cert::CertificateArtifact::Wasip2 { file_name: artifact_file_name, @@ -7719,7 +7667,7 @@ fn cmd_compile_wasip2( embedded_core_module: &component_artifact.envelope.embedded_core_module, envelope, }, - &wasm_gc_output.fragment_plans, + &wasm_gc_output.cert_plans, ) { eprintln!("{}", format!("certificate: {error}").red()); process::exit(1); From 182c8d235eb9eba9222ec34522ff77349d610908 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 03:44:05 +0200 Subject: [PATCH 15/89] cert: delete the family producer The byte classifiers, the per-family plan definitions and renderers, the family-keyed rederivation, the sym/expression-fragment plan IR with its byte lowering, the model evaluator and the record-compute bridge producer are unreachable now that every certified function is its printed MIR plan. The MIR-to-fragment adapter in `src/codegen/cert` goes with them, and `aver-cert` no longer needs `wasm-encoder`. Co-Authored-By: Claude Opus 5.5 (1M context) --- Cargo.lock | 1 - aver-cert/Cargo.toml | 10 +- aver-cert/src/engine/analysis.rs | 1875 -------- aver-cert/src/engine/cert_defs.rs | 404 -- aver-cert/src/engine/cert_methods.rs | 451 -- aver-cert/src/engine/classification.rs | 11 - aver-cert/src/engine/classify_basic.rs | 190 - aver-cert/src/engine/classify_composition.rs | 169 - aver-cert/src/engine/classify_entry.rs | 235 - .../src/engine/classify_expr_fragment.rs | 3 - .../src/engine/classify_expr_fragment_lift.rs | 387 -- .../engine/classify_expr_fragment_lower.rs | 399 -- .../classify_expr_fragment_lower_ops.rs | 210 - .../classify_expr_fragment_plan_check.rs | 537 --- aver-cert/src/engine/classify_model.rs | 182 - aver-cert/src/engine/classify_recursion.rs | 307 -- aver-cert/src/engine/classify_structural.rs | 148 - .../src/engine/classify_variant_dispatch.rs | 150 - aver-cert/src/engine/classify_verbatim.rs | 349 -- aver-cert/src/engine/composition_plan_defs.rs | 212 - aver-cert/src/engine/construct_plan_defs.rs | 217 - aver-cert/src/engine/core_shapes.rs | 73 - aver-cert/src/engine/core_wasm.rs | 316 -- aver-cert/src/engine/declared_envelope.rs | 459 -- aver-cert/src/engine/disasm.rs | 4 - aver-cert/src/engine/disasm_hosts.rs | 275 -- aver-cert/src/engine/disasm_module.rs | 829 ---- aver-cert/src/engine/expr_fragment_defs.rs | 1082 ----- aver-cert/src/engine/expr_fragment_faces.rs | 921 ---- .../src/engine/field_projection_plan_defs.rs | 138 - .../src/engine/int_dispatch_plan_defs.rs | 669 --- aver-cert/src/engine/model_eval.rs | 620 --- aver-cert/src/engine/mutual_plan_defs.rs | 229 - aver-cert/src/engine/recursion_plan_defs.rs | 472 -- aver-cert/src/engine/rederive.rs | 590 --- aver-cert/src/engine/render.rs | 11 - aver-cert/src/engine/render_certificate.rs | 86 - aver-cert/src/engine/render_code.rs | 2 - aver-cert/src/engine/render_code_instrs.rs | 161 - aver-cert/src/engine/render_code_tables.rs | 211 - aver-cert/src/engine/render_composition.rs | 430 -- aver-cert/src/engine/render_expr_fragment.rs | 592 --- .../src/engine/render_expr_fragment_bridge.rs | 459 -- aver-cert/src/engine/render_integer.rs | 1 - aver-cert/src/engine/render_manifest.rs | 1004 ----- aver-cert/src/engine/render_model_support.rs | 321 -- aver-cert/src/engine/render_mutual.rs | 382 -- aver-cert/src/engine/render_project.rs | 3883 ----------------- .../src/engine/render_recursion_bridge.rs | 287 -- .../src/engine/render_side_conditions.rs | 280 -- aver-cert/src/engine/source_bridges.rs | 540 --- aver-cert/src/engine/string_plan_defs.rs | 708 --- aver-cert/src/engine/sym_plan_defs.rs | 1229 ------ aver-cert/src/engine/sym_plan_encode.rs | 469 -- aver-cert/src/engine/sym_plan_render.rs | 182 - aver-cert/src/engine/verbatim_plan_defs.rs | 578 --- src/codegen/cert/expr_fragment_from_mir.rs | 2184 --------- 57 files changed, 4 insertions(+), 27120 deletions(-) delete mode 100644 aver-cert/src/engine/analysis.rs delete mode 100644 aver-cert/src/engine/cert_defs.rs delete mode 100644 aver-cert/src/engine/cert_methods.rs delete mode 100644 aver-cert/src/engine/classification.rs delete mode 100644 aver-cert/src/engine/classify_basic.rs delete mode 100644 aver-cert/src/engine/classify_composition.rs delete mode 100644 aver-cert/src/engine/classify_entry.rs delete mode 100644 aver-cert/src/engine/classify_expr_fragment.rs delete mode 100644 aver-cert/src/engine/classify_expr_fragment_lift.rs delete mode 100644 aver-cert/src/engine/classify_expr_fragment_lower.rs delete mode 100644 aver-cert/src/engine/classify_expr_fragment_lower_ops.rs delete mode 100644 aver-cert/src/engine/classify_expr_fragment_plan_check.rs delete mode 100644 aver-cert/src/engine/classify_model.rs delete mode 100644 aver-cert/src/engine/classify_recursion.rs delete mode 100644 aver-cert/src/engine/classify_structural.rs delete mode 100644 aver-cert/src/engine/classify_variant_dispatch.rs delete mode 100644 aver-cert/src/engine/classify_verbatim.rs delete mode 100644 aver-cert/src/engine/composition_plan_defs.rs delete mode 100644 aver-cert/src/engine/construct_plan_defs.rs delete mode 100644 aver-cert/src/engine/core_shapes.rs delete mode 100644 aver-cert/src/engine/core_wasm.rs delete mode 100644 aver-cert/src/engine/declared_envelope.rs delete mode 100644 aver-cert/src/engine/disasm.rs delete mode 100644 aver-cert/src/engine/disasm_hosts.rs delete mode 100644 aver-cert/src/engine/disasm_module.rs delete mode 100644 aver-cert/src/engine/expr_fragment_defs.rs delete mode 100644 aver-cert/src/engine/expr_fragment_faces.rs delete mode 100644 aver-cert/src/engine/field_projection_plan_defs.rs delete mode 100644 aver-cert/src/engine/int_dispatch_plan_defs.rs delete mode 100644 aver-cert/src/engine/model_eval.rs delete mode 100644 aver-cert/src/engine/mutual_plan_defs.rs delete mode 100644 aver-cert/src/engine/recursion_plan_defs.rs delete mode 100644 aver-cert/src/engine/rederive.rs delete mode 100644 aver-cert/src/engine/render.rs delete mode 100644 aver-cert/src/engine/render_certificate.rs delete mode 100644 aver-cert/src/engine/render_code.rs delete mode 100644 aver-cert/src/engine/render_code_instrs.rs delete mode 100644 aver-cert/src/engine/render_code_tables.rs delete mode 100644 aver-cert/src/engine/render_composition.rs delete mode 100644 aver-cert/src/engine/render_expr_fragment.rs delete mode 100644 aver-cert/src/engine/render_expr_fragment_bridge.rs delete mode 100644 aver-cert/src/engine/render_integer.rs delete mode 100644 aver-cert/src/engine/render_manifest.rs delete mode 100644 aver-cert/src/engine/render_model_support.rs delete mode 100644 aver-cert/src/engine/render_mutual.rs delete mode 100644 aver-cert/src/engine/render_project.rs delete mode 100644 aver-cert/src/engine/render_recursion_bridge.rs delete mode 100644 aver-cert/src/engine/render_side_conditions.rs delete mode 100644 aver-cert/src/engine/source_bridges.rs delete mode 100644 aver-cert/src/engine/string_plan_defs.rs delete mode 100644 aver-cert/src/engine/sym_plan_defs.rs delete mode 100644 aver-cert/src/engine/sym_plan_encode.rs delete mode 100644 aver-cert/src/engine/sym_plan_render.rs delete mode 100644 aver-cert/src/engine/verbatim_plan_defs.rs delete mode 100644 src/codegen/cert/expr_fragment_from_mir.rs 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/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/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/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/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/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_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 deleted file mode 100644 index fbe8f45e7..000000000 --- a/aver-cert/src/engine/source_bridges.rs +++ /dev/null @@ -1,540 +0,0 @@ -// 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. -// -// 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. -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, -}; - -/// 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. -#[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. - pub model: String, - /// Parameter encoders in declaration order. - pub params: Vec, - /// Result encoder. - pub result: SourceEncoder, -} - -/// Lean namespace every bridge theorem, corollary and helper lemma 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. - pub fn statement(&self) -> String { - render_bridge_statement(&self.export, &self.model, &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) - ) -} - -/// 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. -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) - || !is_plain_dotted_name(&bridge.model) - { - return false; - } - if bridge.theorem != SourceBridge::theorem_name(&bridge.export) - || bridge.corollary != SourceBridge::corollary_name(&bridge.export) - { - return false; - } - if !bridge - .params - .iter() - .chain(std::iter::once(&bridge.result)) - .all(SourceEncoder::is_well_formed) - { - return false; - } - let statement = bridge.statement(); - statement_is_single_plain_line(&statement, MAX_BRIDGE_STATEMENT_LEN) - && 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") { - 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, - }) - } - } -} - -/// 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()); - }; - 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()); - }; - if sig.params.len() != plan.params.len() { - return Err(format!( - "source arity {} does not match the plan's {}", - sig.params.len(), - plan.params.len() - )); - } - 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)" - )); - }; - if !encoder_matches(&encoding, plan.params[index]) { - return Err(format!( - "parameter {index} source type `{written}` does not match the plan's type" - )); - } - params.push(encoding); - } - 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 - )); - } - // 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()); - }; - 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 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, - }; - if !bridge_survives_checker_gates(&bridge_plan.bridge) { - return Err( - "statement or identifiers would be refused by the checker's source-bridge gates".into(), - ); - } - Ok(bridge_plan) -} - -/// 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; - } - match bridge_plan_for(c, index, model_info) { - Ok(plan) => planned.push(plan), - Err(reason) => declined.push((c.name().to_string(), reason)), - } - } - (planned, declined) -} - -/// 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", -); - -/// 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"; - -/// `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 -} - -/// Render the package's `Bridge.lean`. -/// -/// Per bridged export it emits three declarations: -/// -/// * `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( - "-- 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\ - 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", - ); - 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") - }; - let bridge_at = if binders.is_empty() { - format!("_root_.AverCert.Bridge.{export}") - } else { - format!("_root_.AverCert.Bridge.{export} {binders}") - }; - let source_binders = params - .iter() - .enumerate() - .map(|(index, encoder)| format!("(x{index} : {}) ", encoder.binder_type())) - .collect::(); - let applied_binders = if binders.is_empty() { - String::new() - } else { - format!("{binders} ") - }; - // 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", - ); - 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.", - ); - 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", - ); - 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())), - ); - 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.", - ); - 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()); - } - } - 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); - } - } - 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/src/codegen/cert/expr_fragment_from_mir.rs b/src/codegen/cert/expr_fragment_from_mir.rs deleted file mode 100644 index 48d495a5a..000000000 --- a/src/codegen/cert/expr_fragment_from_mir.rs +++ /dev/null @@ -1,2184 +0,0 @@ -/// Whether a representation plan has a rendered proof face. `IntCarrier` -/// results are admitted ONLY through an exact face — today the record -/// projection-compute face (whose meaning IS the plan) or one of the pinned -/// shapes below: a bare Int passthrough or any other carrier-returning shape -/// has no coherent face yet (its `Cod` would read as `Int` while `codRepr` -/// falls to the verbatim `WVal` relation), so it must never be selected here -/// nor accepted by the verifier. Likewise, `AdtRef` values are admitted ONLY -/// through the exact field-projection face: any other ADT-ref plan (a bare -/// reference passthrough, a projection chain) stays unplanned here and -/// declines fail-closed at the verifier. -/// -/// Host CALLS carry the same discipline, and it is a separate condition from -/// the result type: a plan may call `__aint_cmp` and still return `boolI32`, -/// and the wall's generic gate (`genericFragmentAllowedFuel`) rejects every -/// `.hostCall` node outright, so such a plan certifies only as one of the exact -/// comparison faces. This mirrors the verifier sidecar, which declines on -/// `expr_fragment_plan_has_host_calls || result == IntCarrier` — both sides -/// read the same two predicates. A host-call-bearing plan without a face must -/// stay UNPLANNED here rather than reach the verifier: an emitted plan would -/// change the function's bytes and then decline, whereas leaving it unplanned -/// keeps the bytes identical to a build with no plan path at all. -fn expr_fragment_plan_has_face(plan: &ExprFragmentPlan, host_table: &FragHostTable) -> bool { - 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; its result is a passthrough of an input local rather than a - // fresh box. - let int_select = expr_fragment_int_select_face(plan).is_some(); - let record_compute = expr_fragment_record_compute_face(plan, host_table).is_some(); - // Construction is certified ONLY through the compute face: a plan that - // packs a struct without that face must stay unplanned (fail-closed, - // bytes untouched) — the generic renderers have no construction arm. - let struct_new_ok = record_compute - || !plan_contains_struct_new(&plan.body); - // The inline sign template has the same discipline: only the compute face - // interprets it, so a plan carrying it without that face stays unplanned - // (bytes untouched) instead of reaching the verifier and declining there. - let int_sign_cmp_ok = record_compute || !plan_contains_int_sign_cmp(&plan.body); - let int_face_ok = plan.result != FragTy::IntCarrier - || tag_dispatch - || vector_get - || record_proj - || int_select - || record_compute; - let host_call_face_ok = !expr_fragment_plan_has_host_calls(plan) - || tag_dispatch - || vector_get - || record_proj - || int_select - || record_compute; - let adt_face_ok = !expr_fragment_plan_touches_adt_ref(plan) - || expr_fragment_project_face(plan).is_some() - || tag_dispatch - || vector_get - || record_proj - || record_compute; - int_face_ok && host_call_face_ok && adt_face_ok && struct_new_ok && int_sign_cmp_ok -} - -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, - }) -} - -/// Producer-side record layout resolver: `(record type name, field name) -> -/// (declared field index, field source type name)`. Backed by the wasm-gc -/// emitter's type registry; returns `None` for newtypes/carriers (whose field -/// reads are identity, not `struct.get`), so those never plan a projection. -pub(crate) type RecordFieldLookup<'a> = &'a dyn Fn(&str, &str) -> Option<(u32, String)>; - -pub(crate) fn fragment_plan_from_mir_fn( - mir_fn: &crate::ir::mir::MirFn, - record_fields: RecordFieldLookup, - builtins: &[String], -) -> Option { - // Encodability gate at MIR time uses placeholder host/struct tables - // (indices do not affect encoding SHAPE) and requires full canonical BYTE - // lowering to succeed, because the wasm-gc emitter emits the function body - // from this plan: a plan that cannot byte-lower must never be selected. - // The face gate mirrors the verifier: carrier-returning plans without the - // straight-line integer face, and ADT-ref plans without the - // field-projection face, stay unplanned (fail-closed decline there, - // untouched bytes here). - if let Some(plan) = sym_plan_from_mir_fn(mir_fn, record_fields, builtins) - && let Some(frag) = plan.to_expr_fragment_plan( - &FragHostTable::placeholder(), - &FragStructTable::placeholder_for(&plan), - ) - && lower_expr_fragment_plan_code_entry_bytes(&frag, 0).is_ok() - && expr_fragment_plan_has_face(&frag, &FragHostTable::placeholder()) - { - return Some(FragmentPlan::Sym(plan)); - } - let plan = repr_expr_fragment_plan_from_mir_fn(mir_fn)?; - if lower_expr_fragment_plan_code_entry_bytes(&plan, 0).is_ok() - && expr_fragment_plan_has_face(&plan, &FragHostTable::placeholder()) - { - Some(FragmentPlan::Expr(plan)) - } else { - None - } -} - -/// The plan as the representation-level fragment it will lower to, encoded -/// against placeholder tables. Indices do not affect the encoding SHAPE, so -/// this answers structural questions (which host roles does the body call?) -/// without needing the module's byte-derived tables. -#[cfg(test)] -fn placeholder_expr_fragment_plan(plan: &FragmentPlan) -> Option { - let struct_table = match plan { - FragmentPlan::Sym(sym) => FragStructTable::placeholder_for(sym), - FragmentPlan::Expr(_) => FragStructTable::default(), - }; - plan.to_expr_fragment_plan(&FragHostTable::placeholder(), &struct_table) -} - -#[cfg(test)] -pub(crate) fn expr_fragment_plan_from_mir_fn( - mir_fn: &crate::ir::mir::MirFn, -) -> Option { - placeholder_expr_fragment_plan(&fragment_plan_from_mir_fn(mir_fn, &|_, _| None, &[])?) -} - -/// Fail-closed representation guard. The plan lowerer emits the ALL-BOXED -/// representation: every Int value is a `$AverInt` carrier ref and every Int -/// param read becomes a carrier `struct.get`. The wasm signature, however, is -/// derived from `MirFnRepr` (`param_types_with_repr` / `return_results_with_repr` -/// with `ENABLE_BARE_SLOTS` on), so a fn whose repr marks any bare param / -/// return / let slot (or an ETAP-2 bare-carrier slot) carries scalar `i64` -/// slots — a plan-emitted body over those slots would `struct.get` an `i64`, -/// invalid wasm. Such functions must never plan; their MIR-emitted bodies -/// already handle the bare representation. -fn mir_fn_repr_is_all_boxed(mir_fn: &crate::ir::mir::MirFn) -> bool { - let repr = &mir_fn.repr; - !repr.bare_return - && repr.bare_slots.is_empty() - && repr.carrier_slots.is_empty() - && repr.bare_params.iter().all(|bare| !bare) -} - -pub(crate) fn sym_plan_from_mir_fn( - mir_fn: &crate::ir::mir::MirFn, - record_fields: RecordFieldLookup, - builtins: &[String], -) -> Option { - if !mir_fn.effects.is_empty() || !mir_fn_repr_is_all_boxed(mir_fn) { - return None; - } - - let mut params = Vec::new(); - let mut params_by_slot = std::collections::HashMap::::new(); - for (idx, param) in mir_fn.params.iter().enumerate() { - if param.local.0 != idx as u32 { - return None; - } - let ty = sym_ty_from_mir_name(¶m.ty)?; - params.push(ty.clone()); - params_by_slot.insert(param.local.0, (idx as u32, ty)); - } - - let result = sym_ty_from_mir_name(&mir_fn.return_type)?; - let mut builder = MirSymPlanBuilder { - params_by_slot: ¶ms_by_slot, - record_fields, - builtins, - aliases: std::collections::HashMap::new(), - alias_hops: 0, - nodes: Vec::new(), - }; - let (root, root_ty) = builder.lower_expr(&mir_fn.body)?; - if root_ty != result { - return None; - } - Some(SymPlan { - params, - result, - body: builder.finish(root)?, - }) -} - -fn repr_expr_fragment_plan_from_mir_fn( - mir_fn: &crate::ir::mir::MirFn, -) -> Option { - if !mir_fn.effects.is_empty() || !mir_fn_repr_is_all_boxed(mir_fn) { - return None; - } - - let mut params = Vec::new(); - let mut params_by_slot = std::collections::HashMap::::new(); - for (idx, param) in mir_fn.params.iter().enumerate() { - if param.local.0 != idx as u32 { - return None; - } - let ty = expr_fragment_ty_from_mir_name(¶m.ty)?; - params.push(ty); - params_by_slot.insert(param.local.0, (idx as u32, ty)); - } - - let result = expr_fragment_ty_from_mir_name(&mir_fn.return_type)?; - let mut builder = MirExprFragmentBuilder { - params_by_slot: ¶ms_by_slot, - nodes: Vec::new(), - }; - let (root, root_ty) = builder.lower_expr(&mir_fn.body)?; - if root_ty != result { - return None; - } - Some(ExprFragmentPlan { - params, - result, - body: builder.finish(root)?, - }) -} - -fn sym_ty_from_mir_name(ty: &str) -> Option { - let ty = ty.trim(); - match ty { - "Int" => Some(SymTy::Int), - "Float" => Some(SymTy::Float), - "Bool" => Some(SymTy::Bool), - // Two producers feed this function and they spell the string type - // differently. Signature types (`MirFn::return_type`, `MirParam::ty`) - // are the resolver `Type`'s Debug rendering, where `Type::Str` prints - // as `Str`. Record field types come from the wasm-gc registry, which - // keeps the annotation as written in the source — `String`. Neither - // arm is the removed `Str` surface alias, so neither can be dropped. - "String" | "Str" => Some(SymTy::String), - "" => None, - other => { - if let Some(inner) = other - .strip_prefix("Option(") - .and_then(|value| value.strip_suffix(')')) - { - return Some(SymTy::App( - "Option".to_string(), - vec![sym_ty_from_mir_name(inner)?], - )); - } - if let Some(inner) = other - .strip_prefix("Vector(") - .and_then(|value| value.strip_suffix(')')) - { - return Some(SymTy::App( - "Vector".to_string(), - vec![sym_ty_from_mir_name(inner)?], - )); - } - if let Some(inner) = other - .strip_prefix("Result(") - .and_then(|value| value.strip_suffix(')')) - { - let (ok, err) = split_mir_debug_binary_args(inner)?; - return Some(SymTy::App( - "Result".to_string(), - vec![sym_ty_from_mir_name(ok)?, sym_ty_from_mir_name(err)?], - )); - } - // User records/ADTs print as `Named { id: ..., name: "User" }`; - // extract the source name. Anything else keeps the pre-existing - // whole-token fallback. - if let Some(name) = mir_named_type_name(other) { - return Some(SymTy::Named(name)); - } - Some(SymTy::Named(other.to_string())) - } - } -} - -fn split_mir_debug_binary_args(value: &str) -> Option<(&str, &str)> { - let mut depth = 0i32; - for (at, ch) in value.char_indices() { - match ch { - '(' | '<' | '[' | '{' => depth += 1, - ')' | '>' | ']' | '}' => depth -= 1, - ',' if depth == 0 => { - return Some((value[..at].trim(), value[at + 1..].trim())); - } - _ => {} - } - } - None -} - -/// Extract the source type name from the resolver `Type::Named` Debug -/// rendering (`Named { id: ..., name: "User" }`). Returns `None` for any -/// other shape or a non-canonical name token. -fn mir_named_type_name(ty: &str) -> Option { - let rest = ty.strip_prefix("Named {")?.strip_suffix('}')?; - let idx = rest.find("name: \"")?; - let after = &rest[idx + 7..]; - let name = &after[..after.find('"')?]; - if !name.is_empty() && !name.chars().any(char::is_whitespace) && !name.contains('=') { - Some(name.to_string()) - } else { - None - } -} - -fn expr_fragment_ty_from_mir_name(ty: &str) -> Option { - match ty.trim() { - "Float" => Some(FragTy::F64), - "Bool" => Some(FragTy::BoolI32), - "Int" => Some(FragTy::IntCarrier), - _ => None, - } -} - -/// Depth guard for let-alias resolution: a chain deeper than this refuses to -/// plan instead of recursing further. Well-formed MIR let chains are acyclic, -/// so any real program resolves in a handful of hops; the cap only exists so -/// pathological nesting degrades to an unplanned fn. -const MAX_ALIAS_RESOLUTION_DEPTH: usize = 32; - -/// Number of reads of `slot` inside `expr`: `Local` reads plus first-class -/// fn-value calls through the slot (`MirCallee::LocalSlot`). `Let` bindings -/// and pattern bindings are definitions, not reads; MIR mints locals fresh -/// per binding, so no shadowing can hide a read from this count. -fn count_slot_reads(expr: &crate::ast::Spanned, slot: u32) -> usize { - use crate::ir::mir::MirExpr; - let sum_all = - |items: &[crate::ast::Spanned]| -> usize { - items.iter().map(|item| count_slot_reads(item, slot)).sum() - }; - match &expr.node { - MirExpr::Literal(_) | MirExpr::FnValue(_) => 0, - MirExpr::Local(local) => usize::from(local.node.slot.0 == slot), - MirExpr::Let(l) => { - count_slot_reads(&l.node.value, slot) + count_slot_reads(&l.node.body, slot) - } - MirExpr::Call(call) => { - let callee_reads = match &call.node.callee { - crate::ir::mir::MirCallee::LocalSlot { - slot: callee_slot, .. - } => usize::from(u32::from(*callee_slot) == slot), - _ => 0, - }; - callee_reads + sum_all(&call.node.args) - } - MirExpr::TailCall(tail_call) => sum_all(&tail_call.node.args), - MirExpr::BinOp(binop) => { - count_slot_reads(&binop.node.lhs, slot) + count_slot_reads(&binop.node.rhs, slot) - } - MirExpr::Neg(inner) - | MirExpr::Try(inner) - | MirExpr::Return(inner) - | MirExpr::Box(inner) - | MirExpr::Unbox(inner) => count_slot_reads(inner, slot), - MirExpr::Match(m) => { - count_slot_reads(&m.node.subject, slot) - + m.node - .arms - .iter() - .map(|arm| count_slot_reads(&arm.body, slot)) - .sum::() - } - MirExpr::Construct(construct) => sum_all(&construct.node.args), - MirExpr::RecordCreate(create) => create - .node - .fields - .iter() - .map(|field| count_slot_reads(&field.value, slot)) - .sum(), - MirExpr::RecordUpdate(update) => { - count_slot_reads(&update.node.base, slot) - + update - .node - .updates - .iter() - .map(|field| count_slot_reads(&field.value, slot)) - .sum::() - } - MirExpr::Project(project) => count_slot_reads(&project.node.base, slot), - MirExpr::IfThenElse(ite) => { - count_slot_reads(&ite.node.cond, slot) - + count_slot_reads(&ite.node.then_branch, slot) - + count_slot_reads(&ite.node.else_branch, slot) - } - MirExpr::List(items) | MirExpr::Tuple(items) => sum_all(items), - MirExpr::MapLiteral(pairs) => pairs - .iter() - .map(|(key, value)| count_slot_reads(key, slot) + count_slot_reads(value, slot)) - .sum(), - MirExpr::InterpolatedStr(parts) => parts - .iter() - .map(|part| match part { - crate::ir::mir::MirStrPart::Literal(_) => 0, - crate::ir::mir::MirStrPart::Expr(inner) => count_slot_reads(inner, slot), - }) - .sum(), - MirExpr::IndependentProduct(product) => sum_all(&product.node.items), - } -} - -struct MirSymPlanBuilder<'a, 'e> { - params_by_slot: &'a std::collections::HashMap, - record_fields: RecordFieldLookup<'a>, - builtins: &'a [String], - /// Single-use `let` bindings in scope: slot -> initializer. A `Local` - /// read of an aliased slot re-lowers the initializer at the use site - /// (sound because every plannable MirExpr is pure, and exact because the - /// binding is proven single-use before it is recorded). - aliases: std::collections::HashMap>, - /// Alias hops currently on the resolution stack (see - /// [`MAX_ALIAS_RESOLUTION_DEPTH`]). - alias_hops: usize, - nodes: Vec, -} - -impl<'a, 'e> MirSymPlanBuilder<'a, 'e> { - fn lower_expr( - &mut self, - expr: &'e crate::ast::Spanned, - ) -> Option<(SymValueId, SymTy)> { - match &expr.node { - crate::ir::mir::MirExpr::Literal(lit) => match &lit.node { - crate::ast::Literal::Bool(value) => { - self.push_node(SymTy::Bool, SymNodeKind::ConstBool(*value)) - } - crate::ast::Literal::Int(value) => { - self.push_node(SymTy::Int, SymNodeKind::ConstInt(*value)) - } - crate::ast::Literal::Float(value) => { - self.push_node(SymTy::Float, SymNodeKind::ConstFloatBits(value.to_bits())) - } - crate::ast::Literal::Str(value) => { - self.push_node(SymTy::String, SymNodeKind::ConstStringBytes(value.as_bytes().to_vec())) - } - _ => None, - }, - crate::ir::mir::MirExpr::Local(local) => { - if let Some((index, ty)) = self.params_by_slot.get(&local.node.slot.0).cloned() { - return self.push_node(ty, SymNodeKind::Param { index }); - } - // The one read of a single-use `let` binding: lower the - // recorded initializer here, preserving stack discipline - // (nodes append in evaluation order at the use site). - let init = *self.aliases.get(&local.node.slot.0)?; - if self.alias_hops >= MAX_ALIAS_RESOLUTION_DEPTH { - return None; - } - self.alias_hops += 1; - let lowered = self.lower_expr(init); - self.alias_hops -= 1; - lowered - } - crate::ir::mir::MirExpr::Let(spanned_let) => self.lower_let(&spanned_let.node), - crate::ir::mir::MirExpr::BinOp(binop) => self.lower_binop(&binop.node), - crate::ir::mir::MirExpr::Project(spanned_proj) => { - // Record field access `base.field`: only a named-record base - // resolvable through the emitter's registry plans a - // projection; newtypes/carriers (identity reads) and unknown - // layouts return `None` from the lookup and stay unplanned. - let proj = &spanned_proj.node; - let (value, base_ty) = self.lower_expr(&proj.base)?; - let SymTy::Named(type_name) = base_ty else { - return None; - }; - let (field, field_ty_name) = (self.record_fields)(&type_name, &proj.field)?; - let field_ty = sym_ty_from_mir_name(&field_ty_name)?; - self.push_node( - field_ty.clone(), - SymNodeKind::ProjectField { - type_name, - field, - field_ty, - value, - }, - ) - } - crate::ir::mir::MirExpr::IfThenElse(ite) => self.lower_if(&ite.node), - // Bool `match` never reaches a backend: the MIR pass - // `bool_match_to_if` rewrites every documented two-armed Bool shape - // into `IfThenElse` upstream, and its stated invariant is that - // backends consume only the rewritten form. What survives here is - // an ADT tag dispatch. - crate::ir::mir::MirExpr::Match(m) => self.lower_tag_match(&m.node), - crate::ir::mir::MirExpr::Call(call) => self.lower_call(&call.node), - crate::ir::mir::MirExpr::RecordCreate(rc) => { - // Record construction over already-planned field values. v1 - // demands the written field order to BE the declared order - // (the emitter evaluates fields as written and `struct.new` - // consumes them in declared order; a reordering write stays - // unplanned, fail-closed, bytes untouched). - let rc = &rc.node; - let mut args = Vec::with_capacity(rc.fields.len()); - for (pos, field) in rc.fields.iter().enumerate() { - let (idx, _field_ty) = - (self.record_fields)(&rc.type_name, &field.name)?; - if idx as usize != pos { - return None; - } - let (value, _value_ty) = self.lower_expr(&field.value)?; - args.push(value); - } - self.push_node( - SymTy::Named(rc.type_name.clone()), - SymNodeKind::Construct { - type_name: rc.type_name.clone(), - ctor_name: rc.type_name.clone(), - args, - }, - ) - } - _ => None, - } - } - - /// Single-use `let` inlining: `x = init; body` lowers as `body` with the - /// single read of `x` replaced by lowering `init` at the use site. All - /// constraints are mandatory and fail closed to "unplanned": - /// - /// - the binding must be read EXACTLY once across the whole remaining - /// body, including nested if/match sub-blocks and later `let` - /// initializers (a multi-use binding inlined per-use would duplicate - /// evaluation relative to the MIR-emitted bytes' sharing); - /// - the initializer must itself be plannable — checked where it is - /// lowered at the use site; purity comes for free because every - /// plannable MirExpr shape is pure (the fn-level effect gate in - /// `sym_plan_from_mir_fn` is unchanged); - /// - malformed shapes (a binding shadowing a param slot, a - /// self-referential initializer) refuse outright. - fn lower_let( - &mut self, - spanned_let: &'e crate::ir::mir::MirLet, - ) -> Option<(SymValueId, SymTy)> { - if self.params_by_slot.contains_key(&spanned_let.binding.0) { - return None; - } - if count_slot_reads(&spanned_let.body, spanned_let.binding.0) != 1 { - return None; - } - if count_slot_reads(&spanned_let.value, spanned_let.binding.0) != 0 { - return None; - } - let displaced = self - .aliases - .insert(spanned_let.binding.0, &spanned_let.value); - let lowered = self.lower_expr(&spanned_let.body); - // Restore the exact scope: the binding ends with its body. - match displaced { - Some(previous) => self.aliases.insert(spanned_let.binding.0, previous), - None => self.aliases.remove(&spanned_let.binding.0), - }; - lowered - } - - /// Builtin calls with a planned source meaning: the fused vector read and - /// eager `Bool.and`. Everything else stays unplanned (fail-closed `None`). - fn lower_call( - &mut self, - call: &'e crate::ir::mir::MirCall, - ) -> Option<(SymValueId, SymTy)> { - if let Some(lowered) = self.lower_fused_vector_get(call) { - return Some(lowered); - } - self.lower_bool_and(call) - } - - /// Eager source-level conjunction: `Bool.and(a, b)` over two Bool-typed - /// operands, exactly as the wasm-gc emitter lowers the builtin (operand 0, - /// operand 1, `i32.and`). `Bool.or` / `Bool.not` are deliberately NOT - /// recognised: their representation opcodes (`i32.or` / `i32.eqz`) are not - /// in the audited instruction set. Anything else returns `None`. - fn lower_bool_and( - &mut self, - call: &'e crate::ir::mir::MirCall, - ) -> Option<(SymValueId, SymTy)> { - let crate::ir::mir::MirCallee::Builtin(id) = call.callee else { - return None; - }; - if self.builtins.get(id.0 as usize)? != "Bool.and" || call.args.len() != 2 { - return None; - } - let (lhs, lhs_ty) = self.lower_expr(&call.args[0])?; - if lhs_ty != SymTy::Bool { - return None; - } - let (rhs, rhs_ty) = self.lower_expr(&call.args[1])?; - if rhs_ty != SymTy::Bool { - return None; - } - self.push_node( - SymTy::Bool, - SymNodeKind::Prim { - op: SymPrim::BoolAnd, - args: vec![lhs, rhs], - }, - ) - } - - /// The fused `Option.withDefault(Vector.get(p0, p1), )` - /// shape, recognised exactly as the wasm-gc emitter fuses it - /// (`emit_mir_option_with_default`): the vector must be param 0 with - /// source type `Vector`, the index param 1 with source type `Int`, - /// and the default an Int literal. Anything broader stays unplanned so - /// the emitted bytes are untouched. - fn lower_fused_vector_get( - &mut self, - call: &crate::ir::mir::MirCall, - ) -> Option<(SymValueId, SymTy)> { - let crate::ir::mir::MirCallee::Builtin(id) = call.callee else { - return None; - }; - if self.builtins.get(id.0 as usize)? != "Option.withDefault" || call.args.len() != 2 { - return None; - } - let crate::ir::mir::MirExpr::Call(inner_sp) = &call.args[0].node else { - return None; - }; - let inner = &inner_sp.node; - let crate::ir::mir::MirCallee::Builtin(inner_id) = inner.callee else { - return None; - }; - if self.builtins.get(inner_id.0 as usize)? != "Vector.get" || inner.args.len() != 2 { - return None; - } - let crate::ir::mir::MirExpr::Local(vector) = &inner.args[0].node else { - return None; - }; - let crate::ir::mir::MirExpr::Local(index) = &inner.args[1].node else { - return None; - }; - let (vector_idx, vector_ty) = self.params_by_slot.get(&vector.node.slot.0)?.clone(); - let (index_idx, index_ty) = self.params_by_slot.get(&index.node.slot.0)?.clone(); - if vector_idx != 0 - || index_idx != 1 - || vector_ty != SymTy::App("Vector".to_string(), vec![SymTy::Int]) - || index_ty != SymTy::Int - { - return None; - } - let default = mir_int_literal(&call.args[1])?; - self.push_node( - SymTy::Int, - SymNodeKind::VectorGetOrDefault { - type_name: "Vector".to_string(), - default, - }, - ) - } - - fn lower_binop(&mut self, binop: &'e crate::ir::mir::MirBinOp) -> Option<(SymValueId, SymTy)> { - // Narrow straight-line integer face: exactly `param + k` over the - // single Int parameter (const on the right, matching the emitted byte - // shape). Anything broader stays unplanned so the emitted bytes are - // untouched and legacy classification is unaffected. - if binop.op == crate::ast::BinOp::Add - && self.params_by_slot.len() == 1 - && self.expr_is_int_param(&binop.lhs) - && let Some(k) = mir_int_literal(&binop.rhs) - { - let (lhs, lhs_ty) = self.lower_expr(&binop.lhs)?; - if lhs_ty != SymTy::Int { - return None; - } - let (rhs, _) = self.push_node(SymTy::Int, SymNodeKind::ConstInt(k))?; - return self.push_node( - SymTy::Int, - SymNodeKind::Prim { - op: SymPrim::IntAdd, - args: vec![lhs, rhs], - }, - ); - } - - if let Some((operand, op, k, const_on_left)) = self.int_const_cmp_shape(binop) { - return self.lower_int_const_cmp(operand, op, k, const_on_left); - } - - let (lhs, lhs_ty) = self.lower_expr(&binop.lhs)?; - let (rhs, rhs_ty) = self.lower_expr(&binop.rhs)?; - // Int VALUE versus Int VALUE. The emitter calls `__aint_cmp` (or - // `__aint_eq`) here, which the two exact-pinned comparison faces - // recognize. Placed before the Float bail so a Float comparison keeps - // its existing primitive lowering untouched. `<=` and `!=` decline: - // neither has an admitted plan primitive behind it. - // Int arithmetic over arbitrary planned operands (projections, - // literals, prior results). Comparisons fall through to the - // value-comparison block below. - if lhs_ty == SymTy::Int && rhs_ty == SymTy::Int { - let arith = match binop.op { - crate::ast::BinOp::Add => Some(SymPrim::IntAdd), - crate::ast::BinOp::Sub => Some(SymPrim::IntSub), - crate::ast::BinOp::Mul => Some(SymPrim::IntMul), - _ => None, - }; - if let Some(op) = arith { - return self.push_node( - SymTy::Int, - SymNodeKind::Prim { - op, - args: vec![lhs, rhs], - }, - ); - } - } - if lhs_ty == SymTy::Int && rhs_ty == SymTy::Int { - let op = sym_int_cmp_op(binop.op)?; - return self.push_node(SymTy::Bool, SymNodeKind::IntCmp { op, lhs, rhs }); - } - if lhs_ty == SymTy::String && rhs_ty == SymTy::String { - if binop.op != crate::ast::BinOp::Add { - return None; - } - return self.push_node( - SymTy::String, - SymNodeKind::Prim { - op: SymPrim::StringConcat, - args: vec![lhs, rhs], - }, - ); - } - - if lhs_ty != SymTy::Float || rhs_ty != SymTy::Float { - return None; - } - let (op, result_ty) = match binop.op { - crate::ast::BinOp::Add => (SymPrim::FloatAdd, SymTy::Float), - crate::ast::BinOp::Mul => (SymPrim::FloatMul, SymTy::Float), - crate::ast::BinOp::Lte => (SymPrim::FloatLe, SymTy::Bool), - crate::ast::BinOp::Gte => (SymPrim::FloatGe, SymTy::Bool), - crate::ast::BinOp::Lt => (SymPrim::FloatLt, SymTy::Bool), - crate::ast::BinOp::Gt => (SymPrim::FloatGt, SymTy::Bool), - crate::ast::BinOp::Eq => (SymPrim::FloatEq, SymTy::Bool), - // `Neq` stays out: `f64.ne` is the UNORDERED comparison (true on - // NaN), so it is not covered by the ordered-comparison NaN clause - // the other five share. - _ => return None, - }; - self.push_node( - result_ty, - SymNodeKind::Prim { - op, - args: vec![lhs, rhs], - }, - ) - } - - /// The emitter specializes EVERY `Int` comparison against an i64 literal - /// into its tag-branch template (`from_mir/builtins.rs`), whatever the - /// other operand is, so the plan has to describe the same shape for any - /// operand — a param operand encodes to the two-arm expansion over its - /// local slot, anything computed to the monolithic `intSignCmp`. The - /// literal side is probed LEFT FIRST, exactly as the emitter probes it, so - /// a comparison of two literals flips the same way on both sides. - fn int_const_cmp_shape( - &self, - binop: &'e crate::ir::mir::MirBinOp, - ) -> Option<(&'e crate::ast::Spanned, crate::ast::BinOp, i64, bool)> - { - // The emitter's own gate: only the six comparisons specialize, so - // arithmetic against a literal (`0 - a.top`) must fall through to the - // ordinary lowering below. - if !matches!( - binop.op, - crate::ast::BinOp::Eq - | crate::ast::BinOp::Neq - | crate::ast::BinOp::Lt - | crate::ast::BinOp::Gt - | crate::ast::BinOp::Lte - | crate::ast::BinOp::Gte - ) { - return None; - } - if let Some(k) = mir_int_literal(&binop.lhs) { - return Some((&binop.rhs, binop.op, k, true)); - } - if let Some(k) = mir_int_literal(&binop.rhs) { - return Some((&binop.lhs, binop.op, k, false)); - } - None - } - - /// Resolve a `Local` read through the single-use let-alias chain to the - /// param it terminates at. Only chains made of `Local` reads qualify: a - /// COMPUTED alias (any non-`Local` initializer) returns `None`. The two - /// callers require exactly that: the `intConstCmp` operand must be a - /// param read (PlanCheck's `isSymParam` — kernel-side, not adapter - /// courtesy), and the tag-match scrutinee is pinned by the wall face to - /// the param-0 local read. - fn resolve_local_chain_param( - &self, - expr: &crate::ast::Spanned, - hops: usize, - ) -> Option<(u32, SymTy)> { - if hops > MAX_ALIAS_RESOLUTION_DEPTH { - return None; - } - let crate::ir::mir::MirExpr::Local(local) = &expr.node else { - return None; - }; - if let Some(entry) = self.params_by_slot.get(&local.node.slot.0) { - return Some(entry.clone()); - } - let init = self.aliases.get(&local.node.slot.0)?; - self.resolve_local_chain_param(init, hops + 1) - } - - fn expr_is_int_param(&self, expr: &crate::ast::Spanned) -> bool { - self.resolve_local_chain_param(expr, 0) - .is_some_and(|(_, ty)| ty == SymTy::Int) - } - - fn lower_int_const_cmp( - &mut self, - operand: &'e crate::ast::Spanned, - op: crate::ast::BinOp, - k: i64, - const_on_left: bool, - ) -> Option<(SymValueId, SymTy)> { - let eff = if const_on_left { flip_cmp(op) } else { op }; - let op = sym_int_const_cmp_op(eff)?; - let (value, value_ty) = self.lower_expr(operand)?; - if value_ty != SymTy::Int { - return None; - } - self.push_node( - SymTy::Bool, - SymNodeKind::IntConstCmp { - op, - value, - constant: k, - }, - ) - } - - fn lower_if(&mut self, ite: &'e crate::ir::mir::MirIfThenElse) -> Option<(SymValueId, SymTy)> { - let (cond, cond_ty) = self.lower_expr(&ite.cond)?; - if cond_ty != SymTy::Bool { - return None; - } - - let mut then_builder = MirSymPlanBuilder { - params_by_slot: self.params_by_slot, - record_fields: self.record_fields, - builtins: self.builtins, - aliases: self.aliases.clone(), - alias_hops: self.alias_hops, - nodes: Vec::new(), - }; - let (then_root, then_ty) = then_builder.lower_expr(&ite.then_branch)?; - let then_block = then_builder.finish(then_root)?; - - let mut else_builder = MirSymPlanBuilder { - params_by_slot: self.params_by_slot, - record_fields: self.record_fields, - builtins: self.builtins, - aliases: self.aliases.clone(), - alias_hops: self.alias_hops, - nodes: Vec::new(), - }; - let (else_root, else_ty) = else_builder.lower_expr(&ite.else_branch)?; - let else_block = else_builder.finish(else_root)?; - - if then_ty != else_ty || then_block.result_ty() != else_block.result_ty() { - return None; - } - - self.push_node( - then_ty, - SymNodeKind::If { - cond, - then_block: Box::new(then_block), - else_block: Box::new(else_block), - }, - ) - } - - fn lower_tag_match( - &mut self, - m: &'e crate::ir::mir::MirMatch, - ) -> Option<(SymValueId, SymTy)> { - if self.params_by_slot.len() != 1 || m.arms.len() != 2 { - return None; - } - // The subject must resolve to THE single param — directly or through - // a single-use let-alias chain of `Local` reads (the wall face pins - // the encoded scrutinee to the param-0 local read, which is exactly - // what the aliased subject lowers back to in `push_tag_match`). - let (_, subject_ty) = self.resolve_local_chain_param(&m.subject, 0)?; - let (type_name, hit_ctor, miss_ctor, tag) = match &subject_ty { - SymTy::App(name, args) if name == "Option" && args.len() == 1 => ( - "Option", - crate::ir::hir::BuiltinCtor::OptionSome, - crate::ir::hir::BuiltinCtor::OptionNone, - crate::codegen::wasm_gc::OPTION_SOME_TAG, - ), - SymTy::App(name, args) if name == "Result" && args.len() == 2 => ( - "Result", - crate::ir::hir::BuiltinCtor::ResultOk, - crate::ir::hir::BuiltinCtor::ResultErr, - crate::codegen::wasm_gc::RESULT_OK_TAG, - ), - _ => return None, - }; - - let mut hit = None; - let mut miss = None; - let mut wildcard = None; - for arm in &m.arms { - let value = mir_int_literal(&arm.body)?; - match &arm.pattern { - crate::ir::mir::MirPattern::Ctor { - ctor: crate::ir::mir::MirCtor::Builtin(ctor), - .. - } if *ctor == hit_ctor && hit.is_none() => hit = Some(value), - crate::ir::mir::MirPattern::Ctor { - ctor: crate::ir::mir::MirCtor::Builtin(ctor), - .. - } if *ctor == miss_ctor && miss.is_none() => miss = Some(value), - crate::ir::mir::MirPattern::Wildcard if wildcard.is_none() => { - wildcard = Some(value) - } - _ => return None, - } - } - match (hit, miss, wildcard) { - (Some(hit), Some(miss), None) => self.push_tag_match( - &m.subject, - type_name, - tag, - hit, - miss, - ), - (Some(hit), None, Some(miss)) => self.push_tag_match( - &m.subject, - type_name, - tag, - hit, - miss, - ), - (None, Some(miss), Some(hit)) => self.push_tag_match( - &m.subject, - type_name, - tag, - hit, - miss, - ), - _ => None, - } - } - - fn push_tag_match( - &mut self, - subject: &'e crate::ast::Spanned, - type_name: &str, - tag: i32, - hit: i64, - miss: i64, - ) -> Option<(SymValueId, SymTy)> { - let (scrutinee, _) = self.lower_expr(subject)?; - let int_block = |value| SymBlock { - nodes: vec![SymNode { - id: SymValueId(0), - ty: SymTy::Int, - kind: SymNodeKind::ConstInt(value), - }], - result: SymValueId(0), - }; - self.push_node( - SymTy::Int, - SymNodeKind::TagMatch { - type_name: type_name.to_string(), - scrutinee, - tag: i64::from(tag), - hit: Box::new(int_block(hit)), - miss: Box::new(int_block(miss)), - }, - ) - } - - fn push_node(&mut self, ty: SymTy, kind: SymNodeKind) -> Option<(SymValueId, SymTy)> { - let id = SymValueId(self.nodes.len()); - self.nodes.push(SymNode { - id, - ty: ty.clone(), - kind, - }); - Some((id, ty)) - } - - fn finish(self, result: SymValueId) -> Option { - // Kernel block-shape invariants (PlanCheck.checkSymBlock): every - // node's id equals its position, and the result is the LAST node - // (`result + 1 = nodes.length`). The builder satisfies both by - // construction today; checking them here makes a future producer bug - // degrade to an unplanned fn instead of a late kernel reject. - if self - .nodes - .iter() - .enumerate() - .any(|(position, node)| node.id.0 != position) - { - return None; - } - if result.0 + 1 != self.nodes.len() { - return None; - } - let block = SymBlock { - nodes: self.nodes, - result, - }; - block.result_ty()?; - Some(block) - } -} - -struct MirExprFragmentBuilder<'a> { - params_by_slot: &'a std::collections::HashMap, - nodes: Vec, -} - -impl MirExprFragmentBuilder<'_> { - fn lower_expr( - &mut self, - expr: &crate::ast::Spanned, - ) -> Option<(FragValueId, FragTy)> { - match &expr.node { - crate::ir::mir::MirExpr::Literal(lit) => match &lit.node { - crate::ast::Literal::Bool(value) => { - self.push_node(FragTy::BoolI32, FragNodeKind::ConstBool(*value)) - } - crate::ast::Literal::Float(value) => { - self.push_node(FragTy::F64, FragNodeKind::ConstF64(value.to_bits())) - } - _ => None, - }, - crate::ir::mir::MirExpr::Local(local) => { - let (index, ty) = *self.params_by_slot.get(&local.node.slot.0)?; - self.push_node(ty, FragNodeKind::Local { index }) - } - crate::ir::mir::MirExpr::BinOp(binop) => self.lower_binop(&binop.node), - crate::ir::mir::MirExpr::IfThenElse(ite) => self.lower_if(&ite.node), - _ => None, - } - } - - fn lower_binop(&mut self, binop: &crate::ir::mir::MirBinOp) -> Option<(FragValueId, FragTy)> { - if let Some(cmp) = self.int_const_cmp_shape(binop) { - return self.lower_int_const_cmp(cmp.0, cmp.1, cmp.2, cmp.3); - } - - let (lhs, lhs_ty) = self.lower_expr(&binop.lhs)?; - let (rhs, rhs_ty) = self.lower_expr(&binop.rhs)?; - if lhs_ty != FragTy::F64 || rhs_ty != FragTy::F64 { - return None; - } - let (op, result_ty) = match binop.op { - crate::ast::BinOp::Add => (FragPrim::F64Add, FragTy::F64), - crate::ast::BinOp::Mul => (FragPrim::F64Mul, FragTy::F64), - crate::ast::BinOp::Lte => (FragPrim::F64Le, FragTy::BoolI32), - crate::ast::BinOp::Gte => (FragPrim::F64Ge, FragTy::BoolI32), - crate::ast::BinOp::Lt => (FragPrim::F64Lt, FragTy::BoolI32), - crate::ast::BinOp::Gt => (FragPrim::F64Gt, FragTy::BoolI32), - crate::ast::BinOp::Eq => (FragPrim::F64Eq, FragTy::BoolI32), - _ => return None, - }; - self.push_node( - result_ty, - FragNodeKind::Prim { - op, - args: vec![lhs, rhs], - }, - ) - } - - fn int_const_cmp_shape<'a>( - &self, - binop: &'a crate::ir::mir::MirBinOp, - ) -> Option<(&'a crate::ast::Spanned, crate::ast::BinOp, i64, bool)> - { - if let Some(k) = mir_int_literal(&binop.rhs) - && self.expr_is_int_param(&binop.lhs) - { - return Some((&binop.lhs, binop.op, k, false)); - } - if let Some(k) = mir_int_literal(&binop.lhs) - && self.expr_is_int_param(&binop.rhs) - { - return Some((&binop.rhs, binop.op, k, true)); - } - None - } - - fn expr_is_int_param(&self, expr: &crate::ast::Spanned) -> bool { - match &expr.node { - crate::ir::mir::MirExpr::Local(local) => self - .params_by_slot - .get(&local.node.slot.0) - .is_some_and(|(_, ty)| *ty == FragTy::IntCarrier), - _ => false, - } - } - - fn lower_int_const_cmp( - &mut self, - operand: &crate::ast::Spanned, - op: crate::ast::BinOp, - k: i64, - const_on_left: bool, - ) -> Option<(FragValueId, FragTy)> { - let eff = if const_on_left { flip_cmp(op) } else { op }; - let small_prim = i64_const_cmp_prim(eff)?; - let big_kind = big_int_const_cmp_kind(eff)?; - - let (carrier, carrier_ty) = self.lower_expr(operand)?; - if carrier_ty != FragTy::IntCarrier { - return None; - } - 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 = self.lower_int_small_const_cmp_block(operand, small_prim, k)?; - let else_block = self.lower_int_big_const_cmp_block(operand, big_kind)?; - self.push_node( - FragTy::BoolI32, - FragNodeKind::If { - cond: is_small, - then_block: Box::new(then_block), - else_block: Box::new(else_block), - }, - ) - } - - fn lower_int_small_const_cmp_block( - &self, - operand: &crate::ast::Spanned, - op: FragPrim, - k: i64, - ) -> Option { - let mut block = MirExprFragmentBuilder { - params_by_slot: self.params_by_slot, - nodes: Vec::new(), - }; - let (carrier, carrier_ty) = block.lower_expr(operand)?; - if carrier_ty != FragTy::IntCarrier { - return None; - } - let (small, _) = block.push_node( - FragTy::I64, - FragNodeKind::StructGet { - field: 0, - receiver: carrier, - }, - )?; - let (constant, _) = block.push_node(FragTy::I64, FragNodeKind::ConstI64(k))?; - let (result, _) = block.push_node( - FragTy::BoolI32, - FragNodeKind::Prim { - op, - args: vec![small, constant], - }, - )?; - block.finish(result) - } - - fn lower_int_big_const_cmp_block( - &self, - operand: &crate::ast::Spanned, - kind: BigIntConstCmpKind, - ) -> Option { - let mut block = MirExprFragmentBuilder { - params_by_slot: self.params_by_slot, - nodes: Vec::new(), - }; - match kind { - BigIntConstCmpKind::Always(value) => { - let (result, _) = - block.push_node(FragTy::BoolI32, FragNodeKind::ConstBool(value))?; - block.finish(result) - } - BigIntConstCmpKind::SignLtZero | BigIntConstCmpKind::SignGtZero => { - let (carrier, carrier_ty) = block.lower_expr(operand)?; - if carrier_ty != FragTy::IntCarrier { - return None; - } - let (sign, _) = block.push_node( - FragTy::RawI32, - FragNodeKind::StructGet { - field: 2, - receiver: carrier, - }, - )?; - let (zero, _) = - block.push_node(FragTy::BoolI32, FragNodeKind::ConstBool(false))?; - let op = match kind { - BigIntConstCmpKind::SignLtZero => FragPrim::I32LtS, - BigIntConstCmpKind::SignGtZero => FragPrim::I32GtS, - BigIntConstCmpKind::Always(_) => unreachable!(), - }; - let (result, _) = block.push_node( - FragTy::BoolI32, - FragNodeKind::Prim { - op, - args: vec![sign, zero], - }, - )?; - block.finish(result) - } - } - } - - fn lower_if(&mut self, ite: &crate::ir::mir::MirIfThenElse) -> Option<(FragValueId, FragTy)> { - let (cond, cond_ty) = self.lower_expr(&ite.cond)?; - if cond_ty != FragTy::BoolI32 { - return None; - } - - let mut then_builder = MirExprFragmentBuilder { - params_by_slot: self.params_by_slot, - nodes: Vec::new(), - }; - let (then_root, then_ty) = then_builder.lower_expr(&ite.then_branch)?; - let then_block = then_builder.finish(then_root)?; - - let mut else_builder = MirExprFragmentBuilder { - params_by_slot: self.params_by_slot, - nodes: Vec::new(), - }; - let (else_root, else_ty) = else_builder.lower_expr(&ite.else_branch)?; - let else_block = else_builder.finish(else_root)?; - - if then_ty != else_ty || then_block.result_ty()? != else_block.result_ty()? { - return None; - } - - self.push_node( - then_ty, - FragNodeKind::If { - cond, - then_block: Box::new(then_block), - else_block: Box::new(else_block), - }, - ) - } - - fn push_node(&mut self, ty: FragTy, kind: FragNodeKind) -> Option<(FragValueId, FragTy)> { - let id = FragValueId(self.nodes.len()); - self.nodes.push(FragNode { id, ty, kind }); - Some((id, ty)) - } - - fn finish(self, result: FragValueId) -> Option { - self.nodes.get(result.0)?; - Some(FragBlock { - nodes: self.nodes, - result, - }) - } -} - -#[derive(Clone, Copy)] -enum BigIntConstCmpKind { - Always(bool), - SignLtZero, - SignGtZero, -} - -fn mir_int_literal(expr: &crate::ast::Spanned) -> Option { - match &expr.node { - crate::ir::mir::MirExpr::Literal(lit) => match lit.node { - crate::ast::Literal::Int(k) => Some(k), - _ => None, - }, - _ => None, - } -} - -fn flip_cmp(op: crate::ast::BinOp) -> crate::ast::BinOp { - match op { - crate::ast::BinOp::Lt => crate::ast::BinOp::Gt, - crate::ast::BinOp::Gt => crate::ast::BinOp::Lt, - crate::ast::BinOp::Lte => crate::ast::BinOp::Gte, - crate::ast::BinOp::Gte => crate::ast::BinOp::Lte, - crate::ast::BinOp::Eq => crate::ast::BinOp::Eq, - crate::ast::BinOp::Neq => crate::ast::BinOp::Neq, - other => other, - } -} - -fn i64_const_cmp_prim(op: crate::ast::BinOp) -> Option { - match op { - crate::ast::BinOp::Eq => Some(FragPrim::I64Eq), - crate::ast::BinOp::Lt => Some(FragPrim::I64LtS), - crate::ast::BinOp::Lte => Some(FragPrim::I64LeS), - crate::ast::BinOp::Gte => Some(FragPrim::I64GeS), - crate::ast::BinOp::Gt => Some(FragPrim::I64GtS), - // `Neq` stays out: `i64.ne` is not in the wall's measured instruction - // set (`WInstr`), so admitting it is a wasm-model extension, not a - // plan-grammar one. - crate::ast::BinOp::Neq => None, - _ => None, - } -} - -fn sym_int_const_cmp_op(op: crate::ast::BinOp) -> Option { - match op { - crate::ast::BinOp::Eq => Some(SymIntCmp::Eq), - crate::ast::BinOp::Lt => Some(SymIntCmp::Lt), - crate::ast::BinOp::Lte => Some(SymIntCmp::Le), - crate::ast::BinOp::Gte => Some(SymIntCmp::Ge), - crate::ast::BinOp::Gt => Some(SymIntCmp::Gt), - // Kept aligned with the representation encoder: `Neq` needs - // `i64.ne` in the wall's measured instruction set first. - crate::ast::BinOp::Neq => None, - _ => None, - } -} - -/// The source operators an Int value-versus-value comparison admits. `Lte` is -/// absent because the plan grammar has no `i32.le_s` to lower its `__aint_cmp` -/// tail to, and `Neq` because nothing needs it: admitting either would widen -/// the checker with no certifiable export behind it. -fn sym_int_cmp_op(op: crate::ast::BinOp) -> Option { - match op { - crate::ast::BinOp::Eq => Some(SymIntCmp::Eq), - crate::ast::BinOp::Lt => Some(SymIntCmp::Lt), - crate::ast::BinOp::Gt => Some(SymIntCmp::Gt), - crate::ast::BinOp::Gte => Some(SymIntCmp::Ge), - crate::ast::BinOp::Lte | crate::ast::BinOp::Neq => None, - _ => None, - } -} - -fn big_int_const_cmp_kind(op: crate::ast::BinOp) -> Option { - match op { - crate::ast::BinOp::Eq => Some(BigIntConstCmpKind::Always(false)), - crate::ast::BinOp::Lt | crate::ast::BinOp::Lte => Some(BigIntConstCmpKind::SignLtZero), - // A Big carrier is 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 | Lte` sharing `SignLtZero`. - crate::ast::BinOp::Gte | crate::ast::BinOp::Gt => Some(BigIntConstCmpKind::SignGtZero), - // Kept aligned with `i64_const_cmp_prim`: no `Neq` admission yet. - crate::ast::BinOp::Neq => None, - _ => None, - } -} - -#[cfg(test)] -mod tests { - use super::*; - use crate::ast::{BinOp, Literal, Spanned}; - use crate::ir::hir::BuiltinCtor; - use crate::ir::FnId; - use crate::ir::mir::{ - LocalId, MirBinOp, MirCtor, MirExpr, MirFn, MirFnRepr, MirIfThenElse, MirLet, MirLocal, - MirMatch, MirMatchArm, MirParam, MirPattern, - }; - - fn span(node: T) -> Spanned { - Spanned { - node, - line: 0, - ty: std::sync::OnceLock::new(), - } - } - - fn int_local(slot: u32) -> Spanned { - span(MirExpr::Local(span(MirLocal::at(LocalId(slot))))) - } - - fn int_lit(value: i64) -> Spanned { - span(MirExpr::Literal(span(Literal::Int(value)))) - } - - fn bool_lit(value: bool) -> Spanned { - span(MirExpr::Literal(span(Literal::Bool(value)))) - } - - fn binop(op: BinOp, lhs: Spanned, rhs: Spanned) -> Spanned { - span(MirExpr::BinOp(span(MirBinOp { - op, - lhs: Box::new(lhs), - rhs: Box::new(rhs), - }))) - } - - fn let_expr(slot: u32, value: Spanned, body: Spanned) -> Spanned { - span(MirExpr::Let(span(MirLet { - binding: LocalId(slot), - binding_name: "y".to_string(), - value: Box::new(value), - body: Box::new(body), - }))) - } - - fn if_expr( - cond: Spanned, - then_branch: Spanned, - else_branch: Spanned, - ) -> Spanned { - span(MirExpr::IfThenElse(span(MirIfThenElse { - cond: Box::new(cond), - then_branch: Box::new(then_branch), - else_branch: Box::new(else_branch), - }))) - } - - /// `fn f(x: Int) -> ` with an arbitrary body. - fn int_param_fn(return_type: &str, body: Spanned, local_count: u32) -> MirFn { - MirFn { - fn_id: FnId(0), - name: "f".to_string(), - params: vec![MirParam { - local: LocalId(0), - name: "x".to_string(), - ty: "Int".to_string(), - }], - return_type: return_type.to_string(), - effects: vec![], - body, - local_count, - aliased_slots: std::sync::Arc::new(Vec::new()), - repr: MirFnRepr::default(), - } - } - - fn float_local(slot: u32) -> Spanned { - span(MirExpr::Local(span(MirLocal::at(LocalId(slot))))) - } - - fn float_binop_fn(op: BinOp) -> MirFn { - MirFn { - fn_id: FnId(0), - name: "f".to_string(), - params: vec![ - MirParam { - local: LocalId(0), - name: "a".to_string(), - ty: "Float".to_string(), - }, - MirParam { - local: LocalId(1), - name: "b".to_string(), - ty: "Float".to_string(), - }, - ], - return_type: match op { - BinOp::Lte => "Bool".to_string(), - _ => "Float".to_string(), - }, - effects: vec![], - body: span(MirExpr::BinOp(span(MirBinOp { - op, - lhs: Box::new(float_local(0)), - rhs: Box::new(float_local(1)), - }))), - local_count: 2, - aliased_slots: std::sync::Arc::new(Vec::new()), - repr: MirFnRepr::default(), - } - } - - fn int_predicate_fn(op: BinOp, lhs: Spanned, rhs: Spanned) -> MirFn { - MirFn { - fn_id: FnId(0), - name: "p".to_string(), - params: vec![MirParam { - local: LocalId(0), - name: "x".to_string(), - ty: "Int".to_string(), - }], - return_type: "Bool".to_string(), - effects: vec![], - body: span(MirExpr::BinOp(span(MirBinOp { - op, - lhs: Box::new(lhs), - rhs: Box::new(rhs), - }))), - local_count: 1, - aliased_slots: std::sync::Arc::new(Vec::new()), - repr: MirFnRepr::default(), - } - } - - /// `fn f(a: Int, b: Int) -> ` with an arbitrary body. - fn int_pair_fn(return_type: &str, body: Spanned, local_count: u32) -> MirFn { - MirFn { - fn_id: FnId(0), - name: "f".to_string(), - params: vec![ - MirParam { - local: LocalId(0), - name: "a".to_string(), - ty: "Int".to_string(), - }, - MirParam { - local: LocalId(1), - name: "b".to_string(), - ty: "Int".to_string(), - }, - ], - return_type: return_type.to_string(), - effects: vec![], - body, - local_count, - aliased_slots: std::sync::Arc::new(Vec::new()), - repr: MirFnRepr::default(), - } - } - - /// `a < b` — a scalar-parameter comparison, which the record - /// projection-compute face absorbed when the pinned Int-comparison face - /// retired. The control for the refusal below: the gate must still admit a - /// host call that DOES land on an exact face. - #[test] - fn bare_int_value_comparison_still_plans() { - let mir_fn = int_pair_fn("Bool", binop(BinOp::Lt, int_local(0), int_local(1)), 2); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]) - .expect("a bare Int value comparison must plan through the compute face"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("int value comparison should use SymPlan") - }; - let table = FragHostTable::placeholder(); - let frag = sym - .to_expr_fragment_plan(&table, &FragStructTable::default()) - .expect("comparison encodes to a representation plan"); - assert!(expr_fragment_plan_has_host_calls(&frag)); - assert!(expr_fragment_record_compute_face(&frag, &table).is_some()); - } - - /// `if a >= 0 { a < b } else { false }` — `validClockValue` after the MIR - /// `bool_match_to_if` rewrite. Two `__aint_cmp` calls NESTED inside a - /// conditional: no admitted face covers it, and the wall's generic - /// expression-fragment gate rejects every `.hostCall` node, so a plan here - /// would be a claim nothing can discharge. The producer must leave the - /// function unplanned — which is also what keeps its emitted bytes the - /// plain emitter's, since the wasm-gc body is emitted FROM the plan - /// whenever one exists. - #[test] - fn nested_int_value_comparison_stays_unplanned() { - let body = if_expr( - binop(BinOp::Gte, int_local(0), int_lit(0)), - binop(BinOp::Lt, int_local(0), int_local(1)), - bool_lit(false), - ); - let mir_fn = int_pair_fn("Bool", body, 2); - assert!( - fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "a host-call-bearing plan with no admitted face must stay unplanned" - ); - } - - fn int_identity_fn() -> MirFn { - MirFn { - fn_id: FnId(0), - name: "id".to_string(), - params: vec![MirParam { - local: LocalId(0), - name: "x".to_string(), - ty: "Int".to_string(), - }], - return_type: "Int".to_string(), - effects: vec![], - body: int_local(0), - local_count: 1, - aliased_slots: std::sync::Arc::new(Vec::new()), - repr: MirFnRepr::default(), - } - } - - fn option_slot_count_fn(some_body: Spanned) -> MirFn { - MirFn { - fn_id: FnId(0), - name: "slotCount".to_string(), - params: vec![MirParam { - local: LocalId(0), - name: "egg".to_string(), - ty: "Option(Int)".to_string(), - }], - return_type: "Int".to_string(), - effects: vec![], - body: span(MirExpr::Match(span(MirMatch { - subject: Box::new(int_local(0)), - arms: vec![ - MirMatchArm { - pattern: MirPattern::Ctor { - ctor: MirCtor::Builtin(BuiltinCtor::OptionNone), - bindings: vec![], - binding_names: vec![], - }, - body: int_lit(0), - }, - MirMatchArm { - pattern: MirPattern::Ctor { - ctor: MirCtor::Builtin(BuiltinCtor::OptionSome), - bindings: vec![LocalId(1)], - binding_names: vec!["value".to_string()], - }, - body: some_body, - }, - ], - }))), - local_count: 2, - aliased_slots: std::sync::Arc::new(Vec::new()), - repr: MirFnRepr::default(), - } - } - - #[test] - fn option_literal_match_lowers_to_operational_tag_dispatch() { - let mir_fn = option_slot_count_fn(int_lit(1)); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("tag plan"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("Option tag match must remain a source symbolic plan") - }; - assert_eq!( - sym.params, - vec![SymTy::App("Option".to_string(), vec![SymTy::Int])] - ); - assert!(matches!( - &sym.body.nodes[1].kind, - SymNodeKind::TagMatch { - type_name, - scrutinee: SymValueId(0), - tag, - hit, - miss, - } if type_name == "Option" - && *tag == i64::from(crate::codegen::wasm_gc::OPTION_SOME_TAG) - && matches!(hit.nodes[0].kind, SymNodeKind::ConstInt(1)) - && matches!(miss.nodes[0].kind, SymNodeKind::ConstInt(0)) - )); - let encoded = plan - .to_expr_fragment_plan( - &FragHostTable::placeholder(), - &FragStructTable::placeholder_for(sym), - ) - .expect("tag plan encodes"); - assert!(expr_fragment_is_tag_dispatch(&encoded)); - } - - #[test] - fn option_match_using_payload_stays_unplanned() { - let mir_fn = option_slot_count_fn(int_local(1)); - assert!( - fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "payload-dependent match exceeds the narrow tag-dispatch producer scope" - ); - } - - #[test] - fn direct_float_mir_prefers_source_level_sym_plan() { - let mir_fn = float_binop_fn(BinOp::Add); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("plan"); - let FragmentPlan::Sym(sym) = plan else { - panic!("direct source-level float fragment should use SymPlan") - }; - - 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, - .. - } - )); - } - - #[test] - fn direct_int_identity_stays_unplanned_without_a_face() { - // A bare Int passthrough ENCODES (the sym plan and its representation - // encoding both exist), but it has no rendered proof face: its `Cod` - // would read as `Int` while `codRepr` falls to the verbatim `WVal` - // relation. The producer must therefore never select it — the export - // keeps its ordinary MIR-emitted body and declines fail-closed at - // classification (see `idGoal` in the goal-matrix fixture). - let mir_fn = int_identity_fn(); - let sym = sym_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("sym plan exists"); - assert_eq!(sym.params, vec![SymTy::Int]); - assert_eq!(sym.result, SymTy::Int); - let expr_plan = sym - .to_expr_fragment_plan(&FragHostTable::placeholder(), &FragStructTable::default()) - .expect("source int identity encodes to a representation plan"); - assert_eq!(expr_plan.result, FragTy::IntCarrier); - assert!( - !expr_fragment_plan_has_face(&expr_plan, &FragHostTable::placeholder()), - "carrier identity must not have a rendered proof face" - ); - assert!( - fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "producer must not select a carrier-returning plan without the \ - straight-line integer face" - ); - } - - #[test] - fn int_carrier_comparison_prefers_source_level_sym_plan() { - let mir_fn = int_predicate_fn(BinOp::Lt, int_local(0), int_lit(0)); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("plan"); - let FragmentPlan::Sym(sym) = plan else { - panic!("source-level int const comparison should use SymPlan") - }; - - assert_eq!(sym.params, vec![SymTy::Int]); - assert_eq!(sym.result, SymTy::Bool); - assert!(matches!(sym.body.nodes[0].kind, SymNodeKind::Param { index: 0 })); - assert!(matches!( - sym.body.nodes[1].kind, - SymNodeKind::IntConstCmp { - op: SymIntCmp::Lt, - value: SymValueId(0), - constant: 0, - } - )); - } - - #[test] - fn int_param_less_than_literal_lowers_from_mir_to_aint_plan() { - let mir_fn = int_predicate_fn(BinOp::Lt, int_local(0), int_lit(0)); - let plan = expr_fragment_plan_from_mir_fn(&mir_fn).expect("plan"); - - assert_eq!(plan.params, vec![FragTy::IntCarrier]); - assert_eq!(plan.result, FragTy::BoolI32); - assert_eq!(plan.body.result_ty(), Some(FragTy::BoolI32)); - assert_eq!(plan.body.nodes.len(), 4); - - assert!(matches!(plan.body.nodes[0].kind, FragNodeKind::Local { index: 0 })); - assert!(matches!( - plan.body.nodes[1].kind, - FragNodeKind::StructGet { - field: 1, - receiver: FragValueId(0) - } - )); - assert!(matches!( - plan.body.nodes[2].kind, - FragNodeKind::RefIsNull { - value: FragValueId(1) - } - )); - let FragNodeKind::If { - cond, - then_block, - else_block, - } = &plan.body.nodes[3].kind - else { - panic!("root must be an if over small-vs-big AverInt carrier") - }; - assert_eq!(*cond, FragValueId(2)); - assert_eq!(then_block.result_ty(), Some(FragTy::BoolI32)); - assert_eq!(else_block.result_ty(), Some(FragTy::BoolI32)); - assert!(matches!( - then_block.nodes[2].kind, - FragNodeKind::ConstI64(0) - )); - assert!(matches!( - then_block.nodes[3].kind, - FragNodeKind::Prim { - op: FragPrim::I64LtS, - .. - } - )); - assert!(matches!( - else_block.nodes[3].kind, - FragNodeKind::Prim { - op: FragPrim::I32LtS, - .. - } - )); - } - - fn user_name_projection_fn() -> MirFn { - MirFn { - fn_id: FnId(0), - name: "userName".to_string(), - params: vec![MirParam { - local: LocalId(0), - name: "u".to_string(), - ty: "User".to_string(), - }], - return_type: "String".to_string(), - effects: vec![], - body: span(MirExpr::Project(span(crate::ir::mir::MirProject { - base: Box::new(int_local(0)), - field: "name".to_string(), - }))), - local_count: 1, - aliased_slots: std::sync::Arc::new(Vec::new()), - repr: MirFnRepr::default(), - } - } - - #[test] - fn record_string_field_projection_plans_through_the_project_face() { - let mir_fn = user_name_projection_fn(); - let record_fields = |record: &str, field: &str| -> Option<(u32, String)> { - (record == "User" && field == "name").then(|| (0, "String".to_string())) - }; - let plan = fragment_plan_from_mir_fn(&mir_fn, &record_fields, &[]).expect("plan"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("record projection should plan as a source-level SymPlan") - }; - assert_eq!(sym.params, vec![SymTy::Named("User".to_string())]); - assert_eq!(sym.result, SymTy::String); - assert!(matches!( - &sym.body.nodes[1].kind, - SymNodeKind::ProjectField { - type_name, - field: 0, - field_ty: SymTy::String, - value: SymValueId(0), - } if type_name == "User" - )); - let frag = sym - .to_expr_fragment_plan( - &FragHostTable::placeholder(), - &FragStructTable::placeholder_for(sym), - ) - .expect("projection encodes to a representation plan"); - assert!( - expr_fragment_project_face(&frag).is_some(), - "encoded projection must match the field-projection face" - ); - } - - #[test] - fn record_int_field_projection_plans_through_the_record_face() { - // `pairFst`-style Int-field reads now plan: the record-parameter face - // (stage-1 flat scalar records) admits a single scalar field read over - // a known layout, so the encoder no longer fail-closes on a scalar - // field and the export gets a certified record-projection plan. - let mut mir_fn = user_name_projection_fn(); - mir_fn.return_type = "Int".to_string(); - let record_fields = |record: &str, field: &str| -> Option<(u32, String)> { - (record == "User" && field == "name").then(|| (0, "Int".to_string())) - }; - assert!( - fragment_plan_from_mir_fn(&mir_fn, &record_fields, &[]).is_some(), - "scalar-field projection over a known layout must plan through the record face" - ); - } - - #[test] - fn record_projection_without_layout_lookup_stays_unplanned() { - let mir_fn = user_name_projection_fn(); - assert!( - fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "projection over an unknown record layout must stay unplanned" - ); - } - - /// Belt-and-braces representation guard: a fn whose `MirFnRepr` marks any - /// bare param / return / slot (or bare-carrier slot) must never plan — - /// with `ENABLE_BARE_SLOTS` its wasm signature carries scalar `i64` slots - /// where the plan lowerer would emit carrier `struct.get` reads (invalid - /// wasm). - /// - /// No end-to-end reproduction is constructible for exported plan-shaped - /// functions today, which is why this stays a unit test: the wasm-gc bare - /// analysis only marks a PARAM bare when `compute_bare_param_intervals` - /// derived a bound for it, and its final mapping yields `Some(interval)` - /// exclusively for params carrying a recognized equality-decrement - /// RECURRENCE (a non-top `guard_floor`, i.e. a self-tail-call counter — - /// see the "Phase A withholds it" comment in - /// `src/ir/mir/optimize/bare_i64.rs`). A body containing that self call - /// dies on the plan builder's `Call`/`TailCall` catch-all, so a - /// plan-shaped body and a bare param are mutually exclusive. `bare_return` - /// similarly requires the body's tail value to be bare-eligible - /// (recurrence arithmetic or a literal), and literal-Int bodies do not - /// plan. Verified empirically: exported `p > 0`-shaped fns keep boxed - /// `(ref $AverInt)` signatures with and without internal literal callers. - /// The guard exists so a future widening of the bare analysis degrades to - /// an unplanned fn instead of emitting invalid wasm. - #[test] - fn bare_repr_functions_never_plan() { - let bare_param = { - let mut mir_fn = int_predicate_fn(BinOp::Lt, int_local(0), int_lit(0)); - mir_fn.repr.bare_params = vec![true]; - mir_fn - }; - let bare_return = { - let mut mir_fn = int_predicate_fn(BinOp::Lt, int_local(0), int_lit(0)); - mir_fn.repr.bare_return = true; - mir_fn - }; - let bare_slot = { - let mut mir_fn = int_predicate_fn(BinOp::Lt, int_local(0), int_lit(0)); - mir_fn.repr.bare_slots.insert(LocalId(1)); - mir_fn - }; - let carrier_slot = { - let mut mir_fn = int_predicate_fn(BinOp::Lt, int_local(0), int_lit(0)); - mir_fn.repr.carrier_slots.insert(LocalId(0)); - mir_fn - }; - for (case, mir_fn) in [ - ("bare param", bare_param), - ("bare return", bare_return), - ("bare let slot", bare_slot), - ("bare carrier slot", carrier_slot), - ] { - assert!( - sym_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "{case}: source plan must refuse a non-all-boxed repr" - ); - assert!( - fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "{case}: representation plan must refuse a non-all-boxed repr" - ); - } - // Control: the identical body with the default (all-boxed) repr plans. - let boxed = int_predicate_fn(BinOp::Lt, int_local(0), int_lit(0)); - assert!(fragment_plan_from_mir_fn(&boxed, &|_, _| None, &[]).is_some()); - } - - /// `named(egg) = y = egg; match y { None -> 0; Some(_) -> 1 }`: the - /// let-renamed subject resolves through the alias chain back to the - /// single param, so the encoded scrutinee is still the param-0 read the - /// wall face pins. - fn let_renamed_option_match_fn() -> MirFn { - let m = span(MirExpr::Match(span(MirMatch { - subject: Box::new(int_local(2)), - arms: vec![ - MirMatchArm { - pattern: MirPattern::Ctor { - ctor: MirCtor::Builtin(BuiltinCtor::OptionNone), - bindings: vec![], - binding_names: vec![], - }, - body: int_lit(0), - }, - MirMatchArm { - pattern: MirPattern::Ctor { - ctor: MirCtor::Builtin(BuiltinCtor::OptionSome), - bindings: vec![LocalId(1)], - binding_names: vec!["value".to_string()], - }, - body: int_lit(1), - }, - ], - }))); - let mut mir_fn = option_slot_count_fn(int_lit(1)); - mir_fn.body = let_expr(2, int_local(0), m); - mir_fn.local_count = 3; - mir_fn - } - - #[test] - fn let_renamed_option_match_lowers_to_tag_dispatch() { - let mir_fn = let_renamed_option_match_fn(); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("tag plan"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("let-renamed Option tag match must remain a source symbolic plan") - }; - assert!(matches!(sym.body.nodes[0].kind, SymNodeKind::Param { index: 0 })); - assert!(matches!( - &sym.body.nodes[1].kind, - SymNodeKind::TagMatch { - scrutinee: SymValueId(0), - .. - } - )); - } - - #[test] - fn chained_let_renames_resolve_recursively() { - // `y = egg; z = y; match z { ... }` — two hops back to the param. - let mut mir_fn = let_renamed_option_match_fn(); - let MirExpr::Let(spanned_let) = mir_fn.body.node else { - panic!("fixture body is a let") - }; - let mut inner_match = *spanned_let.node.body; - let MirExpr::Match(m) = &mut inner_match.node else { - panic!("fixture let body is a match") - }; - m.node.subject = Box::new(int_local(3)); - mir_fn.body = let_expr(2, int_local(0), let_expr(3, int_local(2), inner_match)); - mir_fn.local_count = 4; - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("tag plan"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("chained let renames must remain a source symbolic plan") - }; - assert!(matches!(sym.body.nodes[0].kind, SymNodeKind::Param { index: 0 })); - } - - #[test] - fn let_over_int_add_lowers_through_the_compute_face() { - // `m = x + 2; m` — the single read of `m` re-lowers the initializer, - // producing exactly the add-constant node order the compute face - // absorbed from the retired straight-line integer face. - let body = let_expr(1, binop(BinOp::Add, int_local(0), int_lit(2)), int_local(1)); - let mir_fn = int_param_fn("Int", body, 2); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("plan"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("let over int add should use SymPlan") - }; - assert!(matches!(sym.body.nodes[0].kind, SymNodeKind::Param { index: 0 })); - assert!(matches!(sym.body.nodes[1].kind, SymNodeKind::ConstInt(2))); - assert!(matches!( - sym.body.nodes[2].kind, - SymNodeKind::Prim { - op: SymPrim::IntAdd, - .. - } - )); - } - - #[test] - fn let_bound_comparison_feeds_the_if_condition() { - // `isLow = x >= 48; if isLow { x <= 57 } else { false }` — the - // `inRangeNamed` shape after `bool_match_to_if`. - let body = let_expr( - 1, - binop(BinOp::Gte, int_local(0), int_lit(48)), - if_expr( - int_local(1), - binop(BinOp::Lte, int_local(0), int_lit(57)), - bool_lit(false), - ), - ); - let mir_fn = int_param_fn("Bool", body, 2); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).expect("plan"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("let-bound comparison should use SymPlan") - }; - assert!(matches!( - sym.body.nodes[1].kind, - SymNodeKind::IntConstCmp { - op: SymIntCmp::Ge, - value: SymValueId(0), - constant: 48, - } - )); - assert!(matches!(sym.body.nodes[2].kind, SymNodeKind::If { cond: SymValueId(1), .. })); - } - - #[test] - fn multi_use_let_binding_stays_unplanned() { - // `y = x; if y > 0 { y <= 5 } else { false }` — TWO reads of `y` - // (condition + then branch). Inlining would be semantically fine for - // a pure alias, but the single-use gate is the contract: refuse. - let body = let_expr( - 1, - int_local(0), - if_expr( - binop(BinOp::Gt, int_local(1), int_lit(0)), - binop(BinOp::Lte, int_local(1), int_lit(5)), - bool_lit(false), - ), - ); - let mir_fn = int_param_fn("Bool", body, 2); - assert!( - fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "a let binding read more than once must stay unplanned" - ); - } - - #[test] - fn computed_alias_is_an_int_const_cmp_operand_on_the_compute_face() { - // `y = x + 2; y > 0` — the alias chain terminates in a COMPUTED - // expression, not a param read. The sign template over a computed - // carrier is exactly what the record projection-compute face - // interprets, and that face now takes scalar parameters, so the shape - // plans instead of staying unplanned. (It used to be refused because - // no face covered it, not because the plan was ill-formed.) - let body = let_expr( - 1, - binop(BinOp::Add, int_local(0), int_lit(2)), - binop(BinOp::Gt, int_local(1), int_lit(0)), - ); - let mir_fn = int_param_fn("Bool", body, 2); - let plan = fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]) - .expect("a computed sign test must plan through the compute face"); - let FragmentPlan::Sym(sym) = &plan else { - panic!("a computed sign test should use SymPlan") - }; - let table = FragHostTable::placeholder(); - let frag = sym - .to_expr_fragment_plan(&table, &FragStructTable::default()) - .expect("the sign test encodes to a representation plan"); - assert!(expr_fragment_record_compute_face(&frag, &table).is_some()); - } - - #[test] - fn let_with_unplannable_initializer_stays_unplanned() { - // `y = -x; y > 0` — `Neg` has no plan lowering, so the use-site - // lowering of the initializer fails and the fn stays unplanned. - let body = let_expr( - 1, - span(MirExpr::Neg(Box::new(int_local(0)))), - binop(BinOp::Gt, int_local(1), int_lit(0)), - ); - let mir_fn = int_param_fn("Bool", body, 2); - assert!( - fragment_plan_from_mir_fn(&mir_fn, &|_, _| None, &[]).is_none(), - "an unplannable initializer must keep the fn unplanned" - ); - } - - /// The kernel requires every node id to equal its position and the block - /// result to be the LAST node (PlanCheck.checkSymBlock). The builder - /// produces exactly that shape; `finish` now refuses anything else so a - /// future producer bug fails at the producer, not in the kernel. - #[test] - fn finish_enforces_kernel_block_shape_invariants() { - let params = std::collections::HashMap::new(); - let record_fields = |_: &str, _: &str| -> Option<(u32, String)> { None }; - let make_builder = |nodes: Vec| MirSymPlanBuilder { - params_by_slot: ¶ms, - record_fields: &record_fields, - builtins: &[], - aliases: std::collections::HashMap::new(), - alias_hops: 0, - nodes, - }; - let node = |id: usize| SymNode { - id: SymValueId(id), - ty: SymTy::Bool, - kind: SymNodeKind::ConstBool(true), - }; - assert!( - make_builder(vec![node(0), node(1)]) - .finish(SymValueId(0)) - .is_none(), - "a non-last result must not finish" - ); - assert!( - make_builder(vec![node(1)]).finish(SymValueId(0)).is_none(), - "a discontiguous node id must not finish" - ); - assert!( - make_builder(vec![node(0)]).finish(SymValueId(0)).is_some(), - "the canonical block shape must still finish" - ); - } - - #[test] - fn int_literal_on_left_flips_comparison_before_plan_lowering() { - let mir_fn = int_predicate_fn(BinOp::Lte, int_lit(0), int_local(0)); - let plan = expr_fragment_plan_from_mir_fn(&mir_fn).expect("plan"); - let FragNodeKind::If { - then_block, - else_block, - .. - } = &plan.body.nodes[3].kind - else { - panic!("root must be an if over small-vs-big AverInt carrier") - }; - - assert!(matches!( - then_block.nodes[3].kind, - FragNodeKind::Prim { - op: FragPrim::I64GeS, - .. - } - )); - assert!(matches!( - else_block.nodes[3].kind, - FragNodeKind::Prim { - op: FragPrim::I32GtS, - .. - } - )); - } -} From d94f2f1652b9e91e4b226c203f1ed055e932b3dc Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 03:46:46 +0200 Subject: [PATCH 16/89] cert: name the intrinsic and the newtype record in printer declines A decline now says which intrinsic a call is, and that a record create or projection is over a one-field record the emitter erases, instead of leaving those to the generic typing decline. Co-Authored-By: Claude Opus 5.5 (1M context) --- src/codegen/cert/plan_from_mir.rs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/codegen/cert/plan_from_mir.rs b/src/codegen/cert/plan_from_mir.rs index 8f8054db6..8ca0db6c1 100644 --- a/src/codegen/cert/plan_from_mir.rs +++ b/src/codegen/cert/plan_from_mir.rs @@ -656,6 +656,9 @@ impl Printer<'_> { MirExpr::RecordCreate(r) => { let rec = &r.node; let (tid, declared) = self.types.record_tid(self.layout, &rec.type_name)?; + if declared.len() < 2 { + return Err("RecordCreate of a one-field record (newtype)".into()); + } let written: Vec<&str> = rec.fields.iter().map(|f| f.name.as_str()).collect(); if written != declared.iter().map(String::as_str).collect::>() { return Err("RecordCreate (fields not in declared order)".into()); @@ -667,6 +670,9 @@ impl Printer<'_> { MirExpr::Project(p) => { let base_ty = stamped(&p.node.base)?; let (tid, declared) = self.types.record_tid(self.layout, &base_ty)?; + if declared.len() < 2 { + return Err("Project of a one-field record (newtype)".into()); + } let field = declared .iter() .position(|f| f == &p.node.field) @@ -694,7 +700,12 @@ impl Printer<'_> { self.types.str_seg(self.layout, s.as_bytes())?; Ok(PlanExpr::Literal(PlanLit::Str(s.as_bytes().to_vec()))) } - MirStrPart::Expr(e) => self.expr(e), + MirStrPart::Expr(e) => { + if stamped(e)? != "String" { + return Err("InterpolatedStr (a part is not a String)".into()); + } + self.expr(e) + } }) .collect::>()?, ), From ebf28346c6f5167d67f0661ad8ce439ea1b7f30b Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 04:31:38 +0200 Subject: [PATCH 17/89] cert: prove the whole-module facts one by one in the package A large module (payment_ops, workflow_engine) ran the whole-module conjunction out of the default elaboration budget in one `decide`. Each of the five facts is now its own theorem, and `Artifact.lean` states the same explicit heartbeat allowance the family packages carried. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/render_package.rs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 4e31f2513..5ad168f14 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -367,7 +367,10 @@ fn render_artifact( import ArtifactBytes\n\ import Manifest\n\ {roles_import}\n\ - set_option maxRecDepth 200000\n\n\ + 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\ def data : ArtifactData :=\n \ @@ -380,8 +383,14 @@ fn render_artifact( theorem strings_ok : decodedStringHostRoles data := by\n \ unfold decodedStringHostRoles; decide +kernel\n\n\ theorem axes_ok : AverCert.ClaimAxes.checked data = true := by decide +kernel\n\n\ - theorem whole_ok : acceptedWholeModule data := by\n \ - unfold acceptedWholeModule; refine ⟨?_, ?_, ?_, ?_, ?_⟩ <;> decide +kernel\n\n\ + theorem framing_ok : CertDecode.moduleFramingValid data.modBytes data.modLen = true := by\n \ + decide +kernel\n\n\ + theorem exports_ok : exportsAccounted data = true := by decide +kernel\n\n\ + theorem imports_ok : importsWithinCapabilities data = true := by decide +kernel\n\n\ + theorem start_ok : startAccounted data = true := by decide +kernel\n\n\ + theorem closure_ok : closureIsolation data = true := by decide +kernel\n\n\ + 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", From 7004f41474b0ef60de51e294a2cc295c1925f016 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 05:21:02 +0200 Subject: [PATCH 18/89] cert lint: bind the plan only through its code-entry equality The byte-binding lint counted `planTyped M e.plan` and `callsOrdered fns e` as binding every plan field and the call group, because both conjuncts sit in a definition whose `match` reads the bytes. With the code-entry equality removed the lint stayed green. Rule A1 now needs the callee to read the bytes itself, or the conjunct to meet them on its own. A new rule C2 recognises the real pin: a value lowered by a wall function and then compared for equality with the module bytes (`codeEntryBytes M e.plan` into `exactFuncBindingForExport`). The call scanner also finds calls nested in another call's arguments, so the function type pin `sigPinned` binds the signature. Rule D is now checked on the parsed application: every argument must be producer-free or a whole producer value that is not the value, an ancestor or a part of it, cannot contain its type, and has every leaf bound by the other rules or a standing allowance. `m.subject = subjectOfManifest m` no longer binds `Subject`. Only `obligationsDerived` fires D on the current wall. `FnEntry.group` becomes a declared-only allowance: partial correctness is one fuel induction over all plans, and the L3 check admits recursive calls only to members of the declared group, so a wrong grouping can only lose L3. Both counterexamples are regression tests. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/wall.rs | 108 ++++++ aver-cert/src/wall/byte_binding_lint.rs | 449 ++++++++++++++++++++++-- 2 files changed, 526 insertions(+), 31 deletions(-) diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index 5dc7b98cb..8d49ee4a1 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -379,6 +379,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( + " AverCert.WasmSlice.exactFuncBindingForExport n len (stringBytes e.name) bytes\n else\n (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 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 6755ba06c..30e703c7d 100644 --- a/aver-cert/src/wall/byte_binding_lint.rs +++ b/aver-cert/src/wall/byte_binding_lint.rs @@ -44,10 +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. -//! Under `xs.all (f a …)` every element of the producer list `xs` counts as -//! passed whole as `f`'s next parameter. +//! 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. @@ -56,12 +61,25 @@ //! 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 a wall definition applied to other producer values -//! (not to the value itself). The value then has no freedom of its own; its -//! inputs carry the freedom and need their own binding. This is how the -//! schema-9 obligations are pinned (`obligationsDerived`: the manifest's -//! obligations ARE `obligationsOf` of its plans). +//! 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 @@ -1220,6 +1238,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; @@ -1266,6 +1285,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; } @@ -1273,6 +1295,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 // --------------------------------------------------------------------------- @@ -1375,6 +1604,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(); @@ -1436,8 +1667,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) { @@ -1483,7 +1780,14 @@ pub fn analyse(sources: &[(&str, &str)]) -> Report { 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 @@ -1519,32 +1823,22 @@ 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: a producer value WHOLE on one side, and on the other a - // wall definition applied to other producer values. The - // value then has no freedom of its own: it is whatever the - // wall computes from its inputs, and those inputs carry the - // freedom (and their own bindings). This is how the - // obligations are pinned to `obligationsOf` of the plans. + // 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(); - let b_head = strip_wrappers(&b); - let head: String = b_head.chars().take_while(|c| is_token_char(*c)).collect(); - let head_is_wall_def = !head.is_empty() - && w.resolve(&head, &d.ns, &d.opens) - .and_then(|r| w.get(&r)) - .is_some_and(|g| g.kind == Kind::Def); - if a_whole && head_is_wall_def && !b.contains(stripped_a.trim()) { - for st in whole_producer_values(&w, &env, &stripped_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, "D/derived-by-wall-function", d, c); - } - } + 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; @@ -1591,6 +1885,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)) @@ -1675,6 +2045,23 @@ pub const ALLOWED: &[Allowance] = &[ 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", From 09c5d234a14ddca1f42c7d51db701480ad895cb9 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 05:27:13 +0200 Subject: [PATCH 19/89] cert wall: decline declarations that make an obligation vacuous An obligation quantifies over well-typed arguments. A declared type with no finite value made that hypothesis unsatisfiable and the obligation true of any code: a self-referential newtype `R = [record R]` (whose struct pin then reads as a tautology) used as a parameter or field, `eqref` in a signature, or a record `R = [int, record R]` over a self-referential struct. Such a package was accepted. `plansAccepted` now also requires `TypeTable.declsWellFormed`: - `eqref` only as the subject-scratch local, never in a signature, a record or constructor field, or an Option / Result / List / Vector element; - no newtype cycle; - every declared record and sum, and every parameter and result type of every plan, inhabited, by a least fixpoint over the type table. `inhabTy_sound` turns a passing check into a value, and the new theorem `AcceptanceSoundness.accepted_nonvacuous` states that every certified export of an accepted artifact has well-typed arguments and an inhabited result type. Opaque heap types join the struct indices that must be unique. The producer mirrors the check and declines per function. The local P4 variants probe gains the review's certificate and the other routes as negatives; each keeps every byte pin passing and is declined by the declaration check alone. The wall identity rotates. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../wall/current/AcceptanceSoundness.lean | 32 ++- .../wall/current/AcceptanceSoundnessCore.lean | 2 +- .../wall/current/AcceptedArtifactCore.lean | 8 +- aver-cert/assets/wall/current/TypeTable.lean | 206 +++++++++++++++++- aver-cert/src/engine/plan_check.rs | 92 ++++++++ aver-cert/src/engine/produce.rs | 35 +++ aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- 8 files changed, 371 insertions(+), 8 deletions(-) diff --git a/aver-cert/assets/wall/current/AcceptanceSoundness.lean b/aver-cert/assets/wall/current/AcceptanceSoundness.lean index a0f56eaa3..9f1e526f0 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundness.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundness.lean @@ -208,6 +208,35 @@ theorem accept_sound 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 @@ -227,7 +256,7 @@ theorem refTest_exact_of_accepted (artifact : ArtifactData) 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.2 + 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 @@ -238,5 +267,6 @@ theorem refTest_exact_of_accepted (artifact : ArtifactData) #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 6237681ef..cf9356636 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean @@ -165,7 +165,7 @@ theorem PlanFacts.nodup {s : Subject} {tt : TypeTable} {fns : List FnEntry} 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 + 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 diff --git a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean index b2e5fa1a3..bb83c7ffa 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean @@ -483,7 +483,10 @@ def acceptedWholeModule (artifact : ArtifactData) : Prop := 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. -/ + 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 @@ -491,7 +494,8 @@ def plansAccepted (artifact : ArtifactData) : Bool := 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 + roleTypesPinned artifact.modBytes artifact.modLen M && + declsWellFormed m.subject m.types m.fnPlans /-- The manifest's obligations are exactly the ones the wall derives from its plans: no obligation field is producer data. -/ diff --git a/aver-cert/assets/wall/current/TypeTable.lean b/aver-cert/assets/wall/current/TypeTable.lean index 5326a812b..73cab4ac9 100644 --- a/aver-cert/assets/wall/current/TypeTable.lean +++ b/aver-cert/assets/wall/current/TypeTable.lean @@ -228,13 +228,14 @@ def sumConfirmed (M : MCtx) (grp : List (List Nat × CertDecode.TypeEntry)) (d : 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). -/ +/-- 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.strVec.toList ++ tt.opaques.map (·.2) def natNodup : List Nat → Bool | [] => true @@ -283,4 +284,205 @@ def dataConfirmed (n len : Nat) (s : Subject) (tt : TypeTable) (fns : List FnEnt 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/src/engine/plan_check.rs b/aver-cert/src/engine/plan_check.rs index b12d53980..9f1839987 100644 --- a/aver-cert/src/engine/plan_check.rs +++ b/aver-cert/src/engine/plan_check.rs @@ -629,6 +629,98 @@ fn plan_typed(m: &MCtx<'_>, p: &FnPlan) -> bool { && 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, diff --git a/aver-cert/src/engine/produce.rs b/aver-cert/src/engine/produce.rs index 1bce14fe0..05bbf3e24 100644 --- a/aver-cert/src/engine/produce.rs +++ b/aver-cert/src/engine/produce.rs @@ -187,6 +187,25 @@ fn confirm_type_table(facts: &ModuleFacts, tt: &mut PlanTypeTable) { }); 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 { @@ -214,6 +233,7 @@ fn confirm_type_table(facts: &ModuleFacts, tt: &mut PlanTypeTable) { 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 = ( @@ -490,6 +510,21 @@ fn check_candidate( 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()); }; diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 3763cb005..0afe1195a 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:c8232f4aa548014f86fda03ef7dfd4e9dd2b19c595001ba4a2c2dcf4773c1a3c"; + "sha256:0b51135f43262e048e73037b9024b6e0480462196d65811bb3472e7d2d7a5a35"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 8ad432034..f9c1594dd 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 carries no law-claims and no source bridges yet: a package declaring either is refused. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 19 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:c8232f4aa548014f86fda03ef7dfd4e9dd2b19c595001ba4a2c2dcf4773c1a3c` (`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. +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 19 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:0b51135f43262e048e73037b9024b6e0480462196d65811bb3472e7d2d7a5a35` (`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 = 9` 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. From cd7999edbc3301dd348b469ea0651a5c93173a4d Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 05:29:46 +0200 Subject: [PATCH 20/89] cert docs: disclose the helper model, the unpinned sub-routines and L3 limits The trust inventory now states three assumptions the statement makes: - runtime helpers are modelled as pure functions of their argument values, so the theorem assumes they mutate nothing the caller can reach; the mutability of the carrier's fields and of `$string` is not pinned; - the bignum sub-routines the add, sub, mul and cmp templates call are not pinned, so the truth of those contracts for a given artifact rests on code the certificate does not look at (this predates schema 9); - "returns" at L3 is about the wall's interpreter: stack exhaustion and allocation failure in a real engine are not covered. The architecture document's trust boundary lists these and the two wasm GC facts behind the exact `ref.test`. Co-Authored-By: Claude Opus 5.5 (1M context) --- docs/certificate-format.md | 3 +++ docs/certification-architecture.md | 3 +++ 2 files changed, 6 insertions(+) diff --git a/docs/certificate-format.md b/docs/certificate-format.md index f9c1594dd..d4a2927bf 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -353,6 +353,9 @@ What a positive verdict does trust — the honest TCB: - **`wasmparser`** for full WebAssembly validity (stage 2 rationale): the input is attacker-chosen and the Lean wall does not subsume this check, so it sits on the adversarial path. - **SHA-256 collision resistance**, for both the artifact hash and the wall identity — the two bindings that make a certificate non-transferable. An adversary who can produce SHA-256 collisions can transplant a certificate onto different bytes or a different wall. - **The named runtime contracts** — the L1 theorems are conditional on the host helpers obeying the disclosed laws, and the L3 theorems additionally on the disclosed totality; proving the shipped runtime satisfies them is a per-toolchain-release obligation outside the certificate. +- **Runtime helpers modelled as pure value functions.** The statement wires each runtime helper as a function from argument values to an optional result value (`Schema.HostFns`), and the wall's interpreter has no heap: a struct or array is an immutable value. The theorem therefore assumes that a helper does not mutate anything reachable from the values it is given or that the caller still holds. Nothing in the bytes enforces this: the type-table pin compares field storage only, so the mutability of the carrier's fields and of `$string` (`(array (mut i8))`) is not pinned, and a helper that wrote through a reference it was passed would break the model without breaking any pin. +- **The bignum sub-routines behind add, sub, mul and cmp.** The template equality of section 4.3 pins the bodies of the `box`, `toIndex`, `add`, `sub`, `mul`, `cmp` and `eq` helpers, and the add, sub and mul templates (and the three-way `cmp` template, for three of them) call four factored sub-routines at declared indices (`arithParams.decompose`, `normalize`, `strip`, `umagCmp`). The bodies of those four functions are not pinned: the wall confirms only that the pinned templates call the declared indices. Whether the add, sub, mul and cmp contracts hold for a given artifact therefore rests on code the certificate does not look at. This predates schema 9 and is not changed by it; it is one more reason the runtime contracts above are a per-release obligation rather than a fact about the artifact. +- **"Returns" at L3 is a statement about the wall's interpreter.** `holdsTotal` says the emitted function returns at fuel `n.natAbs + 1` in the wall's interpreter, where fuel counts nested calls and nothing else runs out. A real engine has a bounded call stack and a bounded heap, so for large `n` a run can still trap on stack exhaustion or allocation failure; neither is covered, and the L3 promise must not be read as "the engine returns for every input". - **The plan is the claim — for an export without a credited source-bridge.** For every export certified through the declared compute face (`recordCompute`), the obligation's `model` is the evaluation of the plan the manifest declares (`StandardFace.recordComputeModel Plans.Plan.body`), and the report line prints that plan. Since schema 8 the identification of that plan with the function the user wrote IS a kernel-checked theorem wherever the package declares a source-bridge and the verifier credits it (section 4.1): `AverCert.Bridge. : ∀ x, StandardFace.recordComputeModel Plans.Plan.body (encodeArgs x) = some (encodeResult (. x))`, pinned by `AverCertChecker.bridge_pin_` at a statement the VERIFIER rendered from the manifest's declared structure — not at one the package wrote — and axiom-audited like any other claim. A law-claim whose `bridges` list is non-empty therefore conjoins, under one kernel-checked name, the universal law of the source model, `Holds` about the plan, and the plan-equals-source identity of every function the law mentions — the three halves are no longer identified by construction. What remains trusted is narrower and must be stated as such: (i) the ENCODERS, which the producer chooses and which are part of the theorem's statement, so a reader must read the statement rather than the export name — the verifier constrains their SHAPE (a closed kind set, `_root_.`-qualified names, accessors of the type they claim to project) but not that they are the encoding the user meant; (ii) **the MODEL definition itself, which is producer-emitted.** `_root_..` is a definition the package's own model modules carry, so `plan ≡ ` is kernel-checked RELATIVE TO those modules: it says the plan and the transpiled definition agree, not that the transpilation of the user's source was faithful. That is the same trust boundary the law-claims surface already disclosed — a law is a theorem about the emitted model — and the bridge narrows the gap between the two halves of a certificate without closing this one; (iii) an export with NO declared or no credited bridge, where the old disclosure stands unchanged — the plan is the claim, and its correspondence to the source rests on the producer deriving the plan from the source program's MIR. Today the shapes without a bridge are exactly those whose source signature has no `SVal` image: a parameter or result that is a nested record, a record with a non-Int field, a Float, a String, or a user ADT; a source signature the producer cannot resolve unambiguously to a transpiled definition; and an export whose fixed bridge tactic script does not close, which is reported as an uncredited bridge rather than a silent one. A reimplementation MUST NOT present an UNCREDITED or undeclared bridge as establishing the identity, and MUST NOT present a law-claim with an empty `bridges` list as a kernel-checked statement about the bytes alone. - **Two wasm GC facts behind the exact `ref.test` (S-3).** The audited interpreter's `ref.test` and `ref.cast` compare type indices exactly, while wasm GC tests subtyping, and a variant `match` lowers to a `ref.test` cascade over the constructor structs. The wall pins every constructor struct of every declared sum as `sub final` under the sum's root, inside the rec group that opens the type section (`TypeTable.sumConfirmed`, over the raw entries `GrammarLower.S3Pin` reads), and proves that under this pin the exact test IS the subtype test on those structs (`GrammarSound.ctor_refTest_exact`; for an accepted artifact, `AcceptanceSoundness.refTest_exact_of_accepted`). That proof rests on two facts of the wasm GC specification, carried as the explicit hypothesis `GrammarSound.GcTestSpec` and deliberately not as axioms: (i) subtyping is reflexive; (ii) a type declared final has no subtype in its own rec group other than itself (validation rejects a `sub` that names a final supertype, and distinct positions of one rec group are distinct types under iso-recursive type equivalence). A reimplementation MUST keep the pin, and relies on these two facts exactly as the reference verifier does. - **Explicit source read declarations** — user-ADT domain meaning, representation interpretation, and non-reconstructible models (section 5.1) are conditions of the theorem, not derived facts. diff --git a/docs/certification-architecture.md b/docs/certification-architecture.md index 404eb78de..0c15af970 100644 --- a/docs/certification-architecture.md +++ b/docs/certification-architecture.md @@ -183,6 +183,9 @@ A successful verdict depends on: - the canonical local Elan home used to resolve that pinned toolchain; - SHA-256 collision resistance; - the semantic truth and totality, where required, of named runtime contracts; + these include code the certificate does not pin (the bignum sub-routines the add, sub, mul and cmp helpers call), and they model every helper as a pure function of its argument values that mutates nothing the caller can reach (see the trust inventory in certificate-format.md, section 10); +- two facts of the wasm GC specification behind the exact `ref.test` of a variant match (subtyping is reflexive; a final type has no other subtype in its own rec group), carried as the explicit hypothesis `GrammarSound.GcTestSpec`, not as axioms; +- for L3, the wall's interpreter as the meaning of "returns": fuel counts nested calls only, so stack exhaustion or allocation failure in a real engine at large inputs is not covered; - the explicit source declarations that a binary cannot determine; - any explicitly configured local build-cache directory. From 35fcda43bebc7f4b1931a6cb9c8cbbe0a0102cb2 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 06:35:13 +0200 Subject: [PATCH 21/89] Lean proof export: decline the lift of a generic-oracle effect instead of panicking An effectful function using Wait.poll, whose oracle is generic over its key type, lifted to a signature with an unresolved type variable, and the Lean type renderer panicked on it, aborting the whole export (btc-listener's model emission). The lift now declines with GenericOracle and proof export drops that one function, as it already does for any function it cannot lift. Co-Authored-By: Claude Opus 5.5 (1M context) --- src/codegen/lean/tests.rs | 40 +++++++++++++++++++++++++++++ src/types/checker/effect_lifting.rs | 23 +++++++++++++++++ 2 files changed, 63 insertions(+) diff --git a/src/codegen/lean/tests.rs b/src/codegen/lean/tests.rs index 65bf655cb..fb04c3ffa 100644 --- a/src/codegen/lean/tests.rs +++ b/src/codegen/lean/tests.rs @@ -5403,3 +5403,43 @@ mod citation_probe; mod decidable_normalization; mod waterfall; + +/// `Wait.poll` has an oracle generic over its key type. Lifting an +/// effectful function that uses it has no single oracle parameter type to +/// prepend: the lift declines with `GenericOracle`, and proof export drops +/// that function instead of panicking on the unresolved type variable (the +/// whole export of a program with such a function used to abort on it). +#[test] +fn generic_oracle_effect_declines_the_lift() { + let source = r#" +module WaitProbe + depends [Wait] + intent = "An effectful helper over the generic Wait.poll oracle." + exposes [pollOnce] + effects [Wait.poll] + +fn pollOnce(items: Map) -> Result, String> + ? "Polls the wait set once." + ! [Wait.poll] + Wait.poll(items, 0) +"#; + let ctx = ctx_from_source(source, "WaitProbe"); + let fd = ctx + .fn_defs + .iter() + .find(|fd| fd.name == "pollOnce") + .expect("pollOnce is parsed"); + let lifted = crate::types::checker::effect_lifting::lift_fn_def_with_helpers_and_registry( + fd, + &HashMap::new(), + &ctx.capabilities, + ); + assert!( + matches!( + lifted, + Err(crate::types::checker::effect_lifting::LiftError::GenericOracle { ref method }) + if method == "Wait.poll" + ), + "{lifted:?}" + ); +} diff --git a/src/types/checker/effect_lifting.rs b/src/types/checker/effect_lifting.rs index a395ee963..18e176093 100644 --- a/src/types/checker/effect_lifting.rs +++ b/src/types/checker/effect_lifting.rs @@ -369,6 +369,11 @@ pub enum LiftError { /// already rejects these earlier, but the lifter re-checks to keep /// the invariant local. UnclassifiedEffect { method: String }, + /// The operation's oracle is generic (`Wait.poll`): its signature + /// mentions a type variable that only a call site instantiates, so there + /// is no single oracle parameter type to prepend. Proof export drops the + /// function instead of emitting an unresolved type. + GenericOracle { method: String }, } /// Lift a function body under the given configuration. @@ -1300,6 +1305,11 @@ pub fn oracle_params_for_effects_with_registry( _ => { let binding = oracle_binding_name_for(name, capabilities); let type_str = match oracle_signature_with_registry(capabilities, name) { + Some(t) if type_mentions_var(&t) => { + return Err(LiftError::GenericOracle { + method: name.clone(), + }); + } Some(t) => type_to_annotation(&t), None => continue, }; @@ -1310,6 +1320,19 @@ pub fn oracle_params_for_effects_with_registry( Ok(out) } +/// Whether a type still carries a type variable (or checker recovery), which +/// no backend type can spell. +fn type_mentions_var(ty: &Type) -> bool { + match ty { + Type::Var(_) | Type::Invalid => true, + Type::Result(a, b) | Type::Map(a, b) => type_mentions_var(a) || type_mentions_var(b), + Type::Option(a) | Type::List(a) | Type::Vector(a) => type_mentions_var(a), + Type::Tuple(items) => items.iter().any(type_mentions_var), + Type::Fn(params, ret, _) => params.iter().any(type_mentions_var) || type_mentions_var(ret), + Type::Int | Type::Float | Type::Str | Type::Bool | Type::Unit | Type::Named { .. } => false, + } +} + /// Choose the synth BranchPath param name. Defaults to `path` (the /// name every stub and example writes); falls back to the first /// collision-free `branch_path` / `__branch_path__N` only when the From f709d7b453b9204d4c21528bdf184216b5faef05 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 07:31:26 +0200 Subject: [PATCH 22/89] cert wall: add GrammarBridge, the plan-equals-source statement kinds and proof engines The wall now defines what a schema-9 bridge says about an export's obligation (exportObligation, ArgsTyped, the exact and adequate kinds) and what an adequate bridge means for the bytes (adequate_transfer). Two engines assemble a bridge from one step lemma per function: bridge_of_step (adequacy at every fuel by one fuel induction over a call closure, through evaluation monotonicity, so recursion and mutual recursion need no per-function induction) and exact_of_step (exact answers above a declared call depth for a closure without recursion). String values get their byte encoding strBytes, its injectivity and the choice decoder decodeStr. The wall id rotates. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/GrammarBridge.lean | 408 ++++++++++++++++++ aver-cert/assets/wall/current/lakefile.lean | 2 +- aver-cert/src/format.rs | 2 +- aver-cert/src/wall.rs | 10 +- docs/certificate-format.md | 2 +- 5 files changed, 419 insertions(+), 5 deletions(-) create mode 100644 aver-cert/assets/wall/current/GrammarBridge.lean diff --git a/aver-cert/assets/wall/current/GrammarBridge.lean b/aver-cert/assets/wall/current/GrammarBridge.lean new file mode 100644 index 000000000..2c2429564 --- /dev/null +++ b/aver-cert/assets/wall/current/GrammarBridge.lean @@ -0,0 +1,408 @@ +/- 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 + +/-- 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 (.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/lakefile.lean b/aver-cert/assets/wall/current/lakefile.lean index 97fc6d05b..60d3fd5e6 100644 --- a/aver-cert/assets/wall/current/lakefile.lean +++ b/aver-cert/assets/wall/current/lakefile.lean @@ -11,4 +11,4 @@ lean_lib «CertPrelude» where `SchemaSanity, `WasmSlice, `Wasip2Envelope, `ArithTemplateDerisk, `InterpreterSequencing, `Grammar, `GrammarLower, `GrammarSound, `GrammarTotal, `TypeTable, `AcceptedArtifactCore, `ClaimAxes, `AcceptanceSoundnessCore, - `AcceptanceSoundness] + `AcceptanceSoundness, `GrammarBridge] diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 0afe1195a..a41d7957c 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:0b51135f43262e048e73037b9024b6e0480462196d65811bb3472e7d2d7a5a35"; + "sha256:f50e6372020e27a976216ca24607e846f815d1e7986b28a60d762026bb690994"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index 8d49ee4a1..c15e8a579 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -36,6 +36,7 @@ pub const CERT_ACCEPTANCE_SOUNDNESS_CORE: &str = include_str!("../assets/wall/current/AcceptanceSoundnessCore.lean"); pub const CERT_ACCEPTANCE_SOUNDNESS: &str = include_str!("../assets/wall/current/AcceptanceSoundness.lean"); +pub const CERT_GRAMMAR_BRIDGE: &str = include_str!("../assets/wall/current/GrammarBridge.lean"); #[derive(Clone, Copy, Debug, Eq, PartialEq)] pub struct Source { @@ -45,7 +46,7 @@ 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; 19] = [ +pub const SOURCES: [Source; 20] = [ Source { name: "AcceptanceSoundness.lean", contents: CERT_ACCEPTANCE_SOUNDNESS, @@ -82,6 +83,10 @@ pub const SOURCES: [Source; 19] = [ name: "Grammar.lean", contents: CERT_GRAMMAR, }, + Source { + name: "GrammarBridge.lean", + contents: CERT_GRAMMAR_BRIDGE, + }, Source { name: "GrammarLower.lean", contents: CERT_GRAMMAR_LOWER, @@ -126,7 +131,7 @@ pub const SOURCES: [Source; 19] = [ /// Roots whose complete import graph is artifact-independent and can therefore /// be cached before a certificate is seen. -pub const PRISTINE_ROOTS: [&str; 17] = [ +pub const PRISTINE_ROOTS: [&str; 18] = [ "CertPrelude", "CertDecode", "ArithTemplateDerisk", @@ -144,6 +149,7 @@ pub const PRISTINE_ROOTS: [&str; 17] = [ "ClaimAxes", "AcceptanceSoundnessCore", "AcceptanceSoundness", + "GrammarBridge", ]; #[derive(Debug)] diff --git a/docs/certificate-format.md b/docs/certificate-format.md index d4a2927bf..692b1daa4 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 carries no law-claims and no source bridges yet: a package declaring either is refused. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 19 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:0b51135f43262e048e73037b9024b6e0480462196d65811bb3472e7d2d7a5a35` (`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. +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 20 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:f50e6372020e27a976216ca24607e846f815d1e7986b28a60d762026bb690994` (`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 = 9` 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. From cc6d57953bd6d9a4fdabd4fbd145efd77de87885 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 07:31:32 +0200 Subject: [PATCH 23/89] Lean certificate model: keep the native recursion equations The certificate model converted well-founded Int recursion to explicit fuel for the retired recursion wall. A plan-equals-source bridge unfolds a source function one step through its equation lemma instead, which a fuel wrapper does not offer, so the model now keeps the same recursion shapes as proof export. The entry and dependency Lean namespaces are exposed so the certificate producer can name a transpiled function by its wasm export. Co-Authored-By: Claude Opus 5.5 (1M context) --- src/codegen/lean/mod.rs | 63 ++++++++++++++++----------------------- src/codegen/lean/tests.rs | 8 +++-- 2 files changed, 30 insertions(+), 41 deletions(-) diff --git a/src/codegen/lean/mod.rs b/src/codegen/lean/mod.rs index 8a53c2678..e52204b1e 100644 --- a/src/codegen/lean/mod.rs +++ b/src/codegen/lean/mod.rs @@ -318,45 +318,32 @@ pub fn transpile_for_proof_mode( /// Proof-mode transpilation for an artifact CERTIFICATE's reused model /// modules. /// -/// The same source semantics as [`transpile_for_proof_mode`], with subtractive -/// countdowns retaining the explicit fuel model consumed by the certificate -/// recursion wall. Emitted -/// without the proof-only executable machinery that the `aver proof` -/// sample checks rely on: the `@[implemented_by]`/`unsafe` `DecidableEq` -/// shims (user recursive types and `Float`), the `verify` sample-check -/// `example … := by native_decide` blocks, and the `@[simp]` string-prelude -/// spec lemmas. A certificate never elaborates those — it carries its own -/// decode-to-`Int`/bytes anti-vacuity guards — and the checker's -/// elaboration-executes-code wall rejects the `unsafe`/`implemented_by`/ -/// `@[` tokens they contain. The mode drops them at the source so the -/// certificate's model data files stay kernel-clean, instead of stripping -/// them out of already-emitted text. The `aver proof` emission is -/// untouched (this is a distinct entry point). +/// The same source semantics and the same recursion shapes as +/// [`transpile_for_proof_mode`] (native `termination_by` equations, so a +/// certificate bridge can unfold a recursive function one step through its +/// equation lemma), emitted without the proof-only executable machinery that +/// the `aver proof` sample checks rely on: the `@[implemented_by]`/`unsafe` +/// `DecidableEq` shims (user recursive types and `Float`), the `verify` +/// sample-check `example … := by native_decide` blocks, and the `@[simp]` +/// string-prelude spec lemmas. A certificate never elaborates those, and the +/// checker's elaboration-executes-code wall rejects the +/// `unsafe`/`implemented_by`/`@[` tokens they contain. The mode drops them at +/// the source so the certificate's model data files stay kernel-clean, +/// instead of stripping them out of already-emitted text. The `aver proof` +/// emission is untouched (this is a distinct entry point). pub fn transpile_for_cert_model(ctx: &mut CodegenContext) -> ProjectOutput { - // The certificate recursion wall relates its evaluator to the explicit - // fuel model. Keep that representation at this consumer boundary; proof - // export uses native equations. Adapt the contracts too, so law emission - // sees the same definitions as the certificate model actually contains. - let mut native = Vec::new(); - for (id, contract) in &mut ctx.proof_ir.fn_contracts { - if let Some(crate::ir::RecursionContract::WellFoundedToNat { - param, - floor_div: None, - }) = &contract.recursion - { - let fuel = crate::ir::RecursionContract::Fuel { - fuel_metric: crate::ir::FuelMetric::NatAbsPlusOne { - param: param.clone(), - }, - }; - native.push((*id, contract.recursion.replace(fuel))); - } - } - let output = transpile_unified(ctx, VerifyEmitMode::NativeDecide, LeanEmitMode::Proof, true); - for (id, recursion) in native { - ctx.proof_ir.fn_contracts.get_mut(&id).unwrap().recursion = recursion; - } - output + transpile_unified(ctx, VerifyEmitMode::NativeDecide, LeanEmitMode::Proof, true) +} + +/// The Lean namespace the entry module's definitions are emitted in. +pub fn cert_model_entry_namespace(ctx: &CodegenContext) -> String { + lean_project_name(ctx) +} + +/// The Lean namespace a dependency module's definitions are emitted in: its +/// module path with every reserved segment escaped. +pub fn cert_model_module_namespace(module_path: &str) -> String { + syntax::aver_path_to_lean(module_path) } /// Transpile an Aver program to a Lean 4 project with configurable verify proof mode. diff --git a/src/codegen/lean/tests.rs b/src/codegen/lean/tests.rs index fb04c3ffa..6fdc63dd6 100644 --- a/src/codegen/lean/tests.rs +++ b/src/codegen/lean/tests.rs @@ -5367,7 +5367,7 @@ verify digits law emptyMeansSmall } #[test] -fn certificate_countdown_model_keeps_the_wall_contract_and_restores_proof_context() { +fn certificate_countdown_model_uses_the_native_equations() { let mut ctx = ctx_from_source( r#"module CountdownModel exposes [count] @@ -5384,9 +5384,11 @@ fn count(n: Int, acc: Int) -> Int VerifyEmitMode::NativeDecide, )); assert!(before.contains("termination_by n.toNat"), "{before}"); + // A certificate bridge unfolds `count` one step through its equation + // lemma, so the model keeps the native recursion, not a fuel wrapper. let model = generated_lean_file(&transpile_for_cert_model(&mut ctx)); - assert!(model.contains("def count__fuel"), "{model}"); - assert!(!model.contains("termination_by n.toNat"), "{model}"); + assert!(model.contains("termination_by n.toNat"), "{model}"); + assert!(!model.contains("def count__fuel"), "{model}"); let after = generated_lean_file(&transpile_for_proof_mode( &mut ctx, VerifyEmitMode::NativeDecide, From e660783a5fa21cbe2a708e9ae52c99c5d86407e8 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 07:32:13 +0200 Subject: [PATCH 24/89] cert: plan-equals-source bridges and law-claims on schema 9 The producer emits the Lean source model again at --certify (a panic in that emission costs the package its bridges and law-claims, never the byte certificate) and bridges every certified export whose source definition, encoders and callees resolve. Encoders cover Int, Bool, Float, String, records, user sums, Option, Result, tuples, lists and vectors; a parameter must also decode (Float, List and Vector parameters and recursive types decline). Bridge.lean proves one step lemma per function and assembles each export's bridge with GrammarBridge.exact_of_step for a call closure without recursion and GrammarBridge.bridge_of_step otherwise. Every proof is first | script | sorry under a heartbeat cap, so a proof that does not close costs exactly the bridges whose closure uses it. The manifest entry gains the statement kind, and the encoder specs their schema-9 forms; the checker renders the statement from that structure with the one renderer both sides share, pins and audits each bridge and each bridged law as before, and no longer refuses either surface. Nested model files are admitted through Bridge.lean and Laws.lean imports. The k5 law and bridge tamper tests are ported to the new surface. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/bridge_statement.rs | 864 +++++++++--- aver-cert/src/engine/law_claims.rs | 11 +- aver-cert/src/engine/mod.rs | 2 + aver-cert/src/engine/produce.rs | 8 + aver-cert/src/engine/render_package.rs | 88 +- aver-cert/src/engine/source_bridges.rs | 1788 ++++++++++++++++++++++++ aver-cert/src/verifier.rs | 336 +++-- docs/certificate-format.md | 12 +- src/main/commands.rs | 91 +- tests/cert_verify_spec.rs | 166 ++- 10 files changed, 3015 insertions(+), 351 deletions(-) create mode 100644 aver-cert/src/engine/source_bridges.rs diff --git a/aver-cert/src/bridge_statement.rs b/aver-cert/src/bridge_statement.rs index a71bda3fe..a8c8aacba 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 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 accessors, each a field of `lean_type`. - accessors: Vec, + /// `_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,339 @@ 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 { + 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})") + } + SourceEncoder::Sum { tid, .. } => format!("({TY}.sum {tid})"), + SourceEncoder::Option(elem) => format!("({TY}.option {})", elem.grammar_ty()), + SourceEncoder::Result { ok, err } => { + format!("({TY}.result {} {})", ok.grammar_ty(), err.grammar_ty()) + } + SourceEncoder::List(elem) => format!("({TY}.list {})", elem.grammar_ty()), + SourceEncoder::Vector(elem) => format!("({TY}.vec {})", elem.grammar_ty()), } } /// 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. + pub fn encode(&self, value: &str, fresh: &mut usize) -> 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(&format!("{accessor} ({value})"), fresh)) + .collect::>() + .join(", "); + format!("{SVAL}.record {tid} [{leaves}]") } - SourceEncoder::Record { accessors, .. } => { - let mut leaves = String::new(); - for (index, accessor) in accessors.iter().enumerate() { - if index > 0 { - leaves.push_str(", "); + SourceEncoder::Tuple { tid, elems } => { + let components = tuple_components(value, elems.len()); + let leaves = elems + .iter() + .zip(components) + .map(|(enc, component)| enc.encode(&component, fresh)) + .collect::>() + .join(", "); + format!("{SVAL}.record {tid} [{leaves}]") + } + 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(name, fresh)) + .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 {tid} {index} [{leaves}]")); } - format!("_root_.RecordComputeBridge.SVal.r [{leaves}]") + format!("(match ({value}) with{arms})") + } + SourceEncoder::Option(elem) => { + let y = bind(fresh); + let ty = elem.grammar_ty(); + format!( + "(match ({value}) with | _root_.Option.none => {SVAL}.none {ty} \ + | _root_.Option.some {y} => {SVAL}.some {ty} ({}))", + elem.encode(&y, fresh) + ) + } + SourceEncoder::Result { ok, err } => { + let y = bind(fresh); + let z = bind(fresh); + let (t, e) = (ok.grammar_ty(), err.grammar_ty()); + format!( + "(match ({value}) with | _root_.Except.ok {y} => {SVAL}.ok {t} {e} ({}) \ + | _root_.Except.error {z} => {SVAL}.err {t} {e} ({}))", + ok.encode(&y, fresh), + err.encode(&z, fresh) + ) + } + SourceEncoder::List(elem) => { + let y = bind(fresh); + let acc = bind(fresh); + let ty = elem.grammar_ty(); + format!( + "(_root_.List.foldr (fun {y} {acc} => {SVAL}.cons {ty} ({}) {acc}) \ + ({SVAL}.nil {ty}) ({value}))", + elem.encode(&y, fresh) + ) + } + SourceEncoder::Vector(elem) => { + let y = bind(fresh); + format!( + "{SVAL}.vec {} (_root_.List.map (fun {y} => {}) (_root_.Array.toList ({value})))", + elem.grammar_ty(), + elem.encode(&y, fresh) + ) } } } - /// 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. + /// 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, 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,14 +497,18 @@ 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 a trailing-prime `'` (the transpiler's +/// reserved-word escape). 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 == '_') + let head_ok = + matches!(chars.next(), Some(first) if first.is_ascii_alphabetic() || first == '_'); + let body: String = chars.collect(); + let body = body.trim_end_matches('\''); + head_ok && body.chars().all(|c| c.is_ascii_alphanumeric() || c == '_') }) } @@ -162,15 +517,15 @@ 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,13 +539,22 @@ 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 bridge statement for one export: the plan its obligation evaluates, -/// applied to the encoded arguments, is the encoded source result. +/// 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. /// /// 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 @@ -198,31 +562,43 @@ pub fn plan_body_name(export: &str) -> String { 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(' '); + let binders = param_binders(params); + let forall = |body: String| { + if binders.is_empty() { + body + } else { + format!("∀ {binders}, {body}") } - 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() - } else { - format!("∀ {binders}, ") + }; + 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) ) } @@ -282,168 +658,312 @@ mod tests { 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. #[test] - fn every_encoder_kind_renders_its_exact_statement() { + fn both_kinds_render_their_exact_statement() { 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))" + "∃ 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)))" ); assert_eq!( render_bridge_statement( - "Domain_Rational_lessThan", - "Domain.Rational.lessThan", - &[fraction(), fraction()], - &SourceEncoder::Bool, + "sumFrom", + "RecGen.sumFrom", + BridgeKind::Adequate, + &[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 \ + \"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 quantifier, and the source call is the bare name. + // Nullary: no parameter binders, and the source call is the bare name. assert_eq!( render_bridge_statement( "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))]))" ); } - /// 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. + #[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 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.")); + // named obligation's model, never the source call. + assert!(honest.contains("_root_.AverCert.Schema.Obligation.model o fuel")); } #[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 reserved_word_primes_are_plain_names() { + assert!(is_plain_dotted_name("_root_.Models.Type'.field")); + assert!(!is_plain_dotted_name("_root_.Models.'x")); + assert!(!is_plain_dotted_name("_root_.Models.x'y")); } } diff --git a/aver-cert/src/engine/law_claims.rs b/aver-cert/src/engine/law_claims.rs index 5a03ea408..78fda2f46 100644 --- a/aver-cert/src/engine/law_claims.rs +++ b/aver-cert/src/engine/law_claims.rs @@ -172,7 +172,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( @@ -188,6 +192,11 @@ pub fn render_laws_lean(claims: &[LawClaim], bridge_statements: &[Vec<(String, S 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"); } diff --git a/aver-cert/src/engine/mod.rs b/aver-cert/src/engine/mod.rs index a3468c6fe..45e4c93dc 100644 --- a/aver-cert/src/engine/mod.rs +++ b/aver-cert/src/engine/mod.rs @@ -104,5 +104,7 @@ include!("produce.rs"); #[cfg(feature = "engine")] include!("module_envelope.rs"); #[cfg(feature = "engine")] +include!("source_bridges.rs"); +#[cfg(feature = "engine")] include!("render_package.rs"); include!("law_claims.rs"); diff --git a/aver-cert/src/engine/produce.rs b/aver-cert/src/engine/produce.rs index 05bbf3e24..7d2960412 100644 --- a/aver-cert/src/engine/produce.rs +++ b/aver-cert/src/engine/produce.rs @@ -30,6 +30,9 @@ pub struct CertifiedExport { 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, @@ -777,6 +780,11 @@ pub fn analyze( 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, diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 5ad168f14..8b7625ddd 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -106,9 +106,6 @@ pub struct ProjectDeclines { pub source_bridges: Vec<(String, String)>, } -/// Why a law-claim or a source bridge is not declared by a schema-9 package. -pub const SCHEMA9_BRIDGE_PENDING: &str = "schema 9 does not carry law-claims or source bridges yet: the certified model is the plan itself"; - fn lean_str(s: &str) -> String { let mut out = String::with_capacity(s.len() + 2); out.push('"'); @@ -457,6 +454,9 @@ fn render_manifest_json( target: &str, abi: &str, envelope: Option, + laws: &[LawClaim], + law_bridges: &[Vec], + bridges: &[SourceBridge], declined_bridges: &[(String, String)], ) -> String { let any_total = analysis.certified.iter().any(|c| c.total); @@ -505,8 +505,34 @@ fn render_manifest_json( " \"runtime_contracts\": {},\n", json_list(&analysis.contracts, |c| json_str(c)) )); - s.push_str(" \"laws\": [],\n"); - s.push_str(" \"sourceBridges\": [],\n"); + // 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!( @@ -598,13 +624,14 @@ fn render_manifest_json( /// artifact data with its byte-fact proofs, the final theorem, and the JSON /// manifest the checker reads. Any existing `cert/` directory is replaced. /// -/// Schema 9 declares no law-claims and no source bridges yet: each law the -/// model emission recorded comes back in [`ProjectDeclines`] with the reason. +/// 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, - law_claims: Vec, + model: &SourceModel, ) -> Result { artifact.validate()?; let cert_dir = out_dir.join("cert"); @@ -653,7 +680,27 @@ pub fn write_project( &render_artifact_certificate(), )?; - let declined_bridges: Vec<(String, String)> = Vec::new(); + // 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 &model.files { + write_nested(&cert_dir, path, &sanitize_model_for_cert(content))?; + } + } + let bridges: &[SourceBridge] = if surfaces.bridge_lean.is_some() { + &surfaces.bridges + } else { + &[] + }; + if let Some(bridge_lean) = &surfaces.bridge_lean { + write(&cert_dir, "Bridge.lean", bridge_lean)?; + } + if let Some(laws_lean) = &surfaces.laws_lean { + write(&cert_dir, "Laws.lean", laws_lean)?; + } + let _ = &surfaces.model_roots; std::fs::write( cert_dir.join("cert-manifest.json"), render_manifest_json( @@ -663,15 +710,26 @@ pub fn write_project( target, abi, envelope, - &declined_bridges, + &surfaces.law_claims, + &surfaces.law_bridge_exports, + bridges, + &surfaces.declined_bridges, ), ) .map_err(|e| format!("write manifest: {e}"))?; Ok(ProjectDeclines { - law_claims: law_claims - .into_iter() - .map(|claim| (claim.label, SCHEMA9_BRIDGE_PENDING.to_string())) - .collect(), - source_bridges: declined_bridges, + 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/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs new file mode 100644 index 000000000..f8045d17b --- /dev/null +++ b/aver-cert/src/engine/source_bridges.rs @@ -0,0 +1,1788 @@ +// Included from engine/mod.rs (engine feature) — see the include! list there. + +// ---- plan-equals-source bridges (schema 9) ------------------------------------ +// +// 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::{ + BridgeKind, MAX_BRIDGE_STATEMENT_LEN, ROOT_PREFIX, SourceEncoder, binder_names, + is_plain_dotted_name, param_binders, render_bridge_statement, statement_is_root_qualified, + statement_is_single_plain_line, tuple_components, +}; + +/// 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 { + pub export: String, + pub theorem: String, + pub corollary: String, + /// Fully qualified Lean name of the source function (no `_root_.`). + pub model: String, + pub kind: BridgeKind, + pub params: Vec, + pub result: SourceEncoder, +} + +/// 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 { + pub fn theorem_name(export: &str) -> String { + format!("{BRIDGE_NAMESPACE}.{export}") + } + + pub fn corollary_name(export: &str) -> String { + format!("{BRIDGE_NAMESPACE}.{export}{BRIDGE_COROLLARY_SUFFIX}") + } + + pub fn statement(&self) -> String { + render_bridge_statement( + &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() + ) + } +} + +/// 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.model) + || bridge.theorem != SourceBridge::theorem_name(&bridge.export) + || bridge.corollary != SourceBridge::corollary_name(&bridge.export) + { + return false; + } + if !bridge + .params + .iter() + .chain(std::iter::once(&bridge.result)) + .all(SourceEncoder::is_well_formed) + { + return false; + } + let statement = bridge.statement(); + statement_is_single_plain_line(&statement, MAX_BRIDGE_STATEMENT_LEN) + && statement_is_root_qualified(&statement) +} + +// ---- 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. +#[derive(Debug, Clone)] +struct LeanDef { + qualified: String, + namespace: String, + params: Vec, + ret: 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; + } + return Some((params, ret.to_string())); + } + } +} + +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(" : ") { + if 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) { + if let Some((params, ret)) = parse_def_tail(&rest[name.len()..]) { + let qualified = qualify(&ns, name); + self.defs.insert( + qualified.clone(), + LeanDef { + qualified, + namespace: ns.clone(), + params, + ret, + }, + ); + } + } + } + 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()), + } + } + + /// 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)); + } + if scope.pop().is_none() { + return None; + } + } + } + + /// 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, + }] + }; + 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: the atomic values each one decodes, + /// its argument patterns, and the source arguments it denotes. + shapes: Vec<(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>, +} + +/// 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) { + if 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(), + }; + if let Some(reason) = &model.failure { + for c in &analysis.certified { + declined.push((c.name.clone(), reason.clone())); + } + plan.declined = declined; + return plan; + } + 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 { + 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(); + Ok(BridgedFn { + func_idx: e.func_idx, + model: def.qualified.clone(), + params, + result, + callees: direct_callees(&e.plan.body), + fuel: info.defs.contains_key(&format!("{}__fuel", def.qualified)), + shapes, + }) + })(); + match derived { + Ok(b) => { + string_literals(&e.plan.body, &mut plan.literals); + 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; + }; + 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; + } + plan.bridges.push((bridge, c.func_idx)); + } + plan.declined = declined + .into_iter() + .map(|(name, reason)| (name, clean_reason(&reason))) + .collect(); + plan +} + +// ---- rendering `Bridge.lean` -------------------------------------------------- + +const EVAL_SIMPS: &str = "AverCert.Grammar.eval, AverCert.Grammar.evalArgs, \ + AverCert.Grammar.evalArms, AverCert.Grammar.argsEnv, AverCert.Grammar.upd, \ + AverCert.Grammar.intBin, AverCert.Grammar.boolBin, AverCert.Grammar.floatBin, \ + AverCert.Grammar.strBin, AverCert.Grammar.strCat, AverCert.Grammar.builtinEval, \ + AverCert.Grammar.ctorVal, AverCert.Grammar.patMatch, AverCert.Grammar.bindVals, \ + AverCert.Grammar.noSlot, AverCert.GrammarBridge.over, \ + AverCert.GrammarBridge.decodeStr_strBytes, AverCert.GrammarBridge.strBytes_append, AverCert.GrammarBridge.strBytes_hadd, AverCert.GrammarBridge.strBytes_toString, \ + AverCert.GrammarBridge.string_eq_iff, AverCert.GrammarBridge.string_beq"; + +/// Bool normal forms: the plan's comparisons are `decide`, the source's `==`. +const BOOL_SIMPS: &str = "_root_.beq_iff_eq, _root_.bne_iff_ne, _root_.Bool.beq_eq_decide_eq, \ + _root_.decide_eq_decide, _root_.Bool.decide_eq_true, _root_.decide_not"; + +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(" × ") + ), + } +} + +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(", ")), + }; + 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(", "))); + } + 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(" ")) + }; + 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"); +} + +fn render_step(b: &BridgedFn, fns: &BTreeMap, literals: &str, 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!(", dec_{c}, img_{c}")); + if callee.fuel { + callee_simps.push_str(&format!(", _root_.{}", callee.model)); + } + } + } + let unfold = if b.fuel { + format!("(try unfold _root_.{m})\n (try unfold _root_.{m}__fuel)", m = b.model) + } else { + format!("(try unfold _root_.{})", b.model) + }; + s.push_str(&format!( + "/-- One step of `{model}`: 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, _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\n \ + simp only [img_{f}]\n \ + {unfold}\n \ + simp [AverCert.Plans.fn{f}, {EVAL_SIMPS}{literals}, I{callee_simps}]\n \ + all_goals (try (repeat' split))\n \ + all_goals (try simp_all [{EVAL_SIMPS}{literals}, {BOOL_SIMPS}])\n \ + all_goals (try omega)\n \ + all_goals (try (apply _root_.Bool.eq_iff_iff.mpr; simp only [_root_.Bool.or_eq_true, \ + _root_.Bool.and_eq_true, _root_.decide_eq_true_eq, _root_.Bool.not_eq_true']; omega))\n \ + all_goals (try (congr 1 <;> omega))\n \ + all_goals (try rfl)\n \ + all_goals (try decide)\n \ + done))\n \ + | sorry\n\n", + model = b.model, + cap = STEP_HEARTBEATS, + )); +} + +/// 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). +const STEP_HEARTBEATS: u32 = 1_000_000; +const FILE_HEARTBEATS: u32 = 4_000_000; + +/// The `∀ g ∈ D, ∃ Cs, … ∧ Step …` argument both engines take: split the +/// membership into one goal per closure member, in order, and cite that +/// member's step lemma (the callee side condition is decided). +fn render_steps_proof(closure: &[u32]) -> String { + let pats = closure.iter().map(|_| "rfl").collect::>().join(" | "); + let steps = closure + .iter() + .map(|f| format!("exact ⟨_, by decide, step_{f}⟩")) + .collect::>() + .join(" | "); + format!("(by intro g hg; simp at hg; rcases hg with {pats} <;> first | {steps})") +} + +fn render_export( + bridge: &SourceBridge, + func_idx: u32, + plan: &BridgePlan, + s: &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. + let split_cases: String = b + .params + .iter() + .enumerate() + .filter_map(|(i, p)| rcases_pattern(p).map(|pat| format!("rcases x{i} with {pat}; "))) + .collect(); + let image = format!( + "(by {split_cases}all_goals first | rfl | simp [I, dec_{func_idx}, img_{func_idx}, \ + AverCert.GrammarBridge.decodeStr_strBytes])" + ); + 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) (by simp only [depth]; omega) _ _ {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.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); + s.push_str(" := by\n first\n | (set_option maxHeartbeats "); + s.push_str(&STEP_HEARTBEATS.to_string()); + s.push_str(" in\n (refine ⟨_, 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"); + 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_."); + s.push_str(&bridge.corollary); + s.push_str(" :\n ("); + s.push_str(&statement); + s.push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) :=\n ⟨_root_."); + s.push_str(&bridge.theorem); + s.push_str(", _root_.AverCert.Final.cert⟩\n\n"); + let _ = param_binders; +} + +/// Render the package's `Bridge.lean`. +fn render_bridge_lean(plan: &BridgePlan, model_roots: &[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, 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\ + import GrammarBridge\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); + // 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 literal_names = String::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" + )); + literal_names.push_str(&format!(", strLit_{index}")); + } + for b in plan.fns.values() { + render_step(b, &plan.fns, &literal_names, &mut s); + } + for (bridge, func_idx) in &plan.bridges { + render_export(bridge, *func_idx, plan, &mut s); + } + s.push_str("end AverCert.Bridge\n"); + s +} + +// ---- 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 the qualified name of a def the model declares. +/// 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) -> Vec { + let mut found: Vec = 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() || !info.defs.contains_key(token) { + continue; + } + if !found.iter().any(|seen| seen == token) { + found.push(token.to_string()); + } + } + found +} + +/// The bridges covering every source function a law mentions (`None` when +/// some mentioned function has no bridge; empty when it mentions none). +fn law_bridge_coverage(statement: &str, info: &ModelInfo, bridges: &[SourceBridge]) -> Option> { + let mut covering = Vec::new(); + for model in law_statement_model_fns(statement, info) { + let index = bridges.iter().position(|bridge| bridge.model == model)?; + if !covering.contains(&index) { + covering.push(index); + } + } + Some(covering) +} + +/// The model files the package ships, and the module roots they define. +/// Every model file is a nested or flat `.lean` file; a root that would +/// shadow a package or wall file is refused (the whole model is then left +/// out and every bridge and law declined). +fn model_roots(model: &SourceModel) -> Result, String> { + const PACKAGE_ROOTS: &[&str] = &[ + "Module", + "Plans", + "Manifest", + "Artifact", + "ArtifactHostRoles", + "Final", + "ArtifactCertificate", + "Bridge", + "Laws", + "ArtifactBytes", + "ArtifactComponentBytes", + "CheckerWitness", + ]; + let mut roots = Vec::new(); + for (path, _) in &model.files { + let Some(stem) = path.strip_suffix(".lean") else { + continue; + }; + 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(|c| c.is_ascii_alphanumeric() || c == '_' || c == '\'') + }); + if !valid { + return Err(format!("model file `{path}` is not a plain Lean module path")); + } + let root = segments.join("."); + if PACKAGE_ROOTS.contains(&root.as_str()) + || wall::SOURCES + .iter() + .any(|source| source.name.strip_suffix(".lean") == Some(segments[0])) + { + return Err(format!("model module `{root}` would shadow a certificate file")); + } + roots.push(root); + } + Ok(roots) +} + +/// Drop the lines the checker's code-execution wall refuses (`deriving`); +/// the certificate model mode emits nothing else it would. +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 +} + +/// What `write_project` needs to render the bridge and law surfaces. +struct Surfaces { + model_roots: Vec, + 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)>, +} + +fn plan_surfaces(analysis: &Analysis, model: &SourceModel) -> Surfaces { + let decline_all = |reason: String| Surfaces { + model_roots: Vec::new(), + 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 roots = match model_roots(model) { + Ok(roots) => roots, + Err(reason) => return decline_all(reason), + }; + 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(|| render_bridge_lean(&plan, &roots)); + let info = ModelInfo::from_model(model); + let (law_claims, declined_laws) = admit_law_claims(model.law_claims.clone()); + 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(|| 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_roots: roots, + 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() + }; + 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() + ); + // 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() + ); + // 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()); + } + + /// 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, + }; + 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]), + "(by intro g hg; simp at hg; rcases hg with rfl | rfl <;> first | \ + exact ⟨_, by decide, step_3⟩ | exact ⟨_, by decide, step_9⟩)" + ); + } +} diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index b7f8936d2..111bac03c 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -7,7 +7,7 @@ //! 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}; @@ -164,6 +164,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. @@ -280,6 +282,8 @@ 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, @@ -702,10 +706,17 @@ fn certified_model_line(candidate: &CertifiedCandidate, bridges: &[BridgeOutcome .iter() .find(|bridge| bridge.export == candidate.name && bridge.offending.is_empty()); match credited { - Some(bridge) => format!( - "model: plan ≡ {} (credited source-bridge; see SOURCE-BRIDGES)", - display_safe(&bridge.model) - ), + 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(), } } @@ -1304,15 +1315,6 @@ fn read_candidates( .get("sourceBridges") .and_then(Value::as_array) .ok_or_else(|| "cert-manifest.json is missing array field `sourceBridges`".to_string())?; - // Schema 9 carries no source-bridge statement kind and no law-claims yet: - // the certified model is the plan itself. A package declaring either is - // refused rather than credited. - if !bridges_json.is_empty() { - return Err(format!( - "cert-manifest.json declares source bridges; schema {} carries none yet", - format::CERT_SCHEMA_VERSION - )); - } let certified_names: Vec<&str> = certified .iter() .map(|candidate| candidate.name.as_str()) @@ -1328,10 +1330,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"))?; @@ -1347,6 +1357,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"))?, }; @@ -1373,12 +1384,6 @@ fn read_candidates( .get("laws") .and_then(Value::as_array) .ok_or_else(|| "cert-manifest.json is missing array field `laws`".to_string())?; - if !laws_json.is_empty() { - return Err(format!( - "cert-manifest.json declares law-claims; schema {} carries none yet", - format::CERT_SCHEMA_VERSION - )); - } let mut laws = Vec::with_capacity(laws_json.len()); for (index, entry) in laws_json.iter().enumerate() { let context = format!("laws[{index}]"); @@ -1606,6 +1611,7 @@ struct RawSourceBridge { theorem: String, corollary: String, model: String, + kind: BridgeKind, params: Vec, result: SourceEncoder, } @@ -1673,7 +1679,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) )); } @@ -1681,6 +1687,7 @@ fn validate_source_bridge_candidate( let statement = render_bridge_statement( &bridge.export, &bridge.model, + bridge.kind, &bridge.params, &bridge.result, ); @@ -1702,52 +1709,145 @@ fn validate_source_bridge_candidate( export: bridge.export, corollary: bridge.corollary, model: bridge.model, + kind: bridge.kind, statement, }) } /// 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 => { - exact_object_fields(value, context, &[bridge_statement::ENCODER_KIND_KEY])?; - Ok(SourceEncoder::Int) - } - bridge_statement::ENCODER_KIND_BOOL => { + 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::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) @@ -1859,6 +1959,7 @@ fn parse_bridge_audits( outcomes.push(BridgeOutcome { export: bridge.export.clone(), model: bridge.model.clone(), + kind: bridge.kind, statement: bridge.statement.clone(), offending, }); @@ -2114,7 +2215,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) @@ -2851,9 +2955,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)); } @@ -3023,21 +3128,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() @@ -3138,18 +3252,25 @@ 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 defect this surface was reshaped to close: a package used to declare @@ -3170,20 +3291,30 @@ 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( + "∃ o, _root_.AverCert.GrammarBridge.exportObligation _root_.AverCert.manifest \ + \"Domain_Rational_plus\" = _root_.Option.some o" + ) && candidate + .statement + .contains("_root_.AverCert.Schema.Obligation.model o fuel"), + "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"); @@ -3193,13 +3324,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()]; @@ -3224,25 +3352,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(), @@ -3260,6 +3422,7 @@ mod tests { "theorem", "corollary", "model", + "kind", "params", "result", ]; @@ -3268,6 +3431,7 @@ mod tests { "theorem": "AverCert.Bridge.one", "corollary": "AverCert.Bridge.one_certified", "model": "Domain.one", + "kind": "exact", "params": [], "result": {"kind": "int"}, }); @@ -3289,12 +3453,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()], }, diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 692b1daa4..fb0de65ad 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -32,7 +32,7 @@ Schema version 7 differs from version 6 in one point: the manifest gained the re 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. -Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 carries no law-claims and no source bridges yet: a package declaring either is refused. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. +Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. 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 20 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:f50e6372020e27a976216ca24607e846f815d1e7986b28a60d762026bb690994` (`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. @@ -59,8 +59,8 @@ A certificate package is one directory, conventionally named `cert/`, emitted ne | `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`). | +| `Bridge.lean` | The plan-equals-source proofs: per bridged function a decoder (`dec_`), a source image (`img_`) and ONE step lemma (`step_`, `GrammarBridge.Step`), the image table `I`, and per manifest `sourceBridges` entry the bridge theorem `AverCert.Bridge.` (assembled from the step lemmas of its call closure by `GrammarBridge.exact_of_step` or `GrammarBridge.bridge_of_step`) and the corollary `AverCert.Bridge._certified` the manifest names. Each proof is `first \| (script under a heartbeat cap) \| sorry`, so a proof that does not close costs its own bridges (through the axiom audit) and never the build. 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 functions and laws the bridges and law-claims speak about; recursive functions keep their native `termination_by` equations, so a bridge unfolds one step through the equation lemma. Shipped only when the package declares a bridge or a law-claim. A dotted module dependency (`Data.Fibonacci`) ships its model at the corresponding nested path (`Data/Fibonacci.lean`) and is imported by `Bridge.lean` and `Laws.lean` under its dotted module name (`import Data.Fibonacci`); the verifier stages a nested file only when `Manifest.lean`, `Certificate.lean`, `Bridge.lean` or `Laws.lean` imports it. | 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). @@ -104,8 +104,8 @@ The manifest is a single JSON object. The reference parser is strict about the f | `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. | +| `sourceBridges` | array of objects | kernel-pinned | REQUIRED (may be empty). The plan-equals-source surface: one entry per certified export the producer bridges, each an exact object `{export, theorem, corollary, model, kind, params, result}`. **The entry carries STRUCTURE, never statement text.** The verifier RENDERS the pinned statement from `(export, model, kind, params, result)` (`aver-cert/src/bridge_statement.rs`, the one renderer producer and checker share) 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). `export` MUST be a plain undotted identifier naming an entry of `certified[]`, listed at most once; it fixes the obligation the statement speaks about (`GrammarBridge.exportObligation manifest ""`), so an entry cannot point its claim at another export. `theorem` MUST be exactly `AverCert.Bridge.` and `corollary` exactly `AverCert.Bridge._certified`. `model` is the fully qualified transpiled source function (a plain dotted identifier, ≤200 bytes, a trailing `'` allowed per segment) and is SPLICED into the rendered statement. `kind` is `"exact"` or `"adequate"`. `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 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, …]}` (two or more); `{"kind": "list", "elem": E}`; `{"kind": "vector", "elem": E}`. Names are `_root_.`-qualified plain dotted identifiers; every accessor MUST be a member of its record type and every constructor of its sum type; 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)` (its UTF-8 bytes), a record ↦ `SVal.record tid` of its declared accessors in order (a one-field record is a newtype and still has one field here), a sum ↦ a `match` giving `SVal.variant tid c` of the constructor's fields with `c` its position in `ctors`, `Option` ↦ `SVal.none`/`SVal.some` and Aver `Result` (Lean `Except E T`) ↦ `SVal.ok`/`SVal.err`, each instantiated at the elements' plan types, a tuple ↦ `SVal.record tid` of its components, a list ↦ `SVal.nil`/`SVal.cons` by `List.foldr`, a vector ↦ `SVal.vec` of its elements. With `o := exportObligation manifest ""`, the `exact` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∃ k, ∀ fuel, k ≤ fuel → ∀ x…, o.model fuel [enc x…] = some (encRes ( x…)))` and the `adequate` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∀ fuel x… v, o.model fuel [enc x…] = some v → v = encRes ( x…))`; a nullary export renders without parameter binders. `ArgsTyped` says the encoded arguments inhabit the plan's parameter types, so the obligation's `holds` applies to them; `GrammarBridge.adequate_transfer` states what an adequate bridge then means 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: a model that never returns satisfies it vacuously, and a reimplementation MUST NOT present it as a totality claim. The kind is a producer choice: an `exact` claim on a recursive plan simply fails to prove (not credited), never weakens. The rendered text is put through the statement gate (nonempty, ≤16000 bytes, no control character, no `:=`, `--` or `/-`, balanced delimiters) and every dotted name in it MUST be spelled `_root_.`-first, because the pin elaborates at the root namespace with no `open`. The witness re-elaborates every corollary at exactly the rendered statement conjoined with `Holds` and audits its axioms (section 8): **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 | Certified exports the producer declared NO bridge for, with the reason it refused (a parameter type with no decoder, a recursive source type, an unresolvable source definition, a callee without a bridge). 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. | @@ -356,7 +356,7 @@ What a positive verdict does trust — the honest TCB: - **Runtime helpers modelled as pure value functions.** The statement wires each runtime helper as a function from argument values to an optional result value (`Schema.HostFns`), and the wall's interpreter has no heap: a struct or array is an immutable value. The theorem therefore assumes that a helper does not mutate anything reachable from the values it is given or that the caller still holds. Nothing in the bytes enforces this: the type-table pin compares field storage only, so the mutability of the carrier's fields and of `$string` (`(array (mut i8))`) is not pinned, and a helper that wrote through a reference it was passed would break the model without breaking any pin. - **The bignum sub-routines behind add, sub, mul and cmp.** The template equality of section 4.3 pins the bodies of the `box`, `toIndex`, `add`, `sub`, `mul`, `cmp` and `eq` helpers, and the add, sub and mul templates (and the three-way `cmp` template, for three of them) call four factored sub-routines at declared indices (`arithParams.decompose`, `normalize`, `strip`, `umagCmp`). The bodies of those four functions are not pinned: the wall confirms only that the pinned templates call the declared indices. Whether the add, sub, mul and cmp contracts hold for a given artifact therefore rests on code the certificate does not look at. This predates schema 9 and is not changed by it; it is one more reason the runtime contracts above are a per-release obligation rather than a fact about the artifact. - **"Returns" at L3 is a statement about the wall's interpreter.** `holdsTotal` says the emitted function returns at fuel `n.natAbs + 1` in the wall's interpreter, where fuel counts nested calls and nothing else runs out. A real engine has a bounded call stack and a bounded heap, so for large `n` a run can still trap on stack exhaustion or allocation failure; neither is covered, and the L3 promise must not be read as "the engine returns for every input". -- **The plan is the claim — for an export without a credited source-bridge.** For every export certified through the declared compute face (`recordCompute`), the obligation's `model` is the evaluation of the plan the manifest declares (`StandardFace.recordComputeModel Plans.Plan.body`), and the report line prints that plan. Since schema 8 the identification of that plan with the function the user wrote IS a kernel-checked theorem wherever the package declares a source-bridge and the verifier credits it (section 4.1): `AverCert.Bridge. : ∀ x, StandardFace.recordComputeModel Plans.Plan.body (encodeArgs x) = some (encodeResult (. x))`, pinned by `AverCertChecker.bridge_pin_` at a statement the VERIFIER rendered from the manifest's declared structure — not at one the package wrote — and axiom-audited like any other claim. A law-claim whose `bridges` list is non-empty therefore conjoins, under one kernel-checked name, the universal law of the source model, `Holds` about the plan, and the plan-equals-source identity of every function the law mentions — the three halves are no longer identified by construction. What remains trusted is narrower and must be stated as such: (i) the ENCODERS, which the producer chooses and which are part of the theorem's statement, so a reader must read the statement rather than the export name — the verifier constrains their SHAPE (a closed kind set, `_root_.`-qualified names, accessors of the type they claim to project) but not that they are the encoding the user meant; (ii) **the MODEL definition itself, which is producer-emitted.** `_root_..` is a definition the package's own model modules carry, so `plan ≡ ` is kernel-checked RELATIVE TO those modules: it says the plan and the transpiled definition agree, not that the transpilation of the user's source was faithful. That is the same trust boundary the law-claims surface already disclosed — a law is a theorem about the emitted model — and the bridge narrows the gap between the two halves of a certificate without closing this one; (iii) an export with NO declared or no credited bridge, where the old disclosure stands unchanged — the plan is the claim, and its correspondence to the source rests on the producer deriving the plan from the source program's MIR. Today the shapes without a bridge are exactly those whose source signature has no `SVal` image: a parameter or result that is a nested record, a record with a non-Int field, a Float, a String, or a user ADT; a source signature the producer cannot resolve unambiguously to a transpiled definition; and an export whose fixed bridge tactic script does not close, which is reported as an uncredited bridge rather than a silent one. A reimplementation MUST NOT present an UNCREDITED or undeclared bridge as establishing the identity, and MUST NOT present a law-claim with an empty `bridges` list as a kernel-checked statement about the bytes alone. +- **The plan is the claim — for an export without a credited source-bridge.** Every obligation's `model` is the plan's fuel-indexed meaning (`AcceptedArtifact.modelOf`), and the report line prints that plan. The identification of that plan with the function the user wrote IS a kernel-checked theorem wherever the package declares a source-bridge and the verifier credits it (section 4.1), pinned by `AverCertChecker.bridge_pin_` at a statement the VERIFIER rendered from the manifest's declared structure and axiom-audited like any other claim; its proof is assembled from one-step obligations by the wall's `GrammarBridge.exact_of_step` / `bridge_of_step`, so recursion and mutual recursion need no per-function induction. A law-claim whose `bridges` list is non-empty conjoins, under one kernel-checked name, the universal law of the source model, `Holds` about the plan, and the bridges of every function the law mentions. What remains trusted: (i) the ENCODERS, which the producer chooses and which are part of the theorem's statement — the verifier constrains their SHAPE (a closed kind set, `_root_.`-qualified names, members of the types they claim) but not that the constructor order or the type ids are the correspondence the user meant; the typing conjunct (`ArgsTyped`) rules out encoders whose images the plan cannot even be run on; (ii) **the MODEL definition itself, which is producer-emitted**: `_root_..` is a definition the package's own model modules carry, so `plan ≡ ` is kernel-checked RELATIVE TO those modules, not a proof that the transpilation of the user's source was faithful; (iii) an `adequate` bridge is partial correctness only — it is vacuous where the model never returns — and never a totality claim; (iv) an export with NO declared or no credited bridge, where the plan is the claim and its correspondence to the source rests on the producer deriving the plan from the source program's MIR. Today the shapes without a bridge are: a parameter that is a Float, a List or a Vector (no decoder in this version), a recursive source type, a source definition the producer cannot resolve unambiguously, a function whose callee has no bridge, and an export whose proof script does not close (reported as an uncredited bridge rather than a silent one). A reimplementation MUST NOT present an UNCREDITED or undeclared bridge as establishing the identity, and MUST NOT present a law-claim with an empty `bridges` list as a kernel-checked statement about the bytes alone. - **Two wasm GC facts behind the exact `ref.test` (S-3).** The audited interpreter's `ref.test` and `ref.cast` compare type indices exactly, while wasm GC tests subtyping, and a variant `match` lowers to a `ref.test` cascade over the constructor structs. The wall pins every constructor struct of every declared sum as `sub final` under the sum's root, inside the rec group that opens the type section (`TypeTable.sumConfirmed`, over the raw entries `GrammarLower.S3Pin` reads), and proves that under this pin the exact test IS the subtype test on those structs (`GrammarSound.ctor_refTest_exact`; for an accepted artifact, `AcceptanceSoundness.refTest_exact_of_accepted`). That proof rests on two facts of the wasm GC specification, carried as the explicit hypothesis `GrammarSound.GcTestSpec` and deliberately not as axioms: (i) subtyping is reflexive; (ii) a type declared final has no subtype in its own rec group other than itself (validation rejects a `sub` that names a final supertype, and distinct positions of one rec group are distinct types under iso-recursive type equivalence). A reimplementation MUST keep the pin, and relies on these two facts exactly as the reference verifier does. - **Explicit source read declarations** — user-ADT domain meaning, representation interpretation, and non-reconstructible models (section 5.1) are conditions of the theorem, not derived facts. - **Explicitly configured cache directories**, if any, as trusted local state: their integrity manifests detect accidental corruption, not an active writer able to replace `.olean` outputs and Lake traces together. diff --git a/src/main/commands.rs b/src/main/commands.rs index e37765a3c..3f76db2d2 100644 --- a/src/main/commands.rs +++ b/src/main/commands.rs @@ -7028,6 +7028,9 @@ fn cmd_compile_wasm_gc( .and_then(|name| name.to_str()) .expect("generated wasm file name is UTF-8"); if let Err(error) = emit_artifact_certificate( + file, + project_name, + module_root_override, out_path, aver::codegen::cert::CertificateArtifact::WasmGc { file_name: artifact_file_name, @@ -7285,20 +7288,24 @@ fn render_wasmtime_runtime_policy( /// Gated on `certify` (the aver-cert producer engine + `codegen::cert`). Both /// wasm-gc and wasip2 call this with an explicit description of the delivered /// artifact and the core-module bytes consumed by the Wasm wall. The plans are -/// the optimized MIR the emitter consumed in the same compile. +/// the optimized MIR the emitter consumed in the same compile; the Lean source +/// model (the `aver proof` emission of the module's pure functions and laws) +/// is what the package's plan-equals-source bridges and law-claims speak about. #[cfg(feature = "certify")] fn emit_artifact_certificate( + file: &str, + project_name: Option<&str>, + module_root_override: Option<&str>, out_path: &Path, artifact: aver::codegen::cert::CertificateArtifact<'_>, cert_plans: &aver::codegen::cert::ModulePlans, ) -> Result<(), String> { use aver::codegen::cert; - // Schema 9 states every obligation over the plan and carries no - // law-claims or source bridges yet, so no Lean model is emitted. let analysis = cert::analyze(artifact.core_module_bytes(), cert_plans, artifact.target())?; + let source_model = certificate_source_model(file, project_name, module_root_override); let artifact_file_name = artifact.file_name().to_string(); - let declines = cert::write_project(out_path, artifact, &analysis, Vec::new())?; + let declines = cert::write_project(out_path, artifact, &analysis, &source_model)?; let cert_dir = out_path.join("cert"); let certified = analysis.certified_names(); @@ -7326,6 +7333,79 @@ fn emit_artifact_certificate( Ok(()) } +/// The Lean source model of a certified module: the reused `aver proof` +/// emission (source-level IR, laws included) and the law-claims its emitter +/// recorded as structure. Lean emission is best effort for a certificate: a +/// panic in it costs the package its bridges and law-claims (every one is +/// declined with the reason), never the byte certificate itself. +#[cfg(feature = "certify")] +fn certificate_source_model( + file: &str, + project_name: Option<&str>, + module_root_override: Option<&str>, +) -> aver::codegen::cert::SourceModel { + use aver::codegen::cert; + let (mut mctx, _mroot) = build_codegen_context( + file, + project_name, + module_root_override, + false, + &super::cli::CompilePolicyMode::Embed, + None, + false, + false, // apply_traversal_lowering — the model wants source-level IR + true, // run_refinement_lower + true, // run_contract_lower + true, // run_law_lower + ); + let emitted = std::panic::catch_unwind(std::panic::AssertUnwindSafe(|| { + let out = lean_codegen::transpile_for_cert_model(&mut mctx); + (out, lean_codegen::cert_model_entry_namespace(&mctx)) + })); + match emitted { + Ok((model_out, entry_namespace)) => cert::SourceModel { + files: model_out + .files + .into_iter() + .filter(|(path, _)| path != "lakefile.lean" && path != "lean-toolchain") + .collect(), + entry_namespace, + dependency_namespaces: mctx + .modules + .iter() + .map(|module| { + ( + module.prefix.clone(), + lean_codegen::cert_model_module_namespace(&module.prefix), + ) + }) + .collect(), + // Law-claims travel as STRUCTURE from the emitter that built each + // law theorem's statement — the producer never scans the emitted + // Lean text back for them. + law_claims: model_out + .law_claims + .iter() + .map(|claim| cert::LawClaim { + label: claim.label.clone(), + prefix: claim.namespace.clone(), + theorem: claim.theorem.clone(), + statement: claim.statement.clone(), + }) + .collect(), + failure: None, + }, + Err(payload) => { + let message = payload + .downcast_ref::() + .cloned() + .or_else(|| payload.downcast_ref::<&str>().map(|s| s.to_string())) + .unwrap_or_else(|| "unknown panic".to_string()); + cert::SourceModel::failed(format!("the Lean source model failed to emit: {message}")) + } + } +} + /// `--target wasip2` compile entry — 0.18 "Span". /// /// The wasm-gc backend produces a core module that already imports @@ -7660,6 +7740,9 @@ fn cmd_compile_wasip2( .expect("generated component file name is UTF-8"); let envelope = component_artifact.envelope.declaration(); if let Err(error) = emit_artifact_certificate( + file, + project_name, + module_root_override, out_path, aver::codegen::cert::CertificateArtifact::Wasip2 { file_name: artifact_file_name, diff --git a/tests/cert_verify_spec.rs b/tests/cert_verify_spec.rs index 055cc5797..637d6f14b 100644 --- a/tests/cert_verify_spec.rs +++ b/tests/cert_verify_spec.rs @@ -8441,8 +8441,8 @@ fn explain_states_the_record_compute_faces_certified_domain() { ); } -/// Law-claims pin (schema 7): a clean k5 package carries eleven kernel-checked -/// law corollaries, all credited; the checker-owned witness re-elaborates each +/// Law-claims pin (schema 9): a clean k5 package carries eleven kernel-checked +/// law corollaries, all credited, each also bridged to the bytes; the checker-owned witness re-elaborates each /// corollary at exactly the manifest-declared statement and audits its axioms. /// /// The two failure modes are deliberately different verdicts. A pin that does @@ -8507,8 +8507,8 @@ fn cert_tripwire_declines_tampered_law_claims() { let (ok, report) = aver_check(&wasm, &cert); assert!(ok, "clean k5 law-claims certificate must check:\n{report}"); assert!( - report.contains("10 checked exports"), - "k5 should keep its ten certified exports:\n{report}" + report.contains("12 checked exports"), + "k5 should keep its twelve certified exports:\n{report}" ); assert!( report.contains("law-claims: 11 of 11 credited"), @@ -8519,7 +8519,11 @@ fn cert_tripwire_declines_tampered_law_claims() { "a clean package names no uncredited law:\n{report}" ); assert!( - report.contains("source-bridges: 10 of 10 credited"), + report.contains("bridged-laws: 11 of 11 credited"), + "every k5 law must be bridged to the bytes on a clean package:\n{report}" + ); + assert!( + report.contains("source-bridges: 12 of 12 credited"), "every k5 export must carry a credited plan-equals-source bridge:\n{report}" ); @@ -8610,7 +8614,7 @@ fn cert_tripwire_declines_tampered_law_claims() { "a law failing only its axiom audit must not sink the exports:\n{out}" ); assert!( - out.contains("10 checked exports"), + out.contains("12 checked exports"), "the export verdict must stand unchanged beside an uncredited law:\n{out}" ); assert!( @@ -8625,7 +8629,7 @@ fn cert_tripwire_declines_tampered_law_claims() { "the uncredited law must be named together with the axiom that sank it:\n{out}" ); assert!( - out.contains("source-bridges: 10 of 10 credited"), + out.contains("source-bridges: 12 of 12 credited"), "a law losing its credit must not take the bridges it cited down:\n{out}" ); assert!( @@ -8643,17 +8647,19 @@ fn cert_tripwire_declines_tampered_law_claims() { // well-formed `ok` line. } -/// The same tripwire for the plan-equals-source bridge surface, on the k5 -/// package whose ten record projection-compute exports are all bridged. +/// The same tripwire for the plan-equals-source bridge surface (schema 9), on +/// the k5 package whose twelve exports are all bridged (`exact` kind: no k5 +/// call closure recurses). /// -/// (A) and (B) are the two ways a manifest can try to state something other -/// than what the package proves, now that the entry carries STRUCTURE and the -/// checker renders the statement from it: a permuted record accessor list -/// renders a different claim, so the pin no longer has the package corollary's -/// type; a smuggled `statement` key, or an encoder kind outside the closed set, -/// is refused at the manifest gate before Lean runs at all. There is no third -/// way — a tautology is not expressible, because the left-hand side of the -/// rendered statement is always the export's own plan. +/// (A) and (B) are the ways a manifest can try to state something other than +/// what the package proves, now that the entry carries STRUCTURE and the +/// checker renders the statement from it: a permuted record accessor list, or +/// a `model` naming a different source function, renders a different claim, +/// so the pin no longer has the package corollary's type; a smuggled +/// `statement` key, or an encoder kind outside the closed set, is refused at +/// the manifest gate before Lean runs at all. A tautology is not expressible, +/// because the left-hand side of the rendered statement is always the named +/// export's own obligation model. /// /// (C) A bridge proof degraded to `sorry` still elaborates at the rendered /// statement, so only its axiom audit fails. It costs the bridge and the @@ -8668,19 +8674,13 @@ fn cert_tripwire_declines_tampered_law_claims() { /// case and deliberately not a decline: the claim is then simply not part of /// the bridged surface, and nothing is credited that was not proven. /// -/// (E) A composition step the fixed script cannot close falls to `sorry` -/// instead of failing the build, so a shape the producer guessed wrong about -/// is a not-credited bridge and never a declined package. `isNonPos` is the one -/// bridged export no k5 law mentions, which keeps (E)'s law counters full and -/// isolates the bridge's own credit. +/// (E) A per-function STEP lemma that does not close falls to `sorry` instead +/// of failing the build, and it costs exactly the bridges whose call closure +/// contains that function. `isNonPos` calls nothing and no other export calls +/// it, and no k5 law mentions it, so (E) isolates one bridge's credit. /// -/// The audit LINES themselves — all three markers — are covered where they are -/// read, by the parser unit tests in `aver-cert` -/// (`bridge_audit_without_a_line_declines_instead_of_crediting`, -/// `bridge_audit_rejects_malformed_and_repeated_lines`, -/// `bridged_law_pins_are_numbered_over_the_bridged_claims_only`): the witness -/// is authored inside a temporary build directory this test cannot reach, so -/// that tamper is unit-level only, exactly as it is for law-claims. +/// The audit LINES themselves are covered where they are read, by the parser +/// unit tests in `aver-cert`. #[test] fn cert_tripwire_declines_tampered_source_bridges() { if Command::new("lake").arg("--version").output().is_err() { @@ -8717,34 +8717,36 @@ fn cert_tripwire_declines_tampered_source_bridges() { bridge_lean .matches("/-- plan-equals-source bridge for `") .count(), - 10, - "k5 package must carry ten bridge theorems" + 12, + "k5 package must carry twelve bridge theorems" ); assert!( - manifest.contains("\"export\": \"Domain_Rational_isNonPos\""), - "the bridge surface must name every certified export" + manifest.contains("\"export\": \"Domain_Rational_isNonPos\"") + && manifest.contains("\"kind\": \"exact\""), + "the bridge surface must name every certified export, in the exact kind" ); assert!( - !manifest.contains("\"statement\": \"_root_."), + !manifest.contains("\"statement\": \"∃ o"), "a bridge entry must transport structure, never statement text:\n{manifest}" ); // Tamper A: permute one record encoder's accessors. The checker renders - // `SVal.r [bottom x, top x]` where the package proved `[top x, bottom x]`, - // so the pin no longer has the corollary's type. - let honest_fields = "\"fields\": [\"_root_.Domain.Rational.Fraction.top\", \ - \"_root_.Domain.Rational.Fraction.bottom\"]"; + // `SVal.record 0 [bottom x, top x]` where the package proved + // `[top x, bottom x]`, so the pin no longer has the corollary's type. + let top = + "{\"accessor\": \"_root_.Domain.Rational.Fraction.top\", \"encoder\": {\"kind\": \"int\"}}"; + let bottom = "{\"accessor\": \"_root_.Domain.Rational.Fraction.bottom\", \"encoder\": {\"kind\": \"int\"}}"; + let honest_fields = format!("\"fields\": [{top}, {bottom}]"); assert!( - manifest.contains(honest_fields), - "expected the Fraction encoder to list its two Int leaves in order" + manifest.contains(&honest_fields), + "expected the Fraction encoder to list its two Int fields in order" ); - let permuted_fields = "\"fields\": [\"_root_.Domain.Rational.Fraction.bottom\", \ - \"_root_.Domain.Rational.Fraction.top\"]"; + let permuted_fields = format!("\"fields\": [{bottom}, {top}]"); let dir = temp_dir("cert-k5-bridge-permuted-fields"); copy_dir(&out_dir, &dir); std::fs::write( dir.join("cert").join("cert-manifest.json"), - manifest.replacen(honest_fields, permuted_fields, 1), + manifest.replacen(&honest_fields, &permuted_fields, 1), ) .unwrap(); let (ok, out) = aver_check(&dir.join("main.wasm"), &dir.join("cert")); @@ -8754,9 +8756,35 @@ fn cert_tripwire_declines_tampered_source_bridges() { "a permuted encoder credited:\n{out}" ); - // Tamper B: the two shapes the manifest gate refuses outright, before any - // Lean step — a statement smuggled back in beside the structure, and an - // encoder kind outside the closed set. + // Tamper A': point one bridge at a different source function. The checker + // renders the claim about `isNonPos` where the package proved one about + // `isNonNeg`, so the pin fails to elaborate. + let honest_model = "\"model\": \"Domain.Rational.isNonNeg\""; + assert!( + manifest.contains(honest_model), + "expected the isNonNeg bridge" + ); + let dir = temp_dir("cert-k5-bridge-other-model"); + copy_dir(&out_dir, &dir); + std::fs::write( + dir.join("cert").join("cert-manifest.json"), + manifest.replacen(honest_model, "\"model\": \"Domain.Rational.isNonPos\"", 1), + ) + .unwrap(); + let (ok, out) = aver_check(&dir.join("main.wasm"), &dir.join("cert")); + assert!( + !ok, + "a bridge naming another source function must be DECLINED:\n{out}" + ); + assert!( + !out.contains("CERTIFIED"), + "a bridge naming another source function credited:\n{out}" + ); + + // Tamper B: the shapes the manifest gate refuses outright, before any + // Lean step — a statement smuggled back in beside the structure, an + // encoder kind outside the closed set, and a statement kind outside the + // two the checker renders. for (label, tampered) in [ ( "a declared statement", @@ -8771,6 +8799,10 @@ fn cert_tripwire_declines_tampered_source_bridges() { "an unknown encoder kind", manifest.replacen("\"kind\": \"record\"", "\"kind\": \"matrix\"", 1), ), + ( + "an unknown statement kind", + manifest.replacen("\"kind\": \"exact\"", "\"kind\": \"total\"", 1), + ), ] { let dir = temp_dir("cert-k5-bridge-manifest-gate"); copy_dir(&out_dir, &dir); @@ -8797,11 +8829,11 @@ fn cert_tripwire_declines_tampered_source_bridges() { "a bridge failing only its axiom audit must not sink the exports:\n{out}" ); assert!( - out.contains("10 checked exports"), + out.contains("12 checked exports"), "the export verdict must stand beside an uncredited bridge:\n{out}" ); assert!( - out.contains("source-bridges: 9 of 10 credited"), + out.contains("source-bridges: 11 of 12 credited"), "the sorry'd bridge must lose exactly its own credit:\n{out}" ); assert!( @@ -8835,12 +8867,6 @@ fn cert_tripwire_declines_tampered_source_bridges() { // that law's bridged pin at exactly the declared conjunction, so the // package's `_bridged` corollary — which proves one conjunct FEWER — no // longer has the pinned type. A claim cannot declare more than it proves. - // - // The other direction is deliberately not a decline: a claim that lists - // fewer bridges than its corollary happens to prove is claiming LESS, and - // it simply drops out of the bridged surface (`bridged-laws` counts one - // less denominator). Nothing is credited that was not proven, which is why - // section 4.1 calls this list a producer choice. let at = manifest .find("\"bridges\": [\"") .expect("the first k5 law-claim declares the bridges it conjoins"); @@ -8867,30 +8893,34 @@ fn cert_tripwire_declines_tampered_source_bridges() { "an over-declared law-claim surface credited:\n{out}" ); - // Tamper E: the composition step, which has no fixed script that closes - // every shape, degraded to `sorry`. The `first | … | sorry` in the emitted - // proof is what makes this a not-credited bridge instead of a failed build, - // and a failed build would decline the whole package. - let sorried = sorry_out_theorem( - &bridge_lean, - "_root_.AverCert.Bridge.Domain_Rational_isNonPos_sourceModel", - ); - let dir = temp_dir("cert-k5-bridge-composition-tamper"); + // Tamper E: the per-function step lemma of `isNonPos`, degraded to `sorry`. + // The `first | … | sorry` in the emitted proof is what makes a step that + // cannot close a not-credited bridge instead of a failed build, and the + // step is cited only by the bridges whose call closure reaches it. + let step_doc = "/-- One step of `Domain.Rational.isNonPos`"; + let at = bridge_lean + .find(step_doc) + .expect("expected the isNonPos step lemma"); + let name_at = bridge_lean[at..].find("theorem ").expect("the step lemma") + at + 8; + let name_end = bridge_lean[name_at..].find(' ').expect("its name ends") + name_at; + let step_name = &bridge_lean[name_at..name_end]; + let sorried = sorry_out_theorem(&bridge_lean, step_name); + let dir = temp_dir("cert-k5-bridge-step-tamper"); copy_dir(&out_dir, &dir); std::fs::write(dir.join("cert").join("Bridge.lean"), sorried).unwrap(); let (ok, out) = aver_check(&dir.join("main.wasm"), &dir.join("cert")); assert!( ok, - "a composition step that cannot close must not decline the package:\n{out}" + "a step lemma that cannot close must not decline the package:\n{out}" ); assert!( - out.contains("10 checked exports") - && out.contains("source-bridges: 9 of 10 credited") + out.contains("12 checked exports") + && out.contains("source-bridges: 11 of 12 credited") && out.contains( "source-bridge not credited: Domain_Rational_isNonPos \ (proof depends on sorryAx)" ), - "the unclosed composition costs exactly its own bridge:\n{out}" + "the unclosed step costs exactly its own bridge:\n{out}" ); assert!( out.contains("law-claims: 11 of 11 credited") @@ -8904,7 +8934,7 @@ fn cert_tripwire_declines_tampered_source_bridges() { /// The theorem is found by its `theorem :` header and ends at the blank /// line before the next doc comment. fn sorry_out_theorem(lean: &str, name: &str) -> String { - let header = format!("theorem {name} :\n"); + let header = format!("theorem {name} :"); let at = lean .find(&header) .unwrap_or_else(|| panic!("expected the theorem {name}")); From f67fbe17a79d8362ffc2f412828e427d0d725956 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 08:16:35 +0200 Subject: [PATCH 25/89] cert: close hypothesis-side branches in bridge step proofs A step whose plan and source branch in different orders left an if inside a hypothesis; the script now splits those too before the final arithmetic. Adds renderer tests for the String literal and constructor split helpers. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/source_bridges.rs | 31 ++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index f8045d17b..ccfe1f3de 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -1252,6 +1252,7 @@ fn render_step(b: &BridgedFn, fns: &BTreeMap, literals: &str, s: all_goals (try (repeat' split))\n \ all_goals (try simp_all [{EVAL_SIMPS}{literals}, {BOOL_SIMPS}])\n \ all_goals (try omega)\n \ + all_goals (try (repeat' (split at *)) <;> (try simp_all) <;> (try omega))\n \ all_goals (try (apply _root_.Bool.eq_iff_iff.mpr; simp only [_root_.Bool.or_eq_true, \ _root_.Bool.and_eq_true, _root_.decide_eq_true_eq, _root_.Bool.not_eq_true']; omega))\n \ all_goals (try (congr 1 <;> omega))\n \ @@ -1745,6 +1746,36 @@ mod source_bridge_tests { 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("(⟨⟩ | _)") + ); + } + /// 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. From 999d24631dfd5bbe3f1cb4d2f1b6cfaa0cec861c Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 10:07:14 +0200 Subject: [PATCH 26/89] cert: one lexical gate for the producer and the checker The checker's token scan, file-name rule and law-claim identifier rule move into lean_gate.rs, which the producer can call too. Where the two sides had their own copies they disagreed, and one disagreement was enough for the checker to refuse a whole package over a single bridge or law. - A model name escaped with a trailing prime (none') now passes the bridge gate, which uses the same identifier rule as the producer. A law theorem may carry the same escape; labels and corollaries may not. - The producer's law gate calls the checker's functions, with the checker's statement length cap instead of a stricter local copy. - The token scan admits exactly one form of deriving: the classes BEq, DecidableEq and Inhabited on a type, or ReflBEq and LawfulBEq in a deriving instance line, with nothing else on the line and no continuation after it. A package cannot register a derive handler, so this runs only the pinned toolchain's handlers for those classes. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/bridge_statement.rs | 7 + aver-cert/src/engine/law_claims.rs | 66 +--- aver-cert/src/lean_gate.rs | 545 +++++++++++++++++++++++++++++ aver-cert/src/lib.rs | 1 + aver-cert/src/verifier.rs | 328 +++-------------- docs/certificate-format.md | 4 +- 6 files changed, 624 insertions(+), 327 deletions(-) create mode 100644 aver-cert/src/lean_gate.rs diff --git a/aver-cert/src/bridge_statement.rs b/aver-cert/src/bridge_statement.rs index a8c8aacba..0b707c1d1 100644 --- a/aver-cert/src/bridge_statement.rs +++ b/aver-cert/src/bridge_statement.rs @@ -512,6 +512,13 @@ pub fn is_plain_dotted_name(value: &str) -> bool { }) } +/// 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() diff --git a/aver-cert/src/engine/law_claims.rs b/aver-cert/src/engine/law_claims.rs index 78fda2f46..099d39094 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. diff --git a/aver-cert/src/lean_gate.rs b/aver-cert/src/lean_gate.rs new file mode 100644 index 000000000..efe394daa --- /dev/null +++ b/aver-cert/src/lean_gate.rs @@ -0,0 +1,545 @@ +//! 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. + +/// Elaboration-executing tokens a package `.lean` file may not carry in code +/// position (checker stage 7). `deriving` is the one token with an admitted +/// form: the closed clause [`admitted_deriving_end`] accepts. +pub 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", +]; + +/// 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"]; + +/// The first elaboration-executing token in code position, if any. +/// +/// 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. A `deriving` token is admitted only as +/// the exact closed clause [`admitted_deriving_end`] recognizes. +pub fn code_exec_token(text: &str) -> Option<&'static str> { + let chars: Vec = text.chars().collect(); + find_code_exec_token(&chars) +} + +/// Where scanning resumes after a token that opens an admitted clause, or +/// `None` when the token is refused. +fn admitted_clause_end(token: &str, chars: &[char], at: usize) -> Option { + if token == "deriving" { + admitted_deriving_end(chars, at) + } else { + None + } +} + +/// 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 trailing-prime escape in any +/// segment (a law of a function named after a reserved word lives in +/// `…none'` scope); 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(()) +} + +/// 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> { + let mut i = start; + while i < chars.len() { + if let Some(token) = token_at(tokens, chars, i) { + match admitted_clause_end(token, chars, i) { + Some(end) => { + i = end; + continue; + } + None => return Some(token), + } + } + i += 1; + } + None +} + +/// The context-aware core of [`code_exec_token`]: 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) { + match admitted_clause_end(token, chars, i) { + Some(end) => { + i = end; + continue; + } + None => return Some(token), + } + } + i += 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("@[") + ); + } + + #[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.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/verifier.rs b/aver-cert/src/verifier.rs index 111bac03c..a804b2d2a 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -13,7 +13,7 @@ use crate::bridge_statement::{ use crate::cache::{ArtifactBuildCache, KeyMaterial as ArtifactCacheKeyMaterial}; 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}; @@ -57,29 +57,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 { @@ -1550,25 +1527,12 @@ fn read_candidates( /// newline, no `:=`, no comment openers, so a crafted statement cannot /// terminate the pin early or smuggle in a further declaration. 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", @@ -1631,22 +1595,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), @@ -2311,22 +2270,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 @@ -2449,23 +2393,13 @@ 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}`" )); @@ -2473,195 +2407,6 @@ fn scan_for_code_exec(name: &str, contents: &[u8]) -> Result<(), String> { 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. @@ -3273,6 +3018,41 @@ mod tests { 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.no'ne", + "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 /// its bridge statement as text, so `_root_.M.f x = _root_.M.f x` passed /// every gate, elaborated, audited clean, and printed `model: plan ≡ M.f`. diff --git a/docs/certificate-format.md b/docs/certificate-format.md index fb0de65ad..99a7906ae 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -103,7 +103,7 @@ The manifest is a single JSON object. The reference parser is strict about the f | `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. | +| `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), except that each segment of `theorem` may end in one or more `'` (the transpiler's escape of a Lean keyword, `none'`); the producer applies this same gate, through the same code, before it declares a claim; `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 the producer bridges, each an exact object `{export, theorem, corollary, model, kind, params, result}`. **The entry carries STRUCTURE, never statement text.** The verifier RENDERS the pinned statement from `(export, model, kind, params, result)` (`aver-cert/src/bridge_statement.rs`, the one renderer producer and checker share) 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). `export` MUST be a plain undotted identifier naming an entry of `certified[]`, listed at most once; it fixes the obligation the statement speaks about (`GrammarBridge.exportObligation manifest ""`), so an entry cannot point its claim at another export. `theorem` MUST be exactly `AverCert.Bridge.` and `corollary` exactly `AverCert.Bridge._certified`. `model` is the fully qualified transpiled source function (a plain dotted identifier, ≤200 bytes, a trailing `'` allowed per segment) and is SPLICED into the rendered statement. `kind` is `"exact"` or `"adequate"`. `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 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, …]}` (two or more); `{"kind": "list", "elem": E}`; `{"kind": "vector", "elem": E}`. Names are `_root_.`-qualified plain dotted identifiers; every accessor MUST be a member of its record type and every constructor of its sum type; 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)` (its UTF-8 bytes), a record ↦ `SVal.record tid` of its declared accessors in order (a one-field record is a newtype and still has one field here), a sum ↦ a `match` giving `SVal.variant tid c` of the constructor's fields with `c` its position in `ctors`, `Option` ↦ `SVal.none`/`SVal.some` and Aver `Result` (Lean `Except E T`) ↦ `SVal.ok`/`SVal.err`, each instantiated at the elements' plan types, a tuple ↦ `SVal.record tid` of its components, a list ↦ `SVal.nil`/`SVal.cons` by `List.foldr`, a vector ↦ `SVal.vec` of its elements. With `o := exportObligation manifest ""`, the `exact` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∃ k, ∀ fuel, k ≤ fuel → ∀ x…, o.model fuel [enc x…] = some (encRes ( x…)))` and the `adequate` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∀ fuel x… v, o.model fuel [enc x…] = some v → v = encRes ( x…))`; a nullary export renders without parameter binders. `ArgsTyped` says the encoded arguments inhabit the plan's parameter types, so the obligation's `holds` applies to them; `GrammarBridge.adequate_transfer` states what an adequate bridge then means 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: a model that never returns satisfies it vacuously, and a reimplementation MUST NOT present it as a totality claim. The kind is a producer choice: an `exact` claim on a recursive plan simply fails to prove (not credited), never weakens. The rendered text is put through the statement gate (nonempty, ≤16000 bytes, no control character, no `:=`, `--` or `/-`, balanced delimiters) and every dotted name in it MUST be spelled `_root_.`-first, because the pin elaborates at the root namespace with no `open`. The witness re-elaborates every corollary at exactly the rendered statement conjoined with `Holds` and audits its axioms (section 8): **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 | Certified exports the producer declared NO bridge for, with the reason it refused (a parameter type with no decoder, a recursive source type, an unresolvable source definition, a callee without a bridge). 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. | @@ -324,7 +324,7 @@ A conforming verifier MUST execute the following stages in order and MUST reject 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. +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` in code position. The scan is a case-sensitive token scan after lossy UTF-8 decoding that skips only normal string literals, line comments and block comments, and defaults to scanning as code on any lexical ambiguity (raw or interpolated string prefixes, unterminated strings or comments); word tokens match on identifier boundaries. Within its enumeration it is deliberately overbroad: package Lean files are data and definitions only. `deriving` has exactly one admitted form: the rest of its line is `deriving C, C, …` with every `C` one of `BEq`, `DecidableEq`, `Inhabited`, or `deriving instance C, C, … for T, T, …` with every `C` one of `ReflBEq`, `LawfulBEq` and every `T` a plain dotted identifier; nothing else may follow on the line, and the next token after the line (comments skipped) may be neither `,` nor `with`, since Lean's parser would continue the clause across the newline. A `deriving` clause runs the derive handler registered under each class name; a package can register none (every registration route is on this list), so the admitted clause runs only the pinned toolchain's handlers for those five classes, each of which produces ordinary declarations the kernel checks — the same kind a hand-written `instance`, which this scan never refused, produces. The reference implementation is `aver-cert/src/lean_gate.rs`, which the producer runs over its own model files before shipping them. 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. From 6dbd2edc4474e544e5a849ae3fb05c0c0f8f2312 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 10:07:26 +0200 Subject: [PATCH 27/89] cert model: take the refused prelude pieces from the wall, keep safe deriving Two defects made aver-cert check refuse a whole package: - A model that uses Bits or whose law proofs close with aver_int_order shipped the AverBits prelude (with @[simp] lemmas) and the aver_int_order syntax/macro_rules pair in AverCommon.lean, and the token gate refuses both. They now live in a new wall source, ModelPrelude.lean, which the checker owns and pins by the wall id; a certificate model imports it instead of carrying the text. The macro is recursive, so expanding it into the proofs was not an option. A compiler test pins the wall text to the proof-export prelude constants byte for byte. - The producer stripped every deriving line, so == on a record had no BEq instance and the model failed to build. The certificate model now keeps the derived BEq, DecidableEq where the type reflects equality, and the ReflBEq/LawfulBEq line, and drops Repr and Inhabited (the explicit Inhabited instance stays). The hand-written BEq for enums is gone: it shadowed the derived instance the LawfulBEq line is about. The wall gains one source, so the wall id rotates. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/ModelPrelude.lean | 174 ++++++++++++++++++ aver-cert/assets/wall/current/lakefile.lean | 2 +- aver-cert/src/format.rs | 2 +- aver-cert/src/wall.rs | 13 +- docs/certificate-format.md | 2 +- src/codegen/lean/prelude.rs | 41 ++++- src/codegen/lean/tests.rs | 85 +++++++++ src/codegen/lean/toplevel/mod.rs | 2 +- src/codegen/lean/toplevel/type_def.rs | 77 ++++---- src/codegen/lean/transpile.rs | 12 +- 10 files changed, 365 insertions(+), 45 deletions(-) create mode 100644 aver-cert/assets/wall/current/ModelPrelude.lean diff --git a/aver-cert/assets/wall/current/ModelPrelude.lean b/aver-cert/assets/wall/current/ModelPrelude.lean new file mode 100644 index 000000000..1bb895c92 --- /dev/null +++ b/aver-cert/assets/wall/current/ModelPrelude.lean @@ -0,0 +1,174 @@ +/- 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 + +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/lakefile.lean b/aver-cert/assets/wall/current/lakefile.lean index 60d3fd5e6..6990fe6ec 100644 --- a/aver-cert/assets/wall/current/lakefile.lean +++ b/aver-cert/assets/wall/current/lakefile.lean @@ -11,4 +11,4 @@ lean_lib «CertPrelude» where `SchemaSanity, `WasmSlice, `Wasip2Envelope, `ArithTemplateDerisk, `InterpreterSequencing, `Grammar, `GrammarLower, `GrammarSound, `GrammarTotal, `TypeTable, `AcceptedArtifactCore, `ClaimAxes, `AcceptanceSoundnessCore, - `AcceptanceSoundness, `GrammarBridge] + `AcceptanceSoundness, `GrammarBridge, `ModelPrelude] diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index a41d7957c..37f4ac498 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:f50e6372020e27a976216ca24607e846f815d1e7986b28a60d762026bb690994"; + "sha256:af393ce257133bbc8311bad0f2574f33f92cac4c68cff20e0447d1ffe61601e0"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index c15e8a579..9a59528f7 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -37,6 +37,10 @@ pub const CERT_ACCEPTANCE_SOUNDNESS_CORE: &str = pub const CERT_ACCEPTANCE_SOUNDNESS: &str = include_str!("../assets/wall/current/AcceptanceSoundness.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 { @@ -46,7 +50,7 @@ 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; 20] = [ +pub const SOURCES: [Source; 21] = [ Source { name: "AcceptanceSoundness.lean", contents: CERT_ACCEPTANCE_SOUNDNESS, @@ -103,6 +107,10 @@ pub const SOURCES: [Source; 20] = [ name: "InterpreterSequencing.lean", contents: CERT_INTERPRETER_SEQUENCING, }, + Source { + name: "ModelPrelude.lean", + contents: CERT_MODEL_PRELUDE, + }, Source { name: "Schema.lean", contents: CERT_SCHEMA, @@ -131,7 +139,7 @@ pub const SOURCES: [Source; 20] = [ /// Roots whose complete import graph is artifact-independent and can therefore /// be cached before a certificate is seen. -pub const PRISTINE_ROOTS: [&str; 18] = [ +pub const PRISTINE_ROOTS: [&str; 19] = [ "CertPrelude", "CertDecode", "ArithTemplateDerisk", @@ -150,6 +158,7 @@ pub const PRISTINE_ROOTS: [&str; 18] = [ "AcceptanceSoundnessCore", "AcceptanceSoundness", "GrammarBridge", + "ModelPrelude", ]; #[derive(Debug)] diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 99a7906ae..e5975982a 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 20 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:f50e6372020e27a976216ca24607e846f815d1e7986b28a60d762026bb690994` (`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. +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 21 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:af393ce257133bbc8311bad0f2574f33f92cac4c68cff20e0447d1ffe61601e0` (`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 = 9` 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. diff --git a/src/codegen/lean/prelude.rs b/src/codegen/lean/prelude.rs index f034d0474..0f81f9ec2 100644 --- a/src/codegen/lean/prelude.rs +++ b/src/codegen/lean/prelude.rs @@ -1682,8 +1682,25 @@ pub(super) fn generate_toolchain() -> String { "leanprover/lean4:v4.34.0\n".to_string() } +/// The checker-owned wall module a certificate model imports for the prelude +/// pieces the certificate token gate refuses in package text: `AverBits` +/// (whose equations are `@[simp]`) and the `aver_int_order` tactic (a +/// `syntax`/`macro_rules` pair). The module's text is these same two +/// constants, byte for byte (`aver-cert/assets/wall/current/ModelPrelude.lean`). +pub(crate) const CERT_MODEL_PRELUDE_MODULE: &str = "ModelPrelude"; + pub(super) fn build_common_lean(union_body: &str, cert_model: bool) -> String { - let mut parts = vec![LEAN_PRELUDE_HEADER.to_string()]; + let needs_order_kit = union_body.contains("aver_int_order"); + let needs_bits = crate::codegen::builtin_helpers::needed_helpers(union_body, false) + .iter() + .any(|helper| helper.key == "AverBits"); + let mut parts = Vec::new(); + // A certificate model takes both pieces from the checker's wall: the gate + // would refuse the attribute and the macro in the model's own text. + if cert_model && (needs_order_kit || needs_bits) { + parts.push(format!("import {CERT_MODEL_PRELUDE_MODULE}")); + } + parts.push(LEAN_PRELUDE_HEADER.to_string()); for record in crate::codegen::builtin_records::needed_records(union_body, false) { parts.push(crate::codegen::builtin_records::render_lean(record)); } @@ -1696,6 +1713,7 @@ pub(super) fn build_common_lean(union_body: &str, cert_model: bool) -> String { )), "NumericParse" => parts.push(generate_numeric_parse_prelude(union_body, false)), "StringCodePoint" => parts.push(LEAN_PRELUDE_STRING_CODE_POINT.to_string()), + "AverBits" if cert_model => {} "AverBits" => parts.push(LEAN_PRELUDE_AVER_BITS.to_string()), "AverMeasure" => parts.push(LEAN_PRELUDE_AVER_MEASURE.to_string()), "AverMap" => parts.push(generate_map_prelude(union_body, false)), @@ -1730,8 +1748,27 @@ pub(super) fn build_common_lean(union_body: &str, cert_model: bool) -> String { // stay byte-identical. Not a `BUILTIN_HELPERS` key: it is Lean-only // proof infrastructure (Z3 carries these natively, so Dafny ships // nothing), keyed on emitted tactic text rather than a builtin call. - if union_body.contains("aver_int_order") { + if needs_order_kit && !cert_model { parts.push(LEAN_PRELUDE_NONLINEAR_NONNEG.to_string()); } parts.join("\n\n") } + +#[cfg(all(test, feature = "certify"))] +mod cert_wall_prelude_tests { + /// The certificate model imports `AverBits` and `aver_int_order` from the + /// checker's wall instead of carrying them; the wall text must be these + /// constants byte for byte, or a certificate model and a proof export + /// would prove things about two different `Bits` models. + #[test] + fn the_wall_model_prelude_is_the_proof_prelude_text() { + let wall = aver_cert::wall::SOURCES + .iter() + .find(|source| { + source.name.strip_suffix(".lean") == Some(super::CERT_MODEL_PRELUDE_MODULE) + }) + .expect("the wall carries the model prelude"); + assert!(wall.contents.contains(super::LEAN_PRELUDE_AVER_BITS)); + assert!(wall.contents.contains(super::LEAN_PRELUDE_NONLINEAR_NONNEG)); + } +} diff --git a/src/codegen/lean/tests.rs b/src/codegen/lean/tests.rs index 6fdc63dd6..721ce11e7 100644 --- a/src/codegen/lean/tests.rs +++ b/src/codegen/lean/tests.rs @@ -5399,6 +5399,91 @@ fn count(n: Int, acc: Int) -> Int ); } +/// The two prelude pieces the certificate token gate refuses in package text +/// — `AverBits` with its `@[simp]` equations and the `syntax`/`macro_rules` +/// tactic `aver_int_order` — come from the checker-owned wall module in a +/// certificate model, never from the model's own `AverCommon.lean`. Proof +/// export keeps them inline. +#[test] +fn cert_model_takes_bits_and_the_order_kit_from_the_wall() { + let body = "def f (x : Int) : Int := AverBits.not x\ntheorem t : True := by aver_int_order"; + let cert = super::prelude::build_common_lean(body, true); + assert!( + cert.starts_with(&format!( + "import {}\n", + super::prelude::CERT_MODEL_PRELUDE_MODULE + )), + "{cert}" + ); + for refused in [ + "syntax", + "macro_rules", + "@[", + "namespace AverBits", + "aver_sq_nonneg", + ] { + assert!( + !cert.contains(refused), + "`{refused}` in the certificate prelude:\n{cert}" + ); + } + let proof = super::prelude::build_common_lean(body, false); + assert!(!proof.contains("import "), "{proof}"); + assert!( + proof.contains("macro_rules") && proof.contains("@[simp] theorem not_eq"), + "{proof}" + ); + // A model that needs neither imports nothing. + let plain = super::prelude::build_common_lean("def g (x : Int) : Int := x", true); + assert!(!plain.contains("import "), "{plain}"); +} + +/// A certificate model keeps the derived `BEq` (so `==` on a record has its +/// instance) and derived `DecidableEq` where the type reflects equality, and +/// nothing the checker's `deriving` gate refuses. A record with a `Float` +/// inside keeps `BEq` only: its `DecidableEq` would need the proof export's +/// `implemented_by` shim. +#[test] +fn cert_model_keeps_the_admitted_deriving_classes() { + let mut ctx = ctx_from_source( + r#"module Eqs + exposes [same, near] + effects [] +record Pair + a: Int + b: Int +record Reading + value: Float +fn same(x: Pair, y: Pair) -> Bool + x == y +fn near(x: Reading, y: Reading) -> Bool + x == y +"#, + "Eqs", + ); + let model = generated_lean_file(&transpile_for_cert_model(&mut ctx)); + let clauses: Vec<&str> = model + .lines() + .filter(|line| line.trim_start().starts_with("deriving")) + .collect(); + assert!(clauses.contains(&" deriving BEq, DecidableEq"), "{model}"); + assert!(clauses.contains(&" deriving BEq"), "{model}"); + for clause in &clauses { + assert!( + !clause.contains("Repr") && !clause.contains("Inhabited"), + "{clause}" + ); + } + assert!( + model.contains("deriving instance ReflBEq, LawfulBEq for Pair"), + "{model}" + ); + // The explicit `Inhabited` stays; no hand-written `BEq` competes with the + // derived one the `LawfulBEq` line is about. + assert!(model.contains("instance : Inhabited Pair"), "{model}"); + assert!(!model.contains("instance : BEq"), "{model}"); +} + mod untranslate_context; mod citation_probe; diff --git a/src/codegen/lean/toplevel/mod.rs b/src/codegen/lean/toplevel/mod.rs index 52a28ac0b..abb487ff8 100644 --- a/src/codegen/lean/toplevel/mod.rs +++ b/src/codegen/lean/toplevel/mod.rs @@ -12,7 +12,7 @@ pub use fn_def::{emit_fn_def, emit_fn_def_proof, emit_mutual_group, emit_mutual_ pub use fuel::PROOF_FUEL_EXHAUSTED_MSG; pub(super) use fuel::{law_fuel_simp_names, law_string_pos_rank}; pub use type_def::{ - emit_beq_instance, emit_inhabited_instance, emit_recursive_decidable_eq, + cert_model_deriving, emit_inhabited_instance, emit_recursive_decidable_eq, emit_recursive_measure, emit_type_def_in_scope, }; pub(crate) use verify::law_as_lemma_statement; diff --git a/src/codegen/lean/toplevel/type_def.rs b/src/codegen/lean/toplevel/type_def.rs index 03380deb3..99d3b9dfa 100644 --- a/src/codegen/lean/toplevel/type_def.rs +++ b/src/codegen/lean/toplevel/type_def.rs @@ -115,40 +115,53 @@ pub fn emit_inhabited_instance(td: &TypeDef, ctx: &CodegenContext, scope: Option } } -/// Cert-model `BEq` witness for an all-nullary sum. The certificate's model -/// files may not carry `deriving` (the checker's code-exec token wall rejects -/// the token), so `==` on a user enum needs a hand-emitted instance the same -/// way `Inhabited` gets one. Only the all-nullary shape is emitted: it needs -/// no field instances and no recursion, so the instance can never itself fail -/// to elaborate. A type with payload fields stays uninstanced — `==` on it -/// still fails typeclass synthesis loudly, the same fail-closed decline as -/// before. -pub fn emit_beq_instance(td: &TypeDef) -> String { - if crate::codegen::proof_recognize::detect_canonical_peano(td).is_some() { - return String::new(); - } - match td { - TypeDef::Sum { name, variants, .. } if variants.iter().all(|v| v.fields.is_empty()) => { - let lean_name = aver_name_to_lean(name); - let arms = variants - .iter() - .map(|v| { - let ctor = lean_ctor_name(&v.name); - format!(" | .{ctor}, .{ctor} => true") - }) - .collect::>() - .join("\n"); - let fallback = if variants.len() > 1 { - "\n | _, _ => false" - } else { - "" - }; - format!( - "instance : BEq {lean_name} :=\n ⟨fun a b => match a, b with\n{arms}{fallback}⟩" - ) +/// The certificate-model form of a type declaration's `deriving` clause. +/// +/// The checker's token gate admits a `deriving` clause only when every class +/// it names is one of `BEq`, `DecidableEq`, `Inhabited` (and `ReflBEq`, +/// `LawfulBEq` for the stand-alone `deriving instance … for T` line): the +/// derive handlers of the pinned toolchain for those classes, which only +/// produce kernel-checked declarations. This keeps the proof emission's +/// derived `BEq` — so `==` on a record or a sum has its instance, and the +/// `LawfulBEq` line the law proofs rewrite `==` to `=` with is about that very +/// instance — and drops the rest: +/// +/// * `Repr` — the model never prints; +/// * `Inhabited` — the certificate model states its own `Inhabited` instance +/// next to the type ([`emit_inhabited_instance`]), which skips a constructor +/// it cannot default instead of failing the build; +/// * `DecidableEq` unless the type reflects equality: proof export gets +/// `DecidableEq Float` from an `implemented_by` shim the gate refuses, so a +/// type with a `Float` inside has no derivable instance in a certificate. +/// +/// A clause left with no class is removed. +pub fn cert_model_deriving( + type_def: &str, + td: &TypeDef, + ctx: &CodegenContext, + scope: Option<&str>, +) -> String { + let reflects = equality::reflects_equality( + &crate::types::Type::named(crate::codegen::common::type_def_name(td)), + ctx, + scope, + ); + let mut lines = Vec::new(); + for line in type_def.lines() { + let Some(classes) = line.strip_prefix(" deriving ") else { + lines.push(line.to_string()); + continue; + }; + let kept: Vec<&str> = classes + .split(',') + .map(str::trim) + .filter(|class| *class == "BEq" || (*class == "DecidableEq" && reflects)) + .collect(); + if !kept.is_empty() { + lines.push(format!(" deriving {}", kept.join(", "))); } - _ => String::new(), } + lines.join("\n") } /// Can `deriving Inhabited` find a witness for a value of this annotation? diff --git a/src/codegen/lean/transpile.rs b/src/codegen/lean/transpile.rs index af490bc97..a4f600810 100644 --- a/src/codegen/lean/transpile.rs +++ b/src/codegen/lean/transpile.rs @@ -527,7 +527,13 @@ fn emit_type_sections( measure_sig_type_refs: &[String], ) -> Vec { ctx.with_module_scope(scope, || { - let mut sections = vec![toplevel::emit_type_def_in_scope(td, ctx, scope)]; + let type_def = toplevel::emit_type_def_in_scope(td, ctx, scope); + let type_def = if cert_model { + toplevel::cert_model_deriving(&type_def, td, ctx, scope) + } else { + type_def + }; + let mut sections = vec![type_def]; if scope == Some("Bytes") && crate::codegen::common::type_def_name(td) == "Bytes" { sections.push( "instance : Nonempty Bytes := ⟨⟨[], by simp [Bytes.allInRange]⟩⟩".to_string(), @@ -560,10 +566,6 @@ def stringFromUtf8 (bytes : Bytes) : Except String String := if !inst.is_empty() { sections.push(inst); } - let beq = toplevel::emit_beq_instance(td); - if !beq.is_empty() { - sections.push(beq); - } } if toplevel::is_recursive_type_def(td) && crate::codegen::proof_recognize::detect_canonical_peano(td).is_none() From b8653a2900615dfd80e858c3cf3e4fbe5aa74ef8 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 10:07:33 +0200 Subject: [PATCH 28/89] cert: ship the model nested, isolate each theorem, self-check before shipping Three more ways one law or bridge could cost the whole package: - A user module named Laws (or Bridge, Manifest, Grammar, Schema, ...) shadowed a package or wall file, so the producer left out the whole model and declined every bridge and law. Model files now ship under the reserved directory AverModel/, with model-to-model imports rewritten; the Lean namespaces, and so every name a claim cites, do not change. - A deterministic maxHeartbeats timeout in one law proof escaped the first | ... | sorry ladder (Lean re-throws resource-limit exceptions past every tactic combinator) and failed the build. Every theorem of the model, Bridge.lean and Laws.lean is now prefixed with #guard_msgs (drop error) in. Lean's error recovery already closes a failed goal with sorryAx; only the error message failed the build. The axiom audit then declines exactly the claims that rest on the failed proof. - The producer runs the checker's file-name rule, case-collision rule and token scan over every model file, keeping only the deriving classes the gate admits. A model that would still fail is declined with a reason, costing its bridges and laws and never the byte certificate. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/render_package.rs | 5 +- aver-cert/src/engine/source_bridges.rs | 386 +++++++++++++++++++++---- docs/certificate-format.md | 4 +- 3 files changed, 338 insertions(+), 57 deletions(-) diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 8b7625ddd..d84f8943f 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -685,8 +685,8 @@ pub fn write_project( // 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 &model.files { - write_nested(&cert_dir, path, &sanitize_model_for_cert(content))?; + for (path, content) in &surfaces.model.files { + write_nested(&cert_dir, path, content)?; } } let bridges: &[SourceBridge] = if surfaces.bridge_lean.is_some() { @@ -700,7 +700,6 @@ pub fn write_project( if let Some(laws_lean) = &surfaces.laws_lean { write(&cert_dir, "Laws.lean", laws_lean)?; } - let _ = &surfaces.model_roots; std::fs::write( cert_dir.join("cert-manifest.json"), render_manifest_json( diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index ccfe1f3de..383be0e16 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -117,8 +117,7 @@ impl SourceBridge { /// 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('.') + if !crate::bridge_statement::is_plain_export_name(&bridge.export) || !is_plain_dotted_name(&bridge.model) || bridge.theorem != SourceBridge::theorem_name(&bridge.export) || bridge.corollary != SourceBridge::corollary_name(&bridge.export) @@ -1477,69 +1476,246 @@ fn law_bridge_coverage(statement: &str, info: &ModelInfo, bridges: &[SourceBridg Some(covering) } -/// The model files the package ships, and the module roots they define. -/// Every model file is a nested or flat `.lean` file; a root that would -/// shadow a package or wall file is refused (the whole model is then left -/// out and every bridge and law declined). -fn model_roots(model: &SourceModel) -> Result, String> { - const PACKAGE_ROOTS: &[&str] = &[ - "Module", - "Plans", - "Manifest", - "Artifact", - "ArtifactHostRoles", - "Final", - "ArtifactCertificate", - "Bridge", - "Laws", - "ArtifactBytes", - "ArtifactComponentBytes", - "CheckerWitness", - ]; +/// 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 Some(stem) = path.strip_suffix(".lean") else { - continue; - }; - 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(|c| c.is_ascii_alphanumeric() || c == '_' || c == '\'') - }); - if !valid { - return Err(format!("model file `{path}` is not a plain Lean module path")); + 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 root = segments.join("."); - if PACKAGE_ROOTS.contains(&root.as_str()) - || wall::SOURCES - .iter() - .any(|source| source.name.strip_suffix(".lean") == Some(segments[0])) - { - return Err(format!("model module `{root}` would shadow a certificate file")); + 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" + )); } - roots.push(root); + packaged.files.push((package_path, text)); } - Ok(roots) + packaged.roots = roots + .iter() + .map(|root| format!("{MODEL_PACKAGE_DIR}.{root}")) + .collect(); + Ok(packaged) } -/// Drop the lines the checker's code-execution wall refuses (`deriving`); -/// the certificate model mode emits nothing else it would. -fn sanitize_model_for_cert(content: &str) -> String { +/// 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() { - if line.trim_start().starts_with("deriving ") { + 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 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 { + let kept = keep(rest, &crate::lean_gate::DERIVING_CLASSES); + (!kept.is_empty()).then(|| format!("{indent}deriving {}", kept.join(", "))) + }; + 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() + .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 +} + /// What `write_project` needs to render the bridge and law surfaces. struct Surfaces { - model_roots: Vec, + model: PackagedModel, bridge_lean: Option, laws_lean: Option, bridges: Vec, @@ -1551,7 +1727,7 @@ struct Surfaces { fn plan_surfaces(analysis: &Analysis, model: &SourceModel) -> Surfaces { let decline_all = |reason: String| Surfaces { - model_roots: Vec::new(), + model: PackagedModel::default(), bridge_lean: None, laws_lean: None, bridges: Vec::new(), @@ -1571,14 +1747,15 @@ fn plan_surfaces(analysis: &Analysis, model: &SourceModel) -> Surfaces { if let Some(reason) = &model.failure { return decline_all(reason.clone()); } - let roots = match model_roots(model) { - Ok(roots) => roots, + 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(|| render_bridge_lean(&plan, &roots)); + .then(|| isolate_theorems(&render_bridge_lean(&plan, &roots))); let info = ModelInfo::from_model(model); let (law_claims, declined_laws) = admit_law_claims(model.law_claims.clone()); let law_bridges: Vec> = law_claims @@ -1595,13 +1772,13 @@ fn plan_surfaces(analysis: &Analysis, model: &SourceModel) -> Surfaces { }) .collect(); let laws_lean = (!law_claims.is_empty()) - .then(|| render_laws_lean(&law_claims, &law_bridge_terms, &roots)); + .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_roots: roots, + model: packaged, bridge_lean, laws_lean, bridges, @@ -1776,6 +1953,111 @@ mod source_bridge_tests { ); } + /// 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![], + ); + let packaged = package_model(&m).expect("the model ships"); + assert_eq!( + packaged.roots, + vec!["AverModel.AverCommon", "AverModel.Laws", "AverModel.Grammar"] + ); + 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")); + } + + /// 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. diff --git a/docs/certificate-format.md b/docs/certificate-format.md index e5975982a..35b3ed3c5 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -59,8 +59,8 @@ A certificate package is one directory, conventionally named `cert/`, emitted ne | `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` | The plan-equals-source proofs: per bridged function a decoder (`dec_`), a source image (`img_`) and ONE step lemma (`step_`, `GrammarBridge.Step`), the image table `I`, and per manifest `sourceBridges` entry the bridge theorem `AverCert.Bridge.` (assembled from the step lemmas of its call closure by `GrammarBridge.exact_of_step` or `GrammarBridge.bridge_of_step`) and the corollary `AverCert.Bridge._certified` the manifest names. Each proof is `first \| (script under a heartbeat cap) \| sorry`, so a proof that does not close costs its own bridges (through the axiom audit) and never the build. 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 functions and laws the bridges and law-claims speak about; recursive functions keep their native `termination_by` equations, so a bridge unfolds one step through the equation lemma. Shipped only when the package declares a bridge or a law-claim. A dotted module dependency (`Data.Fibonacci`) ships its model at the corresponding nested path (`Data/Fibonacci.lean`) and is imported by `Bridge.lean` and `Laws.lean` under its dotted module name (`import Data.Fibonacci`); the verifier stages a nested file only when `Manifest.lean`, `Certificate.lean`, `Bridge.lean` or `Laws.lean` imports it. | +| `Bridge.lean` | The plan-equals-source proofs: per bridged function a decoder (`dec_`), a source image (`img_`) and ONE step lemma (`step_`, `GrammarBridge.Step`), the image table `I`, and per manifest `sourceBridges` entry the bridge theorem `AverCert.Bridge.` (assembled from the step lemmas of its call closure by `GrammarBridge.exact_of_step` or `GrammarBridge.bridge_of_step`) and the corollary `AverCert.Bridge._certified` the manifest names. Each proof is `first \| (script under a heartbeat cap) \| sorry`, so a proof that does not close costs its own bridges (through the axiom audit) and never the build. Every theorem also sits behind `#guard_msgs (drop error) in` (see the model-modules row): a resource-limit exception such as a deterministic `maxHeartbeats` timeout escapes every `first` alternative, and without the wrapper its error message failed the whole build. Emitted only when the `sourceBridges` array is nonempty. | +| Model modules (`AverModel/AverCommon.lean`, `AverModel/.lean`, ...) | The `aver proof` Lean model emission in its certificate mode. These carry the source functions and laws the bridges and law-claims speak about; recursive functions keep their native `termination_by` equations, so a bridge unfolds one step through the equation lemma. Shipped only when the package declares a bridge or a law-claim. Every model file ships under the one reserved directory `AverModel/`, whatever the Aver module is called: module `Laws` ships as `AverModel/Laws.lean` and is imported as `AverModel.Laws`, and a dotted module (`Data.Fibonacci`) as `AverModel/Data/Fibonacci.lean` (`import AverModel.Data.Fibonacci`). Flat, a user module named like a package or wall file (`Laws`, `Bridge`, `Grammar`, `Schema`) shadowed it and the producer had to leave the whole model out; nested, no model root can equal or prefix a package, wall or toolchain root. Only the file location moves: the model-to-model `import` lines are rewritten to the nested names, while the Lean namespaces — and so every name a bridge or law-claim cites — stay as emitted. The certificate mode differs from proof export in three ways the staging gates dictate: (1) the prelude pieces the token scan refuses in package text — `AverBits` with its `@[simp]` equations and the `syntax`/`macro_rules` tactic `aver_int_order` — are not emitted; `AverCommon.lean` imports them from the checker-owned wall module `ModelPrelude` instead (a compiler test pins that module's text to the proof-export prelude byte for byte); (2) a type keeps only the `deriving` classes stage 7 admits — `BEq`, `DecidableEq` where the type reflects equality, and the `deriving instance ReflBEq, LawfulBEq for T` line — and states its `Inhabited` instance explicitly; (3) every theorem, of the model and of `Bridge.lean` and `Laws.lean`, is prefixed with `#guard_msgs (drop error) in`, before its `set_option … in` lines and doc comment. A proof that fails — including a deterministic `maxHeartbeats` timeout, which Lean re-throws past every `first \| … \| sorry` alternative — is an elaboration error, and one error used to fail `lake build` and the whole package; Lean's error recovery already closes the failed goal with `sorryAx` (or leaves the constant undeclared, and every declaration citing it recovers to `sorryAx` in turn), so dropping the error MESSAGE of that one command lets the build go on while the axiom audit of section 8 declines exactly the claims resting on the failed proof. The wrapper changes no declaration and admits nothing the kernel did not check; warnings still reach the build log. Before shipping, the producer runs the checker's own file-name rule, case-collision rule and token scan (`aver-cert/src/lean_gate.rs`) over every model file; a model that would fail any of them is not shipped, and every bridge and law-claim is declined with the reason instead of the checker refusing the package. The verifier stages a nested file only when `Manifest.lean`, `Certificate.lean`, `Bridge.lean` or `Laws.lean` imports it. | 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). From 7c1b74e6cbaea71a6c0199fdf85c40f628cbd497 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 10:32:59 +0200 Subject: [PATCH 29/89] cert model: a when-guarded law over Bool connectives exports universally The certificate model exports a when-guarded holds law as a universal claim only when its unfold cone is transparent arithmetic. Bool.and, Bool.or and Bool.not counted as opaque builtins, so a law like the k5 Table 3 rows (a window Bool.and(a <= x, x <= b) under a when) kept its bounded sampled-domain statement and was left out entirely. These three are written inline as &&, || and ! in the Lean model, so there is nothing to unfold; the cone walker now admits them and the proof's simp set gains the lemmas that turn them into propositions for omega. The proof still ends in sorry when it does not close, and the axiom audit decides credit. On k5_fdiv this adds 16 law-claims, all credited. Co-Authored-By: Claude Opus 5.5 (1M context) --- src/codegen/lean/law_auto.rs | 18 ++++++++++++++--- src/codegen/lean/tests.rs | 39 ++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 3 deletions(-) diff --git a/src/codegen/lean/law_auto.rs b/src/codegen/lean/law_auto.rs index 0cf4cc115..0221b9c3e 100644 --- a/src/codegen/lean/law_auto.rs +++ b/src/codegen/lean/law_auto.rs @@ -1750,7 +1750,10 @@ fn emit_verify_law_forall_auto_proof_inner( let mut simp_names = unfolds.clone(); for bridge in [ "decide_eq_true_eq", + "decide_eq_false_iff_not", "Bool.and_eq_true", + "Bool.or_eq_true", + "Bool.not_eq_true'", "beq_iff_eq", "ge_iff_le", "gt_iff_lt", @@ -2038,9 +2041,15 @@ fn cone_body_is_transparent_arithmetic( /// - record construction whose every field is admitted; /// - a call to a user definition that is ITSELF a member of this cone, with /// admitted arguments. A callee that resolves to no user definition — every -/// builtin (`Int.abs`, `Bool.and`, …) and every capability operation — is +/// builtin (`Int.abs`, `String.len`, …) and every capability operation — is /// refused here, which is the whole point of walking bodies rather than -/// inspecting the collected name set. +/// inspecting the collected name set; +/// - the three Boolean connectives `Bool.and`, `Bool.or`, `Bool.not` over +/// admitted arguments. They are the one exception to the builtin rule +/// because they are not calls in the model at all: the Lean emission writes +/// them as the operators `&&`, `||`, `!` inline, so there is nothing to +/// unfold, and the proof arm's simp set carries the lemmas that turn them +/// into `∧`, `∨`, `¬` for `omega`. /// /// Everything else (`match`, lists, tuples, maps, strings, `Float`, `?`, /// record update, tail calls, independent products, constructors) declines. @@ -2081,7 +2090,10 @@ fn transparent_arithmetic_expr( return false; }; let Some(fd) = shared::find_fn_def_by_call_name(ctx, &name) else { - return false; + return matches!(name.as_str(), "Bool.and" | "Bool.or" | "Bool.not") + && args + .iter() + .all(|arg| transparent_arithmetic_expr(arg, bound, cone, ctx)); }; cone.contains(&fd.name) && args diff --git a/src/codegen/lean/tests.rs b/src/codegen/lean/tests.rs index 721ce11e7..c62b04bc4 100644 --- a/src/codegen/lean/tests.rs +++ b/src/codegen/lean/tests.rs @@ -5037,6 +5037,45 @@ verify nonNeg law nonNegOfPositive ); } +/// The k5 Table 3 rows: a `when`-guarded `holds` law whose subject is a +/// `Bool.and` of two comparisons. The Boolean connectives are operators in the +/// Lean model (`&&`, `||`, `!`), not calls, so the cone stays transparent and +/// the law exports as the true universal — instead of the bounded +/// sampled-domain statement the certificate model leaves out. +#[test] +fn cert_model_admits_boolean_connectives_in_a_when_linear_cone() { + let mut ctx = ctx_from_source( + r#" +module TableRow + intent = "a table row as an order window" + +fn window(e: Int, f: Int) -> Bool + ? "f equals e, stated as a two-sided window." + Bool.and(e <= f, Bool.not(f < e)) + +verify window law row + given e: Int = [0] + given f: Int = [0] + when Bool.or(f == e, false) + window(e, f) holds +"#, + "table_row", + ); + let lean = generated_lean_file(&transpile_for_cert_model(&mut ctx)); + assert!( + lean.contains("-- aver:law-class window_law_row universal window.row"), + "{lean}" + ); + assert!( + lean.contains("theorem window_law_row : ∀ (e : Int) (f : Int), "), + "{lean}" + ); + assert!( + lean.contains("Bool.or_eq_true, Bool.not_eq_true'"), + "{lean}" + ); +} + /// CORE when-linear consequence, NEGATIVE gate: the SAME law shape, but one /// cone body calls the builtin `Int.abs`. The cone-name collector resolves /// user definitions only, so that call leaves no name behind — the older From a75c8b1f04369fd4b77ac8063fe26cae771803cd Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 11:44:56 +0200 Subject: [PATCH 30/89] cert: admit a keyword-escape prime anywhere after a segment's first letter A law of a function named after a Lean keyword (btc-listener's Rules.at) lives in a theorem like at'_law_rulesOnlyTurnOn, with the transpiler's prime in the middle of the name. The shared identifier rule only allowed trailing primes, so the producer left three such laws out. Lean lexes a prime after a letter as part of the identifier, so admitting it anywhere after the first character cannot open a character literal. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/bridge_statement.rs | 19 +++++++++++-------- aver-cert/src/lean_gate.rs | 16 ++++++++++++---- aver-cert/src/verifier.rs | 2 +- docs/certificate-format.md | 4 ++-- 4 files changed, 26 insertions(+), 15 deletions(-) diff --git a/aver-cert/src/bridge_statement.rs b/aver-cert/src/bridge_statement.rs index 0b707c1d1..d37bf9616 100644 --- a/aver-cert/src/bridge_statement.rs +++ b/aver-cert/src/bridge_statement.rs @@ -497,18 +497,18 @@ 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 a trailing-prime `'` (the transpiler's -/// reserved-word escape). +/// 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(); - let head_ok = - matches!(chars.next(), Some(first) if first.is_ascii_alphabetic() || first == '_'); - let body: String = chars.collect(); - let body = body.trim_end_matches('\''); - head_ok && body.chars().all(|c| c.is_ascii_alphanumeric() || c == '_') + matches!(chars.next(), Some(first) if first.is_ascii_alphabetic() || first == '_') + && chars.all(|c| c.is_ascii_alphanumeric() || c == '_' || c == '\'') }) } @@ -971,6 +971,9 @@ mod tests { fn reserved_word_primes_are_plain_names() { assert!(is_plain_dotted_name("_root_.Models.Type'.field")); assert!(!is_plain_dotted_name("_root_.Models.'x")); - assert!(!is_plain_dotted_name("_root_.Models.x'y")); + // 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/lean_gate.rs b/aver-cert/src/lean_gate.rs index efe394daa..475f8277b 100644 --- a/aver-cert/src/lean_gate.rs +++ b/aver-cert/src/lean_gate.rs @@ -225,10 +225,10 @@ fn is_plain_unprimed_name(value: &str) -> bool { /// 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 trailing-prime escape in any -/// segment (a law of a function named after a reserved word lives in -/// `…none'` scope); the label and the corollary never do, since the corollary -/// is the label's flattening and the label is a source identity. +/// 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, @@ -533,6 +533,14 @@ mod tests { 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") diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index a804b2d2a..97afe0780 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -3038,7 +3038,7 @@ mod tests { ); for refused in [ "Domain.Policy.'none", - "Domain.Policy.no'ne", + "Domain.Policy..none", "Domain.Policy.none\u{ab}", ] { let mut entry = raw_bridge("Domain_Policy_none"); diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 35b3ed3c5..f26b7d9ec 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -103,8 +103,8 @@ The manifest is a single JSON object. The reference parser is strict about the f | `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), except that each segment of `theorem` may end in one or more `'` (the transpiler's escape of a Lean keyword, `none'`); the producer applies this same gate, through the same code, before it declares a claim; `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 the producer bridges, each an exact object `{export, theorem, corollary, model, kind, params, result}`. **The entry carries STRUCTURE, never statement text.** The verifier RENDERS the pinned statement from `(export, model, kind, params, result)` (`aver-cert/src/bridge_statement.rs`, the one renderer producer and checker share) 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). `export` MUST be a plain undotted identifier naming an entry of `certified[]`, listed at most once; it fixes the obligation the statement speaks about (`GrammarBridge.exportObligation manifest ""`), so an entry cannot point its claim at another export. `theorem` MUST be exactly `AverCert.Bridge.` and `corollary` exactly `AverCert.Bridge._certified`. `model` is the fully qualified transpiled source function (a plain dotted identifier, ≤200 bytes, a trailing `'` allowed per segment) and is SPLICED into the rendered statement. `kind` is `"exact"` or `"adequate"`. `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 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, …]}` (two or more); `{"kind": "list", "elem": E}`; `{"kind": "vector", "elem": E}`. Names are `_root_.`-qualified plain dotted identifiers; every accessor MUST be a member of its record type and every constructor of its sum type; 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)` (its UTF-8 bytes), a record ↦ `SVal.record tid` of its declared accessors in order (a one-field record is a newtype and still has one field here), a sum ↦ a `match` giving `SVal.variant tid c` of the constructor's fields with `c` its position in `ctors`, `Option` ↦ `SVal.none`/`SVal.some` and Aver `Result` (Lean `Except E T`) ↦ `SVal.ok`/`SVal.err`, each instantiated at the elements' plan types, a tuple ↦ `SVal.record tid` of its components, a list ↦ `SVal.nil`/`SVal.cons` by `List.foldr`, a vector ↦ `SVal.vec` of its elements. With `o := exportObligation manifest ""`, the `exact` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∃ k, ∀ fuel, k ≤ fuel → ∀ x…, o.model fuel [enc x…] = some (encRes ( x…)))` and the `adequate` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∀ fuel x… v, o.model fuel [enc x…] = some v → v = encRes ( x…))`; a nullary export renders without parameter binders. `ArgsTyped` says the encoded arguments inhabit the plan's parameter types, so the obligation's `holds` applies to them; `GrammarBridge.adequate_transfer` states what an adequate bridge then means 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: a model that never returns satisfies it vacuously, and a reimplementation MUST NOT present it as a totality claim. The kind is a producer choice: an `exact` claim on a recursive plan simply fails to prove (not credited), never weakens. The rendered text is put through the statement gate (nonempty, ≤16000 bytes, no control character, no `:=`, `--` or `/-`, balanced delimiters) and every dotted name in it MUST be spelled `_root_.`-first, because the pin elaborates at the root namespace with no `open`. The witness re-elaborates every corollary at exactly the rendered statement conjoined with `Holds` and audits its axioms (section 8): **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. | +| `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), except that `theorem` may also carry `'` after the first character of a segment (the transpiler's escape of a Lean keyword: `none'`, and the law theorem `at'_law_…` of a function `at`); the producer applies this same gate, through the same code, before it declares a claim; `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 the producer bridges, each an exact object `{export, theorem, corollary, model, kind, params, result}`. **The entry carries STRUCTURE, never statement text.** The verifier RENDERS the pinned statement from `(export, model, kind, params, result)` (`aver-cert/src/bridge_statement.rs`, the one renderer producer and checker share) 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). `export` MUST be a plain undotted identifier naming an entry of `certified[]`, listed at most once; it fixes the obligation the statement speaks about (`GrammarBridge.exportObligation manifest ""`), so an entry cannot point its claim at another export. `theorem` MUST be exactly `AverCert.Bridge.` and `corollary` exactly `AverCert.Bridge._certified`. `model` is the fully qualified transpiled source function (a plain dotted identifier, ≤200 bytes, `'` allowed after the first character of a segment) and is SPLICED into the rendered statement. `kind` is `"exact"` or `"adequate"`. `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 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, …]}` (two or more); `{"kind": "list", "elem": E}`; `{"kind": "vector", "elem": E}`. Names are `_root_.`-qualified plain dotted identifiers; every accessor MUST be a member of its record type and every constructor of its sum type; 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)` (its UTF-8 bytes), a record ↦ `SVal.record tid` of its declared accessors in order (a one-field record is a newtype and still has one field here), a sum ↦ a `match` giving `SVal.variant tid c` of the constructor's fields with `c` its position in `ctors`, `Option` ↦ `SVal.none`/`SVal.some` and Aver `Result` (Lean `Except E T`) ↦ `SVal.ok`/`SVal.err`, each instantiated at the elements' plan types, a tuple ↦ `SVal.record tid` of its components, a list ↦ `SVal.nil`/`SVal.cons` by `List.foldr`, a vector ↦ `SVal.vec` of its elements. With `o := exportObligation manifest ""`, the `exact` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∃ k, ∀ fuel, k ≤ fuel → ∀ x…, o.model fuel [enc x…] = some (encRes ( x…)))` and the `adequate` statement is `∃ o, … = some o ∧ (∀ x…, ArgsTyped o [enc x…]) ∧ (∀ fuel x… v, o.model fuel [enc x…] = some v → v = encRes ( x…))`; a nullary export renders without parameter binders. `ArgsTyped` says the encoded arguments inhabit the plan's parameter types, so the obligation's `holds` applies to them; `GrammarBridge.adequate_transfer` states what an adequate bridge then means 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: a model that never returns satisfies it vacuously, and a reimplementation MUST NOT present it as a totality claim. The kind is a producer choice: an `exact` claim on a recursive plan simply fails to prove (not credited), never weakens. The rendered text is put through the statement gate (nonempty, ≤16000 bytes, no control character, no `:=`, `--` or `/-`, balanced delimiters) and every dotted name in it MUST be spelled `_root_.`-first, because the pin elaborates at the root namespace with no `open`. The witness re-elaborates every corollary at exactly the rendered statement conjoined with `Holds` and audits its axioms (section 8): **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 | Certified exports the producer declared NO bridge for, with the reason it refused (a parameter type with no decoder, a recursive source type, an unresolvable source definition, a callee without a bridge). 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. | From c4bf53d524a58fb6fcb73824b47bd14687974f8c Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 11:44:56 +0200 Subject: [PATCH 31/89] cert: build the bridge proofs apart from the byte-level proof Bridge.lean imported Final for its _certified corollaries, so every bridge proof waited for Artifact.lean, the byte-level proof whose build time grows with the module. On btc-listener's 117 KB module the two took about eleven and five minutes one after the other. The decoders, images, step lemmas and bridge theorems now go to BridgeProof.lean, which does not import Final; Bridge.lean keeps the corollaries the manifest names and still imports every model root. The integration tests read and tamper the proofs in their new file, and account for the isolation line that now precedes each declaration. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/render_package.rs | 5 ++- aver-cert/src/engine/source_bridges.rs | 58 +++++++++++++++++++------- docs/certificate-format.md | 2 +- tests/cert_certify_spec.rs | 6 +-- tests/cert_verify_spec.rs | 22 ++++++---- 5 files changed, 64 insertions(+), 29 deletions(-) diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index d84f8943f..db34da0f8 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -694,8 +694,9 @@ pub fn write_project( } else { &[] }; - if let Some(bridge_lean) = &surfaces.bridge_lean { - write(&cert_dir, "Bridge.lean", bridge_lean)?; + if let Some((proofs, corollaries)) = &surfaces.bridge_lean { + 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)?; diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index 383be0e16..25be128e3 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -1289,6 +1289,7 @@ fn render_export( 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); @@ -1368,21 +1369,36 @@ fn render_export( s.push_str("\n next => "); s.push_str(&kind_proof); s.push_str("\n done))\n | sorry\n\n"); - s.push_str("/-- The claim the manifest names: the bridge conjoined with the\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_."); - s.push_str(&bridge.corollary); - s.push_str(" :\n ("); - s.push_str(&statement); - s.push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) :=\n ⟨_root_."); - s.push_str(&bridge.theorem); - s.push_str(", _root_.AverCert.Final.cert⟩\n\n"); + c.push_str(&bridge.corollary); + c.push_str(" :\n ("); + c.push_str(&statement); + c.push_str(") ∧ (_root_.AverCert.Schema.Holds _root_.AverCert.manifest) :=\n ⟨_root_."); + c.push_str(&bridge.theorem); + c.push_str(", _root_.AverCert.Final.cert⟩\n\n"); let _ = param_binders; } -/// Render the package's `Bridge.lean`. -fn render_bridge_lean(plan: &BridgePlan, model_roots: &[String]) -> String { +/// The package module that carries the bridge proofs themselves. +pub const BRIDGE_PROOF_MODULE: &str = "BridgeProof"; + +/// Render the package's bridge surface as two files: `BridgeProof.lean` +/// (decoders, images, step lemmas and one bridge theorem per export) and +/// `Bridge.lean` (the `_certified` corollaries the manifest names). +/// +/// 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) { 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\ @@ -1390,7 +1406,6 @@ fn render_bridge_lean(plan: &BridgePlan, model_roots: &[String]) -> String { -- 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\ import GrammarBridge\n", ); for root in model_roots { @@ -1435,11 +1450,23 @@ fn render_bridge_lean(plan: &BridgePlan, model_roots: &[String]) -> String { for b in plan.fns.values() { render_step(b, &plan.fns, &literal_names, &mut s); } + let mut corollaries = String::new(); for (bridge, func_idx) in &plan.bridges { - render_export(bridge, *func_idx, plan, &mut s); + render_export(bridge, *func_idx, plan, &mut s, &mut corollaries); } s.push_str("end AverCert.Bridge\n"); - s + 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) } // ---- law coverage ------------------------------------------------------------- @@ -1716,7 +1743,7 @@ fn command_preamble_start(lines: &[&str], keyword_line: usize) -> usize { /// What `write_project` needs to render the bridge and law surfaces. struct Surfaces { model: PackagedModel, - bridge_lean: Option, + bridge_lean: Option<(String, String)>, laws_lean: Option, bridges: Vec, law_claims: Vec, @@ -1755,7 +1782,10 @@ fn plan_surfaces(analysis: &Analysis, model: &SourceModel) -> Surfaces { 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(|| isolate_theorems(&render_bridge_lean(&plan, &roots))); + .then(|| { + let (proofs, corollaries) = render_bridge_lean(&plan, &roots); + (isolate_theorems(&proofs), isolate_theorems(&corollaries)) + }); let info = ModelInfo::from_model(model); let (law_claims, declined_laws) = admit_law_claims(model.law_claims.clone()); let law_bridges: Vec> = law_claims diff --git a/docs/certificate-format.md b/docs/certificate-format.md index f26b7d9ec..8d7b5ad39 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -59,7 +59,7 @@ A certificate package is one directory, conventionally named `cert/`, emitted ne | `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` | The plan-equals-source proofs: per bridged function a decoder (`dec_`), a source image (`img_`) and ONE step lemma (`step_`, `GrammarBridge.Step`), the image table `I`, and per manifest `sourceBridges` entry the bridge theorem `AverCert.Bridge.` (assembled from the step lemmas of its call closure by `GrammarBridge.exact_of_step` or `GrammarBridge.bridge_of_step`) and the corollary `AverCert.Bridge._certified` the manifest names. Each proof is `first \| (script under a heartbeat cap) \| sorry`, so a proof that does not close costs its own bridges (through the axiom audit) and never the build. Every theorem also sits behind `#guard_msgs (drop error) in` (see the model-modules row): a resource-limit exception such as a deterministic `maxHeartbeats` timeout escapes every `first` alternative, and without the wrapper its error message failed the whole build. Emitted only when the `sourceBridges` array is nonempty. | +| `BridgeProof.lean`, `Bridge.lean` | The plan-equals-source proofs, in `BridgeProof.lean`: per bridged function a decoder (`dec_`), a source image (`img_`) and ONE step lemma (`step_`, `GrammarBridge.Step`), the image table `I`, and per manifest `sourceBridges` entry the bridge theorem `AverCert.Bridge.` (assembled from the step lemmas of its call closure by `GrammarBridge.exact_of_step` or `GrammarBridge.bridge_of_step`). `Bridge.lean` imports it and carries per entry the corollary `AverCert.Bridge._certified` the manifest names. Only the corollaries cite `Final.cert`, which sits behind the byte-level `Artifact.lean`, so the split lets the bridge proofs build in parallel with it rather than after it. Each proof is `first \| (script under a heartbeat cap) \| sorry`, so a proof that does not close costs its own bridges (through the axiom audit) and never the build. Every theorem also sits behind `#guard_msgs (drop error) in` (see the model-modules row): a resource-limit exception such as a deterministic `maxHeartbeats` timeout escapes every `first` alternative, and without the wrapper its error message failed the whole build. Emitted only when the `sourceBridges` array is nonempty. | | Model modules (`AverModel/AverCommon.lean`, `AverModel/.lean`, ...) | The `aver proof` Lean model emission in its certificate mode. These carry the source functions and laws the bridges and law-claims speak about; recursive functions keep their native `termination_by` equations, so a bridge unfolds one step through the equation lemma. Shipped only when the package declares a bridge or a law-claim. Every model file ships under the one reserved directory `AverModel/`, whatever the Aver module is called: module `Laws` ships as `AverModel/Laws.lean` and is imported as `AverModel.Laws`, and a dotted module (`Data.Fibonacci`) as `AverModel/Data/Fibonacci.lean` (`import AverModel.Data.Fibonacci`). Flat, a user module named like a package or wall file (`Laws`, `Bridge`, `Grammar`, `Schema`) shadowed it and the producer had to leave the whole model out; nested, no model root can equal or prefix a package, wall or toolchain root. Only the file location moves: the model-to-model `import` lines are rewritten to the nested names, while the Lean namespaces — and so every name a bridge or law-claim cites — stay as emitted. The certificate mode differs from proof export in three ways the staging gates dictate: (1) the prelude pieces the token scan refuses in package text — `AverBits` with its `@[simp]` equations and the `syntax`/`macro_rules` tactic `aver_int_order` — are not emitted; `AverCommon.lean` imports them from the checker-owned wall module `ModelPrelude` instead (a compiler test pins that module's text to the proof-export prelude byte for byte); (2) a type keeps only the `deriving` classes stage 7 admits — `BEq`, `DecidableEq` where the type reflects equality, and the `deriving instance ReflBEq, LawfulBEq for T` line — and states its `Inhabited` instance explicitly; (3) every theorem, of the model and of `Bridge.lean` and `Laws.lean`, is prefixed with `#guard_msgs (drop error) in`, before its `set_option … in` lines and doc comment. A proof that fails — including a deterministic `maxHeartbeats` timeout, which Lean re-throws past every `first \| … \| sorry` alternative — is an elaboration error, and one error used to fail `lake build` and the whole package; Lean's error recovery already closes the failed goal with `sorryAx` (or leaves the constant undeclared, and every declaration citing it recovers to `sorryAx` in turn), so dropping the error MESSAGE of that one command lets the build go on while the axiom audit of section 8 declines exactly the claims resting on the failed proof. The wrapper changes no declaration and admits nothing the kernel did not check; warnings still reach the build log. Before shipping, the producer runs the checker's own file-name rule, case-collision rule and token scan (`aver-cert/src/lean_gate.rs`) over every model file; a model that would fail any of them is not shipped, and every bridge and law-claim is declined with the reason instead of the checker refusing the package. The verifier stages a nested file only when `Manifest.lean`, `Certificate.lean`, `Bridge.lean` or `Laws.lean` imports it. | 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). diff --git a/tests/cert_certify_spec.rs b/tests/cert_certify_spec.rs index c8a09553f..ed593646e 100644 --- a/tests/cert_certify_spec.rs +++ b/tests/cert_certify_spec.rs @@ -462,11 +462,11 @@ fn certify_goal_matrix_manifest_tracks_current_surface() { } } } - // The statement the package's own `Bridge.lean` carries is the one the + // The statement the package's own bridge proofs carry is the one the // checker renders from the entry above — the producer writes it through // the same function the verifier pins with. - let bridge_lean = std::fs::read_to_string(out_dir.join("cert").join("Bridge.lean")) - .expect("a bridged package emits Bridge.lean"); + let bridge_lean = std::fs::read_to_string(out_dir.join("cert").join("BridgeProof.lean")) + .expect("a bridged package emits BridgeProof.lean"); assert!( bridge_lean.contains(&format!("_root_.AverCert.Plans.{export}Plan.body")), "the emitted bridge names the export's own plan" diff --git a/tests/cert_verify_spec.rs b/tests/cert_verify_spec.rs index 637d6f14b..da143882c 100644 --- a/tests/cert_verify_spec.rs +++ b/tests/cert_verify_spec.rs @@ -628,7 +628,7 @@ fn cert_verify_accepts_nested_module_certificate() { /// A module carrying records verifies end to end. /// /// The model has to state each record's default value itself, because the -/// checker wall strips `deriving` from the staged model. Stating that value as +/// certificate model does not derive `Inhabited`. Stating that value as /// the record's own default made the instance its own premise, so a model /// carrying a one-field record never built and its certificate was DECLINED. /// The fixture pairs a one-field record with a record whose field is that @@ -672,8 +672,8 @@ fn cert_verify_accepts_record_carrying_model() { /// A model carrying a recursive sum type with no nullary constructor builds /// and its certificate verifies end to end. /// -/// The model states each sum type's `Inhabited` witness itself (the checker -/// wall strips `deriving`). The witness used to default the FIRST +/// The model states each sum type's `Inhabited` witness itself (the +/// certificate model does not derive it). The witness used to default the FIRST /// constructor's arguments whenever no nullary constructor existed — for /// `Chain = More(Chain) | Stop(Int)` that stated `⟨Chain.more default⟩`, /// whose `default` asks for the very instance being stated, so the model @@ -8711,7 +8711,7 @@ fn cert_tripwire_declines_tampered_source_bridges() { ); let cert = out_dir.join("cert"); - let bridge_lean = std::fs::read_to_string(cert.join("Bridge.lean")).unwrap(); + let bridge_lean = std::fs::read_to_string(cert.join("BridgeProof.lean")).unwrap(); let manifest = std::fs::read_to_string(cert.join("cert-manifest.json")).unwrap(); assert_eq!( bridge_lean @@ -8822,7 +8822,7 @@ fn cert_tripwire_declines_tampered_source_bridges() { ); let dir = temp_dir("cert-k5-bridge-sorry-tamper"); copy_dir(&out_dir, &dir); - std::fs::write(dir.join("cert").join("Bridge.lean"), sorried).unwrap(); + std::fs::write(dir.join("cert").join("BridgeProof.lean"), sorried).unwrap(); let (ok, out) = aver_check(&dir.join("main.wasm"), &dir.join("cert")); assert!( ok, @@ -8907,7 +8907,7 @@ fn cert_tripwire_declines_tampered_source_bridges() { let sorried = sorry_out_theorem(&bridge_lean, step_name); let dir = temp_dir("cert-k5-bridge-step-tamper"); copy_dir(&out_dir, &dir); - std::fs::write(dir.join("cert").join("Bridge.lean"), sorried).unwrap(); + std::fs::write(dir.join("cert").join("BridgeProof.lean"), sorried).unwrap(); let (ok, out) = aver_check(&dir.join("main.wasm"), &dir.join("cert")); assert!( ok, @@ -8940,9 +8940,13 @@ fn sorry_out_theorem(lean: &str, name: &str) -> String { .unwrap_or_else(|| panic!("expected the theorem {name}")); let rest = &lean[at..]; let assign = rest.find(" := by\n").expect("expected a tactic proof"); - let end = rest[assign..] - .find("\n\n/--") - .expect("expected the theorem to end before the next doc comment") + // The next declaration opens with its `#guard_msgs` isolation line, its + // doc comment, or the namespace's `end`. + let end = ["\n\n#guard_msgs", "\n\n/--", "\nend AverCert"] + .iter() + .filter_map(|next| rest[assign..].find(next)) + .min() + .expect("expected the theorem to end before the next declaration") + assign; format!( "{}{} := by\n sorry{}", From de1296473b82040184e34de8d096a016fd0b41f2 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 13:07:39 +0200 Subject: [PATCH 32/89] cert: admit Euclidean Int.div and Int.mod through a pinned divmod helper The plan grammar admits the two shapes the MIR emitter produces for integer division, printed 1:1 by the plan printer: - the resolver's literal-divisor discharge `IntDivEuclid(a, k)` / `IntModEuclid(a, k)` (a nonzero Int literal divisor), lowered to `a; k; i32.const want_mod; call __aint_divmod`; - the fused `Result.withDefault(Int.div(a, b), )` and its `Int.mod` twin, lowered as the emitter does: the three operands once each into the operand scratch locals after the const-compare scratch, a zero test of the divisor on its carrier word, then the default or `__aint_divmod(a, b, want_mod)`. `Int.div` / `Int.mod` are admitted only there; unfused they decline by name. `__aint_divmod` becomes the `divmod` host role (manifest `hostRoleTable` key, `CertDecode.AddSub.Roles.divmod`). It is not exported, so like add/sub/mul/eq it is pinned by its template only (`ArithTemplateDerisk.divmodTemplateBody`, a function of the same six declared indices); the producer declares it only at the one function whose body is that template. New named runtime contract, `HostContracts.divmod`: on a represented, canonical operand pair with a nonzero divisor and want_mod 0 or 1, a result the helper returns represents `a / b` (Lean `Int.ediv`) or `a % b` (`Int.emod`, in `[0, |b|)`) and is canonical. Nothing is claimed at a zero divisor: the intrinsic's divisor is a nonzero literal by typing, and the fused form's zero test is proved exact on any represented word. No division plan is L3. The wall id rotates. Bridges: the step proofs simplify `intrinsicEval`, and a package whose bridged plans call `Result.withDefault` carries a `withDefault_ite` rewrite for the models' `Except.withDefault` over an `if`. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../wall/current/AcceptanceSoundness.lean | 14 +- .../wall/current/AcceptanceSoundnessCore.lean | 3 +- .../wall/current/AcceptedArtifactCore.lean | 7 +- .../wall/current/ArithTemplateDerisk.lean | 191 ++++++++++++- aver-cert/assets/wall/current/CertDecode.lean | 2 + aver-cert/assets/wall/current/ClaimAxes.lean | 5 + aver-cert/assets/wall/current/Grammar.lean | 93 ++++++- .../assets/wall/current/GrammarBridge.lean | 7 + .../assets/wall/current/GrammarLower.lean | 36 ++- .../assets/wall/current/GrammarSound.lean | 254 +++++++++++++++++- aver-cert/assets/wall/current/SchemaBase.lean | 2 +- aver-cert/assets/wall/current/SchemaCore.lean | 12 +- .../assets/wall/current/SchemaSanity.lean | 3 +- aver-cert/assets/wall/current/TypeTable.lean | 1 + aver-cert/src/engine/mod.rs | 3 + aver-cert/src/engine/module_facts.rs | 106 +++++++- aver-cert/src/engine/plan.rs | 22 ++ aver-cert/src/engine/plan_check.rs | 83 +++++- aver-cert/src/engine/produce.rs | 1 + aver-cert/src/engine/render_package.rs | 6 +- aver-cert/src/engine/source_bridges.rs | 17 ++ aver-cert/src/format.rs | 2 +- aver-cert/src/verifier.rs | 22 +- docs/certificate-format.md | 7 +- src/codegen/cert/plan_from_mir.rs | 129 ++++++++- 25 files changed, 974 insertions(+), 54 deletions(-) diff --git a/aver-cert/assets/wall/current/AcceptanceSoundness.lean b/aver-cert/assets/wall/current/AcceptanceSoundness.lean index 9f1e526f0..fed842d28 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundness.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundness.lean @@ -52,12 +52,15 @@ theorem fns_certified (hf : PlanFacts s tt fns) ∀ 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, hClaims⟩ := + 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⟩⟩ + ⟨_, 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) ?_ ?_ @@ -120,12 +123,15 @@ theorem obligation_total (hf : PlanFacts s tt fns) {e : FnEntry} (he : e ∈ fns 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, hClaims⟩ := + 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⟩⟩ + ⟨_, 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) diff --git a/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean b/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean index cf9356636..5331ba79b 100644 --- a/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean +++ b/aver-cert/assets/wall/current/AcceptanceSoundnessCore.lean @@ -112,6 +112,7 @@ theorem host_facts {M : MCtx} {fns : List FnEntry} (h : HostFns) 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] @@ -121,7 +122,7 @@ theorem host_facts {M : MCtx} {fns : List FnEntry} (h : HostFns) 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]), L (by simp [hostAssoc]), ?_⟩ intro e he apply lookup_none rw [hostAssoc_keys] diff --git a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean index bb83c7ffa..0594288fd 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean @@ -55,13 +55,13 @@ def hostAssoc (M : MCtx) (h : HostFns) : List (Nat × (Nat × (List WVal → Opt [(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.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.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) @@ -322,7 +322,8 @@ def arithTableCheck (n len : Nat) (roles? : Option CertDecode.AddSub.Roles) 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 diff --git a/aver-cert/assets/wall/current/ArithTemplateDerisk.lean b/aver-cert/assets/wall/current/ArithTemplateDerisk.lean index cc5490a36..aace91163 100644 --- a/aver-cert/assets/wall/current/ArithTemplateDerisk.lean +++ b/aver-cert/assets/wall/current/ArithTemplateDerisk.lean @@ -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/CertDecode.lean b/aver-cert/assets/wall/current/CertDecode.lean index f8746b97e..4efb79a4d 100644 --- a/aver-cert/assets/wall/current/CertDecode.lean +++ b/aver-cert/assets/wall/current/CertDecode.lean @@ -977,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/ClaimAxes.lean b/aver-cert/assets/wall/current/ClaimAxes.lean index 4d29cc727..96773e510 100644 --- a/aver-cert/assets/wall/current/ClaimAxes.lean +++ b/aver-cert/assets/wall/current/ClaimAxes.lean @@ -48,6 +48,7 @@ structure ContractUse where toIndex : Bool := false cmp : Bool := false eq : Bool := false + divmod : Bool := false addTotal : Bool := false subTotal : Bool := false mulTotal : Bool := false @@ -72,6 +73,7 @@ def contractUse (artifact : ArtifactData) : ContractUse := 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 } @@ -94,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 := @@ -111,6 +115,7 @@ 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 []) diff --git a/aver-cert/assets/wall/current/Grammar.lean b/aver-cert/assets/wall/current/Grammar.lean index 2fa26dd26..921cb0b39 100644 --- a/aver-cert/assets/wall/current/Grammar.lean +++ b/aver-cert/assets/wall/current/Grammar.lean @@ -37,9 +37,16 @@ * `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), and - the fused `Option.withDefault(Vector.get(v, i), )` over two - bare locals (the emitter's bounds-checked `array.get`). + 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. @@ -125,6 +132,16 @@ inductive Builtin where /-- `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 @@ -138,6 +155,7 @@ 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 @@ -224,6 +242,8 @@ structure MCtx where 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) @@ -356,6 +376,24 @@ 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 @@ -472,9 +510,22 @@ mutual | some (.vec t), some .int, some td => if td = t then some t else none | _, _, _ => none | none => - match tyOf M n Γ false o, tyOf M n Γ false d with - | some to, some td => lazyTy lb to td - | _, _ => 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 @@ -507,6 +558,15 @@ mutual 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 @@ -725,6 +785,11 @@ def strCat : List SVal → Option (List Nat) | .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)) @@ -733,6 +798,18 @@ def builtinEval : Builtin → List SVal → Option SVal | .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. -/ @@ -788,6 +865,10 @@ mutual 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 diff --git a/aver-cert/assets/wall/current/GrammarBridge.lean b/aver-cert/assets/wall/current/GrammarBridge.lean index 2c2429564..62c7f2839 100644 --- a/aver-cert/assets/wall/current/GrammarBridge.lean +++ b/aver-cert/assets/wall/current/GrammarBridge.lean @@ -217,6 +217,13 @@ theorem eval_mono {F G : Nat → List SVal → Option SVal} (hle : Le F G) : 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 <;> diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean index 0b0ed5e1a..a6eee8eec 100644 --- a/aver-cert/assets/wall/current/GrammarLower.lean +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -49,7 +49,14 @@ `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`. + 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 @@ -279,6 +286,24 @@ def extractB (ss idx : Nat) : Nat → List Nat → List BI 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 @@ -340,6 +365,12 @@ mutual | 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)] ++ @@ -357,6 +388,8 @@ mutual (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, _ => @@ -541,6 +574,7 @@ def encW : WInstr → Option (List Nat) | 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] diff --git a/aver-cert/assets/wall/current/GrammarSound.lean b/aver-cert/assets/wall/current/GrammarSound.lean index 9ebfb878a..0571d4b5f 100644 --- a/aver-cert/assets/wall/current/GrammarSound.lean +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -79,7 +79,9 @@ end Rel `__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. -/ + `-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 @@ -87,6 +89,9 @@ structure XHost {C : Nat} (S : CarrierSpec C) (M : MCtx) (host : HostTbl) : Prop ∀ 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`. -/ @@ -885,6 +890,21 @@ theorem vecGetOr?_some {lb : LazyBuiltin} {o d : Expr} {v i : Nat} 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)) = @@ -1250,14 +1270,17 @@ theorem tysOf_length : ∀ {es : List Expr} {ts : List Ty}, tysOf M n Γ es = so 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 ∧ ∃ to td, tyOf M n Γ false o = some to ∧ + (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) := by + 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 + right; left split at h · rename_i t td hv hi hd split at h @@ -1268,12 +1291,62 @@ theorem tyOf_lazy_inv {lb : LazyBuiltin} {o d : Expr} {T : Ty} · simp at h · simp at h · rename_i hvg - left - refine ⟨hvg, ?_⟩ split at h - · rename_i to td ho hd - exact ⟨to, td, ho, hd, h⟩ - · simp 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 @@ -1606,6 +1679,98 @@ theorem ctor_refTest_exact {M : MCtx} {tid ncs : Nat} {entries : List (List Nat) 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 structural induction on the grammar (mutual over the nested @@ -1721,6 +1886,26 @@ theorem agreement : 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, Γ, 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, Γ, 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 @@ -2001,8 +2186,8 @@ theorem agreement : | .call (.lazy _) (_ :: _ :: _ :: _), _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty | .call (.lazy lb) [o, d], Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by - rcases tyOf_lazy_inv hty with ⟨hvg, to, td, hto, htd, hlz⟩ | - ⟨v, i, t, hvg, hΓv, hΓi, htd, rfl⟩ + 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 => @@ -2016,7 +2201,7 @@ theorem agreement : subst td simp only [Option.some.injEq] at hlz subst T - simp only [lowerW, lowerB, hvg, hto, eraseL_append, List.append_assoc] at hrun + 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 @@ -2054,7 +2239,7 @@ theorem agreement : subst td simp only [Option.some.injEq] at hlz subst T - simp only [lowerW, lowerB, hvg, hto, eraseL_append, List.append_assoc] at hrun + 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 @@ -2097,6 +2282,49 @@ theorem agreement : · 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by obtain ⟨ts, hts, hct⟩ := tyOf_construct_inv hty diff --git a/aver-cert/assets/wall/current/SchemaBase.lean b/aver-cert/assets/wall/current/SchemaBase.lean index 714baf59e..f4372db7e 100644 --- a/aver-cert/assets/wall/current/SchemaBase.lean +++ b/aver-cert/assets/wall/current/SchemaBase.lean @@ -287,7 +287,7 @@ 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 } + 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 diff --git a/aver-cert/assets/wall/current/SchemaCore.lean b/aver-cert/assets/wall/current/SchemaCore.lean index 72c7fea8a..cef070fa4 100644 --- a/aver-cert/assets/wall/current/SchemaCore.lean +++ b/aver-cert/assets/wall/current/SchemaCore.lean @@ -96,6 +96,7 @@ structure HostFns where 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 @@ -106,8 +107,12 @@ structure HostFns where 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. A helper that returns `none` makes its - premise vacuous: none of these demands trap-freedom. -/ + `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 @@ -123,6 +128,9 @@ structure HostContracts {C : Nat} (S : CarrierSpec C) (h : HostFns) : Prop where 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 diff --git a/aver-cert/assets/wall/current/SchemaSanity.lean b/aver-cert/assets/wall/current/SchemaSanity.lean index c18b621d6..d1d181625 100644 --- a/aver-cert/assets/wall/current/SchemaSanity.lean +++ b/aver-cert/assets/wall/current/SchemaSanity.lean @@ -163,7 +163,7 @@ 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 } + toIndex := fun _ => none, divmod := fun _ => none } example (C : Nat) : HostContracts (sanityCarrierSpec C) trapHost where add := by intro _ _ _ _ _ _ _ h; cases h @@ -173,6 +173,7 @@ example (C : Nat) : HostContracts (sanityCarrierSpec C) trapHost where 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 -/ diff --git a/aver-cert/assets/wall/current/TypeTable.lean b/aver-cert/assets/wall/current/TypeTable.lean index 73cab4ac9..56cbf0bbb 100644 --- a/aver-cert/assets/wall/current/TypeTable.lean +++ b/aver-cert/assets/wall/current/TypeTable.lean @@ -100,6 +100,7 @@ def mctxOf (s : Subject) (tt : TypeTable) (fns : List FnEntry) : MCtx := 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 } diff --git a/aver-cert/src/engine/mod.rs b/aver-cert/src/engine/mod.rs index 45e4c93dc..e208d8922 100644 --- a/aver-cert/src/engine/mod.rs +++ b/aver-cert/src/engine/mod.rs @@ -68,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. diff --git a/aver-cert/src/engine/module_facts.rs b/aver-cert/src/engine/module_facts.rs index 55f4fad56..b11a5a95a 100644 --- a/aver-cert/src/engine/module_facts.rs +++ b/aver-cert/src/engine/module_facts.rs @@ -93,6 +93,9 @@ pub struct HostRoles { 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, @@ -122,7 +125,7 @@ impl HostRoles { /// The `CertDecode.AddSub.Roles` literal. pub fn roles_lean_value(&self) -> String { format!( - "({{ box := {}, add := {}, mul := {}, sub := {}, toIndex := {}, cmp := {}, eq := {} }} : CertDecode.AddSub.Roles)", + "({{ 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), @@ -130,6 +133,7 @@ impl HostRoles { 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), ) } @@ -142,6 +146,92 @@ impl HostRoles { } } +/// `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 { @@ -786,6 +876,20 @@ impl ModuleFacts { } } } + // `__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 diff --git a/aver-cert/src/engine/plan.rs b/aver-cert/src/engine/plan.rs index bca8a07a3..9cb69ff8e 100644 --- a/aver-cert/src/engine/plan.rs +++ b/aver-cert/src/engine/plan.rs @@ -53,6 +53,18 @@ pub enum PlanBuiltin { 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`. @@ -68,6 +80,7 @@ pub enum PlanCallee { Fn(u32), Builtin(PlanBuiltin), Lazy(PlanLazy), + Intrinsic(PlanIntrinsic), } /// `Grammar.CtorTag`. @@ -269,6 +282,15 @@ impl PlanCallee { 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!( diff --git a/aver-cert/src/engine/plan_check.rs b/aver-cert/src/engine/plan_check.rs index 9f1839987..576bd5f6f 100644 --- a/aver-cert/src/engine/plan_check.rs +++ b/aver-cert/src/engine/plan_check.rs @@ -34,6 +34,7 @@ struct MCtx<'a> { concat: u64, streq: u64, to_index: u64, + divmod: u64, tt: &'a PlanTypeTable, sigs: HashMap, PlanTy)>, } @@ -67,6 +68,7 @@ impl<'a> MCtx<'a> { 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, } @@ -263,6 +265,26 @@ fn vec_get_or(lb: PlanLazy, o: &PlanExpr, d: &PlanExpr) -> Option<(u32, u32)> { } } +/// `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) } @@ -369,14 +391,26 @@ impl MCtx<'_> { } _ => None, }, - None => lazy_ty( - *lb, - &self.ty_of(n, g, false, o)?, - &self.ty_of(n, g, false, d)?, - ), + 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) { @@ -757,6 +791,7 @@ enum WI { StructNew(u64), StructGet(u64, u32), RefIsNull, + I64Eqz, I32Eqz, I32Eq, I32Ne, @@ -944,6 +979,14 @@ impl MCtx<'_> { } 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)))); @@ -1085,6 +1128,35 @@ impl MCtx<'_> { )); 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) @@ -1485,6 +1557,7 @@ impl MCtx<'_> { 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), diff --git a/aver-cert/src/engine/produce.rs b/aver-cert/src/engine/produce.rs index 7d2960412..e854b222f 100644 --- a/aver-cert/src/engine/produce.rs +++ b/aver-cert/src/engine/produce.rs @@ -745,6 +745,7 @@ pub fn analyze( (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), diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index db34da0f8..9aadfb216 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -297,6 +297,7 @@ fn render_artifact_host_roles(analysis: &Analysis, params: &str) -> String { leaf("mul", roles.mul_idx), leaf("cmp", roles.cmp_idx), leaf("eq", roles.eq_idx), + leaf("divmod", roles.divmod_idx), ] .join("\n\n"); format!( @@ -345,7 +346,7 @@ fn render_artifact( 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, Bool.and_true, Bool.true_and]\n \ + decodedHostRole_eq, decodedHostRole_divmod, Bool.and_true, Bool.true_and]\n \ decide +kernel", r.roles_lean_value() ), @@ -566,7 +567,7 @@ fn render_manifest_json( 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\": {}}},\n", + " \"hostRoleTable\": {{\"box\": {}, \"add\": {}, \"mul\": {}, \"sub\": {}, \"toIndex\": {}, \"cmp\": {}, \"eq\": {}, \"divmod\": {}}},\n", role(r.box_idx), role(r.add_idx), role(r.mul_idx), @@ -574,6 +575,7 @@ fn render_manifest_json( role(r.to_index_idx), role(r.cmp_idx), role(r.eq_idx), + role(r.divmod_idx), )), None => s.push_str(" \"hostRoleTable\": null,\n"), } diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index 25be128e3..65bba9b37 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -860,6 +860,9 @@ struct BridgePlan { /// 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, } /// Every String literal a plan mentions (literal nodes and literal @@ -952,6 +955,7 @@ fn plan_bridges(analysis: &Analysis, model: &SourceModel) -> BridgePlan { declined: Vec::new(), depth: BTreeMap::new(), literals: BTreeSet::new(), + with_default: false, }; if let Some(reason) = &model.failure { for c in &analysis.certified { @@ -1007,6 +1011,7 @@ fn plan_bridges(analysis: &Analysis, model: &SourceModel) -> BridgePlan { 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) => { @@ -1118,6 +1123,7 @@ const EVAL_SIMPS: &str = "AverCert.Grammar.eval, AverCert.Grammar.evalArgs, \ AverCert.Grammar.evalArms, AverCert.Grammar.argsEnv, AverCert.Grammar.upd, \ AverCert.Grammar.intBin, AverCert.Grammar.boolBin, AverCert.Grammar.floatBin, \ 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, \ AverCert.GrammarBridge.decodeStr_strBytes, AverCert.GrammarBridge.strBytes_append, AverCert.GrammarBridge.strBytes_hadd, AverCert.GrammarBridge.strBytes_toString, \ @@ -1447,6 +1453,17 @@ fn render_bridge_lean(plan: &BridgePlan, model_roots: &[String]) -> (String, Str )); literal_names.push_str(&format!(", strLit_{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", + ); + literal_names.push_str(", withDefault_ite"); + } for b in plan.fns.values() { render_step(b, &plan.fns, &literal_names, &mut s); } diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 37f4ac498..d95c3624d 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:af393ce257133bbc8311bad0f2574f33f92cac4c68cff20e0447d1ffe61601e0"; + "sha256:792ac24d6852d944f2dd960a5857b8c9534a0e005c014d86f62604b9cabc1be1"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index 97afe0780..e4aec8778 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -183,8 +183,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, @@ -193,6 +193,7 @@ type HostRoleTable = ( Option, Option, Option, + Option, ); struct ManifestIdentity { @@ -763,10 +764,19 @@ 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 := {} }} : \ + cmp := {}, eq := {}, divmod := {} }} : \ CertDecode.AddSub.Roles)", lean_option_nat(box_role), lean_option_nat(add_role), @@ -775,6 +785,7 @@ 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(), @@ -1454,7 +1465,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] { @@ -1470,6 +1481,7 @@ fn read_candidates( optional_index("toIndex")?, optional_index("cmp")?, optional_index("eq")?, + optional_index("divmod")?, )) }; diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 8d7b5ad39..e4edb2c85 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 21 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:af393ce257133bbc8311bad0f2574f33f92cac4c68cff20e0447d1ffe61601e0` (`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. +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 21 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:792ac24d6852d944f2dd960a5857b8c9534a0e005c014d86f62604b9cabc1be1` (`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 = 9` 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. @@ -132,7 +132,7 @@ Declared-only rows describe producer output. The reference verifier never reads ### 4.3 `hostRoleTable`: the declare-and-confirm host-helper pin -`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 module-wide box/add/mul/sub/toIndex/cmp/eq/divmod 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`, `divmod`, each a `u32` or `null`. `divmod` is the Euclidean division helper `__aint_divmod(a, b, want_mod)`; it is not exported, so like `add`, `sub`, `mul` and `eq` it is bound by its template equality only (`ArithTemplateDerisk.divmodTemplateBody`, a function of the same six `arithParams` indices), and a `null` declaration lowers every division to an absent index, which no code entry encodes. 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. 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. @@ -353,8 +353,9 @@ What a positive verdict does trust — the honest TCB: - **`wasmparser`** for full WebAssembly validity (stage 2 rationale): the input is attacker-chosen and the Lean wall does not subsume this check, so it sits on the adversarial path. - **SHA-256 collision resistance**, for both the artifact hash and the wall identity — the two bindings that make a certificate non-transferable. An adversary who can produce SHA-256 collisions can transplant a certificate onto different bytes or a different wall. - **The named runtime contracts** — the L1 theorems are conditional on the host helpers obeying the disclosed laws, and the L3 theorems additionally on the disclosed totality; proving the shipped runtime satisfies them is a per-toolchain-release obligation outside the certificate. +- **The Euclidean division contract (`__aint_divmod`).** A plan that divides (the literal-divisor intrinsics `IntDivEuclid` / `IntModEuclid`, and the fused `Result.withDefault(Int.div(a, b), )` / `Int.mod`) is certified conditionally on one more named contract, disclosed as `__aint_divmod (canonical carrier pair, nonzero divisor, want_mod 0 or 1 -> canonical Euclidean quotient (0) or remainder in [0, |b|) (1))` and stated in `Schema.HostContracts.divmod` as: for represented, canonical operands `a`, `b` with `b ≠ 0` and `want_mod ∈ {0, 1}`, a result the helper returns represents `a / b` (`want_mod = 0`) or `a % b` (`want_mod = 1`), where `/` and `%` are Lean's `Int.ediv` and `Int.emod` (the remainder lies in `[0, |b|)`, the quotient is `(a - a % b) / b`), and the result is canonical. This matches `aver-rt`'s `AverInt::{div,rem}_euclid` and the VM's `Int.div` / `Int.mod` exactly. The contract says nothing at `b = 0`: the helper's fast path traps there (`i64.rem_s`), and every admitted plan either divides by a nonzero literal (the typing requires it) or tests the divisor for zero on its carrier word before the call (the fused form, whose zero test the wall proves exact on any represented word: a Small word carries its value, and a limb-carrying word is never zero, `CarrierSpec.bigElim`). No division plan is L3: the totality check admits no division node. The helper body is pinned by template (section 4.3); what it computes is this contract, an assumption of the theorem like the add/sub/mul contracts, and its canonicity half is exercised empirically by `tests/cert_intcmp_differential.rs`. - **Runtime helpers modelled as pure value functions.** The statement wires each runtime helper as a function from argument values to an optional result value (`Schema.HostFns`), and the wall's interpreter has no heap: a struct or array is an immutable value. The theorem therefore assumes that a helper does not mutate anything reachable from the values it is given or that the caller still holds. Nothing in the bytes enforces this: the type-table pin compares field storage only, so the mutability of the carrier's fields and of `$string` (`(array (mut i8))`) is not pinned, and a helper that wrote through a reference it was passed would break the model without breaking any pin. -- **The bignum sub-routines behind add, sub, mul and cmp.** The template equality of section 4.3 pins the bodies of the `box`, `toIndex`, `add`, `sub`, `mul`, `cmp` and `eq` helpers, and the add, sub and mul templates (and the three-way `cmp` template, for three of them) call four factored sub-routines at declared indices (`arithParams.decompose`, `normalize`, `strip`, `umagCmp`). The bodies of those four functions are not pinned: the wall confirms only that the pinned templates call the declared indices. Whether the add, sub, mul and cmp contracts hold for a given artifact therefore rests on code the certificate does not look at. This predates schema 9 and is not changed by it; it is one more reason the runtime contracts above are a per-release obligation rather than a fact about the artifact. +- **The bignum sub-routines behind add, sub, mul, cmp and divmod.** The template equality of section 4.3 pins the bodies of the `box`, `toIndex`, `add`, `sub`, `mul`, `cmp`, `eq` and `divmod` helpers, and the add, sub, mul and divmod templates (and the three-way `cmp` template, for three of them) call four factored sub-routines at declared indices (`arithParams.decompose`, `normalize`, `strip`, `umagCmp`). The bodies of those four functions are not pinned: the wall confirms only that the pinned templates call the declared indices. Whether the add, sub, mul, cmp and divmod contracts hold for a given artifact therefore rests on code the certificate does not look at. This predates schema 9 and is not changed by it; it is one more reason the runtime contracts above are a per-release obligation rather than a fact about the artifact. - **"Returns" at L3 is a statement about the wall's interpreter.** `holdsTotal` says the emitted function returns at fuel `n.natAbs + 1` in the wall's interpreter, where fuel counts nested calls and nothing else runs out. A real engine has a bounded call stack and a bounded heap, so for large `n` a run can still trap on stack exhaustion or allocation failure; neither is covered, and the L3 promise must not be read as "the engine returns for every input". - **The plan is the claim — for an export without a credited source-bridge.** Every obligation's `model` is the plan's fuel-indexed meaning (`AcceptedArtifact.modelOf`), and the report line prints that plan. The identification of that plan with the function the user wrote IS a kernel-checked theorem wherever the package declares a source-bridge and the verifier credits it (section 4.1), pinned by `AverCertChecker.bridge_pin_` at a statement the VERIFIER rendered from the manifest's declared structure and axiom-audited like any other claim; its proof is assembled from one-step obligations by the wall's `GrammarBridge.exact_of_step` / `bridge_of_step`, so recursion and mutual recursion need no per-function induction. A law-claim whose `bridges` list is non-empty conjoins, under one kernel-checked name, the universal law of the source model, `Holds` about the plan, and the bridges of every function the law mentions. What remains trusted: (i) the ENCODERS, which the producer chooses and which are part of the theorem's statement — the verifier constrains their SHAPE (a closed kind set, `_root_.`-qualified names, members of the types they claim) but not that the constructor order or the type ids are the correspondence the user meant; the typing conjunct (`ArgsTyped`) rules out encoders whose images the plan cannot even be run on; (ii) **the MODEL definition itself, which is producer-emitted**: `_root_..` is a definition the package's own model modules carry, so `plan ≡ ` is kernel-checked RELATIVE TO those modules, not a proof that the transpilation of the user's source was faithful; (iii) an `adequate` bridge is partial correctness only — it is vacuous where the model never returns — and never a totality claim; (iv) an export with NO declared or no credited bridge, where the plan is the claim and its correspondence to the source rests on the producer deriving the plan from the source program's MIR. Today the shapes without a bridge are: a parameter that is a Float, a List or a Vector (no decoder in this version), a recursive source type, a source definition the producer cannot resolve unambiguously, a function whose callee has no bridge, and an export whose proof script does not close (reported as an uncredited bridge rather than a silent one). A reimplementation MUST NOT present an UNCREDITED or undeclared bridge as establishing the identity, and MUST NOT present a law-claim with an empty `bridges` list as a kernel-checked statement about the bytes alone. - **Two wasm GC facts behind the exact `ref.test` (S-3).** The audited interpreter's `ref.test` and `ref.cast` compare type indices exactly, while wasm GC tests subtyping, and a variant `match` lowers to a `ref.test` cascade over the constructor structs. The wall pins every constructor struct of every declared sum as `sub final` under the sum's root, inside the rec group that opens the type section (`TypeTable.sumConfirmed`, over the raw entries `GrammarLower.S3Pin` reads), and proves that under this pin the exact test IS the subtype test on those structs (`GrammarSound.ctor_refTest_exact`; for an accepted artifact, `AcceptanceSoundness.refTest_exact_of_accepted`). That proof rests on two facts of the wasm GC specification, carried as the explicit hypothesis `GrammarSound.GcTestSpec` and deliberately not as axioms: (i) subtyping is reflexive; (ii) a type declared final has no subtype in its own rec group other than itself (validation rejects a `sub` that names a final supertype, and distinct positions of one rec group are distinct types under iso-recursive type equivalence). A reimplementation MUST keep the pin, and relies on these two facts exactly as the reference verifier does. diff --git a/src/codegen/cert/plan_from_mir.rs b/src/codegen/cert/plan_from_mir.rs index 8ca0db6c1..9db48d16f 100644 --- a/src/codegen/cert/plan_from_mir.rs +++ b/src/codegen/cert/plan_from_mir.rs @@ -18,11 +18,12 @@ use std::collections::HashMap; use aver_cert::{ FnPlan, ModulePlans, PLAN_NO_SLOT, PlanBinOp, PlanBuiltin, PlanCallee, PlanCtor, PlanExpr, - PlanLazy, PlanLit, PlanPat, PlanRecordDecl, PlanSumDecl, PlanTy, PlanTypeTable, PlannedFn, + PlanIntrinsic, PlanLazy, PlanLit, PlanPat, PlanRecordDecl, PlanSumDecl, PlanTy, PlanTypeTable, + PlannedFn, }; use crate::ast::{BinOp, Literal, Spanned}; -use crate::ir::hir::{BuiltinCtor, ResolvedFnDef}; +use crate::ir::hir::{BuiltinCtor, BuiltinIntrinsic, ResolvedFnDef}; use crate::ir::mir::{MirCallee, MirCtor, MirExpr, MirFn, MirPattern, MirStrPart}; use crate::ir::{BuiltinId, CtorId, FnId}; @@ -582,6 +583,24 @@ impl Printer<'_> { }) } + /// `Int.div(a, b)` / `Int.mod(a, b)` as a builtin call of two arguments. + fn int_div_builtin(&self, e: &Spanned) -> Option { + let MirExpr::Call(c) = &e.node else { + return None; + }; + let MirCallee::Builtin(b) = &c.node.callee else { + return None; + }; + if c.node.args.len() != 2 { + return None; + } + match self.layout.builtin_name(*b)?.as_str() { + "Int.div" => Some(PlanBuiltin::IntDiv), + "Int.mod" => Some(PlanBuiltin::IntMod), + _ => None, + } + } + fn expr(&mut self, expr: &Spanned) -> Result { Ok(match &expr.node { MirExpr::Literal(lit) => PlanExpr::Literal(match &lit.node { @@ -626,12 +645,55 @@ impl Printer<'_> { "List.prepend" => PlanCallee::Builtin(PlanBuiltin::ListPrepend), "Vector.get" => PlanCallee::Builtin(PlanBuiltin::VecGet), "Option.withDefault" => PlanCallee::Lazy(PlanLazy::OptWithDefault), - "Result.withDefault" => PlanCallee::Lazy(PlanLazy::ResWithDefault), + "Result.withDefault" => { + // `Int.div` / `Int.mod` print only fused here. + if let [o, d] = call.args.as_slice() + && let Some(op) = self.int_div_builtin(o) + { + let MirExpr::Call(inner) = &o.node else { + unreachable!("int_div_builtin matched a call") + }; + if !matches!(&d.node, MirExpr::Literal(l) + if matches!(l.node, Literal::Int(_))) + { + return Err(format!( + "Call Builtin(Result.withDefault) over {} \ + with a default that is not an Int literal", + if op == PlanBuiltin::IntDiv { + "Int.div" + } else { + "Int.mod" + } + )); + } + let inner_args = self.exprs(&inner.node.args)?; + return Ok(PlanExpr::Call( + PlanCallee::Lazy(PlanLazy::ResWithDefault), + vec![ + PlanExpr::Call(PlanCallee::Builtin(op), inner_args), + self.expr(d)?, + ], + )); + } + PlanCallee::Lazy(PlanLazy::ResWithDefault) + } + other @ ("Int.div" | "Int.mod") => { + return Err(format!( + "Call Builtin({other}) outside Result.withDefault (a Result)" + )); + } other => return Err(format!("Call Builtin({other})")), }; PlanExpr::Call(callee, self.exprs(&call.args)?) } - MirCallee::Intrinsic(i) => return Err(format!("Call Intrinsic({i:?})")), + MirCallee::Intrinsic(i) => { + let intrinsic = match i { + BuiltinIntrinsic::IntDivEuclid => PlanIntrinsic::IntDivEuclid, + BuiltinIntrinsic::IntModEuclid => PlanIntrinsic::IntModEuclid, + other => return Err(format!("Call Intrinsic({other:?})")), + }; + PlanExpr::Call(PlanCallee::Intrinsic(intrinsic), self.exprs(&call.args)?) + } MirCallee::LocalSlot { .. } => return Err("Call LocalSlot".into()), } } @@ -1104,6 +1166,65 @@ fn lst(xs: List) -> Int assert!(types.str_segs.iter().any(|(b, _)| b == b"Hello, ")); } + const DIV_SRC: &str = r#" +module D + intent = "division printer probes" + exposes [halve, low, guarded, guardedMod, unfused, notLiteral] + +fn halve(p: Int) -> Int + Int.div(p, 2) + +fn low(v: Int) -> Int + Int.mod(v, 256) + +fn guarded(a: Int, d: Int) -> Int + Result.withDefault(Int.div(a, d), 0) + +fn guardedMod(a: Int, d: Int) -> Int + Result.withDefault(Int.mod(a, d), 7) + +fn unfused(a: Int, d: Int) -> Result + Int.div(a, d) + +fn notLiteral(a: Int, d: Int) -> Int + Result.withDefault(Int.div(a, d), a) +"#; + + /// `Int.div` / `Int.mod` print as the resolver left them: the literal + /// divisor as the Euclidean intrinsic, a variable divisor only fused + /// under `Result.withDefault` with an Int literal default. + #[test] + fn division_prints_as_intrinsic_or_fused_default() { + let (map, _) = plans(DIV_SRC); + use PlanExpr as E; + let l = E::Local; + let int = |k: i64| E::Literal(PlanLit::Int(k)); + assert_eq!( + plan(&map, "halve").body, + E::Call( + PlanCallee::Intrinsic(PlanIntrinsic::IntDivEuclid), + vec![l(0), int(2)] + ) + ); + assert_eq!( + plan(&map, "low").body, + E::Call( + PlanCallee::Intrinsic(PlanIntrinsic::IntModEuclid), + vec![l(0), int(256)] + ) + ); + let fused = |op, d| { + E::Call( + PlanCallee::Lazy(PlanLazy::ResWithDefault), + vec![E::Call(PlanCallee::Builtin(op), vec![l(0), l(1)]), int(d)], + ) + }; + assert_eq!(plan(&map, "guarded").body, fused(PlanBuiltin::IntDiv, 0)); + assert_eq!(plan(&map, "guardedMod").body, fused(PlanBuiltin::IntMod, 7)); + assert!(reason(&map, "unfused").contains("outside Result.withDefault")); + assert!(reason(&map, "notLiteral").contains("not an Int literal")); + } + #[test] fn unadmitted_nodes_decline_by_name() { let (map, _) = plans(SRC); From 1899f8d156ae09e5bf41b27fd00ab62b1435f695 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 13:07:54 +0200 Subject: [PATCH 33/89] cert: give String, Float, List and Vector their default fillers The emitter fills the unused payload field of an Option / Result with `emit_default_value`: `ref.null` of the field's heap type for a String, List or Vector, and `f64.const 0` for a Float. The grammar's typing refused those constructions (`Ty.hasDefault`), so every `Result<_, String>` constructor and every `Option` / `Option` literal declined. The wall now lowers the same fillers (`dfltB`) and the producer twin follows. The wall id rotates. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/assets/wall/current/Grammar.lean | 5 ++++- aver-cert/assets/wall/current/GrammarLower.lean | 4 ++++ aver-cert/src/engine/plan_check.rs | 8 ++++++++ aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- 5 files changed, 18 insertions(+), 3 deletions(-) diff --git a/aver-cert/assets/wall/current/Grammar.lean b/aver-cert/assets/wall/current/Grammar.lean index 921cb0b39..c9d52eee0 100644 --- a/aver-cert/assets/wall/current/Grammar.lean +++ b/aver-cert/assets/wall/current/Grammar.lean @@ -317,9 +317,12 @@ def MCtx.newtype (M : MCtx) (tid : Nat) : Bool := | some [_] => true | _ => false -/-- A type with a default filler value (the emitter's `emit_default_value`). -/ +/-- 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 diff --git a/aver-cert/assets/wall/current/GrammarLower.lean b/aver-cert/assets/wall/current/GrammarLower.lean index a6eee8eec..53d404538 100644 --- a/aver-cert/assets/wall/current/GrammarLower.lean +++ b/aver-cert/assets/wall/current/GrammarLower.lean @@ -269,6 +269,10 @@ def dfltB (M : MCtx) : Ty → List BI | .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 diff --git a/aver-cert/src/engine/plan_check.rs b/aver-cert/src/engine/plan_check.rs index 576bd5f6f..33efa29b6 100644 --- a/aver-cert/src/engine/plan_check.rs +++ b/aver-cert/src/engine/plan_check.rs @@ -175,6 +175,10 @@ fn has_default(t: &PlanTy) -> bool { | PlanTy::Sum(_) | PlanTy::Option(_) | PlanTy::Result(_, _) + | PlanTy::Str + | PlanTy::Float + | PlanTy::List(_) + | PlanTy::Vec(_) ) } @@ -934,6 +938,10 @@ impl MCtx<'_> { 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![], } } diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index d95c3624d..a495b18f3 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:792ac24d6852d944f2dd960a5857b8c9534a0e005c014d86f62604b9cabc1be1"; + "sha256:9191d6f4b78af4c91eddc90cf240999a8569ff90f36532c519349402157d5b0b"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index e4edb2c85..491caccc3 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 21 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:792ac24d6852d944f2dd960a5857b8c9534a0e005c014d86f62604b9cabc1be1` (`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. +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 21 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:9191d6f4b78af4c91eddc90cf240999a8569ff90f36532c519349402157d5b0b` (`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 = 9` 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. From 8bbdd770a06adaa523a8bf54a26a1f131f6226af Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 13:07:54 +0200 Subject: [PATCH 34/89] cert: give a record or sum one type id under every spelling of its name The printer keyed its type table by the name as written, so a record seen bare in a signature (`Fraction`) and module-qualified in a construction (`Domain.Rational.Fraction`) got two type ids, and every plan that built one and returned the other did not type. The layout now reports the name the emitter's registry keys the type by, and the printer keys type ids by it. Co-Authored-By: Claude Opus 5.5 (1M context) --- src/codegen/cert/plan_from_mir.rs | 11 +++++++++-- src/codegen/wasm_gc/cert_layout.rs | 20 ++++++++++++++------ 2 files changed, 23 insertions(+), 8 deletions(-) diff --git a/src/codegen/cert/plan_from_mir.rs b/src/codegen/cert/plan_from_mir.rs index 9db48d16f..a53995de2 100644 --- a/src/codegen/cert/plan_from_mir.rs +++ b/src/codegen/cert/plan_from_mir.rs @@ -31,6 +31,9 @@ use crate::ir::{BuiltinId, CtorId, FnId}; /// constructor in declaration order, the constructor's struct and field /// types. pub struct SumLayout { + /// The name the emitter's registry keys the sum by: every spelling of + /// the type (bare, module-qualified) resolves to this one. + pub key: String, pub root: u32, pub ctors: Vec<(u32, Vec)>, } @@ -39,6 +42,10 @@ pub struct SumLayout { /// one-field newtype, which the emitter erases to its field) and its declared /// fields in order. pub struct RecordLayout { + /// The name the emitter's registry keys the record by: every spelling of + /// the type (bare, module-qualified) resolves to this one, so both get + /// one type id. + pub key: String, pub struct_idx: Option, pub fields: Vec<(String, String)>, } @@ -350,7 +357,7 @@ impl TypeTableBuilder { return Err(format!("type `{name}` has a special representation")); } if let Some(rec) = layout.record(name) { - let key = format!("rec:{name}"); + let key = format!("rec:{}", rec.key); if let Some(reason) = self.failed.get(&key) { return Err(reason.clone()); } @@ -390,7 +397,7 @@ impl TypeTableBuilder { return Ok(PlanTy::Record(tid)); } if let Some(sum) = layout.sum(name) { - let key = format!("sum:{name}"); + let key = format!("sum:{}", sum.key); if let Some(reason) = self.failed.get(&key) { return Err(reason.clone()); } diff --git a/src/codegen/wasm_gc/cert_layout.rs b/src/codegen/wasm_gc/cert_layout.rs index 4b168fbad..e384c8f2b 100644 --- a/src/codegen/wasm_gc/cert_layout.rs +++ b/src/codegen/wasm_gc/cert_layout.rs @@ -90,11 +90,14 @@ impl PlanLayout for CertLayout<'_> { fn record(&self, name: &str) -> Option { let registry = self.registry; let canonical = registry.canonical_type_name(name); - let fields = registry.record_fields.get(canonical).or_else(|| { - canonical - .rsplit_once('.') - .and_then(|(_, bare)| registry.record_fields.get(bare)) - })?; + let (key, fields) = registry + .record_fields + .get_key_value(canonical) + .or_else(|| { + canonical + .rsplit_once('.') + .and_then(|(_, bare)| registry.record_fields.get_key_value(bare)) + })?; if fields .iter() .any(|(field, _)| registry.is_eligible_carrier_field(canonical, field)) @@ -107,6 +110,7 @@ impl PlanLayout for CertLayout<'_> { Some(registry.record_type_idx(canonical)?) }; Some(RecordLayout { + key: key.clone(), struct_idx, fields: fields.clone(), }) @@ -124,7 +128,11 @@ impl PlanLayout for CertLayout<'_> { let info = registry.variant_in(parent, ctor_name)?; ctors.push((info.type_idx, info.fields.clone())); } - Some(SumLayout { root, ctors }) + Some(SumLayout { + key: parent.to_string(), + root, + ctors, + }) } fn user_ctor(&self, ctor: CtorId) -> Option<(String, u32)> { From 0d030e7ef3adbc082d18bc14ce5308ce0467fae3 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 13:07:54 +0200 Subject: [PATCH 35/89] cert: find the sub and mul helpers past a raw-i64 user function The producer located the Int sub and mul helpers as the unique function of the carrier-binop signature whose body opens with that i64 operator. A range-refined user function with a raw i64 body can share both, and then no role was declared and every plan subtracting declined. When the first scan is ambiguous, the helper is the candidate that calls the bignum sub-routines; the wall's template pin still decides. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/module_facts.rs | 30 ++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/aver-cert/src/engine/module_facts.rs b/aver-cert/src/engine/module_facts.rs index b11a5a95a..30da5f7d6 100644 --- a/aver-cert/src/engine/module_facts.rs +++ b/aver-cert/src/engine/module_facts.rs @@ -876,6 +876,36 @@ impl ModuleFacts { } } } + // 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) { From 82efc03b26c7496b9777c49f47b8f6a999d7748a Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 13:07:54 +0200 Subject: [PATCH 36/89] Lean certificate model: hand law statements over with constructor applications The certificate's law gate refuses `:=` in a statement, so a law whose statement builds a record (`{ top := 2, bottom := 1 : Fraction }`) was never claimed. The law-claim now carries the constructor application the structure instance elaborates to, `(Fraction.mk (2) (1))`, with the arguments in declared field order; the model theorem is unchanged and proves the same proposition. A statement whose record literals cannot be rewritten exactly keeps its text, and is refused as before. Co-Authored-By: Claude Opus 5.5 (1M context) --- src/codegen/common.rs | 9 ++ src/codegen/lean/toplevel/verify.rs | 165 ++++++++++++++++++++++++++++ 2 files changed, 174 insertions(+) diff --git a/src/codegen/common.rs b/src/codegen/common.rs index 140bc8ec4..ce35469b3 100644 --- a/src/codegen/common.rs +++ b/src/codegen/common.rs @@ -2997,6 +2997,15 @@ fn type_def_by_name<'a>( .find(|(_, td)| type_def_name(td) == bare) } +/// The declared field names of the record `name` (qualified, or bare as read +/// from the active module), in declaration order; `None` for anything else. +pub(crate) fn record_field_order(ctx: &CodegenContext, name: &str) -> Option> { + match type_def_by_name(ctx, name, ctx.active_module_scope().as_deref())?.1 { + TypeDef::Product { fields, .. } => Some(fields.iter().map(|f| f.0.clone()).collect()), + _ => None, + } +} + /// Append the key type of every `Map` written anywhere inside a type /// annotation — including nested ones, so `List>` yields /// `Int` and `Map>` yields both `String` and `Bool`. diff --git a/src/codegen/lean/toplevel/verify.rs b/src/codegen/lean/toplevel/verify.rs index 08003d3ef..df93d0d2b 100644 --- a/src/codegen/lean/toplevel/verify.rs +++ b/src/codegen/lean/toplevel/verify.rs @@ -1550,6 +1550,10 @@ fn emit_verify_law_block( // the law-class marker is written here — so the claim and the theorem // it cites are assembled from one set of pieces and cannot drift. if let Some(statement) = claim_statement { + // The certificate's law gate refuses `:=` in a statement, so a + // record literal `{ f := v : T }` is handed over as the + // constructor application it elaborates to, `(T.mk v …)`. + let statement = record_literals_as_constructors(&statement, ctx).unwrap_or(statement); ctx.universal_law_claims .borrow_mut() .push(crate::codegen::UniversalLawClaim { @@ -2376,3 +2380,164 @@ pub fn emit_decision(db: &DecisionBlock) -> String { lines.push("-/".to_string()); lines.join("\n") } + +/// Rewrite every structure instance `{ f1 := e1, …, fn := en : T }` of a law +/// statement into `(T.mk (e1') … (en'))`, the arguments in `T`'s declared +/// field order: the term the structure instance elaborates to, spelled +/// without `:=`. `None` when some instance does not have exactly that shape +/// or `T` is not a record whose fields are exactly the ones written (the +/// statement is then left as it is). +fn record_literals_as_constructors(statement: &str, ctx: &CodegenContext) -> Option { + if !statement.contains(":=") { + return Some(statement.to_string()); + } + let chars: Vec = statement.chars().collect(); + rewrite_record_literals(&chars, ctx) +} + +/// The index just past the bracket group opening at `start`, skipping string +/// literals. +fn group_end(chars: &[char], start: usize) -> Option { + let mut depth: Vec = Vec::new(); + let mut i = start; + while i < chars.len() { + let c = chars[i]; + match c { + '"' => { + i += 1; + while i < chars.len() && chars[i] != '"' { + if chars[i] == '\\' { + i += 1; + } + i += 1; + } + } + '(' | '[' | '{' | '⟨' => depth.push(c), + ')' | ']' | '}' | '⟩' => { + let open = depth.pop()?; + let want = match c { + ')' => '(', + ']' => '[', + '}' => '{', + _ => '⟨', + }; + if open != want { + return None; + } + if depth.is_empty() { + return Some(i + 1); + } + } + _ => {} + } + i += 1; + } + None +} + +/// Split `chars` at top-level occurrences of `sep`. +fn split_top(chars: &[char], sep: &[char]) -> Option>> { + let mut parts = Vec::new(); + let mut cur = Vec::new(); + let mut i = 0; + while i < chars.len() { + if matches!(chars[i], '(' | '[' | '{' | '⟨' | '"') { + let end = if chars[i] == '"' { + let mut j = i + 1; + while j < chars.len() && chars[j] != '"' { + if chars[j] == '\\' { + j += 1; + } + j += 1; + } + j + 1 + } else { + group_end(chars, i)? + }; + cur.extend_from_slice(chars.get(i..end)?); + i = end; + continue; + } + if chars[i..].starts_with(sep) { + parts.push(std::mem::take(&mut cur)); + i += sep.len(); + continue; + } + cur.push(chars[i]); + i += 1; + } + parts.push(cur); + Some(parts) +} + +fn rewrite_record_literals(chars: &[char], ctx: &CodegenContext) -> Option { + let mut out = String::new(); + let mut i = 0; + while i < chars.len() { + if chars[i] == '"' { + let mut j = i + 1; + while j < chars.len() && chars[j] != '"' { + if chars[j] == '\\' { + j += 1; + } + j += 1; + } + out.extend(chars.get(i..=j)?); + i = j + 1; + continue; + } + if chars[i] != '{' { + out.push(chars[i]); + i += 1; + continue; + } + let end = group_end(chars, i)?; + let inner: String = chars[i + 1..end - 1].iter().collect(); + let inner = inner.trim(); + if !inner.contains(":=") { + // Not a structure instance: rewrite inside it and keep the braces. + out.push('{'); + out.push_str(&rewrite_record_literals(&chars[i + 1..end - 1], ctx)?); + out.push('}'); + i = end; + continue; + } + let inner_chars: Vec = inner.chars().collect(); + let fields_and_ty = split_top(&inner_chars, &[' ', ':', ' '])?; + let [fields, ty] = fields_and_ty.as_slice() else { + return None; + }; + let ty: String = ty.iter().collect(); + let ty = ty.trim(); + if ty.is_empty() + || !ty + .chars() + .all(|c| c.is_alphanumeric() || c == '.' || c == '_') + { + return None; + } + let mut written: Vec<(String, String)> = Vec::new(); + for part in split_top(fields, &[','])? { + let field = split_top(&part, &[':', '='])?; + let [name, value] = field.as_slice() else { + return None; + }; + let name: String = name.iter().collect(); + let value = rewrite_record_literals(value, ctx)?; + written.push((name.trim().to_string(), value.trim().to_string())); + } + let declared = crate::codegen::common::record_field_order(ctx, ty)?; + if declared.len() != written.len() { + return None; + } + let mut args = Vec::with_capacity(declared.len()); + for field in &declared { + let lean_name = aver_name_to_lean(field); + let (_, value) = written.iter().find(|(n, _)| *n == lean_name)?; + args.push(format!("({value})")); + } + out.push_str(&format!("({ty}.mk {})", args.join(" "))); + i = end; + } + Some(out) +} From fc53078fe26eaee8e9bf3546dfdc9fce7d5c7f04 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 16:05:11 +0200 Subject: [PATCH 37/89] cert: check the plans of a package in chunks `plans_ok` checked every plan of a module in one `decide +kernel`. With the division and default-filler admissions btc-listener offers 173 plans over a 117 KB module, and that one check exhausted the kernel's memory, failing every later declaration of `Artifact.lean` with it. The wall splits `plansAccepted` into the per-entry checks and the rest (`plansAcceptedRest`, `plansAccepted_of_parts`). A package proves the per-entry checks eight plans per declaration in `ArtifactPlans.lean`, chained from the last chunk back to the whole list, and the rest in one check. The acceptance predicate is unchanged. The wall id rotates. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../wall/current/AcceptedArtifactCore.lean | 23 +++++++ aver-cert/src/engine/render_package.rs | 61 ++++++++++++++++++- aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- 4 files changed, 85 insertions(+), 3 deletions(-) diff --git a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean index 0594288fd..5c38476ac 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean @@ -498,6 +498,29 @@ def plansAccepted (artifact : ArtifactData) : Bool := 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 := diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 9aadfb216..2e536660b 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -312,6 +312,58 @@ fn render_artifact_host_roles(analysis: &Analysis, params: &str) -> String { ) } +/// Plans checked per kernel declaration in `ArtifactPlans.lean`. +const PLAN_CHUNK: usize = 8; + +/// The per-entry plan checks (`entryAccepted`), `PLAN_CHUNK` entries per +/// `decide +kernel` declaration, in their own compilation unit: one check +/// over every plan of a large module exhausts the kernel's memory. The +/// chunks are chained from the last one back to the whole list. +fn render_artifact_plans(analysis: &Analysis) -> String { + let n = analysis.entries.len(); + let mut s = String::from( + "-- The per-plan acceptance checks, a few plans per `decide +kernel`\n\ + -- declaration, chained into the check over every plan.\n\ + import AcceptedArtifact\n\ + import ArtifactBytes\n\ + import Manifest\n\n\ + 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\ + /-- One plan's acceptance check against the staged artifact bytes. -/\n\ + 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", + ); + let starts: Vec = (0..n.max(1)).step_by(PLAN_CHUNK).collect(); + for (i, k) in starts.iter().enumerate().rev() { + if i + 1 == starts.len() { + s.push_str(&format!( + "theorem plans_from_{k} : (AverCert.manifest.fnPlans.drop {k}).all planOk = true := by\n \ + decide +kernel\n\n" + )); + } else { + let next = starts[i + 1]; + s.push_str(&format!( + "theorem plans_chunk_{k} :\n \ + ((AverCert.manifest.fnPlans.drop {k}).take {PLAN_CHUNK}).all planOk = true := by\n \ + decide +kernel\n\n\ + 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" + )); + } + } + s.push_str( + "theorem plans_all : AverCert.manifest.fnPlans.all planOk = true := plans_from_0\n\n\ + end AverCert.Artifact\n", + ); + s +} + fn render_artifact( analysis: &Analysis, envelope: Option, @@ -364,6 +416,7 @@ fn render_artifact( import AcceptedArtifact\n\ import ArtifactBytes\n\ import Manifest\n\ + import ArtifactPlans\n\ {roles_import}\n\ set_option maxRecDepth 200000\n\ -- Elaboration cost grows with the artifact; this moves a resource\n\ @@ -376,7 +429,8 @@ fn render_artifact( manifest := AverCert.manifest, wasip2ComponentEnvelope := {envelope},\n \ closureFuel := {fuel},\n \ closureClaim := ⟨{roots}, {helpers}, {admitted}⟩ }}\n\n\ - theorem plans_ok : plansAccepted data = true := by decide +kernel\n\n\ + theorem plans_ok : plansAccepted data = true :=\n \ + plansAccepted_of_parts data plans_all (by decide +kernel)\n\n\ {roles_proof}\n\n\ theorem strings_ok : decodedStringHostRoles data := by\n \ unfold decodedStringHostRoles; decide +kernel\n\n\ @@ -670,6 +724,11 @@ pub fn write_project( &render_artifact_host_roles(analysis, ¶ms), )?; } + write( + &cert_dir, + "ArtifactPlans.lean", + &render_artifact_plans(analysis), + )?; write( &cert_dir, "Artifact.lean", diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index a495b18f3..32c1f9dcf 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:9191d6f4b78af4c91eddc90cf240999a8569ff90f36532c519349402157d5b0b"; + "sha256:ff020cec5b7238dee206bf08b1d90699a5a1fdb26da32daea34a96c35b575853"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 491caccc3..1dbc91190 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 21 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:9191d6f4b78af4c91eddc90cf240999a8569ff90f36532c519349402157d5b0b` (`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. +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 21 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:ff020cec5b7238dee206bf08b1d90699a5a1fdb26da32daea34a96c35b575853` (`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 = 9` 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. From 354d126a9e2633bac532748c97e22ca7617f8e19 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 16:05:11 +0200 Subject: [PATCH 38/89] cert: attempt no source bridge for a plan of more than 100 nodes A bridge step proof unfolds the whole plan body and its callees' images at once, and its heartbeat cap does not bound every tactic it runs. With k5's `divideBang` family newly certified, one step ran for minutes and the bridge build of the package went past any phase limit. Such a plan now declines its bridge with a reason, and so do its callers, as for any callee without a bridge. The export itself stays certified. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/source_bridges.rs | 30 ++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index 65bba9b37..50b49601e 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -865,6 +865,30 @@ struct BridgePlan { with_default: bool, } +/// 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>) { @@ -975,6 +999,12 @@ fn plan_bridges(analysis: &Analysis, model: &SourceModel) -> BridgePlan { .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!( From 1b2fe2629e59e595a0191737ae090441604a0258 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 17:24:40 +0200 Subject: [PATCH 39/89] cert: build the bridge step lemmas in parallel slices `BridgeProof.lean` held every step lemma of a package in one module, so Lake built them one after another; with k5's 260 bridges that module ran past an hour. The decoders, images and rewrite lemmas now live in `BridgeDefs.lean`, the step lemmas in slices of 24 (`BridgeSteps.lean`) that Lake builds in parallel, and `BridgeProof.lean` keeps the export theorems over them. The statements and names are unchanged. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/render_package.rs | 5 +- aver-cert/src/engine/source_bridges.rs | 70 ++++++++++++++++++++++---- 2 files changed, 63 insertions(+), 12 deletions(-) diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 2e536660b..c125c85b5 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -755,7 +755,10 @@ pub fn write_project( } else { &[] }; - if let Some((proofs, corollaries)) = &surfaces.bridge_lean { + 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)?; } diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index 50b49601e..b7b4d2afe 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -1421,10 +1421,17 @@ fn render_export( /// The package module that carries the bridge proofs themselves. pub const BRIDGE_PROOF_MODULE: &str = "BridgeProof"; - -/// Render the package's bridge surface as two files: `BridgeProof.lean` -/// (decoders, images, step lemmas and one bridge theorem per export) and -/// `Bridge.lean` (the `_certified` corollaries the manifest names). +/// 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). /// /// Only the corollaries cite `AverCert.Final.cert`, and `Final` sits behind /// `Artifact.lean`, the byte-level proof whose build time grows with the @@ -1434,7 +1441,10 @@ pub const BRIDGE_PROOF_MODULE: &str = "BridgeProof"; /// 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) { +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\ @@ -1494,9 +1504,43 @@ fn render_bridge_lean(plan: &BridgePlan, model_roots: &[String]) -> (String, Str ); literal_names.push_str(", withDefault_ite"); } - for b in plan.fns.values() { - render_step(b, &plan.fns, &literal_names, &mut s); + 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, &literal_names, &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" + )); let mut corollaries = String::new(); for (bridge, func_idx) in &plan.bridges { render_export(bridge, *func_idx, plan, &mut s, &mut corollaries); @@ -1513,7 +1557,7 @@ fn render_bridge_lean(plan: &BridgePlan, model_roots: &[String]) -> (String, Str } bridge.push_str("\nset_option autoImplicit false\n\n"); bridge.push_str(&corollaries); - (s, bridge) + (s, bridge, parts) } // ---- law coverage ------------------------------------------------------------- @@ -1790,7 +1834,7 @@ fn command_preamble_start(lines: &[&str], keyword_line: usize) -> usize { /// What `write_project` needs to render the bridge and law surfaces. struct Surfaces { model: PackagedModel, - bridge_lean: Option<(String, String)>, + bridge_lean: Option<(String, String, Vec<(String, String)>)>, laws_lean: Option, bridges: Vec, law_claims: Vec, @@ -1830,8 +1874,12 @@ fn plan_surfaces(analysis: &Analysis, model: &SourceModel) -> Surfaces { 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) = render_bridge_lean(&plan, &roots); - (isolate_theorems(&proofs), isolate_theorems(&corollaries)) + 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); let (law_claims, declined_laws) = admit_law_claims(model.law_claims.clone()); From 93ab5a2a7b640f31b98feb150e2a9b43a4e73383 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 18:56:01 +0200 Subject: [PATCH 40/89] cert: rewrite bridge step proofs with one image lemma per function The step proofs unfolded the whole image table `I` with `simp`. Across a module boundary (the step slices import it) that rebuilt the table's equations and ran out of recursion depth on k5's 260 entries, so every k5 step fell to `sorry`; inside one module it cost about 20 seconds per step. `BridgeDefs` now states `I_ : I a = (dec_ a).map img_` by `rfl` for each entry, and a step rewrites with its own and its callees' lemmas only. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/source_bridges.rs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index b7b4d2afe..b8d7ce870 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -1241,6 +1241,16 @@ fn render_image_table(fns: &BTreeMap, s: &mut String) { )); } 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" + )); + } + s.push('\n'); } fn render_step(b: &BridgedFn, fns: &BTreeMap, literals: &str, s: &mut String) { @@ -1254,7 +1264,7 @@ fn render_step(b: &BridgedFn, fns: &BTreeMap, literals: &str, s: let mut callee_simps = String::new(); for c in &b.callees { if let Some(callee) = fns.get(c) { - callee_simps.push_str(&format!(", dec_{c}, img_{c}")); + callee_simps.push_str(&format!(", I_{c}, dec_{c}, img_{c}")); if callee.fuel { callee_simps.push_str(&format!(", _root_.{}", callee.model)); } @@ -1273,7 +1283,7 @@ fn render_step(b: &BridgedFn, fns: &BTreeMap, literals: &str, s: | (set_option maxHeartbeats {cap} in\n \ (refine ⟨AverCert.Plans.fn{f}, rfl, ?_⟩\n \ intro F a w h\n \ - simp only [I, _root_.Option.map_eq_some_iff] at 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, \ @@ -1283,7 +1293,7 @@ fn render_step(b: &BridgedFn, fns: &BTreeMap, literals: &str, s: all_goals\n \ simp only [img_{f}]\n \ {unfold}\n \ - simp [AverCert.Plans.fn{f}, {EVAL_SIMPS}{literals}, I{callee_simps}]\n \ + simp [AverCert.Plans.fn{f}, {EVAL_SIMPS}{literals}, I_{f}{callee_simps}]\n \ all_goals (try (repeat' split))\n \ all_goals (try simp_all [{EVAL_SIMPS}{literals}, {BOOL_SIMPS}])\n \ all_goals (try omega)\n \ @@ -1349,7 +1359,7 @@ fn render_export( .filter_map(|(i, p)| rcases_pattern(p).map(|pat| format!("rcases x{i} with {pat}; "))) .collect(); let image = format!( - "(by {split_cases}all_goals first | rfl | simp [I, dec_{func_idx}, img_{func_idx}, \ + "(by {split_cases}all_goals first | rfl | simp [I_{func_idx}, dec_{func_idx}, img_{func_idx}, \ AverCert.GrammarBridge.decodeStr_strBytes])" ); let steps = render_steps_proof(&closure); From b2f97162793f8cb25195e35bb79e126b4f32f693 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 18:56:01 +0200 Subject: [PATCH 41/89] Revert "cert: attempt no source bridge for a plan of more than 100 nodes" The cap was a stopgap for slow bridge builds. The cost was the step proofs unfolding the whole image table, fixed by the per-function image lemmas, so the cap no longer earns the bridges it drops. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/source_bridges.rs | 30 -------------------------- 1 file changed, 30 deletions(-) diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index b8d7ce870..8718336a7 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -865,30 +865,6 @@ struct BridgePlan { with_default: bool, } -/// 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>) { @@ -999,12 +975,6 @@ fn plan_bridges(analysis: &Analysis, model: &SourceModel) -> BridgePlan { .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!( From 9275b7eccf7960b621bbb62c32b44cb4bca75d5c Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 19:37:52 +0200 Subject: [PATCH 42/89] cert: attempt no source bridge for a plan of more than 100 nodes Re-applied. Even with the per-function image lemmas, the step slice holding k5's largest plans (the 247-node `divideBang` family) ran past ten minutes on its own. A plan of more than 100 nodes declines its bridge with a reason, and so do its callers; the export stays certified. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/source_bridges.rs | 30 ++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index 8718336a7..b8d7ce870 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -865,6 +865,30 @@ struct BridgePlan { with_default: bool, } +/// 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>) { @@ -975,6 +999,12 @@ fn plan_bridges(analysis: &Analysis, model: &SourceModel) -> BridgePlan { .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!( From fdffcfc1bfa7230a7447b481575a94b1ad8e88e2 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 21:35:03 +0200 Subject: [PATCH 43/89] build: optimise sha2 in debug builds The certificate checker hashes its build caches, hundreds of MiB of .olean files, with SHA-256. Unoptimised, restoring the wall cache took 12 seconds per check in the debug builds the developer loop and the test suites use; optimised, under one second. Co-Authored-By: Claude Opus 5.5 (1M context) --- Cargo.toml | 6 ++++++ 1 file changed, 6 insertions(+) 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 From 475bdc2aae5a85fd772c7bb4d7836fe34a04f474 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 21:35:15 +0200 Subject: [PATCH 44/89] cert: report Lean step times on request AVER_CERT_TIMINGS=1 prints how long staging, the wall cache restore and each Lean step took, with Lake's per-module build times, to standard error. It is diagnostic output only and reads nothing the verdict depends on. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/verifier.rs | 21 +++++++++++++++++++++ docs/certification.md | 2 ++ 2 files changed, 23 insertions(+) diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index e4aec8778..e1613d95f 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -555,6 +555,7 @@ 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, core_module_bytes, @@ -572,11 +573,14 @@ fn trusted_check( }, ); let data_cache_hit = cache.was_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 { PristineWallCache::disabled() } else { PristineWallCache::prepare(&build.path, selected_wall, &lean) }; + report_step_timing("wall cache restore", wall_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()) { @@ -2558,9 +2562,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!( @@ -2571,6 +2577,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") diff --git a/docs/certification.md b/docs/certification.md index 5256e49fa..db82e73ae 100644 --- a/docs/certification.md +++ b/docs/certification.md @@ -109,6 +109,8 @@ output. Those directories become trusted local state and must not be writable by an attacker. Strict `verify` still authors a fresh checker witness and runs the final whole-closure replay. +`AVER_CERT_TIMINGS=1` prints how long each Lean step took, with Lake's per-module build times, to standard error. It is a diagnostic only and does not change the verdict. + Every Lean toolchain step (the certificate proof build, the artifact witness check, and the final kernel replay) runs under a wall-clock limit of 15 minutes, so a degenerate or hostile certificate cannot hang `verify` or From 56e7e690e199c99f4acb302b753ccff84177edcc Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 21:35:19 +0200 Subject: [PATCH 45/89] cert: render artifact bytes as chunked numerals Lean reads a numeral in time quadratic in its length: the single hex numeral of btc-listener's 116 KiB module took 20 seconds to elaborate, and ArtifactBytes and ArtifactComponentBytes each paid it (36 and 35 seconds in the package build). The checker now writes 1 KiB hex chunks, each shifted to its byte offset and joined by |||. The chunks cover disjoint bit ranges, so the definition denotes the same number; the kernel evaluates the join with its built-in Nat shift and or. Both modules now build in about a second. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/verifier.rs | 8 ++++++++ aver-cert/src/wall.rs | 31 +++++++++++++++++++++++++------ 2 files changed, 33 insertions(+), 6 deletions(-) diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index e1613d95f..235777747 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -3799,6 +3799,14 @@ mod tests { let rendered = wall::render_artifact_bytes(&[0x00, 0x61, 0x73, 0x6d]); assert!(rendered.contains("def modBytes : Nat := 0x6d736100")); 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("def modBytes : Nat := 0x")); + assert!(rendered.contains("01 |||\n (0xab <<< 8192)\n")); + assert!(rendered.contains("def modLen : Nat := 1025")); } #[test] diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index 9a59528f7..a654d2957 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -245,6 +245,9 @@ pub fn render_artifact_component_bytes(bytes: &[u8]) -> String { ) } +/// 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, @@ -255,12 +258,28 @@ 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", From da1a1061cb233b976913a04c9006ee1705cba9b0 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 21:35:33 +0200 Subject: [PATCH 46/89] cert: prove agreement by induction on the term size The mutual agreement theorems recursed on sub-terms reached through equations (an argument list rewritten to its elements), so Lean compiled them by well-founded recursion. Processing that recursion over the theorems' large proof terms took 140 of GrammarSound's 154 seconds, and every certificate build without a wall cache paid it. Each theorem's cases now form a non-recursive step over hypotheses that answer every strictly smaller argument, the size side condition being an auto-parameter the enclosing case discharges. One induction on a size bound joins the steps, and the nine theorems keep their statements and their parameter lists. GrammarSound builds in 11 seconds. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/GrammarSound.lean | 538 +++++++++++++++--- aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- 3 files changed, 460 insertions(+), 82 deletions(-) diff --git a/aver-cert/assets/wall/current/GrammarSound.lean b/aver-cert/assets/wall/current/GrammarSound.lean index 0571d4b5f..b59325eeb 100644 --- a/aver-cert/assets/wall/current/GrammarSound.lean +++ b/aver-cert/assets/wall/current/GrammarSound.lean @@ -1,6 +1,6 @@ /- GrammarSound — the simulation theorem for the one-grammar plan. - ONE statement, `agreement`, by structural induction over `Grammar.Expr` + 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 @@ -1773,8 +1773,8 @@ theorem intrinsic_run {C : Nat} {S : CarrierSpec C} {M : MCtx} {host : HostTbl} /-! ## The agreement theorem -ONE statement, by structural induction on the grammar (mutual over the nested -argument lists). The context fixes: the carrier specification and the named +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. -/ @@ -1797,9 +1797,129 @@ variable {C : Nat} (S : CarrierSpec C) (X : LCtx) include Ctr hNegC hCarrier hBox hAdd hSub hMul hNeg hCmp hEq R hCallees -mutual -theorem agreement : +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 Γ → @@ -1807,7 +1927,7 @@ theorem agreement : 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), Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -1819,33 +1939,33 @@ theorem agreement : 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), Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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), Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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), Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -1859,7 +1979,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -1876,7 +1996,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -1886,7 +2006,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -1906,7 +2026,7 @@ theorem agreement : (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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -1923,7 +2043,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -2109,7 +2229,7 @@ theorem agreement : · 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -2126,7 +2246,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -2148,7 +2268,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -2163,7 +2283,7 @@ theorem agreement : · simp only [HasTy, true_and] exact ⟨fts, hR, hTs⟩ · exact (srepr_record hR h2 _ _).mpr ⟨ws, rfl, hrep⟩ - | .project tid i base, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -2181,11 +2301,11 @@ theorem agreement : subst hseq exact ⟨sv, by simp [eval, hev1, hsv], hTsv, res_ok hwr hl1⟩ - | .call (.lazy _) [], _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty - | .call (.lazy _) [_], _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOf] at hty - | .call (.lazy _) (_ :: _ :: _ :: _), _, _, _, _, _, _, _, hty, _, _, _ => by + | .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], Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -2326,7 +2446,7 @@ theorem agreement : · 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 => @@ -2516,7 +2636,7 @@ theorem agreement : simp only [SRepr] exact ⟨dd, w, rfl, hw⟩ · cases hct - | .match_ s arms, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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⟩ @@ -2647,7 +2767,7 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 @@ -2660,14 +2780,14 @@ theorem agreement : 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, Γ, env, tail, T, wl, st, out, hty, henv, hl, hrun => by + | .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 : - ∀ (es : List Expr) (Γ : Nat → Option Ty) (env : Nat → Option SVal) (Ts : List Ty) +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 Γ → @@ -2676,13 +2796,13 @@ theorem agreementArgs : ∃ 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' - | [], Γ, env, Ts, wl, st, out, hty, henv, hl, hrun => by + | [], 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, Γ, env, Ts, wl, st, out, hty, henv, hl, hrun => by + | 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 @@ -2694,10 +2814,8 @@ theorem agreementArgs : exact ⟨sv :: svs, w :: ws, wl2, by simp, by simp [evalArgs, hev, hevs], ⟨hT, hTs⟩, ⟨hw, hrep⟩, hl2⟩ -/-- 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) +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 → @@ -2708,8 +2826,8 @@ theorem agreementIntArms : 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, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyIntArms] at hty - | .cons p b rest, Γ, env, tail, T, wl, st, out, sc, bt, x, hsc, hty, henv, hl, hrun => by + | .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 @@ -2797,9 +2915,8 @@ theorem agreementIntArms : | litStr _ => simp [tyIntArms] at hty | tuple _ => simp [tyIntArms] at hty -/-- 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) +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 → @@ -2807,12 +2924,12 @@ theorem agreementBoolArms : 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, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyBoolArms] at hty - | .cons p _ .nil, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + | .nil, hsz, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyBoolArms] at hty + | .cons p _ .nil, hsz, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by cases p <;> simp [tyBoolArms] at hty - | .cons p _ (.cons _ _ (.cons _ _ _)), _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + | .cons p _ (.cons _ _ (.cons _ _ _)), hsz, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by cases p <;> simp [tyBoolArms] at hty - | .cons p t (.cons p2 e .nil), Γ, env, tail, T, wl, st, out, bt, x, hty, henv, hl, hrun => by + | .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 @@ -2860,9 +2977,8 @@ theorem agreementBoolArms : | litStr _ => simp [tyBoolArms] at hty | tuple _ => simp [tyBoolArms] at hty -/-- 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) +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 → @@ -2870,12 +2986,12 @@ theorem agreementOptArms : 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, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOptArms] at hty - | .cons _ _ .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOptArms] at hty + | .cons _ _ .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOptArms] at hty - | .cons _ _ (.cons _ _ (.cons _ _ _)), _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, + | .cons _ _ (.cons _ _ (.cons _ _ _)), hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyOptArms] at hty - | .cons p1 b1 (.cons p2 b2 .nil), Γ, env, tail, T, wl, st, out, bt, t, sv, w, hss, hsw, hsT, + | .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 @@ -2968,10 +3084,8 @@ theorem agreementOptArms : (fun _ => by simp) (by simp) hrun · simp [hac] at hty -/-- 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) +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 → @@ -2979,13 +3093,13 @@ theorem agreementResArms : 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, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyResArms] at hty - | .cons _ _ .nil, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + | .cons _ _ .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyResArms] at hty - | .cons _ _ (.cons _ _ (.cons _ _ _)), _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, + | .cons _ _ (.cons _ _ (.cons _ _ _)), hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyResArms] at hty - | .cons p1 b1 (.cons p2 b2 .nil), Γ, env, tail, T, wl, st, out, bt, t, e, sv, w, hss, hsw, + | .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 @@ -3088,11 +3202,8 @@ theorem agreementResArms : (fun _ => by simp) (fun _ => by simp) hrun · simp [hac] at hty -/-- 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) +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) → @@ -3105,9 +3216,9 @@ theorem agreementVarArms : 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, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyVarArms] at hty - | .cons p b .nil, Γ, env, tail, T, wl, st, out, bt, tid, cv, fs, ws, fts, hss, hws, hcf, hfs, + | .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 @@ -3157,7 +3268,7 @@ theorem agreementVarArms : | bind _ => simp [varArmΓ] at hva | litStr _ => simp [varArmΓ] at hva | tuple _ => simp [varArmΓ] at hva - | .cons p b (.cons p' b' r), Γ, env, tail, T, wl, st, out, bt, tid, cv, fs, ws, fts, hss, + | .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 @@ -3237,10 +3348,8 @@ theorem agreementVarArms : | litStr _ => simp [varArmΓ] at hty | tuple _ => simp [varArmΓ] at hty -/-- 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) +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 → @@ -3248,8 +3357,8 @@ theorem agreementStrArms : 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, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyStrArms] at hty - | .cons p b rest, Γ, env, tail, T, wl, st, out, bt, x, hss, hty, henv, hl, hrun => by + | .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⟩ @@ -3317,9 +3426,8 @@ theorem agreementStrArms : exact ⟨sv, by simp [evalArms, patMatch, bindVals, hev], hT, hres⟩ all_goals simp [tyStrArms] at hty -/-- 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) +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) → @@ -3329,9 +3437,9 @@ theorem agreementTupArms : 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, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by + | .nil, hsz, _, _, _, _, _, _, _, _, _, _, _, _, _, _, _, hty, _, _, _ => by simp [tyTupArms] at hty - | .cons p b rest, Γ, env, tail, T, wl, st, out, tid, fs, ws, fts, hss, hws, hR, hfs, 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 => @@ -3355,7 +3463,277 @@ theorem agreementTupArms : exact ⟨sv, by simp [evalArms, patMatch, hbv, hev], hT, hres' _ _ _ _ hres⟩ · cases hty all_goals simp [tyTupArms] at hty -end + +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 diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 32c1f9dcf..b6d346d9b 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:ff020cec5b7238dee206bf08b1d90699a5a1fdb26da32daea34a96c35b575853"; + "sha256:67a03523bddb74332cb23baf0391c10527d2602d5808342dac413893256711a7"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 1dbc91190..95047c402 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 21 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:ff020cec5b7238dee206bf08b1d90699a5a1fdb26da32daea34a96c35b575853` (`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. +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 21 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:67a03523bddb74332cb23baf0391c10527d2602d5808342dac413893256711a7` (`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 = 9` 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. From 9ac921ceceeb2bc2c77b0fad3cde5e046bc089c8 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 21:35:41 +0200 Subject: [PATCH 47/89] cert: select a bridge's obligation without deciding String equality Every bridge proved exportObligation manifest name = some o by rfl, so both the elaborator and the kernel compared the name with every earlier export name. The kernel has no fast path for String literals: deciding equality rebuilds both UTF-8 byte arrays, in time quadratic in their length. On k5's law leaf these lookups were about 60 of BridgeProof's 95 seconds, and they grew with the square of the export count. The package now shows once that the obligations' export names are pairwise distinct (a literal is definitionally String.ofList of its characters, which the kernel checks without building bytes; distinctness is decided on one number per name), and each bridge selects its obligation by its plan entry through the new wall lemma exportObligation_of_entry. The bridge statements are unchanged. The closure argument now cites each member's step lemma directly instead of trying every step lemma on every member, and the depth side condition is decided by the kernel instead of unfolding depth with simp. BridgeProof on k5's law leaf builds in 9 seconds instead of 95, with the same credit. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/GrammarBridge.lean | 55 +++++++++ aver-cert/src/engine/source_bridges.rs | 109 +++++++++++++++--- aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- 4 files changed, 152 insertions(+), 16 deletions(-) diff --git a/aver-cert/assets/wall/current/GrammarBridge.lean b/aver-cert/assets/wall/current/GrammarBridge.lean index 62c7f2839..95571940c 100644 --- a/aver-cert/assets/wall/current/GrammarBridge.lean +++ b/aver-cert/assets/wall/current/GrammarBridge.lean @@ -49,6 +49,61 @@ 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 diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index b8d7ce870..96df68d34 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -863,6 +863,11 @@ struct BridgePlan { /// 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 @@ -980,6 +985,28 @@ fn plan_bridges(analysis: &Analysis, model: &SourceModel) -> BridgePlan { 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 let Some(reason) = &model.failure { for c in &analysis.certified { @@ -1317,17 +1344,17 @@ fn render_step(b: &BridgedFn, fns: &BTreeMap, literals: &str, s: const STEP_HEARTBEATS: u32 = 1_000_000; const FILE_HEARTBEATS: u32 = 4_000_000; -/// The `∀ g ∈ D, ∃ Cs, … ∧ Step …` argument both engines take: split the -/// membership into one goal per closure member, in order, and cite that -/// member's step lemma (the callee side condition is decided). +/// 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 { - let pats = closure.iter().map(|_| "rfl").collect::>().join(" | "); - let steps = closure - .iter() - .map(|f| format!("exact ⟨_, by decide, step_{f}⟩")) - .collect::>() - .join(" | "); - format!("(by intro g hg; simp at hg; rcases hg with {pats} <;> first | {steps})") + // 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}⟩)"), + ) } fn render_export( @@ -1371,7 +1398,7 @@ fn render_export( intro fuel hk{bs}; \ exact AverCert.GrammarBridge.exact_of_step AverCert.Plans.fnPlans I [{members}] depth \ {steps} \ - fuel {func_idx} (by decide) (by simp only [depth]; omega) _ _ {image}", + 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() @@ -1408,9 +1435,19 @@ fn render_export( // 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(&STEP_HEARTBEATS.to_string()); - s.push_str(" in\n (refine ⟨_, rfl, ?_, ?_⟩\n next => "); + 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); @@ -1429,6 +1466,44 @@ fn render_export( let _ = param_binders; } +/// `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 = names + .iter() + .map(|name| { + let list = name + .chars() + .map(|c| { + // Printable ASCII other than the quote and escape + // characters stays a plain literal (so the gate's + // lexical scan sees no string opener). + if (' '..='~').contains(&c) && !matches!(c, '\'' | '\\' | '"') { + format!("'{c}'") + } else { + format!("(Char.ofNat {})", c as u32) + } + }) + .collect::>() + .join(", "); + format!("[{list}]") + }) + .collect::>() + .join(",\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. @@ -1551,6 +1626,7 @@ fn render_bridge_lean( 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); @@ -2229,8 +2305,13 @@ mod source_bridge_tests { ); assert_eq!( render_steps_proof(&[3, 9]), - "(by intro g hg; simp at hg; rcases hg with rfl | rfl <;> first | \ - exact ⟨_, by decide, step_3⟩ | exact ⟨_, by decide, step_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}" ); } } diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index b6d346d9b..2716cd2cf 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:67a03523bddb74332cb23baf0391c10527d2602d5808342dac413893256711a7"; + "sha256:d41ba4d54644276834d3ef36af1b63207d15fc3979c5e33befd0487c78e6d3c0"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 95047c402..eac70583c 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 21 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:67a03523bddb74332cb23baf0391c10527d2602d5808342dac413893256711a7` (`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. +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 21 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:d41ba4d54644276834d3ef36af1b63207d15fc3979c5e33befd0487c78e6d3c0` (`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 = 9` 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. From 7d0edcd1b7aa77dd0e4c38c64c16da933ff5bcf3 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 23:35:03 +0200 Subject: [PATCH 48/89] cert: account exports on numeric name keys exports_ok was the slowest declaration of a large package: 499 of btc-listener's 614 Artifact seconds at a 15 GiB peak. Its balanced sets were keyed by byte lists (and one by Strings), which the kernel orders by walking both lists through the generic Ord instances, and every one of 605 names was converted from its String literal, which the kernel does in time quadratic in the name's length. The set-shaped checks (export accounting, byteSeqListNodup, stringListNodup) now key every name by WasmSlice.seqKey, a base-2^21 numeral with digits b + 1. seqKey_inj proves it injective on its domain, which holds every byte and every Unicode scalar value, and a name without a key fails the check, so the checks decide the same set facts as before; only an element of 2^21 - 1 or more, which no byte or code point is, would now decline where it passed. stringListNodup compares the names' code points (stringBytes is injective) instead of ordering Strings. exportsAccounted keeps its meaning; its body moves to exportsAccountedOf, which takes the certified entries and declared names. The package proves it through exportsAccounted_of_chars: the names are stated once as character lists (a String literal is definitionally String.ofList of its characters, which the kernel checks without building bytes), so no name is converted in the kernel. exports_ok on btc-listener takes 21 seconds. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../wall/current/AcceptedArtifactCore.lean | 122 ++++++++++++++---- aver-cert/assets/wall/current/WasmSlice.lean | 49 +++++++ aver-cert/src/engine/render_package.rs | 54 +++++++- aver-cert/src/engine/source_bridges.rs | 24 +--- aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 2 +- 6 files changed, 201 insertions(+), 52 deletions(-) diff --git a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean index 5c38476ac..70266d89e 100644 --- a/aver-cert/assets/wall/current/AcceptedArtifactCore.lean +++ b/aver-cert/assets/wall/current/AcceptedArtifactCore.lean @@ -348,8 +348,17 @@ def decodedStringHostRoles (artifact : ArtifactData) : Prop := /-! ### Whole-module interface accounting and certified-closure isolation -/ +/-- Distinct byte sequences, decided on their numeric keys (`WasmSlice.seqKey`, + injective). -/ +def byteSeqListNodup (xs : List AverCert.WasmSlice.ByteSeq) : Bool := + match AverCert.WasmSlice.seqKeys xs with + | some keys => 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 := - AverCert.WasmSlice.indexedNodup xs + byteSeqListNodup (xs.map stringBytes) def lowerHexByte (byte : Nat) : Bool := (decide (48 ≤ byte) && decide (byte ≤ 57)) || @@ -379,9 +388,6 @@ 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.obligations.map (fun obligation => @@ -391,40 +397,102 @@ def declaredUncertifiedNames (manifest : AverCert.Schema.Manifest) : List 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 : AverCert.WasmSlice.ExportEntry) : Option ExportKey := + (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 AverCert.WasmSlice.ExportEntry) + (declared : List AverCert.WasmSlice.ByteSeq) : Bool := + match 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, + 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 := AverCert.WasmSlice.orderedSet actualNames + let declaredIndex := AverCert.WasmSlice.orderedSet declared + let actualEntryIndex := AverCert.WasmSlice.orderedSet actual + let certifiedEntryIndex := AverCert.WasmSlice.orderedSet certified + AverCert.WasmSlice.natListNodup actualNames && + AverCert.WasmSlice.natListNodup certifiedNames && + 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 : 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 } : 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 : 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 } : 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 := diff --git a/aver-cert/assets/wall/current/WasmSlice.lean b/aver-cert/assets/wall/current/WasmSlice.lean index 5e510e72b..57628aecf 100644 --- a/aver-cert/assets/wall/current/WasmSlice.lean +++ b/aver-cert/assets/wall/current/WasmSlice.lean @@ -474,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/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index c125c85b5..3ac63e551 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -141,6 +141,38 @@ fn write(dir: &Path, name: &str, content: &str) -> Result<(), String> { 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}]") +} + fn plan_def_name(func_idx: u32) -> String { format!("fn{func_idx}") } @@ -437,7 +469,11 @@ fn render_artifact( theorem axes_ok : AverCert.ClaimAxes.checked data = true := by decide +kernel\n\n\ theorem framing_ok : CertDecode.moduleFramingValid data.modBytes data.modLen = true := by\n \ decide +kernel\n\n\ - theorem exports_ok : exportsAccounted data = true := by decide +kernel\n\n\ + theorem exports_ok : exportsAccounted data = true :=\n \ + exportsAccounted_of_chars data\n \ + {obligation_names}\n \ + {declared_names}\n \ + rfl rfl (by decide +kernel)\n\n\ theorem imports_ok : importsWithinCapabilities data = true := by decide +kernel\n\n\ theorem start_ok : startAccounted data = true := by decide +kernel\n\n\ theorem closure_ok : closureIsolation data = true := by decide +kernel\n\n\ @@ -446,6 +482,22 @@ fn render_artifact( theorem envelope_ok : artifactEnvelopeAccepted AverCert.ArtifactComponentBytes.componentBytes\n \ AverCert.ArtifactComponentBytes.componentLen data = true := by decide +kernel\n\n\ end AverCert.Artifact\n", + obligation_names = lean_char_lists( + &analysis + .entries + .iter() + .filter(|e| e.exported) + .map(|e| e.name.clone()) + .collect::>(), + "\n " + ), + declared_names = lean_char_lists( + &declared_uncertified(analysis) + .into_iter() + .map(|(name, _)| name) + .collect::>(), + "\n " + ), fuel = analysis.module_envelope.closure_fuel, roots = nats(&closure.roots), helpers = nats(&closure.helpers), diff --git a/aver-cert/src/engine/source_bridges.rs b/aver-cert/src/engine/source_bridges.rs index 96df68d34..c816819d3 100644 --- a/aver-cert/src/engine/source_bridges.rs +++ b/aver-cert/src/engine/source_bridges.rs @@ -1471,34 +1471,14 @@ fn render_export( /// 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 = names - .iter() - .map(|name| { - let list = name - .chars() - .map(|c| { - // Printable ASCII other than the quote and escape - // characters stays a plain literal (so the gate's - // lexical scan sees no string opener). - if (' '..='~').contains(&c) && !matches!(c, '\'' | '\\' | '"') { - format!("'{c}'") - } else { - format!("(Char.ofNat {})", c as u32) - } - }) - .collect::>() - .join(", "); - format!("[{list}]") - }) - .collect::>() - .join(",\n "); + 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 \ + {chars}\n \ rfl (by decide +kernel)\n \ | sorry\n\n" ) diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 2716cd2cf..346154927 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:d41ba4d54644276834d3ef36af1b63207d15fc3979c5e33befd0487c78e6d3c0"; + "sha256:ec192fcadb526327561c7ee2f0af8aba7599a339e2f6e896f239ea3503301f9c"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index eac70583c..bf8c8f750 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 21 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:d41ba4d54644276834d3ef36af1b63207d15fc3979c5e33befd0487c78e6d3c0` (`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. +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 21 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:ec192fcadb526327561c7ee2f0af8aba7599a339e2f6e896f239ea3503301f9c` (`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 = 9` 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. From 18ff69e15d47137df507fd8f80975ded7385072f Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 23:35:10 +0200 Subject: [PATCH 49/89] cert: keep byte numerals out of the compiler; check 32 plans per declaration The package build also compiles every definition to C, and rendering the artifact byte numeral took 19 of ArtifactBytes' 21 seconds on btc-listener (twice, with ArtifactComponentBytes). The checker now marks both byte definitions noncomputable; nothing evaluates them outside the kernel. The producer marks the definitions that mention them noncomputable as well. ArtifactPlans checked 8 plans per decide declaration, and every declaration decodes the module's sections again. At 32 plans per declaration btc-listener's plan checks take 124 seconds instead of 227, at a 7.4 GiB peak. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/render_package.rs | 13 ++++++++----- aver-cert/src/verifier.rs | 4 ++-- aver-cert/src/wall.rs | 3 ++- docs/certificate-format.md | 2 +- 4 files changed, 13 insertions(+), 9 deletions(-) diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 3ac63e551..67469f2f7 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -345,12 +345,15 @@ fn render_artifact_host_roles(analysis: &Analysis, params: &str) -> String { } /// Plans checked per kernel declaration in `ArtifactPlans.lean`. -const PLAN_CHUNK: usize = 8; +const PLAN_CHUNK: usize = 32; /// The per-entry plan checks (`entryAccepted`), `PLAN_CHUNK` entries per /// `decide +kernel` declaration, in their own compilation unit: one check -/// over every plan of a large module exhausts the kernel's memory. The -/// chunks are chained from the last one back to the whole list. +/// over every plan of a large module exhausts the kernel's memory, and every +/// declaration decodes the module's sections again, so the chunk trades the +/// two (on btc-listener's 173 plans: 8 per chunk took 227 seconds, 32 took +/// 124 seconds at a 7.4 GiB peak). The chunks are chained from the last one +/// back to the whole list. fn render_artifact_plans(analysis: &Analysis) -> String { let n = analysis.entries.len(); let mut s = String::from( @@ -364,7 +367,7 @@ fn render_artifact_plans(analysis: &Analysis) -> String { namespace AverCert.Artifact\n\ open AverCert AverCert.Schema AverCert.AcceptedArtifact AverCert.TypeTable\n\n\ /-- One plan's acceptance check against the staged artifact bytes. -/\n\ - abbrev planOk : FnEntry → Bool :=\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", @@ -456,7 +459,7 @@ fn render_artifact( set_option maxHeartbeats 1600000\n\n\ namespace AverCert.Artifact\n\ open AverCert AverCert.Schema AverCert.AcceptedArtifact\n\n\ - def data : ArtifactData :=\n \ + noncomputable def data : ArtifactData :=\n \ {{ modBytes := AverCert.ArtifactBytes.modBytes, modLen := AverCert.ArtifactBytes.modLen,\n \ manifest := AverCert.manifest, wasip2ComponentEnvelope := {envelope},\n \ closureFuel := {fuel},\n \ diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index 235777747..85c717dc8 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -3797,14 +3797,14 @@ 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("def modBytes : Nat := 0x")); + assert!(rendered.contains("noncomputable def modBytes : Nat :=\n 0x")); assert!(rendered.contains("01 |||\n (0xab <<< 8192)\n")); assert!(rendered.contains("def modLen : Nat := 1025")); } diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index a654d2957..2bfb1f1cf 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -37,6 +37,7 @@ pub const CERT_ACCEPTANCE_SOUNDNESS_CORE: &str = pub const CERT_ACCEPTANCE_SOUNDNESS: &str = include_str!("../assets/wall/current/AcceptanceSoundness.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. @@ -282,7 +283,7 @@ fn render_byte_module( .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() ) } diff --git a/docs/certificate-format.md b/docs/certificate-format.md index bf8c8f750..f825f7ec9 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -302,7 +302,7 @@ Three mechanisms bind the certificate to one exact artifact: **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. -**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. +**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 hex numerals of at most 1024 bytes each, every chunk's byte sequence reversed and shifted left by eight times its byte offset, the chunks joined by `|||`, in a `noncomputable` definition; Lean reads one numeral in time quadratic in its length, and the compiler would render the number into C), 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. **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. From 5354972694c3211c6c6d834298c22854c7f43878 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 23:44:29 +0200 Subject: [PATCH 50/89] cert: prove the witness's report pins by reduction first The checker witness pinned ClaimAxes.reportEntries and reportFacets to the manifest's report lists with decide, which evaluates every String comparison in the elaborator and again in the kernel. Both sides are lists of the same literals, so rfl closes the pins by unfolding and compares the literals directly; decide +kernel remains the fallback. The pinned statements are unchanged. On k5's law leaf the witness takes 4.6 seconds instead of 8.9. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/verifier.rs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/aver-cert/src/verifier.rs b/aver-cert/src/verifier.rs index 85c717dc8..fc456092b 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -950,8 +950,10 @@ fn checker_witness(sha: &str, candidates: &Candidates) -> String { 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.ClaimAxes.reportEntries AverCert.Artifact.data = {report_entries} := by decide\n\ - example : AverCert.ClaimAxes.reportFacets AverCert.Artifact.data = {report_facets} := by decide\n\ + example : AverCert.ClaimAxes.reportEntries AverCert.Artifact.data = {report_entries} :=\n \ + by first | rfl | decide +kernel\n\ + example : AverCert.ClaimAxes.reportFacets AverCert.Artifact.data = {report_facets} :=\n \ + by first | rfl | decide +kernel\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\ From 159ee0f2f2791303cbecd7b6edafdd2fdadbaa54 Mon Sep 17 00:00:00 2001 From: jasisz Date: Wed, 23 Sep 2026 23:59:43 +0200 Subject: [PATCH 51/89] cert: spread a large package's byte facts over modules Lake builds independent modules in parallel when the verifier gives it more than one worker (AVER_CERT_BUILD_JOBS), but a large package kept its plan chunks in one module and its whole-module facts in another, so the two ran one after the other whatever the job count. A package with more plans than one chunk now checks each chunk in its own module (ArtifactPlans, over ArtifactPlanCheck) and proves the String roles, the closure and the interface accounting in ArtifactStrings, ArtifactClosure and ArtifactInterface, over the data in ArtifactData; ArtifactPlans and Artifact join them. The theorems and their statements are unchanged. A smaller package keeps one module per step. With four workers btc-listener's law leaf checks in 183 seconds instead of 219. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/engine/render_package.rs | 269 +++++++++++++++++-------- 1 file changed, 188 insertions(+), 81 deletions(-) diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 67469f2f7..0b6ce718c 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -354,55 +354,111 @@ const PLAN_CHUNK: usize = 32; /// two (on btc-listener's 173 plans: 8 per chunk took 227 seconds, 32 took /// 124 seconds at a 7.4 GiB peak). The chunks are chained from the last one /// back to the whole list. -fn render_artifact_plans(analysis: &Analysis) -> String { +fn render_artifact_plans(analysis: &Analysis) -> Vec<(String, String)> { let n = analysis.entries.len(); - let mut s = String::from( - "-- The per-plan acceptance checks, a few plans per `decide +kernel`\n\ - -- declaration, chained into the check over every plan.\n\ - import AcceptedArtifact\n\ - import ArtifactBytes\n\ - import Manifest\n\n\ - set_option maxRecDepth 200000\n\ + let header = "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\ - /-- One plan's acceptance check against the staged artifact bytes. -/\n\ + open AverCert AverCert.Schema AverCert.AcceptedArtifact AverCert.TypeTable\n\n"; + let 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", - ); + AverCert.manifest.fnPlans\n\n"; let starts: Vec = (0..n.max(1)).step_by(PLAN_CHUNK).collect(); - for (i, k) in starts.iter().enumerate().rev() { - if i + 1 == starts.len() { - s.push_str(&format!( - "theorem plans_from_{k} : (AverCert.manifest.fnPlans.drop {k}).all planOk = true := by\n \ - decide +kernel\n\n" - )); - } else { - let next = starts[i + 1]; - s.push_str(&format!( - "theorem plans_chunk_{k} :\n \ - ((AverCert.manifest.fnPlans.drop {k}).take {PLAN_CHUNK}).all planOk = true := by\n \ - decide +kernel\n\n\ - 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" - )); - } - } - s.push_str( - "theorem plans_all : AverCert.manifest.fnPlans.all planOk = true := plans_from_0\n\n\ - end AverCert.Artifact\n", + 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 := by\n \ + decide +kernel\n\n" ); - s + let chunk = |k: usize| { + format!( + "theorem plans_chunk_{k} :\n \ + ((AverCert.manifest.fnPlans.drop {k}).take {PLAN_CHUNK}).all planOk = true := by\n \ + decide +kernel\n\n" + ) + }; + 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 = "import AcceptedArtifact\nimport ArtifactBytes\nimport Manifest\n\n"; + 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 !splits_artifact_modules(analysis) { + return vec![( + "ArtifactPlans.lean".to_string(), + format!( + "-- The per-plan acceptance checks, a few plans per `decide +kernel`\n\ + -- declaration, 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, -) -> String { +) -> Vec<(String, String)> { let envelope = match envelope { None => "none".to_string(), Some(env) => format!( @@ -445,32 +501,23 @@ fn render_artifact( .to_string(), ), }; - format!( - "-- The artifact data and the byte facts of its acceptance, each by\n\ - -- `decide +kernel` against the checker-staged `ArtifactBytes`.\n\ - import AcceptedArtifact\n\ - import ArtifactBytes\n\ - import Manifest\n\ - import ArtifactPlans\n\ - {roles_import}\n\ - 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\ - noncomputable def data : ArtifactData :=\n \ + 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\ - theorem plans_ok : plansAccepted data = true :=\n \ - plansAccepted_of_parts data plans_all (by decide +kernel)\n\n\ - {roles_proof}\n\n\ - theorem strings_ok : decodedStringHostRoles data := by\n \ - unfold decodedStringHostRoles; decide +kernel\n\n\ - theorem axes_ok : AverCert.ClaimAxes.checked data = true := by decide +kernel\n\n\ - theorem framing_ok : CertDecode.moduleFramingValid data.modBytes data.modLen = true := by\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), + ); + let strings = "theorem strings_ok : decodedStringHostRoles data := by\n \ + unfold decodedStringHostRoles; decide +kernel\n\n"; + let closure_ok = + "theorem closure_ok : closureIsolation data = true := by decide +kernel\n\n"; + 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 \ @@ -478,13 +525,7 @@ fn render_artifact( {declared_names}\n \ rfl rfl (by decide +kernel)\n\n\ theorem imports_ok : importsWithinCapabilities data = true := by decide +kernel\n\n\ - theorem start_ok : startAccounted data = true := by decide +kernel\n\n\ - theorem closure_ok : closureIsolation data = true := by decide +kernel\n\n\ - 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", + theorem start_ok : startAccounted data = true := by decide +kernel\n\n", obligation_names = lean_char_lists( &analysis .entries @@ -501,11 +542,81 @@ fn render_artifact( .collect::>(), "\n " ), - fuel = analysis.module_envelope.closure_fuel, - roots = nats(&closure.roots), - helpers = nats(&closure.helpers), - admitted = nats(&closure.admitted), - ) + ); + let rest = format!( + "theorem plans_ok : plansAccepted data = true :=\n \ + plansAccepted_of_parts data plans_all (by decide +kernel)\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 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\ + {roles_import}\n\ + {ARTIFACT_HEADER}\ + {data}{rest}{strings}{exports}{closure_ok}{tail}" + ), + )]; + } + let part = |comment: &str, body: &str| { + format!( + "-- {comment}\n\ + import ArtifactData\n\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.", strings), + ), + ( + "ArtifactClosure.lean".to_string(), + part("The certified closure's isolation.", closure_ok), + ), + ( + "ArtifactInterface.lean".to_string(), + part("The module's framing, exports, imports and start function.", &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 { @@ -779,16 +890,12 @@ pub fn write_project( &render_artifact_host_roles(analysis, ¶ms), )?; } - write( - &cert_dir, - "ArtifactPlans.lean", - &render_artifact_plans(analysis), - )?; - write( - &cert_dir, - "Artifact.lean", - &render_artifact(analysis, envelope), - )?; + for (name, text) in render_artifact_plans(analysis) { + write(&cert_dir, &name, &text)?; + } + for (name, text) in render_artifact(analysis, envelope) { + write(&cert_dir, &name, &text)?; + } write(&cert_dir, "Final.lean", &render_final())?; write( &cert_dir, From ac7e9d6863c5a99be21bf65ea143b6d720766fa4 Mon Sep 17 00:00:00 2001 From: jasisz Date: Thu, 24 Sep 2026 08:12:07 +0200 Subject: [PATCH 52/89] cert: read plan facts from a declared module layout A plan check found its export by comparing its name with every earlier export name, and read its code entry and type through the decoders' arrays, which the kernel walks element by element; every declaration also decoded the sections again. On btc-listener's law leaf the later plan chunks took a minute each. The package now declares the layout in ArtifactLayout.lean: the imported function count and, for every defined function, its type index and the offset and length of its code entry (packed tables); the function types of the planned functions; and each plan entry's export position. The wall confirms the declaration once against its own decoders (layoutConfirmed, fnTypesConfirmed, exportNamesDistinct) and proves that the checks reading it imply the decoder-based ones (entries_of_fast, closureIsolation_of_layout, arithRoleCheck_of_layout, plansAcceptedRest_of_layout). The statements proved are unchanged; a wrong declaration fails an equality and the package declines. On btc-listener's law leaf the plan checks take about 13 seconds of module time instead of 230, the host-role pins 4 instead of 14 and the closure 10 instead of 15. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/DeclaredLayout.lean | 617 ++++++++++++++++++ aver-cert/src/engine/layout.rs | 318 +++++++++ aver-cert/src/engine/mod.rs | 2 + aver-cert/src/engine/render_package.rs | 133 +++- aver-cert/src/format.rs | 2 +- aver-cert/src/wall.rs | 10 +- docs/certificate-format.md | 5 +- docs/certification-architecture.md | 5 + 8 files changed, 1054 insertions(+), 38 deletions(-) create mode 100644 aver-cert/assets/wall/current/DeclaredLayout.lean create mode 100644 aver-cert/src/engine/layout.rs diff --git a/aver-cert/assets/wall/current/DeclaredLayout.lean b/aver-cert/assets/wall/current/DeclaredLayout.lean new file mode 100644 index 000000000..245c736a8 --- /dev/null +++ b/aver-cert/assets/wall/current/DeclaredLayout.lean @@ -0,0 +1,617 @@ +-- 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] + +/-- `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] + +end AverCert.DeclaredLayout diff --git a/aver-cert/src/engine/layout.rs b/aver-cert/src/engine/layout.rs new file mode 100644 index 000000000..397948652 --- /dev/null +++ b/aver-cert/src/engine/layout.rs @@ -0,0 +1,318 @@ +// ---- 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, +} + +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(), + }; + 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 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()?; + 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 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; + } + } + 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) +} + +/// `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 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\ + theorem layout_ok : layoutConfirmed AverCert.ArtifactBytes.modBytes\n \ + AverCert.ArtifactBytes.modLen layout = true := by 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 "), + )) +} diff --git a/aver-cert/src/engine/mod.rs b/aver-cert/src/engine/mod.rs index e208d8922..04681ade4 100644 --- a/aver-cert/src/engine/mod.rs +++ b/aver-cert/src/engine/mod.rs @@ -109,5 +109,7 @@ include!("module_envelope.rs"); #[cfg(feature = "engine")] include!("source_bridges.rs"); #[cfg(feature = "engine")] +include!("layout.rs"); +#[cfg(feature = "engine")] include!("render_package.rs"); include!("law_claims.rs"); diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 0b6ce718c..89dd198ce 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -311,14 +311,21 @@ fn render_manifest_lean(analysis: &Analysis, sha: &str, target: &str, abi: &str) ) } -fn render_artifact_host_roles(analysis: &Analysis, params: &str) -> String { +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 := by decide +kernel" + ArithTemplateDerisk.ArithRole.{name} {idx} {params} = true := {proof}" ) }; let leaves = [ @@ -336,11 +343,13 @@ fn render_artifact_host_roles(analysis: &Analysis, params: &str) -> String { "-- 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\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" + end AverCert.Artifact\n", + layout_import = if layout { "import ArtifactLayout\n" } else { "" }, ) } @@ -348,34 +357,57 @@ fn render_artifact_host_roles(analysis: &Analysis, params: &str) -> String { const PLAN_CHUNK: usize = 32; /// The per-entry plan checks (`entryAccepted`), `PLAN_CHUNK` entries per -/// `decide +kernel` declaration, in their own compilation unit: one check -/// over every plan of a large module exhausts the kernel's memory, and every -/// declaration decodes the module's sections again, so the chunk trades the -/// two (on btc-listener's 173 plans: 8 per chunk took 227 seconds, 32 took -/// 124 seconds at a 7.4 GiB peak). The chunks are chained from the last one -/// back to the whole list. -fn render_artifact_plans(analysis: &Analysis) -> Vec<(String, String)> { +/// 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 = "set_option maxRecDepth 200000\n\ + 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"; - let plan_ok = "/-- One plan's acceptance check against the staged artifact bytes. -/\n\ + open AverCert AverCert.Schema AverCert.AcceptedArtifact AverCert.TypeTable{}\n\n", + if layout { " AverCert.DeclaredLayout" } else { "" } + ); + 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"; + 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 decide +kernel\n\n\ + theorem names_ok : exportNamesDistinct AverCert.ArtifactBytes.modBytes\n \ + AverCert.ArtifactBytes.modLen = true := by 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 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 := by\n \ - decide +kernel\n\n" + "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 := by\n \ - decide +kernel\n\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| { @@ -386,7 +418,10 @@ fn render_artifact_plans(analysis: &Analysis) -> Vec<(String, String)> { simpa only [Nat.reduceAdd, Bool.true_and] using plans_from_{next}\n\n" ) }; - let imports = "import AcceptedArtifact\nimport ArtifactBytes\nimport Manifest\n\n"; + let imports = format!( + "import AcceptedArtifact\nimport ArtifactBytes\nimport Manifest\n{}\n", + if layout { "import ArtifactLayout\n" } else { "" } + ); let mut body = String::new(); let mut chained = String::new(); for (i, k) in starts.iter().enumerate().rev().skip(1) { @@ -399,8 +434,8 @@ fn render_artifact_plans(analysis: &Analysis) -> Vec<(String, String)> { return vec![( "ArtifactPlans.lean".to_string(), format!( - "-- The per-plan acceptance checks, a few plans per `decide +kernel`\n\ - -- declaration, chained into the check over every plan.\n\ + "-- 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}" ), )]; @@ -458,6 +493,7 @@ const ARTIFACT_HEADER: &str = "set_option maxRecDepth 200000\n\ fn render_artifact( analysis: &Analysis, envelope: Option, + layout: bool, ) -> Vec<(String, String)> { let envelope = match envelope { None => "none".to_string(), @@ -514,8 +550,15 @@ fn render_artifact( ); let strings = "theorem strings_ok : decodedStringHostRoles data := by\n \ unfold decodedStringHostRoles; decide +kernel\n\n"; - let closure_ok = - "theorem closure_ok : closureIsolation data = true := by 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 (by decide +kernel)\n\n" + } else { + "theorem closure_ok : closureIsolation data = true := by decide +kernel\n\n" + }; + let layout_import = if layout { "import ArtifactLayout\n" } else { "" }; let exports = format!( "theorem framing_ok : CertDecode.moduleFramingValid data.modBytes data.modLen = true := by\n \ decide +kernel\n\n\ @@ -543,9 +586,15 @@ fn render_artifact( "\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 decide +kernel))" + } else { + "(by decide +kernel)" + }; let rest = format!( "theorem plans_ok : plansAccepted data = true :=\n \ - plansAccepted_of_parts data plans_all (by decide +kernel)\n\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" ); @@ -554,7 +603,8 @@ fn render_artifact( 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 ArtifactBytes\nimport Manifest\n"; + let base_imports = + "import AcceptedArtifact\nimport DeclaredLayout\nimport ArtifactBytes\nimport Manifest\n"; if !splits_artifact_modules(analysis) { return vec![( "Artifact.lean".to_string(), @@ -563,16 +613,18 @@ fn render_artifact( -- `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, body: &str| { + let part = |comment: &str, imports: &str, body: &str| { format!( "-- {comment}\n\ - import ArtifactData\n\n\ + import ArtifactData\n\ + {imports}\n\ {ARTIFACT_HEADER}\ {body}\ end AverCert.Artifact\n" @@ -591,15 +643,19 @@ fn render_artifact( ), ( "ArtifactStrings.lean".to_string(), - part("The String helper roles, decoded from the module.", strings), + part("The String helper roles, decoded from the module.", "", strings), ), ( "ArtifactClosure.lean".to_string(), - part("The certified closure's isolation.", closure_ok), + part("The certified closure's isolation.", layout_import, closure_ok), ), ( "ArtifactInterface.lean".to_string(), - part("The module's framing, exports, imports and start function.", &exports), + part( + "The module's framing, exports, imports and start function.", + "", + &exports, + ), ), ( "Artifact.lean".to_string(), @@ -874,6 +930,15 @@ pub fn write_project( &render_module(artifact.file_name(), &sha), )?; 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", @@ -887,13 +952,13 @@ pub fn write_project( write( &cert_dir, "ArtifactHostRoles.lean", - &render_artifact_host_roles(analysis, ¶ms), + &render_artifact_host_roles(analysis, ¶ms, layout), )?; } - for (name, text) in render_artifact_plans(analysis) { + for (name, text) in render_artifact_plans(analysis, layout) { write(&cert_dir, &name, &text)?; } - for (name, text) in render_artifact(analysis, envelope) { + for (name, text) in render_artifact(analysis, envelope, layout) { write(&cert_dir, &name, &text)?; } write(&cert_dir, "Final.lean", &render_final())?; diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 346154927..0452c1d4e 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:ec192fcadb526327561c7ee2f0af8aba7599a339e2f6e896f239ea3503301f9c"; + "sha256:c5e9b266a101e3c15e30297471121c5c714445f4e65325260d53cc36dd64c688"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/aver-cert/src/wall.rs b/aver-cert/src/wall.rs index 2bfb1f1cf..a803ce71e 100644 --- a/aver-cert/src/wall.rs +++ b/aver-cert/src/wall.rs @@ -31,6 +31,7 @@ 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_CLAIM_AXES: &str = include_str!("../assets/wall/current/ClaimAxes.lean"); pub const CERT_ACCEPTANCE_SOUNDNESS_CORE: &str = include_str!("../assets/wall/current/AcceptanceSoundnessCore.lean"); @@ -51,7 +52,7 @@ 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; 21] = [ +pub const SOURCES: [Source; 22] = [ Source { name: "AcceptanceSoundness.lean", contents: CERT_ACCEPTANCE_SOUNDNESS, @@ -84,6 +85,10 @@ pub const SOURCES: [Source; 21] = [ name: "ClaimAxes.lean", contents: CERT_CLAIM_AXES, }, + Source { + name: "DeclaredLayout.lean", + contents: CERT_DECLARED_LAYOUT, + }, Source { name: "Grammar.lean", contents: CERT_GRAMMAR, @@ -140,7 +145,7 @@ pub const SOURCES: [Source; 21] = [ /// Roots whose complete import graph is artifact-independent and can therefore /// be cached before a certificate is seen. -pub const PRISTINE_ROOTS: [&str; 19] = [ +pub const PRISTINE_ROOTS: [&str; 20] = [ "CertPrelude", "CertDecode", "ArithTemplateDerisk", @@ -155,6 +160,7 @@ pub const PRISTINE_ROOTS: [&str; 19] = [ "GrammarTotal", "TypeTable", "AcceptedArtifactCore", + "DeclaredLayout", "ClaimAxes", "AcceptanceSoundnessCore", "AcceptanceSoundness", diff --git a/docs/certificate-format.md b/docs/certificate-format.md index f825f7ec9..443c28e23 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 21 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:ec192fcadb526327561c7ee2f0af8aba7599a339e2f6e896f239ea3503301f9c` (`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. +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 22 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:c5e9b266a101e3c15e30297471121c5c714445f4e65325260d53cc36dd64c688` (`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 = 9` 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. @@ -57,6 +57,7 @@ A certificate package is one directory, conventionally named `cert/`, emitted ne | `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. | +| `ArtifactLayout.lean` | The declared module layout (`DeclaredLayout.Layout`): the imported function count and, for every defined function, its function-section type index and the byte offset and length of its code entry, as packed tables; the exact function type of every planned function; and every plan entry's name (as characters) and export position. Producer data: `layout_ok` confirms the layout against the staged bytes, and the plan checks confirm the rest (section 7). Emitted when the package has plans. | | `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. | | `BridgeProof.lean`, `Bridge.lean` | The plan-equals-source proofs, in `BridgeProof.lean`: per bridged function a decoder (`dec_`), a source image (`img_`) and ONE step lemma (`step_`, `GrammarBridge.Step`), the image table `I`, and per manifest `sourceBridges` entry the bridge theorem `AverCert.Bridge.` (assembled from the step lemmas of its call closure by `GrammarBridge.exact_of_step` or `GrammarBridge.bridge_of_step`). `Bridge.lean` imports it and carries per entry the corollary `AverCert.Bridge._certified` the manifest names. Only the corollaries cite `Final.cert`, which sits behind the byte-level `Artifact.lean`, so the split lets the bridge proofs build in parallel with it rather than after it. Each proof is `first \| (script under a heartbeat cap) \| sorry`, so a proof that does not close costs its own bridges (through the axiom audit) and never the build. Every theorem also sits behind `#guard_msgs (drop error) in` (see the model-modules row): a resource-limit exception such as a deterministic `maxHeartbeats` timeout escapes every `first` alternative, and without the wrapper its error message failed the whole build. Emitted only when the `sourceBridges` array is nonempty. | @@ -304,6 +305,8 @@ Three mechanisms bind the certificate to one exact artifact: **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 hex numerals of at most 1024 bytes each, every chunk's byte sequence reversed and shifted left by eight times its byte offset, the chunks joined by `|||`, in a `noncomputable` definition; Lean reads one numeral in time quadratic in its length, and the compiler would render the number into C), 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. +**Declared layout.** A package's byte checks read module facts from a declaration instead of searching for them, and the wall confirms the declaration by equality against its own decoders, so the statements proved (`plansAccepted`, `closureIsolation`, `arithRoleCheck`) are unchanged and a wrong declaration only declines. `DeclaredLayout.layoutConfirmed` decodes the import, function and code sections once 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; the sections are decoded in full, so the layout covers every function. `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, which `exportNamesDistinct` (every export name distinct, decided on numeric name keys) makes the one entry the name search of `entryAccepted` finds. `entries_of_fast`, `closureIsolation_of_layout`, `arithRoleCheck_of_layout` and `plansAcceptedRest_of_layout` prove each fast check equal to, or sufficient for, the check it replaces. + **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. ## 8. The checker witness, the axiom whitelist, and the fail-closed guard diff --git a/docs/certification-architecture.md b/docs/certification-architecture.md index 0c15af970..d121c595c 100644 --- a/docs/certification-architecture.md +++ b/docs/certification-architecture.md @@ -164,6 +164,11 @@ module: signature, carrier, and structure facts; - `ClaimAxes` derives policy, termination, totality, and contracts; - family soundness and `Discharge*` modules prove the reusable simulations; +- `DeclaredLayout` confirms a producer-declared module layout (where each + function's code entry, type and export entry are) against the decoders + once, and proves that the checks reading it imply the decoder-based ones, + so the declaration saves searching and decoding without changing what is + accepted; - `AcceptedArtifact` and the artifact-specific bridge assemble the single acceptance statement. From 5efe5f52d1a842595bd85601a72f0d30b77be606 Mon Sep 17 00:00:00 2001 From: jasisz Date: Thu, 24 Sep 2026 08:17:16 +0200 Subject: [PATCH 53/89] cert: classify String helper roles through a signature-shape bitmap roleTable classifies every defined function by its type's signature, read from an array by type index; the kernel walks the decoded type list for each function, and btc-listener's 784 functions made the String roles take 27 seconds. roleTableFast folds the signatures into a bitmap of the types an eq or concat helper can have and reads a signature only for a function of such a type; roleTableFast_eq proves it equal to roleTable, and the package decides decodedStringHostRoles through it. On btc-listener the check takes 5 seconds. Co-Authored-By: Claude Opus 5.5 (1M context) --- .../assets/wall/current/DeclaredLayout.lean | 167 ++++++++++++++++++ aver-cert/src/engine/render_package.rs | 5 +- aver-cert/src/format.rs | 2 +- docs/certificate-format.md | 4 +- 4 files changed, 175 insertions(+), 3 deletions(-) diff --git a/aver-cert/assets/wall/current/DeclaredLayout.lean b/aver-cert/assets/wall/current/DeclaredLayout.lean index 245c736a8..27f6552ee 100644 --- a/aver-cert/assets/wall/current/DeclaredLayout.lean +++ b/aver-cert/assets/wall/current/DeclaredLayout.lean @@ -614,4 +614,171 @@ theorem arithRoleCheck_of_layout {n len : Nat} {L : Layout} | 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 + end AverCert.DeclaredLayout diff --git a/aver-cert/src/engine/render_package.rs b/aver-cert/src/engine/render_package.rs index 89dd198ce..cede285e6 100644 --- a/aver-cert/src/engine/render_package.rs +++ b/aver-cert/src/engine/render_package.rs @@ -548,8 +548,11 @@ fn render_artifact( 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. let strings = "theorem strings_ok : decodedStringHostRoles data := by\n \ - unfold decodedStringHostRoles; decide +kernel\n\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 { diff --git a/aver-cert/src/format.rs b/aver-cert/src/format.rs index 0452c1d4e..814d0efb0 100644 --- a/aver-cert/src/format.rs +++ b/aver-cert/src/format.rs @@ -180,7 +180,7 @@ pub const FN_CLAIM_DISCHARGE_THEOREM: &str = "AcceptanceSoundness.fn_claim_disch /// Identity of the exact checker-owned Lean wall shipped by this release. pub const CURRENT_WALL_ID: &str = - "sha256:c5e9b266a101e3c15e30297471121c5c714445f4e65325260d53cc36dd64c688"; + "sha256:96c915ddda44920222289ec3d02c744e6e23bfc8d576e770be666e0ec0cb93fd"; /// Complete host-import surface admitted by the wasm-gc certificate format. /// diff --git a/docs/certificate-format.md b/docs/certificate-format.md index 443c28e23..f147fde43 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -34,7 +34,7 @@ Schema version 8 differs from version 7 in two related points: the manifest gain Schema version 9 differs from version 8 in how every obligation is stated. The manifest carries one plan list (`Plans.lean` `fnPlans`): each planned function's optimized MIR body, printed 1:1 into the one plan grammar (`Grammar.lean`), plus the declared type layout (`Plans.types`), which the wall confirms against the type and data sections. The obligations are exactly the ones the wall derives from the plans (`AcceptedArtifact.obligationsOf`); their model is the plan's fuel-indexed meaning, so there are no per-family domains, codomains or representation fields left for a producer to choose. Every certified export reports the one class `source-plan-v1`, with facets derived in the wall (`ClaimAxes.reportFacets`) and pinned by the checker witness. Schema 9 re-states the law-claims and plan-equals-source surfaces over the plan grammar (section 4.1): a bridge says, in one of two checker-rendered kinds, that the fuel-indexed model of an export's obligation computes a named transpiled source function through source-value encoders; the wall's `GrammarBridge.lean` holds the statement vocabulary and the proof engines. The Int equality helper `__aint_eq` is pinned by its template only, like the other arithmetic helpers. -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 22 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:c5e9b266a101e3c15e30297471121c5c714445f4e65325260d53cc36dd64c688` (`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. +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 22 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:96c915ddda44920222289ec3d02c744e6e23bfc8d576e770be666e0ec0cb93fd` (`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 = 9` 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. @@ -307,6 +307,8 @@ Three mechanisms bind the certificate to one exact artifact: **Declared layout.** A package's byte checks read module facts from a declaration instead of searching for them, and the wall confirms the declaration by equality against its own decoders, so the statements proved (`plansAccepted`, `closureIsolation`, `arithRoleCheck`) are unchanged and a wrong declaration only declines. `DeclaredLayout.layoutConfirmed` decodes the import, function and code sections once 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; the sections are decoded in full, so the layout covers every function. `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, which `exportNamesDistinct` (every export name distinct, decided on numeric name keys) makes the one entry the name search of `entryAccepted` finds. `entries_of_fast`, `closureIsolation_of_layout`, `arithRoleCheck_of_layout` and `plansAcceptedRest_of_layout` prove each fast check equal to, or sufficient for, the check it replaces. +**String helper roles.** `StringHost.roleTable` classifies every defined function by the signature of its type, which the kernel reads from an array by walking the decoded type list. `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; every other function has no role under either definition. `roleTableFast_eq` proves the two equal, so `decodedStringHostRoles` is decided through the fast one. + **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. ## 8. The checker witness, the axiom whitelist, and the fail-closed guard From ef4e925ce2fefac5902ea9a7ee3c5498125b7efa Mon Sep 17 00:00:00 2001 From: jasisz Date: Thu, 24 Sep 2026 08:32:03 +0200 Subject: [PATCH 54/89] cert: reuse unchanged modules from the data cache The data cache reused a build only when every staged source was identical, so changing one function rebuilt every module of the package, including the model modules that do not depend on it. On a miss the cache now restores each package module whose outputs it holds under a key over the module's source and the keys of the package modules it imports (the wall and toolchain are fixed by the key material), and after a successful build it stores every module's outputs, each entry with its own integrity manifest. Lake recomputes every restored module's input trace and rebuilds any that disagree, so a key that misses an input costs a rebuild, not a stale module. Nothing changes without AVER_CERT_DATA_CACHE; strict verification configures no cache. Co-Authored-By: Claude Opus 5.5 (1M context) --- aver-cert/src/cache.rs | 348 +++++++++++++++++++++++++++++++++++++ aver-cert/src/verifier.rs | 31 +++- docs/certificate-format.md | 2 +- docs/certification.md | 7 +- 4 files changed, 383 insertions(+), 5 deletions(-) diff --git a/aver-cert/src/cache.rs b/aver-cert/src/cache.rs index c664c2595..0cdf85fff 100644 --- a/aver-cert/src/cache.rs +++ b/aver-cert/src/cache.rs @@ -126,6 +126,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 +662,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/verifier.rs b/aver-cert/src/verifier.rs index fc456092b..233da9c9d 100644 --- a/aver-cert/src/verifier.rs +++ b/aver-cert/src/verifier.rs @@ -10,7 +10,9 @@ use crate::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, lean_gate, wall}; @@ -581,9 +583,33 @@ fn trusted_check( 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 { + 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 { @@ -601,6 +627,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) diff --git a/docs/certificate-format.md b/docs/certificate-format.md index f147fde43..c4c7d3b76 100644 --- a/docs/certificate-format.md +++ b/docs/certificate-format.md @@ -331,7 +331,7 @@ A conforming verifier MUST execute the following stages in order and MUST reject 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` in code position. The scan is a case-sensitive token scan after lossy UTF-8 decoding that skips only normal string literals, line comments and block comments, and defaults to scanning as code on any lexical ambiguity (raw or interpolated string prefixes, unterminated strings or comments); word tokens match on identifier boundaries. Within its enumeration it is deliberately overbroad: package Lean files are data and definitions only. `deriving` has exactly one admitted form: the rest of its line is `deriving C, C, …` with every `C` one of `BEq`, `DecidableEq`, `Inhabited`, or `deriving instance C, C, … for T, T, …` with every `C` one of `ReflBEq`, `LawfulBEq` and every `T` a plain dotted identifier; nothing else may follow on the line, and the next token after the line (comments skipped) may be neither `,` nor `with`, since Lean's parser would continue the clause across the newline. A `deriving` clause runs the derive handler registered under each class name; a package can register none (every registration route is on this list), so the admitted clause runs only the pinned toolchain's handlers for those five classes, each of which produces ordinary declarations the kernel checks — the same kind a hand-written `instance`, which this scan never refused, produces. The reference implementation is `aver-cert/src/lean_gate.rs`, which the producer runs over its own model files before shipping them. 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. +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. On a miss, the same cache restores each staged package module (wall sources excluded) whose outputs are stored under a key over a module-layout version, the wall id, the toolchain and schema versions, the module's relative name and contents, and the keys of the staged modules its `import` lines name; each entry carries its own integrity manifest. Lake recomputes every restored module's input trace and rebuilds a module whose trace disagrees, so a key that misses an input costs a rebuild, not a stale module. `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: