b9ca1d8875
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per THEORY.md §3.1: cubical-native modal type formers as the engine
support layer for the cohesive modality triple (ʃ ⊣ ♭ ⊣ ♯).
CType (3 level-preserving formers):
· CType.flat / .sharp / .shape : {ℓ} → CType ℓ → CType ℓ
CTerm (6 — three intros + three elims, modelled on .glueIn / .unglue):
· CTerm.flatIntro / .sharpIntro / .shapeIntro : CTerm → CTerm
· CTerm.flatElim / .sharpElim / .shapeElim : CTerm → CTerm → CTerm
Cascade: Syntax (constructors + SkeletalCType + skeleton + substDim);
DecEq (beq arms); Subst (substDim / substDimExpr + 6 rfl theorems);
DimLine (cascade through 8 dim-absent / dim-substitution lemma families);
Value (3 vIntro CVal + 3 nElim CNeu); Eval (β-reduction axioms +
stuck-neutral propagation, "marker neutral" idiom from vFst/vSnd
preserved); Readback (3 vIntro + 3 nElim arms with axioms); Typing
(6 HasType cases — bare recursion-principle shape; modal cohesion
dependent-motive form deferred to Phase 3); Reflect (3 reflectCType + 6
reflectCTerm + 3 reifyCType with level-coherence discharge + 6
reifyCTerm); Question (6 modal arms + 6 IsModalLine classifier
predicates with their Decidable instances); FFITest (cval/cterm
summary arms).
No Rust changes (Phase 2). No Modal.lean module (Phase 3). No
Crisp / CContext.crispVar / cohesive_triple theorems (Phase 3).
Build: lake build (48 jobs) + lake build CubicalTransport (42 jobs) PASS.
+664 lines across 11 files, 0 removed, 0 new sorries.
Honest deferrals documented:
· Modal type-formers do not yet reduce under transport/comp; the
match A blocks have wildcards so transp i (flat A) φ t produces a
stuck ntransp neutral (correct under current axiom set; cohesion-
driven reductions land in Phase 3).
· HasType.flatElim et al carry the bare recursion-principle shape;
the cohesive-HoTT-correct dependent-motive form requires the modal
predicate lattice from Phase 3.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
953 lines
45 KiB
Text
953 lines
45 KiB
Text
/-
|
||
CubicalTransport.Eval
|
||
====================
|
||
Environment-based evaluator for the cubical calculus (cells-spec §5.4,
|
||
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:
|
||
|
||
· `eval` : `CEnv → CTerm → CVal` — main evaluator
|
||
· `vApp` : `CVal → CVal → CVal` — function application at the value level
|
||
· `vPApp` : `CVal → DimExpr → CVal` — path (dimension) application at value level
|
||
|
||
Coverage: the *λ-calculus fragment* — `var`/`lam`/`app`/`plam`/`papp`.
|
||
`transp`/`comp` produce stuck neutrals (`ntransp`/`ncomp`); their real
|
||
reduction rules come with `Transport.lean` and `Comp.lean` (Weeks 3–4).
|
||
|
||
These are `partial def`s. Termination isn't statically checked because the
|
||
`vPApp` β-step substitutes inside the closure body and re-evaluates; the
|
||
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 "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 "cubical_transport_eval"]
|
||
opaque evalRust (env : CEnv) : CTerm → CVal
|
||
|
||
@[extern "cubical_transport_vapp"]
|
||
opaque vAppRust : CVal → CVal → CVal
|
||
|
||
@[extern "cubical_transport_vpapp"]
|
||
opaque vPAppRust : CVal → DimExpr → CVal
|
||
|
||
@[extern "cubical_transport_vhcomp"]
|
||
opaque vHCompValueRust {ℓ : ULevel} (A : CType ℓ) (φ : FaceFormula) (tube base : CVal) : CVal
|
||
|
||
@[extern "cubical_transport_vcomp_term"]
|
||
opaque vCompAtTermRust {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||
(φ : FaceFormula) (u t : CTerm) : CVal
|
||
|
||
@[extern "cubical_transport_vcompn_term"]
|
||
opaque vCompNAtTermRust {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||
(clauses : List (FaceFormula × CTerm)) (t : CTerm) : CVal
|
||
|
||
@[extern "cubical_transport_vfst"]
|
||
opaque vFstRust : CVal → CVal
|
||
|
||
@[extern "cubical_transport_vsnd"]
|
||
opaque vSndRust : CVal → CVal
|
||
|
||
mutual
|
||
/-- Evaluate a term in an environment. λ-fragment + dimension abstraction
|
||
are reduced immediately; transport dispatches through `vTransp`;
|
||
heterogeneous composition dispatches through `vCompAtTerm` (which has
|
||
access to the raw CTerms so it can substitute at the term level for
|
||
`comp_full`).
|
||
|
||
This is a `partial def` because the β-step in `vPApp` substitutes inside
|
||
a closure body (via `CTerm.substDim`) and re-evaluates — the resulting
|
||
term is the same CTerm size, but Lean's structural-recursion checker
|
||
can't see through that, and indeed an untyped Ω-like term genuinely
|
||
diverges. A well-typed total evaluator arrives in a later phase. -/
|
||
@[implemented_by evalRust]
|
||
partial def eval (env : CEnv) : CTerm → CVal
|
||
| .var x => (env.lookup x).getD (.vneu (.nvar x))
|
||
| .lam x body => .vlam env x body
|
||
| .app f a => vApp (eval env f) (eval env a)
|
||
| .plam i body => .vplam env i body
|
||
| .papp t r => vPApp (eval env t) r
|
||
| .transp i A φ t =>
|
||
-- Priority order: (1) full face, (2) constant line, (3) path
|
||
-- (needs env), (4) glue (dispatched via dedicated axioms in
|
||
-- `Glue.lean`; the partial def produces a stuck neutral as a
|
||
-- runtime placeholder), (5) other via value-level `vTransp`.
|
||
match φ with
|
||
| .top => eval env t -- (1) T1
|
||
| _ =>
|
||
if CType.dimAbsent i A then
|
||
eval env t -- (2) T2
|
||
else
|
||
match A with
|
||
| .path A₀ a b => .vPathTransp env i A₀ a b φ t -- (3)
|
||
| .glue _ _ _ _ _ _ _ _ => -- (4) Glue
|
||
-- Real reduction rules live in `Glue.lean` as dedicated
|
||
-- axioms keyed on specific sub-cases (e.g. constant
|
||
-- equivalence components). The partial def produces
|
||
-- `ntransp` as a placeholder — the same shape vTransp
|
||
-- would produce on stuck glue — so that kernel-level
|
||
-- proofs go exclusively through the Glue axioms.
|
||
.vneu (.ntransp i A φ (eval env t))
|
||
| _ => vTransp i A φ (eval env t) -- (5)
|
||
| .comp i A φ u t => vCompAtTerm env i A φ u t
|
||
| .compN i A clauses t => vCompNAtTerm env i A clauses t
|
||
| .glueIn φ t a =>
|
||
-- Face-priority dispatch: φ = .top → t-side, φ = .bot → a-side,
|
||
-- else stuck `.nglueIn` preserving both face-on / face-off values.
|
||
match φ with
|
||
| .top => eval env t
|
||
| .bot => eval env a
|
||
| _ => .vneu (.nglueIn φ (eval env t) (eval env a))
|
||
| .unglue φ f g =>
|
||
-- Face-priority dispatch:
|
||
-- φ = .top: apply the forward map; the argument is a T-value.
|
||
-- φ = .bot: identity — on the empty face, the glued term is the
|
||
-- A-value `g` itself (consistent with `glueIn .bot t a → a`).
|
||
-- Else: stuck `.nunglue` preserving `f` and `g`.
|
||
match φ with
|
||
| .top => vApp (eval env f) (eval env g)
|
||
| .bot => eval env g
|
||
| _ => .vneu (.nunglue φ (eval env f) (eval env g))
|
||
| .pair a b => .vpair (eval env a) (eval env b)
|
||
| .fst t => vFst (eval env t)
|
||
| .snd t => vSnd (eval env t)
|
||
-- REL1 inductive-type constructors.
|
||
| .dimExpr r => .vdimExpr r
|
||
-- Universe-code constructor (CCHM §6 universe codes).
|
||
| .code A => .vcode A
|
||
| .ctor S c params args =>
|
||
-- Produce a canonical constructor value with all args evaluated.
|
||
-- (Boundary firing for path ctors lands in a follow-up — REL1
|
||
-- design doc §4: when a `.dim`-typed arg evaluates to .zero/.one
|
||
-- and matches a clause in `S.ctors[c].boundary`, we should fire
|
||
-- that clause body instead. TODO REL1.1.)
|
||
.vctor S c params (args.map (eval env))
|
||
| .indElim S params motive branches target =>
|
||
-- β-reduce on a canonical `vctor`; otherwise build a stuck
|
||
-- `.nIndElim` that preserves env-evaluated motive and branches
|
||
-- so it can unstick when target later resolves.
|
||
match eval env target with
|
||
| .vctor _ c _ argsV =>
|
||
match List.lookup c branches with
|
||
| some body =>
|
||
-- Apply branch body to constructor's args via repeated
|
||
-- `vApp` — the body is curried: λ a₁ … aₙ. result.
|
||
-- Recursive-arg hypotheses (the IH passed alongside each
|
||
-- `.self` arg in the design doc §5) are not yet wired
|
||
-- here; an `indElim` of a non-recursive ctor is fully
|
||
-- handled, but recursive ctors land their branch body
|
||
-- with only the constructor args (no IH) — TODO REL1.1.
|
||
argsV.foldl (fun f a => vApp f a) (eval env body)
|
||
| none =>
|
||
.vneu (.nvar s!"<indElim: no branch for {c}>")
|
||
| .vneu n =>
|
||
.vneu (.nIndElim S params (eval env motive)
|
||
(branches.map (fun (nm, b) => (nm, eval env b))) n)
|
||
| _ =>
|
||
.vneu (.nvar "<indElim: target is not canonical>")
|
||
-- Modal introductions: structural lift to the corresponding value form.
|
||
| .flatIntro a => .vFlatIntro (eval env a)
|
||
| .sharpIntro a => .vSharpIntro (eval env a)
|
||
| .shapeIntro a => .vShapeIntro (eval env a)
|
||
-- Modal eliminations: β-reduce on the corresponding intro value form;
|
||
-- otherwise produce a stuck neutral that preserves the evaluated
|
||
-- eliminator function and the (necessarily-stuck) scrutinee neutral.
|
||
| .flatElim f m =>
|
||
match eval env m with
|
||
| .vFlatIntro a => vApp (eval env f) a
|
||
| .vneu n => .vneu (.nflatElim (eval env f) n)
|
||
| _ => .vneu (.nvar "<flatElim: scrutinee is not flat-canonical>")
|
||
| .sharpElim f m =>
|
||
match eval env m with
|
||
| .vSharpIntro a => vApp (eval env f) a
|
||
| .vneu n => .vneu (.nsharpElim (eval env f) n)
|
||
| _ => .vneu (.nvar "<sharpElim: scrutinee is not sharp-canonical>")
|
||
| .shapeElim f m =>
|
||
match eval env m with
|
||
| .vShapeIntro a => vApp (eval env f) a
|
||
| .vneu n => .vneu (.nshapeElim (eval env f) n)
|
||
| _ => .vneu (.nvar "<shapeElim: scrutinee is not shape-canonical>")
|
||
|
||
/-- First projection at the value level. β-reduces `vpair`; pushes a
|
||
stuck neutral into `nfst`. Projecting any other value shape is a
|
||
type error (marker neutral). -/
|
||
@[implemented_by vFstRust]
|
||
partial def vFst : CVal → CVal
|
||
| .vpair a _ => a
|
||
| .vneu n => .vneu (.nfst n)
|
||
| _ => .vneu (.nvar "<vFst: non-pair projection>")
|
||
|
||
/-- Second projection at the value level. Mirror of `vFst`. -/
|
||
@[implemented_by vSndRust]
|
||
partial def vSnd : CVal → CVal
|
||
| .vpair _ b => b
|
||
| .vneu n => .vneu (.nsnd n)
|
||
| _ => .vneu (.nvar "<vSnd: non-pair projection>")
|
||
|
||
/-- Apply one value to another. β-reduces `vlam` closures; pushes stuck
|
||
neutrals into `napp`. `vTranspFun` unfolds per the *full* CCHM Π rule.
|
||
`vHCompFun` unfolds per the CCHM Π hcomp rule: apply pointwise
|
||
through the tube, then recursively hcomp on the codomain. Applying
|
||
a `vplam` or `vTubeApp` as a function is a type error. -/
|
||
@[implemented_by vAppRust]
|
||
partial def vApp : CVal → CVal → CVal
|
||
| .vlam env x body, arg => eval (env.extend x arg) body
|
||
| .vneu n, arg => .vneu (.napp n arg)
|
||
| .vTranspFun i domA codA φ f, arg =>
|
||
vTransp i codA φ (vApp f (vTranspInv i domA φ arg))
|
||
| .vHCompFun codA φ tube base, arg =>
|
||
vHCompValue codA φ (.vTubeApp tube arg) (vApp base arg)
|
||
-- Full CCHM Π hetero comp β-rule. See file-level comment below for
|
||
-- the fill construction.
|
||
| .vCompFun env i domA codA φ u t, arg =>
|
||
let yName := "$y"
|
||
let fj : DimVar := ⟨"$fj"⟩
|
||
let newEnv := env.extend yName arg
|
||
-- `filled_y_at_i`: a line in the *outer* binder `i` giving y_at_i:A(i).
|
||
-- Build as `transp^{fj} (domA[i := (inv fj) ∨ i]) φ ($y)`:
|
||
-- at fj=0: line slice is A(1) (source: y : A(1))
|
||
-- at fj=1: line slice is A(i) (target we want)
|
||
let filled_y_at_i : CTerm :=
|
||
.transp fj
|
||
(domA.substDimExpr i (.join (.inv (.var fj)) (.var i)))
|
||
φ (.var yName)
|
||
-- `filled_y_at_0`: substitute i := 0 in the above — the reversed
|
||
-- line is `A[i := inv fj]`, taking A(1) → A(0).
|
||
let filled_y_at_0 : CTerm :=
|
||
.transp fj
|
||
(domA.substDimExpr i (.inv (.var fj)))
|
||
φ (.var yName)
|
||
eval newEnv (.comp i codA φ
|
||
(.app u filled_y_at_i)
|
||
(.app t filled_y_at_0))
|
||
| .vplam _ _ _, _ => .vneu (.nvar "<vApp: vplam applied as function>")
|
||
| .vTubeApp _ _, _ => .vneu (.nvar "<vApp: vTubeApp applied as function>")
|
||
| .vPathTransp _ _ _ _ _ _ _, _ => .vneu (.nvar "<vApp: vPathTransp applied as function>")
|
||
| .vpair _ _, _ => .vneu (.nvar "<vApp: vpair applied as function>")
|
||
| .vctor _ _ _ _, _ => .vneu (.nvar "<vApp: vctor applied as function>")
|
||
| .vdimExpr _, _ => .vneu (.nvar "<vApp: vdimExpr applied as function>")
|
||
| .vcode _, _ => .vneu (.nvar "<vApp: vcode applied as function>")
|
||
| .vFlatIntro _, _ => .vneu (.nvar "<vApp: vFlatIntro applied as function>")
|
||
| .vSharpIntro _, _ => .vneu (.nvar "<vApp: vSharpIntro applied as function>")
|
||
| .vShapeIntro _, _ => .vneu (.nvar "<vApp: vShapeIntro applied as function>")
|
||
|
||
/-- Apply a value to a dimension expression. β-reduces `vplam` closures
|
||
by substituting the dim in the body and re-evaluating; pushes stuck
|
||
neutrals into `npapp`. `vTubeApp tube arg` applied to dim `r` reduces
|
||
to `vApp (vPApp tube r) arg` — the semantic meaning of
|
||
`λj. (tube @ j) arg`. Marker neutrals for ill-typed applications. -/
|
||
@[implemented_by vPAppRust]
|
||
partial def vPApp : CVal → DimExpr → CVal
|
||
| .vplam env i body, r => eval env (body.substDim i r)
|
||
| .vneu n, r => .vneu (.npapp n r)
|
||
| .vTubeApp tube arg, r => vApp (vPApp tube r) arg
|
||
-- Path transport endpoint reductions: at `.zero` / `.one` the CCHM
|
||
-- multi-clause system degenerates (the (j=0) or (j=1) clause fires)
|
||
-- and the result is the specified endpoint at i=1. At generic `r`
|
||
-- we fall through to `vCompNAtTerm` on the CCHM multi-clause system
|
||
-- `[φ ↦ p@r, (r=0) ↦ a, (r=1) ↦ b]` with base `p@r` — which reduces
|
||
-- further if the face substitutions happen to simplify.
|
||
| .vPathTransp env i _ a _ _ _, .zero => eval env (a.substDim i .one)
|
||
| .vPathTransp env i _ _ b _ _, .one => eval env (b.substDim i .one)
|
||
| .vPathTransp env i A a b φ p, r =>
|
||
vCompNAtTerm env i A
|
||
[ (φ, .papp p r)
|
||
, (FaceFormula.dimExprEq0 r, a)
|
||
, (FaceFormula.dimExprEq1 r, b) ]
|
||
(.papp p r)
|
||
| .vlam _ _ _, _ => .vneu (.nvar "<vPApp: vlam applied as path>")
|
||
| .vTranspFun _ _ _ _ _, _ => .vneu (.nvar "<vPApp: vTranspFun applied as path>")
|
||
| .vHCompFun _ _ _ _, _ => .vneu (.nvar "<vPApp: vHCompFun applied as path>")
|
||
| .vCompFun _ _ _ _ _ _ _, _ => .vneu (.nvar "<vPApp: vCompFun applied as path>")
|
||
| .vpair _ _, _ => .vneu (.nvar "<vPApp: vpair applied as path>")
|
||
| .vctor _ _ _ _, _ => .vneu (.nvar "<vPApp: vctor applied as path>")
|
||
| .vdimExpr _, _ => .vneu (.nvar "<vPApp: vdimExpr applied as path>")
|
||
| .vcode _, _ => .vneu (.nvar "<vPApp: vcode applied as path>")
|
||
| .vFlatIntro _, _ => .vneu (.nvar "<vPApp: vFlatIntro applied as path>")
|
||
| .vSharpIntro _, _ => .vneu (.nvar "<vPApp: vSharpIntro applied as path>")
|
||
| .vShapeIntro _, _ => .vneu (.nvar "<vPApp: vShapeIntro applied as path>")
|
||
|
||
/-- Homogeneous composition at the value level. The type `A` is
|
||
*homogeneous* (doesn't vary along `i`); the tube and base are
|
||
already-evaluated values.
|
||
|
||
Reducing cases (in match order):
|
||
1. `φ = .top` — tube covers everything, result is `tube @ 1`.
|
||
2. `A = .pi` — CCHM Π hcomp: construct a `vHCompFun` closure
|
||
that applies pointwise when the function is
|
||
applied to an argument.
|
||
3. Otherwise — stuck `.vneu (.nhcomp ...)`.
|
||
|
||
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 {ℓ : 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)
|
||
|
||
/-- Heterogeneous composition at the term level. Takes `u` and `t` as
|
||
`CTerm`s (not `CVal`s) so that the `comp_full` reduction can perform
|
||
substitution *at the term level* — `eval env (u.substDim i .one)` —
|
||
which is in general different from `vPApp (eval env u) .one`.
|
||
|
||
Reducing cases (in match order):
|
||
1. `φ = .top` — C1: `eval env (u[i := 1])`.
|
||
2. `φ = .bot` — C2: `eval env (transp i A .bot t)`.
|
||
3. `CType.dimAbsent i A = true` — constant line: heterogeneous
|
||
comp reduces to hcomp on the
|
||
fixed type `A`, with `.plam i u`
|
||
as the tube.
|
||
4. Otherwise — stuck `.vneu (.ncomp ...)`.
|
||
|
||
Note cases (1) and (2) are decidable at the `.top`/`.bot` head of
|
||
`φ`; case (3) discriminates on `A` only after `.top`/`.bot` are
|
||
ruled out. All four cases are mutually exclusive. -/
|
||
@[implemented_by vCompAtTermRust]
|
||
partial def vCompAtTerm {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||
(φ : FaceFormula) (u t : CTerm) : CVal :=
|
||
match φ with
|
||
| .top => eval env (u.substDim i .one)
|
||
| .bot => eval env (.transp i A .bot t)
|
||
| _ =>
|
||
if CType.dimAbsent i A then
|
||
-- Constant line: hetero comp reduces to hcomp. `.plam i u` is the
|
||
-- tube as a dim-closure.
|
||
vHCompValue A φ (eval env (.plam i u)) (eval env t)
|
||
else
|
||
match A with
|
||
| .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
|
||
| _ =>
|
||
.vneu (.ncomp i A φ (eval env u) (eval env t))
|
||
|
||
/-- Multi-clause heterogeneous composition at the term level. Dispatches
|
||
by scanning the clause list:
|
||
· If any clause has face `.top`, that clause's body substituted at
|
||
`i := .one` is the result (CCHM multi-clause full-system rule).
|
||
· If all clause faces are `.bot` or the list is empty, no clause
|
||
fires — reduces to plain transport of the base.
|
||
· If exactly one clause has a non-trivial face, delegate to
|
||
`vCompAtTerm` (single-clause specialisation).
|
||
· Otherwise produce a stuck `ncompN` neutral preserving env, line
|
||
binder, type, evaluated clauses, and evaluated base. -/
|
||
@[implemented_by vCompNAtTermRust]
|
||
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
|
||
| some ⟨_, u⟩ => eval env (u.substDim i .one)
|
||
| none =>
|
||
-- Strip `.bot` clauses (they never fire).
|
||
let live := clauses.filter
|
||
(fun ⟨φ, _⟩ => match φ with | .bot => false | _ => true)
|
||
match live with
|
||
| [] => eval env (.transp i A .bot t)
|
||
| [⟨φ, u⟩] => vCompAtTerm env i A φ u t
|
||
| _ =>
|
||
.vneu (.ncompN env i A
|
||
(live.map (fun ⟨φ, u⟩ => (φ, eval env u)))
|
||
(eval env t))
|
||
end
|
||
|
||
/-!
|
||
## Reduction lemmas (axioms)
|
||
|
||
`partial def` is opaque at the kernel level, so the defining cases of
|
||
`eval`, `vApp`, and `vPApp` are not reducible by `rfl`. We state them as
|
||
axioms — the same pattern used for `CTerm.step` and `step_papp_plam` in
|
||
`Syntax.lean`. They exactly mirror the `partial def` match arms above,
|
||
so they are consistent with the runtime implementation while also being
|
||
usable in kernel-level proofs.
|
||
-/
|
||
|
||
-- Reduction lemmas for `eval`.
|
||
|
||
axiom eval_var (env : CEnv) (x : String) :
|
||
eval env (.var x) = (env.lookup x).getD (.vneu (.nvar x))
|
||
|
||
axiom eval_lam (env : CEnv) (x : String) (body : CTerm) :
|
||
eval env (.lam x body) = .vlam env x body
|
||
|
||
axiom eval_app (env : CEnv) (f a : CTerm) :
|
||
eval env (.app f a) = vApp (eval env f) (eval env a)
|
||
|
||
axiom eval_plam (env : CEnv) (i : DimVar) (body : CTerm) :
|
||
eval env (.plam i body) = .vplam env i body
|
||
|
||
axiom eval_papp (env : CEnv) (t : CTerm) (r : DimExpr) :
|
||
eval env (.papp t r) = vPApp (eval env t) r
|
||
|
||
/-!
|
||
### `eval` on `.transp` — four disjoint cases
|
||
|
||
Replaces the earlier coarse `eval_transp` axiom. Match-arm priority is:
|
||
1. `.top` face → identity (T1 at eval level).
|
||
2. Constant line → identity (T2 at eval level).
|
||
3. `.path A₀ a b` line, non-constant → `vPathTransp` closure.
|
||
4. Non-path, non-constant line → delegate to value-level `vTransp`.
|
||
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 {ℓ : 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 {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||
(φ : FaceFormula) (t : CTerm)
|
||
(hφ : φ ≠ .top)
|
||
(hA : CType.dimAbsent i A = true) :
|
||
eval env (.transp i A φ t) = eval env t
|
||
|
||
/-- (3) Path transport: when the line's body is `.path A₀ a b` with the
|
||
whole path-line genuinely varying, produce a `vPathTransp` closure
|
||
that captures the endpoint CTerms `a`/`b` along with the env and the
|
||
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 {ℓ : ULevel} (env : CEnv) (i : DimVar) (A₀ : CType ℓ)
|
||
(a b : CTerm) (φ : FaceFormula) (t : CTerm)
|
||
(hφ : φ ≠ .top)
|
||
(hA : CType.dimAbsent i (.path A₀ a b) = false) :
|
||
eval env (.transp i (.path A₀ a b) φ t) =
|
||
.vPathTransp env i A₀ a b φ t
|
||
|
||
/-- (4) Non-path non-glue non-constant transport: delegate to the value-level
|
||
`vTransp`, which is env-agnostic and handles `.pi` via `vTranspFun`.
|
||
`.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.
|
||
|
||
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₀ : 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)
|
||
|
||
/-- Π-case theorem (full CCHM): transport along any `pi domA codA` line
|
||
produces a `vTranspFun` closure. Derived via `eval_transp_nonpath`
|
||
(`pi ≠ path` and `pi ≠ glue` by constructor disjointness) plus
|
||
`vTransp_pi`. -/
|
||
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 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
|
||
|
||
/-- Stuck fallback theorem. In our current `CType` universe
|
||
`{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 : 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
|
||
rw [eval_transp_nonpath env i A φ t hφ hA h_not_path h_not_glue]
|
||
exact vTransp_stuck _ _ _ _ hφ hA h_not_pi
|
||
|
||
/-- **T5 at eval level**: face-formula congruence for transport. When
|
||
two face formulas are semantically equal — i.e. `φ.eval env =
|
||
ψ.eval env` for every env — transport under them computes the same
|
||
result.
|
||
|
||
This is a claim about Rust's evaluator: it inspects face formulas
|
||
only through their truth-value semantics, not their syntactic form.
|
||
Two faces that classify the same set of environments produce the
|
||
same transport reduction, regardless of their concrete tree
|
||
structure (e.g. `(i=0) ∧ ⊤` vs `(i=0)`).
|
||
|
||
Stated at the eval level (rather than augmenting the partial def
|
||
with a face-normalisation prepass) so the existing eval-axiom set is
|
||
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 {ℓ : 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)
|
||
|
||
/-!
|
||
### `eval` on `.comp` — four disjoint cases
|
||
|
||
The old coarse `eval_comp` (which asserted the stuck form unconditionally)
|
||
is replaced by four case-axioms mirroring the arms of `vCompAtTerm`. The
|
||
cases are disjoint by precondition, so the axiom set is consistent.
|
||
-/
|
||
|
||
/-- **C1 at eval level**: with a full face, heterogeneous composition
|
||
reduces to the system body substituted at `i := 1`. Crucially this
|
||
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 {ℓ : 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 {ℓ : 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 {ℓ : ULevel} (env : CEnv) (i : DimVar) (A : CType ℓ)
|
||
(φ : FaceFormula) (u t : CTerm)
|
||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||
(hA : CType.dimAbsent i A = true) :
|
||
eval env (.comp i A φ u t) =
|
||
vHCompValue A φ (eval env (.plam i u)) (eval env t)
|
||
|
||
/-- **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 {ℓ ℓ' : ULevel} (env : CEnv) (i : DimVar)
|
||
(var : String) (domA : CType ℓ) (codA : CType ℓ')
|
||
(φ : FaceFormula) (u t : CTerm)
|
||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||
(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. 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 : 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 {ℓ : 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
|
||
|
||
/-!
|
||
### `vHCompValue` — three disjoint cases
|
||
-/
|
||
|
||
/-- Homogeneous composition under a full face: the tube covers everything,
|
||
and the result is the tube evaluated at `1`. -/
|
||
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
|
||
a `vHCompFun` closure that applies pointwise when its function is
|
||
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 {ℓ ℓ' : ULevel}
|
||
(var : String) (domA : CType ℓ) (codA : CType ℓ')
|
||
(φ : FaceFormula) (tube base : CVal)
|
||
(hφ : φ ≠ .top) :
|
||
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).
|
||
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 : A.skeleton ≠ SkeletalCType.pi) :
|
||
vHCompValue A φ tube base = .vneu (.nhcomp A φ tube base)
|
||
|
||
-- Reduction lemmas for `vApp`.
|
||
|
||
axiom vApp_vlam (env : CEnv) (x : String) (body : CTerm) (arg : CVal) :
|
||
vApp (.vlam env x body) arg = eval (env.extend x arg) body
|
||
|
||
axiom vApp_vneu (n : CNeu) (arg : CVal) :
|
||
vApp (.vneu n) arg = .vneu (.napp n arg)
|
||
|
||
/-- Full CCHM Π β-rule at the value level: applying a transported-function
|
||
closure to an argument `arg` inversely transports `arg` through the
|
||
domain, applies the underlying function `f`, and forward-transports the
|
||
result through the codomain.
|
||
|
||
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 {ℓ ℓ' : 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))
|
||
|
||
/-- **CCHM Π hcomp β-rule** at the value level: applying a homogeneously
|
||
composed function closure to `arg` yields hcomp on the codomain with:
|
||
· tube = `λj. (tube @ j) arg` (represented by `vTubeApp`),
|
||
· base = `base arg`.
|
||
No inverse transport — hcomp's type is fixed, so the argument passes
|
||
through unchanged. -/
|
||
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)
|
||
|
||
/-- **Full CCHM Π hetero comp β-rule**: applying `comp^i (pi A B) φ u u₀` to
|
||
`y : A(1)` unfolds via the *fill* construction. For a fresh dim `$fj`
|
||
and argument name `$y`:
|
||
· `y_at_i = transp^{$fj} (A[i := inv $fj ∨ i]) φ y` — fill from A(1) down to A(i).
|
||
· `y_at_0 = transp^{$fj} (A[i := inv $fj]) φ y` — reversed-line transport A(1) → A(0).
|
||
The result is `comp^i B(i) φ (u (y_at_i)) (u₀ (y_at_0))` evaluated in
|
||
an env extending `$y` with the argument.
|
||
|
||
When `CType.dimAbsent i domA = true`, both fills degenerate to `y`
|
||
(by T2 on the constant line), recovering the simpler const-domain
|
||
formula `comp^i B(i) φ (u y) (u₀ y)`.
|
||
|
||
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 {ℓ ℓ' : 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 φ
|
||
(.app u (.transp ⟨"$fj"⟩
|
||
(domA.substDimExpr i (.join (.inv (.var ⟨"$fj"⟩)) (.var i)))
|
||
φ (.var "$y")))
|
||
(.app t (.transp ⟨"$fj"⟩
|
||
(domA.substDimExpr i (.inv (.var ⟨"$fj"⟩)))
|
||
φ (.var "$y"))))
|
||
|
||
-- Reduction lemmas for `vPApp`.
|
||
|
||
axiom vPApp_vplam (env : CEnv) (i : DimVar) (body : CTerm) (r : DimExpr) :
|
||
vPApp (.vplam env i body) r = eval env (body.substDim i r)
|
||
|
||
axiom vPApp_vneu (n : CNeu) (r : DimExpr) :
|
||
vPApp (.vneu n) r = .vneu (.npapp n r)
|
||
|
||
/-- `vTubeApp tube arg` under dim application reduces to `(tube @ r) arg`.
|
||
Encodes the semantic meaning of `λj. (tube @ j) arg`. -/
|
||
axiom vPApp_vTubeApp (tube arg : CVal) (r : DimExpr) :
|
||
vPApp (.vTubeApp tube arg) r = vApp (vPApp tube r) arg
|
||
|
||
/-!
|
||
### `vCompNAtTerm` — compound equation mirroring the partial-def arms
|
||
|
||
Single axiom exposing the full case analysis so that derived theorems can
|
||
pattern-match on the clause list's structure. -/
|
||
|
||
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?
|
||
(fun ⟨φ, _⟩ => match φ with | .top => true | _ => false) with
|
||
| some ⟨_, u⟩ => eval env (u.substDim i .one)
|
||
| none =>
|
||
let live := clauses.filter
|
||
(fun ⟨φ, _⟩ => match φ with | .bot => false | _ => true)
|
||
match live with
|
||
| [] => eval env (.transp i A .bot t)
|
||
| [⟨φ, u⟩] => vCompAtTerm env i A φ u t
|
||
| _ => .vneu (.ncompN env i A
|
||
(live.map (fun ⟨φ, u⟩ => (φ, eval env u)))
|
||
(eval env t))
|
||
|
||
/-!
|
||
### Path transport endpoint reductions
|
||
|
||
Applied at `.zero`, the CCHM `(j=0)` clause fires, giving `a(1)`.
|
||
Applied at `.one`, the `(j=1)` clause fires, giving `b(1)`.
|
||
Applied at any other DimExpr, the multi-clause comp can't be computed
|
||
without machinery we haven't built yet — stalls at `npathTranspApp`.
|
||
The three axioms are disjoint by the shape of the DimExpr argument.
|
||
-/
|
||
|
||
/-- Path transport at left endpoint: result is `a(1)`, i.e. `a` evaluated
|
||
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 {ℓ : 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 {ℓ : 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)
|
||
|
||
/-- **Full CCHM path transport at a generic dim**: apply the path
|
||
transport at `r` by evaluating the CCHM multi-clause comp
|
||
`comp^i A [φ ↦ p@r, (r=0) ↦ a, (r=1) ↦ b] (p@r)` via `vCompNAtTerm`.
|
||
This genuinely unsticks when `r`'s face substitution simplifies:
|
||
· `r = .zero` → `(r=0)` becomes `.top`, firing the left clause → `a(1)`.
|
||
· `r = .one` → `(r=1)` becomes `.top`, firing the right clause → `b(1)`.
|
||
· `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 {ℓ : 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 =
|
||
vCompNAtTerm env i A
|
||
[ (φ, .papp p r)
|
||
, (FaceFormula.dimExprEq0 r, a)
|
||
, (FaceFormula.dimExprEq1 r, b) ]
|
||
(.papp p r)
|
||
|
||
/-!
|
||
### `eval` on `.glueIn` — three disjoint cases
|
||
|
||
`glueIn [φ ↦ t] a` evaluates differently on/off/between the face `φ`:
|
||
· `φ = .top`: the face is full, the result is `t` (only the T-side
|
||
matters).
|
||
· `φ = .bot`: the face is empty, the result is `a` (only the A-side
|
||
matters).
|
||
· Otherwise: a structurally stuck `nglueIn` neutral preserving both
|
||
face-on and face-off values — later dim substitution into `φ` may
|
||
collapse it.
|
||
|
||
The three cases are mutually exclusive by precondition. -/
|
||
|
||
/-- (1) Full-face glueIn reduces to the T-side. -/
|
||
axiom eval_glueIn_top (env : CEnv) (t a : CTerm) :
|
||
eval env (.glueIn .top t a) = eval env t
|
||
|
||
/-- (2) Empty-face glueIn reduces to the A-side. -/
|
||
axiom eval_glueIn_bot (env : CEnv) (t a : CTerm) :
|
||
eval env (.glueIn .bot t a) = eval env a
|
||
|
||
/-- (3) Neutral-face glueIn produces an `nglueIn` stuck neutral preserving
|
||
both evaluated sides. The face formula is kept syntactic so that
|
||
later dim substitution can resolve it to `.top` or `.bot`.
|
||
|
||
The `h_not_unglue` precondition rules out the η-redex shape
|
||
`.glueIn φ t (.unglue φ f g)`, which reduces via
|
||
`eval_glueIn_of_unglue` to `eval env g` instead of a stuck form.
|
||
Without this restriction, the stuck rule and the η-rule would
|
||
disagree on a common instance. -/
|
||
axiom eval_glueIn_stuck (env : CEnv) (φ : FaceFormula) (t a : CTerm)
|
||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||
(h_not_unglue : ∀ f g, a ≠ .unglue φ f g) :
|
||
eval env (.glueIn φ t a) = .vneu (.nglueIn φ (eval env t) (eval env a))
|
||
|
||
/-!
|
||
### `eval` on `.unglue` — three disjoint cases
|
||
|
||
`unglue [φ ↦ f] g` — extracting an A-value from a glued term:
|
||
· `φ = .top`: apply the forward map: `vApp (eval f) (eval g)`.
|
||
· `φ = .bot`: identity. `glueIn .bot t a` reduces to `a`, so the
|
||
argument is already an A-value; unglue is the identity there.
|
||
· Otherwise: stuck `nunglue` preserving `f` and `g`.
|
||
|
||
All three cases are mutually exclusive. -/
|
||
|
||
/-- (1) Full-face unglue: apply the forward map pointwise. -/
|
||
axiom eval_unglue_top (env : CEnv) (f g : CTerm) :
|
||
eval env (.unglue .top f g) = vApp (eval env f) (eval env g)
|
||
|
||
/-- (2) Empty-face unglue: identity on `g`. This is the definitional
|
||
content of `Glue [bot ↦ (T, e)] A = A`: values are already A-values. -/
|
||
axiom eval_unglue_bot (env : CEnv) (f g : CTerm) :
|
||
eval env (.unglue .bot f g) = eval env g
|
||
|
||
/-- (3) Neutral-face unglue: produce a stuck `nunglue` neutral preserving
|
||
`f` and `g`. Later dim substitution into `φ` may resolve it to
|
||
`.top` (→ forward-map application) or `.bot` (→ identity).
|
||
|
||
The `h_not_glueIn` precondition rules out the β-redex shape
|
||
`.unglue φ f (.glueIn φ t a)`, which reduces via
|
||
`eval_unglue_of_glueIn` to `eval env a` under the overlap
|
||
condition. Without this restriction, the stuck rule and the
|
||
β-rule would disagree on a common instance. -/
|
||
axiom eval_unglue_stuck (env : CEnv) (φ : FaceFormula) (f g : CTerm)
|
||
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
|
||
(h_not_glueIn : ∀ t a, g ≠ .glueIn φ t a) :
|
||
eval env (.unglue φ f g) = .vneu (.nunglue φ (eval env f) (eval env g))
|
||
|
||
/-!
|
||
### Glue β- and η-rules (eval level)
|
||
|
||
The β-rule (`unglue · glueIn`) and η-rule (`glueIn · unglue`) on
|
||
matching face formulas fire *regardless* of whether `φ` is `.top`,
|
||
`.bot`, or stuck. On `.top` / `.bot` the existing face-dispatched
|
||
axioms reduce to the same result under the overlap condition
|
||
(consistency check below); on stuck faces, these rules are the only
|
||
way the redex reduces — `eval_unglue_stuck` and `eval_glueIn_stuck`
|
||
carry `h_not_glueIn` / `h_not_unglue` preconditions to avoid conflict.
|
||
|
||
The `h_overlap` condition encodes the CCHM typing-side constraint
|
||
`e.f t = a` (or `t = e.f g`) that accompanies a well-typed glueIn /
|
||
unglue — the evaluator assumes it and short-circuits.
|
||
-/
|
||
|
||
/-- β-rule: `unglue φ f (glueIn φ t a)` reduces to `a` under the
|
||
overlap condition. Rust-discharge: the evaluator recognises the
|
||
nested pattern and short-circuits when the overlap invariant holds
|
||
(typing guarantees it). -/
|
||
axiom eval_unglue_of_glueIn (env : CEnv) (φ : FaceFormula) (f t a : CTerm)
|
||
(h_overlap : eval env (.app f t) = eval env a) :
|
||
eval env (.unglue φ f (.glueIn φ t a)) = eval env a
|
||
|
||
/-- η-rule: `glueIn φ t (unglue φ f g)` reduces to `g` under the
|
||
overlap condition. Rust-discharge: dual to `eval_unglue_of_glueIn`. -/
|
||
axiom eval_glueIn_of_unglue (env : CEnv) (φ : FaceFormula) (f t g : CTerm)
|
||
(h_overlap : eval env t = eval env (.app f g)) :
|
||
eval env (.glueIn φ t (.unglue φ f g)) = eval env g
|
||
|
||
/-!
|
||
### `eval` on Σ constructors — three arms
|
||
|
||
`.pair a b` evaluates component-wise to `.vpair`; `.fst t` / `.snd t`
|
||
project through `vFst` / `vSnd`, which themselves β-reduce on `vpair`
|
||
and produce stuck `.nfst` / `.nsnd` on neutrals.
|
||
-/
|
||
|
||
/-- Pair construction evaluates component-wise. -/
|
||
axiom eval_pair (env : CEnv) (a b : CTerm) :
|
||
eval env (.pair a b) = .vpair (eval env a) (eval env b)
|
||
|
||
/-- First projection delegates to `vFst`. -/
|
||
axiom eval_fst (env : CEnv) (t : CTerm) :
|
||
eval env (.fst t) = vFst (eval env t)
|
||
|
||
/-- Second projection delegates to `vSnd`. -/
|
||
axiom eval_snd (env : CEnv) (t : CTerm) :
|
||
eval env (.snd t) = vSnd (eval env t)
|
||
|
||
/-- β-rule for `vFst` on a pair. -/
|
||
axiom vFst_vpair (a b : CVal) : vFst (.vpair a b) = a
|
||
|
||
/-- β-rule for `vSnd` on a pair. -/
|
||
axiom vSnd_vpair (a b : CVal) : vSnd (.vpair a b) = b
|
||
|
||
/-- `vFst` on a neutral produces a stuck `nfst` neutral. -/
|
||
axiom vFst_vneu (n : CNeu) : vFst (.vneu n) = .vneu (.nfst n)
|
||
|
||
/-- `vSnd` on a neutral produces a stuck `nsnd` neutral. -/
|
||
axiom vSnd_vneu (n : CNeu) : vSnd (.vneu n) = .vneu (.nsnd n)
|
||
|
||
/-!
|
||
### `eval` on `.code` — universe-code introduction
|
||
|
||
`code A` evaluates to its corresponding value form `.vcode A`,
|
||
preserving the underlying CType. Mirrors `eval_dimExpr` (a similar
|
||
"lift constructor data into a value" rule).
|
||
-/
|
||
|
||
/-- Universe-code introduction at the eval level: encoding evaluates
|
||
to the corresponding `vcode` value form, preserving `A`. -/
|
||
axiom eval_code {ℓ : ULevel} (env : CEnv) (A : CType ℓ) :
|
||
eval env (.code A) = .vcode A
|
||
|
||
/-!
|
||
### `eval` on modal introductions / eliminations
|
||
|
||
For each modality M ∈ {flat, sharp, shape}:
|
||
· `M-Intro a` evaluates to `vM-Intro (eval env a)` (lift through the
|
||
constructor).
|
||
· `M-Elim f m` β-reduces when the scrutinee evaluates to a `vM-Intro`,
|
||
via `vApp` with the eliminator function; on a stuck neutral it
|
||
produces a `nM-Elim` neutral; on any other shape, a marker neutral.
|
||
|
||
The arms below mirror the partial-def cases verbatim. Engine-layer
|
||
axioms; modal-cohesion semantics (Crisp variables, `♭ ⊣ ♯ ⊣ ʃ`
|
||
adjunction laws) are Phase 3 and live in a separate `Modal.lean`.
|
||
-/
|
||
|
||
-- Modal introductions: structural lift to the corresponding value form.
|
||
|
||
axiom eval_flatIntro (env : CEnv) (a : CTerm) :
|
||
eval env (.flatIntro a) = .vFlatIntro (eval env a)
|
||
|
||
axiom eval_sharpIntro (env : CEnv) (a : CTerm) :
|
||
eval env (.sharpIntro a) = .vSharpIntro (eval env a)
|
||
|
||
axiom eval_shapeIntro (env : CEnv) (a : CTerm) :
|
||
eval env (.shapeIntro a) = .vShapeIntro (eval env a)
|
||
|
||
-- Modal eliminations: β on the corresponding intro; stuck on neutrals.
|
||
|
||
/-- β-rule: `flatElim f (flatIntro a)` reduces to `app f a` at the eval
|
||
level. The scrutinee evaluates to `vFlatIntro (eval env a)`; the
|
||
elim arm of `eval` then invokes `vApp` on the eliminator value. -/
|
||
axiom eval_flatElim_beta (env : CEnv) (f a : CTerm) :
|
||
eval env (.flatElim f (.flatIntro a)) = vApp (eval env f) (eval env a)
|
||
|
||
axiom eval_sharpElim_beta (env : CEnv) (f a : CTerm) :
|
||
eval env (.sharpElim f (.sharpIntro a)) = vApp (eval env f) (eval env a)
|
||
|
||
axiom eval_shapeElim_beta (env : CEnv) (f a : CTerm) :
|
||
eval env (.shapeElim f (.shapeIntro a)) = vApp (eval env f) (eval env a)
|
||
|
||
/-- Stuck case: `flatElim` whose scrutinee evaluates to a CNeu produces
|
||
a `nflatElim` neutral preserving the evaluated function and
|
||
scrutinee. The scrutinee must be `.vneu n` after eval; this is
|
||
encoded by the explicit hypothesis `eval env m = .vneu n`. -/
|
||
axiom eval_flatElim_stuck (env : CEnv) (f m : CTerm) (n : CNeu)
|
||
(h : eval env m = .vneu n) :
|
||
eval env (.flatElim f m) = .vneu (.nflatElim (eval env f) n)
|
||
|
||
axiom eval_sharpElim_stuck (env : CEnv) (f m : CTerm) (n : CNeu)
|
||
(h : eval env m = .vneu n) :
|
||
eval env (.sharpElim f m) = .vneu (.nsharpElim (eval env f) n)
|
||
|
||
axiom eval_shapeElim_stuck (env : CEnv) (f m : CTerm) (n : CNeu)
|
||
(h : eval env m = .vneu n) :
|
||
eval env (.shapeElim f m) = .vneu (.nshapeElim (eval env f) n)
|