b9ca1d8875
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per THEORY.md §3.1: cubical-native modal type formers as the engine
support layer for the cohesive modality triple (ʃ ⊣ ♭ ⊣ ♯).
CType (3 level-preserving formers):
· CType.flat / .sharp / .shape : {ℓ} → CType ℓ → CType ℓ
CTerm (6 — three intros + three elims, modelled on .glueIn / .unglue):
· CTerm.flatIntro / .sharpIntro / .shapeIntro : CTerm → CTerm
· CTerm.flatElim / .sharpElim / .shapeElim : CTerm → CTerm → CTerm
Cascade: Syntax (constructors + SkeletalCType + skeleton + substDim);
DecEq (beq arms); Subst (substDim / substDimExpr + 6 rfl theorems);
DimLine (cascade through 8 dim-absent / dim-substitution lemma families);
Value (3 vIntro CVal + 3 nElim CNeu); Eval (β-reduction axioms +
stuck-neutral propagation, "marker neutral" idiom from vFst/vSnd
preserved); Readback (3 vIntro + 3 nElim arms with axioms); Typing
(6 HasType cases — bare recursion-principle shape; modal cohesion
dependent-motive form deferred to Phase 3); Reflect (3 reflectCType + 6
reflectCTerm + 3 reifyCType with level-coherence discharge + 6
reifyCTerm); Question (6 modal arms + 6 IsModalLine classifier
predicates with their Decidable instances); FFITest (cval/cterm
summary arms).
No Rust changes (Phase 2). No Modal.lean module (Phase 3). No
Crisp / CContext.crispVar / cohesive_triple theorems (Phase 3).
Build: lake build (48 jobs) + lake build CubicalTransport (42 jobs) PASS.
+664 lines across 11 files, 0 removed, 0 new sorries.
Honest deferrals documented:
· Modal type-formers do not yet reduce under transport/comp; the
match A blocks have wildcards so transp i (flat A) φ t produces a
stuck ntransp neutral (correct under current axiom set; cohesion-
driven reductions land in Phase 3).
· HasType.flatElim et al carry the bare recursion-principle shape;
the cohesive-HoTT-correct dependent-motive form requires the modal
predicate lattice from Phase 3.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
348 lines
16 KiB
Text
348 lines
16 KiB
Text
/-
|
||
CubicalTransport.Subst
|
||
======================
|
||
Dimension substitution for the universe-stratified, dependently-
|
||
typed CType (Layer 0 §0.1 cascade).
|
||
|
||
CTerm already has substDim : DimVar → DimExpr → CTerm → CTerm (Syntax.lean).
|
||
Here we add:
|
||
|
||
CTerm.substDimBool : DimVar → Bool → CTerm → CTerm
|
||
— specialises substDim to the two canonical endpoints (false = 0, true = 1).
|
||
|
||
CType.substDim : DimVar → Bool → CType ℓ → CType ℓ
|
||
CType.substDimExpr : DimVar → DimExpr → CType ℓ → CType ℓ
|
||
— Substitute a dimension variable with a Bool endpoint / DimExpr
|
||
throughout a type. Level-preserving: substituting dim vars
|
||
does not change a type's universe level.
|
||
|
||
## Universe-aware shape
|
||
|
||
All substDim functions are level-polymorphic: they take and return a
|
||
`CType ℓ` at the same `ℓ`. The mutual block over CType is uniform in
|
||
`ℓ` — pattern matching on constructors does not require explicit
|
||
instantiation.
|
||
|
||
## Dependent pi/sigma
|
||
|
||
The new `pi var A B` and `sigma var A B` constructors carry a binder
|
||
name. For dim substitution, the binder is irrelevant (it binds a
|
||
CTerm variable, not a DimVar), so substDim recurses into both A and
|
||
B as usual.
|
||
|
||
## Cumulativity (lift)
|
||
|
||
`lift A` carries the underlying `A : CType ℓ`; substitution descends
|
||
into A (preserving the lift wrapper).
|
||
|
||
## Heterogeneous-level params
|
||
|
||
`params : List (Σ ℓ : ULevel, CType ℓ)`. Each entry is `⟨ℓ', A⟩`
|
||
with `A : CType ℓ'`. The helper `substDim.params` substitutes
|
||
pointwise, preserving each entry's level.
|
||
|
||
## Key theorems
|
||
|
||
· Reduction lemmas (univ, pi, sigma, path, glue, ind, interval, lift)
|
||
— proved by rfl.
|
||
· substDimBool_eq_substDim — the wrapper unfolds correctly.
|
||
· substDim_at_false / substDim_at_true — face-environment connection.
|
||
· substDim_eq_substDimExpr — the Bool-endpoint substitution agrees
|
||
with the DimExpr substitution at the canonical endpoint.
|
||
-/
|
||
|
||
import CubicalTransport.Syntax
|
||
|
||
-- ── CTerm.substDimBool ────────────────────────────────────────────────────────
|
||
|
||
/-- Specialise CTerm.substDim to a Bool endpoint.
|
||
false → substitute i with DimExpr.zero (the i=0 face)
|
||
true → substitute i with DimExpr.one (the i=1 face) -/
|
||
def CTerm.substDimBool (i : DimVar) (b : Bool) (t : CTerm) : CTerm :=
|
||
t.substDim i (if b then .one else .zero)
|
||
|
||
theorem CTerm.substDimBool_eq_substDim (i : DimVar) (b : Bool) (t : CTerm) :
|
||
t.substDimBool i b = t.substDim i (if b then .one else .zero) := rfl
|
||
|
||
theorem CTerm.substDimBool_false (i : DimVar) (t : CTerm) :
|
||
t.substDimBool i false = t.substDim i .zero := rfl
|
||
|
||
theorem CTerm.substDimBool_true (i : DimVar) (t : CTerm) :
|
||
t.substDimBool i true = t.substDim i .one := rfl
|
||
|
||
-- ── CType.substDim ────────────────────────────────────────────────────────────
|
||
-- Substitute dimension variable i with Bool endpoint b throughout a type.
|
||
-- Level-polymorphic — the universe level of the result equals the input.
|
||
|
||
mutual
|
||
def CType.substDim {ℓ : ULevel} (i : DimVar) (b : Bool) : CType ℓ → CType ℓ
|
||
| .univ => .univ
|
||
| .pi var A B => .pi var (A.substDim i b) (B.substDim i b)
|
||
| .path A a t => .path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b)
|
||
| .sigma var A B => .sigma var (A.substDim i b) (B.substDim i b)
|
||
| .glue φ T f fInv sec ret coh A =>
|
||
.glue (φ.substDim i (if b then .one else .zero))
|
||
(T.substDim i b)
|
||
(f.substDimBool i b) (fInv.substDimBool i b)
|
||
(sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b)
|
||
(A.substDim i b)
|
||
| .ind S params => .ind S (CType.substDim.params i b params)
|
||
| .interval => .interval
|
||
| .lift A => .lift (A.substDim i b)
|
||
| .El P => .El (P.substDimBool i b)
|
||
-- Modal type formers: descend into the inner type.
|
||
| .flat A => .flat (A.substDim i b)
|
||
| .sharp A => .sharp (A.substDim i b)
|
||
| .shape A => .shape (A.substDim i b)
|
||
|
||
/-- Pointwise `substDim` through a level-heterogeneous list of CType
|
||
parameters. Each entry's universe level is preserved. -/
|
||
def CType.substDim.params (i : DimVar) (b : Bool) :
|
||
List (Σ ℓ : ULevel, CType ℓ) → List (Σ ℓ : ULevel, CType ℓ)
|
||
| [] => []
|
||
| ⟨ℓ, A⟩ :: rest => ⟨ℓ, A.substDim i b⟩ :: CType.substDim.params i b rest
|
||
end
|
||
|
||
-- ── CType.substDimExpr ────────────────────────────────────────────────────────
|
||
-- Substitute dimension variable `i` with an arbitrary `DimExpr r`
|
||
-- throughout a type. Generalises `CType.substDim`, which fixes `r` to
|
||
-- a Bool endpoint.
|
||
|
||
mutual
|
||
def CType.substDimExpr {ℓ : ULevel} (i : DimVar) (r : DimExpr) : CType ℓ → CType ℓ
|
||
| .univ => .univ
|
||
| .pi var A B => .pi var (A.substDimExpr i r) (B.substDimExpr i r)
|
||
| .path A a t => .path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r)
|
||
| .sigma var A B => .sigma var (A.substDimExpr i r) (B.substDimExpr i r)
|
||
| .glue φ T f fInv sec ret coh A =>
|
||
.glue (φ.substDim i r)
|
||
(T.substDimExpr i r)
|
||
(f.substDim i r) (fInv.substDim i r)
|
||
(sec.substDim i r) (ret.substDim i r) (coh.substDim i r)
|
||
(A.substDimExpr i r)
|
||
| .ind S params => .ind S (CType.substDimExpr.params i r params)
|
||
| .interval => .interval
|
||
| .lift A => .lift (A.substDimExpr i r)
|
||
| .El P => .El (P.substDim i r)
|
||
-- Modal type formers: descend into the inner type.
|
||
| .flat A => .flat (A.substDimExpr i r)
|
||
| .sharp A => .sharp (A.substDimExpr i r)
|
||
| .shape A => .shape (A.substDimExpr i r)
|
||
|
||
/-- Pointwise `substDimExpr` through a level-heterogeneous list of
|
||
CType parameters. -/
|
||
def CType.substDimExpr.params (i : DimVar) (r : DimExpr) :
|
||
List (Σ ℓ : ULevel, CType ℓ) → List (Σ ℓ : ULevel, CType ℓ)
|
||
| [] => []
|
||
| ⟨ℓ, A⟩ :: rest => ⟨ℓ, A.substDimExpr i r⟩ :: CType.substDimExpr.params i r rest
|
||
end
|
||
|
||
-- ── Reduction lemmas (substDim) ──────────────────────────────────────────────
|
||
|
||
namespace CType
|
||
|
||
theorem substDim_univ {ℓ : ULevel} (i : DimVar) (b : Bool) :
|
||
(univ (ℓ := ℓ)).substDim i b = .univ := rfl
|
||
|
||
theorem substDim_pi {ℓ ℓ' : ULevel} (i : DimVar) (b : Bool)
|
||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||
(pi var A B).substDim i b = .pi var (A.substDim i b) (B.substDim i b) := rfl
|
||
|
||
theorem substDim_path {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||
(A : CType ℓ) (a t : CTerm) :
|
||
(path A a t).substDim i b =
|
||
.path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) := rfl
|
||
|
||
theorem substDim_sigma {ℓ ℓ' : ULevel} (i : DimVar) (b : Bool)
|
||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||
(sigma var A B).substDim i b =
|
||
.sigma var (A.substDim i b) (B.substDim i b) := rfl
|
||
|
||
theorem substDim_glue {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||
(φ : FaceFormula) (T : CType ℓ)
|
||
(f fInv sec ret coh : CTerm) (A : CType ℓ) :
|
||
(glue φ T f fInv sec ret coh A).substDim i b =
|
||
.glue (φ.substDim i (if b then .one else .zero))
|
||
(T.substDim i b)
|
||
(f.substDimBool i b) (fInv.substDimBool i b)
|
||
(sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b)
|
||
(A.substDim i b) := rfl
|
||
|
||
theorem substDim_ind {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) :
|
||
(ind (ℓ := ℓ) S params).substDim i b = .ind S (CType.substDim.params i b params) := rfl
|
||
|
||
theorem substDim_interval (i : DimVar) (b : Bool) :
|
||
(interval).substDim i b = .interval := rfl
|
||
|
||
theorem substDim_lift {ℓ : ULevel} (i : DimVar) (b : Bool) (A : CType ℓ) :
|
||
(lift A).substDim i b = .lift (A.substDim i b) := rfl
|
||
|
||
@[simp] theorem substDim_El {ℓ : ULevel} (i : DimVar) (b : Bool) (P : CTerm) :
|
||
(CType.El (ℓ := ℓ) P).substDim i b = .El (P.substDimBool i b) := rfl
|
||
|
||
@[simp] theorem substDim_flat {ℓ : ULevel} (i : DimVar) (b : Bool) (A : CType ℓ) :
|
||
(CType.flat A).substDim i b = .flat (A.substDim i b) := rfl
|
||
|
||
@[simp] theorem substDim_sharp {ℓ : ULevel} (i : DimVar) (b : Bool) (A : CType ℓ) :
|
||
(CType.sharp A).substDim i b = .sharp (A.substDim i b) := rfl
|
||
|
||
@[simp] theorem substDim_shape {ℓ : ULevel} (i : DimVar) (b : Bool) (A : CType ℓ) :
|
||
(CType.shape A).substDim i b = .shape (A.substDim i b) := rfl
|
||
|
||
-- ── Reduction lemmas (substDimExpr) ──────────────────────────────────────────
|
||
|
||
theorem substDimExpr_univ {ℓ : ULevel} (i : DimVar) (r : DimExpr) :
|
||
(univ (ℓ := ℓ)).substDimExpr i r = .univ := rfl
|
||
|
||
theorem substDimExpr_pi {ℓ ℓ' : ULevel} (i : DimVar) (r : DimExpr)
|
||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||
(pi var A B).substDimExpr i r =
|
||
.pi var (A.substDimExpr i r) (B.substDimExpr i r) := rfl
|
||
|
||
theorem substDimExpr_path {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||
(A : CType ℓ) (a t : CTerm) :
|
||
(path A a t).substDimExpr i r =
|
||
.path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r) := rfl
|
||
|
||
theorem substDimExpr_sigma {ℓ ℓ' : ULevel} (i : DimVar) (r : DimExpr)
|
||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||
(sigma var A B).substDimExpr i r =
|
||
.sigma var (A.substDimExpr i r) (B.substDimExpr i r) := rfl
|
||
|
||
theorem substDimExpr_glue {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||
(φ : FaceFormula) (T : CType ℓ)
|
||
(f fInv sec ret coh : CTerm) (A : CType ℓ) :
|
||
(glue φ T f fInv sec ret coh A).substDimExpr i r =
|
||
.glue (φ.substDim i r)
|
||
(T.substDimExpr i r)
|
||
(f.substDim i r) (fInv.substDim i r)
|
||
(sec.substDim i r) (ret.substDim i r) (coh.substDim i r)
|
||
(A.substDimExpr i r) := rfl
|
||
|
||
theorem substDimExpr_ind {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) :
|
||
(ind (ℓ := ℓ) S params).substDimExpr i r =
|
||
.ind S (CType.substDimExpr.params i r params) := rfl
|
||
|
||
theorem substDimExpr_interval (i : DimVar) (r : DimExpr) :
|
||
(interval).substDimExpr i r = .interval := rfl
|
||
|
||
theorem substDimExpr_lift {ℓ : ULevel} (i : DimVar) (r : DimExpr) (A : CType ℓ) :
|
||
(lift A).substDimExpr i r = .lift (A.substDimExpr i r) := rfl
|
||
|
||
@[simp] theorem substDimExpr_El {ℓ : ULevel} (i : DimVar) (r : DimExpr) (P : CTerm) :
|
||
(CType.El (ℓ := ℓ) P).substDimExpr i r = .El (P.substDim i r) := rfl
|
||
|
||
@[simp] theorem substDimExpr_flat {ℓ : ULevel} (i : DimVar) (r : DimExpr) (A : CType ℓ) :
|
||
(CType.flat A).substDimExpr i r = .flat (A.substDimExpr i r) := rfl
|
||
|
||
@[simp] theorem substDimExpr_sharp {ℓ : ULevel} (i : DimVar) (r : DimExpr) (A : CType ℓ) :
|
||
(CType.sharp A).substDimExpr i r = .sharp (A.substDimExpr i r) := rfl
|
||
|
||
@[simp] theorem substDimExpr_shape {ℓ : ULevel} (i : DimVar) (r : DimExpr) (A : CType ℓ) :
|
||
(CType.shape A).substDimExpr i r = .shape (A.substDimExpr i r) := rfl
|
||
|
||
-- ── Bool endpoint = DimExpr at canonical endpoint ────────────────────────────
|
||
|
||
mutual
|
||
def substDim_eq_substDimExpr {ℓ : ULevel} (i : DimVar) (b : Bool) :
|
||
(A : CType ℓ) →
|
||
A.substDim i b = A.substDimExpr i (if b then DimExpr.one else DimExpr.zero)
|
||
| .univ => rfl
|
||
| .pi var A B => by
|
||
show CType.pi var (A.substDim i b) (B.substDim i b) =
|
||
CType.pi var (A.substDimExpr i _) (B.substDimExpr i _)
|
||
rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B]
|
||
| .path A a t => by
|
||
show CType.path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) =
|
||
CType.path (A.substDimExpr i _) (a.substDim i _) (t.substDim i _)
|
||
rw [substDim_eq_substDimExpr i b A,
|
||
CTerm.substDimBool_eq_substDim,
|
||
CTerm.substDimBool_eq_substDim]
|
||
| .sigma var A B => by
|
||
show CType.sigma var (A.substDim i b) (B.substDim i b) =
|
||
CType.sigma var (A.substDimExpr i _) (B.substDimExpr i _)
|
||
rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B]
|
||
| .glue φ T f fInv sec ret coh A => by
|
||
show CType.glue
|
||
(φ.substDim i (if b then DimExpr.one else DimExpr.zero))
|
||
(T.substDim i b)
|
||
(f.substDimBool i b) (fInv.substDimBool i b)
|
||
(sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b)
|
||
(A.substDim i b)
|
||
= CType.glue
|
||
(φ.substDim i _)
|
||
(T.substDimExpr i _)
|
||
(f.substDim i _) (fInv.substDim i _)
|
||
(sec.substDim i _) (ret.substDim i _) (coh.substDim i _)
|
||
(A.substDimExpr i _)
|
||
rw [substDim_eq_substDimExpr i b T,
|
||
substDim_eq_substDimExpr i b A,
|
||
CTerm.substDimBool_eq_substDim,
|
||
CTerm.substDimBool_eq_substDim,
|
||
CTerm.substDimBool_eq_substDim,
|
||
CTerm.substDimBool_eq_substDim,
|
||
CTerm.substDimBool_eq_substDim]
|
||
| .ind S params => by
|
||
show CType.ind S (CType.substDim.params i b params)
|
||
= CType.ind S (CType.substDimExpr.params i _ params)
|
||
rw [substDim_eq_substDimExpr.params i b params]
|
||
| .interval => rfl
|
||
| .lift A => by
|
||
show CType.lift (A.substDim i b) = CType.lift (A.substDimExpr i _)
|
||
rw [substDim_eq_substDimExpr i b A]
|
||
| .El P => by
|
||
show CType.El (CTerm.substDimBool i b P) =
|
||
CType.El (CTerm.substDim i (if b then DimExpr.one else DimExpr.zero) P)
|
||
rw [CTerm.substDimBool_eq_substDim]
|
||
| .flat A => by
|
||
show CType.flat (A.substDim i b) = CType.flat (A.substDimExpr i _)
|
||
rw [substDim_eq_substDimExpr i b A]
|
||
| .sharp A => by
|
||
show CType.sharp (A.substDim i b) = CType.sharp (A.substDimExpr i _)
|
||
rw [substDim_eq_substDimExpr i b A]
|
||
| .shape A => by
|
||
show CType.shape (A.substDim i b) = CType.shape (A.substDimExpr i _)
|
||
rw [substDim_eq_substDimExpr i b A]
|
||
|
||
/-- Helper: pointwise equality between `substDim.params` and
|
||
`substDimExpr.params` at the canonical endpoint DimExpr. -/
|
||
def substDim_eq_substDimExpr.params (i : DimVar) (b : Bool) :
|
||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||
CType.substDim.params i b params =
|
||
CType.substDimExpr.params i (if b then DimExpr.one else DimExpr.zero) params
|
||
| [] => rfl
|
||
| ⟨ℓ, A⟩ :: rest => by
|
||
show ⟨ℓ, A.substDim i b⟩ :: CType.substDim.params i b rest
|
||
= ⟨ℓ, A.substDimExpr i _⟩ :: CType.substDimExpr.params i _ rest
|
||
rw [substDim_eq_substDimExpr i b A,
|
||
substDim_eq_substDimExpr.params i b rest]
|
||
end
|
||
|
||
-- ── Face connection ───────────────────────────────────────────────────────────
|
||
|
||
/-- At the i=0 face (env i = false), substDim i (env i) is substDim i false. -/
|
||
theorem substDim_at_false {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (env : DimVar → Bool)
|
||
(h : env i = false) :
|
||
A.substDim i (env i) = A.substDim i false := by
|
||
rw [h]
|
||
|
||
/-- At the i=1 face (env i = true), substDim i (env i) is substDim i true. -/
|
||
theorem substDim_at_true {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (env : DimVar → Bool)
|
||
(h : env i = true) :
|
||
A.substDim i (env i) = A.substDim i true := by
|
||
rw [h]
|
||
|
||
-- ── Deferred: idempotence and commutativity ───────────────────────────────────
|
||
-- substDim_idem and substDim_comm require simultaneous induction over the
|
||
-- CType/CTerm mutual inductive; deferred to DimLine.lean as in the original.
|
||
|
||
theorem substDim_comm_univ {ℓ : ULevel} (i j : DimVar) (b c : Bool) :
|
||
((univ (ℓ := ℓ)).substDim i b).substDim j c =
|
||
((univ (ℓ := ℓ)).substDim j c).substDim i b := rfl
|
||
|
||
end CType
|
||
|
||
-- Note: dimAbsent, substDimBool_idem, and substDim_idem are proved in
|
||
-- DimLine.lean, which is downstream and has access to dimAbsent predicates.
|