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

/-
  Topolei.Cubical.Equiv
  =====================
  Half-adjoint equivalences between cubical types (cells-spec §5.8).

  `EquivData` packages a forward map, inverse, section, retraction, and a
  coherence 2-cell.  It is the parameter for `Glue` types in §5.7.

  Shape: we store the five components as raw `CTerm`s rather than as a
  Σ-type of such, because CType does not yet have a Σ constructor.  Typing
  (that `f : A → B`, `fInv : B → A`, etc.) is a per-use proof obligation;
  inhabitants such as `idEquiv` exhibit the shape directly and the boundary
  reductions fall out from substDim on term variables.

  The half-adjoint discipline follows HoTT Book §4.2:
    f   : A → B              forward map
    fInv: B → A              inverse
    sec : Π b : B. Path B (f (fInv b)) b                     ε  (section)
    ret : Π a : A. Path A (fInv (f a)) a                     η  (retraction)
    coh : Π a : A. Path (Path B (f a) (f a))
                        (ap f (ret a))
                        (sec (f a))                           τ  (coherence)

  In our non-dependent Π, the inner types depend on the outer λ's bound
  variable through `CTerm` endpoints (which can reference any term variable).

  Fiber types / contractibility of fibers are intentionally deferred: they
  need `.sigma` on `CType`, which is not yet in the syntax (STATUS.md
  "Priority order" item 3).
-/

import CubicalTransport.Typing

-- ── Equivalence data ─────────────────────────────────────────────────────────

/-- Half-adjoint equivalence between two types, represented as five `CTerm`s. -/
structure EquivData where
  /-- Forward map  `f : A → B`. -/
  f    : CTerm
  /-- Inverse map  `fInv : B → A`. -/
  fInv : CTerm
  /-- Section  `ε : Π b. Path B (f (fInv b)) b`. -/
  sec  : CTerm
  /-- Retraction  `η : Π a. Path A (fInv (f a)) a`. -/
  ret  : CTerm
  /-- Coherence 2-cell  `τ : Π a. Path (Path B (f a) (f a))
                                      (ap f (ret a))
                                      (sec (f a))`. -/
  coh  : CTerm
  deriving Repr

-- ── Named-variable hygiene constants ─────────────────────────────────────────
-- Reserved names for the identity equivalence's bound variables.
-- Chosen with `$` prefixes to avoid collision with user code, consistent
-- with the `"$y"` / `⟨"$fj"⟩` convention used by `vApp vCompFun`.

namespace EquivData

/-- Reserved term variable for the identity equivalence's forward / inverse
    bound argument.  User code using `$`-prefixed names is assumed absent. -/
def idEquivVar : String := "$x"

/-- Reserved dimension variable for the sec/ret path. -/
def idEquivDim : DimVar := ⟨"$e"⟩

/-- Reserved outer dimension variable for the coherence 2-cell. -/
def idEquivDimOuter : DimVar := ⟨"$eo"⟩

/-- Reserved inner dimension variable for the coherence 2-cell. -/
def idEquivDimInner : DimVar := ⟨"$ei"⟩

end EquivData

-- ── Identity equivalence ─────────────────────────────────────────────────────

/-- The identity equivalence on any type `A`.

    All five components are constant in their path arguments:
      f    = λx. x
      fInv = λx. x
      sec  = λx. ⟨e⟩ x           -- refl_x
      ret  = λx. ⟨e⟩ x           -- refl_x
      coh  = λx. ⟨eo⟩⟨ei⟩ x     -- refl_refl_x (constant 2-cell)

    `A` is not mentioned in the term structure; the types are implied by
    the calling context (e.g., a `HasType` derivation or a `.glue` face).
    This matches CCHM's treatment where `idEquiv` is universe-polymorphic
    and the type is inferred. -/
def idEquiv (_A : CType) : EquivData :=
  let x  := EquivData.idEquivVar
  let e  := EquivData.idEquivDim
  let eo := EquivData.idEquivDimOuter
  let ei := EquivData.idEquivDimInner
  { f    := .lam x (.var x)
    fInv := .lam x (.var x)
    sec  := .lam x (.plam e  (.var x))
    ret  := .lam x (.plam e  (.var x))
    coh  := .lam x (.plam eo (.plam ei (.var x))) }

-- ── Projection rfl-lemmas ────────────────────────────────────────────────────
-- These are not strictly necessary (the definition is transparent) but they
-- let downstream code rewrite through `idEquiv` without unfolding.

namespace idEquiv

theorem f_def (A : CType) :
    (idEquiv A).f = .lam EquivData.idEquivVar (.var EquivData.idEquivVar) := rfl

theorem fInv_def (A : CType) :
    (idEquiv A).fInv = .lam EquivData.idEquivVar (.var EquivData.idEquivVar) := rfl

