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

/-
  Topolei.Cubical.Glue
  ====================
  The `Glue` type former and univalence-via-glue construction (cells-spec
  §5.7, Phase 1 Week 5).

  The `.glue` constructor is declared in `Cubical/Syntax.lean` (it must live
  alongside `CType` / `CTerm` in the mutual inductive block); this module
  provides the *use-site* machinery:

    · `EquivData.toGlueType` — ergonomic wrapper turning an `EquivData`
      into a `.glue` CType.

    · `uaLine` — the CCHM univalence line, a function from `DimExpr` to
      `CType` giving the glued type at a given dim.  We use a
      *single-face* glue (`dimExprEq0 r ↦ (A, e)` with B as the base),
      which produces `A` at `r = 0` (face fires, `.top`) and `B` at
      `r = 1` (face vacuous, `.bot`).  This is the simplified ua that
      single-face Glue supports; CCHM's two-face symmetric form using
      `[i=0 ↦ (A, e), i=1 ↦ (B, idEquiv)]` would need multi-face Glue
      (deferred — see §5.7 comment below).

    · Endpoint rfl-lemmas: `uaLine_zero`, `uaLine_one` — syntactic
      reductions at the dim-endpoints.

    · `uaLine_zero_glueIn_reduces` / `uaLine_zero_unglue_reduces`:
      content lemmas demonstrating that the endpoint glue types behave
      *computationally* like `A` (at `r = 0`) and `B` (at `r = 1`),
      derived from the face-disjoint axioms in `Eval.lean`.

  Downstream: `Cubical/Soundness.lean` (Week 6) will prove
  `transp_ua : transp (uaLine e A B) .bot a = e.f a` — the computational
  content of univalence — by combining `uaLine_zero_glueIn_reduces`
  with the transport rules for `.glue` (yet to be added; see "Deferred"
  below).

  ## What's intentionally deferred (Phase 1 Week 5 scope)

  1. **Transport of Glue types.**  `CTerm.transp i (.glue …) φ t` has no
     dedicated reduction rule yet.  Adding one requires the CCHM Glue
     transport formula (which involves the equivalence's half-adjoint
     structure), and is Week 6 material.

  2. **Multi-face Glue.**  `CType.glue` carries a single face; CCHM's
     ua-as-two-face-glue would need either a `.glueN` constructor or an
     encoding via iterated single-face glue.  The single-face ua here
     (`Glue [r=0 ↦ (A, e)] B`) is semantically equivalent.

  3. **Type-as-term injection.**  Lean's `CType` and `CTerm` are
     disjoint.  A proper `ua : EquivData → CType → CType → CTerm` with
     `ua e A B : Path U A B` would require embedding `CType` into `CTerm`
     (e.g., a `CTerm.ty : CType → CTerm` injection).  We work at the
     CType-function level (`DimExpr → CType`) instead.
-/

import CubicalTransport.Eval
import CubicalTransport.Equiv

-- ── Ergonomic glue-type construction from EquivData ─────────────────────────

namespace EquivData

/-- Build a `.glue` CType from an `EquivData` and the accompanying face /
    T-type / A-type data.  Inlines the equivalence's five CTerms into the
    `.glue` constructor slots. -/
def toGlueType (φ : FaceFormula) (T : CType) (e : EquivData) (A : CType) :
    CType :=
  .glue φ T e.f e.fInv e.sec e.ret e.coh A

theorem toGlueType_def (φ : FaceFormula) (T : CType) (e : EquivData)
    (A : CType) :
    e.toGlueType φ T A = .glue φ T e.f e.fInv e.sec e.ret e.coh A := rfl

end EquivData

-- ── Univalence line ─────────────────────────────────────────────────────────

