6e4936d6ee
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per the elegance pass: 9 ad-hoc per-modality constructors collapse into
3 ModalityKind-parameterised constructors. Future modalities (Phase
4's ʃ_EML, ℑ infinitesimal) extend ModalityKind by adding cases —
no new constructors, no new ABI bump.
New Lean enum (Syntax.lean):
inductive ModalityKind | flat | sharp | shape
deriving DecidableEq, Repr, Inhabited
Constructor unification:
· CType: 3 (.flat / .sharp / .shape) → 1 (.modal k A)
· CTerm: 6 (.flatIntro / .sharpIntro / .shapeIntro / .flatElim /
.sharpElim / .shapeElim) → 2 (.modalIntro k a, .modalElim k f m)
· CVal: 3 (vFlatIntro / vSharpIntro / vShapeIntro) → 1 (vModalIntro)
· CNeu: 3 (nflatElim / nsharpElim / nshapeElim) → 1 (nModalElim)
· SkeletalCType: 3 (skFlat / skSharp / skShape) → 1 (skModal k)
Engine cascade across 12 files (DecEq, DimLine, Eval, FFITest, Modal,
Question, Readback, Reflect, Subst, Syntax, Typing, Value): every
match site collapsed from 3-per-modality arms to 1 k-parameterised arm.
Reflect.lean: new `reflectModalityKind` / `reifyModalityKind` helpers
+ ModalityKind dispatch arm in classifyFieldType. The Phase 1 macro
auto-derived per-constructor reflect/reify for the new unified
constructors — no manual cascade needed there.
Eval.lean β-rule: `.modalElim k f (.modalIntro k' a)` β-reduces only
when k = k' (kind-discrimination preserves cross-kind correctness even
if typing is bypassed); cross-kind case produces a marker neutral.
Modal.lean transient alias block (top of file, outside namespace) for
backward dot-syntax reference (`.flatIntro a` resolves to
`.modalIntro .flat a` via abbrev). Phase 3 will rewrite Modal.lean
properly to use the unified constructors directly + forModalityKind-
derived functor.
Net: −145 lines across the cascade (-478 deletions, +333 insertions).
Build: lake build (48 jobs) + lake build CubicalTransport (43 jobs) PASS.
Runtime: lake exe cubical-test 49/49 + 46/46 = 95/95 PASS.
Sorry count: Modal.lean 3 (unchanged), total engine 33 (no new sorries
from this phase, all annotated).
The Rust ABI v6 still uses 9 modal tags — diverges from the Lean side
after this commit but FFI tests don't exercise modal paths so no
runtime regression. Phase 4 will sync to ABI v7.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
328 lines
15 KiB
Text
328 lines
15 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 former: descend into the inner type, preserving the kind.
|
||
| .modal k A => .modal k (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 former: descend into the inner type, preserving the kind.
|
||
| .modal k A => .modal k (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_modal {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||
(k : ModalityKind) (A : CType ℓ) :
|
||
(CType.modal k A).substDim i b = .modal k (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_modal {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||
(k : ModalityKind) (A : CType ℓ) :
|
||
(CType.modal k A).substDimExpr i r = .modal k (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]
|
||
| .modal k A => by
|
||
show CType.modal k (A.substDim i b) = CType.modal k (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.
|