cubical-transport-hott-lean4/CubicalTransport/Readback.lean

/-
  CubicalTransport.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 "cubical_transport_readback"]
opaque readbackRust : CVal → CTerm

@[extern "cubical_transport_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 "_" (CType.univ (ℓ := .zero)) 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)
    -- REL1 inductive-type values.
    | .vctor S c params args =>
        .ctor S c params (args.map readback)
    | .vdimExpr r => .dimExpr r
    -- Universe-code value: read back as the encoder constructor.
    | .vcode A => .code A
    -- Modal-introduction value: structural readback of the wrapped value,
    -- preserving the modality kind.
    | .vModalIntro k a => .modalIntro k (readback a)

  /-- 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)
    -- REL1 inductive-eliminator stuck form.
    | .nIndElim S params motive branches target =>
        .indElim S params (readback motive)
          (branches.map (fun p => (p.1, readback p.2)))
          (readbackNeu target)
    -- Modal-elimination stuck form: rebuild the elim term with the
    -- read-back eliminator function and the read-back stuck scrutinee,
    -- preserving the modality kind.
    | .nModalElim k f n => .modalElim k (readback f) (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 {ℓ ℓ' : ULevel} (i : DimVar)
    (domA : CType ℓ) (codA : CType ℓ')
    (φ : FaceFormula) (f : CVal) :
    readback (.vTranspFun i domA codA φ f) =
    .transp i (.pi "_" domA codA) φ (readback f)

axiom readback_vCompFun {ℓ ℓ' : ULevel} (env : CEnv) (i : DimVar)
    (domA : CType ℓ) (codA : CType ℓ') (φ : FaceFormula) (u t : CTerm) :
    readback (.vCompFun env i domA codA φ u t) =
    .comp i (.pi "_" domA codA) φ u t

axiom readback_vHCompFun {ℓ : ULevel} (codA : CType ℓ) (φ : FaceFormula)
    (tube base : CVal) :
    readback (.vHCompFun codA φ tube base) =
    .comp ⟨"$rd_hcomp"⟩ (.pi "_" (CType.univ (ℓ := .zero)) 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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula)
    (v : CVal) :
    readbackNeu (.ntransp i A φ v) = .transp i A φ (readback v)

axiom readbackNeu_ncomp {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula)
    (u t : CVal) :
    readbackNeu (.ncomp i A φ u t) =
    .comp i A φ (readback u) (readback t)

axiom readbackNeu_nhcomp {ℓ : ULevel} (A : CType ℓ) (φ : FaceFormula) (tube base : CVal) :
    readbackNeu (.nhcomp A φ tube base) =
    .comp ⟨"$rd_nhcomp"⟩ A φ (readback tube) (readback base)

axiom readbackNeu_ncompN {ℓ : ULevel} (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)

/-- Universe-code readback: a `vcode A` value reads back as the
    encoder constructor `.code A`, preserving the underlying CType. -/
axiom readback_vcode {ℓ : ULevel} (A : CType ℓ) :
    readback (.vcode A) = .code A

-- Modal-introduction readback axiom (Refactor Phase 2).

axiom readback_vModalIntro (k : ModalityKind) (a : CVal) :
    readback (.vModalIntro k a) = .modalIntro k (readback a)

-- Modal-elimination (stuck) readback axiom (Refactor Phase 2).

axiom readbackNeu_nModalElim (k : ModalityKind) (f : CVal) (n : CNeu) :
    readbackNeu (.nModalElim k f n) = .modalElim k (readback f) (readbackNeu n)

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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (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 {ℓ : ULevel} (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