/-- The single-face CCHM univalence line.  Given an equivalence `e : A ≃ B`
    and two types `A`, `B`, returns a function `DimExpr → CType`:

      uaLine e A B r := Glue [r = 0 ↦ (A, e)] B

    Endpoint behaviour (via `FaceFormula.dimExprEq0`):
      · `r = 0` →  face is `.top`, Glue = A (through `e`).
      · `r = 1` →  face is `.bot`, Glue = B.
      · generic dim k → face is `.eq0 k`, Glue is a "genuinely glued" type.

    Path semantics (sketch): inhabitants of `uaLine e A B` form a path
    between A and B in the universe.  The full theorem
    `uaLine .zero ≃ A`, `uaLine .one ≃ B` is captured computationally by
    the `glueIn`/`unglue` reduction axioms; it is not stated as a CType
    equality because `.glue .top A ... B ≠ A` *structurally*. -/
def uaLine (e : EquivData) (A B : CType) (r : DimExpr) : CType :=
  e.toGlueType (FaceFormula.dimExprEq0 r) A B

-- ── Endpoint rfl-lemmas ─────────────────────────────────────────────────────

/-- At the left dim-endpoint, the face is `.top` (because
    `dimExprEq0 .zero = .top`), so `uaLine e A B .zero` is the glue type
    whose face is full.  Inhabitants there behave like A via
    `eval_glueIn_top` / `eval_unglue_top`. -/
theorem uaLine_zero (e : EquivData) (A B : CType) :
    uaLine e A B .zero =
    e.toGlueType .top A B := by
  show e.toGlueType (FaceFormula.dimExprEq0 .zero) A B = e.toGlueType .top A B
  rfl

/-- At the right dim-endpoint, the face is `.bot` (because
    `dimExprEq0 .one = .bot`), so `uaLine e A B .one` is the glue type
    whose face is empty.  Inhabitants there behave like B via
    `eval_glueIn_bot` / `eval_unglue_bot`. -/
theorem uaLine_one (e : EquivData) (A B : CType) :
    uaLine e A B .one =
    e.toGlueType .bot A B := by
  show e.toGlueType (FaceFormula.dimExprEq0 .one) A B = e.toGlueType .bot A B
  rfl

/-- At a generic dim variable `k`, the face is `.eq0 k` — neither trivial.
    The glue is genuinely non-degenerate and produces stuck `nglueIn` /
    `nunglue` neutrals under `eval`. -/
theorem uaLine_var (e : EquivData) (A B : CType) (k : DimVar) :
    uaLine e A B (.var k) =
    e.toGlueType (.eq0 k) A B := by
  show e.toGlueType (FaceFormula.dimExprEq0 (.var k)) A B =
    e.toGlueType (.eq0 k) A B
  rfl

-- ── Endpoint content: computational univalence at the endpoints ──────────────

/-- At the `r = 0` endpoint, `glueIn` collapses to the T-side argument.
    This is the forward direction of "uaLine at 0 behaves like A":
    given `t : A`, `glueIn [.top ↦ t] a` evaluates to the same value as
    `t` (the A-side `a` is irrelevant under the full face). -/
theorem uaLine_zero_glueIn_reduces (env : CEnv) (t a : CTerm) :
    eval env (.glueIn .top t a) = eval env t :=
  eval_glueIn_top env t a

/-- At the `r = 0` endpoint, `unglue` is the forward map applied.
    Given the equivalence's `f` and a T-value `g`, unglue at the full
    face evaluates to `f g`.  This is the content of "T ≃ A via e". -/
theorem uaLine_zero_unglue_reduces (env : CEnv) (f g : CTerm) :
    eval env (.unglue .top f g) = vApp (eval env f) (eval env g) :=
  eval_unglue_top env f g

/-- At the `r = 1` endpoint, `glueIn` collapses to the A-side argument.
    This is the reverse direction: given `a : B` (the base type), the
    glue `[.bot ↦ t] a` is just `a` (the T-side is irrelevant under the
    empty face). -/
theorem uaLine_one_glueIn_reduces (env : CEnv) (t a : CTerm) :
    eval env (.glueIn .bot t a) = eval env a :=
  eval_glueIn_bot env t a

/-- At the `r = 1` endpoint, `unglue` is the identity.  On the empty
    face, the glued term is already a B-value; unglue returns it
    unchanged. -/
theorem uaLine_one_unglue_reduces (env : CEnv) (f g : CTerm) :
    eval env (.unglue .bot f g) = eval env g :=
  eval_unglue_bot env f g