theorem sec_def (A : CType) :
    (idEquiv A).sec =
      .lam EquivData.idEquivVar
        (.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl

theorem ret_def (A : CType) :
    (idEquiv A).ret =
      .lam EquivData.idEquivVar
        (.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl

theorem coh_def (A : CType) :
    (idEquiv A).coh =
      .lam EquivData.idEquivVar
        (.plam EquivData.idEquivDimOuter
          (.plam EquivData.idEquivDimInner (.var EquivData.idEquivVar))) := rfl

/-- `idEquiv` is constant in its type argument up to the five component terms. -/
theorem components_independent_of_A (A B : CType) :
    (idEquiv A).f = (idEquiv B).f ∧
    (idEquiv A).fInv = (idEquiv B).fInv ∧
    (idEquiv A).sec = (idEquiv B).sec ∧
    (idEquiv A).ret = (idEquiv B).ret ∧
    (idEquiv A).coh = (idEquiv B).coh :=
  ⟨rfl, rfl, rfl, rfl, rfl⟩

end idEquiv

-- ── Forward map typing for idEquiv ───────────────────────────────────────────
-- The five components type-check in the empty context.  We prove typing for
-- `f` and `fInv` directly (they are `λx. x`); `sec` and `ret` follow from
-- `HasType.plam` giving the reflexivity path at `var x` (substDim on a term
-- variable is identity, so both endpoints are `var x`).

namespace idEquiv

/-- `(idEquiv A).f : A → A`. -/
theorem hasType_f (Γ : Ctx) (A : CType) :
    HasType Γ (idEquiv A).f (.pi A A) := by
  show HasType Γ (.lam EquivData.idEquivVar (.var EquivData.idEquivVar)) (.pi A A)
  exact HasType.lam (HasType.var (by simp))

/-- `(idEquiv A).fInv : A → A`. -/
theorem hasType_fInv (Γ : Ctx) (A : CType) :
    HasType Γ (idEquiv A).fInv (.pi A A) :=
  hasType_f Γ A

/-- `(idEquiv A).sec : A → Path A x x`  (reflexivity at the bound variable).

    Under our non-dependent Π, the codomain is a fixed `CType` whose path
    endpoints reference the bound term variable `$x`.  `HasType.plam` on a
    term variable gives a path whose boundaries are both `.var x` because
    `substDim` does not descend into term variables.

    Note: this does *not* match the "full" section type
    `Path A (f (fInv x)) x` because identity-of-β-reduction is not part of
    our typing relation.  We return the propositionally-reduced type. -/
theorem hasType_sec_refl (Γ : Ctx) (A : CType) :
    HasType Γ (idEquiv A).sec
      (.pi A (.path A
        (CTerm.var EquivData.idEquivVar)
        (CTerm.var EquivData.idEquivVar))) := by
  show HasType Γ
    (.lam EquivData.idEquivVar
      (.plam EquivData.idEquivDim (.var EquivData.idEquivVar)))
    (.pi A (.path A (.var EquivData.idEquivVar) (.var EquivData.idEquivVar)))
  -- plam gives Path A (var[i:=0]) (var[i:=1]) = Path A (var x) (var x) since
  -- CTerm.substDim does not descend into term variables.
  exact HasType.lam (HasType.plam (HasType.var (by simp)))

/-- `(idEquiv A).ret : A → Path A x x`. -/
theorem hasType_ret_refl (Γ : Ctx) (A : CType) :
    HasType Γ (idEquiv A).ret
      (.pi A (.path A
        (CTerm.var EquivData.idEquivVar)
        (CTerm.var EquivData.idEquivVar))) :=
  hasType_sec_refl Γ A

/-- `(idEquiv A).coh : A → Path (Path A x x) (⟨ei⟩ x) (⟨ei⟩ x)`.

    The inner plam gives `Path A x x` (by the same argument as `sec`); the
    outer plam gives a path between two copies of `⟨ei⟩ x` — because the
    outer `substDim eo` leaves `plam ei (var x)` alone (the var is a term
    variable, unaffected by dim substitution).  This is the "constant
    2-cell at refl". -/
theorem hasType_coh_refl_refl (Γ : Ctx) (A : CType) :
    HasType Γ (idEquiv A).coh
      (.pi A
        (.path
          (.path A
            (CTerm.var EquivData.idEquivVar)
            (CTerm.var EquivData.idEquivVar))
          (CTerm.plam EquivData.idEquivDimInner
            (CTerm.var EquivData.idEquivVar))
          (CTerm.plam EquivData.idEquivDimInner
            (CTerm.var EquivData.idEquivVar)))) := by
  show HasType Γ
    (.lam EquivData.idEquivVar
      (.plam EquivData.idEquivDimOuter
        (.plam EquivData.idEquivDimInner (.var EquivData.idEquivVar))))
    _
  exact HasType.lam
    (HasType.plam
      (HasType.plam (HasType.var (by simp))))

end idEquiv