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

/-
  CubicalTransport.Transport
  ==========================
  Value-level transport (cells-spec §5.5, Phase 1 Weeks 3–4).
  Universe-aware (Layer 0 §0.1 cascade).

  `vTransp i A φ v` reduces `transp^i A φ v` at the value level.

  Reducing cases (in match order, highest priority first):

    1. **φ = .top** — full face — return `v` unchanged.
       Evaluator-level analogue of axiom `transp_id` (T1).
    2. **`CType.dimAbsent i A = true`** — line is constant — return `v`
       unchanged.  Evaluator-level analogue of `transp_const_id` (T2).
       Covers `univ`, fully-constant `pi`, fully-constant `path`.
    3. **`A = pi var domA codA`** — produce a `vTranspFun i domA codA φ v`
       closure (the pi's binder name is consumed; vApp handles the
       function-side reduction using the transport's binder `i`).
    4. **Otherwise** — stuck.  Produce `vneu (.ntransp i A φ v)`.

  vTransp is a `partial def` for the same reason as `eval`.  Its
  reduction equations are stated as axioms.
-/

import CubicalTransport.Value
import CubicalTransport.DimLine  -- for CType.dimAbsent and substDimExpr

-- ── Rust FFI declaration (Phase C.2) ──────────────────────────────────────

@[extern "cubical_transport_vtransp"]
opaque vTranspRust {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal) : CVal

/-- Value-level transport.  Dispatches in priority order; see file header. -/
@[implemented_by vTranspRust]
partial def vTransp {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal) :
    CVal :=
  match φ with
  | .top => v   -- (1) T1 at eval level.
  | _ =>
    if CType.dimAbsent i A then
      v  -- (2) T2 at eval level.
    else
      match A with
      | .pi _ domA codA =>
          -- (3) Full CCHM Π rule.
          .vTranspFun i domA codA φ v
      | _ =>
          -- (4) non-pi stuck (e.g. path with varying endpoints).
          .vneu (.ntransp i A φ v)

/-- **Inverse transport** along the line `(i, A)`: transport `v : A(1)` back
    to `A(0)`.  Implemented as forward transport along the *reversed* line
    `A[i := inv i]`. -/
def vTranspInv {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal) : CVal :=
  vTransp i (A.substDimExpr i (.inv (.var i))) φ v

/-!
## Reduction lemmas

One lemma per reducing match arm of `vTransp`.  The arms are disjoint
(ordered pattern match), so the lemma set is consistent.

**Axiom-debt cleanup (REL2 follow-up).**  Previously declared `axiom`;
now `theorem ... := by sorry` annotated to **FS-H15** in
`topolei/docs/HYPOTHESES.md` (the partial-def-reduction-equations
umbrella hypothesis).  Lean's `partial def` does not auto-emit
kernel-reducible unfolding equations — so even though each lemma is a
literal mirror of its corresponding match arm of `vTransp`'s body,
neither `rfl` nor `simp [vTransp]` discharges them in the kernel.  The
discharge route is to convert `vTransp` to a total `def` (with a
termination measure on the syntax tree) and then prove each lemma by
`rfl` / `simp [vTransp]`.  Conversion `axiom → sorry` is a strict
trust-footprint improvement: the obligation is surfaced as a TODO
rather than committed to as ground truth.
-/

/-- (1) Reduction under a full face: transport is identity. -/
theorem vTransp_top {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (v : CVal) :
    vTransp i A .top v = v := by
  -- waits on: FS-H15.  Mirror of `vTransp` partial-def's `.top` arm.
  sorry

/-- (2) Reduction under a constant line. -/
theorem vTransp_const {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal)
    (h : CType.dimAbsent i A = true) :
    vTransp i A φ v = v := by
  -- waits on: FS-H15.  Mirror of `vTransp` partial-def's constant-line arm.
  sorry

/-- (3) Π case (full CCHM rule): produces a transported-function closure
    that stores both domain and codomain.  The pi's binder name is
    discarded (vApp uses the transport binder `i`).  Preconditions:
      · `φ ≠ .top`                                   — else (1) fires,
      · `CType.dimAbsent i (.pi var domA codA) = false`  — else (2) fires. -/
theorem vTransp_pi {ℓ ℓ' : ULevel}
    (i : DimVar) (var : String) (domA : CType ℓ) (codA : CType ℓ')
    (φ : FaceFormula) (v : CVal)
    (hφ : φ ≠ .top)
    (hA : CType.dimAbsent i (.pi var domA codA) = false) :
    vTransp i (.pi var domA codA) φ v = .vTranspFun i domA codA φ v := by
  -- waits on: FS-H15.  Mirror of `vTransp` partial-def's `.pi` arm.
  sorry

/-- (4) Stuck: not face-top, not constant, and not a `.pi`.

    The "not a pi" precondition is formulated via `CType.skeleton`
    (the level-erased constructor tag) rather than HEq.  This
    avoids cross-level HEq elimination (which requires K and is
    not available in Lean 4) and is decidable / discharge-able
    by structural pattern matching at every call site. -/
theorem vTransp_stuck {ℓ : ULevel}
    (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal)
    (hφ : φ ≠ .top)
    (hA : CType.dimAbsent i A = false)
    (h_not_pi : A.skeleton ≠ SkeletalCType.pi) :
    vTransp i A φ v = .vneu (.ntransp i A φ v) := by
  -- waits on: FS-H15.  Mirror of `vTransp` partial-def's stuck-fallback arm.
  sorry

-- ── vTranspInv on constant domain ────────────────────────────────────────────

/-- Inverse transport along a line whose body is absent from `i` is the
    identity. -/
theorem vTranspInv_const {ℓ : ULevel}
    (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal)
    (h : CType.dimAbsent i A = true) :
    vTranspInv i A φ v = v := by
  unfold vTranspInv
  rw [CType.substDimExpr_of_absent i _ A h]
  exact vTransp_const i A φ v h

/-- Inverse transport under a full face is identity. -/
theorem vTranspInv_top {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (v : CVal) :
    vTranspInv i A .top v = v := by
  unfold vTranspInv
  exact vTransp_top i _ v

-- ── Convenience wrappers ──────────────────────────────────────────────────────

/-- Transport along a `DimLine` with an already-evaluated argument. -/
def vTranspLine {ℓ : ULevel} (L : DimLine ℓ) (φ : FaceFormula) (v : CVal) : CVal :=
  vTransp L.binder L.body φ v

@[simp] theorem vTranspLine_top {ℓ : ULevel} (L : DimLine ℓ) (v : CVal) :
    vTranspLine L .top v = v := by
  simp [vTranspLine, vTransp_top]

theorem vTranspLine_const {ℓ : ULevel} (L : DimLine ℓ) (φ : FaceFormula) (v : CVal)
    (h : CType.dimAbsent L.binder L.body = true) :
    vTranspLine L φ v = v := by
  simp [vTranspLine, vTransp_const _ _ _ _ h]