-- ── Identity equivalence: uaLine of idEquiv is a constant line ───────────────

/-- `uaLine (idEquiv A) A A` reduces at both endpoints to a glue of A
    with A.  The sec / ret fields are from `idEquiv A`; the face toggle
    is between `.top` and `.bot`.  Not a *fully* constant line (the face
    formula varies), but the underlying types are the same. -/
theorem uaLine_idEquiv_zero_type (A : CType) :
    uaLine (idEquiv A) A A .zero =
    .glue .top A (idEquiv A).f (idEquiv A).fInv
      (idEquiv A).sec (idEquiv A).ret (idEquiv A).coh A := by
  rw [uaLine_zero]
  rfl

theorem uaLine_idEquiv_one_type (A : CType) :
    uaLine (idEquiv A) A A .one =
    .glue .bot A (idEquiv A).f (idEquiv A).fInv
      (idEquiv A).sec (idEquiv A).ret (idEquiv A).coh A := by
  rw [uaLine_one]
  rfl

-- ── CCHM Glue transport rules (constant-component fragment) ────────────────
--
-- The full CCHM §6.2 Glue transport formula is complex (involves an outer
-- comp/fill through the base type and an hcomp-corrected T-side witness
-- built from the equivalence's half-adjoint structure).  We state the
-- formula as a family of face-disjoint axioms covering the sub-cases that
-- arise in well-scoped user code — equivalences are always external to the
-- transport binder, so the T, A, f, fInv, sec, ret, coh components are
-- dim-absent from `i`.  The only piece allowed to mention `i` is the inner
-- face formula `φ`.
--
-- Three sub-cases of `φ.substDim i .one` (the inner face restricted to the
-- outgoing endpoint):
--   · `.bot` — the T-side glueIn witness at `i = 1` is vacuous; the result
--     is a pure A-value.  Covered by `eval_transp_glue_const_at_bot`.
--   · `.top` — the T-side witness is forced; the result is the T-side
--     preimage of the transported A-value under `fInv`.  Covered by
--     `eval_transp_glue_const_at_top`.
--   · Neither — the result is a structured stuck neutral preserving all
--     glue data for later substitution to unstick.  Covered by
--     `eval_transp_glue_const_stuck`.
--
-- The three face-disjoint preconditions (φ.substDim i .one = .bot / = .top
-- / otherwise) partition the problem, so adding more axioms here never
-- risks inconsistency.

/-- **CCHM Glue transport — constant components, inner face collapses at 1.**

    Transport along a `.glue` line where:
      · The fiber type `T`, base type `A`, and the five equivalence CTerms
        (`f`, `fInv`, `sec`, `ret`, `coh`) are all dim-absent from the line
        binder `i`.
      · The outer face `ψ` is non-`.top` (else T1 fires and transport is
        identity).
      · The inner glue face `φ`, restricted to `i := 1`, collapses to `.bot`
        (so no T-side witness is required at the outgoing endpoint).

    Under these conditions the full CCHM Glue-transport formula (CCHM §6.2)
    degenerates:

      1. The outer comp/fill through the base type `A` reduces to a plain
         transport.  (For constant `A` this further reduces to identity via
         T2, though the axiom does not pre-apply T2 so that downstream
         proofs can choose when to use it.)
      2. The T-side glueIn witness at `i = 1` lives on an empty face and is
         therefore irrelevant — the outer `glueIn` collapses to its A-side.
      3. The A-side value is obtained by unglueing the base at the `i = 0`
         face of the glue (`φ.substDim i .zero`).

    Combining, transport reduces to `transp i A ψ (unglue (φ[i:=0]) f t)`.

    **Discharge obligation.** The Rust evaluator's implementation of the
    full CCHM Glue-transport rule must reduce to this equation in the
    restricted setting captured by the hypotheses. -/
axiom eval_transp_glue_const_at_bot
    (env : CEnv) (i : DimVar)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hA : A.dimAbsent i = true)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1 : φ.substDim i .one = .bot) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    eval env (.transp i A ψ (.unglue (φ.substDim i .zero) f t))

