b9ca1d8875
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per THEORY.md §3.1: cubical-native modal type formers as the engine
support layer for the cohesive modality triple (ʃ ⊣ ♭ ⊣ ♯).
CType (3 level-preserving formers):
· CType.flat / .sharp / .shape : {ℓ} → CType ℓ → CType ℓ
CTerm (6 — three intros + three elims, modelled on .glueIn / .unglue):
· CTerm.flatIntro / .sharpIntro / .shapeIntro : CTerm → CTerm
· CTerm.flatElim / .sharpElim / .shapeElim : CTerm → CTerm → CTerm
Cascade: Syntax (constructors + SkeletalCType + skeleton + substDim);
DecEq (beq arms); Subst (substDim / substDimExpr + 6 rfl theorems);
DimLine (cascade through 8 dim-absent / dim-substitution lemma families);
Value (3 vIntro CVal + 3 nElim CNeu); Eval (β-reduction axioms +
stuck-neutral propagation, "marker neutral" idiom from vFst/vSnd
preserved); Readback (3 vIntro + 3 nElim arms with axioms); Typing
(6 HasType cases — bare recursion-principle shape; modal cohesion
dependent-motive form deferred to Phase 3); Reflect (3 reflectCType + 6
reflectCTerm + 3 reifyCType with level-coherence discharge + 6
reifyCTerm); Question (6 modal arms + 6 IsModalLine classifier
predicates with their Decidable instances); FFITest (cval/cterm
summary arms).
No Rust changes (Phase 2). No Modal.lean module (Phase 3). No
Crisp / CContext.crispVar / cohesive_triple theorems (Phase 3).
Build: lake build (48 jobs) + lake build CubicalTransport (42 jobs) PASS.
+664 lines across 11 files, 0 removed, 0 new sorries.
Honest deferrals documented:
· Modal type-formers do not yet reduce under transport/comp; the
match A blocks have wildcards so transp i (flat A) φ t produces a
stuck ntransp neutral (correct under current axiom set; cohesion-
driven reductions land in Phase 3).
· HasType.flatElim et al carry the bare recursion-principle shape;
the cohesive-HoTT-correct dependent-motive form requires the modal
predicate lattice from Phase 3.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
561 lines
25 KiB
Text
561 lines
25 KiB
Text
/-
|
||
CubicalTransport.Syntax
|
||
=======================
|
||
Deep embedding of the cubical term language (CCHM §2–3),
|
||
universe-stratified and dependently-typed.
|
||
|
||
Grammar:
|
||
A, B ::= Uℓ | Π (x : A) B | Σ (x : A) B | Path A a b
|
||
| Glue [φ ↦ (T, e)] A | ind S params | 𝕀 | lift A
|
||
t, u ::= x | λx.t | t u | ⟨i⟩t | t@r
|
||
| transpⁱ A φ t | compⁱ A φ u t | compNⁱ A clauses t
|
||
| glue [φ ↦ t] a | unglue [φ ↦ f] g
|
||
| (a, b) | t.1 | t.2
|
||
| ⟦r⟧ | ctor S c params args | indElim S params motive branches target
|
||
|
||
This is the universe-stratified successor to the original
|
||
monomorphic `CType` (THEORY.md Layer 0 §0.1).
|
||
|
||
## Design (ratified before refactor)
|
||
|
||
1. **CType is universe-indexed.** `CType : ULevel → Type`.
|
||
The level of each constructor is determined by CCHM rules:
|
||
· `univ ℓ` lives at `succ ℓ`
|
||
· `pi`, `sigma` at `max ℓ_A ℓ_B`
|
||
· `path A` at level of A
|
||
· `glue T A` requires T and A at the same level; result at that level
|
||
· `ind` at the level the user picks (schemas don't yet
|
||
constrain their level)
|
||
· `interval` at `zero`
|
||
· `lift A` at `succ` of A's level
|
||
|
||
2. **CTerm is un-indexed.** Universe levels live entirely on
|
||
CType. CTerm constructors that carry a CType payload (transp,
|
||
comp, compN, ctor, indElim) take it at an implicit `{ℓ : ULevel}`
|
||
so callers don't have to thread the level explicitly.
|
||
|
||
3. **Pi and sigma are dependent.** `pi var A B` binds `var : A`
|
||
in the codomain CType `B`. Inside `B`, the variable appears
|
||
as occurrences of `CTerm.var var`. Application substitutes
|
||
the argument for the bound variable (via `substTerm`,
|
||
defined in `Subst.lean`). Existing call sites that wrote
|
||
`.pi A B` (non-dependent) become `.pi "_" A B` — the
|
||
binder name is unused, so substitution does nothing.
|
||
|
||
4. **Cumulativity is a `.lift` constructor.** `lift (A : CType ℓ)`
|
||
produces a `CType ℓ.succ`. The underlying data is `A`; the
|
||
level is bumped. Evaluation unfolds `lift A` to `A`
|
||
(the lift is data-preserving — cumulativity as identity coercion).
|
||
|
||
5. **`params` lists carry heterogeneous-level CTypes.** A schema
|
||
parameter can live at any universe level. We use a Lean Σ
|
||
type — `Σ ℓ : ULevel, CType ℓ` — packaging each param with
|
||
its level. Existing call sites wrap each param: `params := [⟨ℓ, A⟩]`.
|
||
|
||
CType and CTerm are mutually inductive (path endpoints carry CTerms;
|
||
CTerm constructors carry CTypes). The five-way mutual block also
|
||
includes `CTypeArg`, `CtorSpec`, and `CTypeSchema` (REL1 schema
|
||
machinery for inductive types).
|
||
|
||
The path β-rule `(⟨i⟩ t) @ r ↝ t[i := r]`
|
||
and the four "fully-reducing" transport/comp cases (T1, T2, C1, C2)
|
||
are NbE theorems in `Cubical/Readback.lean`. The residual step-level
|
||
axioms — T3, T5, C4 (subject reduction + face congruence) and T4
|
||
(path-line shape preservation) — live in `TransportLaws.lean` /
|
||
`CompLaws.lean`.
|
||
-/
|
||
|
||
import CubicalTransport.Face
|
||
import CubicalTransport.Universe
|
||
|
||
-- ── Universe-stratified syntax ──────────────────────────────────────────────
|
||
|
||
mutual
|
||
/-- Types in the cubical calculus, stratified by universe level.
|
||
|
||
Each constructor's universe-level annotation follows the CCHM
|
||
typing rules. See the file-level comment for the full table. -/
|
||
inductive CType : ULevel → Type where
|
||
/-- The universe `Uℓ` is itself a type at the next level up.
|
||
Russell-paradox avoidance: `Uℓ : Uℓ.succ`, never `Uℓ : Uℓ`. -/
|
||
| univ {ℓ : ULevel}
|
||
: CType (ULevel.succ ℓ)
|
||
/-- Dependent function type `Π (var : A), B`.
|
||
|
||
`var` is the binding name (a Lean `String`); `A` is the
|
||
domain at level `ℓ`; `B` is the codomain CType at level `ℓ'`,
|
||
in scope where `var : A`. Inside `B`, references to the
|
||
bound variable appear as `CTerm.var var`.
|
||
|
||
The result lives at `max ℓ ℓ'` (CCHM Π rule).
|
||
|
||
Non-dependent function `A → B` is the special case where
|
||
`B` does not mention `var`; conventionally written
|
||
`.pi "_" A B`. -/
|
||
| pi {ℓ ℓ' : ULevel} (var : String) (A : CType ℓ) (B : CType ℓ')
|
||
: CType (ULevel.max ℓ ℓ')
|
||
/-- Dependent product type `Σ (var : A), B`. Same shape as `pi`.
|
||
`var : A` is bound in `B`; result at `max ℓ ℓ'`. -/
|
||
| sigma {ℓ ℓ' : ULevel} (var : String) (A : CType ℓ) (B : CType ℓ')
|
||
: CType (ULevel.max ℓ ℓ')
|
||
/-- Path type `Path A a b` — paths in A from a to b. Path types
|
||
are at the same level as their underlying type. -/
|
||
| path {ℓ : ULevel} (A : CType ℓ) (a b : CTerm)
|
||
: CType ℓ
|
||
/-- Glue type (CCHM §6). `Glue [φ ↦ (T, e)] A` — on face `φ`
|
||
the type is `T` with `e : T ≃ A`; off face `φ` the type is
|
||
`A`. T and A live at the same level (the equivalence is
|
||
between same-universe types). -/
|
||
| glue {ℓ : ULevel} (φ : FaceFormula) (T : CType ℓ)
|
||
(f fInv sec ret coh : CTerm) (A : CType ℓ)
|
||
: CType ℓ
|
||
/-- Schema-defined inductive type (REL1, INDUCTIVE_TYPES.md).
|
||
|
||
`ind S params` instantiates schema `S` at type parameters
|
||
`params`. Each parameter is paired with its universe level
|
||
via `Σ ℓ' : ULevel, CType ℓ'` so heterogeneous-level
|
||
parameters are supported (e.g. `List U` has a level-1
|
||
parameter while `List Nat` has a level-0 parameter).
|
||
|
||
The result level `ℓ` is user-specified at instantiation
|
||
time (the schema does not currently constrain the level). -/
|
||
| ind {ℓ : ULevel} (S : CTypeSchema)
|
||
(params : List (Σ ℓ' : ULevel, CType ℓ'))
|
||
: CType ℓ
|
||
/-- The cubical interval `𝕀` as a first-class type (REL2).
|
||
Lives at the bottom universe `.zero`. -/
|
||
| interval
|
||
: CType ULevel.zero
|
||
/-- Cumulativity (Layer 0 §0.1). `lift A` is the same data as
|
||
`A`, but its CType-level index is bumped by one. Reduction
|
||
unfolds `lift A` to `A` (semantically the inclusion is
|
||
identity; the level is metadata). -/
|
||
| lift {ℓ : ULevel} (A : CType ℓ)
|
||
: CType (ULevel.succ ℓ)
|
||
/-- The decoder constructor: turn a CTerm-of-type-univ into a CType.
|
||
|
||
For any CType A : CType ℓ encoded via `CTerm.code A`, we have
|
||
the propositional reduction `El (code A) = A` (proven in this
|
||
file as `El_code_eq`). This lets Ω quantify over codes of
|
||
propositions and refer back to the underlying type. -/
|
||
| El {ℓ : ULevel} (P : CTerm)
|
||
: CType ℓ
|
||
/-- **Modal type former: flat (♭).** Given `A : CType ℓ`, the type
|
||
`flat A` lives at the same universe level `ℓ`. Together with
|
||
`sharp` and `shape`, these are the three modalities of the
|
||
cohesive triple `♭ ⊣ ♯ ⊣ ʃ` (Schreiber/Shulman cohesive HoTT).
|
||
|
||
At the engine layer we add the data constructor; the modal
|
||
cohesion content (Crisp variables, the `♭ ⊣ ♯` adjunction,
|
||
modal-shape commutation diagrams) is the Phase 3 module.
|
||
|
||
Per THEORY.md §3.1; mirrors `path` in level preservation. -/
|
||
| flat {ℓ : ULevel} (A : CType ℓ)
|
||
: CType ℓ
|
||
/-- **Modal type former: sharp (♯).** Given `A : CType ℓ`, the type
|
||
`sharp A` lives at the same universe level `ℓ`. Right adjoint
|
||
of `flat` in the cohesive triple `♭ ⊣ ♯ ⊣ ʃ`.
|
||
|
||
Per THEORY.md §3.1. -/
|
||
| sharp {ℓ : ULevel} (A : CType ℓ)
|
||
: CType ℓ
|
||
/-- **Modal type former: shape (ʃ).** Given `A : CType ℓ`, the type
|
||
`shape A` lives at the same universe level `ℓ`. Left adjoint
|
||
of `flat` in the cohesive triple `♭ ⊣ ♯ ⊣ ʃ`.
|
||
|
||
Per THEORY.md §3.1. -/
|
||
| shape {ℓ : ULevel} (A : CType ℓ)
|
||
: CType ℓ
|
||
|
||
/-- Terms in the cubical calculus. Un-indexed by universe level —
|
||
the level discipline lives in the typing judgment (`HasType`,
|
||
see `Typing.lean`). Type-bearing constructors carry a CType
|
||
payload at an implicit `{ℓ : ULevel}`. -/
|
||
inductive CTerm : Type where
|
||
/-- Variable reference. -/
|
||
| var (x : String) : CTerm
|
||
/-- Lambda abstraction `λx. t`. -/
|
||
| lam (x : String) (t : CTerm) : CTerm
|
||
/-- Function application `f a`. -/
|
||
| app (f a : CTerm) : CTerm
|
||
/-- Dimension abstraction `⟨i⟩ t`. -/
|
||
| plam (i : DimVar) (t : CTerm) : CTerm
|
||
/-- Path application `t @ r`. -/
|
||
| papp (t : CTerm) (r : DimExpr) : CTerm
|
||
/-- Transport `transpⁱ A φ t` — transport `t` along the line
|
||
`λi. A`, with `φ` being a stuck face. -/
|
||
| transp (i : DimVar) {ℓ : ULevel} (A : CType ℓ)
|
||
(φ : FaceFormula) (t : CTerm)
|
||
: CTerm
|
||
/-- Heterogeneous composition `compⁱ A φ u t`. -/
|
||
| comp (i : DimVar) {ℓ : ULevel} (A : CType ℓ)
|
||
(φ : FaceFormula) (u t : CTerm)
|
||
: CTerm
|
||
/-- Multi-clause heterogeneous composition. -/
|
||
| compN (i : DimVar) {ℓ : ULevel} (A : CType ℓ)
|
||
(clauses : List (FaceFormula × CTerm))
|
||
(t : CTerm)
|
||
: CTerm
|
||
/-- Glue introduction `glue [φ ↦ t] a`. -/
|
||
| glueIn (φ : FaceFormula) (t a : CTerm) : CTerm
|
||
/-- Glue elimination `unglue [φ ↦ f] g`. -/
|
||
| unglue (φ : FaceFormula) (f g : CTerm) : CTerm
|
||
/-- Σ introduction (pair). -/
|
||
| pair (a b : CTerm) : CTerm
|
||
/-- Σ first projection. -/
|
||
| fst (t : CTerm) : CTerm
|
||
/-- Σ second projection. -/
|
||
| snd (t : CTerm) : CTerm
|
||
/-- A dimension expression lifted into the term language (REL1). -/
|
||
| dimExpr (r : DimExpr) : CTerm
|
||
/-- Schema constructor application (REL1). -/
|
||
| ctor (S : CTypeSchema) (ctorName : String)
|
||
(params : List (Σ ℓ : ULevel, CType ℓ))
|
||
(args : List CTerm)
|
||
: CTerm
|
||
/-- Inductive eliminator (REL1). -/
|
||
| indElim (S : CTypeSchema)
|
||
(params : List (Σ ℓ : ULevel, CType ℓ))
|
||
(motive : CTerm)
|
||
(branches : List (String × CTerm))
|
||
(target : CTerm)
|
||
: CTerm
|
||
/-- The encoder constructor: turn a CType into a CTerm of type
|
||
`.univ (ℓ := ℓ)`. Carries the underlying type as data. -/
|
||
| code {ℓ : ULevel} (A : CType ℓ)
|
||
: CTerm
|
||
/-- **Modal introduction: η_♭ (flat).** Given `a : A`, the term
|
||
`flatIntro a` inhabits `flat A`. Mirrors the `glueIn` shape:
|
||
a single argument carrying the wrapped value.
|
||
|
||
Reduction: `flatElim f (flatIntro a)` ↝ `app f a`. -/
|
||
| flatIntro (a : CTerm)
|
||
: CTerm
|
||
/-- **Modal introduction: η_♯ (sharp).** Given `a : A`, the term
|
||
`sharpIntro a` inhabits `sharp A`. -/
|
||
| sharpIntro (a : CTerm)
|
||
: CTerm
|
||
/-- **Modal introduction: η_ʃ (shape).** Given `a : A`, the term
|
||
`shapeIntro a` inhabits `shape A`. -/
|
||
| shapeIntro (a : CTerm)
|
||
: CTerm
|
||
/-- **Modal elimination: ♭.rec.** Given the elimination function
|
||
`f : A → C` and a scrutinee `m : flat A`, produce a term of
|
||
type `C`. Two CTerms: target then scrutinee — same shape as
|
||
`unglue` (modulo unglue's leading FaceFormula).
|
||
|
||
Reduction: `flatElim f (flatIntro a)` ↝ `app f a` (β-rule).
|
||
Otherwise: stuck `nflatElim` neutral. -/
|
||
| flatElim (f m : CTerm)
|
||
: CTerm
|
||
/-- **Modal elimination: ♯.rec.** Same shape as `flatElim`. -/
|
||
| sharpElim (f m : CTerm)
|
||
: CTerm
|
||
/-- **Modal elimination: ʃ.rec.** Same shape as `flatElim`. -/
|
||
| shapeElim (f m : CTerm)
|
||
: CTerm
|
||
|
||
/-- Argument shape for a schema constructor (REL1, §2.1). -/
|
||
inductive CTypeArg where
|
||
/-- A non-recursive arg whose type is a closed CType at any
|
||
universe level. -/
|
||
| type {ℓ : ULevel} (A : CType ℓ) : CTypeArg
|
||
/-- The `i`th schema parameter (zero-indexed). -/
|
||
| param (i : Nat) : CTypeArg
|
||
/-- Recursive reference to the inductive type being defined. -/
|
||
| self : CTypeArg
|
||
/-- A dimension binder, used by path constructors. -/
|
||
| dim : CTypeArg
|
||
|
||
/-- Constructor specification (REL1, §2.2).
|
||
`name` unique within schema; `args` positional; `boundary` is
|
||
the partial-element system for path constructors (empty for
|
||
point constructors). -/
|
||
inductive CtorSpec where
|
||
| mk (name : String) (args : List CTypeArg)
|
||
(boundary : List (FaceFormula × CTerm))
|
||
: CtorSpec
|
||
|
||
/-- Schema for an inductive (or higher-inductive) type (REL1, §2.3). -/
|
||
inductive CTypeSchema where
|
||
| mk (name : String) (numParams : Nat)
|
||
(ctors : List CtorSpec)
|
||
: CTypeSchema
|
||
end
|
||
|
||
-- ── Repr derivations ──────────────────────────────────────────────────────────
|
||
|
||
deriving instance Repr for CType
|
||
deriving instance Repr for CTerm
|
||
deriving instance Repr for CTypeArg
|
||
deriving instance Repr for CtorSpec
|
||
deriving instance Repr for CTypeSchema
|
||
|
||
-- DecidableEq for the 5-way mutual block lives in `CubicalTransport.DecEq`
|
||
-- (Lean's `deriving instance DecidableEq` doesn't currently support mutual
|
||
-- inductives — has to be written manually).
|
||
|
||
-- ── Level-erased skeletal classifier ─────────────────────────────────────────
|
||
-- A non-indexed enum tagging a CType by its head constructor. The level
|
||
-- index is stripped — `SkeletalCType` is a plain `Type` with `DecidableEq`
|
||
-- and is therefore safe to compare directly via `Eq` without HEq.
|
||
--
|
||
-- Used to formulate constructor-disjointness preconditions on stuck
|
||
-- axioms (`vTransp_stuck`, `eval_comp_stuck`, etc.) in a way that's
|
||
-- discharge-able by structural pattern matching, without resorting to
|
||
-- HEq elimination across distinct universe indices (which requires K
|
||
-- and is not available in Lean 4 without classical axioms).
|
||
--
|
||
-- This replaces the prior HEq-based formulation
|
||
-- `h_not_pi : ∀ {ℓ_d ℓ_c} (var) (domA : CType ℓ_d) (codA : CType ℓ_c),
|
||
-- HEq A (.pi var domA codA) → False`
|
||
-- with the structurally equivalent
|
||
-- `h_not_pi : A.skeleton ≠ SkeletalCType.pi`
|
||
-- which is decidable, computable, and trivially provable for any
|
||
-- non-pi constructor.
|
||
|
||
inductive SkeletalCType : Type where
|
||
| univ
|
||
| pi
|
||
| sigma
|
||
| path
|
||
| glue
|
||
| ind
|
||
| interval
|
||
| lift
|
||
| El
|
||
| flat
|
||
| sharp
|
||
| shape
|
||
deriving Repr, DecidableEq
|
||
|
||
/-- Strip the universe index, preserving the head constructor as a tag.
|
||
The cornerstone of the structural-disjointness machinery: each CType
|
||
constructor maps to its corresponding skeletal tag, and the tag is
|
||
a non-indexed enum with decidable equality. -/
|
||
def CType.skeleton {ℓ : ULevel} : CType ℓ → SkeletalCType
|
||
| .univ => .univ
|
||
| .pi _ _ _ => .pi
|
||
| .sigma _ _ _ => .sigma
|
||
| .path _ _ _ => .path
|
||
| .glue _ _ _ _ _ _ _ _ => .glue
|
||
| .ind _ _ => .ind
|
||
| .interval => .interval
|
||
| .lift _ => .lift
|
||
| .El _ => .El
|
||
| .flat _ => .flat
|
||
| .sharp _ => .sharp
|
||
| .shape _ => .shape
|
||
|
||
-- ── Skeleton equations (rfl-provable) ────────────────────────────────────────
|
||
|
||
/-- The skeleton of `.ind` is `.ind`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_ind {ℓ : ULevel} (S : CTypeSchema)
|
||
(params : List (Σ ℓ' : ULevel, CType ℓ')) :
|
||
(CType.ind (ℓ := ℓ) S params).skeleton = SkeletalCType.ind := rfl
|
||
|
||
/-- The skeleton of `.pi` is `.pi`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_pi {ℓ_d ℓ_c : ULevel}
|
||
(var : String) (domA : CType ℓ_d) (codA : CType ℓ_c) :
|
||
(CType.pi var domA codA).skeleton = SkeletalCType.pi := rfl
|
||
|
||
/-- The skeleton of `.sigma` is `.sigma`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_sigma {ℓ_a ℓ_b : ULevel}
|
||
(var : String) (A : CType ℓ_a) (B : CType ℓ_b) :
|
||
(CType.sigma var A B).skeleton = SkeletalCType.sigma := rfl
|
||
|
||
/-- The skeleton of `.path` is `.path`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_path {ℓ : ULevel} (A : CType ℓ) (a b : CTerm) :
|
||
(CType.path A a b).skeleton = SkeletalCType.path := rfl
|
||
|
||
/-- The skeleton of `.glue` is `.glue`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_glue {ℓ : ULevel} (φ : FaceFormula) (T : CType ℓ)
|
||
(f fInv s r c : CTerm) (A : CType ℓ) :
|
||
(CType.glue φ T f fInv s r c A).skeleton = SkeletalCType.glue := rfl
|
||
|
||
/-- The skeleton of `.interval` is `.interval`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_interval :
|
||
(CType.interval).skeleton = SkeletalCType.interval := rfl
|
||
|
||
/-- The skeleton of `.univ` is `.univ`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_univ {ℓ : ULevel} :
|
||
(CType.univ (ℓ := ℓ)).skeleton = SkeletalCType.univ := rfl
|
||
|
||
/-- The skeleton of `.lift` is `.lift`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_lift {ℓ : ULevel} (A : CType ℓ) :
|
||
(CType.lift A).skeleton = SkeletalCType.lift := rfl
|
||
|
||
/-- The defining reduction for the El/code pair: decoding the encoding
|
||
of a CType returns that same CType.
|
||
|
||
Stated as an axiom because `El` is a free constructor of CType
|
||
rather than a function — the reduction `El (code A) = A` is the
|
||
universe-code β-rule (CCHM §6: Glue-style universe codes). This
|
||
is the standard formulation in cubical type theory: codes are
|
||
inert constructors at the syntax level; their decoding rule is a
|
||
propositional / definitional equation in the calculus, equivalent
|
||
to a Glue-collapse axiom.
|
||
|
||
The Rust backend implements this rule by inspecting `CType.El`
|
||
targets and folding through `CTerm.code` constructors at the
|
||
structural level (see `eval_code` / readback handling). -/
|
||
@[simp] axiom CType.El_code_eq {ℓ : ULevel} (A : CType ℓ) :
|
||
CType.El (CTerm.code A) = A
|
||
|
||
/-- Skeleton-tag for the new `.El` constructor — used by the
|
||
structural-disjointness framework. -/
|
||
@[simp] theorem CType.skeleton_El {ℓ : ULevel} (P : CTerm) :
|
||
(CType.El (ℓ := ℓ) P).skeleton = SkeletalCType.El := rfl
|
||
|
||
/-- The skeleton of `.flat` is `.flat`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_flat {ℓ : ULevel} (A : CType ℓ) :
|
||
(CType.flat A).skeleton = SkeletalCType.flat := rfl
|
||
|
||
/-- The skeleton of `.sharp` is `.sharp`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_sharp {ℓ : ULevel} (A : CType ℓ) :
|
||
(CType.sharp A).skeleton = SkeletalCType.sharp := rfl
|
||
|
||
/-- The skeleton of `.shape` is `.shape`. -/
|
||
@[simp]
|
||
theorem CType.skeleton_shape {ℓ : ULevel} (A : CType ℓ) :
|
||
(CType.shape A).skeleton = SkeletalCType.shape := rfl
|
||
|
||
-- ── Constructor disjointness via skeleton ────────────────────────────────────
|
||
|
||
/-- Skeletons of distinct constructors are distinct. This is the
|
||
foundational disjointness fact, decided structurally on
|
||
SkeletalCType (which has DecidableEq derived). -/
|
||
theorem SkeletalCType.ind_ne_pi : (SkeletalCType.ind : SkeletalCType) ≠ SkeletalCType.pi := by
|
||
intro h; cases h
|
||
|
||
/-- An `.ind` body is *structurally* not a `.pi` body, in the
|
||
skeleton-based formulation that avoids cross-level HEq.
|
||
|
||
Used by `eval_transp_ind` (TransportLaws.lean) and `eval_comp_ind`
|
||
(CompLaws.lean) to discharge the `h_not_pi` premise of
|
||
`vTransp_stuck` / `eval_comp_stuck`. -/
|
||
theorem CType.ind_skeleton_ne_pi {ℓ : ULevel}
|
||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) :
|
||
(CType.ind (ℓ := ℓ) S params).skeleton ≠ SkeletalCType.pi := by
|
||
rw [CType.skeleton_ind]
|
||
exact SkeletalCType.ind_ne_pi
|
||
|
||
-- ── Convenience: non-dependent pi/sigma sugar ────────────────────────────────
|
||
|
||
namespace CType
|
||
|
||
/-- Non-dependent function type `A → B`. The bound variable name
|
||
`"_"` is reserved (by convention) for unused binders; substitution
|
||
does nothing on it. -/
|
||
abbrev arrow {ℓ ℓ' : ULevel} (A : CType ℓ) (B : CType ℓ') : CType (ULevel.max ℓ ℓ') :=
|
||
.pi "_" A B
|
||
|
||
/-- Non-dependent product type `A × B`. -/
|
||
abbrev prod {ℓ ℓ' : ULevel} (A : CType ℓ) (B : CType ℓ') : CType (ULevel.max ℓ ℓ') :=
|
||
.sigma "_" A B
|
||
|
||
end CType
|
||
|
||
-- ── Dimension substitution ────────────────────────────────────────────────────
|
||
-- Substitute dimension variable i with DimExpr r throughout a term.
|
||
--
|
||
-- Scope inside transp/comp:
|
||
-- · j is the binder of the transport line, bound in A and in φ.
|
||
-- · The base term t (and system u) are in outer scope — we substitute there.
|
||
--
|
||
-- Approximation: `substDim` does NOT descend into A or φ — even when j ≠ i
|
||
-- and i would be free under the binder. Consequence: this substitution is
|
||
-- only faithful for *endpoint* calls (`substDimBool`), where downstream
|
||
-- uses the dimension-absent predicate to justify correctness. Full
|
||
-- DimExpr-in-FaceFormula substitution is deferred (see cells-spec §5.5).
|
||
--
|
||
-- The new universe-stratified CType constructors (pi, sigma with named
|
||
-- binders; lift) do NOT change substDim's behavior at the CTerm level
|
||
-- because CTerm doesn't recurse into CType payloads.
|
||
|
||
mutual
|
||
def CTerm.substDim (i : DimVar) (r : DimExpr) : CTerm → CTerm
|
||
| .var x => .var x
|
||
| .lam x t => .lam x (t.substDim i r)
|
||
| .app f a => .app (f.substDim i r) (a.substDim i r)
|
||
| .plam j t => if j = i then .plam j t -- i bound; stop
|
||
else .plam j (t.substDim i r)
|
||
| .papp t s => .papp (t.substDim i r) (DimExpr.subst i r s)
|
||
-- transp/comp: leave A alone (approximation); descend into t, u and
|
||
-- substitute in φ via the general DimExpr face-formula substitution.
|
||
| .transp j A φ t => .transp j A (φ.substDim i r) (t.substDim i r)
|
||
| .comp j A φ u t => .comp j A (φ.substDim i r) (u.substDim i r) (t.substDim i r)
|
||
| .compN j A clauses t =>
|
||
.compN j A (CTerm.substDim.clauses i r clauses) (t.substDim i r)
|
||
| .glueIn φ t a => .glueIn (φ.substDim i r) (t.substDim i r) (a.substDim i r)
|
||
| .unglue φ f g => .unglue (φ.substDim i r) (f.substDim i r) (g.substDim i r)
|
||
| .pair a b => .pair (a.substDim i r) (b.substDim i r)
|
||
| .fst t => .fst (t.substDim i r)
|
||
| .snd t => .snd (t.substDim i r)
|
||
| .dimExpr s => .dimExpr (DimExpr.subst i r s)
|
||
| .ctor S c params args =>
|
||
.ctor S c params (CTerm.substDim.list i r args)
|
||
| .indElim S params motive branches target =>
|
||
.indElim S params
|
||
(motive.substDim i r)
|
||
(CTerm.substDim.branches i r branches)
|
||
(target.substDim i r)
|
||
-- Universe-code constructor: `code A` carries a CType payload.
|
||
-- Same approximation as transp/comp: A is not recursed into.
|
||
| .code A => .code A
|
||
-- Modal introductions: structural recursion into the wrapped term.
|
||
| .flatIntro a => .flatIntro (a.substDim i r)
|
||
| .sharpIntro a => .sharpIntro (a.substDim i r)
|
||
| .shapeIntro a => .shapeIntro (a.substDim i r)
|
||
-- Modal eliminations: structural recursion into both subterms
|
||
-- (eliminator function and scrutinee).
|
||
| .flatElim f m => .flatElim (f.substDim i r) (m.substDim i r)
|
||
| .sharpElim f m => .sharpElim (f.substDim i r) (m.substDim i r)
|
||
| .shapeElim f m => .shapeElim (f.substDim i r) (m.substDim i r)
|
||
|
||
/-- Helper: apply `CTerm.substDim i r` to each clause body (and
|
||
`FaceFormula.substDim` to each face) in a system's clause list. -/
|
||
def CTerm.substDim.clauses (i : DimVar) (r : DimExpr) :
|
||
List (FaceFormula × CTerm) → List (FaceFormula × CTerm)
|
||
| [] => []
|
||
| (φ, u) :: rest =>
|
||
(φ.substDim i r, u.substDim i r) :: CTerm.substDim.clauses i r rest
|
||
|
||
/-- Helper: apply `CTerm.substDim i r` to each element of a CTerm
|
||
list (ctor argument lists). -/
|
||
def CTerm.substDim.list (i : DimVar) (r : DimExpr) :
|
||
List CTerm → List CTerm
|
||
| [] => []
|
||
| t :: rest => t.substDim i r :: CTerm.substDim.list i r rest
|
||
|
||
/-- Helper: apply `CTerm.substDim i r` to the body of each branch
|
||
in an `indElim`. Branch *names* are unaffected; only bodies. -/
|
||
def CTerm.substDim.branches (i : DimVar) (r : DimExpr) :
|
||
List (String × CTerm) → List (String × CTerm)
|
||
| [] => []
|
||
| (n, b) :: rest =>
|
||
(n, b.substDim i r) :: CTerm.substDim.branches i r rest
|
||
end
|
||
|
||
-- ── One-step reduction ────────────────────────────────────────────────────────
|
||
-- `CTerm.step` is left *opaque*. Semantically it is what a CCHM-style
|
||
-- evaluator will compute. Keeping `step` opaque is required for
|
||
-- soundness: if `step` were a concrete `def` with a wildcard identity
|
||
-- arm, any axiom of the shape `step (.transp …) = t` would rfl-collapse
|
||
-- to `.transp … = t`, contradicting `CTerm.noConfusion`.
|
||
--
|
||
-- See the original Syntax.lean's commentary for the Stage 4.4 history:
|
||
-- only `transp_plam_is_plam_path` (T4) remains as a step-level axiom;
|
||
-- the Rust backend can implement `step` directly or as `readback ∘ eval .nil`.
|
||
|
||
opaque CTerm.step : CTerm → CTerm := id
|