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>
1021 lines
46 KiB
Text
1021 lines
46 KiB
Text
/-
|
||
CubicalTransport.DimLine
|
||
=======================
|
||
Lines of types — the domain of transport (Step 2 of the transport plan).
|
||
|
||
A DimLine is a type abstracted over one dimension variable: λi. A
|
||
This is the argument to transpⁱ (λi. A) φ t₀.
|
||
|
||
The two endpoints are:
|
||
at0 = A[i := false] — the type at i = 0
|
||
at1 = A[i := true] — the type at i = 1
|
||
|
||
A constant line const A i packages A with binder i.
|
||
When i does not appear free in A, at0 = at1 = A.
|
||
|
||
The face connection (atBool_eq0_face / atBool_eq1_face) states that
|
||
whenever eq0 i or eq1 i holds in an environment, the environment's
|
||
value at i selects the correct endpoint type.
|
||
-/
|
||
|
||
import CubicalTransport.Subst
|
||
|
||
-- ── DimLine ───────────────────────────────────────────────────────────────────
|
||
|
||
/-- A line of types: a CType abstracted over one dimension variable.
|
||
Universe-indexed: lines preserve the universe level of their body. -/
|
||
structure DimLine (ℓ : ULevel) where
|
||
binder : DimVar
|
||
body : CType ℓ
|
||
|
||
-- ── Endpoint projections ──────────────────────────────────────────────────────
|
||
|
||
def DimLine.at0 {ℓ : ULevel} (L : DimLine ℓ) : CType ℓ :=
|
||
L.body.substDim L.binder false
|
||
def DimLine.at1 {ℓ : ULevel} (L : DimLine ℓ) : CType ℓ :=
|
||
L.body.substDim L.binder true
|
||
def DimLine.atBool {ℓ : ULevel} (L : DimLine ℓ) (b : Bool) : CType ℓ :=
|
||
L.body.substDim L.binder b
|
||
|
||
-- ── atBool reduction lemmas ───────────────────────────────────────────────────
|
||
|
||
theorem DimLine.atBool_false {ℓ : ULevel} (L : DimLine ℓ) : L.atBool false = L.at0 := rfl
|
||
theorem DimLine.atBool_true {ℓ : ULevel} (L : DimLine ℓ) : L.atBool true = L.at1 := rfl
|
||
|
||
theorem DimLine.atBool_cases {ℓ : ULevel} (L : DimLine ℓ) (b : Bool) :
|
||
L.atBool b = if b then L.at1 else L.at0 := by cases b <;> rfl
|
||
|
||
-- ── Constant line ─────────────────────────────────────────────────────────────
|
||
|
||
def DimLine.const {ℓ : ULevel} (A : CType ℓ) (i : DimVar) : DimLine ℓ :=
|
||
{ binder := i, body := A }
|
||
|
||
theorem DimLine.const_at0 {ℓ : ULevel} (A : CType ℓ) (i : DimVar) :
|
||
(DimLine.const A i).at0 = A.substDim i false := rfl
|
||
|
||
theorem DimLine.const_at1 {ℓ : ULevel} (A : CType ℓ) (i : DimVar) :
|
||
(DimLine.const A i).at1 = A.substDim i true := rfl
|
||
|
||
-- ── Absent dimension ──────────────────────────────────────────────────────────
|
||
-- Syntactic predicate: i does not appear in any DimExpr within the term/type.
|
||
-- `DimExpr.dimAbsent` is defined in Interval.lean (its natural home).
|
||
|
||
mutual
|
||
def CTerm.dimAbsent (i : DimVar) : CTerm → Bool
|
||
| .var _ => true
|
||
| .lam _ t => t.dimAbsent i
|
||
| .app f a => f.dimAbsent i && a.dimAbsent i
|
||
| .plam j t => if j = i then true else t.dimAbsent i
|
||
| .papp t r => t.dimAbsent i && r.dimAbsent i
|
||
-- transp/comp: A is ignored here (matching the same approximation
|
||
-- in `CTerm.substDim`). φ is checked via FaceFormula.dimAbsent.
|
||
| .transp _ _ φ t => φ.dimAbsent i && t.dimAbsent i
|
||
| .comp _ _ φ u t => φ.dimAbsent i && u.dimAbsent i && t.dimAbsent i
|
||
| .compN _ _ clauses t =>
|
||
CTerm.dimAbsent.clauses i clauses && t.dimAbsent i
|
||
-- Glue introduction / elimination: check face + all sub-terms.
|
||
| .glueIn φ t a => φ.dimAbsent i && t.dimAbsent i && a.dimAbsent i
|
||
| .unglue φ f g => φ.dimAbsent i && f.dimAbsent i && g.dimAbsent i
|
||
-- Σ constructors: structural recursion into sub-terms.
|
||
| .pair a b => a.dimAbsent i && b.dimAbsent i
|
||
| .fst t => t.dimAbsent i
|
||
| .snd t => t.dimAbsent i
|
||
-- REL1 inductive-type constructors. Schema and ctor/elim *params*
|
||
-- are static (caller-supplied externally to any binder we'd be
|
||
-- substituting into) — same approximation as transp/comp's `A`.
|
||
| .dimExpr s => s.dimAbsent i
|
||
| .ctor _ _ _ args => CTerm.dimAbsent.list i args
|
||
| .indElim _ _ motive branches target =>
|
||
motive.dimAbsent i &&
|
||
CTerm.dimAbsent.branches i branches &&
|
||
target.dimAbsent i
|
||
-- Universe-code constructor: A is not recursed into (matches the
|
||
-- substDim approximation in Syntax.lean — the CType payload is
|
||
-- conservatively assumed to be dim-stable).
|
||
| .code _ => true
|
||
-- Modal introduction: dim-absence is preserved through the wrapper.
|
||
| .modalIntro _ a => a.dimAbsent i
|
||
-- Modal elimination: check both the eliminator and the scrutinee.
|
||
| .modalElim _ f m => f.dimAbsent i && m.dimAbsent i
|
||
|
||
/-- Helper: check that `i` is absent from every clause in a system. -/
|
||
def CTerm.dimAbsent.clauses (i : DimVar) :
|
||
List (FaceFormula × CTerm) → Bool
|
||
| [] => true
|
||
| (φ, u) :: rest =>
|
||
φ.dimAbsent i && u.dimAbsent i && CTerm.dimAbsent.clauses i rest
|
||
|
||
/-- Helper: check `i` absent from every CTerm in a list (ctor args). -/
|
||
def CTerm.dimAbsent.list (i : DimVar) : List CTerm → Bool
|
||
| [] => true
|
||
| t :: rest => t.dimAbsent i && CTerm.dimAbsent.list i rest
|
||
|
||
/-- Helper: check `i` absent from every branch body of an `indElim`. -/
|
||
def CTerm.dimAbsent.branches (i : DimVar) :
|
||
List (String × CTerm) → Bool
|
||
| [] => true
|
||
| (_, b) :: rest =>
|
||
b.dimAbsent i && CTerm.dimAbsent.branches i rest
|
||
end
|
||
|
||
mutual
|
||
def CType.dimAbsent {ℓ : ULevel} (i : DimVar) : CType ℓ → Bool
|
||
| .univ => true
|
||
| .pi _ A B => A.dimAbsent i && B.dimAbsent i
|
||
| .path A a t => A.dimAbsent i && a.dimAbsent i && t.dimAbsent i
|
||
| .sigma _ A B => A.dimAbsent i && B.dimAbsent i
|
||
| .glue φ T f fInv sec ret coh A =>
|
||
φ.dimAbsent i && T.dimAbsent i &&
|
||
f.dimAbsent i && fInv.dimAbsent i &&
|
||
sec.dimAbsent i && ret.dimAbsent i && coh.dimAbsent i &&
|
||
A.dimAbsent i
|
||
| .ind _ params => CType.dimAbsent.params i params
|
||
| .interval => true -- REL2: 𝕀 carries no dim binders
|
||
| .lift A => A.dimAbsent i
|
||
| .El P => P.dimAbsent i
|
||
-- Modal type former: dim-absence reduces to the inner type's.
|
||
| .modal _ A => A.dimAbsent i
|
||
|
||
/-- Helper: check `i` absent from every CType in a level-heterogeneous
|
||
parameter list. -/
|
||
def CType.dimAbsent.params (i : DimVar) :
|
||
List (Σ ℓ : ULevel, CType ℓ) → Bool
|
||
| [] => true
|
||
| ⟨_, A⟩ :: rest => A.dimAbsent i && CType.dimAbsent.params i rest
|
||
end
|
||
|
||
-- ── Absence → subst is identity: DimExpr level ───────────────────────────────
|
||
|
||
-- "sub `var i → X` in `r` leaves r unchanged when i is absent from r"
|
||
-- Note: DimExpr.subst i X r substitutes (var i → X) in r.
|
||
-- Dot notation r.subst i X inserts r as the *replacement*, not target —
|
||
-- so we write the explicit form DimExpr.subst i X r here.
|
||
theorem DimExpr.subst_of_absent (i : DimVar) (X : DimExpr) (r : DimExpr)
|
||
(h : r.dimAbsent i = true) :
|
||
DimExpr.subst i X r = r := by
|
||
induction r with
|
||
| zero => rfl
|
||
| one => rfl
|
||
| var j =>
|
||
simp only [dimAbsent, bne_iff_ne] at h
|
||
simp only [DimExpr.subst, if_neg h]
|
||
| inv r ih =>
|
||
simp only [dimAbsent] at h; simp [DimExpr.subst, ih h]
|
||
| meet r s ihr ihs =>
|
||
simp only [dimAbsent, Bool.and_eq_true] at h
|
||
simp [DimExpr.subst, ihr h.1, ihs h.2]
|
||
| join r s ihr ihs =>
|
||
simp only [dimAbsent, Bool.and_eq_true] at h
|
||
simp [DimExpr.subst, ihr h.1, ihs h.2]
|
||
|
||
-- ── Absence → subst is identity: CTerm and CType ─────────────────────────────
|
||
-- These require simultaneous induction on the CTerm/CType mutual inductive.
|
||
-- The `induction` tactic is blocked for mutual types, so we use a `def`
|
||
-- (which Lean accepts for structural recursion via match) to build the proof.
|
||
--
|
||
-- Generalised to arbitrary `r : DimExpr` (not just Bool endpoints) — needed
|
||
-- for line reversal in transport, where `r = inv i`. The Bool version is
|
||
-- a corollary at the canonical endpoint DimExpr.
|
||
|
||
mutual
|
||
private def CTerm.substDim_absent_aux (i : DimVar) (r : DimExpr) :
|
||
(t : CTerm) → CTerm.dimAbsent i t = true → CTerm.substDim i r t = t
|
||
| .var _, _ => rfl
|
||
| .lam x t, h => by
|
||
simp only [CTerm.dimAbsent] at h
|
||
show CTerm.lam x (t.substDim i r) = CTerm.lam x t
|
||
congr 1; exact CTerm.substDim_absent_aux i r t h
|
||
| .app f a, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
show CTerm.app (f.substDim i r) (a.substDim i r) = CTerm.app f a
|
||
congr 1
|
||
· exact CTerm.substDim_absent_aux i r f h.1
|
||
· exact CTerm.substDim_absent_aux i r a h.2
|
||
| .plam j t, h => by
|
||
show (if j = i then CTerm.plam j t
|
||
else CTerm.plam j (t.substDim i r)) = CTerm.plam j t
|
||
by_cases hji : j = i
|
||
· subst hji; simp only [ite_true]
|
||
· simp only [if_neg hji]
|
||
simp only [CTerm.dimAbsent, if_neg hji] at h
|
||
exact congrArg (CTerm.plam j) (CTerm.substDim_absent_aux i r t h)
|
||
| .papp t s, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
show CTerm.papp (t.substDim i r) (DimExpr.subst i r s) = CTerm.papp t s
|
||
congr 1
|
||
· exact CTerm.substDim_absent_aux i r t h.1
|
||
· exact DimExpr.subst_of_absent i r s h.2
|
||
| .transp j A φ t, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
have hφ := FaceFormula.substDim_of_absent i r φ h.1
|
||
have ht := CTerm.substDim_absent_aux i r t h.2
|
||
rw [hφ, ht]
|
||
| .comp j A φ u t, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
obtain ⟨⟨hφ, hu⟩, ht⟩ := h
|
||
rw [FaceFormula.substDim_of_absent i r φ hφ,
|
||
CTerm.substDim_absent_aux i r u hu,
|
||
CTerm.substDim_absent_aux i r t ht]
|
||
| .compN j A clauses t, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim.clauses_of_absent i r clauses h.1,
|
||
CTerm.substDim_absent_aux i r t h.2]
|
||
| .glueIn φ t a, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
obtain ⟨⟨hφ, ht⟩, ha⟩ := h
|
||
rw [FaceFormula.substDim_of_absent i r φ hφ,
|
||
CTerm.substDim_absent_aux i r t ht,
|
||
CTerm.substDim_absent_aux i r a ha]
|
||
| .unglue φ f g, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
obtain ⟨⟨hφ, hf⟩, hg⟩ := h
|
||
rw [FaceFormula.substDim_of_absent i r φ hφ,
|
||
CTerm.substDim_absent_aux i r f hf,
|
||
CTerm.substDim_absent_aux i r g hg]
|
||
| .pair a b, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim_absent_aux i r a h.1,
|
||
CTerm.substDim_absent_aux i r b h.2]
|
||
| .fst t, h => by
|
||
simp only [CTerm.dimAbsent] at h
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim_absent_aux i r t h]
|
||
| .snd t, h => by
|
||
simp only [CTerm.dimAbsent] at h
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim_absent_aux i r t h]
|
||
| .dimExpr s, h => by
|
||
simp only [CTerm.dimAbsent] at h
|
||
simp only [CTerm.substDim]
|
||
rw [DimExpr.subst_of_absent i r s h]
|
||
| .ctor S c params args, h => by
|
||
simp only [CTerm.dimAbsent] at h
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim.list_of_absent i r args h]
|
||
| .indElim S params motive branches target, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
obtain ⟨⟨hm, hbr⟩, htg⟩ := h
|
||
rw [CTerm.substDim_absent_aux i r motive hm,
|
||
CTerm.substDim.branches_of_absent i r branches hbr,
|
||
CTerm.substDim_absent_aux i r target htg]
|
||
| .code _, _ => rfl
|
||
| .modalIntro _ a, h => by
|
||
simp only [CTerm.dimAbsent] at h
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim_absent_aux i r a h]
|
||
| .modalElim _ f m, h => by
|
||
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim_absent_aux i r f h.1,
|
||
CTerm.substDim_absent_aux i r m h.2]
|
||
|
||
/-- Helper: `substDim.clauses` is identity on clause lists whose every
|
||
`(face, body)` pair has `i` absent. -/
|
||
private def CTerm.substDim.clauses_of_absent (i : DimVar) (r : DimExpr) :
|
||
(clauses : List (FaceFormula × CTerm)) →
|
||
CTerm.dimAbsent.clauses i clauses = true →
|
||
CTerm.substDim.clauses i r clauses = clauses
|
||
| [], _ => rfl
|
||
| (φ, u) :: rest, h => by
|
||
simp only [CTerm.dimAbsent.clauses, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim.clauses]
|
||
obtain ⟨⟨hφ, hu⟩, hrest⟩ := h
|
||
rw [FaceFormula.substDim_of_absent i r φ hφ,
|
||
CTerm.substDim_absent_aux i r u hu,
|
||
CTerm.substDim.clauses_of_absent i r rest hrest]
|
||
|
||
/-- Helper: `substDim.list` is identity on CTerm lists with `i` absent
|
||
from every element. -/
|
||
private def CTerm.substDim.list_of_absent (i : DimVar) (r : DimExpr) :
|
||
(ts : List CTerm) →
|
||
CTerm.dimAbsent.list i ts = true →
|
||
CTerm.substDim.list i r ts = ts
|
||
| [], _ => rfl
|
||
| t :: rest, h => by
|
||
simp only [CTerm.dimAbsent.list, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim.list]
|
||
rw [CTerm.substDim_absent_aux i r t h.1,
|
||
CTerm.substDim.list_of_absent i r rest h.2]
|
||
|
||
/-- Helper: `substDim.branches` is identity on branch lists whose every
|
||
body has `i` absent. -/
|
||
private def CTerm.substDim.branches_of_absent (i : DimVar) (r : DimExpr) :
|
||
(brs : List (String × CTerm)) →
|
||
CTerm.dimAbsent.branches i brs = true →
|
||
CTerm.substDim.branches i r brs = brs
|
||
| [], _ => rfl
|
||
| (n, b) :: rest, h => by
|
||
simp only [CTerm.dimAbsent.branches, Bool.and_eq_true] at h
|
||
simp only [CTerm.substDim.branches]
|
||
rw [CTerm.substDim_absent_aux i r b h.1,
|
||
CTerm.substDim.branches_of_absent i r rest h.2]
|
||
end
|
||
|
||
/-- Generalised: `CTerm.substDim i r t = t` whenever `i` is absent from `t`,
|
||
for any DimExpr `r`. -/
|
||
theorem CTerm.substDim_of_absent (i : DimVar) (r : DimExpr) (t : CTerm)
|
||
(h : CTerm.dimAbsent i t = true) : CTerm.substDim i r t = t :=
|
||
CTerm.substDim_absent_aux i r t h
|
||
|
||
/-- Bool-endpoint corollary of `CTerm.substDim_of_absent`. -/
|
||
theorem CTerm.substDimBool_of_absent (i : DimVar) (b : Bool) (t : CTerm)
|
||
(h : CTerm.dimAbsent i t = true) : CTerm.substDimBool i b t = t := by
|
||
unfold CTerm.substDimBool
|
||
exact CTerm.substDim_of_absent i _ t h
|
||
|
||
mutual
|
||
private def CType.substDim_absent_aux {ℓ : ULevel} (i : DimVar) (b : Bool) :
|
||
(A : CType ℓ) → CType.dimAbsent i A = true → CType.substDim i b A = A
|
||
| .univ, _ => rfl
|
||
| .pi var A B, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.pi var (CType.substDim i b A) (CType.substDim i b B) =
|
||
CType.pi var A B
|
||
congr 1
|
||
· exact CType.substDim_absent_aux i b A h.1
|
||
· exact CType.substDim_absent_aux i b B h.2
|
||
| .path A a t, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.path (CType.substDim i b A)
|
||
(CTerm.substDimBool i b a) (CTerm.substDimBool i b t) =
|
||
CType.path A a t
|
||
congr 1
|
||
· exact CType.substDim_absent_aux i b A h.1.1
|
||
· exact CTerm.substDimBool_of_absent i b a h.1.2
|
||
· exact CTerm.substDimBool_of_absent i b t h.2
|
||
| .sigma var A B, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.sigma var (CType.substDim i b A) (CType.substDim i b B) =
|
||
CType.sigma var A B
|
||
congr 1
|
||
· exact CType.substDim_absent_aux i b A h.1
|
||
· exact CType.substDim_absent_aux i b B h.2
|
||
| .glue φ T f fInv sec ret coh A, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.glue (φ.substDim i (if b then DimExpr.one else DimExpr.zero))
|
||
(CType.substDim i b T)
|
||
(CTerm.substDimBool i b f) (CTerm.substDimBool i b fInv)
|
||
(CTerm.substDimBool i b sec) (CTerm.substDimBool i b ret)
|
||
(CTerm.substDimBool i b coh)
|
||
(CType.substDim i b A) =
|
||
CType.glue φ T f fInv sec ret coh A
|
||
obtain ⟨⟨⟨⟨⟨⟨⟨hφ, hT⟩, hf⟩, hfInv⟩, hsec⟩, hret⟩, hcoh⟩, hA⟩ := h
|
||
rw [FaceFormula.substDim_of_absent i _ φ hφ,
|
||
CType.substDim_absent_aux i b T hT,
|
||
CTerm.substDimBool_of_absent i b f hf,
|
||
CTerm.substDimBool_of_absent i b fInv hfInv,
|
||
CTerm.substDimBool_of_absent i b sec hsec,
|
||
CTerm.substDimBool_of_absent i b ret hret,
|
||
CTerm.substDimBool_of_absent i b coh hcoh,
|
||
CType.substDim_absent_aux i b A hA]
|
||
| .ind S params, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
simp only [CType.substDim]
|
||
rw [CType.substDim.params_of_absent i b params h]
|
||
| .interval, _ => rfl
|
||
| .lift A, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
show CType.lift (CType.substDim i b A) = CType.lift A
|
||
congr 1
|
||
exact CType.substDim_absent_aux i b A h
|
||
| .El P, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
show CType.El (CTerm.substDimBool i b P) = CType.El P
|
||
congr 1
|
||
exact CTerm.substDimBool_of_absent i b P h
|
||
| .modal k A, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
show CType.modal k (CType.substDim i b A) = CType.modal k A
|
||
congr 1
|
||
exact CType.substDim_absent_aux i b A h
|
||
|
||
/-- Helper: `CType.substDim.params i b` is identity on level-
|
||
heterogeneous parameter lists with `i` absent from every entry. -/
|
||
private def CType.substDim.params_of_absent (i : DimVar) (b : Bool) :
|
||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||
CType.dimAbsent.params i params = true →
|
||
CType.substDim.params i b params = params
|
||
| [], _ => rfl
|
||
| ⟨ℓ, A⟩ :: rest, h => by
|
||
simp only [CType.dimAbsent.params, Bool.and_eq_true] at h
|
||
simp only [CType.substDim.params]
|
||
rw [CType.substDim_absent_aux i b A h.1,
|
||
CType.substDim.params_of_absent i b rest h.2]
|
||
end
|
||
|
||
theorem CType.substDim_of_absent {ℓ : ULevel} (i : DimVar) (b : Bool) (A : CType ℓ)
|
||
(h : CType.dimAbsent i A = true) : CType.substDim i b A = A :=
|
||
CType.substDim_absent_aux i b A h
|
||
|
||
-- ── CType.substDimExpr absent-subst (general DimExpr version) ─────────────────
|
||
|
||
mutual
|
||
private def CType.substDimExpr_absent_aux {ℓ : ULevel} (i : DimVar) (r : DimExpr) :
|
||
(A : CType ℓ) → CType.dimAbsent i A = true → CType.substDimExpr i r A = A
|
||
| .univ, _ => rfl
|
||
| .pi var A B, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.pi var (A.substDimExpr i r) (B.substDimExpr i r) =
|
||
CType.pi var A B
|
||
congr 1
|
||
· exact CType.substDimExpr_absent_aux i r A h.1
|
||
· exact CType.substDimExpr_absent_aux i r B h.2
|
||
| .path A a t, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r) =
|
||
CType.path A a t
|
||
congr 1
|
||
· exact CType.substDimExpr_absent_aux i r A h.1.1
|
||
· exact CTerm.substDim_of_absent i r a h.1.2
|
||
· exact CTerm.substDim_of_absent i r t h.2
|
||
| .sigma var A B, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.sigma var (A.substDimExpr i r) (B.substDimExpr i r) =
|
||
CType.sigma var A B
|
||
congr 1
|
||
· exact CType.substDimExpr_absent_aux i r A h.1
|
||
· exact CType.substDimExpr_absent_aux i r B h.2
|
||
| .glue φ T f fInv sec ret coh A, h => by
|
||
simp only [CType.dimAbsent, Bool.and_eq_true] at h
|
||
show CType.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) =
|
||
CType.glue φ T f fInv sec ret coh A
|
||
obtain ⟨⟨⟨⟨⟨⟨⟨hφ, hT⟩, hf⟩, hfInv⟩, hsec⟩, hret⟩, hcoh⟩, hA⟩ := h
|
||
rw [FaceFormula.substDim_of_absent i r φ hφ,
|
||
CType.substDimExpr_absent_aux i r T hT,
|
||
CTerm.substDim_of_absent i r f hf,
|
||
CTerm.substDim_of_absent i r fInv hfInv,
|
||
CTerm.substDim_of_absent i r sec hsec,
|
||
CTerm.substDim_of_absent i r ret hret,
|
||
CTerm.substDim_of_absent i r coh hcoh,
|
||
CType.substDimExpr_absent_aux i r A hA]
|
||
| .ind S params, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
simp only [CType.substDimExpr]
|
||
rw [CType.substDimExpr.params_of_absent i r params h]
|
||
| .interval, _ => rfl
|
||
| .lift A, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
show CType.lift (A.substDimExpr i r) = CType.lift A
|
||
congr 1
|
||
exact CType.substDimExpr_absent_aux i r A h
|
||
| .El P, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
show CType.El (CTerm.substDim i r P) = CType.El P
|
||
congr 1
|
||
exact CTerm.substDim_of_absent i r P h
|
||
| .modal k A, h => by
|
||
simp only [CType.dimAbsent] at h
|
||
show CType.modal k (A.substDimExpr i r) = CType.modal k A
|
||
congr 1
|
||
exact CType.substDimExpr_absent_aux i r A h
|
||
|
||
/-- Helper: `CType.substDimExpr.params i r` is identity on level-
|
||
heterogeneous parameter lists with `i` absent from every entry. -/
|
||
private def CType.substDimExpr.params_of_absent (i : DimVar) (r : DimExpr) :
|
||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||
CType.dimAbsent.params i params = true →
|
||
CType.substDimExpr.params i r params = params
|
||
| [], _ => rfl
|
||
| ⟨ℓ, A⟩ :: rest, h => by
|
||
simp only [CType.dimAbsent.params, Bool.and_eq_true] at h
|
||
simp only [CType.substDimExpr.params]
|
||
rw [CType.substDimExpr_absent_aux i r A h.1,
|
||
CType.substDimExpr.params_of_absent i r rest h.2]
|
||
end
|
||
|
||
/-- Generalised: when `i` is absent from `A`, substituting `i` by any
|
||
`DimExpr` leaves `A` unchanged. -/
|
||
theorem CType.substDimExpr_of_absent {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||
(A : CType ℓ) (h : CType.dimAbsent i A = true) :
|
||
CType.substDimExpr i r A = A :=
|
||
CType.substDimExpr_absent_aux i r A h
|
||
|
||
-- ── Constancy: at0 = at1 when binder is absent ───────────────────────────────
|
||
|
||
theorem DimLine.const_endpoints_eq {ℓ : ULevel} (A : CType ℓ) (i : DimVar)
|
||
(h : CType.dimAbsent i A = true) :
|
||
(DimLine.const A i).at0 = (DimLine.const A i).at1 := by
|
||
simp [DimLine.const_at0, DimLine.const_at1,
|
||
CType.substDim_of_absent i false A h,
|
||
CType.substDim_of_absent i true A h]
|
||
|
||
-- ── Face connection ───────────────────────────────────────────────────────────
|
||
|
||
/-- On the (eq0 i) face, the line evaluates to at0. -/
|
||
theorem DimLine.atBool_eq0_face {ℓ : ULevel} (L : DimLine ℓ) (env : DimVar → Bool)
|
||
(h : (FaceFormula.eq0 L.binder).eval env = true) :
|
||
L.atBool (env L.binder) = L.at0 := by
|
||
simp only [FaceFormula.eval] at h
|
||
cases hb : env L.binder with
|
||
| false => simp [DimLine.atBool, DimLine.at0]
|
||
| true => simp [hb] at h
|
||
|
||
/-- On the (eq1 i) face, the line evaluates to at1. -/
|
||
theorem DimLine.atBool_eq1_face {ℓ : ULevel} (L : DimLine ℓ) (env : DimVar → Bool)
|
||
(h : (FaceFormula.eq1 L.binder).eval env = true) :
|
||
L.atBool (env L.binder) = L.at1 := by
|
||
simp only [FaceFormula.eval] at h
|
||
cases hb : env L.binder with
|
||
| false => simp [hb] at h
|
||
| true => simp [DimLine.atBool, DimLine.at1]
|
||
|
||
/-- For any environment, atBool gives either at0 or at1. -/
|
||
theorem DimLine.atBool_is_endpoint {ℓ : ULevel} (L : DimLine ℓ) (env : DimVar → Bool) :
|
||
L.atBool (env L.binder) = L.at0 ∨ L.atBool (env L.binder) = L.at1 := by
|
||
cases env L.binder
|
||
· left; rfl
|
||
· right; rfl
|
||
|
||
-- ── Substitution idempotence ──────────────────────────────────────────────────
|
||
-- After substDimBool i b, dimension i is no longer free.
|
||
-- A second substDimBool i b is then a no-op (substDimBool_of_absent).
|
||
|
||
-- Step 1: substituting i out of a DimExpr makes i absent.
|
||
|
||
theorem DimExpr.dimAbsent_after_subst
|
||
(i : DimVar) (r : DimExpr) (hr : r.dimAbsent i = true)
|
||
(e : DimExpr) : (DimExpr.subst i r e).dimAbsent i = true := by
|
||
induction e with
|
||
| zero => rfl
|
||
| one => rfl
|
||
| var j =>
|
||
simp only [DimExpr.subst]
|
||
by_cases hji : j = i
|
||
· simp [hji, hr]
|
||
· simp only [if_neg hji, DimExpr.dimAbsent, bne_iff_ne]; exact hji
|
||
| inv e ih => simp [DimExpr.subst, DimExpr.dimAbsent, ih]
|
||
| meet a b iha ihb =>
|
||
simp only [DimExpr.subst, DimExpr.dimAbsent, iha, ihb, Bool.and_self]
|
||
| join a b iha ihb =>
|
||
simp only [DimExpr.subst, DimExpr.dimAbsent, iha, ihb, Bool.and_self]
|
||
|
||
-- `DimExpr.dimAbsent_endpoint` now lives in Interval.lean.
|
||
|
||
-- Step 2: after substDim i r, i is absent from any CTerm (mutual with a
|
||
-- helper `dimAbsent.clauses_after_substDim` for the compN clause list).
|
||
|
||
mutual
|
||
private def CTerm.dimAbsent_after_substDim_aux
|
||
(i : DimVar) (r : DimExpr) (hr : r.dimAbsent i = true) :
|
||
(t : CTerm) → (t.substDim i r).dimAbsent i = true
|
||
| .var _ => rfl
|
||
| .lam _ t => CTerm.dimAbsent_after_substDim_aux i r hr t
|
||
| .app f a => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr f,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr a, Bool.and_self]
|
||
| .plam j t => by
|
||
simp only [CTerm.substDim]
|
||
by_cases hji : j = i
|
||
· subst hji; simp [CTerm.dimAbsent]
|
||
· simp only [if_neg hji, CTerm.dimAbsent]
|
||
exact CTerm.dimAbsent_after_substDim_aux i r hr t
|
||
| .papp t s => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t,
|
||
DimExpr.dimAbsent_after_subst i r hr s, Bool.and_self]
|
||
| .transp _ _ φ t => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
FaceFormula.dimAbsent_after_substDim i r hr φ,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t, Bool.and_self]
|
||
| .comp _ _ φ u t => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
FaceFormula.dimAbsent_after_substDim i r hr φ,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr u,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t, Bool.and_self]
|
||
| .compN _ _ clauses t => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent.clauses_after_substDim i r hr clauses,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t, Bool.and_true]
|
||
| .glueIn φ t a => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
FaceFormula.dimAbsent_after_substDim i r hr φ,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr a, Bool.and_self]
|
||
| .unglue φ f g => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
FaceFormula.dimAbsent_after_substDim i r hr φ,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr f,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr g, Bool.and_self]
|
||
| .pair a b => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr a,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr b, Bool.and_self]
|
||
| .fst t => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t]
|
||
| .snd t => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t]
|
||
| .dimExpr s => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
DimExpr.dimAbsent_after_subst i r hr s]
|
||
| .ctor S c params args => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent.list_after_substDim i r hr args]
|
||
| .indElim S params motive branches target => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr motive,
|
||
CTerm.dimAbsent.branches_after_substDim i r hr branches,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr target, Bool.and_self]
|
||
| .code _ => by simp [CTerm.substDim, CTerm.dimAbsent]
|
||
| .modalIntro _ a => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr a]
|
||
| .modalElim _ f m => by
|
||
simp only [CTerm.substDim, CTerm.dimAbsent,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr f,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr m, Bool.and_self]
|
||
|
||
/-- Helper: `i` is absent from every clause in the result of substituting
|
||
`i := r` in a clause list (provided `r` doesn't mention `i`). -/
|
||
private def CTerm.dimAbsent.clauses_after_substDim
|
||
(i : DimVar) (r : DimExpr) (hr : r.dimAbsent i = true) :
|
||
(clauses : List (FaceFormula × CTerm)) →
|
||
CTerm.dimAbsent.clauses i (CTerm.substDim.clauses i r clauses) = true
|
||
| [] => rfl
|
||
| (φ, u) :: rest => by
|
||
simp only [CTerm.substDim.clauses, CTerm.dimAbsent.clauses,
|
||
Bool.and_eq_true]
|
||
refine ⟨⟨?_, ?_⟩, ?_⟩
|
||
· exact FaceFormula.dimAbsent_after_substDim i r hr φ
|
||
· exact CTerm.dimAbsent_after_substDim_aux i r hr u
|
||
· exact CTerm.dimAbsent.clauses_after_substDim i r hr rest
|
||
|
||
/-- Helper: `i` is absent from every CTerm in the result of substituting
|
||
`i := r` in a CTerm list. -/
|
||
private def CTerm.dimAbsent.list_after_substDim
|
||
(i : DimVar) (r : DimExpr) (hr : r.dimAbsent i = true) :
|
||
(ts : List CTerm) →
|
||
CTerm.dimAbsent.list i (CTerm.substDim.list i r ts) = true
|
||
| [] => rfl
|
||
| t :: rest => by
|
||
simp only [CTerm.substDim.list, CTerm.dimAbsent.list,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr t,
|
||
CTerm.dimAbsent.list_after_substDim i r hr rest, Bool.and_self]
|
||
|
||
/-- Helper: `i` is absent from every branch body in the result of
|
||
substituting `i := r` in a branch list. -/
|
||
private def CTerm.dimAbsent.branches_after_substDim
|
||
(i : DimVar) (r : DimExpr) (hr : r.dimAbsent i = true) :
|
||
(brs : List (String × CTerm)) →
|
||
CTerm.dimAbsent.branches i (CTerm.substDim.branches i r brs) = true
|
||
| [] => rfl
|
||
| (n, b) :: rest => by
|
||
simp only [CTerm.substDim.branches, CTerm.dimAbsent.branches,
|
||
CTerm.dimAbsent_after_substDim_aux i r hr b,
|
||
CTerm.dimAbsent.branches_after_substDim i r hr rest, Bool.and_self]
|
||
end
|
||
|
||
theorem CTerm.dimAbsent_after_substDimBool (i : DimVar) (b : Bool) (t : CTerm) :
|
||
(t.substDimBool i b).dimAbsent i = true :=
|
||
CTerm.dimAbsent_after_substDim_aux i _ (DimExpr.dimAbsent_endpoint i b) t
|
||
|
||
-- Step 3: after CType.substDim i b, i is absent from the type.
|
||
|
||
mutual
|
||
private def CType.dimAbsent_after_substDim_aux {ℓ : ULevel} (i : DimVar) (b : Bool) :
|
||
(A : CType ℓ) → (A.substDim i b).dimAbsent i = true
|
||
| .univ => rfl
|
||
| .pi _ A B => by
|
||
simp only [CType.substDim, CType.dimAbsent,
|
||
CType.dimAbsent_after_substDim_aux i b A,
|
||
CType.dimAbsent_after_substDim_aux i b B, Bool.and_self]
|
||
| .path A a t => by
|
||
simp only [CType.substDim, CType.dimAbsent,
|
||
CType.dimAbsent_after_substDim_aux i b A,
|
||
CTerm.dimAbsent_after_substDimBool i b a,
|
||
CTerm.dimAbsent_after_substDimBool i b t, Bool.and_self]
|
||
| .sigma _ A B => by
|
||
simp only [CType.substDim, CType.dimAbsent,
|
||
CType.dimAbsent_after_substDim_aux i b A,
|
||
CType.dimAbsent_after_substDim_aux i b B, Bool.and_self]
|
||
| .glue φ T f fInv sec ret coh A => by
|
||
simp only [CType.substDim, CType.dimAbsent,
|
||
FaceFormula.dimAbsent_after_substDim i _
|
||
(DimExpr.dimAbsent_endpoint i b) φ,
|
||
CType.dimAbsent_after_substDim_aux i b T,
|
||
CTerm.dimAbsent_after_substDimBool i b f,
|
||
CTerm.dimAbsent_after_substDimBool i b fInv,
|
||
CTerm.dimAbsent_after_substDimBool i b sec,
|
||
CTerm.dimAbsent_after_substDimBool i b ret,
|
||
CTerm.dimAbsent_after_substDimBool i b coh,
|
||
CType.dimAbsent_after_substDim_aux i b A, Bool.and_self]
|
||
| .ind S params => by
|
||
simp only [CType.substDim, CType.dimAbsent,
|
||
CType.dimAbsent.params_after_substDim i b params]
|
||
| .interval => rfl
|
||
| .lift A => by
|
||
simp only [CType.substDim, CType.dimAbsent,
|
||
CType.dimAbsent_after_substDim_aux i b A]
|
||
| .El P => by
|
||
simp only [CType.substDim, CType.dimAbsent]
|
||
exact CTerm.dimAbsent_after_substDimBool i b P
|
||
| .modal _ A => by
|
||
simp only [CType.substDim, CType.dimAbsent,
|
||
CType.dimAbsent_after_substDim_aux i b A]
|
||
|
||
/-- Helper: `i` absent from every CType in `substDim.params i b ps`. -/
|
||
private def CType.dimAbsent.params_after_substDim (i : DimVar) (b : Bool) :
|
||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||
CType.dimAbsent.params i (CType.substDim.params i b params) = true
|
||
| [] => rfl
|
||
| ⟨_, A⟩ :: rest => by
|
||
simp only [CType.substDim.params, CType.dimAbsent.params,
|
||
CType.dimAbsent_after_substDim_aux i b A,
|
||
CType.dimAbsent.params_after_substDim i b rest, Bool.and_self]
|
||
end
|
||
|
||
theorem CType.dimAbsent_after_substDim {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||
(A : CType ℓ) : (A.substDim i b).dimAbsent i = true :=
|
||
CType.dimAbsent_after_substDim_aux i b A
|
||
|
||
-- Step 4: idempotence.
|
||
|
||
/-- Substituting dimension i twice at the same Bool endpoint is idempotent:
|
||
after the first subst i is absent; the second is a no-op. -/
|
||
theorem CTerm.substDimBool_idem (i : DimVar) (b : Bool) (t : CTerm) :
|
||
(t.substDimBool i b).substDimBool i b = t.substDimBool i b :=
|
||
CTerm.substDimBool_of_absent i b _ (CTerm.dimAbsent_after_substDimBool i b t)
|
||
|
||
theorem CType.substDim_idem {ℓ : ULevel} (i : DimVar) (b : Bool) (A : CType ℓ) :
|
||
(A.substDim i b).substDim i b = A.substDim i b :=
|
||
CType.substDim_of_absent i b _ (CType.dimAbsent_after_substDim i b A)
|
||
|
||
-- ── Substitution commutativity ────────────────────────────────────────────────
|
||
-- Substituting at disjoint dimensions i ≠ j commutes.
|
||
-- General preconditions: r.dimAbsent j = true (r doesn't use j) and vice versa.
|
||
-- For Bool endpoints (.zero / .one) both hold trivially.
|
||
|
||
theorem DimExpr.subst_comm
|
||
(i j : DimVar) (r s : DimExpr) (hij : i ≠ j)
|
||
(hrj : r.dimAbsent j = true) (hsi : s.dimAbsent i = true)
|
||
(e : DimExpr) :
|
||
DimExpr.subst i r (DimExpr.subst j s e) =
|
||
DimExpr.subst j s (DimExpr.subst i r e) := by
|
||
induction e with
|
||
| zero => rfl
|
||
| one => rfl
|
||
| var k =>
|
||
by_cases hki : k = i
|
||
· subst hki
|
||
-- LHS: subst i r (subst j s (var i))
|
||
-- = subst i r (var i) [i ≠ j]
|
||
-- = r
|
||
-- RHS: subst j s (subst i r (var i))
|
||
-- = subst j s r = r [r absent from j]
|
||
simp only [DimExpr.subst, if_neg hij, ite_true,
|
||
DimExpr.subst_of_absent j s r hrj]
|
||
· by_cases hkj : k = j
|
||
· subst hkj
|
||
-- LHS: subst i r (subst j s (var j))
|
||
-- = subst i r s = s [s absent from i]
|
||
-- RHS: subst j s (subst i r (var j))
|
||
-- = subst j s (var j) [j ≠ i]
|
||
-- = s
|
||
simp only [DimExpr.subst, if_neg hki, ite_true,
|
||
DimExpr.subst_of_absent i r s hsi]
|
||
· -- k ≠ i, k ≠ j: both sides reduce to var k
|
||
simp [DimExpr.subst, hki, hkj]
|
||
| inv e ih => simp [DimExpr.subst, ih]
|
||
| meet a b iha ihb => simp [DimExpr.subst, iha, ihb]
|
||
| join a b iha ihb => simp [DimExpr.subst, iha, ihb]
|
||
|
||
-- Bool endpoints have dimAbsent = true for every dimension.
|
||
private theorem DimExpr.subst_comm_bool
|
||
(i j : DimVar) (b c : Bool) (hij : i ≠ j) (e : DimExpr) :
|
||
DimExpr.subst i (if b then .one else .zero)
|
||
(DimExpr.subst j (if c then .one else .zero) e) =
|
||
DimExpr.subst j (if c then .one else .zero)
|
||
(DimExpr.subst i (if b then .one else .zero) e) :=
|
||
DimExpr.subst_comm i j _ _ hij
|
||
(DimExpr.dimAbsent_endpoint j b) (DimExpr.dimAbsent_endpoint i c) e
|
||
|
||
-- CTerm commutativity — private def for structural recursion, mutual with
|
||
-- its clause-list helper so the .compN arm can recurse through the list.
|
||
|
||
mutual
|
||
private def CTerm.substDim_comm_aux
|
||
(i j : DimVar) (r s : DimExpr) (hij : i ≠ j)
|
||
(hrj : r.dimAbsent j = true) (hsi : s.dimAbsent i = true) :
|
||
(t : CTerm) →
|
||
(t.substDim i r).substDim j s =
|
||
(t.substDim j s).substDim i r
|
||
| .var _ => rfl
|
||
| .lam x t => congrArg (CTerm.lam x) (CTerm.substDim_comm_aux i j r s hij hrj hsi t)
|
||
| .app f a => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi f
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi a
|
||
| .plam k t => by
|
||
by_cases hki : k = i <;> by_cases hkj : k = j
|
||
· exact absurd (hki.symm.trans hkj) hij
|
||
· subst hki
|
||
simp only [CTerm.substDim, ite_true, if_neg hij]
|
||
· subst hkj
|
||
simp only [CTerm.substDim, ite_true, if_neg (Ne.symm hij)]
|
||
· simp only [CTerm.substDim, if_neg hki, if_neg hkj]
|
||
exact congrArg (CTerm.plam k) (CTerm.substDim_comm_aux i j r s hij hrj hsi t)
|
||
| .papp t e => by
|
||
simp only [CTerm.substDim]
|
||
rw [CTerm.substDim_comm_aux i j r s hij hrj hsi t,
|
||
(DimExpr.subst_comm i j r s hij hrj hsi e).symm]
|
||
| .transp k A φ t => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact FaceFormula.substDim_comm i j r s hij hrj hsi φ
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi t
|
||
| .comp _ _ φ u t => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact FaceFormula.substDim_comm i j r s hij hrj hsi φ
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi u
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi t
|
||
| .compN _ _ clauses t => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact CTerm.substDim.clauses_comm_aux i j r s hij hrj hsi clauses
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi t
|
||
| .glueIn φ t a => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact FaceFormula.substDim_comm i j r s hij hrj hsi φ
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi t
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi a
|
||
| .unglue φ f g => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact FaceFormula.substDim_comm i j r s hij hrj hsi φ
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi f
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi g
|
||
| .pair a b => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi a
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi b
|
||
| .fst t => by
|
||
simp only [CTerm.substDim]
|
||
exact congrArg CTerm.fst (CTerm.substDim_comm_aux i j r s hij hrj hsi t)
|
||
| .snd t => by
|
||
simp only [CTerm.substDim]
|
||
exact congrArg CTerm.snd (CTerm.substDim_comm_aux i j r s hij hrj hsi t)
|
||
| .dimExpr e => by
|
||
simp only [CTerm.substDim]
|
||
exact congrArg CTerm.dimExpr
|
||
(DimExpr.subst_comm i j r s hij hrj hsi e).symm
|
||
| .ctor S c params args => by
|
||
simp only [CTerm.substDim]
|
||
exact congrArg (CTerm.ctor S c params)
|
||
(CTerm.substDim.list_comm_aux i j r s hij hrj hsi args)
|
||
| .indElim S params motive branches target => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi motive
|
||
· exact CTerm.substDim.branches_comm_aux i j r s hij hrj hsi branches
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi target
|
||
| .code _ => rfl
|
||
| .modalIntro k a => by
|
||
simp only [CTerm.substDim]
|
||
exact congrArg (CTerm.modalIntro k)
|
||
(CTerm.substDim_comm_aux i j r s hij hrj hsi a)
|
||
| .modalElim _ f m => by
|
||
simp only [CTerm.substDim]
|
||
congr 1
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi f
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi m
|
||
|
||
/-- Helper: `substDim.clauses` commutes on disjoint dim variables. -/
|
||
private def CTerm.substDim.clauses_comm_aux
|
||
(i j : DimVar) (r s : DimExpr) (hij : i ≠ j)
|
||
(hrj : r.dimAbsent j = true) (hsi : s.dimAbsent i = true) :
|
||
(clauses : List (FaceFormula × CTerm)) →
|
||
CTerm.substDim.clauses j s (CTerm.substDim.clauses i r clauses) =
|
||
CTerm.substDim.clauses i r (CTerm.substDim.clauses j s clauses)
|
||
| [] => rfl
|
||
| (φ, u) :: rest => by
|
||
simp only [CTerm.substDim.clauses]
|
||
congr 1
|
||
· exact Prod.ext
|
||
(FaceFormula.substDim_comm i j r s hij hrj hsi φ)
|
||
(CTerm.substDim_comm_aux i j r s hij hrj hsi u)
|
||
· exact CTerm.substDim.clauses_comm_aux i j r s hij hrj hsi rest
|
||
|
||
/-- Helper: `substDim.list` commutes on disjoint dim variables. -/
|
||
private def CTerm.substDim.list_comm_aux
|
||
(i j : DimVar) (r s : DimExpr) (hij : i ≠ j)
|
||
(hrj : r.dimAbsent j = true) (hsi : s.dimAbsent i = true) :
|
||
(ts : List CTerm) →
|
||
CTerm.substDim.list j s (CTerm.substDim.list i r ts) =
|
||
CTerm.substDim.list i r (CTerm.substDim.list j s ts)
|
||
| [] => rfl
|
||
| t :: rest => by
|
||
simp only [CTerm.substDim.list]
|
||
congr 1
|
||
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi t
|
||
· exact CTerm.substDim.list_comm_aux i j r s hij hrj hsi rest
|
||
|
||
/-- Helper: `substDim.branches` commutes on disjoint dim variables. -/
|
||
private def CTerm.substDim.branches_comm_aux
|
||
(i j : DimVar) (r s : DimExpr) (hij : i ≠ j)
|
||
(hrj : r.dimAbsent j = true) (hsi : s.dimAbsent i = true) :
|
||
(brs : List (String × CTerm)) →
|
||
CTerm.substDim.branches j s (CTerm.substDim.branches i r brs) =
|
||
CTerm.substDim.branches i r (CTerm.substDim.branches j s brs)
|
||
| [] => rfl
|
||
| (n, b) :: rest => by
|
||
simp only [CTerm.substDim.branches]
|
||
congr 1
|
||
· exact Prod.ext rfl (CTerm.substDim_comm_aux i j r s hij hrj hsi b)
|
||
· exact CTerm.substDim.branches_comm_aux i j r s hij hrj hsi rest
|
||
end
|
||
|
||
theorem CTerm.substDimBool_comm
|
||
(i j : DimVar) (b c : Bool) (hij : i ≠ j) (t : CTerm) :
|
||
(t.substDimBool i b).substDimBool j c =
|
||
(t.substDimBool j c).substDimBool i b :=
|
||
CTerm.substDim_comm_aux i j _ _ hij
|
||
(DimExpr.dimAbsent_endpoint j b) (DimExpr.dimAbsent_endpoint i c) t
|
||
|
||
-- CType commutativity
|
||
|
||
mutual
|
||
private def CType.substDim_comm_aux {ℓ : ULevel}
|
||
(i j : DimVar) (b c : Bool) (hij : i ≠ j) :
|
||
(A : CType ℓ) →
|
||
(A.substDim i b).substDim j c =
|
||
(A.substDim j c).substDim i b
|
||
| .univ => rfl
|
||
| .pi var A B => by
|
||
simp only [CType.substDim]
|
||
rw [CType.substDim_comm_aux i j b c hij A,
|
||
CType.substDim_comm_aux i j b c hij B]
|
||
| .path A a t => by
|
||
simp only [CType.substDim]
|
||
rw [CType.substDim_comm_aux i j b c hij A,
|
||
CTerm.substDimBool_comm i j b c hij a,
|
||
CTerm.substDimBool_comm i j b c hij t]
|
||
| .sigma var A B => by
|
||
simp only [CType.substDim]
|
||
rw [CType.substDim_comm_aux i j b c hij A,
|
||
CType.substDim_comm_aux i j b c hij B]
|
||
| .glue φ T f fInv sec ret coh A => by
|
||
simp only [CType.substDim]
|
||
rw [FaceFormula.substDim_comm i j _ _ hij
|
||
(DimExpr.dimAbsent_endpoint j b) (DimExpr.dimAbsent_endpoint i c) φ,
|
||
CType.substDim_comm_aux i j b c hij T,
|
||
CTerm.substDimBool_comm i j b c hij f,
|
||
CTerm.substDimBool_comm i j b c hij fInv,
|
||
CTerm.substDimBool_comm i j b c hij sec,
|
||
CTerm.substDimBool_comm i j b c hij ret,
|
||
CTerm.substDimBool_comm i j b c hij coh,
|
||
CType.substDim_comm_aux i j b c hij A]
|
||
| .ind S params => by
|
||
simp only [CType.substDim]
|
||
exact congrArg (CType.ind S)
|
||
(CType.substDim.params_comm_aux i j b c hij params)
|
||
| .interval => rfl
|
||
| .lift A => by
|
||
simp only [CType.substDim]
|
||
congr 1
|
||
exact CType.substDim_comm_aux i j b c hij A
|
||
| .El P => by
|
||
simp only [CType.substDim]
|
||
congr 1
|
||
exact CTerm.substDimBool_comm i j b c hij P
|
||
| .modal _ A => by
|
||
simp only [CType.substDim]
|
||
congr 1
|
||
exact CType.substDim_comm_aux i j b c hij A
|
||
|
||
/-- Helper: `CType.substDim.params` commutes on disjoint dim variables.
|
||
Operates on level-heterogeneous parameter lists. -/
|
||
private def CType.substDim.params_comm_aux
|
||
(i j : DimVar) (b c : Bool) (hij : i ≠ j) :
|
||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||
CType.substDim.params j c (CType.substDim.params i b params) =
|
||
CType.substDim.params i b (CType.substDim.params j c params)
|
||
| [] => rfl
|
||
| ⟨ℓ, A⟩ :: rest => by
|
||
simp only [CType.substDim.params]
|
||
congr 1
|
||
· exact Sigma.ext rfl (heq_of_eq (CType.substDim_comm_aux i j b c hij A))
|
||
· exact CType.substDim.params_comm_aux i j b c hij rest
|
||
end
|
||
|
||
theorem CType.substDim_comm {ℓ : ULevel}
|
||
(i j : DimVar) (b c : Bool) (hij : i ≠ j) (A : CType ℓ) :
|
||
(A.substDim i b).substDim j c =
|
||
(A.substDim j c).substDim i b :=
|
||
CType.substDim_comm_aux i j b c hij A
|