/-- **CCHM Glue transport — constant components, inner face collapses to `.top` at 1.**

    Transport along a `.glue` line where:
      · The fiber type `T`, base type `A`, and the five equivalence CTerms
        (`f`, `fInv`, `sec`, `ret`, `coh`) are all dim-absent from the line
        binder `i`.
      · The outer face `ψ` is non-`.top` (else T1 fires and transport is
        identity).
      · The inner glue face `φ`, restricted to `i := 1`, collapses to `.top`
        — the T-side witness is forced at the outgoing endpoint.

    Under these conditions the full CCHM Glue-transport formula (CCHM §6.2)
    produces a value whose output glue face `φ[i:=1]` is `.top`, i.e. a
    T-forced inhabitant.  In our `.glueIn`-free form this is the result of
    applying `fInv` to the A-side transport:

      1. `a₁ := transp i A ψ (unglue (φ[i:=0]) f t)` — the A-side of the
         transported value (same construction as `_at_bot`).
      2. `t₁ := app fInv a₁` — the T-side witness obtained via the
         equivalence inverse.

    Combining, transport reduces to `app fInv (transp i A ψ (unglue (φ[i:=0]) f t))`.

    **Hcomp correction note.** The full CCHM formula includes an hcomp in
    `T` using `sec` to enforce boundary agreement of `t₁` with `t[i:=1]`
    on face `ψ`.  Under the constant-component hypotheses this hcomp's
    boundary obligations match `t₁ = fInv a₁` up to the equivalence's
    propositional coherence (`sec (f t₁) : Path A (f (fInv a₁)) a₁`),
    which is the well-typedness obligation a caller already discharges
    when constructing an inhabitant of the glue type.  The axiom therefore
    states the principal T-side witness directly; a future refinement can
    add the hcomp wrapper once T-side hcomp infrastructure is in place.

    **Discharge obligation.** The Rust evaluator's implementation of the
    full CCHM Glue-transport rule must reduce to this equation in the
    restricted setting captured by the hypotheses. -/
axiom eval_transp_glue_const_at_top
    (env : CEnv) (i : DimVar)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hA : A.dimAbsent i = true)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1 : φ.substDim i .one = .top) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    eval env (.app fInv (.transp i A ψ (.unglue (φ.substDim i .zero) f t)))

/-- **CCHM Glue transport — constant components, inner face stuck at 1.**

    When the inner glue face `φ` restricted to `i := 1` is neither `.top`
    (handled by `eval_transp_glue_const_at_top` — forces a specific T-side
    witness via `fInv`) nor `.bot` (handled by `eval_transp_glue_const_at_bot`
    — collapses to the A-side), the transport produces a structured stuck
    neutral preserving all glue data.

    **Why structured, not full reduction.** The CCHM formula in this case
    still computes a specific `glueIn[φ(1) ↦ t₁] a₁` with a partial T-side
    witness depending on `φ(1)`.  Later dim substitution into `φ` can
    resolve `φ(1)` to `.top` or `.bot`, at which point the structured
    neutral can be unstuck by re-evaluating through the appropriate
    face-disjoint axiom (`_at_top` or `_at_bot`).  Stating the exact `t₁`
    witness for the residual face requires the half-adjoint hcomp
    construction, which is future work — until then, this axiom reflects
    the partial def's runtime behavior (same stuck form `vTransp` would
    produce).

    This axiom is face-disjoint from both `eval_transp_glue_const_at_bot`
    (which requires `φ.substDim i .one = .bot`) and
    `eval_transp_glue_const_at_top` (which requires `φ.substDim i .one =
    .top`), so the three axioms partition the precondition space without
    contradiction. -/
axiom eval_transp_glue_const_stuck
    (env : CEnv) (i : DimVar)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hA : A.dimAbsent i = true)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1_bot : φ.substDim i .one ≠ .bot)
    (hφ1_top : φ.substDim i .one ≠ .top) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    .vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t))

