cubical-transport-hott-lean4/CubicalTransport/DimLine.lean
Maximus Gorog f27211f73f REL1 foundation: schema-based inductive + HIT CTypes (Lean side)
Adds schema-based inductive type encoding to the engine, supporting both
plain inductives (Nat, List, Bool) and HITs (S¹, propositional truncation,
suspensions) via a single CTypeSchema/CtorSpec/CTypeArg structure.

New CType constructor:
  - .ind (S : CTypeSchema) (params : List CType)

New CTerm constructors:
  - .dimExpr  (r : DimExpr)
  - .ctor     (S, ctorName, params, args)
  - .indElim  (S, params, motive, branches, target)

New CVal constructors:
  - .vctor    (S, ctorName, params, evaluatedArgs)
  - .vdimExpr (DimExpr)

New CNeu constructor:
  - .nIndElim (S, params, motive, branches, neuTarget)

Five-way mutual block in Syntax.lean (CType, CTerm, CTypeArg, CtorSpec,
CTypeSchema) with Repr derivation post-hoc.  Tag layout per
docs/INDUCTIVE_TYPES.md §6: old tags preserved (no shifting).  Existing
62/62 smoke + property tests pass unchanged through Rust.

Substitution / dim-absent / endpoint handling:
  Subst.lean      — substDim, substDimExpr, equation lemmas,
                    substDim_eq_substDimExpr (mutual with .params helpers).
  DimLine.lean    — CTerm.dimAbsent + CType.dimAbsent (mutual w/ helpers
                    for list / branches / params).  Plus all five
                    auxiliary mutual blocks: substDim_absent_aux,
                    substDimExpr_absent_aux, dimAbsent_after_substDim_aux,
                    substDim_comm_aux — for both CTerm and CType.

Eval.lean: ctor → vctor (eval'd args); indElim β-reduces on canonical
vctor target via vApp chain over branch body, otherwise stuck via
.nIndElim; dimExpr → vdimExpr.  Path-ctor boundary firing and
recursive-arg IH wiring marked TODO REL1.1 (β-reduction works for
non-recursive ctors today).

Readback.lean: vctor → .ctor, vdimExpr → .dimExpr, nIndElim → .indElim.

FFITest.lean: cvalSummary / ctermSummary extended with new constructor
arms.

Topolei (sibling repo) has not yet been migrated — see
docs/INDUCTIVE_TYPES.md §9.1 for the per-file impact map.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-04-30 15:09:39 -06:00

916 lines
41 KiB
Text
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/-
Topolei.Cubical.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. -/
structure DimLine where
binder : DimVar
body : CType
-- ── Endpoint projections ──────────────────────────────────────────────────────
def DimLine.at0 (L : DimLine) : CType := L.body.substDim L.binder false
def DimLine.at1 (L : DimLine) : CType := L.body.substDim L.binder true
def DimLine.atBool (L : DimLine) (b : Bool) : CType := L.body.substDim L.binder b
-- ── atBool reduction lemmas ───────────────────────────────────────────────────
theorem DimLine.atBool_false (L : DimLine) : L.atBool false = L.at0 := rfl
theorem DimLine.atBool_true (L : DimLine) : L.atBool true = L.at1 := rfl
theorem DimLine.atBool_cases (L : DimLine) (b : Bool) :
L.atBool b = if b then L.at1 else L.at0 := by cases b <;> rfl
-- ── Constant line ─────────────────────────────────────────────────────────────
def DimLine.const (A : CType) (i : DimVar) : DimLine := { binder := i, body := A }
theorem DimLine.const_at0 (A : CType) (i : DimVar) :
(DimLine.const A i).at0 = A.substDim i false := rfl
theorem DimLine.const_at1 (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
/-- 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 (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
/-- Helper: check `i` absent from every CType in a parameter list. -/
def CType.dimAbsent.params (i : DimVar) : List 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]
/-- 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 (i : DimVar) (b : Bool) :
(A : CType) → CType.dimAbsent i A = true → CType.substDim i b A = A
| .univ, _ => rfl
| .pi A B, h => by
simp only [CType.dimAbsent, Bool.and_eq_true] at h
show CType.pi (CType.substDim i b A) (CType.substDim i b B) = CType.pi 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 A B, h => by
simp only [CType.dimAbsent, Bool.and_eq_true] at h
show CType.sigma (CType.substDim i b A) (CType.substDim i b B) =
CType.sigma 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]
/-- Helper: `CType.substDim.params i b` is identity on CType lists with
`i` absent from every element. -/
private def CType.substDim.params_of_absent (i : DimVar) (b : Bool) :
(params : List 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 (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 (i : DimVar) (r : DimExpr) :
(A : CType) → CType.dimAbsent i A = true → CType.substDimExpr i r A = A
| .univ, _ => rfl
| .pi A B, h => by
simp only [CType.dimAbsent, Bool.and_eq_true] at h
show CType.pi (A.substDimExpr i r) (B.substDimExpr i r) = CType.pi 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 A B, h => by
simp only [CType.dimAbsent, Bool.and_eq_true] at h
show CType.sigma (A.substDimExpr i r) (B.substDimExpr i r) =
CType.sigma 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]
/-- Helper: `CType.substDimExpr.params i r` is identity on CType lists
with `i` absent from every element. -/
private def CType.substDimExpr.params_of_absent (i : DimVar) (r : DimExpr) :
(params : List 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. Equivalently: line reversal (via `i := inv i`) is
a no-op on constant-in-`i` types — the fact that makes `vTranspInv` reduce
to identity in the constant-domain case. -/
theorem CType.substDimExpr_of_absent (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 (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 (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 (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 (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]
/-- 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 (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]
/-- 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 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 (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 (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
/-- 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
(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 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 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)
/-- Helper: `CType.substDim.params` commutes on disjoint dim variables. -/
private def CType.substDim.params_comm_aux
(i j : DimVar) (b c : Bool) (hij : i ≠ j) :
(params : List 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 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
(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