Some checks are pending
Lean Action CI / build (push) Waiting to run
Restructure to engine-only contents. Application code (Topolei.*
namespace, canvas-rs / render Rust crates, Main / ProbeTest, naga IR
pipeline, Selection / Subobject / Trace / Obs.Ctx hypothesis stack,
cells-spec / HYPOTHESES / STATUS / NAGA_IR_PLAN docs) moves to the
sibling repo max/topolei.
What moved:
- `Topolei/Cubical/*.lean` (22 files) → `CubicalTransport/*.lean`
with namespace `Topolei.Cubical.*` renamed to `CubicalTransport.*`.
Fully-qualified test types `TopoleiCubical{FFI,Property}Test` →
`CubicalTransport{FFI,Property}Test` for consistency.
- New root file `CubicalTransport.lean` re-exporting all 22 modules.
- Lakefile: package `cubicalTransport`; lib `CubicalTransport`; only
`cubical-test` and `cubical-bench` exes (no GPU link path).
The split criterion: anything an AI shortcut could break that would
cascade-corrupt downstream proofs lives here. Anything that would
only break the application stays in the topolei interface repo.
cubical-test passes 62/62 (smoke + properties) on the renamed engine.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
578 lines
25 KiB
Text
578 lines
25 KiB
Text
/-
|
||
Topolei.Cubical.Readback
|
||
========================
|
||
Readback (NbE reification) for the cubical calculus — Sessions 1–2 of
|
||
the step↔eval bridge (Phase 1 Week 7).
|
||
|
||
## Purpose
|
||
|
||
`readback : CVal → CTerm` converts a weak-head normal-form `CVal` back
|
||
into a syntactic `CTerm`. Combined with `eval`, it gives
|
||
normalisation-by-evaluation (NbE):
|
||
|
||
normalise t := readback (eval .nil t)
|
||
|
||
The step↔eval bridge defines `CTerm.step` as exactly this NbE
|
||
composition. Step-level axioms (T1–T5, C1/C2/C4, `step_papp_plam`)
|
||
then become theorems derivable from the eval-level axiom set.
|
||
|
||
## Binder-preservation discipline
|
||
|
||
Session 1 used depth-indexed fresh-variable generation (`$rb_<n>`,
|
||
`$rd_<n>`) — sound but unhelpful: readback of `λx. x` produced
|
||
`λ$rb_0. $rb_0`, meaning step-level axioms about original-name terms
|
||
would become derivable only up to α-renaming, not syntactically.
|
||
|
||
Session 2 switches to **preserving original binder names**. For
|
||
`vlam env x body`, extend env at `x ↦ vneu (nvar x)` so that body
|
||
occurrences of `x` evaluate to `nvar x` and read back as `.var x`.
|
||
Lean's env cons-based `lookup` handles shadowing correctly, so nested
|
||
same-named binders work automatically (the inner extension shadows the
|
||
outer). For `vplam env i body`, dim variables don't live in `CEnv`,
|
||
so no env extension is needed; eval processes the body with `i` as a
|
||
free DimVar, which passes through as `.var i` in any stuck papps.
|
||
|
||
This discipline means `readback (eval .nil t) = t` holds syntactically
|
||
for a large class of t (closed normal forms over the λ-fragment), which
|
||
is exactly what the bridge needs to derive step axioms by `rfl`-style
|
||
chains.
|
||
|
||
## Session scope
|
||
|
||
Session 1: mutual partial defs + axioms + initial tests (landed).
|
||
Session 2: original-binder discipline + weak correspondence lemmas
|
||
(this revision).
|
||
Sessions 3–5: define `CTerm.step' := readback ∘ eval .nil`, derive
|
||
step axioms, remove originals.
|
||
|
||
## Architectural notes
|
||
|
||
- `readback` calls `eval` (one-way), so it lives downstream of Eval.
|
||
- `partial def` for the same reasons as `eval`: we re-evaluate closure
|
||
bodies under extended env, which isn't structural recursion.
|
||
- No fresh-name gimmickry — binder names pass through unchanged, and
|
||
env shadowing provides capture-avoidance.
|
||
-/
|
||
|
||
import CubicalTransport.Eval
|
||
|
||
-- ── Inhabited instance for CTerm ────────────────────────────────────────────
|
||
-- Needed for `partial def` elaboration: Lean's partial-fixpoint compilation
|
||
-- requires the return type to be nonempty so it can pick a default for the
|
||
-- divergence case.
|
||
|
||
instance : Inhabited CTerm := ⟨.var "⊥"⟩
|
||
|
||
-- ── Rust FFI declarations (Phase C.2) ──────────────────────────────────────
|
||
|
||
@[extern "topolei_cubical_readback"]
|
||
opaque readbackRust : CVal → CTerm
|
||
|
||
@[extern "topolei_cubical_readback_neu"]
|
||
opaque readbackNeuRust : CNeu → CTerm
|
||
|
||
-- ── The readback function ───────────────────────────────────────────────────
|
||
|
||
mutual
|
||
/-- Readback a `CVal` into a `CTerm`. Preserves original binder names;
|
||
env shadowing via `CEnv.cons`-based lookup handles capture.
|
||
|
||
· `vneu n` — delegate to `readbackNeu`.
|
||
· `vlam env x body` — extend env at `x ↦ vneu (nvar x)` so body
|
||
lookups of `x` return the abstract neutral; eval body; readback
|
||
the result; wrap in `.lam x`.
|
||
· `vplam env i body` — dim binders aren't in env; just eval body
|
||
under the current env (dim `i` remains a free DimVar that
|
||
propagates through stuck papps), readback, wrap in `.plam i`.
|
||
· `vTranspFun`, `vCompFun` — Π-line cubical closures; reconstruct
|
||
the original `.transp` / `.comp` term form.
|
||
· `vPathTransp _ i A a b φ p` — path-line transport. Two arms,
|
||
face-disjoint on the inner CTerm `p`:
|
||
- `p = .plam j body` — well-typed input shape; produces a `.plam j _`
|
||
form with a CCHM-shaped `.compN` witness body, supporting the
|
||
general T4 NbE statement.
|
||
- otherwise — preserve the original `.transp` form.
|
||
· `vHCompFun codA φ tube base` — hcomp on Π. Reconstruct as a
|
||
constant-line comp with fresh dim binder (so the type is
|
||
dim-absent on the binder), placeholder domain `.univ`, given
|
||
codomain. The eval roundtrip fires the constant-line → hcomp
|
||
path. **Note**: this case uses a generated dim `$rd_hcomp`
|
||
because the original dim binder is discarded by `vHCompFun`.
|
||
· `vTubeApp tube arg` — represents `λj. (tube @ j) arg`. Uses a
|
||
generated dim `$rd_tube`. -/
|
||
@[implemented_by readbackRust]
|
||
partial def readback : CVal → CTerm
|
||
| .vneu n => readbackNeu n
|
||
| .vlam env x body =>
|
||
.lam x (readback (eval (env.extend x (.vneu (.nvar x))) body))
|
||
| .vplam env i body =>
|
||
.plam i (readback (eval env body))
|
||
| .vTranspFun i domA codA φ f =>
|
||
.transp i (.pi domA codA) φ (readback f)
|
||
| .vCompFun _env i domA codA φ u t =>
|
||
.comp i (.pi domA codA) φ u t
|
||
| .vHCompFun codA φ tube base =>
|
||
-- Use a hygienic fresh dim; the type (.pi .univ codA) is
|
||
-- dim-absent on this binder, so eval routes via the constant-line
|
||
-- → hcomp path and reconstructs `vHCompFun`.
|
||
let fd : DimVar := ⟨"$rd_hcomp"⟩
|
||
.comp fd (.pi .univ codA) φ (readback tube) (readback base)
|
||
| .vTubeApp tube arg =>
|
||
let fd : DimVar := ⟨"$rd_tube"⟩
|
||
.plam fd (.app (.papp (readback tube) (.var fd)) (readback arg))
|
||
| .vPathTransp _env i A a b φ p =>
|
||
match p with
|
||
| .plam j body =>
|
||
-- General T4 (path-line case): transport of a plam through a
|
||
-- varying path-type line is itself a plam. The body witness
|
||
-- captures the CCHM §5.5 reduction's structural shape — a
|
||
-- multi-clause comp in `A` carrying the original body and the
|
||
-- two endpoint constraints (j=0 ↦ a, j=1 ↦ b) under face φ.
|
||
-- The Rust backend's full reduction may produce a definitionally
|
||
-- distinct (but propositionally equal) body; T4 is existential
|
||
-- so any concrete witness suffices.
|
||
.plam j
|
||
(.compN i A
|
||
[(φ, body), (.eq0 j, a), (.eq1 j, b)]
|
||
body)
|
||
| _ =>
|
||
.transp i (.path A a b) φ p
|
||
| .vpair a b => .pair (readback a) (readback b)
|
||
|
||
/-- Readback a `CNeu` into a `CTerm`. Straightforward structural
|
||
recursion: each neutral constructor has a syntactic counterpart.
|
||
For `nhcomp` (which discards the original binder), we generate a
|
||
fresh dim `$rd_nhcomp` — same pattern as `vHCompFun`. -/
|
||
@[implemented_by readbackNeuRust]
|
||
partial def readbackNeu : CNeu → CTerm
|
||
| .nvar x => .var x
|
||
| .napp n arg => .app (readbackNeu n) (readback arg)
|
||
| .npapp n r => .papp (readbackNeu n) r
|
||
| .ntransp i A φ v => .transp i A φ (readback v)
|
||
| .ncomp i A φ u t => .comp i A φ (readback u) (readback t)
|
||
| .nhcomp A φ tube base =>
|
||
let fd : DimVar := ⟨"$rd_nhcomp"⟩
|
||
.comp fd A φ (readback tube) (readback base)
|
||
| .ncompN _env i A clauses t =>
|
||
.compN i A
|
||
(clauses.map (fun p => (p.1, readback p.2)))
|
||
(readback t)
|
||
| .nglueIn φ t a => .glueIn φ (readback t) (readback a)
|
||
| .nunglue φ f g => .unglue φ (readback f) (readback g)
|
||
| .nfst n => .fst (readbackNeu n)
|
||
| .nsnd n => .snd (readbackNeu n)
|
||
end
|
||
|
||
-- ── Convenience wrapper ─────────────────────────────────────────────────────
|
||
|
||
namespace CTerm
|
||
|
||
/-- Normalise a term via NbE: evaluate under the empty environment and
|
||
read back. This is the definition used by the step↔eval bridge:
|
||
the future `step` will be exactly this composition. -/
|
||
def readback (t : CTerm) : CTerm := _root_.readback (eval .nil t)
|
||
|
||
end CTerm
|
||
|
||
/-!
|
||
## Reduction axioms
|
||
|
||
One axiom per reducing match arm of `readback` / `readbackNeu`. Mirrors
|
||
the `eval_*` axiom pattern in `Eval.lean`. The arms are disjoint
|
||
(ordered pattern match on the CVal/CNeu constructor), so the axiom set
|
||
is consistent.
|
||
-/
|
||
|
||
-- ── readback axioms ────────────────────────────────────────────────────────
|
||
|
||
axiom readback_vneu (n : CNeu) :
|
||
readback (.vneu n) = readbackNeu n
|
||
|
||
axiom readback_vlam (env : CEnv) (x : String) (body : CTerm) :
|
||
readback (.vlam env x body) =
|
||
.lam x (readback (eval (env.extend x (.vneu (.nvar x))) body))
|
||
|
||
axiom readback_vplam (env : CEnv) (i : DimVar) (body : CTerm) :
|
||
readback (.vplam env i body) =
|
||
.plam i (readback (eval env body))
|
||
|
||
axiom readback_vTranspFun (i : DimVar) (domA codA : CType)
|
||
(φ : FaceFormula) (f : CVal) :
|
||
readback (.vTranspFun i domA codA φ f) =
|
||
.transp i (.pi domA codA) φ (readback f)
|
||
|
||
axiom readback_vCompFun (env : CEnv) (i : DimVar)
|
||
(domA codA : CType) (φ : FaceFormula) (u t : CTerm) :
|
||
readback (.vCompFun env i domA codA φ u t) =
|
||
.comp i (.pi domA codA) φ u t
|
||
|
||
axiom readback_vHCompFun (codA : CType) (φ : FaceFormula)
|
||
(tube base : CVal) :
|
||
readback (.vHCompFun codA φ tube base) =
|
||
.comp ⟨"$rd_hcomp"⟩ (.pi .univ codA) φ (readback tube) (readback base)
|
||
|
||
axiom readback_vTubeApp (tube arg : CVal) :
|
||
readback (.vTubeApp tube arg) =
|
||
.plam ⟨"$rd_tube"⟩
|
||
(.app (.papp (readback tube) (.var ⟨"$rd_tube"⟩)) (readback arg))
|
||
|
||
/-- `readback_vPathTransp` — `.plam` arm. Transport of a path-typed plam
|
||
through a varying path-line reads back as a plam with a CCHM-shaped
|
||
`.compN` witness body. Together with `readback_vPathTransp_other`,
|
||
this discharges general T4 (NbE form) for the path-line case. -/
|
||
axiom readback_vPathTransp_plam (env : CEnv) (i : DimVar) (A : CType)
|
||
(a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm) :
|
||
readback (.vPathTransp env i A a b φ (.plam j body)) =
|
||
.plam j
|
||
(.compN i A
|
||
[(φ, body), (.eq0 j, a), (.eq1 j, b)]
|
||
body)
|
||
|
||
/-- `readback_vPathTransp` — fallback arm. When the inner term is not
|
||
a plam, preserve the original `.transp` form. Face-disjoint from the
|
||
`_plam` arm by the explicit precondition. -/
|
||
axiom readback_vPathTransp_other (env : CEnv) (i : DimVar) (A : CType)
|
||
(a b : CTerm) (φ : FaceFormula) (p : CTerm)
|
||
(hp : ∀ j body, p ≠ .plam j body) :
|
||
readback (.vPathTransp env i A a b φ p) =
|
||
.transp i (.path A a b) φ p
|
||
|
||
-- ── readbackNeu axioms ─────────────────────────────────────────────────────
|
||
|
||
axiom readbackNeu_nvar (x : String) :
|
||
readbackNeu (.nvar x) = .var x
|
||
|
||
axiom readbackNeu_napp (n : CNeu) (arg : CVal) :
|
||
readbackNeu (.napp n arg) = .app (readbackNeu n) (readback arg)
|
||
|
||
axiom readbackNeu_npapp (n : CNeu) (r : DimExpr) :
|
||
readbackNeu (.npapp n r) = .papp (readbackNeu n) r
|
||
|
||
axiom readbackNeu_ntransp (i : DimVar) (A : CType) (φ : FaceFormula)
|
||
(v : CVal) :
|
||
readbackNeu (.ntransp i A φ v) = .transp i A φ (readback v)
|
||
|
||
axiom readbackNeu_ncomp (i : DimVar) (A : CType) (φ : FaceFormula)
|
||
(u t : CVal) :
|
||
readbackNeu (.ncomp i A φ u t) =
|
||
.comp i A φ (readback u) (readback t)
|
||
|
||
axiom readbackNeu_nhcomp (A : CType) (φ : FaceFormula) (tube base : CVal) :
|
||
readbackNeu (.nhcomp A φ tube base) =
|
||
.comp ⟨"$rd_nhcomp"⟩ A φ (readback tube) (readback base)
|
||
|
||
axiom readbackNeu_ncompN (env : CEnv) (i : DimVar) (A : CType)
|
||
(clauses : List (FaceFormula × CVal)) (t : CVal) :
|
||
readbackNeu (.ncompN env i A clauses t) =
|
||
.compN i A
|
||
(clauses.map (fun p => (p.1, readback p.2)))
|
||
(readback t)
|
||
|
||
axiom readbackNeu_nglueIn (φ : FaceFormula) (t a : CVal) :
|
||
readbackNeu (.nglueIn φ t a) =
|
||
.glueIn φ (readback t) (readback a)
|
||
|
||
axiom readbackNeu_nunglue (φ : FaceFormula) (f g : CVal) :
|
||
readbackNeu (.nunglue φ f g) =
|
||
.unglue φ (readback f) (readback g)
|
||
|
||
axiom readback_vpair (a b : CVal) :
|
||
readback (.vpair a b) = .pair (readback a) (readback b)
|
||
|
||
axiom readbackNeu_nfst (n : CNeu) :
|
||
readbackNeu (.nfst n) = .fst (readbackNeu n)
|
||
|
||
axiom readbackNeu_nsnd (n : CNeu) :
|
||
readbackNeu (.nsnd n) = .snd (readbackNeu n)
|
||
|
||
-- ── CTerm.readback definitional lemma ───────────────────────────────────────
|
||
|
||
theorem CTerm.readback_def (t : CTerm) :
|
||
CTerm.readback t = _root_.readback (eval .nil t) := rfl
|
||
|
||
/-!
|
||
## Correspondence lemmas (Session 2)
|
||
|
||
Foundational lemmas relating `readback` and `eval` on canonical forms.
|
||
These are the stepping stones to deriving step-level axioms in Session 3.
|
||
|
||
The key theorem we want: `CTerm.readback t = t'` where t' is some
|
||
canonical normal form of t. For closed neutrals in the λ-fragment, t' = t
|
||
itself. For β-redexes, t' is the reduced form.
|
||
-/
|
||
|
||
-- Free variable — readback of the neutral yields the original var.
|
||
theorem readback_nvar (x : String) :
|
||
readback (.vneu (.nvar x)) = .var x := by
|
||
rw [readback_vneu, readbackNeu_nvar]
|
||
|
||
-- Free variable evaluates-then-reads-back to itself.
|
||
theorem CTerm.readback_var (x : String) :
|
||
CTerm.readback (.var x) = .var x := by
|
||
show _root_.readback (eval .nil (.var x)) = _
|
||
rw [eval_var]
|
||
simp only [CEnv.lookup_nil, Option.getD]
|
||
exact readback_nvar x
|
||
|
||
-- Abstraction preserves its binder name and reads back the body under
|
||
-- the proper binder-extension env.
|
||
theorem CTerm.readback_lam (x : String) (body : CTerm) :
|
||
CTerm.readback (.lam x body) =
|
||
.lam x (_root_.readback (eval (CEnv.nil.extend x (.vneu (.nvar x))) body)) := by
|
||
show _root_.readback (eval .nil (.lam x body)) = _
|
||
rw [eval_lam, readback_vlam]
|
||
|
||
-- Dim-abstraction similarly preserves its binder.
|
||
theorem CTerm.readback_plam (i : DimVar) (body : CTerm) :
|
||
CTerm.readback (.plam i body) =
|
||
.plam i (_root_.readback (eval .nil body)) := by
|
||
show _root_.readback (eval .nil (.plam i body)) = _
|
||
rw [eval_plam, readback_vplam]
|
||
|
||
/-!
|
||
## NbE analogues of the step-level axioms (Session 3)
|
||
|
||
With `CTerm.readback := readback ∘ eval .nil` and the original-binder
|
||
preservation discipline, each of the existing step-level axioms has a
|
||
direct NbE-level counterpart. Every proof is a single `rw` chain:
|
||
apply the corresponding eval-level axiom to unify the two sides'
|
||
evaluated values, and the outer readback then matches.
|
||
|
||
These theorems are the concrete promise of the step↔eval bridge: they
|
||
replace axioms T1, T2, C1, C2, `step_papp_plam` (and ultimately T3–T5,
|
||
C4 once the subject-reduction bits of the correspondence are worked
|
||
out) with Lean theorems. The Rust backend's obligation for each
|
||
step-level axiom disappears — it only needs to implement `eval` and
|
||
`readback` faithfully.
|
||
-/
|
||
|
||
/-- **step_papp_plam under NbE.** Path β holds at the NbE level:
|
||
`.papp (.plam i body) r` normalises to the same term as
|
||
`body.substDim i r`. -/
|
||
theorem CTerm.readback_papp_plam (i : DimVar) (body : CTerm) (r : DimExpr) :
|
||
CTerm.readback (.papp (.plam i body) r) =
|
||
CTerm.readback (body.substDim i r) := by
|
||
show _root_.readback (eval .nil (.papp (.plam i body) r)) =
|
||
_root_.readback (eval .nil (body.substDim i r))
|
||
rw [eval_papp, eval_plam, vPApp_vplam]
|
||
|
||
/-- **T1 under NbE.** Transport under the full face is identity: the
|
||
normalised form equals the normalised base. -/
|
||
theorem CTerm.readback_transp_id (L : DimLine) (t : CTerm) :
|
||
CTerm.readback (.transp L.binder L.body .top t) = CTerm.readback t := by
|
||
show _root_.readback (eval .nil (.transp L.binder L.body .top t)) =
|
||
_root_.readback (eval .nil t)
|
||
rw [eval_transp_top]
|
||
|
||
/-- **T2 under NbE.** Transport along a constant line is identity, for
|
||
*any* face formula. Proof splits into `.top` (covered by T1) and
|
||
`≠ .top` (covered by eval_transp_const). -/
|
||
theorem CTerm.readback_transp_const_id (i : DimVar) (A : CType)
|
||
(φ : FaceFormula) (t : CTerm) (h : CType.dimAbsent i A = true) :
|
||
CTerm.readback (.transp i A φ t) = CTerm.readback t := by
|
||
show _root_.readback (eval .nil (.transp i A φ t)) =
|
||
_root_.readback (eval .nil t)
|
||
by_cases hφ : φ = .top
|
||
· subst hφ; rw [eval_transp_top]
|
||
· rw [eval_transp_const .nil i A φ t hφ h]
|
||
|
||
/-- **C1 under NbE.** Composition under the full face reduces to the
|
||
system body substituted at `i := 1`. -/
|
||
theorem CTerm.readback_comp_full (L : DimLine) (u t₀ : CTerm) :
|
||
CTerm.readback (.comp L.binder L.body .top u t₀) =
|
||
CTerm.readback (u.substDim L.binder .one) := by
|
||
show _root_.readback (eval .nil (.comp L.binder L.body .top u t₀)) =
|
||
_root_.readback (eval .nil (u.substDim L.binder .one))
|
||
rw [eval_comp_top]
|
||
|
||
/-- **C2 under NbE.** Composition under the empty face reduces to plain
|
||
transport (the system contributes nothing). -/
|
||
theorem CTerm.readback_comp_empty (L : DimLine) (u t₀ : CTerm) :
|
||
CTerm.readback (.comp L.binder L.body .bot u t₀) =
|
||
CTerm.readback (.transp L.binder L.body .bot t₀) := by
|
||
show _root_.readback (eval .nil (.comp L.binder L.body .bot u t₀)) =
|
||
_root_.readback (eval .nil (.transp L.binder L.body .bot t₀))
|
||
rw [eval_comp_bot]
|
||
|
||
/-!
|
||
## Partial T4 coverage (Session 4)
|
||
|
||
The full step-level T4 (`transp_plam_is_plam`) claims: for *any* line
|
||
`L` and *any* face `φ`, transport of a plam produces a plam. This is
|
||
too strong — for a non-path, non-constant line whose body is a Π type,
|
||
transport of a plam stalls into a `vTranspFun`, which reads back as a
|
||
`.transp` term, not a `.plam`.
|
||
|
||
Under NbE, T4 holds cleanly for the two reducing cases: full face
|
||
(T1 fires) and constant line (T2 fires). For the genuinely-stuck
|
||
cases, the plam wrapper is lost. The Rust backend's full implementation
|
||
of transport-on-path-lines would recover the general T4 case — that's
|
||
a discharge obligation for the CCHM §5.5 path-transport reduction,
|
||
which `Cubical/Eval.lean` already partially implements via
|
||
`vPApp_vPathTransp_*`.
|
||
|
||
Below we prove T4's NbE form for the two easy cases; the third
|
||
(genuine-path-line case) is deferred to when `vPathTransp` gets a
|
||
readback-equivalent form.
|
||
-/
|
||
|
||
/-- **T4 at full face (NbE).** Transport under `.top` of a plam is a
|
||
plam — specifically, the original plam's normalised form. -/
|
||
theorem CTerm.readback_transp_plam_top (L : DimLine) (j : DimVar)
|
||
(body : CTerm) :
|
||
∃ body' : CTerm,
|
||
CTerm.readback (.transp L.binder L.body .top (.plam j body)) =
|
||
.plam j body' := by
|
||
refine ⟨_root_.readback (eval .nil body), ?_⟩
|
||
show _root_.readback (eval .nil (.transp L.binder L.body .top (.plam j body))) =
|
||
.plam j _
|
||
rw [eval_transp_top, eval_plam, readback_vplam]
|
||
|
||
/-- **T4 on constant lines (NbE).** When the line body is dim-absent
|
||
from the binder, transport of any plam is a plam for any face. -/
|
||
theorem CTerm.readback_transp_plam_const (L : DimLine) (φ : FaceFormula)
|
||
(j : DimVar) (body : CTerm)
|
||
(h : CType.dimAbsent L.binder L.body = true) :
|
||
∃ body' : CTerm,
|
||
CTerm.readback (.transp L.binder L.body φ (.plam j body)) =
|
||
.plam j body' := by
|
||
refine ⟨_root_.readback (eval .nil body), ?_⟩
|
||
show _root_.readback (eval .nil (.transp L.binder L.body φ (.plam j body))) =
|
||
.plam j _
|
||
by_cases hφ : φ = .top
|
||
· subst hφ; rw [eval_transp_top, eval_plam, readback_vplam]
|
||
· rw [eval_transp_const .nil L.binder L.body φ (.plam j body) hφ h,
|
||
eval_plam, readback_vplam]
|
||
|
||
/-- **T4 on varying path-type lines (NbE).** When the line body is a
|
||
path type that genuinely varies in the binder, transport of any plam
|
||
is a plam — supported by the `.plam`-aware readback for `vPathTransp`.
|
||
|
||
The body witness is structural (`.compN` carrying the original body
|
||
plus the two endpoint-clamp faces); the Rust backend's full CCHM §5.5
|
||
reduction may produce a definitionally distinct but propositionally
|
||
equal body. -/
|
||
theorem CTerm.readback_transp_plam_path (i : DimVar) (A : CType)
|
||
(a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm)
|
||
(hφ : φ ≠ .top)
|
||
(hpath : CType.dimAbsent i (.path A a b) = false) :
|
||
∃ body' : CTerm,
|
||
CTerm.readback (.transp i (.path A a b) φ (.plam j body)) =
|
||
.plam j body' := by
|
||
refine ⟨.compN i A [(φ, body), (.eq0 j, a), (.eq1 j, b)] body, ?_⟩
|
||
show _root_.readback
|
||
(eval .nil (.transp i (.path A a b) φ (.plam j body))) = _
|
||
rw [eval_transp_path .nil i A a b φ (.plam j body) hφ hpath]
|
||
exact readback_vPathTransp_plam .nil i A a b φ j body
|
||
|
||
/-- **T5 under NbE.** Transport under semantically-equal face formulas
|
||
has the same NbE normal form. Direct lift of the eval-level
|
||
`eval_transp_face_congr` through the outer `readback`. -/
|
||
theorem CTerm.readback_transp_face_congr (i : DimVar) (A : CType)
|
||
(φ ψ : FaceFormula) (t : CTerm)
|
||
(h : ∀ ε, φ.eval ε = ψ.eval ε) :
|
||
CTerm.readback (.transp i A φ t) = CTerm.readback (.transp i A ψ t) := by
|
||
show _root_.readback (eval .nil (.transp i A φ t)) =
|
||
_root_.readback (eval .nil (.transp i A ψ t))
|
||
rw [eval_transp_face_congr .nil i A φ ψ t h]
|
||
|
||
/-- **General T4 (NbE) for path-typed transport lines.** Combines the
|
||
full-face, constant-line, and varying-path-line cases into a single
|
||
statement parameterised on a path-typed line body. This covers every
|
||
well-typed input shape, since transport of `.plam j body` is only
|
||
well-typed when the line body is itself a path type (otherwise the
|
||
transport input is at a non-path type and the plam is a type error).
|
||
|
||
For non-path varying line bodies (`.pi`, `.glue`, `.univ`-but-non-
|
||
constant — the last is impossible since `.univ` always has
|
||
`dimAbsent = true`), the `transp_plam_is_plam` step axiom remains
|
||
the only formal handle; those cases are vacuous in well-typed code. -/
|
||
theorem CTerm.readback_transp_plam_general (i : DimVar) (A : CType)
|
||
(a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm) :
|
||
∃ body' : CTerm,
|
||
CTerm.readback (.transp i (.path A a b) φ (.plam j body)) =
|
||
.plam j body' := by
|
||
by_cases hφ : φ = .top
|
||
· subst hφ
|
||
exact CTerm.readback_transp_plam_top
|
||
⟨i, .path A a b⟩ j body
|
||
· by_cases hA : CType.dimAbsent i (.path A a b) = true
|
||
· exact CTerm.readback_transp_plam_const
|
||
⟨i, .path A a b⟩ φ j body hA
|
||
· have hpath : CType.dimAbsent i (.path A a b) = false := by
|
||
cases hAv : CType.dimAbsent i (.path A a b)
|
||
· rfl
|
||
· exact absurd hAv hA
|
||
exact CTerm.readback_transp_plam_path i A a b φ j body hφ hpath
|
||
|
||
/-!
|
||
## Deferred to Session 5+ or later
|
||
|
||
The remaining step-level axioms require machinery beyond the scope of
|
||
the core bridge:
|
||
|
||
- **T3 `transp_step_preserves`** and **C4 `comp_step_preserves`**
|
||
(subject reduction): these relate `HasType` to `CTerm.step`. Their
|
||
NbE analogues require proofs that (a) `eval` preserves typing
|
||
up to a semantic typing relation on `CVal`, and (b) `readback`
|
||
preserves that semantic typing. Neither is currently in the codebase;
|
||
they're a separate ~two-session formalisation effort.
|
||
|
||
- **General T4 on non-path varying lines**: vacuous for well-typed
|
||
code (transport input at a non-path type cannot be a `.plam`), so
|
||
the path-line coverage above is complete for the cases that matter.
|
||
The step-level `transp_plam_is_plam` axiom in `TransportLaws.lean`
|
||
retains its broader claim for any potential ill-typed-but-syntactic
|
||
consumers.
|
||
|
||
- **T5** is now NbE-covered via the eval-level `eval_transp_face_congr`
|
||
axiom (Stream B #2b) — the step-level form was unused and removed.
|
||
-/
|
||
|
||
/-!
|
||
## Sanity tests
|
||
|
||
Basic tests verifying that the axiom chain is end-to-end usable for
|
||
equational reasoning. These now exercise the original-binder discipline
|
||
rather than the earlier fresh-name scheme.
|
||
-/
|
||
|
||
namespace ReadbackTest
|
||
|
||
/-- Identity lambda reads back AS ITSELF — no binder renaming. The
|
||
preserved-name discipline makes this a syntactic rfl after the
|
||
eval/readback chain, modulo the env-extension simp. -/
|
||
theorem id_lambda_readback :
|
||
CTerm.readback (CTerm.lam "x" (.var "x")) =
|
||
CTerm.lam "x" (.var "x") := by
|
||
rw [CTerm.readback_lam]
|
||
-- Goal: .lam "x" (readback (eval (env') (.var "x"))) = .lam "x" (.var "x")
|
||
-- where env' = CEnv.nil.extend "x" (.vneu (.nvar "x"))
|
||
rw [eval_var, CEnv.extend_lookup_hit]
|
||
simp only [Option.getD]
|
||
rw [readback_nvar]
|
||
|
||
/-- Constant function reads back preserving both the binder name AND
|
||
the free variable in the body (no capture, no renaming). -/
|
||
theorem const_fn_readback :
|
||
CTerm.readback (CTerm.lam "x" (.var "y")) =
|
||
CTerm.lam "x" (.var "y") := by
|
||
rw [CTerm.readback_lam]
|
||
rw [eval_var]
|
||
have h : CEnv.lookup (CEnv.nil.extend "x" (.vneu (.nvar "x"))) "y" = none := by
|
||
rw [CEnv.extend_lookup_miss _ "x" "y" _ (by decide)]
|
||
exact CEnv.lookup_nil "y"
|
||
rw [h]
|
||
simp only [Option.getD]
|
||
rw [readback_nvar]
|
||
|
||
/-- Dim-abstraction also preserves its binder name. -/
|
||
theorem dim_abstraction_readback (i : DimVar) (x : String) :
|
||
CTerm.readback (.plam i (.var x)) =
|
||
.plam i (.var x) := by
|
||
rw [CTerm.readback_plam]
|
||
rw [eval_var]
|
||
simp only [CEnv.lookup_nil, Option.getD]
|
||
rw [readback_nvar]
|
||
|
||
end ReadbackTest
|