-- ── CCHM Glue transport — varying base type A (Stream B #1b, 2026-04-23) ────
--
-- Generalises `_at_bot` / `_at_top` / `_stuck` to allow the base type `A` to
-- vary in the line binder `i`.  All five equivalence components and the
-- fiber type `T` are still required to be dim-absent from `i`
-- (varying-equivalence is Stream B #1c, future work).
--
-- The A-side construction switches from a plain `.transp i A ψ` (which
-- only carries the ψ-boundary) to a two-clause `.compN i A` carrying
-- *both* the ψ-boundary (from the outer transport) and the φ-boundary
-- (from the inner glue's T-fiber).  The two clause bodies are:
--
--   · `(ψ, .unglue φ f t)` — on the outer face ψ, the result agrees
--     with the A-side of the input glue (extracted via `unglue` through
--     the φ-face structure).
--   · `(φ, .app f t)` — on the inner glue face φ, the result agrees
--     with `f` applied to the T-fiber `t`.  These coincide on the
--     overlap by the equivalence's well-typedness (`f t = unglue t` on
--     the φ-face, by `eval_unglue_top` semantics).
--
-- The base of the comp at i=0 is the same as in the constant-A case:
-- `.unglue (φ[i:=0]) f t`.
--
-- Face-disjoint from the constant-A axioms by `hA : A.dimAbsent i = false`
-- (the constant-A axioms require `hA : … = true`); the new three are
-- mutually face-disjoint by the same `φ[i:=1]` partition.

/-- **CCHM Glue transport — varying base type A, inner face collapses to `.bot` at 1.**

    Generalises `eval_transp_glue_const_at_bot` to varying-`A` lines via
    the CCHM §6.2 two-clause comp through the base.  Other components
    (`T`, `f`, `fInv`, `sec`, `ret`, `coh`) remain dim-absent from `i`. -/
axiom eval_transp_glue_varA_at_bot
    (env : CEnv) (i : DimVar)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hA : A.dimAbsent i = false)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1 : φ.substDim i .one = .bot) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    eval env (.compN i A
                [(ψ, .unglue φ f t),
                 (φ, .app f t)]
                (.unglue (φ.substDim i .zero) f t))

/-- **CCHM Glue transport — varying base type A, inner face collapses to `.top` at 1.**

    Generalises `eval_transp_glue_const_at_top` to varying-`A` lines.
    The A-side is built via the same two-clause `.compN` as `_varA_at_bot`;
    the T-side witness is then obtained via `fInv` applied to the A-side.

    Same hcomp-correction caveat as `eval_transp_glue_const_at_top`: the
    full CCHM formula adds a T-side hcomp using `sec` to enforce
    ψ-boundary agreement, which trivialises under the constant-equivalence
    hypotheses up to the equivalence's propositional coherence. -/
axiom eval_transp_glue_varA_at_top
    (env : CEnv) (i : DimVar)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hA : A.dimAbsent i = false)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1 : φ.substDim i .one = .top) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    eval env (.app fInv
      (.compN i A
        [(ψ, .unglue φ f t),
         (φ, .app f t)]
        (.unglue (φ.substDim i .zero) f t)))

/-- **CCHM Glue transport — varying base type A, inner face stuck at 1.**

    Mirrors `eval_transp_glue_const_stuck` for varying-`A`: when the
    inner glue face restricted to the outgoing endpoint is neither
    `.top` nor `.bot`, the transport produces a structured stuck neutral
    preserving all glue data — including the now-varying `A`. -/
axiom eval_transp_glue_varA_stuck
    (env : CEnv) (i : DimVar)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hA : A.dimAbsent i = false)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1_bot : φ.substDim i .one ≠ .bot)
    (hφ1_top : φ.substDim i .one ≠ .top) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    .vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t))

-- ── Hcomp-correction wrappers for _at_top (Stage 2.1, 2026-04-23) ───────────
--
-- The `_at_top` axioms above state the *principal* T-side witness
-- `app fInv a₁` where `a₁` is the A-side construction.  This witness
-- agrees with `t[i:=1]` on face `ψ` only *propositionally* — up to the
-- equivalence's half-adjoint coherence `ret : Π x:T. Path T (fInv (f x)) x`.
--
-- The full CCHM §6.2 formula tightens this to *definitional* ψ-agreement
-- by wrapping the principal witness in an hcomp-in-T whose ψ-clause is
-- the j-line `ret (t[i:=1])` — a T-path from `fInv (f t[i:=1])` at j=0
-- to `t[i:=1]` at j=1.  On ψ, `a₁ = f t[i:=1]` (T2 on the constant A-line
-- plus `unglue`-top semantics), so the hcomp's base `fInv a₁` aligns
-- with `ret`'s j=0 endpoint — the square is filled, and the output
-- (at j=1) is `t[i:=1]` on ψ, matching the ψ-boundary constraint exactly.
--
-- Both the hcomp-corrected and naked forms coexist as axioms: the hcomp
-- form is the CCHM-faithful statement (Rust-discharge reference), the
-- naked form is an ergonomic specialisation for `transp_ua`-style proofs
-- at ψ = .bot where the hcomp trivialises.  Stage 3 can consolidate.
--
-- The hcomp binder `j` is an explicit parameter (with `hT_j` / `hA_j`
-- freshness hypotheses) rather than a hardcoded `⟨"$hcj"⟩` — this keeps
-- the axiom hygienic and lets callers pick a binder disjoint from their
-- own scope.

/-- **Hcomp-corrected `_at_top` — constant components.**

    Full CCHM §6.2 formula for Glue transport at `φ[i:=1] = .top`:
    wraps the naked witness `app fInv a₁` in an hcomp-in-T whose
    ψ-clause is `ret (t[i:=1]) @ j`, enforcing definitional ψ-boundary
    agreement.

    The extra `hT_j` / `hA_j` hypotheses state that the fresh hcomp
    binder `j` does not appear in T or A — required so the inner
    `transp i A ψ a₁` and the outer `comp j T ψ …` don't collide.
    `hij : i ≠ j` rules out degenerate binder identity.

    **Rust-discharge axiom.** The evaluator's Glue-transport
    implementation emits this hcomp-corrected form; the naked
    `eval_transp_glue_const_at_top` is derivable from it at ψ = .bot
    (see `eval_transp_glue_const_at_top_from_hcomp`). -/
axiom eval_transp_glue_const_at_top_hcomp
    (env : CEnv) (i j : DimVar) (hij : i ≠ j)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hT_j : T.dimAbsent j = true)
    (hA : A.dimAbsent i = true)
    (hA_j : A.dimAbsent j = true)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1 : φ.substDim i .one = .top) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    eval env (.comp j T ψ
      (.papp (.app ret (t.substDimBool i true)) (.var j))
      (.app fInv
        (.transp i A ψ (.unglue (φ.substDim i .zero) f t))))

/-- **Hcomp-corrected `_at_top` — varying base A.**

    Varying-A companion to `eval_transp_glue_const_at_top_hcomp`.  The
    A-side is built via the CCHM two-clause `.compN` (matching
    `eval_transp_glue_varA_at_top`); the T-side wraps the principal
    `app fInv a₁` witness in the same hcomp-in-T correction. -/
axiom eval_transp_glue_varA_at_top_hcomp
    (env : CEnv) (i j : DimVar) (hij : i ≠ j)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hT : T.dimAbsent i = true)
    (hT_j : T.dimAbsent j = true)
    (hA : A.dimAbsent i = false)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1 : φ.substDim i .one = .top) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    eval env (.comp j T ψ
      (.papp (.app ret (t.substDimBool i true)) (.var j))
      (.app fInv
        (.compN i A
          [(ψ, .unglue φ f t),
           (φ, .app f t)]
          (.unglue (φ.substDim i .zero) f t))))

-- ── Derivation: naked form from hcomp form at ψ = .bot ─────────────────────
-- At ψ = .bot, the hcomp's ψ-clause is vacuous — C2 reduces the outer
-- comp to a plain transp of the base.  Since T is `j`-absent (`hT_j`),
-- T2 reduces that transp to identity, recovering the naked form.

/-- **Naked `_at_top` form at ψ = .bot is a theorem, not an axiom.**

    Derived from `eval_transp_glue_const_at_top_hcomp` at ψ = .bot.
    Gives Stage 2.1's consolidation: the ψ = .bot specialisation of
    the naked axiom is now propositionally derived from the hcomp
    axiom.  The original `eval_transp_glue_const_at_top` axiom still
    exists for general ψ; callers at ψ = .bot can switch to this
    theorem to consume the hcomp-corrected axiom family. -/
