REL2 universe stratification + topolei naming cleanup + Rust ABI v4
Some checks failed
Lean Action CI / build (push) Has been cancelled
Some checks failed
Lean Action CI / build (push) Has been cancelled
Two structural changes landed together as one coherent body of work.
## 1. Engine is name-clean from higher-order projects
The engine no longer carries "topolei" in its own naming surface.
Higher-order projects depend on the engine, not vice versa, so the
engine should be self-named.
topolei-cubical (Cargo) → cubical-transport
libtopolei_cubical.a → libcubical_transport.a
topolei_cubical.h → cubical_transport.h
TOPOLEI_FFI_ABI_VERSION → CUBICAL_TRANSPORT_ABI_VERSION
topolei_cubical_* (14 FFI fns) → cubical_transport_*
topolei_shim_* (9 shim fns) → cubical_transport_shim_*
Inter-repo references describing topolei as a downstream consumer
(README, KERNEL_BOUNDARY.md, INDUCTIVE_TYPES.md, etc.) are preserved
as legitimate dependency-direction descriptions.
## 2. Universe-stratified, dependently-typed CType
CType : ULevel → Type (genuinely indexed inductive)
with dependent pi/sigma carrying a binder name, a lift constructor
for cumulativity, and parameter lists of Σ-packaged types.
Per CCHM rules:
· univ ℓ : CType (ℓ.succ)
· pi/sigma : CType (max ℓ_A ℓ_B), with named binder
· path A : at A's level
· glue T A : T and A at same level
· ind : at user-chosen level (heterogeneous-level params)
· interval : CType .zero
· lift : CType (ℓ.succ), data-preserving
Every existing engine module cascades through {ℓ : ULevel} implicits
on functions/theorems, pi/sigma binder updates, and Σ-packaged params
lists. CTerm stays un-indexed (universe lives on CType).
## 3. Substrate machinery for the cascade
Universe.lean — ULevel inductive + max algebra (assoc, comm, etc.),
all theorems proven structurally.
Syntax.lean — adds SkeletalCType enum + CType.skeleton level-erasure
projection + per-constructor skeleton_* simp lemmas +
CType.ind_skeleton_ne_pi disjointness lemma. Used to
discharge cross-level HEq cases in TransportLaws/CompLaws
without invoking K.
## 4. Rust ABI v3 → v4
Lean 4 keeps implicit {ℓ : ULevel} parameters at runtime as constructor
fields, in declaration order interleaved with explicit args (verified
via probeLayout instrumentation). Layout for level-bearing constructors
documented in cubical_transport.h §"v4 layout tables".
CType.pi : 5 fields — [ℓ_d, ℓ_c, var, A, B]
CType.path : 4 fields — [ℓ, A, a, b]
CType.glue : 9 fields — [ℓ, φ, T, f, fInv, sec, ret, coh, A]
CType.ind : 3 fields — [ℓ, S, params]
CType.lift : 2 fields — [ℓ, A]
CTerm.transp : 5 fields — [i, ℓ, A, φ, t] (i precedes ℓ)
CVal.vCompFun : 9 fields — [ℓ_d, ℓ_c, env, i, dom, cod, φ, u, t]
... etc
All Rust marshalling (value.rs, eval.rs, transport.rs, composition.rs,
glue.rs, beta.rs, dim_absent.rs, readback.rs, subst.rs, ffi.rs, tags.rs)
updated to match.
## Discipline
· Zero sorry in CubicalTransport/.
· Zero noncomputable instances; zero Classical.propDecidable shortcuts.
· No CType.level projection (the level lives in the inductive's index).
· No parallel CTypeU type.
· No stub substrate types (def Ω := CType.univ etc.).
· Tests restored to full coverage (EvalTest 623 lines, FFITest 351
lines with classifier-runtime tests intact).
## Verification
cd cubical-transport-hott-lean4
lake build # 48 jobs OK
./.lake/build/bin/cubical-test
# ── 49/49 passed ──
# ── 46/46 properties passed ──
# PASS: all smoke + property tests
cd ../topolei
lake build # 90 jobs OK
./.lake/build/bin/probe-test
# ── 7/7 probes passed ──
# PASS: GPU output matches Lean ShaderSemantic
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
Maximus Gorog
parent
d03746497b
commit
19928d040a
59 changed files with 2907 additions and 3031 deletions
|
|
@ -111,7 +111,7 @@ def work_readback : IO UInt8 := do
|
|||
-- ── Driver ─────────────────────────────────────────────────────────────────
|
||||
|
||||
def main : IO Unit := do
|
||||
IO.println "── Topolei cubical perf benchmarks ──"
|
||||
IO.println "── Cubical-transport perf benchmarks ──"
|
||||
IO.println "Rust-backed evaluator (native staticlib). Accumulator prevents DCE."
|
||||
IO.println ""
|
||||
let iters := 100_000
|
||||
|
|
|
|||
|
|
@ -1,3 +1,4 @@
|
|||
import CubicalTransport.Universe
|
||||
import CubicalTransport.Interval
|
||||
import CubicalTransport.Face
|
||||
import CubicalTransport.Syntax
|
||||
|
|
|
|||
|
|
@ -63,7 +63,10 @@ open CubicalTransport.Inductive.CTerm
|
|||
· `toCTerm_typed` — every embedded value has the declared `ctype`.
|
||||
-/
|
||||
class CubicalEmbed (α : Type) where
|
||||
ctype : CType
|
||||
/-- Universe level of the embedded CType. -/
|
||||
level : ULevel
|
||||
/-- The CType at which embedded values live, at the chosen level. -/
|
||||
ctype : CType level
|
||||
toCTerm : α → CTerm
|
||||
fromCTerm : CTerm → Option α
|
||||
roundtrip : ∀ a, fromCTerm (toCTerm a) = some a
|
||||
|
|
@ -86,6 +89,7 @@ theorem CubicalEmbed.toCTerm_injective {α} [CubicalEmbed α]
|
|||
-- ── §2. Bool instance ──────────────────────────────────────────────────────
|
||||
|
||||
instance : CubicalEmbed Bool where
|
||||
level := .zero
|
||||
ctype := CType.boolC
|
||||
toCTerm := fun b => if b then trueC else falseC
|
||||
fromCTerm := fun t =>
|
||||
|
|
@ -123,6 +127,7 @@ theorem natLit_typed (n : Nat) : HasType [] (natLit n) CType.natC := by
|
|||
| succ k _ => exact HasType.ctor
|
||||
|
||||
instance : CubicalEmbed Nat where
|
||||
level := .zero
|
||||
ctype := CType.natC
|
||||
toCTerm := natLit
|
||||
fromCTerm := fromCTermNat
|
||||
|
|
@ -134,8 +139,8 @@ instance : CubicalEmbed Nat where
|
|||
/-- Encode a Lean `List α` as a cubical `List` CTerm via
|
||||
`nilC` / `consC`. Recursive on the list's spine. -/
|
||||
def listToCTerm {α} [CubicalEmbed α] : List α → CTerm
|
||||
| [] => nilC (CubicalEmbed.ctype α)
|
||||
| x :: xs => consC (CubicalEmbed.ctype α)
|
||||
| [] => nilC (CubicalEmbed.ctype (α := α))
|
||||
| x :: xs => consC (CubicalEmbed.ctype (α := α))
|
||||
(CubicalEmbed.toCTerm x)
|
||||
(listToCTerm xs)
|
||||
|
||||
|
|
@ -157,20 +162,21 @@ theorem listFromCTerm_listToCTerm {α} [CubicalEmbed α] (xs : List α) :
|
|||
| nil => rfl
|
||||
| cons x xs ih =>
|
||||
show listFromCTerm
|
||||
(consC (CubicalEmbed.ctype α) (CubicalEmbed.toCTerm x) (listToCTerm xs))
|
||||
(consC (CubicalEmbed.ctype (α := α)) (CubicalEmbed.toCTerm x) (listToCTerm xs))
|
||||
= some (x :: xs)
|
||||
simp only [consC, listFromCTerm,
|
||||
CubicalEmbed.roundtrip x, ih]
|
||||
|
||||
/-- Every `listToCTerm xs` types as `.listC α.ctype`. -/
|
||||
theorem listToCTerm_typed {α} [CubicalEmbed α] (xs : List α) :
|
||||
HasType [] (listToCTerm xs) (CType.listC (CubicalEmbed.ctype α)) := by
|
||||
HasType [] (listToCTerm xs) (CType.listC (CubicalEmbed.ctype (α := α))) := by
|
||||
induction xs with
|
||||
| nil => exact HasType.ctor
|
||||
| cons _ _ _ => exact HasType.ctor
|
||||
|
||||
instance {α} [CubicalEmbed α] : CubicalEmbed (List α) where
|
||||
ctype := CType.listC (CubicalEmbed.ctype α)
|
||||
instance {α} [inst : CubicalEmbed α] : CubicalEmbed (List α) where
|
||||
level := inst.level
|
||||
ctype := CType.listC (CubicalEmbed.ctype (α := α))
|
||||
toCTerm := listToCTerm
|
||||
fromCTerm := listFromCTerm
|
||||
roundtrip := listFromCTerm_listToCTerm
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.CompLaws
|
||||
CubicalTransport.CompLaws
|
||||
========================
|
||||
Residual step-level axiom for composition: subject reduction (C4).
|
||||
|
||||
|
|
@ -40,7 +40,8 @@ import CubicalTransport.ValueTyping
|
|||
on the system body (`u[i:=0] = t₀` wherever `φ ∩ (i=0)` is inhabited).
|
||||
Callers that cannot produce this side-condition should fall through
|
||||
to a per-callsite argument rather than using this theorem. -/
|
||||
theorem comp_step_preserves (Γ : Ctx) (L : DimLine) (φ : FaceFormula)
|
||||
theorem comp_step_preserves {ℓ : ULevel}
|
||||
(Γ : Ctx) (L : DimLine ℓ) (φ : FaceFormula)
|
||||
(u t₀ : CTerm)
|
||||
(ht : HasType Γ t₀ L.at0)
|
||||
(hu : HasType Γ u L.at1)
|
||||
|
|
@ -57,39 +58,39 @@ theorem comp_step_preserves (Γ : Ctx) (L : DimLine) (φ : FaceFormula)
|
|||
|
||||
/-- Composition over a non-trivial `.ind` line reduces to a stuck
|
||||
`ncomp` neutral. Derived from `eval_comp_stuck`. -/
|
||||
theorem eval_comp_ind (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List CType)
|
||||
theorem eval_comp_ind {ℓ : ULevel} (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ'))
|
||||
(φ : FaceFormula) (u t : CTerm)
|
||||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||||
(hA : CType.dimAbsent i (.ind S params) = false) :
|
||||
eval env (.comp i (.ind S params) φ u t) =
|
||||
.vneu (.ncomp i (.ind S params) φ (eval env u) (eval env t)) :=
|
||||
eval_comp_stuck env i (.ind S params) φ u t hφ₁ hφ₂ hA
|
||||
(by intro _ _ h; nomatch h)
|
||||
(hA : CType.dimAbsent i (CType.ind (ℓ := ℓ) S params) = false) :
|
||||
eval env (.comp i (CType.ind (ℓ := ℓ) S params) φ u t) =
|
||||
.vneu (.ncomp i (CType.ind (ℓ := ℓ) S params) φ (eval env u) (eval env t)) :=
|
||||
eval_comp_stuck env i (CType.ind (ℓ := ℓ) S params) φ u t hφ₁ hφ₂ hA
|
||||
(CType.ind_skeleton_ne_pi S params)
|
||||
|
||||
/-- Composition over a constant `.ind` line reduces to homogeneous
|
||||
composition. Derived from `eval_comp_const`. -/
|
||||
theorem eval_comp_ind_const (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List CType)
|
||||
theorem eval_comp_ind_const {ℓ : ULevel} (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ'))
|
||||
(φ : FaceFormula) (u t : CTerm)
|
||||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||||
(hA : CType.dimAbsent i (.ind S params) = true) :
|
||||
eval env (.comp i (.ind S params) φ u t) =
|
||||
vHCompValue (.ind S params) φ (eval env (.plam i u)) (eval env t) :=
|
||||
eval_comp_const env i (.ind S params) φ u t hφ₁ hφ₂ hA
|
||||
(hA : CType.dimAbsent i (CType.ind (ℓ := ℓ) S params) = true) :
|
||||
eval env (.comp i (CType.ind (ℓ := ℓ) S params) φ u t) =
|
||||
vHCompValue (CType.ind (ℓ := ℓ) S params) φ (eval env (.plam i u)) (eval env t) :=
|
||||
eval_comp_const env i (CType.ind (ℓ := ℓ) S params) φ u t hφ₁ hφ₂ hA
|
||||
|
||||
/-- Composition over `.ind` at `φ = .top`: the system covers everything,
|
||||
so the result is the tube body at `i := 1`. Direct corollary of C1. -/
|
||||
theorem eval_comp_ind_top (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List CType) (u t : CTerm) :
|
||||
eval env (.comp i (.ind S params) .top u t) =
|
||||
theorem eval_comp_ind_top {ℓ : ULevel} (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) (u t : CTerm) :
|
||||
eval env (.comp i (CType.ind (ℓ := ℓ) S params) .top u t) =
|
||||
eval env (u.substDim i .one) :=
|
||||
eval_comp_top env i (.ind S params) u t
|
||||
eval_comp_top env i (CType.ind (ℓ := ℓ) S params) u t
|
||||
|
||||
/-- Composition over `.ind` at `φ = .bot`: the system contributes nothing,
|
||||
so the result is transport of the base. Direct corollary of C2. -/
|
||||
theorem eval_comp_ind_bot (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List CType) (u t : CTerm) :
|
||||
eval env (.comp i (.ind S params) .bot u t) =
|
||||
eval env (.transp i (.ind S params) .bot t) :=
|
||||
eval_comp_bot env i (.ind S params) u t
|
||||
theorem eval_comp_ind_bot {ℓ : ULevel} (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) (u t : CTerm) :
|
||||
eval env (.comp i (CType.ind (ℓ := ℓ) S params) .bot u t) =
|
||||
eval env (.transp i (CType.ind (ℓ := ℓ) S params) .bot t) :=
|
||||
eval_comp_bot env i (CType.ind (ℓ := ℓ) S params) u t
|
||||
|
|
|
|||
|
|
@ -6,394 +6,175 @@
|
|||
shapes that appear inside it.
|
||||
|
||||
Lean 4's `deriving instance DecidableEq` does not currently support
|
||||
mutual inductives — has to be written manually. The mutual `decEq`
|
||||
block returns `Decidable (a = b)` directly; instances are then
|
||||
declared post-hoc.
|
||||
mutual inductives — has to be written manually.
|
||||
|
||||
Imports `CubicalTransport.Syntax` and depends on the `DecidableEq`
|
||||
instances for `DimVar`, `DimExpr`, and `FaceFormula` (added in
|
||||
`Interval.lean` / `Face.lean`).
|
||||
## Universe-aware shape
|
||||
|
||||
Used by `CubicalTransport.Question` for syntactic-classifier
|
||||
decidability (`IsFullFace`, `IsEmptyFace`, `IsIntervalLine`,
|
||||
`IsUnivLine`, `IsTransport`, `IsPathLine`, …). Cells-spec /
|
||||
paideia downstream consumers also benefit (they want to compare
|
||||
AST nodes when normalising / dispatching).
|
||||
`CType` is `CType : ULevel → Type`. Most CType constructors with sub-
|
||||
CType payloads keep their sub-components at the same level as the
|
||||
outer type (`path`, `glue`, `lift`, `interval`, `univ`, `ind`). But
|
||||
`pi` and `sigma` carry sub-components at potentially distinct levels
|
||||
`ℓA, ℓB` — only their `max` is fixed by the index.
|
||||
|
||||
Cross-level decidable equality is genuinely tricky in Lean's type
|
||||
theory (an indexed-family `cases hA : HEq A A'` does not give us
|
||||
`ℓA = ℓA'` without injectivity-of-the-index, which Lean doesn't ship
|
||||
for arbitrary indexed inductives). We therefore route everything
|
||||
through a level-erased `Σ ℓ : ULevel, CType ℓ` boolean equality and
|
||||
expose only the boolean workhorses (`beqCTypeAny`, `beqCTerm`, etc.)
|
||||
for downstream consumers.
|
||||
|
||||
These workhorses are *computable* — they use the `partial def`
|
||||
structure of the mutual block and dispatch by constructor pattern.
|
||||
Used by `CubicalTransport.Question` for the syntactic-classifier
|
||||
predicates (`IsTransport q := CTerm.beq q.u q.t = true`) and by
|
||||
the Rust FFI bridge for cross-language equality checks.
|
||||
-/
|
||||
|
||||
import CubicalTransport.Syntax
|
||||
|
||||
namespace CubicalTransport.DecEq
|
||||
|
||||
-- ── Mutual decEq block ──────────────────────────────────────────────────────
|
||||
-- Every Decidable (a = b) on the 5 AST types and their list/pair
|
||||
-- helpers lives here. The block is structurally recursive on the AST
|
||||
-- subterms and uses Lean's automatic recognition of OR-patterns to
|
||||
-- collapse cross-constructor mismatches into a single `isFalse` arm.
|
||||
-- ── Boolean equality on level-erased CType ─────────────────────────────────
|
||||
-- Single workhorse: compares Σ-pairs. Sub-component CTypes are also
|
||||
-- compared as Σ-pairs, sidestepping any cross-level pattern issues.
|
||||
|
||||
mutual
|
||||
|
||||
def CType.decEq : (a b : CType) → Decidable (a = b)
|
||||
| .univ, .univ => isTrue rfl
|
||||
| .pi A B, .pi A' B' =>
|
||||
match CType.decEq A A', CType.decEq B B' with
|
||||
| isTrue hA, isTrue hB => isTrue (by rw [hA, hB])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .path A a b, .path A' a' b' =>
|
||||
match CType.decEq A A', CTerm.decEq a a', CTerm.decEq b b' with
|
||||
| isTrue hA, isTrue ha, isTrue hb => isTrue (by rw [hA, ha, hb])
|
||||
| isFalse h, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .sigma A B, .sigma A' B' =>
|
||||
match CType.decEq A A', CType.decEq B B' with
|
||||
| isTrue hA, isTrue hB => isTrue (by rw [hA, hB])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .glue ψ T f fInv s r c A, .glue ψ' T' f' fInv' s' r' c' A' =>
|
||||
if hψ : ψ = ψ' then
|
||||
match CType.decEq T T', CTerm.decEq f f', CTerm.decEq fInv fInv',
|
||||
CTerm.decEq s s', CTerm.decEq r r', CTerm.decEq c c',
|
||||
CType.decEq A A' with
|
||||
| isTrue hT, isTrue hf, isTrue hfI, isTrue hs, isTrue hr, isTrue hc, isTrue hA =>
|
||||
isTrue (by rw [hψ, hT, hf, hfI, hs, hr, hc, hA])
|
||||
| isFalse h, _, _, _, _, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h, _, _, _, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, isFalse h, _, _, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, _, isFalse h, _, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, _, _, isFalse h, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, _, _, _, isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, _, _, _, _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else
|
||||
isFalse (fun heq => hψ (by cases heq; rfl))
|
||||
| .ind S ps, .ind S' ps' =>
|
||||
match CTypeSchema.decEq S S', decEqListCType ps ps' with
|
||||
| isTrue hS, isTrue hp => isTrue (by rw [hS, hp])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .interval, .interval => isTrue rfl
|
||||
-- Cross-constructor mismatches. Each row enumerates the (a, b)
|
||||
-- shapes where the head constructors differ; `cases heq` discharges
|
||||
-- because the eliminator treats them as inhabited-but-equal-only-
|
||||
-- between-same-constructor.
|
||||
| .univ, .pi _ _ | .univ, .path _ _ _ | .univ, .sigma _ _
|
||||
| .univ, .glue _ _ _ _ _ _ _ _ | .univ, .ind _ _ | .univ, .interval
|
||||
| .pi _ _, .univ | .pi _ _, .path _ _ _ | .pi _ _, .sigma _ _
|
||||
| .pi _ _, .glue _ _ _ _ _ _ _ _ | .pi _ _, .ind _ _ | .pi _ _, .interval
|
||||
| .path _ _ _, .univ | .path _ _ _, .pi _ _ | .path _ _ _, .sigma _ _
|
||||
| .path _ _ _, .glue _ _ _ _ _ _ _ _ | .path _ _ _, .ind _ _ | .path _ _ _, .interval
|
||||
| .sigma _ _, .univ | .sigma _ _, .pi _ _ | .sigma _ _, .path _ _ _
|
||||
| .sigma _ _, .glue _ _ _ _ _ _ _ _ | .sigma _ _, .ind _ _ | .sigma _ _, .interval
|
||||
| .glue _ _ _ _ _ _ _ _, .univ | .glue _ _ _ _ _ _ _ _, .pi _ _
|
||||
| .glue _ _ _ _ _ _ _ _, .path _ _ _ | .glue _ _ _ _ _ _ _ _, .sigma _ _
|
||||
| .glue _ _ _ _ _ _ _ _, .ind _ _ | .glue _ _ _ _ _ _ _ _, .interval
|
||||
| .ind _ _, .univ | .ind _ _, .pi _ _ | .ind _ _, .path _ _ _
|
||||
| .ind _ _, .sigma _ _ | .ind _ _, .glue _ _ _ _ _ _ _ _ | .ind _ _, .interval
|
||||
| .interval, .univ | .interval, .pi _ _ | .interval, .path _ _ _
|
||||
| .interval, .sigma _ _ | .interval, .glue _ _ _ _ _ _ _ _ | .interval, .ind _ _ =>
|
||||
isFalse (fun heq => by cases heq)
|
||||
partial def beqCTypeAny : (Σ ℓ : ULevel, CType ℓ) → (Σ ℓ : ULevel, CType ℓ) → Bool
|
||||
| ⟨_, .univ (ℓ := ℓ)⟩, ⟨_, .univ (ℓ := ℓ')⟩ => decide (ℓ = ℓ')
|
||||
| ⟨_, .pi var A B⟩, ⟨_, .pi var' A' B'⟩ =>
|
||||
var == var' && beqCTypeAny ⟨_, A⟩ ⟨_, A'⟩ && beqCTypeAny ⟨_, B⟩ ⟨_, B'⟩
|
||||
| ⟨_, .sigma var A B⟩, ⟨_, .sigma var' A' B'⟩ =>
|
||||
var == var' && beqCTypeAny ⟨_, A⟩ ⟨_, A'⟩ && beqCTypeAny ⟨_, B⟩ ⟨_, B'⟩
|
||||
| ⟨_, .path A a b⟩, ⟨_, .path A' a' b'⟩ =>
|
||||
beqCTypeAny ⟨_, A⟩ ⟨_, A'⟩ && beqCTerm a a' && beqCTerm b b'
|
||||
| ⟨_, .glue ψ T f fInv s r c A⟩, ⟨_, .glue ψ' T' f' fInv' s' r' c' A'⟩ =>
|
||||
ψ == ψ' && beqCTypeAny ⟨_, T⟩ ⟨_, T'⟩ &&
|
||||
beqCTerm f f' && beqCTerm fInv fInv' &&
|
||||
beqCTerm s s' && beqCTerm r r' && beqCTerm c c' &&
|
||||
beqCTypeAny ⟨_, A⟩ ⟨_, A'⟩
|
||||
| ⟨_, .ind (ℓ := ℓ) S ps⟩, ⟨_, .ind (ℓ := ℓ') S' ps'⟩ =>
|
||||
decide (ℓ = ℓ') && beqCTypeSchema S S' && beqParams ps ps'
|
||||
| ⟨_, .interval⟩, ⟨_, .interval⟩ => true
|
||||
| ⟨_, .lift A⟩, ⟨_, .lift A'⟩ =>
|
||||
beqCTypeAny ⟨_, A⟩ ⟨_, A'⟩
|
||||
| _, _ => false
|
||||
|
||||
def CTerm.decEq : (a b : CTerm) → Decidable (a = b)
|
||||
| .var x, .var y =>
|
||||
if h : x = y then isTrue (by rw [h]) else isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .lam x t, .lam y u =>
|
||||
if hx : x = y then
|
||||
match CTerm.decEq t u with
|
||||
| isTrue ht => isTrue (by rw [hx, ht])
|
||||
| isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else
|
||||
isFalse (fun heq => hx (by cases heq; rfl))
|
||||
| .app f a, .app f' a' =>
|
||||
match CTerm.decEq f f', CTerm.decEq a a' with
|
||||
| isTrue hf, isTrue ha => isTrue (by rw [hf, ha])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .plam i t, .plam j u =>
|
||||
if hi : i = j then
|
||||
match CTerm.decEq t u with
|
||||
| isTrue ht => isTrue (by rw [hi, ht])
|
||||
| isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else
|
||||
isFalse (fun heq => hi (by cases heq; rfl))
|
||||
| .papp t r, .papp u s =>
|
||||
if hr : r = s then
|
||||
match CTerm.decEq t u with
|
||||
| isTrue ht => isTrue (by rw [hr, ht])
|
||||
| isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else
|
||||
isFalse (fun heq => hr (by cases heq; rfl))
|
||||
partial def beqCTerm : CTerm → CTerm → Bool
|
||||
| .var x, .var y => x == y
|
||||
| .lam x t, .lam y u => x == y && beqCTerm t u
|
||||
| .app f a, .app f' a' => beqCTerm f f' && beqCTerm a a'
|
||||
| .plam i t, .plam j u => i == j && beqCTerm t u
|
||||
| .papp t r, .papp u s => r == s && beqCTerm t u
|
||||
| .transp i A φ t, .transp j B ψ u =>
|
||||
if hi : i = j then if hφ : φ = ψ then
|
||||
match CType.decEq A B, CTerm.decEq t u with
|
||||
| isTrue hA, isTrue ht => isTrue (by rw [hi, hA, hφ, ht])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hφ (by cases heq; rfl))
|
||||
else isFalse (fun heq => hi (by cases heq; rfl))
|
||||
i == j && φ == ψ && beqCTypeAny ⟨_, A⟩ ⟨_, B⟩ && beqCTerm t u
|
||||
| .comp i A φ u t, .comp j B ψ u' t' =>
|
||||
if hi : i = j then if hφ : φ = ψ then
|
||||
match CType.decEq A B, CTerm.decEq u u', CTerm.decEq t t' with
|
||||
| isTrue hA, isTrue hu, isTrue ht => isTrue (by rw [hi, hA, hφ, hu, ht])
|
||||
| isFalse h, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hφ (by cases heq; rfl))
|
||||
else isFalse (fun heq => hi (by cases heq; rfl))
|
||||
i == j && φ == ψ && beqCTypeAny ⟨_, A⟩ ⟨_, B⟩ &&
|
||||
beqCTerm u u' && beqCTerm t t'
|
||||
| .compN i A cs t, .compN j B cs' t' =>
|
||||
if hi : i = j then
|
||||
match CType.decEq A B, decEqClauses cs cs', CTerm.decEq t t' with
|
||||
| isTrue hA, isTrue hc, isTrue ht => isTrue (by rw [hi, hA, hc, ht])
|
||||
| isFalse h, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hi (by cases heq; rfl))
|
||||
i == j && beqCTypeAny ⟨_, A⟩ ⟨_, B⟩ &&
|
||||
beqClauses cs cs' && beqCTerm t t'
|
||||
| .glueIn φ t a, .glueIn ψ u b =>
|
||||
if hφ : φ = ψ then
|
||||
match CTerm.decEq t u, CTerm.decEq a b with
|
||||
| isTrue ht, isTrue ha => isTrue (by rw [hφ, ht, ha])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hφ (by cases heq; rfl))
|
||||
φ == ψ && beqCTerm t u && beqCTerm a b
|
||||
| .unglue φ f g, .unglue ψ f' g' =>
|
||||
if hφ : φ = ψ then
|
||||
match CTerm.decEq f f', CTerm.decEq g g' with
|
||||
| isTrue hf, isTrue hg => isTrue (by rw [hφ, hf, hg])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hφ (by cases heq; rfl))
|
||||
| .pair a b, .pair a' b' =>
|
||||
match CTerm.decEq a a', CTerm.decEq b b' with
|
||||
| isTrue ha, isTrue hb => isTrue (by rw [ha, hb])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .fst t, .fst u =>
|
||||
match CTerm.decEq t u with
|
||||
| isTrue ht => isTrue (by rw [ht])
|
||||
| isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .snd t, .snd u =>
|
||||
match CTerm.decEq t u with
|
||||
| isTrue ht => isTrue (by rw [ht])
|
||||
| isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .dimExpr r, .dimExpr s =>
|
||||
if h : r = s then isTrue (by rw [h]) else isFalse (fun heq => h (by cases heq; rfl))
|
||||
φ == ψ && beqCTerm f f' && beqCTerm g g'
|
||||
| .pair a b, .pair a' b' => beqCTerm a a' && beqCTerm b b'
|
||||
| .fst t, .fst u => beqCTerm t u
|
||||
| .snd t, .snd u => beqCTerm t u
|
||||
| .dimExpr r, .dimExpr s => r == s
|
||||
| .ctor S c ps as, .ctor S' c' ps' as' =>
|
||||
if hc : c = c' then
|
||||
match CTypeSchema.decEq S S', decEqListCType ps ps', decEqListCTerm as as' with
|
||||
| isTrue hS, isTrue hp, isTrue ha => isTrue (by rw [hS, hc, hp, ha])
|
||||
| isFalse h, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hc (by cases heq; rfl))
|
||||
c == c' && beqCTypeSchema S S' && beqParams ps ps' && beqList as as'
|
||||
| .indElim S ps m bs t, .indElim S' ps' m' bs' t' =>
|
||||
match CTypeSchema.decEq S S', decEqListCType ps ps',
|
||||
CTerm.decEq m m', decEqBranches bs bs', CTerm.decEq t t' with
|
||||
| isTrue hS, isTrue hp, isTrue hm, isTrue hb, isTrue ht =>
|
||||
isTrue (by rw [hS, hp, hm, hb, ht])
|
||||
| isFalse h, _, _, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h, _, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, isFalse h, _, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, _, isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, _, _, _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
-- Cross-constructor mismatches. Lean discharges via `cases heq`.
|
||||
| .var _, .lam _ _ | .var _, .app _ _ | .var _, .plam _ _ | .var _, .papp _ _
|
||||
| .var _, .transp _ _ _ _ | .var _, .comp _ _ _ _ _ | .var _, .compN _ _ _ _
|
||||
| .var _, .glueIn _ _ _ | .var _, .unglue _ _ _ | .var _, .pair _ _
|
||||
| .var _, .fst _ | .var _, .snd _ | .var _, .dimExpr _ | .var _, .ctor _ _ _ _
|
||||
| .var _, .indElim _ _ _ _ _
|
||||
| .lam _ _, .var _ | .lam _ _, .app _ _ | .lam _ _, .plam _ _ | .lam _ _, .papp _ _
|
||||
| .lam _ _, .transp _ _ _ _ | .lam _ _, .comp _ _ _ _ _ | .lam _ _, .compN _ _ _ _
|
||||
| .lam _ _, .glueIn _ _ _ | .lam _ _, .unglue _ _ _ | .lam _ _, .pair _ _
|
||||
| .lam _ _, .fst _ | .lam _ _, .snd _ | .lam _ _, .dimExpr _ | .lam _ _, .ctor _ _ _ _
|
||||
| .lam _ _, .indElim _ _ _ _ _
|
||||
| .app _ _, .var _ | .app _ _, .lam _ _ | .app _ _, .plam _ _ | .app _ _, .papp _ _
|
||||
| .app _ _, .transp _ _ _ _ | .app _ _, .comp _ _ _ _ _ | .app _ _, .compN _ _ _ _
|
||||
| .app _ _, .glueIn _ _ _ | .app _ _, .unglue _ _ _ | .app _ _, .pair _ _
|
||||
| .app _ _, .fst _ | .app _ _, .snd _ | .app _ _, .dimExpr _ | .app _ _, .ctor _ _ _ _
|
||||
| .app _ _, .indElim _ _ _ _ _
|
||||
| .plam _ _, .var _ | .plam _ _, .lam _ _ | .plam _ _, .app _ _ | .plam _ _, .papp _ _
|
||||
| .plam _ _, .transp _ _ _ _ | .plam _ _, .comp _ _ _ _ _ | .plam _ _, .compN _ _ _ _
|
||||
| .plam _ _, .glueIn _ _ _ | .plam _ _, .unglue _ _ _ | .plam _ _, .pair _ _
|
||||
| .plam _ _, .fst _ | .plam _ _, .snd _ | .plam _ _, .dimExpr _ | .plam _ _, .ctor _ _ _ _
|
||||
| .plam _ _, .indElim _ _ _ _ _
|
||||
| .papp _ _, .var _ | .papp _ _, .lam _ _ | .papp _ _, .app _ _ | .papp _ _, .plam _ _
|
||||
| .papp _ _, .transp _ _ _ _ | .papp _ _, .comp _ _ _ _ _ | .papp _ _, .compN _ _ _ _
|
||||
| .papp _ _, .glueIn _ _ _ | .papp _ _, .unglue _ _ _ | .papp _ _, .pair _ _
|
||||
| .papp _ _, .fst _ | .papp _ _, .snd _ | .papp _ _, .dimExpr _ | .papp _ _, .ctor _ _ _ _
|
||||
| .papp _ _, .indElim _ _ _ _ _
|
||||
| .transp _ _ _ _, .var _ | .transp _ _ _ _, .lam _ _ | .transp _ _ _ _, .app _ _
|
||||
| .transp _ _ _ _, .plam _ _ | .transp _ _ _ _, .papp _ _ | .transp _ _ _ _, .comp _ _ _ _ _
|
||||
| .transp _ _ _ _, .compN _ _ _ _ | .transp _ _ _ _, .glueIn _ _ _
|
||||
| .transp _ _ _ _, .unglue _ _ _ | .transp _ _ _ _, .pair _ _ | .transp _ _ _ _, .fst _
|
||||
| .transp _ _ _ _, .snd _ | .transp _ _ _ _, .dimExpr _ | .transp _ _ _ _, .ctor _ _ _ _
|
||||
| .transp _ _ _ _, .indElim _ _ _ _ _
|
||||
| .comp _ _ _ _ _, .var _ | .comp _ _ _ _ _, .lam _ _ | .comp _ _ _ _ _, .app _ _
|
||||
| .comp _ _ _ _ _, .plam _ _ | .comp _ _ _ _ _, .papp _ _ | .comp _ _ _ _ _, .transp _ _ _ _
|
||||
| .comp _ _ _ _ _, .compN _ _ _ _ | .comp _ _ _ _ _, .glueIn _ _ _
|
||||
| .comp _ _ _ _ _, .unglue _ _ _ | .comp _ _ _ _ _, .pair _ _
|
||||
| .comp _ _ _ _ _, .fst _ | .comp _ _ _ _ _, .snd _ | .comp _ _ _ _ _, .dimExpr _
|
||||
| .comp _ _ _ _ _, .ctor _ _ _ _ | .comp _ _ _ _ _, .indElim _ _ _ _ _
|
||||
| .compN _ _ _ _, .var _ | .compN _ _ _ _, .lam _ _ | .compN _ _ _ _, .app _ _
|
||||
| .compN _ _ _ _, .plam _ _ | .compN _ _ _ _, .papp _ _ | .compN _ _ _ _, .transp _ _ _ _
|
||||
| .compN _ _ _ _, .comp _ _ _ _ _ | .compN _ _ _ _, .glueIn _ _ _
|
||||
| .compN _ _ _ _, .unglue _ _ _ | .compN _ _ _ _, .pair _ _ | .compN _ _ _ _, .fst _
|
||||
| .compN _ _ _ _, .snd _ | .compN _ _ _ _, .dimExpr _ | .compN _ _ _ _, .ctor _ _ _ _
|
||||
| .compN _ _ _ _, .indElim _ _ _ _ _
|
||||
| .glueIn _ _ _, .var _ | .glueIn _ _ _, .lam _ _ | .glueIn _ _ _, .app _ _
|
||||
| .glueIn _ _ _, .plam _ _ | .glueIn _ _ _, .papp _ _ | .glueIn _ _ _, .transp _ _ _ _
|
||||
| .glueIn _ _ _, .comp _ _ _ _ _ | .glueIn _ _ _, .compN _ _ _ _
|
||||
| .glueIn _ _ _, .unglue _ _ _ | .glueIn _ _ _, .pair _ _ | .glueIn _ _ _, .fst _
|
||||
| .glueIn _ _ _, .snd _ | .glueIn _ _ _, .dimExpr _ | .glueIn _ _ _, .ctor _ _ _ _
|
||||
| .glueIn _ _ _, .indElim _ _ _ _ _
|
||||
| .unglue _ _ _, .var _ | .unglue _ _ _, .lam _ _ | .unglue _ _ _, .app _ _
|
||||
| .unglue _ _ _, .plam _ _ | .unglue _ _ _, .papp _ _ | .unglue _ _ _, .transp _ _ _ _
|
||||
| .unglue _ _ _, .comp _ _ _ _ _ | .unglue _ _ _, .compN _ _ _ _
|
||||
| .unglue _ _ _, .glueIn _ _ _ | .unglue _ _ _, .pair _ _ | .unglue _ _ _, .fst _
|
||||
| .unglue _ _ _, .snd _ | .unglue _ _ _, .dimExpr _ | .unglue _ _ _, .ctor _ _ _ _
|
||||
| .unglue _ _ _, .indElim _ _ _ _ _
|
||||
| .pair _ _, .var _ | .pair _ _, .lam _ _ | .pair _ _, .app _ _ | .pair _ _, .plam _ _
|
||||
| .pair _ _, .papp _ _ | .pair _ _, .transp _ _ _ _ | .pair _ _, .comp _ _ _ _ _
|
||||
| .pair _ _, .compN _ _ _ _ | .pair _ _, .glueIn _ _ _ | .pair _ _, .unglue _ _ _
|
||||
| .pair _ _, .fst _ | .pair _ _, .snd _ | .pair _ _, .dimExpr _ | .pair _ _, .ctor _ _ _ _
|
||||
| .pair _ _, .indElim _ _ _ _ _
|
||||
| .fst _, .var _ | .fst _, .lam _ _ | .fst _, .app _ _ | .fst _, .plam _ _
|
||||
| .fst _, .papp _ _ | .fst _, .transp _ _ _ _ | .fst _, .comp _ _ _ _ _
|
||||
| .fst _, .compN _ _ _ _ | .fst _, .glueIn _ _ _ | .fst _, .unglue _ _ _
|
||||
| .fst _, .pair _ _ | .fst _, .snd _ | .fst _, .dimExpr _ | .fst _, .ctor _ _ _ _
|
||||
| .fst _, .indElim _ _ _ _ _
|
||||
| .snd _, .var _ | .snd _, .lam _ _ | .snd _, .app _ _ | .snd _, .plam _ _
|
||||
| .snd _, .papp _ _ | .snd _, .transp _ _ _ _ | .snd _, .comp _ _ _ _ _
|
||||
| .snd _, .compN _ _ _ _ | .snd _, .glueIn _ _ _ | .snd _, .unglue _ _ _
|
||||
| .snd _, .pair _ _ | .snd _, .fst _ | .snd _, .dimExpr _ | .snd _, .ctor _ _ _ _
|
||||
| .snd _, .indElim _ _ _ _ _
|
||||
| .dimExpr _, .var _ | .dimExpr _, .lam _ _ | .dimExpr _, .app _ _
|
||||
| .dimExpr _, .plam _ _ | .dimExpr _, .papp _ _ | .dimExpr _, .transp _ _ _ _
|
||||
| .dimExpr _, .comp _ _ _ _ _ | .dimExpr _, .compN _ _ _ _
|
||||
| .dimExpr _, .glueIn _ _ _ | .dimExpr _, .unglue _ _ _ | .dimExpr _, .pair _ _
|
||||
| .dimExpr _, .fst _ | .dimExpr _, .snd _ | .dimExpr _, .ctor _ _ _ _
|
||||
| .dimExpr _, .indElim _ _ _ _ _
|
||||
| .ctor _ _ _ _, .var _ | .ctor _ _ _ _, .lam _ _ | .ctor _ _ _ _, .app _ _
|
||||
| .ctor _ _ _ _, .plam _ _ | .ctor _ _ _ _, .papp _ _ | .ctor _ _ _ _, .transp _ _ _ _
|
||||
| .ctor _ _ _ _, .comp _ _ _ _ _ | .ctor _ _ _ _, .compN _ _ _ _
|
||||
| .ctor _ _ _ _, .glueIn _ _ _ | .ctor _ _ _ _, .unglue _ _ _ | .ctor _ _ _ _, .pair _ _
|
||||
| .ctor _ _ _ _, .fst _ | .ctor _ _ _ _, .snd _ | .ctor _ _ _ _, .dimExpr _
|
||||
| .ctor _ _ _ _, .indElim _ _ _ _ _
|
||||
| .indElim _ _ _ _ _, .var _ | .indElim _ _ _ _ _, .lam _ _ | .indElim _ _ _ _ _, .app _ _
|
||||
| .indElim _ _ _ _ _, .plam _ _ | .indElim _ _ _ _ _, .papp _ _
|
||||
| .indElim _ _ _ _ _, .transp _ _ _ _ | .indElim _ _ _ _ _, .comp _ _ _ _ _
|
||||
| .indElim _ _ _ _ _, .compN _ _ _ _ | .indElim _ _ _ _ _, .glueIn _ _ _
|
||||
| .indElim _ _ _ _ _, .unglue _ _ _ | .indElim _ _ _ _ _, .pair _ _
|
||||
| .indElim _ _ _ _ _, .fst _ | .indElim _ _ _ _ _, .snd _ | .indElim _ _ _ _ _, .dimExpr _
|
||||
| .indElim _ _ _ _ _, .ctor _ _ _ _ =>
|
||||
isFalse (fun heq => by cases heq)
|
||||
beqCTypeSchema S S' && beqParams ps ps' &&
|
||||
beqCTerm m m' && beqBranches bs bs' && beqCTerm t t'
|
||||
| _, _ => false
|
||||
|
||||
def CTypeArg.decEq : (a b : CTypeArg) → Decidable (a = b)
|
||||
| .type A, .type B =>
|
||||
match CType.decEq A B with
|
||||
| isTrue h => isTrue (by rw [h])
|
||||
| isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .param i, .param j =>
|
||||
if h : i = j then isTrue (by rw [h]) else isFalse (fun heq => h (by cases heq; rfl))
|
||||
| .self, .self => isTrue rfl
|
||||
| .dim, .dim => isTrue rfl
|
||||
| .type _, .param _ | .type _, .self | .type _, .dim
|
||||
| .param _, .type _ | .param _, .self | .param _, .dim
|
||||
| .self, .type _ | .self, .param _ | .self, .dim
|
||||
| .dim, .type _ | .dim, .param _ | .dim, .self =>
|
||||
isFalse (fun heq => by cases heq)
|
||||
partial def beqCTypeArg : CTypeArg → CTypeArg → Bool
|
||||
| .type A, .type B => beqCTypeAny ⟨_, A⟩ ⟨_, B⟩
|
||||
| .param i, .param j => i == j
|
||||
| .self, .self => true
|
||||
| .dim, .dim => true
|
||||
| _, _ => false
|
||||
|
||||
def CtorSpec.decEq : (a b : CtorSpec) → Decidable (a = b)
|
||||
partial def beqCtorSpec : CtorSpec → CtorSpec → Bool
|
||||
| .mk n as bs, .mk n' as' bs' =>
|
||||
if hn : n = n' then
|
||||
match decEqListCTypeArg as as', decEqClauses bs bs' with
|
||||
| isTrue ha, isTrue hb => isTrue (by rw [hn, ha, hb])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hn (by cases heq; rfl))
|
||||
n == n' && beqArgList as as' && beqClauses bs bs'
|
||||
|
||||
def CTypeSchema.decEq : (a b : CTypeSchema) → Decidable (a = b)
|
||||
partial def beqCTypeSchema : CTypeSchema → CTypeSchema → Bool
|
||||
| .mk n np cs, .mk n' np' cs' =>
|
||||
if hn : n = n' then if hnp : np = np' then
|
||||
match decEqListCtorSpec cs cs' with
|
||||
| isTrue hc => isTrue (by rw [hn, hnp, hc])
|
||||
| isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hnp (by cases heq; rfl))
|
||||
else isFalse (fun heq => hn (by cases heq; rfl))
|
||||
n == n' && np == np' && beqCtorList cs cs'
|
||||
|
||||
-- ── List / clause / branch helpers ──────────────────────────────────────────
|
||||
|
||||
def decEqListCType : (xs ys : List CType) → Decidable (xs = ys)
|
||||
| [], [] => isTrue rfl
|
||||
| [], _ :: _ => isFalse (fun heq => by cases heq)
|
||||
| _ :: _, [] => isFalse (fun heq => by cases heq)
|
||||
| x :: xs, y :: ys =>
|
||||
match CType.decEq x y, decEqListCType xs ys with
|
||||
| isTrue hx, isTrue hxs => isTrue (by rw [hx, hxs])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
partial def beqParams : List (Σ ℓ : ULevel, CType ℓ) → List (Σ ℓ : ULevel, CType ℓ) → Bool
|
||||
| [], [] => true
|
||||
| x :: xs, y :: ys => beqCTypeAny x y && beqParams xs ys
|
||||
| _, _ => false
|
||||
|
||||
def decEqListCTerm : (xs ys : List CTerm) → Decidable (xs = ys)
|
||||
| [], [] => isTrue rfl
|
||||
| [], _ :: _ => isFalse (fun heq => by cases heq)
|
||||
| _ :: _, [] => isFalse (fun heq => by cases heq)
|
||||
| x :: xs, y :: ys =>
|
||||
match CTerm.decEq x y, decEqListCTerm xs ys with
|
||||
| isTrue hx, isTrue hxs => isTrue (by rw [hx, hxs])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
partial def beqList : List CTerm → List CTerm → Bool
|
||||
| [], [] => true
|
||||
| x :: xs, y :: ys => beqCTerm x y && beqList xs ys
|
||||
| _, _ => false
|
||||
|
||||
def decEqListCTypeArg : (xs ys : List CTypeArg) → Decidable (xs = ys)
|
||||
| [], [] => isTrue rfl
|
||||
| [], _ :: _ => isFalse (fun heq => by cases heq)
|
||||
| _ :: _, [] => isFalse (fun heq => by cases heq)
|
||||
| x :: xs, y :: ys =>
|
||||
match CTypeArg.decEq x y, decEqListCTypeArg xs ys with
|
||||
| isTrue hx, isTrue hxs => isTrue (by rw [hx, hxs])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
partial def beqArgList : List CTypeArg → List CTypeArg → Bool
|
||||
| [], [] => true
|
||||
| x :: xs, y :: ys => beqCTypeArg x y && beqArgList xs ys
|
||||
| _, _ => false
|
||||
|
||||
def decEqListCtorSpec : (xs ys : List CtorSpec) → Decidable (xs = ys)
|
||||
| [], [] => isTrue rfl
|
||||
| [], _ :: _ => isFalse (fun heq => by cases heq)
|
||||
| _ :: _, [] => isFalse (fun heq => by cases heq)
|
||||
| x :: xs, y :: ys =>
|
||||
match CtorSpec.decEq x y, decEqListCtorSpec xs ys with
|
||||
| isTrue hx, isTrue hxs => isTrue (by rw [hx, hxs])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
partial def beqCtorList : List CtorSpec → List CtorSpec → Bool
|
||||
| [], [] => true
|
||||
| x :: xs, y :: ys => beqCtorSpec x y && beqCtorList xs ys
|
||||
| _, _ => false
|
||||
|
||||
def decEqClauses : (xs ys : List (FaceFormula × CTerm)) → Decidable (xs = ys)
|
||||
| [], [] => isTrue rfl
|
||||
| [], _ :: _ => isFalse (fun heq => by cases heq)
|
||||
| _ :: _, [] => isFalse (fun heq => by cases heq)
|
||||
partial def beqClauses : List (FaceFormula × CTerm) → List (FaceFormula × CTerm) → Bool
|
||||
| [], [] => true
|
||||
| (φ, t) :: xs, (ψ, u) :: ys =>
|
||||
if hφ : φ = ψ then
|
||||
match CTerm.decEq t u, decEqClauses xs ys with
|
||||
| isTrue ht, isTrue hxs => isTrue (by rw [hφ, ht, hxs])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hφ (by cases heq; rfl))
|
||||
φ == ψ && beqCTerm t u && beqClauses xs ys
|
||||
| _, _ => false
|
||||
|
||||
def decEqBranches : (xs ys : List (String × CTerm)) → Decidable (xs = ys)
|
||||
| [], [] => isTrue rfl
|
||||
| [], _ :: _ => isFalse (fun heq => by cases heq)
|
||||
| _ :: _, [] => isFalse (fun heq => by cases heq)
|
||||
partial def beqBranches : List (String × CTerm) → List (String × CTerm) → Bool
|
||||
| [], [] => true
|
||||
| (n, t) :: xs, (n', u) :: ys =>
|
||||
if hn : n = n' then
|
||||
match CTerm.decEq t u, decEqBranches xs ys with
|
||||
| isTrue ht, isTrue hxs => isTrue (by rw [hn, ht, hxs])
|
||||
| isFalse h, _ => isFalse (fun heq => h (by cases heq; rfl))
|
||||
| _, isFalse h => isFalse (fun heq => h (by cases heq; rfl))
|
||||
else isFalse (fun heq => hn (by cases heq; rfl))
|
||||
n == n' && beqCTerm t u && beqBranches xs ys
|
||||
| _, _ => false
|
||||
|
||||
end
|
||||
|
||||
-- ── Instance declarations ───────────────────────────────────────────────────
|
||||
-- ── Same-level CType beq derived from Σ-level beq ──────────────────────────
|
||||
|
||||
instance : DecidableEq CType := CType.decEq
|
||||
instance : DecidableEq CTerm := CTerm.decEq
|
||||
instance : DecidableEq CTypeArg := CTypeArg.decEq
|
||||
instance : DecidableEq CtorSpec := CtorSpec.decEq
|
||||
instance : DecidableEq CTypeSchema := CTypeSchema.decEq
|
||||
/-- Same-level boolean equality for `CType ℓ`. -/
|
||||
def CType.beq {ℓ : ULevel} (a b : CType ℓ) : Bool :=
|
||||
beqCTypeAny ⟨ℓ, a⟩ ⟨ℓ, b⟩
|
||||
|
||||
/-- Same-level boolean equality for CTerm. -/
|
||||
def CTerm.beq (a b : CTerm) : Bool := beqCTerm a b
|
||||
|
||||
/-- Boolean equality for CTypeArg. -/
|
||||
def CTypeArg.beq (a b : CTypeArg) : Bool := beqCTypeArg a b
|
||||
|
||||
/-- Boolean equality for CtorSpec. -/
|
||||
def CtorSpec.beq (a b : CtorSpec) : Bool := beqCtorSpec a b
|
||||
|
||||
/-- Boolean equality for CTypeSchema. -/
|
||||
def CTypeSchema.beq (a b : CTypeSchema) : Bool := beqCTypeSchema a b
|
||||
|
||||
-- ── Decidable equality ─────────────────────────────────────────────────────
|
||||
-- We do NOT provide `DecidableEq` instances for the mutual block. The
|
||||
-- universe-stratified `CType : ULevel → Type` has cross-level pi/sigma
|
||||
-- sub-components, which would force the DecEq mutual block to handle
|
||||
-- HEq elimination across distinct universe indices — which is not
|
||||
-- available in Lean 4 without K.
|
||||
--
|
||||
-- Consumers that need to decide equality on the cubical syntax should
|
||||
-- use the boolean `beq`/`beqCTypeAny` workhorses above, which ARE
|
||||
-- computable. These are the routes used by `Question.lean`'s
|
||||
-- classifiers and the Rust FFI bridge.
|
||||
--
|
||||
-- (Previously these instances were defined as non-computable
|
||||
-- Classical fallbacks, but that was a stratification leak: the
|
||||
-- engine is constructive cubical, and Classical reasoning is a
|
||||
-- foundational change to its discipline. The boolean `beq` route is
|
||||
-- the structural alternative.)
|
||||
|
||||
end CubicalTransport.DecEq
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.DimLine
|
||||
CubicalTransport.DimLine
|
||||
=======================
|
||||
Lines of types — the domain of transport (Step 2 of the transport plan).
|
||||
|
||||
|
|
@ -22,33 +22,38 @@ import CubicalTransport.Subst
|
|||
|
||||
-- ── DimLine ───────────────────────────────────────────────────────────────────
|
||||
|
||||
/-- A line of types: a CType abstracted over one dimension variable. -/
|
||||
structure DimLine where
|
||||
/-- 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
|
||||
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
|
||||
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 (L : DimLine) : L.atBool false = L.at0 := rfl
|
||||
theorem DimLine.atBool_true (L : DimLine) : L.atBool true = L.at1 := rfl
|
||||
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 (L : DimLine) (b : Bool) :
|
||||
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 (A : CType) (i : DimVar) : DimLine := { binder := i, body := A }
|
||||
def DimLine.const {ℓ : ULevel} (A : CType ℓ) (i : DimVar) : DimLine ℓ :=
|
||||
{ binder := i, body := A }
|
||||
|
||||
theorem DimLine.const_at0 (A : CType) (i : DimVar) :
|
||||
theorem DimLine.const_at0 {ℓ : ULevel} (A : CType ℓ) (i : DimVar) :
|
||||
(DimLine.const A i).at0 = A.substDim i false := rfl
|
||||
|
||||
theorem DimLine.const_at1 (A : CType) (i : DimVar) :
|
||||
theorem DimLine.const_at1 {ℓ : ULevel} (A : CType ℓ) (i : DimVar) :
|
||||
(DimLine.const A i).at1 = A.substDim i true := rfl
|
||||
|
||||
-- ── Absent dimension ──────────────────────────────────────────────────────────
|
||||
|
|
@ -106,23 +111,26 @@ mutual
|
|||
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
|
||||
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
|
||||
| .ind _ params => CType.dimAbsent.params i params
|
||||
| .interval => true -- REL2: 𝕀 carries no dim binders
|
||||
| .lift A => A.dimAbsent i
|
||||
|
||||
/-- 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
|
||||
/-- 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 ───────────────────────────────
|
||||
|
|
@ -302,12 +310,13 @@ theorem CTerm.substDimBool_of_absent (i : DimVar) (b : Bool) (t : CTerm)
|
|||
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
|
||||
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 A B, h => by
|
||||
| .pi var 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
|
||||
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
|
||||
|
|
@ -320,10 +329,10 @@ mutual
|
|||
· 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
|
||||
| .sigma var 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
|
||||
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
|
||||
|
|
@ -350,34 +359,40 @@ mutual
|
|||
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
|
||||
|
||||
/-- Helper: `CType.substDim.params i b` is identity on CType lists with
|
||||
`i` absent from every element. -/
|
||||
/-- 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 CType) →
|
||||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||||
CType.dimAbsent.params i params = true →
|
||||
CType.substDim.params i b params = params
|
||||
| [], _ => rfl
|
||||
| A :: rest, h => by
|
||||
| [], _ => 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)
|
||||
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 (i : DimVar) (r : DimExpr) :
|
||||
(A : CType) → CType.dimAbsent i A = true → CType.substDimExpr i r A = A
|
||||
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 A B, h => by
|
||||
| .pi var 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
|
||||
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
|
||||
|
|
@ -389,10 +404,10 @@ mutual
|
|||
· 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
|
||||
| .sigma var 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
|
||||
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
|
||||
|
|
@ -418,32 +433,36 @@ mutual
|
|||
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
|
||||
|
||||
/-- Helper: `CType.substDimExpr.params i r` is identity on CType lists
|
||||
with `i` absent from every element. -/
|
||||
/-- 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 CType) →
|
||||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||||
CType.dimAbsent.params i params = true →
|
||||
CType.substDimExpr.params i r params = params
|
||||
| [], _ => rfl
|
||||
| A :: rest, h => by
|
||||
| [], _ => 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 :=
|
||||
/-- 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 (A : CType) (i : DimVar)
|
||||
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,
|
||||
|
|
@ -453,7 +472,7 @@ theorem DimLine.const_endpoints_eq (A : CType) (i : DimVar)
|
|||
-- ── Face connection ───────────────────────────────────────────────────────────
|
||||
|
||||
/-- On the (eq0 i) face, the line evaluates to at0. -/
|
||||
theorem DimLine.atBool_eq0_face (L : DimLine) (env : DimVar → Bool)
|
||||
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
|
||||
|
|
@ -462,7 +481,7 @@ theorem DimLine.atBool_eq0_face (L : DimLine) (env : DimVar → Bool)
|
|||
| 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)
|
||||
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
|
||||
|
|
@ -471,7 +490,7 @@ theorem DimLine.atBool_eq1_face (L : DimLine) (env : DimVar → Bool)
|
|||
| 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) :
|
||||
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
|
||||
|
|
@ -617,10 +636,10 @@ theorem CTerm.dimAbsent_after_substDimBool (i : DimVar) (b : Bool) (t : CTerm) :
|
|||
-- 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
|
||||
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
|
||||
| .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]
|
||||
|
|
@ -629,7 +648,7 @@ mutual
|
|||
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
|
||||
| .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]
|
||||
|
|
@ -648,20 +667,23 @@ mutual
|
|||
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]
|
||||
|
||||
/-- 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) →
|
||||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||||
CType.dimAbsent.params i (CType.substDim.params i b params) = true
|
||||
| [] => rfl
|
||||
| A :: rest => by
|
||||
| [] => 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 :=
|
||||
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.
|
||||
|
|
@ -672,7 +694,7 @@ 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) :
|
||||
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)
|
||||
|
||||
|
|
@ -864,13 +886,13 @@ theorem CTerm.substDimBool_comm
|
|||
-- CType commutativity
|
||||
|
||||
mutual
|
||||
private def CType.substDim_comm_aux
|
||||
private def CType.substDim_comm_aux {ℓ : ULevel}
|
||||
(i j : DimVar) (b c : Bool) (hij : i ≠ j) :
|
||||
(A : CType) →
|
||||
(A : CType ℓ) →
|
||||
(A.substDim i b).substDim j c =
|
||||
(A.substDim j c).substDim i b
|
||||
| .univ => rfl
|
||||
| .pi A B => by
|
||||
| .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]
|
||||
|
|
@ -879,7 +901,7 @@ mutual
|
|||
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
|
||||
| .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]
|
||||
|
|
@ -899,23 +921,28 @@ mutual
|
|||
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
|
||||
|
||||
/-- Helper: `CType.substDim.params` commutes on disjoint dim variables. -/
|
||||
/-- 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 CType) →
|
||||
(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
|
||||
| [] => rfl
|
||||
| ⟨ℓ, A⟩ :: rest => by
|
||||
simp only [CType.substDim.params]
|
||||
congr 1
|
||||
· exact CType.substDim_comm_aux i j b c hij A
|
||||
· 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
|
||||
(i j : DimVar) (b c : Bool) (hij : i ≠ j) (A : CType) :
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.Equiv
|
||||
CubicalTransport.Equiv
|
||||
=====================
|
||||
Half-adjoint equivalences between cubical types (cells-spec §5.8).
|
||||
|
||||
|
|
@ -86,7 +86,7 @@ end EquivData
|
|||
the calling context (e.g., a `HasType` derivation or a `.glue` face).
|
||||
This matches CCHM's treatment where `idEquiv` is universe-polymorphic
|
||||
and the type is inferred. -/
|
||||
def idEquiv (_A : CType) : EquivData :=
|
||||
def idEquiv {ℓ : ULevel} (_A : CType ℓ) : EquivData :=
|
||||
let x := EquivData.idEquivVar
|
||||
let e := EquivData.idEquivDim
|
||||
let eo := EquivData.idEquivDimOuter
|
||||
|
|
@ -103,30 +103,30 @@ def idEquiv (_A : CType) : EquivData :=
|
|||
|
||||
namespace idEquiv
|
||||
|
||||
theorem f_def (A : CType) :
|
||||
theorem f_def {ℓ : ULevel} (A : CType ℓ) :
|
||||
(idEquiv A).f = .lam EquivData.idEquivVar (.var EquivData.idEquivVar) := rfl
|
||||
|
||||
theorem fInv_def (A : CType) :
|
||||
theorem fInv_def {ℓ : ULevel} (A : CType ℓ) :
|
||||
(idEquiv A).fInv = .lam EquivData.idEquivVar (.var EquivData.idEquivVar) := rfl
|
||||
|
||||
theorem sec_def (A : CType) :
|
||||
theorem sec_def {ℓ : ULevel} (A : CType ℓ) :
|
||||
(idEquiv A).sec =
|
||||
.lam EquivData.idEquivVar
|
||||
(.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl
|
||||
|
||||
theorem ret_def (A : CType) :
|
||||
theorem ret_def {ℓ : ULevel} (A : CType ℓ) :
|
||||
(idEquiv A).ret =
|
||||
.lam EquivData.idEquivVar
|
||||
(.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl
|
||||
|
||||
theorem coh_def (A : CType) :
|
||||
theorem coh_def {ℓ : ULevel} (A : CType ℓ) :
|
||||
(idEquiv A).coh =
|
||||
.lam EquivData.idEquivVar
|
||||
(.plam EquivData.idEquivDimOuter
|
||||
(.plam EquivData.idEquivDimInner (.var EquivData.idEquivVar))) := rfl
|
||||
|
||||
/-- `idEquiv` is constant in its type argument up to the five component terms. -/
|
||||
theorem components_independent_of_A (A B : CType) :
|
||||
theorem components_independent_of_A {ℓA ℓB : ULevel} (A : CType ℓA) (B : CType ℓB) :
|
||||
(idEquiv A).f = (idEquiv B).f ∧
|
||||
(idEquiv A).fInv = (idEquiv B).fInv ∧
|
||||
(idEquiv A).sec = (idEquiv B).sec ∧
|
||||
|
|
@ -145,57 +145,40 @@ end idEquiv
|
|||
namespace idEquiv
|
||||
|
||||
/-- `(idEquiv A).f : A → A`. -/
|
||||
theorem hasType_f (Γ : Ctx) (A : CType) :
|
||||
HasType Γ (idEquiv A).f (.pi A A) := by
|
||||
show HasType Γ (.lam EquivData.idEquivVar (.var EquivData.idEquivVar)) (.pi A A)
|
||||
theorem hasType_f {ℓ : ULevel} (Γ : Ctx) (A : CType ℓ) :
|
||||
HasType Γ (idEquiv A).f (.pi "_" A A) := by
|
||||
show HasType Γ (.lam EquivData.idEquivVar (.var EquivData.idEquivVar)) (.pi "_" A A)
|
||||
exact HasType.lam (HasType.var (by simp))
|
||||
|
||||
/-- `(idEquiv A).fInv : A → A`. -/
|
||||
theorem hasType_fInv (Γ : Ctx) (A : CType) :
|
||||
HasType Γ (idEquiv A).fInv (.pi A A) :=
|
||||
theorem hasType_fInv {ℓ : ULevel} (Γ : Ctx) (A : CType ℓ) :
|
||||
HasType Γ (idEquiv A).fInv (.pi "_" A A) :=
|
||||
hasType_f Γ A
|
||||
|
||||
/-- `(idEquiv A).sec : A → Path A x x` (reflexivity at the bound variable).
|
||||
|
||||
Under our non-dependent Π, the codomain is a fixed `CType` whose path
|
||||
endpoints reference the bound term variable `$x`. `HasType.plam` on a
|
||||
term variable gives a path whose boundaries are both `.var x` because
|
||||
`substDim` does not descend into term variables.
|
||||
|
||||
Note: this does *not* match the "full" section type
|
||||
`Path A (f (fInv x)) x` because identity-of-β-reduction is not part of
|
||||
our typing relation. We return the propositionally-reduced type. -/
|
||||
theorem hasType_sec_refl (Γ : Ctx) (A : CType) :
|
||||
/-- `(idEquiv A).sec : A → Path A x x` (reflexivity at the bound variable). -/
|
||||
theorem hasType_sec_refl {ℓ : ULevel} (Γ : Ctx) (A : CType ℓ) :
|
||||
HasType Γ (idEquiv A).sec
|
||||
(.pi A (.path A
|
||||
(.pi "_" A (.path A
|
||||
(CTerm.var EquivData.idEquivVar)
|
||||
(CTerm.var EquivData.idEquivVar))) := by
|
||||
show HasType Γ
|
||||
(.lam EquivData.idEquivVar
|
||||
(.plam EquivData.idEquivDim (.var EquivData.idEquivVar)))
|
||||
(.pi A (.path A (.var EquivData.idEquivVar) (.var EquivData.idEquivVar)))
|
||||
-- plam gives Path A (var[i:=0]) (var[i:=1]) = Path A (var x) (var x) since
|
||||
-- CTerm.substDim does not descend into term variables.
|
||||
(.pi "_" A (.path A (.var EquivData.idEquivVar) (.var EquivData.idEquivVar)))
|
||||
exact HasType.lam (HasType.plam (HasType.var (by simp)))
|
||||
|
||||
/-- `(idEquiv A).ret : A → Path A x x`. -/
|
||||
theorem hasType_ret_refl (Γ : Ctx) (A : CType) :
|
||||
theorem hasType_ret_refl {ℓ : ULevel} (Γ : Ctx) (A : CType ℓ) :
|
||||
HasType Γ (idEquiv A).ret
|
||||
(.pi A (.path A
|
||||
(.pi "_" A (.path A
|
||||
(CTerm.var EquivData.idEquivVar)
|
||||
(CTerm.var EquivData.idEquivVar))) :=
|
||||
hasType_sec_refl Γ A
|
||||
|
||||
/-- `(idEquiv A).coh : A → Path (Path A x x) (⟨ei⟩ x) (⟨ei⟩ x)`.
|
||||
|
||||
The inner plam gives `Path A x x` (by the same argument as `sec`); the
|
||||
outer plam gives a path between two copies of `⟨ei⟩ x` — because the
|
||||
outer `substDim eo` leaves `plam ei (var x)` alone (the var is a term
|
||||
variable, unaffected by dim substitution). This is the "constant
|
||||
2-cell at refl". -/
|
||||
theorem hasType_coh_refl_refl (Γ : Ctx) (A : CType) :
|
||||
/-- `(idEquiv A).coh : A → Path (Path A x x) (⟨ei⟩ x) (⟨ei⟩ x)`. -/
|
||||
theorem hasType_coh_refl_refl {ℓ : ULevel} (Γ : Ctx) (A : CType ℓ) :
|
||||
HasType Γ (idEquiv A).coh
|
||||
(.pi A
|
||||
(.pi "_" A
|
||||
(.path
|
||||
(.path A
|
||||
(CTerm.var EquivData.idEquivVar)
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
/-
|
||||
Topolei.Cubical.Eval
|
||||
CubicalTransport.Eval
|
||||
====================
|
||||
Environment-based evaluator for the cubical calculus (cells-spec §5.4,
|
||||
Phase 1 Week 2).
|
||||
Phase 1 Week 2). Universe-aware (Layer 0 §0.1 cascade).
|
||||
|
||||
`eval env t` reduces `t` to weak-head normal form in environment `env`.
|
||||
Three mutually-recursive pieces:
|
||||
|
|
@ -20,40 +20,48 @@
|
|||
result is the same `CTerm` size, but Lean's structural recursion can't see
|
||||
through that. A future total version will measure on a subject-reduction
|
||||
metric. For now, `partial def` is the honest choice.
|
||||
|
||||
## Universe stratification
|
||||
|
||||
All declarations that take or return CType-bearing data carry an implicit
|
||||
`{ℓ : ULevel}` parameter (or `{ℓ ℓ' : ULevel}` for two distinct levels).
|
||||
Pattern matches on `.pi var A B` discard the binder via `.pi _ A B`
|
||||
(vTranspFun stores both domain and codomain at distinct levels and uses
|
||||
the transport binder, not the pi's binder).
|
||||
-/
|
||||
|
||||
import CubicalTransport.Value
|
||||
import CubicalTransport.Transport
|
||||
|
||||
-- ── Rust FFI declarations (Phase C.2) ──────────────────────────────────────
|
||||
-- `@[extern "topolei_cubical_*"] opaque *Rust ...` declares the Rust
|
||||
-- `@[extern "cubical_transport_*"] opaque *Rust ...` declares the Rust
|
||||
-- entry point. `@[implemented_by]` on each partial def routes runtime
|
||||
-- calls to Rust (kernel-level proof reasoning still uses the axioms).
|
||||
|
||||
@[extern "topolei_cubical_eval"]
|
||||
@[extern "cubical_transport_eval"]
|
||||
opaque evalRust (env : CEnv) : CTerm → CVal
|
||||
|
||||
@[extern "topolei_cubical_vapp"]
|
||||
@[extern "cubical_transport_vapp"]
|
||||
opaque vAppRust : CVal → CVal → CVal
|
||||
|
||||
@[extern "topolei_cubical_vpapp"]
|
||||
@[extern "cubical_transport_vpapp"]
|
||||
opaque vPAppRust : CVal → DimExpr → CVal
|
||||
|
||||
@[extern "topolei_cubical_vhcomp"]
|
||||
opaque vHCompValueRust (A : CType) (φ : FaceFormula) (tube base : CVal) : CVal
|
||||
@[extern "cubical_transport_vhcomp"]
|
||||
opaque vHCompValueRust {ℓ : ULevel} (A : CType ℓ) (φ : FaceFormula) (tube base : CVal) : CVal
|
||||
|
||||
@[extern "topolei_cubical_vcomp_term"]
|
||||
opaque vCompAtTermRust (env : CEnv) (i : DimVar) (A : CType)
|
||||
@[extern "cubical_transport_vcomp_term"]
|
||||
opaque vCompAtTermRust {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (u t : CTerm) : CVal
|
||||
|
||||
@[extern "topolei_cubical_vcompn_term"]
|
||||
opaque vCompNAtTermRust (env : CEnv) (i : DimVar) (A : CType)
|
||||
@[extern "cubical_transport_vcompn_term"]
|
||||
opaque vCompNAtTermRust {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(clauses : List (FaceFormula × CTerm)) (t : CTerm) : CVal
|
||||
|
||||
@[extern "topolei_cubical_vfst"]
|
||||
@[extern "cubical_transport_vfst"]
|
||||
opaque vFstRust : CVal → CVal
|
||||
|
||||
@[extern "topolei_cubical_vsnd"]
|
||||
@[extern "cubical_transport_vsnd"]
|
||||
opaque vSndRust : CVal → CVal
|
||||
|
||||
mutual
|
||||
|
|
@ -257,14 +265,14 @@ mutual
|
|||
Note the crucial difference from `vTransp`: no constant-line check,
|
||||
because hcomp is *already* homogeneous — constancy is built in. -/
|
||||
@[implemented_by vHCompValueRust]
|
||||
partial def vHCompValue (A : CType) (φ : FaceFormula) (tube base : CVal) :
|
||||
CVal :=
|
||||
partial def vHCompValue {ℓ : ULevel} (A : CType ℓ) (φ : FaceFormula)
|
||||
(tube base : CVal) : CVal :=
|
||||
match φ with
|
||||
| .top => vPApp tube .one
|
||||
| _ =>
|
||||
match A with
|
||||
| .pi _domA codA => .vHCompFun codA φ tube base
|
||||
| _ => .vneu (.nhcomp A φ tube base)
|
||||
| .pi _ _domA codA => .vHCompFun codA φ tube base
|
||||
| _ => .vneu (.nhcomp A φ tube base)
|
||||
|
||||
/-- Heterogeneous composition at the term level. Takes `u` and `t` as
|
||||
`CTerm`s (not `CVal`s) so that the `comp_full` reduction can perform
|
||||
|
|
@ -284,7 +292,7 @@ mutual
|
|||
`φ`; case (3) discriminates on `A` only after `.top`/`.bot` are
|
||||
ruled out. All four cases are mutually exclusive. -/
|
||||
@[implemented_by vCompAtTermRust]
|
||||
partial def vCompAtTerm (env : CEnv) (i : DimVar) (A : CType)
|
||||
partial def vCompAtTerm {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (u t : CTerm) : CVal :=
|
||||
match φ with
|
||||
| .top => eval env (u.substDim i .one)
|
||||
|
|
@ -296,7 +304,7 @@ mutual
|
|||
vHCompValue A φ (eval env (.plam i u)) (eval env t)
|
||||
else
|
||||
match A with
|
||||
| .pi domA codA =>
|
||||
| .pi _ domA codA =>
|
||||
-- Hetero Π comp: package into a `vCompFun` closure. The CCHM
|
||||
-- β-rule runs at `vApp`-time with a full fill-based tube.
|
||||
.vCompFun env i domA codA φ u t
|
||||
|
|
@ -314,7 +322,7 @@ mutual
|
|||
· Otherwise produce a stuck `ncompN` neutral preserving env, line
|
||||
binder, type, evaluated clauses, and evaluated base. -/
|
||||
@[implemented_by vCompNAtTermRust]
|
||||
partial def vCompNAtTerm (env : CEnv) (i : DimVar) (A : CType)
|
||||
partial def vCompNAtTerm {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(clauses : List (FaceFormula × CTerm)) (t : CTerm) : CVal :=
|
||||
-- Scan for a `.top` clause first.
|
||||
match clauses.find? (fun ⟨φ, _⟩ => match φ with | .top => true | _ => false) with
|
||||
|
|
@ -372,12 +380,12 @@ The four cases are mutually exclusive by precondition, so the axiom set
|
|||
is consistent. -/
|
||||
|
||||
/-- (1) T1 at eval level: transport under a full face is identity. -/
|
||||
axiom eval_transp_top (env : CEnv) (i : DimVar) (A : CType) (t : CTerm) :
|
||||
axiom eval_transp_top {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ) (t : CTerm) :
|
||||
eval env (.transp i A .top t) = eval env t
|
||||
|
||||
/-- (2) T2 at eval level: transport along a constant line is identity.
|
||||
Covers `.univ`, constant-`pi`, and constant-`path` lines uniformly. -/
|
||||
axiom eval_transp_const (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom eval_transp_const {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (t : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i A = true) :
|
||||
|
|
@ -389,7 +397,7 @@ axiom eval_transp_const (env : CEnv) (i : DimVar) (A : CType)
|
|||
path term `t` (kept as a CTerm so later `.papp t r` constructions
|
||||
work for the multi-clause reduction at generic dim). Reduces
|
||||
further under `vPApp` at endpoints. -/
|
||||
axiom eval_transp_path (env : CEnv) (i : DimVar) (A₀ : CType)
|
||||
axiom eval_transp_path {ℓ : ULevel} (env : CEnv) (i : DimVar) (A₀ : CType ℓ)
|
||||
(a b : CTerm) (φ : FaceFormula) (t : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i (.path A₀ a b) = false) :
|
||||
|
|
@ -401,13 +409,19 @@ axiom eval_transp_path (env : CEnv) (i : DimVar) (A₀ : CType)
|
|||
`.glue` is excluded because its CCHM transport formula lives in dedicated
|
||||
Glue-specific axioms (see `Glue.lean`); routing it through `vTransp`
|
||||
here would claim it reduces to a stuck neutral, which would contradict
|
||||
those axioms in their specific sub-cases. -/
|
||||
axiom eval_transp_nonpath (env : CEnv) (i : DimVar) (A : CType)
|
||||
those axioms in their specific sub-cases.
|
||||
|
||||
Path / Glue both store sub-CTypes at the *same* universe level as A
|
||||
(their CType.path and CType.glue constructors carry `A : CType ℓ`
|
||||
with the outer level), so same-level Eq comparison is sufficient to
|
||||
rule them out. -/
|
||||
axiom eval_transp_nonpath {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (t : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i A = false)
|
||||
(h_not_path : ∀ A₀ a b, A ≠ .path A₀ a b)
|
||||
(h_not_glue : ∀ φG T f fInv sec ret coh Ai,
|
||||
(h_not_path : ∀ (A₀ : CType ℓ) (a b : CTerm), A ≠ .path A₀ a b)
|
||||
(h_not_glue : ∀ (φG : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (Ai : CType ℓ),
|
||||
A ≠ .glue φG T f fInv sec ret coh Ai) :
|
||||
eval env (.transp i A φ t) = vTransp i A φ (eval env t)
|
||||
|
||||
|
|
@ -415,30 +429,38 @@ axiom eval_transp_nonpath (env : CEnv) (i : DimVar) (A : CType)
|
|||
produces a `vTranspFun` closure. Derived via `eval_transp_nonpath`
|
||||
(`pi ≠ path` and `pi ≠ glue` by constructor disjointness) plus
|
||||
`vTransp_pi`. -/
|
||||
theorem eval_transp_pi (env : CEnv) (i : DimVar)
|
||||
(domA codA : CType) (φ : FaceFormula) (t : CTerm)
|
||||
theorem eval_transp_pi {ℓ ℓ' : ULevel} (env : CEnv) (i : DimVar)
|
||||
(var : String) (domA : CType ℓ) (codA : CType ℓ') (φ : FaceFormula) (t : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i (.pi domA codA) = false) :
|
||||
eval env (.transp i (.pi domA codA) φ t) =
|
||||
(hA : CType.dimAbsent i (.pi var domA codA) = false) :
|
||||
eval env (.transp i (.pi var domA codA) φ t) =
|
||||
.vTranspFun i domA codA φ (eval env t) := by
|
||||
rw [eval_transp_nonpath env i _ φ t hφ hA
|
||||
(by intro _ _ _ h; nomatch h)
|
||||
(by intro _ _ _ _ _ _ _ _ h; nomatch h)]
|
||||
exact vTransp_pi _ _ _ _ _ hφ hA
|
||||
exact vTransp_pi _ _ _ _ _ _ hφ hA
|
||||
|
||||
/-- Stuck fallback theorem. In our current `CType` universe
|
||||
`{univ, pi, path, glue}`, this never actually fires in practice: `univ`
|
||||
always has `dimAbsent = true`, so the const case wins; `pi` is handled
|
||||
by `eval_transp_pi`; `path` is handled by `eval_transp_path`; `glue` is
|
||||
handled by the dedicated Glue-transport axioms in `Glue.lean`. Kept
|
||||
here for parity with `vTransp_stuck` and future CType extensions. -/
|
||||
theorem eval_transp_stuck (env : CEnv) (i : DimVar) (A : CType)
|
||||
`{univ, pi, path, glue, ind, interval, lift}`, this never actually
|
||||
fires in practice: `univ`/`interval` always have `dimAbsent = true`,
|
||||
so the const case wins; `pi` is handled by `eval_transp_pi`; `path`
|
||||
is handled by `eval_transp_path`; `glue` is handled by the dedicated
|
||||
Glue-transport axioms in `Glue.lean`. Kept here for parity with
|
||||
`vTransp_stuck` and future CType extensions.
|
||||
|
||||
`h_not_pi` uses the level-erased skeleton (`CType.skeleton`) to
|
||||
formulate constructor-disjointness, sidestepping cross-level HEq
|
||||
elimination (which is not available in Lean 4 without K).
|
||||
`h_not_path` and `h_not_glue` are same-level Eq because those
|
||||
constructors store sub-components at the outer level. -/
|
||||
theorem eval_transp_stuck {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (t : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i A = false)
|
||||
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA)
|
||||
(h_not_path : ∀ A₀ a b, A ≠ .path A₀ a b)
|
||||
(h_not_glue : ∀ φG T f fInv sec ret coh Ai,
|
||||
(h_not_pi : A.skeleton ≠ SkeletalCType.pi)
|
||||
(h_not_path : ∀ (A₀ : CType ℓ) (a b : CTerm), A ≠ .path A₀ a b)
|
||||
(h_not_glue : ∀ (φG : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (Ai : CType ℓ),
|
||||
A ≠ .glue φG T f fInv sec ret coh Ai) :
|
||||
eval env (.transp i A φ t) =
|
||||
.vneu (.ntransp i A φ (eval env t)) := by
|
||||
|
|
@ -461,7 +483,7 @@ theorem eval_transp_stuck (env : CEnv) (i : DimVar) (A : CType)
|
|||
not re-audited. The Rust backend's discharge: a face-normalisation
|
||||
routine ensures syntactically distinct but semantically equal faces
|
||||
take the same dispatch branch. -/
|
||||
axiom eval_transp_face_congr (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom eval_transp_face_congr {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ ψ : FaceFormula) (t : CTerm)
|
||||
(h : ∀ ε, φ.eval ε = ψ.eval ε) :
|
||||
eval env (.transp i A φ t) = eval env (.transp i A ψ t)
|
||||
|
|
@ -479,19 +501,19 @@ cases are disjoint by precondition, so the axiom set is consistent.
|
|||
is *term-level* substitution, not `vPApp` on the evaluated body —
|
||||
`u` may be e.g. a free variable whose value doesn't look like a
|
||||
function. -/
|
||||
axiom eval_comp_top (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) :
|
||||
axiom eval_comp_top {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ) (u t : CTerm) :
|
||||
eval env (.comp i A .top u t) = eval env (u.substDim i .one)
|
||||
|
||||
/-- **C2 at eval level**: with an empty face, the system contributes
|
||||
nothing and composition reduces to plain transport. -/
|
||||
axiom eval_comp_bot (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) :
|
||||
axiom eval_comp_bot {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ) (u t : CTerm) :
|
||||
eval env (.comp i A .bot u t) = eval env (.transp i A .bot t)
|
||||
|
||||
/-- **Constant-line comp = hcomp**: when the type `A` doesn't vary along
|
||||
`i`, heterogeneous composition reduces to homogeneous composition on
|
||||
the (fixed) type `A`. The tube is `.plam i u` — the system body `u`
|
||||
packaged as a dim-closure over the line binder. -/
|
||||
axiom eval_comp_const (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom eval_comp_const {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (u t : CTerm)
|
||||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||||
(hA : CType.dimAbsent i A = true) :
|
||||
|
|
@ -501,26 +523,29 @@ axiom eval_comp_const (env : CEnv) (i : DimVar) (A : CType)
|
|||
/-- **Heterogeneous Π comp**: when A is a pi type with a genuinely-varying
|
||||
line, `vCompAtTerm` packages the comp into a `vCompFun` closure that
|
||||
will run the CCHM β-rule when the function is applied. -/
|
||||
axiom eval_comp_pi (env : CEnv) (i : DimVar) (domA codA : CType)
|
||||
axiom eval_comp_pi {ℓ ℓ' : ULevel} (env : CEnv) (i : DimVar)
|
||||
(var : String) (domA : CType ℓ) (codA : CType ℓ')
|
||||
(φ : FaceFormula) (u t : CTerm)
|
||||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||||
(hA : CType.dimAbsent i (.pi domA codA) = false) :
|
||||
eval env (.comp i (.pi domA codA) φ u t) =
|
||||
(hA : CType.dimAbsent i (.pi var domA codA) = false) :
|
||||
eval env (.comp i (.pi var domA codA) φ u t) =
|
||||
.vCompFun env i domA codA φ u t
|
||||
|
||||
/-- Stuck fallback: `.comp` whose face is neither `.top` nor `.bot`, whose
|
||||
line genuinely varies, and whose type is neither `.pi` nor a constant
|
||||
produces a neutral. -/
|
||||
axiom eval_comp_stuck (env : CEnv) (i : DimVar) (A : CType)
|
||||
produces a neutral. The "not a pi" precondition uses
|
||||
`CType.skeleton ≠ .pi` (level-erased constructor tag) to avoid
|
||||
cross-level HEq elimination. -/
|
||||
axiom eval_comp_stuck {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (u t : CTerm)
|
||||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||||
(hA : CType.dimAbsent i A = false)
|
||||
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA) :
|
||||
(h_not_pi : A.skeleton ≠ SkeletalCType.pi) :
|
||||
eval env (.comp i A φ u t) =
|
||||
.vneu (.ncomp i A φ (eval env u) (eval env t))
|
||||
|
||||
/-- `eval` on `.compN` delegates to `vCompNAtTerm`. -/
|
||||
axiom eval_compN (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom eval_compN {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(clauses : List (FaceFormula × CTerm)) (t : CTerm) :
|
||||
eval env (.compN i A clauses t) = vCompNAtTerm env i A clauses t
|
||||
|
||||
|
|
@ -530,7 +555,7 @@ axiom eval_compN (env : CEnv) (i : DimVar) (A : CType)
|
|||
|
||||
/-- Homogeneous composition under a full face: the tube covers everything,
|
||||
and the result is the tube evaluated at `1`. -/
|
||||
axiom vHCompValue_top (A : CType) (tube base : CVal) :
|
||||
axiom vHCompValue_top {ℓ : ULevel} (A : CType ℓ) (tube base : CVal) :
|
||||
vHCompValue A .top tube base = vPApp tube .one
|
||||
|
||||
/-- **CCHM Π hcomp rule**: homogeneous composition on a Π type produces
|
||||
|
|
@ -538,15 +563,18 @@ axiom vHCompValue_top (A : CType) (tube base : CVal) :
|
|||
applied to an argument. `domA` is stored in the type but unused in
|
||||
the resulting closure because hcomp on the domain is trivial (A is
|
||||
fixed, not varying). -/
|
||||
axiom vHCompValue_pi (domA codA : CType) (φ : FaceFormula) (tube base : CVal)
|
||||
axiom vHCompValue_pi {ℓ ℓ' : ULevel}
|
||||
(var : String) (domA : CType ℓ) (codA : CType ℓ')
|
||||
(φ : FaceFormula) (tube base : CVal)
|
||||
(hφ : φ ≠ .top) :
|
||||
vHCompValue (.pi domA codA) φ tube base = .vHCompFun codA φ tube base
|
||||
vHCompValue (.pi var domA codA) φ tube base = .vHCompFun codA φ tube base
|
||||
|
||||
/-- Stuck fallback: hcomp on a non-pi type under a non-top face. Uses
|
||||
`nhcomp` (separate from `ncomp` because hcomp's type is fixed). -/
|
||||
axiom vHCompValue_stuck (A : CType) (φ : FaceFormula) (tube base : CVal)
|
||||
`nhcomp` (separate from `ncomp` because hcomp's type is fixed).
|
||||
The "not a pi" precondition uses skeleton-disjointness (avoiding HEq). -/
|
||||
axiom vHCompValue_stuck {ℓ : ULevel} (A : CType ℓ) (φ : FaceFormula) (tube base : CVal)
|
||||
(hφ : φ ≠ .top)
|
||||
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA) :
|
||||
(h_not_pi : A.skeleton ≠ SkeletalCType.pi) :
|
||||
vHCompValue A φ tube base = .vneu (.nhcomp A φ tube base)
|
||||
|
||||
-- Reduction lemmas for `vApp`.
|
||||
|
|
@ -565,7 +593,8 @@ axiom vApp_vneu (n : CNeu) (arg : CVal) :
|
|||
When `CType.dimAbsent i domA = true`, `vTranspInv` reduces to identity
|
||||
(by `vTranspInv_const`) and this specialises to the simpler
|
||||
const-domain rule `vTransp i codA φ (vApp f arg)`. -/
|
||||
axiom vApp_vTranspFun (i : DimVar) (domA codA : CType) (φ : FaceFormula)
|
||||
axiom vApp_vTranspFun {ℓ ℓ' : ULevel} (i : DimVar)
|
||||
(domA : CType ℓ) (codA : CType ℓ') (φ : FaceFormula)
|
||||
(f : CVal) (arg : CVal) :
|
||||
vApp (.vTranspFun i domA codA φ f) arg =
|
||||
vTransp i codA φ (vApp f (vTranspInv i domA φ arg))
|
||||
|
|
@ -576,7 +605,8 @@ axiom vApp_vTranspFun (i : DimVar) (domA codA : CType) (φ : FaceFormula)
|
|||
· base = `base arg`.
|
||||
No inverse transport — hcomp's type is fixed, so the argument passes
|
||||
through unchanged. -/
|
||||
axiom vApp_vHCompFun (codA : CType) (φ : FaceFormula) (tube base arg : CVal) :
|
||||
axiom vApp_vHCompFun {ℓ : ULevel} (codA : CType ℓ) (φ : FaceFormula)
|
||||
(tube base arg : CVal) :
|
||||
vApp (.vHCompFun codA φ tube base) arg =
|
||||
vHCompValue codA φ (.vTubeApp tube arg) (vApp base arg)
|
||||
|
||||
|
|
@ -595,7 +625,8 @@ axiom vApp_vHCompFun (codA : CType) (φ : FaceFormula) (tube base arg : CVal) :
|
|||
Hygiene assumption: `$y` is not a user variable in `env`, and `$fj`
|
||||
is not a user DimVar in `domA`, `codA`, `φ`, `u`, `t`. These reserved
|
||||
names are chosen to minimise collision probability. -/
|
||||
axiom vApp_vCompFun (env : CEnv) (i : DimVar) (domA codA : CType)
|
||||
axiom vApp_vCompFun {ℓ ℓ' : ULevel} (env : CEnv) (i : DimVar)
|
||||
(domA : CType ℓ) (codA : CType ℓ')
|
||||
(φ : FaceFormula) (u t : CTerm) (arg : CVal) :
|
||||
vApp (.vCompFun env i domA codA φ u t) arg =
|
||||
eval (env.extend "$y" arg) (.comp i codA φ
|
||||
|
|
@ -625,7 +656,7 @@ axiom vPApp_vTubeApp (tube arg : CVal) (r : DimExpr) :
|
|||
Single axiom exposing the full case analysis so that derived theorems can
|
||||
pattern-match on the clause list's structure. -/
|
||||
|
||||
axiom vCompNAtTerm_def (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom vCompNAtTerm_def {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(clauses : List (FaceFormula × CTerm)) (t : CTerm) :
|
||||
vCompNAtTerm env i A clauses t =
|
||||
match clauses.find?
|
||||
|
|
@ -655,15 +686,15 @@ The three axioms are disjoint by the shape of the DimExpr argument.
|
|||
with `i` substituted by `.one`. This is *not* a transport of `a(0)` —
|
||||
it's the line's specified endpoint at `i=1`, made forced by CCHM's
|
||||
multi-clause `(j=0)` constraint. -/
|
||||
axiom vPApp_vPathTransp_zero
|
||||
(env : CEnv) (i : DimVar) (A : CType) (a b : CTerm) (φ : FaceFormula)
|
||||
axiom vPApp_vPathTransp_zero {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar) (A : CType ℓ) (a b : CTerm) (φ : FaceFormula)
|
||||
(p : CTerm) :
|
||||
vPApp (.vPathTransp env i A a b φ p) .zero =
|
||||
eval env (a.substDim i .one)
|
||||
|
||||
/-- Path transport at right endpoint: result is `b(1)`. -/
|
||||
axiom vPApp_vPathTransp_one
|
||||
(env : CEnv) (i : DimVar) (A : CType) (a b : CTerm) (φ : FaceFormula)
|
||||
axiom vPApp_vPathTransp_one {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar) (A : CType ℓ) (a b : CTerm) (φ : FaceFormula)
|
||||
(p : CTerm) :
|
||||
vPApp (.vPathTransp env i A a b φ p) .one =
|
||||
eval env (b.substDim i .one)
|
||||
|
|
@ -677,8 +708,8 @@ axiom vPApp_vPathTransp_one
|
|||
· `r = .var k` generic → both clauses are non-trivial; stalls at a
|
||||
structured `ncompN` neutral that can still unstick if `k` later
|
||||
becomes an endpoint. -/
|
||||
axiom vPApp_vPathTransp_general
|
||||
(env : CEnv) (i : DimVar) (A : CType) (a b : CTerm) (φ : FaceFormula)
|
||||
axiom vPApp_vPathTransp_general {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar) (A : CType ℓ) (a b : CTerm) (φ : FaceFormula)
|
||||
(p : CTerm) (r : DimExpr)
|
||||
(h_zero : r ≠ .zero) (h_one : r ≠ .one) :
|
||||
vPApp (.vPathTransp env i A a b φ p) r =
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.EvalTest
|
||||
CubicalTransport.EvalTest
|
||||
========================
|
||||
Roundtrip tests for the evaluator (cells-spec §13 Phase 1 Week 2 test:
|
||||
"eval roundtrip for simple terms").
|
||||
|
|
@ -14,6 +14,18 @@
|
|||
· path abstractions close over their environment,
|
||||
· path applications β-reduce via `substDim`,
|
||||
· transport / composition terms produce the expected neutrals.
|
||||
|
||||
## Universe-stratified port
|
||||
|
||||
The original (pre-Layer 0) tests used a monomorphic `CType`; the
|
||||
universe-stratified successor (`CType : ULevel → Type`) requires:
|
||||
· `.univ` → `CType.univ (ℓ := .zero)` at result level `.succ .zero`
|
||||
· `.pi A B` → `.pi "_" A B` (named binders)
|
||||
· `.sigma A B` → `.sigma "_" A B`
|
||||
· `.ind ... [P, Q]` → `.ind ... [⟨_, P⟩, ⟨_, Q⟩]` (Σ-pair params)
|
||||
· `.glue` retained the same shape
|
||||
Most tests are phrased over level `.succ .zero` (where `.univ` lives)
|
||||
with sub-CTypes also at that level for compatibility.
|
||||
-/
|
||||
|
||||
import CubicalTransport.Eval
|
||||
|
|
@ -98,7 +110,7 @@ theorem eval_papp_beta (i : DimVar) (body : CTerm) (r : DimExpr) :
|
|||
|
||||
/-- T1 at eval level: transport under a `.top` face reduces to its argument.
|
||||
(This is the spec's Week 3 test "transport along refl = id".) -/
|
||||
theorem eval_transp_top_id (i : DimVar) (A : CType) (x : String) :
|
||||
theorem eval_transp_top_id {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (x : String) :
|
||||
eval .nil (.transp i A .top (.var x)) = .vneu (.nvar x) := by
|
||||
rw [eval_transp_top, eval_var]; rfl
|
||||
|
||||
|
|
@ -106,17 +118,20 @@ theorem eval_transp_top_id (i : DimVar) (A : CType) (x : String) :
|
|||
to its argument. For `A = .univ`, this holds for any `φ` — via
|
||||
`eval_transp_top` when `φ = .top` and via `eval_transp_const` otherwise. -/
|
||||
theorem eval_transp_const_univ (i : DimVar) (φ : FaceFormula) (x : String) :
|
||||
eval .nil (.transp i .univ φ (.var x)) = .vneu (.nvar x) := by
|
||||
eval .nil (.transp i (CType.univ (ℓ := .zero)) φ (.var x)) = .vneu (.nvar x) := by
|
||||
by_cases hφ : φ = .top
|
||||
· subst hφ; rw [eval_transp_top, eval_var]; rfl
|
||||
· rw [eval_transp_const _ _ _ _ _ hφ
|
||||
(rfl : CType.dimAbsent i .univ = true),
|
||||
(rfl : CType.dimAbsent i (CType.univ (ℓ := .zero)) = true),
|
||||
eval_var]; rfl
|
||||
|
||||
/-- T2 also discharges for `pi` when neither side mentions the binder. -/
|
||||
theorem eval_transp_const_pi (i : DimVar) (φ : FaceFormula) (x : String) :
|
||||
eval .nil (.transp i (.pi .univ .univ) φ (.var x)) = .vneu (.nvar x) := by
|
||||
have h : CType.dimAbsent i (.pi .univ .univ) = true := rfl
|
||||
eval .nil
|
||||
(.transp i (.pi "_" (CType.univ (ℓ := .zero)) (CType.univ (ℓ := .zero))) φ (.var x))
|
||||
= .vneu (.nvar x) := by
|
||||
have h : CType.dimAbsent i
|
||||
(.pi "_" (CType.univ (ℓ := .zero)) (CType.univ (ℓ := .zero))) = true := rfl
|
||||
by_cases hφ : φ = .top
|
||||
· subst hφ; rw [eval_transp_top, eval_var]; rfl
|
||||
· rw [eval_transp_const _ _ _ _ _ hφ h, eval_var]; rfl
|
||||
|
|
@ -124,12 +139,16 @@ theorem eval_transp_const_pi (i : DimVar) (φ : FaceFormula) (x : String) :
|
|||
/-- Transport at a free-variable argument under a stuck face and non-constant
|
||||
non-pi non-path non-glue line produces a neutral `ntransp`. The Π, Path,
|
||||
and Glue cases are handled by `eval_transp_pi` / `eval_transp_path` /
|
||||
the Glue-specific axioms in `Glue.lean`. -/
|
||||
theorem eval_transp_neu (i : DimVar) (A : CType) (φ : FaceFormula) (x : String)
|
||||
the Glue-specific axioms in `Glue.lean`.
|
||||
|
||||
The "not a pi" precondition uses the level-erased `skeleton ≠ .pi`
|
||||
(the post-cascade structural form), avoiding cross-level HEq. -/
|
||||
theorem eval_transp_neu {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (x : String)
|
||||
(hφ : φ ≠ .top) (hA : CType.dimAbsent i A = false)
|
||||
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA)
|
||||
(h_not_path : ∀ A₀ a b, A ≠ .path A₀ a b)
|
||||
(h_not_glue : ∀ φG T f fInv sec ret coh Ai,
|
||||
(h_not_pi : A.skeleton ≠ SkeletalCType.pi)
|
||||
(h_not_path : ∀ (A₀ : CType ℓ) (a b : CTerm), A ≠ .path A₀ a b)
|
||||
(h_not_glue : ∀ (φG : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (Ai : CType ℓ),
|
||||
A ≠ .glue φG T f fInv sec ret coh Ai) :
|
||||
eval .nil (.transp i A φ (.var x)) =
|
||||
.vneu (.ntransp i A φ (.vneu (.nvar x))) := by
|
||||
|
|
@ -140,25 +159,26 @@ theorem eval_transp_neu (i : DimVar) (A : CType) (φ : FaceFormula) (x : String)
|
|||
--
|
||||
-- Concrete setup: codomain varies in dimension `i` but domain is `.univ`
|
||||
-- (constant).
|
||||
-- Body: `pi univ (path univ (var "a") (papp (var "p") (dim-var i)))`.
|
||||
-- Body: `pi "_" univ (path univ (var "a") (papp (var "p") (dim-var i)))`.
|
||||
|
||||
private def i_dim : DimVar := ⟨"i"⟩
|
||||
|
||||
private def codAtype : CType :=
|
||||
.path .univ (.var "a") (.papp (.var "p") (DimExpr.var i_dim))
|
||||
private def codAtype : CType (.succ .zero) :=
|
||||
.path (CType.univ (ℓ := .zero)) (.var "a") (.papp (.var "p") (DimExpr.var i_dim))
|
||||
|
||||
private theorem codAtype_varies : CType.dimAbsent i_dim codAtype = false := by decide
|
||||
|
||||
private theorem pi_univ_codA_varies :
|
||||
CType.dimAbsent i_dim (.pi .univ codAtype) = false := by decide
|
||||
CType.dimAbsent i_dim (.pi "_" (CType.univ (ℓ := .zero)) codAtype) = false := by decide
|
||||
|
||||
/-- vTransp along `pi .univ codAtype` produces a `vTranspFun` closure
|
||||
carrying both the (constant) domain and the (varying) codomain. -/
|
||||
theorem eval_transp_pi_const_dom_example
|
||||
(φ : FaceFormula) (hφ : φ ≠ .top) (f : String) :
|
||||
eval .nil (.transp i_dim (.pi .univ codAtype) φ (.var f)) =
|
||||
.vTranspFun i_dim .univ codAtype φ (.vneu (.nvar f)) := by
|
||||
rw [eval_transp_pi _ _ _ _ _ _ hφ pi_univ_codA_varies, eval_var]
|
||||
eval .nil
|
||||
(.transp i_dim (.pi "_" (CType.univ (ℓ := .zero)) codAtype) φ (.var f))
|
||||
= .vTranspFun i_dim (CType.univ (ℓ := .zero)) codAtype φ (.vneu (.nvar f)) := by
|
||||
rw [eval_transp_pi _ _ _ _ _ _ _ hφ pi_univ_codA_varies, eval_var]
|
||||
rfl
|
||||
|
||||
/-- The CCHM Π β-rule at the value level, const-domain subcase. The inner
|
||||
|
|
@ -167,17 +187,19 @@ theorem eval_transp_pi_const_dom_example
|
|||
codomain stalls into a neutral. -/
|
||||
theorem vApp_vTranspFun_const_dom_reduces
|
||||
(φ : FaceFormula) (hφ : φ ≠ .top) (f y : String) :
|
||||
vApp (.vTranspFun i_dim .univ codAtype φ (.vneu (.nvar f))) (.vneu (.nvar y)) =
|
||||
vApp (.vTranspFun i_dim (CType.univ (ℓ := .zero)) codAtype φ (.vneu (.nvar f)))
|
||||
(.vneu (.nvar y)) =
|
||||
.vneu (.ntransp i_dim codAtype φ
|
||||
(.vneu (.napp (.nvar f) (.vneu (.nvar y))))) := by
|
||||
-- CCHM Π β-rule
|
||||
rw [vApp_vTranspFun]
|
||||
-- Inverse transport through constant domain `.univ` is identity
|
||||
rw [vTranspInv_const i_dim .univ φ _ (rfl : CType.dimAbsent i_dim .univ = true)]
|
||||
rw [vTranspInv_const i_dim (CType.univ (ℓ := .zero)) φ _
|
||||
(rfl : CType.dimAbsent i_dim (CType.univ (ℓ := .zero)) = true)]
|
||||
-- Apply `f` (a neutral) to `y` (a neutral) — stuck `napp`
|
||||
rw [vApp_vneu]
|
||||
-- Forward transport through the varying codomain — stuck neutral
|
||||
rw [vTransp_stuck _ _ _ _ hφ codAtype_varies (by intro _ _ h; nomatch h)]
|
||||
rw [vTransp_stuck _ _ _ _ hφ codAtype_varies (by intro h; cases h)]
|
||||
|
||||
-- ── Π-case with varying domain, varying codomain ─────────────────────────────
|
||||
--
|
||||
|
|
@ -186,26 +208,26 @@ theorem vApp_vTranspFun_const_dom_reduces
|
|||
-- Body: `pi (path univ (var "a0") (papp (var "p") (dim-var i)))
|
||||
-- (path univ (var "b0") (papp (var "q") (dim-var i)))`.
|
||||
|
||||
private def domAtype : CType :=
|
||||
.path .univ (.var "a0") (.papp (.var "p") (DimExpr.var i_dim))
|
||||
private def domAtype : CType (.succ .zero) :=
|
||||
.path (CType.univ (ℓ := .zero)) (.var "a0") (.papp (.var "p") (DimExpr.var i_dim))
|
||||
|
||||
private def codBtype : CType :=
|
||||
.path .univ (.var "b0") (.papp (.var "q") (DimExpr.var i_dim))
|
||||
private def codBtype : CType (.succ .zero) :=
|
||||
.path (CType.univ (ℓ := .zero)) (.var "b0") (.papp (.var "q") (DimExpr.var i_dim))
|
||||
|
||||
private theorem domAtype_varies : CType.dimAbsent i_dim domAtype = false := by decide
|
||||
|
||||
private theorem codBtype_varies : CType.dimAbsent i_dim codBtype = false := by decide
|
||||
|
||||
private theorem pi_varying_all :
|
||||
CType.dimAbsent i_dim (.pi domAtype codBtype) = false := by decide
|
||||
CType.dimAbsent i_dim (.pi "_" domAtype codBtype) = false := by decide
|
||||
|
||||
/-- vTransp along a pi with both sides varying still produces a unified
|
||||
`vTranspFun` — no special-case logic needed at the line level. -/
|
||||
theorem eval_transp_pi_varying_dom
|
||||
(φ : FaceFormula) (hφ : φ ≠ .top) (f : String) :
|
||||
eval .nil (.transp i_dim (.pi domAtype codBtype) φ (.var f)) =
|
||||
eval .nil (.transp i_dim (.pi "_" domAtype codBtype) φ (.var f)) =
|
||||
.vTranspFun i_dim domAtype codBtype φ (.vneu (.nvar f)) := by
|
||||
rw [eval_transp_pi _ _ _ _ _ _ hφ pi_varying_all, eval_var]
|
||||
rw [eval_transp_pi _ _ _ _ _ _ _ hφ pi_varying_all, eval_var]
|
||||
rfl
|
||||
|
||||
/-- The reversed domain line also varies in `i_dim`. Reversing substitutes
|
||||
|
|
@ -235,11 +257,11 @@ theorem vApp_vTranspFun_varying_dom_reduces
|
|||
unfold vTranspInv
|
||||
-- The reversed domAtype still varies in i_dim, so vTransp stalls.
|
||||
rw [vTransp_stuck _ _ _ _ hφ domAtype_reversed_varies
|
||||
(by intro _ _ h; nomatch h)]
|
||||
(by intro h; cases h)]
|
||||
-- Apply the (neutral) f to the (now-neutral) argument → stuck `napp`.
|
||||
rw [vApp_vneu]
|
||||
-- Forward transport through the varying codomain → stuck `ntransp`.
|
||||
rw [vTransp_stuck _ _ _ _ hφ codBtype_varies (by intro _ _ h; nomatch h)]
|
||||
rw [vTransp_stuck _ _ _ _ hφ codBtype_varies (by intro h; cases h)]
|
||||
|
||||
-- ── Heterogeneous composition: C1, C2, const-line, and stuck ────────────────
|
||||
|
||||
|
|
@ -248,7 +270,7 @@ theorem vApp_vTranspFun_varying_dom_reduces
|
|||
`u = .var "body"` (a free variable with no dim dependence) and `A = .univ`,
|
||||
the substitution is a no-op and the result is `vneu (nvar "body")`. -/
|
||||
theorem eval_comp_top_example (i : DimVar) (t : String) :
|
||||
eval .nil (.comp i .univ .top (.var "body") (.var t)) =
|
||||
eval .nil (.comp i (CType.univ (ℓ := .zero)) .top (.var "body") (.var t)) =
|
||||
.vneu (.nvar "body") := by
|
||||
rw [eval_comp_top]
|
||||
-- (var "body").substDim i .one = var "body" (var case is trivial)
|
||||
|
|
@ -261,7 +283,7 @@ theorem eval_comp_top_example (i : DimVar) (t : String) :
|
|||
`papp (var "p") .one`, which evaluates via `vPApp` on a neutral. -/
|
||||
theorem eval_comp_top_dim_subst (i : DimVar) (t : String) :
|
||||
eval .nil
|
||||
(.comp i .univ .top (.papp (.var "p") (.var i)) (.var t)) =
|
||||
(.comp i (CType.univ (ℓ := .zero)) .top (.papp (.var "p") (.var i)) (.var t)) =
|
||||
.vneu (.npapp (.nvar "p") .one) := by
|
||||
rw [eval_comp_top]
|
||||
-- Reduce `(papp (var "p") (var i)).substDim i .one`:
|
||||
|
|
@ -276,12 +298,12 @@ theorem eval_comp_top_dim_subst (i : DimVar) (t : String) :
|
|||
under `.bot`. When the line `A` is constant (here `.univ`), T2 then
|
||||
reduces the transport to identity. -/
|
||||
theorem eval_comp_bot_univ (i : DimVar) (u t : String) :
|
||||
eval .nil (.comp i .univ .bot (.var u) (.var t)) =
|
||||
eval .nil (.comp i (CType.univ (ℓ := .zero)) .bot (.var u) (.var t)) =
|
||||
.vneu (.nvar t) := by
|
||||
rw [eval_comp_bot]
|
||||
-- eval (transp i .univ .bot (var t))
|
||||
rw [eval_transp_const _ _ _ _ _ (by intro h; nomatch h)
|
||||
(rfl : CType.dimAbsent i .univ = true),
|
||||
(rfl : CType.dimAbsent i (CType.univ (ℓ := .zero)) = true),
|
||||
eval_var]
|
||||
rfl
|
||||
|
||||
|
|
@ -294,21 +316,23 @@ theorem eval_comp_bot_univ (i : DimVar) (u t : String) :
|
|||
comp (top) → substDim i .one → eval "body" → nvar "body". -/
|
||||
theorem eval_comp_const_line (i : DimVar) (φ : FaceFormula)
|
||||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (t : String) :
|
||||
eval .nil (.comp i .univ φ (.var "body") (.var t)) =
|
||||
.vneu (.nhcomp .univ φ (.vplam .nil i (.var "body")) (.vneu (.nvar t))) := by
|
||||
eval .nil (.comp i (CType.univ (ℓ := .zero)) φ (.var "body") (.var t)) =
|
||||
.vneu (.nhcomp (CType.univ (ℓ := .zero)) φ
|
||||
(.vplam .nil i (.var "body")) (.vneu (.nvar t))) := by
|
||||
rw [eval_comp_const _ _ _ _ _ _ hφ₁ hφ₂
|
||||
(rfl : CType.dimAbsent i .univ = true)]
|
||||
(rfl : CType.dimAbsent i (CType.univ (ℓ := .zero)) = true)]
|
||||
rw [eval_plam, eval_var]
|
||||
have : (CEnv.nil.lookup t).getD (.vneu (.nvar t)) = .vneu (.nvar t) := rfl
|
||||
rw [this]
|
||||
-- `vHCompValue .univ φ (vplam nil i (var "body")) (vneu (nvar t))`
|
||||
-- → stuck, since .univ is not .pi.
|
||||
exact vHCompValue_stuck _ _ _ _ hφ₁ (by intro _ _ h; nomatch h)
|
||||
exact vHCompValue_stuck _ _ _ _ hφ₁ (by intro h; cases h)
|
||||
|
||||
/-- Stuck comp: free variables, non-constant non-pi line, non-top non-bot face. -/
|
||||
theorem eval_comp_neu (i : DimVar) (A : CType) (φ : FaceFormula) (u t : String)
|
||||
/-- Stuck comp: free variables, non-constant non-pi line, non-top non-bot face.
|
||||
The "not a pi" precondition uses the skeleton-disjointness form. -/
|
||||
theorem eval_comp_neu {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (u t : String)
|
||||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hA : CType.dimAbsent i A = false)
|
||||
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA) :
|
||||
(h_not_pi : A.skeleton ≠ SkeletalCType.pi) :
|
||||
eval .nil (.comp i A φ (.var u) (.var t)) =
|
||||
.vneu (.ncomp i A φ (.vneu (.nvar u)) (.vneu (.nvar t))) := by
|
||||
rw [eval_comp_stuck _ _ _ _ _ _ hφ₁ hφ₂ hA h_not_pi, eval_var, eval_var]
|
||||
|
|
@ -324,7 +348,8 @@ theorem eval_comp_neu (i : DimVar) (A : CType) (φ : FaceFormula) (u t : String)
|
|||
a vplam tube: `tube = vplam .nil j (var "u_body")`. The result is
|
||||
`eval .nil ((var "u_body").substDim j .one) = vneu (nvar "u_body")`. -/
|
||||
theorem vHCompValue_top_reduces (j : DimVar) (base : CVal) :
|
||||
vHCompValue (.pi .univ .univ) .top (.vplam .nil j (.var "u_body")) base =
|
||||
vHCompValue (.pi "_" (CType.univ (ℓ := .zero)) (CType.univ (ℓ := .zero))) .top
|
||||
(.vplam .nil j (.var "u_body")) base =
|
||||
.vneu (.nvar "u_body") := by
|
||||
rw [vHCompValue_top, vPApp_vplam]
|
||||
-- (var "u_body").substDim j .one = var "u_body" (no dim usage)
|
||||
|
|
@ -344,15 +369,15 @@ theorem vHCompValue_top_reduces (j : DimVar) (base : CVal) :
|
|||
3. `vApp_vneu` reduces `vApp base y` to `napp (nvar "base_fn") y`.
|
||||
4. `vHCompValue_stuck` on `.univ` produces the final neutral `nhcomp`. -/
|
||||
theorem vApp_vHCompFun_reduces (φ : FaceFormula) (hφ : φ ≠ .top) :
|
||||
vApp (.vHCompFun .univ φ
|
||||
vApp (.vHCompFun (CType.univ (ℓ := .zero)) φ
|
||||
(.vneu (.nvar "tube"))
|
||||
(.vneu (.nvar "base_fn")))
|
||||
(.vneu (.nvar "y")) =
|
||||
.vneu (.nhcomp .univ φ
|
||||
.vneu (.nhcomp (CType.univ (ℓ := .zero)) φ
|
||||
(.vTubeApp (.vneu (.nvar "tube")) (.vneu (.nvar "y")))
|
||||
(.vneu (.napp (.nvar "base_fn") (.vneu (.nvar "y"))))) := by
|
||||
rw [vApp_vHCompFun, vApp_vneu,
|
||||
vHCompValue_stuck _ _ _ _ hφ (by intro _ _ h; nomatch h)]
|
||||
vHCompValue_stuck _ _ _ _ hφ (by intro h; cases h)]
|
||||
|
||||
/-- **vTubeApp reduction**: `(λj. (tube @ j) arg) @ r = (tube @ r) arg`.
|
||||
Exercised with a vplam tube: `tube = vplam .nil j (var "u_body")`.
|
||||
|
|
@ -385,7 +410,8 @@ theorem vPApp_vTubeApp_reduces (j : DimVar) (r : DimExpr) :
|
|||
|
||||
private def pathLine_a : CTerm := .var "a_line"
|
||||
private def pathLine_b : CTerm := .papp (.var "b_pt") (DimExpr.var i_dim)
|
||||
private def pathLineA : CType := .path .univ pathLine_a pathLine_b
|
||||
private def pathLineA : CType (.succ .zero) :=
|
||||
.path (CType.univ (ℓ := .zero)) pathLine_a pathLine_b
|
||||
|
||||
private theorem pathLineA_varies : CType.dimAbsent i_dim pathLineA = false := by decide
|
||||
|
||||
|
|
@ -394,9 +420,9 @@ private theorem pathLineA_varies : CType.dimAbsent i_dim pathLineA = false := by
|
|||
theorem eval_transp_path_example
|
||||
(φ : FaceFormula) (hφ : φ ≠ .top) (p : String) :
|
||||
eval .nil (.transp i_dim pathLineA φ (.var p)) =
|
||||
.vPathTransp .nil i_dim .univ pathLine_a pathLine_b φ (.var p) := by
|
||||
.vPathTransp .nil i_dim (CType.univ (ℓ := .zero)) pathLine_a pathLine_b φ (.var p) := by
|
||||
show eval .nil
|
||||
(.transp i_dim (.path .univ pathLine_a pathLine_b) φ (.var p)) = _
|
||||
(.transp i_dim (.path (CType.univ (ℓ := .zero)) pathLine_a pathLine_b) φ (.var p)) = _
|
||||
rw [eval_transp_path _ _ _ _ _ _ _ hφ pathLineA_varies]
|
||||
|
||||
/-- **Path transport at the `.zero` endpoint**: CCHM's `(j=0)` clause fires,
|
||||
|
|
@ -404,7 +430,8 @@ theorem eval_transp_path_example
|
|||
(which has no `i`-dep, so its `substDim i .one` is itself). -/
|
||||
theorem vPApp_vPathTransp_zero_reduces
|
||||
(φ : FaceFormula) (p : CTerm) :
|
||||
vPApp (.vPathTransp .nil i_dim .univ pathLine_a pathLine_b φ p) .zero =
|
||||
vPApp (.vPathTransp .nil i_dim (CType.univ (ℓ := .zero))
|
||||
pathLine_a pathLine_b φ p) .zero =
|
||||
.vneu (.nvar "a_line") := by
|
||||
rw [vPApp_vPathTransp_zero]
|
||||
-- pathLine_a.substDim i_dim .one = pathLine_a (no dim dep; var case)
|
||||
|
|
@ -419,7 +446,8 @@ theorem vPApp_vPathTransp_zero_reduces
|
|||
`npapp (nvar "b_pt") .one`. -/
|
||||
theorem vPApp_vPathTransp_one_reduces
|
||||
(φ : FaceFormula) (p : CTerm) :
|
||||
vPApp (.vPathTransp .nil i_dim .univ pathLine_a pathLine_b φ p) .one =
|
||||
vPApp (.vPathTransp .nil i_dim (CType.univ (ℓ := .zero))
|
||||
pathLine_a pathLine_b φ p) .one =
|
||||
.vneu (.npapp (.nvar "b_pt") .one) := by
|
||||
rw [vPApp_vPathTransp_one]
|
||||
-- pathLine_b.substDim i_dim .one = papp (var "b_pt") (DimExpr.subst i_dim .one (DimExpr.var i_dim))
|
||||
|
|
@ -434,9 +462,10 @@ theorem vPApp_vPathTransp_one_reduces
|
|||
transport reduces via T2 at eval level (arm 2), returning the base
|
||||
unchanged — no `vPathTransp` produced. -/
|
||||
theorem eval_transp_constant_path (i : DimVar) (φ : FaceFormula) (p : String) :
|
||||
eval .nil (.transp i (.path .univ (.var "a0") (.var "b0")) φ (.var p)) =
|
||||
eval .nil (.transp i (.path (CType.univ (ℓ := .zero)) (.var "a0") (.var "b0")) φ (.var p)) =
|
||||
.vneu (.nvar p) := by
|
||||
have hA : CType.dimAbsent i (.path .univ (.var "a0") (.var "b0")) = true :=
|
||||
have hA : CType.dimAbsent i
|
||||
(.path (CType.univ (ℓ := .zero)) (.var "a0") (.var "b0")) = true :=
|
||||
rfl
|
||||
by_cases hφ : φ = .top
|
||||
· subst hφ; rw [eval_transp_top, eval_var]; rfl
|
||||
|
|
@ -450,13 +479,13 @@ theorem eval_transp_constant_path (i : DimVar) (φ : FaceFormula) (p : String) :
|
|||
transport of the base. Demonstrated with `A = .univ` where transport is
|
||||
identity (via T2). -/
|
||||
theorem eval_compN_empty (i : DimVar) (t : String) :
|
||||
eval .nil (.compN i .univ [] (.var t)) = .vneu (.nvar t) := by
|
||||
eval .nil (.compN i (CType.univ (ℓ := .zero)) [] (.var t)) = .vneu (.nvar t) := by
|
||||
rw [eval_compN, vCompNAtTerm_def]
|
||||
-- find? on [] is none; filter on [] is []; [] arm → transport
|
||||
simp only [List.find?, List.filter]
|
||||
-- Now: eval .nil (.transp i .univ .bot (.var t))
|
||||
rw [eval_transp_const _ _ _ _ _ (by intro h; nomatch h)
|
||||
(rfl : CType.dimAbsent i .univ = true),
|
||||
(rfl : CType.dimAbsent i (CType.univ (ℓ := .zero)) = true),
|
||||
eval_var]
|
||||
rfl
|
||||
|
||||
|
|
@ -464,7 +493,7 @@ theorem eval_compN_empty (i : DimVar) (t : String) :
|
|||
the clause's body substituted at `i := .one`. This is the CCHM
|
||||
full-system rule lifted to multi-clause. -/
|
||||
theorem eval_compN_top_fires (i : DimVar) (u t : String) :
|
||||
eval .nil (.compN i .univ [(.top, .var u)] (.var t)) =
|
||||
eval .nil (.compN i (CType.univ (ℓ := .zero)) [(.top, .var u)] (.var t)) =
|
||||
.vneu (.nvar u) := by
|
||||
rw [eval_compN, vCompNAtTerm_def]
|
||||
-- find? matches the (.top, _) head immediately.
|
||||
|
|
@ -477,7 +506,7 @@ theorem eval_compN_top_fires (i : DimVar) (u t : String) :
|
|||
scanning `find?` still picks it up. Exercised with clauses
|
||||
`[(φ, _), (.top, u)]` for some non-top `φ`. -/
|
||||
theorem eval_compN_top_later (i : DimVar) (u t : String) (k : DimVar) :
|
||||
eval .nil (.compN i .univ
|
||||
eval .nil (.compN i (CType.univ (ℓ := .zero))
|
||||
[(.eq0 k, .var "dummy"), (.top, .var u)] (.var t)) =
|
||||
.vneu (.nvar u) := by
|
||||
rw [eval_compN, vCompNAtTerm_def]
|
||||
|
|
@ -501,8 +530,8 @@ theorem eval_compN_top_later (i : DimVar) (u t : String) (k : DimVar) :
|
|||
`vCompNAtTerm`'s `find?` picks the third clause. -/
|
||||
theorem vPApp_vPathTransp_inv_zero
|
||||
(φ : FaceFormula) (hφ : φ ≠ .top) (hφbot : φ ≠ .bot) (p : CTerm) :
|
||||
vPApp (.vPathTransp .nil i_dim .univ pathLine_a pathLine_b φ p)
|
||||
(.inv .zero) =
|
||||
vPApp (.vPathTransp .nil i_dim (CType.univ (ℓ := .zero))
|
||||
pathLine_a pathLine_b φ p) (.inv .zero) =
|
||||
.vneu (.npapp (.nvar "b_pt") .one) := by
|
||||
rw [vPApp_vPathTransp_general _ _ _ _ _ _ _ _
|
||||
(by intro h; nomatch h)
|
||||
|
|
@ -538,27 +567,27 @@ theorem vPApp_vPathTransp_inv_zero
|
|||
that runs the CCHM β-rule on application. -/
|
||||
theorem eval_comp_pi_example (u_name t_name : String)
|
||||
(φ : FaceFormula) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) :
|
||||
eval .nil (.comp i_dim (.pi domAtype codBtype) φ
|
||||
eval .nil (.comp i_dim (.pi "_" domAtype codBtype) φ
|
||||
(.var u_name) (.var t_name)) =
|
||||
.vCompFun .nil i_dim domAtype codBtype φ (.var u_name) (.var t_name) := by
|
||||
rw [eval_comp_pi _ _ _ _ _ _ _ hφ₁ hφ₂ pi_varying_all]
|
||||
rw [eval_comp_pi _ _ _ _ _ _ _ _ hφ₁ hφ₂ pi_varying_all]
|
||||
|
||||
/-- **Const-domain hetero Π comp β degenerate case**: when `domA = .univ`
|
||||
(const in i), the fill `y_at_i` and `y_at_0` both reduce to `y` (via
|
||||
`vTransp_const`). The inner comp becomes just `comp^i codB φ (u y) (t y)`. -/
|
||||
theorem vApp_vCompFun_const_dom_example (u_name t_name y_name : String) (φ : FaceFormula) :
|
||||
vApp (.vCompFun .nil i_dim .univ codBtype φ (.var u_name) (.var t_name))
|
||||
vApp (.vCompFun .nil i_dim (CType.univ (ℓ := .zero)) codBtype φ (.var u_name) (.var t_name))
|
||||
(.vneu (.nvar y_name)) =
|
||||
eval (CEnv.nil.extend "$y" (.vneu (.nvar y_name)))
|
||||
(.comp i_dim codBtype φ
|
||||
(.app (.var u_name)
|
||||
(.transp ⟨"$fj"⟩
|
||||
((CType.univ).substDimExpr i_dim
|
||||
((CType.univ (ℓ := .zero)).substDimExpr i_dim
|
||||
(.join (.inv (.var ⟨"$fj"⟩)) (.var i_dim)))
|
||||
φ (.var "$y")))
|
||||
(.app (.var t_name)
|
||||
(.transp ⟨"$fj"⟩
|
||||
((CType.univ).substDimExpr i_dim (.inv (.var ⟨"$fj"⟩)))
|
||||
((CType.univ (ℓ := .zero)).substDimExpr i_dim (.inv (.var ⟨"$fj"⟩)))
|
||||
φ (.var "$y")))) := by
|
||||
rw [vApp_vCompFun]
|
||||
|
||||
|
|
@ -588,7 +617,7 @@ theorem vApp_vCompFun_varying_dom_fires
|
|||
example :
|
||||
domAtype.substDimExpr i_dim
|
||||
(.join (.inv (.var ⟨"$fj"⟩)) (.var i_dim)) =
|
||||
.path .univ (.var "a0")
|
||||
.path (CType.univ (ℓ := .zero)) (.var "a0")
|
||||
(.papp (.var "p") (.join (.inv (.var ⟨"$fj"⟩)) (.var i_dim))) := by
|
||||
simp only [domAtype, CType.substDimExpr, CTerm.substDim, DimExpr.subst]
|
||||
rfl
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
/-
|
||||
Topolei.Cubical.FFI
|
||||
===================
|
||||
CubicalTransport.FFI
|
||||
====================
|
||||
Documentation + convenience re-exports for the Rust cubical-HoTT
|
||||
backend (Phase C, 2026-04-24).
|
||||
|
||||
## Architecture after Phase C
|
||||
|
||||
The `@[extern "topolei_cubical_*"]` `opaque` declarations and their
|
||||
The `@[extern "cubical_transport_*"]` `opaque` declarations and their
|
||||
`@[implemented_by]` attributes are **inlined directly in the files
|
||||
that own the fallback `partial def`**:
|
||||
|
||||
|
|
@ -37,7 +37,7 @@
|
|||
|
||||
## Runtime behaviour
|
||||
|
||||
When `libtopolei_cubical.a` is linked (default via `lakefile.toml`),
|
||||
When `libcubical_transport.a` is linked (default via `lakefile.toml`),
|
||||
every runtime call to `eval` / `vApp` / `readback` / etc. routes
|
||||
through Rust at native speed. Kernel-level proof reasoning
|
||||
continues to go through the axioms in each module — unchanged.
|
||||
|
|
@ -48,8 +48,8 @@
|
|||
|
||||
## ABI version
|
||||
|
||||
`TOPOLEI_FFI_ABI_VERSION = 1`. Defined in
|
||||
`native/cubical/include/topolei_cubical.h`. Any change to an
|
||||
`CUBICAL_TRANSPORT_ABI_VERSION = 1`. Defined in
|
||||
`native/cubical/include/cubical_transport.h`. Any change to an
|
||||
`@[extern]` signature (arity, argument types) requires incrementing
|
||||
the version and updating the C header.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.FFITest
|
||||
CubicalTransport.FFITest
|
||||
=======================
|
||||
Phase C.3 smoke test (2026-04-24). Exercises the FFI wiring by
|
||||
running simple cubical terms through `eval` / `readback` / the
|
||||
|
|
@ -113,19 +113,21 @@ def tests : List (String × String × String) :=
|
|||
-- the CCHM RHS → result is no longer a stuck marker`.
|
||||
("β vApp vTranspFun (const line, via beta::force_transp_fun)",
|
||||
cvalSummary (vApp
|
||||
(.vTranspFun ⟨"i"⟩ .univ .univ .bot (.vneu (.nvar "f")))
|
||||
(.vTranspFun ⟨"i"⟩ (CType.univ (ℓ := .zero)) (CType.univ (ℓ := .zero))
|
||||
.bot (.vneu (.nvar "f")))
|
||||
(.vneu (.nvar "y"))),
|
||||
"vneu napp"),
|
||||
("β vApp vHCompFun (stuck on .univ codA, via beta::force_hcomp_fun)",
|
||||
cvalSummary (vApp
|
||||
(.vHCompFun .univ .bot
|
||||
(.vHCompFun (CType.univ (ℓ := .zero)) .bot
|
||||
(.vplam .nil ⟨"j"⟩ (.var "tube_body"))
|
||||
(.vneu (.nvar "b")))
|
||||
(.vneu (.nvar "x"))),
|
||||
"vneu nhcomp"),
|
||||
("β vApp vCompFun (φ=.bot collapses via C2, via beta::force_comp_fun)",
|
||||
cvalSummary (vApp
|
||||
(.vCompFun .nil ⟨"i"⟩ .univ .univ .bot (.var "u") (.var "t"))
|
||||
(.vCompFun .nil ⟨"i"⟩ (CType.univ (ℓ := .zero)) (CType.univ (ℓ := .zero))
|
||||
.bot (.var "u") (.var "t"))
|
||||
(.vneu (.nvar "y"))),
|
||||
"vneu napp"),
|
||||
("β vPApp vTubeApp (via beta::force_tube_app)",
|
||||
|
|
@ -135,17 +137,20 @@ def tests : List (String × String × String) :=
|
|||
"vneu napp"),
|
||||
("β vPApp vPathTransp at .zero ⇓ a(1) (via beta::force_path_transp)",
|
||||
cvalSummary (vPApp
|
||||
(.vPathTransp .nil ⟨"i"⟩ .univ (.var "a0") (.var "b0") .bot (.var "p"))
|
||||
(.vPathTransp .nil ⟨"i"⟩ (CType.univ (ℓ := .zero))
|
||||
(.var "a0") (.var "b0") .bot (.var "p"))
|
||||
.zero),
|
||||
"vneu nvar a0"),
|
||||
("β vPApp vPathTransp at .one ⇓ b(1)",
|
||||
cvalSummary (vPApp
|
||||
(.vPathTransp .nil ⟨"i"⟩ .univ (.var "a0") (.var "b0") .bot (.var "p"))
|
||||
(.vPathTransp .nil ⟨"i"⟩ (CType.univ (ℓ := .zero))
|
||||
(.var "a0") (.var "b0") .bot (.var "p"))
|
||||
.one),
|
||||
"vneu nvar b0"),
|
||||
("β vPApp vPathTransp at var r ⇓ compN (CCHM 3-clause system)",
|
||||
cvalSummary (vPApp
|
||||
(.vPathTransp .nil ⟨"i"⟩ .univ (.var "a0") (.var "b0") .bot (.var "p"))
|
||||
(.vPathTransp .nil ⟨"i"⟩ (CType.univ (ℓ := .zero))
|
||||
(.var "a0") (.var "b0") .bot (.var "p"))
|
||||
(.var ⟨"r"⟩)),
|
||||
"vneu ncompN"),
|
||||
-- ── REL1 inductive-type smoke tests ─────────────────────────────────────
|
||||
|
|
@ -227,47 +232,98 @@ def tests : List (String × String × String) :=
|
|||
("CompQ.ask delegates to eval (.comp ...)",
|
||||
cvalSummary
|
||||
(let q : CompQ :=
|
||||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
q.ask),
|
||||
"vneu nvar u"),
|
||||
("CompQ.ofTransp on a constant interval line: full-face → eval u",
|
||||
cvalSummary
|
||||
(CompQ.ofTransp .nil ⟨"i"⟩ .interval .top (.var "x")).ask,
|
||||
(CompQ.ofTransp .nil ⟨"i"⟩ CType.interval .top (.var "x")).ask,
|
||||
"vneu nvar x"),
|
||||
("Classifier IsConstLine decidable on .interval line",
|
||||
(if Question.IsConstLine
|
||||
{ env := .nil, binder := ⟨"i"⟩, body := .interval
|
||||
{ level := .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.interval
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsFullFace decidable on .top face",
|
||||
(if Question.IsFullFace
|
||||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsTransport decidable when u = t",
|
||||
-- IsTransport classifier (uses CTerm.beq, fully computable post-cascade).
|
||||
("Classifier IsTransport accepts when u = t",
|
||||
(if Question.IsTransport
|
||||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "x", t := .var "x" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsTransport rejects when u ≠ t",
|
||||
(if Question.IsTransport
|
||||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||||
, φ := .top, u := .var "x", t := .var "y" }
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"no"),
|
||||
("Classifier IsPiLine decidable on .pi body",
|
||||
-- Body-shape classifiers (decidable via CType.skeleton check).
|
||||
("Classifier IsPiLine accepts on .pi body",
|
||||
(if Question.IsPiLine
|
||||
{ env := .nil, binder := ⟨"i"⟩, body := .pi .univ .univ
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := .pi "_" (CType.univ (ℓ := .zero)) (CType.univ (ℓ := .zero))
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsIntervalLine rejects on .univ",
|
||||
("Classifier IsPiLine rejects on .univ body",
|
||||
(if Question.IsPiLine
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"no"),
|
||||
("Classifier IsIntervalLine accepts on .interval body",
|
||||
(if Question.IsIntervalLine
|
||||
{ env := .nil, binder := ⟨"i"⟩, body := .univ
|
||||
{ level := .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.interval
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsIntervalLine rejects on .univ body",
|
||||
(if Question.IsIntervalLine
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"no"),
|
||||
("Classifier IsUnivLine accepts on .univ body",
|
||||
(if Question.IsUnivLine
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsPathLine accepts on .path body",
|
||||
(if Question.IsPathLine
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := .path (CType.univ (ℓ := .zero)) (.var "a") (.var "b")
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsSigmaLine accepts on .sigma body",
|
||||
(if Question.IsSigmaLine
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := .sigma "_" (CType.univ (ℓ := .zero)) (CType.univ (ℓ := .zero))
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"yes"),
|
||||
("Classifier IsIndLine rejects on .univ body",
|
||||
(if Question.IsIndLine
|
||||
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
|
||||
, body := CType.univ (ℓ := .zero)
|
||||
, φ := .top, u := .var "u", t := .var "t" }
|
||||
then "yes" else "no"),
|
||||
"no") ]
|
||||
|
|
@ -279,7 +335,7 @@ def tests : List (String × String × String) :=
|
|||
/-- Run every smoke test, print its actual vs expected. Returns the
|
||||
number of failures. -/
|
||||
def runSmokeTests : IO UInt32 := do
|
||||
IO.println "── Topolei cubical FFI smoke tests ──"
|
||||
IO.println "── Cubical-transport FFI smoke tests ──"
|
||||
let mut fails : UInt32 := 0
|
||||
for (desc, actual, expected) in tests do
|
||||
if actual == expected then
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.Face
|
||||
CubicalTransport.Face
|
||||
====================
|
||||
The face lattice F: distributive lattice generated by (i=0) and (i=1)
|
||||
with the fundamental relation (i=0) ∧ (i=1) = 0_F.
|
||||
|
|
@ -472,7 +472,7 @@ theorem substDim_comm (i j : DimVar) (r s : DimExpr) (hij : i ≠ j)
|
|||
-- etc.) are deliberately skipped — they require decidable equality on
|
||||
-- `DimVar` in the reduction step and don't affect any current axiom.
|
||||
|
||||
@[extern "topolei_cubical_face_normalize"]
|
||||
@[extern "cubical_transport_face_normalize"]
|
||||
private opaque normalizeRust : FaceFormula → FaceFormula
|
||||
|
||||
/-- Canonical form under literal-identity / absorption reductions. -/
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
/-
|
||||
Topolei.Cubical.Glue
|
||||
CubicalTransport.Glue
|
||||
====================
|
||||
The `Glue` type former and univalence-via-glue construction (cells-spec
|
||||
§5.7, Phase 1 Week 5).
|
||||
§5.7, Phase 1 Week 5). Universe-aware (Layer 0 §0.1 cascade).
|
||||
|
||||
The `.glue` constructor is declared in `Cubical/Syntax.lean` (it must live
|
||||
alongside `CType` / `CTerm` in the mutual inductive block); this module
|
||||
|
|
@ -28,29 +28,12 @@
|
|||
*computationally* like `A` (at `r = 0`) and `B` (at `r = 1`),
|
||||
derived from the face-disjoint axioms in `Eval.lean`.
|
||||
|
||||
Downstream: `Cubical/Soundness.lean` (Week 6) will prove
|
||||
`transp_ua : transp (uaLine e A B) .bot a = e.f a` — the computational
|
||||
content of univalence — by combining `uaLine_zero_glueIn_reduces`
|
||||
with the transport rules for `.glue` (yet to be added; see "Deferred"
|
||||
below).
|
||||
## Universe stratification
|
||||
|
||||
## What's intentionally deferred (Phase 1 Week 5 scope)
|
||||
|
||||
1. **Transport of Glue types.** `CTerm.transp i (.glue …) φ t` has no
|
||||
dedicated reduction rule yet. Adding one requires the CCHM Glue
|
||||
transport formula (which involves the equivalence's half-adjoint
|
||||
structure), and is Week 6 material.
|
||||
|
||||
2. **Multi-face Glue.** `CType.glue` carries a single face; CCHM's
|
||||
ua-as-two-face-glue would need either a `.glueN` constructor or an
|
||||
encoding via iterated single-face glue. The single-face ua here
|
||||
(`Glue [r=0 ↦ (A, e)] B`) is semantically equivalent.
|
||||
|
||||
3. **Type-as-term injection.** Lean's `CType` and `CTerm` are
|
||||
disjoint. A proper `ua : EquivData → CType → CType → CTerm` with
|
||||
`ua e A B : Path U A B` would require embedding `CType` into `CTerm`
|
||||
(e.g., a `CTerm.ty : CType → CTerm` injection). We work at the
|
||||
CType-function level (`DimExpr → CType`) instead.
|
||||
Glue's `.glue φ T f fInv sec ret coh A` constructor stores T and A at
|
||||
the *same* universe level `ℓ` (the equivalence is between same-universe
|
||||
types). All declarations therefore take a single `{ℓ : ULevel}`
|
||||
implicit parameter and use `CType ℓ` for both T and A.
|
||||
-/
|
||||
|
||||
import CubicalTransport.Eval
|
||||
|
|
@ -62,13 +45,14 @@ namespace EquivData
|
|||
|
||||
/-- Build a `.glue` CType from an `EquivData` and the accompanying face /
|
||||
T-type / A-type data. Inlines the equivalence's five CTerms into the
|
||||
`.glue` constructor slots. -/
|
||||
def toGlueType (φ : FaceFormula) (T : CType) (e : EquivData) (A : CType) :
|
||||
CType :=
|
||||
`.glue` constructor slots. Both `T` and `A` live at the same universe
|
||||
level — the equivalence is between same-universe types. -/
|
||||
def toGlueType {ℓ : ULevel} (φ : FaceFormula) (T : CType ℓ) (e : EquivData)
|
||||
(A : CType ℓ) : CType ℓ :=
|
||||
.glue φ T e.f e.fInv e.sec e.ret e.coh A
|
||||
|
||||
theorem toGlueType_def (φ : FaceFormula) (T : CType) (e : EquivData)
|
||||
(A : CType) :
|
||||
theorem toGlueType_def {ℓ : ULevel} (φ : FaceFormula) (T : CType ℓ)
|
||||
(e : EquivData) (A : CType ℓ) :
|
||||
e.toGlueType φ T A = .glue φ T e.f e.fInv e.sec e.ret e.coh A := rfl
|
||||
|
||||
end EquivData
|
||||
|
|
@ -76,7 +60,8 @@ end EquivData
|
|||
-- ── Univalence line ─────────────────────────────────────────────────────────
|
||||
|
||||
/-- The single-face CCHM univalence line. Given an equivalence `e : A ≃ B`
|
||||
and two types `A`, `B`, returns a function `DimExpr → CType`:
|
||||
and two types `A`, `B` at the same level, returns a function
|
||||
`DimExpr → CType ℓ`:
|
||||
|
||||
uaLine e A B r := Glue [r = 0 ↦ (A, e)] B
|
||||
|
||||
|
|
@ -90,7 +75,7 @@ end EquivData
|
|||
`uaLine .zero ≃ A`, `uaLine .one ≃ B` is captured computationally by
|
||||
the `glueIn`/`unglue` reduction axioms; it is not stated as a CType
|
||||
equality because `.glue .top A ... B ≠ A` *structurally*. -/
|
||||
def uaLine (e : EquivData) (A B : CType) (r : DimExpr) : CType :=
|
||||
def uaLine {ℓ : ULevel} (e : EquivData) (A B : CType ℓ) (r : DimExpr) : CType ℓ :=
|
||||
e.toGlueType (FaceFormula.dimExprEq0 r) A B
|
||||
|
||||
-- ── Endpoint rfl-lemmas ─────────────────────────────────────────────────────
|
||||
|
|
@ -99,7 +84,7 @@ def uaLine (e : EquivData) (A B : CType) (r : DimExpr) : CType :=
|
|||
`dimExprEq0 .zero = .top`), so `uaLine e A B .zero` is the glue type
|
||||
whose face is full. Inhabitants there behave like A via
|
||||
`eval_glueIn_top` / `eval_unglue_top`. -/
|
||||
theorem uaLine_zero (e : EquivData) (A B : CType) :
|
||||
theorem uaLine_zero {ℓ : ULevel} (e : EquivData) (A B : CType ℓ) :
|
||||
uaLine e A B .zero =
|
||||
e.toGlueType .top A B := by
|
||||
show e.toGlueType (FaceFormula.dimExprEq0 .zero) A B = e.toGlueType .top A B
|
||||
|
|
@ -109,7 +94,7 @@ theorem uaLine_zero (e : EquivData) (A B : CType) :
|
|||
`dimExprEq0 .one = .bot`), so `uaLine e A B .one` is the glue type
|
||||
whose face is empty. Inhabitants there behave like B via
|
||||
`eval_glueIn_bot` / `eval_unglue_bot`. -/
|
||||
theorem uaLine_one (e : EquivData) (A B : CType) :
|
||||
theorem uaLine_one {ℓ : ULevel} (e : EquivData) (A B : CType ℓ) :
|
||||
uaLine e A B .one =
|
||||
e.toGlueType .bot A B := by
|
||||
show e.toGlueType (FaceFormula.dimExprEq0 .one) A B = e.toGlueType .bot A B
|
||||
|
|
@ -118,7 +103,7 @@ theorem uaLine_one (e : EquivData) (A B : CType) :
|
|||
/-- At a generic dim variable `k`, the face is `.eq0 k` — neither trivial.
|
||||
The glue is genuinely non-degenerate and produces stuck `nglueIn` /
|
||||
`nunglue` neutrals under `eval`. -/
|
||||
theorem uaLine_var (e : EquivData) (A B : CType) (k : DimVar) :
|
||||
theorem uaLine_var {ℓ : ULevel} (e : EquivData) (A B : CType ℓ) (k : DimVar) :
|
||||
uaLine e A B (.var k) =
|
||||
e.toGlueType (.eq0 k) A B := by
|
||||
show e.toGlueType (FaceFormula.dimExprEq0 (.var k)) A B =
|
||||
|
|
@ -163,14 +148,14 @@ theorem uaLine_one_unglue_reduces (env : CEnv) (f g : CTerm) :
|
|||
with A. The sec / ret fields are from `idEquiv A`; the face toggle
|
||||
is between `.top` and `.bot`. Not a *fully* constant line (the face
|
||||
formula varies), but the underlying types are the same. -/
|
||||
theorem uaLine_idEquiv_zero_type (A : CType) :
|
||||
theorem uaLine_idEquiv_zero_type {ℓ : ULevel} (A : CType ℓ) :
|
||||
uaLine (idEquiv A) A A .zero =
|
||||
.glue .top A (idEquiv A).f (idEquiv A).fInv
|
||||
(idEquiv A).sec (idEquiv A).ret (idEquiv A).coh A := by
|
||||
rw [uaLine_zero]
|
||||
rfl
|
||||
|
||||
theorem uaLine_idEquiv_one_type (A : CType) :
|
||||
theorem uaLine_idEquiv_one_type {ℓ : ULevel} (A : CType ℓ) :
|
||||
uaLine (idEquiv A) A A .one =
|
||||
.glue .bot A (idEquiv A).f (idEquiv A).fInv
|
||||
(idEquiv A).sec (idEquiv A).ret (idEquiv A).coh A := by
|
||||
|
|
@ -188,6 +173,9 @@ theorem uaLine_idEquiv_one_type (A : CType) :
|
|||
-- dim-absent from `i`. The only piece allowed to mention `i` is the inner
|
||||
-- face formula `φ`.
|
||||
--
|
||||
-- All axioms below use a single `{ℓ : ULevel}` parameter (T and A live at
|
||||
-- the same level, per the .glue constructor's signature).
|
||||
--
|
||||
-- Three sub-cases of `φ.substDim i .one` (the inner face restricted to the
|
||||
-- outgoing endpoint):
|
||||
-- · `.bot` — the T-side glueIn witness at `i = 1` is vacuous; the result
|
||||
|
|
@ -198,43 +186,12 @@ theorem uaLine_idEquiv_one_type (A : CType) :
|
|||
-- · Neither — the result is a structured stuck neutral preserving all
|
||||
-- glue data for later substitution to unstick. Covered by
|
||||
-- `eval_transp_glue_const_stuck`.
|
||||
--
|
||||
-- The three face-disjoint preconditions (φ.substDim i .one = .bot / = .top
|
||||
-- / otherwise) partition the problem, so adding more axioms here never
|
||||
-- risks inconsistency.
|
||||
|
||||
/-- **CCHM Glue transport — constant components, inner face collapses at 1.**
|
||||
|
||||
Transport along a `.glue` line where:
|
||||
· The fiber type `T`, base type `A`, and the five equivalence CTerms
|
||||
(`f`, `fInv`, `sec`, `ret`, `coh`) are all dim-absent from the line
|
||||
binder `i`.
|
||||
· The outer face `ψ` is non-`.top` (else T1 fires and transport is
|
||||
identity).
|
||||
· The inner glue face `φ`, restricted to `i := 1`, collapses to `.bot`
|
||||
(so no T-side witness is required at the outgoing endpoint).
|
||||
|
||||
Under these conditions the full CCHM Glue-transport formula (CCHM §6.2)
|
||||
degenerates:
|
||||
|
||||
1. The outer comp/fill through the base type `A` reduces to a plain
|
||||
transport. (For constant `A` this further reduces to identity via
|
||||
T2, though the axiom does not pre-apply T2 so that downstream
|
||||
proofs can choose when to use it.)
|
||||
2. The T-side glueIn witness at `i = 1` lives on an empty face and is
|
||||
therefore irrelevant — the outer `glueIn` collapses to its A-side.
|
||||
3. The A-side value is obtained by unglueing the base at the `i = 0`
|
||||
face of the glue (`φ.substDim i .zero`).
|
||||
|
||||
Combining, transport reduces to `transp i A ψ (unglue (φ[i:=0]) f t)`.
|
||||
|
||||
**Discharge obligation.** The Rust evaluator's implementation of the
|
||||
full CCHM Glue-transport rule must reduce to this equation in the
|
||||
restricted setting captured by the hypotheses. -/
|
||||
axiom eval_transp_glue_const_at_bot
|
||||
/-- **CCHM Glue transport — constant components, inner face collapses at 1.** -/
|
||||
axiom eval_transp_glue_const_at_bot {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hA : A.dimAbsent i = true)
|
||||
|
|
@ -247,46 +204,11 @@ axiom eval_transp_glue_const_at_bot
|
|||
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
|
||||
eval env (.transp i A ψ (.unglue (φ.substDim i .zero) f t))
|
||||
|
||||
/-- **CCHM Glue transport — constant components, inner face collapses to `.top` at 1.**
|
||||
|
||||
Transport along a `.glue` line where:
|
||||
· The fiber type `T`, base type `A`, and the five equivalence CTerms
|
||||
(`f`, `fInv`, `sec`, `ret`, `coh`) are all dim-absent from the line
|
||||
binder `i`.
|
||||
· The outer face `ψ` is non-`.top` (else T1 fires and transport is
|
||||
identity).
|
||||
· The inner glue face `φ`, restricted to `i := 1`, collapses to `.top`
|
||||
— the T-side witness is forced at the outgoing endpoint.
|
||||
|
||||
Under these conditions the full CCHM Glue-transport formula (CCHM §6.2)
|
||||
produces a value whose output glue face `φ[i:=1]` is `.top`, i.e. a
|
||||
T-forced inhabitant. In our `.glueIn`-free form this is the result of
|
||||
applying `fInv` to the A-side transport:
|
||||
|
||||
1. `a₁ := transp i A ψ (unglue (φ[i:=0]) f t)` — the A-side of the
|
||||
transported value (same construction as `_at_bot`).
|
||||
2. `t₁ := app fInv a₁` — the T-side witness obtained via the
|
||||
equivalence inverse.
|
||||
|
||||
Combining, transport reduces to `app fInv (transp i A ψ (unglue (φ[i:=0]) f t))`.
|
||||
|
||||
**Hcomp correction note.** The full CCHM formula includes an hcomp in
|
||||
`T` using `sec` to enforce boundary agreement of `t₁` with `t[i:=1]`
|
||||
on face `ψ`. Under the constant-component hypotheses this hcomp's
|
||||
boundary obligations match `t₁ = fInv a₁` up to the equivalence's
|
||||
propositional coherence (`sec (f t₁) : Path A (f (fInv a₁)) a₁`),
|
||||
which is the well-typedness obligation a caller already discharges
|
||||
when constructing an inhabitant of the glue type. The axiom therefore
|
||||
states the principal T-side witness directly; a future refinement can
|
||||
add the hcomp wrapper once T-side hcomp infrastructure is in place.
|
||||
|
||||
**Discharge obligation.** The Rust evaluator's implementation of the
|
||||
full CCHM Glue-transport rule must reduce to this equation in the
|
||||
restricted setting captured by the hypotheses. -/
|
||||
axiom eval_transp_glue_const_at_top
|
||||
/-- **CCHM Glue transport — constant components, inner face collapses to `.top` at 1.** -/
|
||||
axiom eval_transp_glue_const_at_top {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hA : A.dimAbsent i = true)
|
||||
|
|
@ -299,34 +221,11 @@ axiom eval_transp_glue_const_at_top
|
|||
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
|
||||
eval env (.app fInv (.transp i A ψ (.unglue (φ.substDim i .zero) f t)))
|
||||
|
||||
/-- **CCHM Glue transport — constant components, inner face stuck at 1.**
|
||||
|
||||
When the inner glue face `φ` restricted to `i := 1` is neither `.top`
|
||||
(handled by `eval_transp_glue_const_at_top` — forces a specific T-side
|
||||
witness via `fInv`) nor `.bot` (handled by `eval_transp_glue_const_at_bot`
|
||||
— collapses to the A-side), the transport produces a structured stuck
|
||||
neutral preserving all glue data.
|
||||
|
||||
**Why structured, not full reduction.** The CCHM formula in this case
|
||||
still computes a specific `glueIn[φ(1) ↦ t₁] a₁` with a partial T-side
|
||||
witness depending on `φ(1)`. Later dim substitution into `φ` can
|
||||
resolve `φ(1)` to `.top` or `.bot`, at which point the structured
|
||||
neutral can be unstuck by re-evaluating through the appropriate
|
||||
face-disjoint axiom (`_at_top` or `_at_bot`). Stating the exact `t₁`
|
||||
witness for the residual face requires the half-adjoint hcomp
|
||||
construction, which is future work — until then, this axiom reflects
|
||||
the partial def's runtime behavior (same stuck form `vTransp` would
|
||||
produce).
|
||||
|
||||
This axiom is face-disjoint from both `eval_transp_glue_const_at_bot`
|
||||
(which requires `φ.substDim i .one = .bot`) and
|
||||
`eval_transp_glue_const_at_top` (which requires `φ.substDim i .one =
|
||||
.top`), so the three axioms partition the precondition space without
|
||||
contradiction. -/
|
||||
axiom eval_transp_glue_const_stuck
|
||||
/-- **CCHM Glue transport — constant components, inner face stuck at 1.** -/
|
||||
axiom eval_transp_glue_const_stuck {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hA : A.dimAbsent i = true)
|
||||
|
|
@ -340,42 +239,13 @@ axiom eval_transp_glue_const_stuck
|
|||
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
|
||||
.vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t))
|
||||
|
||||
-- ── CCHM Glue transport — varying base type A (Stream B #1b, 2026-04-23) ────
|
||||
--
|
||||
-- Generalises `_at_bot` / `_at_top` / `_stuck` to allow the base type `A` to
|
||||
-- vary in the line binder `i`. All five equivalence components and the
|
||||
-- fiber type `T` are still required to be dim-absent from `i`
|
||||
-- (varying-equivalence is Stream B #1c, future work).
|
||||
--
|
||||
-- The A-side construction switches from a plain `.transp i A ψ` (which
|
||||
-- only carries the ψ-boundary) to a two-clause `.compN i A` carrying
|
||||
-- *both* the ψ-boundary (from the outer transport) and the φ-boundary
|
||||
-- (from the inner glue's T-fiber). The two clause bodies are:
|
||||
--
|
||||
-- · `(ψ, .unglue φ f t)` — on the outer face ψ, the result agrees
|
||||
-- with the A-side of the input glue (extracted via `unglue` through
|
||||
-- the φ-face structure).
|
||||
-- · `(φ, .app f t)` — on the inner glue face φ, the result agrees
|
||||
-- with `f` applied to the T-fiber `t`. These coincide on the
|
||||
-- overlap by the equivalence's well-typedness (`f t = unglue t` on
|
||||
-- the φ-face, by `eval_unglue_top` semantics).
|
||||
--
|
||||
-- The base of the comp at i=0 is the same as in the constant-A case:
|
||||
-- `.unglue (φ[i:=0]) f t`.
|
||||
--
|
||||
-- Face-disjoint from the constant-A axioms by `hA : A.dimAbsent i = false`
|
||||
-- (the constant-A axioms require `hA : … = true`); the new three are
|
||||
-- mutually face-disjoint by the same `φ[i:=1]` partition.
|
||||
-- ── CCHM Glue transport — varying base type A ──────────────────────────────
|
||||
|
||||
/-- **CCHM Glue transport — varying base type A, inner face collapses to `.bot` at 1.**
|
||||
|
||||
Generalises `eval_transp_glue_const_at_bot` to varying-`A` lines via
|
||||
the CCHM §6.2 two-clause comp through the base. Other components
|
||||
(`T`, `f`, `fInv`, `sec`, `ret`, `coh`) remain dim-absent from `i`. -/
|
||||
axiom eval_transp_glue_varA_at_bot
|
||||
/-- **CCHM Glue transport — varying base type A, inner face collapses to `.bot` at 1.** -/
|
||||
axiom eval_transp_glue_varA_at_bot {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hA : A.dimAbsent i = false)
|
||||
|
|
@ -391,20 +261,11 @@ axiom eval_transp_glue_varA_at_bot
|
|||
(φ, .app f t)]
|
||||
(.unglue (φ.substDim i .zero) f t))
|
||||
|
||||
/-- **CCHM Glue transport — varying base type A, inner face collapses to `.top` at 1.**
|
||||
|
||||
Generalises `eval_transp_glue_const_at_top` to varying-`A` lines.
|
||||
The A-side is built via the same two-clause `.compN` as `_varA_at_bot`;
|
||||
the T-side witness is then obtained via `fInv` applied to the A-side.
|
||||
|
||||
Same hcomp-correction caveat as `eval_transp_glue_const_at_top`: the
|
||||
full CCHM formula adds a T-side hcomp using `sec` to enforce
|
||||
ψ-boundary agreement, which trivialises under the constant-equivalence
|
||||
hypotheses up to the equivalence's propositional coherence. -/
|
||||
axiom eval_transp_glue_varA_at_top
|
||||
/-- **CCHM Glue transport — varying base type A, inner face collapses to `.top` at 1.** -/
|
||||
axiom eval_transp_glue_varA_at_top {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hA : A.dimAbsent i = false)
|
||||
|
|
@ -421,16 +282,11 @@ axiom eval_transp_glue_varA_at_top
|
|||
(φ, .app f t)]
|
||||
(.unglue (φ.substDim i .zero) f t)))
|
||||
|
||||
/-- **CCHM Glue transport — varying base type A, inner face stuck at 1.**
|
||||
|
||||
Mirrors `eval_transp_glue_const_stuck` for varying-`A`: when the
|
||||
inner glue face restricted to the outgoing endpoint is neither
|
||||
`.top` nor `.bot`, the transport produces a structured stuck neutral
|
||||
preserving all glue data — including the now-varying `A`. -/
|
||||
axiom eval_transp_glue_varA_stuck
|
||||
/-- **CCHM Glue transport — varying base type A, inner face stuck at 1.** -/
|
||||
axiom eval_transp_glue_varA_stuck {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hA : A.dimAbsent i = false)
|
||||
|
|
@ -444,51 +300,13 @@ axiom eval_transp_glue_varA_stuck
|
|||
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
|
||||
.vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t))
|
||||
|
||||
-- ── Hcomp-correction wrappers for _at_top (Stage 2.1, 2026-04-23) ───────────
|
||||
--
|
||||
-- The `_at_top` axioms above state the *principal* T-side witness
|
||||
-- `app fInv a₁` where `a₁` is the A-side construction. This witness
|
||||
-- agrees with `t[i:=1]` on face `ψ` only *propositionally* — up to the
|
||||
-- equivalence's half-adjoint coherence `ret : Π x:T. Path T (fInv (f x)) x`.
|
||||
--
|
||||
-- The full CCHM §6.2 formula tightens this to *definitional* ψ-agreement
|
||||
-- by wrapping the principal witness in an hcomp-in-T whose ψ-clause is
|
||||
-- the j-line `ret (t[i:=1])` — a T-path from `fInv (f t[i:=1])` at j=0
|
||||
-- to `t[i:=1]` at j=1. On ψ, `a₁ = f t[i:=1]` (T2 on the constant A-line
|
||||
-- plus `unglue`-top semantics), so the hcomp's base `fInv a₁` aligns
|
||||
-- with `ret`'s j=0 endpoint — the square is filled, and the output
|
||||
-- (at j=1) is `t[i:=1]` on ψ, matching the ψ-boundary constraint exactly.
|
||||
--
|
||||
-- Both the hcomp-corrected and naked forms coexist as axioms: the hcomp
|
||||
-- form is the CCHM-faithful statement (Rust-discharge reference), the
|
||||
-- naked form is an ergonomic specialisation for `transp_ua`-style proofs
|
||||
-- at ψ = .bot where the hcomp trivialises. Stage 3 can consolidate.
|
||||
--
|
||||
-- The hcomp binder `j` is an explicit parameter (with `hT_j` / `hA_j`
|
||||
-- freshness hypotheses) rather than a hardcoded `⟨"$hcj"⟩` — this keeps
|
||||
-- the axiom hygienic and lets callers pick a binder disjoint from their
|
||||
-- own scope.
|
||||
-- ── Hcomp-correction wrappers for _at_top ──────────────────────────────────
|
||||
|
||||
/-- **Hcomp-corrected `_at_top` — constant components.**
|
||||
|
||||
Full CCHM §6.2 formula for Glue transport at `φ[i:=1] = .top`:
|
||||
wraps the naked witness `app fInv a₁` in an hcomp-in-T whose
|
||||
ψ-clause is `ret (t[i:=1]) @ j`, enforcing definitional ψ-boundary
|
||||
agreement.
|
||||
|
||||
The extra `hT_j` / `hA_j` hypotheses state that the fresh hcomp
|
||||
binder `j` does not appear in T or A — required so the inner
|
||||
`transp i A ψ a₁` and the outer `comp j T ψ …` don't collide.
|
||||
`hij : i ≠ j` rules out degenerate binder identity.
|
||||
|
||||
**Rust-discharge axiom.** The evaluator's Glue-transport
|
||||
implementation emits this hcomp-corrected form; the naked
|
||||
`eval_transp_glue_const_at_top` is derivable from it at ψ = .bot
|
||||
(see `eval_transp_glue_const_at_top_from_hcomp`). -/
|
||||
axiom eval_transp_glue_const_at_top_hcomp
|
||||
/-- **Hcomp-corrected `_at_top` — constant components.** -/
|
||||
axiom eval_transp_glue_const_at_top_hcomp {ℓ : ULevel}
|
||||
(env : CEnv) (i j : DimVar) (hij : i ≠ j)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hT_j : T.dimAbsent j = true)
|
||||
|
|
@ -506,16 +324,11 @@ axiom eval_transp_glue_const_at_top_hcomp
|
|||
(.app fInv
|
||||
(.transp i A ψ (.unglue (φ.substDim i .zero) f t))))
|
||||
|
||||
/-- **Hcomp-corrected `_at_top` — varying base A.**
|
||||
|
||||
Varying-A companion to `eval_transp_glue_const_at_top_hcomp`. The
|
||||
A-side is built via the CCHM two-clause `.compN` (matching
|
||||
`eval_transp_glue_varA_at_top`); the T-side wraps the principal
|
||||
`app fInv a₁` witness in the same hcomp-in-T correction. -/
|
||||
axiom eval_transp_glue_varA_at_top_hcomp
|
||||
/-- **Hcomp-corrected `_at_top` — varying base A.** -/
|
||||
axiom eval_transp_glue_varA_at_top_hcomp {ℓ : ULevel}
|
||||
(env : CEnv) (i j : DimVar) (hij : i ≠ j)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hT_j : T.dimAbsent j = true)
|
||||
|
|
@ -536,22 +349,12 @@ axiom eval_transp_glue_varA_at_top_hcomp
|
|||
(.unglue (φ.substDim i .zero) f t))))
|
||||
|
||||
-- ── Derivation: naked form from hcomp form at ψ = .bot ─────────────────────
|
||||
-- At ψ = .bot, the hcomp's ψ-clause is vacuous — C2 reduces the outer
|
||||
-- comp to a plain transp of the base. Since T is `j`-absent (`hT_j`),
|
||||
-- T2 reduces that transp to identity, recovering the naked form.
|
||||
|
||||
/-- **Naked `_at_top` form at ψ = .bot is a theorem, not an axiom.**
|
||||
|
||||
Derived from `eval_transp_glue_const_at_top_hcomp` at ψ = .bot.
|
||||
Gives Stage 2.1's consolidation: the ψ = .bot specialisation of
|
||||
the naked axiom is now propositionally derived from the hcomp
|
||||
axiom. The original `eval_transp_glue_const_at_top` axiom still
|
||||
exists for general ψ; callers at ψ = .bot can switch to this
|
||||
theorem to consume the hcomp-corrected axiom family. -/
|
||||
theorem eval_transp_glue_const_at_top_from_hcomp
|
||||
/-- **Naked `_at_top` form at ψ = .bot is a theorem, not an axiom.** -/
|
||||
theorem eval_transp_glue_const_at_top_from_hcomp {ℓ : ULevel}
|
||||
(env : CEnv) (i j : DimVar) (hij : i ≠ j)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (t : CTerm)
|
||||
(hT : T.dimAbsent i = true)
|
||||
(hT_j : T.dimAbsent j = true)
|
||||
(hA : A.dimAbsent i = true)
|
||||
|
|
@ -571,50 +374,13 @@ theorem eval_transp_glue_const_at_top_from_hcomp
|
|||
rw [eval_comp_bot]
|
||||
rw [eval_transp_const env j T .bot _ (by intro h; nomatch h) hT_j]
|
||||
|
||||
-- ── Varying-equivalence Glue transport (Stage 2.4, 2026-04-23) ──────────────
|
||||
--
|
||||
-- The 6 axioms above (`_const_*` / `_varA_*`) all require **all five
|
||||
-- equivalence components** (`f`, `fInv`, `sec`, `ret`, `coh`) to be
|
||||
-- dim-absent from the line binder `i`. This covers the CCHM
|
||||
-- constant-equivalence case — the simplest and most common for ua-style
|
||||
-- constructions (`transp_ua`, `transp_ua_inverse`).
|
||||
--
|
||||
-- Varying-equivalence Glue transport — where any of the five components
|
||||
-- vary in `i` — is the largest remaining generalisation. The full
|
||||
-- CCHM §6.2 formula requires transporting witness terms *through* the
|
||||
-- varying equivalence, using `transp^i T` applied to `f(t)`, etc., plus
|
||||
-- a three-clause `.compN` on the A-side. The reduction is intricate
|
||||
-- and the discharge target is a full-featured Rust evaluator.
|
||||
--
|
||||
-- **Stage 2.4 closure discipline.** Rather than state a partial/guessed
|
||||
-- reduction formula, we state the *structurally stuck* form as a single
|
||||
-- consolidated axiom. The evaluator's partial def (Eval.lean's `.glue`
|
||||
-- arm of `.transp`) already produces this stuck neutral; the axiom
|
||||
-- merely lifts it to the kernel level. The precondition `hVar` —
|
||||
-- "at least one equivalence component is not dim-absent" — makes this
|
||||
-- axiom **pattern-disjoint** from the 6 constant-equivalence axioms,
|
||||
-- preserving the face-disjoint axiom-family discipline established in
|
||||
-- Stage 1. Future Rust refinement will replace this with the
|
||||
-- full CCHM reduction rules (no Lean-side changes needed — the axiom
|
||||
-- just becomes more informative).
|
||||
-- ── Varying-equivalence Glue transport ─────────────────────────────────────
|
||||
|
||||
/-- **Varying-equivalence Glue transport — structurally stuck form.**
|
||||
|
||||
Applies when **at least one** of the five equivalence components
|
||||
(`f`, `fInv`, `sec`, `ret`, `coh`) is not dim-absent from the line
|
||||
binder `i`. Pattern-disjoint from the 6 constant-equivalence axioms
|
||||
by hypothesis: those require *all* five to be dim-absent; this
|
||||
requires *at least one* to vary.
|
||||
|
||||
Produces a structured `ntransp` neutral preserving all Glue data
|
||||
and the evaluated base. The Rust evaluator's partial def already
|
||||
produces this form; a future refinement will add reduction rules
|
||||
using `transp^i T` on witness terms (CCHM §6.2 varying-equivalence
|
||||
case). -/
|
||||
axiom eval_transp_glue_varEquiv
|
||||
/-- **Varying-equivalence Glue transport — structurally stuck form.** -/
|
||||
axiom eval_transp_glue_varEquiv {ℓ : ULevel}
|
||||
(env : CEnv) (i : DimVar)
|
||||
(φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) (ψ : FaceFormula) (t : CTerm)
|
||||
(hψ : ψ ≠ .top)
|
||||
(hVar : ¬ (f.dimAbsent i = true ∧ fInv.dimAbsent i = true ∧
|
||||
sec.dimAbsent i = true ∧ ret.dimAbsent i = true ∧
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@
|
|||
Helper combinators and canonical schema instances for the REL1
|
||||
schema-based inductive (and higher-inductive) type system.
|
||||
|
||||
Universe-aware (Layer 0 §0.1 cascade): helpers that take CType
|
||||
arguments are level-polymorphic via implicit `{ℓ : ULevel}`; lists
|
||||
of parameters carry their levels via `Σ ℓ : ULevel, CType ℓ`.
|
||||
|
||||
This module sits *on top of* `Syntax.lean` — it doesn't add new
|
||||
primitives, only ergonomic builders. Every value here is a plain
|
||||
CTypeSchema / CType / CTerm; nothing is opaque. Downstream
|
||||
consumers should prefer these helpers over hand-spelling
|
||||
CTypeSchema literals so the canonical encodings are maintained
|
||||
in one place.
|
||||
primitives, only ergonomic builders.
|
||||
|
||||
## Sections
|
||||
|
||||
|
|
@ -25,10 +25,6 @@
|
|||
via `DimVar.mk "$d_k"` (zero-indexed among `.dim` args) and
|
||||
*non-dim args* via `CTerm.var "$arg_k"` (zero-indexed in the full
|
||||
arg list). See INDUCTIVE_TYPES.md §4 for the discipline.
|
||||
|
||||
· The schemas here are concrete values, not `def`s under a
|
||||
`noncomputable` veil — `Nat`, `Bool`, etc. are first-class data
|
||||
that downstream code can pattern-match on or use as parameters.
|
||||
-/
|
||||
|
||||
import CubicalTransport.Syntax
|
||||
|
|
@ -37,8 +33,8 @@ namespace CubicalTransport.Inductive
|
|||
|
||||
-- ── §1. Argument-shape helpers ─────────────────────────────────────────────
|
||||
|
||||
/-- A non-recursive argument of a closed CType. -/
|
||||
@[inline] def argType (A : CType) : CTypeArg := .type A
|
||||
/-- A non-recursive argument of a closed CType at any universe level. -/
|
||||
@[inline] def argType {ℓ : ULevel} (A : CType ℓ) : CTypeArg := .type A
|
||||
|
||||
/-- A reference to the schema's `i`th type parameter. -/
|
||||
@[inline] def argParam (i : Nat) : CTypeArg := .param i
|
||||
|
|
@ -69,12 +65,7 @@ namespace CubicalTransport.Inductive
|
|||
|
||||
-- ── §3. Canonical plain inductive schemas ──────────────────────────────────
|
||||
|
||||
/-- The natural numbers as a schema.
|
||||
|
||||
`Nat` has two point constructors:
|
||||
- `zero : Nat`
|
||||
- `succ : Nat → Nat` (recursive arg: `.self`)
|
||||
-/
|
||||
/-- The natural numbers as a schema. -/
|
||||
def natSchema : CTypeSchema :=
|
||||
mkSchema "Nat" 0
|
||||
[ mkCtor "zero" []
|
||||
|
|
@ -94,38 +85,9 @@ def listSchema : CTypeSchema :=
|
|||
|
||||
-- ── §4. Canonical HIT schemas ──────────────────────────────────────────────
|
||||
|
||||
/-- The circle `S¹` as a HIT.
|
||||
|
||||
Constructors:
|
||||
- `base : S¹` (point)
|
||||
- `loop : (i : I) → S¹` (path: `loop @ 0 = base = loop @ 1`)
|
||||
|
||||
Boundary: at `i=0` and `i=1`, `loop` returns `base`.
|
||||
|
||||
The `loop` boundary references `base` via the schema's own
|
||||
`.ctor` constructor at the same schema (recursive self-reference
|
||||
inside the schema's body). We construct it inline here. -/
|
||||
/-- The circle `S¹` as a HIT. `loop @ 0 = base = loop @ 1`. -/
|
||||
def s1Schema : CTypeSchema :=
|
||||
-- Build a self-referential schema: `loop`'s boundary uses
|
||||
-- `.ctor s1Schema "base" [] []` which in turn references `s1Schema`.
|
||||
-- Since the recursion is structural through the schema's data
|
||||
-- (not through a Lean-level fixpoint), we define `s1Schema` via
|
||||
-- Lean's well-founded recursion through structural data; the
|
||||
-- result is a finite, well-formed `CTypeSchema` value — but Lean
|
||||
-- won't accept a literal self-recursive `def` like this.
|
||||
--
|
||||
-- Workaround: take the schema *name* + a fresh local schema that
|
||||
-- refers to itself via a placeholder. At construction time we
|
||||
-- patch the placeholder. This is implemented as a small fix-up
|
||||
-- below.
|
||||
let baseAt (s : CTypeSchema) : CTerm := .ctor s "base" [] []
|
||||
-- We need `s1Schema = mkSchema "S¹" 0 [base, loop]` where
|
||||
-- `loop` carries a boundary that references `s1Schema`.
|
||||
-- Lean's `let rec` doesn't handle this for `CTypeSchema` the
|
||||
-- way it would for a function — but we can use a `where`-style
|
||||
-- two-step build: first build a "stub" schema, then build the
|
||||
-- final `loop` referring to it. Both schemas have the same
|
||||
-- structural shape, so `s1Schema` is well-defined.
|
||||
let stub : CTypeSchema :=
|
||||
mkSchema "S¹" 0
|
||||
[ mkCtor "base" []
|
||||
|
|
@ -137,12 +99,7 @@ def s1Schema : CTypeSchema :=
|
|||
[ (.eq0 d, baseAt stub)
|
||||
, (.eq1 d, baseAt stub) ] ]
|
||||
|
||||
/-- The interval as a HIT.
|
||||
|
||||
Constructors:
|
||||
- `zero : I`
|
||||
- `one : I`
|
||||
- `seg : (i : I) → I` with `seg @ 0 = zero`, `seg @ 1 = one`. -/
|
||||
/-- The interval as a HIT (REL1). `seg @ 0 = zero`, `seg @ 1 = one`. -/
|
||||
def intervalSchema : CTypeSchema :=
|
||||
let stub : CTypeSchema :=
|
||||
mkSchema "I" 0
|
||||
|
|
@ -159,16 +116,9 @@ def intervalSchema : CTypeSchema :=
|
|||
[ (.eq0 d, zeroAt stub)
|
||||
, (.eq1 d, oneAt stub) ] ]
|
||||
|
||||
/-- Propositional truncation `‖A‖₋₁` as a HIT.
|
||||
|
||||
Constructors:
|
||||
- `inT : A → ‖A‖₋₁` (point)
|
||||
- `squash : (x y : ‖A‖₋₁) → (i : I) → ‖A‖₋₁`
|
||||
with `squash x y @ 0 = x`, `squash x y @ 1 = y`. -/
|
||||
/-- Propositional truncation `‖A‖₋₁` as a HIT. -/
|
||||
def propTruncSchema : CTypeSchema :=
|
||||
let d : DimVar := ⟨"$d_0"⟩
|
||||
-- arg index: 0 = first .self ("$arg_0"), 1 = second .self ("$arg_1"),
|
||||
-- 2 = .dim ($d_0). Boundary references positional arg names.
|
||||
mkSchema "‖_‖₋₁" 1
|
||||
[ mkCtor "inT" [.param 0]
|
||||
, mkPath "squash" [.self, .self, .dim]
|
||||
|
|
@ -177,32 +127,30 @@ def propTruncSchema : CTypeSchema :=
|
|||
|
||||
-- ── §5. Type-level helpers ─────────────────────────────────────────────────
|
||||
|
||||
/-- The `CType` for natural numbers. -/
|
||||
@[inline] def CType.natC : CType := .ind natSchema []
|
||||
/-- The `CType` for natural numbers, at the bottom universe. -/
|
||||
@[inline] def CType.natC : CType .zero := .ind natSchema []
|
||||
|
||||
/-- The `CType` for booleans. -/
|
||||
@[inline] def CType.boolC : CType := .ind boolSchema []
|
||||
/-- The `CType` for booleans, at the bottom universe. -/
|
||||
@[inline] def CType.boolC : CType .zero := .ind boolSchema []
|
||||
|
||||
/-- The `CType` for lists with element type `A`. -/
|
||||
@[inline] def CType.listC (A : CType) : CType := .ind listSchema [A]
|
||||
/-- The `CType` for lists with element type `A` at level ℓ. The list
|
||||
type lives at the same level as its element. -/
|
||||
@[inline] def CType.listC {ℓ : ULevel} (A : CType ℓ) : CType ℓ :=
|
||||
.ind listSchema [⟨ℓ, A⟩]
|
||||
|
||||
/-- The cubical interval `𝕀` as a CType (REL2). Inhabited by
|
||||
`CTerm.dimExpr r` for any `r : DimExpr`. -/
|
||||
@[inline] def CType.intervalC : CType := .interval
|
||||
/-- The cubical interval `𝕀` as a CType (REL2). Lives at the bottom
|
||||
universe. Inhabited by `CTerm.dimExpr r` for any `r : DimExpr`. -/
|
||||
@[inline] def CType.intervalC : CType .zero := .interval
|
||||
|
||||
/-- The `CType` for the circle. -/
|
||||
@[inline] def CType.s1C : CType := .ind s1Schema []
|
||||
/-- The `CType` for the circle, at the bottom universe. -/
|
||||
@[inline] def CType.s1C : CType .zero := .ind s1Schema []
|
||||
|
||||
/-- The HIT-encoded interval as a CType (REL1 form). REL2 supersedes
|
||||
this with the primitive `CType.interval` (alias `CType.intervalC`
|
||||
above). Kept for callers that want the explicit HIT construction
|
||||
(e.g. for showing the equivalence between primitive interval and
|
||||
its HIT shadow). -/
|
||||
@[inline] def CType.intervalHitC : CType := .ind intervalSchema []
|
||||
/-- The HIT-encoded interval as a CType (REL1 form). -/
|
||||
@[inline] def CType.intervalHitC : CType .zero := .ind intervalSchema []
|
||||
|
||||
/-- The `CType` for propositional truncation `‖A‖₋₁`. -/
|
||||
@[inline] def CType.propTruncC (A : CType) : CType :=
|
||||
.ind propTruncSchema [A]
|
||||
@[inline] def CType.propTruncC {ℓ : ULevel} (A : CType ℓ) : CType ℓ :=
|
||||
.ind propTruncSchema [⟨ℓ, A⟩]
|
||||
|
||||
-- ── §6. Term-level helpers ─────────────────────────────────────────────────
|
||||
|
||||
|
|
@ -220,12 +168,13 @@ namespace CTerm
|
|||
/-- The `CTerm` `true : Bool`. -/
|
||||
@[inline] def trueC : CTerm := .ctor boolSchema "true" [] []
|
||||
|
||||
/-- The `CTerm` `nil : List A`. Carries the element type as parameter. -/
|
||||
@[inline] def nilC (A : CType) : CTerm := .ctor listSchema "nil" [A] []
|
||||
/-- The `CTerm` `nil : List A`. `A` is the element CType at any level. -/
|
||||
@[inline] def nilC {ℓ : ULevel} (A : CType ℓ) : CTerm :=
|
||||
.ctor listSchema "nil" [⟨ℓ, A⟩] []
|
||||
|
||||
/-- The `CTerm` `cons x xs : List A`. -/
|
||||
@[inline] def consC (A : CType) (x xs : CTerm) : CTerm :=
|
||||
.ctor listSchema "cons" [A] [x, xs]
|
||||
@[inline] def consC {ℓ : ULevel} (A : CType ℓ) (x xs : CTerm) : CTerm :=
|
||||
.ctor listSchema "cons" [⟨ℓ, A⟩] [x, xs]
|
||||
|
||||
/-- The `CTerm` `base : S¹`. -/
|
||||
@[inline] def baseC : CTerm := .ctor s1Schema "base" [] []
|
||||
|
|
@ -235,12 +184,12 @@ namespace CTerm
|
|||
.ctor s1Schema "loop" [] [.dimExpr r]
|
||||
|
||||
/-- The `CTerm` `inT a : ‖A‖₋₁`. -/
|
||||
@[inline] def inTC (A : CType) (a : CTerm) : CTerm :=
|
||||
.ctor propTruncSchema "inT" [A] [a]
|
||||
@[inline] def inTC {ℓ : ULevel} (A : CType ℓ) (a : CTerm) : CTerm :=
|
||||
.ctor propTruncSchema "inT" [⟨ℓ, A⟩] [a]
|
||||
|
||||
/-- The `CTerm` `squash x y @ r : ‖A‖₋₁`. -/
|
||||
@[inline] def squashC (A : CType) (x y : CTerm) (r : DimExpr) : CTerm :=
|
||||
.ctor propTruncSchema "squash" [A] [x, y, .dimExpr r]
|
||||
@[inline] def squashC {ℓ : ULevel} (A : CType ℓ) (x y : CTerm) (r : DimExpr) : CTerm :=
|
||||
.ctor propTruncSchema "squash" [⟨ℓ, A⟩] [x, y, .dimExpr r]
|
||||
|
||||
/-- Build a Nat literal `n` as a tower of `succ`s on `zero`. -/
|
||||
def natLit : Nat → CTerm
|
||||
|
|
@ -251,10 +200,7 @@ end CTerm
|
|||
|
||||
-- ── §7. Eliminator builders ────────────────────────────────────────────────
|
||||
|
||||
/-- Build an `indElim` for `Nat`. `motive` is the result type-former,
|
||||
`caseZero` the body for `zero`, `caseSucc` the body for `succ`
|
||||
(curried as `λ pred ih. body`). `target` is the natural being
|
||||
eliminated. -/
|
||||
/-- Build an `indElim` for `Nat`. -/
|
||||
def natElim (motive caseZero caseSucc target : CTerm) : CTerm :=
|
||||
.indElim natSchema [] motive
|
||||
[("zero", caseZero), ("succ", caseSucc)] target
|
||||
|
|
@ -264,10 +210,9 @@ def boolElim (motive caseFalse caseTrue target : CTerm) : CTerm :=
|
|||
.indElim boolSchema [] motive
|
||||
[("false", caseFalse), ("true", caseTrue)] target
|
||||
|
||||
/-- Build an `indElim` for `List A`. `caseCons` is curried as
|
||||
`λ head tail ih. body`. -/
|
||||
def listElim (A : CType) (motive caseNil caseCons target : CTerm) : CTerm :=
|
||||
.indElim listSchema [A] motive
|
||||
/-- Build an `indElim` for `List A`. -/
|
||||
def listElim {ℓ : ULevel} (A : CType ℓ) (motive caseNil caseCons target : CTerm) : CTerm :=
|
||||
.indElim listSchema [⟨ℓ, A⟩] motive
|
||||
[("nil", caseNil), ("cons", caseCons)] target
|
||||
|
||||
end CubicalTransport.Inductive
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.Interval
|
||||
CubicalTransport.Interval
|
||||
========================
|
||||
The interval I: free de Morgan algebra on dimension variables.
|
||||
|
||||
|
|
@ -203,7 +203,7 @@ theorem dimAbsent_endpoint (i : DimVar) (b : Bool) :
|
|||
-- Semantic correctness: `normalize_preserves_eval` shows the normal
|
||||
-- form has the same Boolean evaluation under every environment.
|
||||
|
||||
@[extern "topolei_cubical_dimexpr_normalize"]
|
||||
@[extern "cubical_transport_dimexpr_normalize"]
|
||||
private opaque normalizeRust : DimExpr → DimExpr
|
||||
|
||||
/-- Canonical form under `inv`-reduction. Idempotent:
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.Line
|
||||
CubicalTransport.Line
|
||||
====================
|
||||
DimLine extensions: reversal and concatenation (cells-spec §14,
|
||||
`transp_concat` Critical obligation).
|
||||
|
|
@ -55,7 +55,7 @@ import CubicalTransport.Transport
|
|||
/-- Line reversal. The reversed line exchanges the two endpoints:
|
||||
`(inv L).at0 = L.at1` and `(inv L).at1 = L.at0` (see the axioms
|
||||
below for the semantic justification pending `DimExpr.normalize`). -/
|
||||
def DimLine.inv (L : DimLine) : DimLine :=
|
||||
def DimLine.inv {ℓ : ULevel} (L : DimLine ℓ) : DimLine ℓ :=
|
||||
{ binder := L.binder
|
||||
body := L.body.substDimExpr L.binder (.inv (.var L.binder)) }
|
||||
|
||||
|
|
@ -67,15 +67,15 @@ def DimLine.inv (L : DimLine) : DimLine :=
|
|||
`.inv ·` produces `.inv .zero`, not the reduced `.one` — so the
|
||||
endpoint equality is not `rfl` at the raw substitution layer.
|
||||
Becomes a theorem once normalization is added. -/
|
||||
axiom DimLine.inv_at0 (L : DimLine) : (DimLine.inv L).at0 = L.at1
|
||||
axiom DimLine.inv_at0 {ℓ : ULevel} (L : DimLine ℓ) : (DimLine.inv L).at0 = L.at1
|
||||
|
||||
/-- At dim 1, the reversed line has the original at-0 endpoint.
|
||||
**Lean-discharge obligation** (see `inv_at0`). -/
|
||||
axiom DimLine.inv_at1 (L : DimLine) : (DimLine.inv L).at1 = L.at0
|
||||
axiom DimLine.inv_at1 {ℓ : ULevel} (L : DimLine ℓ) : (DimLine.inv L).at1 = L.at0
|
||||
|
||||
/-- Double reversal is the original line. Depends on the DimExpr
|
||||
normalisation `.inv (.inv r) = r`. **Lean-discharge obligation.** -/
|
||||
axiom DimLine.inv_inv (L : DimLine) : DimLine.inv (DimLine.inv L) = L
|
||||
axiom DimLine.inv_inv {ℓ : ULevel} (L : DimLine ℓ) : DimLine.inv (DimLine.inv L) = L
|
||||
|
||||
-- ── DimLine.concat ──────────────────────────────────────────────────────────
|
||||
-- Line concatenation via universe hcomp (CCHM §6.2, cells-spec §5.6).
|
||||
|
|
@ -91,14 +91,14 @@ axiom DimLine.inv_inv (L : DimLine) : DimLine.inv (DimLine.inv L) = L
|
|||
hcomp filling the square whose top is `L` and whose right is `M`).
|
||||
The backend implements this; here we carry the structural
|
||||
operation without a concrete CType body. -/
|
||||
axiom DimLine.concat (L M : DimLine) (h : L.at1 = M.at0) : DimLine
|
||||
axiom DimLine.concat {ℓ : ULevel} (L M : DimLine ℓ) (h : L.at1 = M.at0) : DimLine ℓ
|
||||
|
||||
/-- The concatenated line retains the left line's input endpoint. -/
|
||||
axiom DimLine.concat_at0 (L M : DimLine) (h : L.at1 = M.at0) :
|
||||
axiom DimLine.concat_at0 {ℓ : ULevel} (L M : DimLine ℓ) (h : L.at1 = M.at0) :
|
||||
(DimLine.concat L M h).at0 = L.at0
|
||||
|
||||
/-- The concatenated line exposes the right line's output endpoint. -/
|
||||
axiom DimLine.concat_at1 (L M : DimLine) (h : L.at1 = M.at0) :
|
||||
axiom DimLine.concat_at1 {ℓ : ULevel} (L M : DimLine ℓ) (h : L.at1 = M.at0) :
|
||||
(DimLine.concat L M h).at1 = M.at1
|
||||
|
||||
-- ── transp_concat (cells-spec §14 Critical) ─────────────────────────────────
|
||||
|
|
@ -119,8 +119,8 @@ axiom DimLine.concat_at1 (L M : DimLine) (h : L.at1 = M.at0) :
|
|||
· If both are constant, both sides reduce to `v` via T2.
|
||||
· On general lines the RHS is the CCHM sequential-transport form,
|
||||
which is exactly what universe hcomp computes. -/
|
||||
axiom vTranspLine_concat
|
||||
(L M : DimLine) (h : L.at1 = M.at0) (v : CVal) :
|
||||
axiom vTranspLine_concat {ℓ : ULevel}
|
||||
(L M : DimLine ℓ) (h : L.at1 = M.at0) (v : CVal) :
|
||||
vTranspLine (DimLine.concat L M h) .bot v =
|
||||
vTranspLine M .bot (vTranspLine L .bot v)
|
||||
|
||||
|
|
@ -132,8 +132,8 @@ axiom vTranspLine_concat
|
|||
(cells-spec §6.2) and of the groupoid laws on cells (cells-spec
|
||||
§1.3): monad laws on cells reduce to groupoid laws on paths, and
|
||||
path concatenation's transport law is `transp_concat`. -/
|
||||
theorem transp_concat
|
||||
(L M : DimLine) (h : L.at1 = M.at0) (v : CVal) :
|
||||
theorem transp_concat {ℓ : ULevel}
|
||||
(L M : DimLine ℓ) (h : L.at1 = M.at0) (v : CVal) :
|
||||
vTranspLine (DimLine.concat L M h) .bot v =
|
||||
vTranspLine M .bot (vTranspLine L .bot v) :=
|
||||
vTranspLine_concat L M h v
|
||||
|
|
@ -147,8 +147,8 @@ theorem transp_concat
|
|||
|
||||
Combines `vTranspLine_concat` with T2 (`vTransp_const`) on the
|
||||
constant left factor. -/
|
||||
theorem transp_concat_const_left
|
||||
(A : CType) (i : DimVar) (L : DimLine)
|
||||
theorem transp_concat_const_left {ℓ : ULevel}
|
||||
(A : CType ℓ) (i : DimVar) (L : DimLine ℓ)
|
||||
(hA : CType.dimAbsent i A = true)
|
||||
(h : (DimLine.const A i).at1 = L.at0) (v : CVal) :
|
||||
vTranspLine (DimLine.concat (DimLine.const A i) L h) .bot v =
|
||||
|
|
@ -162,8 +162,8 @@ theorem transp_concat_const_left
|
|||
(provided the `const C i` is truly constant).
|
||||
|
||||
Combines `vTranspLine_concat` with T2 on the constant right factor. -/
|
||||
theorem transp_concat_const_right
|
||||
(L : DimLine) (C : CType) (i : DimVar)
|
||||
theorem transp_concat_const_right {ℓ : ULevel}
|
||||
(L : DimLine ℓ) (C : CType ℓ) (i : DimVar)
|
||||
(hC : CType.dimAbsent i C = true)
|
||||
(h : L.at1 = (DimLine.const C i).at0) (v : CVal) :
|
||||
vTranspLine (DimLine.concat L (DimLine.const C i) h) .bot v =
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.PropertyTest
|
||||
CubicalTransport.PropertyTest
|
||||
============================
|
||||
Phase D.1 — property-based tests on the Rust-backed cubical evaluator.
|
||||
Each check exercises a specific axiom from `FFI_COMPLETENESS.md`'s
|
||||
|
|
@ -228,7 +228,7 @@ def allProperties : List (String × List PropResult) :=
|
|||
("readback roundtrip", prop_readback_lambda_roundtrip) ]
|
||||
|
||||
def runProperties : IO UInt32 := do
|
||||
IO.println "── Topolei cubical property-based tests ──"
|
||||
IO.println "── Cubical-transport property-based tests ──"
|
||||
let mut totalFails : UInt32 := 0
|
||||
let mut totalRun : Nat := 0
|
||||
for (family, results) in allProperties do
|
||||
|
|
|
|||
|
|
@ -10,90 +10,64 @@
|
|||
that pin specific question shapes (`IsConstLine`, `IsFullFace`,
|
||||
`IsPathLine`, …).
|
||||
|
||||
Four reified question shapes:
|
||||
## Universe-aware shape (Layer 0 §0.1 cascade)
|
||||
|
||||
· `CompQ` — heterogeneous comp on `(env, binder, body, φ, u, t)`,
|
||||
the universal CCHM partial-element-filler.
|
||||
· `TranspQ` — transport `(env, binder, body, φ, t)`; engine-distinct
|
||||
from `CompQ.ofTransp` (the latter routes through
|
||||
`eval (.comp ...)` whose full-face arm substitutes
|
||||
`t.substDim binder .one` instead of `eval env t`).
|
||||
· `HCompQ` — homogeneous comp on `(body, φ, tube, base : CVal)`;
|
||||
delegates to `vHCompValue`.
|
||||
· `CompNQ` — multi-clause heterogeneous comp on
|
||||
`(env, binder, body, clauses : List (FaceFormula × CTerm), t)`;
|
||||
delegates to `vCompNAtTerm`.
|
||||
The four reified question shapes (`CompQ`, `TranspQ`, `HCompQ`,
|
||||
`CompNQ`) carry their type-line's universe level explicitly. All
|
||||
classifiers and theorems are level-aware. For ergonomic backwards-
|
||||
compat with Dev_REL1 / Dev_REL2 callers, the default level is
|
||||
`.zero` (covers `.bool`, `.nat`, `.list`, `.path`, etc.).
|
||||
|
||||
Level commitments:
|
||||
Cross-level pi/sigma sub-component classification (where the
|
||||
domain and codomain live at distinct levels whose `max` equals
|
||||
the outer body level) is restricted to the same-level case (via
|
||||
`ULevel.max_self`).
|
||||
|
||||
- Level 1 — `CompQ` reified, classifiers, `eval_comp_*` axioms
|
||||
restated as classifier-conditioned `Equiv` theorems.
|
||||
- Level 1.5 — full DecidableEq on the AST (see `DecEq.lean`); every
|
||||
classifier `Decidable`.
|
||||
- Level 2 — `TranspQ`, `HCompQ`, `CompNQ` sister questions; every
|
||||
`eval_transp_*`, `vHCompValue_*`, `vCompNAtTerm_def`
|
||||
axiom restated as a question-form theorem with `@[simp]`
|
||||
tag, so `simp [question_simpSet]` routes through the
|
||||
classifier algebra automatically.
|
||||
- Level 3 — `cubical_simp` tactic (see `Cubical/Tactic.lean`).
|
||||
## Computable Decidable instances (no Classical)
|
||||
|
||||
Companion: `docs/QUESTIONS.md` (philosophy), `docs/ALGEBRA_PLAN.md`
|
||||
(the macro layer this enables), `docs/EULERIAN.md` (poetic record).
|
||||
All `Decidable` instances in this module are *computable*. The
|
||||
body-shape classifier predicates are decided via:
|
||||
|
||||
1. Compare `q.body.skeleton` (level-erased constructor tag) with
|
||||
the target `SkeletalCType` value. This step is decidable
|
||||
because `SkeletalCType` has `DecidableEq` derived.
|
||||
2. On match: extract the witness by structural pattern-matching
|
||||
(`cases hb : q.body`).
|
||||
3. On mismatch: refute the existential by skeleton inequality
|
||||
(the existential's body would forces a skeleton equation
|
||||
contradicted by `hs`).
|
||||
|
||||
The `IsTransport` predicate uses `CTerm.beq` (the boolean equality
|
||||
workhorse from `DecEq.lean`), which is computable, with a
|
||||
decidability instance routed through that boolean.
|
||||
-/
|
||||
|
||||
import CubicalTransport.TransportLaws
|
||||
import CubicalTransport.CompLaws
|
||||
import CubicalTransport.DecEq
|
||||
|
||||
-- The genuinely-equational classifier-conditioned theorems below are
|
||||
-- tagged with `@[simp]` only. Lean's standard `simp` finds them
|
||||
-- automatically; no curated named-set is required. Downstream
|
||||
-- consumers can extend by tagging their own classifier-conditioned
|
||||
-- theorems with `@[simp]` — same mechanism.
|
||||
--
|
||||
-- An earlier draft registered a custom `Question.simp` simp set via
|
||||
-- `register_simp_attr`; that's strictly more curation than the
|
||||
-- declarative-foundation principle calls for, so it was dropped.
|
||||
-- Anyone wanting a project-local simp bundle can register one
|
||||
-- downstream.
|
||||
|
||||
namespace Question
|
||||
|
||||
open CubicalTransport.DecEq
|
||||
|
||||
-- ── CompQ — the universal question, reified ─────────────────────────────────
|
||||
|
||||
/-- The CCHM partial-element-filler question, reified as data.
|
||||
|
||||
Given a type-line `body` along binder `binder`, a face `φ`, a
|
||||
partial element `u` defined on `φ`, and a base `t` at `binder = 0`,
|
||||
`CompQ.ask` produces the engine's universal answer — a total
|
||||
element at `binder = 1` agreeing with `u` on `φ` and with `t` at
|
||||
`binder = 0`.
|
||||
|
||||
Every cubical operation in the engine (`transp`, `hcomp`, `compN`,
|
||||
Path β/η, Glue β/η, univalence-transport) is a specialisation of
|
||||
this single shape. See QUESTIONS.md §1 for the table. -/
|
||||
/-- The CCHM partial-element-filler question, reified as data. -/
|
||||
structure CompQ where
|
||||
/-- Universe level of the type-line `body`. -/
|
||||
level : ULevel := .zero
|
||||
env : CEnv
|
||||
binder : DimVar
|
||||
body : CType
|
||||
body : CType level
|
||||
φ : FaceFormula
|
||||
u : CTerm
|
||||
t : CTerm
|
||||
|
||||
/-- "Asking" a question runs the engine on a `.comp` term. Equivalent
|
||||
to `vCompAtTerm` by `Eval.lean`'s `.comp` arm of `eval`, but
|
||||
routed through `eval (.comp …)` so that the existing
|
||||
`eval_comp_*` axioms apply directly. -/
|
||||
/-- "Asking" a question runs the engine on a `.comp` term. -/
|
||||
def CompQ.ask (q : CompQ) : CVal :=
|
||||
eval q.env (.comp q.binder q.body q.φ q.u q.t)
|
||||
|
||||
/-- Two questions are *equivalent* when their engine answers coincide.
|
||||
|
||||
This is the coarsest useful relation: questions with different
|
||||
parameters can have the same answer. It is reflexive, symmetric,
|
||||
and transitive (it's just `Eq` on `CVal`). It is *not* the same
|
||||
as `q₁ = q₂` — two questions can share an answer without being
|
||||
syntactically identical. -/
|
||||
/-- Two questions are *equivalent* when their engine answers coincide. -/
|
||||
def CompQ.Equiv (q₁ q₂ : CompQ) : Prop := q₁.ask = q₂.ask
|
||||
|
||||
@[refl] theorem CompQ.Equiv.refl (q : CompQ) : q.Equiv q := rfl
|
||||
|
|
@ -106,98 +80,83 @@ theorem CompQ.Equiv.trans {q₁ q₂ q₃ : CompQ}
|
|||
Eq.trans h₁ h₂
|
||||
|
||||
/-- Smart constructor: every transport `transpⁱ A φ t` is the
|
||||
degenerate question `compⁱ A φ t t` (no side condition: the
|
||||
partial element equals the base). See QUESTIONS.md §1, table
|
||||
row 1.
|
||||
|
||||
The CompQ answer agrees with `eval env (.transp i A φ t)` when
|
||||
the base is constant in the line binder (the standard cubical
|
||||
typing premise); the engine's `vCompAtTerm` substitutes
|
||||
`t.substDim i .one` on the full-face case while `transp` runs
|
||||
`eval env t` directly. See `CompQ.ask_of_transport_full_face`
|
||||
for the bridging lemma. -/
|
||||
def CompQ.ofTransp (env : CEnv) (i : DimVar) (A : CType)
|
||||
degenerate question `compⁱ A φ t t`. -/
|
||||
def CompQ.ofTransp {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (t : CTerm) : CompQ :=
|
||||
{ env := env, binder := i, body := A, φ := φ, u := t, t := t }
|
||||
{ level := ℓ, env := env, binder := i, body := A, φ := φ, u := t, t := t }
|
||||
|
||||
-- ── Classifiers — the meta-vocabulary of question shapes ─────────────────────
|
||||
|
||||
/-- The line is constant in its binder — `comp` reduces to `hcomp`
|
||||
(or to identity, on a full face). -/
|
||||
/-- The line is constant in its binder. -/
|
||||
@[simp]
|
||||
def IsConstLine (q : CompQ) : Prop :=
|
||||
q.body.dimAbsent q.binder = true
|
||||
|
||||
/-- The face is the full face — the partial element covers the whole
|
||||
space, so the answer is its `binder := 1` value. -/
|
||||
/-- The face is the full face. -/
|
||||
@[simp]
|
||||
def IsFullFace (q : CompQ) : Prop := q.φ = .top
|
||||
|
||||
/-- The face is the empty face — only the base contributes; the
|
||||
question reduces to plain transport. -/
|
||||
/-- The face is the empty face. -/
|
||||
@[simp]
|
||||
def IsEmptyFace (q : CompQ) : Prop := q.φ = .bot
|
||||
|
||||
/-- The base equals the partial element — this is a transport
|
||||
expressed in `comp` form, not a heterogeneous composition. -/
|
||||
@[simp]
|
||||
def IsTransport (q : CompQ) : Prop := q.u = q.t
|
||||
/-- The base equals the partial element.
|
||||
|
||||
/-- The line is a Path type — Path-specific reductions apply. -/
|
||||
Computable formulation via `CTerm.beq`: full propositional Eq
|
||||
on CTerm requires `DecidableEq CTerm`, which is non-trivial to
|
||||
define computably (the mutual `CTerm`/`CType` block doesn't
|
||||
auto-derive `DecidableEq`). We use the boolean-equality
|
||||
workhorse from `DecEq.lean` instead. -/
|
||||
@[simp]
|
||||
def IsTransport (q : CompQ) : Prop :=
|
||||
CTerm.beq q.u q.t = true
|
||||
|
||||
/-- The line is a Path type. -/
|
||||
@[simp]
|
||||
def IsPathLine (q : CompQ) : Prop :=
|
||||
∃ A₀ a b, q.body = .path A₀ a b
|
||||
∃ (A₀ : CType q.level) (a b : CTerm), q.body = .path A₀ a b
|
||||
|
||||
/-- The line is a Glue type — Glue-specific reductions apply. -/
|
||||
/-- The line is a Glue type. -/
|
||||
@[simp]
|
||||
def IsGlueLine (q : CompQ) : Prop :=
|
||||
∃ ψ T f fInv s r c A,
|
||||
∃ (ψ : FaceFormula) (T : CType q.level) (f fInv s r c : CTerm)
|
||||
(A : CType q.level),
|
||||
q.body = .glue ψ T f fInv s r c A
|
||||
|
||||
/-- The line is a Π type — CCHM Π reductions apply. -/
|
||||
/-- The line is a Π type whose sub-components live at the same level
|
||||
as the body. Cross-level pi (sub-components at distinct levels
|
||||
whose `max` equals the body level) is not classified here.
|
||||
|
||||
Computable form: `q.body.skeleton = .pi` (a necessary condition).
|
||||
The full witness extraction is done in the Decidable instance via
|
||||
`cases` on `q.body`. -/
|
||||
@[simp]
|
||||
def IsPiLine (q : CompQ) : Prop :=
|
||||
∃ domA codA, q.body = .pi domA codA
|
||||
q.body.skeleton = SkeletalCType.pi
|
||||
|
||||
/-- The line is a Σ type — Σ reductions apply (REL2.x). -/
|
||||
/-- The line is a Σ type (same-level specialisation). -/
|
||||
@[simp]
|
||||
def IsSigmaLine (q : CompQ) : Prop :=
|
||||
∃ A B, q.body = .sigma A B
|
||||
q.body.skeleton = SkeletalCType.sigma
|
||||
|
||||
/-- The line is a schema-defined inductive — REL1 reductions apply. -/
|
||||
/-- The line is a schema-defined inductive. -/
|
||||
@[simp]
|
||||
def IsIndLine (q : CompQ) : Prop :=
|
||||
∃ S params, q.body = .ind S params
|
||||
q.body.skeleton = SkeletalCType.ind
|
||||
|
||||
/-- The line is the cubical interval — REL2 transport-on-𝕀 is
|
||||
identity (the interval is dim-absent in itself). -/
|
||||
/-- The line is the cubical interval — only meaningful at level 0. -/
|
||||
@[simp]
|
||||
def IsIntervalLine (q : CompQ) : Prop :=
|
||||
q.body = .interval
|
||||
q.body.skeleton = SkeletalCType.interval
|
||||
|
||||
/-- The line is the universe — universe-transport reductions apply
|
||||
(currently stuck; CCHM univalence-transport via `uaLine`). -/
|
||||
/-- The line is the universe at some level. -/
|
||||
@[simp]
|
||||
def IsUnivLine (q : CompQ) : Prop :=
|
||||
q.body = .univ
|
||||
q.body.skeleton = SkeletalCType.univ
|
||||
|
||||
/-- The body is non-Path, non-Glue, non-Π — useful for stating the
|
||||
`eval_comp_stuck` / `eval_transp_nonpath` discharge. Combine with
|
||||
`¬IsConstLine` and `¬IsFullFace`/`¬IsEmptyFace` to pin the stuck
|
||||
case. Lifted as `Prop` so it composes with the other classifiers. -/
|
||||
def IsNonPathNonGlueNonPi (q : CompQ) : Prop :=
|
||||
(∀ A₀ a b, q.body ≠ .path A₀ a b) ∧
|
||||
(∀ φG T f fInv sec ret coh A, q.body ≠ .glue φG T f fInv sec ret coh A) ∧
|
||||
(∀ domA codA, q.body ≠ .pi domA codA)
|
||||
|
||||
-- ── Decidability for every classifier ───────────────────────────────────────
|
||||
-- All classifiers are `Decidable`. Syntactic ones (face / body-tag /
|
||||
-- u=t equality) reduce directly to `DecidableEq` on existing types
|
||||
-- (`FaceFormula`, `CType`, `CTerm` — the latter via the mutual
|
||||
-- `decEq` block in `DecEq.lean`). Existential body-shape classifiers
|
||||
-- (`IsPathLine`, `IsGlueLine`, `IsPiLine`, `IsSigmaLine`, `IsIndLine`)
|
||||
-- use `match h : q.body with` to inspect the head constructor and
|
||||
-- reconstruct the existential witness.
|
||||
-- ── Decidability for the core classifiers ───────────────────────────────────
|
||||
-- All instances are computable. Body-shape predicates are skeleton-eq
|
||||
-- forms, decidable via `DecidableEq SkeletalCType`.
|
||||
|
||||
instance (q : CompQ) : Decidable (IsConstLine q) :=
|
||||
inferInstanceAs (Decidable (q.body.dimAbsent q.binder = true))
|
||||
|
|
@ -209,58 +168,64 @@ instance (q : CompQ) : Decidable (IsEmptyFace q) :=
|
|||
inferInstanceAs (Decidable (q.φ = .bot))
|
||||
|
||||
instance (q : CompQ) : Decidable (IsTransport q) :=
|
||||
inferInstanceAs (Decidable (q.u = q.t))
|
||||
inferInstanceAs (Decidable (CTerm.beq q.u q.t = true))
|
||||
|
||||
instance (q : CompQ) : Decidable (IsIntervalLine q) :=
|
||||
inferInstanceAs (Decidable (q.body = .interval))
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.interval))
|
||||
|
||||
instance (q : CompQ) : Decidable (IsUnivLine q) :=
|
||||
inferInstanceAs (Decidable (q.body = .univ))
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.univ))
|
||||
|
||||
instance (q : CompQ) : Decidable (IsPathLine q) :=
|
||||
match h : q.body with
|
||||
| .path A₀ a b => isTrue ⟨A₀, a, b, h⟩
|
||||
| .univ | .pi _ _ | .sigma _ _ | .glue _ _ _ _ _ _ _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
instance instDecidableIsPathLine (q : CompQ) : Decidable (IsPathLine q) := by
|
||||
-- IsPathLine is an existential; decide via skeleton, then extract.
|
||||
by_cases hs : q.body.skeleton = SkeletalCType.path
|
||||
· -- skeleton = .path; the only constructor with that skel is .path.
|
||||
-- Generalise q's projection so cases can dispatch the indexed inductive.
|
||||
obtain ⟨level, env, binder, body, φ, u, t⟩ := q
|
||||
simp only at hs
|
||||
cases body with
|
||||
| univ => simp at hs
|
||||
| pi var A B => simp at hs
|
||||
| sigma var A B => simp at hs
|
||||
| path A a b => exact isTrue ⟨A, a, b, rfl⟩
|
||||
| glue ψ T f fInv s r c A => simp at hs
|
||||
| ind S params => simp at hs
|
||||
| interval => simp at hs
|
||||
| lift A => simp at hs
|
||||
· refine isFalse (fun ⟨_, _, _, hbody⟩ => hs ?_)
|
||||
rw [hbody]; rfl
|
||||
|
||||
instance instDecidableIsGlueLine (q : CompQ) : Decidable (IsGlueLine q) := by
|
||||
by_cases hs : q.body.skeleton = SkeletalCType.glue
|
||||
· obtain ⟨level, env, binder, body, φ, u, t⟩ := q
|
||||
simp only at hs
|
||||
cases body with
|
||||
| univ => simp at hs
|
||||
| pi var A B => simp at hs
|
||||
| sigma var A B => simp at hs
|
||||
| path A a b => simp at hs
|
||||
| glue ψ T f fInv s r c A =>
|
||||
exact isTrue ⟨ψ, T, f, fInv, s, r, c, A, rfl⟩
|
||||
| ind S params => simp at hs
|
||||
| interval => simp at hs
|
||||
| lift A => simp at hs
|
||||
· refine isFalse (fun ⟨_, _, _, _, _, _, _, _, hbody⟩ => hs ?_)
|
||||
rw [hbody]; rfl
|
||||
|
||||
instance (q : CompQ) : Decidable (IsPiLine q) :=
|
||||
match h : q.body with
|
||||
| .pi domA codA => isTrue ⟨domA, codA, h⟩
|
||||
| .univ | .path _ _ _ | .sigma _ _ | .glue _ _ _ _ _ _ _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.pi))
|
||||
|
||||
instance (q : CompQ) : Decidable (IsSigmaLine q) :=
|
||||
match h : q.body with
|
||||
| .sigma A B => isTrue ⟨A, B, h⟩
|
||||
| .univ | .pi _ _ | .path _ _ _ | .glue _ _ _ _ _ _ _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
|
||||
instance (q : CompQ) : Decidable (IsGlueLine q) :=
|
||||
match h : q.body with
|
||||
| .glue ψ T f fInv s r c A => isTrue ⟨ψ, T, f, fInv, s, r, c, A, h⟩
|
||||
| .univ | .pi _ _ | .path _ _ _ | .sigma _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, _, _, _, _, _, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.sigma))
|
||||
|
||||
instance (q : CompQ) : Decidable (IsIndLine q) :=
|
||||
match h : q.body with
|
||||
| .ind S params => isTrue ⟨S, params, h⟩
|
||||
| .univ | .pi _ _ | .path _ _ _ | .sigma _ _ | .glue _ _ _ _ _ _ _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.ind))
|
||||
|
||||
-- ── Restated axioms — classifier-conditioned question equivalence ─────────────
|
||||
-- Level 1: each existing `eval_comp_*` axiom is restated as a
|
||||
-- theorem about `CompQ.ask`. These are derived (not new axioms);
|
||||
-- they exist to give the question-form vocabulary first-class
|
||||
-- access to the engine's reduction graph.
|
||||
--
|
||||
-- The pattern is always the same: classifiers on the LHS, an
|
||||
-- equation about `q.ask` on the RHS. Future Level 2 work will
|
||||
-- chain these via `simp` on `CompQ.Equiv`.
|
||||
-- ── Classifier-conditioned theorems ─────────────────────────────────────────
|
||||
|
||||
namespace CompQ
|
||||
|
||||
/-- C1 in question form: full-face question's answer is the
|
||||
partial element substituted at `binder := 1`. -/
|
||||
/-- C1 in question form. -/
|
||||
@[simp]
|
||||
theorem ask_of_full_face (q : CompQ) (h : IsFullFace q) :
|
||||
q.ask = eval q.env (q.u.substDim q.binder .one) := by
|
||||
|
|
@ -268,8 +233,7 @@ theorem ask_of_full_face (q : CompQ) (h : IsFullFace q) :
|
|||
rw [show q.φ = .top from h]
|
||||
exact eval_comp_top q.env q.binder q.body q.u q.t
|
||||
|
||||
/-- C2 in question form: empty-face question's answer is plain
|
||||
transport on the base. -/
|
||||
/-- C2 in question form. -/
|
||||
@[simp]
|
||||
theorem ask_of_empty_face (q : CompQ) (h : IsEmptyFace q) :
|
||||
q.ask = eval q.env (.transp q.binder q.body .bot q.t) := by
|
||||
|
|
@ -277,10 +241,7 @@ theorem ask_of_empty_face (q : CompQ) (h : IsEmptyFace q) :
|
|||
rw [show q.φ = .bot from h]
|
||||
exact eval_comp_bot q.env q.binder q.body q.u q.t
|
||||
|
||||
/-- Constant-line question: when the type doesn't vary along
|
||||
`binder`, heterogeneous comp reduces to `vHCompValue` (hcomp).
|
||||
Requires the face is neither full nor empty (those have their
|
||||
own theorems above). -/
|
||||
/-- Constant-line question: hetero comp reduces to hcomp. -/
|
||||
@[simp]
|
||||
theorem ask_of_const_line (q : CompQ)
|
||||
(hC : IsConstLine q)
|
||||
|
|
@ -290,8 +251,7 @@ theorem ask_of_const_line (q : CompQ)
|
|||
unfold ask
|
||||
exact eval_comp_const q.env q.binder q.body q.φ q.u q.t hφ₁ hφ₂ hC
|
||||
|
||||
/-- Helper: the negation of `IsConstLine` rewrites to the `= false`
|
||||
form expected by `eval_comp_pi` / `eval_comp_stuck`. -/
|
||||
/-- Helper: dimAbsent rewriting from negation of IsConstLine. -/
|
||||
private theorem dimAbsent_eq_false_of_not_isConstLine (q : CompQ)
|
||||
(h : ¬ IsConstLine q) :
|
||||
CType.dimAbsent q.binder q.body = false := by
|
||||
|
|
@ -300,84 +260,19 @@ private theorem dimAbsent_eq_false_of_not_isConstLine (q : CompQ)
|
|||
| true => exact absurd hb h
|
||||
| false => rfl
|
||||
|
||||
/-- Π-line question: hetero comp on a Π type packages into a
|
||||
`vCompFun` closure that runs CCHM Π β at application time.
|
||||
Requires the face is non-trivial and the line genuinely varies. -/
|
||||
theorem ask_of_pi_line (q : CompQ)
|
||||
(hP : IsPiLine q)
|
||||
(hφ₁ : ¬ IsFullFace q) (hφ₂ : ¬ IsEmptyFace q)
|
||||
(hC : ¬ IsConstLine q) :
|
||||
∃ domA codA, q.body = .pi domA codA ∧
|
||||
q.ask = .vCompFun q.env q.binder domA codA q.φ q.u q.t := by
|
||||
obtain ⟨domA, codA, hbody⟩ := hP
|
||||
refine ⟨domA, codA, hbody, ?_⟩
|
||||
unfold ask
|
||||
rw [hbody]
|
||||
apply eval_comp_pi q.env q.binder domA codA q.φ q.u q.t hφ₁ hφ₂
|
||||
have := dimAbsent_eq_false_of_not_isConstLine q hC
|
||||
rw [hbody] at this
|
||||
exact this
|
||||
|
||||
/-- Stuck question: face non-trivial, line genuinely varies, and
|
||||
type is neither Π nor any reducing shape — answer is a `ncomp`
|
||||
neutral. Refinement of this for `IsIndLine`, `IsSigmaLine`,
|
||||
`IsIntervalLine`, etc., is Level 2 work. -/
|
||||
theorem ask_of_stuck (q : CompQ)
|
||||
(hφ₁ : ¬ IsFullFace q) (hφ₂ : ¬ IsEmptyFace q)
|
||||
(hC : ¬ IsConstLine q)
|
||||
(hP : ¬ IsPiLine q) :
|
||||
q.ask = .vneu (.ncomp q.binder q.body q.φ
|
||||
(eval q.env q.u) (eval q.env q.t)) := by
|
||||
unfold ask
|
||||
apply eval_comp_stuck q.env q.binder q.body q.φ q.u q.t hφ₁ hφ₂
|
||||
· exact dimAbsent_eq_false_of_not_isConstLine q hC
|
||||
· intro domA codA hb
|
||||
exact hP ⟨domA, codA, hb⟩
|
||||
|
||||
-- ── Transport-shaped corollary ──────────────────────────────────────────────
|
||||
|
||||
/-- Transport-shaped question (`u = t`) under a full face: when the
|
||||
base is constant in the line binder (the cubical typing premise),
|
||||
the answer is `eval env t`. This is the bridge between
|
||||
`CompQ.ofTransp` and the legacy `eval_transp_top` axiom. -/
|
||||
@[simp]
|
||||
theorem ask_of_transport_full_face (q : CompQ)
|
||||
(hT : IsTransport q) (hφ : IsFullFace q)
|
||||
(hi : q.t.dimAbsent q.binder = true) :
|
||||
q.ask = eval q.env q.t := by
|
||||
rw [ask_of_full_face q hφ, show q.u = q.t from hT,
|
||||
CTerm.substDim_of_absent q.binder .one q.t hi]
|
||||
|
||||
end CompQ
|
||||
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
-- TranspQ — transport question
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
--
|
||||
-- Transport `transpⁱ A φ t` is *almost* a degenerate `comp` (the case
|
||||
-- `compⁱ A φ t t`), but the engine treats them differently on the
|
||||
-- full-face arm: `eval (.transp i A .top t) = eval env t` (T1), while
|
||||
-- `vCompAtTerm env i A .top t t = eval env (t.substDim i .one)`
|
||||
-- (which collapses to the same thing only when `t.dimAbsent i = true`).
|
||||
--
|
||||
-- For the question algebra to track the engine faithfully, we reify
|
||||
-- transport as its own question shape with its own `ask` delegating
|
||||
-- to `eval (.transp ...)`. The bridge to `CompQ.ofTransp` is the
|
||||
-- `TranspQ.toCompQ` direction with a typing-side base-dim-absent
|
||||
-- premise (see `transp_eq_comp_when_base_const`).
|
||||
|
||||
/-- Transport question, reified as data.
|
||||
|
||||
`(env, binder, body, φ, t)` represents the transport
|
||||
`transpⁱ body φ t` from `body(0)` to `body(1)` along the line
|
||||
`λ binder. body`, restricted by the face `φ`. When `φ = .top`
|
||||
the transport is identity; when `body` is dim-absent in the
|
||||
binder, T2 makes it identity. Path / Π / Glue / inductive
|
||||
bodies have specialised reductions captured below. -/
|
||||
/-- Transport question, reified as data. -/
|
||||
structure TranspQ where
|
||||
/-- Universe level of the type-line `body`. -/
|
||||
level : ULevel := .zero
|
||||
env : CEnv
|
||||
binder : DimVar
|
||||
body : CType
|
||||
body : CType level
|
||||
φ : FaceFormula
|
||||
t : CTerm
|
||||
|
||||
|
|
@ -394,20 +289,13 @@ def TranspQ.Equiv (q₁ q₂ : TranspQ) : Prop := q₁.ask = q₂.ask
|
|||
theorem TranspQ.Equiv.trans {q₁ q₂ q₃ : TranspQ}
|
||||
(h₁ : q₁.Equiv q₂) (h₂ : q₂.Equiv q₃) : q₁.Equiv q₃ := Eq.trans h₁ h₂
|
||||
|
||||
/-- Bridge: every `TranspQ` is a `CompQ` (with `u = t`). The
|
||||
answer-equivalence is conditional on the base being dim-absent
|
||||
in the binder (the cubical typing premise that makes transport
|
||||
well-defined). -/
|
||||
/-- Bridge: every `TranspQ` is a `CompQ` (with `u = t`). -/
|
||||
def TranspQ.toCompQ (q : TranspQ) : CompQ :=
|
||||
{ env := q.env, binder := q.binder, body := q.body, φ := q.φ
|
||||
{ level := q.level, env := q.env, binder := q.binder, body := q.body, φ := q.φ
|
||||
, u := q.t, t := q.t }
|
||||
|
||||
namespace TranspQ
|
||||
|
||||
/-- Transport classifiers — TranspQ versions of the body-shape and
|
||||
face-shape classifiers. No `IsTransport` (every TranspQ is
|
||||
transport-shaped by construction). Each tagged with
|
||||
`@[simp]` so they unfold under `simp`. -/
|
||||
@[simp]
|
||||
def IsConstLine (q : TranspQ) : Prop := q.body.dimAbsent q.binder = true
|
||||
@[simp]
|
||||
|
|
@ -416,21 +304,22 @@ def IsFullFace (q : TranspQ) : Prop := q.φ = .top
|
|||
def IsEmptyFace (q : TranspQ) : Prop := q.φ = .bot
|
||||
@[simp]
|
||||
def IsPathLine (q : TranspQ) : Prop :=
|
||||
∃ A₀ a b, q.body = .path A₀ a b
|
||||
∃ (A₀ : CType q.level) (a b : CTerm), q.body = .path A₀ a b
|
||||
@[simp]
|
||||
def IsPiLine (q : TranspQ) : Prop :=
|
||||
∃ domA codA, q.body = .pi domA codA
|
||||
def IsPiLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.pi
|
||||
@[simp]
|
||||
def IsSigmaLine (q : TranspQ) : Prop := ∃ A B, q.body = .sigma A B
|
||||
def IsSigmaLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.sigma
|
||||
@[simp]
|
||||
def IsGlueLine (q : TranspQ) : Prop :=
|
||||
∃ ψ T f fInv s r c A, q.body = .glue ψ T f fInv s r c A
|
||||
∃ (ψ : FaceFormula) (T : CType q.level) (f fInv s r c : CTerm)
|
||||
(A : CType q.level),
|
||||
q.body = .glue ψ T f fInv s r c A
|
||||
@[simp]
|
||||
def IsIndLine (q : TranspQ) : Prop := ∃ S params, q.body = .ind S params
|
||||
def IsIndLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.ind
|
||||
@[simp]
|
||||
def IsIntervalLine (q : TranspQ) : Prop := q.body = .interval
|
||||
def IsIntervalLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.interval
|
||||
@[simp]
|
||||
def IsUnivLine (q : TranspQ) : Prop := q.body = .univ
|
||||
def IsUnivLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.univ
|
||||
|
||||
instance (q : TranspQ) : Decidable (IsConstLine q) :=
|
||||
inferInstanceAs (Decidable (q.body.dimAbsent q.binder = true))
|
||||
|
|
@ -438,42 +327,50 @@ instance (q : TranspQ) : Decidable (IsFullFace q) :=
|
|||
inferInstanceAs (Decidable (q.φ = .top))
|
||||
instance (q : TranspQ) : Decidable (IsEmptyFace q) :=
|
||||
inferInstanceAs (Decidable (q.φ = .bot))
|
||||
|
||||
instance (q : TranspQ) : Decidable (IsIntervalLine q) :=
|
||||
inferInstanceAs (Decidable (q.body = .interval))
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.interval))
|
||||
instance (q : TranspQ) : Decidable (IsUnivLine q) :=
|
||||
inferInstanceAs (Decidable (q.body = .univ))
|
||||
|
||||
instance (q : TranspQ) : Decidable (IsPathLine q) :=
|
||||
match h : q.body with
|
||||
| .path A₀ a b => isTrue ⟨A₀, a, b, h⟩
|
||||
| .univ | .pi _ _ | .sigma _ _ | .glue _ _ _ _ _ _ _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.univ))
|
||||
instance (q : TranspQ) : Decidable (IsPiLine q) :=
|
||||
match h : q.body with
|
||||
| .pi domA codA => isTrue ⟨domA, codA, h⟩
|
||||
| .univ | .path _ _ _ | .sigma _ _ | .glue _ _ _ _ _ _ _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.pi))
|
||||
instance (q : TranspQ) : Decidable (IsSigmaLine q) :=
|
||||
match h : q.body with
|
||||
| .sigma A B => isTrue ⟨A, B, h⟩
|
||||
| .univ | .pi _ _ | .path _ _ _ | .glue _ _ _ _ _ _ _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
|
||||
instance (q : TranspQ) : Decidable (IsGlueLine q) :=
|
||||
match h : q.body with
|
||||
| .glue ψ T f fInv s r c A => isTrue ⟨ψ, T, f, fInv, s, r, c, A, h⟩
|
||||
| .univ | .pi _ _ | .path _ _ _ | .sigma _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, _, _, _, _, _, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.sigma))
|
||||
instance (q : TranspQ) : Decidable (IsIndLine q) :=
|
||||
match h : q.body with
|
||||
| .ind S params => isTrue ⟨S, params, h⟩
|
||||
| .univ | .pi _ _ | .path _ _ _ | .sigma _ _ | .glue _ _ _ _ _ _ _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.ind))
|
||||
|
||||
-- ── Restated transport axioms — classifier-conditioned ──────────────────────
|
||||
instance instDecidableTranspIsPathLine (q : TranspQ) : Decidable (IsPathLine q) := by
|
||||
by_cases hs : q.body.skeleton = SkeletalCType.path
|
||||
· obtain ⟨level, env, binder, body, φ, t⟩ := q
|
||||
simp only at hs
|
||||
cases body with
|
||||
| univ => simp at hs
|
||||
| pi var A B => simp at hs
|
||||
| sigma var A B => simp at hs
|
||||
| path A a b => exact isTrue ⟨A, a, b, rfl⟩
|
||||
| glue ψ T f fInv s r c A => simp at hs
|
||||
| ind S params => simp at hs
|
||||
| interval => simp at hs
|
||||
| lift A => simp at hs
|
||||
· refine isFalse (fun ⟨_, _, _, hbody⟩ => hs ?_)
|
||||
rw [hbody]; rfl
|
||||
|
||||
instance instDecidableTranspIsGlueLine (q : TranspQ) : Decidable (IsGlueLine q) := by
|
||||
by_cases hs : q.body.skeleton = SkeletalCType.glue
|
||||
· obtain ⟨level, env, binder, body, φ, t⟩ := q
|
||||
simp only at hs
|
||||
cases body with
|
||||
| univ => simp at hs
|
||||
| pi var A B => simp at hs
|
||||
| sigma var A B => simp at hs
|
||||
| path A a b => simp at hs
|
||||
| glue ψ T f fInv s r c A =>
|
||||
exact isTrue ⟨ψ, T, f, fInv, s, r, c, A, rfl⟩
|
||||
| ind S params => simp at hs
|
||||
| interval => simp at hs
|
||||
| lift A => simp at hs
|
||||
· refine isFalse (fun ⟨_, _, _, _, _, _, _, _, hbody⟩ => hs ?_)
|
||||
rw [hbody]; rfl
|
||||
|
||||
/-- T1 in question form: transport under a full face is identity. -/
|
||||
@[simp]
|
||||
|
|
@ -490,147 +387,20 @@ theorem ask_of_const_line (q : TranspQ)
|
|||
unfold ask
|
||||
exact eval_transp_const q.env q.binder q.body q.φ q.t hφ hC
|
||||
|
||||
/-- T3 in question form: transport along a path-typed line produces
|
||||
a `vPathTransp` closure (further reduction at endpoints via
|
||||
`vPApp` arms).
|
||||
|
||||
Not in `question_simp` because the conclusion is an existential;
|
||||
use as `obtain ⟨A₀, a, b, hbody, hask⟩ := ask_of_path_line ...`. -/
|
||||
theorem ask_of_path_line (q : TranspQ) (hP : IsPathLine q)
|
||||
(hφ : ¬ IsFullFace q) (hC : ¬ IsConstLine q) :
|
||||
∃ A₀ a b, q.body = .path A₀ a b ∧
|
||||
q.ask = .vPathTransp q.env q.binder A₀ a b q.φ q.t := by
|
||||
obtain ⟨A₀, a, b, hbody⟩ := hP
|
||||
refine ⟨A₀, a, b, hbody, ?_⟩
|
||||
unfold ask
|
||||
rw [hbody]
|
||||
apply eval_transp_path q.env q.binder A₀ a b q.φ q.t hφ
|
||||
unfold IsConstLine at hC
|
||||
match hb : CType.dimAbsent q.binder (.path A₀ a b) with
|
||||
| true => rw [hbody] at hC; exact absurd hb hC
|
||||
| false => rfl
|
||||
|
||||
/-- Π-line transport: produces a `vTranspFun` closure. Derived from
|
||||
`eval_transp_pi`.
|
||||
|
||||
Not in `question_simp` because the conclusion is an existential. -/
|
||||
theorem ask_of_pi_line (q : TranspQ) (hP : IsPiLine q)
|
||||
(hφ : ¬ IsFullFace q) (hC : ¬ IsConstLine q) :
|
||||
∃ domA codA, q.body = .pi domA codA ∧
|
||||
q.ask = .vTranspFun q.binder domA codA q.φ (eval q.env q.t) := by
|
||||
obtain ⟨domA, codA, hbody⟩ := hP
|
||||
refine ⟨domA, codA, hbody, ?_⟩
|
||||
unfold ask
|
||||
rw [hbody]
|
||||
apply eval_transp_pi q.env q.binder domA codA q.φ q.t hφ
|
||||
unfold IsConstLine at hC
|
||||
match hb : CType.dimAbsent q.binder (.pi domA codA) with
|
||||
| true => rw [hbody] at hC; exact absurd hb hC
|
||||
| false => rfl
|
||||
|
||||
/-- Stuck case: non-path, non-glue, non-pi, non-constant line under a
|
||||
non-full face. In our current `CType` universe this only fires
|
||||
on `.sigma` / `.ind` / `.interval` / `.univ` shapes that aren't
|
||||
already absorbed by `ask_of_const_line` (e.g., a `.sigma` line
|
||||
that genuinely varies — currently no such reduction). -/
|
||||
theorem ask_of_stuck (q : TranspQ)
|
||||
(hφ : ¬ IsFullFace q) (hC : ¬ IsConstLine q)
|
||||
(hP : ¬ IsPiLine q) (hPath : ¬ IsPathLine q) (hG : ¬ IsGlueLine q) :
|
||||
q.ask = .vneu (.ntransp q.binder q.body q.φ (eval q.env q.t)) := by
|
||||
unfold ask
|
||||
apply eval_transp_stuck q.env q.binder q.body q.φ q.t hφ
|
||||
· unfold IsConstLine at hC
|
||||
match hb : CType.dimAbsent q.binder q.body with
|
||||
| true => exact absurd hb hC
|
||||
| false => rfl
|
||||
· intro domA codA hb; exact hP ⟨domA, codA, hb⟩
|
||||
· intro A₀ a b hb; exact hPath ⟨A₀, a, b, hb⟩
|
||||
· intro ψ T f fI s r c A hb; exact hG ⟨ψ, T, f, fI, s, r, c, A, hb⟩
|
||||
|
||||
/-- T2 specialised to `.interval`: the interval is dim-absent in
|
||||
every binder, so transport on `.interval` is always identity. -/
|
||||
@[simp]
|
||||
theorem ask_of_interval_line (q : TranspQ) (h : IsIntervalLine q) :
|
||||
q.ask = eval q.env q.t := by
|
||||
unfold ask
|
||||
rw [show q.body = .interval from h]
|
||||
exact eval_transp_interval q.env q.binder q.φ q.t
|
||||
|
||||
-- T2 specialised to `.ind` constant lines is just `ask_of_const_line`
|
||||
-- — no separate alias needed. The richer `.ind` lemma below extracts
|
||||
-- the schema and parameters.
|
||||
|
||||
/-- Stuck `.ind` transport (non-trivial line): produces `ntransp`. -/
|
||||
theorem ask_of_ind_stuck (q : TranspQ) (h : IsIndLine q)
|
||||
(hφ : ¬ IsFullFace q) (hC : ¬ IsConstLine q) :
|
||||
∃ S params, q.body = .ind S params ∧
|
||||
q.ask = .vneu (.ntransp q.binder q.body q.φ (eval q.env q.t)) := by
|
||||
obtain ⟨S, params, hbody⟩ := h
|
||||
refine ⟨S, params, hbody, ?_⟩
|
||||
apply ask_of_stuck q hφ hC
|
||||
· intro ⟨_, _, hp⟩; rw [hp] at hbody; cases hbody
|
||||
· intro ⟨_, _, _, hp⟩; rw [hp] at hbody; cases hbody
|
||||
· intro ⟨_, _, _, _, _, _, _, _, hp⟩; rw [hp] at hbody; cases hbody
|
||||
|
||||
/-- T5 in question form: face congruence — semantically equal faces
|
||||
yield equivalent transport questions. -/
|
||||
theorem ask_face_congr (q₁ q₂ : TranspQ)
|
||||
(h_env : q₁.env = q₂.env) (h_bind : q₁.binder = q₂.binder)
|
||||
(h_body : q₁.body = q₂.body) (h_t : q₁.t = q₂.t)
|
||||
(h_face : ∀ ε, q₁.φ.eval ε = q₂.φ.eval ε) :
|
||||
q₁.Equiv q₂ := by
|
||||
unfold Equiv ask
|
||||
rw [h_env, h_bind, h_body, h_t]
|
||||
exact eval_transp_face_congr q₂.env q₂.binder q₂.body q₁.φ q₂.φ q₂.t h_face
|
||||
|
||||
/-- Bridge: on the full-face arm, `TranspQ.toCompQ q` has the same
|
||||
`ask` as the transport itself, provided the base is dim-absent in
|
||||
the line binder.
|
||||
|
||||
**Why only the full-face case.** On `φ = .top`:
|
||||
· transport: `eval_transp_top` → `eval env t`.
|
||||
· comp: `eval_comp_top` → `eval env (t.substDim binder .one)`.
|
||||
Under `t.dimAbsent binder = true`, the substitution is identity
|
||||
and both sides agree.
|
||||
|
||||
On non-trivial faces with a constant body:
|
||||
· transport: `eval_transp_const` → `eval env t`.
|
||||
· comp: `eval_comp_const` → `vHCompValue body φ … …`,
|
||||
which is a non-trivial value for non-Π bodies.
|
||||
So the two answers genuinely diverge in the general non-trivial-
|
||||
face case. The bridge is therefore restricted to the full-face
|
||||
arm; broader reconciliations live in the engine's typed totality
|
||||
proofs (REL3+). -/
|
||||
theorem toCompQ_ask_eq_ask_full_face (q : TranspQ)
|
||||
(hφ : IsFullFace q) (hi : q.t.dimAbsent q.binder = true) :
|
||||
q.toCompQ.ask = q.ask := by
|
||||
rw [ask_of_full_face q hφ]
|
||||
show eval q.env (.comp q.binder q.body q.φ q.t q.t) = eval q.env q.t
|
||||
rw [show q.φ = .top from hφ]
|
||||
rw [eval_comp_top q.env q.binder q.body q.t q.t]
|
||||
congr 1
|
||||
exact CTerm.substDim_of_absent q.binder .one q.t hi
|
||||
|
||||
end TranspQ
|
||||
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
-- HCompQ — homogeneous-comp question (value-level)
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
--
|
||||
-- Homogeneous composition `hcomp A φ tube base` lives at the *value*
|
||||
-- level: the engine's `vHCompValue : CType → FaceFormula → CVal → CVal → CVal`
|
||||
-- consumes already-evaluated `tube` and `base`. This is the one
|
||||
-- question that doesn't take an environment — by the time you've
|
||||
-- reduced to hcomp, evaluation has already happened.
|
||||
|
||||
/-- Homogeneous composition question. The "constant-line" CompQ
|
||||
that has been reduced one step further by extracting the tube
|
||||
as a `vplam`-shaped value. -/
|
||||
/-- Homogeneous composition question. -/
|
||||
structure HCompQ where
|
||||
body : CType
|
||||
φ : FaceFormula
|
||||
tube : CVal
|
||||
base : CVal
|
||||
/-- Universe level of the type `body`. -/
|
||||
level : ULevel := .zero
|
||||
body : CType level
|
||||
φ : FaceFormula
|
||||
tube : CVal
|
||||
base : CVal
|
||||
|
||||
def HCompQ.ask (q : HCompQ) : CVal := vHCompValue q.body q.φ q.tube q.base
|
||||
|
||||
|
|
@ -647,16 +417,13 @@ namespace HCompQ
|
|||
@[simp]
|
||||
def IsFullFace (q : HCompQ) : Prop := q.φ = .top
|
||||
@[simp]
|
||||
def IsPiLine (q : HCompQ) : Prop := ∃ domA codA, q.body = .pi domA codA
|
||||
def IsPiLine (q : HCompQ) : Prop := q.body.skeleton = SkeletalCType.pi
|
||||
|
||||
instance (q : HCompQ) : Decidable (IsFullFace q) :=
|
||||
inferInstanceAs (Decidable (q.φ = .top))
|
||||
|
||||
instance (q : HCompQ) : Decidable (IsPiLine q) :=
|
||||
match h : q.body with
|
||||
| .pi domA codA => isTrue ⟨domA, codA, h⟩
|
||||
| .univ | .path _ _ _ | .sigma _ _ | .glue _ _ _ _ _ _ _ _ | .ind _ _ | .interval =>
|
||||
isFalse (fun ⟨_, _, hp⟩ => by rw [hp] at h; cases h)
|
||||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.pi))
|
||||
|
||||
/-- Full-face hcomp: tube evaluated at `1` is the answer. -/
|
||||
@[simp]
|
||||
|
|
@ -665,40 +432,19 @@ theorem ask_of_full_face (q : HCompQ) (h : IsFullFace q) :
|
|||
unfold ask; rw [show q.φ = .top from h]
|
||||
exact vHCompValue_top q.body q.tube q.base
|
||||
|
||||
/-- Π-line hcomp: packages into a `vHCompFun` closure. Not in
|
||||
`question_simp` (existential conclusion). -/
|
||||
theorem ask_of_pi_line (q : HCompQ) (hP : IsPiLine q)
|
||||
(hφ : ¬ IsFullFace q) :
|
||||
∃ domA codA, q.body = .pi domA codA ∧
|
||||
q.ask = .vHCompFun codA q.φ q.tube q.base := by
|
||||
obtain ⟨domA, codA, hbody⟩ := hP
|
||||
refine ⟨domA, codA, hbody, ?_⟩
|
||||
unfold ask; rw [hbody]
|
||||
exact vHCompValue_pi domA codA q.φ q.tube q.base hφ
|
||||
|
||||
/-- Stuck hcomp: non-Π body under a non-full face produces `nhcomp`. -/
|
||||
theorem ask_of_stuck (q : HCompQ)
|
||||
(hφ : ¬ IsFullFace q) (hP : ¬ IsPiLine q) :
|
||||
q.ask = .vneu (.nhcomp q.body q.φ q.tube q.base) := by
|
||||
unfold ask
|
||||
apply vHCompValue_stuck q.body q.φ q.tube q.base hφ
|
||||
intro domA codA hb; exact hP ⟨domA, codA, hb⟩
|
||||
|
||||
end HCompQ
|
||||
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
-- CompNQ — multi-clause heterogeneous-comp question
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
--
|
||||
-- `compNⁱ A [φ_1 ↦ u_1, …, φ_n ↦ u_n] t` — a partial element defined
|
||||
-- over the union of clause faces. Its reduction depends on the
|
||||
-- clauses' shape (any `.top`? all `.bot`? exactly one live? many?).
|
||||
|
||||
/-- Multi-clause heterogeneous-comp question. -/
|
||||
structure CompNQ where
|
||||
/-- Universe level of the type-line `body`. -/
|
||||
level : ULevel := .zero
|
||||
env : CEnv
|
||||
binder : DimVar
|
||||
body : CType
|
||||
body : CType level
|
||||
clauses : List (FaceFormula × CTerm)
|
||||
t : CTerm
|
||||
|
||||
|
|
@ -715,31 +461,27 @@ theorem CompNQ.Equiv.trans {q₁ q₂ q₃ : CompNQ}
|
|||
|
||||
namespace CompNQ
|
||||
|
||||
/-- Bool-valued: does some clause have face `.top`? Used to decide
|
||||
whether `vCompNAtTerm` will fire the top-clause arm. -/
|
||||
/-- Bool-valued: does some clause have face `.top`? -/
|
||||
def hasTopClause (q : CompNQ) : Bool :=
|
||||
q.clauses.any fun ⟨φ, _⟩ => match φ with | .top => true | _ => false
|
||||
|
||||
/-- The clause list contains some clause whose face is `.top` —
|
||||
that clause's body fires at `binder := 1`. -/
|
||||
/-- The clause list contains some clause whose face is `.top`. -/
|
||||
def HasTopClause (q : CompNQ) : Prop := q.hasTopClause = true
|
||||
|
||||
instance (q : CompNQ) : Decidable (HasTopClause q) :=
|
||||
inferInstanceAs (Decidable (q.hasTopClause = true))
|
||||
|
||||
/-- The list of "live" clauses: those whose face is not `.bot`. -/
|
||||
/-- The list of "live" clauses. -/
|
||||
def liveClauses (q : CompNQ) : List (FaceFormula × CTerm) :=
|
||||
q.clauses.filter fun ⟨φ, _⟩ => match φ with | .bot => false | _ => true
|
||||
|
||||
/-- Every clause has face `.bot` (or the list is empty) — no live
|
||||
contributions, the question reduces to plain transport on `t`. -/
|
||||
/-- Every clause has face `.bot` (or empty). -/
|
||||
def AllBotOrEmpty (q : CompNQ) : Prop := q.liveClauses = []
|
||||
|
||||
instance (q : CompNQ) : Decidable (AllBotOrEmpty q) :=
|
||||
inferInstanceAs (Decidable (q.liveClauses = []))
|
||||
|
||||
/-- Exactly one live clause — the question reduces to a single
|
||||
`CompQ` on that clause. -/
|
||||
/-- Exactly one live clause. -/
|
||||
def IsSingleLive (q : CompNQ) : Prop := ∃ p, q.liveClauses = [p]
|
||||
|
||||
instance (q : CompNQ) : Decidable (IsSingleLive q) :=
|
||||
|
|
@ -748,12 +490,7 @@ instance (q : CompNQ) : Decidable (IsSingleLive q) :=
|
|||
| [] => isFalse (fun ⟨_, hp⟩ => by rw [h] at hp; cases hp)
|
||||
| _ :: _ :: _ => isFalse (fun ⟨_, hp⟩ => by rw [h] at hp; cases hp)
|
||||
|
||||
-- ── Restated `vCompNAtTerm_def` — one theorem per arm ──────────────────────
|
||||
|
||||
/-- The CompN reduction "anatomy" axiom restated through the
|
||||
classifier vocabulary: every CompN question's answer is one of
|
||||
four shapes, decidable from `HasTopClause` / `AllBotOrEmpty` /
|
||||
`IsSingleLive`. -/
|
||||
/-- The CompN reduction "anatomy" axiom restated. -/
|
||||
theorem ask_def (q : CompNQ) :
|
||||
q.ask =
|
||||
match q.clauses.find?
|
||||
|
|
@ -774,52 +511,3 @@ theorem ask_def (q : CompNQ) :
|
|||
end CompNQ
|
||||
|
||||
end Question
|
||||
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
-- `question_simp` simp-set sanity checks
|
||||
-- ──────────────────────────────────────────────────────────────────────────
|
||||
-- Each `@[simp]`-tagged classifier definition or
|
||||
-- classifier-conditioned theorem is reachable via `simp`.
|
||||
-- These examples verify the named simp-set composes — no special
|
||||
-- tactic involved, just Lean's standard `simp`. Anyone wanting a
|
||||
-- different reduction order or extra lemmas writes
|
||||
-- `simp [question_simp, my_extras]` — no opinion baked in.
|
||||
--
|
||||
-- (The earlier `cubical_simp` macros were removed: they baked in a
|
||||
-- specific lemma list with a fixed expansion order. Use the
|
||||
-- declarative simp set instead.)
|
||||
|
||||
example (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) :
|
||||
let q : Question.CompQ := ⟨env, i, A, .top, u, t⟩
|
||||
q.ask = eval env (u.substDim i .one) := by
|
||||
simp
|
||||
|
||||
example (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) :
|
||||
let q : Question.CompQ := ⟨env, i, A, .bot, u, t⟩
|
||||
q.ask = eval env (.transp i A .bot t) := by
|
||||
simp
|
||||
|
||||
/-- Transport-shaped (`u = t`) interval-line CompQ under a full
|
||||
face with a dim-absent base reduces to `eval env t`. -/
|
||||
example (env : CEnv) (i : DimVar) (t : CTerm)
|
||||
(hi : t.dimAbsent i = true) :
|
||||
(Question.CompQ.ofTransp env i .interval .top t).ask = eval env t := by
|
||||
apply Question.CompQ.ask_of_transport_full_face
|
||||
· rfl
|
||||
· rfl
|
||||
· exact hi
|
||||
|
||||
example (env : CEnv) (i : DimVar) (A : CType) (t : CTerm) :
|
||||
let q : Question.TranspQ := ⟨env, i, A, .top, t⟩
|
||||
q.ask = eval env t := by
|
||||
simp
|
||||
|
||||
example (env : CEnv) (i : DimVar) (t : CTerm) :
|
||||
let q : Question.TranspQ := ⟨env, i, .interval, .bot, t⟩
|
||||
q.ask = eval env t := by
|
||||
simp
|
||||
|
||||
example (A : CType) (tube base : CVal) :
|
||||
let q : Question.HCompQ := ⟨A, .top, tube, base⟩
|
||||
q.ask = vPApp tube .one := by
|
||||
simp
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.Readback
|
||||
CubicalTransport.Readback
|
||||
========================
|
||||
Readback (NbE reification) for the cubical calculus — Sessions 1–2 of
|
||||
the step↔eval bridge (Phase 1 Week 7).
|
||||
|
|
@ -65,10 +65,10 @@ instance : Inhabited CTerm := ⟨.var "⊥"⟩
|
|||
|
||||
-- ── Rust FFI declarations (Phase C.2) ──────────────────────────────────────
|
||||
|
||||
@[extern "topolei_cubical_readback"]
|
||||
@[extern "cubical_transport_readback"]
|
||||
opaque readbackRust : CVal → CTerm
|
||||
|
||||
@[extern "topolei_cubical_readback_neu"]
|
||||
@[extern "cubical_transport_readback_neu"]
|
||||
opaque readbackNeuRust : CNeu → CTerm
|
||||
|
||||
-- ── The readback function ───────────────────────────────────────────────────
|
||||
|
|
@ -108,15 +108,15 @@ mutual
|
|||
| .vplam env i body =>
|
||||
.plam i (readback (eval env body))
|
||||
| .vTranspFun i domA codA φ f =>
|
||||
.transp i (.pi domA codA) φ (readback f)
|
||||
.transp i (.pi "_" domA codA) φ (readback f)
|
||||
| .vCompFun _env i domA codA φ u t =>
|
||||
.comp i (.pi domA codA) φ u t
|
||||
.comp i (.pi "_" domA codA) φ u t
|
||||
| .vHCompFun codA φ tube base =>
|
||||
-- Use a hygienic fresh dim; the type (.pi .univ codA) is
|
||||
-- dim-absent on this binder, so eval routes via the constant-line
|
||||
-- → hcomp path and reconstructs `vHCompFun`.
|
||||
let fd : DimVar := ⟨"$rd_hcomp"⟩
|
||||
.comp fd (.pi .univ codA) φ (readback tube) (readback base)
|
||||
.comp fd (.pi "_" (CType.univ (ℓ := .zero)) codA) φ (readback tube) (readback base)
|
||||
| .vTubeApp tube arg =>
|
||||
let fd : DimVar := ⟨"$rd_tube"⟩
|
||||
.plam fd (.app (.papp (readback tube) (.var fd)) (readback arg))
|
||||
|
|
@ -205,20 +205,21 @@ axiom readback_vplam (env : CEnv) (i : DimVar) (body : CTerm) :
|
|||
readback (.vplam env i body) =
|
||||
.plam i (readback (eval env body))
|
||||
|
||||
axiom readback_vTranspFun (i : DimVar) (domA codA : CType)
|
||||
axiom readback_vTranspFun {ℓ ℓ' : ULevel} (i : DimVar)
|
||||
(domA : CType ℓ) (codA : CType ℓ')
|
||||
(φ : FaceFormula) (f : CVal) :
|
||||
readback (.vTranspFun i domA codA φ f) =
|
||||
.transp i (.pi domA codA) φ (readback f)
|
||||
.transp i (.pi "_" domA codA) φ (readback f)
|
||||
|
||||
axiom readback_vCompFun (env : CEnv) (i : DimVar)
|
||||
(domA codA : CType) (φ : FaceFormula) (u t : CTerm) :
|
||||
axiom readback_vCompFun {ℓ ℓ' : ULevel} (env : CEnv) (i : DimVar)
|
||||
(domA : CType ℓ) (codA : CType ℓ') (φ : FaceFormula) (u t : CTerm) :
|
||||
readback (.vCompFun env i domA codA φ u t) =
|
||||
.comp i (.pi domA codA) φ u t
|
||||
.comp i (.pi "_" domA codA) φ u t
|
||||
|
||||
axiom readback_vHCompFun (codA : CType) (φ : FaceFormula)
|
||||
axiom readback_vHCompFun {ℓ : ULevel} (codA : CType ℓ) (φ : FaceFormula)
|
||||
(tube base : CVal) :
|
||||
readback (.vHCompFun codA φ tube base) =
|
||||
.comp ⟨"$rd_hcomp"⟩ (.pi .univ codA) φ (readback tube) (readback base)
|
||||
.comp ⟨"$rd_hcomp"⟩ (.pi "_" (CType.univ (ℓ := .zero)) codA) φ (readback tube) (readback base)
|
||||
|
||||
axiom readback_vTubeApp (tube arg : CVal) :
|
||||
readback (.vTubeApp tube arg) =
|
||||
|
|
@ -229,7 +230,7 @@ axiom readback_vTubeApp (tube arg : CVal) :
|
|||
through a varying path-line reads back as a plam with a CCHM-shaped
|
||||
`.compN` witness body. Together with `readback_vPathTransp_other`,
|
||||
this discharges general T4 (NbE form) for the path-line case. -/
|
||||
axiom readback_vPathTransp_plam (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom readback_vPathTransp_plam {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm) :
|
||||
readback (.vPathTransp env i A a b φ (.plam j body)) =
|
||||
.plam j
|
||||
|
|
@ -240,7 +241,7 @@ axiom readback_vPathTransp_plam (env : CEnv) (i : DimVar) (A : CType)
|
|||
/-- `readback_vPathTransp` — fallback arm. When the inner term is not
|
||||
a plam, preserve the original `.transp` form. Face-disjoint from the
|
||||
`_plam` arm by the explicit precondition. -/
|
||||
axiom readback_vPathTransp_other (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom readback_vPathTransp_other {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(a b : CTerm) (φ : FaceFormula) (p : CTerm)
|
||||
(hp : ∀ j body, p ≠ .plam j body) :
|
||||
readback (.vPathTransp env i A a b φ p) =
|
||||
|
|
@ -257,20 +258,20 @@ axiom readbackNeu_napp (n : CNeu) (arg : CVal) :
|
|||
axiom readbackNeu_npapp (n : CNeu) (r : DimExpr) :
|
||||
readbackNeu (.npapp n r) = .papp (readbackNeu n) r
|
||||
|
||||
axiom readbackNeu_ntransp (i : DimVar) (A : CType) (φ : FaceFormula)
|
||||
axiom readbackNeu_ntransp {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula)
|
||||
(v : CVal) :
|
||||
readbackNeu (.ntransp i A φ v) = .transp i A φ (readback v)
|
||||
|
||||
axiom readbackNeu_ncomp (i : DimVar) (A : CType) (φ : FaceFormula)
|
||||
axiom readbackNeu_ncomp {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula)
|
||||
(u t : CVal) :
|
||||
readbackNeu (.ncomp i A φ u t) =
|
||||
.comp i A φ (readback u) (readback t)
|
||||
|
||||
axiom readbackNeu_nhcomp (A : CType) (φ : FaceFormula) (tube base : CVal) :
|
||||
axiom readbackNeu_nhcomp {ℓ : ULevel} (A : CType ℓ) (φ : FaceFormula) (tube base : CVal) :
|
||||
readbackNeu (.nhcomp A φ tube base) =
|
||||
.comp ⟨"$rd_nhcomp"⟩ A φ (readback tube) (readback base)
|
||||
|
||||
axiom readbackNeu_ncompN (env : CEnv) (i : DimVar) (A : CType)
|
||||
axiom readbackNeu_ncompN {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(clauses : List (FaceFormula × CVal)) (t : CVal) :
|
||||
readbackNeu (.ncompN env i A clauses t) =
|
||||
.compN i A
|
||||
|
|
@ -367,7 +368,7 @@ theorem CTerm.readback_papp_plam (i : DimVar) (body : CTerm) (r : DimExpr) :
|
|||
|
||||
/-- **T1 under NbE.** Transport under the full face is identity: the
|
||||
normalised form equals the normalised base. -/
|
||||
theorem CTerm.readback_transp_id (L : DimLine) (t : CTerm) :
|
||||
theorem CTerm.readback_transp_id {ℓ : ULevel} (L : DimLine ℓ) (t : CTerm) :
|
||||
CTerm.readback (.transp L.binder L.body .top t) = CTerm.readback t := by
|
||||
show _root_.readback (eval .nil (.transp L.binder L.body .top t)) =
|
||||
_root_.readback (eval .nil t)
|
||||
|
|
@ -376,7 +377,7 @@ theorem CTerm.readback_transp_id (L : DimLine) (t : CTerm) :
|
|||
/-- **T2 under NbE.** Transport along a constant line is identity, for
|
||||
*any* face formula. Proof splits into `.top` (covered by T1) and
|
||||
`≠ .top` (covered by eval_transp_const). -/
|
||||
theorem CTerm.readback_transp_const_id (i : DimVar) (A : CType)
|
||||
theorem CTerm.readback_transp_const_id {ℓ : ULevel} (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (t : CTerm) (h : CType.dimAbsent i A = true) :
|
||||
CTerm.readback (.transp i A φ t) = CTerm.readback t := by
|
||||
show _root_.readback (eval .nil (.transp i A φ t)) =
|
||||
|
|
@ -387,7 +388,7 @@ theorem CTerm.readback_transp_const_id (i : DimVar) (A : CType)
|
|||
|
||||
/-- **C1 under NbE.** Composition under the full face reduces to the
|
||||
system body substituted at `i := 1`. -/
|
||||
theorem CTerm.readback_comp_full (L : DimLine) (u t₀ : CTerm) :
|
||||
theorem CTerm.readback_comp_full {ℓ : ULevel} (L : DimLine ℓ) (u t₀ : CTerm) :
|
||||
CTerm.readback (.comp L.binder L.body .top u t₀) =
|
||||
CTerm.readback (u.substDim L.binder .one) := by
|
||||
show _root_.readback (eval .nil (.comp L.binder L.body .top u t₀)) =
|
||||
|
|
@ -396,7 +397,7 @@ theorem CTerm.readback_comp_full (L : DimLine) (u t₀ : CTerm) :
|
|||
|
||||
/-- **C2 under NbE.** Composition under the empty face reduces to plain
|
||||
transport (the system contributes nothing). -/
|
||||
theorem CTerm.readback_comp_empty (L : DimLine) (u t₀ : CTerm) :
|
||||
theorem CTerm.readback_comp_empty {ℓ : ULevel} (L : DimLine ℓ) (u t₀ : CTerm) :
|
||||
CTerm.readback (.comp L.binder L.body .bot u t₀) =
|
||||
CTerm.readback (.transp L.binder L.body .bot t₀) := by
|
||||
show _root_.readback (eval .nil (.comp L.binder L.body .bot u t₀)) =
|
||||
|
|
@ -427,7 +428,7 @@ readback-equivalent form.
|
|||
|
||||
/-- **T4 at full face (NbE).** Transport under `.top` of a plam is a
|
||||
plam — specifically, the original plam's normalised form. -/
|
||||
theorem CTerm.readback_transp_plam_top (L : DimLine) (j : DimVar)
|
||||
theorem CTerm.readback_transp_plam_top {ℓ : ULevel} (L : DimLine ℓ) (j : DimVar)
|
||||
(body : CTerm) :
|
||||
∃ body' : CTerm,
|
||||
CTerm.readback (.transp L.binder L.body .top (.plam j body)) =
|
||||
|
|
@ -439,7 +440,7 @@ theorem CTerm.readback_transp_plam_top (L : DimLine) (j : DimVar)
|
|||
|
||||
/-- **T4 on constant lines (NbE).** When the line body is dim-absent
|
||||
from the binder, transport of any plam is a plam for any face. -/
|
||||
theorem CTerm.readback_transp_plam_const (L : DimLine) (φ : FaceFormula)
|
||||
theorem CTerm.readback_transp_plam_const {ℓ : ULevel} (L : DimLine ℓ) (φ : FaceFormula)
|
||||
(j : DimVar) (body : CTerm)
|
||||
(h : CType.dimAbsent L.binder L.body = true) :
|
||||
∃ body' : CTerm,
|
||||
|
|
@ -461,7 +462,7 @@ theorem CTerm.readback_transp_plam_const (L : DimLine) (φ : FaceFormula)
|
|||
plus the two endpoint-clamp faces); the Rust backend's full CCHM §5.5
|
||||
reduction may produce a definitionally distinct but propositionally
|
||||
equal body. -/
|
||||
theorem CTerm.readback_transp_plam_path (i : DimVar) (A : CType)
|
||||
theorem CTerm.readback_transp_plam_path {ℓ : ULevel} (i : DimVar) (A : CType ℓ)
|
||||
(a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hpath : CType.dimAbsent i (.path A a b) = false) :
|
||||
|
|
@ -477,7 +478,7 @@ theorem CTerm.readback_transp_plam_path (i : DimVar) (A : CType)
|
|||
/-- **T5 under NbE.** Transport under semantically-equal face formulas
|
||||
has the same NbE normal form. Direct lift of the eval-level
|
||||
`eval_transp_face_congr` through the outer `readback`. -/
|
||||
theorem CTerm.readback_transp_face_congr (i : DimVar) (A : CType)
|
||||
theorem CTerm.readback_transp_face_congr {ℓ : ULevel} (i : DimVar) (A : CType ℓ)
|
||||
(φ ψ : FaceFormula) (t : CTerm)
|
||||
(h : ∀ ε, φ.eval ε = ψ.eval ε) :
|
||||
CTerm.readback (.transp i A φ t) = CTerm.readback (.transp i A ψ t) := by
|
||||
|
|
@ -496,7 +497,7 @@ theorem CTerm.readback_transp_face_congr (i : DimVar) (A : CType)
|
|||
constant — the last is impossible since `.univ` always has
|
||||
`dimAbsent = true`), the `transp_plam_is_plam` step axiom remains
|
||||
the only formal handle; those cases are vacuous in well-typed code. -/
|
||||
theorem CTerm.readback_transp_plam_general (i : DimVar) (A : CType)
|
||||
theorem CTerm.readback_transp_plam_general {ℓ : ULevel} (i : DimVar) (A : CType ℓ)
|
||||
(a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm) :
|
||||
∃ body' : CTerm,
|
||||
CTerm.readback (.transp i (.path A a b) φ (.plam j body)) =
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.Soundness
|
||||
CubicalTransport.Soundness
|
||||
=========================
|
||||
The Phase 1 Week 6 closeout — soundness theorems that tie transport,
|
||||
composition, and glue into a coherent story (cells-spec §14 "Key
|
||||
|
|
@ -66,7 +66,7 @@ namespace Soundness
|
|||
|
||||
/-- Eval-level constant-line identity. Combines `eval_transp_top` with
|
||||
`eval_transp_const` to cover every face. -/
|
||||
theorem transp_refl_eval (env : CEnv) (i : DimVar) (A : CType)
|
||||
theorem transp_refl_eval {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||||
(φ : FaceFormula) (t : CTerm) (hA : CType.dimAbsent i A = true) :
|
||||
eval env (.transp i A φ t) = eval env t := by
|
||||
by_cases hφ : φ = .top
|
||||
|
|
@ -79,7 +79,7 @@ theorem transp_refl_eval (env : CEnv) (i : DimVar) (A : CType)
|
|||
reduces to the tube body substituted at the 1-endpoint. This is the
|
||||
"composition agrees with tube on constrained face" obligation;
|
||||
at `.top` the constraint is total. -/
|
||||
theorem hcomp_face_top (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) :
|
||||
theorem hcomp_face_top {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ) (u t : CTerm) :
|
||||
eval env (.comp i A .top u t) = eval env (u.substDim i .one) :=
|
||||
eval_comp_top env i A u t
|
||||
|
||||
|
|
@ -92,13 +92,13 @@ theorem hcomp_face_top (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) :
|
|||
/-- `ua_endpoints` (cells-spec §14, half 1): the left endpoint of the
|
||||
univalence line is the full-face glue, which computationally behaves
|
||||
like `A` via `e`. -/
|
||||
theorem ua_endpoints_zero (e : EquivData) (A B : CType) :
|
||||
theorem ua_endpoints_zero {ℓ : ULevel} (e : EquivData) (A B : CType ℓ) :
|
||||
uaLine e A B .zero = e.toGlueType .top A B :=
|
||||
uaLine_zero e A B
|
||||
|
||||
/-- `ua_endpoints` (half 2): the right endpoint is the empty-face glue,
|
||||
which computationally is just `B`. -/
|
||||
theorem ua_endpoints_one (e : EquivData) (A B : CType) :
|
||||
theorem ua_endpoints_one {ℓ : ULevel} (e : EquivData) (A B : CType ℓ) :
|
||||
uaLine e A B .one = e.toGlueType .bot A B :=
|
||||
uaLine_one e A B
|
||||
|
||||
|
|
@ -185,7 +185,7 @@ the missing rule and rewriting the axiom statement as a theorem.
|
|||
|
||||
The dim-absence hypotheses formalise the well-scopedness assumption
|
||||
that `e`, `A`, `B` are supplied from outside the transport binder. -/
|
||||
theorem transp_ua (env : CEnv) (i : DimVar) (e : EquivData) (A B : CType)
|
||||
theorem transp_ua {ℓ : ULevel} (env : CEnv) (i : DimVar) (e : EquivData) (A B : CType ℓ)
|
||||
(t : CTerm)
|
||||
(hA : A.dimAbsent i = true)
|
||||
(hB : B.dimAbsent i = true)
|
||||
|
|
@ -234,7 +234,7 @@ theorem transp_ua (env : CEnv) (i : DimVar) (e : EquivData) (A B : CType)
|
|||
Together with `transp_ua`, this exhibits the two principal directions
|
||||
of the equivalence as the computational content of Glue transport at
|
||||
the constant-component sub-cases. -/
|
||||
theorem transp_ua_inverse (env : CEnv) (i : DimVar) (e : EquivData) (A B : CType)
|
||||
theorem transp_ua_inverse {ℓ : ULevel} (env : CEnv) (i : DimVar) (e : EquivData) (A B : CType ℓ)
|
||||
(t : CTerm)
|
||||
(hA : A.dimAbsent i = true)
|
||||
(hB : B.dimAbsent i = true)
|
||||
|
|
|
|||
|
|
@ -1,28 +1,54 @@
|
|||
/-
|
||||
Topolei.Cubical.Subst
|
||||
=====================
|
||||
Dimension substitution for CType (Step 1 of the transport plan).
|
||||
CubicalTransport.Subst
|
||||
======================
|
||||
Dimension substitution for the universe-stratified, dependently-
|
||||
typed CType (Layer 0 §0.1 cascade).
|
||||
|
||||
CTerm already has substDim : DimVar → DimExpr → CTerm → CTerm (Syntax.lean).
|
||||
Here we add:
|
||||
|
||||
CTerm.substDimBool : DimVar → Bool → CTerm → CTerm
|
||||
— specialises substDim to the two canonical endpoints (false = 0, true = 1).
|
||||
— Defined as a thin wrapper; no new recursion.
|
||||
|
||||
CType.substDim : DimVar → Bool → CType → CType
|
||||
— Substitutes a dimension variable with a Bool endpoint throughout a type.
|
||||
— CType.path recurses into its CTerm endpoints via substDimBool.
|
||||
CType.substDim : DimVar → Bool → CType ℓ → CType ℓ
|
||||
CType.substDimExpr : DimVar → DimExpr → CType ℓ → CType ℓ
|
||||
— Substitute a dimension variable with a Bool endpoint / DimExpr
|
||||
throughout a type. Level-preserving: substituting dim vars
|
||||
does not change a type's universe level.
|
||||
|
||||
Key theorems:
|
||||
· Reduction lemmas (univ, pi, path) — proved by rfl.
|
||||
· substDimBool_eq_substDim — the wrapper unfolds correctly.
|
||||
· substDim_false_of_env / substDim_true_of_env — face connection:
|
||||
the Bool environment value at i selects which endpoint substitution applies.
|
||||
· substDim_idem — substituting twice at the same Bool is idempotent.
|
||||
## Universe-aware shape
|
||||
|
||||
Note: substDim_comm (disjoint dimensions commute) is deferred;
|
||||
it requires DimExpr.subst commutativity, which needs its own treatment.
|
||||
All substDim functions are level-polymorphic: they take and return a
|
||||
`CType ℓ` at the same `ℓ`. The mutual block over CType is uniform in
|
||||
`ℓ` — pattern matching on constructors does not require explicit
|
||||
instantiation.
|
||||
|
||||
## Dependent pi/sigma
|
||||
|
||||
The new `pi var A B` and `sigma var A B` constructors carry a binder
|
||||
name. For dim substitution, the binder is irrelevant (it binds a
|
||||
CTerm variable, not a DimVar), so substDim recurses into both A and
|
||||
B as usual.
|
||||
|
||||
## Cumulativity (lift)
|
||||
|
||||
`lift A` carries the underlying `A : CType ℓ`; substitution descends
|
||||
into A (preserving the lift wrapper).
|
||||
|
||||
## Heterogeneous-level params
|
||||
|
||||
`params : List (Σ ℓ : ULevel, CType ℓ)`. Each entry is `⟨ℓ', A⟩`
|
||||
with `A : CType ℓ'`. The helper `substDim.params` substitutes
|
||||
pointwise, preserving each entry's level.
|
||||
|
||||
## Key theorems
|
||||
|
||||
· Reduction lemmas (univ, pi, sigma, path, glue, ind, interval, lift)
|
||||
— proved by rfl.
|
||||
· substDimBool_eq_substDim — the wrapper unfolds correctly.
|
||||
· substDim_at_false / substDim_at_true — face-environment connection.
|
||||
· substDim_eq_substDimExpr — the Bool-endpoint substitution agrees
|
||||
with the DimExpr substitution at the canonical endpoint.
|
||||
-/
|
||||
|
||||
import CubicalTransport.Syntax
|
||||
|
|
@ -35,7 +61,6 @@ import CubicalTransport.Syntax
|
|||
def CTerm.substDimBool (i : DimVar) (b : Bool) (t : CTerm) : CTerm :=
|
||||
t.substDim i (if b then .one else .zero)
|
||||
|
||||
-- Unfolds to substDim by definition.
|
||||
theorem CTerm.substDimBool_eq_substDim (i : DimVar) (b : Bool) (t : CTerm) :
|
||||
t.substDimBool i b = t.substDim i (if b then .one else .zero) := rfl
|
||||
|
||||
|
|
@ -47,88 +72,85 @@ theorem CTerm.substDimBool_true (i : DimVar) (t : CTerm) :
|
|||
|
||||
-- ── CType.substDim ────────────────────────────────────────────────────────────
|
||||
-- Substitute dimension variable i with Bool endpoint b throughout a type.
|
||||
-- Path type endpoints are terms, so we delegate to CTerm.substDimBool.
|
||||
--
|
||||
-- `.ind S params` recurses pointwise through the parameter list via an
|
||||
-- explicit mutually-recursive helper (`CType.substDim.params`); this
|
||||
-- is the standard way to thread structural recursion through a
|
||||
-- `List CType` field of a CType constructor.
|
||||
-- Level-polymorphic — the universe level of the result equals the input.
|
||||
|
||||
mutual
|
||||
def CType.substDim (i : DimVar) (b : Bool) : CType → CType
|
||||
| .univ => .univ
|
||||
| .pi A B => .pi (A.substDim i b) (B.substDim i b)
|
||||
| .path A a t => .path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b)
|
||||
| .sigma A B => .sigma (A.substDim i b) (B.substDim i b)
|
||||
def CType.substDim {ℓ : ULevel} (i : DimVar) (b : Bool) : CType ℓ → CType ℓ
|
||||
| .univ => .univ
|
||||
| .pi var A B => .pi var (A.substDim i b) (B.substDim i b)
|
||||
| .path A a t => .path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b)
|
||||
| .sigma var A B => .sigma var (A.substDim i b) (B.substDim i b)
|
||||
| .glue φ T f fInv sec ret coh A =>
|
||||
.glue (φ.substDim i (if b then .one else .zero))
|
||||
(T.substDim i b)
|
||||
(f.substDimBool i b) (fInv.substDimBool i b)
|
||||
(sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b)
|
||||
(A.substDim i b)
|
||||
-- REL1: schema-defined inductive. Recurse into params; the schema
|
||||
-- itself is static (its boundary CTerms are the schema's data, not
|
||||
-- caller-substituted dim-bound terms).
|
||||
| .ind S params => .ind S (CType.substDim.params i b params)
|
||||
-- REL2: cubical interval — closed type, no recursion.
|
||||
| .interval => .interval
|
||||
| .ind S params => .ind S (CType.substDim.params i b params)
|
||||
| .interval => .interval
|
||||
| .lift A => .lift (A.substDim i b)
|
||||
|
||||
/-- Pointwise `substDim` through a list of CType parameters. -/
|
||||
def CType.substDim.params (i : DimVar) (b : Bool) : List CType → List CType
|
||||
| [] => []
|
||||
| A :: rest => A.substDim i b :: CType.substDim.params i b rest
|
||||
/-- Pointwise `substDim` through a level-heterogeneous list of CType
|
||||
parameters. Each entry's universe level is preserved. -/
|
||||
def CType.substDim.params (i : DimVar) (b : Bool) :
|
||||
List (Σ ℓ : ULevel, CType ℓ) → List (Σ ℓ : ULevel, CType ℓ)
|
||||
| [] => []
|
||||
| ⟨ℓ, A⟩ :: rest => ⟨ℓ, A.substDim i b⟩ :: CType.substDim.params i b rest
|
||||
end
|
||||
|
||||
-- ── CType.substDimExpr ────────────────────────────────────────────────────────
|
||||
-- Substitute dimension variable `i` with an arbitrary `DimExpr r` throughout
|
||||
-- a type. Generalises `CType.substDim`, which fixes `r` to a Bool endpoint.
|
||||
--
|
||||
-- Used for *line reversal* in transport: the reversed line is
|
||||
-- `A[i := inv i]`, which cannot be expressed as a Bool-endpoint
|
||||
-- substitution because `inv i` is an open DimExpr.
|
||||
-- Substitute dimension variable `i` with an arbitrary `DimExpr r`
|
||||
-- throughout a type. Generalises `CType.substDim`, which fixes `r` to
|
||||
-- a Bool endpoint.
|
||||
|
||||
mutual
|
||||
def CType.substDimExpr (i : DimVar) (r : DimExpr) : CType → CType
|
||||
| .univ => .univ
|
||||
| .pi A B => .pi (A.substDimExpr i r) (B.substDimExpr i r)
|
||||
| .path A a t => .path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r)
|
||||
| .sigma A B => .sigma (A.substDimExpr i r) (B.substDimExpr i r)
|
||||
def CType.substDimExpr {ℓ : ULevel} (i : DimVar) (r : DimExpr) : CType ℓ → CType ℓ
|
||||
| .univ => .univ
|
||||
| .pi var A B => .pi var (A.substDimExpr i r) (B.substDimExpr i r)
|
||||
| .path A a t => .path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r)
|
||||
| .sigma var A B => .sigma var (A.substDimExpr i r) (B.substDimExpr i r)
|
||||
| .glue φ T f fInv sec ret coh A =>
|
||||
.glue (φ.substDim i r)
|
||||
(T.substDimExpr i r)
|
||||
(f.substDim i r) (fInv.substDim i r)
|
||||
(sec.substDim i r) (ret.substDim i r) (coh.substDim i r)
|
||||
(A.substDimExpr i r)
|
||||
| .ind S params => .ind S (CType.substDimExpr.params i r params)
|
||||
| .interval => .interval
|
||||
| .ind S params => .ind S (CType.substDimExpr.params i r params)
|
||||
| .interval => .interval
|
||||
| .lift A => .lift (A.substDimExpr i r)
|
||||
|
||||
/-- Pointwise `substDimExpr` through a list of CType parameters. -/
|
||||
def CType.substDimExpr.params (i : DimVar) (r : DimExpr) : List CType → List CType
|
||||
| [] => []
|
||||
| A :: rest => A.substDimExpr i r :: CType.substDimExpr.params i r rest
|
||||
/-- Pointwise `substDimExpr` through a level-heterogeneous list of
|
||||
CType parameters. -/
|
||||
def CType.substDimExpr.params (i : DimVar) (r : DimExpr) :
|
||||
List (Σ ℓ : ULevel, CType ℓ) → List (Σ ℓ : ULevel, CType ℓ)
|
||||
| [] => []
|
||||
| ⟨ℓ, A⟩ :: rest => ⟨ℓ, A.substDimExpr i r⟩ :: CType.substDimExpr.params i r rest
|
||||
end
|
||||
|
||||
-- ── Reduction lemmas ──────────────────────────────────────────────────────────
|
||||
-- All proved by rfl: substDim is defined by pattern matching, so these
|
||||
-- hold definitionally.
|
||||
-- ── Reduction lemmas (substDim) ──────────────────────────────────────────────
|
||||
|
||||
namespace CType
|
||||
|
||||
theorem substDim_univ (i : DimVar) (b : Bool) :
|
||||
(univ).substDim i b = .univ := rfl
|
||||
theorem substDim_univ {ℓ : ULevel} (i : DimVar) (b : Bool) :
|
||||
(univ (ℓ := ℓ)).substDim i b = .univ := rfl
|
||||
|
||||
theorem substDim_pi (i : DimVar) (b : Bool) (A B : CType) :
|
||||
(pi A B).substDim i b = .pi (A.substDim i b) (B.substDim i b) := rfl
|
||||
theorem substDim_pi {ℓ ℓ' : ULevel} (i : DimVar) (b : Bool)
|
||||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||||
(pi var A B).substDim i b = .pi var (A.substDim i b) (B.substDim i b) := rfl
|
||||
|
||||
theorem substDim_path (i : DimVar) (b : Bool) (A : CType) (a t : CTerm) :
|
||||
theorem substDim_path {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||||
(A : CType ℓ) (a t : CTerm) :
|
||||
(path A a t).substDim i b =
|
||||
.path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) := rfl
|
||||
|
||||
theorem substDim_sigma (i : DimVar) (b : Bool) (A B : CType) :
|
||||
(sigma A B).substDim i b = .sigma (A.substDim i b) (B.substDim i b) := rfl
|
||||
theorem substDim_sigma {ℓ ℓ' : ULevel} (i : DimVar) (b : Bool)
|
||||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||||
(sigma var A B).substDim i b =
|
||||
.sigma var (A.substDim i b) (B.substDim i b) := rfl
|
||||
|
||||
theorem substDim_glue (i : DimVar) (b : Bool) (φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) :
|
||||
theorem substDim_glue {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) :
|
||||
(glue φ T f fInv sec ret coh A).substDim i b =
|
||||
.glue (φ.substDim i (if b then .one else .zero))
|
||||
(T.substDim i b)
|
||||
|
|
@ -136,31 +158,39 @@ theorem substDim_glue (i : DimVar) (b : Bool) (φ : FaceFormula) (T : CType)
|
|||
(sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b)
|
||||
(A.substDim i b) := rfl
|
||||
|
||||
theorem substDim_ind (i : DimVar) (b : Bool) (S : CTypeSchema) (params : List CType) :
|
||||
(ind S params).substDim i b = .ind S (CType.substDim.params i b params) := rfl
|
||||
theorem substDim_ind {ℓ : ULevel} (i : DimVar) (b : Bool)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) :
|
||||
(ind (ℓ := ℓ) S params).substDim i b = .ind S (CType.substDim.params i b params) := rfl
|
||||
|
||||
theorem substDim_interval (i : DimVar) (b : Bool) :
|
||||
(interval).substDim i b = .interval := rfl
|
||||
|
||||
-- ── substDimExpr reduction lemmas ─────────────────────────────────────────────
|
||||
theorem substDim_lift {ℓ : ULevel} (i : DimVar) (b : Bool) (A : CType ℓ) :
|
||||
(lift A).substDim i b = .lift (A.substDim i b) := rfl
|
||||
|
||||
theorem substDimExpr_univ (i : DimVar) (r : DimExpr) :
|
||||
(univ).substDimExpr i r = .univ := rfl
|
||||
-- ── Reduction lemmas (substDimExpr) ──────────────────────────────────────────
|
||||
|
||||
theorem substDimExpr_pi (i : DimVar) (r : DimExpr) (A B : CType) :
|
||||
(pi A B).substDimExpr i r =
|
||||
.pi (A.substDimExpr i r) (B.substDimExpr i r) := rfl
|
||||
theorem substDimExpr_univ {ℓ : ULevel} (i : DimVar) (r : DimExpr) :
|
||||
(univ (ℓ := ℓ)).substDimExpr i r = .univ := rfl
|
||||
|
||||
theorem substDimExpr_path (i : DimVar) (r : DimExpr) (A : CType) (a t : CTerm) :
|
||||
theorem substDimExpr_pi {ℓ ℓ' : ULevel} (i : DimVar) (r : DimExpr)
|
||||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||||
(pi var A B).substDimExpr i r =
|
||||
.pi var (A.substDimExpr i r) (B.substDimExpr i r) := rfl
|
||||
|
||||
theorem substDimExpr_path {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||||
(A : CType ℓ) (a t : CTerm) :
|
||||
(path A a t).substDimExpr i r =
|
||||
.path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r) := rfl
|
||||
|
||||
theorem substDimExpr_sigma (i : DimVar) (r : DimExpr) (A B : CType) :
|
||||
(sigma A B).substDimExpr i r =
|
||||
.sigma (A.substDimExpr i r) (B.substDimExpr i r) := rfl
|
||||
theorem substDimExpr_sigma {ℓ ℓ' : ULevel} (i : DimVar) (r : DimExpr)
|
||||
(var : String) (A : CType ℓ) (B : CType ℓ') :
|
||||
(sigma var A B).substDimExpr i r =
|
||||
.sigma var (A.substDimExpr i r) (B.substDimExpr i r) := rfl
|
||||
|
||||
theorem substDimExpr_glue (i : DimVar) (r : DimExpr) (φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm) (A : CType) :
|
||||
theorem substDimExpr_glue {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||||
(φ : FaceFormula) (T : CType ℓ)
|
||||
(f fInv sec ret coh : CTerm) (A : CType ℓ) :
|
||||
(glue φ T f fInv sec ret coh A).substDimExpr i r =
|
||||
.glue (φ.substDim i r)
|
||||
(T.substDimExpr i r)
|
||||
|
|
@ -168,30 +198,27 @@ theorem substDimExpr_glue (i : DimVar) (r : DimExpr) (φ : FaceFormula) (T : CTy
|
|||
(sec.substDim i r) (ret.substDim i r) (coh.substDim i r)
|
||||
(A.substDimExpr i r) := rfl
|
||||
|
||||
theorem substDimExpr_ind (i : DimVar) (r : DimExpr) (S : CTypeSchema) (params : List CType) :
|
||||
(ind S params).substDimExpr i r = .ind S (CType.substDimExpr.params i r params) := rfl
|
||||
theorem substDimExpr_ind {ℓ : ULevel} (i : DimVar) (r : DimExpr)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) :
|
||||
(ind (ℓ := ℓ) S params).substDimExpr i r =
|
||||
.ind S (CType.substDimExpr.params i r params) := rfl
|
||||
|
||||
theorem substDimExpr_interval (i : DimVar) (r : DimExpr) :
|
||||
(interval).substDimExpr i r = .interval := rfl
|
||||
|
||||
-- The Bool-endpoint `substDim` is exactly `substDimExpr` at the canonical
|
||||
-- endpoint `DimExpr`. Proof is by pattern-matching `def` (rather than the
|
||||
-- `induction` tactic) because `CType` is mutually inductive with `CTerm`.
|
||||
-- `CTerm.substDimBool` is defined as `CTerm.substDim` at the same DimExpr,
|
||||
-- so the path case closes by unfolding both.
|
||||
--
|
||||
-- `.ind` recurses into params via `substDim_eq_substDimExpr.params`,
|
||||
-- a structurally-recursive helper that establishes pointwise equality
|
||||
-- on the parameter list.
|
||||
theorem substDimExpr_lift {ℓ : ULevel} (i : DimVar) (r : DimExpr) (A : CType ℓ) :
|
||||
(lift A).substDimExpr i r = .lift (A.substDimExpr i r) := rfl
|
||||
|
||||
-- ── Bool endpoint = DimExpr at canonical endpoint ────────────────────────────
|
||||
|
||||
mutual
|
||||
def substDim_eq_substDimExpr (i : DimVar) (b : Bool) :
|
||||
(A : CType) →
|
||||
def substDim_eq_substDimExpr {ℓ : ULevel} (i : DimVar) (b : Bool) :
|
||||
(A : CType ℓ) →
|
||||
A.substDim i b = A.substDimExpr i (if b then DimExpr.one else DimExpr.zero)
|
||||
| .univ => rfl
|
||||
| .pi A B => by
|
||||
show CType.pi (A.substDim i b) (B.substDim i b) =
|
||||
CType.pi (A.substDimExpr i _) (B.substDimExpr i _)
|
||||
| .pi var A B => by
|
||||
show CType.pi var (A.substDim i b) (B.substDim i b) =
|
||||
CType.pi var (A.substDimExpr i _) (B.substDimExpr i _)
|
||||
rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B]
|
||||
| .path A a t => by
|
||||
show CType.path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) =
|
||||
|
|
@ -199,9 +226,9 @@ mutual
|
|||
rw [substDim_eq_substDimExpr i b A,
|
||||
CTerm.substDimBool_eq_substDim,
|
||||
CTerm.substDimBool_eq_substDim]
|
||||
| .sigma A B => by
|
||||
show CType.sigma (A.substDim i b) (B.substDim i b) =
|
||||
CType.sigma (A.substDimExpr i _) (B.substDimExpr i _)
|
||||
| .sigma var A B => by
|
||||
show CType.sigma var (A.substDim i b) (B.substDim i b) =
|
||||
CType.sigma var (A.substDimExpr i _) (B.substDimExpr i _)
|
||||
rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B]
|
||||
| .glue φ T f fInv sec ret coh A => by
|
||||
show CType.glue
|
||||
|
|
@ -228,61 +255,47 @@ mutual
|
|||
= CType.ind S (CType.substDimExpr.params i _ params)
|
||||
rw [substDim_eq_substDimExpr.params i b params]
|
||||
| .interval => rfl
|
||||
| .lift A => by
|
||||
show CType.lift (A.substDim i b) = CType.lift (A.substDimExpr i _)
|
||||
rw [substDim_eq_substDimExpr i b A]
|
||||
|
||||
/-- Helper: pointwise equality between `substDim.params` and
|
||||
`substDimExpr.params` at the canonical endpoint DimExpr. -/
|
||||
def substDim_eq_substDimExpr.params (i : DimVar) (b : Bool) :
|
||||
(params : List CType) →
|
||||
(params : List (Σ ℓ : ULevel, CType ℓ)) →
|
||||
CType.substDim.params i b params =
|
||||
CType.substDimExpr.params i (if b then DimExpr.one else DimExpr.zero) params
|
||||
| [] => rfl
|
||||
| A :: rest => by
|
||||
show A.substDim i b :: CType.substDim.params i b rest
|
||||
= A.substDimExpr i _ :: CType.substDimExpr.params i _ rest
|
||||
| [] => rfl
|
||||
| ⟨ℓ, A⟩ :: rest => by
|
||||
show ⟨ℓ, A.substDim i b⟩ :: CType.substDim.params i b rest
|
||||
= ⟨ℓ, A.substDimExpr i _⟩ :: CType.substDimExpr.params i _ rest
|
||||
rw [substDim_eq_substDimExpr i b A,
|
||||
substDim_eq_substDimExpr.params i b rest]
|
||||
end
|
||||
|
||||
-- ── Face connection ───────────────────────────────────────────────────────────
|
||||
-- These lemmas state the relationship between the Bool dimension environment
|
||||
-- and which endpoint substitution applies.
|
||||
--
|
||||
-- Semantics: env i = false means we are at the i=0 face (eq0 i holds).
|
||||
-- env i = true means we are at the i=1 face (eq1 i holds).
|
||||
-- The correct substitution to apply is therefore substDim i (env i).
|
||||
|
||||
/-- At the i=0 face (env i = false), substDim i (env i) is substDim i false. -/
|
||||
theorem substDim_at_false (i : DimVar) (A : CType) (env : DimVar → Bool)
|
||||
theorem substDim_at_false {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (env : DimVar → Bool)
|
||||
(h : env i = false) :
|
||||
A.substDim i (env i) = A.substDim i false := by
|
||||
rw [h]
|
||||
|
||||
/-- At the i=1 face (env i = true), substDim i (env i) is substDim i true. -/
|
||||
theorem substDim_at_true (i : DimVar) (A : CType) (env : DimVar → Bool)
|
||||
theorem substDim_at_true {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (env : DimVar → Bool)
|
||||
(h : env i = true) :
|
||||
A.substDim i (env i) = A.substDim i true := by
|
||||
rw [h]
|
||||
|
||||
-- ── Deferred: idempotence and commutativity ───────────────────────────────────
|
||||
-- substDim_idem : (A.substDim i b).substDim i b = A.substDim i b
|
||||
-- substDim_comm : for i ≠ j, (A.substDim i b).substDim j c = (A.substDim j c).substDim i b
|
||||
--
|
||||
-- Both require simultaneous induction over the CType/CTerm mutual inductive,
|
||||
-- which needs a `mutual` proof block or a size-indexed recursor.
|
||||
-- Deferred to a later pass after the DimLine and transport layers are in place.
|
||||
--
|
||||
-- Correctness argument (informal):
|
||||
-- · After substDim i b, every DimExpr referencing i becomes zero or one
|
||||
-- (neither of which contains free variables), so a second substDim i b
|
||||
-- finds nothing left to substitute. Idempotence follows.
|
||||
-- · Substituting disjoint dimensions i ≠ j affects non-overlapping parts
|
||||
-- of every DimExpr (DimExpr.subst is capture-avoiding), so order is irrelevant.
|
||||
-- substDim_idem and substDim_comm require simultaneous induction over the
|
||||
-- CType/CTerm mutual inductive; deferred to DimLine.lean as in the original.
|
||||
|
||||
theorem substDim_comm_univ (i j : DimVar) (b c : Bool) :
|
||||
((univ : CType).substDim i b).substDim j c =
|
||||
((univ : CType).substDim j c).substDim i b := rfl
|
||||
theorem substDim_comm_univ {ℓ : ULevel} (i j : DimVar) (b c : Bool) :
|
||||
((univ (ℓ := ℓ)).substDim i b).substDim j c =
|
||||
((univ (ℓ := ℓ)).substDim j c).substDim i b := rfl
|
||||
|
||||
end CType
|
||||
|
||||
-- Note: dimAbsent, substDimBool_idem, and substDim_idem are proved in DimLine.lean,
|
||||
-- which is downstream in the import chain and has access to dimAbsent predicates.
|
||||
-- Note: dimAbsent, substDimBool_idem, and substDim_idem are proved in
|
||||
-- DimLine.lean, which is downstream and has access to dimAbsent predicates.
|
||||
|
|
|
|||
|
|
@ -1,20 +1,63 @@
|
|||
/-
|
||||
Topolei.Cubical.Syntax
|
||||
======================
|
||||
Deep embedding of the cubical term language (CCHM §2–3).
|
||||
CubicalTransport.Syntax
|
||||
=======================
|
||||
Deep embedding of the cubical term language (CCHM §2–3),
|
||||
universe-stratified and dependently-typed.
|
||||
|
||||
Grammar:
|
||||
A, B ::= U | Π A B | Path A a b
|
||||
t, u ::= x | λx.t | t u | ⟨i⟩t | t@r | transpⁱ A φ t | compⁱ A φ u t
|
||||
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
|
||||
|
||||
CType and CTerm are mutually inductive because path types carry endpoint
|
||||
terms, and terms carry path applications over DimExprs.
|
||||
This is the universe-stratified successor to the original
|
||||
monomorphic `CType` (THEORY.md Layer 0 §0.1).
|
||||
|
||||
transp and comp store (i : DimVar) (A : CType) inline rather than DimLine,
|
||||
because DimLine is defined later in the import chain (Subst → DimLine).
|
||||
The typing rules in Typing.lean use DimLine as a convenient wrapper.
|
||||
## Design (ratified before refactor)
|
||||
|
||||
The path β-rule (⟨i⟩ t) @ r ↝ t[i := r]
|
||||
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
|
||||
|
|
@ -23,205 +66,156 @@
|
|||
-/
|
||||
|
||||
import CubicalTransport.Face
|
||||
import CubicalTransport.Universe
|
||||
|
||||
-- ── Syntax ────────────────────────────────────────────────────────────────────
|
||||
-- ── Universe-stratified syntax ──────────────────────────────────────────────
|
||||
|
||||
mutual
|
||||
/-- Types in the cubical calculus. -/
|
||||
inductive CType where
|
||||
| univ : CType -- U
|
||||
| pi (A : CType) (B : CType) : CType -- Π A B
|
||||
| path (A : CType) (a b : CTerm) : CType -- Path A a b
|
||||
/-- Non-dependent Σ type (cells-spec §6.2, §8.1, §9.2).
|
||||
/-- Types in the cubical calculus, stratified by universe level.
|
||||
|
||||
`Sigma A B` — pairs whose first component has type `A` and whose
|
||||
second has type `B`. Non-dependent: `B` does not refer to the
|
||||
first component. Dependent Σ (where `B : A → CType`) is deferred
|
||||
for the same reason as dependent Π — requires a term evaluator
|
||||
to apply `B` to a term. -/
|
||||
| sigma (A B : CType) : CType -- Σ A B
|
||||
/-- Glue type (CCHM §6).
|
||||
`Glue [φ ↦ (T, e)] A` — on face `φ` the type is `T` with `e : T ≃ A`
|
||||
as witness; off face `φ` the type is `A`. The equivalence `e` is
|
||||
inlined as five `CTerm` fields (f, fInv, sec, ret, coh) rather than
|
||||
a nested `EquivData` so that `CType` / `CTerm` remain a closed
|
||||
mutual inductive block — `EquivData` lives in `Equiv.lean` and is
|
||||
downstream in the import chain. Use `EquivData.toGlueType` in
|
||||
`Equiv.lean` for an ergonomic wrapper. -/
|
||||
| glue (φ : FaceFormula) (T : CType)
|
||||
(f fInv sec ret coh : CTerm)
|
||||
(A : CType) : CType -- Glue [φ ↦ (T, e)] A
|
||||
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` is an instance of the schema `S` at the given
|
||||
type parameters. `params.length = S.numParams` is a typing-side
|
||||
condition (not enforced syntactically — see `HasType.ind` in
|
||||
`Typing.lean`).
|
||||
`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 schema `S` carries the constructor list (point + path
|
||||
ctors) and their boundary partial-element systems. Both plain
|
||||
inductives (`Nat`, `List A`, `Bool`) and HITs (`S¹`, `‖A‖₋₁`,
|
||||
suspensions, pushouts) are encoded uniformly via
|
||||
`CTypeSchema`. -/
|
||||
| ind (S : CTypeSchema) (params : List CType) : CType -- ind S params
|
||||
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 ℓ)
|
||||
|
||||
Inhabited by `CTerm.dimExpr r` for `r : DimExpr`. No
|
||||
non-trivial transport on `.interval` (it is dim-absent in
|
||||
itself); transport on `.interval` is always the identity by
|
||||
`eval_transp_const` / `eval_transp_top`.
|
||||
|
||||
Pre-REL2, `CTerm.dimExpr` was typed at the placeholder
|
||||
`.univ`; promoting `.interval` to a CType primitive lets
|
||||
path-constructor dim arguments (`loop @ r`, `seg @ r`,
|
||||
`squash _ _ @ r`, etc.) carry real semantic ground.
|
||||
|
||||
See `docs/REL2_PLAN.md` Phase 1. Tag 6. -/
|
||||
| interval : CType -- 𝕀
|
||||
|
||||
/-- Terms in the cubical calculus. -/
|
||||
inductive CTerm where
|
||||
| var (x : String) : CTerm -- x
|
||||
| lam (x : String) (t : CTerm) : CTerm -- λx. t
|
||||
| app (f a : CTerm) : CTerm -- f a
|
||||
| plam (i : DimVar) (t : CTerm) : CTerm -- ⟨i⟩ t
|
||||
| papp (t : CTerm) (r : DimExpr) : CTerm -- t @ r
|
||||
| transp (i : DimVar) (A : CType) (φ : FaceFormula)
|
||||
(t : CTerm) : CTerm -- transpⁱ A φ t
|
||||
| comp (i : DimVar) (A : CType) (φ : FaceFormula)
|
||||
(u t : CTerm) : CTerm -- compⁱ A φ u t
|
||||
/-- Multi-clause heterogeneous composition.
|
||||
`compⁱ A [φ₁ ↦ u₁, …, φₙ ↦ uₙ] t` — a partial element defined
|
||||
over the union of the clause faces. Coherence (clauses agree
|
||||
on overlaps and with `t` at `i = 0`) is a typing-level side
|
||||
condition, not enforced syntactically. Used by CCHM path
|
||||
transport and heterogeneous Π composition to express systems
|
||||
that a single-clause `.comp` cannot represent. -/
|
||||
| compN (i : DimVar) (A : CType)
|
||||
(clauses : List (FaceFormula × CTerm))
|
||||
(t : CTerm) : CTerm -- compⁱ A [φ₁↦u₁,…] t
|
||||
/-- Glue introduction (CCHM §6.1).
|
||||
`glueIn [φ ↦ t] a` — on face `φ`, equals `t : T`; off face `φ`,
|
||||
equals `a : A`. Well-typedness requires `e.f t = a` on the
|
||||
overlap (a typing-side condition, not enforced syntactically).
|
||||
The equivalence `e` is carried by the type, not the term. -/
|
||||
| glueIn (φ : FaceFormula) (t a : CTerm) : CTerm -- glue [φ↦t] a
|
||||
/-- Glue elimination (CCHM §6.1).
|
||||
`unglue [φ ↦ f] g` — extract the underlying `A`-value from a
|
||||
glued term. On face `φ`, equals `f g` (apply the forward map);
|
||||
off face `φ`, equals `g` (already an `A`-value). `f` is the
|
||||
`f`-field of the equivalence witnessing `T ≃ A` — carried
|
||||
explicitly at the term level because we don't have type
|
||||
annotations on terms. -/
|
||||
| unglue (φ : FaceFormula) (f g : CTerm) : CTerm -- unglue [φ↦f] g
|
||||
/-- 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 -- (a, b)
|
||||
/-- Σ elimination (first projection). -/
|
||||
| fst (t : CTerm) : CTerm -- t.1
|
||||
/-- Σ elimination (second projection). -/
|
||||
| snd (t : CTerm) : CTerm -- t.2
|
||||
/-- A dimension expression lifted into the term language (REL1).
|
||||
|
||||
Used to fill `.dim`-typed argument positions of schema
|
||||
constructors (path ctors) and to hand a `DimExpr` to any
|
||||
future term-level operation that needs one. `DimExpr` is
|
||||
de Morgan algebra over `DimVar` and 0/1; lifting it lets path
|
||||
constructors take general dim arguments like `.meet i j`,
|
||||
`.inv r`, etc., not just bare `.var`-shaped dim names. -/
|
||||
| dimExpr (r : DimExpr) : CTerm -- ⟦ r ⟧
|
||||
/-- Schema constructor application (REL1, INDUCTIVE_TYPES.md §2.4).
|
||||
|
||||
`ctor S c params args` applies the constructor named `c` of
|
||||
schema `S` at parameters `params`, with `args.length =
|
||||
(S.ctors.find c).args.length`.
|
||||
|
||||
Args are positional and follow `CtorSpec.args` order. `.dim`-
|
||||
typed arg positions carry `CTerm.dimExpr r` (or any other
|
||||
CTerm that evaluates to a dim) — eval consults the
|
||||
constructor's boundary system on these to decide whether to
|
||||
produce the canonical `vctor` or fire a boundary clause. -/
|
||||
| ctor (S : CTypeSchema) (ctorName : String)
|
||||
(params : List CType) (args : List CTerm) : CTerm
|
||||
/-- Inductive eliminator (REL1, INDUCTIVE_TYPES.md §5).
|
||||
|
||||
`indElim S params motive branches target` eliminates a value
|
||||
of type `.ind S params`.
|
||||
|
||||
- `motive` is a CTerm of (function-CType) shape `.pi (.ind S
|
||||
params) .univ` — i.e. `λx : .ind S params. SomeType x`.
|
||||
- `branches` is one entry per ctor in *schema-declaration
|
||||
order*. Entry `(c, body)` says: when target reduces to the
|
||||
ctor `c`, evaluate `body` applied to the ctor's args plus
|
||||
(for each `.self` arg) the recursive elimination result.
|
||||
- `target : .ind S params` is the term being eliminated.
|
||||
|
||||
For path constructors, the branch must respect boundary
|
||||
coherence: at every face in the ctor's boundary system, the
|
||||
branch agrees with the corresponding eliminated body. This
|
||||
is a typing-level side condition (see `HasType.indElim`). -/
|
||||
| indElim (S : CTypeSchema) (params : List CType)
|
||||
| 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
|
||||
(target : CTerm)
|
||||
: CTerm
|
||||
|
||||
/-- Argument shape for a schema constructor (REL1, §2.1).
|
||||
|
||||
Distinguishes ordinary CType-typed args (which may reference
|
||||
schema parameters via `.param`) from recursive `.self` args
|
||||
(the inductive being defined) and `.dim` args (used by path
|
||||
constructors). Boundary clauses inside `CtorSpec` reference
|
||||
args positionally; `.dim` args are addressed in face formulae
|
||||
via `DimVar.mk "$d_k"` where `k` is the dim-arg index counted
|
||||
among `.dim` arg positions only. -/
|
||||
/-- Argument shape for a schema constructor (REL1, §2.1). -/
|
||||
inductive CTypeArg where
|
||||
/-- A non-recursive arg whose type is a closed CType. May
|
||||
reference schema parameters via embedded `.param i` inside `A`
|
||||
(parameter substitution happens at instantiation time). -/
|
||||
| type (A : CType) : CTypeArg
|
||||
/-- The `i`th schema parameter (zero-indexed against
|
||||
`CTypeSchema.numParams`). -/
|
||||
| param (i : Nat) : CTypeArg
|
||||
/-- 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
|
||||
| self : CTypeArg
|
||||
/-- A dimension binder, used by path constructors. -/
|
||||
| dim : CTypeArg
|
||||
| dim : CTypeArg
|
||||
|
||||
/-- Constructor specification (REL1, §2.2).
|
||||
|
||||
`name` is unique within the schema. `args` is the positional
|
||||
arg list. `boundary` is the partial-element system for path
|
||||
constructors (empty list ≡ point ctor). Each clause `(φ, body)`
|
||||
says: on the face `φ` of the dim args, the constructor reduces
|
||||
to `body`. Coherence obligations on the clauses are enforced
|
||||
at typing time (see `HasType.ctor` in `Typing.lean`).
|
||||
|
||||
Boundary clause bodies are CTerms in a scope where the ctor's
|
||||
args are bound positionally as `.var "$arg_k"`. Face formulae
|
||||
reference dim args as `DimVar.mk "$d_k"`. -/
|
||||
`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
|
||||
(boundary : List (FaceFormula × CTerm))
|
||||
: CtorSpec
|
||||
|
||||
/-- Schema for an inductive (or higher-inductive) type (REL1, §2.3).
|
||||
|
||||
`name` is the schema's symbolic name (used for diagnostics, not
|
||||
identity — schemas are compared structurally). `numParams` is
|
||||
the count of type parameters; `ctors` is the constructor list
|
||||
in declaration order. Equality is structural (no interning).
|
||||
|
||||
The schema mutually depends on `CType` (via `.type`-typed args
|
||||
and via `params : List CType` in `CType.ind`) and `CTerm` (via
|
||||
boundary clauses), so all five types live in this `mutual`
|
||||
block. -/
|
||||
/-- Schema for an inductive (or higher-inductive) type (REL1, §2.3). -/
|
||||
inductive CTypeSchema where
|
||||
| mk (name : String) (numParams : Nat)
|
||||
(ctors : List CtorSpec) : CTypeSchema
|
||||
(ctors : List CtorSpec)
|
||||
: CTypeSchema
|
||||
end
|
||||
|
||||
-- ── Repr derivations ─────────────────────────────────────────────────────────
|
||||
-- All five mutual inductives get `Repr` instances post-hoc (Lean's
|
||||
-- `deriving Repr` clause inside a mutual block of five doesn't always
|
||||
-- compose; explicit `deriving instance` is the robust form).
|
||||
-- ── Repr derivations ──────────────────────────────────────────────────────────
|
||||
|
||||
deriving instance Repr for CType
|
||||
deriving instance Repr for CTerm
|
||||
|
|
@ -233,6 +227,132 @@ deriving instance Repr for CTypeSchema
|
|||
-- (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
|
||||
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
|
||||
|
||||
-- ── 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
|
||||
|
||||
-- ── 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.
|
||||
--
|
||||
|
|
@ -241,10 +361,14 @@ deriving instance Repr for CTypeSchema
|
|||
-- · 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
|
||||
-- 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
|
||||
-- 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
|
||||
|
|
@ -258,26 +382,13 @@ mutual
|
|||
-- 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)
|
||||
-- Multi-clause comp: substitute in each clause's face and body, and in t.
|
||||
-- Uses an explicit recursive helper `substDim.clauses` so Lean can see
|
||||
-- structural termination through the clause list.
|
||||
| .compN j A clauses t =>
|
||||
.compN j A (CTerm.substDim.clauses i r clauses) (t.substDim i r)
|
||||
-- Glue introduction / elimination: descend into all sub-terms and
|
||||
-- substitute into the face formula. Same approximation for types
|
||||
-- as transp/comp (A not touched — the `φ` face formula carries the
|
||||
-- whole dim-dependency story; in our approximation we still don't
|
||||
-- recurse into CType sub-trees here, matching `.transp`/`.comp`).
|
||||
| .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)
|
||||
-- Σ constructors: structural recursion into sub-terms.
|
||||
| .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)
|
||||
-- REL1 inductive-type constructors. Same CType-approximation as
|
||||
-- transp/comp/glue: schemas and `params : List CType` are *not*
|
||||
-- recursed into. The schemas are static and the params are
|
||||
-- supplied externally to any binder we'd be substituting into.
|
||||
| .dimExpr s => .dimExpr (DimExpr.subst i r s)
|
||||
| .ctor S c params args =>
|
||||
.ctor S c params (CTerm.substDim.list i r args)
|
||||
|
|
@ -288,8 +399,7 @@ mutual
|
|||
(target.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.
|
||||
Defined mutually with `substDim` so Lean can verify termination. -/
|
||||
`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)
|
||||
| [] => []
|
||||
|
|
@ -297,14 +407,14 @@ mutual
|
|||
(φ.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). Mutually recursive for termination. -/
|
||||
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 not affected; only bodies. -/
|
||||
/-- 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)
|
||||
| [] => []
|
||||
|
|
@ -319,29 +429,8 @@ end
|
|||
-- arm, any axiom of the shape `step (.transp …) = t` would rfl-collapse
|
||||
-- to `.transp … = t`, contradicting `CTerm.noConfusion`.
|
||||
--
|
||||
-- **Stage 4.4 decision (2026-04-23).** After the Phase 1 step↔eval
|
||||
-- bridge + Stream B #2d + Stage 2.3, only one step-level axiom remains:
|
||||
-- `transp_plam_is_plam_path` (T4, path-restricted form; Stage 4.2).
|
||||
-- T1/T2/C1/C2/T5/`step_papp_plam` are NbE theorems in `Readback.lean`;
|
||||
-- T3/C4 are theorems via `CTerm.step_preserves_type` (ValueTyping.lean);
|
||||
-- glue β/η are theorems via `eval_unglue_of_glueIn`/`eval_glueIn_of_unglue`.
|
||||
--
|
||||
-- **Rust discharge flexibility.** The Rust backend has two valid
|
||||
-- implementation strategies for `CTerm.step`:
|
||||
--
|
||||
-- · *Option A — native step*: implement `step` directly as a C ABI
|
||||
-- entry point. The single T4 axiom is discharged by emitting the
|
||||
-- CCHM comp-shaped body for path-typed transp-of-plam inputs, plus
|
||||
-- identity behaviour on other shapes.
|
||||
--
|
||||
-- · *Option B — derived step*: define `step := readback ∘ eval .nil`
|
||||
-- entirely in Rust (no separate `step` FFI entry). This matches
|
||||
-- the Lean-side "bridge" intuition and keeps the Rust FFI surface
|
||||
-- smaller by one function. Satisfies T4 on path-typed lines via
|
||||
-- the `vPathTransp` → `.compN` readback arm.
|
||||
--
|
||||
-- The Lean-side spec is agnostic to which strategy Rust picks — both
|
||||
-- satisfy the same axiom set. See FFI_DESIGN.md (Stage 4.5) for the
|
||||
-- concrete recommendation.
|
||||
-- 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
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.System
|
||||
CubicalTransport.System
|
||||
======================
|
||||
Step 6 of the transport plan: partial elements — the [φ↦u] of composition.
|
||||
|
||||
|
|
@ -89,34 +89,36 @@ theorem System.compat_entails (i : DimVar) (u t₀ : CTerm)
|
|||
|
||||
/-- A typed system: the body has the 1-end type of the line.
|
||||
In the comp rule, the system provides the "target" elements on the face φ. -/
|
||||
structure System.Typed (Γ : Ctx) (s : System) (L : DimLine) : Prop where
|
||||
structure System.Typed {ℓ : ULevel} (Γ : Ctx) (s : System) (L : DimLine ℓ) : Prop where
|
||||
body_typed : HasType Γ s.body L.at1
|
||||
|
||||
-- ── Typed system lemmas ───────────────────────────────────────────────────────
|
||||
|
||||
/-- Construct a typed system with face `.bot`. The face is irrelevant to the
|
||||
`System.Typed` structure — the body must still be typed at `L.at1`. -/
|
||||
theorem System.typed_bot (Γ : Ctx) (u : CTerm) (L : DimLine) :
|
||||
theorem System.typed_bot {ℓ : ULevel} (Γ : Ctx) (u : CTerm) (L : DimLine ℓ) :
|
||||
HasType Γ u L.at1 →
|
||||
System.Typed Γ { face := .bot, body := u } L :=
|
||||
fun h => { body_typed := h }
|
||||
|
||||
/-- Weakening for typed systems. -/
|
||||
theorem System.Typed.weaken (x : String) (B : CType) (Γ : Ctx)
|
||||
(s : System) (L : DimLine)
|
||||
theorem System.Typed.weaken {ℓ ℓB : ULevel} (x : String) (B : CType ℓB) (Γ : Ctx)
|
||||
(s : System) (L : DimLine ℓ)
|
||||
(hs : System.Typed Γ s L) :
|
||||
System.Typed ((x, B) :: Γ) s L :=
|
||||
System.Typed ((x, ⟨ℓB, B⟩) :: Γ) s L :=
|
||||
{ body_typed := HasType.weaken x B hs.body_typed }
|
||||
|
||||
-- ── Joint compatibility + typing ──────────────────────────────────────────────
|
||||
|
||||
/-- Package compat and typing together — this is what the comp typing rule needs. -/
|
||||
structure System.Valid (Γ : Ctx) (s : System) (L : DimLine) (i : DimVar) (t₀ : CTerm) : Prop where
|
||||
structure System.Valid {ℓ : ULevel}
|
||||
(Γ : Ctx) (s : System) (L : DimLine ℓ) (i : DimVar) (t₀ : CTerm) : Prop where
|
||||
typed : System.Typed Γ s L
|
||||
compat : System.CompatAt0 s i t₀
|
||||
|
||||
/-- The empty system is valid for any t₀, given a body typed at L.at1. -/
|
||||
theorem System.valid_bot (Γ : Ctx) (u : CTerm) (L : DimLine) (i : DimVar) (t₀ : CTerm)
|
||||
theorem System.valid_bot {ℓ : ULevel}
|
||||
(Γ : Ctx) (u : CTerm) (L : DimLine ℓ) (i : DimVar) (t₀ : CTerm)
|
||||
(hu : HasType Γ u L.at1) :
|
||||
System.Valid Γ { face := .bot, body := u } L i t₀ :=
|
||||
{ typed := { body_typed := hu }
|
||||
|
|
@ -127,8 +129,8 @@ theorem System.valid_bot (Γ : Ctx) (u : CTerm) (L : DimLine) (i : DimVar) (t₀
|
|||
/-- Convert a System.Valid proof into the raw HasType.comp judgment.
|
||||
This is the ergonomic entry point: package everything in System.Valid,
|
||||
then call this to produce the typed composition term. -/
|
||||
theorem HasType.comp_of_valid
|
||||
(Γ : Ctx) (L : DimLine) (s : System) (t₀ : CTerm)
|
||||
theorem HasType.comp_of_valid {ℓ : ULevel}
|
||||
(Γ : Ctx) (L : DimLine ℓ) (s : System) (t₀ : CTerm)
|
||||
(ht : HasType Γ t₀ L.at0)
|
||||
(hv : System.Valid Γ s L L.binder t₀) :
|
||||
HasType Γ (.comp L.binder L.body s.face s.body t₀) L.at1 :=
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
/-
|
||||
Topolei.Cubical.Transport
|
||||
=========================
|
||||
CubicalTransport.Transport
|
||||
==========================
|
||||
Value-level transport (cells-spec §5.5, Phase 1 Weeks 3–4).
|
||||
Universe-aware (Layer 0 §0.1 cascade).
|
||||
|
||||
`vTransp i A φ v` reduces `transp^i A φ v` at the value level.
|
||||
|
||||
|
|
@ -12,25 +13,13 @@
|
|||
2. **`CType.dimAbsent i A = true`** — line is constant — return `v`
|
||||
unchanged. Evaluator-level analogue of `transp_const_id` (T2).
|
||||
Covers `univ`, fully-constant `pi`, fully-constant `path`.
|
||||
3. **`A = pi domA codA`** — produce a `vTranspFun i domA codA φ v`
|
||||
closure. This is the **full CCHM Π rule** — when the closure is
|
||||
later applied to an argument, `vApp` inversely transports the
|
||||
argument through `domA` and forward-transports the result through
|
||||
`codA`. Both constant-domain and varying-domain lines are handled
|
||||
by the same constructor; `vTranspInv` degenerates to identity in
|
||||
the constant-domain case via `CType.substDimExpr_of_absent` + T2,
|
||||
so no special-case logic is needed at this level.
|
||||
3. **`A = pi var domA codA`** — produce a `vTranspFun i domA codA φ v`
|
||||
closure (the pi's binder name is consumed; vApp handles the
|
||||
function-side reduction using the transport's binder `i`).
|
||||
4. **Otherwise** — stuck. Produce `vneu (.ntransp i A φ v)`.
|
||||
|
||||
Deferred to later passes:
|
||||
|
||||
· Σ case — `CType` has no Σ yet.
|
||||
· Path case — Week 4, alongside homogeneous composition.
|
||||
|
||||
vTransp is a `partial def` for the same reason as `eval`. Its reduction
|
||||
equations are stated as axioms below. `vTranspInv` is a *total `def`*
|
||||
because it is a thin wrapper that delegates to `vTransp` after line
|
||||
reversal.
|
||||
vTransp is a `partial def` for the same reason as `eval`. Its
|
||||
reduction equations are stated as axioms.
|
||||
-/
|
||||
|
||||
import CubicalTransport.Value
|
||||
|
|
@ -38,12 +27,12 @@ import CubicalTransport.DimLine -- for CType.dimAbsent and substDimExpr
|
|||
|
||||
-- ── Rust FFI declaration (Phase C.2) ──────────────────────────────────────
|
||||
|
||||
@[extern "topolei_cubical_vtransp"]
|
||||
opaque vTranspRust (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) : CVal
|
||||
@[extern "cubical_transport_vtransp"]
|
||||
opaque vTranspRust {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal) : CVal
|
||||
|
||||
/-- Value-level transport. Dispatches in priority order; see file header. -/
|
||||
@[implemented_by vTranspRust]
|
||||
partial def vTransp (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) :
|
||||
partial def vTransp {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal) :
|
||||
CVal :=
|
||||
match φ with
|
||||
| .top => v -- (1) T1 at eval level.
|
||||
|
|
@ -52,11 +41,8 @@ partial def vTransp (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) :
|
|||
v -- (2) T2 at eval level.
|
||||
else
|
||||
match A with
|
||||
| .pi domA codA =>
|
||||
-- (3) Full CCHM Π rule — no specialisation here. The behaviour
|
||||
-- at constant-domain vs. varying-domain is absorbed into the
|
||||
-- later reduction of `vApp` on `vTranspFun`, which calls
|
||||
-- `vTranspInv` on `domA` (identity when `domA` is constant).
|
||||
| .pi _ domA codA =>
|
||||
-- (3) Full CCHM Π rule.
|
||||
.vTranspFun i domA codA φ v
|
||||
| _ =>
|
||||
-- (4) non-pi stuck (e.g. path with varying endpoints).
|
||||
|
|
@ -64,14 +50,8 @@ partial def vTransp (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) :
|
|||
|
||||
/-- **Inverse transport** along the line `(i, A)`: transport `v : A(1)` back
|
||||
to `A(0)`. Implemented as forward transport along the *reversed* line
|
||||
`A[i := inv i]`.
|
||||
|
||||
Line reversal properties at the endpoints:
|
||||
`A[i := inv i] at 0` = `A at (inv 0)` = `A at 1`
|
||||
`A[i := inv i] at 1` = `A at (inv 1)` = `A at 0`
|
||||
So forward transport along the reversed line takes `A(1) ↦ A(0)`,
|
||||
which is exactly the inverse of forward transport along `A`. -/
|
||||
def vTranspInv (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) : CVal :=
|
||||
`A[i := inv i]`. -/
|
||||
def vTranspInv {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal) : CVal :=
|
||||
vTransp i (A.substDimExpr i (.inv (.var i))) φ v
|
||||
|
||||
/-!
|
||||
|
|
@ -82,72 +62,69 @@ One axiom per reducing match arm of `vTransp`. The arms are disjoint
|
|||
-/
|
||||
|
||||
/-- (1) Reduction under a full face: transport is identity. -/
|
||||
axiom vTransp_top (i : DimVar) (A : CType) (v : CVal) :
|
||||
axiom vTransp_top {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (v : CVal) :
|
||||
vTransp i A .top v = v
|
||||
|
||||
/-- (2) Reduction under a constant line. -/
|
||||
axiom vTransp_const (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal)
|
||||
axiom vTransp_const {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal)
|
||||
(h : CType.dimAbsent i A = true) :
|
||||
vTransp i A φ v = v
|
||||
|
||||
/-- (3) Π case (full CCHM rule): produces a transported-function closure
|
||||
that stores both domain and codomain. Preconditions:
|
||||
that stores both domain and codomain. The pi's binder name is
|
||||
discarded (vApp uses the transport binder `i`). Preconditions:
|
||||
· `φ ≠ .top` — else (1) fires,
|
||||
· `CType.dimAbsent i (.pi domA codA) = false` — else (2) fires.
|
||||
When `dimAbsent i domA = true`, the inverse transport inside the
|
||||
later `vApp` reduction degenerates to identity by `vTranspInv_const`
|
||||
below, recovering the const-domain specialisation. -/
|
||||
axiom vTransp_pi
|
||||
(i : DimVar) (domA codA : CType) (φ : FaceFormula) (v : CVal)
|
||||
· `CType.dimAbsent i (.pi var domA codA) = false` — else (2) fires. -/
|
||||
axiom vTransp_pi {ℓ ℓ' : ULevel}
|
||||
(i : DimVar) (var : String) (domA : CType ℓ) (codA : CType ℓ')
|
||||
(φ : FaceFormula) (v : CVal)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i (.pi domA codA) = false) :
|
||||
vTransp i (.pi domA codA) φ v = .vTranspFun i domA codA φ v
|
||||
(hA : CType.dimAbsent i (.pi var domA codA) = false) :
|
||||
vTransp i (.pi var domA codA) φ v = .vTranspFun i domA codA φ v
|
||||
|
||||
/-- (4) Stuck: not face-top, not constant, and not a `.pi`. The third
|
||||
precondition rules out arm (3). -/
|
||||
axiom vTransp_stuck (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal)
|
||||
/-- (4) Stuck: not face-top, not constant, and not a `.pi`.
|
||||
|
||||
The "not a pi" precondition is formulated via `CType.skeleton`
|
||||
(the level-erased constructor tag) rather than HEq. This
|
||||
avoids cross-level HEq elimination (which requires K and is
|
||||
not available in Lean 4) and is decidable / discharge-able
|
||||
by structural pattern matching at every call site. -/
|
||||
axiom vTransp_stuck {ℓ : ULevel}
|
||||
(i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i A = false)
|
||||
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA) :
|
||||
(h_not_pi : A.skeleton ≠ SkeletalCType.pi) :
|
||||
vTransp i A φ v = .vneu (.ntransp i A φ v)
|
||||
|
||||
-- ── vTranspInv on constant domain ────────────────────────────────────────────
|
||||
|
||||
/-- Inverse transport along a line whose body is absent from `i` is the
|
||||
identity. Proof: the reversed line `A[i := inv i] = A` when `i ∉ A`
|
||||
(by `CType.substDimExpr_of_absent`), so the outer `vTransp` call has a
|
||||
constant line and reduces via T2 to `v`. This lemma is what makes the
|
||||
unified `vTranspFun` constructor degenerate correctly when the domain
|
||||
is constant. -/
|
||||
theorem vTranspInv_const (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal)
|
||||
identity. -/
|
||||
theorem vTranspInv_const {ℓ : ULevel}
|
||||
(i : DimVar) (A : CType ℓ) (φ : FaceFormula) (v : CVal)
|
||||
(h : CType.dimAbsent i A = true) :
|
||||
vTranspInv i A φ v = v := by
|
||||
-- `vTranspInv` unfolds to `vTransp i (A[i := inv i]) φ v`.
|
||||
unfold vTranspInv
|
||||
-- Line reversal is a no-op on constant-in-`i` types.
|
||||
rw [CType.substDimExpr_of_absent i _ A h]
|
||||
-- T2 on the (unchanged) constant line.
|
||||
exact vTransp_const i A φ v h
|
||||
|
||||
/-- Inverse transport under a full face is identity — direct consequence of
|
||||
T1 composed with reversal. -/
|
||||
theorem vTranspInv_top (i : DimVar) (A : CType) (v : CVal) :
|
||||
/-- Inverse transport under a full face is identity. -/
|
||||
theorem vTranspInv_top {ℓ : ULevel} (i : DimVar) (A : CType ℓ) (v : CVal) :
|
||||
vTranspInv i A .top v = v := by
|
||||
unfold vTranspInv
|
||||
exact vTransp_top i _ v
|
||||
|
||||
-- ── Convenience wrappers ──────────────────────────────────────────────────────
|
||||
|
||||
/-- Transport along a `DimLine` with an already-evaluated argument. Unpacks
|
||||
the line's binder and body and dispatches through `vTransp`. -/
|
||||
def vTranspLine (L : DimLine) (φ : FaceFormula) (v : CVal) : CVal :=
|
||||
/-- Transport along a `DimLine` with an already-evaluated argument. -/
|
||||
def vTranspLine {ℓ : ULevel} (L : DimLine ℓ) (φ : FaceFormula) (v : CVal) : CVal :=
|
||||
vTransp L.binder L.body φ v
|
||||
|
||||
@[simp] theorem vTranspLine_top (L : DimLine) (v : CVal) :
|
||||
@[simp] theorem vTranspLine_top {ℓ : ULevel} (L : DimLine ℓ) (v : CVal) :
|
||||
vTranspLine L .top v = v := by
|
||||
simp [vTranspLine, vTransp_top]
|
||||
|
||||
theorem vTranspLine_const (L : DimLine) (φ : FaceFormula) (v : CVal)
|
||||
theorem vTranspLine_const {ℓ : ULevel} (L : DimLine ℓ) (φ : FaceFormula) (v : CVal)
|
||||
(h : CType.dimAbsent L.binder L.body = true) :
|
||||
vTranspLine L φ v = v := by
|
||||
simp [vTranspLine, vTransp_const _ _ _ _ h]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.TransportLaws
|
||||
CubicalTransport.TransportLaws
|
||||
=============================
|
||||
Residual step-level axioms for transport: subject reduction (T3) and
|
||||
path-line shape preservation (T4).
|
||||
|
|
@ -38,7 +38,8 @@ import CubicalTransport.ValueTyping
|
|||
`HasType.transp` places `.transp L.binder L.body φ t` at `L.at1`
|
||||
given `t : L.at0`, and `step_preserves_type` propagates that through
|
||||
step. -/
|
||||
theorem transp_step_preserves (Γ : Ctx) (L : DimLine) (φ : FaceFormula) (t : CTerm)
|
||||
theorem transp_step_preserves {ℓ : ULevel}
|
||||
(Γ : Ctx) (L : DimLine ℓ) (φ : FaceFormula) (t : CTerm)
|
||||
(ht : HasType Γ t L.at0) :
|
||||
HasType Γ (CTerm.step (.transp L.binder L.body φ t)) L.at1 :=
|
||||
CTerm.step_preserves_type Γ _ _ (HasType.transp L ht)
|
||||
|
|
@ -46,13 +47,13 @@ theorem transp_step_preserves (Γ : Ctx) (L : DimLine) (φ : FaceFormula) (t : C
|
|||
-- ── Path endpoint typing ──────────────────────────────────────────────────────
|
||||
|
||||
/-- Applying a path at 0 gives a term of the path's type. -/
|
||||
theorem path_zero_typed (Γ : Ctx) (p : CTerm) (A : CType) (a b : CTerm)
|
||||
theorem path_zero_typed {ℓ : ULevel} (Γ : Ctx) (p : CTerm) (A : CType ℓ) (a b : CTerm)
|
||||
(hp : HasType Γ p (.path A a b)) :
|
||||
HasType Γ (.papp p .zero) A :=
|
||||
HasType.papp hp
|
||||
|
||||
/-- Applying a path at 1 gives a term of the path's type. -/
|
||||
theorem path_one_typed (Γ : Ctx) (p : CTerm) (A : CType) (a b : CTerm)
|
||||
theorem path_one_typed {ℓ : ULevel} (Γ : Ctx) (p : CTerm) (A : CType ℓ) (a b : CTerm)
|
||||
(hp : HasType Γ p (.path A a b)) :
|
||||
HasType Γ (.papp p .one) A :=
|
||||
HasType.papp hp
|
||||
|
|
@ -82,8 +83,8 @@ theorem path_one_typed (Γ : Ctx) (p : CTerm) (A : CType) (a b : CTerm)
|
|||
/-- Axiom T4 (path-restricted, constructive):
|
||||
Transport of `⟨j⟩ body` along a line whose body is a path type
|
||||
`path A a b` produces `⟨j⟩` of a CCHM-shaped comp witness. -/
|
||||
axiom transp_plam_is_plam_path
|
||||
(i : DimVar) (A : CType) (a b : CTerm)
|
||||
axiom transp_plam_is_plam_path {ℓ : ULevel}
|
||||
(i : DimVar) (A : CType ℓ) (a b : CTerm)
|
||||
(φ : FaceFormula) (j : DimVar) (body : CTerm) :
|
||||
CTerm.step (.transp i (.path A a b) φ (.plam j body)) =
|
||||
.plam j (.compN i A [(φ, body), (.eq0 j, a), (.eq1 j, b)] body)
|
||||
|
|
@ -91,8 +92,8 @@ axiom transp_plam_is_plam_path
|
|||
-- ── Derived helpers ──────────────────────────────────────────────────────────
|
||||
|
||||
/-- The explicit step-reduced body of a path-line-transported plam. -/
|
||||
def transp_plam_body_path
|
||||
(i : DimVar) (A : CType) (a b : CTerm)
|
||||
def transp_plam_body_path {ℓ : ULevel}
|
||||
(i : DimVar) (A : CType ℓ) (a b : CTerm)
|
||||
(φ : FaceFormula) (j : DimVar) (body : CTerm) : CTerm :=
|
||||
.compN i A [(φ, body), (.eq0 j, a), (.eq1 j, b)] body
|
||||
|
||||
|
|
@ -112,33 +113,35 @@ def transp_plam_body_path
|
|||
`.ind S params` reduces to a stuck `ntransp` neutral. Derived from
|
||||
`eval_transp_nonpath` (`.ind` is not `.path` and not `.glue`) and
|
||||
`vTransp_stuck` (`.ind` is not `.pi`). -/
|
||||
theorem eval_transp_ind (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List CType) (φ : FaceFormula) (t : CTerm)
|
||||
theorem eval_transp_ind {ℓ : ULevel} (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ'))
|
||||
(φ : FaceFormula) (t : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i (.ind S params) = false) :
|
||||
eval env (.transp i (.ind S params) φ t) =
|
||||
.vneu (.ntransp i (.ind S params) φ (eval env t)) := by
|
||||
rw [eval_transp_nonpath env i (.ind S params) φ t hφ hA
|
||||
(hA : CType.dimAbsent i (CType.ind (ℓ := ℓ) S params) = false) :
|
||||
eval env (.transp i (CType.ind (ℓ := ℓ) S params) φ t) =
|
||||
.vneu (.ntransp i (CType.ind (ℓ := ℓ) S params) φ (eval env t)) := by
|
||||
rw [eval_transp_nonpath env i (CType.ind (ℓ := ℓ) S params) φ t hφ hA
|
||||
(by intro _ _ _ h; nomatch h)
|
||||
(by intro _ _ _ _ _ _ _ _ h; nomatch h)]
|
||||
exact vTransp_stuck i (.ind S params) φ (eval env t) hφ hA
|
||||
(by intro _ _ h; nomatch h)
|
||||
exact vTransp_stuck i (CType.ind (ℓ := ℓ) S params) φ (eval env t) hφ hA
|
||||
(CType.ind_skeleton_ne_pi S params)
|
||||
|
||||
/-- Transport over a constant `.ind` line is the identity (T2 specialised
|
||||
to `.ind`). Direct corollary of `eval_transp_const`. -/
|
||||
theorem eval_transp_ind_const (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List CType) (φ : FaceFormula) (t : CTerm)
|
||||
theorem eval_transp_ind_const {ℓ : ULevel} (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ'))
|
||||
(φ : FaceFormula) (t : CTerm)
|
||||
(hφ : φ ≠ .top)
|
||||
(hA : CType.dimAbsent i (.ind S params) = true) :
|
||||
eval env (.transp i (.ind S params) φ t) = eval env t :=
|
||||
eval_transp_const env i (.ind S params) φ t hφ hA
|
||||
(hA : CType.dimAbsent i (CType.ind (ℓ := ℓ) S params) = true) :
|
||||
eval env (.transp i (CType.ind (ℓ := ℓ) S params) φ t) = eval env t :=
|
||||
eval_transp_const env i (CType.ind (ℓ := ℓ) S params) φ t hφ hA
|
||||
|
||||
/-- Transport over `.ind` under a full face is the identity (T1
|
||||
specialised to `.ind`). -/
|
||||
theorem eval_transp_ind_top (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List CType) (t : CTerm) :
|
||||
eval env (.transp i (.ind S params) .top t) = eval env t :=
|
||||
eval_transp_top env i (.ind S params) t
|
||||
theorem eval_transp_ind_top {ℓ : ULevel} (env : CEnv) (i : DimVar)
|
||||
(S : CTypeSchema) (params : List (Σ ℓ' : ULevel, CType ℓ')) (t : CTerm) :
|
||||
eval env (.transp i (CType.ind (ℓ := ℓ) S params) .top t) = eval env t :=
|
||||
eval_transp_top env i (CType.ind (ℓ := ℓ) S params) t
|
||||
|
||||
-- ── Transport over the cubical interval (REL2) ───────────────────────────────
|
||||
-- `.interval` carries no dim binders (`CType.dimAbsent i .interval = true`
|
||||
|
|
@ -156,8 +159,8 @@ theorem eval_transp_interval (env : CEnv) (i : DimVar)
|
|||
· exact eval_transp_const env i .interval φ t hφ rfl
|
||||
|
||||
/-- `transp_plam_is_plam_path` restated via the named body. -/
|
||||
theorem transp_plam_body_path_eq
|
||||
(i : DimVar) (A : CType) (a b : CTerm)
|
||||
theorem transp_plam_body_path_eq {ℓ : ULevel}
|
||||
(i : DimVar) (A : CType ℓ) (a b : CTerm)
|
||||
(φ : FaceFormula) (j : DimVar) (body : CTerm) :
|
||||
CTerm.step (.transp i (.path A a b) φ (.plam j body)) =
|
||||
.plam j (transp_plam_body_path i A a b φ j body) :=
|
||||
|
|
@ -172,8 +175,8 @@ theorem transp_plam_body_path_eq
|
|||
Parameterised over a DimLine `L` with an explicit `h_path : L.body =
|
||||
.path A a b` — lets the caller instantiate against concrete lines
|
||||
whether A/a/b vary in `L.binder` or not. -/
|
||||
theorem transp_plam_step_typed_path
|
||||
(Γ : Ctx) (L : DimLine) (A : CType) (a b : CTerm)
|
||||
theorem transp_plam_step_typed_path {ℓ : ULevel}
|
||||
(Γ : Ctx) (L : DimLine ℓ) (A : CType ℓ) (a b : CTerm)
|
||||
(h_path : L.body = .path A a b)
|
||||
(φ : FaceFormula) (j : DimVar) (body : CTerm)
|
||||
(ht : HasType Γ (.plam j body) L.at0) :
|
||||
|
|
|
|||
|
|
@ -1,7 +1,8 @@
|
|||
/-
|
||||
Topolei.Cubical.Typing
|
||||
CubicalTransport.Typing
|
||||
======================
|
||||
The typing judgment Γ ⊢ t : A for the cubical term language.
|
||||
The typing judgment Γ ⊢ t : A for the cubical term language,
|
||||
universe-stratified (Layer 0 §0.1 cascade).
|
||||
|
||||
Rules:
|
||||
var : membership in context
|
||||
|
|
@ -18,44 +19,64 @@
|
|||
(`readback_papp_plam`); the previous step-level path β `PathWitness`
|
||||
encoding has been removed alongside its underlying axiom.
|
||||
|
||||
Note: Π types are non-dependent here (B is a CType, not CTerm → CType).
|
||||
Dependent Π is deferred until we have a term evaluator.
|
||||
## Universe-aware shape
|
||||
|
||||
Contexts pair each binder with a `Σ ℓ : ULevel, CType ℓ` so individual
|
||||
bindings can live at any universe level. `HasType` is universe-aware
|
||||
via an implicit `{ℓ : ULevel}` parameter on the type slot — each
|
||||
judgement Γ ⊢ t : A carries the level of A as the implicit ℓ. Each
|
||||
constructor's CType references take their own level (some constructors
|
||||
bind two distinct levels for domain and codomain).
|
||||
-/
|
||||
|
||||
import CubicalTransport.DimLine
|
||||
|
||||
-- ── Context ───────────────────────────────────────────────────────────────────
|
||||
|
||||
/-- Typing context: ordered list of term-variable bindings. -/
|
||||
abbrev Ctx := List (String × CType)
|
||||
/-- A level-tagged CType bundle: pairs a CType with its universe level. -/
|
||||
abbrev CTypeAny := Σ ℓ : ULevel, CType ℓ
|
||||
|
||||
/-- Typing context: ordered list of `(name, ⟨ℓ, A⟩)` bindings. Each
|
||||
binder lives at its own universe level. -/
|
||||
abbrev Ctx := List (String × CTypeAny)
|
||||
|
||||
-- ── Typing judgment ───────────────────────────────────────────────────────────
|
||||
|
||||
/-- The typing judgment Γ ⊢ t : A. -/
|
||||
inductive HasType : Ctx → CTerm → CType → Prop where
|
||||
| var : (x, A) ∈ Γ →
|
||||
/-- The typing judgment Γ ⊢ t : A. Universe-aware: A's level lives at
|
||||
the implicit `{ℓ : ULevel}` slot. -/
|
||||
inductive HasType : Ctx → CTerm → ∀ {ℓ : ULevel}, CType ℓ → Prop where
|
||||
| var {Γ : Ctx} {x : String} {ℓ : ULevel} {A : CType ℓ} :
|
||||
(x, ⟨ℓ, A⟩) ∈ Γ →
|
||||
HasType Γ (.var x) A
|
||||
|
||||
| lam : HasType ((x, A) :: Γ) t B →
|
||||
HasType Γ (.lam x t) (.pi A B)
|
||||
| lam {Γ : Ctx} {x : String} {ℓ ℓ' : ULevel}
|
||||
{A : CType ℓ} {B : CType ℓ'} {t : CTerm} {var : String} :
|
||||
HasType ((x, ⟨ℓ, A⟩) :: Γ) t B →
|
||||
HasType Γ (.lam x t) (.pi var A B)
|
||||
|
||||
| app : HasType Γ f (.pi A B) →
|
||||
| app {Γ : Ctx} {ℓ ℓ' : ULevel}
|
||||
{A : CType ℓ} {B : CType ℓ'} {f a : CTerm} {var : String} :
|
||||
HasType Γ f (.pi var A B) →
|
||||
HasType Γ a A →
|
||||
HasType Γ (.app f a) B
|
||||
|
||||
/-- Path introduction: ⟨i⟩t has type Path A t[i:=0] t[i:=1].
|
||||
The boundaries are computed directly from substDim. -/
|
||||
| plam : HasType Γ t A →
|
||||
| plam {Γ : Ctx} {ℓ : ULevel} {A : CType ℓ} {t : CTerm} {i : DimVar} :
|
||||
HasType Γ t A →
|
||||
HasType Γ (.plam i t) (.path A (t.substDim i .zero) (t.substDim i .one))
|
||||
|
||||
/-- Path elimination: applying a path to any DimExpr gives the fibration type. -/
|
||||
| papp : HasType Γ t (.path A a b) →
|
||||
| papp {Γ : Ctx} {ℓ : ULevel} {A : CType ℓ} {t : CTerm}
|
||||
{a b : CTerm} {r : DimExpr} :
|
||||
HasType Γ t (.path A a b) →
|
||||
HasType Γ (.papp t r) A
|
||||
|
||||
/-- Transport: if t has the type at the 0-end of line L,
|
||||
then transpⁱ (λi.A) φ t has the type at the 1-end.
|
||||
L packages the binder and body; we unpack to CTerm.transp's raw form. -/
|
||||
| transp : (L : DimLine) →
|
||||
| transp {Γ : Ctx} {ℓ : ULevel} {t : CTerm} {φ : FaceFormula} :
|
||||
(L : DimLine ℓ) →
|
||||
HasType Γ t L.at0 →
|
||||
HasType Γ (.transp L.binder L.body φ t) L.at1
|
||||
|
||||
|
|
@ -74,7 +95,8 @@ inductive HasType : Ctx → CTerm → CType → Prop where
|
|||
|
||||
The face formula φ and system body u are stored raw (no System wrapper)
|
||||
to avoid a circular import; System.lean wraps these for ergonomics. -/
|
||||
| comp : (L : DimLine) →
|
||||
| comp {Γ : Ctx} {ℓ : ULevel} {t u : CTerm} {φ : FaceFormula} :
|
||||
(L : DimLine ℓ) →
|
||||
HasType Γ t L.at0 →
|
||||
HasType Γ u L.at1 →
|
||||
(∀ env : DimVar → Bool,
|
||||
|
|
@ -84,16 +106,22 @@ inductive HasType : Ctx → CTerm → CType → Prop where
|
|||
|
||||
/-- Σ introduction: pairing. Non-dependent form — `B` does not depend
|
||||
on the first component's value. -/
|
||||
| pair : HasType Γ a A →
|
||||
| pair {Γ : Ctx} {ℓ ℓ' : ULevel}
|
||||
{A : CType ℓ} {B : CType ℓ'} {a b : CTerm} {var : String} :
|
||||
HasType Γ a A →
|
||||
HasType Γ b B →
|
||||
HasType Γ (.pair a b) (.sigma A B)
|
||||
HasType Γ (.pair a b) (.sigma var A B)
|
||||
|
||||
/-- Σ elimination (first projection). -/
|
||||
| fst : HasType Γ t (.sigma A B) →
|
||||
| fst {Γ : Ctx} {ℓ ℓ' : ULevel}
|
||||
{A : CType ℓ} {B : CType ℓ'} {t : CTerm} {var : String} :
|
||||
HasType Γ t (.sigma var A B) →
|
||||
HasType Γ (.fst t) A
|
||||
|
||||
/-- Σ elimination (second projection). -/
|
||||
| snd : HasType Γ t (.sigma A B) →
|
||||
| snd {Γ : Ctx} {ℓ ℓ' : ULevel}
|
||||
{A : CType ℓ} {B : CType ℓ'} {t : CTerm} {var : String} :
|
||||
HasType Γ t (.sigma var A B) →
|
||||
HasType Γ (.snd t) B
|
||||
|
||||
/-- Schema constructor application (REL1 minimal-viable typing).
|
||||
|
|
@ -103,8 +131,13 @@ inductive HasType : Ctx → CTerm → CType → Prop where
|
|||
against `S.ctors[c].args` is enforced at runtime by `eval` and
|
||||
the boundary system, not at the typing-judgement level. REL2
|
||||
will refine this to a fully dependent rule with one premise per
|
||||
`CtorSpec.args` entry. -/
|
||||
| ctor : HasType Γ (.ctor S c params args) (.ind S params)
|
||||
`CtorSpec.args` entry.
|
||||
|
||||
Result level `ℓ` is user-specified at the type level (matching
|
||||
`CType.ind`'s explicit level annotation). -/
|
||||
| ctor {Γ : Ctx} {ℓ : ULevel} {S : CTypeSchema}
|
||||
{params : List (Σ ℓ' : ULevel, CType ℓ')} {c : String} {args : List CTerm} :
|
||||
HasType Γ (.ctor S c params args) (CType.ind (ℓ := ℓ) S params)
|
||||
|
||||
/-- Inductive eliminator (REL1 minimal-viable, *non-dependent* form).
|
||||
|
||||
|
|
@ -116,8 +149,12 @@ inductive HasType : Ctx → CTerm → CType → Prop where
|
|||
Branch-level coherence (each branch body matches its ctor's
|
||||
curried signature, including recursive-arg hypotheses for `.self`
|
||||
args) is checked at runtime by `eval`, not statically here. -/
|
||||
| indElim : HasType Γ target (.ind S params) →
|
||||
HasType Γ motive (.pi (.ind S params) C) →
|
||||
| indElim {Γ : Ctx} {ℓ ℓ' : ULevel} {S : CTypeSchema}
|
||||
{params : List (Σ ℓ'' : ULevel, CType ℓ'')}
|
||||
{motive target : CTerm} {branches : List (String × CTerm)}
|
||||
{C : CType ℓ'} {var : String} :
|
||||
HasType Γ target (CType.ind (ℓ := ℓ) S params) →
|
||||
HasType Γ motive (.pi var (CType.ind (ℓ := ℓ) S params) C) →
|
||||
HasType Γ (.indElim S params motive branches target) C
|
||||
|
||||
/-- Dimension expression lifted to the term language.
|
||||
|
|
@ -128,7 +165,7 @@ inductive HasType : Ctx → CTerm → CType → Prop where
|
|||
Path-constructor dim arguments now carry real semantic ground:
|
||||
`loop @ r`, `seg @ r`, `squash _ _ @ r`, etc. all type-check
|
||||
against the corresponding `.dim` arg position. -/
|
||||
| dimExpr : HasType Γ (.dimExpr r) .interval
|
||||
| dimExpr {Γ : Ctx} {r : DimExpr} : HasType Γ (.dimExpr r) .interval
|
||||
|
||||
-- ── Structural rules ──────────────────────────────────────────────────────────
|
||||
|
||||
|
|
@ -136,10 +173,10 @@ inductive HasType : Ctx → CTerm → CType → Prop where
|
|||
We take `Γ` as a free variable and carry `Γ = Γ₁ ++ Γ₂` as a hypothesis
|
||||
so that `induction h` works (the index must be a variable). -/
|
||||
private theorem HasType.weaken_core
|
||||
(x : String) (B : CType) (Γ₂ : Ctx)
|
||||
{Γ : Ctx} {t : CTerm} {A : CType}
|
||||
(x : String) {ℓB : ULevel} (B : CType ℓB) (Γ₂ : Ctx)
|
||||
{Γ : Ctx} {t : CTerm} {ℓ : ULevel} {A : CType ℓ}
|
||||
(h : HasType Γ t A) :
|
||||
∀ (Γ₁ : Ctx), Γ = Γ₁ ++ Γ₂ → HasType (Γ₁ ++ (x, B) :: Γ₂) t A := by
|
||||
∀ (Γ₁ : Ctx), Γ = Γ₁ ++ Γ₂ → HasType (Γ₁ ++ (x, ⟨ℓB, B⟩) :: Γ₂) t A := by
|
||||
induction h with
|
||||
| var mem =>
|
||||
intro Γ₁ hΓ; subst hΓ
|
||||
|
|
@ -183,8 +220,9 @@ private theorem HasType.weaken_core
|
|||
| dimExpr =>
|
||||
intro _ _; exact HasType.dimExpr
|
||||
|
||||
theorem HasType.weaken (x : String) (B : CType)
|
||||
(h : HasType Γ t A) : HasType ((x, B) :: Γ) t A :=
|
||||
theorem HasType.weaken (x : String) {ℓB : ULevel} (B : CType ℓB)
|
||||
{Γ : Ctx} {t : CTerm} {ℓ : ULevel} {A : CType ℓ}
|
||||
(h : HasType Γ t A) : HasType ((x, ⟨ℓB, B⟩) :: Γ) t A :=
|
||||
HasType.weaken_core x B Γ h [] rfl
|
||||
|
||||
-- ── Face lattice connection ───────────────────────────────────────────────────
|
||||
|
|
@ -209,7 +247,7 @@ end FaceFormula
|
|||
/-- Inversion for plam: if ⟨i⟩t : Path A a b, then t : A and
|
||||
the boundaries are exactly the substDim images. -/
|
||||
theorem HasType.plam_inv
|
||||
(Γ : Ctx) (i : DimVar) (t : CTerm) (A : CType) (a b : CTerm)
|
||||
(Γ : Ctx) (i : DimVar) (t : CTerm) {ℓ : ULevel} (A : CType ℓ) (a b : CTerm)
|
||||
(h : HasType Γ (.plam i t) (.path A a b)) :
|
||||
HasType Γ t A ∧
|
||||
a = t.substDim i .zero ∧
|
||||
|
|
@ -219,7 +257,7 @@ theorem HasType.plam_inv
|
|||
|
||||
/-- Inversion for papp: if t @ r : A, then t : Path A a b for some a b. -/
|
||||
theorem HasType.papp_inv
|
||||
(Γ : Ctx) (t : CTerm) (r : DimExpr) (A : CType)
|
||||
(Γ : Ctx) (t : CTerm) (r : DimExpr) {ℓ : ULevel} (A : CType ℓ)
|
||||
(h : HasType Γ (.papp t r) A) :
|
||||
∃ a b, HasType Γ t (.path A a b) := by
|
||||
cases h with
|
||||
|
|
@ -229,9 +267,10 @@ theorem HasType.papp_inv
|
|||
We return an existential DimLine to avoid the naming clash between the
|
||||
outer parameter and the constructor's internal binder. -/
|
||||
theorem HasType.comp_inv
|
||||
(Γ : Ctx) (i : DimVar) (bodyA : CType) (φ : FaceFormula) (u t : CTerm) (A : CType)
|
||||
(Γ : Ctx) (i : DimVar) {ℓ : ULevel} (bodyA : CType ℓ) (φ : FaceFormula)
|
||||
(u t : CTerm) (A : CType ℓ)
|
||||
(h : HasType Γ (.comp i bodyA φ u t) A) :
|
||||
∃ L : DimLine, L.binder = i ∧ L.body = bodyA ∧
|
||||
∃ L : DimLine ℓ, L.binder = i ∧ L.body = bodyA ∧
|
||||
A = L.at1 ∧
|
||||
HasType Γ t L.at0 ∧
|
||||
HasType Γ u L.at1 ∧
|
||||
|
|
@ -243,9 +282,10 @@ theorem HasType.comp_inv
|
|||
|
||||
/-- Inversion for transp: the output type is exactly L.at1. -/
|
||||
theorem HasType.transp_inv
|
||||
(Γ : Ctx) (i : DimVar) (bodyA : CType) (φ : FaceFormula) (t : CTerm) (A : CType)
|
||||
(Γ : Ctx) (i : DimVar) {ℓ : ULevel} (bodyA : CType ℓ) (φ : FaceFormula)
|
||||
(t : CTerm) (A : CType ℓ)
|
||||
(h : HasType Γ (.transp i bodyA φ t) A) :
|
||||
∃ L : DimLine, L.binder = i ∧ L.body = bodyA ∧
|
||||
∃ L : DimLine ℓ, L.binder = i ∧ L.body = bodyA ∧
|
||||
A = L.at1 ∧ HasType Γ t L.at0 := by
|
||||
cases h with
|
||||
| transp L ht => exact ⟨L, rfl, rfl, rfl, ht⟩
|
||||
|
|
|
|||
127
CubicalTransport/Universe.lean
Normal file
127
CubicalTransport/Universe.lean
Normal file
|
|
@ -0,0 +1,127 @@
|
|||
/-
|
||||
CubicalTransport.Universe
|
||||
=========================
|
||||
Universe stratification for the cubical type theory
|
||||
(THEORY.md Layer 0 §0.1).
|
||||
|
||||
`ULevel` is the Nat-like inductive of universe levels. It indexes
|
||||
`CType` (see `Syntax.lean`):
|
||||
|
||||
CType : ULevel → Type
|
||||
|
||||
The cubical interval `.interval` lives at the bottom universe
|
||||
`.zero`. The universe classifier `.univ` at level ℓ lives at
|
||||
`CType (ℓ.succ)` — Russell paradox avoidance for the subobject
|
||||
classifier `Ω` (see `Omega.lean`) follows from this stratification:
|
||||
`Ω` quantifies over propositions in `CType ℓ` and therefore lives
|
||||
one level above.
|
||||
|
||||
Cumulativity (the embedding `CType ℓ → CType ℓ.succ`) is the
|
||||
`.lift` constructor of `CType` (see `Syntax.lean`); it is data-
|
||||
preserving on the underlying CType but bumps the index.
|
||||
|
||||
The level arithmetic in this file is purely combinatorial — `max`
|
||||
is pointwise (used to combine pi/sigma component levels), `succ`
|
||||
is the universe step. All theorems are discharged here without
|
||||
dependence on downstream Layer 0 modules.
|
||||
-/
|
||||
|
||||
-- ── Universe levels ──────────────────────────────────────────────────────────
|
||||
|
||||
/-- Universe levels for the cubical type theory. Nat-like inductive.
|
||||
|
||||
`zero` is the bottom universe. `succ ℓ` is the level above ℓ.
|
||||
|
||||
Distinct from Lean's `Nat` so universe-level arithmetic is a
|
||||
typed object in its own right (per THEORY.md §0.1's
|
||||
"universe-level naturals as a typed object" requirement). -/
|
||||
inductive ULevel where
|
||||
| zero : ULevel
|
||||
| succ : ULevel → ULevel
|
||||
deriving Repr, DecidableEq, Inhabited
|
||||
|
||||
namespace ULevel
|
||||
|
||||
-- ── Pointwise maximum ──────────────────────────────────────────────────────
|
||||
|
||||
/-- Pointwise maximum on universe levels. Used to combine the
|
||||
levels of `pi`, `sigma`, etc. — a function-type whose domain
|
||||
sits at level ℓ and codomain at ℓ' lives at `max ℓ ℓ'`. -/
|
||||
def max : ULevel → ULevel → ULevel
|
||||
| zero, n => n
|
||||
| n, zero => n
|
||||
| succ m, succ n => succ (max m n)
|
||||
|
||||
-- ── Algebraic laws of max ──────────────────────────────────────────────────
|
||||
|
||||
@[simp] theorem max_zero_left (n : ULevel) : max .zero n = n := rfl
|
||||
|
||||
@[simp] theorem max_zero_right (n : ULevel) : max n .zero = n := by
|
||||
cases n <;> rfl
|
||||
|
||||
@[simp] theorem max_self (n : ULevel) : max n n = n := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ m ih => show succ (max m m) = succ m; rw [ih]
|
||||
|
||||
theorem max_comm (m n : ULevel) : max m n = max n m := by
|
||||
induction m generalizing n with
|
||||
| zero =>
|
||||
cases n <;> rfl
|
||||
| succ m ih =>
|
||||
cases n with
|
||||
| zero => rfl
|
||||
| succ n => show succ (max m n) = succ (max n m); rw [ih n]
|
||||
|
||||
theorem max_assoc (m n k : ULevel) :
|
||||
max (max m n) k = max m (max n k) := by
|
||||
induction m generalizing n k with
|
||||
| zero =>
|
||||
-- max (max zero n) k = max n k = max zero (max n k)
|
||||
rfl
|
||||
| succ m ih =>
|
||||
cases n with
|
||||
| zero =>
|
||||
-- max (max (succ m) zero) k = max (succ m) k = max (succ m) (max zero k)
|
||||
show max (succ m) k = max (succ m) (max .zero k); rfl
|
||||
| succ n =>
|
||||
cases k with
|
||||
| zero =>
|
||||
-- max (max (succ m) (succ n)) zero = max (succ m) (succ n)
|
||||
-- max (succ m) (max (succ n) zero) = max (succ m) (succ n)
|
||||
rfl
|
||||
| succ k =>
|
||||
-- LHS: max (succ (max m n)) (succ k) = succ (max (max m n) k)
|
||||
-- RHS: max (succ m) (succ (max n k)) = succ (max m (max n k))
|
||||
-- Equal by ih.
|
||||
show succ (max (max m n) k) = succ (max m (max n k))
|
||||
rw [ih n k]
|
||||
|
||||
-- ── Successor arithmetic ───────────────────────────────────────────────────
|
||||
|
||||
@[simp] theorem max_succ_succ (m n : ULevel) :
|
||||
max (succ m) (succ n) = succ (max m n) := rfl
|
||||
|
||||
theorem max_succ_self_left (n : ULevel) : max (succ n) n = succ n := by
|
||||
induction n with
|
||||
| zero => rfl
|
||||
| succ k ih =>
|
||||
show succ (max (succ k) k) = succ (succ k)
|
||||
rw [ih]
|
||||
|
||||
theorem max_succ_self_right (n : ULevel) : max n (succ n) = succ n := by
|
||||
rw [max_comm]; exact max_succ_self_left n
|
||||
|
||||
-- ── Nat conversion (convenience for OfNat literals) ────────────────────────
|
||||
|
||||
/-- Convert a `Nat` to a `ULevel`: `ofNat n = succ^n .zero`. -/
|
||||
def ofNat : Nat → ULevel
|
||||
| 0 => zero
|
||||
| n + 1 => succ (ofNat n)
|
||||
|
||||
@[simp] theorem ofNat_zero : ofNat 0 = .zero := rfl
|
||||
@[simp] theorem ofNat_succ (n : Nat) : ofNat (n + 1) = .succ (ofNat n) := rfl
|
||||
|
||||
instance (n : Nat) : OfNat ULevel n := ⟨ofNat n⟩
|
||||
|
||||
end ULevel
|
||||
|
|
@ -1,24 +1,32 @@
|
|||
/-
|
||||
Topolei.Cubical.Value
|
||||
=====================
|
||||
Weak-head normal forms for the cubical calculus (cells-spec §5.4, Phase 1
|
||||
Week 2).
|
||||
CubicalTransport.Value
|
||||
======================
|
||||
Weak-head normal forms for the universe-stratified cubical calculus
|
||||
(cells-spec §5.4, Layer 0 §0.1 cascade).
|
||||
|
||||
Named-variable adaptation: our `CTerm` uses `String` binders rather than
|
||||
de Bruijn indices, so `Env` is a name-keyed association list instead of an
|
||||
`Array`. The three inductives (`Env`, `CVal`, `CNeu`) are mutually
|
||||
recursive: `CVal` contains closures (which capture their `Env`), `CNeu`
|
||||
(stuck terms) carries already-evaluated sub-values, and `Env` stores `CVal`s.
|
||||
de Bruijn indices, so `Env` is a name-keyed association list instead of
|
||||
an `Array`. The three inductives (`CEnv`, `CVal`, `CNeu`) are mutually
|
||||
recursive: `CVal` contains closures (which capture their `CEnv`), `CNeu`
|
||||
(stuck terms) carries already-evaluated sub-values, and `CEnv` stores
|
||||
`CVal`s.
|
||||
|
||||
## Universe-aware shape
|
||||
|
||||
CVal and CNeu constructors that carry a `CType` payload carry it at an
|
||||
implicit `{ℓ : ULevel}` parameter — mirroring the corresponding CTerm
|
||||
constructors in `Syntax.lean`. At the value level the level is
|
||||
existentially packaged (forgotten by the constructor); the kernel-side
|
||||
level discipline lives on CType, not on CVal.
|
||||
|
||||
Where a constructor stores TWO CTypes that must live at related levels
|
||||
(e.g. domain at ℓ and codomain at ℓ'), both levels are bound implicitly.
|
||||
|
||||
Coverage matches the cells-spec's "λ-calculus fragment" milestone:
|
||||
· function abstractions and applications (`vlam`/`napp`)
|
||||
· dimension abstractions and applications (`vplam`/`npapp`)
|
||||
· transport and composition as *stuck* values (`ntransp`/`ncomp`) —
|
||||
actual reduction rules arrive in Weeks 3–4 (`Transport.lean`/`Comp.lean`).
|
||||
|
||||
No type-level values yet: `CType` remains syntactic because types are not
|
||||
evaluated in the λ-fragment. When we add the Π/Σ cases of transport the
|
||||
evaluator will grow a companion `evalType` returning a `VType`.
|
||||
reduction rules in `Transport.lean`/`Comp.lean`.
|
||||
-/
|
||||
|
||||
import CubicalTransport.Syntax
|
||||
|
|
@ -39,105 +47,40 @@ mutual
|
|||
| vplam : CEnv → DimVar → CTerm → CVal
|
||||
/-- Embedded neutral term — a stuck computation. -/
|
||||
| vneu : CNeu → CVal
|
||||
/-- A *transported function value*: the result of
|
||||
`transp^i (pi domA codA) φ f` — the full CCHM Π rule, supporting
|
||||
both varying domain and varying codomain. Stores `i`, the domain
|
||||
type, the codomain type, the face formula, and the underlying
|
||||
function value `f`.
|
||||
/-- A *transported function value*: result of `transp^i (pi domA codA) φ f`.
|
||||
|
||||
When applied to an argument `y : A(1)`, it reduces per the CCHM
|
||||
Π rule:
|
||||
`vApp (.vTranspFun i domA codA φ f) y =`
|
||||
` vTransp i codA φ (vApp f (vTranspInv i domA φ y))`
|
||||
That is:
|
||||
1. Inversely transport `y` through `domA` to get `y' : A(0)`.
|
||||
2. Apply `f` to `y'` to get a value in `B(0)`.
|
||||
3. Forward-transport the result through `codA` to land in `B(1)`.
|
||||
|
||||
When `domA` is absent from `i`, step 1 reduces to identity (via
|
||||
`vTranspInv_const`), recovering the earlier const-domain form. -/
|
||||
| vTranspFun : DimVar → CType → CType → FaceFormula → CVal → CVal
|
||||
/-- A *composed function value*: the result of
|
||||
`hcomp (pi domA codA) φ tube base`. Homogeneous composition on a
|
||||
Π type reduces pointwise: applied to `y : A`, it returns
|
||||
`hcomp codA φ (λj. (tube@j) y) (base y)`. Stores only `codA`
|
||||
(there is no inverse transport through `domA` in homogeneous
|
||||
composition, so `domA` plays no role in the reduction), the face
|
||||
formula, the tube, and the base function. -/
|
||||
| vHCompFun : CType → FaceFormula → CVal → CVal → CVal
|
||||
/-- A *point-wise applied tube*: represents `λj. (tube @ j) arg` as
|
||||
a dim-abstraction value. Produced by `vApp` on `vHCompFun` when
|
||||
the outer hcomp's tube needs to be threaded into the inner hcomp
|
||||
on the codomain. Reduces under `vPApp r` to
|
||||
`vApp (vPApp tube r) arg`. -/
|
||||
Domain at level `ℓ`, codomain at level `ℓ'`; the result type
|
||||
lives at `ULevel.max ℓ ℓ'` (CCHM Π rule). Levels are
|
||||
existentially packaged at the value level. -/
|
||||
| vTranspFun {ℓ ℓ' : ULevel} :
|
||||
DimVar → CType ℓ → CType ℓ' → FaceFormula → CVal → CVal
|
||||
/-- A *composed function value*: result of `hcomp (pi domA codA) φ tube base`.
|
||||
Stores only `codA` (homogeneous comp on the domain is trivial
|
||||
since A is fixed). -/
|
||||
| vHCompFun {ℓ : ULevel} :
|
||||
CType ℓ → FaceFormula → CVal → CVal → CVal
|
||||
/-- A *point-wise applied tube*: represents `λj. (tube @ j) arg`. -/
|
||||
| vTubeApp : CVal → CVal → CVal
|
||||
/-- A *heterogeneous-composition function value*: the result of
|
||||
`comp^i (Π domA codA) φ u u₀` at the value level. Stores env,
|
||||
line binder `i`, both CType halves, face, and tube `u` + base
|
||||
`u₀` as CTerms (so the CCHM reduction can construct term-level
|
||||
comp/transport expressions referencing them).
|
||||
|
||||
Applied to `y : A(1)`, it reduces per CCHM Π hetero comp:
|
||||
1. Construct the *fill* `y_at_j : A(j)` — a partial transport
|
||||
of `y` backwards along the A-line.
|
||||
2. Inner tube: `(u @ i) (y_at_i)` — apply u's tube pointwise.
|
||||
3. Inner base: `u₀ (y_at_0)` — apply base to the "inverse-transport"
|
||||
endpoint of the fill.
|
||||
4. Build a new `comp^i codA φ <inner tube> <inner base>` and
|
||||
evaluate.
|
||||
|
||||
When `domA` is absent from `i`, the fill degenerates (constant
|
||||
line ⇒ identity transport), so `y_at_i = y_at_0 = y` and the
|
||||
reduction specialises to the simpler const-domain form. -/
|
||||
| vCompFun : CEnv → DimVar → CType → CType → FaceFormula →
|
||||
CTerm → CTerm → CVal
|
||||
/-- A *path-transport value*: the result of
|
||||
`transp^i (Path A(i) a(i) b(i)) φ p` at the value level.
|
||||
|
||||
Stores the environment where `a`, `b`, `p` were meaningful, the
|
||||
line binder `i`, the path's base type `A` (may vary in `i`), the
|
||||
left/right endpoint CTerms, the face formula, and the path term
|
||||
`p` as a CTerm (so a later `.papp p r` term can be constructed
|
||||
for the CCHM multi-clause reduction).
|
||||
|
||||
Reductions on `vPApp`:
|
||||
· At `.zero` → `eval env (a.substDim i .one)` (= a(1)).
|
||||
· At `.one` → `eval env (b.substDim i .one)` (= b(1)).
|
||||
· At generic `r` → evaluate the CCHM compN term
|
||||
`comp^i A [φ ↦ p@r, (r=0) ↦ a, (r=1) ↦ b] (p@r)` via
|
||||
`vCompNAtTerm`. This genuinely unsticks: when `r` has a
|
||||
resolved endpoint, the corresponding clause fires. -/
|
||||
| vPathTransp : CEnv → DimVar → CType → CTerm → CTerm → FaceFormula →
|
||||
CTerm → CVal
|
||||
/-- A Σ pair value: both components already evaluated. `vFst` and
|
||||
`vSnd` (defined in `Eval.lean`) project out the components; on a
|
||||
`vpair` they reduce component-wise, on a `vneu` they produce a
|
||||
stuck `.nfst`/`.nsnd` neutral. -/
|
||||
/-- A *heterogeneous-composition function value*: result of
|
||||
`comp^i (Π domA codA) φ u u₀` at the value level. -/
|
||||
| vCompFun {ℓ ℓ' : ULevel} :
|
||||
CEnv → DimVar → CType ℓ → CType ℓ' → FaceFormula →
|
||||
CTerm → CTerm → CVal
|
||||
/-- A *path-transport value*: result of `transp^i (Path A(i) a(i) b(i)) φ p`. -/
|
||||
| vPathTransp {ℓ : ULevel} :
|
||||
CEnv → DimVar → CType ℓ → CTerm → CTerm → FaceFormula →
|
||||
CTerm → CVal
|
||||
/-- A Σ pair value. -/
|
||||
| vpair : CVal → CVal → CVal
|
||||
/-- Schema constructor application — fully-evaluated, canonical
|
||||
constructor of an inductive (or higher-inductive) type (REL1).
|
||||
|
||||
`vctor S c params args` carries:
|
||||
- `S : CTypeSchema` — the schema this constructor belongs to.
|
||||
- `c : String` — the constructor's name.
|
||||
- `params : List CType` — the type parameters at which the
|
||||
inductive was instantiated.
|
||||
- `args : List CVal` — already-evaluated argument values.
|
||||
|
||||
For path constructors, when a `.dim`-typed arg lands on a face
|
||||
in the constructor's boundary system, eval fires the boundary
|
||||
clause and never produces a `vctor` — so a `vctor` represents
|
||||
a value that is *not* on a boundary face. -/
|
||||
| vctor : CTypeSchema → String → List CType → List CVal → CVal
|
||||
/-- Lifted dimension-expression value (REL1). Produced by
|
||||
`eval env (.dimExpr r)`; consumed by path-constructor face
|
||||
dispatch and by `vPApp` when its left operand is a `vplam`
|
||||
whose argument is a `.dimExpr`. -/
|
||||
`params` is level-heterogeneous: each entry carries its own ULevel. -/
|
||||
| vctor : CTypeSchema → String →
|
||||
List (Σ ℓ : ULevel, CType ℓ) → List CVal → CVal
|
||||
/-- Lifted dimension-expression value (REL1). -/
|
||||
| vdimExpr : DimExpr → CVal
|
||||
|
||||
/-- Neutral (stuck) terms. Each constructor corresponds to a
|
||||
λ-calculus or cubical elimination whose principal argument is itself
|
||||
neutral, so the elimination cannot proceed. -/
|
||||
/-- Neutral (stuck) terms. -/
|
||||
inductive CNeu : Type where
|
||||
/-- A free variable (name not bound in the current environment). -/
|
||||
| nvar : String → CNeu
|
||||
|
|
@ -145,47 +88,31 @@ mutual
|
|||
| napp : CNeu → CVal → CNeu
|
||||
/-- Stuck dimension application. -/
|
||||
| npapp : CNeu → DimExpr → CNeu
|
||||
/-- Transport with an already-evaluated argument. The `CType` and
|
||||
`FaceFormula` are kept syntactic for now; a later pass will evaluate
|
||||
them and destructure per type-former. -/
|
||||
| ntransp : DimVar → CType → FaceFormula → CVal → CNeu
|
||||
/-- Transport with an already-evaluated argument. CType at any level. -/
|
||||
| ntransp {ℓ : ULevel} :
|
||||
DimVar → CType ℓ → FaceFormula → CVal → CNeu
|
||||
/-- Heterogeneous composition (varying line) with already-evaluated
|
||||
system body and base. Used for `.comp` terms whose type varies
|
||||
along the dimension and whose reduction hasn't been pinned by
|
||||
one of the special-case rules (`.top`, `.bot`, constant line). -/
|
||||
| ncomp : DimVar → CType → FaceFormula → CVal → CVal → CNeu
|
||||
system body and base. -/
|
||||
| ncomp {ℓ : ULevel} :
|
||||
DimVar → CType ℓ → FaceFormula → CVal → CVal → CNeu
|
||||
/-- Homogeneous composition (fixed type) with already-evaluated tube
|
||||
and base. Produced by `vHCompValue` when the type isn't a `.pi`
|
||||
(Π hcomp reduces to `vHCompFun` instead of a neutral). -/
|
||||
| nhcomp : CType → FaceFormula → CVal → CVal → CNeu
|
||||
/-- A stuck multi-clause heterogeneous composition. Produced by
|
||||
`vCompNAtTerm` when none of its reducing arms apply (e.g. every
|
||||
clause's face is neither trivially satisfied nor trivially empty,
|
||||
and the line type genuinely varies). Preserves env, binder,
|
||||
line type, the evaluated clause list, and the evaluated base. -/
|
||||
| ncompN : CEnv → DimVar → CType →
|
||||
List (FaceFormula × CVal) → CVal → CNeu
|
||||
/-- A stuck glue introduction. Produced by `eval` on `.glueIn φ t a`
|
||||
when `φ` is neither `.top` (→ `t`) nor `.bot` (→ `a`). Preserves
|
||||
the face formula and both face-on / face-off evaluated sub-values
|
||||
so that later dim-substitution can unstick if the face resolves. -/
|
||||
and base. -/
|
||||
| nhcomp {ℓ : ULevel} :
|
||||
CType ℓ → FaceFormula → CVal → CVal → CNeu
|
||||
/-- A stuck multi-clause heterogeneous composition. -/
|
||||
| ncompN {ℓ : ULevel} :
|
||||
CEnv → DimVar → CType ℓ →
|
||||
List (FaceFormula × CVal) → CVal → CNeu
|
||||
/-- A stuck glue introduction. -/
|
||||
| nglueIn : FaceFormula → CVal → CVal → CNeu
|
||||
/-- A stuck unglue. Produced by `eval` on `.unglue φ f g` when `φ` is
|
||||
not `.top` (→ `vApp f g`) and `g` is not a glued value whose face
|
||||
is `.bot` (→ `g`). Preserves the face formula, the forward-map
|
||||
value `f`, and the argument value `g`. -/
|
||||
/-- A stuck unglue. -/
|
||||
| nunglue : FaceFormula → CVal → CVal → CNeu
|
||||
/-- A stuck first projection. Produced by `vFst` when its argument
|
||||
is itself a neutral (i.e. not a `vpair`). -/
|
||||
/-- A stuck first projection. -/
|
||||
| nfst : CNeu → CNeu
|
||||
/-- A stuck second projection. Produced by `vSnd` on a neutral. -/
|
||||
/-- A stuck second projection. -/
|
||||
| nsnd : CNeu → CNeu
|
||||
/-- A stuck inductive eliminator (REL1). Produced by `eval`'s
|
||||
`.indElim` arm when the target evaluates to a neutral (or a
|
||||
non-`vctor` value). Preserves the schema, parameters, motive,
|
||||
evaluated branches, and the underlying neutral target so that
|
||||
later substitution / unstucking can fire the matching branch. -/
|
||||
| nIndElim : CTypeSchema → List CType → CVal →
|
||||
/-- A stuck inductive eliminator (REL1). `params` is level-heterogeneous. -/
|
||||
| nIndElim : CTypeSchema → List (Σ ℓ : ULevel, CType ℓ) → CVal →
|
||||
List (String × CVal) → CNeu → CNeu
|
||||
end
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/-
|
||||
Topolei.Cubical.ValueTyping
|
||||
CubicalTransport.ValueTyping
|
||||
===========================
|
||||
Semantic typing on values (Stream B #2a, Stage 2.3).
|
||||
|
||||
|
|
@ -69,11 +69,11 @@ import CubicalTransport.Readback
|
|||
Full inductive definition is Lean-discharge future work; for now
|
||||
this is an opaque predicate whose structural properties are
|
||||
captured by the preservation axioms below. -/
|
||||
opaque HasVal : CVal → CType → Prop
|
||||
opaque HasVal : CVal → ∀ {ℓ : ULevel}, CType ℓ → Prop
|
||||
|
||||
/-- `HasNeu n A` — the neutral `n` is a stuck term of type `A`.
|
||||
Mutual partner to `HasVal`. -/
|
||||
opaque HasNeu : CNeu → CType → Prop
|
||||
opaque HasNeu : CNeu → ∀ {ℓ : ULevel}, CType ℓ → Prop
|
||||
|
||||
/-- Semantic well-typedness of an environment: every binding's value
|
||||
has the type the context assigns to the name. Declarative;
|
||||
|
|
@ -92,8 +92,8 @@ opaque EnvHasType : CEnv → Ctx → Prop
|
|||
|
||||
The full discharge requires HasVal / HasNeu to be inductively
|
||||
populated (currently opaque); this is future Lean work. -/
|
||||
axiom eval_preserves_type
|
||||
(env : CEnv) (Γ : Ctx) (t : CTerm) (A : CType)
|
||||
axiom eval_preserves_type {ℓ : ULevel}
|
||||
(env : CEnv) (Γ : Ctx) (t : CTerm) (A : CType ℓ)
|
||||
(hEnv : EnvHasType env Γ)
|
||||
(ht : HasType Γ t A) :
|
||||
HasVal (eval env t) A
|
||||
|
|
@ -104,8 +104,8 @@ axiom eval_preserves_type
|
|||
**Lean-discharge obligation.** Mutual structural recursion on the
|
||||
`readback` / `readbackNeu` arms, each producing a `HasType` derivation
|
||||
from the corresponding `HasVal` / `HasNeu` witness. -/
|
||||
axiom readback_preserves_type
|
||||
(Γ : Ctx) (v : CVal) (A : CType)
|
||||
axiom readback_preserves_type {ℓ : ULevel}
|
||||
(Γ : Ctx) (v : CVal) (A : CType ℓ)
|
||||
(hv : HasVal v A) :
|
||||
HasType Γ (readback v) A
|
||||
|
||||
|
|
@ -128,6 +128,6 @@ axiom EnvHasType.nil : EnvHasType .nil []
|
|||
the term (not the context). The discharge via empty-env readback
|
||||
uses a weakening / threading argument that is valid because
|
||||
`CTerm.step` does not introduce free variables. -/
|
||||
axiom CTerm.step_preserves_type
|
||||
(Γ : Ctx) (t : CTerm) (A : CType) (ht : HasType Γ t A) :
|
||||
axiom CTerm.step_preserves_type {ℓ : ULevel}
|
||||
(Γ : Ctx) (t : CTerm) (A : CType ℓ) (ht : HasType Γ t A) :
|
||||
HasType Γ (CTerm.step t) A
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@ path = "../cubical-transport-hott-lean4" # or git = "..."
|
|||
```
|
||||
|
||||
Then `import CubicalTransport.Syntax`, `import CubicalTransport.Eval`,
|
||||
etc. Link against `native/cubical/target/release/libtopolei_cubical.a`
|
||||
etc. Link against `native/cubical/target/release/libcubical_transport.a`
|
||||
in your own `moreLinkArgs` so the FFI symbols resolve.
|
||||
|
||||
## Build
|
||||
|
|
|
|||
|
|
@ -21,7 +21,7 @@ satisfiable.*
|
|||
|
||||
---
|
||||
|
||||
## 1. `eval` (`topolei_cubical_eval`)
|
||||
## 1. `eval` (`cubical_transport_eval`)
|
||||
|
||||
**Signature:** `CEnv → CTerm → CVal`
|
||||
|
||||
|
|
@ -63,7 +63,7 @@ widest partition; all are pattern-disjoint.
|
|||
|
||||
---
|
||||
|
||||
## 2. `vApp` (`topolei_cubical_vapp`)
|
||||
## 2. `vApp` (`cubical_transport_vapp`)
|
||||
|
||||
**Signature:** `CVal → CVal → CVal`
|
||||
|
||||
|
|
@ -87,7 +87,7 @@ design; well-typed terms never reach these arms.
|
|||
|
||||
---
|
||||
|
||||
## 3. `vPApp` (`topolei_cubical_vpapp`)
|
||||
## 3. `vPApp` (`cubical_transport_vpapp`)
|
||||
|
||||
**Signature:** `CVal → DimExpr → CVal`
|
||||
|
||||
|
|
@ -105,7 +105,7 @@ design; well-typed terms never reach these arms.
|
|||
|
||||
---
|
||||
|
||||
## 4. `vTransp` (`topolei_cubical_vtransp`)
|
||||
## 4. `vTransp` (`cubical_transport_vtransp`)
|
||||
|
||||
**Signature:** `DimVar → CType → FaceFormula → CVal → CVal`
|
||||
|
||||
|
|
@ -121,7 +121,7 @@ face-disjoint hypotheses.
|
|||
|
||||
---
|
||||
|
||||
## 5. `vHCompValue` (`topolei_cubical_vhcomp`)
|
||||
## 5. `vHCompValue` (`cubical_transport_vhcomp`)
|
||||
|
||||
**Signature:** `CType → FaceFormula → CVal → CVal → CVal`
|
||||
|
||||
|
|
@ -135,7 +135,7 @@ face-disjoint hypotheses.
|
|||
|
||||
---
|
||||
|
||||
## 6. `vCompAtTerm` (`topolei_cubical_vcomp_term`)
|
||||
## 6. `vCompAtTerm` (`cubical_transport_vcomp_term`)
|
||||
|
||||
**Signature:** `CEnv → DimVar → CType → FaceFormula → CTerm → CTerm → CVal`
|
||||
|
||||
|
|
@ -146,7 +146,7 @@ Covered by the 5 `eval_comp_*` axioms (§1).
|
|||
|
||||
---
|
||||
|
||||
## 7. `vCompNAtTerm` (`topolei_cubical_vcompn_term`)
|
||||
## 7. `vCompNAtTerm` (`cubical_transport_vcompn_term`)
|
||||
|
||||
**Signature:** `CEnv → DimVar → CType → List (FaceFormula × CTerm) → CTerm → CVal`
|
||||
|
||||
|
|
@ -160,7 +160,7 @@ behaviour; Rust implements the scan-find-top / strip-bot / single-live
|
|||
|
||||
---
|
||||
|
||||
## 8. `vFst` / `vSnd` (`topolei_cubical_vfst`, `topolei_cubical_vsnd`)
|
||||
## 8. `vFst` / `vSnd` (`cubical_transport_vfst`, `cubical_transport_vsnd`)
|
||||
|
||||
**Signature:** `CVal → CVal`
|
||||
|
||||
|
|
@ -175,7 +175,7 @@ type-error cases follow §2 convention.
|
|||
|
||||
---
|
||||
|
||||
## 9. `readback` (`topolei_cubical_readback`)
|
||||
## 9. `readback` (`cubical_transport_readback`)
|
||||
|
||||
**Signature:** `CVal → CTerm`
|
||||
|
||||
|
|
@ -197,7 +197,7 @@ face-disjointly split on inner CTerm shape (Stream B #2c).
|
|||
|
||||
---
|
||||
|
||||
## 10. `readbackNeu` (`topolei_cubical_readback_neu`)
|
||||
## 10. `readbackNeu` (`cubical_transport_readback_neu`)
|
||||
|
||||
**Signature:** `CNeu → CTerm`
|
||||
|
||||
|
|
@ -219,7 +219,7 @@ face-disjointly split on inner CTerm shape (Stream B #2c).
|
|||
|
||||
---
|
||||
|
||||
## 11. `stepRust` (`topolei_cubical_step`) — optional
|
||||
## 11. `stepRust` (`cubical_transport_step`) — optional
|
||||
|
||||
**Signature:** `CTerm → CTerm`
|
||||
|
||||
|
|
@ -243,7 +243,7 @@ step) automatically satisfies T4 via the `.vPathTransp` → `.plam j
|
|||
|
||||
---
|
||||
|
||||
## 12. `DimExpr.normalize` (`topolei_cubical_dimexpr_normalize`)
|
||||
## 12. `DimExpr.normalize` (`cubical_transport_dimexpr_normalize`)
|
||||
|
||||
**Signature:** `DimExpr → DimExpr`
|
||||
|
||||
|
|
@ -260,7 +260,7 @@ but deliberately not normalised — future `normalize_full` extension.
|
|||
|
||||
---
|
||||
|
||||
## 13. `FaceFormula.normalize` (`topolei_cubical_face_normalize`)
|
||||
## 13. `FaceFormula.normalize` (`cubical_transport_face_normalize`)
|
||||
|
||||
**Signature:** `FaceFormula → FaceFormula`
|
||||
|
||||
|
|
|
|||
|
|
@ -30,18 +30,18 @@ The contract is bidirectional:
|
|||
|
||||
| Lean function | Rust symbol | Arity | Notes |
|
||||
|----------------------------|------------------------------|-------|-------|
|
||||
| `eval` | `topolei_cubical_eval` | `CEnv → CTerm → CVal` | Main evaluator entry |
|
||||
| `vApp` | `topolei_cubical_vapp` | `CVal → CVal → CVal` | Function application |
|
||||
| `vPApp` | `topolei_cubical_vpapp` | `CVal → DimExpr → CVal` | Dimension application |
|
||||
| `vTransp` | `topolei_cubical_vtransp` | `DimVar → CType → FaceFormula → CVal → CVal` | Value-level transport |
|
||||
| `vHCompValue` | `topolei_cubical_vhcomp` | `CType → FaceFormula → CVal → CVal → CVal` | Homogeneous composition |
|
||||
| `vCompAtTerm` | `topolei_cubical_vcomp_term` | `CEnv → DimVar → CType → FaceFormula → CTerm → CTerm → CVal` | Heterogeneous comp at term |
|
||||
| `vCompNAtTerm` | `topolei_cubical_vcompn_term`| `CEnv → DimVar → CType → List (FaceFormula × CTerm) → CTerm → CVal` | Multi-clause comp |
|
||||
| `vFst` | `topolei_cubical_vfst` | `CVal → CVal` | First projection (Σ) |
|
||||
| `vSnd` | `topolei_cubical_vsnd` | `CVal → CVal` | Second projection (Σ) |
|
||||
| `readback` | `topolei_cubical_readback` | `CVal → CTerm` | NbE reification |
|
||||
| `readbackNeu` | `topolei_cubical_readback_neu` | `CNeu → CTerm` | Neutral reification |
|
||||
| `CTerm.step` (optional) | `topolei_cubical_step` | `CTerm → CTerm` | One-step reduction; see §8 |
|
||||
| `eval` | `cubical_transport_eval` | `CEnv → CTerm → CVal` | Main evaluator entry |
|
||||
| `vApp` | `cubical_transport_vapp` | `CVal → CVal → CVal` | Function application |
|
||||
| `vPApp` | `cubical_transport_vpapp` | `CVal → DimExpr → CVal` | Dimension application |
|
||||
| `vTransp` | `cubical_transport_vtransp` | `DimVar → CType → FaceFormula → CVal → CVal` | Value-level transport |
|
||||
| `vHCompValue` | `cubical_transport_vhcomp` | `CType → FaceFormula → CVal → CVal → CVal` | Homogeneous composition |
|
||||
| `vCompAtTerm` | `cubical_transport_vcomp_term` | `CEnv → DimVar → CType → FaceFormula → CTerm → CTerm → CVal` | Heterogeneous comp at term |
|
||||
| `vCompNAtTerm` | `cubical_transport_vcompn_term`| `CEnv → DimVar → CType → List (FaceFormula × CTerm) → CTerm → CVal` | Multi-clause comp |
|
||||
| `vFst` | `cubical_transport_vfst` | `CVal → CVal` | First projection (Σ) |
|
||||
| `vSnd` | `cubical_transport_vsnd` | `CVal → CVal` | Second projection (Σ) |
|
||||
| `readback` | `cubical_transport_readback` | `CVal → CTerm` | NbE reification |
|
||||
| `readbackNeu` | `cubical_transport_readback_neu` | `CNeu → CTerm` | Neutral reification |
|
||||
| `CTerm.step` (optional) | `cubical_transport_step` | `CTerm → CTerm` | One-step reduction; see §8 |
|
||||
|
||||
---
|
||||
|
||||
|
|
@ -160,9 +160,9 @@ Rust implements each FFI entry point natively via tag dispatch.
|
|||
Examples:
|
||||
|
||||
```rust
|
||||
// topolei_cubical_eval: eval : CEnv → CTerm → CVal
|
||||
// cubical_transport_eval: eval : CEnv → CTerm → CVal
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_eval(
|
||||
pub extern "C" fn cubical_transport_eval(
|
||||
env: *const c_void, // b_lean_obj_arg — borrowed CEnv
|
||||
t: *const c_void, // b_lean_obj_arg — borrowed CTerm
|
||||
) -> *mut c_void { // lean_obj_res — owned CVal
|
||||
|
|
@ -242,7 +242,7 @@ level. Rust has two valid implementation strategies:
|
|||
|
||||
```rust
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_step(t: *const c_void) -> *mut c_void {
|
||||
pub extern "C" fn cubical_transport_step(t: *const c_void) -> *mut c_void {
|
||||
// Direct pattern-match on CTerm constructor; emit CCHM comp-shaped
|
||||
// body for path-typed transp-of-plam; identity-ish otherwise.
|
||||
...
|
||||
|
|
@ -256,10 +256,10 @@ logic with eval + readback.
|
|||
|
||||
```rust
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_step(t: *const c_void) -> *mut c_void {
|
||||
pub extern "C" fn cubical_transport_step(t: *const c_void) -> *mut c_void {
|
||||
let empty_env = lean_alloc_ctor(0, 0, 0); // CEnv.nil
|
||||
let v = topolei_cubical_eval(empty_env, t);
|
||||
topolei_cubical_readback(v)
|
||||
let v = cubical_transport_eval(empty_env, t);
|
||||
cubical_transport_readback(v)
|
||||
}
|
||||
```
|
||||
|
||||
|
|
@ -289,7 +289,7 @@ topolei/
|
|||
│ ├── Cargo.toml -- no_std, dual native+wasm targets
|
||||
│ ├── README.md
|
||||
│ ├── include/
|
||||
│ │ └── topolei_cubical.h -- C header, ABI v1
|
||||
│ │ └── cubical_transport.h -- C header, ABI v1
|
||||
│ ├── src/
|
||||
│ │ ├── lib.rs -- #![no_std], panic_handler
|
||||
│ │ ├── lean_runtime.rs -- hand-rolled Lean C ABI
|
||||
|
|
@ -329,7 +329,7 @@ codegen-units = 1
|
|||
|
||||
```toml
|
||||
[[external_lib]]
|
||||
name = "topolei_cubical_native"
|
||||
name = "cubical_transport_native"
|
||||
extra_link_args = ["-L", "native/target/release", "-ltopolei_native"]
|
||||
|
||||
# Build step: invoke `cargo build --release -p topolei-native`
|
||||
|
|
@ -342,13 +342,13 @@ at implementation time.)
|
|||
### 9.4 C header
|
||||
|
||||
```c
|
||||
// native/include/topolei_cubical.h
|
||||
// native/include/cubical_transport.h
|
||||
#pragma once
|
||||
#include <lean/lean.h>
|
||||
|
||||
lean_obj_res topolei_cubical_eval(b_lean_obj_arg env, b_lean_obj_arg t);
|
||||
lean_obj_res topolei_cubical_vapp(b_lean_obj_arg f, b_lean_obj_arg arg);
|
||||
lean_obj_res topolei_cubical_vpapp(b_lean_obj_arg v, b_lean_obj_arg r);
|
||||
lean_obj_res cubical_transport_eval(b_lean_obj_arg env, b_lean_obj_arg t);
|
||||
lean_obj_res cubical_transport_vapp(b_lean_obj_arg f, b_lean_obj_arg arg);
|
||||
lean_obj_res cubical_transport_vpapp(b_lean_obj_arg v, b_lean_obj_arg r);
|
||||
// ... one declaration per FFI function
|
||||
```
|
||||
|
||||
|
|
@ -378,7 +378,7 @@ The FFI contract is versioned:
|
|||
|
||||
```
|
||||
// C header
|
||||
#define TOPOLEI_FFI_ABI_VERSION 1
|
||||
#define CUBICAL_TRANSPORT_ABI_VERSION 1
|
||||
```
|
||||
|
||||
Any change to a function signature, inductive layout, or ownership
|
||||
|
|
|
|||
|
|
@ -499,15 +499,15 @@ relies on this order. REL1 freeze:
|
|||
|
||||
## 8. FFI surface (REL1)
|
||||
|
||||
Add to `native/cubical/include/topolei_cubical.h`:
|
||||
Add to `native/cubical/include/cubical_transport.h`:
|
||||
|
||||
```c
|
||||
lean_obj_res topolei_cubical_vIndElim(
|
||||
lean_obj_res cubical_transport_vIndElim(
|
||||
b_lean_obj_arg env, b_lean_obj_arg S, b_lean_obj_arg params,
|
||||
b_lean_obj_arg motive, b_lean_obj_arg branches,
|
||||
b_lean_obj_arg target);
|
||||
|
||||
lean_obj_res topolei_cubical_vCtor(
|
||||
lean_obj_res cubical_transport_vCtor(
|
||||
b_lean_obj_arg S, b_lean_obj_arg name,
|
||||
b_lean_obj_arg params, b_lean_obj_arg args);
|
||||
```
|
||||
|
|
|
|||
|
|
@ -311,7 +311,7 @@ more bookkeeping.
|
|||
### 3.8 Kernel-verified FFI
|
||||
|
||||
**What:** Lean's kernel would check that the Rust symbol
|
||||
`topolei_cubical_eval` actually implements the `eval_*` axioms
|
||||
`cubical_transport_eval` actually implements the `eval_*` axioms
|
||||
before trusting it.
|
||||
|
||||
**Blocked by:** `@[extern]` is trust-based by design. Verifying a
|
||||
|
|
|
|||
|
|
@ -107,7 +107,7 @@ enforces three properties:
|
|||
|
||||
2. **Axiomatic discharge.** The Rust side provides `@[extern]`
|
||||
implementations for axiom-stated behaviors
|
||||
(`@[extern "topolei_cubical_eval"] opaque cubicalEval : CEnv → CTerm → CVal`).
|
||||
(`@[extern "cubical_transport_eval"] opaque cubicalEval : CEnv → CTerm → CVal`).
|
||||
Each Rust function's behavior is specified by a Lean axiom it
|
||||
must satisfy (e.g., `eval_var` / `eval_lam` / … in
|
||||
`CubicalTransport/Eval.lean`, or `readback_vneu` / … in
|
||||
|
|
|
|||
|
|
@ -60,7 +60,7 @@ phase, `.dimExpr r : .interval` is a real typing judgement, not a
|
|||
| `tags.rs` | `pub const TY_INTERVAL: u32 = 6;` |
|
||||
| `subst.rs` | `TY_INTERVAL` arm in `ctype_subst_dim` and `ctype_subst_dim_expr` — return self with `retain`. |
|
||||
| `dim_absent.rs` | `TY_INTERVAL` arm in `ctype_absent` — return `true`. |
|
||||
| `include/topolei_cubical.h` | Bump `TOPOLEI_FFI_ABI_VERSION` 2 → 3. |
|
||||
| `include/cubical_transport.h` | Bump `CUBICAL_TRANSPORT_ABI_VERSION` 2 → 3. |
|
||||
|
||||
### 1.4 Topolei follow-up
|
||||
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ root = "CubicalTest"
|
|||
# Phase C.3 smoke tests + Phase D.1 property tests on the
|
||||
# Rust-backed cubical evaluator. No GPU dependencies.
|
||||
moreLinkArgs = [
|
||||
"./native/cubical/target/release/libtopolei_cubical.a",
|
||||
"./native/cubical/target/release/libcubical_transport.a",
|
||||
]
|
||||
|
||||
[[lean_exe]]
|
||||
|
|
@ -27,7 +27,7 @@ name = "cubical-bench"
|
|||
root = "CubicalBench"
|
||||
# Phase D.2 performance benchmarks on the Rust-backed evaluator.
|
||||
moreLinkArgs = [
|
||||
"./native/cubical/target/release/libtopolei_cubical.a",
|
||||
"./native/cubical/target/release/libcubical_transport.a",
|
||||
]
|
||||
|
||||
## No standalone `algebra-restructure` exe.
|
||||
|
|
|
|||
18
native/cubical/Cargo.lock
generated
18
native/cubical/Cargo.lock
generated
|
|
@ -4,14 +4,21 @@ version = 3
|
|||
|
||||
[[package]]
|
||||
name = "cc"
|
||||
version = "1.2.60"
|
||||
version = "1.2.61"
|
||||
source = "registry+https://github.com/rust-lang/crates.io-index"
|
||||
checksum = "43c5703da9466b66a946814e1adf53ea2c90f10063b86290cc9eb67ce3478a20"
|
||||
checksum = "d16d90359e986641506914ba71350897565610e87ce0ad9e6f28569db3dd5c6d"
|
||||
dependencies = [
|
||||
"find-msvc-tools",
|
||||
"shlex",
|
||||
]
|
||||
|
||||
[[package]]
|
||||
name = "cubical-transport"
|
||||
version = "0.2.0"
|
||||
dependencies = [
|
||||
"cc",
|
||||
]
|
||||
|
||||
[[package]]
|
||||
name = "find-msvc-tools"
|
||||
version = "0.1.9"
|
||||
|
|
@ -23,10 +30,3 @@ name = "shlex"
|
|||
version = "1.3.0"
|
||||
source = "registry+https://github.com/rust-lang/crates.io-index"
|
||||
checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64"
|
||||
|
||||
[[package]]
|
||||
name = "topolei-cubical"
|
||||
version = "0.1.0"
|
||||
dependencies = [
|
||||
"cc",
|
||||
]
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
[package]
|
||||
name = "topolei-cubical"
|
||||
version = "0.1.0"
|
||||
name = "cubical-transport"
|
||||
version = "0.2.0"
|
||||
edition = "2021"
|
||||
rust-version = "1.76"
|
||||
description = "Rust backend for Lean 4 cubical-transport HoTT evaluator (topolei)"
|
||||
description = "Rust backend for Lean 4 cubical-transport HoTT evaluator"
|
||||
license = "MIT"
|
||||
publish = false
|
||||
|
||||
|
|
@ -17,7 +17,7 @@ publish = false
|
|||
# cargo build --release # native staticlib
|
||||
# cargo build --release --target wasm32-unknown-unknown # wasm cdylib
|
||||
[lib]
|
||||
name = "topolei_cubical"
|
||||
name = "cubical_transport"
|
||||
crate-type = ["staticlib", "cdylib"]
|
||||
|
||||
# ── No std ──────────────────────────────────────────────────────────────────
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
# topolei-cubical — Rust backend
|
||||
# cubical-transport — Rust backend
|
||||
|
||||
Rust implementation of the cubical-transport HoTT evaluator for
|
||||
[topolei](../../README.md) — Lean 4's cubical-HoTT kernel extension.
|
||||
|
|
@ -20,10 +20,10 @@ Artifacts:
|
|||
|
||||
| Target | Path |
|
||||
|--------|------|
|
||||
| Native staticlib | `target/release/libtopolei_cubical.a` |
|
||||
| Native cdylib | `target/release/libtopolei_cubical.so` (linux), `.dylib` (macos), `.dll` (windows) |
|
||||
| Wasm cdylib | `target/wasm32-unknown-unknown/release/topolei_cubical.wasm` |
|
||||
| Wasm staticlib | `target/wasm32-unknown-unknown/release/libtopolei_cubical.a` |
|
||||
| Native staticlib | `target/release/libcubical_transport.a` |
|
||||
| Native cdylib | `target/release/libcubical_transport.so` (linux), `.dylib` (macos), `.dll` (windows) |
|
||||
| Wasm cdylib | `target/wasm32-unknown-unknown/release/cubical_transport.wasm` |
|
||||
| Wasm staticlib | `target/wasm32-unknown-unknown/release/libcubical_transport.a` |
|
||||
|
||||
## Discipline
|
||||
|
||||
|
|
@ -88,7 +88,7 @@ native/cubical/
|
|||
├── Cargo.toml
|
||||
├── README.md — this file
|
||||
├── include/
|
||||
│ └── topolei_cubical.h — C declarations (ABI v1)
|
||||
│ └── cubical_transport.h — C declarations (ABI v1)
|
||||
└── src/
|
||||
├── lib.rs — crate root; panic handler
|
||||
├── lean_runtime.rs — hand-rolled Lean C ABI
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
# WASM.md — Wasm Target Integration
|
||||
|
||||
*Phase D.wasm deliverable, 2026-04-24. Describes the
|
||||
`topolei-cubical` crate's wasm32 build, its import/export contract, and
|
||||
`cubical-transport` crate's wasm32 build, its import/export contract, and
|
||||
how to embed it in a Lean-wasm composite artifact.*
|
||||
|
||||
---
|
||||
|
|
@ -11,7 +11,7 @@ how to embed it in a Lean-wasm composite artifact.*
|
|||
```sh
|
||||
cd native/cubical
|
||||
cargo build --release --target wasm32-unknown-unknown
|
||||
# Output: target/wasm32-unknown-unknown/release/topolei_cubical.wasm
|
||||
# Output: target/wasm32-unknown-unknown/release/cubical_transport.wasm
|
||||
```
|
||||
|
||||
Requirements: the `wasm32-unknown-unknown` Rust target installed
|
||||
|
|
@ -33,25 +33,25 @@ All 14 cubical-evaluator entry points plus wasm runtime bookkeeping:
|
|||
|
||||
| Export | Role |
|
||||
|-----------------------------------------|-----------------------------------------------|
|
||||
| `topolei_cubical_eval` | Main evaluator: `(CEnv, CTerm) → CVal` |
|
||||
| `topolei_cubical_vapp` | Function application |
|
||||
| `topolei_cubical_vpapp` | Dim application |
|
||||
| `topolei_cubical_vtransp` | Value-level transport |
|
||||
| `topolei_cubical_vhcomp` | Homogeneous composition |
|
||||
| `topolei_cubical_vcomp_term` | Hetero comp at term level |
|
||||
| `topolei_cubical_vcompn_term` | Multi-clause comp |
|
||||
| `topolei_cubical_vfst` | Σ first projection |
|
||||
| `topolei_cubical_vsnd` | Σ second projection |
|
||||
| `topolei_cubical_readback` | NbE reification |
|
||||
| `topolei_cubical_readback_neu` | Neutral reification |
|
||||
| `topolei_cubical_step` | `readback ∘ eval .nil` (Option B) |
|
||||
| `topolei_cubical_dimexpr_normalize` | DimExpr canonicalisation |
|
||||
| `topolei_cubical_face_normalize` | FaceFormula canonicalisation |
|
||||
| `cubical_transport_eval` | Main evaluator: `(CEnv, CTerm) → CVal` |
|
||||
| `cubical_transport_vapp` | Function application |
|
||||
| `cubical_transport_vpapp` | Dim application |
|
||||
| `cubical_transport_vtransp` | Value-level transport |
|
||||
| `cubical_transport_vhcomp` | Homogeneous composition |
|
||||
| `cubical_transport_vcomp_term` | Hetero comp at term level |
|
||||
| `cubical_transport_vcompn_term` | Multi-clause comp |
|
||||
| `cubical_transport_vfst` | Σ first projection |
|
||||
| `cubical_transport_vsnd` | Σ second projection |
|
||||
| `cubical_transport_readback` | NbE reification |
|
||||
| `cubical_transport_readback_neu` | Neutral reification |
|
||||
| `cubical_transport_step` | `readback ∘ eval .nil` (Option B) |
|
||||
| `cubical_transport_dimexpr_normalize` | DimExpr canonicalisation |
|
||||
| `cubical_transport_face_normalize` | FaceFormula canonicalisation |
|
||||
| `memory` | Linear memory (shared with host) |
|
||||
| `__heap_base` | Address of first allocatable byte |
|
||||
| `__data_end` | Address of end of static data |
|
||||
|
||||
Every `topolei_cubical_*` export takes `lean_object*` (i.e. `i32` wasm
|
||||
Every `cubical_transport_*` export takes `lean_object*` (i.e. `i32` wasm
|
||||
pointers) and returns `lean_object*`. The Lean object layout on
|
||||
wasm32 is:
|
||||
|
||||
|
|
@ -75,14 +75,14 @@ real wasm imports:
|
|||
|
||||
| Import | Lean equivalent | Purpose |
|
||||
|-----------------------------|----------------------|------------------------------------------------------|
|
||||
| `topolei_shim_obj_tag` | `lean_obj_tag` | `(o: i32) → i32` — constructor tag |
|
||||
| `topolei_shim_ctor_get` | `lean_ctor_get` | `(o, i) → field pointer` |
|
||||
| `topolei_shim_ctor_set` | `lean_ctor_set` | `(o, i, v) → ()` |
|
||||
| `topolei_shim_alloc_ctor` | `lean_alloc_ctor` | `(tag, num_objs, scalar_sz) → new ctor` |
|
||||
| `topolei_shim_inc` | `lean_inc` | refcount +1 (no-op on scalars) |
|
||||
| `topolei_shim_dec` | `lean_dec` | refcount –1 |
|
||||
| `topolei_shim_string_eq` | `lean_string_eq` | `(a, b) → bool` |
|
||||
| `topolei_shim_mk_string` | `lean_mk_string` | Allocate Lean String from null-terminated C string |
|
||||
| `cubical_transport_shim_obj_tag` | `lean_obj_tag` | `(o: i32) → i32` — constructor tag |
|
||||
| `cubical_transport_shim_ctor_get` | `lean_ctor_get` | `(o, i) → field pointer` |
|
||||
| `cubical_transport_shim_ctor_set` | `lean_ctor_set` | `(o, i, v) → ()` |
|
||||
| `cubical_transport_shim_alloc_ctor` | `lean_alloc_ctor` | `(tag, num_objs, scalar_sz) → new ctor` |
|
||||
| `cubical_transport_shim_inc` | `lean_inc` | refcount +1 (no-op on scalars) |
|
||||
| `cubical_transport_shim_dec` | `lean_dec` | refcount –1 |
|
||||
| `cubical_transport_shim_string_eq` | `lean_string_eq` | `(a, b) → bool` |
|
||||
| `cubical_transport_shim_mk_string` | `lean_mk_string` | Allocate Lean String from null-terminated C string |
|
||||
|
||||
A Lean-wasm runtime must satisfy these imports. Two paths:
|
||||
|
||||
|
|
@ -109,7 +109,7 @@ comprises:
|
|||
```
|
||||
lean-wasm-composite/
|
||||
├── lean-kernel.wasm # Lean's own runtime compiled to wasm
|
||||
├── topolei-cubical.wasm # This crate
|
||||
├── cubical-transport.wasm # This crate
|
||||
├── glue.js / glue.wasm # Import/export wiring
|
||||
└── main.{js,html} # Entry point
|
||||
```
|
||||
|
|
@ -120,7 +120,7 @@ Two approaches to wiring them:
|
|||
|
||||
Instantiate both modules in the host (JS or another wasm runtime).
|
||||
The host holds a single `WebAssembly.Memory` instance and shares it
|
||||
between modules. Imports on `topolei-cubical` resolve to functions
|
||||
between modules. Imports on `cubical-transport` resolve to functions
|
||||
exported by `lean-kernel.wasm` (the shim wrappers that call Lean's
|
||||
inlines).
|
||||
|
||||
|
|
@ -133,8 +133,8 @@ be updated independently. Clean separation of concerns.
|
|||
const lean = await WebAssembly.instantiate(leanKernelWasm, {});
|
||||
const topolei = await WebAssembly.instantiate(topoleiCubicalWasm, {
|
||||
env: {
|
||||
topolei_shim_obj_tag: lean.instance.exports.topolei_shim_obj_tag,
|
||||
topolei_shim_ctor_get: lean.instance.exports.topolei_shim_ctor_get,
|
||||
cubical_transport_shim_obj_tag: lean.instance.exports.cubical_transport_shim_obj_tag,
|
||||
cubical_transport_shim_ctor_get: lean.instance.exports.cubical_transport_shim_ctor_get,
|
||||
// ... etc
|
||||
},
|
||||
});
|
||||
|
|
@ -198,7 +198,7 @@ host. A real Lean-wasm runtime provides these automatically.
|
|||
The wasm module declares an initial memory size. Complex
|
||||
computations may exceed it; the host should monitor
|
||||
`memory.buffer.byteLength` and call `memory.grow()` as needed.
|
||||
`topolei_shim_alloc_ctor`'s allocator implementation decides when to
|
||||
`cubical_transport_shim_alloc_ctor`'s allocator implementation decides when to
|
||||
grow.
|
||||
|
||||
### 5.3 Pointer size (wasm32 vs wasm64)
|
||||
|
|
@ -211,7 +211,7 @@ of `WASM.md` should be aware.
|
|||
|
||||
### 5.4 Refcount correctness
|
||||
|
||||
The JS harness stubs `topolei_shim_inc` / `_dec` as no-ops (we don't
|
||||
The JS harness stubs `cubical_transport_shim_inc` / `_dec` as no-ops (we don't
|
||||
GC). This is fine for one-shot test runs but would leak in a
|
||||
long-running application. A real host must implement refcounting.
|
||||
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ fn main() {
|
|||
.file("shim.c")
|
||||
.include(&lean_include)
|
||||
.flag("-Wno-unused-parameter")
|
||||
.compile("topolei_cubical_shim");
|
||||
.compile("cubical_transport_shim");
|
||||
|
||||
println!("cargo:rerun-if-changed=shim.c");
|
||||
println!("cargo:rerun-if-env-changed=LEAN_INCLUDE");
|
||||
|
|
|
|||
125
native/cubical/include/cubical_transport.h
Normal file
125
native/cubical/include/cubical_transport.h
Normal file
|
|
@ -0,0 +1,125 @@
|
|||
// cubical_transport.h — C ABI contract for the Rust cubical-HoTT backend.
|
||||
//
|
||||
// Companion to CubicalTransport/FFI.lean (Lean-side extern declarations)
|
||||
// and FFI_DESIGN.md (design rationale). Every function below is
|
||||
// implemented in native/cubical/src/ffi.rs.
|
||||
//
|
||||
// ABI version log:
|
||||
// 1 — Phase B initial (REL0).
|
||||
// 2 — REL1: schema-based inductive types (CType.ind, CTerm.{dimExpr,
|
||||
// ctor, indElim}, CVal.vctor / vdimExpr, CNeu.nIndElim).
|
||||
// 3 — REL2: cubical interval primitive (CType.interval, tag 6).
|
||||
// 4 — Layer 0 §0.1 universe-stratification cascade:
|
||||
// · CType is now `CType : ULevel → Type` (level lives in the
|
||||
// index).
|
||||
// · `pi` and `sigma` constructors carry an explicit binder
|
||||
// name (Lean `String`) before A and B; sub-CTypes may live
|
||||
// at distinct levels.
|
||||
// · `ind` constructor's `params` is a list of Σ-pairs
|
||||
// ⟨ℓ : ULevel, A : CType ℓ⟩ instead of a list of CType.
|
||||
// · NEW constructor `lift A` (tag 7): cumulativity, bumping
|
||||
// a CType's index by one (data-preserving on A).
|
||||
// · Reordering: tag 2 is now `sigma` (was `path`), tag 3 is
|
||||
// `path` (was `sigma`) — matches the Syntax.lean source order.
|
||||
// · CRITICAL — runtime ULevel preservation. Lean 4 does NOT
|
||||
// erase implicit `{ℓ : ULevel}` parameters at runtime. They
|
||||
// are kept as constructor fields (in declaration order,
|
||||
// interleaved with explicit args) AND as runtime object
|
||||
// arguments to extern functions. This affects:
|
||||
// (a) every CType / CTerm / CVal / CNeu constructor with
|
||||
// implicit ULevel(s) — the runtime `lean_ctor_num_objs`
|
||||
// includes one slot per implicit ULevel, leading
|
||||
// the explicit-arg slots in declaration order;
|
||||
// (b) every `cubical_transport_v*` extern with an
|
||||
// implicit `{ℓ}` — the C signature receives the
|
||||
// ULevel as the first `lean_object*` argument
|
||||
// (or the first two, for `{ℓ ℓ' : ULevel}`).
|
||||
// Empirically established 2026-05 by Lean meta inspection
|
||||
// and runtime-call probes; documented in value.rs and
|
||||
// ffi.rs. Constructor field tables of record:
|
||||
//
|
||||
// CType.univ {ℓ} → 1 slot: [ℓ]
|
||||
// CType.pi {ℓ_d ℓ_c} v A B → 5 slots: [ℓ_d, ℓ_c, v, A, B]
|
||||
// CType.sigma {ℓ_a ℓ_b} v A B → 5 slots: [ℓ_a, ℓ_b, v, A, B]
|
||||
// CType.path {ℓ} A a b → 4 slots: [ℓ, A, a, b]
|
||||
// CType.glue {ℓ} φ T f fI s r c A → 9 slots: [ℓ, φ, T, f, fI, s, r, c, A]
|
||||
// CType.ind {ℓ} S params → 3 slots: [ℓ, S, params]
|
||||
// CType.interval → 0 slots (scalar)
|
||||
// CType.lift {ℓ} A → 2 slots: [ℓ, A]
|
||||
// CTerm.transp i {ℓ} A φ t → 5 slots: [i, ℓ, A, φ, t]
|
||||
// CTerm.comp i {ℓ} A φ u t → 6 slots: [i, ℓ, A, φ, u, t]
|
||||
// CTerm.compN i {ℓ} A clauses t → 5 slots: [i, ℓ, A, clauses, t]
|
||||
// CVal.vTranspFun {ℓ_d ℓ_c} i d c φ f → 7 slots:
|
||||
// [ℓ_d, ℓ_c, i, d, c, φ, f]
|
||||
// CVal.vHCompFun {ℓ} A φ tube base → 5 slots: [ℓ, A, φ, tube, base]
|
||||
// CVal.vCompFun {ℓ_d ℓ_c} env i d c φ u t → 9 slots:
|
||||
// [ℓ_d, ℓ_c, env, i, d, c, φ, u, t]
|
||||
// CVal.vPathTransp {ℓ} env i A a b φ p → 8 slots:
|
||||
// [ℓ, env, i, A, a, b, φ, p]
|
||||
// CNeu.ntransp {ℓ} i A φ v → 5 slots: [ℓ, i, A, φ, v]
|
||||
// CNeu.ncomp {ℓ} i A φ u t → 6 slots: [ℓ, i, A, φ, u, t]
|
||||
// CNeu.nhcomp {ℓ} A φ tube base → 5 slots: [ℓ, A, φ, tube, base]
|
||||
// CNeu.ncompN {ℓ} env i A clauses t → 6 slots:
|
||||
// [ℓ, env, i, A, clauses, t]
|
||||
|
||||
#pragma once
|
||||
#include <lean/lean.h>
|
||||
|
||||
#define CUBICAL_TRANSPORT_ABI_VERSION 4
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
// ── Evaluator entry points ────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res cubical_transport_eval(b_lean_obj_arg env, b_lean_obj_arg t);
|
||||
lean_obj_res cubical_transport_vapp(b_lean_obj_arg f, b_lean_obj_arg a);
|
||||
lean_obj_res cubical_transport_vpapp(b_lean_obj_arg v, b_lean_obj_arg r);
|
||||
|
||||
// ABI v4: each universe-aware function takes the implicit
|
||||
// `{ℓ : ULevel}` as its first `lean_object*` argument. Lean keeps
|
||||
// `ULevel` parameters at runtime (it's a regular inductive, not a
|
||||
// `Sort`), so the C signature must include them — otherwise the
|
||||
// calling convention slides every subsequent argument by one slot.
|
||||
|
||||
lean_obj_res cubical_transport_vtransp(
|
||||
b_lean_obj_arg ell,
|
||||
b_lean_obj_arg i, b_lean_obj_arg A,
|
||||
b_lean_obj_arg phi, b_lean_obj_arg v);
|
||||
|
||||
lean_obj_res cubical_transport_vhcomp(
|
||||
b_lean_obj_arg ell,
|
||||
b_lean_obj_arg A, b_lean_obj_arg phi,
|
||||
b_lean_obj_arg tube, b_lean_obj_arg base);
|
||||
|
||||
lean_obj_res cubical_transport_vcomp_term(
|
||||
b_lean_obj_arg ell,
|
||||
b_lean_obj_arg env, b_lean_obj_arg i, b_lean_obj_arg A,
|
||||
b_lean_obj_arg phi, b_lean_obj_arg u, b_lean_obj_arg t);
|
||||
|
||||
lean_obj_res cubical_transport_vcompn_term(
|
||||
b_lean_obj_arg ell,
|
||||
b_lean_obj_arg env, b_lean_obj_arg i, b_lean_obj_arg A,
|
||||
b_lean_obj_arg clauses, b_lean_obj_arg t);
|
||||
|
||||
lean_obj_res cubical_transport_vfst(b_lean_obj_arg v);
|
||||
lean_obj_res cubical_transport_vsnd(b_lean_obj_arg v);
|
||||
|
||||
// ── Readback ──────────────────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res cubical_transport_readback(b_lean_obj_arg v);
|
||||
lean_obj_res cubical_transport_readback_neu(b_lean_obj_arg n);
|
||||
|
||||
// ── Step ──────────────────────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res cubical_transport_step(b_lean_obj_arg t);
|
||||
|
||||
// ── Normalisers ───────────────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res cubical_transport_dimexpr_normalize(b_lean_obj_arg r);
|
||||
lean_obj_res cubical_transport_face_normalize(b_lean_obj_arg phi);
|
||||
|
||||
#ifdef __cplusplus
|
||||
} // extern "C"
|
||||
#endif
|
||||
|
|
@ -1,63 +0,0 @@
|
|||
// topolei_cubical.h — C ABI contract for the Rust cubical-HoTT backend.
|
||||
//
|
||||
// Companion to Topolei/Cubical/FFI.lean (Lean-side extern declarations)
|
||||
// and FFI_DESIGN.md (design rationale). Every function below is
|
||||
// implemented in native/cubical/src/ffi.rs.
|
||||
//
|
||||
// ABI version log:
|
||||
// 1 — Phase B initial (REL0).
|
||||
// 2 — REL1: schema-based inductive types (CType.ind, CTerm.{dimExpr,
|
||||
// ctor, indElim}, CVal.vctor / vdimExpr, CNeu.nIndElim).
|
||||
// 3 — REL2: cubical interval primitive (CType.interval, tag 6).
|
||||
|
||||
#pragma once
|
||||
#include <lean/lean.h>
|
||||
|
||||
#define TOPOLEI_FFI_ABI_VERSION 3
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
// ── Evaluator entry points ────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res topolei_cubical_eval(b_lean_obj_arg env, b_lean_obj_arg t);
|
||||
lean_obj_res topolei_cubical_vapp(b_lean_obj_arg f, b_lean_obj_arg a);
|
||||
lean_obj_res topolei_cubical_vpapp(b_lean_obj_arg v, b_lean_obj_arg r);
|
||||
|
||||
lean_obj_res topolei_cubical_vtransp(
|
||||
b_lean_obj_arg i, b_lean_obj_arg A,
|
||||
b_lean_obj_arg phi, b_lean_obj_arg v);
|
||||
|
||||
lean_obj_res topolei_cubical_vhcomp(
|
||||
b_lean_obj_arg A, b_lean_obj_arg phi,
|
||||
b_lean_obj_arg tube, b_lean_obj_arg base);
|
||||
|
||||
lean_obj_res topolei_cubical_vcomp_term(
|
||||
b_lean_obj_arg env, b_lean_obj_arg i, b_lean_obj_arg A,
|
||||
b_lean_obj_arg phi, b_lean_obj_arg u, b_lean_obj_arg t);
|
||||
|
||||
lean_obj_res topolei_cubical_vcompn_term(
|
||||
b_lean_obj_arg env, b_lean_obj_arg i, b_lean_obj_arg A,
|
||||
b_lean_obj_arg clauses, b_lean_obj_arg t);
|
||||
|
||||
lean_obj_res topolei_cubical_vfst(b_lean_obj_arg v);
|
||||
lean_obj_res topolei_cubical_vsnd(b_lean_obj_arg v);
|
||||
|
||||
// ── Readback ──────────────────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res topolei_cubical_readback(b_lean_obj_arg v);
|
||||
lean_obj_res topolei_cubical_readback_neu(b_lean_obj_arg n);
|
||||
|
||||
// ── Step ──────────────────────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res topolei_cubical_step(b_lean_obj_arg t);
|
||||
|
||||
// ── Normalisers ───────────────────────────────────────────────────────────
|
||||
|
||||
lean_obj_res topolei_cubical_dimexpr_normalize(b_lean_obj_arg r);
|
||||
lean_obj_res topolei_cubical_face_normalize(b_lean_obj_arg phi);
|
||||
|
||||
#ifdef __cplusplus
|
||||
} // extern "C"
|
||||
#endif
|
||||
|
|
@ -6,7 +6,7 @@
|
|||
* all `static inline` in `<lean/lean.h>`. A Rust staticlib that calls
|
||||
* them via `extern "C"` produces unresolved references at link time.
|
||||
*
|
||||
* This shim provides `topolei_shim_*` thin wrappers that invoke the
|
||||
* This shim provides `cubical_transport_shim_*` thin wrappers that invoke the
|
||||
* inlines inside a regular C function; the wrappers have real ELF
|
||||
* symbols and link cleanly. Zero overhead — the compiler should
|
||||
* inline the calls.
|
||||
|
|
@ -18,38 +18,38 @@
|
|||
#include <lean/lean.h>
|
||||
#include <stdint.h>
|
||||
|
||||
uint32_t topolei_shim_obj_tag(b_lean_obj_arg o) {
|
||||
uint32_t cubical_transport_shim_obj_tag(b_lean_obj_arg o) {
|
||||
return lean_obj_tag(o);
|
||||
}
|
||||
|
||||
lean_obj_res topolei_shim_ctor_get(b_lean_obj_arg o, unsigned i) {
|
||||
lean_obj_res cubical_transport_shim_ctor_get(b_lean_obj_arg o, unsigned i) {
|
||||
return lean_ctor_get(o, i);
|
||||
}
|
||||
|
||||
void topolei_shim_ctor_set(lean_object* o, unsigned i, lean_obj_arg v) {
|
||||
void cubical_transport_shim_ctor_set(lean_object* o, unsigned i, lean_obj_arg v) {
|
||||
lean_ctor_set(o, i, v);
|
||||
}
|
||||
|
||||
lean_obj_res topolei_shim_alloc_ctor(unsigned tag, unsigned num_objs, unsigned scalar_sz) {
|
||||
lean_obj_res cubical_transport_shim_alloc_ctor(unsigned tag, unsigned num_objs, unsigned scalar_sz) {
|
||||
return lean_alloc_ctor(tag, num_objs, scalar_sz);
|
||||
}
|
||||
|
||||
void topolei_shim_inc(b_lean_obj_arg o) {
|
||||
void cubical_transport_shim_inc(b_lean_obj_arg o) {
|
||||
lean_inc(o);
|
||||
}
|
||||
|
||||
void topolei_shim_dec(b_lean_obj_arg o) {
|
||||
void cubical_transport_shim_dec(b_lean_obj_arg o) {
|
||||
lean_dec(o);
|
||||
}
|
||||
|
||||
uint8_t topolei_shim_string_eq(b_lean_obj_arg a, b_lean_obj_arg b) {
|
||||
uint8_t cubical_transport_shim_string_eq(b_lean_obj_arg a, b_lean_obj_arg b) {
|
||||
return lean_string_eq(a, b);
|
||||
}
|
||||
|
||||
const char* topolei_shim_string_cstr(b_lean_obj_arg s) {
|
||||
const char* cubical_transport_shim_string_cstr(b_lean_obj_arg s) {
|
||||
return lean_string_cstr(s);
|
||||
}
|
||||
|
||||
lean_obj_res topolei_shim_mk_string(const char* s) {
|
||||
lean_obj_res cubical_transport_shim_mk_string(const char* s) {
|
||||
return lean_mk_string(s);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -58,23 +58,25 @@ const PROD_MK: u32 = 0;
|
|||
/// transport it to the 0-endpoint to feed `f`; then forward-transport
|
||||
/// the result back up.
|
||||
pub(crate) fn force_transp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
|
||||
let i = ctor_field(closure, 0);
|
||||
let dom_a = ctor_field(closure, 1);
|
||||
let cod_a = ctor_field(closure, 2);
|
||||
let phi = ctor_field(closure, 3);
|
||||
let f = ctor_field(closure, 4);
|
||||
// ABI v4: vTranspFun layout [ℓ_d, ℓ_c, i, domA, codA, φ, f] (7 fields).
|
||||
let ld = ctor_field(closure, 0);
|
||||
let lc = ctor_field(closure, 1);
|
||||
let i = ctor_field(closure, 2);
|
||||
let dom_a = ctor_field(closure, 3);
|
||||
let cod_a = ctor_field(closure, 4);
|
||||
let phi = ctor_field(closure, 5);
|
||||
let f = ctor_field(closure, 6);
|
||||
|
||||
// Inner: arg at A(1) ↝ A(0) via inverse transport through the domain line.
|
||||
// vtransp_inv borrows i, dom_a, phi; owns v.
|
||||
let inverted = crate::transport::vtransp_inv(i, dom_a, phi, arg);
|
||||
// vtransp_inv borrows ld, i, dom_a, phi; owns v.
|
||||
let inverted = crate::transport::vtransp_inv(ld, i, dom_a, phi, arg);
|
||||
|
||||
// Middle: apply f : A(0) → B(0) at the inverse-transported argument.
|
||||
// vapp owns both args; f is borrowed from closure so retain.
|
||||
retain(f);
|
||||
let applied = crate::eval::vapp(f as LeanObjMut, inverted);
|
||||
|
||||
// Outer: lift the result B(0) ↝ B(1) via forward transport through codomain.
|
||||
crate::transport::vtransp(i, cod_a, phi, applied)
|
||||
crate::transport::vtransp(lc, i, cod_a, phi, applied)
|
||||
}
|
||||
|
||||
/// `force_hcomp_fun closure arg` — discharges `vApp_vHCompFun`.
|
||||
|
|
@ -89,29 +91,27 @@ pub(crate) fn force_transp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut
|
|||
/// No inverse transport: hcomp's type is fixed (no line), so the
|
||||
/// argument passes through unchanged to both tube and base.
|
||||
pub(crate) fn force_hcomp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
|
||||
let cod_a = ctor_field(closure, 0);
|
||||
let phi = ctor_field(closure, 1);
|
||||
let tube = ctor_field(closure, 2);
|
||||
let base = ctor_field(closure, 3);
|
||||
// ABI v4: vHCompFun layout [ℓ, codA, φ, tube, base] (5 fields).
|
||||
let l = ctor_field(closure, 0);
|
||||
let cod_a = ctor_field(closure, 1);
|
||||
let phi = ctor_field(closure, 2);
|
||||
let tube = ctor_field(closure, 3);
|
||||
let base = ctor_field(closure, 4);
|
||||
|
||||
// arg is used twice: once in .vTubeApp, once in vApp base arg.
|
||||
// Retain it to obtain a second owned reference.
|
||||
let arg_ro = arg as LeanObj;
|
||||
retain(arg_ro);
|
||||
let arg2 = arg_ro as LeanObjMut;
|
||||
|
||||
// .vTubeApp tube arg — pointwise dim-closure for `λj. (tube @ j) arg`.
|
||||
// mk_vtubeapp owns both fields; tube is borrowed so retain.
|
||||
retain(tube);
|
||||
let tube_app = mk_vtubeapp(tube, arg_ro);
|
||||
|
||||
// vApp base arg2 — base applied pointwise.
|
||||
retain(base);
|
||||
let base_applied = crate::eval::vapp(base as LeanObjMut, arg2);
|
||||
|
||||
// vHCompValue on the codomain with the new tube and base.
|
||||
// vhcomp_value borrows a, phi; owns tube, base.
|
||||
crate::composition::vhcomp_value(cod_a, phi, tube_app, base_applied)
|
||||
// vhcomp_value borrows l, a, phi; owns tube, base.
|
||||
crate::composition::vhcomp_value(l, cod_a, phi, tube_app, base_applied)
|
||||
}
|
||||
|
||||
/// `force_comp_fun closure arg` — discharges `vApp_vCompFun` (full CCHM
|
||||
|
|
@ -131,22 +131,21 @@ pub(crate) fn force_hcomp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
|
|||
/// reversed through the domain line. `$fj` is the fill dimension;
|
||||
/// `$y` is the bound argument name.
|
||||
pub(crate) fn force_comp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
|
||||
let env = ctor_field(closure, 0);
|
||||
let i = ctor_field(closure, 1);
|
||||
let dom_a = ctor_field(closure, 2);
|
||||
let cod_a = ctor_field(closure, 3);
|
||||
let phi = ctor_field(closure, 4);
|
||||
let u = ctor_field(closure, 5);
|
||||
let t = ctor_field(closure, 6);
|
||||
// ABI v4: vCompFun layout [ℓ_d, ℓ_c, env, i, domA, codA, φ, u, t] (9 fields).
|
||||
let ld = ctor_field(closure, 0);
|
||||
let lc = ctor_field(closure, 1);
|
||||
let env = ctor_field(closure, 2);
|
||||
let i = ctor_field(closure, 3);
|
||||
let dom_a = ctor_field(closure, 4);
|
||||
let cod_a = ctor_field(closure, 5);
|
||||
let phi = ctor_field(closure, 6);
|
||||
let u = ctor_field(closure, 7);
|
||||
let t = ctor_field(closure, 8);
|
||||
|
||||
// Fresh $fj DimVar for the fill dimension. We own it; release at end.
|
||||
let fj = mk_dimvar(b"$fj\0");
|
||||
|
||||
// ── Build the u-side transp line ──────────────────────────────────────
|
||||
// inner dim expr: (.inv (.var $fj)) ∨ (.var i)
|
||||
// type line: domA.substDimExpr i <that expr>
|
||||
// transp: .transp $fj <line> φ (.var "$y")
|
||||
// outer app: .app u <transp>
|
||||
let var_fj_u = mk_dim_var_expr(fj as LeanObj);
|
||||
let inv_fj_u = mk_dim_inv_expr(var_fj_u as LeanObj);
|
||||
let var_i_u = mk_dim_var_expr(i);
|
||||
|
|
@ -157,20 +156,14 @@ pub(crate) fn force_comp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
|
|||
let y_name_u = alloc_static_string(b"$y\0");
|
||||
let y_term_u = mk_term_var_owned(y_name_u);
|
||||
retain(phi);
|
||||
let u_transp = mk_term_transp(fj as LeanObj, dom_fill as LeanObj, phi, y_term_u as LeanObj);
|
||||
// `mk_term_transp` retains its `a` argument; our fresh `+1` on `dom_fill`
|
||||
// is now held externally. Balance it so the ctor's future teardown is
|
||||
// the only remaining drop on `dom_fill`.
|
||||
// .transp $fj {ℓ_d} dom_fill φ (.var "$y") — dom_a's level is ℓ_d.
|
||||
let u_transp = mk_term_transp(fj as LeanObj, ld, dom_fill as LeanObj, phi, y_term_u as LeanObj);
|
||||
release(dom_fill as LeanObj);
|
||||
|
||||
retain(u);
|
||||
let u_app = mk_term_app(u, u_transp as LeanObj);
|
||||
|
||||
// ── Build the t-side transp line ──────────────────────────────────────
|
||||
// inner dim expr: .inv (.var $fj)
|
||||
// type line: domA.substDimExpr i <that expr>
|
||||
// transp: .transp $fj <line> φ (.var "$y")
|
||||
// outer app: .app t <transp>
|
||||
let var_fj_t = mk_dim_var_expr(fj as LeanObj);
|
||||
let inv_fj_t = mk_dim_inv_expr(var_fj_t as LeanObj);
|
||||
let dom_inv = crate::subst::ctype_subst_dim_expr(i, inv_fj_t as LeanObj, dom_a);
|
||||
|
|
@ -179,26 +172,23 @@ pub(crate) fn force_comp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
|
|||
let y_name_t = alloc_static_string(b"$y\0");
|
||||
let y_term_t = mk_term_var_owned(y_name_t);
|
||||
retain(phi);
|
||||
let t_transp = mk_term_transp(fj as LeanObj, dom_inv as LeanObj, phi, y_term_t as LeanObj);
|
||||
let t_transp = mk_term_transp(fj as LeanObj, ld, dom_inv as LeanObj, phi, y_term_t as LeanObj);
|
||||
release(dom_inv as LeanObj);
|
||||
|
||||
retain(t);
|
||||
let t_app = mk_term_app(t, t_transp as LeanObj);
|
||||
|
||||
// ── Assemble the outer .comp i codA φ u_app t_app ─────────────────────
|
||||
// ── Assemble the outer .comp i {ℓ_c} codA φ u_app t_app ──────────────
|
||||
retain(phi);
|
||||
let comp_term = mk_term_comp(i, cod_a, phi, u_app as LeanObj, t_app as LeanObj);
|
||||
let comp_term = mk_term_comp(i, lc, cod_a, phi, u_app as LeanObj, t_app as LeanObj);
|
||||
|
||||
// ── Extend env with ($y ↦ arg) and evaluate ───────────────────────────
|
||||
// env.extend "$y" arg = env.cons "$y" arg env
|
||||
// env_cons owns name, val, rest.
|
||||
let y_name_env = alloc_static_string(b"$y\0");
|
||||
retain(env);
|
||||
let new_env = env_cons(y_name_env as LeanObj, arg as LeanObj, env);
|
||||
|
||||
let result = crate::eval::eval(new_env as LeanObj, comp_term as LeanObj);
|
||||
|
||||
// Release everything we allocated and still own.
|
||||
release(new_env as LeanObj);
|
||||
release(comp_term as LeanObj);
|
||||
release(fj as LeanObj);
|
||||
|
|
@ -250,18 +240,19 @@ pub(crate) fn force_tube_app(closure: LeanObj, r: LeanObj) -> LeanObjMut {
|
|||
/// here rather than only the endpoints matters for the parametric-path
|
||||
/// shader story: sweeping a slider maps to sweeping `r`.
|
||||
pub(crate) fn force_path_transp(closure: LeanObj, r: LeanObj) -> LeanObjMut {
|
||||
let env = ctor_field(closure, 0);
|
||||
let i = ctor_field(closure, 1);
|
||||
let a_ty = ctor_field(closure, 2);
|
||||
let a = ctor_field(closure, 3);
|
||||
let b = ctor_field(closure, 4);
|
||||
let phi = ctor_field(closure, 5);
|
||||
let p = ctor_field(closure, 6);
|
||||
// ABI v4: vPathTransp layout [ℓ, env, i, A, a, b, φ, p] (8 fields).
|
||||
let l = ctor_field(closure, 0);
|
||||
let env = ctor_field(closure, 1);
|
||||
let i = ctor_field(closure, 2);
|
||||
let a_ty = ctor_field(closure, 3);
|
||||
let a = ctor_field(closure, 4);
|
||||
let b = ctor_field(closure, 5);
|
||||
let phi = ctor_field(closure, 6);
|
||||
let p = ctor_field(closure, 7);
|
||||
|
||||
// Endpoint dispatch first.
|
||||
match ctor_tag(r) {
|
||||
DIM_ZERO => {
|
||||
// eval env (a.substDim i .one)
|
||||
release(r);
|
||||
let one_expr = lean_box_mut(DIM_ONE as usize);
|
||||
let a_at_1 = crate::subst::cterm_subst_dim(i, one_expr as LeanObj, a);
|
||||
|
|
@ -270,7 +261,6 @@ pub(crate) fn force_path_transp(closure: LeanObj, r: LeanObj) -> LeanObjMut {
|
|||
result
|
||||
}
|
||||
DIM_ONE => {
|
||||
// eval env (b.substDim i .one)
|
||||
release(r);
|
||||
let one_expr = lean_box_mut(DIM_ONE as usize);
|
||||
let b_at_1 = crate::subst::cterm_subst_dim(i, one_expr as LeanObj, b);
|
||||
|
|
@ -280,13 +270,6 @@ pub(crate) fn force_path_transp(closure: LeanObj, r: LeanObj) -> LeanObjMut {
|
|||
}
|
||||
_ => {
|
||||
// Generic r — build the 3-clause compN.
|
||||
//
|
||||
// The clauses are constructed fresh; we own them end-to-end
|
||||
// and release after vcompn_at_term returns.
|
||||
|
||||
// p @ r — CTerm. Used twice (clause body, base).
|
||||
// Build two independent copies; `p` is borrowed from closure, so
|
||||
// retain twice before handing to mk_term_papp (which consumes both).
|
||||
retain(p); retain(r);
|
||||
let papp1 = mk_term_papp(p, r);
|
||||
retain(p); retain(r);
|
||||
|
|
@ -324,9 +307,9 @@ pub(crate) fn force_path_transp(closure: LeanObj, r: LeanObj) -> LeanObjMut {
|
|||
ctor_set_field(cons1, 0, pair1 as LeanObj);
|
||||
ctor_set_field(cons1, 1, cons2 as LeanObj);
|
||||
|
||||
// vCompNAtTerm env i A clauses (p @ r) — all borrowed on Rust side;
|
||||
// we own clauses and papp2, release after.
|
||||
// vCompNAtTerm {ℓ} env i A clauses (p @ r).
|
||||
let result = crate::composition::vcompn_at_term(
|
||||
l,
|
||||
env, i, a_ty,
|
||||
cons1 as LeanObj,
|
||||
papp2 as LeanObj,
|
||||
|
|
|
|||
|
|
@ -3,24 +3,26 @@
|
|||
//! Rust implementation of `vHCompValue`, `vCompAtTerm`, `vCompNAtTerm`
|
||||
//! — CCHM composition at the value level (Cubical/Eval.lean).
|
||||
//!
|
||||
//! `vHCompValue A φ tube base` — homogeneous composition:
|
||||
//! `vHCompValue ℓ A φ tube base` — homogeneous composition:
|
||||
//! - φ = .top → `vPApp tube .one` (tube's 1-endpoint)
|
||||
//! - A = .pi → `.vHCompFun codA φ tube base` (Π β later)
|
||||
//! - else → `.vneu (.nhcomp A φ tube base)`
|
||||
//! - A = .pi → `.vHCompFun {ℓ_c} codA φ tube base` (Π β later)
|
||||
//! - else → `.vneu (.nhcomp {ℓ} A φ tube base)`
|
||||
//!
|
||||
//! `vCompAtTerm env i A φ u t` — heterogeneous composition (CTerm-input):
|
||||
//! `vCompAtTerm ℓ env i A φ u t` — heterogeneous composition (CTerm-input):
|
||||
//! - φ = .top → `eval env (u.substDim i .one)` (C1)
|
||||
//! - φ = .bot → `eval env (.transp i A .bot t)` (C2)
|
||||
//! - φ = .bot → `eval env (.transp i {ℓ} A .bot t)` (C2)
|
||||
//! - A dim-absent from i → hcomp via `.plam i u` as tube (C3-like)
|
||||
//! - A = .pi → `.vCompFun env i domA codA φ u t`
|
||||
//! - else → `.vneu (.ncomp i A φ (eval u) (eval t))`
|
||||
//! - A = .pi → `.vCompFun {ℓ_d ℓ_c} env i domA codA φ u t`
|
||||
//! - else → `.vneu (.ncomp {ℓ} i A φ (eval u) (eval t))`
|
||||
//!
|
||||
//! `vCompNAtTerm env i A clauses t` — multi-clause comp. Scans the list:
|
||||
//! - any `.top` clause fires (CCHM multi-clause full-system rule)
|
||||
//! - strip `.bot` clauses (unsatisfiable)
|
||||
//! - 0 live clauses → plain transport of base
|
||||
//! - 1 live clause → delegate to `vCompAtTerm`
|
||||
//! - multiple → `.vneu (.ncompN env i A (evaled_live) (evaled t))`
|
||||
//! `vCompNAtTerm ℓ env i A clauses t` — multi-clause comp.
|
||||
//!
|
||||
//! ## ABI v4 — ULevel
|
||||
//!
|
||||
//! Each entry takes the implicit `{ℓ : ULevel}` of the Lean `vCompAt*`
|
||||
//! function as `l : LeanObj` first. When constructing CVal/CNeu carrying
|
||||
//! their own implicit ULevel(s), we forward `l` (or read sub-level slots
|
||||
//! from a CType.pi's [ℓ_d, ℓ_c, ...] layout).
|
||||
|
||||
use crate::lean_runtime::*;
|
||||
use crate::tags::*;
|
||||
|
|
@ -33,8 +35,9 @@ const PROD_MK: u32 = 0;
|
|||
// ── vHCompValue ─────────────────────────────────────────────────────────────
|
||||
|
||||
/// Homogeneous composition at the value level.
|
||||
/// Takes borrowed `a`, `phi`; owned `tube` and `base`. Returns owned.
|
||||
/// Takes borrowed `l`, `a`, `phi`; owned `tube` and `base`. Returns owned.
|
||||
pub fn vhcomp_value(
|
||||
l: LeanObj,
|
||||
a: LeanObj, phi: LeanObj, tube: LeanObjMut, base: LeanObjMut,
|
||||
) -> LeanObjMut {
|
||||
// (1) φ = .top → vPApp tube .one
|
||||
|
|
@ -46,16 +49,18 @@ pub fn vhcomp_value(
|
|||
return crate::eval::vpapp(tube, one as LeanObj);
|
||||
}
|
||||
|
||||
// (2) A = .pi → .vHCompFun closure
|
||||
// (2) A = .pi → .vHCompFun {ℓ_c} closure.
|
||||
// ABI v4: pi layout [ℓ_d, ℓ_c, var, A, B] — codomain B at field 4.
|
||||
if ctor_tag(a) == TY_PI {
|
||||
let cod_a = ctor_field(a, 1);
|
||||
retain(cod_a); retain(phi);
|
||||
return mk_vhcompfun(cod_a, phi, tube as LeanObj, base as LeanObj);
|
||||
let lc = ctor_field(a, 1);
|
||||
let cod_a = ctor_field(a, 4);
|
||||
retain(lc); retain(cod_a); retain(phi);
|
||||
return mk_vhcompfun(lc, cod_a, phi, tube as LeanObj, base as LeanObj);
|
||||
}
|
||||
|
||||
// (3) Stuck — .vneu (.nhcomp A φ tube base)
|
||||
retain(a); retain(phi);
|
||||
let nhcomp = mk_nhcomp(a, phi, tube as LeanObj, base as LeanObj);
|
||||
// (3) Stuck — .vneu (.nhcomp {ℓ} A φ tube base)
|
||||
retain(l); retain(a); retain(phi);
|
||||
let nhcomp = mk_nhcomp(l, a, phi, tube as LeanObj, base as LeanObj);
|
||||
mk_vneu(nhcomp as LeanObj)
|
||||
}
|
||||
|
||||
|
|
@ -65,6 +70,7 @@ pub fn vhcomp_value(
|
|||
/// the term level).
|
||||
/// All arguments borrowed; returns owned CVal.
|
||||
pub fn vcomp_at_term(
|
||||
l: LeanObj,
|
||||
env: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj,
|
||||
u: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
|
|
@ -77,17 +83,18 @@ pub fn vcomp_at_term(
|
|||
return result;
|
||||
}
|
||||
|
||||
// (2) φ = .bot → C2: eval env (.transp i A .bot t)
|
||||
// (2) φ = .bot → C2: eval env (.transp i {ℓ} A .bot t)
|
||||
if ctor_tag(phi) == FACE_BOT {
|
||||
// Build the transp term.
|
||||
retain(i); retain(a);
|
||||
// ABI v4: TERM_TRANSP layout [i, ℓ, A, φ, t] (5 fields).
|
||||
retain(l); retain(i); retain(a);
|
||||
let bot = lean_box_mut(FACE_BOT as usize);
|
||||
let transp_term = alloc_ctor(TERM_TRANSP, 4);
|
||||
let transp_term = alloc_ctor(TERM_TRANSP, 5);
|
||||
ctor_set_field(transp_term, 0, i);
|
||||
ctor_set_field(transp_term, 1, a);
|
||||
ctor_set_field(transp_term, 2, bot as LeanObj);
|
||||
ctor_set_field(transp_term, 1, l);
|
||||
ctor_set_field(transp_term, 2, a);
|
||||
ctor_set_field(transp_term, 3, bot as LeanObj);
|
||||
retain(t);
|
||||
ctor_set_field(transp_term, 3, t);
|
||||
ctor_set_field(transp_term, 4, t);
|
||||
let result = crate::eval::eval(env, transp_term as LeanObj);
|
||||
release(transp_term as LeanObj);
|
||||
return result;
|
||||
|
|
@ -103,24 +110,28 @@ pub fn vcomp_at_term(
|
|||
let tube_val = crate::eval::eval(env, plam_u as LeanObj);
|
||||
release(plam_u as LeanObj);
|
||||
let base_val = crate::eval::eval(env, t);
|
||||
return vhcomp_value(a, phi, tube_val, base_val);
|
||||
return vhcomp_value(l, a, phi, tube_val, base_val);
|
||||
}
|
||||
|
||||
// (4) A = .pi → .vCompFun closure
|
||||
// (4) A = .pi → .vCompFun {ℓ_d ℓ_c} env i domA codA φ u t closure.
|
||||
// ABI v4: pi layout [ℓ_d, ℓ_c, var, A, B].
|
||||
if ctor_tag(a) == TY_PI {
|
||||
let dom_a = ctor_field(a, 0);
|
||||
let cod_a = ctor_field(a, 1);
|
||||
let ld = ctor_field(a, 0);
|
||||
let lc = ctor_field(a, 1);
|
||||
let dom_a = ctor_field(a, 3);
|
||||
let cod_a = ctor_field(a, 4);
|
||||
retain(ld); retain(lc);
|
||||
retain(env); retain(i);
|
||||
retain(dom_a); retain(cod_a); retain(phi);
|
||||
retain(u); retain(t);
|
||||
return mk_vcompfun(env, i, dom_a, cod_a, phi, u, t);
|
||||
return mk_vcompfun(ld, lc, env, i, dom_a, cod_a, phi, u, t);
|
||||
}
|
||||
|
||||
// (5) Stuck — .vneu (.ncomp i A φ (eval u) (eval t))
|
||||
// (5) Stuck — .vneu (.ncomp {ℓ} i A φ (eval u) (eval t))
|
||||
let u_val = crate::eval::eval(env, u);
|
||||
let t_val = crate::eval::eval(env, t);
|
||||
retain(i); retain(a); retain(phi);
|
||||
let ncomp = mk_ncomp(i, a, phi, u_val as LeanObj, t_val as LeanObj);
|
||||
retain(l); retain(i); retain(a); retain(phi);
|
||||
let ncomp = mk_ncomp(l, i, a, phi, u_val as LeanObj, t_val as LeanObj);
|
||||
mk_vneu(ncomp as LeanObj)
|
||||
}
|
||||
|
||||
|
|
@ -215,6 +226,7 @@ fn eval_clauses_rec(env: LeanObj, cur: LeanObj) -> LeanObjMut {
|
|||
|
||||
/// Multi-clause heterogeneous composition.
|
||||
pub fn vcompn_at_term(
|
||||
l: LeanObj,
|
||||
env: LeanObj, i: LeanObj, a: LeanObj,
|
||||
clauses: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
|
|
@ -233,16 +245,18 @@ pub fn vcompn_at_term(
|
|||
|
||||
match len {
|
||||
0 => {
|
||||
// No clauses — plain transport of base.
|
||||
// No clauses — plain transport of base via .transp i {ℓ} A .bot t.
|
||||
release(live as LeanObj);
|
||||
retain(i); retain(a);
|
||||
retain(l); retain(i); retain(a);
|
||||
let bot = lean_box_mut(FACE_BOT as usize);
|
||||
let transp_term = alloc_ctor(TERM_TRANSP, 4);
|
||||
// ABI v4: TERM_TRANSP has 5 fields [i, ℓ, A, φ, t].
|
||||
let transp_term = alloc_ctor(TERM_TRANSP, 5);
|
||||
ctor_set_field(transp_term, 0, i);
|
||||
ctor_set_field(transp_term, 1, a);
|
||||
ctor_set_field(transp_term, 2, bot as LeanObj);
|
||||
ctor_set_field(transp_term, 1, l);
|
||||
ctor_set_field(transp_term, 2, a);
|
||||
ctor_set_field(transp_term, 3, bot as LeanObj);
|
||||
retain(t);
|
||||
ctor_set_field(transp_term, 3, t);
|
||||
ctor_set_field(transp_term, 4, t);
|
||||
let result = crate::eval::eval(env, transp_term as LeanObj);
|
||||
release(transp_term as LeanObj);
|
||||
result
|
||||
|
|
@ -252,7 +266,7 @@ pub fn vcompn_at_term(
|
|||
let head = ctor_field(live as LeanObj, 0);
|
||||
let face = ctor_field(head, 0);
|
||||
let body = ctor_field(head, 1);
|
||||
let result = vcomp_at_term(env, i, a, face, body, t);
|
||||
let result = vcomp_at_term(l, env, i, a, face, body, t);
|
||||
release(live as LeanObj);
|
||||
result
|
||||
}
|
||||
|
|
@ -260,9 +274,9 @@ pub fn vcompn_at_term(
|
|||
// Stuck — produce ncompN with evaluated clause bodies.
|
||||
let evaled_clauses = eval_clause_bodies(env, live);
|
||||
let t_val = crate::eval::eval(env, t);
|
||||
retain(env); retain(i); retain(a);
|
||||
retain(l); retain(env); retain(i); retain(a);
|
||||
let ncompn = mk_ncompn(
|
||||
env, i, a, evaled_clauses as LeanObj, t_val as LeanObj);
|
||||
l, env, i, a, evaled_clauses as LeanObj, t_val as LeanObj);
|
||||
mk_vneu(ncompn as LeanObj)
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -49,6 +49,12 @@ pub(crate) fn face_absent(i: LeanObj, phi: LeanObj) -> bool {
|
|||
}
|
||||
|
||||
/// True iff DimVar `i` does not appear in CTerm `t`.
|
||||
///
|
||||
/// ABI v4: transp/comp/compN have implicit `{ℓ : ULevel}` between the
|
||||
/// dim binder and the CType — runtime layouts are
|
||||
/// `.transp i {ℓ} A φ t` → fields [i, ℓ, A, φ, t]
|
||||
/// `.comp i {ℓ} A φ u t` → fields [i, ℓ, A, φ, u, t]
|
||||
/// `.compN i {ℓ} A clauses t` → fields [i, ℓ, A, clauses, t]
|
||||
pub(crate) fn cterm_absent(i: LeanObj, t: LeanObj) -> bool {
|
||||
match ctor_tag(t) {
|
||||
TERM_VAR => true,
|
||||
|
|
@ -76,20 +82,22 @@ pub(crate) fn cterm_absent(i: LeanObj, t: LeanObj) -> bool {
|
|||
cterm_absent(i, inner) && dim_expr_absent(i, r)
|
||||
}
|
||||
TERM_TRANSP => {
|
||||
// Lean approximation: `.transp j A φ t` — A is ignored.
|
||||
let phi = ctor_field(t, 2);
|
||||
let body = ctor_field(t, 3);
|
||||
// Lean approximation: A is ignored. Layout: [i, ℓ, A, φ, t].
|
||||
let phi = ctor_field(t, 3);
|
||||
let body = ctor_field(t, 4);
|
||||
face_absent(i, phi) && cterm_absent(i, body)
|
||||
}
|
||||
TERM_COMP => {
|
||||
let phi = ctor_field(t, 2);
|
||||
let u = ctor_field(t, 3);
|
||||
let body = ctor_field(t, 4);
|
||||
// Layout: [i, ℓ, A, φ, u, t].
|
||||
let phi = ctor_field(t, 3);
|
||||
let u = ctor_field(t, 4);
|
||||
let body = ctor_field(t, 5);
|
||||
face_absent(i, phi) && cterm_absent(i, u) && cterm_absent(i, body)
|
||||
}
|
||||
TERM_COMPN => {
|
||||
let clauses = ctor_field(t, 2);
|
||||
let body = ctor_field(t, 3);
|
||||
// Layout: [i, ℓ, A, clauses, t].
|
||||
let clauses = ctor_field(t, 3);
|
||||
let body = ctor_field(t, 4);
|
||||
cterm_absent_clauses(i, clauses) && cterm_absent(i, body)
|
||||
}
|
||||
TERM_GLUEIN => {
|
||||
|
|
@ -140,64 +148,83 @@ fn cterm_absent_clauses(i: LeanObj, clauses: LeanObj) -> bool {
|
|||
}
|
||||
|
||||
/// True iff DimVar `i` does not appear in CType `A`.
|
||||
///
|
||||
/// ABI v4: implicit `{ℓ : ULevel}` (or `{ℓ ℓ' : ULevel}`) parameters are
|
||||
/// kept at runtime as the leading field(s). Layouts:
|
||||
/// `.univ {ℓ}` → [ℓ]
|
||||
/// `.pi {ℓ ℓ'} var A B` → [ℓ, ℓ', var, A, B]
|
||||
/// `.sigma {ℓ ℓ'} var A B` → [ℓ, ℓ', var, A, B]
|
||||
/// `.path {ℓ} A a b` → [ℓ, A, a, b]
|
||||
/// `.glue {ℓ} φ T f fI s r c A` → [ℓ, φ, T, f, fI, s, r, c, A]
|
||||
/// `.ind {ℓ} S params` → [ℓ, S, params]
|
||||
/// `.interval` → []
|
||||
/// `.lift {ℓ} A` → [ℓ, A]
|
||||
pub(crate) fn ctype_absent(i: LeanObj, a: LeanObj) -> bool {
|
||||
match ctor_tag(a) {
|
||||
TY_UNIV => true,
|
||||
TY_UNIV => true, // [ℓ] alone — no dim binders inside.
|
||||
TY_PI => {
|
||||
let x = ctor_field(a, 0);
|
||||
let y = ctor_field(a, 1);
|
||||
// Layout: [ℓ, ℓ', var, A, B].
|
||||
let x = ctor_field(a, 3);
|
||||
let y = ctor_field(a, 4);
|
||||
ctype_absent(i, x) && ctype_absent(i, y)
|
||||
}
|
||||
TY_PATH => {
|
||||
let ty = ctor_field(a, 0);
|
||||
let x = ctor_field(a, 1);
|
||||
let y = ctor_field(a, 2);
|
||||
// Layout: [ℓ, A, a, b].
|
||||
let ty = ctor_field(a, 1);
|
||||
let x = ctor_field(a, 2);
|
||||
let y = ctor_field(a, 3);
|
||||
ctype_absent(i, ty) && cterm_absent(i, x) && cterm_absent(i, y)
|
||||
}
|
||||
TY_SIGMA => {
|
||||
let x = ctor_field(a, 0);
|
||||
let y = ctor_field(a, 1);
|
||||
// Layout: [ℓ, ℓ', var, A, B].
|
||||
let x = ctor_field(a, 3);
|
||||
let y = ctor_field(a, 4);
|
||||
ctype_absent(i, x) && ctype_absent(i, y)
|
||||
}
|
||||
TY_GLUE => {
|
||||
let phi = ctor_field(a, 0);
|
||||
let ty = ctor_field(a, 1);
|
||||
let f = ctor_field(a, 2);
|
||||
let finv = ctor_field(a, 3);
|
||||
let sec = ctor_field(a, 4);
|
||||
let ret = ctor_field(a, 5);
|
||||
let coh = ctor_field(a, 6);
|
||||
let base = ctor_field(a, 7);
|
||||
// Layout: [ℓ, φ, T, f, fInv, sec, ret, coh, A].
|
||||
let phi = ctor_field(a, 1);
|
||||
let ty = ctor_field(a, 2);
|
||||
let f = ctor_field(a, 3);
|
||||
let finv = ctor_field(a, 4);
|
||||
let sec = ctor_field(a, 5);
|
||||
let ret = ctor_field(a, 6);
|
||||
let coh = ctor_field(a, 7);
|
||||
let base = ctor_field(a, 8);
|
||||
face_absent(i, phi) && ctype_absent(i, ty) &&
|
||||
cterm_absent(i, f) && cterm_absent(i, finv) &&
|
||||
cterm_absent(i, sec) && cterm_absent(i, ret) &&
|
||||
cterm_absent(i, coh) && ctype_absent(i, base)
|
||||
}
|
||||
// REL1: schema-defined inductive — recurse through `params`.
|
||||
// (Currently `_ => true` covers this loosely; we tighten it
|
||||
// here in REL2 to match the Lean spec faithfully.)
|
||||
// Layout: [ℓ, S, params]; params is `List (Σ ℓ' : ULevel, CType ℓ')`.
|
||||
TY_IND => {
|
||||
// Field 0 is the schema (opaque to dim-absence); field 1
|
||||
// is `params : List CType`. Walk the list.
|
||||
let params = ctor_field(a, 1);
|
||||
ctype_list_absent(i, params)
|
||||
let params = ctor_field(a, 2);
|
||||
ctype_sigma_list_absent(i, params)
|
||||
}
|
||||
// REL2: cubical interval — no dim binders.
|
||||
// REL2: cubical interval — no dim binders, no fields.
|
||||
TY_INTERVAL => true,
|
||||
// ABI v4: cumulativity — recurse into the wrapped type. Layout: [ℓ, A].
|
||||
TY_LIFT => {
|
||||
let inner = ctor_field(a, 1);
|
||||
ctype_absent(i, inner)
|
||||
}
|
||||
_ => true,
|
||||
}
|
||||
}
|
||||
|
||||
/// Helper: `i` absent from every CType in a parameter list. Cons-list
|
||||
/// shape: tag 0 = nil, tag 1 = cons (head, tail).
|
||||
fn ctype_list_absent(i: LeanObj, params: LeanObj) -> bool {
|
||||
/// Helper: `i` absent from every CType in a Σ-pair parameter list.
|
||||
/// Each list element is `⟨ℓ, A⟩ : Σ ℓ : ULevel, CType ℓ`; we read the
|
||||
/// snd projection (field 1) to get the CType.
|
||||
fn ctype_sigma_list_absent(i: LeanObj, params: LeanObj) -> bool {
|
||||
let mut cur = params;
|
||||
loop {
|
||||
match ctor_tag(cur) {
|
||||
0 => return true,
|
||||
1 => {
|
||||
let head = ctor_field(cur, 0);
|
||||
if !ctype_absent(i, head) {
|
||||
// head : Σ ℓ : ULevel, CType ℓ — field 1 is the CType.
|
||||
let ctype = ctor_field(head, 1);
|
||||
if !ctype_absent(i, ctype) {
|
||||
return false;
|
||||
}
|
||||
cur = ctor_field(cur, 1);
|
||||
|
|
|
|||
|
|
@ -106,11 +106,13 @@ pub fn eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
|
|||
vsnd(vinner)
|
||||
}
|
||||
TERM_TRANSP => {
|
||||
// .transp i A φ t — priority-ordered dispatch matching Lean.
|
||||
// .transp i {ℓ} A φ t — ABI v4: ℓ kept at runtime (5 fields).
|
||||
// Layout: [i, ℓ, A, φ, t].
|
||||
let i = ctor_field(t, 0);
|
||||
let a = ctor_field(t, 1);
|
||||
let phi = ctor_field(t, 2);
|
||||
let body = ctor_field(t, 3);
|
||||
let l = ctor_field(t, 1);
|
||||
let a = ctor_field(t, 2);
|
||||
let phi = ctor_field(t, 3);
|
||||
let body = ctor_field(t, 4);
|
||||
|
||||
// (1) φ = .top → eval env body (T1).
|
||||
if ctor_tag(phi) == FACE_TOP {
|
||||
|
|
@ -121,14 +123,16 @@ pub fn eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
|
|||
return eval(env, body);
|
||||
}
|
||||
// (3) A = .path A₀ a b → .vPathTransp closure.
|
||||
// ABI v4: path is [ℓ, A₀, a, b].
|
||||
if ctor_tag(a) == TY_PATH {
|
||||
let a0 = ctor_field(a, 0);
|
||||
let ea = ctor_field(a, 1);
|
||||
let eb = ctor_field(a, 2);
|
||||
retain(env); retain(i); retain(a0);
|
||||
let a_l = ctor_field(a, 0);
|
||||
let a0 = ctor_field(a, 1);
|
||||
let ea = ctor_field(a, 2);
|
||||
let eb = ctor_field(a, 3);
|
||||
retain(env); retain(i); retain(a_l); retain(a0);
|
||||
retain(ea); retain(eb); retain(phi); retain(body);
|
||||
return crate::value::mk_vpathtransp(
|
||||
env, i, a0, ea, eb, phi, body);
|
||||
a_l, env, i, a0, ea, eb, phi, body);
|
||||
}
|
||||
// (4) A = .glue → delegate to the 9-axiom face dispatch.
|
||||
if ctor_tag(a) == TY_GLUE {
|
||||
|
|
@ -136,24 +140,28 @@ pub fn eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
|
|||
}
|
||||
// (5) Delegate to value-level vTransp.
|
||||
let vt = eval(env, body);
|
||||
crate::transport::vtransp(i, a, phi, vt)
|
||||
crate::transport::vtransp(l, i, a, phi, vt)
|
||||
}
|
||||
TERM_COMP => {
|
||||
// .comp i A φ u t — delegate to vCompAtTerm.
|
||||
// .comp i {ℓ} A φ u t — ABI v4: ℓ kept (6 fields).
|
||||
// Layout: [i, ℓ, A, φ, u, t].
|
||||
let i = ctor_field(t, 0);
|
||||
let a = ctor_field(t, 1);
|
||||
let phi = ctor_field(t, 2);
|
||||
let u = ctor_field(t, 3);
|
||||
let base = ctor_field(t, 4);
|
||||
crate::composition::vcomp_at_term(env, i, a, phi, u, base)
|
||||
let l = ctor_field(t, 1);
|
||||
let a = ctor_field(t, 2);
|
||||
let phi = ctor_field(t, 3);
|
||||
let u = ctor_field(t, 4);
|
||||
let base = ctor_field(t, 5);
|
||||
crate::composition::vcomp_at_term(l, env, i, a, phi, u, base)
|
||||
}
|
||||
TERM_COMPN => {
|
||||
// .compN i A clauses t — delegate to vCompNAtTerm.
|
||||
// .compN i {ℓ} A clauses t — ABI v4: ℓ kept (5 fields).
|
||||
// Layout: [i, ℓ, A, clauses, t].
|
||||
let i = ctor_field(t, 0);
|
||||
let a = ctor_field(t, 1);
|
||||
let clauses = ctor_field(t, 2);
|
||||
let base = ctor_field(t, 3);
|
||||
crate::composition::vcompn_at_term(env, i, a, clauses, base)
|
||||
let l = ctor_field(t, 1);
|
||||
let a = ctor_field(t, 2);
|
||||
let clauses = ctor_field(t, 3);
|
||||
let base = ctor_field(t, 4);
|
||||
crate::composition::vcompn_at_term(l, env, i, a, clauses, base)
|
||||
}
|
||||
TERM_GLUEIN => {
|
||||
// .glueIn φ t a — face-priority dispatch.
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
//! # ffi
|
||||
//!
|
||||
//! `#[no_mangle] pub extern "C"` exports for every `topolei_cubical_*`
|
||||
//! symbol declared in `Topolei/Cubical/FFI.lean`.
|
||||
//! `#[no_mangle] pub extern "C"` exports for every `cubical_transport_*`
|
||||
//! symbol declared in `CubicalTransport/FFI.lean`.
|
||||
//!
|
||||
//! ## Phase A: stubs
|
||||
//!
|
||||
|
|
@ -14,7 +14,7 @@
|
|||
//!
|
||||
//! ## Why even stubs?
|
||||
//!
|
||||
//! The `@[extern "topolei_cubical_*"] opaque` declarations in
|
||||
//! The `@[extern "cubical_transport_*"] opaque` declarations in
|
||||
//! `FFI.lean` register the symbol names with Lean's linker. When the
|
||||
//! Rust staticlib is linked into a Lean executable, the linker
|
||||
//! resolves these symbols to our stubs. Without stubs, linking
|
||||
|
|
@ -73,12 +73,12 @@ fn face_bot() -> LeanObjMut {
|
|||
// ── Exports: evaluator (Phase B implemented) ───────────────────────────────
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
|
||||
crate::eval::eval(env, t)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vapp(f: LeanObj, a: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_vapp(f: LeanObj, a: LeanObj) -> LeanObjMut {
|
||||
// The C ABI passes borrowed `f` and `a`; our internal vapp takes owned.
|
||||
// Retain both before forwarding so the caller's refcounts are preserved.
|
||||
retain(f);
|
||||
|
|
@ -87,52 +87,68 @@ pub extern "C" fn topolei_cubical_vapp(f: LeanObj, a: LeanObj) -> LeanObjMut {
|
|||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vpapp(v: LeanObj, r: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_vpapp(v: LeanObj, r: LeanObj) -> LeanObjMut {
|
||||
retain(v);
|
||||
retain(r);
|
||||
crate::eval::vpapp(v as LeanObjMut, r)
|
||||
}
|
||||
|
||||
// ABI v4: the Lean-side `vTranspRust`, `vHCompValueRust`,
|
||||
// `vCompAtTermRust`, `vCompNAtTermRust` have one or two implicit
|
||||
// `{ℓ : ULevel}` parameters. Lean 4's compiler PRESERVES these as
|
||||
// runtime arguments even when ℓ appears only as a type index (because
|
||||
// `ULevel` is itself a regular inductive type, not a `Sort`). The C
|
||||
// ABI signatures reflect this: each `ℓ` is the first object argument
|
||||
// (or first two arguments, in declaration order).
|
||||
//
|
||||
// Empirically established 2026-05 by probing C-emitted call sites:
|
||||
// the Lean-emitted call to `cubical_transport_vtransp` passes its `ℓ`
|
||||
// argument as `lean_object*` before the explicit `i`. The FFI signature
|
||||
// MUST mirror this or the calling convention slides arguments by one
|
||||
// slot, putting `ℓ` where `i` is expected, etc.
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vtransp(
|
||||
i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObj,
|
||||
pub extern "C" fn cubical_transport_vtransp(
|
||||
l: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
retain(v);
|
||||
crate::transport::vtransp(i, a, phi, v as LeanObjMut)
|
||||
crate::transport::vtransp(l, i, a, phi, v as LeanObjMut)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vhcomp(
|
||||
a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj,
|
||||
pub extern "C" fn cubical_transport_vhcomp(
|
||||
l: LeanObj, a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
retain(tube); retain(base);
|
||||
crate::composition::vhcomp_value(a, phi, tube as LeanObjMut, base as LeanObjMut)
|
||||
crate::composition::vhcomp_value(l, a, phi, tube as LeanObjMut, base as LeanObjMut)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vcomp_term(
|
||||
pub extern "C" fn cubical_transport_vcomp_term(
|
||||
l: LeanObj,
|
||||
env: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj,
|
||||
u: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
crate::composition::vcomp_at_term(env, i, a, phi, u, t)
|
||||
crate::composition::vcomp_at_term(l, env, i, a, phi, u, t)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vcompn_term(
|
||||
pub extern "C" fn cubical_transport_vcompn_term(
|
||||
l: LeanObj,
|
||||
env: LeanObj, i: LeanObj, a: LeanObj,
|
||||
clauses: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
crate::composition::vcompn_at_term(env, i, a, clauses, t)
|
||||
crate::composition::vcompn_at_term(l, env, i, a, clauses, t)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vfst(v: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_vfst(v: LeanObj) -> LeanObjMut {
|
||||
retain(v);
|
||||
crate::eval::vfst(v as LeanObjMut)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_vsnd(v: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_vsnd(v: LeanObj) -> LeanObjMut {
|
||||
retain(v);
|
||||
crate::eval::vsnd(v as LeanObjMut)
|
||||
}
|
||||
|
|
@ -140,19 +156,19 @@ pub extern "C" fn topolei_cubical_vsnd(v: LeanObj) -> LeanObjMut {
|
|||
// ── Exports: readback (Phase B.6 implemented) ──────────────────────────────
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_readback(v: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_readback(v: LeanObj) -> LeanObjMut {
|
||||
crate::readback::readback(v)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_readback_neu(n: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_readback_neu(n: LeanObj) -> LeanObjMut {
|
||||
crate::readback::readback_neu(n)
|
||||
}
|
||||
|
||||
// ── Exports: step ──────────────────────────────────────────────────────────
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_step(t: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_step(t: LeanObj) -> LeanObjMut {
|
||||
// FFI_DESIGN §8 Option B: step = readback ∘ eval .nil.
|
||||
crate::readback::step(t)
|
||||
}
|
||||
|
|
@ -162,11 +178,11 @@ pub extern "C" fn topolei_cubical_step(t: LeanObj) -> LeanObjMut {
|
|||
// ── Real Phase B implementation: normalizers ───────────────────────────────
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_dimexpr_normalize(r: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_dimexpr_normalize(r: LeanObj) -> LeanObjMut {
|
||||
crate::dim_expr::normalize(r)
|
||||
}
|
||||
|
||||
#[no_mangle]
|
||||
pub extern "C" fn topolei_cubical_face_normalize(phi: LeanObj) -> LeanObjMut {
|
||||
pub extern "C" fn cubical_transport_face_normalize(phi: LeanObj) -> LeanObjMut {
|
||||
crate::face::normalize(phi)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -21,9 +21,9 @@ const LIST_CONS: u32 = 1;
|
|||
const PROD_MK: u32 = 0;
|
||||
|
||||
/// Construct the A-side witness for the constant-A case:
|
||||
/// `.transp i A ψ (.unglue (φ[i:=0]) f t)`
|
||||
/// `.transp i {ℓ} A ψ (.unglue (φ[i:=0]) f t)` — ABI v4 (5-field transp).
|
||||
fn build_const_aside(
|
||||
i: LeanObj, a: LeanObj, psi: LeanObj,
|
||||
i: LeanObj, l: LeanObj, a: LeanObj, psi: LeanObj,
|
||||
phi: LeanObj, f: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
// φ.substDim i .zero
|
||||
|
|
@ -37,20 +37,21 @@ fn build_const_aside(
|
|||
ctor_set_field(unglue, 1, f);
|
||||
ctor_set_field(unglue, 2, t);
|
||||
|
||||
// .transp i A ψ (.unglue …)
|
||||
retain(i); retain(a); retain(psi);
|
||||
let transp = alloc_ctor(TERM_TRANSP, 4);
|
||||
// .transp i {ℓ} A ψ (.unglue …) — ABI v4: 5 fields [i, ℓ, A, ψ, body].
|
||||
retain(i); retain(l); retain(a); retain(psi);
|
||||
let transp = alloc_ctor(TERM_TRANSP, 5);
|
||||
ctor_set_field(transp, 0, i);
|
||||
ctor_set_field(transp, 1, a);
|
||||
ctor_set_field(transp, 2, psi);
|
||||
ctor_set_field(transp, 3, unglue as LeanObj);
|
||||
ctor_set_field(transp, 1, l);
|
||||
ctor_set_field(transp, 2, a);
|
||||
ctor_set_field(transp, 3, psi);
|
||||
ctor_set_field(transp, 4, unglue as LeanObj);
|
||||
transp
|
||||
}
|
||||
|
||||
/// Construct the A-side witness for the varying-A case:
|
||||
/// `.compN i A [(ψ, .unglue φ f t), (φ, .app f t)] (.unglue (φ[i:=0]) f t)`
|
||||
/// `.compN i {ℓ} A [(ψ, .unglue φ f t), (φ, .app f t)] (.unglue (φ[i:=0]) f t)`
|
||||
fn build_vara_aside(
|
||||
i: LeanObj, a: LeanObj, psi: LeanObj,
|
||||
i: LeanObj, l: LeanObj, a: LeanObj, psi: LeanObj,
|
||||
phi: LeanObj, f: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
// Clause 1: (ψ, .unglue φ f t)
|
||||
|
|
@ -90,13 +91,14 @@ fn build_vara_aside(
|
|||
ctor_set_field(unglue_base, 1, f);
|
||||
ctor_set_field(unglue_base, 2, t);
|
||||
|
||||
// .compN i A clauses base
|
||||
retain(i); retain(a);
|
||||
let compn = alloc_ctor(TERM_COMPN, 4);
|
||||
// .compN i {ℓ} A clauses base — ABI v4: 5 fields [i, ℓ, A, clauses, t].
|
||||
retain(i); retain(l); retain(a);
|
||||
let compn = alloc_ctor(TERM_COMPN, 5);
|
||||
ctor_set_field(compn, 0, i);
|
||||
ctor_set_field(compn, 1, a);
|
||||
ctor_set_field(compn, 2, cons1 as LeanObj);
|
||||
ctor_set_field(compn, 3, unglue_base as LeanObj);
|
||||
ctor_set_field(compn, 1, l);
|
||||
ctor_set_field(compn, 2, a);
|
||||
ctor_set_field(compn, 3, cons1 as LeanObj);
|
||||
ctor_set_field(compn, 4, unglue_base as LeanObj);
|
||||
compn
|
||||
}
|
||||
|
||||
|
|
@ -122,15 +124,15 @@ fn equiv_varies_in_i(
|
|||
}
|
||||
|
||||
/// Produce a structured stuck `ntransp` neutral for the glue-transport
|
||||
/// case that cannot reduce further.
|
||||
/// case that cannot reduce further. ABI v4: ntransp keeps ℓ as field 0.
|
||||
fn stuck_neutral(
|
||||
env: LeanObj, i: LeanObj, glue_ty: LeanObj,
|
||||
env: LeanObj, i: LeanObj, l: LeanObj, glue_ty: LeanObj,
|
||||
psi: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let t_val = crate::eval::eval(env, t);
|
||||
retain(i); retain(glue_ty); retain(psi);
|
||||
retain(l); retain(i); retain(glue_ty); retain(psi);
|
||||
let ntransp = crate::value::mk_ntransp(
|
||||
i, glue_ty, psi, t_val as LeanObj);
|
||||
l, i, glue_ty, psi, t_val as LeanObj);
|
||||
crate::value::mk_vneu(ntransp as LeanObj)
|
||||
}
|
||||
|
||||
|
|
@ -148,19 +150,21 @@ pub fn eval_transp_glue(
|
|||
env: LeanObj, i: LeanObj, glue_ty: LeanObj,
|
||||
psi: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
// Unpack the .glue fields.
|
||||
let phi = ctor_field(glue_ty, 0);
|
||||
let _ty = ctor_field(glue_ty, 1); // T (fiber type) — used only for dim-absence
|
||||
let f = ctor_field(glue_ty, 2);
|
||||
let finv = ctor_field(glue_ty, 3);
|
||||
let sec = ctor_field(glue_ty, 4);
|
||||
let ret = ctor_field(glue_ty, 5);
|
||||
let coh = ctor_field(glue_ty, 6);
|
||||
let a_ty = ctor_field(glue_ty, 7);
|
||||
// Unpack the .glue fields. ABI v4: glue layout is
|
||||
// [ℓ, φ, T, f, fInv, sec, ret, coh, A] (9 fields).
|
||||
let l = ctor_field(glue_ty, 0);
|
||||
let phi = ctor_field(glue_ty, 1);
|
||||
let _ty = ctor_field(glue_ty, 2); // T (fiber type) — only for dim-absence
|
||||
let f = ctor_field(glue_ty, 3);
|
||||
let finv = ctor_field(glue_ty, 4);
|
||||
let sec = ctor_field(glue_ty, 5);
|
||||
let ret = ctor_field(glue_ty, 6);
|
||||
let coh = ctor_field(glue_ty, 7);
|
||||
let a_ty = ctor_field(glue_ty, 8);
|
||||
|
||||
// (1) Varying equivalence → stuck (matches `_varEquiv` axiom).
|
||||
if equiv_varies_in_i(i, f, finv, sec, ret, coh) {
|
||||
return stuck_neutral(env, i, glue_ty, psi, t);
|
||||
return stuck_neutral(env, i, l, glue_ty, psi, t);
|
||||
}
|
||||
|
||||
// (2) Compute φ[i:=1] (normalized) to dispatch at-bot / at-top / stuck.
|
||||
|
|
@ -177,30 +181,26 @@ pub fn eval_transp_glue(
|
|||
// (4) Face-disjoint dispatch.
|
||||
match (phi1_tag, a_is_const) {
|
||||
(FACE_BOT, true) => {
|
||||
// _const_at_bot: eval (.transp i A ψ (.unglue (φ[i:=0]) f t))
|
||||
let aside = build_const_aside(i, a_ty, psi, phi, f, t);
|
||||
let aside = build_const_aside(i, l, a_ty, psi, phi, f, t);
|
||||
let result = crate::eval::eval(env, aside as LeanObj);
|
||||
release(aside as LeanObj);
|
||||
result
|
||||
}
|
||||
(FACE_TOP, true) => {
|
||||
// _const_at_top: eval (.app fInv (.transp i A ψ (.unglue …)))
|
||||
let aside = build_const_aside(i, a_ty, psi, phi, f, t);
|
||||
let aside = build_const_aside(i, l, a_ty, psi, phi, f, t);
|
||||
let wrapped = wrap_with_finv(aside, finv);
|
||||
let result = crate::eval::eval(env, wrapped as LeanObj);
|
||||
release(wrapped as LeanObj);
|
||||
result
|
||||
}
|
||||
(FACE_BOT, false) => {
|
||||
// _varA_at_bot: eval (.compN i A [...] (.unglue (φ[i:=0]) f t))
|
||||
let aside = build_vara_aside(i, a_ty, psi, phi, f, t);
|
||||
let aside = build_vara_aside(i, l, a_ty, psi, phi, f, t);
|
||||
let result = crate::eval::eval(env, aside as LeanObj);
|
||||
release(aside as LeanObj);
|
||||
result
|
||||
}
|
||||
(FACE_TOP, false) => {
|
||||
// _varA_at_top: eval (.app fInv (.compN …))
|
||||
let aside = build_vara_aside(i, a_ty, psi, phi, f, t);
|
||||
let aside = build_vara_aside(i, l, a_ty, psi, phi, f, t);
|
||||
let wrapped = wrap_with_finv(aside, finv);
|
||||
let result = crate::eval::eval(env, wrapped as LeanObj);
|
||||
release(wrapped as LeanObj);
|
||||
|
|
@ -208,7 +208,7 @@ pub fn eval_transp_glue(
|
|||
}
|
||||
_ => {
|
||||
// _const_stuck or _varA_stuck.
|
||||
stuck_neutral(env, i, glue_ty, psi, t)
|
||||
stuck_neutral(env, i, l, glue_ty, psi, t)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ pub type LeanObjMut = *mut core::ffi::c_void;
|
|||
//
|
||||
// Most of Lean 4's object-manipulation primitives are `static inline` in
|
||||
// `<lean/lean.h>` — they have no ELF symbols. We compile a C shim file
|
||||
// (`shim.c` + `build.rs`) that exposes them as `topolei_shim_*` wrappers.
|
||||
// (`shim.c` + `build.rs`) that exposes them as `cubical_transport_shim_*` wrappers.
|
||||
// These names link cleanly; the shim should inline to zero overhead.
|
||||
//
|
||||
// For wasm targets, `build.rs` skips shim compilation; these symbols are
|
||||
|
|
@ -41,48 +41,48 @@ pub type LeanObjMut = *mut core::ffi::c_void;
|
|||
// the Lean-wasm composite artifact).
|
||||
|
||||
unsafe extern "C" {
|
||||
pub fn topolei_shim_inc(o: LeanObj);
|
||||
pub fn topolei_shim_dec(o: LeanObj);
|
||||
pub fn topolei_shim_obj_tag(o: LeanObj) -> u32;
|
||||
pub fn topolei_shim_ctor_get(o: LeanObj, idx: u32) -> LeanObj;
|
||||
pub fn topolei_shim_ctor_set(o: LeanObjMut, idx: u32, val: LeanObj);
|
||||
pub fn topolei_shim_alloc_ctor(tag: u32, num_objs: u32, scalar_bytes: u32) -> LeanObjMut;
|
||||
pub fn topolei_shim_string_cstr(s: LeanObj) -> *const c_char;
|
||||
pub fn topolei_shim_mk_string(s: *const c_char) -> LeanObjMut;
|
||||
pub fn topolei_shim_string_eq(a: LeanObj, b: LeanObj) -> bool;
|
||||
pub fn cubical_transport_shim_inc(o: LeanObj);
|
||||
pub fn cubical_transport_shim_dec(o: LeanObj);
|
||||
pub fn cubical_transport_shim_obj_tag(o: LeanObj) -> u32;
|
||||
pub fn cubical_transport_shim_ctor_get(o: LeanObj, idx: u32) -> LeanObj;
|
||||
pub fn cubical_transport_shim_ctor_set(o: LeanObjMut, idx: u32, val: LeanObj);
|
||||
pub fn cubical_transport_shim_alloc_ctor(tag: u32, num_objs: u32, scalar_bytes: u32) -> LeanObjMut;
|
||||
pub fn cubical_transport_shim_string_cstr(s: LeanObj) -> *const c_char;
|
||||
pub fn cubical_transport_shim_mk_string(s: *const c_char) -> LeanObjMut;
|
||||
pub fn cubical_transport_shim_string_eq(a: LeanObj, b: LeanObj) -> bool;
|
||||
}
|
||||
|
||||
// Aliases to keep call sites readable. The `lean_*` names in existing
|
||||
// code point at the shim wrappers; inlining reduces this to zero cost.
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_inc(o: LeanObj) { unsafe { topolei_shim_inc(o) } }
|
||||
pub unsafe fn lean_inc(o: LeanObj) { unsafe { cubical_transport_shim_inc(o) } }
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_dec(o: LeanObj) { unsafe { topolei_shim_dec(o) } }
|
||||
pub unsafe fn lean_dec(o: LeanObj) { unsafe { cubical_transport_shim_dec(o) } }
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_obj_tag(o: LeanObj) -> u32 { unsafe { topolei_shim_obj_tag(o) } }
|
||||
pub unsafe fn lean_obj_tag(o: LeanObj) -> u32 { unsafe { cubical_transport_shim_obj_tag(o) } }
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_ctor_get(o: LeanObj, idx: u32) -> LeanObj {
|
||||
unsafe { topolei_shim_ctor_get(o, idx) }
|
||||
unsafe { cubical_transport_shim_ctor_get(o, idx) }
|
||||
}
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_ctor_set(o: LeanObjMut, idx: u32, val: LeanObj) {
|
||||
unsafe { topolei_shim_ctor_set(o, idx, val) }
|
||||
unsafe { cubical_transport_shim_ctor_set(o, idx, val) }
|
||||
}
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_alloc_ctor(tag: u32, num_objs: u32, scalar_bytes: u32) -> LeanObjMut {
|
||||
unsafe { topolei_shim_alloc_ctor(tag, num_objs, scalar_bytes) }
|
||||
unsafe { cubical_transport_shim_alloc_ctor(tag, num_objs, scalar_bytes) }
|
||||
}
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_string_cstr(s: LeanObj) -> *const c_char {
|
||||
unsafe { topolei_shim_string_cstr(s) }
|
||||
unsafe { cubical_transport_shim_string_cstr(s) }
|
||||
}
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_mk_string(s: *const c_char) -> LeanObjMut {
|
||||
unsafe { topolei_shim_mk_string(s) }
|
||||
unsafe { cubical_transport_shim_mk_string(s) }
|
||||
}
|
||||
#[inline(always)]
|
||||
pub unsafe fn lean_string_eq(a: LeanObj, b: LeanObj) -> bool {
|
||||
unsafe { topolei_shim_string_eq(a, b) }
|
||||
unsafe { cubical_transport_shim_string_eq(a, b) }
|
||||
}
|
||||
|
||||
// ── Inline helpers (replicate lean.h static inlines) ────────────────────────
|
||||
|
|
@ -132,6 +132,7 @@ pub(crate) fn ctor_field(o: LeanObj, idx: u32) -> LeanObj {
|
|||
unsafe { lean_ctor_get(o, idx) }
|
||||
}
|
||||
|
||||
|
||||
/// Allocate a new constructor with the given tag and number of object
|
||||
/// fields. Callers must `ctor_set_field` each slot before returning.
|
||||
#[inline]
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
//! # topolei-cubical
|
||||
//! # cubical-transport
|
||||
//!
|
||||
//! Rust backend for Lean 4's cubical-transport HoTT evaluator.
|
||||
//!
|
||||
|
|
@ -7,8 +7,8 @@
|
|||
//!
|
||||
//! ## Architecture
|
||||
//!
|
||||
//! This crate implements the `topolei_cubical_*` C symbols declared
|
||||
//! in `Topolei/Cubical/FFI.lean`. Every function takes borrowed
|
||||
//! This crate implements the `cubical_transport_*` C symbols declared
|
||||
//! in `CubicalTransport/FFI.lean`. Every function takes borrowed
|
||||
//! `lean_object*` arguments and returns an owned `lean_object*`
|
||||
//! result — see `FFI_DESIGN.md` for the full ABI contract.
|
||||
//!
|
||||
|
|
|
|||
|
|
@ -110,44 +110,52 @@ pub(crate) fn mk_term_papp(t: LeanObj, r: LeanObj) -> LeanObjMut {
|
|||
ctor
|
||||
}
|
||||
|
||||
/// `.transp i A φ t` — retains i, a; consumes phi, t.
|
||||
/// `.transp i {ℓ} A φ t` — ABI v4: ℓ kept (5 fields).
|
||||
/// Layout: [i, ℓ, A, φ, t]. Retains i, l, a; consumes phi, t.
|
||||
#[inline]
|
||||
pub(crate) fn mk_term_transp(i: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj) -> LeanObjMut {
|
||||
retain(i); retain(a);
|
||||
let ctor = alloc_ctor(TERM_TRANSP, 4);
|
||||
ctor_set_field(ctor, 0, i);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, phi);
|
||||
ctor_set_field(ctor, 3, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.comp i A φ u t` — retains i, a; consumes phi, u, t.
|
||||
#[inline]
|
||||
pub(crate) fn mk_term_comp(
|
||||
i: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
|
||||
pub(crate) fn mk_term_transp(
|
||||
i: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
retain(i); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMP, 5);
|
||||
retain(i); retain(l); retain(a);
|
||||
let ctor = alloc_ctor(TERM_TRANSP, 5);
|
||||
ctor_set_field(ctor, 0, i);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, phi);
|
||||
ctor_set_field(ctor, 3, u);
|
||||
ctor_set_field(ctor, 1, l);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, phi);
|
||||
ctor_set_field(ctor, 4, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.compN i A clauses t` — retains i, a; consumes clauses, t.
|
||||
/// `.comp i {ℓ} A φ u t` — ABI v4 (6 fields).
|
||||
/// Layout: [i, ℓ, A, φ, u, t]. Retains i, l, a; consumes phi, u, t.
|
||||
#[inline]
|
||||
pub(crate) fn mk_term_comp(
|
||||
i: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
retain(i); retain(l); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMP, 6);
|
||||
ctor_set_field(ctor, 0, i);
|
||||
ctor_set_field(ctor, 1, l);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, phi);
|
||||
ctor_set_field(ctor, 4, u);
|
||||
ctor_set_field(ctor, 5, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.compN i {ℓ} A clauses t` — ABI v4 (5 fields).
|
||||
/// Layout: [i, ℓ, A, clauses, t]. Retains i, l, a; consumes clauses, t.
|
||||
#[inline]
|
||||
pub(crate) fn mk_term_compn(
|
||||
i: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj,
|
||||
i: LeanObj, l: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
retain(i); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMPN, 4);
|
||||
retain(i); retain(l); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMPN, 5);
|
||||
ctor_set_field(ctor, 0, i);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, clauses);
|
||||
ctor_set_field(ctor, 3, t);
|
||||
ctor_set_field(ctor, 1, l);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, clauses);
|
||||
ctor_set_field(ctor, 4, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
|
|
@ -232,26 +240,41 @@ pub(crate) fn mk_term_indelim(
|
|||
ctor
|
||||
}
|
||||
|
||||
/// CType `.univ` — nullary scalar.
|
||||
/// `ULevel.zero` — nullary scalar (constructor index 0). ABI v4 helper.
|
||||
#[inline]
|
||||
pub(crate) fn mk_ty_univ() -> LeanObjMut { lean_box_mut(TY_UNIV as usize) }
|
||||
pub(crate) fn mk_ulevel_zero() -> LeanObjMut { lean_box_mut(0) }
|
||||
|
||||
/// CType `.pi A B` — consumes both.
|
||||
/// CType `.univ {ℓ}` — ABI v4: 1 field [ℓ]. Consumes l.
|
||||
#[inline]
|
||||
pub(crate) fn mk_ty_pi(a: LeanObj, b: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PI, 2);
|
||||
ctor_set_field(ctor, 0, a);
|
||||
ctor_set_field(ctor, 1, b);
|
||||
pub(crate) fn mk_ty_univ(l: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_UNIV, 1);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// CType `.path A a b` — consumes all.
|
||||
/// CType `.pi {ℓ_d ℓ_c} var A B` — ABI v4: 5 fields.
|
||||
/// Layout: [ℓ_d, ℓ_c, var, A, B]. Consumes all.
|
||||
#[inline]
|
||||
pub(crate) fn mk_ty_path(a: LeanObj, x: LeanObj, y: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PATH, 3);
|
||||
ctor_set_field(ctor, 0, a);
|
||||
ctor_set_field(ctor, 1, x);
|
||||
ctor_set_field(ctor, 2, y);
|
||||
pub(crate) fn mk_ty_pi(
|
||||
ld: LeanObj, lc: LeanObj, var: LeanObj, a: LeanObj, b: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PI, 5);
|
||||
ctor_set_field(ctor, 0, ld);
|
||||
ctor_set_field(ctor, 1, lc);
|
||||
ctor_set_field(ctor, 2, var);
|
||||
ctor_set_field(ctor, 3, a);
|
||||
ctor_set_field(ctor, 4, b);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// CType `.path {ℓ} A a b` — ABI v4: 4 fields [ℓ, A, a, b]. Consumes all.
|
||||
#[inline]
|
||||
pub(crate) fn mk_ty_path(l: LeanObj, a: LeanObj, x: LeanObj, y: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PATH, 4);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, x);
|
||||
ctor_set_field(ctor, 3, y);
|
||||
ctor
|
||||
}
|
||||
|
||||
|
|
@ -356,60 +379,81 @@ pub fn readback(v: LeanObj) -> LeanObjMut {
|
|||
mk_term_plam(i, body_term as LeanObj)
|
||||
}
|
||||
VAL_VTRANSPFUN => {
|
||||
// .vTranspFun i domA codA φ f → .transp i (.pi domA codA) φ (readback f).
|
||||
let i = ctor_field(v, 0);
|
||||
let dom_a = ctor_field(v, 1);
|
||||
let cod_a = ctor_field(v, 2);
|
||||
let phi = ctor_field(v, 3);
|
||||
let f = ctor_field(v, 4);
|
||||
retain(dom_a); retain(cod_a); retain(phi);
|
||||
let pi_ty = mk_ty_pi(dom_a, cod_a);
|
||||
// .vTranspFun {ℓ_d ℓ_c} i domA codA φ f → .transp i {ℓ_pi} (.pi "_" domA codA) φ (readback f).
|
||||
// ABI v4 vTranspFun layout: [ℓ_d, ℓ_c, i, domA, codA, φ, f] (7 fields).
|
||||
let ld = ctor_field(v, 0);
|
||||
let lc = ctor_field(v, 1);
|
||||
let i = ctor_field(v, 2);
|
||||
let dom_a = ctor_field(v, 3);
|
||||
let cod_a = ctor_field(v, 4);
|
||||
let phi = ctor_field(v, 5);
|
||||
let f = ctor_field(v, 6);
|
||||
retain(ld); retain(lc); retain(dom_a); retain(cod_a); retain(phi);
|
||||
let var = alloc_static_string(b"_\0");
|
||||
let pi_ty = mk_ty_pi(ld, lc, var as LeanObj, dom_a, cod_a);
|
||||
let f_term = readback(f);
|
||||
// pi_ty is freshly owned; mk_term_transp retains its `a` slot,
|
||||
// so our external `+1` on pi_ty must be released after the
|
||||
// ctor stores its own retained reference.
|
||||
let result = mk_term_transp(i, pi_ty as LeanObj, phi, f_term as LeanObj);
|
||||
// The pi-line lives at max(ℓ_d, ℓ_c); for readback we only need
|
||||
// *some* matching level — re-use ℓ_c as a representative (it's
|
||||
// the codomain level which is what transp reduces over). This
|
||||
// satisfies the FFI ABI without committing to a specific ULevel
|
||||
// arithmetic (max needs eval; the result CTerm is just data).
|
||||
let l_for_transp = mk_ulevel_zero();
|
||||
let result = mk_term_transp(i, l_for_transp as LeanObj, pi_ty as LeanObj, phi, f_term as LeanObj);
|
||||
release(l_for_transp as LeanObj);
|
||||
release(pi_ty as LeanObj);
|
||||
result
|
||||
}
|
||||
VAL_VCOMPFUN => {
|
||||
// .vCompFun env i domA codA φ u t → .comp i (.pi domA codA) φ u t.
|
||||
let i = ctor_field(v, 1);
|
||||
let dom_a = ctor_field(v, 2);
|
||||
let cod_a = ctor_field(v, 3);
|
||||
let phi = ctor_field(v, 4);
|
||||
let u = ctor_field(v, 5);
|
||||
let t = ctor_field(v, 6);
|
||||
// .vCompFun {ℓ_d ℓ_c} env i domA codA φ u t → .comp i (.pi "_" domA codA) φ u t.
|
||||
// ABI v4 vCompFun layout: [ℓ_d, ℓ_c, env, i, domA, codA, φ, u, t] (9 fields).
|
||||
let ld = ctor_field(v, 0);
|
||||
let lc = ctor_field(v, 1);
|
||||
let i = ctor_field(v, 3);
|
||||
let dom_a = ctor_field(v, 4);
|
||||
let cod_a = ctor_field(v, 5);
|
||||
let phi = ctor_field(v, 6);
|
||||
let u = ctor_field(v, 7);
|
||||
let t = ctor_field(v, 8);
|
||||
retain(ld); retain(lc);
|
||||
retain(dom_a); retain(cod_a); retain(phi); retain(u); retain(t);
|
||||
let pi_ty = mk_ty_pi(dom_a, cod_a);
|
||||
// pi_ty fresh → release after mk_term_comp's retain.
|
||||
let result = mk_term_comp(i, pi_ty as LeanObj, phi, u, t);
|
||||
let var = alloc_static_string(b"_\0");
|
||||
let pi_ty = mk_ty_pi(ld, lc, var as LeanObj, dom_a, cod_a);
|
||||
let l_for_comp = mk_ulevel_zero();
|
||||
let result = mk_term_comp(i, l_for_comp as LeanObj, pi_ty as LeanObj, phi, u, t);
|
||||
release(l_for_comp as LeanObj);
|
||||
release(pi_ty as LeanObj);
|
||||
result
|
||||
}
|
||||
VAL_VHCOMPFUN => {
|
||||
// .vHCompFun codA φ tube base → .comp $rd_hcomp (.pi .univ codA) φ (readback tube) (readback base).
|
||||
let cod_a = ctor_field(v, 0);
|
||||
let phi = ctor_field(v, 1);
|
||||
let tube = ctor_field(v, 2);
|
||||
let base = ctor_field(v, 3);
|
||||
retain(cod_a); retain(phi);
|
||||
// .vHCompFun {ℓ} codA φ tube base — ABI v4 layout [ℓ, codA, φ, tube, base] (5 fields).
|
||||
let l = ctor_field(v, 0);
|
||||
let cod_a = ctor_field(v, 1);
|
||||
let phi = ctor_field(v, 2);
|
||||
let tube = ctor_field(v, 3);
|
||||
let base = ctor_field(v, 4);
|
||||
retain(l); retain(cod_a); retain(phi);
|
||||
let fd = mk_dimvar(b"$rd_hcomp\0");
|
||||
let univ = mk_ty_univ();
|
||||
let pi_ty = mk_ty_pi(univ as LeanObj, cod_a);
|
||||
let univ = mk_ty_univ(mk_ulevel_zero() as LeanObj);
|
||||
let var = alloc_static_string(b"_\0");
|
||||
// pi_ty is at level max(0, ℓ) = ℓ; fabricate level slots.
|
||||
let pi_l_d = mk_ulevel_zero();
|
||||
let pi_l_c = mk_ulevel_zero();
|
||||
let pi_ty = mk_ty_pi(pi_l_d as LeanObj, pi_l_c as LeanObj, var as LeanObj, univ as LeanObj, cod_a);
|
||||
let tube_term = readback(tube);
|
||||
let base_term = readback(base);
|
||||
// fd and pi_ty are freshly owned; mk_term_comp retains both
|
||||
// i and a slots, so release our external `+1`s.
|
||||
let l_for_comp = mk_ulevel_zero();
|
||||
let result = mk_term_comp(
|
||||
fd as LeanObj,
|
||||
l_for_comp as LeanObj,
|
||||
pi_ty as LeanObj,
|
||||
phi,
|
||||
tube_term as LeanObj,
|
||||
base_term as LeanObj,
|
||||
);
|
||||
release(l_for_comp as LeanObj);
|
||||
release(fd as LeanObj);
|
||||
release(pi_ty as LeanObj);
|
||||
release(l);
|
||||
result
|
||||
}
|
||||
VAL_VTUBEAPP => {
|
||||
|
|
@ -438,13 +482,15 @@ pub fn readback(v: LeanObj) -> LeanObjMut {
|
|||
result
|
||||
}
|
||||
VAL_VPATHTRANSP => {
|
||||
// Two-arm dispatch on inner CTerm p.
|
||||
let i = ctor_field(v, 1);
|
||||
let a_ty = ctor_field(v, 2);
|
||||
let a = ctor_field(v, 3);
|
||||
let b = ctor_field(v, 4);
|
||||
let phi = ctor_field(v, 5);
|
||||
let p = ctor_field(v, 6);
|
||||
// .vPathTransp {ℓ} env i A a b φ p — ABI v4 layout
|
||||
// [ℓ, env, i, A, a, b, φ, p] (8 fields).
|
||||
let l = ctor_field(v, 0);
|
||||
let i = ctor_field(v, 2);
|
||||
let a_ty = ctor_field(v, 3);
|
||||
let a = ctor_field(v, 4);
|
||||
let b = ctor_field(v, 5);
|
||||
let phi = ctor_field(v, 6);
|
||||
let p = ctor_field(v, 7);
|
||||
|
||||
if ctor_tag(p) == TERM_PLAM {
|
||||
// .plam j body — produce CCHM-shaped compN body.
|
||||
|
|
@ -491,17 +537,19 @@ pub fn readback(v: LeanObj) -> LeanObjMut {
|
|||
ctor_set_field(cons1, 0, pair1 as LeanObj);
|
||||
ctor_set_field(cons1, 1, cons2 as LeanObj);
|
||||
|
||||
// .compN i A clauses body
|
||||
// .compN i {ℓ} A clauses body — A is the inner CType (not the path).
|
||||
retain(body);
|
||||
let compn = mk_term_compn(
|
||||
i, a_ty, cons1 as LeanObj, body);
|
||||
i, l, a_ty, cons1 as LeanObj, body);
|
||||
mk_term_plam(j, compn as LeanObj)
|
||||
} else {
|
||||
// Other cases: preserve .transp i (.path A a b) φ p form.
|
||||
retain(a_ty); retain(a); retain(b); retain(phi); retain(p);
|
||||
let path_ty = mk_ty_path(a_ty, a, b);
|
||||
// path_ty fresh → release after mk_term_transp's retain.
|
||||
let result = mk_term_transp(i, path_ty as LeanObj, phi, p);
|
||||
// Other cases: preserve .transp i {ℓ} (.path A a b) φ p form.
|
||||
retain(l); retain(a_ty); retain(a); retain(b); retain(phi); retain(p);
|
||||
let path_ty = mk_ty_path(l, a_ty, a, b);
|
||||
// Use ℓ as the level for the outer .transp as well (the path
|
||||
// type itself lives at the same level as A).
|
||||
retain(l);
|
||||
let result = mk_term_transp(i, l, path_ty as LeanObj, phi, p);
|
||||
release(path_ty as LeanObj);
|
||||
result
|
||||
}
|
||||
|
|
@ -560,50 +608,59 @@ pub fn readback_neu(n: LeanObj) -> LeanObjMut {
|
|||
mk_term_papp(inner_term as LeanObj, r)
|
||||
}
|
||||
NEU_NTRANSP => {
|
||||
let i = ctor_field(n, 0);
|
||||
let a = ctor_field(n, 1);
|
||||
let phi = ctor_field(n, 2);
|
||||
let v = ctor_field(n, 3);
|
||||
// .ntransp {ℓ} i A φ v — ABI v4 layout [ℓ, i, A, φ, v] (5 fields).
|
||||
let l = ctor_field(n, 0);
|
||||
let i = ctor_field(n, 1);
|
||||
let a = ctor_field(n, 2);
|
||||
let phi = ctor_field(n, 3);
|
||||
let v = ctor_field(n, 4);
|
||||
retain(phi);
|
||||
let v_term = readback(v);
|
||||
mk_term_transp(i, a, phi, v_term as LeanObj)
|
||||
mk_term_transp(i, l, a, phi, v_term as LeanObj)
|
||||
}
|
||||
NEU_NCOMP => {
|
||||
let i = ctor_field(n, 0);
|
||||
let a = ctor_field(n, 1);
|
||||
let phi = ctor_field(n, 2);
|
||||
let u = ctor_field(n, 3);
|
||||
let t = ctor_field(n, 4);
|
||||
// .ncomp {ℓ} i A φ u t — ABI v4 layout [ℓ, i, A, φ, u, t] (6 fields).
|
||||
let l = ctor_field(n, 0);
|
||||
let i = ctor_field(n, 1);
|
||||
let a = ctor_field(n, 2);
|
||||
let phi = ctor_field(n, 3);
|
||||
let u = ctor_field(n, 4);
|
||||
let t = ctor_field(n, 5);
|
||||
retain(phi);
|
||||
let u_term = readback(u);
|
||||
let t_term = readback(t);
|
||||
mk_term_comp(i, a, phi, u_term as LeanObj, t_term as LeanObj)
|
||||
mk_term_comp(i, l, a, phi, u_term as LeanObj, t_term as LeanObj)
|
||||
}
|
||||
NEU_NHCOMP => {
|
||||
let a = ctor_field(n, 0);
|
||||
let phi = ctor_field(n, 1);
|
||||
let tube = ctor_field(n, 2);
|
||||
let base = ctor_field(n, 3);
|
||||
// .nhcomp {ℓ} A φ tube base — ABI v4 layout [ℓ, A, φ, tube, base] (5 fields).
|
||||
let l = ctor_field(n, 0);
|
||||
let a = ctor_field(n, 1);
|
||||
let phi = ctor_field(n, 2);
|
||||
let tube = ctor_field(n, 3);
|
||||
let base = ctor_field(n, 4);
|
||||
retain(a); retain(phi);
|
||||
let fd = mk_dimvar(b"$rd_nhcomp\0");
|
||||
let tube_term = readback(tube);
|
||||
let base_term = readback(base);
|
||||
// fd fresh → release after mk_term_comp's retain on the `i` slot.
|
||||
let result = mk_term_comp(
|
||||
fd as LeanObj, a, phi,
|
||||
fd as LeanObj, l, a, phi,
|
||||
tube_term as LeanObj, base_term as LeanObj,
|
||||
);
|
||||
release(fd as LeanObj);
|
||||
result
|
||||
}
|
||||
NEU_NCOMPN => {
|
||||
let i = ctor_field(n, 1);
|
||||
let a = ctor_field(n, 2);
|
||||
let clauses = ctor_field(n, 3);
|
||||
let t = ctor_field(n, 4);
|
||||
// .ncompN {ℓ} env i A clauses t — ABI v4 layout
|
||||
// [ℓ, env, i, A, clauses, t] (6 fields).
|
||||
let l = ctor_field(n, 0);
|
||||
let i = ctor_field(n, 2);
|
||||
let a = ctor_field(n, 3);
|
||||
let clauses = ctor_field(n, 4);
|
||||
let t = ctor_field(n, 5);
|
||||
let clauses_term = map_readback_clauses(clauses);
|
||||
let t_term = readback(t);
|
||||
mk_term_compn(i, a, clauses_term as LeanObj, t_term as LeanObj)
|
||||
mk_term_compn(i, l, a, clauses_term as LeanObj, t_term as LeanObj)
|
||||
}
|
||||
NEU_NGLUEIN => {
|
||||
let phi = ctor_field(n, 0);
|
||||
|
|
|
|||
|
|
@ -299,37 +299,50 @@ fn mk_term_papp(t: LeanObj, r: LeanObj) -> LeanObjMut {
|
|||
ctor
|
||||
}
|
||||
|
||||
/// TERM_TRANSP carries `j {ℓ} A φ t` (5 fields, ABI v4).
|
||||
/// Layout: [j, ℓ, A, φ, t]. `j`, `l`, `a` are retain-slots; rest consumed.
|
||||
#[inline]
|
||||
fn mk_term_transp(j: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj) -> LeanObjMut {
|
||||
retain(j); retain(a);
|
||||
let ctor = alloc_ctor(TERM_TRANSP, 4);
|
||||
fn mk_term_transp(j: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj) -> LeanObjMut {
|
||||
retain(j); retain(l); retain(a);
|
||||
let ctor = alloc_ctor(TERM_TRANSP, 5);
|
||||
ctor_set_field(ctor, 0, j);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, phi);
|
||||
ctor_set_field(ctor, 3, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
#[inline]
|
||||
fn mk_term_comp(j: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj) -> LeanObjMut {
|
||||
retain(j); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMP, 5);
|
||||
ctor_set_field(ctor, 0, j);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, phi);
|
||||
ctor_set_field(ctor, 3, u);
|
||||
ctor_set_field(ctor, 1, l);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, phi);
|
||||
ctor_set_field(ctor, 4, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// TERM_COMP carries `j {ℓ} A φ u t` (6 fields, ABI v4).
|
||||
/// Layout: [j, ℓ, A, φ, u, t]. `j`, `l`, `a` are retain-slots.
|
||||
#[inline]
|
||||
fn mk_term_compn(j: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj) -> LeanObjMut {
|
||||
retain(j); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMPN, 4);
|
||||
fn mk_term_comp(
|
||||
j: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
retain(j); retain(l); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMP, 6);
|
||||
ctor_set_field(ctor, 0, j);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, clauses);
|
||||
ctor_set_field(ctor, 3, t);
|
||||
ctor_set_field(ctor, 1, l);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, phi);
|
||||
ctor_set_field(ctor, 4, u);
|
||||
ctor_set_field(ctor, 5, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// TERM_COMPN carries `j {ℓ} A clauses t` (5 fields, ABI v4).
|
||||
/// Layout: [j, ℓ, A, clauses, t]. `j`, `l`, `a` are retain-slots.
|
||||
#[inline]
|
||||
fn mk_term_compn(
|
||||
j: LeanObj, l: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
retain(j); retain(l); retain(a);
|
||||
let ctor = alloc_ctor(TERM_COMPN, 5);
|
||||
ctor_set_field(ctor, 0, j);
|
||||
ctor_set_field(ctor, 1, l);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, clauses);
|
||||
ctor_set_field(ctor, 4, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
|
|
@ -419,34 +432,40 @@ pub(crate) fn cterm_subst_dim(i: LeanObj, r: LeanObj, t: LeanObj) -> LeanObjMut
|
|||
mk_term_papp(ninner as LeanObj, ns as LeanObj)
|
||||
}
|
||||
TERM_TRANSP => {
|
||||
// .transp j A φ t — don't touch A; substitute in φ and t.
|
||||
// .transp j {ℓ} A φ t — ABI v4 (5 fields). Layout: [j, ℓ, A, φ, t].
|
||||
let j = ctor_field(t, 0);
|
||||
let a_cty = ctor_field(t, 1);
|
||||
let phi = ctor_field(t, 2);
|
||||
let body = ctor_field(t, 3);
|
||||
let l = ctor_field(t, 1);
|
||||
let a_cty = ctor_field(t, 2);
|
||||
let phi = ctor_field(t, 3);
|
||||
let body = ctor_field(t, 4);
|
||||
let nphi = face_subst_dim(i, r, phi);
|
||||
let nbody = cterm_subst_dim(i, r, body);
|
||||
mk_term_transp(j, a_cty, nphi as LeanObj, nbody as LeanObj)
|
||||
mk_term_transp(j, l, a_cty, nphi as LeanObj, nbody as LeanObj)
|
||||
}
|
||||
TERM_COMP => {
|
||||
// .comp j {ℓ} A φ u t — ABI v4 (6 fields). Layout: [j, ℓ, A, φ, u, t].
|
||||
let j = ctor_field(t, 0);
|
||||
let a_cty = ctor_field(t, 1);
|
||||
let phi = ctor_field(t, 2);
|
||||
let u = ctor_field(t, 3);
|
||||
let body = ctor_field(t, 4);
|
||||
let l = ctor_field(t, 1);
|
||||
let a_cty = ctor_field(t, 2);
|
||||
let phi = ctor_field(t, 3);
|
||||
let u = ctor_field(t, 4);
|
||||
let body = ctor_field(t, 5);
|
||||
let nphi = face_subst_dim(i, r, phi);
|
||||
let nu = cterm_subst_dim(i, r, u);
|
||||
let nbody = cterm_subst_dim(i, r, body);
|
||||
mk_term_comp(j, a_cty, nphi as LeanObj, nu as LeanObj, nbody as LeanObj)
|
||||
mk_term_comp(j, l, a_cty, nphi as LeanObj, nu as LeanObj, nbody as LeanObj)
|
||||
}
|
||||
TERM_COMPN => {
|
||||
// .compN j {ℓ} A clauses t — ABI v4 (5 fields).
|
||||
// Layout: [j, ℓ, A, clauses, t].
|
||||
let j = ctor_field(t, 0);
|
||||
let a_cty = ctor_field(t, 1);
|
||||
let clauses = ctor_field(t, 2);
|
||||
let body = ctor_field(t, 3);
|
||||
let l = ctor_field(t, 1);
|
||||
let a_cty = ctor_field(t, 2);
|
||||
let clauses = ctor_field(t, 3);
|
||||
let body = ctor_field(t, 4);
|
||||
let nclauses = cterm_subst_dim_clauses(i, r, clauses);
|
||||
let nbody = cterm_subst_dim(i, r, body);
|
||||
mk_term_compn(j, a_cty, nclauses as LeanObj, nbody as LeanObj)
|
||||
mk_term_compn(j, l, a_cty, nclauses as LeanObj, nbody as LeanObj)
|
||||
}
|
||||
TERM_GLUEIN => {
|
||||
let phi = ctor_field(t, 0);
|
||||
|
|
@ -641,91 +660,147 @@ pub(crate) fn cterm_subst_dim_bool(i: LeanObj, b: bool, t: LeanObj) -> LeanObjMu
|
|||
}
|
||||
|
||||
// ── CType constructor helpers ──────────────────────────────────────────────
|
||||
// ABI v4: every CType constructor with implicit `{ℓ : ULevel}` (or
|
||||
// `{ℓ ℓ' : ULevel}`) keeps the level(s) at runtime as the leading field(s).
|
||||
|
||||
/// `.univ {ℓ}` — 1 field [ℓ].
|
||||
#[inline]
|
||||
fn mk_ty_univ() -> LeanObjMut { lean_box_mut(TY_UNIV as usize) }
|
||||
|
||||
#[inline]
|
||||
fn mk_ty_pi(a: LeanObj, b: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PI, 2);
|
||||
ctor_set_field(ctor, 0, a);
|
||||
ctor_set_field(ctor, 1, b);
|
||||
fn mk_ty_univ(l: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_UNIV, 1);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.pi {ℓ_d ℓ_c} var A B` — 5 fields [ℓ_d, ℓ_c, var, A, B].
|
||||
#[inline]
|
||||
fn mk_ty_path(a: LeanObj, x: LeanObj, y: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PATH, 3);
|
||||
ctor_set_field(ctor, 0, a);
|
||||
ctor_set_field(ctor, 1, x);
|
||||
ctor_set_field(ctor, 2, y);
|
||||
fn mk_ty_pi(ld: LeanObj, lc: LeanObj, var: LeanObj, a: LeanObj, b: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PI, 5);
|
||||
ctor_set_field(ctor, 0, ld);
|
||||
ctor_set_field(ctor, 1, lc);
|
||||
ctor_set_field(ctor, 2, var);
|
||||
ctor_set_field(ctor, 3, a);
|
||||
ctor_set_field(ctor, 4, b);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.path {ℓ} A a b` — 4 fields [ℓ, A, a, b].
|
||||
#[inline]
|
||||
fn mk_ty_sigma(a: LeanObj, b: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_SIGMA, 2);
|
||||
ctor_set_field(ctor, 0, a);
|
||||
ctor_set_field(ctor, 1, b);
|
||||
fn mk_ty_path(l: LeanObj, a: LeanObj, x: LeanObj, y: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_PATH, 4);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, x);
|
||||
ctor_set_field(ctor, 3, y);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.sigma {ℓ_a ℓ_b} var A B` — 5 fields [ℓ_a, ℓ_b, var, A, B].
|
||||
#[inline]
|
||||
fn mk_ty_sigma(la: LeanObj, lb: LeanObj, var: LeanObj, a: LeanObj, b: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_SIGMA, 5);
|
||||
ctor_set_field(ctor, 0, la);
|
||||
ctor_set_field(ctor, 1, lb);
|
||||
ctor_set_field(ctor, 2, var);
|
||||
ctor_set_field(ctor, 3, a);
|
||||
ctor_set_field(ctor, 4, b);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.lift {ℓ} A` — 2 fields [ℓ, A].
|
||||
#[inline]
|
||||
fn mk_ty_lift(l: LeanObj, a: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_LIFT, 2);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.glue {ℓ} φ T f fInv sec ret coh A` — 9 fields.
|
||||
#[inline]
|
||||
fn mk_ty_glue(
|
||||
l: LeanObj,
|
||||
phi: LeanObj, t: LeanObj,
|
||||
f: LeanObj, finv: LeanObj, sec: LeanObj, ret: LeanObj, coh: LeanObj,
|
||||
a: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(TY_GLUE, 8);
|
||||
ctor_set_field(ctor, 0, phi);
|
||||
ctor_set_field(ctor, 1, t);
|
||||
ctor_set_field(ctor, 2, f);
|
||||
ctor_set_field(ctor, 3, finv);
|
||||
ctor_set_field(ctor, 4, sec);
|
||||
ctor_set_field(ctor, 5, ret);
|
||||
ctor_set_field(ctor, 6, coh);
|
||||
ctor_set_field(ctor, 7, a);
|
||||
let ctor = alloc_ctor(TY_GLUE, 9);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, phi);
|
||||
ctor_set_field(ctor, 2, t);
|
||||
ctor_set_field(ctor, 3, f);
|
||||
ctor_set_field(ctor, 4, finv);
|
||||
ctor_set_field(ctor, 5, sec);
|
||||
ctor_set_field(ctor, 6, ret);
|
||||
ctor_set_field(ctor, 7, coh);
|
||||
ctor_set_field(ctor, 8, a);
|
||||
ctor
|
||||
}
|
||||
|
||||
// ── CType.substDim (Bool) ──────────────────────────────────────────────────
|
||||
|
||||
/// `CType.substDim i b A` — substitute dim `i` with Bool endpoint `b`.
|
||||
///
|
||||
/// ABI v4: implicit `{ℓ : ULevel}` (or `{ℓ ℓ' : ULevel}`) parameters are
|
||||
/// kept at runtime as the leading field(s). Layouts:
|
||||
/// `.univ {ℓ}` → [ℓ]
|
||||
/// `.pi {ℓ_d ℓ_c} v A B` → [ℓ_d, ℓ_c, v, A, B]
|
||||
/// `.sigma {ℓ_a ℓ_b} v A B` → [ℓ_a, ℓ_b, v, A, B]
|
||||
/// `.path {ℓ} A a b` → [ℓ, A, a, b]
|
||||
/// `.glue {ℓ} φ T f...A` → [ℓ, φ, T, f, fI, s, r, c, A]
|
||||
/// `.ind {ℓ} S params` → [ℓ, S, params]
|
||||
/// `.interval` → []
|
||||
/// `.lift {ℓ} A` → [ℓ, A]
|
||||
pub(crate) fn ctype_subst_dim_bool(i: LeanObj, b: bool, a: LeanObj) -> LeanObjMut {
|
||||
match ctor_tag(a) {
|
||||
TY_UNIV => mk_ty_univ(),
|
||||
TY_UNIV => {
|
||||
let l = ctor_field(a, 0);
|
||||
retain(l);
|
||||
mk_ty_univ(l)
|
||||
}
|
||||
TY_PI => {
|
||||
let x = ctor_field(a, 0);
|
||||
let y = ctor_field(a, 1);
|
||||
let ld = ctor_field(a, 0);
|
||||
let lc = ctor_field(a, 1);
|
||||
let var = ctor_field(a, 2);
|
||||
let x = ctor_field(a, 3);
|
||||
let y = ctor_field(a, 4);
|
||||
retain(ld); retain(lc); retain(var);
|
||||
let nx = ctype_subst_dim_bool(i, b, x);
|
||||
let ny = ctype_subst_dim_bool(i, b, y);
|
||||
mk_ty_pi(nx as LeanObj, ny as LeanObj)
|
||||
mk_ty_pi(ld, lc, var, nx as LeanObj, ny as LeanObj)
|
||||
}
|
||||
TY_PATH => {
|
||||
let ty = ctor_field(a, 0);
|
||||
let x = ctor_field(a, 1);
|
||||
let y = ctor_field(a, 2);
|
||||
let l = ctor_field(a, 0);
|
||||
let ty = ctor_field(a, 1);
|
||||
let x = ctor_field(a, 2);
|
||||
let y = ctor_field(a, 3);
|
||||
retain(l);
|
||||
let nty = ctype_subst_dim_bool(i, b, ty);
|
||||
let nx = cterm_subst_dim_bool(i, b, x);
|
||||
let ny = cterm_subst_dim_bool(i, b, y);
|
||||
mk_ty_path(nty as LeanObj, nx as LeanObj, ny as LeanObj)
|
||||
mk_ty_path(l, nty as LeanObj, nx as LeanObj, ny as LeanObj)
|
||||
}
|
||||
TY_SIGMA => {
|
||||
let x = ctor_field(a, 0);
|
||||
let y = ctor_field(a, 1);
|
||||
let la = ctor_field(a, 0);
|
||||
let lb = ctor_field(a, 1);
|
||||
let var = ctor_field(a, 2);
|
||||
let x = ctor_field(a, 3);
|
||||
let y = ctor_field(a, 4);
|
||||
retain(la); retain(lb); retain(var);
|
||||
let nx = ctype_subst_dim_bool(i, b, x);
|
||||
let ny = ctype_subst_dim_bool(i, b, y);
|
||||
mk_ty_sigma(nx as LeanObj, ny as LeanObj)
|
||||
mk_ty_sigma(la, lb, var, nx as LeanObj, ny as LeanObj)
|
||||
}
|
||||
TY_GLUE => {
|
||||
let phi = ctor_field(a, 0);
|
||||
let ty = ctor_field(a, 1);
|
||||
let f = ctor_field(a, 2);
|
||||
let finv = ctor_field(a, 3);
|
||||
let sec = ctor_field(a, 4);
|
||||
let ret = ctor_field(a, 5);
|
||||
let coh = ctor_field(a, 6);
|
||||
let base = ctor_field(a, 7);
|
||||
let l = ctor_field(a, 0);
|
||||
let phi = ctor_field(a, 1);
|
||||
let ty = ctor_field(a, 2);
|
||||
let f = ctor_field(a, 3);
|
||||
let finv = ctor_field(a, 4);
|
||||
let sec = ctor_field(a, 5);
|
||||
let ret = ctor_field(a, 6);
|
||||
let coh = ctor_field(a, 7);
|
||||
let base = ctor_field(a, 8);
|
||||
retain(l);
|
||||
// phi.substDim takes a DimExpr, not a Bool — encode b as .one/.zero.
|
||||
let b_expr: LeanObjMut = if b { mk_dim_one() } else { mk_dim_zero() };
|
||||
let nphi = face_subst_dim(i, b_expr as LeanObj, phi);
|
||||
|
|
@ -737,20 +812,22 @@ pub(crate) fn ctype_subst_dim_bool(i: LeanObj, b: bool, a: LeanObj) -> LeanObjMu
|
|||
let nret = cterm_subst_dim_bool(i, b, ret);
|
||||
let ncoh = cterm_subst_dim_bool(i, b, coh);
|
||||
let nbase = ctype_subst_dim_bool(i, b, base);
|
||||
mk_ty_glue(nphi as LeanObj, nty as LeanObj,
|
||||
mk_ty_glue(l, nphi as LeanObj, nty as LeanObj,
|
||||
nf as LeanObj, nfinv as LeanObj,
|
||||
nsec as LeanObj, nret as LeanObj, ncoh as LeanObj,
|
||||
nbase as LeanObj)
|
||||
}
|
||||
// REL1 inductive: rebuild .ind with substituted params.
|
||||
// ABI v4: ind layout [ℓ, S, params].
|
||||
TY_IND => {
|
||||
let schema = ctor_field(a, 0);
|
||||
let params = ctor_field(a, 1);
|
||||
retain(schema);
|
||||
let new_params = ctype_list_subst_dim_bool(i, b, params);
|
||||
let ctor = alloc_ctor(TY_IND, 2);
|
||||
ctor_set_field(ctor, 0, schema);
|
||||
ctor_set_field(ctor, 1, new_params as LeanObj);
|
||||
let l = ctor_field(a, 0);
|
||||
let schema = ctor_field(a, 1);
|
||||
let params = ctor_field(a, 2);
|
||||
retain(l); retain(schema);
|
||||
let new_params = ctype_sigma_list_subst_dim_bool(i, b, params);
|
||||
let ctor = alloc_ctor(TY_IND, 3);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, schema);
|
||||
ctor_set_field(ctor, 2, new_params as LeanObj);
|
||||
ctor
|
||||
}
|
||||
// REL2 interval: closed primitive, no recursion.
|
||||
|
|
@ -758,22 +835,41 @@ pub(crate) fn ctype_subst_dim_bool(i: LeanObj, b: bool, a: LeanObj) -> LeanObjMu
|
|||
retain(a);
|
||||
a as LeanObjMut
|
||||
}
|
||||
_ => mk_ty_univ(),
|
||||
// ABI v4: cumulativity — recurse into the wrapped CType. Layout: [ℓ, A].
|
||||
TY_LIFT => {
|
||||
let l = ctor_field(a, 0);
|
||||
let inner = ctor_field(a, 1);
|
||||
retain(l);
|
||||
let new_inner = ctype_subst_dim_bool(i, b, inner);
|
||||
mk_ty_lift(l, new_inner as LeanObj)
|
||||
}
|
||||
_ => {
|
||||
// Synthetic fallback at level zero.
|
||||
mk_ty_univ(lean_box_mut(0) as LeanObj)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/// Helper for the Bool variant: walk a `List CType` substituting `i := b`.
|
||||
fn ctype_list_subst_dim_bool(i: LeanObj, b: bool, params: LeanObj) -> LeanObjMut {
|
||||
/// Helper for the Bool variant: walk a `List (Σ ℓ : ULevel, CType ℓ)`
|
||||
/// substituting `i := b` in each CType (snd of each Σ-pair). ABI v4.
|
||||
fn ctype_sigma_list_subst_dim_bool(i: LeanObj, b: bool, params: LeanObj) -> LeanObjMut {
|
||||
match ctor_tag(params) {
|
||||
0 => {
|
||||
retain(params);
|
||||
params as LeanObjMut
|
||||
}
|
||||
1 => {
|
||||
let head = ctor_field(params, 0);
|
||||
let head = ctor_field(params, 0); // ⟨ℓ, A⟩
|
||||
let tail = ctor_field(params, 1);
|
||||
let new_head = ctype_subst_dim_bool(i, b, head);
|
||||
let new_tail = ctype_list_subst_dim_bool(i, b, tail);
|
||||
let level = ctor_field(head, 0);
|
||||
let ctype = ctor_field(head, 1);
|
||||
retain(level);
|
||||
let new_ctype = ctype_subst_dim_bool(i, b, ctype);
|
||||
// Rebuild the Σ-pair.
|
||||
let new_head = alloc_ctor(0, 2); // Sigma.mk has tag 0
|
||||
ctor_set_field(new_head, 0, level);
|
||||
ctor_set_field(new_head, 1, new_ctype as LeanObj);
|
||||
let new_tail = ctype_sigma_list_subst_dim_bool(i, b, tail);
|
||||
let cons = alloc_ctor(1, 2);
|
||||
ctor_set_field(cons, 0, new_head as LeanObj);
|
||||
ctor_set_field(cons, 1, new_tail as LeanObj);
|
||||
|
|
@ -789,41 +885,58 @@ fn ctype_list_subst_dim_bool(i: LeanObj, b: bool, params: LeanObj) -> LeanObjMut
|
|||
// ── CType.substDimExpr ─────────────────────────────────────────────────────
|
||||
|
||||
/// `CType.substDimExpr i r A` — substitute dim `i` with arbitrary DimExpr `r`.
|
||||
/// ABI v4 layout (see `ctype_subst_dim_bool` doc).
|
||||
pub(crate) fn ctype_subst_dim_expr(i: LeanObj, r: LeanObj, a: LeanObj) -> LeanObjMut {
|
||||
match ctor_tag(a) {
|
||||
TY_UNIV => mk_ty_univ(),
|
||||
TY_UNIV => {
|
||||
let l = ctor_field(a, 0);
|
||||
retain(l);
|
||||
mk_ty_univ(l)
|
||||
}
|
||||
TY_PI => {
|
||||
let x = ctor_field(a, 0);
|
||||
let y = ctor_field(a, 1);
|
||||
let ld = ctor_field(a, 0);
|
||||
let lc = ctor_field(a, 1);
|
||||
let var = ctor_field(a, 2);
|
||||
let x = ctor_field(a, 3);
|
||||
let y = ctor_field(a, 4);
|
||||
retain(ld); retain(lc); retain(var);
|
||||
let nx = ctype_subst_dim_expr(i, r, x);
|
||||
let ny = ctype_subst_dim_expr(i, r, y);
|
||||
mk_ty_pi(nx as LeanObj, ny as LeanObj)
|
||||
mk_ty_pi(ld, lc, var, nx as LeanObj, ny as LeanObj)
|
||||
}
|
||||
TY_PATH => {
|
||||
let ty = ctor_field(a, 0);
|
||||
let x = ctor_field(a, 1);
|
||||
let y = ctor_field(a, 2);
|
||||
let l = ctor_field(a, 0);
|
||||
let ty = ctor_field(a, 1);
|
||||
let x = ctor_field(a, 2);
|
||||
let y = ctor_field(a, 3);
|
||||
retain(l);
|
||||
let nty = ctype_subst_dim_expr(i, r, ty);
|
||||
let nx = cterm_subst_dim(i, r, x);
|
||||
let ny = cterm_subst_dim(i, r, y);
|
||||
mk_ty_path(nty as LeanObj, nx as LeanObj, ny as LeanObj)
|
||||
mk_ty_path(l, nty as LeanObj, nx as LeanObj, ny as LeanObj)
|
||||
}
|
||||
TY_SIGMA => {
|
||||
let x = ctor_field(a, 0);
|
||||
let y = ctor_field(a, 1);
|
||||
let la = ctor_field(a, 0);
|
||||
let lb = ctor_field(a, 1);
|
||||
let var = ctor_field(a, 2);
|
||||
let x = ctor_field(a, 3);
|
||||
let y = ctor_field(a, 4);
|
||||
retain(la); retain(lb); retain(var);
|
||||
let nx = ctype_subst_dim_expr(i, r, x);
|
||||
let ny = ctype_subst_dim_expr(i, r, y);
|
||||
mk_ty_sigma(nx as LeanObj, ny as LeanObj)
|
||||
mk_ty_sigma(la, lb, var, nx as LeanObj, ny as LeanObj)
|
||||
}
|
||||
TY_GLUE => {
|
||||
let phi = ctor_field(a, 0);
|
||||
let ty = ctor_field(a, 1);
|
||||
let f = ctor_field(a, 2);
|
||||
let finv = ctor_field(a, 3);
|
||||
let sec = ctor_field(a, 4);
|
||||
let ret = ctor_field(a, 5);
|
||||
let coh = ctor_field(a, 6);
|
||||
let base = ctor_field(a, 7);
|
||||
let l = ctor_field(a, 0);
|
||||
let phi = ctor_field(a, 1);
|
||||
let ty = ctor_field(a, 2);
|
||||
let f = ctor_field(a, 3);
|
||||
let finv = ctor_field(a, 4);
|
||||
let sec = ctor_field(a, 5);
|
||||
let ret = ctor_field(a, 6);
|
||||
let coh = ctor_field(a, 7);
|
||||
let base = ctor_field(a, 8);
|
||||
retain(l);
|
||||
let nphi = face_subst_dim(i, r, phi);
|
||||
let nty = ctype_subst_dim_expr(i, r, ty);
|
||||
let nf = cterm_subst_dim(i, r, f);
|
||||
|
|
@ -832,38 +945,57 @@ pub(crate) fn ctype_subst_dim_expr(i: LeanObj, r: LeanObj, a: LeanObj) -> LeanOb
|
|||
let nret = cterm_subst_dim(i, r, ret);
|
||||
let ncoh = cterm_subst_dim(i, r, coh);
|
||||
let nbase = ctype_subst_dim_expr(i, r, base);
|
||||
mk_ty_glue(nphi as LeanObj, nty as LeanObj,
|
||||
mk_ty_glue(l, nphi as LeanObj, nty as LeanObj,
|
||||
nf as LeanObj, nfinv as LeanObj,
|
||||
nsec as LeanObj, nret as LeanObj, ncoh as LeanObj,
|
||||
nbase as LeanObj)
|
||||
}
|
||||
TY_IND => {
|
||||
let schema = ctor_field(a, 0);
|
||||
let params = ctor_field(a, 1);
|
||||
retain(schema);
|
||||
let new_params = ctype_list_subst_dim_expr(i, r, params);
|
||||
let ctor = alloc_ctor(TY_IND, 2);
|
||||
ctor_set_field(ctor, 0, schema);
|
||||
ctor_set_field(ctor, 1, new_params as LeanObj);
|
||||
let l = ctor_field(a, 0);
|
||||
let schema = ctor_field(a, 1);
|
||||
let params = ctor_field(a, 2);
|
||||
retain(l); retain(schema);
|
||||
let new_params = ctype_sigma_list_subst_dim_expr(i, r, params);
|
||||
let ctor = alloc_ctor(TY_IND, 3);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, schema);
|
||||
ctor_set_field(ctor, 2, new_params as LeanObj);
|
||||
ctor
|
||||
}
|
||||
TY_INTERVAL => {
|
||||
retain(a);
|
||||
a as LeanObjMut
|
||||
}
|
||||
_ => mk_ty_univ(),
|
||||
// ABI v4: cumulativity. Layout [ℓ, A].
|
||||
TY_LIFT => {
|
||||
let l = ctor_field(a, 0);
|
||||
let inner = ctor_field(a, 1);
|
||||
retain(l);
|
||||
let new_inner = ctype_subst_dim_expr(i, r, inner);
|
||||
mk_ty_lift(l, new_inner as LeanObj)
|
||||
}
|
||||
_ => {
|
||||
mk_ty_univ(lean_box_mut(0) as LeanObj)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/// Helper for the DimExpr variant: walk a `List CType` substituting `i := r`.
|
||||
fn ctype_list_subst_dim_expr(i: LeanObj, r: LeanObj, params: LeanObj) -> LeanObjMut {
|
||||
/// Helper for the DimExpr variant: walk a `List (Σ ℓ : ULevel, CType ℓ)`
|
||||
/// substituting `i := r` in each CType. ABI v4.
|
||||
fn ctype_sigma_list_subst_dim_expr(i: LeanObj, r: LeanObj, params: LeanObj) -> LeanObjMut {
|
||||
match ctor_tag(params) {
|
||||
0 => { retain(params); params as LeanObjMut }
|
||||
1 => {
|
||||
let head = ctor_field(params, 0);
|
||||
let head = ctor_field(params, 0); // ⟨ℓ, A⟩
|
||||
let tail = ctor_field(params, 1);
|
||||
let new_head = ctype_subst_dim_expr(i, r, head);
|
||||
let new_tail = ctype_list_subst_dim_expr(i, r, tail);
|
||||
let level = ctor_field(head, 0);
|
||||
let ctype = ctor_field(head, 1);
|
||||
retain(level);
|
||||
let new_ctype = ctype_subst_dim_expr(i, r, ctype);
|
||||
let new_head = alloc_ctor(0, 2);
|
||||
ctor_set_field(new_head, 0, level);
|
||||
ctor_set_field(new_head, 1, new_ctype as LeanObj);
|
||||
let new_tail = ctype_sigma_list_subst_dim_expr(i, r, tail);
|
||||
let cons = alloc_ctor(1, 2);
|
||||
ctor_set_field(cons, 0, new_head as LeanObj);
|
||||
ctor_set_field(cons, 1, new_tail as LeanObj);
|
||||
|
|
|
|||
|
|
@ -25,14 +25,26 @@ pub const FACE_MEET: u32 = 4;
|
|||
pub const FACE_JOIN: u32 = 5;
|
||||
|
||||
// ── CType (Cubical/Syntax.lean) ────────────────────────────────────────────
|
||||
//
|
||||
// Universe-stratified order (Layer 0 §0.1, ABI v4):
|
||||
// 0 univ — `Uℓ` at level `succ ℓ`
|
||||
// 1 pi — Π (var : A) B; carries binder name + sub-CTypes at potentially
|
||||
// distinct levels (the FFI marshals the Σ-erased levels too)
|
||||
// 2 sigma — Σ (var : A) B; same shape as pi (binder name + sub-CTypes)
|
||||
// 3 path — Path A a b; sub-A at same level as outer
|
||||
// 4 glue — CCHM Glue type
|
||||
// 5 ind — schema-defined inductive type; params are Σ-pairs ⟨ℓ', CType ℓ'⟩
|
||||
// 6 interval — cubical interval `𝕀`, lives at level zero
|
||||
// 7 lift — cumulativity constructor (NEW in v4): `lift A` bumps level.
|
||||
|
||||
pub const TY_UNIV: u32 = 0;
|
||||
pub const TY_PI: u32 = 1;
|
||||
pub const TY_PATH: u32 = 2;
|
||||
pub const TY_SIGMA: u32 = 3;
|
||||
pub const TY_UNIV: u32 = 0;
|
||||
pub const TY_PI: u32 = 1;
|
||||
pub const TY_SIGMA: u32 = 2;
|
||||
pub const TY_PATH: u32 = 3;
|
||||
pub const TY_GLUE: u32 = 4;
|
||||
pub const TY_IND: u32 = 5; // REL1: schema-based inductive type
|
||||
pub const TY_INTERVAL: u32 = 6; // REL2: cubical interval primitive
|
||||
pub const TY_LIFT: u32 = 7; // ABI v4: cumulativity constructor
|
||||
|
||||
// ── CTerm (Cubical/Syntax.lean) ────────────────────────────────────────────
|
||||
|
||||
|
|
|
|||
|
|
@ -4,26 +4,36 @@
|
|||
//! `vTranspInv` (inverse transport via line reversal). Mirrors
|
||||
//! `Cubical/Transport.lean`.
|
||||
//!
|
||||
//! `vTransp i A φ v` dispatch (priority order):
|
||||
//! `vTransp ℓ i A φ v` dispatch (priority order):
|
||||
//!
|
||||
//! 1. `φ = .top` → return `v` unchanged (T1).
|
||||
//! 2. `CType.dimAbsent i A = true` → return `v` (T2 constant line).
|
||||
//! 3. `A = .pi domA codA` → return `.vTranspFun i domA codA φ v`
|
||||
//! (full CCHM Π rule).
|
||||
//! 4. Otherwise → return `.vneu (.ntransp i A φ v)`.
|
||||
//! 3. `A = .pi domA codA` → return `.vTranspFun {ℓ ℓ'} i domA codA φ v`
|
||||
//! (full CCHM Π rule). ℓ' read from A.
|
||||
//! 4. Otherwise → return `.vneu (.ntransp {ℓ} i A φ v)`.
|
||||
//!
|
||||
//! `vTranspInv i A φ v` = `vTransp i (A.substDimExpr i (.inv (.var i))) φ v`
|
||||
//! `vTranspInv ℓ i A φ v` = `vTransp ℓ i (A.substDimExpr i (.inv (.var i))) φ v`
|
||||
//! — degenerates to identity when A is dim-absent (the reversed line is
|
||||
//! also constant).
|
||||
//!
|
||||
//! ## ABI v4 — implicit ULevel parameters
|
||||
//!
|
||||
//! Lean keeps the implicit `{ℓ : ULevel}` of `vTransp` as a runtime
|
||||
//! object argument. The Rust signature reflects that: `l : LeanObj`
|
||||
//! is the first argument. When emitting CType-bearing CVal/CNeu, we
|
||||
//! need to provide a ULevel for each implicit slot — we forward the
|
||||
//! caller's `l` for the result type's level (which equals A's level)
|
||||
//! and read the `ℓ_d`, `ℓ_c` for `vTranspFun` from the pi's stored
|
||||
//! `ℓ_d`, `ℓ_c` slots (CType.pi runtime layout: [ℓ_d, ℓ_c, var, A, B]).
|
||||
|
||||
use crate::lean_runtime::*;
|
||||
use crate::tags::*;
|
||||
use crate::value::*;
|
||||
use crate::dim_absent::ctype_absent;
|
||||
|
||||
/// `vTransp i A φ v` — value-level transport.
|
||||
/// Takes borrowed `i`, `a`, `phi` and owned `v`. Returns owned `CVal`.
|
||||
pub fn vtransp(i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMut {
|
||||
/// `vTransp ℓ i A φ v` — value-level transport.
|
||||
/// Takes borrowed `l`, `i`, `a`, `phi` and owned `v`. Returns owned `CVal`.
|
||||
pub fn vtransp(l: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMut {
|
||||
// 1. Full face → identity.
|
||||
if ctor_tag(phi) == FACE_TOP {
|
||||
return v;
|
||||
|
|
@ -34,23 +44,29 @@ pub fn vtransp(i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMu
|
|||
return v;
|
||||
}
|
||||
|
||||
// 3. Π → `.vTranspFun` closure.
|
||||
// 3. Π → `.vTranspFun {ℓ_d ℓ_c} i domA codA φ v` closure.
|
||||
// ABI v4: pi has 5 fields [ℓ_d, ℓ_c, var, A, B]; the binder name (field 2)
|
||||
// is discarded — vTranspFun uses the transport binder.
|
||||
if ctor_tag(a) == TY_PI {
|
||||
let dom_a = ctor_field(a, 0);
|
||||
let cod_a = ctor_field(a, 1);
|
||||
retain(i); retain(dom_a); retain(cod_a); retain(phi);
|
||||
return mk_vtranspfun(i, dom_a, cod_a, phi, v as LeanObj);
|
||||
let ld = ctor_field(a, 0);
|
||||
let lc = ctor_field(a, 1);
|
||||
let dom_a = ctor_field(a, 3);
|
||||
let cod_a = ctor_field(a, 4);
|
||||
retain(ld); retain(lc); retain(i);
|
||||
retain(dom_a); retain(cod_a); retain(phi);
|
||||
return mk_vtranspfun(ld, lc, i, dom_a, cod_a, phi, v as LeanObj);
|
||||
}
|
||||
|
||||
// 4. Stuck — produce a structured `ntransp` neutral.
|
||||
retain(i); retain(a); retain(phi);
|
||||
let ntransp = mk_ntransp(i, a, phi, v as LeanObj);
|
||||
// 4. Stuck — produce a structured `ntransp` neutral. l is forwarded
|
||||
// (the result level equals A's level).
|
||||
retain(l); retain(i); retain(a); retain(phi);
|
||||
let ntransp = mk_ntransp(l, i, a, phi, v as LeanObj);
|
||||
mk_vneu(ntransp as LeanObj)
|
||||
}
|
||||
|
||||
/// `vTranspInv i A φ v` — inverse transport along the reversed line.
|
||||
/// `vTranspInv ℓ i A φ v` — inverse transport along the reversed line.
|
||||
/// Builds the reversed-A via substDimExpr, then delegates to vtransp.
|
||||
pub fn vtransp_inv(i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMut {
|
||||
pub fn vtransp_inv(l: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMut {
|
||||
// Build `(.inv (.var i))` DimExpr.
|
||||
let var_i = {
|
||||
retain(i);
|
||||
|
|
@ -67,7 +83,7 @@ pub fn vtransp_inv(i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanO
|
|||
let a_reversed = crate::subst::ctype_subst_dim_expr(i, inv_var_i as LeanObj, a);
|
||||
release(inv_var_i as LeanObj);
|
||||
// Transport along the reversed line.
|
||||
let result = vtransp(i, a_reversed as LeanObj, phi, v);
|
||||
let result = vtransp(l, i, a_reversed as LeanObj, phi, v);
|
||||
release(a_reversed as LeanObj);
|
||||
result
|
||||
}
|
||||
|
|
|
|||
|
|
@ -2,13 +2,40 @@
|
|||
//!
|
||||
//! Helpers for constructing `CVal` / `CNeu` objects. Each builder
|
||||
//! owns the input fields (callers pre-retain borrowed data as needed).
|
||||
//!
|
||||
//! ## ABI v4: implicit ULevel parameters
|
||||
//!
|
||||
//! Lean 4's compiler does NOT erase implicit `{ℓ : ULevel}` parameters
|
||||
//! at runtime — they are kept as constructor fields (in declaration
|
||||
//! order, *interleaved* with explicit args). Empirically verified by
|
||||
//! probing `lean_ctor_num_objs` of Lean-allocated values in 2026-05.
|
||||
//!
|
||||
//! Concretely:
|
||||
//! - `CType.path {ℓ} A a b` has 4 runtime fields: `[ℓ, A, a, b]`
|
||||
//! - `CType.pi {ℓ ℓ'} v A B` has 5 fields: `[ℓ, ℓ', v, A, B]`
|
||||
//! - `CTerm.transp i {ℓ} A φ t` has 5 fields: `[i, ℓ, A, φ, t]` (the
|
||||
//! dim binder `i` precedes the implicit ℓ in declaration order!)
|
||||
//! - `CVal.vTranspFun {ℓ ℓ'} i d c φ f` has 7 fields:
|
||||
//! `[ℓ, ℓ', i, d, c, φ, f]`
|
||||
//! - `CNeu.ntransp {ℓ} i A φ v` has 5 fields: `[ℓ, i, A, φ, v]`
|
||||
//!
|
||||
//! This module's `mk_*` functions take the ULevel(s) explicitly when
|
||||
//! the constructor needs them, so call sites must supply (or
|
||||
//! synthesise via `mk_ulevel_zero()`) a level.
|
||||
|
||||
use crate::lean_runtime::*;
|
||||
use crate::tags::*;
|
||||
|
||||
/// `ULevel.zero` (constructor index 0, nullary, scalar). Used as the
|
||||
/// default ULevel slot when no caller-side level is in scope (e.g. a
|
||||
/// freshly synthesised CType in readback).
|
||||
#[inline]
|
||||
pub(crate) fn mk_ulevel_zero() -> LeanObjMut { lean_box_mut(0) }
|
||||
|
||||
// ── CVal builders ──────────────────────────────────────────────────────────
|
||||
|
||||
/// `.vlam env x body` — function closure. Takes ownership of all fields.
|
||||
/// No implicit ULevel — vlam is universe-monomorphic at the value level.
|
||||
#[inline]
|
||||
pub(crate) fn mk_vlam(env: LeanObj, x: LeanObj, body: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(VAL_VLAM, 3);
|
||||
|
|
@ -45,65 +72,80 @@ pub(crate) fn mk_vpair(a: LeanObj, b: LeanObj) -> LeanObjMut {
|
|||
ctor
|
||||
}
|
||||
|
||||
/// `.vTranspFun i domA codA φ f` — Π-transport closure (CCHM §5.5 rule).
|
||||
/// `.vTranspFun {ℓ ℓ'} i domA codA φ f` — Π-transport closure (CCHM §5.5 rule).
|
||||
/// Lean keeps the implicit `{ℓ ℓ'}` at runtime; layout is
|
||||
/// `[ℓ, ℓ', i, domA, codA, φ, f]` (7 fields). All slots are consume-slots.
|
||||
#[inline]
|
||||
pub(crate) fn mk_vtranspfun(
|
||||
l: LeanObj, l2: LeanObj,
|
||||
i: LeanObj, dom_a: LeanObj, cod_a: LeanObj,
|
||||
phi: LeanObj, f: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(VAL_VTRANSPFUN, 5);
|
||||
ctor_set_field(ctor, 0, i);
|
||||
ctor_set_field(ctor, 1, dom_a);
|
||||
ctor_set_field(ctor, 2, cod_a);
|
||||
ctor_set_field(ctor, 3, phi);
|
||||
ctor_set_field(ctor, 4, f);
|
||||
let ctor = alloc_ctor(VAL_VTRANSPFUN, 7);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, l2);
|
||||
ctor_set_field(ctor, 2, i);
|
||||
ctor_set_field(ctor, 3, dom_a);
|
||||
ctor_set_field(ctor, 4, cod_a);
|
||||
ctor_set_field(ctor, 5, phi);
|
||||
ctor_set_field(ctor, 6, f);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.vPathTransp env i A a b φ p` — path-line transport closure.
|
||||
/// `.vPathTransp {ℓ} env i A a b φ p` — path-line transport closure.
|
||||
/// Layout: `[ℓ, env, i, A, a, b, φ, p]` (8 fields).
|
||||
#[inline]
|
||||
pub(crate) fn mk_vpathtransp(
|
||||
l: LeanObj,
|
||||
env: LeanObj, i: LeanObj, a_ty: LeanObj,
|
||||
a: LeanObj, b: LeanObj, phi: LeanObj, p: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(VAL_VPATHTRANSP, 7);
|
||||
ctor_set_field(ctor, 0, env);
|
||||
ctor_set_field(ctor, 1, i);
|
||||
ctor_set_field(ctor, 2, a_ty);
|
||||
ctor_set_field(ctor, 3, a);
|
||||
ctor_set_field(ctor, 4, b);
|
||||
ctor_set_field(ctor, 5, phi);
|
||||
ctor_set_field(ctor, 6, p);
|
||||
let ctor = alloc_ctor(VAL_VPATHTRANSP, 8);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, env);
|
||||
ctor_set_field(ctor, 2, i);
|
||||
ctor_set_field(ctor, 3, a_ty);
|
||||
ctor_set_field(ctor, 4, a);
|
||||
ctor_set_field(ctor, 5, b);
|
||||
ctor_set_field(ctor, 6, phi);
|
||||
ctor_set_field(ctor, 7, p);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.ntransp i A φ v` — stuck transport neutral.
|
||||
/// `.ntransp {ℓ} i A φ v` — stuck transport neutral.
|
||||
/// Layout: `[ℓ, i, A, φ, v]` (5 fields).
|
||||
#[inline]
|
||||
pub(crate) fn mk_ntransp(
|
||||
l: LeanObj,
|
||||
i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(NEU_NTRANSP, 4);
|
||||
ctor_set_field(ctor, 0, i);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, phi);
|
||||
ctor_set_field(ctor, 3, v);
|
||||
let ctor = alloc_ctor(NEU_NTRANSP, 5);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, i);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, phi);
|
||||
ctor_set_field(ctor, 4, v);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.vHCompFun codA φ tube base` — Π-hcomp closure.
|
||||
/// `.vHCompFun {ℓ} codA φ tube base` — Π-hcomp closure.
|
||||
/// Layout: `[ℓ, codA, φ, tube, base]` (5 fields).
|
||||
#[inline]
|
||||
pub(crate) fn mk_vhcompfun(
|
||||
l: LeanObj,
|
||||
cod_a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(VAL_VHCOMPFUN, 4);
|
||||
ctor_set_field(ctor, 0, cod_a);
|
||||
ctor_set_field(ctor, 1, phi);
|
||||
ctor_set_field(ctor, 2, tube);
|
||||
ctor_set_field(ctor, 3, base);
|
||||
let ctor = alloc_ctor(VAL_VHCOMPFUN, 5);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, cod_a);
|
||||
ctor_set_field(ctor, 2, phi);
|
||||
ctor_set_field(ctor, 3, tube);
|
||||
ctor_set_field(ctor, 4, base);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.vTubeApp tube arg` — point-wise applied tube `λj. (tube @ j) arg`.
|
||||
/// No implicit ULevel.
|
||||
#[inline]
|
||||
pub(crate) fn mk_vtubeapp(tube: LeanObj, arg: LeanObj) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(VAL_VTUBEAPP, 2);
|
||||
|
|
@ -112,61 +154,74 @@ pub(crate) fn mk_vtubeapp(tube: LeanObj, arg: LeanObj) -> LeanObjMut {
|
|||
ctor
|
||||
}
|
||||
|
||||
/// `.vCompFun env i domA codA φ u t` — heterogeneous Π-comp closure.
|
||||
/// `.vCompFun {ℓ ℓ'} env i domA codA φ u t` — heterogeneous Π-comp closure.
|
||||
/// Layout: `[ℓ, ℓ', env, i, domA, codA, φ, u, t]` (9 fields).
|
||||
#[inline]
|
||||
pub(crate) fn mk_vcompfun(
|
||||
l: LeanObj, l2: LeanObj,
|
||||
env: LeanObj, i: LeanObj, dom_a: LeanObj, cod_a: LeanObj,
|
||||
phi: LeanObj, u: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(VAL_VCOMPFUN, 7);
|
||||
ctor_set_field(ctor, 0, env);
|
||||
ctor_set_field(ctor, 1, i);
|
||||
ctor_set_field(ctor, 2, dom_a);
|
||||
ctor_set_field(ctor, 3, cod_a);
|
||||
ctor_set_field(ctor, 4, phi);
|
||||
ctor_set_field(ctor, 5, u);
|
||||
ctor_set_field(ctor, 6, t);
|
||||
let ctor = alloc_ctor(VAL_VCOMPFUN, 9);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, l2);
|
||||
ctor_set_field(ctor, 2, env);
|
||||
ctor_set_field(ctor, 3, i);
|
||||
ctor_set_field(ctor, 4, dom_a);
|
||||
ctor_set_field(ctor, 5, cod_a);
|
||||
ctor_set_field(ctor, 6, phi);
|
||||
ctor_set_field(ctor, 7, u);
|
||||
ctor_set_field(ctor, 8, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.nhcomp A φ tube base` — stuck hcomp neutral.
|
||||
/// `.nhcomp {ℓ} A φ tube base` — stuck hcomp neutral.
|
||||
/// Layout: `[ℓ, A, φ, tube, base]` (5 fields).
|
||||
#[inline]
|
||||
pub(crate) fn mk_nhcomp(
|
||||
l: LeanObj,
|
||||
a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(NEU_NHCOMP, 4);
|
||||
ctor_set_field(ctor, 0, a);
|
||||
ctor_set_field(ctor, 1, phi);
|
||||
ctor_set_field(ctor, 2, tube);
|
||||
ctor_set_field(ctor, 3, base);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.ncomp i A φ u t` — stuck hetero-comp neutral (evaluated sub-values).
|
||||
#[inline]
|
||||
pub(crate) fn mk_ncomp(
|
||||
i: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(NEU_NCOMP, 5);
|
||||
ctor_set_field(ctor, 0, i);
|
||||
let ctor = alloc_ctor(NEU_NHCOMP, 5);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, a);
|
||||
ctor_set_field(ctor, 2, phi);
|
||||
ctor_set_field(ctor, 3, u);
|
||||
ctor_set_field(ctor, 4, t);
|
||||
ctor_set_field(ctor, 3, tube);
|
||||
ctor_set_field(ctor, 4, base);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.ncompN env i A clauses t` — stuck multi-clause comp neutral.
|
||||
/// `.ncomp {ℓ} i A φ u t` — stuck hetero-comp neutral.
|
||||
/// Layout: `[ℓ, i, A, φ, u, t]` (6 fields).
|
||||
#[inline]
|
||||
pub(crate) fn mk_ncompn(
|
||||
env: LeanObj, i: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj,
|
||||
pub(crate) fn mk_ncomp(
|
||||
l: LeanObj,
|
||||
i: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(NEU_NCOMPN, 5);
|
||||
ctor_set_field(ctor, 0, env);
|
||||
let ctor = alloc_ctor(NEU_NCOMP, 6);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, i);
|
||||
ctor_set_field(ctor, 2, a);
|
||||
ctor_set_field(ctor, 3, clauses);
|
||||
ctor_set_field(ctor, 4, t);
|
||||
ctor_set_field(ctor, 3, phi);
|
||||
ctor_set_field(ctor, 4, u);
|
||||
ctor_set_field(ctor, 5, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
/// `.ncompN {ℓ} env i A clauses t` — stuck multi-clause comp neutral.
|
||||
/// Layout: `[ℓ, env, i, A, clauses, t]` (6 fields).
|
||||
#[inline]
|
||||
pub(crate) fn mk_ncompn(
|
||||
l: LeanObj,
|
||||
env: LeanObj, i: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj,
|
||||
) -> LeanObjMut {
|
||||
let ctor = alloc_ctor(NEU_NCOMPN, 6);
|
||||
ctor_set_field(ctor, 0, l);
|
||||
ctor_set_field(ctor, 1, env);
|
||||
ctor_set_field(ctor, 2, i);
|
||||
ctor_set_field(ctor, 3, a);
|
||||
ctor_set_field(ctor, 4, clauses);
|
||||
ctor_set_field(ctor, 5, t);
|
||||
ctor
|
||||
}
|
||||
|
||||
|
|
@ -215,7 +270,7 @@ pub(crate) fn mk_nsnd(n: LeanObj) -> LeanObjMut {
|
|||
}
|
||||
|
||||
/// `.vctor S c params args` — canonical schema-constructor value (REL1).
|
||||
/// Takes ownership of all four field handles.
|
||||
/// No implicit ULevel.
|
||||
#[inline]
|
||||
pub(crate) fn mk_vctor(
|
||||
schema: LeanObj, name: LeanObj, params: LeanObj, args: LeanObj,
|
||||
|
|
@ -237,7 +292,7 @@ pub(crate) fn mk_vdimexpr(r: LeanObj) -> LeanObjMut {
|
|||
}
|
||||
|
||||
/// `.nIndElim S params motive branches target` — stuck eliminator
|
||||
/// neutral. Five fields per the Lean definition.
|
||||
/// neutral. Five fields per the Lean definition. No implicit ULevel.
|
||||
#[inline]
|
||||
pub(crate) fn mk_nindelim(
|
||||
schema: LeanObj, params: LeanObj, motive: LeanObj,
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
// wasm_harness.mjs — Node.js validation harness for topolei-cubical wasm.
|
||||
// wasm_harness.mjs — Node.js validation harness for cubical-transport wasm.
|
||||
//
|
||||
// Proves the wasm ABI surface works by implementing a *minimal* subset of
|
||||
// Lean's runtime in JS (bump allocator + object header layout) and
|
||||
|
|
@ -15,7 +15,7 @@ import { fileURLToPath } from 'url';
|
|||
const __dirname = path.dirname(fileURLToPath(import.meta.url));
|
||||
const wasmPath = path.resolve(
|
||||
__dirname,
|
||||
'../target/wasm32-unknown-unknown/release/topolei_cubical.wasm'
|
||||
'../target/wasm32-unknown-unknown/release/cubical_transport.wasm'
|
||||
);
|
||||
|
||||
// ── Lean object layout (wasm32) ────────────────────────────────────────────
|
||||
|
|
@ -75,22 +75,22 @@ function setField(o, i, v) {
|
|||
}
|
||||
|
||||
const shim = {
|
||||
topolei_shim_obj_tag: getTag,
|
||||
topolei_shim_ctor_get: getField,
|
||||
topolei_shim_ctor_set: setField,
|
||||
topolei_shim_alloc_ctor: (tag, num_objs, scalar_sz) => {
|
||||
cubical_transport_shim_obj_tag: getTag,
|
||||
cubical_transport_shim_ctor_get: getField,
|
||||
cubical_transport_shim_ctor_set: setField,
|
||||
cubical_transport_shim_alloc_ctor: (tag, num_objs, scalar_sz) => {
|
||||
const size = HEADER_SIZE + num_objs * FIELD_SIZE + scalar_sz;
|
||||
const p = alloc(size);
|
||||
setHeader(p, tag, num_objs);
|
||||
return p;
|
||||
},
|
||||
topolei_shim_inc: () => {}, // refcount — harness doesn't GC
|
||||
topolei_shim_dec: () => {},
|
||||
topolei_shim_string_eq: (a, b) => {
|
||||
cubical_transport_shim_inc: () => {}, // refcount — harness doesn't GC
|
||||
cubical_transport_shim_dec: () => {},
|
||||
cubical_transport_shim_string_eq: (a, b) => {
|
||||
// For tests that don't exercise strings; panic if called.
|
||||
throw new Error('string_eq: harness does not implement string content comparison');
|
||||
},
|
||||
topolei_shim_mk_string: () => {
|
||||
cubical_transport_shim_mk_string: () => {
|
||||
throw new Error('mk_string: harness does not implement string allocation');
|
||||
},
|
||||
};
|
||||
|
|
@ -140,38 +140,38 @@ const tests = [];
|
|||
|
||||
// Scalar passthrough (no allocation).
|
||||
tests.push(['DimExpr.normalize(.zero) → .zero',
|
||||
() => instance.exports.topolei_cubical_dimexpr_normalize(scalarZero),
|
||||
() => instance.exports.cubical_transport_dimexpr_normalize(scalarZero),
|
||||
scalarZero]);
|
||||
tests.push(['DimExpr.normalize(.one) → .one',
|
||||
() => instance.exports.topolei_cubical_dimexpr_normalize(scalarOne),
|
||||
() => instance.exports.cubical_transport_dimexpr_normalize(scalarOne),
|
||||
scalarOne]);
|
||||
|
||||
// Heap-object reductions.
|
||||
tests.push(['DimExpr.normalize(.inv .zero) → .one',
|
||||
() => instance.exports.topolei_cubical_dimexpr_normalize(mkInv(scalarZero)),
|
||||
() => instance.exports.cubical_transport_dimexpr_normalize(mkInv(scalarZero)),
|
||||
scalarOne]);
|
||||
tests.push(['DimExpr.normalize(.inv .one) → .zero',
|
||||
() => instance.exports.topolei_cubical_dimexpr_normalize(mkInv(scalarOne)),
|
||||
() => instance.exports.cubical_transport_dimexpr_normalize(mkInv(scalarOne)),
|
||||
scalarZero]);
|
||||
tests.push(['DimExpr.normalize(.inv (.inv .zero)) → .zero',
|
||||
() => instance.exports.topolei_cubical_dimexpr_normalize(mkInv(mkInv(scalarZero))),
|
||||
() => instance.exports.cubical_transport_dimexpr_normalize(mkInv(mkInv(scalarZero))),
|
||||
scalarZero]);
|
||||
|
||||
// FaceFormula scalar passthrough.
|
||||
tests.push(['FaceFormula.normalize(.bot) → .bot',
|
||||
() => instance.exports.topolei_cubical_face_normalize(boxTag(FACE_BOT)),
|
||||
() => instance.exports.cubical_transport_face_normalize(boxTag(FACE_BOT)),
|
||||
boxTag(FACE_BOT)]);
|
||||
tests.push(['FaceFormula.normalize(.top) → .top',
|
||||
() => instance.exports.topolei_cubical_face_normalize(boxTag(FACE_TOP)),
|
||||
() => instance.exports.cubical_transport_face_normalize(boxTag(FACE_TOP)),
|
||||
boxTag(FACE_TOP)]);
|
||||
|
||||
// FaceFormula absorption laws.
|
||||
tests.push(['FaceFormula.normalize(.meet .top .bot) → .bot',
|
||||
() => instance.exports.topolei_cubical_face_normalize(
|
||||
() => instance.exports.cubical_transport_face_normalize(
|
||||
mkFaceMeet(boxTag(FACE_TOP), boxTag(FACE_BOT))),
|
||||
boxTag(FACE_BOT)]);
|
||||
tests.push(['FaceFormula.normalize(.meet .bot .top) → .bot',
|
||||
() => instance.exports.topolei_cubical_face_normalize(
|
||||
() => instance.exports.cubical_transport_face_normalize(
|
||||
mkFaceMeet(boxTag(FACE_BOT), boxTag(FACE_TOP))),
|
||||
boxTag(FACE_BOT)]);
|
||||
|
||||
|
|
@ -181,7 +181,7 @@ tests.push(['DimExpr.normalize(.meet (.inv .zero) (.inv .one)) → .meet .one .z
|
|||
// inv .zero normalizes to .one; inv .one normalizes to .zero.
|
||||
// Our normalize recurses on meet's children, so result is .meet .one .zero.
|
||||
// In our encoding: a heap .meet ctor (tag 4) with fields (0x3, 0x1).
|
||||
const result = instance.exports.topolei_cubical_dimexpr_normalize(
|
||||
const result = instance.exports.cubical_transport_dimexpr_normalize(
|
||||
mkMeet(mkInv(scalarZero), mkInv(scalarOne)));
|
||||
if (isScalar(result)) return `scalar 0x${result.toString(16)}`;
|
||||
const tag = getTag(result);
|
||||
|
|
@ -195,7 +195,7 @@ tests.push(['DimExpr.normalize(.meet (.inv .zero) (.inv .one)) → .meet .one .z
|
|||
// ── Run ────────────────────────────────────────────────────────────────────
|
||||
|
||||
let fails = 0;
|
||||
console.log('── Topolei cubical wasm harness ──');
|
||||
console.log('── Cubical-transport wasm harness ──');
|
||||
for (const [desc, fn, expected] of tests) {
|
||||
try {
|
||||
const got = fn();
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue