271b47102e
Some checks are pending
Lean Action CI / build (push) Waiting to run
Lands the foundational DecidableEq machinery and the @[simp]-
based question-form routing in one go (per project discipline:
no shortcuts, no compat shims).
CubicalTransport/DecEq.lean (new, ~290 lines):
- Mutual decEq for the 5-way AST block (CType, CTerm, CTypeArg,
CtorSpec, CTypeSchema) plus list/clause/branch helpers
(decEqListCType, decEqListCTerm, decEqListCTypeArg,
decEqListCtorSpec, decEqClauses, decEqBranches).
- Returns Decidable (a = b) directly; uses OR-patterns for
cross-constructor mismatches, discharged uniformly via cases.
- Five DecidableEq instances declared post-block.
- Lean 4 deriving doesn't support mutual inductives; manual
decEq is the canonical approach.
CubicalTransport/Interval.lean: deriving DecidableEq on DimExpr.
CubicalTransport/Face.lean: deriving DecidableEq on FaceFormula.
CubicalTransport/Question.lean:
- All 11 classifier Decidable instances now land:
IsConstLine, IsFullFace, IsEmptyFace, IsTransport,
IsIntervalLine, IsUnivLine — direct from DecidableEq.
IsPathLine, IsPiLine, IsSigmaLine, IsGlueLine, IsIndLine —
via match h : q.body with on the head constructor +
existential-witness reconstruction in the isTrue arm.
- @[simp] tags on ask_of_full_face / ask_of_empty_face /
ask_of_const_line / ask_of_transport_full_face — the Level 2
routing through CompQ.Equiv.
- Three example proofs at end of file demonstrating that the
simp-set composes (full-face C1, empty-face C2, transport-
shaped interval-line reduction).
CubicalTransport/FFITest.lean: 6 new classifier-decidability
smoke tests (IsFullFace, IsTransport×2, IsPiLine, IsIntervalLine).
Test count: 84 → 89 passing.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
291 lines
12 KiB
Text
291 lines
12 KiB
Text
/-
|
||
Topolei.Cubical.FFITest
|
||
=======================
|
||
Phase C.3 smoke test (2026-04-24). Exercises the FFI wiring by
|
||
running simple cubical terms through `eval` / `readback` / the
|
||
normalizers. With `@[implemented_by]` attached, these execute in
|
||
the Rust backend at runtime.
|
||
|
||
**Why not `#eval`?** `#eval` runs at Lean's compile-time in the
|
||
interpreter, which does not link our Rust staticlib. Calling a
|
||
Rust-backed function under the interpreter raises "Could not find
|
||
native implementation of external declaration ..." The tests here
|
||
are `def`s + a `runSmokeTests : IO Unit` entry point that exercises
|
||
them inside a compiled binary where Rust IS linked.
|
||
|
||
Invoke from a compiled executable. `Main.lean` can optionally
|
||
route to `CubicalTransportFFITest.runSmokeTests` when passed
|
||
`--cubical-test`. Or a dedicated test exe target.
|
||
-/
|
||
|
||
import CubicalTransport.Readback
|
||
import CubicalTransport.FFI
|
||
import CubicalTransport.Inductive
|
||
import CubicalTransport.Bridge
|
||
import CubicalTransport.Question
|
||
|
||
open CubicalTransport.Inductive
|
||
open CubicalTransport.Inductive.CTerm
|
||
open CubicalTransport.Bridge
|
||
open Question
|
||
|
||
namespace CubicalTransportFFITest
|
||
|
||
-- ── Summarisers ────────────────────────────────────────────────────────────
|
||
|
||
def cvalSummary : CVal → String
|
||
| .vneu (.nvar s) => s!"vneu nvar {s}"
|
||
| .vneu (.napp _ _) => "vneu napp"
|
||
| .vneu (.npapp _ _) => "vneu npapp"
|
||
| .vneu (.ntransp _ _ _ _) => "vneu ntransp"
|
||
| .vneu (.nhcomp _ _ _ _) => "vneu nhcomp"
|
||
| .vneu (.ncomp _ _ _ _ _) => "vneu ncomp"
|
||
| .vneu (.ncompN _ _ _ _ _) => "vneu ncompN"
|
||
| .vneu (.nglueIn _ _ _) => "vneu nglueIn"
|
||
| .vneu (.nunglue _ _ _) => "vneu nunglue"
|
||
| .vneu (.nfst _) => "vneu nfst"
|
||
| .vneu (.nsnd _) => "vneu nsnd"
|
||
| .vneu (.nIndElim _ _ _ _ _) => "vneu nIndElim"
|
||
| .vlam _ x _ => s!"vlam {x} ..."
|
||
| .vplam _ i _ => s!"vplam {i.name} ..."
|
||
| .vpair _ _ => "vpair ..."
|
||
| .vTranspFun _ _ _ _ _ => "vTranspFun"
|
||
| .vHCompFun _ _ _ _ => "vHCompFun"
|
||
| .vCompFun _ _ _ _ _ _ _ => "vCompFun"
|
||
| .vTubeApp _ _ => "vTubeApp"
|
||
| .vPathTransp _ _ _ _ _ _ _ => "vPathTransp"
|
||
| .vctor _ c _ _ => s!"vctor {c} ..."
|
||
| .vdimExpr _ => "vdimExpr ..."
|
||
|
||
def ctermSummary : CTerm → String
|
||
| .var x => s!"var {x}"
|
||
| .lam x _ => s!"lam {x} ..."
|
||
| .app _ _ => "app ..."
|
||
| .plam i _ => s!"plam {i.name} ..."
|
||
| .pair _ _ => "pair ..."
|
||
| .fst _ => "fst ..."
|
||
| .snd _ => "snd ..."
|
||
| .dimExpr _ => "dimExpr ..."
|
||
| .ctor _ c _ _ => s!"ctor {c} ..."
|
||
| .indElim _ _ _ _ _ => "indElim ..."
|
||
| _ => "<other CTerm>"
|
||
|
||
-- ── Individual test definitions ────────────────────────────────────────────
|
||
-- Each returns (description, actual, expected) for runSmokeTests to print.
|
||
|
||
def tests : List (String × String × String) :=
|
||
[ ("eval .nil (.var \"x\")",
|
||
cvalSummary (eval .nil (.var "x")),
|
||
"vneu nvar x"),
|
||
("eval .nil (.lam \"x\" (.var \"x\"))",
|
||
cvalSummary (eval .nil (.lam "x" (.var "x"))),
|
||
"vlam x ..."),
|
||
("(λx. x) y ⇓ y",
|
||
cvalSummary (eval .nil (.app (.lam "x" (.var "x")) (.var "y"))),
|
||
"vneu nvar y"),
|
||
("(a, b).fst ⇓ a",
|
||
cvalSummary (eval .nil (.fst (.pair (.var "a") (.var "b")))),
|
||
"vneu nvar a"),
|
||
("(a, b).snd ⇓ b",
|
||
cvalSummary (eval .nil (.snd (.pair (.var "a") (.var "b")))),
|
||
"vneu nvar b"),
|
||
("readback (eval .nil (.lam \"x\" (.var \"x\"))) ≡ .lam \"x\" ...",
|
||
ctermSummary (readback (eval .nil (.lam "x" (.var "x")))),
|
||
"lam x ..."),
|
||
("DimExpr.normalize (.inv .zero) ≡ .one",
|
||
match DimExpr.normalize (.inv .zero) with
|
||
| .one => "one"
|
||
| _ => "<other>",
|
||
"one"),
|
||
("DimExpr.normalize (.inv (.inv (.var i))) ≡ .var i",
|
||
match DimExpr.normalize (.inv (.inv (.var ⟨"i"⟩))) with
|
||
| .var j => s!"var {j.name}"
|
||
| _ => "<other>",
|
||
"var i"),
|
||
("FaceFormula.normalize (.meet .top (.eq0 i)) ≡ .eq0 i",
|
||
match FaceFormula.normalize (.meet .top (.eq0 ⟨"i"⟩)) with
|
||
| .eq0 j => s!"eq0 {j.name}"
|
||
| _ => "<other>",
|
||
"eq0 i"),
|
||
-- ── β-rules: discharge the five cubical-closure axioms ─────────────────
|
||
-- Each test exercises the path `Lean constructs a CVal closure →
|
||
-- vApp/vPApp routes through Rust @[implemented_by] → forcer unfolds
|
||
-- the CCHM RHS → result is no longer a stuck marker`.
|
||
("β vApp vTranspFun (const line, via beta::force_transp_fun)",
|
||
cvalSummary (vApp
|
||
(.vTranspFun ⟨"i"⟩ .univ .univ .bot (.vneu (.nvar "f")))
|
||
(.vneu (.nvar "y"))),
|
||
"vneu napp"),
|
||
("β vApp vHCompFun (stuck on .univ codA, via beta::force_hcomp_fun)",
|
||
cvalSummary (vApp
|
||
(.vHCompFun .univ .bot
|
||
(.vplam .nil ⟨"j"⟩ (.var "tube_body"))
|
||
(.vneu (.nvar "b")))
|
||
(.vneu (.nvar "x"))),
|
||
"vneu nhcomp"),
|
||
("β vApp vCompFun (φ=.bot collapses via C2, via beta::force_comp_fun)",
|
||
cvalSummary (vApp
|
||
(.vCompFun .nil ⟨"i"⟩ .univ .univ .bot (.var "u") (.var "t"))
|
||
(.vneu (.nvar "y"))),
|
||
"vneu napp"),
|
||
("β vPApp vTubeApp (via beta::force_tube_app)",
|
||
cvalSummary (vPApp
|
||
(.vTubeApp (.vplam .nil ⟨"j"⟩ (.var "tube_body")) (.vneu (.nvar "x")))
|
||
(.var ⟨"r"⟩)),
|
||
"vneu napp"),
|
||
("β vPApp vPathTransp at .zero ⇓ a(1) (via beta::force_path_transp)",
|
||
cvalSummary (vPApp
|
||
(.vPathTransp .nil ⟨"i"⟩ .univ (.var "a0") (.var "b0") .bot (.var "p"))
|
||
.zero),
|
||
"vneu nvar a0"),
|
||
("β vPApp vPathTransp at .one ⇓ b(1)",
|
||
cvalSummary (vPApp
|
||
(.vPathTransp .nil ⟨"i"⟩ .univ (.var "a0") (.var "b0") .bot (.var "p"))
|
||
.one),
|
||
"vneu nvar b0"),
|
||
("β vPApp vPathTransp at var r ⇓ compN (CCHM 3-clause system)",
|
||
cvalSummary (vPApp
|
||
(.vPathTransp .nil ⟨"i"⟩ .univ (.var "a0") (.var "b0") .bot (.var "p"))
|
||
(.var ⟨"r"⟩)),
|
||
"vneu ncompN"),
|
||
-- ── REL1 inductive-type smoke tests ─────────────────────────────────────
|
||
("eval (zero : Nat) ⇓ vctor zero",
|
||
cvalSummary (eval .nil zeroC),
|
||
"vctor zero ..."),
|
||
("eval (succ (succ zero) : Nat) ⇓ vctor succ",
|
||
cvalSummary (eval .nil (succC (succC zeroC))),
|
||
"vctor succ ..."),
|
||
("eval (false : Bool) ⇓ vctor false",
|
||
cvalSummary (eval .nil falseC),
|
||
"vctor false ..."),
|
||
("eval (cons true nil : List Bool) ⇓ vctor cons",
|
||
cvalSummary (eval .nil (consC CType.boolC trueC (nilC CType.boolC))),
|
||
"vctor cons ..."),
|
||
("readback ∘ eval (succ zero : Nat) ≡ ctor succ",
|
||
ctermSummary (readback (eval .nil (succC zeroC))),
|
||
"ctor succ ..."),
|
||
("eval (base : S¹) ⇓ vctor base",
|
||
cvalSummary (eval .nil baseC),
|
||
"vctor base ..."),
|
||
("eval (loop @ r : S¹) ⇓ vctor loop",
|
||
cvalSummary (eval .nil (loopC (.var ⟨"r"⟩))),
|
||
"vctor loop ..."),
|
||
("indElim Bool false-case (true → \"yes\") on true ⇓ \"yes\"",
|
||
cvalSummary (eval .nil
|
||
(boolElim (.lam "x" (.var "M")) (.var "no") (.var "yes") trueC)),
|
||
"vneu nvar yes"),
|
||
("indElim Bool true-case on false ⇓ \"no\"",
|
||
cvalSummary (eval .nil
|
||
(boolElim (.lam "x" (.var "M")) (.var "no") (.var "yes") falseC)),
|
||
"vneu nvar no"),
|
||
("transp_ind T1: φ=.top is identity",
|
||
cvalSummary (eval .nil
|
||
(.transp ⟨"i"⟩ CType.natC .top zeroC)),
|
||
"vctor zero ..."),
|
||
("transp_ind T2: constant Nat line is identity",
|
||
cvalSummary (eval .nil
|
||
(.transp ⟨"i"⟩ CType.natC (.eq0 ⟨"j"⟩) (succC zeroC))),
|
||
"vctor succ ..."),
|
||
("comp_ind C1: φ=.top reduces to u[i:=1]",
|
||
cvalSummary (eval .nil
|
||
(.comp ⟨"i"⟩ CType.natC .top (succC zeroC) zeroC)),
|
||
"vctor succ ..."),
|
||
-- REL2: interval primitive
|
||
("eval (.dimExpr .zero) ⇓ vdimExpr",
|
||
cvalSummary (eval .nil (.dimExpr .zero)),
|
||
"vdimExpr ..."),
|
||
("transp_interval is identity (constant line on 𝕀)",
|
||
cvalSummary (eval .nil
|
||
(.transp ⟨"i"⟩ CType.intervalC (.eq0 ⟨"j"⟩) (.dimExpr .one))),
|
||
"vdimExpr ..."),
|
||
-- REL2 Phase 2: Bridge.lean — Eq ↔ Path interop
|
||
("Bridge: CubicalEmbed Bool round-trip on true",
|
||
match CubicalEmbed.fromCTerm (α := Bool) (CubicalEmbed.toCTerm true) with
|
||
| some true => "ok"
|
||
| _ => "<roundtrip failed>",
|
||
"ok"),
|
||
("Bridge: CubicalEmbed Bool round-trip on false",
|
||
match CubicalEmbed.fromCTerm (α := Bool) (CubicalEmbed.toCTerm false) with
|
||
| some false => "ok"
|
||
| _ => "<roundtrip failed>",
|
||
"ok"),
|
||
("Bridge: CubicalEmbed Nat round-trip on 7",
|
||
match CubicalEmbed.fromCTerm (α := Nat) (CubicalEmbed.toCTerm 7) with
|
||
| some 7 => "ok"
|
||
| _ => "<roundtrip failed>",
|
||
"ok"),
|
||
("Bridge: CubicalEmbed (List Bool) round-trip on [true, false, true]",
|
||
match CubicalEmbed.fromCTerm (α := List Bool)
|
||
(CubicalEmbed.toCTerm [true, false, true]) with
|
||
| some [true, false, true] => "ok"
|
||
| _ => "<roundtrip failed>",
|
||
"ok"),
|
||
("Bridge: Eq.toPath rfl on Bool produces a constant plam",
|
||
ctermSummary (Eq.toPath (rfl : true = true)),
|
||
"plam $eq2path ..."),
|
||
-- Question.lean Level 1: CompQ smoke
|
||
("CompQ.ask delegates to eval (.comp ...)",
|
||
cvalSummary
|
||
(let q : CompQ :=
|
||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||
, φ := .top, u := .var "u", t := .var "t" }
|
||
q.ask),
|
||
"vneu nvar u"),
|
||
("CompQ.ofTransp on a constant interval line: full-face → eval u",
|
||
cvalSummary
|
||
(CompQ.ofTransp .nil ⟨"i"⟩ .interval .top (.var "x")).ask,
|
||
"vneu nvar x"),
|
||
("Classifier IsConstLine decidable on .interval line",
|
||
(if Question.IsConstLine
|
||
{ env := .nil, binder := ⟨"i"⟩, body := .interval
|
||
, φ := .top, u := .var "u", t := .var "t" }
|
||
then "yes" else "no"),
|
||
"yes"),
|
||
("Classifier IsFullFace decidable on .top face",
|
||
(if Question.IsFullFace
|
||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||
, φ := .top, u := .var "u", t := .var "t" }
|
||
then "yes" else "no"),
|
||
"yes"),
|
||
("Classifier IsTransport decidable when u = t",
|
||
(if Question.IsTransport
|
||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||
, φ := .top, u := .var "x", t := .var "x" }
|
||
then "yes" else "no"),
|
||
"yes"),
|
||
("Classifier IsTransport rejects when u ≠ t",
|
||
(if Question.IsTransport
|
||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||
, φ := .top, u := .var "x", t := .var "y" }
|
||
then "yes" else "no"),
|
||
"no"),
|
||
("Classifier IsPiLine decidable on .pi body",
|
||
(if Question.IsPiLine
|
||
{ env := .nil, binder := ⟨"i"⟩, body := .pi .univ .univ
|
||
, φ := .top, u := .var "u", t := .var "t" }
|
||
then "yes" else "no"),
|
||
"yes"),
|
||
("Classifier IsIntervalLine rejects on .univ",
|
||
(if Question.IsIntervalLine
|
||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||
, φ := .top, u := .var "u", t := .var "t" }
|
||
then "yes" else "no"),
|
||
"no") ]
|
||
|
||
/-- Run every smoke test, print its actual vs expected. Returns the
|
||
number of failures. -/
|
||
def runSmokeTests : IO UInt32 := do
|
||
IO.println "── Topolei cubical FFI smoke tests ──"
|
||
let mut fails : UInt32 := 0
|
||
for (desc, actual, expected) in tests do
|
||
if actual == expected then
|
||
IO.println s!" ✅ {desc}"
|
||
else
|
||
IO.println s!" ❌ {desc}"
|
||
IO.println s!" expected: {expected}"
|
||
IO.println s!" actual: {actual}"
|
||
fails := fails + 1
|
||
IO.println s!"── {tests.length - fails.toNat} / {tests.length} passed ──"
|
||
return fails
|
||
|
||
end CubicalTransportFFITest
|