19928d040a
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>
513 lines
20 KiB
Text
513 lines
20 KiB
Text
/-
|
||
CubicalTransport.Question — The universal question form
|
||
=======================================================
|
||
Implements `docs/QUESTIONS.md` Levels 1 + 1.5 + 2.
|
||
|
||
The CCHM partial-element-filler problem `comp i A φ u t` is *the*
|
||
universal cubical question. This module reifies that question as
|
||
a Lean record `CompQ`, defines `ask` (run the engine), `Equiv`
|
||
(answers coincide), and a vocabulary of classifying predicates
|
||
that pin specific question shapes (`IsConstLine`, `IsFullFace`,
|
||
`IsPathLine`, …).
|
||
|
||
## Universe-aware shape (Layer 0 §0.1 cascade)
|
||
|
||
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.).
|
||
|
||
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`).
|
||
|
||
## Computable Decidable instances (no Classical)
|
||
|
||
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
|
||
|
||
namespace Question
|
||
|
||
open CubicalTransport.DecEq
|
||
|
||
-- ── CompQ — the universal question, reified ─────────────────────────────────
|
||
|
||
/-- 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 level
|
||
φ : FaceFormula
|
||
u : CTerm
|
||
t : CTerm
|
||
|
||
/-- "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. -/
|
||
def CompQ.Equiv (q₁ q₂ : CompQ) : Prop := q₁.ask = q₂.ask
|
||
|
||
@[refl] theorem CompQ.Equiv.refl (q : CompQ) : q.Equiv q := rfl
|
||
|
||
@[symm] theorem CompQ.Equiv.symm {q₁ q₂ : CompQ}
|
||
(h : q₁.Equiv q₂) : q₂.Equiv q₁ := Eq.symm h
|
||
|
||
theorem CompQ.Equiv.trans {q₁ q₂ q₃ : CompQ}
|
||
(h₁ : q₁.Equiv q₂) (h₂ : q₂.Equiv q₃) : q₁.Equiv q₃ :=
|
||
Eq.trans h₁ h₂
|
||
|
||
/-- Smart constructor: every transport `transpⁱ A φ t` is the
|
||
degenerate question `compⁱ A φ t t`. -/
|
||
def CompQ.ofTransp {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||
(φ : FaceFormula) (t : CTerm) : CompQ :=
|
||
{ 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. -/
|
||
@[simp]
|
||
def IsConstLine (q : CompQ) : Prop :=
|
||
q.body.dimAbsent q.binder = true
|
||
|
||
/-- The face is the full face. -/
|
||
@[simp]
|
||
def IsFullFace (q : CompQ) : Prop := q.φ = .top
|
||
|
||
/-- The face is the empty face. -/
|
||
@[simp]
|
||
def IsEmptyFace (q : CompQ) : Prop := q.φ = .bot
|
||
|
||
/-- The base equals the partial element.
|
||
|
||
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₀ : CType q.level) (a b : CTerm), q.body = .path A₀ a b
|
||
|
||
/-- The line is a Glue type. -/
|
||
@[simp]
|
||
def IsGlueLine (q : CompQ) : Prop :=
|
||
∃ (ψ : 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 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 :=
|
||
q.body.skeleton = SkeletalCType.pi
|
||
|
||
/-- The line is a Σ type (same-level specialisation). -/
|
||
@[simp]
|
||
def IsSigmaLine (q : CompQ) : Prop :=
|
||
q.body.skeleton = SkeletalCType.sigma
|
||
|
||
/-- The line is a schema-defined inductive. -/
|
||
@[simp]
|
||
def IsIndLine (q : CompQ) : Prop :=
|
||
q.body.skeleton = SkeletalCType.ind
|
||
|
||
/-- The line is the cubical interval — only meaningful at level 0. -/
|
||
@[simp]
|
||
def IsIntervalLine (q : CompQ) : Prop :=
|
||
q.body.skeleton = SkeletalCType.interval
|
||
|
||
/-- The line is the universe at some level. -/
|
||
@[simp]
|
||
def IsUnivLine (q : CompQ) : Prop :=
|
||
q.body.skeleton = SkeletalCType.univ
|
||
|
||
-- ── 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))
|
||
|
||
instance (q : CompQ) : Decidable (IsFullFace q) :=
|
||
inferInstanceAs (Decidable (q.φ = .top))
|
||
|
||
instance (q : CompQ) : Decidable (IsEmptyFace q) :=
|
||
inferInstanceAs (Decidable (q.φ = .bot))
|
||
|
||
instance (q : CompQ) : Decidable (IsTransport q) :=
|
||
inferInstanceAs (Decidable (CTerm.beq q.u q.t = true))
|
||
|
||
instance (q : CompQ) : Decidable (IsIntervalLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.interval))
|
||
|
||
instance (q : CompQ) : Decidable (IsUnivLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.univ))
|
||
|
||
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) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.pi))
|
||
|
||
instance (q : CompQ) : Decidable (IsSigmaLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.sigma))
|
||
|
||
instance (q : CompQ) : Decidable (IsIndLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.ind))
|
||
|
||
-- ── Classifier-conditioned theorems ─────────────────────────────────────────
|
||
|
||
namespace CompQ
|
||
|
||
/-- 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
|
||
unfold ask
|
||
rw [show q.φ = .top from h]
|
||
exact eval_comp_top q.env q.binder q.body q.u q.t
|
||
|
||
/-- 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
|
||
unfold ask
|
||
rw [show q.φ = .bot from h]
|
||
exact eval_comp_bot q.env q.binder q.body q.u q.t
|
||
|
||
/-- Constant-line question: hetero comp reduces to hcomp. -/
|
||
@[simp]
|
||
theorem ask_of_const_line (q : CompQ)
|
||
(hC : IsConstLine q)
|
||
(hφ₁ : ¬ IsFullFace q) (hφ₂ : ¬ IsEmptyFace q) :
|
||
q.ask = vHCompValue q.body q.φ
|
||
(eval q.env (.plam q.binder q.u)) (eval q.env q.t) := by
|
||
unfold ask
|
||
exact eval_comp_const q.env q.binder q.body q.φ q.u q.t hφ₁ hφ₂ hC
|
||
|
||
/-- 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
|
||
unfold IsConstLine at h
|
||
match hb : CType.dimAbsent q.binder q.body with
|
||
| true => exact absurd hb h
|
||
| false => rfl
|
||
|
||
end CompQ
|
||
|
||
-- ──────────────────────────────────────────────────────────────────────────
|
||
-- TranspQ — transport question
|
||
-- ──────────────────────────────────────────────────────────────────────────
|
||
|
||
/-- Transport question, reified as data. -/
|
||
structure TranspQ where
|
||
/-- Universe level of the type-line `body`. -/
|
||
level : ULevel := .zero
|
||
env : CEnv
|
||
binder : DimVar
|
||
body : CType level
|
||
φ : FaceFormula
|
||
t : CTerm
|
||
|
||
/-- "Asking" a transport question runs the engine on `.transp`. -/
|
||
def TranspQ.ask (q : TranspQ) : CVal :=
|
||
eval q.env (.transp q.binder q.body q.φ q.t)
|
||
|
||
/-- Two transport questions are equivalent when their answers agree. -/
|
||
def TranspQ.Equiv (q₁ q₂ : TranspQ) : Prop := q₁.ask = q₂.ask
|
||
|
||
@[refl] theorem TranspQ.Equiv.refl (q : TranspQ) : q.Equiv q := rfl
|
||
@[symm] theorem TranspQ.Equiv.symm {q₁ q₂ : TranspQ}
|
||
(h : q₁.Equiv q₂) : q₂.Equiv q₁ := Eq.symm h
|
||
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`). -/
|
||
def TranspQ.toCompQ (q : TranspQ) : CompQ :=
|
||
{ level := q.level, env := q.env, binder := q.binder, body := q.body, φ := q.φ
|
||
, u := q.t, t := q.t }
|
||
|
||
namespace TranspQ
|
||
|
||
@[simp]
|
||
def IsConstLine (q : TranspQ) : Prop := q.body.dimAbsent q.binder = true
|
||
@[simp]
|
||
def IsFullFace (q : TranspQ) : Prop := q.φ = .top
|
||
@[simp]
|
||
def IsEmptyFace (q : TranspQ) : Prop := q.φ = .bot
|
||
@[simp]
|
||
def IsPathLine (q : TranspQ) : Prop :=
|
||
∃ (A₀ : CType q.level) (a b : CTerm), q.body = .path A₀ a b
|
||
@[simp]
|
||
def IsPiLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.pi
|
||
@[simp]
|
||
def IsSigmaLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.sigma
|
||
@[simp]
|
||
def IsGlueLine (q : TranspQ) : Prop :=
|
||
∃ (ψ : 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 := q.body.skeleton = SkeletalCType.ind
|
||
@[simp]
|
||
def IsIntervalLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.interval
|
||
@[simp]
|
||
def IsUnivLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.univ
|
||
|
||
instance (q : TranspQ) : Decidable (IsConstLine q) :=
|
||
inferInstanceAs (Decidable (q.body.dimAbsent q.binder = true))
|
||
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.skeleton = SkeletalCType.interval))
|
||
instance (q : TranspQ) : Decidable (IsUnivLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.univ))
|
||
instance (q : TranspQ) : Decidable (IsPiLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.pi))
|
||
instance (q : TranspQ) : Decidable (IsSigmaLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.sigma))
|
||
instance (q : TranspQ) : Decidable (IsIndLine q) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.ind))
|
||
|
||
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]
|
||
theorem ask_of_full_face (q : TranspQ) (h : IsFullFace q) :
|
||
q.ask = eval q.env q.t := by
|
||
unfold ask; rw [show q.φ = .top from h]
|
||
exact eval_transp_top q.env q.binder q.body q.t
|
||
|
||
/-- T2 in question form: transport along a constant line is identity. -/
|
||
@[simp]
|
||
theorem ask_of_const_line (q : TranspQ)
|
||
(hC : IsConstLine q) (hφ : ¬ IsFullFace q) :
|
||
q.ask = eval q.env q.t := by
|
||
unfold ask
|
||
exact eval_transp_const q.env q.binder q.body q.φ q.t hφ hC
|
||
|
||
end TranspQ
|
||
|
||
-- ──────────────────────────────────────────────────────────────────────────
|
||
-- HCompQ — homogeneous-comp question (value-level)
|
||
-- ──────────────────────────────────────────────────────────────────────────
|
||
|
||
/-- Homogeneous composition question. -/
|
||
structure HCompQ where
|
||
/-- 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
|
||
|
||
def HCompQ.Equiv (q₁ q₂ : HCompQ) : Prop := q₁.ask = q₂.ask
|
||
|
||
@[refl] theorem HCompQ.Equiv.refl (q : HCompQ) : q.Equiv q := rfl
|
||
@[symm] theorem HCompQ.Equiv.symm {q₁ q₂ : HCompQ}
|
||
(h : q₁.Equiv q₂) : q₂.Equiv q₁ := Eq.symm h
|
||
theorem HCompQ.Equiv.trans {q₁ q₂ q₃ : HCompQ}
|
||
(h₁ : q₁.Equiv q₂) (h₂ : q₂.Equiv q₃) : q₁.Equiv q₃ := Eq.trans h₁ h₂
|
||
|
||
namespace HCompQ
|
||
|
||
@[simp]
|
||
def IsFullFace (q : HCompQ) : Prop := q.φ = .top
|
||
@[simp]
|
||
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) :=
|
||
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.pi))
|
||
|
||
/-- Full-face hcomp: tube evaluated at `1` is the answer. -/
|
||
@[simp]
|
||
theorem ask_of_full_face (q : HCompQ) (h : IsFullFace q) :
|
||
q.ask = vPApp q.tube .one := by
|
||
unfold ask; rw [show q.φ = .top from h]
|
||
exact vHCompValue_top q.body q.tube q.base
|
||
|
||
end HCompQ
|
||
|
||
-- ──────────────────────────────────────────────────────────────────────────
|
||
-- CompNQ — multi-clause heterogeneous-comp question
|
||
-- ──────────────────────────────────────────────────────────────────────────
|
||
|
||
/-- Multi-clause heterogeneous-comp question. -/
|
||
structure CompNQ where
|
||
/-- Universe level of the type-line `body`. -/
|
||
level : ULevel := .zero
|
||
env : CEnv
|
||
binder : DimVar
|
||
body : CType level
|
||
clauses : List (FaceFormula × CTerm)
|
||
t : CTerm
|
||
|
||
def CompNQ.ask (q : CompNQ) : CVal :=
|
||
vCompNAtTerm q.env q.binder q.body q.clauses q.t
|
||
|
||
def CompNQ.Equiv (q₁ q₂ : CompNQ) : Prop := q₁.ask = q₂.ask
|
||
|
||
@[refl] theorem CompNQ.Equiv.refl (q : CompNQ) : q.Equiv q := rfl
|
||
@[symm] theorem CompNQ.Equiv.symm {q₁ q₂ : CompNQ}
|
||
(h : q₁.Equiv q₂) : q₂.Equiv q₁ := Eq.symm h
|
||
theorem CompNQ.Equiv.trans {q₁ q₂ q₃ : CompNQ}
|
||
(h₁ : q₁.Equiv q₂) (h₂ : q₂.Equiv q₃) : q₁.Equiv q₃ := Eq.trans h₁ h₂
|
||
|
||
namespace CompNQ
|
||
|
||
/-- 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`. -/
|
||
def HasTopClause (q : CompNQ) : Prop := q.hasTopClause = true
|
||
|
||
instance (q : CompNQ) : Decidable (HasTopClause q) :=
|
||
inferInstanceAs (Decidable (q.hasTopClause = true))
|
||
|
||
/-- 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 empty). -/
|
||
def AllBotOrEmpty (q : CompNQ) : Prop := q.liveClauses = []
|
||
|
||
instance (q : CompNQ) : Decidable (AllBotOrEmpty q) :=
|
||
inferInstanceAs (Decidable (q.liveClauses = []))
|
||
|
||
/-- Exactly one live clause. -/
|
||
def IsSingleLive (q : CompNQ) : Prop := ∃ p, q.liveClauses = [p]
|
||
|
||
instance (q : CompNQ) : Decidable (IsSingleLive q) :=
|
||
match h : q.liveClauses with
|
||
| [p] => isTrue ⟨p, h⟩
|
||
| [] => isFalse (fun ⟨_, hp⟩ => by rw [h] at hp; cases hp)
|
||
| _ :: _ :: _ => isFalse (fun ⟨_, hp⟩ => by rw [h] at hp; cases hp)
|
||
|
||
/-- The CompN reduction "anatomy" axiom restated. -/
|
||
theorem ask_def (q : CompNQ) :
|
||
q.ask =
|
||
match q.clauses.find?
|
||
(fun ⟨φ, _⟩ => match φ with | .top => true | _ => false) with
|
||
| some ⟨_, u⟩ => eval q.env (u.substDim q.binder .one)
|
||
| none =>
|
||
let live := q.clauses.filter
|
||
(fun ⟨φ, _⟩ => match φ with | .bot => false | _ => true)
|
||
match live with
|
||
| [] => eval q.env (.transp q.binder q.body .bot q.t)
|
||
| [⟨φ, u⟩] => vCompAtTerm q.env q.binder q.body φ u q.t
|
||
| _ => .vneu (.ncompN q.env q.binder q.body
|
||
(live.map (fun ⟨φ, u⟩ => (φ, eval q.env u)))
|
||
(eval q.env q.t)) := by
|
||
unfold ask
|
||
exact vCompNAtTerm_def q.env q.binder q.body q.clauses q.t
|
||
|
||
end CompNQ
|
||
|
||
end Question
|