theorem eval_transp_glue_const_at_top_from_hcomp
    (env : CEnv) (i j : DimVar) (hij : i ≠ j)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (t : CTerm)
    (hT : T.dimAbsent i = true)
    (hT_j : T.dimAbsent j = true)
    (hA : A.dimAbsent i = true)
    (hA_j : A.dimAbsent j = true)
    (hf : f.dimAbsent i = true)
    (hfInv : fInv.dimAbsent i = true)
    (hsec : sec.dimAbsent i = true)
    (hret : ret.dimAbsent i = true)
    (hcoh : coh.dimAbsent i = true)
    (hφ1 : φ.substDim i .one = .top) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) .bot t) =
    eval env (.app fInv
      (.transp i A .bot (.unglue (φ.substDim i .zero) f t))) := by
  rw [eval_transp_glue_const_at_top_hcomp env i j hij φ T f fInv sec ret coh
        A .bot t (by intro h; nomatch h) hT hT_j hA hA_j
        hf hfInv hsec hret hcoh hφ1]
  rw [eval_comp_bot]
  rw [eval_transp_const env j T .bot _ (by intro h; nomatch h) hT_j]

-- ── Varying-equivalence Glue transport (Stage 2.4, 2026-04-23) ──────────────
--
-- The 6 axioms above (`_const_*` / `_varA_*`) all require **all five
-- equivalence components** (`f`, `fInv`, `sec`, `ret`, `coh`) to be
-- dim-absent from the line binder `i`.  This covers the CCHM
-- constant-equivalence case — the simplest and most common for ua-style
-- constructions (`transp_ua`, `transp_ua_inverse`).
--
-- Varying-equivalence Glue transport — where any of the five components
-- vary in `i` — is the largest remaining generalisation.  The full
-- CCHM §6.2 formula requires transporting witness terms *through* the
-- varying equivalence, using `transp^i T` applied to `f(t)`, etc., plus
-- a three-clause `.compN` on the A-side.  The reduction is intricate
-- and the discharge target is a full-featured Rust evaluator.
--
-- **Stage 2.4 closure discipline.**  Rather than state a partial/guessed
-- reduction formula, we state the *structurally stuck* form as a single
-- consolidated axiom.  The evaluator's partial def (Eval.lean's `.glue`
-- arm of `.transp`) already produces this stuck neutral; the axiom
-- merely lifts it to the kernel level.  The precondition `hVar` —
-- "at least one equivalence component is not dim-absent" — makes this
-- axiom **pattern-disjoint** from the 6 constant-equivalence axioms,
-- preserving the face-disjoint axiom-family discipline established in
-- Stage 1.  Future Rust refinement will replace this with the
-- full CCHM reduction rules (no Lean-side changes needed — the axiom
-- just becomes more informative).

/-- **Varying-equivalence Glue transport — structurally stuck form.**

    Applies when **at least one** of the five equivalence components
    (`f`, `fInv`, `sec`, `ret`, `coh`) is not dim-absent from the line
    binder `i`.  Pattern-disjoint from the 6 constant-equivalence axioms
    by hypothesis: those require *all* five to be dim-absent; this
    requires *at least one* to vary.

    Produces a structured `ntransp` neutral preserving all Glue data
    and the evaluated base.  The Rust evaluator's partial def already
    produces this form; a future refinement will add reduction rules
    using `transp^i T` on witness terms (CCHM §6.2 varying-equivalence
    case). -/
axiom eval_transp_glue_varEquiv
    (env : CEnv) (i : DimVar)
    (φ : FaceFormula) (T : CType)
    (f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
    (hψ : ψ ≠ .top)
    (hVar : ¬ (f.dimAbsent i = true ∧ fInv.dimAbsent i = true ∧
               sec.dimAbsent i = true ∧ ret.dimAbsent i = true ∧
               coh.dimAbsent i = true)) :
    eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
    .vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t))