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

/-
  CubicalTransport.Decidable
  ==========================
  Decidable equality at the cubical CType level (THEORY.md
  Layer 0 §0.7).  Universe-aware (Layer 0 §0.1 cascade).

  This module provides:

  · `emptySchema` / `CType.botC` — the empty type at any level, the
    cubical-side `⊥`.  Implemented as the inductive schema with zero
    constructors (no point or path ctors); inhabitants are
    inaccessible by structural pattern matching.

  · `CType.notC A` — `A → ⊥`, the "negation" type at level ℓ for
    `A : CType ℓ`.  Coerced to `CType ℓ` via `CType.piSelf` (same-
    level pi from `Truncation.lean`'s §1A re-anchoring discipline).

  · `decSchema` — the schema for `CDecidable`.  Two type parameters
    `[A, A → ⊥]`; two point constructors `inl : .param 0 → Dec` and
    `inr : .param 1 → Dec`.  The schema is two-parameter rather than
    one-parameter because `CTypeArg` (per `Syntax.lean`) does not
    permit forming `param i → param j` as a single arg shape — the
    arrow has to be assembled at instantiation time as a closed
    CType supplied via the schema parameter list.

  · `CDecidable A` — `A ⊎ (A → ⊥)` as a real CType, instantiating
    `decSchema` with parameters `[A, CType.notC A]` at level ℓ.

  · `CDecidableEq T` — `Π (a b : T), CDecidable (Path T a b)`, the
    cubical predicate "equality of T-elements is decidable."

  · `Hedberg` — the theorem `CDecidableEq T → IsNType .zero T`
    (THEORY.md §0.7), the bridge contract for the discrete-math
    layer.  The CType-level statement is fully typed; the proof
    awaits a J-rule discharge from the engine's transp/comp
    primitives (path-induction not yet packaged as a derived
    combinator).

  ## Universe-stratification notes

  `emptySchema` has zero parameters and zero ctors; instantiating
  `.ind emptySchema []` at any level produces `⊥` at that level.
  `CType.botC ℓ` exposes this directly.

  `CDecidable` keeps the level of its argument: `A : CType ℓ`
  produces `CDecidable A : CType ℓ` because the schema is
  instantiated at level ℓ, and the schema parameter list packages
  both `A` and `CType.notC A` at level ℓ.

  ## Hygienic binder names

  `CDecidableEq` uses the binder names `"$a"`, `"$b"` for the inner
  pi binders; references via `.var "$a"`, `.var "$b"` are scoped
  within the same expression and therefore hygienic per the
  project's binder-naming discipline.
-/

import CubicalTransport.Truncation

namespace CubicalTransport.Decidable

open CubicalTransport.Inductive
open CubicalTransport.Truncation

-- ── §1.  The empty type as a schema ────────────────────────────────────────

/-- The empty type as a CTypeSchema.  Zero constructors — no point or
    path ctors.  Instantiation `.ind emptySchema []` is the cubical
    `⊥` at any user-supplied level.

    Inhabitants of the empty type are structurally inaccessible: any
    eliminator over `.ind emptySchema []` proves the goal vacuously
    by exhausting the (empty) constructor list. -/
def emptySchema : CTypeSchema :=
  mkSchema "⊥" 0 []

/-- `⊥` as a CType at any level.  Polymorphic in the level parameter:
    instantiating at `ℓ.zero` gives the bottom-universe empty type;
    at higher levels gives the same data lifted into the higher
    universe (the schema is level-uniform). -/
def CType.botC (ℓ : ULevel) : CType ℓ := .ind emptySchema []

/-- Negation as a CType: `¬A := A → ⊥`, with both A and ⊥ at the
    same level ℓ.  Uses `CType.piSelf` (Truncation.lean §1A) to
    coerce `max ℓ ℓ` back to `ℓ`. -/
def CType.notC {ℓ : ULevel} (A : CType ℓ) : CType ℓ :=
  CType.piSelf "$_neg" A (CType.botC ℓ)

-- ── §2.  The decidable schema ──────────────────────────────────────────────

/-- The schema for `CDecidable`.  Two parameters and two
    constructors:

    · `params := [A, A → ⊥]` at positions 0 and 1
    · `inl : .param 0 → CDecidable`  (positive witness)
    · `inr : .param 1 → CDecidable`  (negative witness)

    Two-parameter rather than one-parameter because `CTypeArg` does
    not permit `.param 0 → .param j`-shaped args (no arrow former at
    the CTypeArg level).  Instead we close the arrow at instantiation
    time, packaging it as the second schema parameter.

    No path constructors — `CDecidable` is plain (a sum type, not a
    HIT). -/
def decSchema : CTypeSchema :=
  mkSchema "CDecidable" 2
    [ mkCtor "inl" [.param 0]
    , mkCtor "inr" [.param 1] ]

-- ── §3.  CDecidable, CDecidableEq ──────────────────────────────────────────

/-- Decidability as a CType (THEORY.md §0.7).  `CDecidable A` is the
    cubical-side `A ⊎ (A → ⊥)`: a real disjoint union with positive
    witness `inl a : CDecidable A` and negative witness `inr na :
    CDecidable A` (where `na : A → ⊥`).

    Encoded as `.ind decSchema [⟨ℓ, A⟩, ⟨ℓ, A → ⊥⟩]` at level ℓ. -/
def CDecidable {ℓ : ULevel} (A : CType ℓ) : CType ℓ :=
  .ind (ℓ := ℓ) decSchema [⟨ℓ, A⟩, ⟨ℓ, CType.notC A⟩]

/-- Decidable equality on T (THEORY.md §0.7):
    `Π (a b : T), CDecidable (Path T a b)`.

    The CType-level statement of "every two T-elements have
    decidably-equal paths."  This is the precondition of the
    Hedberg theorem (below). -/
def CDecidableEq {ℓ : ULevel} (T : CType ℓ) : CType ℓ :=
  CType.piSelf "$a" T
    (CType.piSelf "$b" T
      (CDecidable (.path T (.var "$a") (.var "$b"))))

-- ── §4.  Hedberg: decidable equality implies set-level ────────────────────

/-- The Hedberg theorem (THEORY.md §0.7, HoTT Book Theorem 7.2.5):
    decidable equality on T implies T is a Set (i.e., `IsNType .zero T`).

    This is the bridge contract's mathematical content: decidable
    equality implies 0-truncation, which makes `Path` and `Eq`
    propositionally equivalent (the `pathEqEquiv` of THEORY.md §0.8).

    ## Statement

    For every level ℓ and every CType T at level ℓ, there exists a
    CTerm witnessing the implication
        CDecidableEq T → IsNType .zero T
    in the empty context.  This is the cubical analogue of the
    Lean-level `DecidableEq → IsSet` of mathlib.

    ## Proof sketch (Univalent Foundations §7.2.5)

    Given `dec : CDecidableEq T`, define
        K (a b : T) (p : Path T a b) : Path T a b
    by case analysis on `dec a b`:
      · `inl q` (positive): return `q` (constant in `p`).
      · `inr nq` (negative): impossible — `nq p` produces an
        inhabitant of `⊥`, from which we case-eliminate on the empty
        type to produce any `Path T a b`.
    In both cases, K is constant in `p`.  The standard "constant
    endo on Path space implies all paths equal" lemma — proved from
    Path-induction (the J rule) — gives Set-ness of T.

    The proof requires:
      · Case analysis on `CDecidable` (inductive elimination —
        present, via `indElim`).
      · Empty-type elimination (`emptySchema.ctors = []` so `indElim`
        on `.ind emptySchema []` has no branches — proves any goal).
      · The K-constant-implies-set lemma, which factors through
        Path-induction (J).

    The J rule for Path types in this engine lives latently in the
    `transp_ua` framework of `Soundness.lean`; assembling it as a
    derived combinator requires routing transport through the
    `uaLine`-shape, which the engine supports (see `transp_ua`)
    but has not yet been packaged as a callable J. -/
theorem Hedberg {ℓ : ULevel} (T : CType ℓ) :
    ∃ (w : CTerm), HasType [] w (CType.piSelf "$dec" (CDecidableEq T)
                                   (IsNType .zero T)) := by
  -- waits on: J-rule combinator built from Soundness.transp_ua
  -- (CCHM path-induction packaged as a derived combinator).  Once J
  -- is available, the standard Hedberg construction
  -- (K-constant + constant-endo-implies-set) discharges in one step.
  sorry

end CubicalTransport.Decidable