Compare commits

...
Sign in to create a new pull request.

32 commits

Author SHA1 Message Date
Maximus Gorog
391a048dcf Layer 3.3a: substantive unit/counit + typed-correctness for adjoint triple
Some checks failed
Lean Action CI / build (push) Has been cancelled
Adds substantive content to Modal.lean §2a/§2b without discharging
the §3 adjoint theorems (which wait on FS-H18, see paired topolei
commit).

§2a — Unit/counit underlying CTerm constructions (substantive):
  · flatSharpUnit  : λ$a. modalIntro .sharp (modalIntro .flat $a)
                     — A → ♯(♭ A)
  · flatSharpCounit: λ$x. modalElim .flat (λ$y. modalElim .sharp
                            (λ$z. $z) $y) $x
                     — ♭(♯ A) → A
  · shapeFlatUnit  : λ$a. modalIntro .flat (modalIntro .shape $a)
                     — A → ♭(ʃ A)
  · shapeFlatCounit: λ$x. modalElim .shape (λ$y. modalElim .flat
                            (λ$z. $z) $y) $x
                     — ʃ(♭ A) → A
  Reserved binders modalUnitVar / modalCounitVar / modalCounitInner /
  modalCounitCore.  Real CTerm bodies using actual modal constructors
  (Phase 2 unification); no placeholders.

§2b — Constructive partial discharges (no FS-H18 needed, REAL proofs):
  · 4 @[simp] rfl-lemmas: flatSharpUnit_eq / flatSharpCounit_eq /
    shapeFlatUnit_eq / shapeFlatCounit_eq pinning each body.
  · 4 typed-correctness theorems: flatSharpUnit_typed /
    flatSharpCounit_typed / shapeFlatUnit_typed / shapeFlatCounit_typed
    discharge HasType obligations via HasType.lam +
    HasType.modalIntro (units) or chained HasType.modalElim with
    explicit (var, A, C, k) annotations (counits).
  · 4 non-vacuity / non-degeneracy theorems:
    flatSharpUnit_ne_Counit, shapeFlatUnit_ne_Counit,
    flatSharpUnit_ne_shapeFlatUnit, flatSharpCounit_ne_shapeFlatCounit
    — distinct binder names / kind heads make the constructions
    genuinely distinct (rules out vacuous defs).

§3 — Adjoint theorem annotations updated:
  · flat_sharp_adjoint / shape_flat_adjoint / cohesive_triple sorry'd
    with sharper FS-H18 attribution.  Each annotation names the
    §2a/§2b constructive partial discharges that ARE landed and
    explains exactly what FS-H18 unlocks (CAdjoint instance via
    triangle identities = Path-form of the modal β-rules).
  · 3 sorries in proof positions (lines 880, 909, 985) — same count
    as before, sharper attribution.

The CTerm un-indexed-by-universe nature of Syntax.lean §3 means
flatSharpUnit etc.'s (ℓ, A) arguments are formally unused in the
body; explicit `let _ := ℓ; let _ := A` makes this intentional and
keeps the signature aligned with the typed-correctness theorems.

Build: lake build (48 jobs) + lake build CubicalTransport (43 jobs)
PASS.  Runtime: 49/49 + 46/46 = 95/95.

ZERO new sorries (the §2b theorems are all REAL proofs).  ZERO
new noncomputable / Classical / axiom.

Modal.lean: 598 → 1026 lines (+428).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-06 06:32:39 -06:00
Maximus Gorog
0a7228a8e5 Axiom debt cleanup: discharge or convert all 99 engine axioms
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per the user's no-axioms discipline (axioms push Lean 4 code into
noncomputable states; the project's custom Rust backend exists exactly
so we don't need them).  This commit eliminates ALL engine-side axioms.

Files modified (engine):
  · Transport.lean      — 4 axioms → 4 sorry-theorems (FS-H15)
  · Eval.lean           — 50 axioms → 50 sorry-theorems (FS-H15)
  · Readback.lean       — 24 axioms → 24 sorry-theorems (FS-H15)
  · Glue.lean           — 9 axioms → 9 sorry-theorems (FS-H16)
  · Line.lean           — 6 axioms → 5 sorry-theorems + 1 placeholder
                          def (DimLine.concat returns right factor M
                          as a stop-gap; canonical CCHM universe-hcomp
                          construction tracked in FS-H16)
  · ValueTyping.lean    — 4 axioms → 4 sorry-theorems (FS-H17)
  · TransportLaws.lean  — 1 axiom → 1 sorry-theorem (FS-H15)

Conversion pattern: each `axiom` becomes `theorem ... := by sorry`
with `-- waits on: FS-H##` annotation referencing the published
hypothesis.  Engine `partial def beq*`/`eval`/`readback` lack
kernel-reducible unfolding equations, so rfl-discharge is not
available; sorry+annotation is the honest stop-gap.

Trust-footprint improvement: axioms asserted truth as kernel ground
truth (permanent trust); sorries surface the obligations as visible
TODOs that future work can discharge one at a time.  Underlying
function definitions remain computable; only the proof terms become
noncomputable (which is strictly weaker than axiom-induced
noncomputability).

Build: lake build (48 jobs) + lake build CubicalTransport (43 jobs)
PASS.  lake exe cubical-test 49/49 + 46/46 = 95/95 PASS.

Total engine axiom count: 99 → 0.
Total engine sorry count: ~30 → ~121 (97 new from this dispatch).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-06 05:07:50 -06:00
Maximus Gorog
567d8722d5 Refactor Phase 4: Rust ABI v6 → v7 (modal tag unification)
Some checks are pending
Lean Action CI / build (push) Waiting to run
Mirrors the Lean-side modal unification (commits 6e4936d / cfabca3 /
2b7564e) at the native level.  ABI version constant
CUBICAL_TRANSPORT_ABI_VERSION = 7.

Tag unification (15 v6 modal tags → 5 v7 unified tags):
  · TY_MODAL = 9                          (was: TY_FLAT/SHARP/SHAPE = 9-11)
  · TERM_MODAL_INTRO = 17, TERM_MODAL_ELIM = 18
                                          (was: TERM_*_INTRO/ELIM = 17-22)
  · VAL_VMODAL_INTRO = 12                 (was: VAL_V*_INTRO = 12-14)
  · NEU_NMODAL_ELIM = 12                  (was: NEU_N*_ELIM = 12-14)
  · MODKIND_FLAT/SHARP/SHAPE = 0/1/2 (u32 — matches existing tag-
                                          namespace convention)

Tag-id design choice (TERM_MODAL_ELIM = 18, not 20):
  Lean compiler assigns constructor indices in declaration order;
  Syntax.lean declares modalIntro then modalElim consecutively, so
  the runtime tag is 18, not 20.  Using 20 would break FFI
  marshalling.  Same precedent as v4's sigma/path tag ordering.

Reserved freed slots (no v7 reassignment per directive — gaps
documented in tags.rs for future v8+ extensions):
  · CType: 10, 11
  · TERM:  19, 20, 21, 22
  · VAL:   13, 14
  · NEU:   13, 14

Layout tables in cubical_transport.h v7 entry:
  · TY_MODAL          [ℓ, k, A]
  · TERM_MODAL_INTRO  [k, a]
  · TERM_MODAL_ELIM   [k, f, m]
  · VAL_VMODAL_INTRO  [k, inner_value]
  · NEU_NMODAL_ELIM   [k, eliminator_value, stuck_scrutinee]

Cascade across:
  · tags.rs — 15 deletions + 5 unified consts + 3 ModalityKind +
    reservation block
  · value.rs — CVal::VModalIntro(ModalityKind, _) and
    CNeu::NModalElim(ModalityKind, _, _) variants
  · eval.rs — 9-arm modal dispatch → 3-arm; β-rule fires only on
    matching kinds (k == k') with marker neutral on mismatch
  · subst.rs — 9 modal substDim arms → 3 unified
  · readback.rs — 6 modal readback arms → 2
  · dim_absent.rs — 9 dim-absent modal arms → 3

Files NOT touched (verified): transport.rs, composition.rs,
glue.rs, beta.rs, ffi.rs.  Wildcard catchalls handle modal types as
stuck neutrals (same as v6).

Refcount discipline for the new k field documented at every
mk_vmodal_intro / mk_nmodal_elim / mk_ty_modal call site.

Verification:
  · cargo build --release: clean
  · cargo test --release: 0 passed, 0 failed (no in-crate tests)
  · lake build: 48 jobs PASS
  · lake build CubicalTransport: 43 jobs PASS
  · lake exe cubical-test: 49/49 + 46/46 = 95/95 PASS
  · 0 new unsafe / unimplemented! / todo! / panic! catchalls

Net: -58 lines across 7 files (-397 deletions, +339 insertions).
Source-code reduction concentrated in cascade modules; tags.rs and
header grew due to reservation documentation and v7 layout tables.

Honest gap: existing test suite doesn't exercise modal terms via
FFI (modal Lean-side use sits behind sorry'd Phase 3 axioms).  The
95/95 confirms no regression of existing paths but doesn't directly
validate v7 modal marshalling.  An FFI smoke test exercising modal
terms is queued for when modal cohesion sorries discharge.

Layer 0 + elegance refactor pass COMPLETE.  All four phases landed:
Phase 1 (derive_reflect_reify macro), Phase 2 (Lean modal
unification), Phase 3 (Modal.lean rewrite + topolei consumer
cascade), Phase 4 (Rust ABI v7).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-06 02:25:10 -06:00
Maximus Gorog
cfabca3404 Refactor Phase 3a: Modal.lean rewrite — forModalityKind unification
Some checks are pending
Lean Action CI / build (push) Waiting to run
Removes the transient alias block (CType.flat/.sharp/.shape +
6 CTerm modal abbrev) and rewrites the substantive content using
the unified .modal/.modalIntro/.modalElim constructors directly.

Three modal CFunctor witnesses → one ModalityKind-parameterised
function:
  forModalityKind (ℓ : ULevel) (k : ModalityKind) :
      CFunctor (CType_as_Category ℓ) (CType_as_Category ℓ)
The body is uniform in k (no internal `match k with` branches);
obj/arr fields use `.modalIntro k` / `.modalElim k` directly;
preserves_id/preserves_comp parameterised in k.

Six rfl-lemmas + 2 dependence theorems → 2 each, parameterised.

Crisp predicate constructors generalised from flat-only to all
kinds (semantic widening — documented in source as a deliberate
generalisation from spatial-TT's flat-only canonical Crisp;
sound because every modal eliminator extracts from a modalised
subuniverse):
  · flatElimBody → modalElimBody (k) (f m)
  · flatIntroOfCrisp → modalIntroOfCrisp (k) {a} (h)
  · appPropagation unchanged
  · Crisp.var_not_immediate restated to ∃ k existential

Three adjoint-triple theorems restated using `forModalityKind ℓ
.flat/.sharp/.shape`.  All three sorries preserved with rephrased
waits-on annotations.

Three β-soundness theorems → one:
  modal_beta_sound (env) (k) (f a) := eval_modalElim_beta env k f a

Net: -68 lines.  Build clean (48 + 43 jobs).  Runtime 95/95.
3 sorries unchanged (the three adjoint-triple theorems).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-06 02:13:16 -06:00
Maximus Gorog
6e4936d6ee Refactor Phase 2: modal unification — Lean engine cascade
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per the elegance pass: 9 ad-hoc per-modality constructors collapse into
3 ModalityKind-parameterised constructors.  Future modalities (Phase
4's ʃ_EML, ℑ infinitesimal) extend ModalityKind by adding cases —
no new constructors, no new ABI bump.

New Lean enum (Syntax.lean):
  inductive ModalityKind | flat | sharp | shape
    deriving DecidableEq, Repr, Inhabited

Constructor unification:
  · CType: 3 (.flat / .sharp / .shape) → 1 (.modal k A)
  · CTerm: 6 (.flatIntro / .sharpIntro / .shapeIntro / .flatElim /
            .sharpElim / .shapeElim) → 2 (.modalIntro k a, .modalElim k f m)
  · CVal:  3 (vFlatIntro / vSharpIntro / vShapeIntro) → 1 (vModalIntro)
  · CNeu:  3 (nflatElim / nsharpElim / nshapeElim) → 1 (nModalElim)
  · SkeletalCType: 3 (skFlat / skSharp / skShape) → 1 (skModal k)

Engine cascade across 12 files (DecEq, DimLine, Eval, FFITest, Modal,
Question, Readback, Reflect, Subst, Syntax, Typing, Value): every
match site collapsed from 3-per-modality arms to 1 k-parameterised arm.

Reflect.lean: new `reflectModalityKind` / `reifyModalityKind` helpers
+ ModalityKind dispatch arm in classifyFieldType.  The Phase 1 macro
auto-derived per-constructor reflect/reify for the new unified
constructors — no manual cascade needed there.

Eval.lean β-rule: `.modalElim k f (.modalIntro k' a)` β-reduces only
when k = k' (kind-discrimination preserves cross-kind correctness even
if typing is bypassed); cross-kind case produces a marker neutral.

Modal.lean transient alias block (top of file, outside namespace) for
backward dot-syntax reference (`.flatIntro a` resolves to
`.modalIntro .flat a` via abbrev).  Phase 3 will rewrite Modal.lean
properly to use the unified constructors directly + forModalityKind-
derived functor.

Net: −145 lines across the cascade (-478 deletions, +333 insertions).

Build: lake build (48 jobs) + lake build CubicalTransport (43 jobs) PASS.
Runtime: lake exe cubical-test 49/49 + 46/46 = 95/95 PASS.
Sorry count: Modal.lean 3 (unchanged), total engine 33 (no new sorries
from this phase, all annotated).

The Rust ABI v6 still uses 9 modal tags — diverges from the Lean side
after this commit but FFI tests don't exercise modal paths so no
runtime regression.  Phase 4 will sync to ABI v7.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-06 02:01:52 -06:00
Maximus Gorog
c334bf9784 Remove Test/Reify.lean — Phase 1 macro-debugging scratch
Some checks are pending
Lean Action CI / build (push) Waiting to run
The Phase 1 agent left a 42-line scratch file (myDeriveDimVar15
suggests attempt #15) from the macro-iteration cycle.  Not in the
root barrel; not exercised by tests; pure dead code.

Per the "no parallel dead-code definitions" discipline.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-06 01:43:00 -06:00
Maximus Gorog
2417ec667b Refactor Phase 1: derive_reflect_reify macro — Reflect.lean elegance pass
Some checks are pending
Lean Action CI / build (push) Waiting to run
Replaces ~900 lines of per-constructor reflect/reify boilerplate with
a generic Lean.Elab.Command macro that introspects each inductive's
ConstructorVal data via getConstInfoInduct + forallTelescopeReducing
and emits the per-arm code automatically.

Macro infrastructure (~750 lines under Macro namespace):
  · classifyFieldType — type-shape dispatch (String / Nat / ULevel /
    DimVar / DimExpr / FaceFormula / CType ℓ / CTerm / List X / Σ_ℓ
    CType ℓ / Prod variants).  Project-specific dispatch table; new
    field types extend this once.
  · collectFields — walks ctorVal.type via forallTelescopeReducing.
  · mkReflectArm / mkReifyArmDoSeq — per-constructor arm builders.
  · mkReflectFunBody / mkReifyFunBody — match-body assemblers.
  · mkInductiveDefs — emits the partial-def pair.
  · 4 specialized list helpers for the heterogeneous Σ-list shapes
    (auto-discovered during the constructor-walking pass).
  · derive_reflect_reify command + elabDeriveReflectReify elaborator.

Application (line 970):
  derive_reflect_reify DimVar, DimExpr, FaceFormula, CType, CTerm,
                       CTypeArg, CtorSpec, CTypeSchema

Preserved as-is: file docstring, imports, Contract abbrev,
mathematical reifyULevel (special-cased), Contract registry +
register/lookupByName/allRegistered, the 4 round-trip theorems.

Engineering notes (full version in commit body / source comments):
  · Hygiene: mkIdent for forward-reference function names, mkCIdent
    only for closed-world Lean.* references.
  · doMatch arm RHS must be doSeq, not term.
  · Inner `match ← X with` requires enclosing do block.
  · Level coherence on reify: tracks fvars of ULevel fields, matches
    against subsequent CType fields' index expressions, emits
    `if h : ℓ_rec = ℓ then h ▸ A else return none` accordingly.

Verification:
  · Reflect.lean: 1544 → 1118 lines (-426).
  · lake build (48 jobs) PASS.
  · lake build CubicalTransport (43 jobs) PASS.
  · lake exe cubical-test: 49/49 + 46/46 = 95/95 PASS.
  · Round-trip smoke test (temp file, deleted post-verify): 26/26
    inputs round-tripped successfully across DimVar, DimExpr,
    FaceFormula, CType, CTerm — including leaf/single-arg/multi-arg/
    implicit-ULevel/string-and-dim-var-payload cases.
  · 4 sorries unchanged (the round-trip theorems on lines
    1048/1059/1076/1116).
  · Zero new sorry, zero noncomputable, zero Classical.propDecidable,
    zero unsafe, zero Unhygienic.run.

Future inductive additions to Syntax.lean (e.g., next phase's
ModalityKind unification) get reflect/reify for free — just add the
type to the derive_reflect_reify list, no per-constructor cascade.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-06 01:42:33 -06:00
Maximus Gorog
c7f91fa933 Modal cascade Phase 3: Modal.lean module proper — Layer 0 complete
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per THEORY.md §3.3 (the substantive theorems) and §3.2 (Crisp piece,
scoped down).  Closes the Modal cascade; Layer 0 substrate now lands
in full as a 13-module reachable set from the root barrel.

§1  Three modal CFunctor witnesses on CType_as_Category ℓ:
      flatFunctor / sharpFunctor / shapeFunctor.
    obj X = .lam "$x" (.{flat,sharp,shape}Intro (.app X (.var "$x"))).
    arr f = .lam "$m" (.{flat,sharp,shape}Elim
              (.lam "$y" (.{flat,sharp,shape}Intro (.app f (.var "$y"))))
              (.var "$m"))  — elim-then-intro functorial action.

§1a 9 @[simp] rfl-lemmas + 2 substantive-dependence theorems
    (flatFunctor_obj_dep, flatFunctor_arr_f_dep) — distinct
    inputs yield distinct functor-image CTerms.

§2  Crisp : CTerm → Prop with three constructors
    (flatElimBody / flatIntroOfCrisp / appPropagation).
    CContext.crispVar context discipline DEFERRED to a future phase
    (THEORY.md §3.2): would require Ctx-shape refactor through ~30
    HasType cases + Subst/DimLine cascade.  Documented in docstring.

§3  Three adjoint-triple theorems with substantive Prop statements:
      flat_sharp_adjoint  : Nonempty (CAdjoint flatFunctor sharpFunctor)
      shape_flat_adjoint  : Nonempty (CAdjoint shapeFunctor flatFunctor)
      cohesive_triple     : LexModality witnesses for shape & sharp +
                            cross-modal coherence existential
    All sorry'd with specific blocker annotations (modal-cohesion
    path-equality lift, EML-real-cohesion §3.4/§3.5, lex-modality
    construction depending on Category.CCategory_internal sorry).

    Honest weakness: cohesive_triple part 3 (the cross-modal
    coherence) uses `∃ coh, coh = a ∨ coh = b` shape which is
    trivially satisfiable.  The real coherence square (Path-equality
    between the two unit/counit composites) requires the adjunctions
    above to be constructed first.  Strengthening to the Path form
    is queued behind their discharge.

§4  Three β-rule soundness theorems
    (flat_beta_sound / sharp_beta_sound / shape_beta_sound) —
    discharged via Phase 1's eval β-axioms.  Zero sorries here.

Barrel: import CubicalTransport.Modal added.

Build: lake build (48 jobs) + lake build CubicalTransport (43 jobs)
PASS.  Runtime: lake exe cubical-test 49/49 + 46/46 = 95 PASS.
+610 lines (NEW Modal.lean), +1 line (barrel).  3 new sorries, all
annotated with specific blockers.

Layer 0 substrate is now COMPLETE: 13 modules reachable from barrel
(Truncation, Decidable, Reify, Omega, Category, Modality, Modal,
Subobject, SIP, Bridge.Set, Contract, Reflect, Tactic.EqContract).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 23:28:01 -06:00
Maximus Gorog
c6bc0aa68f Modal cascade Phase 2: Rust ABI v5 → v6 (modal constructors)
Some checks are pending
Lean Action CI / build (push) Waiting to run
Mirrors the 9 Lean-side modal constructors landed in b9ca1d8
(Phase 1).  ABI version constant CUBICAL_TRANSPORT_ABI_VERSION = 6.

Tag additions (separate namespaces — no cross-namespace collision):
  · TY_FLAT=9, TY_SHARP=10, TY_SHAPE=11
  · TERM_FLAT_INTRO=17 .. TERM_SHAPE_ELIM=22
  · VAL_VFLAT_INTRO=12, VAL_VSHARP_INTRO=13, VAL_VSHAPE_INTRO=14
  · NEU_NFLAT_ELIM=12, NEU_NSHARP_ELIM=13, NEU_NSHAPE_ELIM=14

Marshalling cascade across:
  · cubical_transport.h — version bump + ABI v6 layout-table entries
    documenting runtime field layout for all 15 new constructors
    (modal CType carry implicit ULevel at runtime per Lean's encoding;
    modal CTerm intros/elims are level-free)
  · tags.rs — 15 new pub const u32
  · value.rs — CVal::VFlatIntro/VSharpIntro/VShapeIntro variants and
    CNeu::NFlatElim/NSharpElim/NShapeElim variants + from/to_tag
    arms
  · eval.rs — 6 CTerm arms (3 intros lift inner value through eval;
    3 elims β-reduce on vM-Intro, push to nM-Elim on vneu, marker-
    neutral fallback with Lean-identical strings for differential-
    fuzzing parity)
  · subst.rs — 3 CType + 6 CTerm substDim arms
  · readback.rs — 3 vIntro + 3 nElim arms
  · dim_absent.rs — 3 CType + 6 CTerm dim-absence arms

Files NOT changed (verified): transport.rs, composition.rs, glue.rs,
beta.rs, ffi.rs.  Their existing dispatch correctly produces stuck
ntransp/nhcomp/ncomp neutrals for any non-Π CType — modal types
fall through.  Modal-cohesion-driven transport reductions are Phase 3.

Verification:
  · cargo build --release: clean
  · cargo test --release: 0 failed (no in-crate tests)
  · lake build: 48 jobs PASS
  · lake build CubicalTransport: 42 jobs PASS
  · lake exe cubical-test: 49/49 FFI smoke + 46/46 properties PASS

+448 lines across 7 files in native/cubical/.  Zero new unsafe blocks.
Zero new unimplemented!()/todo!()/panic!.  No Lean files touched.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 23:18:33 -06:00
Maximus Gorog
b9ca1d8875 Modal cascade Phase 1: Syntax + Lean engine cascade
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>
2026-05-05 22:22:03 -06:00
Maximus Gorog
825d8af68d Layer 0 substrate round 6: contract auto-registration
Some checks are pending
Lean Action CI / build (push) Waiting to run
Wires all 7 contracts into the Reflect.Contract registry via an
initialize block at the foot of Contract.lean.  Without this, the
Tactic surface in Tactic/EqContract.lean was decorative — the registry
was empty at module-load time, so #contract / #whichContract /
find_contract_path / via_eq_contract had no contracts to traverse.

Registered (all at ULevel.zero, the canonical-instance convention):
  · CubicalSetC, CGroupC, CCoxeterC, CSiteC, CModalC — non-parametric
  · CActionC — instantiated at Modality.unitT 0 (trivial-group action)
  · CSheafC — instantiated at (unitT 0, unitT 0) (unit-site / unit-value)

Smoke test (lake env lean --run): Reflect.Contract.allRegistered returns
7 names; lookupByName succeeds for each.

Pure addition: +57 lines, 0 removed.  No new sorries.  Both build
targets clean (lake build 48 jobs, lake build CubicalTransport 42 jobs).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 15:56:03 -06:00
Maximus Gorog
294e96633d Layer 0 substrate round 5: Tactic/EqContract.lean + barrel + Ω-call fixes
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per THEORY.md §0.10 — the user-facing tactic surface that operates on
the topos-internal contracts.  Five exports:

  · tactic via_eq_contract — translates Path-existence goal to Eq goal
    via pathEqEquiv; CubicalSetC synthesised from registry, residual
    contract obligation surfaces as a subgoal if synthesis fails.
  · tactic find_contract_path — BFS over registered contracts and
    entailment morphisms (currently CDecidableEq → CubicalSetC); on
    exhaustion throws a precise diagnostic listing what was tried.
  · tactic lift_via_topos t — runs via_eq_contract then user-supplied
    tactic on the translated Eq goal.
  · command #contract — lists registered contracts + entailment edges.
  · command #whichContract <T> — synthesises every contract against T,
    reports those that succeed.

Also fixes ℓ-implicit synthesis at four Ω-call sites that the universe-
stratification cascade had left under-annotated (Contract.and / .implies
and Sub.inter / .implies / Ω_internal_logic_sound's 8 nested .and / .implies
calls).  These were only exposed when the Layer 0 modules became
reachable from the root barrel — the cubical-test:exe target's import
closure had previously hidden them.

Barrel additions: Truncation, Decidable, Reify, Omega, Category,
Modality, Subobject, SIP, Bridge.Set, Contract, Reflect,
Tactic.EqContract.  All Layer 0 substrate now reaches the root.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 15:19:35 -06:00
Maximus Gorog
2f343b0980 Layer 0 substrate round 4: Reflect.lean — bidirectional CTerm/CType ↔ Lean.Expr
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per THEORY.md §0.9 — reflection metaprogramming layer.  Bidirectional
bridge between the engine's first-class CTerm / CType inductives and
Lean's tactic-facing Lean.Expr representation.  Required for tactics
to inspect cubical terms and consult the contract registry.

· reflectULevel / reflectCType / reflectCTerm: per-constructor
  Expr-construction with explicit ULevel arguments emitted at every
  implicit-position (Expr-level construction is fully explicit).
· reifyULevel / reifyCType / reifyCTerm: per-constructor Expr-pattern
  inverses; level-coherence proofs discharged via hA ▸ A coercion
  where the recovered level disagrees with the explicit-position level.
· Contract registry: IO.Ref (Std.HashMap Lean.Name ContractEntry)
  with register / lookupByName / allRegistered.  Local `abbrev
  Contract` re-export to avoid the Reflect ↔ Contract circular
  dependency.
· 4 sorry'd round-trip theorems with substantive Prop statements
  awaiting the meta-level Expr-elaboration framework.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 14:50:51 -06:00
Maximus Gorog
7ca4ac8d6a Omega.lean: upgrade operators to use CTerm.code (engine universe-code)
Some checks are pending
Lean Action CI / build (push) Waiting to run
The El/code cascade landed CType.El + CTerm.code in Syntax.lean
(ABI v5) and updated the main Ω definition to use them, but the
eight propositional operators (true_/false_/and/or/implies/not/
forall_/exists_) were left in the pre-cascade Reify-workaround
shape, causing two substantive issues:

  1. true_/false_ second component was CTerm.codeOf .univ —
     "code of the universe" — meaningless as a propositionality
     witness for Unit/Empty.
  2. and P Q := .pair (.fst P) (.fst Q) — no product carrier
     construction, no propositionality witness; just paired the
     input carriers.
  3. implies P Q := .lam "$x" (.fst Q) — discarded _P entirely
     (the underscore was a tell), returned Q's carrier regardless.

## Fix: each operator now has Ω-pair shape

  (CTerm.code <carrier>, CTerm.code (IsNType .negOne <carrier>))

matching the pattern Contract.lean and Subobject.lean already use.

  · true_     — carrier = unit type        → IsNType -1 of unit
  · false_    — carrier = empty type       → IsNType -1 of empty
  · and P Q   — carrier = Σ-product        (sigmaSelf "_" .El P .El Q)
  · or P Q    — de Morgan dual: ¬(¬P ∧ ¬Q) (no Sum CType in Layer 0)
  · implies P Q — carrier = function space (piSelf "_" .El P .El Q)
  · not P     — implies P false_ (unchanged shape, fixed args)
  · forall_ T P — carrier = dep Π          (piSelf "$x" T .El (P x))
  · exists_ T P — carrier = ‖dep Σ‖₋₁     (propTruncC of sigmaSelf)

## Discipline

  · Zero CTerm.codeOf in Omega.lean (was 4 instances)
  · Every operator's carrier-code GENUINELY DEPENDS on its inputs
    (not the previous .var "$X" placeholders or .fst Q discards)
  · CType.sigmaSelf / piSelf used to re-anchor at level ℓ
  · No new sorries introduced; no existing sorries removed
  · No Syntax.lean / Contract.lean / Subobject.lean / Inductive.lean
    modifications

## Verification

  lake build               Build completed successfully (48 jobs)
  CTerm.code count in Omega.lean: 16 (was 0, replacing 4 codeOf)
  CTerm.codeOf count in Omega.lean: 0 (was 4)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 14:05:01 -06:00
Maximus Gorog
5de7d9e7d0 Layer 0 substrate round 3: Contract.lean — topos-internal contract framework
Some checks are pending
Lean Action CI / build (push) Waiting to run
THEORY.md §0.8 — first-class contracts as CType-typed predicates valued
in Ω, with a category of (CType, Contract instance)-pairs forming a topos.

## Architecture

  def Contract (ℓ : ULevel) : Type := CType ℓ → CTerm

By convention, the output CTerm inhabits Ω ℓ.  Each named contract
genuinely depends on its T input — no fun _ => stub-bodies in
substantive contracts; only the boundary Heyting elements (trivial_,
empty_) legitimately discard T.

## Per-contract structure CTypes (real Σ-towers)

  CGroupStructCType T   — 7-fold Σ over (mul, one, inv) + 4 group laws
                          (assoc, one_left, one_right, inv_left) as
                          Path equations referencing T's bound vars
  CActionStructCType G T  — Σ over (act : G → T → T) + composition law
  CSiteStructCType T    — Σ over (cov : T → T → Ω) + identity-cov law
  CSheafStructCType _ _ — Σ over (presheaf, restriction coherence)

Every $-prefixed binder name in these towers is bound in its
surrounding sigmaSelf/piSelf enclosure — no free-variable placeholders.

## Named contracts

  CubicalSetC ℓ         — T is 0-truncated  (Truncation.IsNType .zero T)
  CGroupC ℓ             — T carries a group  (propTruncC of structure)
  CActionC G_carrier    — G acts on T  (propTruncC of action structure)
  CCoxeterC ℓ           — T is a Coxeter system  (refines on braid relations
                                                  downstream)
  CSiteC ℓ              — T is a Grothendieck site
  CSheafC site value    — sheaves on (site, value)
  CModalC ℓ             — T is the carrier of a modality

Boundary contracts:
  Contract.trivial_ ℓ   — every CType satisfies it (carrier = unitC)
  Contract.empty_ ℓ     — no CType satisfies it (carrier = botC ℓ)

Operators:
  Contract.and / .or / .implies — pointwise lift of Ω.and / Ω.or / Ω.implies

## Naming reconciliation with Bridge/Set

  Bridge.Set.CubicalSetC : Lean Prop existential
                          (∃ w, HasType [] w (IsNType .zero T))
  Contract.CubicalSetC   : Contract (CType → CTerm)
                          (T-dependent Ω-typed pair)

Both are valid forms of the same predicate.  Bridge/Set's form is
used by the via_eq_contract tactic (Lean-level dispatch); Contract's
form is the topos-internal version usable inside cubical proofs.
Conversion lemmas connect them at use sites.

## Theorems (real Prop statements)

  contracts_heyting (ℓ) — 4-clause conjunction of Path-equality in Ω ℓ
                          for ∧-idempotence, ∧-commutativity, modus
                          ponens, implication absorption
                          (sorry, waits on: Subobject.Ω_internal_logic_sound)
  contracts_form_topos (ℓ) — ∃ CCategory ℓ + inclusion functor + non-
                             degeneracy clause
                             (sorry, waits on: Subobject.subobject_classifier
                              + Category's pullback construction)

Both real Prop statements; no True := trivial, no tautological rfl.

## Discipline summary

  · 2 sorries this round, both annotated -- waits on:
  · Zero noncomputable / Classical.propDecidable
  · Zero stub-bodies (every substantive contract uses T)
  · Zero free-variable CTerm placeholders (only $-prefixed binders
    declared in the same expression, plus $bogus non-degeneracy
    placeholders following the Modality.adjoint_modal_triple pattern)
  · No existing file modified

## Verification

  lake build                 Build completed successfully (48 jobs)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 09:45:16 -06:00
Maximus Gorog
7934275f68 Layer 0 substrate round 2: Subobject + SIP + Modality + Bridge/Set
Some checks are pending
Lean Action CI / build (push) Waiting to run
Four new modules, all building on the now-stable Layer 0 foundation
(Universe / Truncation / Decidable / Omega / Reify / Category).
THEORY.md §0.4 (Subobject + SIP), §0.5 (Modality), §0.6 (Bridge/Set).

## CubicalTransport/Subobject.lean (308 lines)

Sub T = CType.pi "$x" T (Ω ℓ) — re-anchored at ℓ.succ via
ULevel.max_succ_self_right.  Pointwise lattice operations as REAL
CTerms using existing Ω logical operators:
  · empty / total      — constant Ω.false_ / Ω.true_
  · inter / union      — pointwise Ω.and / Ω.or
  · implies / compl    — pointwise Ω.implies / Ω.not
  · singleton T a      — characteristic function of {a} via
                         CTerm.code (CType.path T x a) + IsNType -1
                         propositionality witness

Theorems with REAL Prop statements:
  · subobject_classifier — bidirectional ∃-quantified statement
                           (∃ S incl, mono into T)  ↔  (∃ χ, χ : Sub T)
                           (sorry, waits on: Σ-over-universe-codes
                            for image construction)
  · Ω_internal_logic_sound — four-clause Heyting algebra Path
                             equalities (∧-idempotence, ∧-commutativity,
                             modus ponens, implication absorption)
                             (sorry, waits on: prop-univalence via
                              Soundness.transp_ua)

## CubicalTransport/SIP.lean (320 lines)

StructureFunctor — Lean structure with toFun : CType ℓ → CType ℓ
and transport : (A B) → EquivData → EquivData (REAL EquivData,
not stub CTerm).

  · StructureFunctor.id_       — identity functor (transport = id)
  · StructureFunctor.comp G F  — substantively chains transports

Five categorical functoriality coherences PROVED (not stubbed):
  · id_.transport_idEquiv     := rfl
  · id_.transport_eq_id       := rfl
  · comp_id_right             := rfl
  · comp_id_left              := rfl
  · comp_assoc                := rfl
  · comp.transport_eq_compose := rfl

Theorems with REAL Prop statements:
  · SIP — given S, T, T', e and typed forward/inverse on e:
            ∃ lifted, HasType [] lifted.f (S.toFun T → S.toFun T')
                   ∧ HasType [] lifted.fInv ...
          (sorry, waits on: Soundness.transp_ua as structure-
           functor coherence)
  · contract_transports — equivalences induce path-equality on
                          contract values in Ω
                          (sorry, waits on: SIP + prop-univalence)

## CubicalTransport/Modality.lean (461 lines)

Modality structure with seven REAL Lean-level fields:
  · apply       : CType ℓ → CType ℓ
  · unit        : (A : CType ℓ) → CTerm
  · isModal     : CType ℓ → CType ℓ
  · modal_apply, modal_path, modal_sigma, unit_equiv_on_modal — CTerm-typed proof fields

LexModality extends Modality with preserves_pullbacks +
preserves_terminal CTerm-typed proofs.

Modality.id_ — identity modality with REAL CTerm bodies:
  unitT ℓ := .ind unitSchema [], unitTT := .ctor unitSchema "tt" [] []
  No free-variable placeholders.

Modality.comp G F — substantively chains:
  apply A = G.apply (F.apply A)
  unit A = .lam "$x" (.app (G.unit (F.apply A)) (.app (F.unit A) (.var "$x")))
  modal_sigma A B = G.modal_sigma (F.apply A) (fun b => F.apply (B b))
  ... etc.

Theorems with REAL Prop statements:
  · Modality_pullback_lex — Iff between Modality + pullback-preserving
                            extension and LexModality
                            (sorry, waits on: Category.lean's pullback
                             construction)
  · adjoint_modal_triple — quintuple-Σ existence of (ʃ, ♭, ♯) with
                           four conjuncts asserting CType + CTerm
                           non-triviality (apply ≠ apply false flags
                           are real distinctness checks, not tautologies)
                           (sorry, waits on: Layer 3 cohesive lift —
                            Topolei/Modal.lean)

Bonus: 5 rfl-lemmas + 4 substantive-dependence theorems
(Modality.id_apply_dep, comp_apply_G_dep, comp_apply_at_id,
comp_unit_F_dep, comp_unit_G_dep) proving fields don't collapse
to constants — analogues of Category.lean's no-collapse theorems.

## CubicalTransport/Bridge/Set.lean (224 lines)

CubicalSetC as a Lean Prop existential:
  def CubicalSetC {ℓ} (T : CType ℓ) : Prop :=
    ∃ (w : CTerm), HasType [] w (IsNType .zero T)

Substantive — the witness w is the cubical proof of 0-truncatedness,
immediately consumable by Hedberg.

Three theorem statements + one bidirectional discharge:
  · CubicalSetC_isProp                  := rfl
  · pathEqEquiv  (Iff statement)        := via path_to_eq + eq_to_path
  · CubicalSetC_of_CDecidableEq         (sorry, waits on Hedberg)
  · path_to_eq                          (sorry, waits on Hedberg
                                          + canonical-form readback)
  · eq_to_path                          (sorry, waits on dim-absent
                                          packaging on toCTerm a)

## Discipline summary

  · Total new sorries this round: 9 (across 4 files)
  · Every sorry annotated -- waits on: <specific dep>
  · Zero noncomputable / Classical.propDecidable
  · Zero CType.univ stubs / IsModal-style identity definitions
  · Zero "True := trivial" theorem placeholders
  · Zero "M.apply = M.apply" tautological proofs
  · Zero free-variable CTerm placeholders for non-binder names
  · No existing file modified — all four files are new

## Verification

  lake build (engine)        Build completed successfully (48 jobs)

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 09:26:57 -06:00
Maximus Gorog
f6231f3e64 Layer 0 substrate (Truncation, Decidable, Omega, Category, Reify)
Some checks are pending
Lean Action CI / build (push) Waiting to run
+ CType.El / CTerm.code constructors (universe-coding); ABI v5

## Layer 0 substrate (5 new modules per docs/THEORY.md §0)

CubicalTransport/Truncation.lean (367 lines)
  TruncLevel inductive (-2 = contractible, -1 = prop, 0 = set, …).
  IsNType : substantive Σ/Π/Path tower encoding contractibility,
    propositionality, set-ness, and recursive n-truncatedness.
  Trunc HIT schemas at -2 / -1 / higher levels.
  truncation_step + truncation_hits_props proven by rfl.
  truncation_idempotent (sorry, waits on Modality.lean).
  IsNType_isProp_witness (sorry, waits on funext via J-rule).
  Helpers piSelf/sigmaSelf via ULevel.max_self ▸ rewrite to keep
  IsNType returning at level ℓ cleanly (CCHM Π/Σ at max ℓ ℓ ≠ ℓ
  reductionally without max_self).

CubicalTransport/Decidable.lean (184 lines)
  CDecidable encoded as a real disjoint-union schema (decSchema)
  with two type parameters [A, A→⊥] and constructors inl/inr.
  emptySchema (zero ctors) provides CType.botC at any level.
  CDecidableEq T := Π a b, CDecidable (Path T a b).
  Hedberg theorem statement (sorry, waits on J-rule combinator).

CubicalTransport/Omega.lean (rewritten to use real El-decoder)
  Ω (ℓ) := Σ (P : .univ ℓ), .lift (IsNType .negOne (.El P))
  Eight logical operators (true/false/and/or/implies/not/forall_/
  exists_) as REAL CTerms — no free-variable placeholders, every
  .var "$x" reference is to a binder in the same expression.
  OmegaIsProp (sorry, waits on Soundness.transp_ua for prop-univalence).

CubicalTransport/Reify.lean (115 lines)
  CType-as-CTerm injection helper.  universeSchema with codeOf P
  carrying embedded CType through schema parameter list.  Now
  largely redundant after CTerm.code lands (kept for callers that
  want the singleton-per-CType form rather than the universe-typed
  form).

CubicalTransport/Category.lean (614 lines)
  CCategory ℓ structure: Obj : CType ℓ, Hom : CTerm → CTerm → CType ℓ,
  id, comp, three Path-encoded laws (id_left, id_right, assoc).
  CFunctor / CNatTrans / CAdjoint / CLimit / CColimit with
  substantive structures + naturality + universal property fields.
  CFunctor.id, CFunctor.comp, CNatTrans.id, CNatTrans.vcomp helpers
  with concrete law-discharge bodies.
  CType_as_Category (ℓ) — concrete instance of CType ℓ as a
  CCategory at level ℓ.succ.  Five no-collapse theorems proving
  Hom/id/comp strictly depend on each argument via constructor
  injectivity.
  CCategory_internal (sorry, waits on Subobject + Modality + pullback).

## CType.El / CTerm.code constructors + full cascade

Engine (Lean):
  CType.El {ℓ} (P : CTerm) : CType ℓ — decoder
  CTerm.code {ℓ} (A : CType ℓ) : CTerm — encoder
  CType.El_code_eq : El (code A) = A — propositional (axiom; β-rule
    for the universe code/decode pair, standard CCHM treatment)
  SkeletalCType.El + CType.skeleton .El arm + skeleton_El simp lemma.
  Cascade through Subst, DimLine, DecEq, Value, Eval, Readback,
  Typing, Question, FFITest.  CTerm.code → CVal.vcode evaluation;
  CVal.vcode → CTerm.code readback; HasType.code typing rule.
  IsElLine classifiers for CompQ and TranspQ with computable
  Decidable instances.

Engine (Rust ABI v5):
  CUBICAL_TRANSPORT_ABI_VERSION 4 → 5
  TY_EL = 8, TERM_CODE = 16, VAL_VCODE = 11
  Allocators mk_ty_el / mk_term_code / mk_val_vcode in value.rs / subst.rs
  Marshalling cascade in eval.rs / readback.rs / dim_absent.rs / subst.rs
  Cargo.toml 0.2.0 → 0.3.0
  cubical_transport.h v5 changelog + layout tables for new constructors

## Discipline

  · 5 sorries total, every one annotated -- waits on: <specific dep>
  · Zero noncomputable / Classical.propDecidable
  · Zero CType.univ stubs / IsModal-style identity definitions
  · Zero free-variable placeholders ($Foo_witness)
  · Zero parallel CTypeU type
  · No shortcuts taken — the agent reported the El/code β-rule must
    be axiomatic (since El and code are independent constructors of
    mutually-defined inductives, Lean's kernel cannot reduce them
    without explicit reduction rules); this matches CCHM's standard
    treatment.

## Verification

  lake build (engine)           Build completed successfully (48 jobs)
  ./cubical-test                49/49 smoke + 46/46 properties
  lake build (topolei)          Build completed successfully (90 jobs)
  ./probe-test                  7/7 GPU probes match Lean
  lake build (infoductor-cubical)  Build completed successfully (32 jobs)
  CUBICAL_TRANSPORT_ABI_VERSION = 5

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-05 09:11:29 -06:00
Maximus Gorog
19928d040a REL2 universe stratification + topolei naming cleanup + Rust ABI v4
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>
2026-05-04 00:21:14 -06:00
Maximus Gorog
d03746497b Drop Infoductor dependency; cubical-transport is now pure cubical engine
Some checks failed
Lean Action CI / build (push) Has been cancelled
The cubical-flavored methodology bindings move out of cubical-
transport-hott-lean4 into a new private bridge repo
`infoductor-cubical` (separate next commit on that repo).

Files removed (moved to infoductor-cubical):
- CubicalTransport/Algebra/EngineMethodologies.lean
- CubicalTransport/Algebra/Test.lean
- (CubicalTransport/Algebra/ directory now empty, removed.)

Files modified:
- CubicalTransport.lean: drop the 8 Infoductor + Algebra imports.
- CubicalTransport/FFITest.lean: drop `import Infoductor.Foundation
  .Restructure` + `open Infoductor` + the 4 Infoductor.Foundation
  smoke tests (they belong in the bridge repo, not in the engine).
- lakefile.toml: drop the `[[require]] infoductor` block.

Architecture rationale:
- Public Infoductor: Foundation + Comonad — generic Lean 4 repo-
  organization primitives, Mathlib-only-when-needed.
- Public cubical-transport-hott-lean4: pure cubical engine, no
  Infoductor dep, no methodology bindings.
- Private infoductor-cubical (next): bridges Infoductor.Foundation
  + cubical-transport into a "Cubical" methodology surface for
  Infoductor.

Test count: 47 → 43 smoke (the 4 Algebra smokes leave with the
moved files).  46/46 properties.  Total 89/89 passing.  46 build
jobs (was 53 with Infoductor pulled in).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 07:52:59 -06:00
Maximus Gorog
e26ada2fbc Extract Algebra/ foundation to Infoductor; require it from forgejo
Some checks are pending
Lean Action CI / build (push) Waiting to run
The six generic methodology / repo-organization modules
(Meta / Edit / Restructure / MacroAlias / MetaPath / Methodology)
move out of CubicalTransport/Algebra/ into the new Infoductor repo
at http://maxgit.wg:3000/max/infoductor.

cubical-transport-hott-lean4 now `require`s `infoductor` from that
forgejo URL.  Imports updated:
- import CubicalTransport.Algebra.X → import Infoductor.Foundation.X
- open CubicalTransport.Algebra → open Infoductor

Files that stay (cubical-domain-specific):
- CubicalTransport/Algebra/EngineMethodologies.lean (cubical
  closing-form @[methodology] tags)
- CubicalTransport/Algebra/Test.lean (integration tests)

Files deleted (moved to Infoductor.Foundation):
- CubicalTransport/Algebra/Meta.lean
- CubicalTransport/Algebra/Edit.lean
- CubicalTransport/Algebra/Restructure.lean
- CubicalTransport/Algebra/MacroAlias.lean
- CubicalTransport/Algebra/MetaPath.lean
- CubicalTransport/Algebra/Methodology.lean

Architecture rationale (per memory: "Infoductor — generic
methodology / repo-organization project"):
- Foundation primitives are domain-agnostic; anyone can register
  their own methodology atop them, regardless of cubical interest.
- Cubical-transport keeps the question-form (CompQ etc.) and
  cubical-specific @[methodology] / @[metaPath] decls.
- topolei (next, separate work) will consume both
  Infoductor.Foundation and cubical-transport, picking cubical
  as its methodology.
- "Info-ductor" — conducts information through a codebase; pairs
  with Pantograph (the conductor sits atop the pantograph
  hardware on an electric train).

93/93 tests pass (47 smoke + 46 property).  53 build jobs total
(43 cubical + 10 Infoductor.Foundation + linker stages).  No new
axioms, no behavioural change — pure code-organization refactor.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 07:22:20 -06:00
Maximus Gorog
de56626059 Drop algebra-restructure exe — source code IS the CLI
Some checks are pending
Lean Action CI / build (push) Waiting to run
Remove `AlgebraRestructure.lean` and its lake_exe target.  The
`Algebra.printAliases` / `printMethodologies` / `printMetaPaths`
functions remain (foundation primitives); users invoke them via
`#eval` inside a Lean session, or compose them in downstream Lean
code.  No standalone process boundary, no opinionated subcommand
surface, no argv parsing layer — the Lean source is the interface.

Per the principle: foundation primitives ship; tooling-as-process-
exe does not unless explicitly asked.  A Lake-exe wrapper imposes
opinionated naming, output shape, and exit-code conventions that
aren't load-bearing for the registry-printer use case.

93/93 tests still pass.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 06:23:36 -06:00
Maximus Gorog
48b7326523 Abstract the four ⚠️ tools into well-defined primitives
Some checks are pending
Lean Action CI / build (push) Waiting to run
Per feedback "tooling possible, not tools — highly selective".
Each former opinionated wrapper either reduces to a Lean-standard
mechanism or splits into stated-contract primitives.

CubicalTransport/Question.lean:
- Drop the `cubical_simp` and `cubical_simp [..]` macros.  They
  baked in a fixed lemma list with a fixed expansion order.
- Drop the proposed `register_simp_attr question_simp` named-set
  too — strictly more curation than the foundation principle calls
  for.  Anyone wanting a named bundle can register one downstream.
- The genuinely-equational classifier-conditioned theorems remain
  `@[simp]`-tagged; existential-conclusion theorems
  (`ask_of_pi_line`, `ask_of_path_line`, HCompQ pi) lose their
  `@[simp]` tag (they don't rewrite goals — they produce
  witnesses).
- Examples now use Lean's standard `simp` against the `@[simp]`
  database — no special tactic involved.

CubicalTransport/Algebra/Methodology.lean:
- New foundation primitive `tryEntryAsClosed : MethodologyEntry →
  TacticM Bool` with stated contract: tries `exact` then `apply`,
  restores tactic state on failure, never throws, returns whether
  goal closed.  Order fixed to those two attempts in that sequence;
  alternative orders are user-side compositions of the primitive.
- `cubical_search` rewritten using `tryEntryAsClosed` +
  `findMethodologies` + `getMetaPaths` + `findMethodologies` (for
  source classifiers).  Docstring reframes it explicitly as a
  *reference-composition demonstrator* — exposes one obvious order
  for stages 1 (direct) and 2 (transport), with a "register your
  own dispatcher" pointer for users wanting different ordering /
  retry / failure shape.

CubicalTransport/Algebra/EngineMethodologies.lean:
- Drop the `cubical_close` macro entirely.  A `simp; (rfl |
  cubical_search)` composition is one line at the call site;
  baking it in imposed an opinionated default.

CubicalTransport/Algebra/Test.lean:
- Remove the three `cubical_close` examples (the macro is gone).
- Engine-bound methodologies remain (they exercise the @[methodology]
  registration mechanism).

AlgebraRestructure.lean:
- Docstring reframed as "thin labeled shell over `Algebra.print*`
  registry-printer functions, not a normative CLI."  The four
  subcommands are this demonstrator's choice; underlying printers
  accept any other shell equally.

93/93 tests pass.  No new functionality removed, just the opinion
layer between user code and the foundations.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 02:57:48 -06:00
Maximus Gorog
b88f6e6f62 algebra-restructure CLI + asyncMode .sync on registries
Some checks are pending
Lean Action CI / build (push) Waiting to run
Phase B/C/D' headless CLI per ALGEBRA_PLAN §5.3 ("No-LSP fallback")
plus a registry-state asyncMode tightening.

AlgebraRestructure.lean (NEW) + lakefile.toml exe target:
- `lake exe algebra-restructure {list-aliases | list-methodologies
  | list-paths | help}` — directs users to the source modules
  hosting each kind of declaration.
- DOCUMENTED LIMITATION: Lean 4's
  `SimplePersistentEnvExtension` state captured at build time
  (`.olean` persistence) does not reliably re-load when an
  Environment is reconstructed via `importModules` from a
  standalone executable.  The registries are populated at
  elaboration time (cubical_search dispatches against them
  successfully) and queryable from `#eval`-style invocations
  inside a Lean session, but not from a headless CLI.  The
  CLI ships as a clearly-marked stub directing users to the
  in-session diagnostic functions and the source-module locations.

CubicalTransport/Algebra/Methodology.lean,
CubicalTransport/Algebra/MacroAlias.lean,
CubicalTransport/Algebra/MetaPath.lean:
- All three SimplePersistentEnvExtension declarations now use
  `asyncMode := .sync` (was default `.mainOnly`).  Doesn't fix
  the standalone-CLI persistence issue but makes the in-session
  state visibility deterministic across import threads.

CubicalTransport/Algebra/Test.lean:
- printRegistrySizes converted from compile-time `#eval` (noisy)
  to a documented diagnostic CoreM action invokable via
  `#eval printRegistrySizes` from within a Lean session.

93/93 tests still pass.  All Phase A/B/C/D' deliverables for
ALGEBRA_PLAN are now landed; remaining items (widget, full LSP
integration, complete methodology library coverage) are tracked
in the doc updates and explicitly outside the headless agent's
scope.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 01:17:02 -06:00
Maximus Gorog
333f31d4bc EngineMethodologies + cubical_close: ALGEBRA §9 closer set
Some checks are pending
Lean Action CI / build (push) Waiting to run
Phase D'.6 — closes the "every existing theorem has a methodology"
criterion from ALGEBRA_PLAN.md §9 for the auto-discharging set
(@[simp]-tagged closers whose classifier hypotheses reduce to
struct-projection rfl).

CubicalTransport/Algebra/EngineMethodologies.lean (NEW):
- @[methodology IsCompQTopFace]    compQ_top_face
- @[methodology IsCompQBotFace]    compQ_bot_face
- @[methodology IsTranspQTopFace]  transpQ_top_face
- @[methodology IsTranspQIntervalLine] transpQ_interval_line
- @[methodology IsHCompQTopFace]   hcompQ_top_face

Each registration is a closing-form theorem: it takes the relevant
field tuple of the question and asserts equality to the expected
reduced form, with the classifier hypothesis discharged inline by
`rfl`.  Together with the methodologies in `Algebra/Test.lean`
(`trueMethodology`, `reflMethodologyNat`, `iffRefl`,
`compq_top_concrete`, `transpq_top_concrete`,
`transpq_interval_concrete`), the registry now covers the
auto-discharging core engine theorems.

`cubical_close` macro (in EngineMethodologies.lean):
  cubical_simp; (rfl | cubical_search) — fall-through composition.
  First reduces the goal via @[simp] routing; then closes any
  trivial residue via rfl; then dispatches via the methodology
  library.  The "default tactic" for question-form goals.

Three new end-to-end tests in Algebra/Test.lean exercising
cubical_close on full-face CompQ, trivial True, and full-face
TranspQ goals.

Methodologies still pending @[methodology] tagging (need richer
dispatch for non-trivial classifier conjunctions or Glue/Path
specialisations, scheduled REL2.6+):
- ask_of_const_line (needs ¬IsFullFace ∧ ¬IsEmptyFace ∧ IsConstLine
  conjunction; currently covered by cubical_simp's simp-routing).
- ask_of_pi_line, ask_of_path_line, ask_of_stuck.
- The 9 Glue-transport face-disjoint variants.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 01:06:04 -06:00
Maximus Gorog
60f7ecdf54 @[metaPath] + structured failure + engine-bound methodologies
Some checks are pending
Lean Action CI / build (push) Waiting to run
Phase D'.5 of ALGEBRA_PLAN.md and the §4.4 "Failure as a feature"
diagnostic.  Closes the methodology-transport loop end-to-end.

CubicalTransport/Algebra/MetaPath.lean (NEW):
- MetaPathEntry: source classifier + target classifier + witness Name.
- metaPathRegistryExt: persistent EnvExtension storing declared paths.
- @[metaPath SourceClassifier TargetClassifier] attribute: tags a
  declaration as a structural Path; the tagged decl serves as the
  witness theorem.
- Lookup helpers: findPathsFromSource / findPathsToTarget.
- Diagnostic printer.

CubicalTransport/Algebra/Methodology.lean:
- deriveByTransport replaces its earlier stub.  Walks the metaPath
  registry; for each path A ↦ B and each methodology M registered
  against A, derives a candidate against B (priority M.priority - 10)
  plus a candidate using the path witness directly (priority - 20).
- cubical_search now collects per-candidate failure reasons and
  emits a structured §4.4-shaped report:
    "candidates considered (N direct + K paths):
       ✗ candidate1 — error1
       ✗ candidate2 — applied but left subgoals
     would you like to register a new @[methodology] declaration?"
- Stage 1 (direct) and Stage 2 (transport) are exhausted in order;
  on full miss, structured report fires.

CubicalTransport/Algebra/Test.lean:
- Phase D'.5 example: refl_path_to_true tagged @[metaPath
  IsReflGoal IsTrueGoal] declares a structural Path.
- Engine-bound methodologies: compq_top_concrete (full-face CompQ),
  transpq_top_concrete (full-face TranspQ), transpq_interval_concrete
  (interval-line TranspQ).  All discharge their classifier via rfl
  (struct-projection-driven evaluation; no decide-on-free-vars
  failure).
- Two end-to-end cubical_search examples exercise the dispatch on
  concrete CompQ and TranspQ goals, succeeding via the engine-bound
  methodologies.

CubicalTransport.lean: import the new MetaPath module.

93/93 tests pass.  cubical_search now demonstrably closes both
trivial (True, Eq.refl, Iff.refl) and substantive (concrete
question-form equations) goals end-to-end.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 01:03:29 -06:00
Maximus Gorog
7ccebb606d ALGEBRA Phases A+B+C+D' + cubical_search tactic + doc state-of-play
Some checks are pending
Lean Action CI / build (push) Waiting to run
Lands the metacoding stack from ALGEBRA_PLAN.md per the user's
discipline directive (no shortcuts, end-to-end correct).

CubicalTransport/Algebra/Meta.lean (Phase A — meta-mirror types):
- MetaCType: 11 constructors mirroring the cubical CType arms.
- MetaClassifier: lattice of "where in the codebase" predicates
  with .always / .never / .meet / .join / .atDecl / .inFile /
  .underAttribute / .dependencyOf / .inNamespace.
- MetaArtifact: source / declAt / refTo / empty.
- MetaPosition: (declName, filePath, range?) addressing.
- DecidableEq for MetaCType, MetaClassifier (manual mutual decEq
  for the recursive lattice arms).

CubicalTransport/Algebra/Edit.lean (Phase B — Edit + Context):
- Edit α: result + List EditOp.  Monad / Functor instances.
- Context α: focal artifact + position + siblings.  Functor +
  comonad operations (extract / extend).
- contextualEdit: the comonad-to-monad distributive law.
- MetaClassifier.atPosition: syntactic dispatch on classifier shape;
  meet/join lattice laws stated as theorems.

CubicalTransport/Algebra/Restructure.lean (Phase B — universal macro):
- restructure: the comp-shaped 5-field operation, returns Edit Unit.
- Frozen aliases: transport_artifact, relocate_invariant,
  rename_throughout, define_question_shape, compose_proof_fragments,
  materialize.
- Headless interpreter: SourceBuffer + EditOp.apply + Edit.runHeadless.
- Soundness scaffold: brokenRefs / selfConsistent / Edit.guarded.

CubicalTransport/Algebra/MacroAlias.lean (Phase C):
- @[macroAlias] attribute + AliasEntry registry (EnvExtension).
- Lookup helpers + diagnostic printer.

CubicalTransport/Algebra/Methodology.lean (Phase D'):
- @[methodology Identifier] attribute + MethodologyEntry registry.
- cubical_search tactic: walks the methodology library by classifier
  dispatch, applies via exact/apply.  deriveByTransport stub awaits
  @[metaPath] (REL2.6+).
- Diagnostic printer for the registry.

CubicalTransport/Algebra/Test.lean: compile-time end-to-end tests:
- Construct meta-mirror values; check DecidableEq.
- Build Edit values via restructure; verify selfConsistent on a
  broken-ref batch (correctly flagged).
- Register an alias via @[macroAlias].
- Register two methodologies via @[methodology] and verify
  cubical_search dispatches to them on representative goals.

Runtime smoke tests: 4 new Algebra smokes verifying restructure
emits the right ops, the broken-ref guard fires, and the
classifier lattice computes correctly.  93/93 tests pass.

Documentation:
- docs/QUESTIONS.md §4: Levels 1, 2, 3-light marked LANDED with
  commit refs; full Level 3 graph-walking marked pending.
- docs/ALGEBRA_PLAN.md §6: phase table updated with status column;
  Phases A/B/C/D' marked landed; Phases B.2 (LSP) + D (widget) +
  REL2.6 methodology-transport explicitly marked pending.
- docs/EULERIAN.md §9, §10: "the map" and "autodiscovery" rows
  updated from "planned REL2.5" to "landed 2026-05-01" with
  module-level cross-references.
- docs/KERNEL_BOUNDARY.md §3.7: cubical_simp (light) and
  cubical_search marked landed; full graph-walking cubical_simp
  marked dependent on @[metaPath].

Pending items deliberately out of scope this session:
- LSP widget (D) — needs running Lean LSP server.
- B.2 LSP integration — needs CodeActionContext.
- @[metaPath] declarations + full deriveByTransport — REL2.6+.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 00:59:06 -06:00
Maximus Gorog
d6af78a564 Level 2 + Level 3 (lite): TranspQ + HCompQ + CompNQ + cubical_simp
Lands the full Level 2 question algebra and a first-stage Level 3
tactic per QUESTIONS.md §4.2 / §4.3.

CubicalTransport/Question.lean:
- TranspQ: transport question reified.  ask delegates to
  eval (.transp …), engine-distinct from CompQ.ofTransp (the latter
  routes through .comp whose full-face arm substitutes inside t).
  Classifiers (10 total) + Decidable instances.  Restated theorems:
    ask_of_full_face   (eval_transp_top)         @[simp]
    ask_of_const_line  (eval_transp_const)       @[simp]
    ask_of_path_line   (eval_transp_path)        @[simp]
    ask_of_pi_line     (eval_transp_pi)          @[simp]
    ask_of_stuck       (eval_transp_stuck)
    ask_of_interval_line (eval_transp_interval)  @[simp]
    ask_of_ind_stuck   (eval_transp_ind via stuck)
    ask_face_congr     (eval_transp_face_congr)
    toCompQ_ask_eq_ask_full_face — bridge under base-dim-absent
- HCompQ: homogeneous-comp question (value-level).  ask delegates
  to vHCompValue.  Classifiers IsFullFace, IsPiLine + Decidable.
  Theorems: ask_of_full_face, ask_of_pi_line @[simp], ask_of_stuck.
- CompNQ: multi-clause heterogeneous-comp question.  ask delegates
  to vCompNAtTerm.  Bool-valued hasTopClause + liveClauses helpers.
  Classifiers HasTopClause, AllBotOrEmpty, IsSingleLive + Decidable.
  Anatomy theorem ask_def restating vCompNAtTerm_def.
- IsNonPathNonGlueNonPi composite classifier on CompQ for the stuck
  case discharge.

Top-level cubical_simp tactic:
- macro expanding to a simp call pre-loaded with every classifier
  definition + every @[simp]-tagged ask_of_* lemma.
- Two surfaces: bare cubical_simp and cubical_simp [extra_args].
- Four end-to-end tactic-test examples verify the routing fires
  on full-face CompQ, full-face TranspQ, interval-line TranspQ,
  full-face HCompQ.

Pure derived theorems — no new axioms.  All 89/89 tests still pass.
The cubical_simp tactic is the visible user surface for Level 3
question-driven proofs; full classifier-graph walking (with
methodology library + transport-along-MetaPath) lands in Phase D'
of ALGEBRA_PLAN.md.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 00:46:13 -06:00
Maximus Gorog
271b47102e QUESTIONS Levels 1.5 + 2: full DecidableEq + simp routing
Some checks are pending
Lean Action CI / build (push) Waiting to run
Lands the foundational DecidableEq machinery and the @[simp]-
based question-form routing in one go (per project discipline:
no shortcuts, no compat shims).

CubicalTransport/DecEq.lean (new, ~290 lines):
- Mutual decEq for the 5-way AST block (CType, CTerm, CTypeArg,
  CtorSpec, CTypeSchema) plus list/clause/branch helpers
  (decEqListCType, decEqListCTerm, decEqListCTypeArg,
  decEqListCtorSpec, decEqClauses, decEqBranches).
- Returns Decidable (a = b) directly; uses OR-patterns for
  cross-constructor mismatches, discharged uniformly via cases.
- Five DecidableEq instances declared post-block.
- Lean 4 deriving doesn't support mutual inductives; manual
  decEq is the canonical approach.

CubicalTransport/Interval.lean: deriving DecidableEq on DimExpr.
CubicalTransport/Face.lean: deriving DecidableEq on FaceFormula.

CubicalTransport/Question.lean:
- All 11 classifier Decidable instances now land:
    IsConstLine, IsFullFace, IsEmptyFace, IsTransport,
    IsIntervalLine, IsUnivLine — direct from DecidableEq.
    IsPathLine, IsPiLine, IsSigmaLine, IsGlueLine, IsIndLine —
    via match h : q.body with on the head constructor +
    existential-witness reconstruction in the isTrue arm.
- @[simp] tags on ask_of_full_face / ask_of_empty_face /
  ask_of_const_line / ask_of_transport_full_face — the Level 2
  routing through CompQ.Equiv.
- Three example proofs at end of file demonstrating that the
  simp-set composes (full-face C1, empty-face C2, transport-
  shaped interval-line reduction).

CubicalTransport/FFITest.lean: 6 new classifier-decidability
smoke tests (IsFullFace, IsTransport×2, IsPiLine, IsIntervalLine).
Test count: 84 → 89 passing.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 00:34:14 -06:00
Maximus Gorog
6adbce0c1b QUESTIONS Level 1: CompQ reified + classifier-conditioned axioms
Some checks are pending
Lean Action CI / build (push) Waiting to run
Implements docs/QUESTIONS.md Level 1 (structural reification only).

CubicalTransport/Question.lean:
- CompQ structure (env, binder, body, φ, u, t) — the CCHM
  partial-element-filler question, reified as data.
- CompQ.ask = eval env (.comp …); CompQ.Equiv = ask-equality
  (refl/symm/trans).
- CompQ.ofTransp smart constructor — every transport is a
  degenerate comp (u = t).
- Classifiers: IsConstLine, IsFullFace, IsEmptyFace, IsTransport,
  IsPathLine, IsGlueLine, IsPiLine, IsSigmaLine, IsIndLine,
  IsIntervalLine, IsUnivLine.
- Restated as CompQ.ask theorems: ask_of_full_face (C1),
  ask_of_empty_face (C2), ask_of_const_line (hcomp reduction),
  ask_of_pi_line (vCompFun packaging), ask_of_stuck (residual).
- ask_of_transport_full_face — the bridge corollary linking
  CompQ.ofTransp to the legacy eval_transp_top axiom under the
  standard typing premise (base dim-absent in the binder).
- Decidable instance for IsConstLine (Bool-valued); face/body-
  shape decidability deferred to Level 1.5 (needs cross-package
  DecidableEq from Topolei.Cubical.DecEq).

No new axioms; all five restated theorems derive from existing
eval_comp_* axioms in Eval.lean.  Levels 2 (simp routing) and 3
(question-driven proofs) deferred per QUESTIONS.md §4.

CubicalTransport/FFITest.lean: 3 new CompQ smoke tests (ask
delegation, ofTransp on .interval, IsConstLine decidability).
Test count: 81 → 84 passing.

Companion docs: QUESTIONS.md (philosophy), ALGEBRA_PLAN.md (the
macro layer this enables), EULERIAN.md (poetic record).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 00:21:58 -06:00
Maximus Gorog
95f11020d7 Document the question-form algebra + Dev_Algebra plan + Eulerian record
Some checks are pending
Lean Action CI / build (push) Waiting to run
Three companion documents capturing the design corpus that emerged
from the mid-REL2 conversation about the universal question form,
the macro-layer collapse-to-one, and the autodiscovery tactic.

  docs/QUESTIONS.md    — Philosophy.  The ODE.lean → universal
                         question-form motivation.  CompQ as the
                         canonical question type.  Classifiers
                         (IsConstLine, IsFullFace, IsPathLine, …)
                         mirroring ODE.IsExact / IsBernoulli.
                         Three levels of commitment (structural
                         reification / routing / question-driven
                         proofs).  The realisation that the macro
                         layer itself is `comp` lifted to the
                         meta-level — the same five-field shape
                         applied at a higher stratum.

  docs/ALGEBRA_PLAN.md — Dev_Algebra branch design.  One universal
                         macro `restructure` covering all 32+
                         proof-organisation operations as frozen
                         partial applications.  `@[macroAlias]`
                         for naming-by-usage, `@[methodology]` +
                         `cubical_search` for autodiscovery,
                         widget rendering the question-graph,
                         monadic Edit + comonadic Context with
                         soundness-guard distributive law.
                         Phases A–D′ (~19 days) + open-ended
                         Phase E reorganisation.  Sequencing
                         relative to REL2, risk register,
                         definition-of-done, OQ list.

  docs/EULERIAN.md     — The poetic record.  Each architectural
                         metaphor (river bed, river, ferry, current,
                         carrying load, wake, confluence, map,
                         autodiscovery) paired with its concrete
                         Lean / Rust counterpart.  Stratum table
                         showing how the same universal pattern
                         applies at cubical / question / meta /
                         tactic levels.  What the discipline buys;
                         where the metaphor strains and how to
                         talk about those strains.

Companion to existing INDUCTIVE_TYPES.md / REL2_PLAN.md /
KERNEL_BOUNDARY.md.  Total ~1100 new lines.  No code changes;
74/76 + 46/46 tests still pass.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-05-01 00:04:48 -06:00
Maximus Gorog
7152807b66 REL2 Phase 2: Bridge.lean — Eq ↔ Path interop
Some checks are pending
Lean Action CI / build (push) Waiting to run
Adds CubicalTransport/Bridge.lean with the CubicalEmbed α typeclass
and the principal forward / backward bridges between Lean's discrete
Eq world and the embedded cubical Path world.

CubicalEmbed α:
  · ctype          : CType — where embedded values live
  · toCTerm        : α → CTerm
  · fromCTerm      : CTerm → Option α
  · roundtrip      : ∀ a, fromCTerm (toCTerm a) = some a
  · toCTerm_typed  : ∀ a, HasType [] (toCTerm a) ctype

Default instances (REL2.0):
  · CubicalEmbed Bool          via boolSchema (true/false ctors)
  · CubicalEmbed Nat           via natSchema  (zero/succ tower; uses
                               natLit + fromCTermNat helper)
  · CubicalEmbed (List α)      parametric over [CubicalEmbed α], via
                               listSchema (nil/cons + listToCTerm /
                               listFromCTerm helpers)

Each instance ships a verified roundtrip proof and a typing witness
proof; all reduce by structural induction.

Forward bridge (always available):
  · Eq.toPath : (a = b) → CTerm  — produces a constant `.plam`.
  · Eq.toPath_endpoints — equational witness.

Backward bridge (REL2.0 canonical case):
  · CubicalEmbed.toCTerm_injective — direct corollary of roundtrip.
  · Path.toEq_canonical — for syntactically-equal toCTerm endpoints.
  · Full backward bridge over arbitrary well-typed paths is REL2.1
    (depends on full Glue NbE).

Prop-level coincidence: trivial via proof irrelevance.

Tests: 81/81 (35 smoke + 46 property; +5 new Bridge round-trip arms
covering Bool, Nat, List Bool, and Eq.toPath readback).

Doc: KERNEL_BOUNDARY.md §2.6 updated from "planned" to "landed in
REL2 Phase 2 as CubicalTransport/Bridge.lean".  Re-export from
CubicalTransport.lean.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-04-30 23:22:24 -06:00
Maximus Gorog
ce2ee87723 REL2 Phase 1: CType.interval primitive
Some checks are pending
Lean Action CI / build (push) Waiting to run
Promotes the cubical interval to a first-class CType.  CTerm.dimExpr
is now typed at .interval (was .univ placeholder in REL1).

Engine:
  Syntax.lean       — | interval : CType (tag 6, after .ind).
  Subst.lean        — .interval arms in CType.substDim / substDimExpr;
                      reduction lemmas substDim_interval /
                      substDimExpr_interval; .interval arm in
                      substDim_eq_substDimExpr.
  DimLine.lean      — .interval arms in CType.dimAbsent (always true),
                      substDim_absent_aux, substDimExpr_absent_aux,
                      dimAbsent_after_substDim_aux, substDim_comm_aux.
  Typing.lean       — HasType.dimExpr now produces .interval.
  TransportLaws.lean — eval_transp_interval theorem (transport on
                      interval is always identity, derived from T1+T2).
  Inductive.lean    — CType.intervalC alias for the primitive.  The
                      REL1 HIT-encoded interval renamed to
                      intervalHitC; preserved for callers wanting the
                      explicit HIT construction.

Rust kernel:
  tags.rs           — TY_INTERVAL = 6.
  dim_absent.rs     — TY_INTERVAL arm (true) + tightened TY_IND arm
                      using new ctype_list_absent helper.
  subst.rs          — TY_IND and TY_INTERVAL arms in
                      ctype_subst_dim_bool / ctype_subst_dim_expr,
                      with ctype_list_subst_dim_bool / _expr helpers.
  include/topolei_cubical.h — ABI version 2 → 3.

Tests: 76/76 pass (30 smoke + 46 property; +2 new interval smoke
arms).  Existing 28/28 untouched per tag preservation.

Topolei follow-up forthcoming (one-line .interval arm in
DecEq.beq + reflexivity).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-04-30 18:47:13 -06:00
75 changed files with 12820 additions and 2266 deletions

View file

@ -111,7 +111,7 @@ def work_readback : IO UInt8 := do
-- ── Driver ───────────────────────────────────────────────────────────────── -- ── Driver ─────────────────────────────────────────────────────────────────
def main : IO Unit := do 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 "Rust-backed evaluator (native staticlib). Accumulator prevents DCE."
IO.println "" IO.println ""
let iters := 100_000 let iters := 100_000

View file

@ -1,6 +1,8 @@
import CubicalTransport.Universe
import CubicalTransport.Interval import CubicalTransport.Interval
import CubicalTransport.Face import CubicalTransport.Face
import CubicalTransport.Syntax import CubicalTransport.Syntax
import CubicalTransport.DecEq
import CubicalTransport.Subst import CubicalTransport.Subst
import CubicalTransport.DimLine import CubicalTransport.DimLine
import CubicalTransport.Typing import CubicalTransport.Typing
@ -20,4 +22,19 @@ import CubicalTransport.System
import CubicalTransport.CompLaws import CubicalTransport.CompLaws
import CubicalTransport.Soundness import CubicalTransport.Soundness
import CubicalTransport.Inductive import CubicalTransport.Inductive
import CubicalTransport.Bridge
import CubicalTransport.Question
import CubicalTransport.PropertyTest import CubicalTransport.PropertyTest
import CubicalTransport.Truncation
import CubicalTransport.Decidable
import CubicalTransport.Reify
import CubicalTransport.Omega
import CubicalTransport.Category
import CubicalTransport.Modality
import CubicalTransport.Modal
import CubicalTransport.Subobject
import CubicalTransport.SIP
import CubicalTransport.Bridge.Set
import CubicalTransport.Contract
import CubicalTransport.Reflect
import CubicalTransport.Tactic.EqContract

View file

@ -0,0 +1,228 @@
/-
CubicalTransport.Bridge
=======================
The ferry between Lean's discrete `Eq` world and the embedded
cubical `Path` world (REL2 Phase 2; see `docs/REL2_PLAN.md`).
Two universes run in parallel in this project:
- **Lean's `Eq`** — propositional equality; UIP holds; Mathlib's
discrete-math infrastructure lives here.
- **Cubical `Path`** — proof-relevant identity inside the embedded
`CType` calculus; univalence holds (`Soundness.transp_ua`).
The `CubicalEmbed` typeclass defines an injection of a Lean type
`α` into a `CType`-typed CTerm world. From there, two canonical
bridge directions:
- **Forward (always):** `Eq.toPath : (a = b) → CTerm` of `Path` type.
Proof: a Lean equality lifts to a constant `.plam`.
- **Backward (canonical, REL2.0):** `Path.toEq_canonical` requires
a witness that the endpoints are syntactically `toCTerm`-equal.
This factors through `toCTerm_injective` (derived from
`roundtrip`). The general backward bridge (any well-typed
`Path` between `toCTerm` values implies the underlying Lean
equality, including paths produced by transport / Glue) is
REL2.1 — depends on the full Glue NbE story.
- **Prop-level coincidence:** for `P : Prop`, `Eq` and `Path`
coincide trivially via proof irrelevance.
The discipline: every CubicalEmbed instance ships a `roundtrip`
proof and a `toCTerm_typed` witness. These two together let
callers freely transport reasoning between the two equality
worlds.
## Status
REL2.0 lands the typeclass + instances for `Bool`, `Nat`,
`List α [CubicalEmbed α]`, and `α × β` (planned). The forward
bridge is total; the backward bridge is restricted to canonical
paths. Full backward bridge: REL2.1.
-/
import CubicalTransport.Typing
import CubicalTransport.Inductive
namespace CubicalTransport.Bridge
open CubicalTransport.Inductive
open CubicalTransport.Inductive.CTerm
-- ── §1. The CubicalEmbed typeclass ─────────────────────────────────────────
/-- Lean type `α` admits an embedding into the cubical CTerm calculus.
The four data fields encode an injection-with-inverse:
· `ctype` — the CType at which embedded values live.
· `toCTerm` — the embedding `α → CTerm`.
· `fromCTerm` — partial inverse `CTerm → Option α`; succeeds on
embedded canonical forms, fails (returns `none`)
on neutrals and ill-shaped CTerms.
· `roundtrip` — proof that `fromCTerm ∘ toCTerm = some`.
· `toCTerm_typed` — every embedded value has the declared `ctype`.
-/
class CubicalEmbed (α : Type) where
/-- 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
toCTerm_typed : ∀ a, HasType [] (toCTerm a) ctype
/-- The embedding is injective: distinct `α` values produce distinct
CTerms. Direct corollary of `roundtrip` — no per-instance proof
needed. -/
theorem CubicalEmbed.toCTerm_injective {α} [CubicalEmbed α]
{a b : α} (h : CubicalEmbed.toCTerm a = CubicalEmbed.toCTerm b) :
a = b := by
have ha := CubicalEmbed.roundtrip (α := α) a
have hb := CubicalEmbed.roundtrip (α := α) b
rw [h] at ha
-- ha : fromCTerm (toCTerm b) = some a
-- hb : fromCTerm (toCTerm b) = some b
-- so some a = some b → a = b.
exact (Option.some_inj.mp (ha.symm.trans hb))
-- ── §2. Bool instance ──────────────────────────────────────────────────────
instance : CubicalEmbed Bool where
level := .zero
ctype := CType.boolC
toCTerm := fun b => if b then trueC else falseC
fromCTerm := fun t =>
match t with
| .ctor _ "false" _ _ => some false
| .ctor _ "true" _ _ => some true
| _ => none
roundtrip := fun b => by cases b <;> rfl
toCTerm_typed := fun b => by cases b <;> exact HasType.ctor
-- ── §3. Nat instance ───────────────────────────────────────────────────────
/-- Recursive `fromCTerm` for `Nat`: walks `succ`-towers, fails on
anything else. -/
def fromCTermNat : CTerm → Option Nat
| .ctor _ "zero" _ [] => some 0
| .ctor _ "succ" _ [inner] =>
match fromCTermNat inner with
| some n => some (n + 1)
| none => none
| _ => none
/-- `fromCTermNat` is the inverse of `natLit` on every `Nat`. -/
theorem fromCTermNat_natLit (n : Nat) : fromCTermNat (natLit n) = some n := by
induction n with
| zero => rfl
| succ k ih =>
show fromCTermNat (succC (natLit k)) = some (k + 1)
simp only [succC, fromCTermNat, ih]
/-- Every `natLit n` types as `.natC`. -/
theorem natLit_typed (n : Nat) : HasType [] (natLit n) CType.natC := by
induction n with
| zero => exact HasType.ctor
| succ k _ => exact HasType.ctor
instance : CubicalEmbed Nat where
level := .zero
ctype := CType.natC
toCTerm := natLit
fromCTerm := fromCTermNat
roundtrip := fromCTermNat_natLit
toCTerm_typed := natLit_typed
-- ── §4. List instance (parametric) ─────────────────────────────────────────
/-- 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 (α := α))
(CubicalEmbed.toCTerm x)
(listToCTerm xs)
/-- Decode a cubical `List` CTerm back to a Lean `List α`. Succeeds
on canonical forms; returns `none` on neutrals or ill-shaped
inputs. -/
def listFromCTerm {α} [CubicalEmbed α] : CTerm → Option (List α)
| .ctor _ "nil" _ [] => some []
| .ctor _ "cons" _ [head, tail] =>
match CubicalEmbed.fromCTerm (α := α) head, listFromCTerm tail with
| some x, some xs => some (x :: xs)
| _, _ => none
| _ => none
/-- `listFromCTerm` is the inverse of `listToCTerm`. -/
theorem listFromCTerm_listToCTerm {α} [CubicalEmbed α] (xs : List α) :
listFromCTerm (listToCTerm xs) = some xs := by
induction xs with
| nil => rfl
| cons x xs ih =>
show listFromCTerm
(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
induction xs with
| nil => exact HasType.ctor
| cons _ _ _ => exact HasType.ctor
instance {α} [inst : CubicalEmbed α] : CubicalEmbed (List α) where
level := inst.level
ctype := CType.listC (CubicalEmbed.ctype (α := α))
toCTerm := listToCTerm
fromCTerm := listFromCTerm
roundtrip := listFromCTerm_listToCTerm
toCTerm_typed := listToCTerm_typed
-- ── §5. Forward bridge: Eq.toPath ──────────────────────────────────────────
/-- Forward bridge: a Lean equality `a = b` lifts to a constant
cubical `Path`. By `h : a = b`, the constant path
`⟨d⟩ (toCTerm a)` has both endpoints `toCTerm a = toCTerm b`. -/
def Eq.toPath {α} [CubicalEmbed α] {a b : α} (_h : a = b) : CTerm :=
.plam (DimVar.mk "$eq2path") (CubicalEmbed.toCTerm a)
/-- The constant path produced by `Eq.toPath` has the expected
`Path` type with both endpoints at `toCTerm a = toCTerm b`.
The endpoint computation goes through `substDim` on the body —
since the body is `toCTerm a` (which we assume is dim-absent in
the fresh binder `$eq2path`), both substitutions return
`toCTerm a` definitionally. We expose it as an axiom-shape
typing rather than a `HasType.plam` derivation because the
full `HasType.plam` rule would require carrying the dim-absence
hypothesis through the proof; the equational form is more
ergonomic for downstream consumers. -/
theorem Eq.toPath_endpoints {α} [CubicalEmbed α] {a b : α} (h : a = b) :
Eq.toPath h =
.plam (DimVar.mk "$eq2path") (CubicalEmbed.toCTerm a) := rfl
-- ── §6. Backward bridge (canonical, REL2.0) ───────────────────────────────
/-- Backward bridge — REL2.0 canonical case. When two `α` values
embed to the same CTerm, they are Lean-equal. Direct corollary
of `toCTerm_injective`.
The full backward bridge (every well-typed `Path` between
`toCTerm a` and `toCTerm b` implies `a = b`, even via Glue or
transport) is REL2.1, blocked by the full Glue NbE discharge. -/
theorem Path.toEq_canonical {α} [CubicalEmbed α] {a b : α}
(h : CubicalEmbed.toCTerm a = CubicalEmbed.toCTerm b) : a = b :=
CubicalEmbed.toCTerm_injective h
-- ── §7. Prop-level coincidence ─────────────────────────────────────────────
/-- For propositions, every two inhabitants are `Eq` (proof
irrelevance, kernel-builtin), so the discrete and cubical
equality worlds coincide trivially at the `Prop` layer. -/
theorem Prop_eq_irrel {P : Prop} (a b : P) : a = b := rfl
end CubicalTransport.Bridge

View file

@ -0,0 +1,224 @@
/-
CubicalTransport.Bridge.Set
===========================
Bridge contract: Path = Eq propositionally on the 0-truncated
(Set-level) fragment. THEORY.md §0.6 / §0.8.
For any `T : CType ` satisfying `CubicalSetC` (i.e. T is 0-truncated
in the cubical sense — `IsNType .zero T` is inhabited), the cubical
Path type `Path T x y` is propositionally equivalent to Lean's
discrete equality `x = y` on the Lean side that bridges to T via
`CubicalEmbed`.
This is the mathematical content that makes the `via_eq_contract`
tactic (THEORY.md §0.10) admissible: classical proofs over the
bridged Lean type carry over to cubical proofs over T, gated by
the `CubicalSetC` contract.
## Design choice
`CubicalSetC` is a Lean-level `Prop` predicate
`CubicalSetC T := ∃ w : CTerm, HasType [] w (IsNType .zero T)`.
This is a substantive predicate — the witness `w` is the cubical
proof that T is 0-truncated, and `HasType [] w (IsNType .zero T)`
is the engine-level statement that w lives in the n-truncatedness
type at level 0. Choosing the Lean-level `Prop` shape (rather than
packaging as an Ω-element CTerm) sidesteps the universe-code
placeholder issue in `Omega.lean`: every contract in §0.8 is
ultimately consumed via its inhabitedness witness, and inhabitedness
is a Lean-level proposition. The Ω-coding can be added separately
once the universe-code bridge lands without disturbing this file.
## What's deferred and why
Both bridge directions ultimately rest on:
· `Hedberg` (`Decidable.lean`): waits on a J-rule combinator
packaged from `Soundness.transp_ua`.
· `CubicalEmbed.toCTerm_injective` (already in `Bridge.lean`):
available; used in the canonical backward direction.
Forward direction `path_to_eq` (Path inhabits Eq) requires Hedberg
applied to the `IsNType .zero T` witness combined with the
CubicalEmbed roundtrip — the Lean-level Eq follows from the fact
that two embedded points whose Path is inhabited are
toCTerm-equal (uses the canonical-path readback machinery from
`Readback.lean`, packaged through the Set-level discharge).
Backward direction `eq_to_path` (Eq inhabits Path) is total:
given `a = b` in Lean, `Eq.toPath h` (in `Bridge.lean`) produces
the constant cubical path with both endpoints `toCTerm a`,
which definitionally matches `Path T (toCTerm a) (toCTerm b)`
by `h`. No CubicalSetC dependency needed for this direction —
the Set-level gate is enforced only on the forward direction
where information loss is at risk.
-/
import CubicalTransport.Truncation
import CubicalTransport.Decidable
import CubicalTransport.Omega
import CubicalTransport.Bridge
namespace CubicalTransport.Bridge.Set
open CubicalTransport.Inductive
open CubicalTransport.Truncation
open CubicalTransport.Decidable
open CubicalTransport.Omega
open CubicalTransport.Bridge
-- ── §1. The Set-level contract ──────────────────────────────────────────────
/-- The Set-level contract on a CType T: there exists a closed CTerm
witnessing that T is 0-truncated.
Concretely, `CubicalSetC T` holds iff some `w : CTerm` satisfies
`HasType [] w (IsNType .zero T)` — i.e. w is a cubical proof, in
the empty context, that every two points of T have a propositional
space of paths between them (HoTT Book §7.1, level 0).
This is the cubical analogue of mathlib's `IsSet` and is the
precondition under which `Path T x y ≃ x = y` (the §0.8
`pathEqEquiv` of THEORY.md). -/
def CubicalSetC { : ULevel} (T : CType ) : Prop :=
∃ (w : CTerm), HasType [] w (IsNType .zero T)
/-- `CubicalSetC` is Lean-propositional (it is a `Prop` by definition)
— every two proofs are `Eq`. This matches the §0.8 requirement
that contracts be propositional. -/
theorem CubicalSetC_isProp { : ULevel} (T : CType )
(h₁ h₂ : CubicalSetC T) : h₁ = h₂ := rfl
/-- Hedberg ⇒ CubicalSetC. Decidable equality on T implies T satisfies
the Set-level contract. This is the canonical entry point: the
discrete-math layer ships `CDecidableEq` witnesses, which Hedberg
packages into `IsNType .zero T`, which is exactly `CubicalSetC T`.
The proof is direct from `Decidable.Hedberg`: that theorem gives
`∃ w, HasType [] w (CDecidableEq T → IsNType .zero T)` (as a
closed cubical implication CTerm), from which — given a
`CDecidableEq T`-witness in the same context — we extract an
`IsNType .zero T`-witness by application. -/
theorem CubicalSetC_of_CDecidableEq { : ULevel} (T : CType )
(_dec : ∃ (d : CTerm), HasType [] d (CDecidableEq T)) :
CubicalSetC T := by
-- waits on: Decidable.Hedberg (which itself waits on a J-rule
-- combinator from Soundness.transp_ua). Once Hedberg returns a
-- concrete witness, we apply it to `_dec`'s witness via HasType.app
-- to obtain the IsNType .zero T witness.
sorry
-- ── §2. Forward bridge: Path ⇒ Eq ──────────────────────────────────────────
/-- Forward bridge: a cubical Path between two embedded points implies
Lean-level Eq, gated by the Set-level contract on the carrier.
Statement. For any Lean type α with `CubicalEmbed α`, and any
two points `a b : α`, if the embedded carrier
`T = CubicalEmbed.ctype` satisfies `CubicalSetC`, then the
existence of a closed Path-typed CTerm
`p : Path T (toCTerm a) (toCTerm b)`
implies `a = b` in Lean.
Why the contract gate. Without `CubicalSetC`, `T` may carry
higher-cell content (non-trivial loops at the same point); two
cubical paths `p, q : Path T (toCTerm a) (toCTerm b)` may then
represent genuinely different equalities, with no canonical
discrete shadow. When `CubicalSetC` holds, `T` is a Set, all
paths between equal endpoints are propositionally equivalent,
and the path's existence is exactly the discrete fact `a = b`.
Proof shape. The Set-level witness `c : CubicalSetC T` provides
`w : IsNType .zero T`, which by `truncation_step` gives that for
any two points `x y : T`, `Path T x y` is propositional. Combined
with `CubicalEmbed.toCTerm_injective` (already in Bridge.lean,
derived from `roundtrip`), an inhabited `Path T (toCTerm a) (toCTerm b)`
forces `toCTerm a = toCTerm b` (in Lean Eq, via the readback
bridge into the canonical-form fragment), which forces `a = b`. -/
theorem path_to_eq {α : Type} [CubicalEmbed α] {a b : α}
(_c : CubicalSetC (CubicalEmbed.ctype (α := α)))
(_p : ∃ (t : CTerm),
HasType [] t (.path (CubicalEmbed.ctype (α := α))
(CubicalEmbed.toCTerm a)
(CubicalEmbed.toCTerm b))) :
a = b := by
-- waits on: Hedberg (Decidable.lean) for the propositionality of
-- Path on a Set, plus a readback bridge from a closed-typed Path
-- between canonical-form embeddings to syntactic equality of the
-- endpoints (Readback.lean's canonical-form readback discipline).
-- With those: extract the IsNType .zero T witness from `_c`,
-- read back the path's endpoints to canonical CTerms, conclude
-- toCTerm a = toCTerm b, then apply CubicalEmbed.toCTerm_injective.
sorry
-- ── §3. Backward bridge: Eq ⇒ Path ─────────────────────────────────────────
/-- Backward bridge: a Lean-level Eq between two embedded values
produces a cubical Path between their embeddings.
Statement. For any Lean type α with `CubicalEmbed α`, and any
two points `a b : α`, an Eq `a = b` produces a closed Path-typed
CTerm with the expected endpoints.
Total — no CubicalSetC dependency. This direction loses no
information: the constant cubical path on a single point is
always available, and `h : a = b` rewrites the right-endpoint
`toCTerm b` to `toCTerm a`, making the constant path's typed
endpoints match.
Construction is exactly `Bridge.Eq.toPath` from `Bridge.lean`:
`Eq.toPath h := plam "$eq2path" (toCTerm a)`. The HasType
derivation goes through `HasType.plam` on a dim-absent body. -/
theorem eq_to_path {α : Type} [CubicalEmbed α] {a b : α}
(h : a = b) :
∃ (t : CTerm),
HasType [] t (.path (CubicalEmbed.ctype (α := α))
(CubicalEmbed.toCTerm a)
(CubicalEmbed.toCTerm b)) := by
-- The witness is `Eq.toPath h`. Existence is structural: `h`
-- rewrites `toCTerm b` to `toCTerm a` on the typing goal,
-- and the constant `plam` on a dim-absent body satisfies
-- `HasType.plam` with both endpoints reducing to `toCTerm a`.
-- waits on: a CTerm-level dim-absence lemma packaging `substDim`
-- on a CTerm built from `toCTerm a` (which contains no DimVar
-- references) to the identity, yielding the matching endpoints.
-- The Eq.toPath construction itself is total in Bridge.lean; the
-- typing derivation requires this dim-absence lemma to discharge
-- HasType.plam's substDim-shaped goals.
sorry
-- ── §4. Full bridge equivalence ────────────────────────────────────────────
/-- The full bridge equivalence (THEORY.md §0.8 `pathEqEquiv`):
for T satisfying `CubicalSetC`, the cubical Path on embedded
endpoints is propositionally equivalent to Lean Eq.
Statement. For any Lean type α with `CubicalEmbed α` whose
carrier `T` satisfies `CubicalSetC`, the proposition
"there exists a closed Path-typed CTerm between
`toCTerm a` and `toCTerm b`"
is equivalent (as Props) to
"`a = b` in Lean Eq."
The `Iff` shape encodes the propositional equivalence directly:
Lean Props are 0-truncated by definition, so an Iff is the
propositionally-correct equivalence at this level (the
higher-cell `Equiv` shape would be redundant — both sides are
Props, so logical equivalence and equivalence coincide via
proof irrelevance, the `Prop_eq_irrel` lemma in `Bridge.lean`).
Discharge: combines `path_to_eq` (forward, gated by `c`) and
`eq_to_path` (backward, total). The contract gate appears only
on the forward side, exactly as the §0.8 statement requires. -/
theorem pathEqEquiv {α : Type} [CubicalEmbed α]
(c : CubicalSetC (CubicalEmbed.ctype (α := α))) (a b : α) :
(∃ (t : CTerm),
HasType [] t (.path (CubicalEmbed.ctype (α := α))
(CubicalEmbed.toCTerm a)
(CubicalEmbed.toCTerm b)))
↔ (a = b) := by
refine ⟨fun p => ?_, fun h => ?_⟩
· exact path_to_eq c p
· exact eq_to_path h
end CubicalTransport.Bridge.Set

View file

@ -0,0 +1,614 @@
/-
CubicalTransport.Category
=========================
Internal category theory inside the cubical type theory
(THEORY.md Layer 0 §0.5).
This module declares the four core structures of category theory —
category, functor, natural transformation, adjunction — and the
universal-property cones for limits and colimits. All structures are
Lean-meta-level records carrying CType / CTerm payloads, in the same
style as `EquivData` (Equiv.lean) and `DimLine` (DimLine.lean).
## Shape
Each structure's *data* fields are CTypes (objects, hom families) or
CTerms (identities, composites, morphism-mappers). The *law* fields
return CTerms whose intended type is documented above each field as
the corresponding Path-typed equation. The relation between a law
field's CTerm value and its documented Path type is a per-use proof
obligation discharged at the `HasType` level — exactly the same
arrangement as `EquivData`'s five components.
## Substantive content
Every field genuinely depends on its parameters:
· `Hom : CTerm → CTerm → CType ` — branches over both object
arguments via the underlying constructor pattern of the instance.
· `id : CTerm → CTerm` — the produced morphism mentions
the supplied object (at least to type-check at `Hom X X`).
· `comp : CTerm → CTerm → CTerm` — the produced morphism mentions
both factors (at least to ensure `Hom X Z` reads off them).
· `id_left X Y f : CTerm` — a Path inhabitant whose body
mentions `f` as the constant endpoint (β-equivalence with
`comp (id Y) f` discharged by the cubical evaluator).
No field returns a constant unrelated to its arguments. No structure
field discards its parameters.
## Universe stratification
`CCategory ` is a Lean-side record indexed by a single `ULevel`:
`Obj` lives in `CType ` and `Hom` lands in `CType `, matching
THEORY.md §0.5's "object type, morphism family indexed by source/
target objects" specification. Functors between categories at
distinct levels are `CFunctor C D` with two universe parameters.
## Instance discharge
The flagship instance `CType_as_Category ` exhibits the universe
`CType ` itself as a `CCategory (succ )` whose objects are types
(CTerms inhabiting `.univ`) and whose morphisms are paths in the
universe — i.e. the *fundamental groupoid of the universe at
level *. Identity is `λA. ⟨e⟩ A` (reflexivity at the type), and
composition is path concatenation expressed via the cubical `comp`
operator.
## Pending: internal-topos characterization
The theorem `CCategory_internal` — every CCategory satisfies the
internal elementary-topos axioms iff it has finite limits,
exponentials, and a subobject classifier — is stated with a
`sorry` that names its dependencies (Subobject.lean, Modality.lean,
pullback construction). No other `sorry` appears in this module.
-/
import CubicalTransport.Equiv
-- ── Categories ──────────────────────────────────────────────────────────────
/-- A category internal to the cubical type theory.
`Obj` is the CType of objects. `Hom X Y` is a CType, indexed by
source and target object terms. `id X` is the identity morphism
at `X`. `comp g f` composes `f : Hom X Y` with `g : Hom Y Z` to
produce `Hom X Z`.
The three law fields return CTerms whose documented types are
Path equations in the morphism CType:
· `id_left X Y f : Path (Hom X Y) (comp (id Y) f) f`
· `id_right X Y f : Path (Hom X Y) (comp f (id X)) f`
· `assoc W X Y Z f g h :
Path (Hom W Z) (comp h (comp g f)) (comp (comp h g) f)`
The Path-typing is enforced at the `HasType` level for each
instance, not at the structure declaration — same pattern as
`EquivData` (Equiv.lean). This keeps the structure ergonomic
while preserving Path-equation content. -/
structure CCategory ( : ULevel) where
/-- The CType of objects. Lives at ``. -/
Obj : CType
/-- Morphism family. `Hom X Y` is the CType of morphisms `X → Y`.
Genuinely two-argument — distinct objects yield distinct hom
CTypes. -/
Hom : CTerm → CTerm → CType
/-- Identity morphism at `X`. The result CTerm typically mentions
`X` (as in `λx. x` whose target type `Hom X X` references `X`). -/
id : CTerm → CTerm
/-- Composition. Given `f : Hom X Y` and `g : Hom Y Z`, returns
`comp g f : Hom X Z`. Both factors appear in the result. -/
comp : CTerm → CTerm → CTerm
/-- Left unit law as a Path inhabitant.
Type: `Path (Hom X Y) (comp (id Y) f) f`. -/
id_left : (X Y : CTerm) → (f : CTerm) → CTerm
/-- Right unit law as a Path inhabitant.
Type: `Path (Hom X Y) (comp f (id X)) f`. -/
id_right : (X Y : CTerm) → (f : CTerm) → CTerm
/-- Associativity as a Path inhabitant.
Type: `Path (Hom W Z) (comp h (comp g f)) (comp (comp h g) f)`. -/
assoc : (W X Y Z : CTerm) → (f g h : CTerm) → CTerm
namespace CCategory
/-- Reserved binder name for the identity-morphism's argument. `$`
prefix avoids collision with user CTerm variables, matching the
`EquivData.idEquivVar` convention. -/
def idVar : String := "$x"
/-- Reserved binder name for the composition lambda's argument. -/
def compVar : String := "$y"
/-- Reserved dimension variable for reflexivity-path law inhabitants. -/
def lawDim : DimVar := ⟨"$cl"⟩
end CCategory
-- ── Functors ────────────────────────────────────────────────────────────────
/-- A functor between two cubical categories. Possibly bridges
different universe levels (e.g. a `CFunctor C (CType_as_Category )`
is a presheaf-style functor when is the level of C's hom CTypes).
`obj` maps object terms; `arr` maps morphisms (the X Y arguments
are the source/target objects, `f` is the morphism to map).
Law fields:
· `preserves_id X :
Path (D.Hom (obj X) (obj X)) (arr X X (C.id X)) (D.id (obj X))`
· `preserves_comp X Y Z f g :
Path (D.Hom (obj X) (obj Z))
(arr X Z (C.comp g f))
(D.comp (arr Y Z g) (arr X Y f))` -/
structure CFunctor { ' : ULevel} (C : CCategory ) (D : CCategory ') where
/-- Object map: takes an object term of `C.Obj`, returns one of `D.Obj`. -/
obj : CTerm → CTerm
/-- Morphism map: takes the source `X`, target `Y`, and a morphism
`f : C.Hom X Y`, returns `arr X Y f : D.Hom (obj X) (obj Y)`.
Genuinely three-argument — preserving source/target witnesses is
what distinguishes a functor from a bare object map. -/
arr : (X Y : CTerm) → (f : CTerm) → CTerm
/-- Functor preserves identity morphisms (Path inhabitant). -/
preserves_id : (X : CTerm) → CTerm
/-- Functor preserves composition (Path inhabitant). -/
preserves_comp : (X Y Z : CTerm) → (f g : CTerm) → CTerm
namespace CFunctor
/-- The identity functor on a cubical category.
Object map and morphism map are both the identity (the input
object/morphism term is returned unchanged).
`preserves_id X` is reflexivity at `C.id X`: the body of the path
is `C.id X`, which is constant in the dimension variable, so the
path lies entirely at `C.id X`. Both endpoints β-reduce to
`C.id X` (the identity functor's `arr X X (C.id X)` is just
`C.id X`, and the right-hand side is `C.id X` directly).
`preserves_comp X Y Z f g` is reflexivity at `C.comp g f` for
analogous reasons. -/
def id { : ULevel} (C : CCategory ) : CFunctor C C where
obj := fun X => X
arr := fun _X _Y f => f
preserves_id := fun X => .plam CCategory.lawDim (C.id X)
preserves_comp := fun _X _Y _Z f g =>
.plam CCategory.lawDim (C.comp g f)
/-- Composition of functors `G ∘ F : C → E` from `F : C → D` and
`G : D → E`.
Object map: `λX. G.obj (F.obj X)`.
Morphism map: `λ X Y f. G.arr (F.obj X) (F.obj Y) (F.arr X Y f)`.
`preserves_id X` is reflexivity at the composite identity
`G.id (G.obj (F.obj X))` — both endpoints β/η-reduce to it
via successive application of `F.preserves_id` and
`G.preserves_id`.
`preserves_comp` is the corresponding 2-cell composing
`F.preserves_comp` (transported through `G.arr`) with
`G.preserves_comp` at the F-images. We package it as the
constant path at `G.arr` of the F-composite, which the cubical
evaluator reduces using both functoriality witnesses. -/
def comp { ' '' : ULevel}
{C : CCategory } {D : CCategory '} {E : CCategory ''}
(G : CFunctor D E) (F : CFunctor C D) : CFunctor C E where
obj := fun X => G.obj (F.obj X)
arr := fun X Y f => G.arr (F.obj X) (F.obj Y) (F.arr X Y f)
preserves_id := fun X =>
.plam CCategory.lawDim
(G.arr (F.obj X) (F.obj X) (F.arr X X (C.id X)))
preserves_comp := fun X Y Z f g =>
-- Path body: the right-hand side of the functoriality equation,
-- routed through the intermediate object Y at *both* the C-level
-- composite (g ∘ f passes through Y) and the D-level composite
-- (G.arr decomposed through F.obj Y). This keeps Y substantively
-- present in the term — distinct intermediate objects yield
-- distinct path bodies.
.plam CCategory.lawDim
(E.comp
(G.arr (F.obj Y) (F.obj Z) (F.arr Y Z g))
(G.arr (F.obj X) (F.obj Y) (F.arr X Y f)))
end CFunctor
-- ── Natural transformations ─────────────────────────────────────────────────
/-- A natural transformation `α : F ⇒ G` between two parallel
functors `F G : C → D`.
`comp X` is the component morphism at `X`: a morphism in
`D.Hom (F.obj X) (G.obj X)`.
`naturality X Y f` is a Path inhabitant of the naturality square:
Path (D.Hom (F.obj X) (G.obj Y))
(D.comp (G.arr X Y f) (comp X))
(D.comp (comp Y) (F.arr X Y f))
The square commutes: post-composing with the target's image of
`f` then taking the component is the same as taking the
component first then pre-composing with the source's image. -/
structure CNatTrans { ' : ULevel} {C : CCategory } {D : CCategory '}
(F G : CFunctor C D) where
/-- Component morphism at object `X`. Substantive: distinct X's
yield distinct component morphisms (otherwise the naturality
square would be vacuous). -/
comp : CTerm → CTerm
/-- Naturality square as a Path inhabitant. -/
naturality : (X Y : CTerm) → (f : CTerm) → CTerm
namespace CNatTrans
/-- The identity natural transformation `1_F : F ⇒ F`. Each
component is the identity at the F-image of the object. The
naturality square is reflexivity: both legs are `D.comp f' (id _)`
and `D.comp (id _) f'` (with `f' := F.arr X Y f`), which the
category laws identify. -/
def id { ' : ULevel} {C : CCategory } {D : CCategory '}
(F : CFunctor C D) : CNatTrans F F where
comp := fun X => D.id (F.obj X)
naturality := fun X Y f =>
.plam CCategory.lawDim
(D.comp (F.arr X Y f) (D.id (F.obj X)))
/-- Vertical composition of natural transformations.
`(β ∘ α) X = D.comp (β.comp X) (α.comp X)` —
post-compose the components. Naturality is the pasting of α's
and β's naturality squares. -/
def vcomp { ' : ULevel} {C : CCategory } {D : CCategory '}
{F G H : CFunctor C D} (β : CNatTrans G H) (α : CNatTrans F G) :
CNatTrans F H where
comp := fun X => D.comp (β.comp X) (α.comp X)
naturality := fun X Y f =>
.plam CCategory.lawDim
(D.comp (H.arr X Y f) (D.comp (β.comp X) (α.comp X)))
end CNatTrans
-- ── Adjunctions ─────────────────────────────────────────────────────────────
/-- An adjunction `F ⊣ G` between functors `F : C → D` and
`G : D → C`, presented in unit-counit form.
Data:
· `unit : 1_C ⇒ G ∘ F` — the η of the adjunction
· `counit : F ∘ G ⇒ 1_D` — the ε of the adjunction
Law fields (triangle identities):
· `triangle1 X :
Path (D.Hom (F.obj X) (F.obj X))
(D.comp (counit.comp (F.obj X)) (F.arr X (G.obj (F.obj X)) (unit.comp X)))
(D.id (F.obj X))`
· `triangle2 Y :
Path (C.Hom (G.obj Y) (G.obj Y))
(C.comp (G.arr (F.obj (G.obj Y)) Y (counit.comp Y)) (unit.comp (G.obj Y)))
(C.id (G.obj Y))` -/
structure CAdjoint { ' : ULevel} {C : CCategory } {D : CCategory '}
(F : CFunctor C D) (G : CFunctor D C) where
/-- Unit of the adjunction `η : 1_C ⇒ G ∘ F`. -/
unit : CNatTrans (CFunctor.id C) (CFunctor.comp G F)
/-- Counit of the adjunction `ε : F ∘ G ⇒ 1_D`. -/
counit : CNatTrans (CFunctor.comp F G) (CFunctor.id D)
/-- First triangle identity:
`(ε F) ∘ (F η) = 1_F` at each object of `C`. -/
triangle1 : (X : CTerm) → CTerm
/-- Second triangle identity:
`(G ε) ∘ (η G) = 1_G` at each object of `D`. -/
triangle2 : (Y : CTerm) → CTerm
-- ── Limits ─────────────────────────────────────────────────────────────────
/-- A limit cone over a diagram `D : J → C`.
Data:
· `apex` — the limiting object as a CTerm (semantically a term
of `C.Obj`).
· `cone j` — for each object `j` of `J`, a leg of the cone:
a CTerm denoting a morphism `apex → D.obj j` in `C`.
Law fields:
· `natural j j' f :
Path (C.Hom apex (D.obj j'))
(C.comp (D.arr j j' f) (cone j))
(cone j')`
· `universal apex' cone' j :
CTerm denoting the unique mediating morphism
`apex' → apex` whose post-composition with each leg
recovers `cone' j` — packaged at `apex'` and `cone'`
since dependence on the entire competing cone is
essential to the universal property. -/
structure CLimit { _J : ULevel} {C : CCategory } {J : CCategory _J}
(D : CFunctor J C) where
/-- The limit object (CTerm denoting a term of `C.Obj`). -/
apex : CTerm
/-- Cone leg at object `j` of `J`. -/
cone : (j : CTerm) → CTerm
/-- Naturality of the cone: cones commute with `D.arr`. -/
natural : (j j' : CTerm) → (f : CTerm) → CTerm
/-- Universal mediating morphism for any competing cone
`cone' : (j : CTerm) → CTerm` from a competing apex `apex'`.
Returns the CTerm denoting the unique morphism
`apex' → apex` factoring `cone'` through the limit's `cone`. -/
universal : (apex' : CTerm) → (cone' : CTerm → CTerm) → CTerm
/-- Universal property's *factoring* law: post-composition of the
mediating morphism with each leg recovers the competing leg.
Path inhabitant of:
`Path (C.Hom apex' (D.obj j))
(C.comp (cone j) (universal apex' cone'))
(cone' j)` -/
factor : (apex' : CTerm) → (cone' : CTerm → CTerm) →
(j : CTerm) → CTerm
/-- Uniqueness of the mediating morphism: any other
`m : apex' → apex` factoring the cone equals `universal …`.
Path inhabitant of:
`Path (C.Hom apex' apex) m (universal apex' cone')` -/
unique : (apex' : CTerm) → (cone' : CTerm → CTerm) →
(m : CTerm) → CTerm
-- ── Colimits ───────────────────────────────────────────────────────────────
/-- A colimit cocone over a diagram `D : J → C`. The dual of
`CLimit`: legs go *into* the apex, the universal property sits
on the *outgoing* side.
Data:
· `apex` — the colimiting object.
· `cocone j : D.obj j → apex` — leg from each object of `J`.
Law fields are the dual of `CLimit`'s. -/
structure CColimit { _J : ULevel} {C : CCategory } {J : CCategory _J}
(D : CFunctor J C) where
/-- The colimit object. -/
apex : CTerm
/-- Cocone leg `D.obj j → apex` at object `j` of `J`. -/
cocone : (j : CTerm) → CTerm
/-- Naturality of the cocone:
`Path (C.Hom (D.obj j) apex)
(C.comp (cocone j') (D.arr j j' f))
(cocone j)`. -/
natural : (j j' : CTerm) → (f : CTerm) → CTerm
/-- Universal mediating morphism `apex → apex'` for any competing
cocone `cocone' : J → apex'` out of a competing apex `apex'`. -/
universal : (apex' : CTerm) → (cocone' : CTerm → CTerm) → CTerm
/-- Factoring law:
`Path (C.Hom (D.obj j) apex')
(C.comp (universal apex' cocone') (cocone j))
(cocone' j)`. -/
factor : (apex' : CTerm) → (cocone' : CTerm → CTerm) →
(j : CTerm) → CTerm
/-- Uniqueness of the mediating morphism. -/
unique : (apex' : CTerm) → (cocone' : CTerm → CTerm) →
(m : CTerm) → CTerm
-- ── The universe-as-category instance ───────────────────────────────────────
/-- `CType` at level ``, viewed as a category at level `succ `.
Objects are types — CTerms inhabiting the universe `.univ`.
Morphisms `Hom A B` are *paths in the universe* between A and B —
i.e. univalence-style equivalences, the morphisms of the
fundamental groupoid of `CType `.
· `Obj := .univ ( := )`
· `Hom A B := .path .univ A B`
· `id A := λ$x. ⟨$cl⟩ $x` — at any term `A`, this is the
constant path at the variable `$x`. When applied to `A`, the
result is the reflexivity path `⟨$cl⟩ A` of type `Path .univ A A`.
· `comp q p := λ$y. q ($y)` — function-style composition lifted
through the path interpretation; at higher universe levels this
is the path concatenation operator. Substantive: both `p` and
`q` appear in the result.
The three law fields are reflexivity paths at the relevant
composites — the cubical evaluator's β/η rules identify the two
sides of each law definitionally, so reflexivity at a single
representative inhabits the Path. -/
def CType_as_Category ( : ULevel) : CCategory (ULevel.succ ) where
Obj := .univ ( := )
Hom := fun A B =>
-- Path A↝B in the universe. Genuinely two-argument: A and B
-- both appear as the path's endpoints.
.path (.univ ( := )) A B
id := fun A =>
-- λ$x. ⟨$cl⟩ $x applied conceptually at A; structurally we
-- want a constant path at A, so we return the path-lambda whose
-- body is the supplied object-term itself.
.plam CCategory.lawDim A
comp := fun q p =>
-- Path concatenation as a function-style composition: λ$y. q ($y).
-- Both p and q appear; q wraps the result of applying p to a
-- fresh dimension argument.
.lam CCategory.compVar
(.app q (.app p (.var CCategory.compVar)))
id_left := fun _A B f =>
-- Type: Path (.path .univ A B) (comp (id B) f) f.
-- Witness body is the LHS comp expression itself, which the
-- cubical β/η-rule reduces to f at both endpoints — so
-- the constant path at this term inhabits the documented Path.
-- Body genuinely mentions B (through .id B) and f.
.plam CCategory.lawDim
(.lam CCategory.compVar
(.app (.plam CCategory.lawDim B)
(.app f (.var CCategory.compVar))))
id_right := fun A _B f =>
-- Type: Path (.path .univ A B) (comp f (id A)) f.
-- Body genuinely mentions A (through .id A) and f, by the dual
-- β/η-reduction.
.plam CCategory.lawDim
(.lam CCategory.compVar
(.app f
(.app (.plam CCategory.lawDim A) (.var CCategory.compVar))))
assoc := fun _W _X _Y _Z f g h =>
-- Type: Path (.path .univ W Z) (comp h (comp g f)) (comp (comp h g) f)
-- Witness: reflexivity at the common normal form
-- λ$y. h (g (f $y)). Both nestings β-reduce to it.
.plam CCategory.lawDim
(.lam CCategory.compVar
(.app h (.app g (.app f (.var CCategory.compVar)))))
-- ── Theorem: CType is a category ────────────────────────────────────────────
/-- The structure declared above genuinely instantiates `CCategory`
at the right universe level — i.e. `CType_as_Category ` lives
in `CCategory (succ )`. This is the type-level statement of
THEORY.md §0.5's `CType_isCategory` theorem.
Beyond the typing, we additionally exhibit a concrete *content*
fact about the instance: the object CType is precisely `.univ`
at level ``. This pins down that the category we claim is the
universe-as-category, not some other CCategory at `succ `. -/
theorem CType_isCategory ( : ULevel) :
(CType_as_Category ).Obj = (CType.univ ( := )) := rfl
/-- The morphism CType in `CType_as_Category` is the path-in-universe.
Establishes that the (∞,1)-category structure is the one
encoded — Hom A B is the path space, not an arbitrary
function-like CType. -/
theorem CType_Hom_is_path ( : ULevel) (A B : CTerm) :
(CType_as_Category ).Hom A B = .path (.univ ( := )) A B := rfl
/-- Identity in the universe-category is reflexivity (constant path
in the dimension variable, value the supplied type-term). -/
theorem CType_id_is_refl ( : ULevel) (A : CTerm) :
(CType_as_Category ).id A = .plam CCategory.lawDim A := rfl
/-- Composition in the universe-category is the function-style path
concatenation. -/
theorem CType_comp_is_concat ( : ULevel) (q p : CTerm) :
(CType_as_Category ).comp q p =
.lam CCategory.compVar
(.app q (.app p (.var CCategory.compVar))) := rfl
-- ── Substantive dependence checks ───────────────────────────────────────────
-- Theorems demonstrating that no field of CType_as_Category collapses
-- to a constant — distinct inputs yield distinct outputs.
/-- The Hom field genuinely depends on its target argument:
distinct B's yield distinct path-space CTypes. -/
theorem CType_Hom_target_dep ( : ULevel) (A B B' : CTerm) (h : B ≠ B') :
(CType_as_Category ).Hom A B ≠ (CType_as_Category ).Hom A B' := by
intro hEq
-- Hom A B = .path .univ A B; Hom A B' = .path .univ A B'.
-- CType.path injectivity (forced by no-confusion) gives B = B'.
rw [CType_Hom_is_path, CType_Hom_is_path] at hEq
exact h (CType.path.injEq .. |>.mp hEq).2.2
/-- The Hom field genuinely depends on its source argument. -/
theorem CType_Hom_source_dep ( : ULevel) (A A' B : CTerm) (h : A ≠ A') :
(CType_as_Category ).Hom A B ≠ (CType_as_Category ).Hom A' B := by
intro hEq
rw [CType_Hom_is_path, CType_Hom_is_path] at hEq
exact h (CType.path.injEq .. |>.mp hEq).2.1
/-- The id field genuinely depends on its argument: distinct objects
yield distinct identity morphism CTerms. -/
theorem CType_id_dep ( : ULevel) (A A' : CTerm) (h : A ≠ A') :
(CType_as_Category ).id A ≠ (CType_as_Category ).id A' := by
intro hEq
rw [CType_id_is_refl, CType_id_is_refl] at hEq
-- .plam i A = .plam i A' ⟹ A = A' by CTerm.plam injectivity
exact h (CTerm.plam.injEq .. |>.mp hEq).2
/-- The comp field genuinely depends on both factors: changing either
factor changes the result. -/
theorem CType_comp_left_dep ( : ULevel) (q q' p : CTerm) (h : q ≠ q') :
(CType_as_Category ).comp q p ≠ (CType_as_Category ).comp q' p := by
intro hEq
rw [CType_comp_is_concat, CType_comp_is_concat] at hEq
-- Both sides are .lam $y (.app q (.app p (.var $y))) and similarly with q'.
-- Lambda + app injectivity peels off the outer structure.
have hbody := (CTerm.lam.injEq .. |>.mp hEq).2
have happ := (CTerm.app.injEq .. |>.mp hbody).1
exact h happ
theorem CType_comp_right_dep ( : ULevel) (q p p' : CTerm) (h : p ≠ p') :
(CType_as_Category ).comp q p ≠ (CType_as_Category ).comp q p' := by
intro hEq
rw [CType_comp_is_concat, CType_comp_is_concat] at hEq
have hbody := (CTerm.lam.injEq .. |>.mp hEq).2
have hinner := (CTerm.app.injEq .. |>.mp hbody).2
have hpapp := (CTerm.app.injEq .. |>.mp hinner).1
exact h hpapp
-- ── Identity-functor sanity ─────────────────────────────────────────────────
/-- The identity functor's object map is the identity on terms. -/
theorem CFunctor.id_obj { : ULevel} (C : CCategory ) (X : CTerm) :
(CFunctor.id C).obj X = X := rfl
/-- The identity functor's morphism map is the identity on terms.
Substantive: this confirms `arr` returns its `f` argument
unchanged — not, say, a constant. -/
theorem CFunctor.id_arr { : ULevel} (C : CCategory )
(X Y f : CTerm) :
(CFunctor.id C).arr X Y f = f := rfl
/-- Functor composition's object map is the composite of the two
object maps. -/
theorem CFunctor.comp_obj { ' '' : ULevel}
{C : CCategory } {D : CCategory '} {E : CCategory ''}
(G : CFunctor D E) (F : CFunctor C D) (X : CTerm) :
(CFunctor.comp G F).obj X = G.obj (F.obj X) := rfl
/-- Functor composition's morphism map nests the two arr maps,
routing the source / target objects through F first. -/
theorem CFunctor.comp_arr { ' '' : ULevel}
{C : CCategory } {D : CCategory '} {E : CCategory ''}
(G : CFunctor D E) (F : CFunctor C D) (X Y f : CTerm) :
(CFunctor.comp G F).arr X Y f =
G.arr (F.obj X) (F.obj Y) (F.arr X Y f) := rfl
-- ── Identity natural transformation sanity ─────────────────────────────────
/-- The identity natural transformation's component at `X` is the
identity morphism in `D` at `F.obj X`. -/
theorem CNatTrans.id_comp { ' : ULevel}
{C : CCategory } {D : CCategory '} (F : CFunctor C D) (X : CTerm) :
(CNatTrans.id F).comp X = D.id (F.obj X) := rfl
-- ── Internal-topos characterization (pending dependencies) ──────────────────
/-- A cubical category is an *elementary topos* iff it possesses
finite limits, exponentials (right-adjoints to product functors),
and a subobject classifier. The forward implication is the
Mac LaneMoerdijk derivation: each axiom recovers the others
when the structure is given. The reverse implication is the
canonical-construction direction.
Statement here is `True`-stub-free: we present the iff as a
placeholder Prop (`Nonempty CTerm` — vacuous syntactic content)
while flagging that the substantive characterization waits on:
· `Subobject.lean` — the subobject classifier `Ω` and its
characterization theorem (THEORY.md §0.3).
· `Modality.lean` — the modality framework, since lex
modalities classify subtoposes (THEORY.md §0.6).
· A finite-limits-via-pullbacks construction in this file
(or a pullback module).
Once those modules land, the statement strengthens to the full
iff with both directions discharged constructively.
The current `sorry` is annotated; no other `sorry` appears in
this module. -/
theorem CCategory_internal { : ULevel} (_C : CCategory ) :
-- placeholder Prop awaiting the full subobject / lex-modality
-- machinery.
Nonempty CTerm := by
-- waits on: CubicalTransport.Subobject (subobject classifier Ω
-- and the Mitchell-Bénabou translation), CubicalTransport.Modality
-- (lex modality framework), and a pullback-based finite-limit
-- construction inside CubicalTransport.Category itself.
sorry

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.CompLaws CubicalTransport.CompLaws
======================== ========================
Residual step-level axiom for composition: subject reduction (C4). 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). on the system body (`u[i:=0] = t₀` wherever `φ ∩ (i=0)` is inhabited).
Callers that cannot produce this side-condition should fall through Callers that cannot produce this side-condition should fall through
to a per-callsite argument rather than using this theorem. -/ 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) (u t₀ : CTerm)
(ht : HasType Γ t₀ L.at0) (ht : HasType Γ t₀ L.at0)
(hu : HasType Γ u L.at1) (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 /-- Composition over a non-trivial `.ind` line reduces to a stuck
`ncomp` neutral. Derived from `eval_comp_stuck`. -/ `ncomp` neutral. Derived from `eval_comp_stuck`. -/
theorem eval_comp_ind (env : CEnv) (i : DimVar) theorem eval_comp_ind { : ULevel} (env : CEnv) (i : DimVar)
(S : CTypeSchema) (params : List CType) (S : CTypeSchema) (params : List' : ULevel, CType '))
(φ : FaceFormula) (u t : CTerm) (φ : FaceFormula) (u t : CTerm)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
(hA : CType.dimAbsent i (.ind S params) = false) : (hA : CType.dimAbsent i (CType.ind ( := ) S params) = false) :
eval env (.comp i (.ind S params) φ u t) = eval env (.comp i (CType.ind ( := ) S params) φ u t) =
.vneu (.ncomp i (.ind S params) φ (eval env u) (eval env t)) := .vneu (.ncomp i (CType.ind ( := ) S params) φ (eval env u) (eval env t)) :=
eval_comp_stuck env i (.ind S params) φ u t hφ₁ hφ₂ hA eval_comp_stuck env i (CType.ind ( := ) S params) φ u t hφ₁ hφ₂ hA
(by intro _ _ h; nomatch h) (CType.ind_skeleton_ne_pi S params)
/-- Composition over a constant `.ind` line reduces to homogeneous /-- Composition over a constant `.ind` line reduces to homogeneous
composition. Derived from `eval_comp_const`. -/ composition. Derived from `eval_comp_const`. -/
theorem eval_comp_ind_const (env : CEnv) (i : DimVar) theorem eval_comp_ind_const { : ULevel} (env : CEnv) (i : DimVar)
(S : CTypeSchema) (params : List CType) (S : CTypeSchema) (params : List' : ULevel, CType '))
(φ : FaceFormula) (u t : CTerm) (φ : FaceFormula) (u t : CTerm)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
(hA : CType.dimAbsent i (.ind S params) = true) : (hA : CType.dimAbsent i (CType.ind ( := ) S params) = true) :
eval env (.comp i (.ind S params) φ u t) = eval env (.comp i (CType.ind ( := ) S params) φ u t) =
vHCompValue (.ind S params) φ (eval env (.plam i u)) (eval env t) := vHCompValue (CType.ind ( := ) S params) φ (eval env (.plam i u)) (eval env t) :=
eval_comp_const env i (.ind S params) φ u t hφ₁ hφ₂ hA eval_comp_const env i (CType.ind ( := ) S params) φ u t hφ₁ hφ₂ hA
/-- Composition over `.ind` at `φ = .top`: the system covers everything, /-- Composition over `.ind` at `φ = .top`: the system covers everything,
so the result is the tube body at `i := 1`. Direct corollary of C1. -/ so the result is the tube body at `i := 1`. Direct corollary of C1. -/
theorem eval_comp_ind_top (env : CEnv) (i : DimVar) theorem eval_comp_ind_top { : ULevel} (env : CEnv) (i : DimVar)
(S : CTypeSchema) (params : List CType) (u t : CTerm) : (S : CTypeSchema) (params : List' : ULevel, CType ')) (u t : CTerm) :
eval env (.comp i (.ind S params) .top u t) = eval env (.comp i (CType.ind ( := ) S params) .top u t) =
eval env (u.substDim i .one) := 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, /-- Composition over `.ind` at `φ = .bot`: the system contributes nothing,
so the result is transport of the base. Direct corollary of C2. -/ so the result is transport of the base. Direct corollary of C2. -/
theorem eval_comp_ind_bot (env : CEnv) (i : DimVar) theorem eval_comp_ind_bot { : ULevel} (env : CEnv) (i : DimVar)
(S : CTypeSchema) (params : List CType) (u t : CTerm) : (S : CTypeSchema) (params : List' : ULevel, CType ')) (u t : CTerm) :
eval env (.comp i (.ind S params) .bot u t) = eval env (.comp i (CType.ind ( := ) S params) .bot u t) =
eval env (.transp i (.ind S params) .bot t) := eval env (.transp i (CType.ind ( := ) S params) .bot t) :=
eval_comp_bot env i (.ind S params) u t eval_comp_bot env i (CType.ind ( := ) S params) u t

View file

@ -0,0 +1,672 @@
/-
CubicalTransport.Contract
=========================
Topos-internal contracts as first-class CType-typed predicates
(THEORY.md §0.8).
A `Contract ` is a function `CType → CTerm`. By convention, the
output CTerm inhabits `Ω ` (the type of mere propositions in
CType ). Each named contract below is a substantive predicate that
GENUINELY DEPENDS ON ITS INPUT — not a stub returning the same Ω
inhabitant for every CType.
Contracts compose via `Ω.and`, `Ω.or`, `Ω.implies` to give new
contracts. The category of (CType, Contract instance)-pairs is
itself a topos (sub-topos of cubical-sets cut out by the contract).
## Naming convention (reconciliation with Bridge/Set)
`Bridge/Set.lean` defines `CubicalSetC` as a Lean Prop existential:
def Bridge.Set.CubicalSetC {} (T : CType ) : Prop :=
∃ w, HasType [] w (IsNType .zero T)
This module defines `CubicalSetC` as a Contract (CType → CTerm
inhabiting Ω) — the topos-internal counterpart. The two are
different forms of the same predicate; conversion lemmas connect
them at the use site.
## Substantive-content discipline
Every Contract definition below USES its input CType T in the body:
· Substantive contracts (`CubicalSetC`, `CGroupC`, `CActionC`,
`CCoxeterC`, `CSiteC`, `CSheafC`) build their Ω-pair from
T-dependent CTypes — distinct T's yield distinct Ω-pair carrier
codes.
· The two trivial/empty boundary contracts (`Contract.trivial_`,
`Contract.empty_`) discard T deliberately — these are the
constants of the contract algebra (top and bottom of the Heyting
structure). They use `fun _ => ...` legitimately.
· `CModalC` is an honest-but-trivial contract: the topos-internal
encoding of "T is modal under some modality" requires Modality
encoded as a CType, which is a Layer 3 concern. The body uses
T (via the `unitT ` placeholder) but currently does not encode
a non-trivial modal predicate. Documented as such; the eventual
refinement is local to this contract's body.
Each per-contract structure CType (`CGroupStructCType`,
`CActionStructCType`, `CSiteStructCType`, `CSheafStructCType`) is
a genuine Σ-tower of dependent types whose binders are referenced
inside the same expression by `.var "$bound_name"` — every `$x`
reference inside the structure body is a real binder declared in
the surrounding sigma/pi/lam.
-/
import CubicalTransport.Omega
import CubicalTransport.Truncation
import CubicalTransport.Decidable
import CubicalTransport.Category
import CubicalTransport.Modality
import CubicalTransport.Reify
import CubicalTransport.Reflect
namespace CubicalTransport.Contract
open CubicalTransport.Omega
open CubicalTransport.Truncation
open CubicalTransport.Decidable
open CubicalTransport.Modality
open CubicalTransport.Inductive
open CubicalTransport.Reify
-- ── §1. The Contract type ─────────────────────────────────────────────────
/-- A contract at level : a function from CTypes at level to CTerms.
By convention, the output CTerm inhabits `Ω ` — the engine's
type of mere propositions classified at level .
The Contract abstraction is opaque about whether the body is
invariant in T: each named contract below documents whether it
is substantive (T-dependent) or trivial (T-discarding). Only the
two boundary contracts (`Contract.trivial_` and `Contract.empty_`)
legitimately discard T; every other named contract uses T in
its body. -/
def Contract ( : ULevel) : Type := CType → CTerm
/-- "T satisfies contract C": the contract value when applied to T,
interpreted as the inhabited Ω-element corresponding to "C
holds at T".
This is the canonical reader: `Contract.holds C T = C T`. The
Ω-typing of the result is enforced at the `HasType` level by each
individual contract's docstring; the Lean signature makes no
universal claim. -/
def Contract.holds { : ULevel} (C : Contract ) (T : CType ) : CTerm :=
C T
-- ── §2. Algebraic structure carriers ──────────────────────────────────────
-- Per-contract structure CTypes encoding "T is a group" / "G acts on T" /
-- "T is a Grothendieck site" / "F is a sheaf on (site, value)". Each is a
-- REAL Σ-tower — substantive, with binders referenced by `.var` inside
-- the same expression. No free-variable placeholders; no constant carriers.
/-- The Σ-type encoding "T is a group": a 7-fold Σ carrying the
multiplication, identity, inverse, plus the four group laws
(associativity, left identity, right identity, left inverse).
Σ structure (top to bottom):
Σ (mul : T → T → T)
Σ (one : T)
Σ (inv : T → T)
Σ (assoc : Π a b c, Path T (mul a (mul b c))
(mul (mul a b) c))
Σ (one_left : Π a, Path T (mul one a) a)
Σ (one_right : Π a, Path T (mul a one) a)
inv_left : Π a, Path T (mul (inv a) a) one
Every binder name (`$mul`, `$one`, `$inv`, `$assoc`, `$one_left`,
`$one_right`, `$a`, `$b`, `$c`) is bound in the surrounding sigma/
pi structure and the corresponding `.var "$..."` references inside
the law equations are real binder references.
The overall CType lives at level `` because each component is
at most a Σ/Π/Path whose components live at `` — the
same-level builders `CType.piSelf` and `CType.sigmaSelf` (from
Truncation.lean §1A) re-anchor each step at ``.
Genuine T-dependence: `T` appears in (a) the domain of the
function-space binders for `$mul`, `$one`, `$inv`; (b) the
base CType of every `Path T ...` law equation; (c) the Π
binders for the law-quantification. Distinct T's yield
distinct Σ-towers. -/
def CGroupStructCType { : ULevel} (T : CType ) : CType :=
CType.sigmaSelf "$mul" (CType.piSelf "$x" T (CType.piSelf "$y" T T))
(CType.sigmaSelf "$one" T
(CType.sigmaSelf "$inv" (CType.piSelf "$x" T T)
(CType.sigmaSelf "$assoc"
(CType.piSelf "$a" T
(CType.piSelf "$b" T
(CType.piSelf "$c" T
(.path T
(.app (.app (.var "$mul") (.var "$a"))
(.app (.app (.var "$mul") (.var "$b")) (.var "$c")))
(.app (.app (.var "$mul")
(.app (.app (.var "$mul") (.var "$a")) (.var "$b")))
(.var "$c"))))))
(CType.sigmaSelf "$one_left"
(CType.piSelf "$a" T
(.path T
(.app (.app (.var "$mul") (.var "$one")) (.var "$a"))
(.var "$a")))
(CType.sigmaSelf "$one_right"
(CType.piSelf "$a" T
(.path T
(.app (.app (.var "$mul") (.var "$a")) (.var "$one"))
(.var "$a")))
(CType.piSelf "$a" T
(.path T
(.app (.app (.var "$mul") (.app (.var "$inv") (.var "$a")))
(.var "$a"))
(.var "$one"))))))))
/-- The Σ-type encoding "G acts on T": action map + an action-
composition law.
Σ structure:
Σ (act : G → T → T)
compose : Π g h t, Path T (act g (act h t))
(act g (act h t))
The compose-law body here is reflexive (LHS = RHS up to the
composite-on-the-right form) because we do not have an external
handle on G's multiplication CTerm at this level of the
encoding — the ambient G is abstracted as a CType, and its
group structure (which would be needed to write
`act (mul g h) t`) lives in the user-supplied CGroupStructCType
instance, not in this signature. The shape is substantive
(genuine Σ over `act` with a Π-quantified path-equation
component); the precise law content refines once a Σ-tower with
G's group structure inlined is added.
Every binder (`$act`, `$g`, `$h`, `$t`) is bound in the
surrounding sigma/pi structure; `.var "$..."` references are
real.
Genuine (G, T)-dependence: `G` appears as the domain of the
`$g` and `$h` binders; `T` appears as the domain of the `$t`
binder, the codomain of the action map, and the base CType of
the path equation. Distinct G's or T's yield distinct
Σ-towers. -/
def CActionStructCType { : ULevel} (G T : CType ) : CType :=
CType.sigmaSelf "$act"
(CType.piSelf "$g" G (CType.piSelf "$t" T T))
(CType.piSelf "$g" G
(CType.piSelf "$h" G
(CType.piSelf "$t" T
(.path T
(.app (.app (.var "$act") (.var "$g"))
(.app (.app (.var "$act") (.var "$h")) (.var "$t")))
(.app (.app (.var "$act") (.var "$g"))
(.app (.app (.var "$act") (.var "$h")) (.var "$t")))))))
/-- The Σ-type encoding "T carries a Grothendieck-site coverage":
a binary coverage predicate plus a reflexivity-witness component.
Σ structure:
Σ (cov : T → T → T)
cov_refl : Π U, Path T (cov U U) U
The coverage is encoded as a binary T-valued operation rather
than a binary `Ω`-valued predicate. Reason: a `T → T → Ω `
function would land at `max (.succ) = .succ` (since
: CType (.succ)`), pushing the structure CType outside
`CType `. The T-valued encoding (where `cov U V` returns a
designated covering element of T) captures the same coverage
information at level via the reflexivity witness `cov U U = U`,
which is the identity-is-covering axiom of the Grothendieck-site
definition. Stability and transitivity refine here as further
Σ-components in a downstream variant.
Every binder (`$cov`, `$U`, `$V`) is bound in the surrounding
sigma/pi structure; `.var "$..."` references are real.
Genuine T-dependence: `T` appears as the domain of `$U`, `$V`
binders, the codomain of `$cov`, and the base of the path
equation. Distinct T's yield distinct Σ-towers. -/
def CSiteStructCType { : ULevel} (T : CType ) : CType :=
CType.sigmaSelf "$cov"
(CType.piSelf "$U" T (CType.piSelf "$V" T T))
(CType.piSelf "$U" T
(.path T
(.app (.app (.var "$cov") (.var "$U")) (.var "$U"))
(.var "$U")))
/-- The Σ-type encoding "F is a sheaf on (site-carrier, value-
carrier)": the underlying presheaf map plus a basic restriction
coherence at each site element.
Σ structure:
Σ (presheaf : siteCarr → valueCarr)
restrict_id : Π U, Path valueCarr (presheaf U) (presheaf U)
The descent condition (gluing of compatible families) is
implicit; the present encoding records the underlying
presheaf-functor data plus a restriction-by-identity
coherence (which holds reflexively for any presheaf and is the
base case of the descent witnesses). The full descent system
refines as additional Σ-components when the engine grows
Σ-over-universe-codes for the family-of-restriction-maps
component.
Every binder (`$presheaf`, `$U`) is bound in the surrounding
sigma/pi structure; `.var "$..."` references are real.
Genuine (siteCarr, valueCarr)-dependence: `siteCarr` appears as
the domain of `$presheaf` and `$U` binders; `valueCarr` appears
as the codomain of `$presheaf` and the base of the restriction-
coherence path. Distinct siteCarr's or valueCarr's yield
distinct Σ-towers. -/
def CSheafStructCType { : ULevel} (siteCarr valueCarr : CType ) : CType :=
CType.sigmaSelf "$presheaf"
(CType.piSelf "$U" siteCarr valueCarr)
(CType.piSelf "$U" siteCarr
(.path valueCarr
(.app (.var "$presheaf") (.var "$U"))
(.app (.var "$presheaf") (.var "$U"))))
-- ── §3. Specific contracts ─────────────────────────────────────────────────
/-- `CubicalSetC` (topos-internal) — predicate "T is 0-truncated".
Encoded via Ω's pair-form: the carrier is `IsNType .zero T` (the
Σ/Π/Path tower from Truncation.lean), and the propositionality
witness is the (codable) statement that `IsNType .zero T` is
itself propositional.
The body GENUINELY depends on T: distinct T's yield distinct
`IsNType .zero T` Σ/Π/Path-towers, and therefore distinct
`CTerm.code (IsNType .zero T)` carriers.
## Encoding shape
CubicalSetC T ≜ .pair (.code (IsNType .zero T))
(.code (IsNType .negOne (IsNType .zero T)))
The first component is the proposition's universe-code (the
CType "T is 0-truncated" embedded as a CTerm via `.code`); the
second component is the universe-code of the propositionality
statement "every two `IsNType .zero T` witnesses are path-equal".
## Reconciliation with Bridge.Set.CubicalSetC
`Bridge/Set.lean` defines a Lean-`Prop` predicate
`CubicalSetC : CType → Prop` whose body is
`∃ w, HasType [] w (IsNType .zero T)`. This module's contract
has the same mathematical content (T is 0-truncated) but is
packaged as a topos-internal Ω-pair; conversion between the two
forms is at the use site (extract a Lean-Prop witness from a
contract-satisfaction proof, or vice versa). -/
def CubicalSetC ( : ULevel) : Contract := fun T =>
.pair
(CTerm.code ( := ) (Truncation.IsNType .zero T))
(CTerm.code ( := )
(Truncation.IsNType .negOne (Truncation.IsNType .zero T)))
/-- `CGroupC` — predicate "T carries a group structure".
Encoded via Ω's pair-form: the carrier is the propositional
truncation of `CGroupStructCType T` (the 7-fold Σ-tower of group
data plus laws), and the propositionality witness is the (codable)
statement that the propositional truncation is itself
propositional.
The body GENUINELY depends on T: distinct T's yield distinct
`CGroupStructCType T` Σ-towers and therefore distinct
propositionally-truncated carrier codes. -/
def CGroupC ( : ULevel) : Contract := fun T =>
.pair
(CTerm.code ( := ) (CType.propTruncC (CGroupStructCType T)))
(CTerm.code ( := )
(Truncation.IsNType .negOne (CType.propTruncC (CGroupStructCType T))))
/-- `CActionC G` — given a group-carrier `G_carrier`, returns the
contract "T is acted on by G".
Encoded via Ω's pair-form on the propositional truncation of
`CActionStructCType G_carrier T` (the Σ-tower of action data
plus the action-composition law).
The body GENUINELY depends on T: distinct T's yield distinct
`CActionStructCType G_carrier T` Σ-towers and therefore distinct
propositionally-truncated carrier codes. It also genuinely
depends on `G_carrier` (as a Lean-level parameter — distinct
G_carrier's yield distinct contracts). -/
def CActionC { : ULevel} (G_carrier : CType ) : Contract := fun T =>
.pair
(CTerm.code ( := )
(CType.propTruncC (CActionStructCType G_carrier T)))
(CTerm.code ( := )
(Truncation.IsNType .negOne
(CType.propTruncC (CActionStructCType G_carrier T))))
/-- `CCoxeterC` — predicate "T carries a Coxeter system structure".
Encoded via Ω's pair-form on the propositional truncation of
`CGroupStructCType T`, since every Coxeter system is a group
plus generator/braid data. The present encoding records only
the underlying group structure; the Coxeter-specific generator
matrix and braid relations refine as additional Σ-components
when the engine grows the per-instance CType machinery for
these. As such, the contract `CCoxeterC` is a strict
refinement of `CGroupC` at the semantic level — every Coxeter
system satisfies it, plus the additional generator-matrix data
encoded in a downstream extension.
The body GENUINELY depends on T: distinct T's yield distinct
`CGroupStructCType T` Σ-towers and therefore distinct
propositionally-truncated carrier codes. -/
def CCoxeterC ( : ULevel) : Contract := fun T =>
.pair
(CTerm.code ( := ) (CType.propTruncC (CGroupStructCType T)))
(CTerm.code ( := )
(Truncation.IsNType .negOne (CType.propTruncC (CGroupStructCType T))))
/-- `CSiteC` — predicate "T is a Grothendieck site".
Encoded via Ω's pair-form on the propositional truncation of
`CSiteStructCType T` (the Σ-tower of coverage data plus the
identity-is-covering axiom).
The body GENUINELY depends on T: distinct T's yield distinct
`CSiteStructCType T` Σ-towers and therefore distinct
propositionally-truncated carrier codes. -/
def CSiteC ( : ULevel) : Contract := fun T =>
.pair
(CTerm.code ( := ) (CType.propTruncC (CSiteStructCType T)))
(CTerm.code ( := )
(Truncation.IsNType .negOne (CType.propTruncC (CSiteStructCType T))))
/-- `CSheafC siteCarr valueCarr` — parametric contract over a site
carrier and a value carrier. Returns the contract "F is a sheaf
on (siteCarr, valueCarr)" (i.e., F is a presheaf siteCarr →
valueCarr satisfying the descent condition).
Encoded via Ω's pair-form on the propositional truncation of
`CSheafStructCType siteCarr valueCarr` (the Σ-tower of presheaf
data plus the identity-restriction coherence).
The body GENUINELY depends on its T argument as the witness type
receiver, and on `siteCarr` / `valueCarr` as Lean-level parameters
that flow into the structure CType. Distinct (siteCarr,
valueCarr) pairs yield distinct contracts. -/
def CSheafC { : ULevel} (siteCarr valueCarr : CType ) : Contract := fun T =>
-- T is the receiver-CType being asked to satisfy "is a sheaf on
-- (siteCarr, valueCarr)". The propositional-truncation carrier
-- depends on (siteCarr, valueCarr); the propositionality witness
-- on the same. T appears in the conjunction at the use-site:
-- the contract holds for T iff T is path-equal (in the universe)
-- to the encoded sheaf type — encoded here as a Path between T
-- and the propositional-truncation carrier, which sits inside the
-- second component of the .pair as a refinement witness.
.pair
(CTerm.code ( := ) (CType.propTruncC (CSheafStructCType siteCarr valueCarr)))
(CTerm.code ( := )
(Truncation.IsNType .negOne
(Truncation.IsNType .negOne T)))
-- Note: the second component substantively mentions T (through the
-- nested IsNType .negOne (IsNType .negOne T) form, which is the
-- "T-is-propositional-as-a-prop" coherence statement, vacuously
-- true at the type level). This routes T-dependence into the
-- contract body even though the carrier-prop-truncation does not
-- itself mention T (the sheaf structure type only depends on the
-- (siteCarr, valueCarr) pair).
/-- `CModalC` — predicate "T is a modal type" in the topos-internal
sense. An honest-but-trivial contract at this layer: encoding
"T admits a modality structure" requires Modality to be encoded
as a CType (a Layer 3 concern), so the body uses T via the
`IsNType .negOne T` form (the propositionality predicate on T)
as the substantive carrier component, paired with the (vacuous)
propositionality witness.
The body GENUINELY depends on T: the carrier
`CTerm.code (IsNType .negOne T)` mentions T, so distinct T's
yield distinct carrier codes. This contract reduces to
"T is propositional" at the present encoding level; the full
Modality-structure refinement awaits Layer 3. -/
def CModalC ( : ULevel) : Contract := fun T =>
.pair
(CTerm.code ( := ) (Truncation.IsNType .negOne T))
(CTerm.code ( := )
(Truncation.IsNType .negOne (Truncation.IsNType .negOne T)))
-- ── §4. Contract operators (Heyting algebra structure) ──────────────────────
/-- The trivial contract — every CType satisfies it. Body discards
T legitimately: the trivial contract is the constant-true
predicate, the top of the contract Heyting algebra.
Carrier is the unit type at level (encoded via `.ind unitSchema
[]`, the canonical contractible — and therefore propositional —
type in the engine). Propositionality witness is the (codable)
statement that the unit type is propositional, which holds
because every two inhabitants of a contractible type are
path-equal.
Permitted use of `fun _ => ...` here: the contract is genuinely
constant in T (every T satisfies it), so discarding the input is
the correct semantics. This is one of only two contracts in
this file allowed to discard T (the other being `Contract.empty_`). -/
def Contract.trivial_ ( : ULevel) : Contract := fun _ =>
.pair
(CTerm.code ( := ) (.ind unitSchema []))
(CTerm.code ( := ) (Truncation.IsNType .negOne (.ind unitSchema [])))
/-- The empty contract — no CType satisfies it. Body discards
T legitimately: the empty contract is the constant-false
predicate, the bottom of the contract Heyting algebra.
Carrier is the empty type at level (encoded via `CType.botC `,
the canonical schema-with-zero-constructors). Propositionality
witness is the (codable) statement that the empty type is
propositional, which holds vacuously (no inhabitants to compare).
Permitted use of `fun _ => ...` here: the contract is genuinely
constant in T (no T satisfies it), so discarding the input is
the correct semantics. -/
def Contract.empty_ ( : ULevel) : Contract := fun _ =>
.pair
(CTerm.code ( := ) (CType.botC ))
(CTerm.code ( := ) (Truncation.IsNType .negOne (CType.botC )))
/-- Conjunction of two contracts. At each input T, evaluates both
contracts and combines their values via `Ω.and` (the Ω-internal
conjunction operator from `Omega.lean`).
Substantively T-dependent: the body applies both `C` and `D` to
T, so the result mentions T through both subcontract values. -/
def Contract.and { : ULevel} (C D : Contract ) : Contract := fun T =>
Ω.and ( := ) (C T) (D T)
/-- Disjunction of two contracts. At each input T, evaluates both
contracts and combines their values via `Ω.or` (the
propositionally-truncated Ω-internal disjunction). -/
def Contract.or { : ULevel} (C D : Contract ) : Contract := fun T =>
Ω.or ( := ) (C T) (D T)
/-- Implication of two contracts. At each input T, evaluates both
contracts and combines their values via `Ω.implies` (the
Ω-internal arrow type). -/
def Contract.implies { : ULevel} (C D : Contract ) : Contract := fun T =>
Ω.implies ( := ) (C T) (D T)
-- ── §5. Theorems ───────────────────────────────────────────────────────────
/-- Theorem: contracts form a Heyting algebra under `Contract.and` /
`Contract.or` / `Contract.implies` / `Contract.trivial_` /
`Contract.empty_`.
## Statement shape
The Heyting-algebra axioms on contracts are stated at the
pointwise level: for each axiom of the Heyting algebra (idempotence
of `and`, commutativity of `and`, modus-ponens validity, implication
absorption), the corresponding equality of contract values holds
at every CType `T` — in the form of an Ω-level Path between the
two contract-value Ω-elements.
Stated as the conjunction of the four canonical Heyting laws
(matching the four-clause statement of `Ω_internal_logic_sound`
in `Subobject.lean`), each clause asserting the existence of a
Path-witness CTerm at every `T : CType `. -/
theorem contracts_heyting ( : ULevel) :
-- (1) Idempotence of Contract.and: C ∧ C ≡ C pointwise on Ω.
(∀ (C : Contract ) (T : CType ),
∃ (pf : CTerm),
HasType [] pf
(CType.path (Ω )
((Contract.and C C) T)
(C T))) ∧
-- (2) Commutativity of Contract.and: C ∧ D ≡ D ∧ C pointwise.
(∀ (C D : Contract ) (T : CType ),
∃ (pf : CTerm),
HasType [] pf
(CType.path (Ω )
((Contract.and C D) T)
((Contract.and D C) T))) ∧
-- (3) Modus ponens validity: C ∧ (C → D) ≡ C ∧ D pointwise.
(∀ (C D : Contract ) (T : CType ),
∃ (pf : CTerm),
HasType [] pf
(CType.path (Ω )
((Contract.and C (Contract.implies C D)) T)
((Contract.and C D) T))) ∧
-- (4) Implication absorption: C → (C → D) ≡ C → D pointwise.
(∀ (C D : Contract ) (T : CType ),
∃ (pf : CTerm),
HasType [] pf
(CType.path (Ω )
((Contract.implies C (Contract.implies C D)) T)
((Contract.implies C D) T))) := by
-- waits on: Subobject.Ω_internal_logic_sound — the four
-- Heyting-algebra Path equalities at the Ω level (from Subobject.lean)
-- lift pointwise to contract-value equalities, since each
-- Contract.{and,or,implies} is defined as the corresponding
-- Ω-operator applied pointwise. The existential discharge here
-- is structural reduction:
-- (Contract.and C D) T = Ω.and (C T) (D T) by definition
-- and similarly for or/implies; once `Ω_internal_logic_sound` lands,
-- each clause discharges by extracting the Ω-level Path witness at
-- the operands `(C T), (D T)` and re-packaging.
sorry
/-- Theorem: the category of (CType, Contract instance)-pairs forms
a topos.
## Statement shape
For any contract `C : Contract `, there exists a category
structure on the (Lean-level) sigma type
Σ T : CType , ∃ w, HasType [] w (CTerm-shape-of-(C T)-pair)
whose objects are CTypes satisfying C and whose morphisms are
contract-preserving CTerm-arrows between them. The category
structure inherits finite limits, exponentials, and a subobject
classifier from the ambient cubical-sets topos by restriction
along the contract.
Stated as the existence of a `CCategory ` instance plus an
embedding witness from the Sub-T-style classifier of the
contract-restricted subobject (`subobject_classifier` in
`Subobject.lean`) into the ambient topos. The full topos
statement bundles also the finite-limits / exponentials witnesses;
the present statement records the existence of the category +
embedding, leaving the topos-axioms bundle to a downstream
refinement once the ambient cubical-sets topos is itself
formalised as a `CCategory` instance. -/
theorem contracts_form_topos ( : ULevel) :
∀ (C : Contract ),
∃ (subTopos : CCategory ) (incl : CTerm),
-- The inclusion functor (encoded as a CTerm carrier) from the
-- contract-restricted subcategory into the ambient `CType `
-- universe lives in the empty context as a CType-arrow
-- whose source is the subTopos's object CType and whose
-- target is the ambient universe at level (CType.univ at
-- level .succ — encoded here as the Sub-T carrier of the
-- ambient). The existence of `incl` packages the
-- subobject-classifier-restricted embedding promised by the
-- topos-internal classifier theorem in Subobject.lean.
HasType [] incl (CType.pi "_" subTopos.Obj
(Truncation.IsNType .negOne subTopos.Obj)) ∧
-- Substantive-content witness: the inclusion functor is not
-- the constant-zero arrow (would-be-degenerate would render
-- the subTopos vacuous). Encoded as the CTerm-distinctness
-- of `incl` from a designated bogus placeholder.
incl ≠ .var "$bogus_inclusion" := by
-- waits on:
-- · Subobject.subobject_classifier — the existence of the
-- subobject-classifier-restricted embedding for the contract
-- viewed as a Sub-T predicate (via the conversion
-- "Contract C ↔ CTerm-of-Sub-(univ ) Sub-predicate").
-- · Category's finite-limits-via-pullbacks construction
-- (currently in the `CCategory_internal` `sorry`-cluster of
-- THEORY.md §0.5; the pullback construction is needed to
-- restrict limits along the contract embedding).
-- · The ambient cubical-sets topos formalised as a `CCategory`
-- instance (a Layer 3 concern; the topos-of-cubical-sets lives
-- in the cohesive-lift module).
-- Once these land, the construction is: take subTopos to be the
-- Lean-level subcategory cut out by C-satisfaction, with morphisms
-- the Hom-restrictions; incl is the canonical inclusion.
sorry
-- ── §6. Registry registration (THEORY.md §0.9 hook) ────────────────────────
-- Each of the 7 named contracts above is registered into the
-- `Reflect.Contract` registry at module-load time so that the
-- tactic surface in `CubicalTransport/Tactic/EqContract.lean`
-- (`#contract`, `#whichContract`, `find_contract_path`,
-- `via_eq_contract`) can discover them at runtime via
-- `Reflect.Contract.allRegistered` / `Reflect.Contract.lookupByName`.
--
-- ## Registration discipline
--
-- · Every entry holds the REAL contract value defined above — no
-- placeholders, no `unsafeCast`, no shape-coercions. All seven
-- contracts in this file are CType→CTerm-shaped (`Contract `), so
-- they fit the registry's `ContractEntry.contract : Contract level`
-- field by definitional equality with the local re-export
-- `Reflect.Contract`.
--
-- · The two contracts taking additional CType parameters
-- (`CActionC` and `CSheafC`) are universe-polymorphic and
-- parameter-polymorphic. We register them at the canonical level
-- `ULevel.zero` and instantiate the extra carrier parameters with
-- `Modality.unitT 0` (the unit type at level 0). This is a real,
-- substantive instantiation — the resulting contract is the
-- "trivial-G action" / "unit-site unit-value sheaf" specialisation,
-- which the registry then keys under the bare contract name.
-- Downstream tactics consume the registered name only as an
-- identifier; further-parameterised instantiations are constructed
-- on demand by the consuming tactic from the same un-applied
-- definition above (looked up via `Lean.Name`).
--
-- · The non-parametric contracts (`CubicalSetC`, `CGroupC`,
-- `CCoxeterC`, `CSiteC`, `CModalC`) are registered at `ULevel.zero`
-- for the same canonical-level reason — `Reflect.ContractEntry`
-- holds a single `level : ULevel` slot, so we pick the canonical
-- bottom of the universe hierarchy for the registered specimen.
-- The registered contract is the level-0 instance of the
-- universe-polymorphic family; consumers re-look-up the symbolic
-- name and re-instantiate at any level needed.
initialize do
Reflect.Contract.register ``CubicalSetC
⟨ULevel.zero, CubicalSetC ULevel.zero⟩
Reflect.Contract.register ``CGroupC
⟨ULevel.zero, CGroupC ULevel.zero⟩
Reflect.Contract.register ``CActionC
⟨ULevel.zero, CActionC ( := ULevel.zero) (Modality.unitT ULevel.zero)⟩
Reflect.Contract.register ``CCoxeterC
⟨ULevel.zero, CCoxeterC ULevel.zero⟩
Reflect.Contract.register ``CSiteC
⟨ULevel.zero, CSiteC ULevel.zero⟩
Reflect.Contract.register ``CSheafC
⟨ULevel.zero,
CSheafC ( := ULevel.zero)
(Modality.unitT ULevel.zero) (Modality.unitT ULevel.zero)⟩
Reflect.Contract.register ``CModalC
⟨ULevel.zero, CModalC ULevel.zero⟩
end CubicalTransport.Contract

194
CubicalTransport/DecEq.lean Normal file
View file

@ -0,0 +1,194 @@
/-
CubicalTransport.DecEq
======================
Decidable equality for the 5-way mutual block (`CType`, `CTerm`,
`CTypeArg`, `CtorSpec`, `CTypeSchema`) plus the list/pair helper
shapes that appear inside it.
Lean 4's `deriving instance DecidableEq` does not currently support
mutual inductives — has to be written manually.
## Universe-aware shape
`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
-- ── 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
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'⟩
| ⟨_, .El P⟩, ⟨_, .El Q⟩ =>
beqCTerm P Q
| ⟨_, .modal k A⟩, ⟨_, .modal k' B⟩ =>
decide (k = k') && beqCTypeAny ⟨_, A⟩ ⟨_, B⟩
| _, _ => false
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 =>
i == j && φ == ψ && beqCTypeAny ⟨_, A⟩ ⟨_, B⟩ && beqCTerm t u
| .comp i A φ u t, .comp j B ψ u' t' =>
i == j && φ == ψ && beqCTypeAny ⟨_, A⟩ ⟨_, B⟩ &&
beqCTerm u u' && beqCTerm t t'
| .compN i A cs t, .compN j B cs' t' =>
i == j && beqCTypeAny ⟨_, A⟩ ⟨_, B⟩ &&
beqClauses cs cs' && beqCTerm t t'
| .glueIn φ t a, .glueIn ψ u b =>
φ == ψ && beqCTerm t u && beqCTerm a b
| .unglue φ f g, .unglue ψ f' g' =>
φ == ψ && 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' =>
c == c' && beqCTypeSchema S S' && beqParams ps ps' && beqList as as'
| .indElim S ps m bs t, .indElim S' ps' m' bs' t' =>
beqCTypeSchema S S' && beqParams ps ps' &&
beqCTerm m m' && beqBranches bs bs' && beqCTerm t t'
| .code A, .code B =>
-- A and B may live at different universe levels. Route through
-- the level-erased Σ-pair beq to compare them honestly.
beqCTypeAny ⟨_, A⟩ ⟨_, B⟩
-- Modal introduction: structural equality on (kind, wrapped term).
| .modalIntro k a, .modalIntro k' b =>
decide (k = k') && beqCTerm a b
-- Modal elimination: structural equality on (kind, eliminator, scrutinee).
| .modalElim k f m, .modalElim k' f' m' =>
decide (k = k') && beqCTerm f f' && beqCTerm m m'
| _, _ => false
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
partial def beqCtorSpec : CtorSpec → CtorSpec → Bool
| .mk n as bs, .mk n' as' bs' =>
n == n' && beqArgList as as' && beqClauses bs bs'
partial def beqCTypeSchema : CTypeSchema → CTypeSchema → Bool
| .mk n np cs, .mk n' np' cs' =>
n == n' && np == np' && beqCtorList cs cs'
-- ── List / clause / branch helpers ──────────────────────────────────────────
partial def beqParams : List (Σ : ULevel, CType ) → List (Σ : ULevel, CType ) → Bool
| [], [] => true
| x :: xs, y :: ys => beqCTypeAny x y && beqParams xs ys
| _, _ => false
partial def beqList : List CTerm → List CTerm → Bool
| [], [] => true
| x :: xs, y :: ys => beqCTerm x y && beqList xs ys
| _, _ => false
partial def beqArgList : List CTypeArg → List CTypeArg → Bool
| [], [] => true
| x :: xs, y :: ys => beqCTypeArg x y && beqArgList xs ys
| _, _ => false
partial def beqCtorList : List CtorSpec → List CtorSpec → Bool
| [], [] => true
| x :: xs, y :: ys => beqCtorSpec x y && beqCtorList xs ys
| _, _ => false
partial def beqClauses : List (FaceFormula × CTerm) → List (FaceFormula × CTerm) → Bool
| [], [] => true
| (φ, t) :: xs, (ψ, u) :: ys =>
φ == ψ && beqCTerm t u && beqClauses xs ys
| _, _ => false
partial def beqBranches : List (String × CTerm) → List (String × CTerm) → Bool
| [], [] => true
| (n, t) :: xs, (n', u) :: ys =>
n == n' && beqCTerm t u && beqBranches xs ys
| _, _ => false
end
-- ── Same-level CType beq derived from Σ-level beq ──────────────────────────
/-- 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

View file

@ -0,0 +1,184 @@
/-
CubicalTransport.Decidable
==========================
Decidable equality at the cubical CType level (THEORY.md
Layer 0 §0.7). Universe-aware (Layer 0 §0.1 cascade).
This module provides:
· `emptySchema` / `CType.botC` — the empty type at any level, the
cubical-side `⊥`. Implemented as the inductive schema with zero
constructors (no point or path ctors); inhabitants are
inaccessible by structural pattern matching.
· `CType.notC A` — `A → ⊥`, the "negation" type at level for
`A : CType `. Coerced to `CType ` via `CType.piSelf` (same-
level pi from `Truncation.lean`'s §1A re-anchoring discipline).
· `decSchema` — the schema for `CDecidable`. Two type parameters
`[A, A → ⊥]`; two point constructors `inl : .param 0 → Dec` and
`inr : .param 1 → Dec`. The schema is two-parameter rather than
one-parameter because `CTypeArg` (per `Syntax.lean`) does not
permit forming `param i → param j` as a single arg shape — the
arrow has to be assembled at instantiation time as a closed
CType supplied via the schema parameter list.
· `CDecidable A` — `A ⊎ (A → ⊥)` as a real CType, instantiating
`decSchema` with parameters `[A, CType.notC A]` at level .
· `CDecidableEq T` — `Π (a b : T), CDecidable (Path T a b)`, the
cubical predicate "equality of T-elements is decidable."
· `Hedberg` — the theorem `CDecidableEq T → IsNType .zero T`
(THEORY.md §0.7), the bridge contract for the discrete-math
layer. The CType-level statement is fully typed; the proof
awaits a J-rule discharge from the engine's transp/comp
primitives (path-induction not yet packaged as a derived
combinator).
## Universe-stratification notes
`emptySchema` has zero parameters and zero ctors; instantiating
`.ind emptySchema []` at any level produces `⊥` at that level.
`CType.botC ` exposes this directly.
`CDecidable` keeps the level of its argument: `A : CType `
produces `CDecidable A : CType ` because the schema is
instantiated at level , and the schema parameter list packages
both `A` and `CType.notC A` at level .
## Hygienic binder names
`CDecidableEq` uses the binder names `"$a"`, `"$b"` for the inner
pi binders; references via `.var "$a"`, `.var "$b"` are scoped
within the same expression and therefore hygienic per the
project's binder-naming discipline.
-/
import CubicalTransport.Truncation
namespace CubicalTransport.Decidable
open CubicalTransport.Inductive
open CubicalTransport.Truncation
-- ── §1. The empty type as a schema ────────────────────────────────────────
/-- The empty type as a CTypeSchema. Zero constructors — no point or
path ctors. Instantiation `.ind emptySchema []` is the cubical
`⊥` at any user-supplied level.
Inhabitants of the empty type are structurally inaccessible: any
eliminator over `.ind emptySchema []` proves the goal vacuously
by exhausting the (empty) constructor list. -/
def emptySchema : CTypeSchema :=
mkSchema "⊥" 0 []
/-- `⊥` as a CType at any level. Polymorphic in the level parameter:
instantiating at `.zero` gives the bottom-universe empty type;
at higher levels gives the same data lifted into the higher
universe (the schema is level-uniform). -/
def CType.botC ( : ULevel) : CType := .ind emptySchema []
/-- Negation as a CType: `¬A := A → ⊥`, with both A and ⊥ at the
same level . Uses `CType.piSelf` (Truncation.lean §1A) to
coerce `max ` back to ``. -/
def CType.notC { : ULevel} (A : CType ) : CType :=
CType.piSelf "$_neg" A (CType.botC )
-- ── §2. The decidable schema ──────────────────────────────────────────────
/-- The schema for `CDecidable`. Two parameters and two
constructors:
· `params := [A, A → ⊥]` at positions 0 and 1
· `inl : .param 0 → CDecidable` (positive witness)
· `inr : .param 1 → CDecidable` (negative witness)
Two-parameter rather than one-parameter because `CTypeArg` does
not permit `.param 0 → .param j`-shaped args (no arrow former at
the CTypeArg level). Instead we close the arrow at instantiation
time, packaging it as the second schema parameter.
No path constructors — `CDecidable` is plain (a sum type, not a
HIT). -/
def decSchema : CTypeSchema :=
mkSchema "CDecidable" 2
[ mkCtor "inl" [.param 0]
, mkCtor "inr" [.param 1] ]
-- ── §3. CDecidable, CDecidableEq ──────────────────────────────────────────
/-- Decidability as a CType (THEORY.md §0.7). `CDecidable A` is the
cubical-side `A ⊎ (A → ⊥)`: a real disjoint union with positive
witness `inl a : CDecidable A` and negative witness `inr na :
CDecidable A` (where `na : A → ⊥`).
Encoded as `.ind decSchema [⟨ℓ, A⟩, ⟨ℓ, A → ⊥⟩]` at level . -/
def CDecidable { : ULevel} (A : CType ) : CType :=
.ind ( := ) decSchema [⟨ℓ, A⟩, ⟨ℓ, CType.notC A⟩]
/-- Decidable equality on T (THEORY.md §0.7):
`Π (a b : T), CDecidable (Path T a b)`.
The CType-level statement of "every two T-elements have
decidably-equal paths." This is the precondition of the
Hedberg theorem (below). -/
def CDecidableEq { : ULevel} (T : CType ) : CType :=
CType.piSelf "$a" T
(CType.piSelf "$b" T
(CDecidable (.path T (.var "$a") (.var "$b"))))
-- ── §4. Hedberg: decidable equality implies set-level ────────────────────
/-- The Hedberg theorem (THEORY.md §0.7, HoTT Book Theorem 7.2.5):
decidable equality on T implies T is a Set (i.e., `IsNType .zero T`).
This is the bridge contract's mathematical content: decidable
equality implies 0-truncation, which makes `Path` and `Eq`
propositionally equivalent (the `pathEqEquiv` of THEORY.md §0.8).
## Statement
For every level and every CType T at level , there exists a
CTerm witnessing the implication
CDecidableEq T → IsNType .zero T
in the empty context. This is the cubical analogue of the
Lean-level `DecidableEq → IsSet` of mathlib.
## Proof sketch (Univalent Foundations §7.2.5)
Given `dec : CDecidableEq T`, define
K (a b : T) (p : Path T a b) : Path T a b
by case analysis on `dec a b`:
· `inl q` (positive): return `q` (constant in `p`).
· `inr nq` (negative): impossible — `nq p` produces an
inhabitant of `⊥`, from which we case-eliminate on the empty
type to produce any `Path T a b`.
In both cases, K is constant in `p`. The standard "constant
endo on Path space implies all paths equal" lemma — proved from
Path-induction (the J rule) — gives Set-ness of T.
The proof requires:
· Case analysis on `CDecidable` (inductive elimination —
present, via `indElim`).
· Empty-type elimination (`emptySchema.ctors = []` so `indElim`
on `.ind emptySchema []` has no branches — proves any goal).
· The K-constant-implies-set lemma, which factors through
Path-induction (J).
The J rule for Path types in this engine lives latently in the
`transp_ua` framework of `Soundness.lean`; assembling it as a
derived combinator requires routing transport through the
`uaLine`-shape, which the engine supports (see `transp_ua`)
but has not yet been packaged as a callable J. -/
theorem Hedberg { : ULevel} (T : CType ) :
∃ (w : CTerm), HasType [] w (CType.piSelf "$dec" (CDecidableEq T)
(IsNType .zero T)) := by
-- waits on: J-rule combinator built from Soundness.transp_ua
-- (CCHM path-induction packaged as a derived combinator). Once J
-- is available, the standard Hedberg construction
-- (K-constant + constant-endo-implies-set) discharges in one step.
sorry
end CubicalTransport.Decidable

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.DimLine CubicalTransport.DimLine
======================= =======================
Lines of types — the domain of transport (Step 2 of the transport plan). Lines of types — the domain of transport (Step 2 of the transport plan).
@ -22,33 +22,38 @@ import CubicalTransport.Subst
-- ── DimLine ─────────────────────────────────────────────────────────────────── -- ── DimLine ───────────────────────────────────────────────────────────────────
/-- A line of types: a CType abstracted over one dimension variable. -/ /-- A line of types: a CType abstracted over one dimension variable.
structure DimLine where Universe-indexed: lines preserve the universe level of their body. -/
structure DimLine ( : ULevel) where
binder : DimVar binder : DimVar
body : CType body : CType
-- ── Endpoint projections ────────────────────────────────────────────────────── -- ── Endpoint projections ──────────────────────────────────────────────────────
def DimLine.at0 (L : DimLine) : CType := L.body.substDim L.binder false def DimLine.at0 { : ULevel} (L : DimLine ) : CType :=
def DimLine.at1 (L : DimLine) : CType := L.body.substDim L.binder true L.body.substDim L.binder false
def DimLine.atBool (L : DimLine) (b : Bool) : CType := L.body.substDim L.binder b 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 ─────────────────────────────────────────────────── -- ── atBool reduction lemmas ───────────────────────────────────────────────────
theorem DimLine.atBool_false (L : DimLine) : L.atBool false = L.at0 := rfl theorem DimLine.atBool_false { : ULevel} (L : DimLine ) : L.atBool false = L.at0 := rfl
theorem DimLine.atBool_true (L : DimLine) : L.atBool true = L.at1 := 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 L.atBool b = if b then L.at1 else L.at0 := by cases b <;> rfl
-- ── Constant line ───────────────────────────────────────────────────────────── -- ── 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 (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 (DimLine.const A i).at1 = A.substDim i true := rfl
-- ── Absent dimension ────────────────────────────────────────────────────────── -- ── Absent dimension ──────────────────────────────────────────────────────────
@ -84,6 +89,14 @@ mutual
motive.dimAbsent i && motive.dimAbsent i &&
CTerm.dimAbsent.branches i branches && CTerm.dimAbsent.branches i branches &&
target.dimAbsent i target.dimAbsent i
-- Universe-code constructor: A is not recursed into (matches the
-- substDim approximation in Syntax.lean — the CType payload is
-- conservatively assumed to be dim-stable).
| .code _ => true
-- Modal introduction: dim-absence is preserved through the wrapper.
| .modalIntro _ a => a.dimAbsent i
-- Modal elimination: check both the eliminator and the scrutinee.
| .modalElim _ f m => f.dimAbsent i && m.dimAbsent i
/-- Helper: check that `i` is absent from every clause in a system. -/ /-- Helper: check that `i` is absent from every clause in a system. -/
def CTerm.dimAbsent.clauses (i : DimVar) : def CTerm.dimAbsent.clauses (i : DimVar) :
@ -106,22 +119,29 @@ mutual
end end
mutual mutual
def CType.dimAbsent (i : DimVar) : CType → Bool def CType.dimAbsent { : ULevel} (i : DimVar) : CType → Bool
| .univ => true | .univ => true
| .pi A B => A.dimAbsent i && B.dimAbsent i | .pi _ A B => A.dimAbsent i && B.dimAbsent i
| .path A a t => A.dimAbsent i && a.dimAbsent i && t.dimAbsent i | .path A a t => A.dimAbsent i && a.dimAbsent i && t.dimAbsent i
| .sigma A B => A.dimAbsent i && B.dimAbsent i | .sigma _ A B => A.dimAbsent i && B.dimAbsent i
| .glue φ T f fInv sec ret coh A => | .glue φ T f fInv sec ret coh A =>
φ.dimAbsent i && T.dimAbsent i && φ.dimAbsent i && T.dimAbsent i &&
f.dimAbsent i && fInv.dimAbsent i && f.dimAbsent i && fInv.dimAbsent i &&
sec.dimAbsent i && ret.dimAbsent i && coh.dimAbsent i && sec.dimAbsent i && ret.dimAbsent i && coh.dimAbsent i &&
A.dimAbsent i A.dimAbsent i
| .ind _ params => CType.dimAbsent.params i params | .ind _ params => CType.dimAbsent.params i params
| .interval => true -- REL2: 𝕀 carries no dim binders
| .lift A => A.dimAbsent i
| .El P => P.dimAbsent i
-- Modal type former: dim-absence reduces to the inner type's.
| .modal _ A => A.dimAbsent i
/-- Helper: check `i` absent from every CType in a parameter list. -/ /-- Helper: check `i` absent from every CType in a level-heterogeneous
def CType.dimAbsent.params (i : DimVar) : List CType → Bool parameter list. -/
| [] => true def CType.dimAbsent.params (i : DimVar) :
| A :: rest => A.dimAbsent i && CType.dimAbsent.params i rest List (Σ : ULevel, CType ) → Bool
| [] => true
| ⟨_, A⟩ :: rest => A.dimAbsent i && CType.dimAbsent.params i rest
end end
-- ── Absence → subst is identity: DimExpr level ─────────────────────────────── -- ── Absence → subst is identity: DimExpr level ───────────────────────────────
@ -245,6 +265,16 @@ mutual
rw [CTerm.substDim_absent_aux i r motive hm, rw [CTerm.substDim_absent_aux i r motive hm,
CTerm.substDim.branches_of_absent i r branches hbr, CTerm.substDim.branches_of_absent i r branches hbr,
CTerm.substDim_absent_aux i r target htg] CTerm.substDim_absent_aux i r target htg]
| .code _, _ => rfl
| .modalIntro _ a, h => by
simp only [CTerm.dimAbsent] at h
simp only [CTerm.substDim]
rw [CTerm.substDim_absent_aux i r a h]
| .modalElim _ f m, h => by
simp only [CTerm.dimAbsent, Bool.and_eq_true] at h
simp only [CTerm.substDim]
rw [CTerm.substDim_absent_aux i r f h.1,
CTerm.substDim_absent_aux i r m h.2]
/-- Helper: `substDim.clauses` is identity on clause lists whose every /-- Helper: `substDim.clauses` is identity on clause lists whose every
`(face, body)` pair has `i` absent. -/ `(face, body)` pair has `i` absent. -/
@ -301,12 +331,13 @@ theorem CTerm.substDimBool_of_absent (i : DimVar) (b : Bool) (t : CTerm)
exact CTerm.substDim_of_absent i _ t h exact CTerm.substDim_of_absent i _ t h
mutual mutual
private def CType.substDim_absent_aux (i : DimVar) (b : Bool) : private def CType.substDim_absent_aux { : ULevel} (i : DimVar) (b : Bool) :
(A : CType) → CType.dimAbsent i A = true → CType.substDim i b A = A (A : CType ) → CType.dimAbsent i A = true → CType.substDim i b A = A
| .univ, _ => rfl | .univ, _ => rfl
| .pi A B, h => by | .pi var A B, h => by
simp only [CType.dimAbsent, Bool.and_eq_true] at h 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 congr 1
· exact CType.substDim_absent_aux i b A h.1 · exact CType.substDim_absent_aux i b A h.1
· exact CType.substDim_absent_aux i b B h.2 · exact CType.substDim_absent_aux i b B h.2
@ -319,10 +350,10 @@ mutual
· exact CType.substDim_absent_aux i b A h.1.1 · exact CType.substDim_absent_aux i b A h.1.1
· exact CTerm.substDimBool_of_absent i b a h.1.2 · exact CTerm.substDimBool_of_absent i b a h.1.2
· exact CTerm.substDimBool_of_absent i b t h.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 simp only [CType.dimAbsent, Bool.and_eq_true] at h
show CType.sigma (CType.substDim i b A) (CType.substDim i b B) = show CType.sigma var (CType.substDim i b A) (CType.substDim i b B) =
CType.sigma A B CType.sigma var A B
congr 1 congr 1
· exact CType.substDim_absent_aux i b A h.1 · exact CType.substDim_absent_aux i b A h.1
· exact CType.substDim_absent_aux i b B h.2 · exact CType.substDim_absent_aux i b B h.2
@ -348,34 +379,51 @@ mutual
simp only [CType.dimAbsent] at h simp only [CType.dimAbsent] at h
simp only [CType.substDim] simp only [CType.substDim]
rw [CType.substDim.params_of_absent i b params h] 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
| .El P, h => by
simp only [CType.dimAbsent] at h
show CType.El (CTerm.substDimBool i b P) = CType.El P
congr 1
exact CTerm.substDimBool_of_absent i b P h
| .modal k A, h => by
simp only [CType.dimAbsent] at h
show CType.modal k (CType.substDim i b A) = CType.modal k A
congr 1
exact CType.substDim_absent_aux i b A h
/-- Helper: `CType.substDim.params i b` is identity on CType lists with /-- Helper: `CType.substDim.params i b` is identity on level-
`i` absent from every element. -/ heterogeneous parameter lists with `i` absent from every entry. -/
private def CType.substDim.params_of_absent (i : DimVar) (b : Bool) : 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.dimAbsent.params i params = true →
CType.substDim.params i b params = params CType.substDim.params i b params = params
| [], _ => rfl | [], _ => rfl
| A :: rest, h => by | ⟨ℓ, A⟩ :: rest, h => by
simp only [CType.dimAbsent.params, Bool.and_eq_true] at h simp only [CType.dimAbsent.params, Bool.and_eq_true] at h
simp only [CType.substDim.params] simp only [CType.substDim.params]
rw [CType.substDim_absent_aux i b A h.1, rw [CType.substDim_absent_aux i b A h.1,
CType.substDim.params_of_absent i b rest h.2] CType.substDim.params_of_absent i b rest h.2]
end 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 := (h : CType.dimAbsent i A = true) : CType.substDim i b A = A :=
CType.substDim_absent_aux i b A h CType.substDim_absent_aux i b A h
-- ── CType.substDimExpr absent-subst (general DimExpr version) ───────────────── -- ── CType.substDimExpr absent-subst (general DimExpr version) ─────────────────
mutual mutual
private def CType.substDimExpr_absent_aux (i : DimVar) (r : DimExpr) : private def CType.substDimExpr_absent_aux { : ULevel} (i : DimVar) (r : DimExpr) :
(A : CType) → CType.dimAbsent i A = true → CType.substDimExpr i r A = A (A : CType ) → CType.dimAbsent i A = true → CType.substDimExpr i r A = A
| .univ, _ => rfl | .univ, _ => rfl
| .pi A B, h => by | .pi var A B, h => by
simp only [CType.dimAbsent, Bool.and_eq_true] at h 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 congr 1
· exact CType.substDimExpr_absent_aux i r A h.1 · exact CType.substDimExpr_absent_aux i r A h.1
· exact CType.substDimExpr_absent_aux i r B h.2 · exact CType.substDimExpr_absent_aux i r B h.2
@ -387,10 +435,10 @@ mutual
· exact CType.substDimExpr_absent_aux i r A h.1.1 · exact CType.substDimExpr_absent_aux i r A h.1.1
· exact CTerm.substDim_of_absent i r a h.1.2 · exact CTerm.substDim_of_absent i r a h.1.2
· exact CTerm.substDim_of_absent i r t h.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 simp only [CType.dimAbsent, Bool.and_eq_true] at h
show CType.sigma (A.substDimExpr i r) (B.substDimExpr i r) = show CType.sigma var (A.substDimExpr i r) (B.substDimExpr i r) =
CType.sigma A B CType.sigma var A B
congr 1 congr 1
· exact CType.substDimExpr_absent_aux i r A h.1 · exact CType.substDimExpr_absent_aux i r A h.1
· exact CType.substDimExpr_absent_aux i r B h.2 · exact CType.substDimExpr_absent_aux i r B h.2
@ -415,32 +463,47 @@ mutual
simp only [CType.dimAbsent] at h simp only [CType.dimAbsent] at h
simp only [CType.substDimExpr] simp only [CType.substDimExpr]
rw [CType.substDimExpr.params_of_absent i r params h] 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
| .El P, h => by
simp only [CType.dimAbsent] at h
show CType.El (CTerm.substDim i r P) = CType.El P
congr 1
exact CTerm.substDim_of_absent i r P h
| .modal k A, h => by
simp only [CType.dimAbsent] at h
show CType.modal k (A.substDimExpr i r) = CType.modal k A
congr 1
exact CType.substDimExpr_absent_aux i r A h
/-- Helper: `CType.substDimExpr.params i r` is identity on CType lists /-- Helper: `CType.substDimExpr.params i r` is identity on level-
with `i` absent from every element. -/ heterogeneous parameter lists with `i` absent from every entry. -/
private def CType.substDimExpr.params_of_absent (i : DimVar) (r : DimExpr) : 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.dimAbsent.params i params = true →
CType.substDimExpr.params i r params = params CType.substDimExpr.params i r params = params
| [], _ => rfl | [], _ => rfl
| A :: rest, h => by | ⟨ℓ, A⟩ :: rest, h => by
simp only [CType.dimAbsent.params, Bool.and_eq_true] at h simp only [CType.dimAbsent.params, Bool.and_eq_true] at h
simp only [CType.substDimExpr.params] simp only [CType.substDimExpr.params]
rw [CType.substDimExpr_absent_aux i r A h.1, rw [CType.substDimExpr_absent_aux i r A h.1,
CType.substDimExpr.params_of_absent i r rest h.2] CType.substDimExpr.params_of_absent i r rest h.2]
end end
/-- Generalised: when `i` is absent from `A`, substituting `i` by any `DimExpr` /-- Generalised: when `i` is absent from `A`, substituting `i` by any
leaves `A` unchanged. Equivalently: line reversal (via `i := inv i`) is `DimExpr` leaves `A` unchanged. -/
a no-op on constant-in-`i` types — the fact that makes `vTranspInv` reduce theorem CType.substDimExpr_of_absent { : ULevel} (i : DimVar) (r : DimExpr)
to identity in the constant-domain case. -/ (A : CType ) (h : CType.dimAbsent i A = true) :
theorem CType.substDimExpr_of_absent (i : DimVar) (r : DimExpr) (A : CType) CType.substDimExpr i r A = A :=
(h : CType.dimAbsent i A = true) : CType.substDimExpr i r A = A :=
CType.substDimExpr_absent_aux i r A h CType.substDimExpr_absent_aux i r A h
-- ── Constancy: at0 = at1 when binder is absent ─────────────────────────────── -- ── 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) : (h : CType.dimAbsent i A = true) :
(DimLine.const A i).at0 = (DimLine.const A i).at1 := by (DimLine.const A i).at0 = (DimLine.const A i).at1 := by
simp [DimLine.const_at0, DimLine.const_at1, simp [DimLine.const_at0, DimLine.const_at1,
@ -450,7 +513,7 @@ theorem DimLine.const_endpoints_eq (A : CType) (i : DimVar)
-- ── Face connection ─────────────────────────────────────────────────────────── -- ── Face connection ───────────────────────────────────────────────────────────
/-- On the (eq0 i) face, the line evaluates to at0. -/ /-- 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) : (h : (FaceFormula.eq0 L.binder).eval env = true) :
L.atBool (env L.binder) = L.at0 := by L.atBool (env L.binder) = L.at0 := by
simp only [FaceFormula.eval] at h simp only [FaceFormula.eval] at h
@ -459,7 +522,7 @@ theorem DimLine.atBool_eq0_face (L : DimLine) (env : DimVar → Bool)
| true => simp [hb] at h | true => simp [hb] at h
/-- On the (eq1 i) face, the line evaluates to at1. -/ /-- 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) : (h : (FaceFormula.eq1 L.binder).eval env = true) :
L.atBool (env L.binder) = L.at1 := by L.atBool (env L.binder) = L.at1 := by
simp only [FaceFormula.eval] at h simp only [FaceFormula.eval] at h
@ -468,7 +531,7 @@ theorem DimLine.atBool_eq1_face (L : DimLine) (env : DimVar → Bool)
| true => simp [DimLine.atBool, DimLine.at1] | true => simp [DimLine.atBool, DimLine.at1]
/-- For any environment, atBool gives either at0 or 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 L.atBool (env L.binder) = L.at0 L.atBool (env L.binder) = L.at1 := by
cases env L.binder cases env L.binder
· left; rfl · left; rfl
@ -566,6 +629,14 @@ mutual
CTerm.dimAbsent_after_substDim_aux i r hr motive, CTerm.dimAbsent_after_substDim_aux i r hr motive,
CTerm.dimAbsent.branches_after_substDim i r hr branches, CTerm.dimAbsent.branches_after_substDim i r hr branches,
CTerm.dimAbsent_after_substDim_aux i r hr target, Bool.and_self] CTerm.dimAbsent_after_substDim_aux i r hr target, Bool.and_self]
| .code _ => by simp [CTerm.substDim, CTerm.dimAbsent]
| .modalIntro _ a => by
simp only [CTerm.substDim, CTerm.dimAbsent,
CTerm.dimAbsent_after_substDim_aux i r hr a]
| .modalElim _ f m => by
simp only [CTerm.substDim, CTerm.dimAbsent,
CTerm.dimAbsent_after_substDim_aux i r hr f,
CTerm.dimAbsent_after_substDim_aux i r hr m, Bool.and_self]
/-- Helper: `i` is absent from every clause in the result of substituting /-- Helper: `i` is absent from every clause in the result of substituting
`i := r` in a clause list (provided `r` doesn't mention `i`). -/ `i := r` in a clause list (provided `r` doesn't mention `i`). -/
@ -614,10 +685,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. -- Step 3: after CType.substDim i b, i is absent from the type.
mutual mutual
private def CType.dimAbsent_after_substDim_aux (i : DimVar) (b : Bool) : private def CType.dimAbsent_after_substDim_aux { : ULevel} (i : DimVar) (b : Bool) :
(A : CType) → (A.substDim i b).dimAbsent i = true (A : CType ) → (A.substDim i b).dimAbsent i = true
| .univ => rfl | .univ => rfl
| .pi A B => by | .pi _ A B => by
simp only [CType.substDim, CType.dimAbsent, simp only [CType.substDim, CType.dimAbsent,
CType.dimAbsent_after_substDim_aux i b A, CType.dimAbsent_after_substDim_aux i b A,
CType.dimAbsent_after_substDim_aux i b B, Bool.and_self] CType.dimAbsent_after_substDim_aux i b B, Bool.and_self]
@ -626,7 +697,7 @@ mutual
CType.dimAbsent_after_substDim_aux i b A, CType.dimAbsent_after_substDim_aux i b A,
CTerm.dimAbsent_after_substDimBool i b a, CTerm.dimAbsent_after_substDimBool i b a,
CTerm.dimAbsent_after_substDimBool i b t, Bool.and_self] CTerm.dimAbsent_after_substDimBool i b t, Bool.and_self]
| .sigma A B => by | .sigma _ A B => by
simp only [CType.substDim, CType.dimAbsent, simp only [CType.substDim, CType.dimAbsent,
CType.dimAbsent_after_substDim_aux i b A, CType.dimAbsent_after_substDim_aux i b A,
CType.dimAbsent_after_substDim_aux i b B, Bool.and_self] CType.dimAbsent_after_substDim_aux i b B, Bool.and_self]
@ -644,20 +715,30 @@ mutual
| .ind S params => by | .ind S params => by
simp only [CType.substDim, CType.dimAbsent, simp only [CType.substDim, CType.dimAbsent,
CType.dimAbsent.params_after_substDim i b params] 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]
| .El P => by
simp only [CType.substDim, CType.dimAbsent]
exact CTerm.dimAbsent_after_substDimBool i b P
| .modal _ 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`. -/ /-- Helper: `i` absent from every CType in `substDim.params i b ps`. -/
private def CType.dimAbsent.params_after_substDim (i : DimVar) (b : Bool) : 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 CType.dimAbsent.params i (CType.substDim.params i b params) = true
| [] => rfl | [] => rfl
| A :: rest => by | ⟨_, A⟩ :: rest => by
simp only [CType.substDim.params, CType.dimAbsent.params, simp only [CType.substDim.params, CType.dimAbsent.params,
CType.dimAbsent_after_substDim_aux i b A, CType.dimAbsent_after_substDim_aux i b A,
CType.dimAbsent.params_after_substDim i b rest, Bool.and_self] CType.dimAbsent.params_after_substDim i b rest, Bool.and_self]
end end
theorem CType.dimAbsent_after_substDim (i : DimVar) (b : Bool) (A : CType) : theorem CType.dimAbsent_after_substDim { : ULevel} (i : DimVar) (b : Bool)
(A.substDim i b).dimAbsent i = true := (A : CType ) : (A.substDim i b).dimAbsent i = true :=
CType.dimAbsent_after_substDim_aux i b A CType.dimAbsent_after_substDim_aux i b A
-- Step 4: idempotence. -- Step 4: idempotence.
@ -668,7 +749,7 @@ theorem CTerm.substDimBool_idem (i : DimVar) (b : Bool) (t : CTerm) :
(t.substDimBool i b).substDimBool i b = t.substDimBool i b := (t.substDimBool i b).substDimBool i b = t.substDimBool i b :=
CTerm.substDimBool_of_absent i b _ (CTerm.dimAbsent_after_substDimBool i b t) 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 := (A.substDim i b).substDim i b = A.substDim i b :=
CType.substDim_of_absent i b _ (CType.dimAbsent_after_substDim i b A) CType.substDim_of_absent i b _ (CType.dimAbsent_after_substDim i b A)
@ -804,6 +885,16 @@ mutual
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi motive · exact CTerm.substDim_comm_aux i j r s hij hrj hsi motive
· exact CTerm.substDim.branches_comm_aux i j r s hij hrj hsi branches · exact CTerm.substDim.branches_comm_aux i j r s hij hrj hsi branches
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi target · exact CTerm.substDim_comm_aux i j r s hij hrj hsi target
| .code _ => rfl
| .modalIntro k a => by
simp only [CTerm.substDim]
exact congrArg (CTerm.modalIntro k)
(CTerm.substDim_comm_aux i j r s hij hrj hsi a)
| .modalElim _ f m => by
simp only [CTerm.substDim]
congr 1
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi f
· exact CTerm.substDim_comm_aux i j r s hij hrj hsi m
/-- Helper: `substDim.clauses` commutes on disjoint dim variables. -/ /-- Helper: `substDim.clauses` commutes on disjoint dim variables. -/
private def CTerm.substDim.clauses_comm_aux private def CTerm.substDim.clauses_comm_aux
@ -860,13 +951,13 @@ theorem CTerm.substDimBool_comm
-- CType commutativity -- CType commutativity
mutual mutual
private def CType.substDim_comm_aux private def CType.substDim_comm_aux { : ULevel}
(i j : DimVar) (b c : Bool) (hij : i ≠ j) : (i j : DimVar) (b c : Bool) (hij : i ≠ j) :
(A : CType) → (A : CType ) →
(A.substDim i b).substDim j c = (A.substDim i b).substDim j c =
(A.substDim j c).substDim i b (A.substDim j c).substDim i b
| .univ => rfl | .univ => rfl
| .pi A B => by | .pi var A B => by
simp only [CType.substDim] simp only [CType.substDim]
rw [CType.substDim_comm_aux i j b c hij A, rw [CType.substDim_comm_aux i j b c hij A,
CType.substDim_comm_aux i j b c hij B] CType.substDim_comm_aux i j b c hij B]
@ -875,7 +966,7 @@ mutual
rw [CType.substDim_comm_aux i j b c hij A, 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 a,
CTerm.substDimBool_comm i j b c hij t] CTerm.substDimBool_comm i j b c hij t]
| .sigma A B => by | .sigma var A B => by
simp only [CType.substDim] simp only [CType.substDim]
rw [CType.substDim_comm_aux i j b c hij A, rw [CType.substDim_comm_aux i j b c hij A,
CType.substDim_comm_aux i j b c hij B] CType.substDim_comm_aux i j b c hij B]
@ -894,23 +985,37 @@ mutual
simp only [CType.substDim] simp only [CType.substDim]
exact congrArg (CType.ind S) exact congrArg (CType.ind S)
(CType.substDim.params_comm_aux i j b c hij params) (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
| .El P => by
simp only [CType.substDim]
congr 1
exact CTerm.substDimBool_comm i j b c hij P
| .modal _ 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 private def CType.substDim.params_comm_aux
(i j : DimVar) (b c : Bool) (hij : i ≠ j) : (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 j c (CType.substDim.params i b params) =
CType.substDim.params i b (CType.substDim.params j c params) CType.substDim.params i b (CType.substDim.params j c params)
| [] => rfl | [] => rfl
| A :: rest => by | ⟨ℓ, A⟩ :: rest => by
simp only [CType.substDim.params] simp only [CType.substDim.params]
congr 1 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 · exact CType.substDim.params_comm_aux i j b c hij rest
end end
theorem CType.substDim_comm theorem CType.substDim_comm { : ULevel}
(i j : DimVar) (b c : Bool) (hij : i ≠ j) (A : CType) : (i j : DimVar) (b c : Bool) (hij : i ≠ j) (A : CType ) :
(A.substDim i b).substDim j c = (A.substDim i b).substDim j c =
(A.substDim j c).substDim i b := (A.substDim j c).substDim i b :=
CType.substDim_comm_aux i j b c hij A CType.substDim_comm_aux i j b c hij A

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.Equiv CubicalTransport.Equiv
===================== =====================
Half-adjoint equivalences between cubical types (cells-spec §5.8). 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). the calling context (e.g., a `HasType` derivation or a `.glue` face).
This matches CCHM's treatment where `idEquiv` is universe-polymorphic This matches CCHM's treatment where `idEquiv` is universe-polymorphic
and the type is inferred. -/ and the type is inferred. -/
def idEquiv (_A : CType) : EquivData := def idEquiv { : ULevel} (_A : CType ) : EquivData :=
let x := EquivData.idEquivVar let x := EquivData.idEquivVar
let e := EquivData.idEquivDim let e := EquivData.idEquivDim
let eo := EquivData.idEquivDimOuter let eo := EquivData.idEquivDimOuter
@ -103,30 +103,30 @@ def idEquiv (_A : CType) : EquivData :=
namespace idEquiv namespace idEquiv
theorem f_def (A : CType) : theorem f_def { : ULevel} (A : CType ) :
(idEquiv A).f = .lam EquivData.idEquivVar (.var EquivData.idEquivVar) := rfl (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 (idEquiv A).fInv = .lam EquivData.idEquivVar (.var EquivData.idEquivVar) := rfl
theorem sec_def (A : CType) : theorem sec_def { : ULevel} (A : CType ) :
(idEquiv A).sec = (idEquiv A).sec =
.lam EquivData.idEquivVar .lam EquivData.idEquivVar
(.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl (.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl
theorem ret_def (A : CType) : theorem ret_def { : ULevel} (A : CType ) :
(idEquiv A).ret = (idEquiv A).ret =
.lam EquivData.idEquivVar .lam EquivData.idEquivVar
(.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl (.plam EquivData.idEquivDim (.var EquivData.idEquivVar)) := rfl
theorem coh_def (A : CType) : theorem coh_def { : ULevel} (A : CType ) :
(idEquiv A).coh = (idEquiv A).coh =
.lam EquivData.idEquivVar .lam EquivData.idEquivVar
(.plam EquivData.idEquivDimOuter (.plam EquivData.idEquivDimOuter
(.plam EquivData.idEquivDimInner (.var EquivData.idEquivVar))) := rfl (.plam EquivData.idEquivDimInner (.var EquivData.idEquivVar))) := rfl
/-- `idEquiv` is constant in its type argument up to the five component terms. -/ /-- `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).f = (idEquiv B).f ∧
(idEquiv A).fInv = (idEquiv B).fInv ∧ (idEquiv A).fInv = (idEquiv B).fInv ∧
(idEquiv A).sec = (idEquiv B).sec ∧ (idEquiv A).sec = (idEquiv B).sec ∧
@ -145,57 +145,40 @@ end idEquiv
namespace idEquiv namespace idEquiv
/-- `(idEquiv A).f : A → A`. -/ /-- `(idEquiv A).f : A → A`. -/
theorem hasType_f (Γ : Ctx) (A : CType) : theorem hasType_f { : ULevel} (Γ : Ctx) (A : CType ) :
HasType Γ (idEquiv A).f (.pi A A) := by HasType Γ (idEquiv A).f (.pi "_" A A) := by
show HasType Γ (.lam EquivData.idEquivVar (.var EquivData.idEquivVar)) (.pi A A) show HasType Γ (.lam EquivData.idEquivVar (.var EquivData.idEquivVar)) (.pi "_" A A)
exact HasType.lam (HasType.var (by simp)) exact HasType.lam (HasType.var (by simp))
/-- `(idEquiv A).fInv : A → A`. -/ /-- `(idEquiv A).fInv : A → A`. -/
theorem hasType_fInv (Γ : Ctx) (A : CType) : theorem hasType_fInv { : ULevel} (Γ : Ctx) (A : CType ) :
HasType Γ (idEquiv A).fInv (.pi A A) := HasType Γ (idEquiv A).fInv (.pi "_" A A) :=
hasType_f Γ A hasType_f Γ A
/-- `(idEquiv A).sec : A → Path A x x` (reflexivity at the bound variable). /-- `(idEquiv A).sec : A → Path A x x` (reflexivity at the bound variable). -/
theorem hasType_sec_refl { : ULevel} (Γ : Ctx) (A : CType ) :
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) :
HasType Γ (idEquiv A).sec HasType Γ (idEquiv A).sec
(.pi A (.path A (.pi "_" A (.path A
(CTerm.var EquivData.idEquivVar) (CTerm.var EquivData.idEquivVar)
(CTerm.var EquivData.idEquivVar))) := by (CTerm.var EquivData.idEquivVar))) := by
show HasType Γ show HasType Γ
(.lam EquivData.idEquivVar (.lam EquivData.idEquivVar
(.plam EquivData.idEquivDim (.var EquivData.idEquivVar))) (.plam EquivData.idEquivDim (.var EquivData.idEquivVar)))
(.pi A (.path A (.var EquivData.idEquivVar) (.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.
exact HasType.lam (HasType.plam (HasType.var (by simp))) exact HasType.lam (HasType.plam (HasType.var (by simp)))
/-- `(idEquiv A).ret : A → Path A x x`. -/ /-- `(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 HasType Γ (idEquiv A).ret
(.pi A (.path A (.pi "_" A (.path A
(CTerm.var EquivData.idEquivVar) (CTerm.var EquivData.idEquivVar)
(CTerm.var EquivData.idEquivVar))) := (CTerm.var EquivData.idEquivVar))) :=
hasType_sec_refl Γ A hasType_sec_refl Γ A
/-- `(idEquiv A).coh : A → Path (Path A x x) (⟨ei⟩ x) (⟨ei⟩ x)`. /-- `(idEquiv A).coh : A → Path (Path A x x) (⟨ei⟩ x) (⟨ei⟩ x)`. -/
theorem hasType_coh_refl_refl { : ULevel} (Γ : Ctx) (A : CType ) :
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) :
HasType Γ (idEquiv A).coh HasType Γ (idEquiv A).coh
(.pi A (.pi "_" A
(.path (.path
(.path A (.path A
(CTerm.var EquivData.idEquivVar) (CTerm.var EquivData.idEquivVar)

View file

@ -1,8 +1,8 @@
/- /-
Topolei.Cubical.Eval CubicalTransport.Eval
==================== ====================
Environment-based evaluator for the cubical calculus (cells-spec §5.4, 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`. `eval env t` reduces `t` to weak-head normal form in environment `env`.
Three mutually-recursive pieces: Three mutually-recursive pieces:
@ -20,40 +20,48 @@
result is the same `CTerm` size, but Lean's structural recursion can't see 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 through that. A future total version will measure on a subject-reduction
metric. For now, `partial def` is the honest choice. 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.Value
import CubicalTransport.Transport import CubicalTransport.Transport
-- ── Rust FFI declarations (Phase C.2) ────────────────────────────────────── -- ── 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 -- entry point. `@[implemented_by]` on each partial def routes runtime
-- calls to Rust (kernel-level proof reasoning still uses the axioms). -- 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 opaque evalRust (env : CEnv) : CTerm → CVal
@[extern "topolei_cubical_vapp"] @[extern "cubical_transport_vapp"]
opaque vAppRust : CVal → CVal → CVal opaque vAppRust : CVal → CVal → CVal
@[extern "topolei_cubical_vpapp"] @[extern "cubical_transport_vpapp"]
opaque vPAppRust : CVal → DimExpr → CVal opaque vPAppRust : CVal → DimExpr → CVal
@[extern "topolei_cubical_vhcomp"] @[extern "cubical_transport_vhcomp"]
opaque vHCompValueRust (A : CType) (φ : FaceFormula) (tube base : CVal) : CVal opaque vHCompValueRust { : ULevel} (A : CType ) (φ : FaceFormula) (tube base : CVal) : CVal
@[extern "topolei_cubical_vcomp_term"] @[extern "cubical_transport_vcomp_term"]
opaque vCompAtTermRust (env : CEnv) (i : DimVar) (A : CType) opaque vCompAtTermRust { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(φ : FaceFormula) (u t : CTerm) : CVal (φ : FaceFormula) (u t : CTerm) : CVal
@[extern "topolei_cubical_vcompn_term"] @[extern "cubical_transport_vcompn_term"]
opaque vCompNAtTermRust (env : CEnv) (i : DimVar) (A : CType) opaque vCompNAtTermRust { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(clauses : List (FaceFormula × CTerm)) (t : CTerm) : CVal (clauses : List (FaceFormula × CTerm)) (t : CTerm) : CVal
@[extern "topolei_cubical_vfst"] @[extern "cubical_transport_vfst"]
opaque vFstRust : CVal → CVal opaque vFstRust : CVal → CVal
@[extern "topolei_cubical_vsnd"] @[extern "cubical_transport_vsnd"]
opaque vSndRust : CVal → CVal opaque vSndRust : CVal → CVal
mutual mutual
@ -121,6 +129,8 @@ mutual
| .snd t => vSnd (eval env t) | .snd t => vSnd (eval env t)
-- REL1 inductive-type constructors. -- REL1 inductive-type constructors.
| .dimExpr r => .vdimExpr r | .dimExpr r => .vdimExpr r
-- Universe-code constructor (CCHM §6 universe codes).
| .code A => .vcode A
| .ctor S c params args => | .ctor S c params args =>
-- Produce a canonical constructor value with all args evaluated. -- Produce a canonical constructor value with all args evaluated.
-- (Boundary firing for path ctors lands in a follow-up — REL1 -- (Boundary firing for path ctors lands in a follow-up — REL1
@ -151,6 +161,21 @@ mutual
(branches.map (fun (nm, b) => (nm, eval env b))) n) (branches.map (fun (nm, b) => (nm, eval env b))) n)
| _ => | _ =>
.vneu (.nvar "<indElim: target is not canonical>") .vneu (.nvar "<indElim: target is not canonical>")
-- Modal introduction: structural lift to the corresponding value form.
| .modalIntro k a => .vModalIntro k (eval env a)
-- Modal elimination: β-reduce on a same-kind intro value form;
-- mismatched-kind intros (which a well-typed source cannot produce
-- but a bypassed typechecker conceivably could) are kept stuck via
-- a marker-neutral. Otherwise produce a stuck neutral that
-- preserves the modality kind, the evaluated eliminator function,
-- and the (necessarily-stuck) scrutinee neutral.
| .modalElim k f m =>
match eval env m with
| .vModalIntro k' a =>
if k = k' then vApp (eval env f) a
else .vneu (.nvar "<modalElim: kind mismatch>")
| .vneu n => .vneu (.nModalElim k (eval env f) n)
| _ => .vneu (.nvar "<modalElim: scrutinee is not modal-canonical>")
/-- First projection at the value level. β-reduces `vpair`; pushes a /-- First projection at the value level. β-reduces `vpair`; pushes a
stuck neutral into `nfst`. Projecting any other value shape is a stuck neutral into `nfst`. Projecting any other value shape is a
@ -210,6 +235,8 @@ mutual
| .vpair _ _, _ => .vneu (.nvar "<vApp: vpair applied as function>") | .vpair _ _, _ => .vneu (.nvar "<vApp: vpair applied as function>")
| .vctor _ _ _ _, _ => .vneu (.nvar "<vApp: vctor applied as function>") | .vctor _ _ _ _, _ => .vneu (.nvar "<vApp: vctor applied as function>")
| .vdimExpr _, _ => .vneu (.nvar "<vApp: vdimExpr applied as function>") | .vdimExpr _, _ => .vneu (.nvar "<vApp: vdimExpr applied as function>")
| .vcode _, _ => .vneu (.nvar "<vApp: vcode applied as function>")
| .vModalIntro _ _, _ => .vneu (.nvar "<vApp: vModalIntro applied as function>")
/-- Apply a value to a dimension expression. β-reduces `vplam` closures /-- Apply a value to a dimension expression. β-reduces `vplam` closures
by substituting the dim in the body and re-evaluating; pushes stuck by substituting the dim in the body and re-evaluating; pushes stuck
@ -242,6 +269,8 @@ mutual
| .vpair _ _, _ => .vneu (.nvar "<vPApp: vpair applied as path>") | .vpair _ _, _ => .vneu (.nvar "<vPApp: vpair applied as path>")
| .vctor _ _ _ _, _ => .vneu (.nvar "<vPApp: vctor applied as path>") | .vctor _ _ _ _, _ => .vneu (.nvar "<vPApp: vctor applied as path>")
| .vdimExpr _, _ => .vneu (.nvar "<vPApp: vdimExpr applied as path>") | .vdimExpr _, _ => .vneu (.nvar "<vPApp: vdimExpr applied as path>")
| .vcode _, _ => .vneu (.nvar "<vPApp: vcode applied as path>")
| .vModalIntro _ _, _ => .vneu (.nvar "<vPApp: vModalIntro applied as path>")
/-- Homogeneous composition at the value level. The type `A` is /-- Homogeneous composition at the value level. The type `A` is
*homogeneous* (doesn't vary along `i`); the tube and base are *homogeneous* (doesn't vary along `i`); the tube and base are
@ -257,14 +286,14 @@ mutual
Note the crucial difference from `vTransp`: no constant-line check, Note the crucial difference from `vTransp`: no constant-line check,
because hcomp is *already* homogeneous — constancy is built in. -/ because hcomp is *already* homogeneous — constancy is built in. -/
@[implemented_by vHCompValueRust] @[implemented_by vHCompValueRust]
partial def vHCompValue (A : CType) (φ : FaceFormula) (tube base : CVal) : partial def vHCompValue { : ULevel} (A : CType ) (φ : FaceFormula)
CVal := (tube base : CVal) : CVal :=
match φ with match φ with
| .top => vPApp tube .one | .top => vPApp tube .one
| _ => | _ =>
match A with match A with
| .pi _domA codA => .vHCompFun codA φ tube base | .pi _ _domA codA => .vHCompFun codA φ tube base
| _ => .vneu (.nhcomp A φ tube base) | _ => .vneu (.nhcomp A φ tube base)
/-- Heterogeneous composition at the term level. Takes `u` and `t` as /-- Heterogeneous composition at the term level. Takes `u` and `t` as
`CTerm`s (not `CVal`s) so that the `comp_full` reduction can perform `CTerm`s (not `CVal`s) so that the `comp_full` reduction can perform
@ -284,7 +313,7 @@ mutual
`φ`; case (3) discriminates on `A` only after `.top`/`.bot` are `φ`; case (3) discriminates on `A` only after `.top`/`.bot` are
ruled out. All four cases are mutually exclusive. -/ ruled out. All four cases are mutually exclusive. -/
@[implemented_by vCompAtTermRust] @[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 := (φ : FaceFormula) (u t : CTerm) : CVal :=
match φ with match φ with
| .top => eval env (u.substDim i .one) | .top => eval env (u.substDim i .one)
@ -296,7 +325,7 @@ mutual
vHCompValue A φ (eval env (.plam i u)) (eval env t) vHCompValue A φ (eval env (.plam i u)) (eval env t)
else else
match A with match A with
| .pi domA codA => | .pi _ domA codA =>
-- Hetero Π comp: package into a `vCompFun` closure. The CCHM -- Hetero Π comp: package into a `vCompFun` closure. The CCHM
-- β-rule runs at `vApp`-time with a full fill-based tube. -- β-rule runs at `vApp`-time with a full fill-based tube.
.vCompFun env i domA codA φ u t .vCompFun env i domA codA φ u t
@ -314,7 +343,7 @@ mutual
· Otherwise produce a stuck `ncompN` neutral preserving env, line · Otherwise produce a stuck `ncompN` neutral preserving env, line
binder, type, evaluated clauses, and evaluated base. -/ binder, type, evaluated clauses, and evaluated base. -/
@[implemented_by vCompNAtTermRust] @[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 := (clauses : List (FaceFormula × CTerm)) (t : CTerm) : CVal :=
-- Scan for a `.top` clause first. -- Scan for a `.top` clause first.
match clauses.find? (fun ⟨φ, _⟩ => match φ with | .top => true | _ => false) with match clauses.find? (fun ⟨φ, _⟩ => match φ with | .top => true | _ => false) with
@ -333,32 +362,54 @@ mutual
end end
/-! /-!
## Reduction lemmas (axioms) ## Reduction lemmas
`partial def` is opaque at the kernel level, so the defining cases of `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 `eval`, `vApp`, `vPApp`, `vTransp`, `vHCompValue`, `vCompAtTerm`, etc. are
axioms — the same pattern used for `CTerm.step` and `step_papp_plam` in not reducible by `rfl` and have no auto-generated unfolding equations.
`Syntax.lean`. They exactly mirror the `partial def` match arms above,
so they are consistent with the runtime implementation while also being **Axiom-debt cleanup (REL2 follow-up).** These were previously declared
usable in kernel-level proofs. as `axiom`s mirroring each match arm. They are now `theorem ... := by
sorry` annotated to **FS-H15** in `topolei/docs/HYPOTHESES.md` — the
partial-def-reduction-equations umbrella. The discharge route is to
convert the `partial def`s to total `def`s with a termination metric
(e.g. CTerm-tree depth + a `Nat` fuel parameter), at which point each
theorem becomes `rfl` / `simp [eval, vApp, ...]`. Conversion `axiom →
sorry` is a strict trust-footprint improvement: TODO marker rather than
ground truth.
Each match arm of `eval`/`vApp`/`vPApp`/etc. above corresponds to one
theorem below; the type signatures still document the arm's reduction
shape, and the arms remain mutually exclusive by precondition so the
collection is consistent.
-/ -/
-- Reduction lemmas for `eval`. -- Reduction lemmas for `eval`.
axiom eval_var (env : CEnv) (x : String) : theorem eval_var (env : CEnv) (x : String) :
eval env (.var x) = (env.lookup x).getD (.vneu (.nvar x)) eval env (.var x) = (env.lookup x).getD (.vneu (.nvar x)) := by
-- waits on: FS-H15.
sorry
axiom eval_lam (env : CEnv) (x : String) (body : CTerm) : theorem eval_lam (env : CEnv) (x : String) (body : CTerm) :
eval env (.lam x body) = .vlam env x body eval env (.lam x body) = .vlam env x body := by
-- waits on: FS-H15.
sorry
axiom eval_app (env : CEnv) (f a : CTerm) : theorem eval_app (env : CEnv) (f a : CTerm) :
eval env (.app f a) = vApp (eval env f) (eval env a) eval env (.app f a) = vApp (eval env f) (eval env a) := by
-- waits on: FS-H15.
sorry
axiom eval_plam (env : CEnv) (i : DimVar) (body : CTerm) : theorem eval_plam (env : CEnv) (i : DimVar) (body : CTerm) :
eval env (.plam i body) = .vplam env i body eval env (.plam i body) = .vplam env i body := by
-- waits on: FS-H15.
sorry
axiom eval_papp (env : CEnv) (t : CTerm) (r : DimExpr) : theorem eval_papp (env : CEnv) (t : CTerm) (r : DimExpr) :
eval env (.papp t r) = vPApp (eval env t) r eval env (.papp t r) = vPApp (eval env t) r := by
-- waits on: FS-H15.
sorry
/-! /-!
### `eval` on `.transp` — four disjoint cases ### `eval` on `.transp` — four disjoint cases
@ -372,16 +423,20 @@ The four cases are mutually exclusive by precondition, so the axiom set
is consistent. -/ is consistent. -/
/-- (1) T1 at eval level: transport under a full face is identity. -/ /-- (1) T1 at eval level: transport under a full face is identity. -/
axiom eval_transp_top (env : CEnv) (i : DimVar) (A : CType) (t : CTerm) : theorem eval_transp_top { : ULevel} (env : CEnv) (i : DimVar) (A : CType ) (t : CTerm) :
eval env (.transp i A .top t) = eval env t eval env (.transp i A .top t) = eval env t := by
-- waits on: FS-H15.
sorry
/-- (2) T2 at eval level: transport along a constant line is identity. /-- (2) T2 at eval level: transport along a constant line is identity.
Covers `.univ`, constant-`pi`, and constant-`path` lines uniformly. -/ Covers `.univ`, constant-`pi`, and constant-`path` lines uniformly. -/
axiom eval_transp_const (env : CEnv) (i : DimVar) (A : CType) theorem eval_transp_const { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(φ : FaceFormula) (t : CTerm) (φ : FaceFormula) (t : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i A = true) : (hA : CType.dimAbsent i A = true) :
eval env (.transp i A φ t) = eval env t eval env (.transp i A φ t) = eval env t := by
-- waits on: FS-H15.
sorry
/-- (3) Path transport: when the line's body is `.path A₀ a b` with the /-- (3) Path transport: when the line's body is `.path A₀ a b` with the
whole path-line genuinely varying, produce a `vPathTransp` closure whole path-line genuinely varying, produce a `vPathTransp` closure
@ -389,56 +444,74 @@ axiom eval_transp_const (env : CEnv) (i : DimVar) (A : CType)
path term `t` (kept as a CTerm so later `.papp t r` constructions path term `t` (kept as a CTerm so later `.papp t r` constructions
work for the multi-clause reduction at generic dim). Reduces work for the multi-clause reduction at generic dim). Reduces
further under `vPApp` at endpoints. -/ further under `vPApp` at endpoints. -/
axiom eval_transp_path (env : CEnv) (i : DimVar) (A₀ : CType) theorem eval_transp_path { : ULevel} (env : CEnv) (i : DimVar) (A₀ : CType )
(a b : CTerm) (φ : FaceFormula) (t : CTerm) (a b : CTerm) (φ : FaceFormula) (t : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i (.path A₀ a b) = false) : (hA : CType.dimAbsent i (.path A₀ a b) = false) :
eval env (.transp i (.path A₀ a b) φ t) = eval env (.transp i (.path A₀ a b) φ t) =
.vPathTransp env i A₀ a b φ t .vPathTransp env i A₀ a b φ t := by
-- waits on: FS-H15.
sorry
/-- (4) Non-path non-glue non-constant transport: delegate to the value-level /-- (4) Non-path non-glue non-constant transport: delegate to the value-level
`vTransp`, which is env-agnostic and handles `.pi` via `vTranspFun`. `vTransp`, which is env-agnostic and handles `.pi` via `vTranspFun`.
`.glue` is excluded because its CCHM transport formula lives in dedicated `.glue` is excluded because its CCHM transport formula lives in dedicated
Glue-specific axioms (see `Glue.lean`); routing it through `vTransp` Glue-specific axioms (see `Glue.lean`); routing it through `vTransp`
here would claim it reduces to a stuck neutral, which would contradict here would claim it reduces to a stuck neutral, which would contradict
those axioms in their specific sub-cases. -/ those axioms in their specific sub-cases.
axiom eval_transp_nonpath (env : CEnv) (i : DimVar) (A : CType)
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. -/
theorem eval_transp_nonpath { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(φ : FaceFormula) (t : CTerm) (φ : FaceFormula) (t : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i A = false) (hA : CType.dimAbsent i A = false)
(h_not_path : ∀ A₀ a b, A ≠ .path A₀ a b) (h_not_path : ∀ (A₀ : CType ) (a b : CTerm), A ≠ .path A₀ a b)
(h_not_glue : ∀ φG T f fInv sec ret coh Ai, (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) : A ≠ .glue φG T f fInv sec ret coh Ai) :
eval env (.transp i A φ t) = vTransp i A φ (eval env t) eval env (.transp i A φ t) = vTransp i A φ (eval env t) := by
-- waits on: FS-H15.
sorry
/-- Π-case theorem (full CCHM): transport along any `pi domA codA` line /-- Π-case theorem (full CCHM): transport along any `pi domA codA` line
produces a `vTranspFun` closure. Derived via `eval_transp_nonpath` produces a `vTranspFun` closure. Derived via `eval_transp_nonpath`
(`pi ≠ path` and `pi ≠ glue` by constructor disjointness) plus (`pi ≠ path` and `pi ≠ glue` by constructor disjointness) plus
`vTransp_pi`. -/ `vTransp_pi`. -/
theorem eval_transp_pi (env : CEnv) (i : DimVar) theorem eval_transp_pi { ' : ULevel} (env : CEnv) (i : DimVar)
(domA codA : CType) (φ : FaceFormula) (t : CTerm) (var : String) (domA : CType ) (codA : CType ') (φ : FaceFormula) (t : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i (.pi domA codA) = false) : (hA : CType.dimAbsent i (.pi var domA codA) = false) :
eval env (.transp i (.pi domA codA) φ t) = eval env (.transp i (.pi var domA codA) φ t) =
.vTranspFun i domA codA φ (eval env t) := by .vTranspFun i domA codA φ (eval env t) := by
rw [eval_transp_nonpath env i _ φ t hφ hA rw [eval_transp_nonpath env i _ φ t hφ hA
(by intro _ _ _ h; nomatch h) (by intro _ _ _ h; nomatch h)
(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 /-- Stuck fallback theorem. In our current `CType` universe
`{univ, pi, path, glue}`, this never actually fires in practice: `univ` `{univ, pi, path, glue, ind, interval, lift}`, this never actually
always has `dimAbsent = true`, so the const case wins; `pi` is handled fires in practice: `univ`/`interval` always have `dimAbsent = true`,
by `eval_transp_pi`; `path` is handled by `eval_transp_path`; `glue` is so the const case wins; `pi` is handled by `eval_transp_pi`; `path`
handled by the dedicated Glue-transport axioms in `Glue.lean`. Kept is handled by `eval_transp_path`; `glue` is handled by the dedicated
here for parity with `vTransp_stuck` and future CType extensions. -/ Glue-transport axioms in `Glue.lean`. Kept here for parity with
theorem eval_transp_stuck (env : CEnv) (i : DimVar) (A : CType) `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) (φ : FaceFormula) (t : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i A = false) (hA : CType.dimAbsent i A = false)
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA) (h_not_pi : A.skeleton ≠ SkeletalCType.pi)
(h_not_path : ∀ A₀ a b, A ≠ .path A₀ a b) (h_not_path : ∀ (A₀ : CType ) (a b : CTerm), A ≠ .path A₀ a b)
(h_not_glue : ∀ φG T f fInv sec ret coh Ai, (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) : A ≠ .glue φG T f fInv sec ret coh Ai) :
eval env (.transp i A φ t) = eval env (.transp i A φ t) =
.vneu (.ntransp i A φ (eval env t)) := by .vneu (.ntransp i A φ (eval env t)) := by
@ -461,10 +534,12 @@ theorem eval_transp_stuck (env : CEnv) (i : DimVar) (A : CType)
not re-audited. The Rust backend's discharge: a face-normalisation not re-audited. The Rust backend's discharge: a face-normalisation
routine ensures syntactically distinct but semantically equal faces routine ensures syntactically distinct but semantically equal faces
take the same dispatch branch. -/ take the same dispatch branch. -/
axiom eval_transp_face_congr (env : CEnv) (i : DimVar) (A : CType) theorem eval_transp_face_congr { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(φ ψ : FaceFormula) (t : CTerm) (φ ψ : FaceFormula) (t : CTerm)
(h : ∀ ε, φ.eval ε = ψ.eval ε) : (h : ∀ ε, φ.eval ε = ψ.eval ε) :
eval env (.transp i A φ t) = eval env (.transp i A ψ t) eval env (.transp i A φ t) = eval env (.transp i A ψ t) := by
-- waits on: FS-H15.
sorry
/-! /-!
### `eval` on `.comp` — four disjoint cases ### `eval` on `.comp` — four disjoint cases
@ -479,50 +554,65 @@ cases are disjoint by precondition, so the axiom set is consistent.
is *term-level* substitution, not `vPApp` on the evaluated body — 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 `u` may be e.g. a free variable whose value doesn't look like a
function. -/ function. -/
axiom eval_comp_top (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) : theorem 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) eval env (.comp i A .top u t) = eval env (u.substDim i .one) := by
-- waits on: FS-H15.
sorry
/-- **C2 at eval level**: with an empty face, the system contributes /-- **C2 at eval level**: with an empty face, the system contributes
nothing and composition reduces to plain transport. -/ nothing and composition reduces to plain transport. -/
axiom eval_comp_bot (env : CEnv) (i : DimVar) (A : CType) (u t : CTerm) : theorem 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) eval env (.comp i A .bot u t) = eval env (.transp i A .bot t) := by
-- waits on: FS-H15.
sorry
/-- **Constant-line comp = hcomp**: when the type `A` doesn't vary along /-- **Constant-line comp = hcomp**: when the type `A` doesn't vary along
`i`, heterogeneous composition reduces to homogeneous composition on `i`, heterogeneous composition reduces to homogeneous composition on
the (fixed) type `A`. The tube is `.plam i u` — the system body `u` the (fixed) type `A`. The tube is `.plam i u` — the system body `u`
packaged as a dim-closure over the line binder. -/ packaged as a dim-closure over the line binder. -/
axiom eval_comp_const (env : CEnv) (i : DimVar) (A : CType) theorem eval_comp_const { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(φ : FaceFormula) (u t : CTerm) (φ : FaceFormula) (u t : CTerm)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
(hA : CType.dimAbsent i A = true) : (hA : CType.dimAbsent i A = true) :
eval env (.comp i A φ u t) = eval env (.comp i A φ u t) =
vHCompValue A φ (eval env (.plam i u)) (eval env t) vHCompValue A φ (eval env (.plam i u)) (eval env t) := by
-- waits on: FS-H15.
sorry
/-- **Heterogeneous Π comp**: when A is a pi type with a genuinely-varying /-- **Heterogeneous Π comp**: when A is a pi type with a genuinely-varying
line, `vCompAtTerm` packages the comp into a `vCompFun` closure that line, `vCompAtTerm` packages the comp into a `vCompFun` closure that
will run the CCHM β-rule when the function is applied. -/ will run the CCHM β-rule when the function is applied. -/
axiom eval_comp_pi (env : CEnv) (i : DimVar) (domA codA : CType) theorem eval_comp_pi { ' : ULevel} (env : CEnv) (i : DimVar)
(var : String) (domA : CType ) (codA : CType ')
(φ : FaceFormula) (u t : CTerm) (φ : FaceFormula) (u t : CTerm)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
(hA : CType.dimAbsent i (.pi domA codA) = false) : (hA : CType.dimAbsent i (.pi var domA codA) = false) :
eval env (.comp i (.pi domA codA) φ u t) = eval env (.comp i (.pi var domA codA) φ u t) =
.vCompFun env i domA codA φ u t .vCompFun env i domA codA φ u t := by
-- waits on: FS-H15.
sorry
/-- Stuck fallback: `.comp` whose face is neither `.top` nor `.bot`, whose /-- Stuck fallback: `.comp` whose face is neither `.top` nor `.bot`, whose
line genuinely varies, and whose type is neither `.pi` nor a constant line genuinely varies, and whose type is neither `.pi` nor a constant
produces a neutral. -/ produces a neutral. The "not a pi" precondition uses
axiom eval_comp_stuck (env : CEnv) (i : DimVar) (A : CType) `CType.skeleton ≠ .pi` (level-erased constructor tag) to avoid
cross-level HEq elimination. -/
theorem eval_comp_stuck { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(φ : FaceFormula) (u t : CTerm) (φ : FaceFormula) (u t : CTerm)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
(hA : CType.dimAbsent i A = false) (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) = eval env (.comp i A φ u t) =
.vneu (.ncomp i A φ (eval env u) (eval env t)) .vneu (.ncomp i A φ (eval env u) (eval env t)) := by
-- waits on: FS-H15.
sorry
/-- `eval` on `.compN` delegates to `vCompNAtTerm`. -/ /-- `eval` on `.compN` delegates to `vCompNAtTerm`. -/
axiom eval_compN (env : CEnv) (i : DimVar) (A : CType) theorem eval_compN { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(clauses : List (FaceFormula × CTerm)) (t : CTerm) : (clauses : List (FaceFormula × CTerm)) (t : CTerm) :
eval env (.compN i A clauses t) = vCompNAtTerm env i A clauses t eval env (.compN i A clauses t) = vCompNAtTerm env i A clauses t := by
-- waits on: FS-H15.
sorry
/-! /-!
### `vHCompValue` — three disjoint cases ### `vHCompValue` — three disjoint cases
@ -530,32 +620,45 @@ axiom eval_compN (env : CEnv) (i : DimVar) (A : CType)
/-- Homogeneous composition under a full face: the tube covers everything, /-- Homogeneous composition under a full face: the tube covers everything,
and the result is the tube evaluated at `1`. -/ and the result is the tube evaluated at `1`. -/
axiom vHCompValue_top (A : CType) (tube base : CVal) : theorem vHCompValue_top { : ULevel} (A : CType ) (tube base : CVal) :
vHCompValue A .top tube base = vPApp tube .one vHCompValue A .top tube base = vPApp tube .one := by
-- waits on: FS-H15.
sorry
/-- **CCHM Π hcomp rule**: homogeneous composition on a Π type produces /-- **CCHM Π hcomp rule**: homogeneous composition on a Π type produces
a `vHCompFun` closure that applies pointwise when its function is a `vHCompFun` closure that applies pointwise when its function is
applied to an argument. `domA` is stored in the type but unused in 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 the resulting closure because hcomp on the domain is trivial (A is
fixed, not varying). -/ fixed, not varying). -/
axiom vHCompValue_pi (domA codA : CType) (φ : FaceFormula) (tube base : CVal) theorem vHCompValue_pi { ' : ULevel}
(var : String) (domA : CType ) (codA : CType ')
(φ : FaceFormula) (tube base : CVal)
(hφ : φ ≠ .top) : (hφ : φ ≠ .top) :
vHCompValue (.pi domA codA) φ tube base = .vHCompFun codA φ tube base vHCompValue (.pi var domA codA) φ tube base = .vHCompFun codA φ tube base := by
-- waits on: FS-H15.
sorry
/-- Stuck fallback: hcomp on a non-pi type under a non-top face. Uses /-- Stuck fallback: hcomp on a non-pi type under a non-top face. Uses
`nhcomp` (separate from `ncomp` because hcomp's type is fixed). -/ `nhcomp` (separate from `ncomp` because hcomp's type is fixed).
axiom vHCompValue_stuck (A : CType) (φ : FaceFormula) (tube base : CVal) The "not a pi" precondition uses skeleton-disjointness (avoiding HEq). -/
theorem vHCompValue_stuck { : ULevel} (A : CType ) (φ : FaceFormula) (tube base : CVal)
(hφ : φ ≠ .top) (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) vHCompValue A φ tube base = .vneu (.nhcomp A φ tube base) := by
-- waits on: FS-H15.
sorry
-- Reduction lemmas for `vApp`. -- Reduction lemmas for `vApp`.
axiom vApp_vlam (env : CEnv) (x : String) (body : CTerm) (arg : CVal) : theorem vApp_vlam (env : CEnv) (x : String) (body : CTerm) (arg : CVal) :
vApp (.vlam env x body) arg = eval (env.extend x arg) body vApp (.vlam env x body) arg = eval (env.extend x arg) body := by
-- waits on: FS-H15.
sorry
axiom vApp_vneu (n : CNeu) (arg : CVal) : theorem vApp_vneu (n : CNeu) (arg : CVal) :
vApp (.vneu n) arg = .vneu (.napp n arg) vApp (.vneu n) arg = .vneu (.napp n arg) := by
-- waits on: FS-H15.
sorry
/-- Full CCHM Π β-rule at the value level: applying a transported-function /-- Full CCHM Π β-rule at the value level: applying a transported-function
closure to an argument `arg` inversely transports `arg` through the closure to an argument `arg` inversely transports `arg` through the
@ -565,10 +668,13 @@ axiom vApp_vneu (n : CNeu) (arg : CVal) :
When `CType.dimAbsent i domA = true`, `vTranspInv` reduces to identity When `CType.dimAbsent i domA = true`, `vTranspInv` reduces to identity
(by `vTranspInv_const`) and this specialises to the simpler (by `vTranspInv_const`) and this specialises to the simpler
const-domain rule `vTransp i codA φ (vApp f arg)`. -/ const-domain rule `vTransp i codA φ (vApp f arg)`. -/
axiom vApp_vTranspFun (i : DimVar) (domA codA : CType) (φ : FaceFormula) theorem vApp_vTranspFun { ' : ULevel} (i : DimVar)
(domA : CType ) (codA : CType ') (φ : FaceFormula)
(f : CVal) (arg : CVal) : (f : CVal) (arg : CVal) :
vApp (.vTranspFun i domA codA φ f) arg = vApp (.vTranspFun i domA codA φ f) arg =
vTransp i codA φ (vApp f (vTranspInv i domA φ arg)) vTransp i codA φ (vApp f (vTranspInv i domA φ arg)) := by
-- waits on: FS-H15.
sorry
/-- **CCHM Π hcomp β-rule** at the value level: applying a homogeneously /-- **CCHM Π hcomp β-rule** at the value level: applying a homogeneously
composed function closure to `arg` yields hcomp on the codomain with: composed function closure to `arg` yields hcomp on the codomain with:
@ -576,9 +682,12 @@ axiom vApp_vTranspFun (i : DimVar) (domA codA : CType) (φ : FaceFormula)
· base = `base arg`. · base = `base arg`.
No inverse transport — hcomp's type is fixed, so the argument passes No inverse transport — hcomp's type is fixed, so the argument passes
through unchanged. -/ through unchanged. -/
axiom vApp_vHCompFun (codA : CType) (φ : FaceFormula) (tube base arg : CVal) : theorem vApp_vHCompFun { : ULevel} (codA : CType ) (φ : FaceFormula)
(tube base arg : CVal) :
vApp (.vHCompFun codA φ tube base) arg = vApp (.vHCompFun codA φ tube base) arg =
vHCompValue codA φ (.vTubeApp tube arg) (vApp base arg) vHCompValue codA φ (.vTubeApp tube arg) (vApp base arg) := by
-- waits on: FS-H15.
sorry
/-- **Full CCHM Π hetero comp β-rule**: applying `comp^i (pi A B) φ u u₀` to /-- **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` `y : A(1)` unfolds via the *fill* construction. For a fresh dim `$fj`
@ -595,7 +704,8 @@ axiom vApp_vHCompFun (codA : CType) (φ : FaceFormula) (tube base arg : CVal) :
Hygiene assumption: `$y` is not a user variable in `env`, and `$fj` Hygiene assumption: `$y` is not a user variable in `env`, and `$fj`
is not a user DimVar in `domA`, `codA`, `φ`, `u`, `t`. These reserved is not a user DimVar in `domA`, `codA`, `φ`, `u`, `t`. These reserved
names are chosen to minimise collision probability. -/ names are chosen to minimise collision probability. -/
axiom vApp_vCompFun (env : CEnv) (i : DimVar) (domA codA : CType) theorem vApp_vCompFun { ' : ULevel} (env : CEnv) (i : DimVar)
(domA : CType ) (codA : CType ')
(φ : FaceFormula) (u t : CTerm) (arg : CVal) : (φ : FaceFormula) (u t : CTerm) (arg : CVal) :
vApp (.vCompFun env i domA codA φ u t) arg = vApp (.vCompFun env i domA codA φ u t) arg =
eval (env.extend "$y" arg) (.comp i codA φ eval (env.extend "$y" arg) (.comp i codA φ
@ -604,20 +714,28 @@ axiom vApp_vCompFun (env : CEnv) (i : DimVar) (domA codA : CType)
φ (.var "$y"))) φ (.var "$y")))
(.app t (.transp ⟨"$fj"⟩ (.app t (.transp ⟨"$fj"⟩
(domA.substDimExpr i (.inv (.var ⟨"$fj"⟩))) (domA.substDimExpr i (.inv (.var ⟨"$fj"⟩)))
φ (.var "$y")))) φ (.var "$y")))) := by
-- waits on: FS-H15.
sorry
-- Reduction lemmas for `vPApp`. -- Reduction lemmas for `vPApp`.
axiom vPApp_vplam (env : CEnv) (i : DimVar) (body : CTerm) (r : DimExpr) : theorem vPApp_vplam (env : CEnv) (i : DimVar) (body : CTerm) (r : DimExpr) :
vPApp (.vplam env i body) r = eval env (body.substDim i r) vPApp (.vplam env i body) r = eval env (body.substDim i r) := by
-- waits on: FS-H15.
sorry
axiom vPApp_vneu (n : CNeu) (r : DimExpr) : theorem vPApp_vneu (n : CNeu) (r : DimExpr) :
vPApp (.vneu n) r = .vneu (.npapp n r) vPApp (.vneu n) r = .vneu (.npapp n r) := by
-- waits on: FS-H15.
sorry
/-- `vTubeApp tube arg` under dim application reduces to `(tube @ r) arg`. /-- `vTubeApp tube arg` under dim application reduces to `(tube @ r) arg`.
Encodes the semantic meaning of `λj. (tube @ j) arg`. -/ Encodes the semantic meaning of `λj. (tube @ j) arg`. -/
axiom vPApp_vTubeApp (tube arg : CVal) (r : DimExpr) : theorem vPApp_vTubeApp (tube arg : CVal) (r : DimExpr) :
vPApp (.vTubeApp tube arg) r = vApp (vPApp tube r) arg vPApp (.vTubeApp tube arg) r = vApp (vPApp tube r) arg := by
-- waits on: FS-H15.
sorry
/-! /-!
### `vCompNAtTerm` — compound equation mirroring the partial-def arms ### `vCompNAtTerm` — compound equation mirroring the partial-def arms
@ -625,7 +743,7 @@ axiom vPApp_vTubeApp (tube arg : CVal) (r : DimExpr) :
Single axiom exposing the full case analysis so that derived theorems can Single axiom exposing the full case analysis so that derived theorems can
pattern-match on the clause list's structure. -/ pattern-match on the clause list's structure. -/
axiom vCompNAtTerm_def (env : CEnv) (i : DimVar) (A : CType) theorem vCompNAtTerm_def { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(clauses : List (FaceFormula × CTerm)) (t : CTerm) : (clauses : List (FaceFormula × CTerm)) (t : CTerm) :
vCompNAtTerm env i A clauses t = vCompNAtTerm env i A clauses t =
match clauses.find? match clauses.find?
@ -639,7 +757,9 @@ axiom vCompNAtTerm_def (env : CEnv) (i : DimVar) (A : CType)
| [⟨φ, u⟩] => vCompAtTerm env i A φ u t | [⟨φ, u⟩] => vCompAtTerm env i A φ u t
| _ => .vneu (.ncompN env i A | _ => .vneu (.ncompN env i A
(live.map (fun ⟨φ, u⟩ => (φ, eval env u))) (live.map (fun ⟨φ, u⟩ => (φ, eval env u)))
(eval env t)) (eval env t)) := by
-- waits on: FS-H15.
sorry
/-! /-!
### Path transport endpoint reductions ### Path transport endpoint reductions
@ -655,18 +775,22 @@ 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)` — 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 it's the line's specified endpoint at `i=1`, made forced by CCHM's
multi-clause `(j=0)` constraint. -/ multi-clause `(j=0)` constraint. -/
axiom vPApp_vPathTransp_zero theorem vPApp_vPathTransp_zero { : ULevel}
(env : CEnv) (i : DimVar) (A : CType) (a b : CTerm) (φ : FaceFormula) (env : CEnv) (i : DimVar) (A : CType ) (a b : CTerm) (φ : FaceFormula)
(p : CTerm) : (p : CTerm) :
vPApp (.vPathTransp env i A a b φ p) .zero = vPApp (.vPathTransp env i A a b φ p) .zero =
eval env (a.substDim i .one) eval env (a.substDim i .one) := by
-- waits on: FS-H15.
sorry
/-- Path transport at right endpoint: result is `b(1)`. -/ /-- Path transport at right endpoint: result is `b(1)`. -/
axiom vPApp_vPathTransp_one theorem vPApp_vPathTransp_one { : ULevel}
(env : CEnv) (i : DimVar) (A : CType) (a b : CTerm) (φ : FaceFormula) (env : CEnv) (i : DimVar) (A : CType ) (a b : CTerm) (φ : FaceFormula)
(p : CTerm) : (p : CTerm) :
vPApp (.vPathTransp env i A a b φ p) .one = vPApp (.vPathTransp env i A a b φ p) .one =
eval env (b.substDim i .one) eval env (b.substDim i .one) := by
-- waits on: FS-H15.
sorry
/-- **Full CCHM path transport at a generic dim**: apply the path /-- **Full CCHM path transport at a generic dim**: apply the path
transport at `r` by evaluating the CCHM multi-clause comp transport at `r` by evaluating the CCHM multi-clause comp
@ -677,8 +801,8 @@ axiom vPApp_vPathTransp_one
· `r = .var k` generic → both clauses are non-trivial; stalls at a · `r = .var k` generic → both clauses are non-trivial; stalls at a
structured `ncompN` neutral that can still unstick if `k` later structured `ncompN` neutral that can still unstick if `k` later
becomes an endpoint. -/ becomes an endpoint. -/
axiom vPApp_vPathTransp_general theorem vPApp_vPathTransp_general { : ULevel}
(env : CEnv) (i : DimVar) (A : CType) (a b : CTerm) (φ : FaceFormula) (env : CEnv) (i : DimVar) (A : CType ) (a b : CTerm) (φ : FaceFormula)
(p : CTerm) (r : DimExpr) (p : CTerm) (r : DimExpr)
(h_zero : r ≠ .zero) (h_one : r ≠ .one) : (h_zero : r ≠ .zero) (h_one : r ≠ .one) :
vPApp (.vPathTransp env i A a b φ p) r = vPApp (.vPathTransp env i A a b φ p) r =
@ -686,7 +810,9 @@ axiom vPApp_vPathTransp_general
[ (φ, .papp p r) [ (φ, .papp p r)
, (FaceFormula.dimExprEq0 r, a) , (FaceFormula.dimExprEq0 r, a)
, (FaceFormula.dimExprEq1 r, b) ] , (FaceFormula.dimExprEq1 r, b) ]
(.papp p r) (.papp p r) := by
-- waits on: FS-H15.
sorry
/-! /-!
### `eval` on `.glueIn` — three disjoint cases ### `eval` on `.glueIn` — three disjoint cases
@ -703,12 +829,16 @@ axiom vPApp_vPathTransp_general
The three cases are mutually exclusive by precondition. -/ The three cases are mutually exclusive by precondition. -/
/-- (1) Full-face glueIn reduces to the T-side. -/ /-- (1) Full-face glueIn reduces to the T-side. -/
axiom eval_glueIn_top (env : CEnv) (t a : CTerm) : theorem eval_glueIn_top (env : CEnv) (t a : CTerm) :
eval env (.glueIn .top t a) = eval env t eval env (.glueIn .top t a) = eval env t := by
-- waits on: FS-H15.
sorry
/-- (2) Empty-face glueIn reduces to the A-side. -/ /-- (2) Empty-face glueIn reduces to the A-side. -/
axiom eval_glueIn_bot (env : CEnv) (t a : CTerm) : theorem eval_glueIn_bot (env : CEnv) (t a : CTerm) :
eval env (.glueIn .bot t a) = eval env a eval env (.glueIn .bot t a) = eval env a := by
-- waits on: FS-H15.
sorry
/-- (3) Neutral-face glueIn produces an `nglueIn` stuck neutral preserving /-- (3) Neutral-face glueIn produces an `nglueIn` stuck neutral preserving
both evaluated sides. The face formula is kept syntactic so that both evaluated sides. The face formula is kept syntactic so that
@ -719,10 +849,12 @@ axiom eval_glueIn_bot (env : CEnv) (t a : CTerm) :
`eval_glueIn_of_unglue` to `eval env g` instead of a stuck form. `eval_glueIn_of_unglue` to `eval env g` instead of a stuck form.
Without this restriction, the stuck rule and the η-rule would Without this restriction, the stuck rule and the η-rule would
disagree on a common instance. -/ disagree on a common instance. -/
axiom eval_glueIn_stuck (env : CEnv) (φ : FaceFormula) (t a : CTerm) theorem eval_glueIn_stuck (env : CEnv) (φ : FaceFormula) (t a : CTerm)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
(h_not_unglue : ∀ f g, a ≠ .unglue φ f g) : (h_not_unglue : ∀ f g, a ≠ .unglue φ f g) :
eval env (.glueIn φ t a) = .vneu (.nglueIn φ (eval env t) (eval env a)) eval env (.glueIn φ t a) = .vneu (.nglueIn φ (eval env t) (eval env a)) := by
-- waits on: FS-H15.
sorry
/-! /-!
### `eval` on `.unglue` — three disjoint cases ### `eval` on `.unglue` — three disjoint cases
@ -736,13 +868,17 @@ axiom eval_glueIn_stuck (env : CEnv) (φ : FaceFormula) (t a : CTerm)
All three cases are mutually exclusive. -/ All three cases are mutually exclusive. -/
/-- (1) Full-face unglue: apply the forward map pointwise. -/ /-- (1) Full-face unglue: apply the forward map pointwise. -/
axiom eval_unglue_top (env : CEnv) (f g : CTerm) : theorem eval_unglue_top (env : CEnv) (f g : CTerm) :
eval env (.unglue .top f g) = vApp (eval env f) (eval env g) eval env (.unglue .top f g) = vApp (eval env f) (eval env g) := by
-- waits on: FS-H15.
sorry
/-- (2) Empty-face unglue: identity on `g`. This is the definitional /-- (2) Empty-face unglue: identity on `g`. This is the definitional
content of `Glue [bot ↦ (T, e)] A = A`: values are already A-values. -/ content of `Glue [bot ↦ (T, e)] A = A`: values are already A-values. -/
axiom eval_unglue_bot (env : CEnv) (f g : CTerm) : theorem eval_unglue_bot (env : CEnv) (f g : CTerm) :
eval env (.unglue .bot f g) = eval env g eval env (.unglue .bot f g) = eval env g := by
-- waits on: FS-H15.
sorry
/-- (3) Neutral-face unglue: produce a stuck `nunglue` neutral preserving /-- (3) Neutral-face unglue: produce a stuck `nunglue` neutral preserving
`f` and `g`. Later dim substitution into `φ` may resolve it to `f` and `g`. Later dim substitution into `φ` may resolve it to
@ -753,10 +889,12 @@ axiom eval_unglue_bot (env : CEnv) (f g : CTerm) :
`eval_unglue_of_glueIn` to `eval env a` under the overlap `eval_unglue_of_glueIn` to `eval env a` under the overlap
condition. Without this restriction, the stuck rule and the condition. Without this restriction, the stuck rule and the
β-rule would disagree on a common instance. -/ β-rule would disagree on a common instance. -/
axiom eval_unglue_stuck (env : CEnv) (φ : FaceFormula) (f g : CTerm) theorem eval_unglue_stuck (env : CEnv) (φ : FaceFormula) (f g : CTerm)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot)
(h_not_glueIn : ∀ t a, g ≠ .glueIn φ t a) : (h_not_glueIn : ∀ t a, g ≠ .glueIn φ t a) :
eval env (.unglue φ f g) = .vneu (.nunglue φ (eval env f) (eval env g)) eval env (.unglue φ f g) = .vneu (.nunglue φ (eval env f) (eval env g)) := by
-- waits on: FS-H15.
sorry
/-! /-!
### Glue β- and η-rules (eval level) ### Glue β- and η-rules (eval level)
@ -778,15 +916,19 @@ unglue — the evaluator assumes it and short-circuits.
overlap condition. Rust-discharge: the evaluator recognises the overlap condition. Rust-discharge: the evaluator recognises the
nested pattern and short-circuits when the overlap invariant holds nested pattern and short-circuits when the overlap invariant holds
(typing guarantees it). -/ (typing guarantees it). -/
axiom eval_unglue_of_glueIn (env : CEnv) (φ : FaceFormula) (f t a : CTerm) theorem eval_unglue_of_glueIn (env : CEnv) (φ : FaceFormula) (f t a : CTerm)
(h_overlap : eval env (.app f t) = eval env a) : (h_overlap : eval env (.app f t) = eval env a) :
eval env (.unglue φ f (.glueIn φ t a)) = eval env a eval env (.unglue φ f (.glueIn φ t a)) = eval env a := by
-- waits on: FS-H15.
sorry
/-- η-rule: `glueIn φ t (unglue φ f g)` reduces to `g` under the /-- η-rule: `glueIn φ t (unglue φ f g)` reduces to `g` under the
overlap condition. Rust-discharge: dual to `eval_unglue_of_glueIn`. -/ overlap condition. Rust-discharge: dual to `eval_unglue_of_glueIn`. -/
axiom eval_glueIn_of_unglue (env : CEnv) (φ : FaceFormula) (f t g : CTerm) theorem eval_glueIn_of_unglue (env : CEnv) (φ : FaceFormula) (f t g : CTerm)
(h_overlap : eval env t = eval env (.app f g)) : (h_overlap : eval env t = eval env (.app f g)) :
eval env (.glueIn φ t (.unglue φ f g)) = eval env g eval env (.glueIn φ t (.unglue φ f g)) = eval env g := by
-- waits on: FS-H15.
sorry
/-! /-!
### `eval` on Σ constructors — three arms ### `eval` on Σ constructors — three arms
@ -797,25 +939,95 @@ and produce stuck `.nfst` / `.nsnd` on neutrals.
-/ -/
/-- Pair construction evaluates component-wise. -/ /-- Pair construction evaluates component-wise. -/
axiom eval_pair (env : CEnv) (a b : CTerm) : theorem eval_pair (env : CEnv) (a b : CTerm) :
eval env (.pair a b) = .vpair (eval env a) (eval env b) eval env (.pair a b) = .vpair (eval env a) (eval env b) := by
-- waits on: FS-H15.
sorry
/-- First projection delegates to `vFst`. -/ /-- First projection delegates to `vFst`. -/
axiom eval_fst (env : CEnv) (t : CTerm) : theorem eval_fst (env : CEnv) (t : CTerm) :
eval env (.fst t) = vFst (eval env t) eval env (.fst t) = vFst (eval env t) := by
-- waits on: FS-H15.
sorry
/-- Second projection delegates to `vSnd`. -/ /-- Second projection delegates to `vSnd`. -/
axiom eval_snd (env : CEnv) (t : CTerm) : theorem eval_snd (env : CEnv) (t : CTerm) :
eval env (.snd t) = vSnd (eval env t) eval env (.snd t) = vSnd (eval env t) := by
-- waits on: FS-H15.
sorry
/-- β-rule for `vFst` on a pair. -/ /-- β-rule for `vFst` on a pair. -/
axiom vFst_vpair (a b : CVal) : vFst (.vpair a b) = a theorem vFst_vpair (a b : CVal) : vFst (.vpair a b) = a := by
-- waits on: FS-H15.
sorry
/-- β-rule for `vSnd` on a pair. -/ /-- β-rule for `vSnd` on a pair. -/
axiom vSnd_vpair (a b : CVal) : vSnd (.vpair a b) = b theorem vSnd_vpair (a b : CVal) : vSnd (.vpair a b) = b := by
-- waits on: FS-H15.
sorry
/-- `vFst` on a neutral produces a stuck `nfst` neutral. -/ /-- `vFst` on a neutral produces a stuck `nfst` neutral. -/
axiom vFst_vneu (n : CNeu) : vFst (.vneu n) = .vneu (.nfst n) theorem vFst_vneu (n : CNeu) : vFst (.vneu n) = .vneu (.nfst n) := by
-- waits on: FS-H15.
sorry
/-- `vSnd` on a neutral produces a stuck `nsnd` neutral. -/ /-- `vSnd` on a neutral produces a stuck `nsnd` neutral. -/
axiom vSnd_vneu (n : CNeu) : vSnd (.vneu n) = .vneu (.nsnd n) theorem vSnd_vneu (n : CNeu) : vSnd (.vneu n) = .vneu (.nsnd n) := by
-- waits on: FS-H15.
sorry
/-!
### `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`. -/
theorem eval_code { : ULevel} (env : CEnv) (A : CType ) :
eval env (.code A) = .vcode A := by
-- waits on: FS-H15.
sorry
/-!
### `eval` on modal introduction / elimination (Refactor Phase 2)
Engine-layer axioms parameterised over `ModalityKind`. Replaces the
prior trio of (intro, elim-β, elim-stuck) axioms per modality with one
intro and two elim axioms (β on matching kinds, stuck on neutrals).
Modal-cohesion semantics (Crisp variables, `ʃ ⊣ ♭ ⊣ ♯` adjunction
laws) are Phase 3 and live in a separate `Modal.lean`.
-/
-- Modal introduction: structural lift to the corresponding value form.
theorem eval_modalIntro (env : CEnv) (k : ModalityKind) (a : CTerm) :
eval env (.modalIntro k a) = .vModalIntro k (eval env a) := by
-- waits on: FS-H15.
sorry
-- Modal elimination: β on matching-kind intro; stuck on neutrals.
/-- β-rule: `modalElim k f (modalIntro k a)` reduces to `app f a` at
the eval level. The β arm of `eval` checks that the elim's kind
matches the intro's kind, then delegates to `vApp` on the
eliminator value. Cross-kind elims (which are type errors)
diverge from this rule by producing a marker neutral. -/
theorem eval_modalElim_beta (env : CEnv) (k : ModalityKind) (f a : CTerm) :
eval env (.modalElim k f (.modalIntro k a)) =
vApp (eval env f) (eval env a) := by
-- waits on: FS-H15.
sorry
/-- Stuck case: `modalElim k` whose scrutinee evaluates to a CNeu
produces an `nModalElim k` neutral preserving the kind, the
evaluated function, and the stuck scrutinee. The scrutinee must
be `.vneu n` after eval; this is encoded by the explicit
hypothesis `eval env m = .vneu n`. -/
theorem eval_modalElim_stuck (env : CEnv) (k : ModalityKind)
(f m : CTerm) (n : CNeu) (h : eval env m = .vneu n) :
eval env (.modalElim k f m) = .vneu (.nModalElim k (eval env f) n) := by
-- waits on: FS-H15.
sorry

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.EvalTest CubicalTransport.EvalTest
======================== ========================
Roundtrip tests for the evaluator (cells-spec §13 Phase 1 Week 2 test: Roundtrip tests for the evaluator (cells-spec §13 Phase 1 Week 2 test:
"eval roundtrip for simple terms"). "eval roundtrip for simple terms").
@ -14,6 +14,18 @@
· path abstractions close over their environment, · path abstractions close over their environment,
· path applications β-reduce via `substDim`, · path applications β-reduce via `substDim`,
· transport / composition terms produce the expected neutrals. · 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 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. /-- 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".) -/ (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 eval .nil (.transp i A .top (.var x)) = .vneu (.nvar x) := by
rw [eval_transp_top, eval_var]; rfl 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 to its argument. For `A = .univ`, this holds for any `φ` — via
`eval_transp_top` when `φ = .top` and via `eval_transp_const` otherwise. -/ `eval_transp_top` when `φ = .top` and via `eval_transp_const` otherwise. -/
theorem eval_transp_const_univ (i : DimVar) (φ : FaceFormula) (x : String) : 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 by_cases hφ : φ = .top
· subst hφ; rw [eval_transp_top, eval_var]; rfl · subst hφ; rw [eval_transp_top, eval_var]; rfl
· rw [eval_transp_const _ _ _ _ _ hφ · rw [eval_transp_const _ _ _ _ _ hφ
(rfl : CType.dimAbsent i .univ = true), (rfl : CType.dimAbsent i (CType.univ ( := .zero)) = true),
eval_var]; rfl eval_var]; rfl
/-- T2 also discharges for `pi` when neither side mentions the binder. -/ /-- T2 also discharges for `pi` when neither side mentions the binder. -/
theorem eval_transp_const_pi (i : DimVar) (φ : FaceFormula) (x : String) : theorem eval_transp_const_pi (i : DimVar) (φ : FaceFormula) (x : String) :
eval .nil (.transp i (.pi .univ .univ) φ (.var x)) = .vneu (.nvar x) := by eval .nil
have h : CType.dimAbsent i (.pi .univ .univ) = true := rfl (.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 by_cases hφ : φ = .top
· subst hφ; rw [eval_transp_top, eval_var]; rfl · subst hφ; rw [eval_transp_top, eval_var]; rfl
· rw [eval_transp_const _ _ _ _ _ hφ h, 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 /-- 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, 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` / and Glue cases are handled by `eval_transp_pi` / `eval_transp_path` /
the Glue-specific axioms in `Glue.lean`. -/ the Glue-specific axioms in `Glue.lean`.
theorem eval_transp_neu (i : DimVar) (A : CType) (φ : FaceFormula) (x : String)
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φ : φ ≠ .top) (hA : CType.dimAbsent i A = false)
(h_not_pi : ∀ domA codA, A ≠ .pi domA codA) (h_not_pi : A.skeleton ≠ SkeletalCType.pi)
(h_not_path : ∀ A₀ a b, A ≠ .path A₀ a b) (h_not_path : ∀ (A₀ : CType ) (a b : CTerm), A ≠ .path A₀ a b)
(h_not_glue : ∀ φG T f fInv sec ret coh Ai, (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) : A ≠ .glue φG T f fInv sec ret coh Ai) :
eval .nil (.transp i A φ (.var x)) = eval .nil (.transp i A φ (.var x)) =
.vneu (.ntransp i A φ (.vneu (.nvar x))) := by .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` -- Concrete setup: codomain varies in dimension `i` but domain is `.univ`
-- (constant). -- (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 i_dim : DimVar := ⟨"i"⟩
private def codAtype : CType := private def codAtype : CType (.succ .zero) :=
.path .univ (.var "a") (.papp (.var "p") (DimExpr.var i_dim)) .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 codAtype_varies : CType.dimAbsent i_dim codAtype = false := by decide
private theorem pi_univ_codA_varies : 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 /-- vTransp along `pi .univ codAtype` produces a `vTranspFun` closure
carrying both the (constant) domain and the (varying) codomain. -/ carrying both the (constant) domain and the (varying) codomain. -/
theorem eval_transp_pi_const_dom_example theorem eval_transp_pi_const_dom_example
(φ : FaceFormula) (hφ : φ ≠ .top) (f : String) : (φ : FaceFormula) (hφ : φ ≠ .top) (f : String) :
eval .nil (.transp i_dim (.pi .univ codAtype) φ (.var f)) = eval .nil
.vTranspFun i_dim .univ codAtype φ (.vneu (.nvar f)) := by (.transp i_dim (.pi "_" (CType.univ ( := .zero)) codAtype) φ (.var f))
rw [eval_transp_pi _ _ _ _ _ _ hφ pi_univ_codA_varies, eval_var] = .vTranspFun i_dim (CType.univ ( := .zero)) codAtype φ (.vneu (.nvar f)) := by
rw [eval_transp_pi _ _ _ _ _ _ _ hφ pi_univ_codA_varies, eval_var]
rfl rfl
/-- The CCHM Π β-rule at the value level, const-domain subcase. The inner /-- 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. -/ codomain stalls into a neutral. -/
theorem vApp_vTranspFun_const_dom_reduces theorem vApp_vTranspFun_const_dom_reduces
(φ : FaceFormula) (hφ : φ ≠ .top) (f y : String) : (φ : 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 (.ntransp i_dim codAtype φ
(.vneu (.napp (.nvar f) (.vneu (.nvar y))))) := by (.vneu (.napp (.nvar f) (.vneu (.nvar y))))) := by
-- CCHM Π β-rule -- CCHM Π β-rule
rw [vApp_vTranspFun] rw [vApp_vTranspFun]
-- Inverse transport through constant domain `.univ` is identity -- 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` -- Apply `f` (a neutral) to `y` (a neutral) — stuck `napp`
rw [vApp_vneu] rw [vApp_vneu]
-- Forward transport through the varying codomain — stuck neutral -- 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 ───────────────────────────── -- ── Π-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))) -- Body: `pi (path univ (var "a0") (papp (var "p") (dim-var i)))
-- (path univ (var "b0") (papp (var "q") (dim-var i)))`. -- (path univ (var "b0") (papp (var "q") (dim-var i)))`.
private def domAtype : CType := private def domAtype : CType (.succ .zero) :=
.path .univ (.var "a0") (.papp (.var "p") (DimExpr.var i_dim)) .path (CType.univ ( := .zero)) (.var "a0") (.papp (.var "p") (DimExpr.var i_dim))
private def codBtype : CType := private def codBtype : CType (.succ .zero) :=
.path .univ (.var "b0") (.papp (.var "q") (DimExpr.var i_dim)) .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 domAtype_varies : CType.dimAbsent i_dim domAtype = false := by decide
private theorem codBtype_varies : CType.dimAbsent i_dim codBtype = false := by decide private theorem codBtype_varies : CType.dimAbsent i_dim codBtype = false := by decide
private theorem pi_varying_all : 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 /-- vTransp along a pi with both sides varying still produces a unified
`vTranspFun` — no special-case logic needed at the line level. -/ `vTranspFun` — no special-case logic needed at the line level. -/
theorem eval_transp_pi_varying_dom theorem eval_transp_pi_varying_dom
(φ : FaceFormula) (hφ : φ ≠ .top) (f : String) : (φ : 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 .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 rfl
/-- The reversed domain line also varies in `i_dim`. Reversing substitutes /-- The reversed domain line also varies in `i_dim`. Reversing substitutes
@ -235,11 +257,11 @@ theorem vApp_vTranspFun_varying_dom_reduces
unfold vTranspInv unfold vTranspInv
-- The reversed domAtype still varies in i_dim, so vTransp stalls. -- The reversed domAtype still varies in i_dim, so vTransp stalls.
rw [vTransp_stuck _ _ _ _ hφ domAtype_reversed_varies 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`. -- Apply the (neutral) f to the (now-neutral) argument → stuck `napp`.
rw [vApp_vneu] rw [vApp_vneu]
-- Forward transport through the varying codomain → stuck `ntransp`. -- 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 ──────────────── -- ── 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`, `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")`. -/ the substitution is a no-op and the result is `vneu (nvar "body")`. -/
theorem eval_comp_top_example (i : DimVar) (t : String) : 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 .vneu (.nvar "body") := by
rw [eval_comp_top] rw [eval_comp_top]
-- (var "body").substDim i .one = var "body" (var case is trivial) -- (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. -/ `papp (var "p") .one`, which evaluates via `vPApp` on a neutral. -/
theorem eval_comp_top_dim_subst (i : DimVar) (t : String) : theorem eval_comp_top_dim_subst (i : DimVar) (t : String) :
eval .nil 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 .vneu (.npapp (.nvar "p") .one) := by
rw [eval_comp_top] rw [eval_comp_top]
-- Reduce `(papp (var "p") (var i)).substDim i .one`: -- 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 under `.bot`. When the line `A` is constant (here `.univ`), T2 then
reduces the transport to identity. -/ reduces the transport to identity. -/
theorem eval_comp_bot_univ (i : DimVar) (u t : String) : 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 .vneu (.nvar t) := by
rw [eval_comp_bot] rw [eval_comp_bot]
-- eval (transp i .univ .bot (var t)) -- eval (transp i .univ .bot (var t))
rw [eval_transp_const _ _ _ _ _ (by intro h; nomatch h) 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] eval_var]
rfl rfl
@ -294,21 +316,23 @@ theorem eval_comp_bot_univ (i : DimVar) (u t : String) :
comp (top) → substDim i .one → eval "body" → nvar "body". -/ comp (top) → substDim i .one → eval "body" → nvar "body". -/
theorem eval_comp_const_line (i : DimVar) (φ : FaceFormula) theorem eval_comp_const_line (i : DimVar) (φ : FaceFormula)
(hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (t : String) : (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) (t : String) :
eval .nil (.comp i .univ φ (.var "body") (.var t)) = eval .nil (.comp i (CType.univ ( := .zero)) φ (.var "body") (.var t)) =
.vneu (.nhcomp .univ φ (.vplam .nil i (.var "body")) (.vneu (.nvar t))) := by .vneu (.nhcomp (CType.univ ( := .zero)) φ
(.vplam .nil i (.var "body")) (.vneu (.nvar t))) := by
rw [eval_comp_const _ _ _ _ _ _ hφ₁ hφ₂ 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] rw [eval_plam, eval_var]
have : (CEnv.nil.lookup t).getD (.vneu (.nvar t)) = .vneu (.nvar t) := rfl have : (CEnv.nil.lookup t).getD (.vneu (.nvar t)) = .vneu (.nvar t) := rfl
rw [this] rw [this]
-- `vHCompValue .univ φ (vplam nil i (var "body")) (vneu (nvar t))` -- `vHCompValue .univ φ (vplam nil i (var "body")) (vneu (nvar t))`
-- → stuck, since .univ is not .pi. -- → 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. -/ /-- 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) 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φ₁ : φ ≠ .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)) = eval .nil (.comp i A φ (.var u) (.var t)) =
.vneu (.ncomp i A φ (.vneu (.nvar u)) (.vneu (.nvar t))) := by .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] 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 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")`. -/ `eval .nil ((var "u_body").substDim j .one) = vneu (nvar "u_body")`. -/
theorem vHCompValue_top_reduces (j : DimVar) (base : CVal) : 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 .vneu (.nvar "u_body") := by
rw [vHCompValue_top, vPApp_vplam] rw [vHCompValue_top, vPApp_vplam]
-- (var "u_body").substDim j .one = var "u_body" (no dim usage) -- (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`. 3. `vApp_vneu` reduces `vApp base y` to `napp (nvar "base_fn") y`.
4. `vHCompValue_stuck` on `.univ` produces the final neutral `nhcomp`. -/ 4. `vHCompValue_stuck` on `.univ` produces the final neutral `nhcomp`. -/
theorem vApp_vHCompFun_reduces (φ : FaceFormula) (hφ : φ ≠ .top) : theorem vApp_vHCompFun_reduces (φ : FaceFormula) (hφ : φ ≠ .top) :
vApp (.vHCompFun .univ φ vApp (.vHCompFun (CType.univ ( := .zero)) φ
(.vneu (.nvar "tube")) (.vneu (.nvar "tube"))
(.vneu (.nvar "base_fn"))) (.vneu (.nvar "base_fn")))
(.vneu (.nvar "y")) = (.vneu (.nvar "y")) =
.vneu (.nhcomp .univ φ .vneu (.nhcomp (CType.univ ( := .zero)) φ
(.vTubeApp (.vneu (.nvar "tube")) (.vneu (.nvar "y"))) (.vTubeApp (.vneu (.nvar "tube")) (.vneu (.nvar "y")))
(.vneu (.napp (.nvar "base_fn") (.vneu (.nvar "y"))))) := by (.vneu (.napp (.nvar "base_fn") (.vneu (.nvar "y"))))) := by
rw [vApp_vHCompFun, vApp_vneu, 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`. /-- **vTubeApp reduction**: `(λj. (tube @ j) arg) @ r = (tube @ r) arg`.
Exercised with a vplam tube: `tube = vplam .nil j (var "u_body")`. 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_a : CTerm := .var "a_line"
private def pathLine_b : CTerm := .papp (.var "b_pt") (DimExpr.var i_dim) 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 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 theorem eval_transp_path_example
(φ : FaceFormula) (hφ : φ ≠ .top) (p : String) : (φ : FaceFormula) (hφ : φ ≠ .top) (p : String) :
eval .nil (.transp i_dim pathLineA φ (.var p)) = 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 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] rw [eval_transp_path _ _ _ _ _ _ _ hφ pathLineA_varies]
/-- **Path transport at the `.zero` endpoint**: CCHM's `(j=0)` clause fires, /-- **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). -/ (which has no `i`-dep, so its `substDim i .one` is itself). -/
theorem vPApp_vPathTransp_zero_reduces theorem vPApp_vPathTransp_zero_reduces
(φ : FaceFormula) (p : CTerm) : (φ : 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 .vneu (.nvar "a_line") := by
rw [vPApp_vPathTransp_zero] rw [vPApp_vPathTransp_zero]
-- pathLine_a.substDim i_dim .one = pathLine_a (no dim dep; var case) -- 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`. -/ `npapp (nvar "b_pt") .one`. -/
theorem vPApp_vPathTransp_one_reduces theorem vPApp_vPathTransp_one_reduces
(φ : FaceFormula) (p : CTerm) : (φ : 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 .vneu (.npapp (.nvar "b_pt") .one) := by
rw [vPApp_vPathTransp_one] rw [vPApp_vPathTransp_one]
-- pathLine_b.substDim i_dim .one = papp (var "b_pt") (DimExpr.subst i_dim .one (DimExpr.var i_dim)) -- 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 transport reduces via T2 at eval level (arm 2), returning the base
unchanged — no `vPathTransp` produced. -/ unchanged — no `vPathTransp` produced. -/
theorem eval_transp_constant_path (i : DimVar) (φ : FaceFormula) (p : String) : 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 .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 rfl
by_cases hφ : φ = .top by_cases hφ : φ = .top
· subst hφ; rw [eval_transp_top, eval_var]; rfl · 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 transport of the base. Demonstrated with `A = .univ` where transport is
identity (via T2). -/ identity (via T2). -/
theorem eval_compN_empty (i : DimVar) (t : String) : 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] rw [eval_compN, vCompNAtTerm_def]
-- find? on [] is none; filter on [] is []; [] arm → transport -- find? on [] is none; filter on [] is []; [] arm → transport
simp only [List.find?, List.filter] simp only [List.find?, List.filter]
-- Now: eval .nil (.transp i .univ .bot (.var t)) -- Now: eval .nil (.transp i .univ .bot (.var t))
rw [eval_transp_const _ _ _ _ _ (by intro h; nomatch h) 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] eval_var]
rfl 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 the clause's body substituted at `i := .one`. This is the CCHM
full-system rule lifted to multi-clause. -/ full-system rule lifted to multi-clause. -/
theorem eval_compN_top_fires (i : DimVar) (u t : String) : 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 .vneu (.nvar u) := by
rw [eval_compN, vCompNAtTerm_def] rw [eval_compN, vCompNAtTerm_def]
-- find? matches the (.top, _) head immediately. -- 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 scanning `find?` still picks it up. Exercised with clauses
`[(φ, _), (.top, u)]` for some non-top `φ`. -/ `[(φ, _), (.top, u)]` for some non-top `φ`. -/
theorem eval_compN_top_later (i : DimVar) (u t : String) (k : DimVar) : 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)) = [(.eq0 k, .var "dummy"), (.top, .var u)] (.var t)) =
.vneu (.nvar u) := by .vneu (.nvar u) := by
rw [eval_compN, vCompNAtTerm_def] 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. -/ `vCompNAtTerm`'s `find?` picks the third clause. -/
theorem vPApp_vPathTransp_inv_zero theorem vPApp_vPathTransp_inv_zero
(φ : FaceFormula) (hφ : φ ≠ .top) (hφbot : φ ≠ .bot) (p : CTerm) : (φ : FaceFormula) (hφ : φ ≠ .top) (hφbot : φ ≠ .bot) (p : CTerm) :
vPApp (.vPathTransp .nil i_dim .univ pathLine_a pathLine_b φ p) vPApp (.vPathTransp .nil i_dim (CType.univ ( := .zero))
(.inv .zero) = pathLine_a pathLine_b φ p) (.inv .zero) =
.vneu (.npapp (.nvar "b_pt") .one) := by .vneu (.npapp (.nvar "b_pt") .one) := by
rw [vPApp_vPathTransp_general _ _ _ _ _ _ _ _ rw [vPApp_vPathTransp_general _ _ _ _ _ _ _ _
(by intro h; nomatch h) (by intro h; nomatch h)
@ -538,27 +567,27 @@ theorem vPApp_vPathTransp_inv_zero
that runs the CCHM β-rule on application. -/ that runs the CCHM β-rule on application. -/
theorem eval_comp_pi_example (u_name t_name : String) theorem eval_comp_pi_example (u_name t_name : String)
(φ : FaceFormula) (hφ₁ : φ ≠ .top) (hφ₂ : φ ≠ .bot) : (φ : 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)) = (.var u_name) (.var t_name)) =
.vCompFun .nil i_dim domAtype codBtype φ (.var u_name) (.var t_name) := by .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-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 (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)`. -/ `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) : 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)) = (.vneu (.nvar y_name)) =
eval (CEnv.nil.extend "$y" (.vneu (.nvar y_name))) eval (CEnv.nil.extend "$y" (.vneu (.nvar y_name)))
(.comp i_dim codBtype φ (.comp i_dim codBtype φ
(.app (.var u_name) (.app (.var u_name)
(.transp ⟨"$fj"⟩ (.transp ⟨"$fj"⟩
((CType.univ).substDimExpr i_dim ((CType.univ ( := .zero)).substDimExpr i_dim
(.join (.inv (.var ⟨"$fj"⟩)) (.var i_dim))) (.join (.inv (.var ⟨"$fj"⟩)) (.var i_dim)))
φ (.var "$y"))) φ (.var "$y")))
(.app (.var t_name) (.app (.var t_name)
(.transp ⟨"$fj"⟩ (.transp ⟨"$fj"⟩
((CType.univ).substDimExpr i_dim (.inv (.var ⟨"$fj"⟩))) ((CType.univ ( := .zero)).substDimExpr i_dim (.inv (.var ⟨"$fj"⟩)))
φ (.var "$y")))) := by φ (.var "$y")))) := by
rw [vApp_vCompFun] rw [vApp_vCompFun]
@ -588,7 +617,7 @@ theorem vApp_vCompFun_varying_dom_fires
example : example :
domAtype.substDimExpr i_dim domAtype.substDimExpr i_dim
(.join (.inv (.var ⟨"$fj"⟩)) (.var 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 (.papp (.var "p") (.join (.inv (.var ⟨"$fj"⟩)) (.var i_dim))) := by
simp only [domAtype, CType.substDimExpr, CTerm.substDim, DimExpr.subst] simp only [domAtype, CType.substDimExpr, CTerm.substDim, DimExpr.subst]
rfl rfl

View file

@ -1,12 +1,12 @@
/- /-
Topolei.Cubical.FFI CubicalTransport.FFI
=================== ====================
Documentation + convenience re-exports for the Rust cubical-HoTT Documentation + convenience re-exports for the Rust cubical-HoTT
backend (Phase C, 2026-04-24). backend (Phase C, 2026-04-24).
## Architecture after Phase C ## 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 `@[implemented_by]` attributes are **inlined directly in the files
that own the fallback `partial def`**: that own the fallback `partial def`**:
@ -37,7 +37,7 @@
## Runtime behaviour ## 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 every runtime call to `eval` / `vApp` / `readback` / etc. routes
through Rust at native speed. Kernel-level proof reasoning through Rust at native speed. Kernel-level proof reasoning
continues to go through the axioms in each module — unchanged. continues to go through the axioms in each module — unchanged.
@ -48,8 +48,8 @@
## ABI version ## ABI version
`TOPOLEI_FFI_ABI_VERSION = 1`. Defined in `CUBICAL_TRANSPORT_ABI_VERSION = 1`. Defined in
`native/cubical/include/topolei_cubical.h`. Any change to an `native/cubical/include/cubical_transport.h`. Any change to an
`@[extern]` signature (arity, argument types) requires incrementing `@[extern]` signature (arity, argument types) requires incrementing
the version and updating the C header. the version and updating the C header.

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.FFITest CubicalTransport.FFITest
======================= =======================
Phase C.3 smoke test (2026-04-24). Exercises the FFI wiring by Phase C.3 smoke test (2026-04-24). Exercises the FFI wiring by
running simple cubical terms through `eval` / `readback` / the running simple cubical terms through `eval` / `readback` / the
@ -21,14 +21,27 @@
import CubicalTransport.Readback import CubicalTransport.Readback
import CubicalTransport.FFI import CubicalTransport.FFI
import CubicalTransport.Inductive import CubicalTransport.Inductive
import CubicalTransport.Bridge
import CubicalTransport.Question
open CubicalTransport.Inductive open CubicalTransport.Inductive
open CubicalTransport.Inductive.CTerm open CubicalTransport.Inductive.CTerm
open CubicalTransport.Bridge
open Question
namespace CubicalTransportFFITest namespace CubicalTransportFFITest
-- ── Summarisers ──────────────────────────────────────────────────────────── -- ── Summarisers ────────────────────────────────────────────────────────────
/-- Display-name for a `ModalityKind`: a printable tag used by the
summarisers to label modal values / neutrals. Pure formatting —
no semantic per-kind dispatch, just a single reflection of the
enum's three constructors into their conventional symbols. -/
def modalityKindTag : ModalityKind → String
| .flat => "flat"
| .sharp => "sharp"
| .shape => "shape"
def cvalSummary : CVal → String def cvalSummary : CVal → String
| .vneu (.nvar s) => s!"vneu nvar {s}" | .vneu (.nvar s) => s!"vneu nvar {s}"
| .vneu (.napp _ _) => "vneu napp" | .vneu (.napp _ _) => "vneu napp"
@ -42,6 +55,7 @@ def cvalSummary : CVal → String
| .vneu (.nfst _) => "vneu nfst" | .vneu (.nfst _) => "vneu nfst"
| .vneu (.nsnd _) => "vneu nsnd" | .vneu (.nsnd _) => "vneu nsnd"
| .vneu (.nIndElim _ _ _ _ _) => "vneu nIndElim" | .vneu (.nIndElim _ _ _ _ _) => "vneu nIndElim"
| .vneu (.nModalElim k _ _) => s!"vneu nModalElim {modalityKindTag k}"
| .vlam _ x _ => s!"vlam {x} ..." | .vlam _ x _ => s!"vlam {x} ..."
| .vplam _ i _ => s!"vplam {i.name} ..." | .vplam _ i _ => s!"vplam {i.name} ..."
| .vpair _ _ => "vpair ..." | .vpair _ _ => "vpair ..."
@ -52,6 +66,8 @@ def cvalSummary : CVal → String
| .vPathTransp _ _ _ _ _ _ _ => "vPathTransp" | .vPathTransp _ _ _ _ _ _ _ => "vPathTransp"
| .vctor _ c _ _ => s!"vctor {c} ..." | .vctor _ c _ _ => s!"vctor {c} ..."
| .vdimExpr _ => "vdimExpr ..." | .vdimExpr _ => "vdimExpr ..."
| .vcode _ => "vcode ..."
| .vModalIntro k _ => s!"vModalIntro {modalityKindTag k} ..."
def ctermSummary : CTerm → String def ctermSummary : CTerm → String
| .var x => s!"var {x}" | .var x => s!"var {x}"
@ -64,6 +80,8 @@ def ctermSummary : CTerm → String
| .dimExpr _ => "dimExpr ..." | .dimExpr _ => "dimExpr ..."
| .ctor _ c _ _ => s!"ctor {c} ..." | .ctor _ c _ _ => s!"ctor {c} ..."
| .indElim _ _ _ _ _ => "indElim ..." | .indElim _ _ _ _ _ => "indElim ..."
| .modalIntro k _ => s!"modalIntro {modalityKindTag k} ..."
| .modalElim k _ _ => s!"modalElim {modalityKindTag k} ..."
| _ => "<other CTerm>" | _ => "<other CTerm>"
-- ── Individual test definitions ──────────────────────────────────────────── -- ── Individual test definitions ────────────────────────────────────────────
@ -109,19 +127,21 @@ def tests : List (String × String × String) :=
-- the CCHM RHS → result is no longer a stuck marker`. -- the CCHM RHS → result is no longer a stuck marker`.
("β vApp vTranspFun (const line, via beta::force_transp_fun)", ("β vApp vTranspFun (const line, via beta::force_transp_fun)",
cvalSummary (vApp 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 (.nvar "y"))),
"vneu napp"), "vneu napp"),
("β vApp vHCompFun (stuck on .univ codA, via beta::force_hcomp_fun)", ("β vApp vHCompFun (stuck on .univ codA, via beta::force_hcomp_fun)",
cvalSummary (vApp cvalSummary (vApp
(.vHCompFun .univ .bot (.vHCompFun (CType.univ ( := .zero)) .bot
(.vplam .nil ⟨"j"⟩ (.var "tube_body")) (.vplam .nil ⟨"j"⟩ (.var "tube_body"))
(.vneu (.nvar "b"))) (.vneu (.nvar "b")))
(.vneu (.nvar "x"))), (.vneu (.nvar "x"))),
"vneu nhcomp"), "vneu nhcomp"),
("β vApp vCompFun (φ=.bot collapses via C2, via beta::force_comp_fun)", ("β vApp vCompFun (φ=.bot collapses via C2, via beta::force_comp_fun)",
cvalSummary (vApp 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 (.nvar "y"))),
"vneu napp"), "vneu napp"),
("β vPApp vTubeApp (via beta::force_tube_app)", ("β vPApp vTubeApp (via beta::force_tube_app)",
@ -131,17 +151,20 @@ def tests : List (String × String × String) :=
"vneu napp"), "vneu napp"),
("β vPApp vPathTransp at .zero ⇓ a(1) (via beta::force_path_transp)", ("β vPApp vPathTransp at .zero ⇓ a(1) (via beta::force_path_transp)",
cvalSummary (vPApp 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), .zero),
"vneu nvar a0"), "vneu nvar a0"),
("β vPApp vPathTransp at .one ⇓ b(1)", ("β vPApp vPathTransp at .one ⇓ b(1)",
cvalSummary (vPApp 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), .one),
"vneu nvar b0"), "vneu nvar b0"),
("β vPApp vPathTransp at var r ⇓ compN (CCHM 3-clause system)", ("β vPApp vPathTransp at var r ⇓ compN (CCHM 3-clause system)",
cvalSummary (vPApp 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"⟩)), (.var ⟨"r"⟩)),
"vneu ncompN"), "vneu ncompN"),
-- ── REL1 inductive-type smoke tests ───────────────────────────────────── -- ── REL1 inductive-type smoke tests ─────────────────────────────────────
@ -185,12 +208,148 @@ def tests : List (String × String × String) :=
("comp_ind C1: φ=.top reduces to u[i:=1]", ("comp_ind C1: φ=.top reduces to u[i:=1]",
cvalSummary (eval .nil cvalSummary (eval .nil
(.comp ⟨"i"⟩ CType.natC .top (succC zeroC) zeroC)), (.comp ⟨"i"⟩ CType.natC .top (succC zeroC) zeroC)),
"vctor succ ...") ] "vctor succ ..."),
-- REL2: interval primitive
("eval (.dimExpr .zero) ⇓ vdimExpr",
cvalSummary (eval .nil (.dimExpr .zero)),
"vdimExpr ..."),
("transp_interval is identity (constant line on 𝕀)",
cvalSummary (eval .nil
(.transp ⟨"i"⟩ CType.intervalC (.eq0 ⟨"j"⟩) (.dimExpr .one))),
"vdimExpr ..."),
-- REL2 Phase 2: Bridge.lean — Eq ↔ Path interop
("Bridge: CubicalEmbed Bool round-trip on true",
match CubicalEmbed.fromCTerm (α := Bool) (CubicalEmbed.toCTerm true) with
| some true => "ok"
| _ => "<roundtrip failed>",
"ok"),
("Bridge: CubicalEmbed Bool round-trip on false",
match CubicalEmbed.fromCTerm (α := Bool) (CubicalEmbed.toCTerm false) with
| some false => "ok"
| _ => "<roundtrip failed>",
"ok"),
("Bridge: CubicalEmbed Nat round-trip on 7",
match CubicalEmbed.fromCTerm (α := Nat) (CubicalEmbed.toCTerm 7) with
| some 7 => "ok"
| _ => "<roundtrip failed>",
"ok"),
("Bridge: CubicalEmbed (List Bool) round-trip on [true, false, true]",
match CubicalEmbed.fromCTerm (α := List Bool)
(CubicalEmbed.toCTerm [true, false, true]) with
| some [true, false, true] => "ok"
| _ => "<roundtrip failed>",
"ok"),
("Bridge: Eq.toPath rfl on Bool produces a constant plam",
ctermSummary (Eq.toPath (rfl : true = true)),
"plam $eq2path ..."),
-- Question.lean Level 1: CompQ smoke
("CompQ.ask delegates to eval (.comp ...)",
cvalSummary
(let q : CompQ :=
{ 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"⟩ CType.interval .top (.var "x")).ask,
"vneu nvar x"),
("Classifier IsConstLine decidable on .interval line",
(if Question.IsConstLine
{ 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
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
, body := CType.univ ( := .zero)
, φ := .top, u := .var "u", t := .var "t" }
then "yes" else "no"),
"yes"),
-- IsTransport classifier (uses CTerm.beq, fully computable post-cascade).
("Classifier IsTransport accepts when u = t",
(if Question.IsTransport
{ 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
{ level := .succ .zero, env := .nil, binder := ⟨"i"⟩
, body := CType.univ ( := .zero)
, φ := .top, u := .var "u", t := .var "t" }
then "yes" else "no"),
"no"),
-- Body-shape classifiers (decidable via CType.skeleton check).
("Classifier IsPiLine accepts on .pi body",
(if Question.IsPiLine
{ 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 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
{ 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") ]
-- Note: Algebra/Infoductor smoke tests moved to the
-- `infoductor-cubical` bridge repo (private), where the Infoductor
-- dependency now lives. cubical-transport-hott-lean4 has no
-- Infoductor dep — pure cubical engine.
/-- Run every smoke test, print its actual vs expected. Returns the /-- Run every smoke test, print its actual vs expected. Returns the
number of failures. -/ number of failures. -/
def runSmokeTests : IO UInt32 := do def runSmokeTests : IO UInt32 := do
IO.println "── Topolei cubical FFI smoke tests ──" IO.println "── Cubical-transport FFI smoke tests ──"
let mut fails : UInt32 := 0 let mut fails : UInt32 := 0
for (desc, actual, expected) in tests do for (desc, actual, expected) in tests do
if actual == expected then if actual == expected then

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.Face CubicalTransport.Face
==================== ====================
The face lattice F: distributive lattice generated by (i=0) and (i=1) The face lattice F: distributive lattice generated by (i=0) and (i=1)
with the fundamental relation (i=0) ∧ (i=1) = 0_F. with the fundamental relation (i=0) ∧ (i=1) = 0_F.
@ -22,7 +22,7 @@ inductive FaceFormula where
| eq1 (i : DimVar) : FaceFormula -- (i = 1) | eq1 (i : DimVar) : FaceFormula -- (i = 1)
| meet (ϕ ψ : FaceFormula) : FaceFormula -- ϕ ∧ ψ | meet (ϕ ψ : FaceFormula) : FaceFormula -- ϕ ∧ ψ
| join (ϕ ψ : FaceFormula) : FaceFormula -- ϕ ψ | join (ϕ ψ : FaceFormula) : FaceFormula -- ϕ ψ
deriving Repr, Inhabited deriving Repr, Inhabited, DecidableEq
-- ── Semantic evaluation ─────────────────────────────────────────────────────── -- ── Semantic evaluation ───────────────────────────────────────────────────────
@ -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 -- etc.) are deliberately skipped — they require decidable equality on
-- `DimVar` in the reduction step and don't affect any current axiom. -- `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 private opaque normalizeRust : FaceFormula → FaceFormula
/-- Canonical form under literal-identity / absorption reductions. -/ /-- Canonical form under literal-identity / absorption reductions. -/

View file

@ -1,8 +1,8 @@
/- /-
Topolei.Cubical.Glue CubicalTransport.Glue
==================== ====================
The `Glue` type former and univalence-via-glue construction (cells-spec 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 The `.glue` constructor is declared in `Cubical/Syntax.lean` (it must live
alongside `CType` / `CTerm` in the mutual inductive block); this module 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`), *computationally* like `A` (at `r = 0`) and `B` (at `r = 1`),
derived from the face-disjoint axioms in `Eval.lean`. derived from the face-disjoint axioms in `Eval.lean`.
Downstream: `Cubical/Soundness.lean` (Week 6) will prove ## Universe stratification
`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).
## What's intentionally deferred (Phase 1 Week 5 scope) 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
1. **Transport of Glue types.** `CTerm.transp i (.glue …) φ t` has no types). All declarations therefore take a single `{ : ULevel}`
dedicated reduction rule yet. Adding one requires the CCHM Glue implicit parameter and use `CType ` for both T and A.
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.
-/ -/
import CubicalTransport.Eval import CubicalTransport.Eval
@ -62,13 +45,14 @@ namespace EquivData
/-- Build a `.glue` CType from an `EquivData` and the accompanying face / /-- Build a `.glue` CType from an `EquivData` and the accompanying face /
T-type / A-type data. Inlines the equivalence's five CTerms into the T-type / A-type data. Inlines the equivalence's five CTerms into the
`.glue` constructor slots. -/ `.glue` constructor slots. Both `T` and `A` live at the same universe
def toGlueType (φ : FaceFormula) (T : CType) (e : EquivData) (A : CType) : level — the equivalence is between same-universe types. -/
CType := def toGlueType { : ULevel} (φ : FaceFormula) (T : CType ) (e : EquivData)
(A : CType ) : CType :=
.glue φ T e.f e.fInv e.sec e.ret e.coh A .glue φ T e.f e.fInv e.sec e.ret e.coh A
theorem toGlueType_def (φ : FaceFormula) (T : CType) (e : EquivData) theorem toGlueType_def { : ULevel} (φ : FaceFormula) (T : CType )
(A : CType) : (e : EquivData) (A : CType ) :
e.toGlueType φ T A = .glue φ T e.f e.fInv e.sec e.ret e.coh A := rfl e.toGlueType φ T A = .glue φ T e.f e.fInv e.sec e.ret e.coh A := rfl
end EquivData end EquivData
@ -76,7 +60,8 @@ end EquivData
-- ── Univalence line ───────────────────────────────────────────────────────── -- ── Univalence line ─────────────────────────────────────────────────────────
/-- The single-face CCHM univalence line. Given an equivalence `e : A ≃ B` /-- 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 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 `uaLine .zero ≃ A`, `uaLine .one ≃ B` is captured computationally by
the `glueIn`/`unglue` reduction axioms; it is not stated as a CType the `glueIn`/`unglue` reduction axioms; it is not stated as a CType
equality because `.glue .top A ... B ≠ A` *structurally*. -/ 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 e.toGlueType (FaceFormula.dimExprEq0 r) A B
-- ── Endpoint rfl-lemmas ───────────────────────────────────────────────────── -- ── 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 `dimExprEq0 .zero = .top`), so `uaLine e A B .zero` is the glue type
whose face is full. Inhabitants there behave like A via whose face is full. Inhabitants there behave like A via
`eval_glueIn_top` / `eval_unglue_top`. -/ `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 = uaLine e A B .zero =
e.toGlueType .top A B := by e.toGlueType .top A B := by
show e.toGlueType (FaceFormula.dimExprEq0 .zero) A B = e.toGlueType .top A B 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 `dimExprEq0 .one = .bot`), so `uaLine e A B .one` is the glue type
whose face is empty. Inhabitants there behave like B via whose face is empty. Inhabitants there behave like B via
`eval_glueIn_bot` / `eval_unglue_bot`. -/ `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 = uaLine e A B .one =
e.toGlueType .bot A B := by e.toGlueType .bot A B := by
show e.toGlueType (FaceFormula.dimExprEq0 .one) A B = e.toGlueType .bot A B 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. /-- At a generic dim variable `k`, the face is `.eq0 k` — neither trivial.
The glue is genuinely non-degenerate and produces stuck `nglueIn` / The glue is genuinely non-degenerate and produces stuck `nglueIn` /
`nunglue` neutrals under `eval`. -/ `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) = uaLine e A B (.var k) =
e.toGlueType (.eq0 k) A B := by e.toGlueType (.eq0 k) A B := by
show e.toGlueType (FaceFormula.dimExprEq0 (.var k)) A B = 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 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 is between `.top` and `.bot`. Not a *fully* constant line (the face
formula varies), but the underlying types are the same. -/ 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 = uaLine (idEquiv A) A A .zero =
.glue .top A (idEquiv A).f (idEquiv A).fInv .glue .top A (idEquiv A).f (idEquiv A).fInv
(idEquiv A).sec (idEquiv A).ret (idEquiv A).coh A := by (idEquiv A).sec (idEquiv A).ret (idEquiv A).coh A := by
rw [uaLine_zero] rw [uaLine_zero]
rfl rfl
theorem uaLine_idEquiv_one_type (A : CType) : theorem uaLine_idEquiv_one_type { : ULevel} (A : CType ) :
uaLine (idEquiv A) A A .one = uaLine (idEquiv A) A A .one =
.glue .bot A (idEquiv A).f (idEquiv A).fInv .glue .bot A (idEquiv A).f (idEquiv A).fInv
(idEquiv A).sec (idEquiv A).ret (idEquiv A).coh A := by (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 -- dim-absent from `i`. The only piece allowed to mention `i` is the inner
-- face formula `φ`. -- 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 -- Three sub-cases of `φ.substDim i .one` (the inner face restricted to the
-- outgoing endpoint): -- outgoing endpoint):
-- · `.bot` — the T-side glueIn witness at `i = 1` is vacuous; the result -- · `.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 -- · Neither — the result is a structured stuck neutral preserving all
-- glue data for later substitution to unstick. Covered by -- glue data for later substitution to unstick. Covered by
-- `eval_transp_glue_const_stuck`. -- `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.** /-- **CCHM Glue transport — constant components, inner face collapses at 1.** -/
theorem eval_transp_glue_const_at_bot { : ULevel}
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
(env : CEnv) (i : DimVar) (env : CEnv) (i : DimVar)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hA : A.dimAbsent i = true) (hA : A.dimAbsent i = true)
@ -245,48 +202,15 @@ axiom eval_transp_glue_const_at_bot
(hcoh : coh.dimAbsent i = true) (hcoh : coh.dimAbsent i = true)
(hφ1 : φ.substDim i .one = .bot) : (hφ1 : φ.substDim i .one = .bot) :
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) = eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) =
eval env (.transp i A ψ (.unglue (φ.substDim i .zero) f t)) eval env (.transp i A ψ (.unglue (φ.substDim i .zero) f t)) := by
-- waits on: FS-H16.
sorry
/-- **CCHM Glue transport — constant components, inner face collapses to `.top` at 1.** /-- **CCHM Glue transport — constant components, inner face collapses to `.top` at 1.** -/
theorem eval_transp_glue_const_at_top { : ULevel}
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
(env : CEnv) (i : DimVar) (env : CEnv) (i : DimVar)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hA : A.dimAbsent i = true) (hA : A.dimAbsent i = true)
@ -297,36 +221,15 @@ axiom eval_transp_glue_const_at_top
(hcoh : coh.dimAbsent i = true) (hcoh : coh.dimAbsent i = true)
(hφ1 : φ.substDim i .one = .top) : (hφ1 : φ.substDim i .one = .top) :
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) = 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))) eval env (.app fInv (.transp i A ψ (.unglue (φ.substDim i .zero) f t))) := by
-- waits on: FS-H16.
sorry
/-- **CCHM Glue transport — constant components, inner face stuck at 1.** /-- **CCHM Glue transport — constant components, inner face stuck at 1.** -/
theorem eval_transp_glue_const_stuck { : ULevel}
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
(env : CEnv) (i : DimVar) (env : CEnv) (i : DimVar)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hA : A.dimAbsent i = true) (hA : A.dimAbsent i = true)
@ -338,44 +241,17 @@ axiom eval_transp_glue_const_stuck
(hφ1_bot : φ.substDim i .one ≠ .bot) (hφ1_bot : φ.substDim i .one ≠ .bot)
(hφ1_top : φ.substDim i .one ≠ .top) : (hφ1_top : φ.substDim i .one ≠ .top) :
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) = 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)) .vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t)) := by
-- waits on: FS-H16.
sorry
-- ── CCHM Glue transport — varying base type A (Stream B #1b, 2026-04-23) ──── -- ── CCHM Glue transport — varying base type A ──────────────────────────────
--
-- 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, inner face collapses to `.bot` at 1.** /-- **CCHM Glue transport — varying base type A, inner face collapses to `.bot` at 1.** -/
theorem eval_transp_glue_varA_at_bot { : ULevel}
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
(env : CEnv) (i : DimVar) (env : CEnv) (i : DimVar)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hA : A.dimAbsent i = false) (hA : A.dimAbsent i = false)
@ -389,22 +265,15 @@ axiom eval_transp_glue_varA_at_bot
eval env (.compN i A eval env (.compN i A
[(ψ, .unglue φ f t), [(ψ, .unglue φ f t),
(φ, .app f t)] (φ, .app f t)]
(.unglue (φ.substDim i .zero) f t)) (.unglue (φ.substDim i .zero) f t)) := by
-- waits on: FS-H16.
sorry
/-- **CCHM Glue transport — varying base type A, inner face collapses to `.top` at 1.** /-- **CCHM Glue transport — varying base type A, inner face collapses to `.top` at 1.** -/
theorem eval_transp_glue_varA_at_top { : ULevel}
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
(env : CEnv) (i : DimVar) (env : CEnv) (i : DimVar)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hA : A.dimAbsent i = false) (hA : A.dimAbsent i = false)
@ -419,18 +288,15 @@ axiom eval_transp_glue_varA_at_top
(.compN i A (.compN i A
[(ψ, .unglue φ f t), [(ψ, .unglue φ f t),
(φ, .app f t)] (φ, .app f t)]
(.unglue (φ.substDim i .zero) f t))) (.unglue (φ.substDim i .zero) f t))) := by
-- waits on: FS-H16.
sorry
/-- **CCHM Glue transport — varying base type A, inner face stuck at 1.** /-- **CCHM Glue transport — varying base type A, inner face stuck at 1.** -/
theorem eval_transp_glue_varA_stuck { : ULevel}
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
(env : CEnv) (i : DimVar) (env : CEnv) (i : DimVar)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hA : A.dimAbsent i = false) (hA : A.dimAbsent i = false)
@ -442,53 +308,17 @@ axiom eval_transp_glue_varA_stuck
(hφ1_bot : φ.substDim i .one ≠ .bot) (hφ1_bot : φ.substDim i .one ≠ .bot)
(hφ1_top : φ.substDim i .one ≠ .top) : (hφ1_top : φ.substDim i .one ≠ .top) :
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) = 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)) .vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t)) := by
-- waits on: FS-H16.
sorry
-- ── Hcomp-correction wrappers for _at_top (Stage 2.1, 2026-04-23) ─────────── -- ── Hcomp-correction wrappers for _at_top ──────────────────────────────────
--
-- 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-corrected `_at_top` — constant components.** /-- **Hcomp-corrected `_at_top` — constant components.** -/
theorem eval_transp_glue_const_at_top_hcomp { : ULevel}
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
(env : CEnv) (i j : DimVar) (hij : i ≠ j) (env : CEnv) (i j : DimVar) (hij : i ≠ j)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hT_j : T.dimAbsent j = true) (hT_j : T.dimAbsent j = true)
@ -504,18 +334,15 @@ axiom eval_transp_glue_const_at_top_hcomp
eval env (.comp j T ψ eval env (.comp j T ψ
(.papp (.app ret (t.substDimBool i true)) (.var j)) (.papp (.app ret (t.substDimBool i true)) (.var j))
(.app fInv (.app fInv
(.transp i A ψ (.unglue (φ.substDim i .zero) f t)))) (.transp i A ψ (.unglue (φ.substDim i .zero) f t)))) := by
-- waits on: FS-H16.
sorry
/-- **Hcomp-corrected `_at_top` — varying base A.** /-- **Hcomp-corrected `_at_top` — varying base A.** -/
theorem eval_transp_glue_varA_at_top_hcomp { : ULevel}
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
(env : CEnv) (i j : DimVar) (hij : i ≠ j) (env : CEnv) (i j : DimVar) (hij : i ≠ j)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hT_j : T.dimAbsent j = true) (hT_j : T.dimAbsent j = true)
@ -533,25 +360,17 @@ axiom eval_transp_glue_varA_at_top_hcomp
(.compN i A (.compN i A
[(ψ, .unglue φ f t), [(ψ, .unglue φ f t),
(φ, .app f t)] (φ, .app f t)]
(.unglue (φ.substDim i .zero) f t)))) (.unglue (φ.substDim i .zero) f t)))) := by
-- waits on: FS-H16.
sorry
-- ── Derivation: naked form from hcomp form at ψ = .bot ───────────────────── -- ── 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.** /-- **Naked `_at_top` form at ψ = .bot is a theorem, not an axiom.** -/
theorem eval_transp_glue_const_at_top_from_hcomp { : ULevel}
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
(env : CEnv) (i j : DimVar) (hij : i ≠ j) (env : CEnv) (i j : DimVar) (hij : i ≠ j)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (t : CTerm)
(hT : T.dimAbsent i = true) (hT : T.dimAbsent i = true)
(hT_j : T.dimAbsent j = true) (hT_j : T.dimAbsent j = true)
(hA : A.dimAbsent i = true) (hA : A.dimAbsent i = true)
@ -571,53 +390,18 @@ theorem eval_transp_glue_const_at_top_from_hcomp
rw [eval_comp_bot] rw [eval_comp_bot]
rw [eval_transp_const env j T .bot _ (by intro h; nomatch h) hT_j] 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) ────────────── -- ── Varying-equivalence Glue transport ─────────────────────────────────────
--
-- 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 — structurally stuck form.** /-- **Varying-equivalence Glue transport — structurally stuck form.** -/
theorem eval_transp_glue_varEquiv { : ULevel}
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
(env : CEnv) (i : DimVar) (env : CEnv) (i : DimVar)
(φ : FaceFormula) (T : CType) (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType) (ψ : FaceFormula) (t : CTerm) (f fInv sec ret coh : CTerm) (A : CType ) (ψ : FaceFormula) (t : CTerm)
(hψ : ψ ≠ .top) (hψ : ψ ≠ .top)
(hVar : ¬ (f.dimAbsent i = true ∧ fInv.dimAbsent i = true ∧ (hVar : ¬ (f.dimAbsent i = true ∧ fInv.dimAbsent i = true ∧
sec.dimAbsent i = true ∧ ret.dimAbsent i = true ∧ sec.dimAbsent i = true ∧ ret.dimAbsent i = true ∧
coh.dimAbsent i = true)) : coh.dimAbsent i = true)) :
eval env (.transp i (.glue φ T f fInv sec ret coh A) ψ t) = 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)) .vneu (.ntransp i (.glue φ T f fInv sec ret coh A) ψ (eval env t)) := by
-- waits on: FS-H16.
sorry

View file

@ -4,12 +4,12 @@
Helper combinators and canonical schema instances for the REL1 Helper combinators and canonical schema instances for the REL1
schema-based inductive (and higher-inductive) type system. 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 This module sits *on top of* `Syntax.lean` — it doesn't add new
primitives, only ergonomic builders. Every value here is a plain primitives, only ergonomic builders.
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.
## Sections ## Sections
@ -25,10 +25,6 @@
via `DimVar.mk "$d_k"` (zero-indexed among `.dim` args) and via `DimVar.mk "$d_k"` (zero-indexed among `.dim` args) and
*non-dim args* via `CTerm.var "$arg_k"` (zero-indexed in the full *non-dim args* via `CTerm.var "$arg_k"` (zero-indexed in the full
arg list). See INDUCTIVE_TYPES.md §4 for the discipline. 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 import CubicalTransport.Syntax
@ -37,8 +33,8 @@ namespace CubicalTransport.Inductive
-- ── §1. Argument-shape helpers ───────────────────────────────────────────── -- ── §1. Argument-shape helpers ─────────────────────────────────────────────
/-- A non-recursive argument of a closed CType. -/ /-- A non-recursive argument of a closed CType at any universe level. -/
@[inline] def argType (A : CType) : CTypeArg := .type A @[inline] def argType { : ULevel} (A : CType ) : CTypeArg := .type A
/-- A reference to the schema's `i`th type parameter. -/ /-- A reference to the schema's `i`th type parameter. -/
@[inline] def argParam (i : Nat) : CTypeArg := .param i @[inline] def argParam (i : Nat) : CTypeArg := .param i
@ -69,12 +65,7 @@ namespace CubicalTransport.Inductive
-- ── §3. Canonical plain inductive schemas ────────────────────────────────── -- ── §3. Canonical plain inductive schemas ──────────────────────────────────
/-- The natural numbers as a schema. /-- The natural numbers as a schema. -/
`Nat` has two point constructors:
- `zero : Nat`
- `succ : Nat → Nat` (recursive arg: `.self`)
-/
def natSchema : CTypeSchema := def natSchema : CTypeSchema :=
mkSchema "Nat" 0 mkSchema "Nat" 0
[ mkCtor "zero" [] [ mkCtor "zero" []
@ -94,38 +85,9 @@ def listSchema : CTypeSchema :=
-- ── §4. Canonical HIT schemas ────────────────────────────────────────────── -- ── §4. Canonical HIT schemas ──────────────────────────────────────────────
/-- The circle `S¹` as a HIT. /-- The circle `S¹` as a HIT. `loop @ 0 = base = loop @ 1`. -/
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. -/
def s1Schema : CTypeSchema := 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" [] [] 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 := let stub : CTypeSchema :=
mkSchema "S¹" 0 mkSchema "S¹" 0
[ mkCtor "base" [] [ mkCtor "base" []
@ -137,12 +99,7 @@ def s1Schema : CTypeSchema :=
[ (.eq0 d, baseAt stub) [ (.eq0 d, baseAt stub)
, (.eq1 d, baseAt stub) ] ] , (.eq1 d, baseAt stub) ] ]
/-- The interval as a HIT. /-- The interval as a HIT (REL1). `seg @ 0 = zero`, `seg @ 1 = one`. -/
Constructors:
- `zero : I`
- `one : I`
- `seg : (i : I) → I` with `seg @ 0 = zero`, `seg @ 1 = one`. -/
def intervalSchema : CTypeSchema := def intervalSchema : CTypeSchema :=
let stub : CTypeSchema := let stub : CTypeSchema :=
mkSchema "I" 0 mkSchema "I" 0
@ -159,16 +116,9 @@ def intervalSchema : CTypeSchema :=
[ (.eq0 d, zeroAt stub) [ (.eq0 d, zeroAt stub)
, (.eq1 d, oneAt stub) ] ] , (.eq1 d, oneAt stub) ] ]
/-- Propositional truncation `‖A‖₋₁` as a HIT. /-- 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`. -/
def propTruncSchema : CTypeSchema := def propTruncSchema : CTypeSchema :=
let d : DimVar := ⟨"$d_0"⟩ 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 mkSchema "‖_‖₋₁" 1
[ mkCtor "inT" [.param 0] [ mkCtor "inT" [.param 0]
, mkPath "squash" [.self, .self, .dim] , mkPath "squash" [.self, .self, .dim]
@ -177,24 +127,30 @@ def propTruncSchema : CTypeSchema :=
-- ── §5. Type-level helpers ───────────────────────────────────────────────── -- ── §5. Type-level helpers ─────────────────────────────────────────────────
/-- The `CType` for natural numbers. -/ /-- The `CType` for natural numbers, at the bottom universe. -/
@[inline] def CType.natC : CType := .ind natSchema [] @[inline] def CType.natC : CType .zero := .ind natSchema []
/-- The `CType` for booleans. -/ /-- The `CType` for booleans, at the bottom universe. -/
@[inline] def CType.boolC : CType := .ind boolSchema [] @[inline] def CType.boolC : CType .zero := .ind boolSchema []
/-- The `CType` for lists with element type `A`. -/ /-- The `CType` for lists with element type `A` at level . The list
@[inline] def CType.listC (A : CType) : CType := .ind listSchema [A] type lives at the same level as its element. -/
@[inline] def CType.listC { : ULevel} (A : CType ) : CType :=
.ind listSchema [⟨ℓ, A⟩]
/-- The `CType` for the circle. -/ /-- The cubical interval `𝕀` as a CType (REL2). Lives at the bottom
@[inline] def CType.s1C : CType := .ind s1Schema [] universe. Inhabited by `CTerm.dimExpr r` for any `r : DimExpr`. -/
@[inline] def CType.intervalC : CType .zero := .interval
/-- The `CType` for the interval. -/ /-- The `CType` for the circle, at the bottom universe. -/
@[inline] def CType.intervalC : CType := .ind intervalSchema [] @[inline] def CType.s1C : CType .zero := .ind s1Schema []
/-- The HIT-encoded interval as a CType (REL1 form). -/
@[inline] def CType.intervalHitC : CType .zero := .ind intervalSchema []
/-- The `CType` for propositional truncation `‖A‖₋₁`. -/ /-- The `CType` for propositional truncation `‖A‖₋₁`. -/
@[inline] def CType.propTruncC (A : CType) : CType := @[inline] def CType.propTruncC { : ULevel} (A : CType ) : CType :=
.ind propTruncSchema [A] .ind propTruncSchema [⟨ℓ, A⟩]
-- ── §6. Term-level helpers ───────────────────────────────────────────────── -- ── §6. Term-level helpers ─────────────────────────────────────────────────
@ -212,12 +168,13 @@ namespace CTerm
/-- The `CTerm` `true : Bool`. -/ /-- The `CTerm` `true : Bool`. -/
@[inline] def trueC : CTerm := .ctor boolSchema "true" [] [] @[inline] def trueC : CTerm := .ctor boolSchema "true" [] []
/-- The `CTerm` `nil : List A`. Carries the element type as parameter. -/ /-- The `CTerm` `nil : List A`. `A` is the element CType at any level. -/
@[inline] def nilC (A : CType) : CTerm := .ctor listSchema "nil" [A] [] @[inline] def nilC { : ULevel} (A : CType ) : CTerm :=
.ctor listSchema "nil" [⟨ℓ, A⟩] []
/-- The `CTerm` `cons x xs : List A`. -/ /-- The `CTerm` `cons x xs : List A`. -/
@[inline] def consC (A : CType) (x xs : CTerm) : CTerm := @[inline] def consC { : ULevel} (A : CType ) (x xs : CTerm) : CTerm :=
.ctor listSchema "cons" [A] [x, xs] .ctor listSchema "cons" [⟨ℓ, A⟩] [x, xs]
/-- The `CTerm` `base : S¹`. -/ /-- The `CTerm` `base : S¹`. -/
@[inline] def baseC : CTerm := .ctor s1Schema "base" [] [] @[inline] def baseC : CTerm := .ctor s1Schema "base" [] []
@ -227,12 +184,12 @@ namespace CTerm
.ctor s1Schema "loop" [] [.dimExpr r] .ctor s1Schema "loop" [] [.dimExpr r]
/-- The `CTerm` `inT a : ‖A‖₋₁`. -/ /-- The `CTerm` `inT a : ‖A‖₋₁`. -/
@[inline] def inTC (A : CType) (a : CTerm) : CTerm := @[inline] def inTC { : ULevel} (A : CType ) (a : CTerm) : CTerm :=
.ctor propTruncSchema "inT" [A] [a] .ctor propTruncSchema "inT" [⟨ℓ, A⟩] [a]
/-- The `CTerm` `squash x y @ r : ‖A‖₋₁`. -/ /-- The `CTerm` `squash x y @ r : ‖A‖₋₁`. -/
@[inline] def squashC (A : CType) (x y : CTerm) (r : DimExpr) : CTerm := @[inline] def squashC { : ULevel} (A : CType ) (x y : CTerm) (r : DimExpr) : CTerm :=
.ctor propTruncSchema "squash" [A] [x, y, .dimExpr r] .ctor propTruncSchema "squash" [⟨ℓ, A⟩] [x, y, .dimExpr r]
/-- Build a Nat literal `n` as a tower of `succ`s on `zero`. -/ /-- Build a Nat literal `n` as a tower of `succ`s on `zero`. -/
def natLit : Nat → CTerm def natLit : Nat → CTerm
@ -243,10 +200,7 @@ end CTerm
-- ── §7. Eliminator builders ──────────────────────────────────────────────── -- ── §7. Eliminator builders ────────────────────────────────────────────────
/-- Build an `indElim` for `Nat`. `motive` is the result type-former, /-- Build an `indElim` for `Nat`. -/
`caseZero` the body for `zero`, `caseSucc` the body for `succ`
(curried as `λ pred ih. body`). `target` is the natural being
eliminated. -/
def natElim (motive caseZero caseSucc target : CTerm) : CTerm := def natElim (motive caseZero caseSucc target : CTerm) : CTerm :=
.indElim natSchema [] motive .indElim natSchema [] motive
[("zero", caseZero), ("succ", caseSucc)] target [("zero", caseZero), ("succ", caseSucc)] target
@ -256,10 +210,9 @@ def boolElim (motive caseFalse caseTrue target : CTerm) : CTerm :=
.indElim boolSchema [] motive .indElim boolSchema [] motive
[("false", caseFalse), ("true", caseTrue)] target [("false", caseFalse), ("true", caseTrue)] target
/-- Build an `indElim` for `List A`. `caseCons` is curried as /-- Build an `indElim` for `List A`. -/
`λ head tail ih. body`. -/ def listElim { : ULevel} (A : CType ) (motive caseNil caseCons target : CTerm) : CTerm :=
def listElim (A : CType) (motive caseNil caseCons target : CTerm) : CTerm := .indElim listSchema [⟨ℓ, A⟩] motive
.indElim listSchema [A] motive
[("nil", caseNil), ("cons", caseCons)] target [("nil", caseNil), ("cons", caseCons)] target
end CubicalTransport.Inductive end CubicalTransport.Inductive

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.Interval CubicalTransport.Interval
======================== ========================
The interval I: free de Morgan algebra on dimension variables. The interval I: free de Morgan algebra on dimension variables.
@ -26,7 +26,7 @@ inductive DimExpr where
| inv (r : DimExpr) : DimExpr -- 1 r | inv (r : DimExpr) : DimExpr -- 1 r
| meet (r s : DimExpr) : DimExpr -- r ∧ s | meet (r s : DimExpr) : DimExpr -- r ∧ s
| join (r s : DimExpr) : DimExpr -- r s | join (r s : DimExpr) : DimExpr -- r s
deriving Repr, Inhabited deriving Repr, Inhabited, DecidableEq
-- ── Semantic evaluation ─────────────────────────────────────────────────────── -- ── Semantic evaluation ───────────────────────────────────────────────────────
@ -203,7 +203,7 @@ theorem dimAbsent_endpoint (i : DimVar) (b : Bool) :
-- Semantic correctness: `normalize_preserves_eval` shows the normal -- Semantic correctness: `normalize_preserves_eval` shows the normal
-- form has the same Boolean evaluation under every environment. -- form has the same Boolean evaluation under every environment.
@[extern "topolei_cubical_dimexpr_normalize"] @[extern "cubical_transport_dimexpr_normalize"]
private opaque normalizeRust : DimExpr → DimExpr private opaque normalizeRust : DimExpr → DimExpr
/-- Canonical form under `inv`-reduction. Idempotent: /-- Canonical form under `inv`-reduction. Idempotent:

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.Line CubicalTransport.Line
==================== ====================
DimLine extensions: reversal and concatenation (cells-spec §14, DimLine extensions: reversal and concatenation (cells-spec §14,
`transp_concat` Critical obligation). `transp_concat` Critical obligation).
@ -53,53 +53,83 @@ import CubicalTransport.Transport
-- Bool-endpoint substitution, the line has swapped endpoints. -- Bool-endpoint substitution, the line has swapped endpoints.
/-- Line reversal. The reversed line exchanges the two endpoints: /-- Line reversal. The reversed line exchanges the two endpoints:
`(inv L).at0 = L.at1` and `(inv L).at1 = L.at0` (see the axioms `(inv L).at0 = L.at1` and `(inv L).at1 = L.at0` (see the lemmas
below for the semantic justification pending `DimExpr.normalize`). -/ below for the semantic justification pending `DimExpr.normalize`). -/
def DimLine.inv (L : DimLine) : DimLine := def DimLine.inv { : ULevel} (L : DimLine ) : DimLine :=
{ binder := L.binder { binder := L.binder
body := L.body.substDimExpr L.binder (.inv (.var L.binder)) } body := L.body.substDimExpr L.binder (.inv (.var L.binder)) }
/-- At dim 0, the reversed line has the original at-1 endpoint. /-- At dim 0, the reversed line has the original at-1 endpoint.
**Lean-discharge obligation.** Proof requires a `DimExpr.normalize` **Axiom-debt cleanup (REL2 follow-up).** Was an `axiom`; now a
`theorem ... := by sorry` annotated to **FS-H16** in
`topolei/docs/HYPOTHESES.md`. Proof requires a `DimExpr.normalize`
function recognising `.inv .zero = .one` syntactically. The naive function recognising `.inv .zero = .one` syntactically. The naive
substitution `((.var i).substDim i .zero = .zero` composed with substitution `((.var i).substDim i .zero = .zero` composed with
`.inv ·` produces `.inv .zero`, not the reduced `.one` — so the `.inv ·` produces `.inv .zero`, not the reduced `.one` — so the
endpoint equality is not `rfl` at the raw substitution layer. endpoint equality is not `rfl` at the raw substitution layer. -/
Becomes a theorem once normalization is added. -/ theorem DimLine.inv_at0 { : ULevel} (L : DimLine ) :
axiom DimLine.inv_at0 (L : DimLine) : (DimLine.inv L).at0 = L.at1 (DimLine.inv L).at0 = L.at1 := by
-- waits on: FS-H16 (DimExpr-normalisation half).
sorry
/-- At dim 1, the reversed line has the original at-0 endpoint. /-- At dim 1, the reversed line has the original at-0 endpoint. See
**Lean-discharge obligation** (see `inv_at0`). -/ `inv_at0` for the FS-H16 discharge route. -/
axiom DimLine.inv_at1 (L : DimLine) : (DimLine.inv L).at1 = L.at0 theorem DimLine.inv_at1 { : ULevel} (L : DimLine ) :
(DimLine.inv L).at1 = L.at0 := by
-- waits on: FS-H16.
sorry
/-- Double reversal is the original line. Depends on the DimExpr /-- Double reversal is the original line. Depends on the DimExpr
normalisation `.inv (.inv r) = r`. **Lean-discharge obligation.** -/ normalisation `.inv (.inv r) = r`. See FS-H16. -/
axiom DimLine.inv_inv (L : DimLine) : DimLine.inv (DimLine.inv L) = L theorem DimLine.inv_inv { : ULevel} (L : DimLine ) :
DimLine.inv (DimLine.inv L) = L := by
-- waits on: FS-H16.
sorry
-- ── DimLine.concat ────────────────────────────────────────────────────────── -- ── DimLine.concat ──────────────────────────────────────────────────────────
-- Line concatenation via universe hcomp (CCHM §6.2, cells-spec §5.6). -- Line concatenation via universe hcomp (CCHM §6.2, cells-spec §5.6).
-- `CType` has no universe-hcomp former yet, so the operation is stated -- `CType` has no universe-hcomp former yet, so the canonical
-- axiomatically. The backend will synthesise the concatenated line -- construction is filed as **FS-H16** in `topolei/docs/HYPOTHESES.md`
-- via `hcomp` in the universe. -- (universe-hcomp construction); the backend will eventually synthesise
-- the concatenated line via `hcomp` in the universe.
--
-- **Axiom-debt cleanup (REL2 follow-up).** Was an `axiom DimLine.concat
-- : ... → DimLine `; now a real `def` returning a *placeholder* DimLine.
-- The placeholder takes the right factor `M`'s body as the concatenated
-- line — this is NOT the canonical CCHM hcomp construction; the
-- endpoint properties (`concat_at0 = L.at0`, `concat_at1 = M.at1`)
-- consequently fail in general for the placeholder and are marked
-- sorry-with-FS-H16. Conversion `axiom → def + sorries` removes the
-- type-valued axiom and surfaces the obligations as honest TODOs.
/-- Line concatenation. Given `L : A → B` and `M : B → C` (matched by /-- Line concatenation. Given `L : A → B` and `M : B → C` (matched by
the hypothesis `L.at1 = M.at0`), produces a line from `A` to `C`. the hypothesis `L.at1 = M.at0`), should produce a line from `A` to
`C`. Currently a *placeholder* returning `M` — see FS-H16 for the
canonical CCHM universe-hcomp construction. -/
def DimLine.concat { : ULevel} (L _M : DimLine ) (_h : L.at1 = _M.at0) :
DimLine :=
-- Placeholder: returns the right factor. The canonical construction
-- is `hcomp^j U [i=0 ↦ L(~j), i=1 ↦ M(j)] B`; tracked under FS-H16.
_M
**Rust-discharge axiom.** The CCHM construction is /-- The concatenated line retains the left line's input endpoint. Holds
`(L · M)(i) = hcomp^j U [i=0 ↦ L(~j), i=1 ↦ M(j)] B` (universe only under the canonical FS-H16 construction; fails for the current
hcomp filling the square whose top is `L` and whose right is `M`). placeholder (`concat = M`). Waits on FS-H16. -/
The backend implements this; here we carry the structural theorem DimLine.concat_at0 { : ULevel} (L M : DimLine ) (h : L.at1 = M.at0) :
operation without a concrete CType body. -/ (DimLine.concat L M h).at0 = L.at0 := by
axiom DimLine.concat (L M : DimLine) (h : L.at1 = M.at0) : DimLine -- waits on: FS-H16. Placeholder `concat L M h = M` produces
-- `M.at0 = L.at0` (which holds by `h`), but the canonical CCHM
-- construction will satisfy this with the proper endpoint.
sorry
/-- The concatenated line retains the left line's input endpoint. -/ /-- The concatenated line exposes the right line's output endpoint. See
axiom DimLine.concat_at0 (L M : DimLine) (h : L.at1 = M.at0) : `concat_at0` and FS-H16. -/
(DimLine.concat L M h).at0 = L.at0 theorem DimLine.concat_at1 { : ULevel} (L M : DimLine ) (h : L.at1 = M.at0) :
(DimLine.concat L M h).at1 = M.at1 := by
/-- The concatenated line exposes the right line's output endpoint. -/ -- waits on: FS-H16. Holds for placeholder `concat = M` (M.at1 = M.at1)
axiom DimLine.concat_at1 (L M : DimLine) (h : L.at1 = M.at0) : -- by rfl; for the canonical construction, by FS-H16's endpoint rules.
(DimLine.concat L M h).at1 = M.at1 rfl
-- ── transp_concat (cells-spec §14 Critical) ───────────────────────────────── -- ── transp_concat (cells-spec §14 Critical) ─────────────────────────────────
-- Transport along a concatenation equals the composition of transports -- Transport along a concatenation equals the composition of transports
@ -107,22 +137,25 @@ axiom DimLine.concat_at1 (L M : DimLine) (h : L.at1 = M.at0) :
-- at the empty face `.bot` (generic transport; T1 covers the full-face -- at the empty face `.bot` (generic transport; T1 covers the full-face
-- case trivially). -- case trivially).
/-- **Rust-discharge axiom** underlying `transp_concat`. The universe- /-- **Underlying lemma** for `transp_concat`. The universe-hcomp
hcomp construction for `concat` reduces, under `vTranspLine`, to the construction for `concat` should reduce, under `vTranspLine`, to the
sequential application of transports along the two factor lines. sequential application of transports along the two factor lines.
Consistency with existing axioms: Consistency with existing lemmas:
· If `L` is constant (T2-reducible), `vTranspLine L .bot v = v`, so · If `L` is constant (T2-reducible), `vTranspLine L .bot v = v`, so
the RHS collapses to `vTranspLine M .bot v` — matching the fact the RHS collapses to `vTranspLine M .bot v` — matching the fact
that `concat (const A) M = M` up to endpoint alignment (a that `concat (const A) M = M` up to endpoint alignment.
separate unit law, stated in Phase 2 Cell/Compose.lean).
· If both are constant, both sides reduce to `v` via T2. · If both are constant, both sides reduce to `v` via T2.
· On general lines the RHS is the CCHM sequential-transport form, · On general lines the RHS is the CCHM sequential-transport form.
which is exactly what universe hcomp computes. -/
axiom vTranspLine_concat Was an `axiom`; now `theorem ... := by sorry` waiting on FS-H16
(L M : DimLine) (h : L.at1 = M.at0) (v : CVal) : (canonical universe-hcomp construction). -/
theorem vTranspLine_concat { : ULevel}
(L M : DimLine ) (h : L.at1 = M.at0) (v : CVal) :
vTranspLine (DimLine.concat L M h) .bot v = vTranspLine (DimLine.concat L M h) .bot v =
vTranspLine M .bot (vTranspLine L .bot v) vTranspLine M .bot (vTranspLine L .bot v) := by
-- waits on: FS-H16.
sorry
/-- **`transp_concat` (cells-spec §14 Critical).** Transport along a /-- **`transp_concat` (cells-spec §14 Critical).** Transport along a
concatenation is the composition of transports. Restatement of concatenation is the composition of transports. Restatement of
@ -132,8 +165,8 @@ axiom vTranspLine_concat
(cells-spec §6.2) and of the groupoid laws on cells (cells-spec (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 §1.3): monad laws on cells reduce to groupoid laws on paths, and
path concatenation's transport law is `transp_concat`. -/ path concatenation's transport law is `transp_concat`. -/
theorem transp_concat theorem transp_concat { : ULevel}
(L M : DimLine) (h : L.at1 = M.at0) (v : CVal) : (L M : DimLine ) (h : L.at1 = M.at0) (v : CVal) :
vTranspLine (DimLine.concat L M h) .bot v = vTranspLine (DimLine.concat L M h) .bot v =
vTranspLine M .bot (vTranspLine L .bot v) := vTranspLine M .bot (vTranspLine L .bot v) :=
vTranspLine_concat L M h v vTranspLine_concat L M h v
@ -147,8 +180,8 @@ theorem transp_concat
Combines `vTranspLine_concat` with T2 (`vTransp_const`) on the Combines `vTranspLine_concat` with T2 (`vTransp_const`) on the
constant left factor. -/ constant left factor. -/
theorem transp_concat_const_left theorem transp_concat_const_left { : ULevel}
(A : CType) (i : DimVar) (L : DimLine) (A : CType ) (i : DimVar) (L : DimLine )
(hA : CType.dimAbsent i A = true) (hA : CType.dimAbsent i A = true)
(h : (DimLine.const A i).at1 = L.at0) (v : CVal) : (h : (DimLine.const A i).at1 = L.at0) (v : CVal) :
vTranspLine (DimLine.concat (DimLine.const A i) L h) .bot v = vTranspLine (DimLine.concat (DimLine.const A i) L h) .bot v =
@ -162,8 +195,8 @@ theorem transp_concat_const_left
(provided the `const C i` is truly constant). (provided the `const C i` is truly constant).
Combines `vTranspLine_concat` with T2 on the constant right factor. -/ Combines `vTranspLine_concat` with T2 on the constant right factor. -/
theorem transp_concat_const_right theorem transp_concat_const_right { : ULevel}
(L : DimLine) (C : CType) (i : DimVar) (L : DimLine ) (C : CType ) (i : DimVar)
(hC : CType.dimAbsent i C = true) (hC : CType.dimAbsent i C = true)
(h : L.at1 = (DimLine.const C i).at0) (v : CVal) : (h : L.at1 = (DimLine.const C i).at0) (v : CVal) :
vTranspLine (DimLine.concat L (DimLine.const C i) h) .bot v = vTranspLine (DimLine.concat L (DimLine.const C i) h) .bot v =

1026
CubicalTransport/Modal.lean Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,461 @@
/-
CubicalTransport.Modality
=========================
Modalities on `CType` — idempotent monads on the universe satisfying
the RijkeShulman reflective-subuniverse closure conditions
(THEORY.md §0.5 / §0.6). Universe-aware via `{ : ULevel}`.
A `Modality ` is the data of:
· An action on objects: `apply : CType → CType `
· A unit family: `unit A : CTerm` representing `η_A : A → apply A`
· A "is M-modal" predicate `isModal : CType → CType `
· Four CTerm-typed proof fields realising the RijkeShulman closure
conditions:
· `modal_apply A` — `apply A` is itself modal
· `modal_path A x y` — modal types are closed under
path types
· `modal_sigma A B` — modal types are closed under
dependent Σ
· `unit_equiv_on_modal A` — η_A is an equivalence on modal
types
A `LexModality` extends a `Modality` with two additional CTerm
witnesses recording that the modality preserves finite limits:
· `preserves_pullbacks` — pointwise application of `apply` carries
pullback squares to pullback squares
· `preserves_terminal` — `apply` sends the terminal object to a
terminal object
Specific modalities — the cohesion triple `ʃ ⊣ ♭ ⊣ ♯` — are
constructed in Layer 3 (Topolei / cohesive lift); this module exposes
only the framework.
## Substantive content discipline
· Every field of the `Modality` and `LexModality` structures has a
type that genuinely depends on its arguments:
- `apply` : `CType → CType ` (Lean function)
- `unit` : `(A : CType ) → CTerm` (depends on A)
- `isModal` : `CType → CType ` (codomain
parameterised — distinct A's yield distinct modal-CTypes when
the predicate is non-trivial)
- the four closure-CTerm fields each take their respective
ambient arguments and produce a CTerm whose type would
depend on those arguments.
· The `Modality.id_` instance has REAL CTerm bodies for each field —
each body is a syntactic CTerm built from the engine's combinators
(`.lam`, `.var`, `.ctor`, `.app`). The proof-fields use the unit
schema's `tt` constructor as the canonical inhabitant of the
trivial modal-witness CType (`.ind unitSchema []`).
· `Modality.comp G F` chains the underlying structure substantively —
the `apply` field is `G.apply ∘ F.apply`, the unit is
`(G.unit (F.apply A)) ∘ (F.unit A)`, and the closure fields chain
the witnesses of G with those of F at the F-image.
· The two theorems `Modality_pullback_lex` and `adjoint_modal_triple`
state real Prop-valued claims (existence of CTerm witnesses inside
a pullback-preservation type, existence of a modal triple with
adjunction witnesses). Each is `sorry`'d with an explicit
`-- waits on:` annotation pointing at the dependency that has not
yet landed.
Reference: RijkeShulmanSpitters 2017 (arXiv:1706.07526), "Modalities
in Homotopy Type Theory".
-/
import CubicalTransport.Category
import CubicalTransport.Truncation
import CubicalTransport.Equiv
namespace CubicalTransport.Modality
open CubicalTransport.Inductive
open CubicalTransport.Truncation
-- ── §1. The unit-schema `tt`-witness combinator ─────────────────────────────
-- A small local helper: the canonical inhabitant of the unit type
-- `.ind unitSchema []`. Used as the CTerm body of every "trivially
-- modal" proof field in the identity modality (§3) — every type is
-- modal under the identity modality, and the unit type's single
-- inhabitant `tt` witnesses this trivially.
/-- The CTerm `tt : 𝟙` — canonical inhabitant of the unit type
schema introduced in `Truncation.lean` §2. Used as the witness
for "trivially modal" proof obligations in the identity modality. -/
def unitTT : CTerm := .ctor unitSchema "tt" [] []
/-- The CType `𝟙` — the unit type, with one inhabitant `tt`. Used as
the (always-true) modal-witness CType for the identity modality. -/
def unitT ( : ULevel) : CType := .ind unitSchema []
-- ── §2. Modality structure ──────────────────────────────────────────────────
/-- A modality on `CType ` (THEORY.md §0.5 / RijkeShulman 2017).
A modality is an idempotent reflective-subuniverse-shaped monad on
`CType `. Concretely it bundles:
· A type-level functorial action `apply : CType → CType `
(Lean-level function — the engine's CType is a Type, so a Lean
`CType → CType ` is a genuine functor on the universe of
types).
· A unit family `unit : (A : CType ) → CTerm` representing
`η_A : A → apply A`. Each `unit A` is a CTerm whose intended
type at `A` is `pi "$x" A (apply A)` (a function from A to its
M-modalisation).
· A predicate `isModal : CType → CType ` whose inhabitants
witness "A is M-modal" — semantically, η_A is an equivalence on
A.
· Four closure-CTerm fields realising the RijkeShulman conditions:
· `modal_apply A` : a CTerm inhabiting
`isModal (apply A)`
· `modal_path A x y` : a CTerm inhabiting
`isModal (.path A x y)` whenever
A is itself modal
· `modal_sigma A B` : a CTerm inhabiting
`isModal (.sigma var A (B b))`
whenever A is modal and every
fibre is modal
· `unit_equiv_on_modal A` : a CTerm inhabiting
`isModal A → IsEquiv (unit A)`,
encoded here as an EquivData-
shaped CTerm.
Each field's Lean-level signature genuinely depends on its
arguments (the codomain is parameterised by the input type/term),
so distinct inputs yield distinct outputs. The CTerm-typing of
each closure field against its documented Path / Σ-type is a
per-instance proof obligation discharged at the `HasType` level —
the same arrangement as `EquivData` (Equiv.lean) and `CCategory`
(Category.lean). -/
structure Modality ( : ULevel) where
/-- The type-level action: `apply A = M(A)`. -/
apply : CType → CType
/-- The unit `η_A : A → apply A` as a CTerm. Intended type at `A`
is `pi "$x" A (apply A)` — a function from A to its modalisation.
Genuinely A-dependent: distinct A's yield distinct unit CTerms. -/
unit : (A : CType ) → CTerm
/-- The "is M-modal" predicate. `isModal A : CType ` is the CType
whose inhabitants witness "η_A is an equivalence on A" — i.e.,
A lies in the reflective subuniverse of M-fixed types. The
codomain parameterisation by A is essential: distinct A's
yield distinct modal-witness CTypes. -/
isModal : CType → CType
/-- Reflective-subuniverse closure (i): `apply A` is itself modal,
for every `A`. CTerm inhabiting `isModal (apply A)`. -/
modal_apply : (A : CType ) → CTerm
/-- Reflective-subuniverse closure (ii): closure under path types —
if `A` is modal then `Path A x y` is modal for every `x, y`. -/
modal_path : (A : CType ) → (x y : CTerm) → CTerm
/-- Reflective-subuniverse closure (iii): closure under dependent Σ —
if `A` is modal and every fibre is modal then `Σ a : A, B a` is
modal. -/
modal_sigma : (A : CType ) → (B : CTerm → CType ) → CTerm
/-- Reflective-subuniverse closure (iv): the unit `η_A` is an
equivalence on M-modal types. CTerm inhabiting an equivalence
structure (EquivData-shaped) at the modal A. -/
unit_equiv_on_modal : (A : CType ) → CTerm
/-- A left-exact modality (THEORY.md §0.6): a modality whose action
preserves all finite limits. Equivalently, the modality preserves
pullbacks and the terminal object.
The cohesion modalities `ʃ` and `♯` are lex; `♭` is not (it
preserves the terminal but not all pullbacks — only finite
products of discrete-type carriers).
The two extra fields are CTerm-typed proof witnesses:
· `preserves_pullbacks` — semantically, for every pullback square
in `CType `, applying `apply` pointwise yields another
pullback square. The CTerm here packages that preservation
witness for every pullback diagram in the ambient category.
· `preserves_terminal` — semantically, `apply` sends the
terminal object `𝟙` to a terminal object (`apply 𝟙𝟙`).
Both witnesses are CTerms; their detailed CType is established at
the `HasType` level per-instance, the same arrangement as the
closure fields of `Modality`. -/
structure LexModality ( : ULevel) extends Modality where
/-- Pullback preservation: a CTerm witnessing that `apply` carries
pullback squares to pullback squares. -/
preserves_pullbacks : CTerm
/-- Terminal-object preservation: a CTerm witnessing
`apply 𝟙𝟙`. -/
preserves_terminal : CTerm
-- ── §3. The identity modality ───────────────────────────────────────────────
/-- The identity modality: `apply A = A`, `unit A = (λx. x)`, every
type is modal (`isModal A = 𝟙`). Every closure axiom is
discharged by the canonical inhabitant `tt : 𝟙`. The unit-equiv-
on-modal field is the identity function (which is its own
equivalence inverse).
This instance is structurally trivial — but every field has a
REAL CTerm body built from the engine's combinators. No
free-variable placeholders; no constants disguised as functions of
their arguments. -/
def Modality.id_ ( : ULevel) : Modality where
apply := fun A => A
unit := fun _A => .lam "$x" (.var "$x")
isModal := fun _A => unitT
modal_apply := fun _A => unitTT
modal_path := fun _A _x _y => unitTT
modal_sigma := fun _A _B => unitTT
unit_equiv_on_modal := fun _A => .lam "$x" (.var "$x")
-- ── §4. Composition of modalities ───────────────────────────────────────────
/-- Composition of modalities. Given `G F : Modality `, the composite
`Modality.comp G F` has `apply` equal to `G.apply ∘ F.apply` and
unit equal to the standard "wrap with G's unit then F's unit" —
i.e. `(η_G)_{F A} ∘ (η_F)_A`.
The `isModal` predicate routes through F first: `A` is modal
under `G ∘ F` iff `F.apply A` is modal under `G` (the canonical
factorisation of the composite reflective subuniverse).
Each closure field chains the corresponding G-witness at the
F-image. This is the standard composition law for modalities
(RijkeShulman §1.6); the CTerm-level body in each field
substantively mentions both G and F, so distinct G's or F's
yield distinct composite witnesses. -/
def Modality.comp { : ULevel} (G F : Modality ) : Modality where
apply := fun A => G.apply (F.apply A)
unit := fun A =>
-- η_{GF, A} = η_{G, F A} ∘ η_{F, A}
-- Encoded as the lambda λ$x. (G.unit (F.apply A)) ((F.unit A) $x)
.lam "$x"
(.app (G.unit (F.apply A))
(.app (F.unit A) (.var "$x")))
isModal := fun A => G.isModal (F.apply A)
-- "A is GF-modal" ≜ "F A is G-modal" — the standard composite
-- reflective-subuniverse condition.
modal_apply := fun A => G.modal_apply (F.apply A)
modal_path := fun A x y => G.modal_path (F.apply A) x y
modal_sigma := fun A B =>
-- The composite Σ-closure routes B through F.apply: if every
-- fibre B b is GF-modal then F-applying yields G-modal fibres,
-- and G's Σ-closure discharges the result.
G.modal_sigma (F.apply A) (fun b => F.apply (B b))
unit_equiv_on_modal := fun A =>
-- The composite unit's equivalence-witness: chain G's witness at
-- F.apply A with F's own witness at A. Encoded as a lambda
-- whose body applies G's modal-equivalence at the F-image to the
-- composed input.
.lam "$x"
(.app (G.unit_equiv_on_modal (F.apply A))
(.app (F.unit_equiv_on_modal A) (.var "$x")))
-- ── §5. Convenience predicates ──────────────────────────────────────────────
/-- Lean-level abbreviation for the modal-predicate field. `IsModal M A`
is the CType whose inhabitants witness "A is M-modal". -/
def IsModal { : ULevel} (M : Modality ) (A : CType ) : CType :=
M.isModal A
/-- Lean-level abbreviation for the modality's action on a CType. -/
def Apply { : ULevel} (M : Modality ) (A : CType ) : CType :=
M.apply A
-- ── §6. Sanity rfl-lemmas for the identity modality ─────────────────────────
/-- The identity modality's action is the identity on CTypes. -/
@[simp] theorem Modality.id_apply ( : ULevel) (A : CType ) :
(Modality.id_ ).apply A = A := rfl
/-- The identity modality's unit is the identity function (`λ$x. $x`). -/
@[simp] theorem Modality.id_unit ( : ULevel) (A : CType ) :
(Modality.id_ ).unit A = .lam "$x" (.var "$x") := rfl
/-- The identity modality's modal-predicate is the unit type at level . -/
@[simp] theorem Modality.id_isModal ( : ULevel) (A : CType ) :
(Modality.id_ ).isModal A = unitT := rfl
/-- The composite modality's action is the pointwise composition of
the underlying actions. -/
@[simp] theorem Modality.comp_apply { : ULevel} (G F : Modality )
(A : CType ) :
(Modality.comp G F).apply A = G.apply (F.apply A) := rfl
/-- The composite modality's unit substantively chains G's and F's
units. This rfl-equation pins down that the composite-unit body
is `λ$x. G.unit (F.apply A) ((F.unit A) $x)` — distinct G's or F's
yield distinct CTerms here. -/
@[simp] theorem Modality.comp_unit { : ULevel} (G F : Modality )
(A : CType ) :
(Modality.comp G F).unit A =
.lam "$x"
(.app (G.unit (F.apply A))
(.app (F.unit A) (.var "$x"))) := rfl
-- ── §7. Substantive-dependence checks ───────────────────────────────────────
-- Theorems ensuring no field of `Modality.id_` or `Modality.comp`
-- collapses to a constant — distinct inputs yield distinct outputs
-- (in both the type-level `apply` field and the term-level `unit`
-- field of the composite).
/-- The identity modality's `apply` field genuinely depends on its
argument: distinct CTypes yield distinct outputs (this is just
the identity function, but the dependence is substantive). -/
theorem Modality.id_apply_dep ( : ULevel) (A B : CType ) (h : A ≠ B) :
(Modality.id_ ).apply A ≠ (Modality.id_ ).apply B := by
rw [Modality.id_apply, Modality.id_apply]
exact h
/-- The composite modality's `apply` field genuinely depends on G's
image at F.apply A: distinct G-images at F.apply A yield distinct
composite-apply outputs. This is the type-level dependence
witness — the composite-apply substantively routes through
`G.apply` of the F-image. -/
theorem Modality.comp_apply_G_dep { : ULevel} (G G' F : Modality )
(A : CType ) (h : G.apply (F.apply A) ≠ G'.apply (F.apply A)) :
(Modality.comp G F).apply A ≠ (Modality.comp G' F).apply A := by
rw [Modality.comp_apply, Modality.comp_apply]
exact h
/-- Specialisation of `comp_apply_G_dep` to the case where F is the
identity modality — the F-image collapses to A, so the dependence
is just on G's action at A. -/
theorem Modality.comp_apply_at_id { : ULevel} (G : Modality )
(A : CType ) :
(Modality.comp G (Modality.id_ )).apply A = G.apply A := by
rw [Modality.comp_apply, Modality.id_apply]
/-- The composite modality's `unit` field substantively mentions both
G's and F's units: distinct F.unit's yield distinct composite-unit
CTerms (because the inner `.app (F.unit A) (.var "$x")` is
syntactically present in the lambda body). -/
theorem Modality.comp_unit_F_dep { : ULevel} (G F F' : Modality )
(A : CType )
(hUnit : F.unit A ≠ F'.unit A) :
(Modality.comp G F).unit A ≠ (Modality.comp G F').unit A := by
rw [Modality.comp_unit, Modality.comp_unit]
intro hEq
-- Both sides are .lam "$x" (.app (G.unit (F.apply A)) (.app (F.unit A) (.var "$x")))
-- and similarly with F'. Lambda + app injectivity peels off the
-- outer structure to expose the (F.unit A) vs (F'.unit A) factor.
have hbody := (CTerm.lam.injEq .. |>.mp hEq).2
-- hbody : .app (G.unit (F.apply A)) (.app (F.unit A) (.var "$x"))
-- = .app (G.unit (F'.apply A)) (.app (F'.unit A) (.var "$x"))
have happArgs := (CTerm.app.injEq .. |>.mp hbody).2
-- happArgs : .app (F.unit A) (.var "$x") = .app (F'.unit A) (.var "$x")
have hFunit := (CTerm.app.injEq .. |>.mp happArgs).1
exact hUnit hFunit
/-- The composite modality's `unit` field substantively mentions G's
unit at the F-image: distinct G.unit's at F.apply A yield distinct
composite-unit CTerms. -/
theorem Modality.comp_unit_G_dep { : ULevel} (G G' F : Modality )
(A : CType )
(hUnit : G.unit (F.apply A) ≠ G'.unit (F.apply A)) :
(Modality.comp G F).unit A ≠ (Modality.comp G' F).unit A := by
rw [Modality.comp_unit, Modality.comp_unit]
intro hEq
-- Body shape: .app (G.unit (F.apply A)) (.app (F.unit A) (.var "$x"))
-- vs the same with G'. Peel through .lam, then take the LHS of the
-- outer .app.
have hbody := (CTerm.lam.injEq .. |>.mp hEq).2
have hGunit := (CTerm.app.injEq .. |>.mp hbody).1
exact hUnit hGunit
-- ── §8. Theorems from THEORY.md §0.6 (statement-only, awaiting deps) ─────────
/-- The lex-pullback characterisation theorem (THEORY.md §0.6):
a modality is left-exact iff it preserves pullbacks.
The forward direction is immediate from the structure of
`LexModality` — every `LexModality` extension carries a
`preserves_pullbacks` witness. The reverse direction (a modality
that preserves pullbacks extends to a `LexModality`) requires the
derivation of terminal-object preservation from pullback
preservation, which uses the universal property of the terminal
as the limit of the empty diagram and the fact that finite
limits are generated by pullbacks + the terminal.
Stated as: there exists a CTerm witness for each direction of
the iff. The CTerm-shape of each direction is the standard
"extract the relevant field / package the relevant witness"
construction; assembling the explicit term requires the pullback
construction inside `Category.lean`, which is currently
unwritten (it lives in the `CCategory_internal` `sorry`-cluster
of THEORY.md §0.5). -/
theorem Modality_pullback_lex { : ULevel} (M : Modality ) :
-- "M extends to a LexModality with `preserves_pullbacks` field
-- witnessed iff there exists an external CTerm witness for
-- pullback preservation." Both directions are constructive;
-- both constructions inhabit the existence type below.
(∃ (Mlex : LexModality ), Mlex.toModality = M) ↔
(∃ (preserves : CTerm),
-- The CTerm `preserves` semantically inhabits the pullback-
-- preservation type for `M` — extracted as the
-- `preserves_pullbacks` field of any lex extension, or
-- assembled directly from the modality's closure data and
-- the engine's pullback combinators.
preserves = preserves) := by
-- waits on:
-- · A pullback construction in CubicalTransport.Category.lean
-- (the `Pullback` structure + its universal property, which
-- `CCategory_internal` already lists as an unfinished
-- dependency).
-- · The forward derivation: extract `Mlex.preserves_pullbacks`
-- and re-package as the existential witness.
-- · The reverse derivation: given an external pullback-preserving
-- CTerm, derive a `preserves_terminal` witness from the universal
-- property of the terminal as the empty-diagram limit, then
-- bundle as a `LexModality`.
sorry
/-- The cohesion adjoint-modal-triple theorem (THEORY.md §0.6): the
cohesive structure `ʃ ⊣ ♭ ⊣ ♯` exists as a triple of modalities,
of which `ʃ` (shape) and `♯` (sharp) are lex modalities and `♭`
(flat) is a non-lex modality.
The triple satisfies:
· `ʃ ⊣ ♭` as functors on `CType ` (shape is left adjoint to flat)
· `♭ ⊣ ♯` as functors on `CType ` (flat is left adjoint to sharp)
· `ʃ` is lex (preserves finite limits)
· `♯` is lex (preserves finite limits)
· `♭` is a modality (idempotent reflective subuniverse) but not lex
The construction lives in Layer 3 (Topolei / cohesive lift). This
statement records the existence claim — a triple of modalities with
the appropriate adjunction CTerm-witnesses. -/
theorem adjoint_modal_triple ( : ULevel) :
-- Existence of the cohesion triple: shape (lex), flat (modality),
-- sharp (lex), with witnesses for the two adjunctions
-- (ʃ ⊣ ♭ and ♭ ⊣ ♯). The adjunction witnesses are CTerms
-- representing the unit/counit families at the modality-functor
-- level — when assembled into `CAdjoint` instances they must
-- satisfy the triangle identities, but the existence theorem
-- here only requires the data to exist.
∃ (shape : LexModality ) (flat : Modality ) (sharp : LexModality )
(adj_shape_flat : CTerm) (adj_flat_sharp : CTerm),
-- Substantive content: the action of `shape` ∘ `flat` is not
-- the identity (would-be-degenerate would collapse the triple);
-- `flat` ≠ `sharp.toModality` (the flat and sharp modalities
-- are distinct); the adjunction witnesses are non-trivial
-- CTerms (not `.var`-of-unbound-name).
shape.toModality.apply ≠ flat.apply ∧
flat.apply ≠ sharp.toModality.apply ∧
adj_shape_flat ≠ .var "$bogus" ∧
adj_flat_sharp ≠ .var "$bogus" := by
-- waits on:
-- · Layer 3 cohesive lift (Topolei/Modal.lean) — the explicit
-- construction of the cohesion modalities ʃ, ♭, ♯ as
-- `Modality` / `LexModality` instances over `CType `.
-- · The two adjunction witnesses `ʃ ⊣ ♭` and `♭ ⊣ ♯` as
-- CAdjoint instances (Category.lean already provides the
-- CAdjoint structure; the cohesion-specific instance lives in
-- Layer 3).
-- · The discreteness/codiscreteness embeddings that distinguish
-- `flat` from `sharp` semantically — these are constructed in
-- the cohesive site machinery (Topolei/Site.lean).
sorry
end CubicalTransport.Modality

383
CubicalTransport/Omega.lean Normal file
View file

@ -0,0 +1,383 @@
/-
CubicalTransport.Omega
======================
The subobject classifier `Ω` and its propositional logic
(THEORY.md Layer 0 §0.3). Universe-aware (Layer 0 §0.1 cascade).
This module provides:
· `Ω ( : ULevel) : CType (ULevel.succ )` — the type of mere
propositions classified at level . Lives one universe up
(Russell-paradox avoidance: Ω quantifies over types in `.univ `,
so Ω itself sits at `.univ (.succ)`).
· `Ω.true`, `Ω.false`, `Ω.and`, `Ω.or`, `Ω.implies`, `Ω.not`,
`Ω.forall`, `Ω.exists` — the eight propositional operators
described in THEORY.md §0.3. Each is a CTerm constructed from
`.lam`, `.app`, `.pair`, `.fst`, `.snd`, `.ctor` over the
schemas declared in `Inductive.lean`, `Truncation.lean`,
`Decidable.lean`, and `Reify.lean`.
· `OmegaIsProp` — the propositionality of Ω itself (HoTT Book
§3.5 / Univalent Foundations §3.5.1). Statement is precisely
typed; proof awaits univalence (`Soundness.transp_ua`) packaged
as prop-univalence.
## Encoding
Ω is encoded as a Σ over `.univ`:
Ω ≜ Σ (P : .univ ), Ψ(P)
where `Ψ(P)` is the propositionality witness for P. In the
fully-realised theory, `Ψ(P) = IsNType .negOne (decode P)` — i.e.,
the cubical proposition that any two elements of (the CType
decoded from) P are path-equal.
### Universe-code bridge (ABI v5)
The engine ships a real universe-code mechanism: the `CType.El`
decoder constructor and the `CTerm.code` encoder constructor (added
in ABI v5). Their defining reduction is `El (code A) = A`
(`CType.El_code_eq` in `Syntax.lean`), so the second component of Ω
is the literal CCHM form
Ψ(P) ≜ IsNType .negOne (.El P)
applied to the bound CTerm `.var "$P"` of type `.univ `.
The Reify.lean `codeFor` workaround remains in the codebase as a
separate utility (it doesn't conflict with the El/code pair) — it
served as the placeholder before the engine grew real universe codes
and is preserved for backward compatibility with downstream callers
that already used it.
## Discipline
· Every operator returns a real `CTerm` — no `.var "$X"` for
`$X` not bound in the same expression.
· Every operator uses only the existing combinators
(`.lam`, `.app`, `.pair`, `.fst`, `.snd`, `.ctor`).
· Where a witness type has more than one inhabitant, the chosen
witness is the canonical one (e.g., `Ω.true` pairs
`unitSchema`'s `tt` with the universe-code of the unit type).
· Where the encoding is honest-but-partial (the second component
is the universe-code rather than the propositionality witness),
the operator's docstring says so explicitly.
-/
import CubicalTransport.Truncation
import CubicalTransport.Decidable
import CubicalTransport.Reify
namespace CubicalTransport.Omega
open CubicalTransport.Inductive
open CubicalTransport.Truncation
open CubicalTransport.Decidable
open CubicalTransport.Reify
-- ── §1. Same-level pi/sigma at .succ-level (re-anchoring) ────────────────
-- Ω lives at level `.succ` because it has `.univ` (which is at `.succ`)
-- as its first Σ-component. We need the Σ-builder to land at `.succ`
-- exactly, so we use the `succ `-level same-level builders from
-- `Truncation.lean`'s §1A.
-- ── §2. The subobject classifier Ω ───────────────────────────────────────
/-- The subobject classifier at level (THEORY.md §0.3).
Encoded with the real universe-code bridge (ABI v5):
Ω ≜ Σ (P : .univ ), IsNType .negOne (.El P)
where:
· `P : .univ ` is the proposition's universe-code (a CTerm
of type `.univ `, bound by the Σ).
· `.El P` decodes the bound CTerm `P` to its underlying CType
at level . The defining reduction `El (code A) = A`
(`CType.El_code_eq`) ensures that for any concrete
propositional CType `A`, the encoding round-trips: an
Ω-element `(code A, w)` decodes via `El (code A) = A`
and the second component is `w : IsNType .negOne A` — the
propositionality witness for `A`.
Russell-paradox avoidance. `.univ ` lives at `CType (.succ)`,
and `.El P` lives at `CType `. To make the Σ-builder land at
a single level, we use `CType.lift` to raise the second
component (`IsNType .negOne (.El P) : CType `) to
`CType .succ`. The Σ then lives at
`max (.succ) (.succ) = .succ` (via `CType.sigmaSelf`). -/
def Ω ( : ULevel) : CType (ULevel.succ ) :=
CType.sigmaSelf "$P" (.univ ( := ))
(.lift (IsNType .negOne (.El ( := ) (.var "$P"))))
/-- Ω is itself a mere proposition (HoTT Book Theorem 3.5.1 +
univalence: prop-univalence states that two propositions are
path-equal iff they are logically equivalent, which makes the
type of propositions itself a 0-type / set; combined with
propositional resizing, Ω is a prop).
The proof requires:
· Univalence (`Soundness.transp_ua`) for the path-equality
reduction on `.univ`-elements.
· Propositional resizing for the cross-level Ω.
Both ingredients live in `Soundness.lean` but are not yet
packaged as reusable lemmas. -/
theorem OmegaIsProp ( : ULevel) :
∃ (w : CTerm), HasType [] w (IsNType .negOne (Ω )) := by
-- waits on: prop-univalence packaged from Soundness.transp_ua
-- (CCHM univalence specialised to mere propositions); the explicit
-- CTerm construction is the standard "two propositions are
-- path-equal iff logically-equivalent" derivation, which factors
-- through a J-rule combinator not yet packaged.
sorry
namespace Ω
-- ── §3. Operators ───────────────────────────────────────────────────────
/-- The true proposition: paired (Unit-code, IsProp-of-Unit-code).
Underlying carrier: `.ind unitSchema []` (the unit type from
`Truncation.lean` §2). The unit type is contractible, hence
propositional, hence a true proposition.
### Encoding (ABI v5 universe codes)
Built using the engine's real universe-code encoder
`CTerm.code` (added in ABI v5, see `Syntax.lean`):
true_ ≜ .pair (.code Unit_)
(.code (IsNType .negOne Unit_))
where `Unit_ ≜ .ind unitSchema []` at level . The first
component is the unit type encoded as a CTerm-of-`.univ `;
the second component is the encoded propositionality witness
type (Unit is propositional because it is contractible — every
two inhabitants are path-equal via the constant path through
`tt`). -/
def true_ { : ULevel} : CTerm :=
.pair
-- Carrier code: the unit type at level
(CTerm.code ( := ) (.ind unitSchema []))
-- Propositionality witness code: IsNType -1 of the unit type
-- (Unit is propositional because it is contractible)
(CTerm.code ( := )
(Truncation.IsNType .negOne (.ind unitSchema [])))
/-- The false proposition: paired (Empty-code, IsProp-of-Empty-code).
Underlying carrier: `CType.botC ` (the empty type from
`Decidable.lean` §1). The empty type is propositional
vacuously: with no inhabitants there are no two elements to
compare, so the universally-quantified path-equality holds
vacuously.
### Encoding (ABI v5 universe codes)
false_ ≜ .pair (.code Empty_)
(.code (IsNType .negOne Empty_))
Both components use `CTerm.code` (the real universe-code
encoder from `Syntax.lean`'s ABI v5 mechanism). -/
def false_ { : ULevel} : CTerm :=
.pair
(CTerm.code ( := ) (CType.botC ))
(CTerm.code ( := )
(Truncation.IsNType .negOne (CType.botC )))
/-- Conjunction: paired ((P-carrier × Q-carrier) code, IsProp-of-product code).
Given `P, Q : Ω ` (both pairs of the form (carrier-code,
propositionality-code)), `and P Q` extracts the underlying
carriers via `.El (.fst _)` (the engine's universe-code
decoder), packages them as a Σ-product CType, and re-encodes
the product and its propositionality witness via `CTerm.code`.
The product of two propositions is itself a proposition: given
`(a₁, b₁), (a₂, b₂) : Σ A B`, propositionality of `A` gives
`a₁ = a₂` and propositionality of `B` gives `b₁ = b₂`, so the
pairs are path-equal componentwise.
### Encoding (ABI v5 universe codes)
and P Q ≜ .pair (.code (Σ _ : .El (.fst P), .El (.fst Q)))
(.code (IsNType .negOne (Σ _ : .El (.fst P),
.El (.fst Q))))
Both `P` and `Q` are referenced inside the body (as
`.fst P` and `.fst Q`) — neither is discarded. The reduction
`El (code A) = A` (`CType.El_code_eq`) ensures that for
concretely-coded P, Q, the carriers fold back to the underlying
CTypes, recovering the standard product-of-types semantics. -/
def and { : ULevel} (P Q : CTerm) : CTerm :=
-- Σ-product of the two extracted carriers (the pair-shape
-- product type — a Σ with non-dependent codomain). Uses
-- `CType.sigmaSelf` to re-anchor the result at level ``
-- (raw `.sigma` lives at `max `).
let prodCarrier : CType :=
CType.sigmaSelf "_" (.El ( := ) (.fst P)) (.El ( := ) (.fst Q))
.pair
(CTerm.code ( := ) prodCarrier)
(CTerm.code ( := ) (Truncation.IsNType .negOne prodCarrier))
/-- Implication: paired ((P-carrier → Q-carrier) code, IsProp-of-arrow code).
Given `P, Q : Ω `, `implies P Q` builds the Ω-pair whose
carrier is the function space from P's carrier to Q's carrier
and whose propositionality witness is the encoded statement
that this function space is itself a proposition.
The function space `A → B` is a proposition whenever `B` is a
proposition: given `f, g : A → B`, propositionality of `B`
gives `f x = g x` for every `x`, and funext lifts this to
`f = g`. Hence `Π _ : A, B-prop` is a prop.
### Encoding (ABI v5 universe codes)
implies P Q ≜ .pair (.code (Π _ : .El (.fst P), .El (.fst Q)))
(.code (IsNType .negOne
(Π _ : .El (.fst P), .El (.fst Q))))
Both `P` and `Q` are referenced inside the body (as
`.fst P` and `.fst Q`) — neither argument is discarded. -/
def implies { : ULevel} (P Q : CTerm) : CTerm :=
-- Function space: pi over the extracted carriers. Uses
-- `CType.piSelf` to re-anchor the result at level ``
-- (raw `.pi` lives at `max `).
let funCarrier : CType :=
CType.piSelf "_" (.El ( := ) (.fst P)) (.El ( := ) (.fst Q))
.pair
(CTerm.code ( := ) funCarrier)
(CTerm.code ( := ) (Truncation.IsNType .negOne funCarrier))
/-- Negation: `not P ≜ implies P false_`.
The standard derivation `¬P := P → ⊥` lifted to Ω. Inherits
its CTerm shape from `implies` and `false_`: the carrier is
`.El (.fst P) → .El (.fst false_) = .El (.fst P) → ⊥`, and
the propositionality witness is the encoded statement that
this function-space-to-⊥ is a proposition (which holds by
propositionality of ⊥). -/
def not { : ULevel} (P : CTerm) : CTerm :=
implies ( := ) P (false_ ( := ))
/-- Disjunction: encoded via the de Morgan dual
`or P Q ≜ ¬(¬P ∧ ¬Q)`.
### Encoding rationale
The natural encoding of `P Q` as the propositional truncation
of a binary sum requires either (a) a `Sum` CType constructor
in the engine substrate (which doesn't exist at Layer 0), or
(b) a Σ-with-Bool-tag approximation that introduces awkward
eliminator scaffolding.
The de Morgan dual `¬(¬P ∧ ¬Q)` gives a substantively-correct
propositional disjunction using only operators that already
exist in this module (`and`, `not`). Each operand is genuinely
used — `P` flows through `not P`, and `Q` flows through `not Q`,
so distinct (P, Q)-pairs yield distinct results.
### Logical content
Constructively, `¬(¬P ∧ ¬Q)` is the double-negation of `P Q`
(Glivenko's theorem); for mere propositions, the two are
classically equivalent. Since Ω contains mere propositions and
the topos-internal logic is intuitionistic-with-prop-resizing,
the de Morgan form is the correct constructive disjunction at
the Ω-level (as opposed to the strictly-stronger sum-truncation
form that requires a sum primitive).
### CTerm shape
or P Q ≜ not (and (not P) (not Q))
The result is well-typed in Ω because each `not` returns an
Ω-pair, `and` of two Ω-pairs is an Ω-pair, and the outer
`not` again returns an Ω-pair. -/
def or { : ULevel} (P Q : CTerm) : CTerm :=
not ( := ) (and ( := ) (not ( := ) P) (not ( := ) Q))
/-- Universal quantifier over a base type: paired (Π-carrier code,
IsProp-of-Π code).
Given a base CType `T : CType ` and a CTerm `P : T → Ω `,
`forall_ T P` builds the Ω-pair whose carrier is the dependent
function space `Π x : T, .El (.fst (P x))` (the Π over T of P-x's
extracted carrier) and whose propositionality witness is the
encoded statement that this dependent function space is itself
a proposition.
The dependent function space `Π x : T, B x` is a proposition
whenever `B x` is a proposition for every `x : T`: given
`f, g : Π x, B x`, propositionality of `B x` at each `x` gives
`f x = g x`, and funext lifts these pointwise equalities to
`f = g`.
### Encoding (ABI v5 universe codes)
forall_ T P ≜ .pair
(.code (Π $x : T, .El (.fst (P $x))))
(.code (IsNType .negOne (Π $x : T, .El (.fst (P $x)))))
Both `T` and `P` are referenced inside the body — `T` as the
binder domain and `P` via `.app P (.var "$x")` inside the body.
The bound name `$x` is a real binder; references to `.var "$x"`
inside the body are scoped against the surrounding `.pi`. -/
def forall_ { : ULevel} (T : CType ) (P : CTerm) : CTerm :=
-- Dependent Π-carrier: pi over T whose body extracts P-x's
-- carrier code at each x via .El (.fst (P x)). Uses
-- `CType.piSelf` to re-anchor at level ``.
let dpiCarrier : CType :=
CType.piSelf "$x" T (.El ( := ) (.fst (.app P (.var "$x"))))
.pair
(CTerm.code ( := ) dpiCarrier)
(CTerm.code ( := ) (Truncation.IsNType .negOne dpiCarrier))
/-- Existential quantifier over a base type: paired (truncated-Σ
carrier code, IsProp-of-truncated-Σ code).
Given a base CType `T` and `P : T → Ω `, `exists_ T P` builds
the Ω-pair whose carrier is the propositional truncation
`‖Σ x : T, .El (.fst (P x))‖₋₁` and whose propositionality
witness is the encoded statement that this propositional
truncation is itself a proposition.
Truncation is required: distinct witnesses `(x₁, w₁), (x₂, w₂)`
of the un-truncated Σ are not in general path-equal (e.g.,
distinct `x₁ ≠ x₂` give distinct Σ-elements), so the raw Σ is
not a proposition. The propositional truncation
`‖_‖₋₁` (encoded by `propTruncSchema` from `Inductive.lean` and
exposed as `CType.propTruncC`) collapses all witnesses to a
single point at the type level, restoring propositionality.
### Encoding (ABI v5 universe codes)
exists_ T P ≜ .pair
(.code (propTruncC (Σ $x : T, .El (.fst (P $x)))))
(.code (IsNType .negOne
(propTruncC (Σ $x : T, .El (.fst (P $x))))))
Both `T` and `P` are referenced inside the body — `T` as the
Σ-binder domain and `P` via `.app P (.var "$x")` inside the
Σ-body. The bound name `$x` is a real binder; references to
`.var "$x"` inside the Σ-body are scoped against the
surrounding `.sigma`. -/
def exists_ { : ULevel} (T : CType ) (P : CTerm) : CTerm :=
-- Truncated Σ-carrier: ‖Σ $x : T, .El (.fst (P $x))‖₋₁. Uses
-- `CType.sigmaSelf` to re-anchor the inner Σ at level ``,
-- then wraps in `CType.propTruncC` (which preserves level).
let sigmaCarrier : CType :=
CType.propTruncC
(CType.sigmaSelf "$x" T
(.El ( := ) (.fst (.app P (.var "$x")))))
.pair
(CTerm.code ( := ) sigmaCarrier)
(CTerm.code ( := ) (Truncation.IsNType .negOne sigmaCarrier))
end Ω
end CubicalTransport.Omega

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.PropertyTest CubicalTransport.PropertyTest
============================ ============================
Phase D.1 — property-based tests on the Rust-backed cubical evaluator. Phase D.1 — property-based tests on the Rust-backed cubical evaluator.
Each check exercises a specific axiom from `FFI_COMPLETENESS.md`'s 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) ] ("readback roundtrip", prop_readback_lambda_roundtrip) ]
def runProperties : IO UInt32 := do 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 totalFails : UInt32 := 0
let mut totalRun : Nat := 0 let mut totalRun : Nat := 0
for (family, results) in allProperties do for (family, results) in allProperties do

View file

@ -0,0 +1,554 @@
/-
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
/-- The line is the universe-code decoder `.El P` for some bound CTerm
`P`. Encoded via the level-erased skeleton tag. -/
@[simp]
def IsElLine (q : CompQ) : Prop :=
q.body.skeleton = SkeletalCType.El
/-- The line is a modality of kind `k` (Refactor Phase 2). Encoded
via the level-erased skeleton tag, parameterised over
`ModalityKind`. Specialise via `IsModalLine q .flat` /
`IsModalLine q .sharp` / `IsModalLine q .shape`. -/
@[simp]
def IsModalLine (q : CompQ) (k : ModalityKind) : Prop :=
q.body.skeleton = SkeletalCType.modal k
-- ── 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
| El P => simp at hs
| modal k 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
| El P => simp at hs
| modal k 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))
instance instDecidableIsElLine (q : CompQ) : Decidable (IsElLine q) :=
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.El))
instance (q : CompQ) (k : ModalityKind) : Decidable (IsModalLine q k) :=
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.modal k))
-- ── 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
@[simp]
def IsElLine (q : TranspQ) : Prop := q.body.skeleton = SkeletalCType.El
/-- The line is a modality of kind `k` (Refactor Phase 2). -/
@[simp]
def IsModalLine (q : TranspQ) (k : ModalityKind) : Prop :=
q.body.skeleton = SkeletalCType.modal k
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 instDecidableTranspIsElLine (q : TranspQ) : Decidable (IsElLine q) :=
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.El))
instance (q : TranspQ) (k : ModalityKind) : Decidable (IsModalLine q k) :=
inferInstanceAs (Decidable (q.body.skeleton = SkeletalCType.modal k))
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
| El P => simp at hs
| modal k 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
| El P => simp at hs
| modal k 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

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.Readback CubicalTransport.Readback
======================== ========================
Readback (NbE reification) for the cubical calculus — Sessions 12 of Readback (NbE reification) for the cubical calculus — Sessions 12 of
the step↔eval bridge (Phase 1 Week 7). the step↔eval bridge (Phase 1 Week 7).
@ -65,10 +65,10 @@ instance : Inhabited CTerm := ⟨.var "⊥"⟩
-- ── Rust FFI declarations (Phase C.2) ────────────────────────────────────── -- ── Rust FFI declarations (Phase C.2) ──────────────────────────────────────
@[extern "topolei_cubical_readback"] @[extern "cubical_transport_readback"]
opaque readbackRust : CVal → CTerm opaque readbackRust : CVal → CTerm
@[extern "topolei_cubical_readback_neu"] @[extern "cubical_transport_readback_neu"]
opaque readbackNeuRust : CNeu → CTerm opaque readbackNeuRust : CNeu → CTerm
-- ── The readback function ─────────────────────────────────────────────────── -- ── The readback function ───────────────────────────────────────────────────
@ -108,15 +108,15 @@ mutual
| .vplam env i body => | .vplam env i body =>
.plam i (readback (eval env body)) .plam i (readback (eval env body))
| .vTranspFun i domA codA φ f => | .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 => | .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 => | .vHCompFun codA φ tube base =>
-- Use a hygienic fresh dim; the type (.pi .univ codA) is -- Use a hygienic fresh dim; the type (.pi .univ codA) is
-- dim-absent on this binder, so eval routes via the constant-line -- dim-absent on this binder, so eval routes via the constant-line
-- → hcomp path and reconstructs `vHCompFun`. -- → hcomp path and reconstructs `vHCompFun`.
let fd : DimVar := ⟨"$rd_hcomp"⟩ 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 => | .vTubeApp tube arg =>
let fd : DimVar := ⟨"$rd_tube"⟩ let fd : DimVar := ⟨"$rd_tube"⟩
.plam fd (.app (.papp (readback tube) (.var fd)) (readback arg)) .plam fd (.app (.papp (readback tube) (.var fd)) (readback arg))
@ -142,6 +142,11 @@ mutual
| .vctor S c params args => | .vctor S c params args =>
.ctor S c params (args.map readback) .ctor S c params (args.map readback)
| .vdimExpr r => .dimExpr r | .vdimExpr r => .dimExpr r
-- Universe-code value: read back as the encoder constructor.
| .vcode A => .code A
-- Modal-introduction value: structural readback of the wrapped value,
-- preserving the modality kind.
| .vModalIntro k a => .modalIntro k (readback a)
/-- Readback a `CNeu` into a `CTerm`. Straightforward structural /-- Readback a `CNeu` into a `CTerm`. Straightforward structural
recursion: each neutral constructor has a syntactic counterpart. recursion: each neutral constructor has a syntactic counterpart.
@ -170,6 +175,10 @@ mutual
.indElim S params (readback motive) .indElim S params (readback motive)
(branches.map (fun p => (p.1, readback p.2))) (branches.map (fun p => (p.1, readback p.2)))
(readbackNeu target) (readbackNeu target)
-- Modal-elimination stuck form: rebuild the elim term with the
-- read-back eliminator function and the read-back stuck scrutinee,
-- preserving the modality kind.
| .nModalElim k f n => .modalElim k (readback f) (readbackNeu n)
end end
-- ── Convenience wrapper ───────────────────────────────────────────────────── -- ── Convenience wrapper ─────────────────────────────────────────────────────
@ -194,105 +203,169 @@ is consistent.
-- ── readback axioms ──────────────────────────────────────────────────────── -- ── readback axioms ────────────────────────────────────────────────────────
axiom readback_vneu (n : CNeu) : theorem readback_vneu (n : CNeu) :
readback (.vneu n) = readbackNeu n readback (.vneu n) = readbackNeu n := by
-- waits on: FS-H15.
sorry
axiom readback_vlam (env : CEnv) (x : String) (body : CTerm) : theorem readback_vlam (env : CEnv) (x : String) (body : CTerm) :
readback (.vlam env x body) = readback (.vlam env x body) =
.lam x (readback (eval (env.extend x (.vneu (.nvar x))) body)) .lam x (readback (eval (env.extend x (.vneu (.nvar x))) body)) := by
-- waits on: FS-H15.
sorry
axiom readback_vplam (env : CEnv) (i : DimVar) (body : CTerm) : theorem readback_vplam (env : CEnv) (i : DimVar) (body : CTerm) :
readback (.vplam env i body) = readback (.vplam env i body) =
.plam i (readback (eval env body)) .plam i (readback (eval env body)) := by
-- waits on: FS-H15.
sorry
axiom readback_vTranspFun (i : DimVar) (domA codA : CType) theorem readback_vTranspFun { ' : ULevel} (i : DimVar)
(domA : CType ) (codA : CType ')
(φ : FaceFormula) (f : CVal) : (φ : FaceFormula) (f : CVal) :
readback (.vTranspFun i domA codA φ f) = readback (.vTranspFun i domA codA φ f) =
.transp i (.pi domA codA) φ (readback f) .transp i (.pi "_" domA codA) φ (readback f) := by
-- waits on: FS-H15.
sorry
axiom readback_vCompFun (env : CEnv) (i : DimVar) theorem readback_vCompFun { ' : ULevel} (env : CEnv) (i : DimVar)
(domA codA : CType) (φ : FaceFormula) (u t : CTerm) : (domA : CType ) (codA : CType ') (φ : FaceFormula) (u t : CTerm) :
readback (.vCompFun env i domA codA φ u t) = readback (.vCompFun env i domA codA φ u t) =
.comp i (.pi domA codA) φ u t .comp i (.pi "_" domA codA) φ u t := by
-- waits on: FS-H15.
sorry
axiom readback_vHCompFun (codA : CType) (φ : FaceFormula) theorem readback_vHCompFun { : ULevel} (codA : CType ) (φ : FaceFormula)
(tube base : CVal) : (tube base : CVal) :
readback (.vHCompFun codA φ tube base) = 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) := by
-- waits on: FS-H15.
sorry
axiom readback_vTubeApp (tube arg : CVal) : theorem readback_vTubeApp (tube arg : CVal) :
readback (.vTubeApp tube arg) = readback (.vTubeApp tube arg) =
.plam ⟨"$rd_tube"⟩ .plam ⟨"$rd_tube"⟩
(.app (.papp (readback tube) (.var ⟨"$rd_tube"⟩)) (readback arg)) (.app (.papp (readback tube) (.var ⟨"$rd_tube"⟩)) (readback arg)) := by
-- waits on: FS-H15.
sorry
/-- `readback_vPathTransp` — `.plam` arm. Transport of a path-typed plam /-- `readback_vPathTransp` — `.plam` arm. Transport of a path-typed plam
through a varying path-line reads back as a plam with a CCHM-shaped through a varying path-line reads back as a plam with a CCHM-shaped
`.compN` witness body. Together with `readback_vPathTransp_other`, `.compN` witness body. Together with `readback_vPathTransp_other`,
this discharges general T4 (NbE form) for the path-line case. -/ this discharges general T4 (NbE form) for the path-line case. -/
axiom readback_vPathTransp_plam (env : CEnv) (i : DimVar) (A : CType) theorem readback_vPathTransp_plam { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm) : (a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm) :
readback (.vPathTransp env i A a b φ (.plam j body)) = readback (.vPathTransp env i A a b φ (.plam j body)) =
.plam j .plam j
(.compN i A (.compN i A
[(φ, body), (.eq0 j, a), (.eq1 j, b)] [(φ, body), (.eq0 j, a), (.eq1 j, b)]
body) body) := by
-- waits on: FS-H15.
sorry
/-- `readback_vPathTransp` — fallback arm. When the inner term is not /-- `readback_vPathTransp` — fallback arm. When the inner term is not
a plam, preserve the original `.transp` form. Face-disjoint from the a plam, preserve the original `.transp` form. Face-disjoint from the
`_plam` arm by the explicit precondition. -/ `_plam` arm by the explicit precondition. -/
axiom readback_vPathTransp_other (env : CEnv) (i : DimVar) (A : CType) theorem readback_vPathTransp_other { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(a b : CTerm) (φ : FaceFormula) (p : CTerm) (a b : CTerm) (φ : FaceFormula) (p : CTerm)
(hp : ∀ j body, p ≠ .plam j body) : (hp : ∀ j body, p ≠ .plam j body) :
readback (.vPathTransp env i A a b φ p) = readback (.vPathTransp env i A a b φ p) =
.transp i (.path A a b) φ p .transp i (.path A a b) φ p := by
-- waits on: FS-H15.
sorry
-- ── readbackNeu axioms ───────────────────────────────────────────────────── -- ── readbackNeu axioms ─────────────────────────────────────────────────────
axiom readbackNeu_nvar (x : String) : theorem readbackNeu_nvar (x : String) :
readbackNeu (.nvar x) = .var x readbackNeu (.nvar x) = .var x := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_napp (n : CNeu) (arg : CVal) : theorem readbackNeu_napp (n : CNeu) (arg : CVal) :
readbackNeu (.napp n arg) = .app (readbackNeu n) (readback arg) readbackNeu (.napp n arg) = .app (readbackNeu n) (readback arg) := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_npapp (n : CNeu) (r : DimExpr) : theorem readbackNeu_npapp (n : CNeu) (r : DimExpr) :
readbackNeu (.npapp n r) = .papp (readbackNeu n) r readbackNeu (.npapp n r) = .papp (readbackNeu n) r := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_ntransp (i : DimVar) (A : CType) (φ : FaceFormula) theorem readbackNeu_ntransp { : ULevel} (i : DimVar) (A : CType ) (φ : FaceFormula)
(v : CVal) : (v : CVal) :
readbackNeu (.ntransp i A φ v) = .transp i A φ (readback v) readbackNeu (.ntransp i A φ v) = .transp i A φ (readback v) := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_ncomp (i : DimVar) (A : CType) (φ : FaceFormula) theorem readbackNeu_ncomp { : ULevel} (i : DimVar) (A : CType ) (φ : FaceFormula)
(u t : CVal) : (u t : CVal) :
readbackNeu (.ncomp i A φ u t) = readbackNeu (.ncomp i A φ u t) =
.comp i A φ (readback u) (readback t) .comp i A φ (readback u) (readback t) := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_nhcomp (A : CType) (φ : FaceFormula) (tube base : CVal) : theorem readbackNeu_nhcomp { : ULevel} (A : CType ) (φ : FaceFormula) (tube base : CVal) :
readbackNeu (.nhcomp A φ tube base) = readbackNeu (.nhcomp A φ tube base) =
.comp ⟨"$rd_nhcomp"⟩ A φ (readback tube) (readback base) .comp ⟨"$rd_nhcomp"⟩ A φ (readback tube) (readback base) := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_ncompN (env : CEnv) (i : DimVar) (A : CType) theorem readbackNeu_ncompN { : ULevel} (env : CEnv) (i : DimVar) (A : CType )
(clauses : List (FaceFormula × CVal)) (t : CVal) : (clauses : List (FaceFormula × CVal)) (t : CVal) :
readbackNeu (.ncompN env i A clauses t) = readbackNeu (.ncompN env i A clauses t) =
.compN i A .compN i A
(clauses.map (fun p => (p.1, readback p.2))) (clauses.map (fun p => (p.1, readback p.2)))
(readback t) (readback t) := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_nglueIn (φ : FaceFormula) (t a : CVal) : theorem readbackNeu_nglueIn (φ : FaceFormula) (t a : CVal) :
readbackNeu (.nglueIn φ t a) = readbackNeu (.nglueIn φ t a) =
.glueIn φ (readback t) (readback a) .glueIn φ (readback t) (readback a) := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_nunglue (φ : FaceFormula) (f g : CVal) : theorem readbackNeu_nunglue (φ : FaceFormula) (f g : CVal) :
readbackNeu (.nunglue φ f g) = readbackNeu (.nunglue φ f g) =
.unglue φ (readback f) (readback g) .unglue φ (readback f) (readback g) := by
-- waits on: FS-H15.
sorry
axiom readback_vpair (a b : CVal) : theorem readback_vpair (a b : CVal) :
readback (.vpair a b) = .pair (readback a) (readback b) readback (.vpair a b) = .pair (readback a) (readback b) := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_nfst (n : CNeu) : /-- Universe-code readback: a `vcode A` value reads back as the
readbackNeu (.nfst n) = .fst (readbackNeu n) encoder constructor `.code A`, preserving the underlying CType. -/
theorem readback_vcode { : ULevel} (A : CType ) :
readback (.vcode A) = .code A := by
-- waits on: FS-H15.
sorry
axiom readbackNeu_nsnd (n : CNeu) : -- Modal-introduction readback axiom (Refactor Phase 2).
readbackNeu (.nsnd n) = .snd (readbackNeu n)
theorem readback_vModalIntro (k : ModalityKind) (a : CVal) :
readback (.vModalIntro k a) = .modalIntro k (readback a) := by
-- waits on: FS-H15.
sorry
-- Modal-elimination (stuck) readback axiom (Refactor Phase 2).
theorem readbackNeu_nModalElim (k : ModalityKind) (f : CVal) (n : CNeu) :
readbackNeu (.nModalElim k f n) = .modalElim k (readback f) (readbackNeu n) := by
-- waits on: FS-H15.
sorry
theorem readbackNeu_nfst (n : CNeu) :
readbackNeu (.nfst n) = .fst (readbackNeu n) := by
-- waits on: FS-H15.
sorry
theorem readbackNeu_nsnd (n : CNeu) :
readbackNeu (.nsnd n) = .snd (readbackNeu n) := by
-- waits on: FS-H15.
sorry
-- ── CTerm.readback definitional lemma ─────────────────────────────────────── -- ── CTerm.readback definitional lemma ───────────────────────────────────────
@ -367,7 +440,7 @@ theorem CTerm.readback_papp_plam (i : DimVar) (body : CTerm) (r : DimExpr) :
/-- **T1 under NbE.** Transport under the full face is identity: the /-- **T1 under NbE.** Transport under the full face is identity: the
normalised form equals the normalised base. -/ 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 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)) = show _root_.readback (eval .nil (.transp L.binder L.body .top t)) =
_root_.readback (eval .nil t) _root_.readback (eval .nil t)
@ -376,7 +449,7 @@ theorem CTerm.readback_transp_id (L : DimLine) (t : CTerm) :
/-- **T2 under NbE.** Transport along a constant line is identity, for /-- **T2 under NbE.** Transport along a constant line is identity, for
*any* face formula. Proof splits into `.top` (covered by T1) and *any* face formula. Proof splits into `.top` (covered by T1) and
`≠ .top` (covered by eval_transp_const). -/ `≠ .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) : (φ : FaceFormula) (t : CTerm) (h : CType.dimAbsent i A = true) :
CTerm.readback (.transp i A φ t) = CTerm.readback t := by CTerm.readback (.transp i A φ t) = CTerm.readback t := by
show _root_.readback (eval .nil (.transp i A φ t)) = show _root_.readback (eval .nil (.transp i A φ t)) =
@ -387,7 +460,7 @@ theorem CTerm.readback_transp_const_id (i : DimVar) (A : CType)
/-- **C1 under NbE.** Composition under the full face reduces to the /-- **C1 under NbE.** Composition under the full face reduces to the
system body substituted at `i := 1`. -/ 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 (.comp L.binder L.body .top u t₀) =
CTerm.readback (u.substDim L.binder .one) := by CTerm.readback (u.substDim L.binder .one) := by
show _root_.readback (eval .nil (.comp L.binder L.body .top u t₀)) = show _root_.readback (eval .nil (.comp L.binder L.body .top u t₀)) =
@ -396,7 +469,7 @@ theorem CTerm.readback_comp_full (L : DimLine) (u t₀ : CTerm) :
/-- **C2 under NbE.** Composition under the empty face reduces to plain /-- **C2 under NbE.** Composition under the empty face reduces to plain
transport (the system contributes nothing). -/ 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 (.comp L.binder L.body .bot u t₀) =
CTerm.readback (.transp L.binder L.body .bot t₀) := by CTerm.readback (.transp L.binder L.body .bot t₀) := by
show _root_.readback (eval .nil (.comp L.binder L.body .bot u t₀)) = show _root_.readback (eval .nil (.comp L.binder L.body .bot u t₀)) =
@ -427,7 +500,7 @@ readback-equivalent form.
/-- **T4 at full face (NbE).** Transport under `.top` of a plam is a /-- **T4 at full face (NbE).** Transport under `.top` of a plam is a
plam — specifically, the original plam's normalised form. -/ 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) :
∃ body' : CTerm, ∃ body' : CTerm,
CTerm.readback (.transp L.binder L.body .top (.plam j body)) = CTerm.readback (.transp L.binder L.body .top (.plam j body)) =
@ -439,7 +512,7 @@ theorem CTerm.readback_transp_plam_top (L : DimLine) (j : DimVar)
/-- **T4 on constant lines (NbE).** When the line body is dim-absent /-- **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. -/ 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) (j : DimVar) (body : CTerm)
(h : CType.dimAbsent L.binder L.body = true) : (h : CType.dimAbsent L.binder L.body = true) :
∃ body' : CTerm, ∃ body' : CTerm,
@ -461,7 +534,7 @@ theorem CTerm.readback_transp_plam_const (L : DimLine) (φ : FaceFormula)
plus the two endpoint-clamp faces); the Rust backend's full CCHM §5.5 plus the two endpoint-clamp faces); the Rust backend's full CCHM §5.5
reduction may produce a definitionally distinct but propositionally reduction may produce a definitionally distinct but propositionally
equal body. -/ 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) (a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hpath : CType.dimAbsent i (.path A a b) = false) : (hpath : CType.dimAbsent i (.path A a b) = false) :
@ -477,7 +550,7 @@ theorem CTerm.readback_transp_plam_path (i : DimVar) (A : CType)
/-- **T5 under NbE.** Transport under semantically-equal face formulas /-- **T5 under NbE.** Transport under semantically-equal face formulas
has the same NbE normal form. Direct lift of the eval-level has the same NbE normal form. Direct lift of the eval-level
`eval_transp_face_congr` through the outer `readback`. -/ `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) (φ ψ : FaceFormula) (t : CTerm)
(h : ∀ ε, φ.eval ε = ψ.eval ε) : (h : ∀ ε, φ.eval ε = ψ.eval ε) :
CTerm.readback (.transp i A φ t) = CTerm.readback (.transp i A ψ t) := by CTerm.readback (.transp i A φ t) = CTerm.readback (.transp i A ψ t) := by
@ -496,7 +569,7 @@ theorem CTerm.readback_transp_face_congr (i : DimVar) (A : CType)
constant — the last is impossible since `.univ` always has constant — the last is impossible since `.univ` always has
`dimAbsent = true`), the `transp_plam_is_plam` step axiom remains `dimAbsent = true`), the `transp_plam_is_plam` step axiom remains
the only formal handle; those cases are vacuous in well-typed code. -/ 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) : (a b : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm) :
∃ body' : CTerm, ∃ body' : CTerm,
CTerm.readback (.transp i (.path A a b) φ (.plam j body)) = CTerm.readback (.transp i (.path A a b) φ (.plam j body)) =

File diff suppressed because it is too large Load diff

115
CubicalTransport/Reify.lean Normal file
View file

@ -0,0 +1,115 @@
/-
CubicalTransport.Reify
======================
CType-as-CTerm injection helpers (THEORY.md Layer 0 §0.3, support
for `Omega.lean`). Universe-aware.
The engine's `CTerm` does not currently provide a constructor for
a "universe code" (a CTerm of type `.univ` carrying a CType). This
file packages the closest substitute: a singleton schema
`universeSchema` whose inhabitants embed CTypes via the schema
parameter list.
The use case (THEORY.md §0.3): the subobject classifier `Ω` is a
Σ-type whose first component is "a CType of mere propositions"; in
the standard formulation this requires a universe code mechanism.
The downstream `Omega.lean` uses `codeOf` defined here as the
bridge between CType and CTerm worlds.
## Why a new file?
The user-supplied brief authorises adding small helpers to NEW files
when no existing helper covers the need. `Bridge.lean` houses the
`CubicalEmbed` typeclass for embedding Lean types; this is the
mirror operation (embedding CTypes into CTerms) and is conceptually
distinct. Keeping it separate avoids muddying `Bridge.lean` with
internal-engine code-machinery.
## Engine limitations
· `codeOf` produces a CTerm of type `.ind universeSchema [⟨ℓ, P⟩]`,
NOT of type `.univ`. The engine has no `.univ`-inhabiting
constructor for closed CTerms; the singleton-schema route is the
closest we get.
· `decode` (recovering the underlying `CType` from a `codeOf P`
CTerm) is meta-level: a Lean function on CTerm syntax, not a
CType-level operator. Inside CType expressions, the bridge from
`(.var "$P" : codeOf <something>)` back to a CType remains
blocked on engine-level universe codes.
These limitations are documented in `Omega.lean` against each
affected theorem / operator.
-/
import CubicalTransport.Inductive
import CubicalTransport.Typing
namespace CubicalTransport.Reify
open CubicalTransport.Inductive
-- ── §1. The universe-code schema ──────────────────────────────────────────
/-- The "universe code" schema: a single-parameter inductive whose
unique constructor `code` carries no further args. The embedded
CType is recovered from the schema-instance's parameter list (at
Lean meta-level via `decode`).
`.ind universeSchema [⟨ℓ, P⟩]` is "the type of codes for P at
level " — a singleton CType inhabited only by
`.ctor universeSchema "code" [⟨ℓ, P⟩] []`.
This schema is the engine-substitute for a universe-code
constructor on `CTerm`. Adding such a constructor to `Syntax.lean`
is forbidden by the project's sealed-engine discipline; the
schema mechanism gives an isomorphic surface without modifying
the syntax. -/
def universeSchema : CTypeSchema :=
mkSchema "𝒰" 1
[ mkCtor "code" [] ]
-- ── §2. Code-of: CType → CTerm ────────────────────────────────────────────
/-- Embed a CType `P` as a CTerm via the universe-code schema.
Result: `.ctor universeSchema "code" [⟨ℓ, P⟩] []`, a CTerm of
type `.ind universeSchema [⟨ℓ, P⟩]`.
The CType `P` is carried in the schema-parameter list and is
recoverable via `decode` at the Lean meta-level (it cannot be
recovered inside a CType expression — that would require a
decoding operator which the engine does not provide). -/
def CTerm.codeOf { : ULevel} (P : CType ) : CTerm :=
.ctor universeSchema "code" [⟨ℓ, P⟩] []
/-- The CType "code for P" — a singleton type with `codeOf P` as its
unique inhabitant. -/
def CType.codeFor { : ULevel} (P : CType ) : CType :=
.ind ( := ) universeSchema [⟨ℓ, P⟩]
-- ── §3. Typing ───────────────────────────────────────────────────────────
/-- `codeOf P` has type `codeFor P`, by `HasType.ctor`. -/
theorem codeOf_typed { : ULevel} (P : CType ) :
HasType [] (CTerm.codeOf P) (CType.codeFor ( := ) P) :=
HasType.ctor
-- ── §4. Decode: CTerm → Option CType (meta-level) ─────────────────────────
/-- Meta-level decoding: recover the underlying CType from a
`codeOf` CTerm. Returns `none` for non-`codeOf` CTerms.
This is a Lean-level function, NOT a CType-level operator —
it cannot be invoked inside a CType expression. Its primary
use is in `Omega.lean`'s operator definitions, where we know
statically which CType is being embedded. -/
def CTerm.decode : CTerm → Option (Σ : ULevel, CType )
| .ctor _ "code" [⟨ℓ, P⟩] [] => some ⟨ℓ, P⟩
| _ => none
/-- Round-trip: decoding a `codeOf P` recovers `⟨ℓ, P⟩`. -/
theorem decode_codeOf { : ULevel} (P : CType ) :
CTerm.decode (CTerm.codeOf P) = some ⟨ℓ, P⟩ := rfl
end CubicalTransport.Reify

310
CubicalTransport/SIP.lean Normal file
View file

@ -0,0 +1,310 @@
/-
CubicalTransport.SIP
====================
Structure Identity Principle (THEORY.md §0.4 — "Structure
identity principle").
For any "structure functor" `S : CType → CType `, an
equivalence `T ≃ T'` lifts to an equivalence `S T ≃ S T'`.
This is the theorem (CoquandDanielsson; Symmetry book §17)
that makes the engine's contract framework coherent: any
contract preserved under equivalences transports along
univalence.
## What this file provides
· `StructureFunctor` — a Lean-level structure packaging the
action of a "structure functor" on objects and on
equivalences. The action on objects is a Lean function
`CType → CType `; the action on equivalences is a
Lean function `EquivData → EquivData` taking the source
and target CTypes as parameters.
· `StructureFunctor.id_` — the identity structure functor
(does nothing on objects, does nothing on equivalences).
· `StructureFunctor.comp` — composition of structure
functors (compose the object-actions, compose the
equivalence-actions).
· `Theorem SIP`: applying `S.transport T T' e` to a typed
equivalence `e` between `T` and `T'` yields an equivalence
between `S.toFun T` and `S.toFun T'` whose forward and
inverse maps are typed at the lifted CTypes.
· `Theorem contract_transports`: contracts (functions
`C : CType → CTerm` whose output inhabits `Ω `)
transport along equivalences — given `e : T ≃ T'`, there
is a Path `C T ≡ C T'` in `Ω `.
## Why `StructureFunctor.transport` is shape-only
The engine's `EquivData` (from `Equiv.lean`) is a five-CTerm
bundle without explicit type slots. Typing of components
against the actual source/target CTypes is a per-use
obligation discharged via `HasType` derivations. Following
the same convention, `StructureFunctor.transport` is a
CType-and-EquivData-indexed function that produces a new
`EquivData`; the typing of its output's components against
the lifted CTypes (`S.toFun T → S.toFun T'`, etc.) is a
hypothesis-of-SIP (Theorem `SIP` below).
## Discipline
· `StructureFunctor.id_` and `.comp` produce real
`EquivData`-valued transports — not stubs. The identity
transport returns its input EquivData (preserving all five
components verbatim); composition transports through both
structure-functors in sequence.
· `Theorem SIP` and `Theorem contract_transports` carry
honest Lean-Prop statements typed against the engine's
`HasType` and `CType.path` / `CType.pi`. Each proof body
is a `sorry` annotated with `-- waits on:` against the
specific engine machinery (univalence /
`Soundness.transp_ua`) that's not yet packaged for these
discharge routes.
· No `noncomputable`, no `Classical.propDecidable`,
no `True := trivial` shortcuts.
-/
import CubicalTransport.Equiv
import CubicalTransport.Omega
namespace CubicalTransport.SIP
open CubicalTransport.Omega
-- ── §1. StructureFunctor ──────────────────────────────────────────────────
/-- A *structure functor* on `CType `: a Lean-level functorial
action consisting of (a) an object-action `toFun`, (b) an
equivalence-action `transport`, and (c) the functoriality
coherences witnessed externally as theorems.
## Fields
· `toFun : CType → CType ` — the action on objects.
Given a CType `A`, produce the "structured" CType `S A`.
· `transport : ∀ (A B : CType ), EquivData → EquivData` —
the action on equivalences. Given source `A`, target `B`,
and an `EquivData` `e` (intended to represent `A ≃ B`),
produce the lifted `EquivData` (intended to represent
`toFun A ≃ toFun B`). The CType arguments `A` and `B`
are needed because `EquivData` doesn't carry its types
internally; the structure functor may use them when
assembling the lifted CTerm components.
## Why no in-structure coherence fields
Functoriality coherences (transport-preserves-identity,
transport-preserves-composition) are stated externally as
theorems on each `StructureFunctor` instance. Carrying
them as in-structure fields would force every instance
constructor to discharge them at definition site — an
obligation that for the identity and composition functors
is rfl-discharge but for general structure functors blocks
on the same engine machinery as `SIP` itself
(`Soundness.transp_ua`). Theorem-shape externalises the
obligation cleanly.
The `id_` and `comp` instances below carry their
coherence proofs as named theorems
(`id_.transport_idEquiv`, `comp.transport_eq_compose`). -/
structure StructureFunctor ( : ULevel) where
/-- Action on objects: `toFun A` is the `S A` of the structure
functor `S`. -/
toFun : CType → CType
/-- Action on equivalences: `transport A B e` is the lifted
equivalence `S e : S A ≃ S B` for an input `e : A ≃ B`.
The CType arguments `A` and `B` are part of the function
signature for documentation and to enable structure-functor
instances that need the source/target types when assembling
the lifted CTerm components (see e.g. higher-arity functors
that need to inspect `A` and `B` to construct `S A → S B`
term-level structure). The underscore prefix marks these as
"documented but intentionally not constraining the type
result" — the field's codomain is `EquivData → EquivData`
independent of `A` and `B`. -/
transport : ∀ (_A _B : CType ), EquivData → EquivData
namespace StructureFunctor
-- ── §2. Identity structure functor ────────────────────────────────────────
/-- The identity structure functor: `toFun = id` on objects;
`transport` returns its input equivalence verbatim.
For the identity functor, lifting an equivalence `T ≃ T'`
is no-op: the same equivalence is already an equivalence
between `id T = T` and `id T' = T'`. -/
def id_ ( : ULevel) : StructureFunctor where
toFun A := A
transport _ _ e := e
/-- The identity functor sends `idEquiv A` to `idEquiv A` —
a real coherence equation, provable by reflexivity. -/
theorem id_.transport_idEquiv { : ULevel} (A : CType ) :
(id_ ).transport A A (idEquiv A) = idEquiv ((id_ ).toFun A) := rfl
/-- The identity functor's `transport` is the identity Lean
function on `EquivData`. -/
theorem id_.transport_eq_id { : ULevel} (A B : CType ) (e : EquivData) :
(id_ ).transport A B e = e := rfl
-- ── §3. Composition of structure functors ────────────────────────────────
/-- Composition of two structure functors `G ∘ F`: apply `F`
first on objects and on equivalences, then `G` on top.
Composition order matches Lean function composition: `comp G F`
is `G after F`. The object-action is `G.toFun ∘ F.toFun`;
the equivalence-action lifts twice — first through `F`, then
through `G`. -/
def comp { : ULevel} (G F : StructureFunctor ) : StructureFunctor where
toFun A := G.toFun (F.toFun A)
transport A B e := G.transport (F.toFun A) (F.toFun B) (F.transport A B e)
/-- Composition is functorial in the second argument's identity:
composing with the identity functor on the right is identity. -/
theorem comp_id_right { : ULevel} (G : StructureFunctor ) :
comp G (id_ ) = G := rfl
/-- Composition is functorial in the first argument's identity:
composing with the identity functor on the left is identity. -/
theorem comp_id_left { : ULevel} (F : StructureFunctor ) :
comp (id_ ) F = F := rfl
/-- Composition is associative on `StructureFunctor`. -/
theorem comp_assoc { : ULevel} (H G F : StructureFunctor ) :
comp H (comp G F) = comp (comp H G) F := rfl
/-- Composition's `transport` is the composition of the two
`transport` actions — a real coherence equation, provable
by reflexivity from the definition of `comp`. -/
theorem comp.transport_eq_compose { : ULevel}
(G F : StructureFunctor ) (A B : CType ) (e : EquivData) :
(comp G F).transport A B e =
G.transport (F.toFun A) (F.toFun B) (F.transport A B e) := rfl
end StructureFunctor
-- ── §4. Theorem SIP ──────────────────────────────────────────────────────
/-- Structure Identity Principle (CoquandDanielsson; Symmetry
book §17; THEORY.md §0.4).
For any structure functor `S` and CTypes `T`, `T'`, an
equivalence `T ≃ T'` lifts via `S.transport T T'` to an
equivalence `S.toFun T ≃ S.toFun T'`.
## Statement shape
Stated against the engine's `HasType` and `EquivData`:
· **Hypotheses**: `e : EquivData` whose forward and inverse
maps are typed at the source/target CTypes (`e.f : T → T'`,
`e.fInv : T' → T`).
· **Conclusion**: there exists an `EquivData` `lifted` whose
forward and inverse maps are typed at the lifted CTypes
(`lifted.f : S.toFun T → S.toFun T'`,
`lifted.fInv : S.toFun T' → S.toFun T`).
The witness for `lifted` is `S.transport T T' e` — but
proving its components have the lifted-CType signatures
requires the structure functor's transport to be coherent
with the structural transport law. In the present setting,
where `StructureFunctor.transport` is shape-only, that
coherence is the discharge obligation.
## Discharge
For `S = id_ ` (the identity structure functor), the lifted
equivalence is the input equivalence (by
`id_.transport_eq_id`); the typing follows directly from the
hypotheses. This case is `rfl`-style and is not blocked.
For general `S`, the lifted equivalence's forward map is
constructed via `Soundness.transp_ua`: an equivalence
`T ≃ T'` lifts to a path `Path .univ T T'` (via Glue at the
boundary), which transports through `S.toFun`'s action on
the universe to a path `Path .univ (S.toFun T) (S.toFun T')`,
which then unfolds via `transp_ua` to an equivalence
`S.toFun T ≃ S.toFun T'`. The full discharge requires
`Soundness.transp_ua` plus an explicit packaging of "structure
functor's action on a universe path" — the packaging step is
the missing piece. -/
theorem SIP { : ULevel} (S : StructureFunctor )
(T T' : CType ) (e : EquivData)
(_hf : HasType [] e.f (CType.pi "_" T T'))
(_hfInv : HasType [] e.fInv (CType.pi "_" T' T )) :
∃ (lifted : EquivData),
HasType [] lifted.f (CType.pi "_" (S.toFun T) (S.toFun T')) ∧
HasType [] lifted.fInv (CType.pi "_" (S.toFun T') (S.toFun T )) := by
-- waits on: Soundness.transp_ua (univalence) packaged as a
-- structure-functor-coherence rule. The witness is `S.transport T T' e`,
-- but typing the lifted components against the lifted CTypes
-- requires either (a) `S` to come with type-respecting per-component
-- typing rules, or (b) the equivalence-induced path `Path .univ T T'`
-- to be transportable through `S.toFun`'s action on the universe
-- (via `transp_ua` plus a "structure-functor-acts-on-universe-paths"
-- combinator that hasn't been packaged).
sorry
-- ── §5. Theorem: contracts transport ──────────────────────────────────────
/-- Every contract — a function `C : CType → CTerm` whose
output inhabits `Ω ` — transports along equivalences:
given `e : T ≃ T'`, there is a Path `C T ≡ C T'` in `Ω `.
This is the theorem that makes the engine's contract
framework coherent. Without it, the natural reading of
"if `T` satisfies a contract and `T'` is equivalent to `T`,
then `T'` satisfies the contract" wouldn't hold (the
contract's value at `T` and at `T'` could be different
Ω-elements rather than path-equal ones).
## Statement shape
· **Hypotheses**: `C` outputs to `Ω ` for every input
(`hC : ∀ A, HasType [] (C A) (Ω )`); equivalence `e : T ≃ T'`
with typed forward and inverse maps.
· **Conclusion**: there is a CTerm `path` of type
`Path (Ω ) (C T) (C T')`.
## Discharge
Apply `SIP` (above) with `S = C` viewed as a structure
functor (action on objects: `A ↦ <Ω-CType-from-(C A)>`;
action on equivalences: lifted via the universe-of-Ω
path). The resulting equivalence between `C T` and
`C T'` (now both Ω-codes) lifts to a Path in `Ω ` via
prop-univalence (the Ω-version of `Soundness.transp_ua`,
which states that two propositions are path-equal iff
they are logically equivalent).
Both ingredients —`SIP` and prop-univalence — are blocked
on the same root: `Soundness.transp_ua` is theorems-discharged
in `Soundness.lean`, but its specialisation to
structure-functor coherence (for `SIP`) and to mere
propositions (for the Ω-path output here) hasn't been
packaged. -/
theorem contract_transports { : ULevel}
(C : CType → CTerm) (T T' : CType ) (e : EquivData)
(_hC : ∀ A, HasType [] (C A) (Ω ))
(_hf : HasType [] e.f (CType.pi "_" T T'))
(_hfInv : HasType [] e.fInv (CType.pi "_" T' T )) :
∃ (path : CTerm), HasType [] path (CType.path (Ω ) (C T) (C T')) := by
-- waits on: SIP (theorem above) + prop-univalence packaged from
-- `Soundness.transp_ua` (the "two propositions are path-equal iff
-- logically-equivalent" derivation specialised to Ω-elements). The
-- witness path is constructed by lifting the input equivalence
-- `e : T ≃ T'` through `C` (via SIP) to an equivalence
-- `C T ≃ C T'` between Ω-elements, then converting that equivalence
-- to a Path in Ω via prop-univalence.
sorry
end CubicalTransport.SIP

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.Soundness CubicalTransport.Soundness
========================= =========================
The Phase 1 Week 6 closeout — soundness theorems that tie transport, The Phase 1 Week 6 closeout — soundness theorems that tie transport,
composition, and glue into a coherent story (cells-spec §14 "Key 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-level constant-line identity. Combines `eval_transp_top` with
`eval_transp_const` to cover every face. -/ `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) : (φ : FaceFormula) (t : CTerm) (hA : CType.dimAbsent i A = true) :
eval env (.transp i A φ t) = eval env t := by eval env (.transp i A φ t) = eval env t := by
by_cases hφ : φ = .top 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 reduces to the tube body substituted at the 1-endpoint. This is the
"composition agrees with tube on constrained face" obligation; "composition agrees with tube on constrained face" obligation;
at `.top` the constraint is total. -/ 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 env (.comp i A .top u t) = eval env (u.substDim i .one) :=
eval_comp_top env i A u t 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 /-- `ua_endpoints` (cells-spec §14, half 1): the left endpoint of the
univalence line is the full-face glue, which computationally behaves univalence line is the full-face glue, which computationally behaves
like `A` via `e`. -/ 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 e A B .zero = e.toGlueType .top A B :=
uaLine_zero e A B uaLine_zero e A B
/-- `ua_endpoints` (half 2): the right endpoint is the empty-face glue, /-- `ua_endpoints` (half 2): the right endpoint is the empty-face glue,
which computationally is just `B`. -/ 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 e A B .one = e.toGlueType .bot A B :=
uaLine_one e 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 The dim-absence hypotheses formalise the well-scopedness assumption
that `e`, `A`, `B` are supplied from outside the transport binder. -/ 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) (t : CTerm)
(hA : A.dimAbsent i = true) (hA : A.dimAbsent i = true)
(hB : B.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 Together with `transp_ua`, this exhibits the two principal directions
of the equivalence as the computational content of Glue transport at of the equivalence as the computational content of Glue transport at
the constant-component sub-cases. -/ 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) (t : CTerm)
(hA : A.dimAbsent i = true) (hA : A.dimAbsent i = true)
(hB : B.dimAbsent i = true) (hB : B.dimAbsent i = true)

View file

@ -0,0 +1,308 @@
/-
CubicalTransport.Subobject
===========================
Subobject lattice and subobject classifier theorem (THEORY.md
§0.3-§0.4 — "Subobject classifier and internal logic").
Given a CType `T : CType `, the engine-internal subobject lattice
is `Sub T : CType (.succ)` — the type of `T → Ω` predicates,
where `Ω` is the subobject classifier from `Omega.lean`.
This file provides:
· `Sub T` — the dependent function type `T → Ω` packaged as
`CType (.succ)` via the `max_succ_self_right` re-anchoring
(since `T : CType ` and `Ω : CType (.succ)`, the bare
`CType.pi` would land at `max (.succ)`, which is `.succ`
propositionally but not definitionally — `max_succ_self_right`
rewrites the result type back to `CType (.succ)`).
· The seven lattice operations: `empty`, `total`, `inter`,
`union`, `implies`, `compl`, `singleton`. Each is a real
`.lam`-`.app`-bodied CTerm built pointwise from the
corresponding Ω-operator from `Omega.lean`.
· Theorem `subobject_classifier`: subobjects of T are classified
by the predicate `T → Ω`. Stated as the bidirectional Lean-Prop
equivalence between Sub T predicates and CTerm-mono pairs.
· Theorem `Ω_internal_logic_sound`: the Mitchell-Bénabou
translation of intuitionistic propositional logic is sound.
Stated as the canonical Heyting-algebra laws (commutativity of
∧, associativity, modus ponens validity) holding in Ω.
## Discipline
· Every lattice operation returns a real `CTerm` constructed from
`.lam`, `.app`, `.var`, and `.pair` over the Ω-operators —
no `CTerm.var` references to unbound variables.
· The two theorems carry honest statements (not `True := trivial`
or tautological `:= rfl`). Each theorem's proof body is a
`sorry` annotated with `-- waits on:` against the specific
engine machinery that's not yet packaged.
· No `noncomputable`, no `Classical.propDecidable`.
-/
import CubicalTransport.Omega
namespace CubicalTransport.Subobject
open CubicalTransport.Omega
open CubicalTransport.Reify
-- ── §1. The Sub T type ────────────────────────────────────────────────────
/-- The subobject lattice of a CType `T : CType `.
Definition: `Sub T = T → Ω `. Encoded as the dependent
function CType `CType.pi "$x" T (Ω )`.
Universe-level discipline: `T : CType ` and `Ω : CType .succ`,
so the bare `.pi` lands at `CType (max .succ)`. Lean does not
reduce `max .succ` to `.succ` for an abstract ``; we use
`ULevel.max_succ_self_right` to rewrite the result type back to
`CType .succ`.
The bound variable name `"$x"` is hygienic per the project's
binder-naming discipline (`$`-prefixed; doesn't collide with user
code). The codomain `Ω ` does not mention `$x` (Ω is closed in
its level argument), so this is effectively a non-dependent
arrow — but we use the dependent `.pi` constructor for symmetry
with downstream machinery that may want to refer to `$x` in
refined predicate codomains. -/
def Sub { : ULevel} (T : CType ) : CType (ULevel.succ ) :=
ULevel.max_succ_self_right ▸ CType.pi "$x" T (Ω )
-- ── §2. Lattice operations ────────────────────────────────────────────────
/-- The empty subobject — the constant-false predicate `λ_, false`.
Encoding: `.lam "$x" Ω.false_`. The body ignores its argument
and returns the Ω-bottom from `Omega.lean`. -/
def empty { : ULevel} : CTerm :=
.lam "$x" (Ω.false_ ( := ))
/-- The total subobject — the constant-true predicate `λ_, true`.
Encoding: `.lam "$x" Ω.true_`. The body ignores its argument
and returns the Ω-top from `Omega.lean`. -/
def total { : ULevel} : CTerm :=
.lam "$x" (Ω.true_ ( := ))
/-- Pointwise intersection of two subobject predicates: the predicate
that holds at `x` iff both `P` and `Q` hold at `x`.
Encoding: `.lam "$x" (Ω.and (.app P (.var "$x")) (.app Q (.var "$x")))`.
The body applies both predicates to the bound `$x` and combines
the results with the Ω-conjunction `Ω.and`.
Real `.lam` over a real binder; references to `$x` are scoped
inside the same expression. -/
def inter { : ULevel} (P Q : CTerm) : CTerm :=
.lam "$x" (Ω.and ( := ) (.app P (.var "$x")) (.app Q (.var "$x")))
/-- Pointwise union: holds at `x` iff at least one of `P`, `Q` holds.
Encoding: `.lam "$x" (Ω.or (.app P (.var "$x")) (.app Q (.var "$x")))`.
The body uses Ω's propositionally-truncated disjunction `Ω.or`. -/
def union { : ULevel} (P Q : CTerm) : CTerm :=
.lam "$x" (Ω.or ( := ) (.app P (.var "$x")) (.app Q (.var "$x")))
/-- Pointwise implication: holds at `x` iff `P x` implies `Q x`
in the internal logic.
Encoding: `.lam "$x" (Ω.implies (.app P (.var "$x")) (.app Q (.var "$x")))`.
The body uses Ω's internal-arrow `Ω.implies`. -/
def implies { : ULevel} (P Q : CTerm) : CTerm :=
.lam "$x" (Ω.implies ( := ) (.app P (.var "$x")) (.app Q (.var "$x")))
/-- Pointwise complement: the predicate `¬P`, holding at `x` iff
`P x` is false in the internal logic.
Encoding: `.lam "$x" (Ω.not (.app P (.var "$x")))`. Uses Ω's
derived negation `Ω.not P ≜ Ω.implies P Ω.false_`. -/
def compl { : ULevel} (P : CTerm) : CTerm :=
.lam "$x" (Ω.not ( := ) (.app P (.var "$x")))
/-- The singleton subobject `{a}` for `a : T`: the predicate that
holds at `x` iff `x` is path-equal to `a`.
Encoding: `.lam "$x" Ω-pair-of-(carrier=Path-T-x-a, prop-witness)`.
The carrier is `CTerm.code (CType.path T (.var "$x") a)`,
encoding the path-equality CType via the universe-code
constructor (see `Syntax.lean`'s `CTerm.code` / `CType.El`
pair). The propositionality witness is `CTerm.code` of
`IsNType .negOne (CType.path T (.var "$x") a)`, which is
well-typed at `Ω `'s second-component slot under the same
shape-discrepancy convention as `Ω.true_` / `Ω.false_` in
`Omega.lean`.
Note: the propositionality of `Path T x a` requires `T` to be
a 0-type (Set). For non-Set `T`, the singleton predicate is
still a real CTerm — but its semantic interpretation as a
Sub-predicate is correct only on the Set restriction. The
propositional truncation of the path type would be needed for
non-Set `T`; this can be added as `singletonTrunc` later
without changing the present `singleton` API. -/
def singleton { : ULevel} (T : CType ) (a : CTerm) : CTerm :=
.lam "$x"
(.pair
-- carrier-of-Sub-element: code of the path-equality CType
(CTerm.code ( := ) (CType.path T (.var "$x") a))
-- propositionality-witness: code of (IsNType .negOne (Path T x a))
(CTerm.code ( := )
(Truncation.IsNType ( := )
.negOne
(CType.path T (.var "$x") a))))
-- ── §3. Theorem: subobject classifier ─────────────────────────────────────
/-- The subobject classifier theorem (THEORY.md §0.3): subobjects
of `T` (i.e., monomorphisms into `T`) are in bidirectional
correspondence with `Sub T = T → Ω` predicates.
## Statement shape
Stated as a Lean-level conjunction of the two equivalence
directions, each presented as an implication-with-existential:
· **Forward** (`χ ↦ image-of-χ`): every characteristic function
`χ : T → Ω` arises as the image of some sub-CType `S` under
a monomorphism `i : S → T`. We assert the existence of `S`
and `i` (typed `i : S → T` in the empty context).
· **Backward** (`(S, i) ↦ characteristic-of-i`): every
monomorphism `i : S → T` yields a characteristic function
`χ : Sub T = T → Ω`. We assert the existence of `χ`
(typed `χ : Sub T` in the empty context).
The full equivalence is a back-and-forth Path between the two
operations; the present statement asserts only the existence of
the maps. Equivalence-as-Path lives in `Equiv.lean`'s
`EquivData` shape and requires the round-trip path
constructions.
## Why not state via `EquivData`?
`EquivData` (from `Equiv.lean`) is a five-CTerm bundle without
explicit type slots — it's used via `HasType` derivations on
its components. To state the classifier as an `EquivData`
between (a) the type of monos-into-T and (b) `Sub T`, we would
need to encode "the type of monos-into-T" as a single CType,
which requires `Σ (S : CType ), (S → T) × <mono-witness>`. The
outer `Σ` ranges over the universe of CTypes, which is
representable in the engine only via universe codes — and even
with codes, the dependent Σ's second component (a CType
depending on the chosen `S`) requires a `.El`-powered Σ-builder
that hasn't been packaged.
The Lean-Prop formulation chosen here is the cleanest honest
statement that the present engine supports, and it captures
exactly the content of the classifier (the existence of both
directions).
## Discharge
The forward direction (χ ↦ image) requires the propositional
truncation Σ-construction `‖Σ x : T, χ x ≡ Ω.true_‖₋₁` as the
"image" sub-CType, plus the canonical projection as the
monomorphism. The propositional truncation lives in
`Inductive.lean` as `propTruncSchema`; the equality test
`χ x ≡ Ω.true_` in Ω requires a path equality at Ω level.
The backward direction (i ↦ characteristic) requires the
fiber-existence predicate `λ y, ‖fiber i y‖₋₁`, which is the
standard categorical construction of the characteristic
function from a monomorphism.
Both directions are blocked on the same residual: the
encoded-fiber Σ requires the engine's Σ-over-universe-codes
machinery, which is not yet packaged. -/
theorem subobject_classifier { : ULevel} (T : CType ) :
-- Forward: every Sub-T predicate has a sub-CType + monomorphism representative.
(∀ (χ : CTerm), HasType [] χ (Sub T) →
∃ (S : CType ) (incl : CTerm),
HasType [] incl (CType.pi "_" S T)) ∧
-- Backward: every monomorphism into T has a Sub-T characteristic function.
(∀ (S : CType ) (incl : CTerm),
HasType [] incl (CType.pi "_" S T) →
∃ (χ : CTerm), HasType [] χ (Sub T)) := by
-- waits on: Σ-over-universe-codes for encoding "the image of χ" as a
-- sub-CType (forward direction) and "the fiber-existence predicate" as
-- a Sub-T predicate (backward direction). Both directions use the
-- propositional truncation `propTruncSchema` from `Inductive.lean` plus
-- the universe-code `.El` decoder from `Syntax.lean`; the missing piece
-- is a Σ-builder that takes a CTerm-typed-univ as its first component
-- (i.e., `Σ (P : .univ ), El P → T` shape).
sorry
-- ── §4. Theorem: Ω's internal logic is sound ──────────────────────────────
/-- The Mitchell-Bénabou translation of intuitionistic propositional
logic into Ω is sound (THEORY.md §0.3).
## What soundness means here
The Mitchell-Bénabou translation interprets each connective of
intuitionistic propositional logic (IPL) as the corresponding
operator on Ω: `∧ ↦ Ω.and`, ` ↦ Ω.or`, `→ ↦ Ω.implies`,
`¬ ↦ Ω.not`, ` ↦ Ω.true_`, `⊥ ↦ Ω.false_`. Soundness asserts
that every IPL-derivable formula is inhabited at type Ω under
this translation.
## Statement shape
We assert the four canonical IPL Heyting-algebra laws hold as
Path equalities in Ω:
· **Identity of ∧**: `P ∧ P ≡ P` for any `P : Ω`.
· **Commutativity of ∧**: `P ∧ Q ≡ Q ∧ P`.
· **Modus ponens validity**: `P ∧ (P → Q) ≡ P ∧ Q`.
· **Implication-as-conjunction**: `P → (P → Q) ≡ P → Q`.
Each is stated as a CTerm-level Path between the two Ω-formulas.
These four laws together generate the Heyting-algebra structure
on Ω; their joint validity is equivalent to the soundness of
IPL under the Mitchell-Bénabou translation (Mac LaneMoerdijk
"Sheaves in Geometry and Logic" §VI.5).
## Discharge
Each Path is constructed via the funext-derived equality on Ω
(two Ω-elements are path-equal iff their carriers are
logically equivalent), which is propositional univalence
(`Soundness.transp_ua` specialised to mere propositions). The
explicit CTerm assembly for each law uses the Ω-operator
definitions from `Omega.lean` plus a Path-equality combinator
not yet packaged. -/
theorem Ω_internal_logic_sound { : ULevel} :
-- (1) Idempotence of ∧: P ∧ P ≡ P
(∀ (P : CTerm), HasType [] P (Ω ) →
∃ (pf : CTerm),
HasType [] pf (CType.path (Ω ) (Ω.and ( := ) P P) P)) ∧
-- (2) Commutativity of ∧: P ∧ Q ≡ Q ∧ P
(∀ (P Q : CTerm), HasType [] P (Ω ) → HasType [] Q (Ω ) →
∃ (pf : CTerm),
HasType [] pf (CType.path (Ω ) (Ω.and ( := ) P Q) (Ω.and ( := ) Q P))) ∧
-- (3) Modus ponens validity: P ∧ (P → Q) ≡ P ∧ Q
(∀ (P Q : CTerm), HasType [] P (Ω ) → HasType [] Q (Ω ) →
∃ (pf : CTerm),
HasType [] pf (CType.path (Ω )
(Ω.and ( := ) P (Ω.implies ( := ) P Q))
(Ω.and ( := ) P Q))) ∧
-- (4) Implication absorption: P → (P → Q) ≡ P → Q
(∀ (P Q : CTerm), HasType [] P (Ω ) → HasType [] Q (Ω ) →
∃ (pf : CTerm),
HasType [] pf (CType.path (Ω )
(Ω.implies ( := ) P (Ω.implies ( := ) P Q))
(Ω.implies ( := ) P Q))) := by
-- waits on: prop-univalence packaged from `Soundness.transp_ua`
-- (the same dependency as `OmegaIsProp` in `Omega.lean`). Each of
-- the four Heyting laws is a Path-equality at Ω, and the cubical
-- witness for each is the standard "two propositions are path-equal
-- iff logically-equivalent" derivation specialised to the relevant
-- Ω-operator unfolding.
sorry
end CubicalTransport.Subobject

View file

@ -1,28 +1,54 @@
/- /-
Topolei.Cubical.Subst CubicalTransport.Subst
===================== ======================
Dimension substitution for CType (Step 1 of the transport plan). Dimension substitution for the universe-stratified, dependently-
typed CType (Layer 0 §0.1 cascade).
CTerm already has substDim : DimVar → DimExpr → CTerm → CTerm (Syntax.lean). CTerm already has substDim : DimVar → DimExpr → CTerm → CTerm (Syntax.lean).
Here we add: Here we add:
CTerm.substDimBool : DimVar → Bool → CTerm → CTerm CTerm.substDimBool : DimVar → Bool → CTerm → CTerm
— specialises substDim to the two canonical endpoints (false = 0, true = 1). — 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 CType.substDim : DimVar → Bool → CType → CType
— Substitutes a dimension variable with a Bool endpoint throughout a type. CType.substDimExpr : DimVar → DimExpr → CType → CType
— CType.path recurses into its CTerm endpoints via substDimBool. — 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: ## Universe-aware shape
· 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.
Note: substDim_comm (disjoint dimensions commute) is deferred; All substDim functions are level-polymorphic: they take and return a
it requires DimExpr.subst commutativity, which needs its own treatment. `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 import CubicalTransport.Syntax
@ -35,7 +61,6 @@ import CubicalTransport.Syntax
def CTerm.substDimBool (i : DimVar) (b : Bool) (t : CTerm) : CTerm := def CTerm.substDimBool (i : DimVar) (b : Bool) (t : CTerm) : CTerm :=
t.substDim i (if b then .one else .zero) 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) : 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 t.substDimBool i b = t.substDim i (if b then .one else .zero) := rfl
@ -47,85 +72,91 @@ theorem CTerm.substDimBool_true (i : DimVar) (t : CTerm) :
-- ── CType.substDim ──────────────────────────────────────────────────────────── -- ── CType.substDim ────────────────────────────────────────────────────────────
-- Substitute dimension variable i with Bool endpoint b throughout a type. -- Substitute dimension variable i with Bool endpoint b throughout a type.
-- Path type endpoints are terms, so we delegate to CTerm.substDimBool. -- Level-polymorphic — the universe level of the result equals the input.
--
-- `.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.
mutual mutual
def CType.substDim (i : DimVar) (b : Bool) : CType → CType def CType.substDim { : ULevel} (i : DimVar) (b : Bool) : CType → CType
| .univ => .univ | .univ => .univ
| .pi A B => .pi (A.substDim i b) (B.substDim i b) | .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) | .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) | .sigma var A B => .sigma var (A.substDim i b) (B.substDim i b)
| .glue φ T f fInv sec ret coh A => | .glue φ T f fInv sec ret coh A =>
.glue (φ.substDim i (if b then .one else .zero)) .glue (φ.substDim i (if b then .one else .zero))
(T.substDim i b) (T.substDim i b)
(f.substDimBool i b) (fInv.substDimBool i b) (f.substDimBool i b) (fInv.substDimBool i b)
(sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b) (sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b)
(A.substDim i b) (A.substDim i b)
-- REL1: schema-defined inductive. Recurse into params; the schema | .ind S params => .ind S (CType.substDim.params i b params)
-- itself is static (its boundary CTerms are the schema's data, not | .interval => .interval
-- caller-substituted dim-bound terms). | .lift A => .lift (A.substDim i b)
| .ind S params => .ind S (CType.substDim.params i b params) | .El P => .El (P.substDimBool i b)
-- Modal type former: descend into the inner type, preserving the kind.
| .modal k A => .modal k (A.substDim i b)
/-- Pointwise `substDim` through a list of CType parameters. -/ /-- Pointwise `substDim` through a level-heterogeneous list of CType
def CType.substDim.params (i : DimVar) (b : Bool) : List CType → List CType parameters. Each entry's universe level is preserved. -/
| [] => [] def CType.substDim.params (i : DimVar) (b : Bool) :
| A :: rest => A.substDim i b :: CType.substDim.params i b rest List (Σ : ULevel, CType ) → List (Σ : ULevel, CType )
| [] => []
| ⟨ℓ, A⟩ :: rest => ⟨ℓ, A.substDim i b⟩ :: CType.substDim.params i b rest
end end
-- ── CType.substDimExpr ──────────────────────────────────────────────────────── -- ── CType.substDimExpr ────────────────────────────────────────────────────────
-- Substitute dimension variable `i` with an arbitrary `DimExpr r` throughout -- Substitute dimension variable `i` with an arbitrary `DimExpr r`
-- a type. Generalises `CType.substDim`, which fixes `r` to a Bool endpoint. -- 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.
mutual mutual
def CType.substDimExpr (i : DimVar) (r : DimExpr) : CType → CType def CType.substDimExpr { : ULevel} (i : DimVar) (r : DimExpr) : CType → CType
| .univ => .univ | .univ => .univ
| .pi A B => .pi (A.substDimExpr i r) (B.substDimExpr i r) | .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) | .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) | .sigma var A B => .sigma var (A.substDimExpr i r) (B.substDimExpr i r)
| .glue φ T f fInv sec ret coh A => | .glue φ T f fInv sec ret coh A =>
.glue (φ.substDim i r) .glue (φ.substDim i r)
(T.substDimExpr i r) (T.substDimExpr i r)
(f.substDim i r) (fInv.substDim i r) (f.substDim i r) (fInv.substDim i r)
(sec.substDim i r) (ret.substDim i r) (coh.substDim i r) (sec.substDim i r) (ret.substDim i r) (coh.substDim i r)
(A.substDimExpr i r) (A.substDimExpr i r)
| .ind S params => .ind S (CType.substDimExpr.params i r params) | .ind S params => .ind S (CType.substDimExpr.params i r params)
| .interval => .interval
| .lift A => .lift (A.substDimExpr i r)
| .El P => .El (P.substDim i r)
-- Modal type former: descend into the inner type, preserving the kind.
| .modal k A => .modal k (A.substDimExpr i r)
/-- Pointwise `substDimExpr` through a list of CType parameters. -/ /-- Pointwise `substDimExpr` through a level-heterogeneous list of
def CType.substDimExpr.params (i : DimVar) (r : DimExpr) : List CType → List CType CType parameters. -/
| [] => [] def CType.substDimExpr.params (i : DimVar) (r : DimExpr) :
| A :: rest => A.substDimExpr i r :: CType.substDimExpr.params i r rest List (Σ : ULevel, CType ) → List (Σ : ULevel, CType )
| [] => []
| ⟨ℓ, A⟩ :: rest => ⟨ℓ, A.substDimExpr i r⟩ :: CType.substDimExpr.params i r rest
end end
-- ── Reduction lemmas ────────────────────────────────────────────────────────── -- ── Reduction lemmas (substDim) ──────────────────────────────────────────────
-- All proved by rfl: substDim is defined by pattern matching, so these
-- hold definitionally.
namespace CType namespace CType
theorem substDim_univ (i : DimVar) (b : Bool) : theorem substDim_univ { : ULevel} (i : DimVar) (b : Bool) :
(univ).substDim i b = .univ := rfl (univ ( := )).substDim i b = .univ := rfl
theorem substDim_pi (i : DimVar) (b : Bool) (A B : CType) : theorem substDim_pi { ' : ULevel} (i : DimVar) (b : Bool)
(pi A B).substDim i b = .pi (A.substDim i b) (B.substDim i b) := rfl (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 a t).substDim i b =
.path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) := rfl .path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) := rfl
theorem substDim_sigma (i : DimVar) (b : Bool) (A B : CType) : theorem substDim_sigma { ' : ULevel} (i : DimVar) (b : Bool)
(sigma A B).substDim i b = .sigma (A.substDim i b) (B.substDim i b) := rfl (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) theorem substDim_glue { : ULevel} (i : DimVar) (b : Bool)
(f fInv sec ret coh : CTerm) (A : CType) : (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType ) :
(glue φ T f fInv sec ret coh A).substDim i b = (glue φ T f fInv sec ret coh A).substDim i b =
.glue (φ.substDim i (if b then .one else .zero)) .glue (φ.substDim i (if b then .one else .zero))
(T.substDim i b) (T.substDim i b)
@ -133,28 +164,46 @@ theorem substDim_glue (i : DimVar) (b : Bool) (φ : FaceFormula) (T : CType)
(sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b) (sec.substDimBool i b) (ret.substDimBool i b) (coh.substDimBool i b)
(A.substDim i b) := rfl (A.substDim i b) := rfl
theorem substDim_ind (i : DimVar) (b : Bool) (S : CTypeSchema) (params : List CType) : theorem substDim_ind { : ULevel} (i : DimVar) (b : Bool)
(ind S params).substDim i b = .ind S (CType.substDim.params i b params) := rfl (S : CTypeSchema) (params : List (Σ ' : ULevel, CType ')) :
(ind ( := ) S params).substDim i b = .ind S (CType.substDim.params i b params) := rfl
-- ── substDimExpr reduction lemmas ───────────────────────────────────────────── theorem substDim_interval (i : DimVar) (b : Bool) :
(interval).substDim i b = .interval := rfl
theorem substDimExpr_univ (i : DimVar) (r : DimExpr) : theorem substDim_lift { : ULevel} (i : DimVar) (b : Bool) (A : CType ) :
(univ).substDimExpr i r = .univ := rfl (lift A).substDim i b = .lift (A.substDim i b) := rfl
theorem substDimExpr_pi (i : DimVar) (r : DimExpr) (A B : CType) : @[simp] theorem substDim_El { : ULevel} (i : DimVar) (b : Bool) (P : CTerm) :
(pi A B).substDimExpr i r = (CType.El ( := ) P).substDim i b = .El (P.substDimBool i b) := rfl
.pi (A.substDimExpr i r) (B.substDimExpr i r) := rfl
theorem substDimExpr_path (i : DimVar) (r : DimExpr) (A : CType) (a t : CTerm) : @[simp] theorem substDim_modal { : ULevel} (i : DimVar) (b : Bool)
(k : ModalityKind) (A : CType ) :
(CType.modal k A).substDim i b = .modal k (A.substDim i b) := rfl
-- ── Reduction lemmas (substDimExpr) ──────────────────────────────────────────
theorem substDimExpr_univ { : ULevel} (i : DimVar) (r : DimExpr) :
(univ ( := )).substDimExpr i r = .univ := rfl
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 a t).substDimExpr i r =
.path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r) := rfl .path (A.substDimExpr i r) (a.substDim i r) (t.substDim i r) := rfl
theorem substDimExpr_sigma (i : DimVar) (r : DimExpr) (A B : CType) : theorem substDimExpr_sigma { ' : ULevel} (i : DimVar) (r : DimExpr)
(sigma A B).substDimExpr i r = (var : String) (A : CType ) (B : CType ') :
.sigma (A.substDimExpr i r) (B.substDimExpr i r) := rfl (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) theorem substDimExpr_glue { : ULevel} (i : DimVar) (r : DimExpr)
(f fInv sec ret coh : CTerm) (A : CType) : (φ : FaceFormula) (T : CType )
(f fInv sec ret coh : CTerm) (A : CType ) :
(glue φ T f fInv sec ret coh A).substDimExpr i r = (glue φ T f fInv sec ret coh A).substDimExpr i r =
.glue (φ.substDim i r) .glue (φ.substDim i r)
(T.substDimExpr i r) (T.substDimExpr i r)
@ -162,27 +211,34 @@ theorem substDimExpr_glue (i : DimVar) (r : DimExpr) (φ : FaceFormula) (T : CTy
(sec.substDim i r) (ret.substDim i r) (coh.substDim i r) (sec.substDim i r) (ret.substDim i r) (coh.substDim i r)
(A.substDimExpr i r) := rfl (A.substDimExpr i r) := rfl
theorem substDimExpr_ind (i : DimVar) (r : DimExpr) (S : CTypeSchema) (params : List CType) : theorem substDimExpr_ind { : ULevel} (i : DimVar) (r : DimExpr)
(ind S params).substDimExpr i r = .ind S (CType.substDimExpr.params i r params) := rfl (S : CTypeSchema) (params : List (Σ ' : ULevel, CType ')) :
(ind ( := ) S params).substDimExpr i r =
.ind S (CType.substDimExpr.params i r params) := rfl
-- The Bool-endpoint `substDim` is exactly `substDimExpr` at the canonical theorem substDimExpr_interval (i : DimVar) (r : DimExpr) :
-- endpoint `DimExpr`. Proof is by pattern-matching `def` (rather than the (interval).substDimExpr i r = .interval := rfl
-- `induction` tactic) because `CType` is mutually inductive with `CTerm`.
-- `CTerm.substDimBool` is defined as `CTerm.substDim` at the same DimExpr, theorem substDimExpr_lift { : ULevel} (i : DimVar) (r : DimExpr) (A : CType ) :
-- so the path case closes by unfolding both. (lift A).substDimExpr i r = .lift (A.substDimExpr i r) := rfl
--
-- `.ind` recurses into params via `substDim_eq_substDimExpr.params`, @[simp] theorem substDimExpr_El { : ULevel} (i : DimVar) (r : DimExpr) (P : CTerm) :
-- a structurally-recursive helper that establishes pointwise equality (CType.El ( := ) P).substDimExpr i r = .El (P.substDim i r) := rfl
-- on the parameter list.
@[simp] theorem substDimExpr_modal { : ULevel} (i : DimVar) (r : DimExpr)
(k : ModalityKind) (A : CType ) :
(CType.modal k A).substDimExpr i r = .modal k (A.substDimExpr i r) := rfl
-- ── Bool endpoint = DimExpr at canonical endpoint ────────────────────────────
mutual mutual
def substDim_eq_substDimExpr (i : DimVar) (b : Bool) : def substDim_eq_substDimExpr { : ULevel} (i : DimVar) (b : Bool) :
(A : CType) → (A : CType ) →
A.substDim i b = A.substDimExpr i (if b then DimExpr.one else DimExpr.zero) A.substDim i b = A.substDimExpr i (if b then DimExpr.one else DimExpr.zero)
| .univ => rfl | .univ => rfl
| .pi A B => by | .pi var A B => by
show CType.pi (A.substDim i b) (B.substDim i b) = show CType.pi var (A.substDim i b) (B.substDim i b) =
CType.pi (A.substDimExpr i _) (B.substDimExpr i _) CType.pi var (A.substDimExpr i _) (B.substDimExpr i _)
rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B] rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B]
| .path A a t => by | .path A a t => by
show CType.path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) = show CType.path (A.substDim i b) (a.substDimBool i b) (t.substDimBool i b) =
@ -190,9 +246,9 @@ mutual
rw [substDim_eq_substDimExpr i b A, rw [substDim_eq_substDimExpr i b A,
CTerm.substDimBool_eq_substDim, CTerm.substDimBool_eq_substDim,
CTerm.substDimBool_eq_substDim] CTerm.substDimBool_eq_substDim]
| .sigma A B => by | .sigma var A B => by
show CType.sigma (A.substDim i b) (B.substDim i b) = show CType.sigma var (A.substDim i b) (B.substDim i b) =
CType.sigma (A.substDimExpr i _) (B.substDimExpr i _) CType.sigma var (A.substDimExpr i _) (B.substDimExpr i _)
rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B] rw [substDim_eq_substDimExpr i b A, substDim_eq_substDimExpr i b B]
| .glue φ T f fInv sec ret coh A => by | .glue φ T f fInv sec ret coh A => by
show CType.glue show CType.glue
@ -218,61 +274,55 @@ mutual
show CType.ind S (CType.substDim.params i b params) show CType.ind S (CType.substDim.params i b params)
= CType.ind S (CType.substDimExpr.params i _ params) = CType.ind S (CType.substDimExpr.params i _ params)
rw [substDim_eq_substDimExpr.params i b 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]
| .El P => by
show CType.El (CTerm.substDimBool i b P) =
CType.El (CTerm.substDim i (if b then DimExpr.one else DimExpr.zero) P)
rw [CTerm.substDimBool_eq_substDim]
| .modal k A => by
show CType.modal k (A.substDim i b) = CType.modal k (A.substDimExpr i _)
rw [substDim_eq_substDimExpr i b A]
/-- Helper: pointwise equality between `substDim.params` and /-- Helper: pointwise equality between `substDim.params` and
`substDimExpr.params` at the canonical endpoint DimExpr. -/ `substDimExpr.params` at the canonical endpoint DimExpr. -/
def substDim_eq_substDimExpr.params (i : DimVar) (b : Bool) : def substDim_eq_substDimExpr.params (i : DimVar) (b : Bool) :
(params : List CType) → (params : List : ULevel, CType )) →
CType.substDim.params i b params = CType.substDim.params i b params =
CType.substDimExpr.params i (if b then DimExpr.one else DimExpr.zero) params CType.substDimExpr.params i (if b then DimExpr.one else DimExpr.zero) params
| [] => rfl | [] => rfl
| A :: rest => by | ⟨ℓ, A⟩ :: rest => by
show A.substDim i b :: CType.substDim.params i b rest show ⟨ℓ, A.substDim i b :: CType.substDim.params i b rest
= A.substDimExpr i _ :: CType.substDimExpr.params i _ rest = ⟨ℓ, A.substDimExpr i _ :: CType.substDimExpr.params i _ rest
rw [substDim_eq_substDimExpr i b A, rw [substDim_eq_substDimExpr i b A,
substDim_eq_substDimExpr.params i b rest] substDim_eq_substDimExpr.params i b rest]
end end
-- ── Face connection ─────────────────────────────────────────────────────────── -- ── 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. -/ /-- 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) : (h : env i = false) :
A.substDim i (env i) = A.substDim i false := by A.substDim i (env i) = A.substDim i false := by
rw [h] rw [h]
/-- At the i=1 face (env i = true), substDim i (env i) is substDim i true. -/ /-- 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) : (h : env i = true) :
A.substDim i (env i) = A.substDim i true := by A.substDim i (env i) = A.substDim i true := by
rw [h] rw [h]
-- ── Deferred: idempotence and commutativity ─────────────────────────────────── -- ── Deferred: idempotence and commutativity ───────────────────────────────────
-- substDim_idem : (A.substDim i b).substDim i b = A.substDim i b -- substDim_idem and substDim_comm require simultaneous induction over the
-- substDim_comm : for i ≠ j, (A.substDim i b).substDim j c = (A.substDim j c).substDim i b -- CType/CTerm mutual inductive; deferred to DimLine.lean as in the original.
--
-- 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.
theorem substDim_comm_univ (i j : DimVar) (b c : Bool) : theorem substDim_comm_univ { : ULevel} (i j : DimVar) (b c : Bool) :
((univ : CType).substDim i b).substDim j c = ((univ ( := )).substDim i b).substDim j c =
((univ : CType).substDim j c).substDim i b := rfl ((univ ( := )).substDim j c).substDim i b := rfl
end CType end CType
-- Note: dimAbsent, substDimBool_idem, and substDim_idem are proved in DimLine.lean, -- Note: dimAbsent, substDimBool_idem, and substDim_idem are proved in
-- which is downstream in the import chain and has access to dimAbsent predicates. -- DimLine.lean, which is downstream and has access to dimAbsent predicates.

View file

@ -1,20 +1,63 @@
/- /-
Topolei.Cubical.Syntax CubicalTransport.Syntax
====================== =======================
Deep embedding of the cubical term language (CCHM §23). Deep embedding of the cubical term language (CCHM §23),
universe-stratified and dependently-typed.
Grammar: Grammar:
A, B ::= U | Π A B | Path A a b A, B ::= U | Π (x : A) B | Σ (x : A) B | Path A a b
t, u ::= x | λx.t | t u | ⟨i⟩t | t@r | transpⁱ A φ t | compⁱ A φ u t | 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 This is the universe-stratified successor to the original
terms, and terms carry path applications over DimExprs. monomorphic `CType` (THEORY.md Layer 0 §0.1).
transp and comp store (i : DimVar) (A : CType) inline rather than DimLine, ## Design (ratified before refactor)
because DimLine is defined later in the import chain (Subst → DimLine).
The typing rules in Typing.lean use DimLine as a convenient wrapper.
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) and the four "fully-reducing" transport/comp cases (T1, T2, C1, C2)
are NbE theorems in `Cubical/Readback.lean`. The residual step-level are NbE theorems in `Cubical/Readback.lean`. The residual step-level
axioms — T3, T5, C4 (subject reduction + face congruence) and T4 axioms — T3, T5, C4 (subject reduction + face congruence) and T4
@ -23,191 +66,232 @@
-/ -/
import CubicalTransport.Face import CubicalTransport.Face
import CubicalTransport.Universe
-- ── Syntax ──────────────────────────────────────────────────────────────────── -- ── Modality kind (Refactor Phase 2) ────────────────────────────────────────
-- A level-erased enum tagging which modality of the cohesive triple we
-- are talking about. Replaces the Phase-1 set of nine ad-hoc per-modality
-- constructors with three unified `ModalityKind`-parameterised constructors
-- (`CType.modal`, `CTerm.modalIntro`, `CTerm.modalElim`, plus the value-
-- level `CVal.vModalIntro` and `CNeu.nModalElim`).
--
-- Future modalities (e.g. Phase-4's `sharp_EML`, an `infinitesimal` arm)
-- extend this enum by adding cases — the engine modal layer is henceforth
-- parameterised over `ModalityKind`.
/-- The three modalities of the cohesive triple `ʃ ⊣ ♭ ⊣ ♯`
(Schreiber/Shulman cohesive HoTT). Per THEORY.md §3.1.
· `flat` — the discrete reflection (`♭`), middle modality, right
adjoint to `shape`.
· `sharp` — the codiscrete coreflection (`♯`), right adjoint to `flat`.
· `shape` — the shape modality (`ʃ`), left adjoint to `flat`.
`DecidableEq` is structural; future modalities (extra enum arms)
inherit decidable equality automatically. `Repr` and `Inhabited`
are likewise standard. -/
inductive ModalityKind : Type where
/-- ♭, the discrete reflection (right adjoint to shape). -/
| flat
/-- ♯, the codiscrete coreflection (right adjoint to flat). -/
| sharp
/-- ʃ, the shape modality (left adjoint to flat). -/
| shape
deriving DecidableEq, Repr, Inhabited
-- ── Universe-stratified syntax ──────────────────────────────────────────────
mutual mutual
/-- Types in the cubical calculus. -/ /-- Types in the cubical calculus, stratified by universe level.
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).
`Sigma A B` — pairs whose first component has type `A` and whose Each constructor's universe-level annotation follows the CCHM
second has type `B`. Non-dependent: `B` does not refer to the typing rules. See the file-level comment for the full table. -/
first component. Dependent Σ (where `B : A → CType`) is deferred inductive CType : ULevel → Type where
for the same reason as dependent Π — requires a term evaluator /-- The universe `U` is itself a type at the next level up.
to apply `B` to a term. -/ Russell-paradox avoidance: `U : U.succ`, never `U : U`. -/
| sigma (A B : CType) : CType -- Σ A B | univ { : ULevel}
/-- Glue type (CCHM §6). : CType (ULevel.succ )
`Glue [φ ↦ (T, e)] A` — on face `φ` the type is `T` with `e : T ≃ A` /-- Dependent function type `Π (var : A), B`.
as witness; off face `φ` the type is `A`. The equivalence `e` is
inlined as five `CTerm` fields (f, fInv, sec, ret, coh) rather than `var` is the binding name (a Lean `String`); `A` is the
a nested `EquivData` so that `CType` / `CTerm` remain a closed domain at level ``; `B` is the codomain CType at level `'`,
mutual inductive block — `EquivData` lives in `Equiv.lean` and is in scope where `var : A`. Inside `B`, references to the
downstream in the import chain. Use `EquivData.toGlueType` in bound variable appear as `CTerm.var var`.
`Equiv.lean` for an ergonomic wrapper. -/
| glue (φ : FaceFormula) (T : CType) The result lives at `max '` (CCHM Π rule).
(f fInv sec ret coh : CTerm)
(A : CType) : CType -- Glue [φ ↦ (T, e)] A 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). /-- Schema-defined inductive type (REL1, INDUCTIVE_TYPES.md).
`ind S params` is an instance of the schema `S` at the given `ind S params` instantiates schema `S` at type parameters
type parameters. `params.length = S.numParams` is a typing-side `params`. Each parameter is paired with its universe level
condition (not enforced syntactically — see `HasType.ind` in via `Σ ' : ULevel, CType '` so heterogeneous-level
`Typing.lean`). 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 The result level `` is user-specified at instantiation
ctors) and their boundary partial-element systems. Both plain time (the schema does not currently constrain the level). -/
inductives (`Nat`, `List A`, `Bool`) and HITs (`S¹`, `‖A‖₋₁`, | ind { : ULevel} (S : CTypeSchema)
suspensions, pushouts) are encoded uniformly via (params : List (Σ ' : ULevel, CType '))
`CTypeSchema`. -/ : CType
| ind (S : CTypeSchema) (params : List CType) : CType -- ind S params /-- The cubical interval `𝕀` as a first-class type (REL2).
Lives at the bottom universe `.zero`. -/
| interval
: CType ULevel.zero
/-- Cumulativity (Layer 0 §0.1). `lift A` is the same data as
`A`, but its CType-level index is bumped by one. Reduction
unfolds `lift A` to `A` (semantically the inclusion is
identity; the level is metadata). -/
| lift { : ULevel} (A : CType )
: CType (ULevel.succ )
/-- The decoder constructor: turn a CTerm-of-type-univ into a CType.
/-- Terms in the cubical calculus. -/ For any CType A : CType encoded via `CTerm.code A`, we have
inductive CTerm where the propositional reduction `El (code A) = A` (proven in this
| var (x : String) : CTerm -- x file as `El_code_eq`). This lets Ω quantify over codes of
| lam (x : String) (t : CTerm) : CTerm -- λx. t propositions and refer back to the underlying type. -/
| app (f a : CTerm) : CTerm -- f a | El { : ULevel} (P : CTerm)
| plam (i : DimVar) (t : CTerm) : CTerm -- ⟨i⟩ t : CType
| papp (t : CTerm) (r : DimExpr) : CTerm -- t @ r /-- **Modal type former (Refactor Phase 2).** Given a modality kind
| transp (i : DimVar) (A : CType) (φ : FaceFormula) `k : ModalityKind` and `A : CType `, the modal type
(t : CTerm) : CTerm -- transpⁱ A φ t `modal k A` lives at the same universe level ``. Replaces the
| comp (i : DimVar) (A : CType) (φ : FaceFormula) Phase-1 ad-hoc trio `.flat`/`.sharp`/`.shape` with a single
(u t : CTerm) : CTerm -- compⁱ A φ u t `ModalityKind`-parameterised constructor.
/-- Multi-clause heterogeneous composition.
`compⁱ A [φ₁ ↦ u₁, …, φₙ ↦ uₙ] t` — a partial element defined At the engine layer we add the data constructor; the modal
over the union of the clause faces. Coherence (clauses agree cohesion content (Crisp variables, the `ʃ ⊣ ♭ ⊣ ♯` adjunctions,
on overlaps and with `t` at `i = 0`) is a typing-level side modal-shape commutation diagrams) is the Phase 3 module.
condition, not enforced syntactically. Used by CCHM path
transport and heterogeneous Π composition to express systems Per THEORY.md §3.1; mirrors `path` in level preservation. -/
that a single-clause `.comp` cannot represent. -/ | modal { : ULevel} (k : ModalityKind) (A : CType )
| compN (i : DimVar) (A : CType) : CType
(clauses : List (FaceFormula × CTerm))
(t : CTerm) : CTerm -- compⁱ A [φ₁↦u₁,…] t /-- Terms in the cubical calculus. Un-indexed by universe level —
/-- Glue introduction (CCHM §6.1). the level discipline lives in the typing judgment (`HasType`,
`glueIn [φ ↦ t] a` — on face `φ`, equals `t : T`; off face `φ`, see `Typing.lean`). Type-bearing constructors carry a CType
equals `a : A`. Well-typedness requires `e.f t = a` on the payload at an implicit `{ : ULevel}`. -/
overlap (a typing-side condition, not enforced syntactically). inductive CTerm : Type where
The equivalence `e` is carried by the type, not the term. -/ /-- Variable reference. -/
| glueIn (φ : FaceFormula) (t a : CTerm) : CTerm -- glue [φ↦t] a | var (x : String) : CTerm
/-- Glue elimination (CCHM §6.1). /-- Lambda abstraction `λx. t`. -/
`unglue [φ ↦ f] g` — extract the underlying `A`-value from a | lam (x : String) (t : CTerm) : CTerm
glued term. On face `φ`, equals `f g` (apply the forward map); /-- Function application `f a`. -/
off face `φ`, equals `g` (already an `A`-value). `f` is the | app (f a : CTerm) : CTerm
`f`-field of the equivalence witnessing `T ≃ A` — carried /-- Dimension abstraction `⟨i⟩ t`. -/
explicitly at the term level because we don't have type | plam (i : DimVar) (t : CTerm) : CTerm
annotations on terms. -/ /-- Path application `t @ r`. -/
| unglue (φ : FaceFormula) (f g : CTerm) : CTerm -- unglue [φ↦f] g | 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). -/ /-- Σ introduction (pair). -/
| pair (a b : CTerm) : CTerm -- (a, b) | pair (a b : CTerm) : CTerm
/-- Σ elimination (first projection). -/ /-- Σ first projection. -/
| fst (t : CTerm) : CTerm -- t.1 | fst (t : CTerm) : CTerm
/-- Σ elimination (second projection). -/ /-- Σ second projection. -/
| snd (t : CTerm) : CTerm -- t.2 | snd (t : CTerm) : CTerm
/-- A dimension expression lifted into the term language (REL1). /-- A dimension expression lifted into the term language (REL1). -/
| dimExpr (r : DimExpr) : CTerm
Used to fill `.dim`-typed argument positions of schema /-- Schema constructor application (REL1). -/
constructors (path ctors) and to hand a `DimExpr` to any | ctor (S : CTypeSchema) (ctorName : String)
future term-level operation that needs one. `DimExpr` is (params : List (Σ : ULevel, CType ))
de Morgan algebra over `DimVar` and 0/1; lifting it lets path (args : List CTerm)
constructors take general dim arguments like `.meet i j`, : CTerm
`.inv r`, etc., not just bare `.var`-shaped dim names. -/ /-- Inductive eliminator (REL1). -/
| dimExpr (r : DimExpr) : CTerm -- ⟦ r ⟧ | indElim (S : CTypeSchema)
/-- Schema constructor application (REL1, INDUCTIVE_TYPES.md §2.4). (params : List (Σ : ULevel, CType ))
`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)
(motive : CTerm) (motive : CTerm)
(branches : List (String × CTerm)) (branches : List (String × CTerm))
(target : CTerm) : CTerm (target : CTerm)
: CTerm
/-- The encoder constructor: turn a CType into a CTerm of type
`.univ ( := )`. Carries the underlying type as data. -/
| code { : ULevel} (A : CType )
: CTerm
/-- **Modal introduction (Refactor Phase 2).** Given a modality
kind `k : ModalityKind` and a term `a : A`, the term
`modalIntro k a` inhabits `modal k A`. Replaces the Phase-1
trio `.flatIntro`/`.sharpIntro`/`.shapeIntro` with a single
unified constructor parameterised over `k`.
/-- Argument shape for a schema constructor (REL1, §2.1). Reduction: `modalElim k f (modalIntro k a)` ↝ `app f a` (β
fires only when both elim and intro carry the same kind). -/
| modalIntro (k : ModalityKind) (a : CTerm)
: CTerm
/-- **Modal elimination (Refactor Phase 2).** Given an elimination
function `f : A → C` and a scrutinee `m : modal k A`, produce
a term of type `C`. Replaces the Phase-1 trio `.flatElim` /
`.sharpElim` / `.shapeElim` with one unified
`ModalityKind`-parameterised constructor.
Distinguishes ordinary CType-typed args (which may reference Reduction: `modalElim k f (modalIntro k a)` ↝ `app f a` (β-rule
schema parameters via `.param`) from recursive `.self` args on matching kinds). Otherwise: stuck `nModalElim k` neutral. -/
(the inductive being defined) and `.dim` args (used by path | modalElim (k : ModalityKind) (f m : CTerm)
constructors). Boundary clauses inside `CtorSpec` reference : CTerm
args positionally; `.dim` args are addressed in face formulae
via `DimVar.mk "$d_k"` where `k` is the dim-arg index counted /-- Argument shape for a schema constructor (REL1, §2.1). -/
among `.dim` arg positions only. -/
inductive CTypeArg where inductive CTypeArg where
/-- A non-recursive arg whose type is a closed CType. May /-- A non-recursive arg whose type is a closed CType at any
reference schema parameters via embedded `.param i` inside `A` universe level. -/
(parameter substitution happens at instantiation time). -/ | type { : ULevel} (A : CType ) : CTypeArg
| type (A : CType) : CTypeArg /-- The `i`th schema parameter (zero-indexed). -/
/-- The `i`th schema parameter (zero-indexed against | param (i : Nat) : CTypeArg
`CTypeSchema.numParams`). -/
| param (i : Nat) : CTypeArg
/-- Recursive reference to the inductive type being defined. -/ /-- Recursive reference to the inductive type being defined. -/
| self : CTypeArg | self : CTypeArg
/-- A dimension binder, used by path constructors. -/ /-- A dimension binder, used by path constructors. -/
| dim : CTypeArg | dim : CTypeArg
/-- Constructor specification (REL1, §2.2). /-- Constructor specification (REL1, §2.2).
`name` unique within schema; `args` positional; `boundary` is
`name` is unique within the schema. `args` is the positional the partial-element system for path constructors (empty for
arg list. `boundary` is the partial-element system for path point constructors). -/
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"`. -/
inductive CtorSpec where inductive CtorSpec where
| mk (name : String) (args : List CTypeArg) | 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). /-- 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. -/
inductive CTypeSchema where inductive CTypeSchema where
| mk (name : String) (numParams : Nat) | mk (name : String) (numParams : Nat)
(ctors : List CtorSpec) : CTypeSchema (ctors : List CtorSpec)
: CTypeSchema
end end
-- ── Repr derivations ───────────────────────────────────────────────────────── -- ── 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).
deriving instance Repr for CType deriving instance Repr for CType
deriving instance Repr for CTerm deriving instance Repr for CTerm
@ -215,6 +299,171 @@ deriving instance Repr for CTypeArg
deriving instance Repr for CtorSpec deriving instance Repr for CtorSpec
deriving instance Repr for CTypeSchema deriving instance Repr for CTypeSchema
-- DecidableEq for the 5-way mutual block lives in `CubicalTransport.DecEq`
-- (Lean's `deriving instance DecidableEq` doesn't currently support mutual
-- inductives — has to be written manually).
-- ── Level-erased skeletal classifier ─────────────────────────────────────────
-- A non-indexed enum tagging a CType by its head constructor. The level
-- index is stripped — `SkeletalCType` is a plain `Type` with `DecidableEq`
-- and is therefore safe to compare directly via `Eq` without HEq.
--
-- Used to formulate constructor-disjointness preconditions on stuck
-- axioms (`vTransp_stuck`, `eval_comp_stuck`, etc.) in a way that's
-- discharge-able by structural pattern matching, without resorting to
-- HEq elimination across distinct universe indices (which requires K
-- and is not available in Lean 4 without classical axioms).
--
-- This replaces the prior HEq-based formulation
-- `h_not_pi : ∀ {_d _c} (var) (domA : CType _d) (codA : CType _c),
-- HEq A (.pi var domA codA) → False`
-- with the structurally equivalent
-- `h_not_pi : A.skeleton ≠ SkeletalCType.pi`
-- which is decidable, computable, and trivially provable for any
-- non-pi constructor.
inductive SkeletalCType : Type where
| univ
| pi
| sigma
| path
| glue
| ind
| interval
| lift
| El
/-- Modal skeleton (Refactor Phase 2). Carries the modality kind so
that distinct modalities (`♭` vs `♯` vs `ʃ`) remain distinct
skeletons — required for constructor-disjointness reasoning. -/
| modal (k : ModalityKind)
deriving Repr, DecidableEq
/-- Strip the universe index, preserving the head constructor as a tag.
The cornerstone of the structural-disjointness machinery: each CType
constructor maps to its corresponding skeletal tag, and the tag is
a non-indexed enum with decidable equality. -/
def CType.skeleton { : ULevel} : CType → SkeletalCType
| .univ => .univ
| .pi _ _ _ => .pi
| .sigma _ _ _ => .sigma
| .path _ _ _ => .path
| .glue _ _ _ _ _ _ _ _ => .glue
| .ind _ _ => .ind
| .interval => .interval
| .lift _ => .lift
| .El _ => .El
| .modal k _ => .modal k
-- ── Skeleton equations (rfl-provable) ────────────────────────────────────────
/-- The skeleton of `.ind` is `.ind`. -/
@[simp]
theorem CType.skeleton_ind { : ULevel} (S : CTypeSchema)
(params : List (Σ ' : ULevel, CType ')) :
(CType.ind ( := ) S params).skeleton = SkeletalCType.ind := rfl
/-- The skeleton of `.pi` is `.pi`. -/
@[simp]
theorem CType.skeleton_pi {_d _c : ULevel}
(var : String) (domA : CType _d) (codA : CType _c) :
(CType.pi var domA codA).skeleton = SkeletalCType.pi := rfl
/-- The skeleton of `.sigma` is `.sigma`. -/
@[simp]
theorem CType.skeleton_sigma {_a _b : ULevel}
(var : String) (A : CType _a) (B : CType _b) :
(CType.sigma var A B).skeleton = SkeletalCType.sigma := rfl
/-- The skeleton of `.path` is `.path`. -/
@[simp]
theorem CType.skeleton_path { : ULevel} (A : CType ) (a b : CTerm) :
(CType.path A a b).skeleton = SkeletalCType.path := rfl
/-- The skeleton of `.glue` is `.glue`. -/
@[simp]
theorem CType.skeleton_glue { : ULevel} (φ : FaceFormula) (T : CType )
(f fInv s r c : CTerm) (A : CType ) :
(CType.glue φ T f fInv s r c A).skeleton = SkeletalCType.glue := rfl
/-- The skeleton of `.interval` is `.interval`. -/
@[simp]
theorem CType.skeleton_interval :
(CType.interval).skeleton = SkeletalCType.interval := rfl
/-- The skeleton of `.univ` is `.univ`. -/
@[simp]
theorem CType.skeleton_univ { : ULevel} :
(CType.univ ( := )).skeleton = SkeletalCType.univ := rfl
/-- The skeleton of `.lift` is `.lift`. -/
@[simp]
theorem CType.skeleton_lift { : ULevel} (A : CType ) :
(CType.lift A).skeleton = SkeletalCType.lift := rfl
/-- The defining reduction for the El/code pair: decoding the encoding
of a CType returns that same CType.
Stated as an axiom because `El` is a free constructor of CType
rather than a function — the reduction `El (code A) = A` is the
universe-code β-rule (CCHM §6: Glue-style universe codes). This
is the standard formulation in cubical type theory: codes are
inert constructors at the syntax level; their decoding rule is a
propositional / definitional equation in the calculus, equivalent
to a Glue-collapse axiom.
The Rust backend implements this rule by inspecting `CType.El`
targets and folding through `CTerm.code` constructors at the
structural level (see `eval_code` / readback handling). -/
@[simp] axiom CType.El_code_eq { : ULevel} (A : CType ) :
CType.El (CTerm.code A) = A
/-- Skeleton-tag for the new `.El` constructor — used by the
structural-disjointness framework. -/
@[simp] theorem CType.skeleton_El { : ULevel} (P : CTerm) :
(CType.El ( := ) P).skeleton = SkeletalCType.El := rfl
/-- The skeleton of `.modal k A` is `.modal k`. Carries the modality
kind through so that distinct kinds remain distinct skeletons. -/
@[simp]
theorem CType.skeleton_modal { : ULevel} (k : ModalityKind) (A : CType ) :
(CType.modal k A).skeleton = SkeletalCType.modal k := 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 ──────────────────────────────────────────────────── -- ── Dimension substitution ────────────────────────────────────────────────────
-- Substitute dimension variable i with DimExpr r throughout a term. -- Substitute dimension variable i with DimExpr r throughout a term.
-- --
@ -223,10 +472,14 @@ deriving instance Repr for CTypeSchema
-- · The base term t (and system u) are in outer scope — we substitute there. -- · 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 -- 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 -- 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). -- 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 mutual
def CTerm.substDim (i : DimVar) (r : DimExpr) : CTerm → CTerm def CTerm.substDim (i : DimVar) (r : DimExpr) : CTerm → CTerm
@ -240,26 +493,13 @@ mutual
-- substitute in φ via the general DimExpr face-formula substitution. -- substitute in φ via the general DimExpr face-formula substitution.
| .transp j A φ t => .transp j A (φ.substDim i r) (t.substDim i r) | .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) | .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 clauses t =>
.compN j A (CTerm.substDim.clauses i r clauses) (t.substDim i r) .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) | .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) | .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) | .pair a b => .pair (a.substDim i r) (b.substDim i r)
| .fst t => .fst (t.substDim i r) | .fst t => .fst (t.substDim i r)
| .snd t => .snd (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) | .dimExpr s => .dimExpr (DimExpr.subst i r s)
| .ctor S c params args => | .ctor S c params args =>
.ctor S c params (CTerm.substDim.list i r args) .ctor S c params (CTerm.substDim.list i r args)
@ -268,10 +508,17 @@ mutual
(motive.substDim i r) (motive.substDim i r)
(CTerm.substDim.branches i r branches) (CTerm.substDim.branches i r branches)
(target.substDim i r) (target.substDim i r)
-- Universe-code constructor: `code A` carries a CType payload.
-- Same approximation as transp/comp: A is not recursed into.
| .code A => .code A
-- Modal introductions: structural recursion into the wrapped term.
| .modalIntro k a => .modalIntro k (a.substDim i r)
-- Modal eliminations: structural recursion into both subterms
-- (eliminator function and scrutinee).
| .modalElim k f m => .modalElim k (f.substDim i r) (m.substDim i r)
/-- Helper: apply `CTerm.substDim i r` to each clause body (and /-- Helper: apply `CTerm.substDim i r` to each clause body (and
`FaceFormula.substDim` to each face) in a system's clause list. `FaceFormula.substDim` to each face) in a system's clause list. -/
Defined mutually with `substDim` so Lean can verify termination. -/
def CTerm.substDim.clauses (i : DimVar) (r : DimExpr) : def CTerm.substDim.clauses (i : DimVar) (r : DimExpr) :
List (FaceFormula × CTerm) → List (FaceFormula × CTerm) List (FaceFormula × CTerm) → List (FaceFormula × CTerm)
| [] => [] | [] => []
@ -279,14 +526,14 @@ mutual
(φ.substDim i r, u.substDim i r) :: CTerm.substDim.clauses i r rest (φ.substDim i r, u.substDim i r) :: CTerm.substDim.clauses i r rest
/-- Helper: apply `CTerm.substDim i r` to each element of a CTerm /-- 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) : def CTerm.substDim.list (i : DimVar) (r : DimExpr) :
List CTerm → List CTerm List CTerm → List CTerm
| [] => [] | [] => []
| t :: rest => t.substDim i r :: CTerm.substDim.list i r rest | 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 /-- Helper: apply `CTerm.substDim i r` to the body of each branch
an `indElim`. Branch *names* are not affected; only bodies. -/ in an `indElim`. Branch *names* are unaffected; only bodies. -/
def CTerm.substDim.branches (i : DimVar) (r : DimExpr) : def CTerm.substDim.branches (i : DimVar) (r : DimExpr) :
List (String × CTerm) → List (String × CTerm) List (String × CTerm) → List (String × CTerm)
| [] => [] | [] => []
@ -301,29 +548,8 @@ end
-- arm, any axiom of the shape `step (.transp …) = t` would rfl-collapse -- arm, any axiom of the shape `step (.transp …) = t` would rfl-collapse
-- to `.transp … = t`, contradicting `CTerm.noConfusion`. -- to `.transp … = t`, contradicting `CTerm.noConfusion`.
-- --
-- **Stage 4.4 decision (2026-04-23).** After the Phase 1 step↔eval -- See the original Syntax.lean's commentary for the Stage 4.4 history:
-- bridge + Stream B #2d + Stage 2.3, only one step-level axiom remains: -- only `transp_plam_is_plam_path` (T4) remains as a step-level axiom;
-- `transp_plam_is_plam_path` (T4, path-restricted form; Stage 4.2). -- the Rust backend can implement `step` directly or as `readback ∘ eval .nil`.
-- 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.
opaque CTerm.step : CTerm → CTerm := id opaque CTerm.step : CTerm → CTerm := id

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.System CubicalTransport.System
====================== ======================
Step 6 of the transport plan: partial elements — the [φ↦u] of composition. 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. /-- 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 φ. -/ 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 body_typed : HasType Γ s.body L.at1
-- ── Typed system lemmas ─────────────────────────────────────────────────────── -- ── Typed system lemmas ───────────────────────────────────────────────────────
/-- Construct a typed system with face `.bot`. The face is irrelevant to the /-- 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`. -/ `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 → HasType Γ u L.at1 →
System.Typed Γ { face := .bot, body := u } L := System.Typed Γ { face := .bot, body := u } L :=
fun h => { body_typed := h } fun h => { body_typed := h }
/-- Weakening for typed systems. -/ /-- Weakening for typed systems. -/
theorem System.Typed.weaken (x : String) (B : CType) (Γ : Ctx) theorem System.Typed.weaken { B : ULevel} (x : String) (B : CType B) (Γ : Ctx)
(s : System) (L : DimLine) (s : System) (L : DimLine )
(hs : System.Typed Γ s L) : (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 } { body_typed := HasType.weaken x B hs.body_typed }
-- ── Joint compatibility + typing ────────────────────────────────────────────── -- ── Joint compatibility + typing ──────────────────────────────────────────────
/-- Package compat and typing together — this is what the comp typing rule needs. -/ /-- 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 typed : System.Typed Γ s L
compat : System.CompatAt0 s i t₀ compat : System.CompatAt0 s i t₀
/-- The empty system is valid for any t₀, given a body typed at L.at1. -/ /-- 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) : (hu : HasType Γ u L.at1) :
System.Valid Γ { face := .bot, body := u } L i t₀ := System.Valid Γ { face := .bot, body := u } L i t₀ :=
{ typed := { body_typed := hu } { 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. /-- Convert a System.Valid proof into the raw HasType.comp judgment.
This is the ergonomic entry point: package everything in System.Valid, This is the ergonomic entry point: package everything in System.Valid,
then call this to produce the typed composition term. -/ then call this to produce the typed composition term. -/
theorem HasType.comp_of_valid theorem HasType.comp_of_valid { : ULevel}
(Γ : Ctx) (L : DimLine) (s : System) (t₀ : CTerm) (Γ : Ctx) (L : DimLine ) (s : System) (t₀ : CTerm)
(ht : HasType Γ t₀ L.at0) (ht : HasType Γ t₀ L.at0)
(hv : System.Valid Γ s L L.binder t₀) : (hv : System.Valid Γ s L L.binder t₀) :
HasType Γ (.comp L.binder L.body s.face s.body t₀) L.at1 := HasType Γ (.comp L.binder L.body s.face s.body t₀) L.at1 :=

View file

@ -0,0 +1,747 @@
/-
CubicalTransport.Tactic.EqContract
==================================
User-facing tactic surface that operates on the topos-internal
contracts (THEORY.md §0.10 / §∞.3).
## What this module exports
Three tactics and two commands:
· `tactic via_eq_contract` — translates a cubical Path-equality
existence goal to a Lean Eq goal using `pathEqEquiv`, gated by
`CubicalSetC` synthesis from the contract registry. After the
tactic runs, the goal is the Eq-side; the user discharges it
with mathlib (or any other Lean reasoning). When the contract
cannot be discharged automatically, the residual `CubicalSetC T`
obligation is left as an additional subgoal alongside the Eq.
· `tactic find_contract_path` — synthesis: given a goal of shape
expressing "find me a contract for T", BFS the contract
registry combined with the entailment-morphism table to
discover a contract value. Closes the goal with the
discovered pair, or fails with a precise error.
· `tactic lift_via_topos t` — bundled: takes a tactic argument
`t` (as a `tacticSeq`), runs `via_eq_contract` to translate the
goal, then applies `t` on the translated goal. One-shot
transport from cubical-side to mathlib-side.
· `command #contract` — displays the topos of contracts: lists
every registered Contract by name (from
`Reflect.Contract.allRegistered`), alongside the known
entailment morphisms.
· `command #whichContract <CType>` — given a CType expression,
attempts contract synthesis for every registered contract and
lists the ones that succeed.
## Design
All five user-facing items share four internal helpers:
· `parsePathGoal` — given the goal Expr, peels `Exists`,
`HasType`, and `CType.path` to extract the four pieces
`(α_expr, embed_expr, T_expr, a_value_expr, b_value_expr)`
needed to apply `pathEqEquiv`.
· `entailmentRegistry` — the hardcoded table of known entailment
morphisms `(fromContractName, toContractName, lemmaName)`.
Currently houses only the canonical `CDecidableEq → CubicalSetC`
morphism via `CubicalSetC_of_CDecidableEq`; additional
entailments land here as Hedberg / J-rule discharges unlock
further Set-level promotions.
· `synthCubicalSetC` — BFS over the entailment table to attempt
to construct a Lean-Prop witness of `CubicalSetC T` from the
registry. Falls back to leaving the obligation as an mvar
when no closed chain succeeds.
· `attemptSynthesis` — for `#whichContract`: given a contract
name and a CType, try the same BFS to construct a satisfaction
witness, returning whether it succeeded.
## Implementation discipline
· No `sorry` is emitted by any tactic body. When a tactic cannot
construct a proof, it throws a precise `throwError` with
diagnostic context (the goal, the expected shape, the registry
contents, the entailment chain attempted).
· The BFS in `find_contract_path` and `synthCubicalSetC` is real:
a worklist over `(currentName, derivationChain)` pairs,
expanded by entailment morphisms, with a visited-set to prevent
cycles. When the worklist is exhausted, a precise error fires
that lists what was tried.
· Pattern matching on the goal Expr is precise: the
`parsePathGoal` helper reduces (`whnf`) at every layer and
matches each constructor name explicitly; mismatches throw
diagnostic errors pointing at the actual vs. expected shape.
· The Lean metaprogramming API used is fixed-set: `MVarId`,
`getMainGoal`, `withMainContext`, `replaceMainGoal`,
`liftMetaTactic`, `evalTactic`, `Lean.Meta.mkFreshExprMVar`,
`MVarId.apply`, `Lean.Meta.whnf`, `Expr.getAppFnArgs`. Each
has been verified against the Lean 4.30.0-rc2 source.
-/
import CubicalTransport.Reflect
import CubicalTransport.Bridge.Set
namespace CubicalTransport.Tactic.EqContract
open Lean Lean.Meta Lean.Elab Lean.Elab.Tactic Lean.Elab.Command
open CubicalTransport.Reflect
open CubicalTransport.Bridge.Set
-- ── §1. Entailment morphism registry ──────────────────────────────────────
/-- A single entailment morphism from one named contract to another,
discharged by a named lemma whose signature is
`fromContract T → toContract T`
(or, in the `CubicalSetC ← CDecidableEq` case, with the source
expressed as the corresponding closed-cubical-existential
statement).
Stored as a triple of `Lean.Name`s for cheap registry
inspection; the lemma is applied by name via `MVarId.apply`
on a fresh-mvar expression of the lemma's constant. -/
structure EntailmentMorphism where
/-- The source contract's name (the contract a witness is needed for). -/
fromContract : Lean.Name
/-- The target contract's name (the contract this morphism produces). -/
toContract : Lean.Name
/-- The Lean lemma's `Name` that discharges the entailment. -/
lemmaName : Lean.Name
deriving Repr
/-- The hardcoded entailment registry. Each entry is read by the
`synthCubicalSetC` BFS and by the `#contract` command.
The sole entry currently formalised is
`CDecidableEq → CubicalSetC` via `CubicalSetC_of_CDecidableEq`
(Bridge/Set.lean §1). Additional entailments land here as
Hedberg (`Decidable.lean`) and the J-rule combinator from
`Soundness.transp_ua` discharge further Set-level promotions:
· `CGroupC → CubicalSetC` once the group-on-a-Set lemma lands;
· `CCoxeterC → CGroupC` once the Coxeter-is-group inclusion lands;
· `CSheafC → CSiteC` once the sheaf-on-site projection lands.
Each entry's `lemmaName` is a real Lean constant — the BFS tries
`MVarId.apply` on a fresh-level-instantiated `mkConst lemmaName`
expression. -/
def entailmentRegistry : List EntailmentMorphism := [
{ fromContract := ``CubicalTransport.Decidable.CDecidableEq
toContract := ``CubicalTransport.Bridge.Set.CubicalSetC
lemmaName := ``CubicalTransport.Bridge.Set.CubicalSetC_of_CDecidableEq }
]
-- ── §2. Parsing helpers for the via_eq_contract goal shape ────────────────
/-- The five pieces extracted from a Path-existence goal. Used by
`via_eq_contract` and `lift_via_topos` to construct the
`Iff.mpr (pathEqEquiv ...)` term that flips the goal from the
Path-side to the Eq-side.
· `αExpr` — the Lean type `α : Type` whose elements are being
equated (the `α` of `[CubicalEmbed α]`).
· `embedExpr` — the `CubicalEmbed α` typeclass instance.
· `tExpr` — the carrier CType `T : CType `, equal to
`@CubicalEmbed.ctype α embedExpr`.
· `aExpr` — the left endpoint value `a : α`.
· `bExpr` — the right endpoint value `b : α`. -/
structure PathGoalParts where
αExpr : Expr
embedExpr : Expr
tExpr : Expr
aExpr : Expr
bExpr : Expr
/-- Strip a chain of metadata wrappers and instantiate metavariables
to expose the underlying expression head, but do NOT unfold any
constants (typeclass projections, definitions, etc.). Used at
every layer of `parsePathGoal` to peel through the elaborated
encoding without losing the symbolic structure (which `whnf`
with full transparency would erase via β/δ-reduction of
typeclass projections like `CubicalEmbed.ctype` and
`CubicalEmbed.toCTerm`).
Implementation: `instantiateMVars` followed by `whnf` at
`.reducible` transparency, which only reduces `[reducible]`
declarations (not typeclass projections nor definitions). -/
private def reduce (e : Expr) : MetaM Expr := do
let e ← instantiateMVars e
withTransparency .reducible (whnf e)
/-- Try to extract the underlying value `a : α` from an
`@CubicalTransport.Bridge.CubicalEmbed.toCTerm α inst aValue`
application. Returns the third explicit argument when matched.
The encoding produced by `CubicalEmbed.toCTerm a` elaborates to
the three-explicit-argument form `@toCTerm α inst a`. We match
by constant name and pull the value off the args array. -/
private def extractToCTermValue (e : Expr) : MetaM (Option Expr) := do
let e ← reduce e
let (fn, args) := e.getAppFnArgs
if fn == ``CubicalTransport.Bridge.CubicalEmbed.toCTerm then
-- @CubicalEmbed.toCTerm α inst a — three args. The value
-- lives in the last position.
if h : args.size ≥ 3 then
return some (args[args.size - 1]'(by omega))
else
return none
else
return none
/-- Try to extract the `α` and `inst` from a
`@CubicalTransport.Bridge.CubicalEmbed.ctype α inst` application.
Returns the pair `(α, inst)` when matched. Used by
`parsePathGoal` to peel the carrier CType layer. -/
private def extractCubicalEmbedCarrier (e : Expr) :
MetaM (Option (Expr × Expr)) := do
let e ← reduce e
let (fn, args) := e.getAppFnArgs
if fn == ``CubicalTransport.Bridge.CubicalEmbed.ctype then
-- @CubicalEmbed.ctype α inst — two arguments.
if h : args.size ≥ 2 then
let α := args[0]'(by omega)
let inst := args[1]'(by omega)
return some (α, inst)
else
return none
else
return none
/-- Parse a goal expression of the shape
`∃ (t : CTerm), HasType [] t
(.path (CubicalEmbed.ctype (α := α))
(CubicalEmbed.toCTerm a)
(CubicalEmbed.toCTerm b))`
into the five pieces `(α, inst, T, a, b)` needed to invoke
`pathEqEquiv`.
Returns `none` if the goal does not have this exact shape; the
caller then throws a precise diagnostic error.
Algorithm:
1. `whnf` the goal to expose the `Exists` head.
2. Match `Exists` with two args: `[CTerm_type, predicate_λ]`.
The predicate is `fun t => HasType [] t (.path T a_emb b_emb)`.
3. Strip the lambda to get the body, with `t` as `bvar 0`.
4. `whnf` the body to expose `HasType`.
5. Match `HasType` with its full arg list and pull the LAST
argument (the type).
6. `whnf` the type to expose `.path`.
7. Match `.path` with four args: `[, T_carrier, a_emb, b_emb]`.
8. `whnf` `T_carrier` to expose `CubicalEmbed.ctype α inst`;
extract `(α, inst)`.
9. `whnf` `a_emb` and `b_emb` to expose `CubicalEmbed.toCTerm`
applications; extract the underlying values. -/
def parsePathGoal (goalType : Expr) :
MetaM (Option PathGoalParts) := do
let goalType ← reduce goalType
-- Step 1-2: peel Exists.
let (existsFn, existsArgs) := goalType.getAppFnArgs
if existsFn != ``Exists then
return none
if existsArgs.size < 2 then
return none
let predicate := existsArgs[1]!
-- Step 3: strip the lambda to get the body. The body has the
-- bound `t` as `bvar 0`.
if !predicate.isLambda then
return none
let body := predicate.bindingBody!
let body ← reduce body
-- Step 4-5: peel HasType. The encoding is
-- @HasType ctx t A
-- — four explicit (or some implicit) arguments. We match by
-- constant name and pull the LAST arg as the type expression
-- (T_expr).
let (hasTypeFn, hasTypeArgs) := body.getAppFnArgs
if hasTypeFn != ``HasType then
return none
if hasTypeArgs.size < 4 then
return none
-- Last arg is the CType.
let tExpr := hasTypeArgs[hasTypeArgs.size - 1]!
-- Step 6-7: peel CType.path.
let tExpr ← reduce tExpr
let (pathFn, pathArgs) := tExpr.getAppFnArgs
if pathFn != ``CType.path then
return none
if pathArgs.size < 4 then
return none
-- Args: [, T_carrier, a_emb, b_emb].
let tCarrier := pathArgs[1]!
let aEmb := pathArgs[2]!
let bEmb := pathArgs[3]!
-- Step 8: extract α and inst from T_carrier.
let some (α, inst) ← extractCubicalEmbedCarrier tCarrier | return none
-- Step 9: extract a and b values from the toCTerm forms.
let some aVal ← extractToCTermValue aEmb | return none
let some bVal ← extractToCTermValue bEmb | return none
return some {
αExpr := α
embedExpr := inst
tExpr := tCarrier
aExpr := aVal
bExpr := bVal
}
-- ── §3. Universe-level extraction helper ──────────────────────────────────
/-- Extract the universe-level argument from a CType expression's
type. For `T : CType `, `inferType T` yields `CType `, and
we want `` as an Expr. Used by `synthCubicalSetC` and
`via_eq_contract` to fill in the `` argument to
`CubicalSetC T`. -/
def extractCTypeLevel (T : Expr) : MetaM Expr := do
let tType ← inferType T
let tType ← whnf tType
let (_, args) := tType.getAppFnArgs
if args.size ≥ 1 then
return args[0]!
else
throwError "extractCTypeLevel: cannot extract universe level from {← ppExpr tType} (expected `CType `-shaped)"
-- ── §4. CubicalSetC synthesis (BFS over the entailment registry) ──────────
/-- Configuration cap on the BFS recursion depth, to keep the
search bounded. Five layers is more than enough for the
current entailment graph (which has only one edge); leaves
headroom for future entailments. -/
private def synthDepthCap : Nat := 5
/-- BFS over the entailment registry to attempt construction of a
closed `Expr` that discharges `goalMVar`.
The implementation runs as follows:
· For each entailment morphism whose `toContract` matches
the goal's head constant, try `MVarId.apply` with the
morphism's lemma.
· The resulting subgoals (the morphism's hypotheses) are
each fed back to `bfsSynth` recursively.
· Stop when no remaining subgoals (success), the depth cap
is exceeded (failure), or no morphism applies (failure).
Returns `true` on success, `false` on failure. On success,
`goalMVar` is fully assigned (and so are any subgoals
introduced along the way). On failure, the caller should run
this in a `withSavedState` block to roll back partial
assignments. -/
partial def bfsSynth (goalMVar : MVarId) (depth : Nat := synthDepthCap) :
MetaM Bool := do
if depth == 0 then
return false
goalMVar.withContext do
let goalType ← goalMVar.getType
let goalType ← whnf goalType
let (headFn, _) := goalType.getAppFnArgs
-- For each entailment morphism whose `toContract` matches the
-- head, try the application.
let candidates := entailmentRegistry.filter fun m => m.toContract == headFn
for morphism in candidates do
let lemmaConst ← mkConstWithFreshMVarLevels morphism.lemmaName
let savedState ← saveState
let attemptResult : MetaM (Option (List MVarId)) := do
try
let r ← goalMVar.apply lemmaConst
return some r
catch _ =>
return none
match ← attemptResult with
| none =>
restoreState savedState
continue
| some newGoals =>
-- Recursively try to discharge each new goal.
let mut allDischarged := true
for ng in newGoals do
if !(← bfsSynth ng (depth - 1)) then
allDischarged := false
break
if allDischarged then
return true
else
-- Roll back the partial application and try the next
-- candidate morphism.
restoreState savedState
continue
-- No morphism worked: synthesis failure.
return false
/-- Synthesize a closed `Expr` of type `CubicalSetC T_expr` by BFS
over the entailment registry. Returns `some witnessExpr` if
the synthesis succeeds, `none` otherwise.
The returned expression has type `CubicalSetC T_expr` and can
be passed directly as the `c : CubicalSetC ...` argument to
`pathEqEquiv` (the lemma's signature is exactly
`pathEqEquiv c a b : ... ↔ a = b`).
On failure, the caller (typically `via_eq_contract`) reports a
precise error or leaves the obligation as a residual subgoal. -/
def synthCubicalSetC (T_expr : Expr) :
MetaM (Option Expr) := do
-- The goal type is `CubicalSetC T_expr`. Build the mvar and
-- run BFS.
let levelExpr ← extractCTypeLevel T_expr
let cubicalSetCTy := mkAppN
(mkConst ``CubicalTransport.Bridge.Set.CubicalSetC)
#[levelExpr, T_expr]
let savedState ← saveState
let goalMVar ← mkFreshExprMVar cubicalSetCTy MetavarKind.synthetic
if (← bfsSynth goalMVar.mvarId!) then
let result ← instantiateMVars goalMVar
-- Verify that the result is fully closed (no remaining mvars).
if (← getMVars result).isEmpty then
return some result
else
-- Partial discharge: roll back and report failure.
restoreState savedState
return none
else
-- BFS failed: roll back and report failure.
restoreState savedState
return none
-- ── §5. via_eq_contract ───────────────────────────────────────────────────
/-- The `via_eq_contract` tactic. Translates a cubical Path-side
existence goal to a Lean Eq goal via `pathEqEquiv`'s `mpr`
direction.
Expected goal shape:
`⊢ ∃ (t : CTerm), HasType [] t
(.path (CubicalEmbed.ctype (α := α))
(CubicalEmbed.toCTerm a)
(CubicalEmbed.toCTerm b))`
Behavior:
· Inspect the goal; throw a precise error if it doesn't
match this shape.
· Synthesize `CubicalSetC T` from the entailment registry
via `synthCubicalSetC`. If synthesis succeeds, the
contract argument is filled in automatically. If not, the
`CubicalSetC T` obligation is left as an additional
subgoal alongside `a = b`.
· Apply `Iff.mpr (pathEqEquiv c a b)` to the goal, replacing
it with `a = b` (plus the residual `CubicalSetC T` if
unsolved).
-/
syntax "via_eq_contract" : tactic
elab_rules : tactic
| `(tactic| via_eq_contract) => do
let goal ← getMainGoal
goal.withContext do
let goalType ← goal.getType
let goalType ← instantiateMVars goalType
-- Step 1: parse the Path-existence shape.
let some parts ← parsePathGoal goalType
| throwError "via_eq_contract: goal is not a cubical Path-existence shape.\n\
Expected: ∃ t, HasType [] t (.path (CubicalEmbed.ctype) (CubicalEmbed.toCTerm a) (CubicalEmbed.toCTerm b))\n\
Got: {← ppExpr goalType}\n\
Hint: the goal's outer head must be ∃, with the body asserting a typed-Path existence."
-- Step 2: attempt to synthesize CubicalSetC T from the
-- registry. Record success/failure for the application
-- step that follows.
let synthesizedC ← synthCubicalSetC parts.tExpr
-- Step 3: build the application `Iff.mpr (pathEqEquiv ?c a b)`.
-- We use a metavariable for the contract argument when
-- synthesis failed; otherwise we use the synthesized term.
let cArg ← match synthesizedC with
| some witness => pure witness
| none =>
-- Make a fresh mvar of the appropriate type, to be left
-- as an additional subgoal.
let levelExpr ← extractCTypeLevel parts.tExpr
let cubicalSetCTy := mkAppN
(mkConst ``CubicalTransport.Bridge.Set.CubicalSetC)
#[levelExpr, parts.tExpr]
mkFreshExprMVar cubicalSetCTy MetavarKind.syntheticOpaque
-- Build the pathEqEquiv application:
-- `@pathEqEquiv α inst c a b`. Use `mkAppOptM` so the
-- implicit `α` and `[CubicalEmbed α]` instance arguments are
-- filled in correctly (we supply them as `some`-options
-- explicitly to override implicit-search).
let equivApp ← mkAppOptM
``CubicalTransport.Bridge.Set.pathEqEquiv
#[some parts.αExpr, some parts.embedExpr, some cArg,
some parts.aExpr, some parts.bExpr]
-- Apply `Iff.mpr` to flip the direction. `Iff.mpr` has the
-- signature `{a b : Prop} → (a ↔ b) → b → a`, so applying it
-- to `equivApp : (∃...) ↔ (a = b)` yields a function of type
-- `(a = b) → (∃...)`. Use `mkAppM` so the implicit
-- propositional arguments get filled in from the type of
-- `equivApp`.
let appliedTerm ← mkAppM ``Iff.mpr #[equivApp]
-- Apply to the main goal. `MVarId.apply` will produce new
-- subgoals for any unsolved arguments — the `a = b` goal
-- and (if synthesis failed) the `CubicalSetC T` goal.
let newGoals ← goal.apply appliedTerm
replaceMainGoal newGoals
-- ── §6. find_contract_path ────────────────────────────────────────────────
/-- The `find_contract_path` tactic. Synthesis: given a goal,
BFS the contract registry combined with the entailment-
morphism table to discover a contract value or chain that
closes the goal.
Goal shape (chosen interpretation, documented below):
`⊢ <some-shape> involving a registered contract`
The tactic tries each registered contract as a closed lemma
via `MVarId.applyConst`-style application. When a direct
application doesn't close the goal, the BFS expands the
frontier by adding contracts reachable via entailment
morphisms whose `fromContract` is the current contract.
Why this shape: THEORY.md §0.10 specifies
`find_contract_path` as "given a goal, walks the contract DAG
to find a sequence of contract entailments that resolve the
goal." The most natural interpretation is "try each
registered contract; if direct application fails, follow
entailment edges."
Behavior:
· Get the registry of all registered contract names.
· For each name, look up the entry; try
`MVarId.applyConst` of the contract's defining constant.
· BFS-expand by entailment morphisms.
· On exhaustion, throw an error listing the registered
contracts, the entailment morphisms, and the chains
attempted.
-/
syntax "find_contract_path" : tactic
elab_rules : tactic
| `(tactic| find_contract_path) => do
let goal ← getMainGoal
goal.withContext do
let goalType ← goal.getType
let goalType ← instantiateMVars goalType
-- Get the registered contracts.
let registered ← Contract.allRegistered
if registered.isEmpty && entailmentRegistry.isEmpty then
throwError "find_contract_path: the contract registry is empty AND \
there are no entailment morphisms.\n\
No contracts have been registered via `Contract.register` in any \
module's `initialize` block.\n\
Goal was: {← ppExpr goalType}"
-- BFS worklist: each entry is a contract name and a list of
-- entailments traversed to reach it. Start with all
-- registered contracts as seeds.
let mut visited : Std.HashSet Lean.Name := ∅
let mut frontier : List (Lean.Name × List Lean.Name) :=
registered.map fun n => (n, [n])
let mut attemptedChains : List (List Lean.Name) := []
let mut closed := false
while !frontier.isEmpty do
match frontier with
| [] =>
-- Unreachable: while-guard forbids empty frontier; we
-- include this arm to satisfy the exhaustiveness
-- check.
break
| (n, chain) :: rest =>
frontier := rest
if visited.contains n then
continue
visited := visited.insert n
attemptedChains := chain :: attemptedChains
let entry? ← Contract.lookupByName n
match entry? with
| none =>
-- A name in `allRegistered` should always resolve;
-- defensively skip and continue if it doesn't.
continue
| some _entry =>
-- Try to close the goal using the contract's defining
-- constant. `applyConst` instantiates fresh universe
-- mvars and unifies the conclusion with the goal.
let savedState ← saveState
let attemptResult : MetaM (Option (List MVarId)) := do
try
let result ← goal.applyConst n
return some result
catch _ =>
return none
match ← attemptResult with
| some [] =>
-- All subgoals discharged: success.
replaceMainGoal []
closed := true
break
| _ =>
-- Direct application didn't close cleanly. Roll back
-- and expand frontier by entailments from n.
restoreState savedState
for morphism in entailmentRegistry do
if morphism.fromContract == n && !visited.contains morphism.toContract then
frontier := frontier ++ [(morphism.toContract, morphism.toContract :: chain)]
continue
if closed then return
-- BFS exhausted without closing.
let registeredStr := registered.map fun n => s!"{n}"
let entailmentStr := entailmentRegistry.map fun m =>
s!"{m.fromContract} → {m.toContract} (via {m.lemmaName})"
let attemptedStr := attemptedChains.map fun c =>
String.intercalate " → " (c.map fun n => s!"{n}")
throwError "find_contract_path: contract synthesis failed.\n\
Goal: {← ppExpr goalType}\n\
Registered contracts ({registered.length}): {registeredStr}\n\
Entailment morphisms ({entailmentRegistry.length}): {entailmentStr}\n\
Chains attempted ({attemptedChains.length}): {attemptedStr}"
-- ── §7. lift_via_topos ────────────────────────────────────────────────────
/-- The `lift_via_topos t` tactic. Bundled one-shot transport from
cubical-side to mathlib-side.
Behavior:
1. Run `via_eq_contract` to translate the goal from the
Path-existence shape to the Eq-shape `a = b`.
2. Run the user-supplied tactic `t` on the translated goal.
Effectively: `lift_via_topos t ≡ via_eq_contract; t`. -/
syntax "lift_via_topos" tacticSeq : tactic
elab_rules : tactic
| `(tactic| lift_via_topos $t:tacticSeq) => do
evalTactic (← `(tactic| via_eq_contract))
evalTactic t
-- ── §8. #contract command ─────────────────────────────────────────────────
/-- The `#contract` command. Displays the topos of contracts:
lists every registered Contract by name (read from
`Reflect.Contract.allRegistered`), alongside the known
entailment morphisms (read from `entailmentRegistry`).
Output format:
Registered contracts (N):
• <Name1>
• <Name2>
...
Entailment morphisms (M):
• <FromName> → <ToName> (via <LemmaName>)
...
Used for human exploration of the contract registry's current
state. No side effects — pure read of the registry. -/
syntax "#contract" : command
elab_rules : command
| `(command| #contract) => do
let registered ← Contract.allRegistered
let mut msg : MessageData := m!"Registered contracts ({registered.length}):"
if registered.isEmpty then
msg := msg ++ m!"\n (none — call `Contract.register` in an `initialize` block to register one)"
else
for n in registered do
msg := msg ++ m!"\n • {n}"
msg := msg ++ m!"\n\nEntailment morphisms ({entailmentRegistry.length}):"
if entailmentRegistry.isEmpty then
msg := msg ++ m!"\n (none)"
else
for morphism in entailmentRegistry do
msg := msg ++ m!"\n • {morphism.fromContract} → {morphism.toContract} (via {morphism.lemmaName})"
logInfo msg
-- ── §9. #whichContract command ───────────────────────────────────────────
/-- For `#whichContract`: given a contract name and a CType
expression, attempt synthesis of the contract's satisfaction
on the CType. Returns `true` if a witness can be constructed,
`false` otherwise.
Currently a structural test: applies the contract function to
the CType and checks that the application typechecks (the
Reflect-registered contract entry has a level `e.level` and a
function `e.contract : CType e.level → CTerm`). Since the
contract function is just a Lean-level pure function, the
application succeeds iff the CType is at the right level.
A stronger test (typed-satisfaction in the empty context)
requires the engine's HasType-checker, which lives outside
this module's scope. This implementation is intentionally a
structural filter, suitable for `#whichContract`'s "list
candidate contracts" purpose. -/
def attemptSynthesis (contractName : Lean.Name)
(TE : Expr) : MetaM Bool := do
-- Look up the contract entry.
let entry? ← Contract.lookupByName contractName
match entry? with
| none =>
-- Unknown contract — synthesis cannot succeed.
return false
| some _entry =>
-- Structural test: try to apply the contract's defining Lean
-- constant to the CType expression. If this elaborates
-- without error, the contract is structurally applicable.
let cExpr ← mkConstWithFreshMVarLevels contractName
let appExpr := mkApp cExpr TE
try
-- `inferType` will succeed iff the application is
-- well-typed, i.e. the contract's CType-level matches the
-- input's level.
let _ ← inferType appExpr
return true
catch _ =>
return false
/-- The `#whichContract <CType>` command. Given a CType
expression, lists the registered contracts that apply to it
(per `attemptSynthesis`).
Output format:
<CType expression> satisfies (K of N contracts):
• <Name1>
• <Name2>
...
or, if no contracts apply:
No registered contract is satisfied by <CType expression>.
Used to discover what contracts a CType participates in. Pure
read of the registry plus a structural per-contract test. -/
syntax "#whichContract" term : command
elab_rules : command
| `(command| #whichContract $T:term) => do
-- Elaborate the CType expression in the command context.
-- Use `liftTermElabM` to bridge from `CommandElabM` to
-- `TermElabM`.
let TE ← liftTermElabM do
Term.elabTerm T none
-- Run the synthesis attempt for each registered contract.
let registered ← Contract.allRegistered
let mut satisfied : List Lean.Name := []
for n in registered do
let ok ← liftTermElabM do
attemptSynthesis n TE
if ok then
satisfied := satisfied ++ [n]
let TEStr ← liftTermElabM do
let fmt ← Lean.Meta.ppExpr TE
return fmt.pretty
if satisfied.isEmpty then
logInfo m!"No registered contract is satisfied by {TEStr}."
else
let mut msg : MessageData :=
m!"{TEStr} satisfies ({satisfied.length} of {registered.length} contracts):"
for n in satisfied do
msg := msg ++ m!"\n • {n}"
logInfo msg
end CubicalTransport.Tactic.EqContract

View file

@ -1,7 +1,8 @@
/- /-
Topolei.Cubical.Transport CubicalTransport.Transport
========================= ==========================
Value-level transport (cells-spec §5.5, Phase 1 Weeks 34). Value-level transport (cells-spec §5.5, Phase 1 Weeks 34).
Universe-aware (Layer 0 §0.1 cascade).
`vTransp i A φ v` reduces `transp^i A φ v` at the value level. `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` 2. **`CType.dimAbsent i A = true`** — line is constant — return `v`
unchanged. Evaluator-level analogue of `transp_const_id` (T2). unchanged. Evaluator-level analogue of `transp_const_id` (T2).
Covers `univ`, fully-constant `pi`, fully-constant `path`. Covers `univ`, fully-constant `pi`, fully-constant `path`.
3. **`A = pi domA codA`** — produce a `vTranspFun i domA codA φ v` 3. **`A = pi var domA codA`** — produce a `vTranspFun i domA codA φ v`
closure. This is the **full CCHM Π rule** — when the closure is closure (the pi's binder name is consumed; vApp handles the
later applied to an argument, `vApp` inversely transports the function-side reduction using the transport's binder `i`).
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.
4. **Otherwise** — stuck. Produce `vneu (.ntransp i A φ v)`. 4. **Otherwise** — stuck. Produce `vneu (.ntransp i A φ v)`.
Deferred to later passes: vTransp is a `partial def` for the same reason as `eval`. Its
reduction equations are stated as axioms.
· Σ 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.
-/ -/
import CubicalTransport.Value import CubicalTransport.Value
@ -38,12 +27,12 @@ import CubicalTransport.DimLine -- for CType.dimAbsent and substDimExpr
-- ── Rust FFI declaration (Phase C.2) ────────────────────────────────────── -- ── Rust FFI declaration (Phase C.2) ──────────────────────────────────────
@[extern "topolei_cubical_vtransp"] @[extern "cubical_transport_vtransp"]
opaque vTranspRust (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) : CVal opaque vTranspRust { : ULevel} (i : DimVar) (A : CType ) (φ : FaceFormula) (v : CVal) : CVal
/-- Value-level transport. Dispatches in priority order; see file header. -/ /-- Value-level transport. Dispatches in priority order; see file header. -/
@[implemented_by vTranspRust] @[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 := CVal :=
match φ with match φ with
| .top => v -- (1) T1 at eval level. | .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. v -- (2) T2 at eval level.
else else
match A with match A with
| .pi domA codA => | .pi _ domA codA =>
-- (3) Full CCHM Π rule — no specialisation here. The behaviour -- (3) Full CCHM Π rule.
-- 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).
.vTranspFun i domA codA φ v .vTranspFun i domA codA φ v
| _ => | _ =>
-- (4) non-pi stuck (e.g. path with varying endpoints). -- (4) non-pi stuck (e.g. path with varying endpoints).
@ -64,90 +50,102 @@ partial def vTransp (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) :
/-- **Inverse transport** along the line `(i, A)`: transport `v : A(1)` back /-- **Inverse transport** along the line `(i, A)`: transport `v : A(1)` back
to `A(0)`. Implemented as forward transport along the *reversed* line to `A(0)`. Implemented as forward transport along the *reversed* line
`A[i := inv i]`. `A[i := inv i]`. -/
def vTranspInv { : ULevel} (i : DimVar) (A : CType ) (φ : FaceFormula) (v : CVal) : CVal :=
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 :=
vTransp i (A.substDimExpr i (.inv (.var i))) φ v vTransp i (A.substDimExpr i (.inv (.var i))) φ v
/-! /-!
## Reduction axioms and theorems ## Reduction lemmas
One axiom per reducing match arm of `vTransp`. The arms are disjoint One lemma per reducing match arm of `vTransp`. The arms are disjoint
(ordered pattern match), so the axiom set is consistent. (ordered pattern match), so the lemma set is consistent.
**Axiom-debt cleanup (REL2 follow-up).** Previously declared `axiom`;
now `theorem ... := by sorry` annotated to **FS-H15** in
`topolei/docs/HYPOTHESES.md` (the partial-def-reduction-equations
umbrella hypothesis). Lean's `partial def` does not auto-emit
kernel-reducible unfolding equations — so even though each lemma is a
literal mirror of its corresponding match arm of `vTransp`'s body,
neither `rfl` nor `simp [vTransp]` discharges them in the kernel. The
discharge route is to convert `vTransp` to a total `def` (with a
termination measure on the syntax tree) and then prove each lemma by
`rfl` / `simp [vTransp]`. Conversion `axiom → sorry` is a strict
trust-footprint improvement: the obligation is surfaced as a TODO
rather than committed to as ground truth.
-/ -/
/-- (1) Reduction under a full face: transport is identity. -/ /-- (1) Reduction under a full face: transport is identity. -/
axiom vTransp_top (i : DimVar) (A : CType) (v : CVal) : theorem vTransp_top { : ULevel} (i : DimVar) (A : CType ) (v : CVal) :
vTransp i A .top v = v vTransp i A .top v = v := by
-- waits on: FS-H15. Mirror of `vTransp` partial-def's `.top` arm.
sorry
/-- (2) Reduction under a constant line. -/ /-- (2) Reduction under a constant line. -/
axiom vTransp_const (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) theorem vTransp_const { : ULevel} (i : DimVar) (A : CType ) (φ : FaceFormula) (v : CVal)
(h : CType.dimAbsent i A = true) : (h : CType.dimAbsent i A = true) :
vTransp i A φ v = v vTransp i A φ v = v := by
-- waits on: FS-H15. Mirror of `vTransp` partial-def's constant-line arm.
sorry
/-- (3) Π case (full CCHM rule): produces a transported-function closure /-- (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, · `φ ≠ .top` — else (1) fires,
· `CType.dimAbsent i (.pi domA codA) = false` — else (2) fires. · `CType.dimAbsent i (.pi var domA codA) = false` — else (2) fires. -/
When `dimAbsent i domA = true`, the inverse transport inside the theorem vTransp_pi { ' : ULevel}
later `vApp` reduction degenerates to identity by `vTranspInv_const` (i : DimVar) (var : String) (domA : CType ) (codA : CType ')
below, recovering the const-domain specialisation. -/ (φ : FaceFormula) (v : CVal)
axiom vTransp_pi
(i : DimVar) (domA codA : CType) (φ : FaceFormula) (v : CVal)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i (.pi domA codA) = false) : (hA : CType.dimAbsent i (.pi var domA codA) = false) :
vTransp i (.pi domA codA) φ v = .vTranspFun i domA codA φ v vTransp i (.pi var domA codA) φ v = .vTranspFun i domA codA φ v := by
-- waits on: FS-H15. Mirror of `vTransp` partial-def's `.pi` arm.
sorry
/-- (4) Stuck: not face-top, not constant, and not a `.pi`. The third /-- (4) Stuck: not face-top, not constant, and not a `.pi`.
precondition rules out arm (3). -/
axiom vTransp_stuck (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal) 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. -/
theorem vTransp_stuck { : ULevel}
(i : DimVar) (A : CType ) (φ : FaceFormula) (v : CVal)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i A = false) (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) vTransp i A φ v = .vneu (.ntransp i A φ v) := by
-- waits on: FS-H15. Mirror of `vTransp` partial-def's stuck-fallback arm.
sorry
-- ── vTranspInv on constant domain ──────────────────────────────────────────── -- ── vTranspInv on constant domain ────────────────────────────────────────────
/-- Inverse transport along a line whose body is absent from `i` is the /-- 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` identity. -/
(by `CType.substDimExpr_of_absent`), so the outer `vTransp` call has a theorem vTranspInv_const { : ULevel}
constant line and reduces via T2 to `v`. This lemma is what makes the (i : DimVar) (A : CType ) (φ : FaceFormula) (v : CVal)
unified `vTranspFun` constructor degenerate correctly when the domain
is constant. -/
theorem vTranspInv_const (i : DimVar) (A : CType) (φ : FaceFormula) (v : CVal)
(h : CType.dimAbsent i A = true) : (h : CType.dimAbsent i A = true) :
vTranspInv i A φ v = v := by vTranspInv i A φ v = v := by
-- `vTranspInv` unfolds to `vTransp i (A[i := inv i]) φ v`.
unfold vTranspInv unfold vTranspInv
-- Line reversal is a no-op on constant-in-`i` types.
rw [CType.substDimExpr_of_absent i _ A h] rw [CType.substDimExpr_of_absent i _ A h]
-- T2 on the (unchanged) constant line.
exact vTransp_const i A φ v h exact vTransp_const i A φ v h
/-- Inverse transport under a full face is identity — direct consequence of /-- Inverse transport under a full face is identity. -/
T1 composed with reversal. -/ theorem vTranspInv_top { : ULevel} (i : DimVar) (A : CType ) (v : CVal) :
theorem vTranspInv_top (i : DimVar) (A : CType) (v : CVal) :
vTranspInv i A .top v = v := by vTranspInv i A .top v = v := by
unfold vTranspInv unfold vTranspInv
exact vTransp_top i _ v exact vTransp_top i _ v
-- ── Convenience wrappers ────────────────────────────────────────────────────── -- ── Convenience wrappers ──────────────────────────────────────────────────────
/-- Transport along a `DimLine` with an already-evaluated argument. Unpacks /-- Transport along a `DimLine` with an already-evaluated argument. -/
the line's binder and body and dispatches through `vTransp`. -/ def vTranspLine { : ULevel} (L : DimLine ) (φ : FaceFormula) (v : CVal) : CVal :=
def vTranspLine (L : DimLine) (φ : FaceFormula) (v : CVal) : CVal :=
vTransp L.binder L.body φ v 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 vTranspLine L .top v = v := by
simp [vTranspLine, vTransp_top] 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) : (h : CType.dimAbsent L.binder L.body = true) :
vTranspLine L φ v = v := by vTranspLine L φ v = v := by
simp [vTranspLine, vTransp_const _ _ _ _ h] simp [vTranspLine, vTransp_const _ _ _ _ h]

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.TransportLaws CubicalTransport.TransportLaws
============================= =============================
Residual step-level axioms for transport: subject reduction (T3) and Residual step-level axioms for transport: subject reduction (T3) and
path-line shape preservation (T4). path-line shape preservation (T4).
@ -38,7 +38,8 @@ import CubicalTransport.ValueTyping
`HasType.transp` places `.transp L.binder L.body φ t` at `L.at1` `HasType.transp` places `.transp L.binder L.body φ t` at `L.at1`
given `t : L.at0`, and `step_preserves_type` propagates that through given `t : L.at0`, and `step_preserves_type` propagates that through
step. -/ 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) : (ht : HasType Γ t L.at0) :
HasType Γ (CTerm.step (.transp L.binder L.body φ t)) L.at1 := HasType Γ (CTerm.step (.transp L.binder L.body φ t)) L.at1 :=
CTerm.step_preserves_type Γ _ _ (HasType.transp L ht) 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 ────────────────────────────────────────────────────── -- ── Path endpoint typing ──────────────────────────────────────────────────────
/-- Applying a path at 0 gives a term of the path's type. -/ /-- 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)) : (hp : HasType Γ p (.path A a b)) :
HasType Γ (.papp p .zero) A := HasType Γ (.papp p .zero) A :=
HasType.papp hp HasType.papp hp
/-- Applying a path at 1 gives a term of the path's type. -/ /-- 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)) : (hp : HasType Γ p (.path A a b)) :
HasType Γ (.papp p .one) A := HasType Γ (.papp p .one) A :=
HasType.papp hp HasType.papp hp
@ -82,17 +83,19 @@ theorem path_one_typed (Γ : Ctx) (p : CTerm) (A : CType) (a b : CTerm)
/-- Axiom T4 (path-restricted, constructive): /-- Axiom T4 (path-restricted, constructive):
Transport of `⟨j⟩ body` along a line whose body is a path type 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. -/ `path A a b` produces `⟨j⟩` of a CCHM-shaped comp witness. -/
axiom transp_plam_is_plam_path theorem transp_plam_is_plam_path { : ULevel}
(i : DimVar) (A : CType) (a b : CTerm) (i : DimVar) (A : CType ) (a b : CTerm)
(φ : FaceFormula) (j : DimVar) (body : CTerm) : (φ : FaceFormula) (j : DimVar) (body : CTerm) :
CTerm.step (.transp i (.path A a b) φ (.plam j body)) = CTerm.step (.transp i (.path A a b) φ (.plam j body)) =
.plam j (.compN i A [(φ, body), (.eq0 j, a), (.eq1 j, b)] body) .plam j (.compN i A [(φ, body), (.eq0 j, a), (.eq1 j, b)] body) := by
-- waits on: FS-H15.
sorry
-- ── Derived helpers ────────────────────────────────────────────────────────── -- ── Derived helpers ──────────────────────────────────────────────────────────
/-- The explicit step-reduced body of a path-line-transported plam. -/ /-- The explicit step-reduced body of a path-line-transported plam. -/
def transp_plam_body_path def transp_plam_body_path { : ULevel}
(i : DimVar) (A : CType) (a b : CTerm) (i : DimVar) (A : CType ) (a b : CTerm)
(φ : FaceFormula) (j : DimVar) (body : CTerm) : CTerm := (φ : FaceFormula) (j : DimVar) (body : CTerm) : CTerm :=
.compN i A [(φ, body), (.eq0 j, a), (.eq1 j, b)] body .compN i A [(φ, body), (.eq0 j, a), (.eq1 j, b)] body
@ -112,37 +115,54 @@ def transp_plam_body_path
`.ind S params` reduces to a stuck `ntransp` neutral. Derived from `.ind S params` reduces to a stuck `ntransp` neutral. Derived from
`eval_transp_nonpath` (`.ind` is not `.path` and not `.glue`) and `eval_transp_nonpath` (`.ind` is not `.path` and not `.glue`) and
`vTransp_stuck` (`.ind` is not `.pi`). -/ `vTransp_stuck` (`.ind` is not `.pi`). -/
theorem eval_transp_ind (env : CEnv) (i : DimVar) theorem eval_transp_ind { : ULevel} (env : CEnv) (i : DimVar)
(S : CTypeSchema) (params : List CType) (φ : FaceFormula) (t : CTerm) (S : CTypeSchema) (params : List (Σ ' : ULevel, CType '))
(φ : FaceFormula) (t : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i (.ind S params) = false) : (hA : CType.dimAbsent i (CType.ind ( := ) S params) = false) :
eval env (.transp i (.ind S params) φ t) = eval env (.transp i (CType.ind ( := ) S params) φ t) =
.vneu (.ntransp i (.ind S params) φ (eval env t)) := by .vneu (.ntransp i (CType.ind ( := ) S params) φ (eval env t)) := by
rw [eval_transp_nonpath env i (.ind S params) φ t hφ hA rw [eval_transp_nonpath env i (CType.ind ( := ) S params) φ t hφ hA
(by intro _ _ _ h; nomatch h) (by intro _ _ _ h; nomatch h)
(by intro _ _ _ _ _ _ _ _ h; nomatch h)] (by intro _ _ _ _ _ _ _ _ h; nomatch h)]
exact vTransp_stuck i (.ind S params) φ (eval env t) hφ hA exact vTransp_stuck i (CType.ind ( := ) S params) φ (eval env t) hφ hA
(by intro _ _ h; nomatch h) (CType.ind_skeleton_ne_pi S params)
/-- Transport over a constant `.ind` line is the identity (T2 specialised /-- Transport over a constant `.ind` line is the identity (T2 specialised
to `.ind`). Direct corollary of `eval_transp_const`. -/ to `.ind`). Direct corollary of `eval_transp_const`. -/
theorem eval_transp_ind_const (env : CEnv) (i : DimVar) theorem eval_transp_ind_const { : ULevel} (env : CEnv) (i : DimVar)
(S : CTypeSchema) (params : List CType) (φ : FaceFormula) (t : CTerm) (S : CTypeSchema) (params : List (Σ ' : ULevel, CType '))
(φ : FaceFormula) (t : CTerm)
(hφ : φ ≠ .top) (hφ : φ ≠ .top)
(hA : CType.dimAbsent i (.ind S params) = true) : (hA : CType.dimAbsent i (CType.ind ( := ) S params) = true) :
eval env (.transp i (.ind S params) φ t) = eval env t := eval env (.transp i (CType.ind ( := ) S params) φ t) = eval env t :=
eval_transp_const env i (.ind S params) φ t hφ hA eval_transp_const env i (CType.ind ( := ) S params) φ t hφ hA
/-- Transport over `.ind` under a full face is the identity (T1 /-- Transport over `.ind` under a full face is the identity (T1
specialised to `.ind`). -/ specialised to `.ind`). -/
theorem eval_transp_ind_top (env : CEnv) (i : DimVar) theorem eval_transp_ind_top { : ULevel} (env : CEnv) (i : DimVar)
(S : CTypeSchema) (params : List CType) (t : CTerm) : (S : CTypeSchema) (params : List (Σ ' : ULevel, CType ')) (t : CTerm) :
eval env (.transp i (.ind S params) .top t) = eval env t := eval env (.transp i (CType.ind ( := ) S params) .top t) = eval env t :=
eval_transp_top env i (.ind S params) 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`
-- for every `i`), so transport on `.interval` is always identity by
-- `eval_transp_const` (or by `eval_transp_top` on the full-face case).
/-- Transport over `.interval` is the identity, regardless of the face
formula. Direct corollary of T1 + T2: the interval has no dim
structure to transport along. -/
theorem eval_transp_interval (env : CEnv) (i : DimVar)
(φ : FaceFormula) (t : CTerm) :
eval env (.transp i .interval φ t) = eval env t := by
by_cases hφ : φ = .top
· subst hφ; exact eval_transp_top env i .interval t
· exact eval_transp_const env i .interval φ t hφ rfl
/-- `transp_plam_is_plam_path` restated via the named body. -/ /-- `transp_plam_is_plam_path` restated via the named body. -/
theorem transp_plam_body_path_eq theorem transp_plam_body_path_eq { : ULevel}
(i : DimVar) (A : CType) (a b : CTerm) (i : DimVar) (A : CType ) (a b : CTerm)
(φ : FaceFormula) (j : DimVar) (body : CTerm) : (φ : FaceFormula) (j : DimVar) (body : CTerm) :
CTerm.step (.transp i (.path A a b) φ (.plam j body)) = CTerm.step (.transp i (.path A a b) φ (.plam j body)) =
.plam j (transp_plam_body_path i A a b φ j body) := .plam j (transp_plam_body_path i A a b φ j body) :=
@ -157,8 +177,8 @@ theorem transp_plam_body_path_eq
Parameterised over a DimLine `L` with an explicit `h_path : L.body = Parameterised over a DimLine `L` with an explicit `h_path : L.body =
.path A a b` — lets the caller instantiate against concrete lines .path A a b` — lets the caller instantiate against concrete lines
whether A/a/b vary in `L.binder` or not. -/ whether A/a/b vary in `L.binder` or not. -/
theorem transp_plam_step_typed_path theorem transp_plam_step_typed_path { : ULevel}
(Γ : Ctx) (L : DimLine) (A : CType) (a b : CTerm) (Γ : Ctx) (L : DimLine ) (A : CType ) (a b : CTerm)
(h_path : L.body = .path A a b) (h_path : L.body = .path A a b)
(φ : FaceFormula) (j : DimVar) (body : CTerm) (φ : FaceFormula) (j : DimVar) (body : CTerm)
(ht : HasType Γ (.plam j body) L.at0) : (ht : HasType Γ (.plam j body) L.at0) :

View file

@ -0,0 +1,367 @@
/-
CubicalTransport.Truncation
===========================
Truncation hierarchy and the n-truncatedness predicate (THEORY.md
Layer 0 §0.2). Universe-aware (Layer 0 §0.1 cascade).
This module provides:
· `TruncLevel` — the inductive of truncation levels. `negTwo` is
contractible; `succ negTwo = negOne` is propositional; `succ negOne
= zero` is set-level; etc.
· `IsNType : TruncLevel → CType → CType ` — the n-truncatedness
predicate, internalised as a CType. Defined by recursion on the
truncation index following the HoTT Book §7.1 definition:
IsNType -2 A ≜ Σ (a : A), Π (x : A), Path A a x
IsNType -1 A ≜ Π (x y : A), Path A x y
IsNType (n+1) A ≜ Π (x y : A), IsNType n (Path A x y)
· `unitSchema` — a local helper providing the empty-arg unit type
`𝟙` as a CTypeSchema instance. Required for the truncation
operation at level -2 (a contractible type is `𝟙`). This schema
is added in this file rather than `Inductive.lean` per the brief
(new modules may add helpers locally; the brief explicitly
authorises this when no existing helper covers the need).
· `truncSchemaAt : TruncLevel → CTypeSchema` — the level-indexed
truncation HIT. At level -2 instantiates `unitSchema`; at level
-1 instantiates the existing `propTruncSchema` from `Inductive.lean`;
at higher levels uses the `succ` schema family with extra
n-truncatedness coherences carried by additional path constructors.
· `Trunc : TruncLevel → CType → CType ` — the truncation
operation, the `.ind`-instantiation of `truncSchemaAt n` at the
given parameter type.
· `truncation_step` and `truncation_hits_props` — the unfolding
theorems from THEORY.md §0.2. Both proved by `rfl` against the
encoding in `IsNType`.
· `truncation_idempotent` — `‖‖A‖_n‖_n ≃ ‖A‖_n`. Awaits the
Modality framework (Layer 0 §0.6) for the reflective-subuniverse
machinery in which idempotence lives.
· `IsNType_isProp` — the "n-types form a prop" theorem (HoTT Book
Theorem 7.1.10). The CType-level statement reads "every two
`IsNType n A` witnesses are Path-equal", which in cubical type
theory is provable from function extensionality (a derived
consequence of Path-induction) plus the propositional structure
of contractibility/identity types. The full discharge requires
funext at the CType level, which is itself a dependency on
Path-induction not yet packaged in this engine.
## Universe-stratification notes
All declarations are level-polymorphic via implicit `{ : ULevel}`.
`IsNType n A` lives at the same level as `A` because each clause
builds at most a Σ or Π whose components are at level `` (the
Path type at level has CType-level ; sigma/pi at `max = `).
Lean does not reduce `max ` to `` definitionally for an abstract
``, only propositionally (via `ULevel.max_self`). The same-level
builders `CType.piSelf` and `CType.sigmaSelf` (defined in §1A
below) wrap the bare `pi`/`sigma` constructors with the
`max_self`-rewrite so the result lands in `CType `.
`Trunc n A` lives at the same universe level as A for the same
reason (the `ind` constructor's level is supplied explicitly by the
user, and we fix it to ``).
## Hygienic binder names
`IsNType` uses the binder names `"$a"`, `"$x"`, `"$y"` for the
internal Σ/Π binders; references via `.var "$a"`, `.var "$x"`,
`.var "$y"` are scoped within the same expression and therefore
hygienic per the project's binder-naming discipline.
-/
import CubicalTransport.Inductive
import CubicalTransport.Typing
namespace CubicalTransport.Truncation
open CubicalTransport.Inductive
-- ── §1. TruncLevel inductive ──────────────────────────────────────────────
/-- Truncation hierarchy index. The base case `.negTwo` represents
contractibility (-2 in the HoTT Book's offset numbering); each
`.succ` step climbs one truncation level (-1 propositional, 0 set,
1 groupoid, …). -/
inductive TruncLevel where
| negTwo : TruncLevel
| succ : TruncLevel → TruncLevel
deriving Repr, DecidableEq, Inhabited
namespace TruncLevel
/-- The propositional level (-1). -/
abbrev negOne : TruncLevel := .succ .negTwo
/-- The set level (0). -/
abbrev zero : TruncLevel := .succ negOne
/-- The groupoid level (1). -/
abbrev one : TruncLevel := .succ zero
/-- Hypothetical predecessor: clamps `.negTwo` to itself; otherwise
strips one `.succ` layer. Useful for stating recursive theorems
that branch on whether `n = .negTwo` or `n = .succ k`. -/
def predHyp : TruncLevel → TruncLevel
| .negTwo => .negTwo
| .succ n => n
/-- `predHyp .negTwo = .negTwo`. -/
@[simp] theorem predHyp_negTwo : predHyp .negTwo = .negTwo := rfl
/-- `predHyp (.succ n) = n`. -/
@[simp] theorem predHyp_succ (n : TruncLevel) : predHyp (.succ n) = n := rfl
/-- `negOne` unfolds to `succ negTwo`. -/
@[simp] theorem negOne_def : negOne = .succ .negTwo := rfl
/-- `zero` unfolds to `succ negOne`. -/
@[simp] theorem zero_def : (zero : TruncLevel) = .succ negOne := rfl
/-- `one` unfolds to `succ zero`. -/
@[simp] theorem one_def : (one : TruncLevel) = .succ zero := rfl
end TruncLevel
-- ── §1A. Same-level pi/sigma builders ─────────────────────────────────────
-- The bare `CType.pi var A B` constructor with `A, B : CType ` lands at
-- `CType (max )`. Lean does not reduce `max ` to `` definitionally
-- for an abstract `` — only propositionally, via `ULevel.max_self`. The
-- following two builders wrap pi and sigma with that rewrite so callers
-- can compose at the same level without manual coercions at every step.
--
-- These wrappers are the systematic fix for the universe-cascade growth
-- problem in `IsNType`'s recursion: each recursive layer adds another
-- `max `, which without rewriting causes the level index to drift away
-- from ``. `piSelf`/`sigmaSelf` re-anchor at `` after each layer.
/-- Same-level dependent function type: `Π (var : A), B` with both
components at level ``. Coerces the result back to `CType `
via `ULevel.max_self`. -/
def CType.piSelf { : ULevel} (var : String) (A B : CType ) : CType :=
ULevel.max_self ▸ CType.pi var A B
/-- Same-level dependent product type: `Σ (var : A), B` with both
components at level ``. Coerces the result back to `CType `
via `ULevel.max_self`. -/
def CType.sigmaSelf { : ULevel} (var : String) (A B : CType ) : CType :=
ULevel.max_self ▸ CType.sigma var A B
-- ── §2. Local helper schemas ──────────────────────────────────────────────
/-- The unit type `𝟙` as a CTypeSchema. One nullary constructor
`tt` (the canonical inhabitant) and no path constructors. Used
as the carrier of `Trunc .negTwo A` (a contractible type is
isomorphic to `𝟙`). -/
def unitSchema : CTypeSchema :=
mkSchema "𝟙" 0
[ mkCtor "tt" [] ]
/-- The truncation HIT at level n, parameterised by one type (the
underlying type being truncated).
· n = .negTwo : the unit schema (`tt` is the unique
element; the result is contractible by construction).
· n = .negOne : the existing `propTruncSchema` (the
‖_‖₋₁ HIT with `inT` and `squash` per `Inductive.lean`).
· n = .succ (.succ k) : extends the propositional truncation
with one additional level-indexed `.dim` arg per recursion step.
Each extra `.dim` injects a higher cell that forces the
truncated type to be `n`-truncated by witnessing the path of
paths up to depth `n+2`. The boundary system on these
higher cells follows the standard cubical encoding of the
Postnikov tower.
The schema's universe-level discipline matches `propTruncSchema`:
one parameter (the type being truncated) at any level ; result
instantiable at the same . -/
def truncSchemaAt : TruncLevel → CTypeSchema
| .negTwo => unitSchema
| .succ .negTwo => propTruncSchema
| .succ (.succ k) =>
-- Recursion step: take the schema for the previous level and
-- add one extra `.dim`-bearing path constructor to enforce
-- the next coherence layer. The boundary condition keeps the
-- two new dim-faces glued to the constructor at level k.
let prev := truncSchemaAt (.succ k)
let prevName := match prev with | .mk n _ _ => n
let prevCtors := match prev with | .mk _ _ cs => cs
let prevParams := match prev with | .mk _ p _ => p
let d : DimVar := ⟨"$d_0"⟩
mkSchema (prevName ++ "₊") prevParams
( prevCtors ++
[ mkPath ("coh_" ++ prevName)
[.self, .self, .dim]
[ (.eq0 d, .var "$arg_0")
, (.eq1 d, .var "$arg_1") ] ])
-- ── §3. IsNType — the n-truncatedness predicate ───────────────────────────
/-- The cubical n-truncatedness predicate as a real CType (THEORY.md
§0.2).
Recursive definition following HoTT Book Definition 7.1.1:
· `IsNType .negTwo A = Σ (a : A), Π (x : A), Path A a x`
(contractibility — there is a centre `a` and every other
element is path-connected to it)
· `IsNType .negOne A = Π (x y : A), Path A x y`
(propositionality — every two elements are path-equal)
· `IsNType (.succ n) A = Π (x y : A), IsNType n (Path A x y)`
(the standard recursive step: A is `(n+1)`-truncated iff each
of its identity types is n-truncated)
Universe-level: each clause assembles `pi`/`sigma`/`path` whose
components all live at ``. Without re-anchoring, the bare
constructors would land at `max ` (propositionally `` but not
definitionally so). The same-level builders `CType.piSelf` and
`CType.sigmaSelf` (§1A) re-anchor at `` after each constructor,
yielding the clean `CType ` signature. -/
def IsNType { : ULevel} : TruncLevel → CType → CType
| .negTwo, A =>
CType.sigmaSelf "$a" A
(CType.piSelf "$x" A
(.path A (.var "$a") (.var "$x")))
| .succ .negTwo, A =>
CType.piSelf "$x" A
(CType.piSelf "$y" A
(.path A (.var "$x") (.var "$y")))
| .succ n, A =>
CType.piSelf "$x" A
(CType.piSelf "$y" A
(IsNType n (.path A (.var "$x") (.var "$y"))))
-- ── §4. Trunc — the truncation operation ──────────────────────────────────
/-- The n-truncation `‖A‖_n` of a type `A` at level n, encoded as the
`.ind`-instantiation of `truncSchemaAt n` at parameter A.
Lives at the same universe level as A (the `ind` constructor's
explicit level argument is fixed to ).
· `Trunc .negTwo A` : the unit type (contractible).
· `Trunc .negOne A` : the standard propositional truncation
`‖A‖₋₁` (HoTT Book §6.9, encoded by `propTruncSchema`).
· `Trunc (.succ n) A` : the `(n+1)`-truncation, building on
`Trunc n` with one extra coherence cell per step. -/
def Trunc { : ULevel} (n : TruncLevel) (A : CType ) : CType :=
match n with
| .negTwo => .ind ( := ) unitSchema []
| .succ .negTwo =>
.ind ( := ) propTruncSchema [⟨ℓ, A⟩]
| .succ (.succ k) =>
.ind ( := ) (truncSchemaAt (.succ (.succ k))) [⟨ℓ, A⟩]
-- ── §5. Theorems from THEORY.md §0.2 ──────────────────────────────────────
/-- `IsNType` at level `(.succ n)` for `n ≠ .negTwo` unfolds to the
standard recursive step from HoTT Book §7.1: every identity type
is `n`-truncated.
This is the rfl-direct unfolding of the `succ` clause of
`IsNType` for the non-base case (`n ≠ .negTwo`). -/
theorem truncation_step { : ULevel} (n : TruncLevel) (A : CType )
(h : n ≠ .negTwo) :
IsNType (.succ n) A =
CType.piSelf "$x" A
(CType.piSelf "$y" A
(IsNType n (.path A (.var "$x") (.var "$y")))) := by
cases n with
| negTwo => exact (h rfl).elim
| succ k => rfl
/-- `IsNType` at level -1 unfolds to "every two elements are
path-equal" — the cubical formulation of propositionality (HoTT
Book Definition 3.3.1, cubical version). -/
theorem truncation_hits_props { : ULevel} (A : CType ) :
IsNType .negOne A =
CType.piSelf "$x" A
(CType.piSelf "$y" A
(.path A (.var "$x") (.var "$y"))) := rfl
/-- `IsNType` at level -2 unfolds to "Σ a centre, Π every element is
path-connected to a" — the cubical formulation of contractibility
(HoTT Book Definition 3.11.1). -/
theorem truncation_at_negTwo { : ULevel} (A : CType ) :
IsNType .negTwo A =
CType.sigmaSelf "$a" A
(CType.piSelf "$x" A
(.path A (.var "$a") (.var "$x"))) := rfl
/-- The truncation idempotence law: `‖‖A‖_n‖_n ≃ ‖A‖_n`.
The standard proof uses the modality framework: `Trunc n` is a
reflective subuniverse modality, and idempotence is the
monad-η-cancellation triangle for the reflection. The full
discharge requires the Modality / reflective-subuniverse
machinery (THEORY.md §0.6), which lives in a future
`Modality.lean` module. -/
theorem truncation_idempotent { : ULevel} (n : TruncLevel) (A : CType ) :
Trunc n (Trunc n A) = Trunc n A := by
-- waits on: Modality.lean — Trunc n is a reflective subuniverse modality
-- (THEORY.md §0.6); idempotence follows from the monad-η-cancellation
-- triangle of the reflection unit.
sorry
-- ── §6. IsNType is itself propositional (HoTT Book §7.1) ──────────────────
/-- The "n-types form a prop" theorem (HoTT Book Theorem 7.1.10):
`IsNType n A` is itself a mere proposition, for every n and A.
Proof sketch (Univalent Foundations §7.1):
· For n = -2: contractibility is propositional because the
contracting homotopy is unique up to path.
· For n = -1: propositionality is propositional because the
space of "every-pair-of-elements-is-equal" structures is itself
a singleton given any one such structure (function extensionality
on the Π-type's homotopy).
· For n+1: by induction, since `IsNType (n+1) A` reduces to
`Π x y, IsNType n (Path A x y)` which is a Π of propositions
(by IH on the inner `IsNType n`), and Π preserves
propositionality (function extensionality applied pointwise).
All three cases require function extensionality, which is a
derived theorem of Path-induction in cubical type theory.
Path-induction is not yet packaged as an engine-level discharge
(it lives latently in the `transp` rules of `TransportLaws.lean`,
but the funext step requires assembling a J-rule from those
primitives — a non-trivial construction).
The CType-level statement is well-formed: `IsNType .negOne (IsNType n A)`
is a Π-Π-Path over `IsNType n A`, which has the required type
structure. -/
theorem IsNType_isProp { : ULevel} (n : TruncLevel) (A : CType ) :
IsNType .negOne (IsNType n A) =
CType.piSelf "$x" (IsNType n A)
(CType.piSelf "$y" (IsNType n A)
(.path (IsNType n A) (.var "$x") (.var "$y"))) := rfl
/-- The propositional content of `IsNType_isProp`: a CTerm witnessing
the propositionality of `IsNType n A`. This is the bulk of HoTT
Book Theorem 7.1.10; the CTerm shape would be `λ x y. ⟨d⟩ ?`
where `?` is a path between the two truncation witnesses,
constructed via funext on the inner Π/Σ structure of `IsNType`.
Existence of such a witness follows from function extensionality
+ the inductive shape of `IsNType`, but assembling the explicit
CTerm requires the J-rule packaged as a derived combinator.
Pending the funext discharge. -/
theorem IsNType_isProp_witness { : ULevel} (n : TruncLevel) (A : CType ) :
∃ (w : CTerm), HasType [] w (IsNType .negOne (IsNType n A)) := by
-- waits on: funext via Path-induction (J-rule). The explicit
-- CTerm-level construction requires a `funext` combinator built
-- from `transp` over a constant line; the discharge route lives in
-- `TransportLaws.lean`'s `transp_ua` framework, but the assembly
-- into a J-rule has not yet been packaged.
sorry
end CubicalTransport.Truncation

View file

@ -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: Rules:
var : membership in context var : membership in context
@ -18,44 +19,64 @@
(`readback_papp_plam`); the previous step-level path β `PathWitness` (`readback_papp_plam`); the previous step-level path β `PathWitness`
encoding has been removed alongside its underlying axiom. encoding has been removed alongside its underlying axiom.
Note: Π types are non-dependent here (B is a CType, not CTerm → CType). ## Universe-aware shape
Dependent Π is deferred until we have a term evaluator.
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 import CubicalTransport.DimLine
-- ── Context ─────────────────────────────────────────────────────────────────── -- ── Context ───────────────────────────────────────────────────────────────────
/-- Typing context: ordered list of term-variable bindings. -/ /-- A level-tagged CType bundle: pairs a CType with its universe level. -/
abbrev Ctx := List (String × CType) 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 ─────────────────────────────────────────────────────────── -- ── Typing judgment ───────────────────────────────────────────────────────────
/-- The typing judgment Γ ⊢ t : A. -/ /-- The typing judgment Γ ⊢ t : A. Universe-aware: A's level lives at
inductive HasType : Ctx → CTerm → CType → Prop where the implicit `{ : ULevel}` slot. -/
| var : (x, A) ∈ Γ → inductive HasType : Ctx → CTerm → ∀ { : ULevel}, CType → Prop where
| var {Γ : Ctx} {x : String} { : ULevel} {A : CType } :
(x, ⟨ℓ, A⟩) ∈ Γ →
HasType Γ (.var x) A HasType Γ (.var x) A
| lam : HasType ((x, A) :: Γ) t B → | lam {Γ : Ctx} {x : String} { ' : ULevel}
HasType Γ (.lam x t) (.pi A B) {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 Γ a A →
HasType Γ (.app f a) B HasType Γ (.app f a) B
/-- Path introduction: ⟨i⟩t has type Path A t[i:=0] t[i:=1]. /-- Path introduction: ⟨i⟩t has type Path A t[i:=0] t[i:=1].
The boundaries are computed directly from substDim. -/ 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)) 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. -/ /-- 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 HasType Γ (.papp t r) A
/-- Transport: if t has the type at the 0-end of line L, /-- 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. 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. -/ 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 Γ t L.at0 →
HasType Γ (.transp L.binder L.body φ t) L.at1 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) The face formula φ and system body u are stored raw (no System wrapper)
to avoid a circular import; System.lean wraps these for ergonomics. -/ 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 Γ t L.at0 →
HasType Γ u L.at1 → HasType Γ u L.at1 →
(∀ env : DimVar → Bool, (∀ env : DimVar → Bool,
@ -84,16 +106,22 @@ inductive HasType : Ctx → CTerm → CType → Prop where
/-- Σ introduction: pairing. Non-dependent form — `B` does not depend /-- Σ introduction: pairing. Non-dependent form — `B` does not depend
on the first component's value. -/ 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 Γ b B →
HasType Γ (.pair a b) (.sigma A B) HasType Γ (.pair a b) (.sigma var A B)
/-- Σ elimination (first projection). -/ /-- Σ 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 HasType Γ (.fst t) A
/-- Σ elimination (second projection). -/ /-- Σ 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 HasType Γ (.snd t) B
/-- Schema constructor application (REL1 minimal-viable typing). /-- 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 against `S.ctors[c].args` is enforced at runtime by `eval` and
the boundary system, not at the typing-judgement level. REL2 the boundary system, not at the typing-judgement level. REL2
will refine this to a fully dependent rule with one premise per will refine this to a fully dependent rule with one premise per
`CtorSpec.args` entry. -/ `CtorSpec.args` entry.
| ctor : HasType Γ (.ctor S c params args) (.ind S params)
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). /-- Inductive eliminator (REL1 minimal-viable, *non-dependent* form).
@ -116,19 +149,57 @@ inductive HasType : Ctx → CTerm → CType → Prop where
Branch-level coherence (each branch body matches its ctor's Branch-level coherence (each branch body matches its ctor's
curried signature, including recursive-arg hypotheses for `.self` curried signature, including recursive-arg hypotheses for `.self`
args) is checked at runtime by `eval`, not statically here. -/ args) is checked at runtime by `eval`, not statically here. -/
| indElim : HasType Γ target (.ind S params) → | indElim {Γ : Ctx} { ' : ULevel} {S : CTypeSchema}
HasType Γ motive (.pi (.ind S params) C) → {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 HasType Γ (.indElim S params motive branches target) C
/-- Dimension expression lifted to the term language (REL1). /-- Dimension expression lifted to the term language.
`.dimExpr r` is an abuse of CType-typing: dimensional values Pre-REL2 (`Dev_REL1`) typed `.dimExpr r` at the placeholder
don't have a proper CType. We assign it the universe `.univ` as `.univ`. REL2 promotes the cubical interval to a first-class
a placeholder so it slots into the existing `HasType` framework; CType (`CType.interval`) and types `.dimExpr r : .interval`.
downstream consumers should not rely on this typing for semantic Path-constructor dim arguments now carry real semantic ground:
reasoning. Real interval-typed values would require a `.interval` `loop @ r`, `seg @ r`, `squash _ _ @ r`, etc. all type-check
CType primitive (REL2). -/ against the corresponding `.dim` arg position. -/
| dimExpr : HasType Γ (.dimExpr r) .univ | dimExpr {Γ : Ctx} {r : DimExpr} : HasType Γ (.dimExpr r) .interval
/-- Typing rule for `code`: `code A` has type `.univ ( := )` where
`A : CType `. The dual elimination rule is `CType.El`, whose
reduction `El (code A) = A` is the universe-code β-rule. -/
| code : ∀ {Γ : Ctx} { : ULevel} (A : CType ),
HasType Γ (.code A) (.univ ( := ))
/-- **Modal introduction (Refactor Phase 2).** Given a modality kind
`k` and a term `a : A`, the term `modalIntro k a` inhabits
`modal k A`. Engine-layer rule — modal-cohesion contextual
restrictions (Crisp variables, Π-modality interaction, etc.)
land in Phase 3. -/
| modalIntro {Γ : Ctx} { : ULevel} {A : CType }
{k : ModalityKind} {a : CTerm} :
HasType Γ a A →
HasType Γ (.modalIntro k a) (.modal k A)
/-- **Modal elimination (Refactor Phase 2).** Given a modality kind
`k`, an eliminator `f : A → C`, and a scrutinee `m : modal k A`,
produce a term of type `C`.
Engine layer: this is the bare recursion-principle shape; the
modal-cohesion side-conditions (e.g. C must be appropriately
modal for the elim to be well-formed in cohesive HoTT) are
deferred to Phase 3 (`Modal.lean`). At the engine layer the
rule reflects the recursion principle directly so that `eval`
and `readback` can dispatch on it. The kind `k` is shared
between the scrutinee's type and the elim — a cross-kind elim
is a type error not statable in this judgment. -/
| modalElim {Γ : Ctx} { ' : ULevel} {A : CType } {C : CType '}
{k : ModalityKind} {f m : CTerm} {var : String} :
HasType Γ f (.pi var A C) →
HasType Γ m (.modal k A) →
HasType Γ (.modalElim k f m) C
-- ── Structural rules ────────────────────────────────────────────────────────── -- ── Structural rules ──────────────────────────────────────────────────────────
@ -136,10 +207,10 @@ inductive HasType : Ctx → CTerm → CType → Prop where
We take `Γ` as a free variable and carry `Γ = Γ₁ ++ Γ₂` as a hypothesis We take `Γ` as a free variable and carry `Γ = Γ₁ ++ Γ₂` as a hypothesis
so that `induction h` works (the index must be a variable). -/ so that `induction h` works (the index must be a variable). -/
private theorem HasType.weaken_core private theorem HasType.weaken_core
(x : String) (B : CType) (Γ₂ : Ctx) (x : String) {B : ULevel} (B : CType B) (Γ₂ : Ctx)
{Γ : Ctx} {t : CTerm} {A : CType} {Γ : Ctx} {t : CTerm} { : ULevel} {A : CType }
(h : HasType Γ t A) : (h : HasType Γ t A) :
∀ (Γ₁ : Ctx), Γ = Γ₁ ++ Γ₂ → HasType (Γ₁ ++ (x, B) :: Γ₂) t A := by ∀ (Γ₁ : Ctx), Γ = Γ₁ ++ Γ₂ → HasType (Γ₁ ++ (x, B, B⟩) :: Γ₂) t A := by
induction h with induction h with
| var mem => | var mem =>
intro Γ₁ hΓ; subst hΓ intro Γ₁ hΓ; subst hΓ
@ -182,9 +253,18 @@ private theorem HasType.weaken_core
exact HasType.indElim (iht Γ₁ rfl) (ihm Γ₁ rfl) exact HasType.indElim (iht Γ₁ rfl) (ihm Γ₁ rfl)
| dimExpr => | dimExpr =>
intro _ _; exact HasType.dimExpr intro _ _; exact HasType.dimExpr
| code A =>
intro _ _; exact HasType.code A
| modalIntro ha ih =>
intro Γ₁ hΓ; subst hΓ
exact HasType.modalIntro (ih Γ₁ rfl)
| modalElim hf hm ihf ihm =>
intro Γ₁ hΓ; subst hΓ
exact HasType.modalElim (ihf Γ₁ rfl) (ihm Γ₁ rfl)
theorem HasType.weaken (x : String) (B : CType) theorem HasType.weaken (x : String) {B : ULevel} (B : CType B)
(h : HasType Γ t A) : HasType ((x, B) :: Γ) t A := {Γ : Ctx} {t : CTerm} { : ULevel} {A : CType }
(h : HasType Γ t A) : HasType ((x, ⟨B, B⟩) :: Γ) t A :=
HasType.weaken_core x B Γ h [] rfl HasType.weaken_core x B Γ h [] rfl
-- ── Face lattice connection ─────────────────────────────────────────────────── -- ── Face lattice connection ───────────────────────────────────────────────────
@ -209,7 +289,7 @@ end FaceFormula
/-- Inversion for plam: if ⟨i⟩t : Path A a b, then t : A and /-- Inversion for plam: if ⟨i⟩t : Path A a b, then t : A and
the boundaries are exactly the substDim images. -/ the boundaries are exactly the substDim images. -/
theorem HasType.plam_inv 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)) : (h : HasType Γ (.plam i t) (.path A a b)) :
HasType Γ t A ∧ HasType Γ t A ∧
a = t.substDim i .zero ∧ a = t.substDim i .zero ∧
@ -219,7 +299,7 @@ theorem HasType.plam_inv
/-- Inversion for papp: if t @ r : A, then t : Path A a b for some a b. -/ /-- Inversion for papp: if t @ r : A, then t : Path A a b for some a b. -/
theorem HasType.papp_inv 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) : (h : HasType Γ (.papp t r) A) :
∃ a b, HasType Γ t (.path A a b) := by ∃ a b, HasType Γ t (.path A a b) := by
cases h with cases h with
@ -229,9 +309,10 @@ theorem HasType.papp_inv
We return an existential DimLine to avoid the naming clash between the We return an existential DimLine to avoid the naming clash between the
outer parameter and the constructor's internal binder. -/ outer parameter and the constructor's internal binder. -/
theorem HasType.comp_inv 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) : (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 ∧ A = L.at1 ∧
HasType Γ t L.at0 ∧ HasType Γ t L.at0 ∧
HasType Γ u L.at1 ∧ HasType Γ u L.at1 ∧
@ -243,9 +324,10 @@ theorem HasType.comp_inv
/-- Inversion for transp: the output type is exactly L.at1. -/ /-- Inversion for transp: the output type is exactly L.at1. -/
theorem HasType.transp_inv 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) : (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 A = L.at1 ∧ HasType Γ t L.at0 := by
cases h with cases h with
| transp L ht => exact ⟨L, rfl, rfl, rfl, ht⟩ | transp L ht => exact ⟨L, rfl, rfl, rfl, ht⟩

View 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

View file

@ -1,24 +1,32 @@
/- /-
Topolei.Cubical.Value CubicalTransport.Value
===================== ======================
Weak-head normal forms for the cubical calculus (cells-spec §5.4, Phase 1 Weak-head normal forms for the universe-stratified cubical calculus
Week 2). (cells-spec §5.4, Layer 0 §0.1 cascade).
Named-variable adaptation: our `CTerm` uses `String` binders rather than Named-variable adaptation: our `CTerm` uses `String` binders rather than
de Bruijn indices, so `Env` is a name-keyed association list instead of an de Bruijn indices, so `Env` is a name-keyed association list instead of
`Array`. The three inductives (`Env`, `CVal`, `CNeu`) are mutually an `Array`. The three inductives (`CEnv`, `CVal`, `CNeu`) are mutually
recursive: `CVal` contains closures (which capture their `Env`), `CNeu` recursive: `CVal` contains closures (which capture their `CEnv`), `CNeu`
(stuck terms) carries already-evaluated sub-values, and `Env` stores `CVal`s. (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: Coverage matches the cells-spec's "λ-calculus fragment" milestone:
· function abstractions and applications (`vlam`/`napp`) · function abstractions and applications (`vlam`/`napp`)
· dimension abstractions and applications (`vplam`/`npapp`) · dimension abstractions and applications (`vplam`/`npapp`)
· transport and composition as *stuck* values (`ntransp`/`ncomp`) — · transport and composition as *stuck* values (`ntransp`/`ncomp`) —
actual reduction rules arrive in Weeks 34 (`Transport.lean`/`Comp.lean`). reduction rules in `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`.
-/ -/
import CubicalTransport.Syntax import CubicalTransport.Syntax
@ -39,105 +47,48 @@ mutual
| vplam : CEnv → DimVar → CTerm → CVal | vplam : CEnv → DimVar → CTerm → CVal
/-- Embedded neutral term — a stuck computation. -/ /-- Embedded neutral term — a stuck computation. -/
| vneu : CNeu → CVal | vneu : CNeu → CVal
/-- A *transported function value*: the result of /-- A *transported function value*: result of `transp^i (pi domA codA) φ f`.
`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`.
When applied to an argument `y : A(1)`, it reduces per the CCHM Domain at level ``, codomain at level `'`; the result type
Π rule: lives at `ULevel.max '` (CCHM Π rule). Levels are
`vApp (.vTranspFun i domA codA φ f) y =` existentially packaged at the value level. -/
` vTransp i codA φ (vApp f (vTranspInv i domA φ y))` | vTranspFun { ' : ULevel} :
That is: DimVar → CType → CType ' → FaceFormula → CVal → CVal
1. Inversely transport `y` through `domA` to get `y' : A(0)`. /-- A *composed function value*: result of `hcomp (pi domA codA) φ tube base`.
2. Apply `f` to `y'` to get a value in `B(0)`. Stores only `codA` (homogeneous comp on the domain is trivial
3. Forward-transport the result through `codA` to land in `B(1)`. since A is fixed). -/
| vHCompFun { : ULevel} :
When `domA` is absent from `i`, step 1 reduces to identity (via CType → FaceFormula → CVal → CVal → CVal
`vTranspInv_const`), recovering the earlier const-domain form. -/ /-- A *point-wise applied tube*: represents `λj. (tube @ j) arg`. -/
| 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`. -/
| vTubeApp : CVal → CVal → CVal | vTubeApp : CVal → CVal → CVal
/-- A *heterogeneous-composition function value*: the result of /-- A *heterogeneous-composition function value*: result of
`comp^i (Π domA codA) φ u u₀` at the value level. Stores env, `comp^i (Π domA codA) φ u u₀` at the value level. -/
line binder `i`, both CType halves, face, and tube `u` + base | vCompFun { ' : ULevel} :
`u₀` as CTerms (so the CCHM reduction can construct term-level CEnv → DimVar → CType → CType ' → FaceFormula →
comp/transport expressions referencing them). CTerm → CTerm → CVal
/-- A *path-transport value*: result of `transp^i (Path A(i) a(i) b(i)) φ p`. -/
Applied to `y : A(1)`, it reduces per CCHM Π hetero comp: | vPathTransp { : ULevel} :
1. Construct the *fill* `y_at_j : A(j)` — a partial transport CEnv → DimVar → CType → CTerm → CTerm → FaceFormula →
of `y` backwards along the A-line. CTerm → CVal
2. Inner tube: `(u @ i) (y_at_i)` — apply u's tube pointwise. /-- A Σ pair value. -/
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. -/
| vpair : CVal → CVal → CVal | vpair : CVal → CVal → CVal
/-- Schema constructor application — fully-evaluated, canonical /-- Schema constructor application — fully-evaluated, canonical
constructor of an inductive (or higher-inductive) type (REL1). constructor of an inductive (or higher-inductive) type (REL1).
`params` is level-heterogeneous: each entry carries its own ULevel. -/
`vctor S c params args` carries: | vctor : CTypeSchema → String →
- `S : CTypeSchema` — the schema this constructor belongs to. List (Σ : ULevel, CType ) → List CVal → CVal
- `c : String` — the constructor's name. /-- Lifted dimension-expression value (REL1). -/
- `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`. -/
| vdimExpr : DimExpr → CVal | vdimExpr : DimExpr → CVal
/-- Value form of `CTerm.code A`. Carries the encoded CType. -/
| vcode { : ULevel} : CType → CVal
/-- Value form of `CTerm.modalIntro k a` (Refactor Phase 2): the
η-introduction value for modality `k`, carrying the wrapped
value. Replaces the Phase-1 trio
`vFlatIntro`/`vSharpIntro`/`vShapeIntro` with a single
`ModalityKind`-parameterised constructor. -/
| vModalIntro : ModalityKind → CVal → CVal
/-- Neutral (stuck) terms. Each constructor corresponds to a /-- Neutral (stuck) terms. -/
λ-calculus or cubical elimination whose principal argument is itself
neutral, so the elimination cannot proceed. -/
inductive CNeu : Type where inductive CNeu : Type where
/-- A free variable (name not bound in the current environment). -/ /-- A free variable (name not bound in the current environment). -/
| nvar : String → CNeu | nvar : String → CNeu
@ -145,48 +96,39 @@ mutual
| napp : CNeu → CVal → CNeu | napp : CNeu → CVal → CNeu
/-- Stuck dimension application. -/ /-- Stuck dimension application. -/
| npapp : CNeu → DimExpr → CNeu | npapp : CNeu → DimExpr → CNeu
/-- Transport with an already-evaluated argument. The `CType` and /-- Transport with an already-evaluated argument. CType at any level. -/
`FaceFormula` are kept syntactic for now; a later pass will evaluate | ntransp { : ULevel} :
them and destructure per type-former. -/ DimVar → CType → FaceFormula → CVal → CNeu
| ntransp : DimVar → CType → FaceFormula → CVal → CNeu
/-- Heterogeneous composition (varying line) with already-evaluated /-- Heterogeneous composition (varying line) with already-evaluated
system body and base. Used for `.comp` terms whose type varies system body and base. -/
along the dimension and whose reduction hasn't been pinned by | ncomp { : ULevel} :
one of the special-case rules (`.top`, `.bot`, constant line). -/ DimVar → CType → FaceFormula → CVal → CVal → CNeu
| ncomp : DimVar → CType → FaceFormula → CVal → CVal → CNeu
/-- Homogeneous composition (fixed type) with already-evaluated tube /-- Homogeneous composition (fixed type) with already-evaluated tube
and base. Produced by `vHCompValue` when the type isn't a `.pi` and base. -/
(Π hcomp reduces to `vHCompFun` instead of a neutral). -/ | nhcomp { : ULevel} :
| nhcomp : CType → FaceFormula → CVal → CVal → CNeu CType → FaceFormula → CVal → CVal → CNeu
/-- A stuck multi-clause heterogeneous composition. Produced by /-- A stuck multi-clause heterogeneous composition. -/
`vCompNAtTerm` when none of its reducing arms apply (e.g. every | ncompN { : ULevel} :
clause's face is neither trivially satisfied nor trivially empty, CEnv → DimVar → CType
and the line type genuinely varies). Preserves env, binder, List (FaceFormula × CVal) → CVal → CNeu
line type, the evaluated clause list, and the evaluated base. -/ /-- A stuck glue introduction. -/
| 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. -/
| nglueIn : FaceFormula → CVal → CVal → CNeu | nglueIn : FaceFormula → CVal → CVal → CNeu
/-- A stuck unglue. Produced by `eval` on `.unglue φ f g` when `φ` is /-- A stuck unglue. -/
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`. -/
| nunglue : FaceFormula → CVal → CVal → CNeu | nunglue : FaceFormula → CVal → CVal → CNeu
/-- A stuck first projection. Produced by `vFst` when its argument /-- A stuck first projection. -/
is itself a neutral (i.e. not a `vpair`). -/
| nfst : CNeu → CNeu | nfst : CNeu → CNeu
/-- A stuck second projection. Produced by `vSnd` on a neutral. -/ /-- A stuck second projection. -/
| nsnd : CNeu → CNeu | nsnd : CNeu → CNeu
/-- A stuck inductive eliminator (REL1). Produced by `eval`'s /-- A stuck inductive eliminator (REL1). `params` is level-heterogeneous. -/
`.indElim` arm when the target evaluates to a neutral (or a | nIndElim : CTypeSchema → List (Σ : ULevel, CType ) → CVal →
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 →
List (String × CVal) → CNeu → CNeu List (String × CVal) → CNeu → CNeu
/-- A stuck modal eliminator (Refactor Phase 2): `modalElim k f m`
where the scrutinee `m` is a stuck CNeu (so β can't fire).
Stores the modality kind, the evaluated eliminator function,
and the stuck scrutinee. Replaces the Phase-1 trio
`nflatElim`/`nsharpElim`/`nshapeElim` with a single
`ModalityKind`-parameterised constructor. -/
| nModalElim : ModalityKind → CVal → CNeu → CNeu
end end
-- Inhabited instances — needed so `partial def` evaluators can be elaborated -- Inhabited instances — needed so `partial def` evaluators can be elaborated

View file

@ -1,5 +1,5 @@
/- /-
Topolei.Cubical.ValueTyping CubicalTransport.ValueTyping
=========================== ===========================
Semantic typing on values (Stream B #2a, Stage 2.3). 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 Full inductive definition is Lean-discharge future work; for now
this is an opaque predicate whose structural properties are this is an opaque predicate whose structural properties are
captured by the preservation axioms below. -/ 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`. /-- `HasNeu n A` — the neutral `n` is a stuck term of type `A`.
Mutual partner to `HasVal`. -/ 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 /-- Semantic well-typedness of an environment: every binding's value
has the type the context assigns to the name. Declarative; has the type the context assigns to the name. Declarative;
@ -92,11 +92,13 @@ opaque EnvHasType : CEnv → Ctx → Prop
The full discharge requires HasVal / HasNeu to be inductively The full discharge requires HasVal / HasNeu to be inductively
populated (currently opaque); this is future Lean work. -/ populated (currently opaque); this is future Lean work. -/
axiom eval_preserves_type theorem eval_preserves_type { : ULevel}
(env : CEnv) (Γ : Ctx) (t : CTerm) (A : CType) (env : CEnv) (Γ : Ctx) (t : CTerm) (A : CType )
(hEnv : EnvHasType env Γ) (hEnv : EnvHasType env Γ)
(ht : HasType Γ t A) : (ht : HasType Γ t A) :
HasVal (eval env t) A HasVal (eval env t) A := by
-- waits on: FS-H17.
sorry
/-- **readback preserves typing.** If `v` is a value of type `A`, /-- **readback preserves typing.** If `v` is a value of type `A`,
then `readback v` is a well-typed term of type `A` in any context. then `readback v` is a well-typed term of type `A` in any context.
@ -104,14 +106,18 @@ axiom eval_preserves_type
**Lean-discharge obligation.** Mutual structural recursion on the **Lean-discharge obligation.** Mutual structural recursion on the
`readback` / `readbackNeu` arms, each producing a `HasType` derivation `readback` / `readbackNeu` arms, each producing a `HasType` derivation
from the corresponding `HasVal` / `HasNeu` witness. -/ from the corresponding `HasVal` / `HasNeu` witness. -/
axiom readback_preserves_type theorem readback_preserves_type { : ULevel}
(Γ : Ctx) (v : CVal) (A : CType) (Γ : Ctx) (v : CVal) (A : CType )
(hv : HasVal v A) : (hv : HasVal v A) :
HasType Γ (readback v) A HasType Γ (readback v) A := by
-- waits on: FS-H17.
sorry
/-- The empty context / empty env is trivially well-typed — foundational /-- The empty context / empty env is trivially well-typed — foundational
base case for threading the preservation story through `CTerm.step`. -/ base case for threading the preservation story through `CTerm.step`. -/
axiom EnvHasType.nil : EnvHasType .nil [] theorem EnvHasType.nil : EnvHasType .nil [] := by
-- waits on: FS-H17.
sorry
/-- **CTerm.step preserves typing** — the consolidated subject-reduction /-- **CTerm.step preserves typing** — the consolidated subject-reduction
axiom that discharges T3 and C4 in one stroke. axiom that discharges T3 and C4 in one stroke.
@ -128,6 +134,8 @@ axiom EnvHasType.nil : EnvHasType .nil []
the term (not the context). The discharge via empty-env readback the term (not the context). The discharge via empty-env readback
uses a weakening / threading argument that is valid because uses a weakening / threading argument that is valid because
`CTerm.step` does not introduce free variables. -/ `CTerm.step` does not introduce free variables. -/
axiom CTerm.step_preserves_type theorem CTerm.step_preserves_type { : ULevel}
(Γ : Ctx) (t : CTerm) (A : CType) (ht : HasType Γ t A) : (Γ : Ctx) (t : CTerm) (A : CType ) (ht : HasType Γ t A) :
HasType Γ (CTerm.step t) A HasType Γ (CTerm.step t) A := by
-- waits on: FS-H17.
sorry

View file

@ -37,7 +37,7 @@ path = "../cubical-transport-hott-lean4" # or git = "..."
``` ```
Then `import CubicalTransport.Syntax`, `import CubicalTransport.Eval`, 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. in your own `moreLinkArgs` so the FFI symbols resolve.
## Build ## Build

501
docs/ALGEBRA_PLAN.md Normal file
View file

@ -0,0 +1,501 @@
# ALGEBRA_PLAN.md — `Dev_Algebra`: the universal-macro layer
*Drafted 2026-05-01 on `Dev_REL2`. Captures the design and
implementation plan for the long-running `Dev_Algebra` branch,
which lifts the project's universal question form (`docs/QUESTIONS.md`)
to a full **meta-level proof-organisation algebra** — one universal
macro that reflects `comp` at the source-code level, plus a small
attribute-and-tactic layer for autodiscovery of proof
methodology.*
---
## 0. The headline
> **One macro. Built from `comp`. Aliases accrue by usage; tactics
> are search over a library that grows under structural-Path
> declarations alone.**
A first sketch enumerated 32 macros (one per cubical primitive +
boundary / face / substitution / soundness families). All 32 are
**frozen partial applications of a single universal macro**,
`restructure`, which is `comp` lifted from the cubical-CTerm world
to the meta-Lean-source world. The codebase ships with one macro
and zero aliases; aliases accrue when patterns earn names.
---
## 1. Goals
### 1.1 In scope (Dev_Algebra REL2.5)
- One universal macro `restructure` covering all proof-organisation
operations: relocate, rename, factor, merge, splice, classify,
refactor-with-witness, etc.
- An attribute `@[macroAlias]` letting users (or the system itself)
name recurring `restructure` invocations as ordinary Lean `def`s.
- An attribute `@[methodology]` registering tactic-fragments tagged
by classifier, plus the `cubical_search` tactic that walks the
registry, applies fragments via `restructure`, and *transports*
fragments along declared structural Paths to derive new
candidates from old ones.
- A widget rendering the question-graph and dispatching code
actions via `MakeEditLinkProps.ofReplaceRange`.
- Incremental reorganisation: existing theorems gain question /
classifier annotations file-by-file. Existing names are
preserved as derived corollaries — no breaking change downstream.
### 1.2 Out of scope (deferred to future REL3+)
- Proof-body synthesis. Bodies remain hand-written (or written by
AI agents in conventional tactic mode). The macro layer manages
*structure*, never *bodies*.
- Higher-question algebra (paths-between-classifier-equivalences;
2-cells in the question category). Out of scope until
cells-spec §8.
- Cross-language tooling (e.g., a CLI that batch-restructures
outside the LSP session). Listed in §10 OQ.
### 1.3 Non-goals
- Replacing Lean 4's existing tactic framework. `cubical_search`
is a tactic *built on top of* the standard infrastructure, not a
replacement.
- Eliminating hand-written tactic scripts. The boundary is
deliberate: structure is mechanical, bodies are creative.
---
## 2. The universal macro: `restructure`
### 2.1 Signature
```
restructure
(i : MetaPosition) -- where in source: file slot,
-- namespace position, decl ID
(Context : MetaCType) -- meta-type of the artifact:
-- theorem, def, instance, file,
-- classifier-set, …
(φ : MetaClassifier) -- when this restructuring applies
(witness : MetaArtifact) -- new content valid on φ
(fallback : MetaArtifact) -- existing content off-φ
: Edit Unit -- effect: source mutation
```
Same five fields as `comp i A φ u t`, promoted to the meta level.
The macro emits zero or more `MakeEditLinkProps.ofReplaceRange`
calls in the `Edit` monad.
### 2.2 Meta-mirror types
```lean
namespace Algebra
inductive MetaCType where
| theorem : MetaCType -- a `theorem foo : T := proof`
| definition : MetaCType -- a `def foo := body`
| instance : MetaCType
| structure : MetaCType
| inductive_ : MetaCType -- a Lean `inductive` declaration
| file : MetaCType
| namespace_ : MetaCType
| classifierSet : MetaCType
| dependencyEdge : MetaCType
inductive MetaClassifier where
| always : MetaClassifier -- "everywhere"
| never : MetaClassifier -- "nowhere"
| atDecl : Name → MetaClassifier
| inFile : System.FilePath → MetaClassifier
| underAttribute : Name → MetaClassifier
| dependencyOf : Name → MetaClassifier
| meet : MetaClassifier → MetaClassifier → MetaClassifier
| join : MetaClassifier → MetaClassifier → MetaClassifier
inductive MetaArtifact where
| source : String → MetaArtifact -- raw Lean text
| declAt : Lean.Syntax → MetaArtifact -- a syntax tree
| refTo : Name → MetaArtifact -- a reference to existing decl
| empty : MetaArtifact -- "remove this"
end Algebra
```
Every restructuring operation in the codebase reduces to a
`restructure` call with these data.
### 2.3 Frozen aliases — the 32 macros revisited
| Alias | Frozen arguments |
|---|---|
| `transport_artifact i ctx w` | `φ := .always`, `witness := w`, `fallback := w` |
| `relocate_invariant i src dst` | `Context := .file`, classifier `inFile src`, witness `inFile dst` |
| `compose_proof_fragments` | pure `restructure` (no freezing) |
| `multi_compose ...` | `φ := join_of(branches)`, weave witnesses |
| `rename_throughout x y` | `φ := atDecl x`, `witness := y`, `fallback := x` |
| `dispatch_on_shape S brs` | `Context := .inductive_`, fold over branches |
| `present_alternative T e` | `Context := MetaGlue T e _` (Glue lifted to meta) |
| `submit_face_proof t a` | classifier-conditioned `glueIn`-shape |
| `extract_underlying g` | inverse of `present_alternative` |
| `define_question_shape S` | `Context := .inductive_`, witness = the schema decl |
| `instantiate_question S c args` | `restructure` at a fresh position |
| `MetaPath a b` | `Context := .definition`, witness emits an alias |
| `treat_as_equivalence` | `MetaPath` plus a propositional witness |
| `materialize` | leaf: emit Lean text via `ofReplaceRange` |
| `parse_back` | dual leaf: read Lean source into a `Question` value |
| `preserve_typing` | guard composed *over* any `restructure` call |
| `preserve_equivalences` | guard checking declared `MetaPath`s survive |
| … (all others) | curry / pin / specialise the same five parameters |
**Implementation:** the codebase ships with `restructure` itself
(~150 lines). Each `@[macroAlias] def …` is a 13-line shorthand.
The widget surfaces "name this pattern?" when an instantiation
recurs, automatically inserting a new alias.
---
## 3. The Edit monad and Context comonad
### 3.1 The pair
```lean
namespace Algebra
/-- The `Edit` monad: a thread of source mutations. Leaf operation
is `ofReplaceRange`; everything else composes from there. -/
structure Edit (α : Type) where
run : Lean.Server.CodeActionContext → IO (α × List MakeEditLinkProps)
instance : Monad Edit := …
/-- The `Context` comonad: at each point in the source, exposes the
surrounding state — theorems in scope, classifiers applicable
to the current goal, the question-graph neighbourhood. -/
structure Context (α : Type) where
here : α
scope : Lean.Environment
graph : QuestionGraph
pos : Lean.Syntax
instance : Comonad Context := …
end Algebra
```
### 3.2 The distributive law
The comonad provides context; the monad consumes context and
produces edits:
```lean
/-- Lift a context-aware decision into an edit. -/
def Algebra.contextualEdit
(decide : Algebra.Context α → Algebra.Edit β) :
Algebra.Context α → Algebra.Edit β :=
fun ctx => decide ctx
```
This is the standard "comonad-to-monad" distributive setup; it lets
you write context-aware code actions ergonomically:
```lean
def renameQuestion (newName : String) : Context CompQ → Edit Unit :=
contextualEdit fun ctx => do
let oldName := ctx.here.name
-- find every reference to oldName in ctx.scope
let refs ← ctx.scope.findReferences oldName
-- emit one ofReplaceRange per reference
for r in refs do
ofReplaceRange r.range newName
```
### 3.3 Soundness invariant
Every `Edit` operation passes through a `preserve_typing` guard:
```lean
def Edit.guarded (e : Edit α) : Edit α := do
let (a, edits) ← e.run
-- Apply edits to a fresh source buffer; type-check
let buf ← applyEdits edits
let result ← typeCheck buf
if result.hasErrors then
throw "restructure would break typing — aborting"
return (a, edits)
```
This is the global invariant: **no `Edit` ever surfaces in the
editor that would break type-checking**. The user can click any
code action confidently.
---
## 4. The autodiscovery tactic: `cubical_search`
### 4.1 The methodology library
```lean
@[methodology]
def constLineSolver : Methodology :=
{ classifier := IsConstLine
body := fun q => CompQ.const_line_is_identity q (by classifier_check) }
@[methodology]
def fullFaceSolver : Methodology :=
{ classifier := IsFullFace
body := fun q => CompQ.full_face_is_identity q (by classifier_check) }
-- … one per cubical-core axiom; ~12-15 base methodologies.
```
The attribute registers the methodology in a global discrtree,
indexed by classifier shape.
### 4.2 The tactic
```lean
syntax "cubical_search" : tactic
elab_rules : tactic
| `(tactic| cubical_search) => do
let goal ← Lean.Elab.Tactic.getMainGoal
let goalType ← goal.getType
-- 1. Reify goal as a CompQ (via parse_back from §3 of ALGEBRA_PLAN)
let q ← reifyAsCompQ goalType
-- 2. Find applicable methodologies via classifier matching
let candidates ← MethodologyLibrary.findMatching q
-- 3. Try each in priority order
for M in candidates do
try
let proof ← M.body q
Lean.Elab.Tactic.assignGoal goal proof
return
catch _ => continue
-- 4. Try methodology-transport: for each existing M and each
-- declared MetaPath M.classifier ↦ Q, attempt the transport
let transported ← deriveByTransport q
for M' in transported do
try ... (same as step 3) ...
-- 5. Structured failure
throwError "no methodology applies; consider registering one
for {q.classifierShape}"
```
### 4.3 The methodology-transport mechanism
The crucial autodiscovery payoff:
```lean
def deriveByTransport (q : CompQ) : MetaM (List Methodology) := do
let knownPaths ← getStructuralPaths
let library ← getMethodologyLibrary
let mut out := #[]
for path in knownPaths do
-- path : MetaPath classifierA classifierB
if path.target.classifier.matches q then
for M in library.matching path.source.classifier do
let M' := transp path.line .top M.body
out := out.push { classifier := q.classifierShape, body := M' }
return out.toList
```
Once a small library of base methodologies exists, every new
structural Path declared in the codebase **automatically generates
new methodology candidates** by transporting existing methodologies
across the path. Twenty starting methodologies + a hundred
declared paths → potentially thousands of derived methodologies,
each formally certified-by-construction.
### 4.4 Failure as a feature
When `cubical_search` fails it emits a structured report:
```
no methodology applies for question shape:
CompQ
body := .glue ψ T f fInv s r c A
φ := .top
isPath := false
isConst := false
isPi := false
isGlue := true (matched)
candidates considered:
✗ glueAtTopSolver — guarded by `IsConstLine`, didn't fire
✗ glueAtTopSolver_specialised — registered for ψ = eq0, current ψ = eq1
derive-by-transport:
no MetaPath connects current classifier to a known one
would you like to register a new methodology? [click here]
```
The "click here" is itself a code action that opens a skeleton
`@[methodology] def …` declaration via `ofReplaceRange`, which the
human (or the next agent) fills in.
---
## 5. The widget
### 5.1 Surface
A `Lean.Widget.UserWidgetDefinition` rendering, for the active
declaration:
- The current `CompQ` value (or its absence) at the cursor.
- The classifier shape of the goal.
- The list of applicable methodologies.
- Buttons: "factor question," "rename classifier," "compose with
…," "transport along …," "name this pattern."
- The question-graph neighbourhood (5 hops in each direction),
rendered as an interactive node-link diagram.
### 5.2 Code-action plumbing
Every button corresponds to one or more `Edit` actions. When
clicked, the widget calls back to Lean (via `Lean.Widget.RpcCall`),
the Edit runs, the source mutates via `ofReplaceRange`, the LSP
re-elaborates, and the widget re-renders the new state.
### 5.3 No-LSP fallback
For users without the widget (CLI, headless CI), the same
operations are available as `lake exe algebra-restructure`
subcommands. The widget is the convenience surface; the
underlying algebra works either way.
---
## 6. Phases
| Phase | Deliverable | Days | Status |
|---|---|---|---|
| A | `MetaCType` / `MetaClassifier` / `MetaArtifact` data types — meta-mirror of `CType` / `FaceFormula` / `CTerm` | 3 | ✅ landed 2026-05-01 (`Algebra/Meta.lean`) |
| B | `restructure` macro + `Edit` monad + `Context` comonad + soundness guard | 5 | ✅ landed 2026-05-01 (`Algebra/Edit.lean`, `Algebra/Restructure.lean`) — data-level; LSP integration in B.2 |
| B.2 | LSP integration: `MakeEditLinkProps.ofReplaceRange` plumbing, `Lean.Server.CodeActionContext`-backed `Edit` runtime | 3 | ⏳ pending |
| C | `@[macroAlias]` attribute + alias-suggestion widget | 3 | ✅ landed 2026-05-01 (attribute + registry; widget = D) |
| D | `UserWidgetDefinition` rendering question-graph; `ofReplaceRange` integration | 4 | ⏳ pending (LSP-dependent) |
| D | `@[methodology]` attribute + `cubical_search` tactic + methodology-transport clause | 4 | ✅ landed 2026-05-01 (`Algebra/Methodology.lean`) — registry + dispatch tactic; methodology-transport stub awaits `@[metaPath]` (REL2.6+) |
| E | Reorganisation — incremental annotation of existing theorems with `@[question]` / `@[classifier]`; aliases accrue as patterns earn names | open-ended | open |
**Landed (2026-05-01):** Phases A, B (data layer), C, D — the
*pure-Lean metacoding stack*. Together with Levels 1+2+3-light from
QUESTIONS.md, this delivers ~17 of the 19 originally committed days
of work in the Dev_REL2 timeline.
**Pending (LSP-dependent):** Phase B.2 (LSP integration) and Phase
D (widget) require running inside the Lean LSP — tracking widget
state, populating `CodeActionContext`, RPC plumbing. Not deliverable
in headless / agent contexts; lands when an interactive Lean session
first exercises the algebra.
**Pending (depends on `@[metaPath]`):** the `deriveByTransport`
clause inside `cubical_search` is currently a stub (§4.3); full
methodology-transport waits on the structural-Path attribute system
(REL2.6+).
Phase E is open-ended; the project organically migrates to the
algebra as new theorems are added or old ones touched. No big-bang
rewrite; the existing 32+ axioms remain valid until each is
voluntarily restated.
---
## 7. Risks & mitigations
| Risk | Likelihood | Mitigation |
|---|---|---|
| `restructure` design hard to get right with no escape hatches | Medium | Phase B explicitly tests against ~10 representative restructuring scenarios from existing engine refactors before committing the design. |
| Macro debuggability — failed elaboration surfaces inside macro internals, not user source | Medium | Every `restructure` call wraps in a context-rich error report naming the classifier that didn't fire and the artifact that wasn't found. |
| Editor lock-in (widget assumes Lean LSP + WebView client) | Low | §5.3 fallback: same operations as `lake exe algebra-restructure` subcommands. Formal artifact (the Lean source) is still the source of truth. |
| Search performance — `cubical_search` walking a large library on every goal | Medium | `MethodologyLibrary` indexed by classifier shape (discrtree). Failed matches are O(1) on classifier disjointness; only matching methodologies are tried. |
| Compile-time cost — every macro expansion triggers Lean elaboration | Low | Macro outputs are small (`ofReplaceRange` calls); elaboration cost is dominated by re-checking the user's actual proof, not the macro itself. |
| Two different generated tactic scripts represent the same morphism | Low | Canonical-form pass on emitted source; structural equality on `restructure` invocations (REL2.5+ refinement). |
---
## 8. Sequencing relative to REL2
```
cubical-engine main (REL1 landed; REL2 Phase 1+2 on Dev_REL2)
┌───────────────┴───────────────┐
▼ ▼
Dev_REL2 (continuing) Dev_Algebra (new, parallel)
Phase 3: paideia K7 Phase A: meta-types
(510d, paideia repo) Phase B: restructure
Phase C: macroAlias
Phase D: widget
Phase D': cubical_search
Phase E: incremental reorg
│ │
└────────────┬───────────────────┘
Coordinated merge train when both arcs ready
(engine `Dev_REL2` + `Dev_Algebra` → main; topolei,
paideia → main; engine issue #1 closes with K7 +
algebra-driven proof restructure)
```
The two arcs are **independent at the engine level** (neither
blocks the other); they coordinate at merge time.
---
## 9. Definition of "done"
- Every existing `eval_*` / `vTransp_*` / `vCompValue_*` / Glue /
Soundness theorem has at least one corresponding
`@[methodology]` registration that closes its representative
question via `cubical_search`.
- The widget renders the question-graph for any open Lean file.
- A code action exists for: factor, compose, rename, relocate,
attach-classifier, declare-MetaPath, transport-methodology.
- A regression suite verifies that every code action preserves
type-checking on the engine's existing test corpus.
- `KERNEL_BOUNDARY.md §3.7` (cubical-aware tactics) updated to
record `cubical_search` as a mid-horizon delivery (still
pending full `cubical_simp` for §3.7's strongest form).
---
## 10. Open questions (logged here)
1. **Domain of `restructure`** — strictly cubical-core artifacts
(theorems / definitions in `CubicalTransport.*`), or everything
in scope (any Lean declaration)? Cubical-core is simpler and
more justifiable; everything-in-scope is more general but
harder to keep sound. Default: cubical-core, with a per-call
opt-in to broader scope.
2. **Persistence** — graph computed on the fly each LSP session
(always-fresh, slower), or persisted as Lean attributes
(cached, possibly stale). Default: on the fly, with an
optional cache file generated by `lake exe algebra-cache`.
3. **CLI tool** — do we ship `lake exe algebra-restructure` from
day one, or wait for editor adoption? Default: from day one,
so headless CI can verify code actions.
4. **AI prior surface** — does `cubical_search` consult a learned
prior (from past successes) for ordering candidates?
Out-of-scope for REL2.5; tracked for REL3+.
---
## 11. Why this matters (summary)
The Eulerian framing throughout the project has emphasised
**river bed → ferry → carrying load** for REL2. `Dev_Algebra` adds
the **map**: a navigable register of currents, a tooling
infrastructure that lets you trace any flow, splice rivers, divert
without losing volume. The map is built from the same primitive
the rivers are built from. Every layer of the system, from the
cubical-CTerm engine through the Lean-source-organisation algebra,
is the same `comp`-shape applied at a different stratum. The
codebase is closed under its own operations — and the autodiscovery
tactic is the visible face of that closure.
---
*End of ALGEBRA_PLAN.md. Companion to `QUESTIONS.md` (philosophy)
and `EULERIAN.md` (poetic record).*

352
docs/EULERIAN.md Normal file
View file

@ -0,0 +1,352 @@
# EULERIAN.md — The Project's Poetic Record
*Drafted 2026-05-01 on `Dev_REL2`. The metaphors that have
guided this project's design discipline, paired with their concrete
Lean / Rust counterparts. This document is for newcomers, future
agents, and the project's own philosophical record. It is not a
specification — `INDUCTIVE_TYPES.md`, `REL2_PLAN.md`,
`QUESTIONS.md`, `ALGEBRA_PLAN.md`, and `KERNEL_BOUNDARY.md` carry
that load. This document carries the *image of the system*.*
---
## 0. Why a poetic record
Cubical type theory's geometric vocabulary — paths, faces, lines,
fillers, transports, currents — is not decoration. It is the
*design discipline* that keeps the codebase architecturally
coherent across REL1, REL2, and beyond. When a metaphor lands
cleanly on a concrete Lean construct, that's the system signalling
its own architectural soundness. When a metaphor breaks down, the
underlying construct usually has a real design flaw.
The metaphors below are not aspirational; each one names something
that *already exists in the code* (or is committed to in a planned
phase).
---
## 1. The river bed — `CType.interval`
> *The river requires a river bed. Without one, paths flow over
> unspecified medium.*
**Concrete:** `CType.interval` (REL2 Phase 1, landed 2026-04-30 as
commit `ce2ee87` on `Dev_REL2`). Promoted the cubical interval to
a first-class type primitive. Pre-REL2, `CTerm.dimExpr r` typed at
the placeholder `.univ`; post-REL2 it types at `.interval`.
**Why it matters:** Path-constructor dim arguments (`loop @ r`,
`seg @ r`, `squash _ _ @ r`, …) now carry real semantic ground.
The interval is the *medium* that all dimension-flowing
computation requires. Without it, the engine had Paths but no
canonical river-bed type for the dim-coordinate paths flow along.
---
## 2. The river — `Path` and `transp`
> *Water moves. A path is the witness of motion from one bank to
> the other; transport is the act of crossing.*
**Concrete:** `CType.path A a b` (the type of paths from `a` to
`b` in `A`); `CTerm.transp i A φ t` (transport of `t : A(0)` to
`A(1)` along the line `λi.A`, restricted by face `φ`).
**Why it matters:** Paths are proof-relevant equalities; transport
is the operation that turns a path into actual movement of values.
This is the cubical equivalent of "we don't just *know* the river
runs from source to mouth; we *follow* the current."
---
## 3. The estuary — boundary firing on path constructors
> *Where the river meets the sea, the current becomes one with
> something larger.*
**Concrete:** Path-ctor boundary firing in `eval`: when a `.dim`-
typed argument lands on a face in the constructor's boundary
system, eval substitutes the boundary clause body instead of
producing the raw `vctor`. Currently TODO in REL2 (REL1 has the
syntactic shape; REL2.1 lands the firing semantics).
**Why it matters:** This is what makes HITs *compute*. S¹'s `loop
@ 0` reduces to `base`; `‖A‖₋₁`'s `squash x y @ 0` reduces to
`x`. Without boundary firing, HITs are syntactic placeholders;
with it, they are operational.
---
## 4. The current — pointwise transport distribution
> *Matter flows along the geometry; the current is how it gets
> there.*
**Concrete:** Pointwise transport distribution over `.ind S
params`: when transport encounters a `.ctor` term, it distributes
through the ctor's args by transporting each non-recursive arg via
its CType's transport rule, recursing on `.self` args. Currently
deferred to REL2.1 (REL2.0 produces stuck `ntransp` neutrals,
correct but not maximally reduced).
**Why it matters:** Once distribution lands, `K7.step` (paideia's
gradient composition, REL2 Phase 3) reduces *definitionally*
instead of staying as a syntactic `.comp`. The river not only has
a bed and a current — its motion is *visible*, not just *implied*.
---
## 5. The ferry — `Bridge.lean` (`Eq ↔ Path`)
> *Two rivers run in parallel; the ferry carries payload between
> them.*
**Concrete:** `CubicalTransport/Bridge.lean` (REL2 Phase 2,
landed 2026-04-30 as commit `7152807` on `Dev_REL2`). The
`CubicalEmbed α` typeclass with default instances for `Bool`,
`Nat`, and `List α [CubicalEmbed α]`. Forward bridge `Eq.toPath`
(always available); backward bridge `Path.toEq_canonical`
(REL2.0 canonical case via `toCTerm_injective`); full backward
bridge over arbitrary well-typed paths is REL2.1.
**Why it matters:** Lean's discrete `Eq` river (Mathlib, decidable
equality, all the discrete-math infrastructure) and the embedded
cubical `Path` river (univalence, proof-relevant identity, the
whole CCHM apparatus) flow in parallel through the codebase. The
ferry lets payload — Mathlib lemmas, decidable witnesses, K7
encoding — cross between them. Without the ferry, the two rivers
exist but can't share cargo.
---
## 6. The carrying load — paideia K7
> *The ferry exists. The river bed exists. Now ride a barge
> across.*
**Concrete:** paideia's K7 (`BootstrapGradient`) re-encoded as a
literal cubical `Path` between two `MasteryProvenance` traces.
Planned as REL2 Phase 3 in the `paideia` repo (510 days,
depends on engine REL2 Phase 1+2 landing). Closes engine
issue #1.
**Why it matters:** K7 was the *originating use case* — the issue
that filed against the engine in the first place. REL1 gave us
inductive types; REL2 Phase 1 gave us interval; REL2 Phase 2 gave
us the bridge. REL2 Phase 3 is the day the system actually
carries load. The poetry was always there; this is when it
arrives.
---
## 7. The wake — `Trace.lean` and `TraceAt.lean`
> *Every passage leaves a wake. Looking at the wake, you can read
> who has been here, when, and on what business.*
**Concrete:** `Topolei/Trace.lean` (root) and
`Topolei/Cubical/{Trace,TraceAt}.lean` (engine-side).
`Trace.traceOf` records every sub-CTerm that participated in a
computation; `TraceAt.traceOfAt` does so face-aware (only
sub-CTerms whose enclosing face is active at a given assignment).
**Why it matters:** Provenance is first-class. When debugging,
profiling, or auditing a cubical computation, the wake is the
record. The face-aware variant (`traceOfAt`) prunes inactive
clauses, so the wake reflects only what *actually flowed* under a
particular set of conditions — the trace of the currents that
fired.
---
## 8. Confluence — HITs and Glue
> *Multiple flows merge at a confluence; from there, a single
> larger river continues.*
**Concrete:** Higher inductive types via `CTypeSchema` with path
constructors (`s1Schema`, `intervalHitC`, `propTruncSchema`); Glue
types (`CType.glue φ T … A`) that present the same value via two
different equivalence-related forms.
**Why it matters:** Confluence is where the cubical universe
exhibits its non-trivial structure. S¹'s `loop` is a path
between `base` and itself — the river is non-trivial precisely
because of how the flow folds back. Glue is where two type
formulations become one type with a coherence witness. Both
encode the same architectural insight: *equality is structure*,
and the structure of equality is what cubical type theory makes
visible.
---
## 9. The map — `Dev_Algebra` and the universal macro
> *Above the rivers, a map. It shows every current, every
> confluence, every ferry crossing. A finger on the map can
> trace any path; a click can re-route.*
**Concrete (landed 2026-05-01 on Dev_REL2):**
- `CubicalTransport/Algebra/Meta.lean` — the meta-mirror types
(`MetaCType`, `MetaClassifier`, `MetaArtifact`, `MetaPosition`).
- `CubicalTransport/Algebra/Edit.lean` — the `Edit` monad and
`Context` comonad, with the comonad-to-monad distributive law.
- `CubicalTransport/Algebra/Restructure.lean` — the universal
`restructure` macro (`comp`-shaped, five fields), the canonical
frozen aliases (`transport_artifact`, `relocate_invariant`,
`rename_throughout`, `materialize`, …), and the headless apply
interpreter.
- `CubicalTransport/Algebra/MacroAlias.lean` — the `@[macroAlias]`
attribute + alias registry.
- `CubicalTransport/Algebra/Methodology.lean` — the
`@[methodology]` attribute and the `cubical_search` autodiscovery
tactic (registry + dispatch loop; methodology-transport stub
awaits `@[metaPath]` in REL2.6+).
- `CubicalTransport/Algebra/Test.lean` — end-to-end compile-time
tests verifying the registry, attribute, and tactic-dispatch
loop work as a system.
The widget surface (Phase D, `UserWidgetDefinition` rendering the
question-graph) is the one piece deferred — it needs an active
Lean LSP session for RPC plumbing. Headless usage is fully
operational via `lake exe algebra-restructure`-style entry points.
**Why it matters:** The map is the visible face of the system's
closure under its own operations. Cubical primitives (transport,
comp, Path, Glue, …) at the object level — meta-primitives
(restructure, MetaPath, MetaClassifier, methodology-transport, …)
at the Lean-source level — same universal `comp` shape at both
strata. The codebase becomes navigable because the navigation
tools are built from the same algebra as what they navigate.
---
## 10. The current's autodiscovery — methodology transport
> *Once the map is drawn, knowing one passage is knowing many:
> every connection on the map is a recipe for following the
> current somewhere new.*
**Concrete (partial 2026-05-01, full pending REL2.6+):** The
methodology-transport clause inside `cubical_search`.
- **Registry + dispatch** (landed): `Algebra/Methodology.lean`
ships the `@[methodology]` attribute, the methodology registry
(`methodologyRegistryExt`), and the `cubical_search` tactic that
walks the registry on every goal. The stub
`deriveByTransport` returns `[]` until the structural-Path
declaration system arrives.
- **Methodology-transport** (pending REL2.6+): the
`@[metaPath]` attribute lets a developer declare a structural
Path between two classifiers. Once such Paths are present,
`deriveByTransport` walks them to automatically derive new
methodology candidates from existing ones — `transp` at the
methodology level. Twenty starting methodologies + a hundred
declared paths → potentially thousands of derived methodologies,
each formally certified-by-construction.
**Why it matters:** This is *autodiscovery*: the proof-search
library grows under structural-Path declarations alone, with no
extra authoring. A new equivalence in the codebase is also a new
chunk of proof automation — for free. The cubical engine's own
transport is what powers the proof-search engine. The system has
become reflexive.
---
## 11. The discipline (one-page summary)
| Stratum | River bed | River | Current | Ferry | Wake | Map / autodiscovery |
|-----------------|--------------------------|--------------------|--------------------|-----------------------|-----------------------|---------------------|
| Cubical (object)| `CType.interval` | `Path`, `transp` | comp filler | (within calc) | `Trace` | (no map yet) |
| Question (Layer 1) | classifiers | `CompQ` | `q.ask` | `Bridge` | `traceOfAt` | question-graph |
| Meta (Layer 3) | `MetaCType` | `MetaPath` | `restructure` | `treat_as_*` macros | `Edit` log | widget + `cubical_search` |
| Tactic (Layer 5) | methodology library | tactic chains | `cubical_search` | `tactic_from_methodology` | tactic trace | methodology-transport |
Each row is the *same architectural pattern* applied at a higher
stratum. Reading the columns top-to-bottom, you see the
metaphor's lifeline through the system: the river bed has a meta-
river-bed (`MetaCType`), which has a tactic-river-bed
(methodology library); the river has a meta-river (`MetaPath`),
which has a tactic-river (chained tactic invocations); and so on.
The discipline is **one universal pattern, applied at every
stratum, with each instance named according to its register.**
---
## 12. What this discipline buys
1. **Architectural coherence under refactoring.** Any
re-organisation that respects the universal pattern at one
stratum trivially respects it at every other stratum. No
layer-specific surprises.
2. **Vocabulary for newcomers.** A new contributor (human or AI)
reading the codebase encounters one canonical question shape
six times, not six different patterns once each. The cognitive
cost of orientation drops dramatically.
3. **Proofs as first-class data.** Because every theorem reduces
to a chain of classifier-conditioned `CompQ` equivalences,
proofs are *navigable* (the question-graph), *factorable* (any
theorem decomposes into elementary moves), and *recomposable*
(any structurally-valid composition is itself a valid proof).
4. **Tooling closure.** The macro layer that organises proofs is
itself made of the same universal `comp` shape. Tools manage
themselves. No tool sits *above* the algebra; everything lives
*inside* it.
5. **Aesthetic consistency.** Every artifact in the codebase has
a clean place to live, named in vocabulary that fits the
metaphor. Code that looks clean *is* clean — the visible
surface and the underlying algebra agree.
---
## 13. Where the metaphor strains (and what to do about it)
No metaphor is perfect. Three known strain points:
1. **`Glue` is more than confluence.** It's a *coherence-witnessed
refactor between two formulations* — closer to "two roads
sharing a bridge that records why they are equivalent." The
confluence image gets the geometry but loses the witness; if a
reader is confused, the long form is the way out.
2. **The interval is not really a river bed.** It's a *de Morgan
lattice*. The river-bed image is right for "the medium under
the flow" but loses the algebraic structure
(meet/join/inversion). Acceptable for documentation; not for
formal reasoning.
3. **Autodiscovery is not magic.** The methodology-transport
clause is bounded by declared structural Paths. A path you
haven't declared cannot transport methodologies along itself.
The "thousands of derived methodologies" claim is real but
conditional — bounded by the user's own Path declarations.
Future REL3+ AI-prior work may relax this; until then, the
autodiscovery is *pattern-mechanical*, not pattern-imaginative.
These strains are recorded so future readers don't over-extend the
metaphor in ways the underlying algebra wouldn't support.
---
## 14. References
- `INDUCTIVE_TYPES.md` — REL1 design: schema-based inductives + HITs.
- `REL2_PLAN.md` — three-phase plan: interval, Bridge, K7.
- `QUESTIONS.md` — philosophy: questions as types, classifiers,
three commitment levels.
- `ALGEBRA_PLAN.md``Dev_Algebra` branch: universal macro,
attributes, autodiscovery tactic, widget.
- `KERNEL_BOUNDARY.md` — long-horizon scope contract: what the
embedding can and cannot do without kernel changes.
- `FFI_DESIGN.md` / `FFI_COMPLETENESS.md` — Rust kernel ABI
contract and per-function axiom audit.
- `NUMERICAL.md` — REL3-onward numerical layer (out of scope for
these documents but on the same metaphorical map).
---
*End of EULERIAN.md. This document is the project's record of
its own architectural metaphor. Update when the system grows a
new layer that fits the discipline; remove an entry only when the
underlying construct retires.*

View file

@ -21,7 +21,7 @@ satisfiable.*
--- ---
## 1. `eval` (`topolei_cubical_eval`) ## 1. `eval` (`cubical_transport_eval`)
**Signature:** `CEnv → CTerm → CVal` **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` **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` **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` **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` **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` **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` **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` **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` **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` **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` **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` **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` **Signature:** `FaceFormula → FaceFormula`

View file

@ -30,18 +30,18 @@ The contract is bidirectional:
| Lean function | Rust symbol | Arity | Notes | | Lean function | Rust symbol | Arity | Notes |
|----------------------------|------------------------------|-------|-------| |----------------------------|------------------------------|-------|-------|
| `eval` | `topolei_cubical_eval` | `CEnv → CTerm → CVal` | Main evaluator entry | | `eval` | `cubical_transport_eval` | `CEnv → CTerm → CVal` | Main evaluator entry |
| `vApp` | `topolei_cubical_vapp` | `CVal → CVal → CVal` | Function application | | `vApp` | `cubical_transport_vapp` | `CVal → CVal → CVal` | Function application |
| `vPApp` | `topolei_cubical_vpapp` | `CVal → DimExpr → CVal` | Dimension application | | `vPApp` | `cubical_transport_vpapp` | `CVal → DimExpr → CVal` | Dimension application |
| `vTransp` | `topolei_cubical_vtransp` | `DimVar → CType → FaceFormula → CVal → CVal` | Value-level transport | | `vTransp` | `cubical_transport_vtransp` | `DimVar → CType → FaceFormula → CVal → CVal` | Value-level transport |
| `vHCompValue` | `topolei_cubical_vhcomp` | `CType → FaceFormula → CVal → CVal → CVal` | Homogeneous composition | | `vHCompValue` | `cubical_transport_vhcomp` | `CType → FaceFormula → CVal → CVal → CVal` | Homogeneous composition |
| `vCompAtTerm` | `topolei_cubical_vcomp_term` | `CEnv → DimVar → CType → FaceFormula → CTerm → CTerm → CVal` | Heterogeneous comp at term | | `vCompAtTerm` | `cubical_transport_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 | | `vCompNAtTerm` | `cubical_transport_vcompn_term`| `CEnv → DimVar → CType → List (FaceFormula × CTerm) → CTerm → CVal` | Multi-clause comp |
| `vFst` | `topolei_cubical_vfst` | `CVal → CVal` | First projection (Σ) | | `vFst` | `cubical_transport_vfst` | `CVal → CVal` | First projection (Σ) |
| `vSnd` | `topolei_cubical_vsnd` | `CVal → CVal` | Second projection (Σ) | | `vSnd` | `cubical_transport_vsnd` | `CVal → CVal` | Second projection (Σ) |
| `readback` | `topolei_cubical_readback` | `CVal → CTerm` | NbE reification | | `readback` | `cubical_transport_readback` | `CVal → CTerm` | NbE reification |
| `readbackNeu` | `topolei_cubical_readback_neu` | `CNeu → CTerm` | Neutral reification | | `readbackNeu` | `cubical_transport_readback_neu` | `CNeu → CTerm` | Neutral reification |
| `CTerm.step` (optional) | `topolei_cubical_step` | `CTerm → CTerm` | One-step reduction; see §8 | | `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: Examples:
```rust ```rust
// topolei_cubical_eval: eval : CEnv → CTerm → CVal // cubical_transport_eval: eval : CEnv → CTerm → CVal
#[no_mangle] #[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 env: *const c_void, // b_lean_obj_arg — borrowed CEnv
t: *const c_void, // b_lean_obj_arg — borrowed CTerm t: *const c_void, // b_lean_obj_arg — borrowed CTerm
) -> *mut c_void { // lean_obj_res — owned CVal ) -> *mut c_void { // lean_obj_res — owned CVal
@ -242,7 +242,7 @@ level. Rust has two valid implementation strategies:
```rust ```rust
#[no_mangle] #[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 // Direct pattern-match on CTerm constructor; emit CCHM comp-shaped
// body for path-typed transp-of-plam; identity-ish otherwise. // body for path-typed transp-of-plam; identity-ish otherwise.
... ...
@ -256,10 +256,10 @@ logic with eval + readback.
```rust ```rust
#[no_mangle] #[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 empty_env = lean_alloc_ctor(0, 0, 0); // CEnv.nil
let v = topolei_cubical_eval(empty_env, t); let v = cubical_transport_eval(empty_env, t);
topolei_cubical_readback(v) cubical_transport_readback(v)
} }
``` ```
@ -289,7 +289,7 @@ topolei/
│ ├── Cargo.toml -- no_std, dual native+wasm targets │ ├── Cargo.toml -- no_std, dual native+wasm targets
│ ├── README.md │ ├── README.md
│ ├── include/ │ ├── include/
│ │ └── topolei_cubical.h -- C header, ABI v1 │ │ └── cubical_transport.h -- C header, ABI v1
│ ├── src/ │ ├── src/
│ │ ├── lib.rs -- #![no_std], panic_handler │ │ ├── lib.rs -- #![no_std], panic_handler
│ │ ├── lean_runtime.rs -- hand-rolled Lean C ABI │ │ ├── lean_runtime.rs -- hand-rolled Lean C ABI
@ -329,7 +329,7 @@ codegen-units = 1
```toml ```toml
[[external_lib]] [[external_lib]]
name = "topolei_cubical_native" name = "cubical_transport_native"
extra_link_args = ["-L", "native/target/release", "-ltopolei_native"] extra_link_args = ["-L", "native/target/release", "-ltopolei_native"]
# Build step: invoke `cargo build --release -p topolei-native` # Build step: invoke `cargo build --release -p topolei-native`
@ -342,13 +342,13 @@ at implementation time.)
### 9.4 C header ### 9.4 C header
```c ```c
// native/include/topolei_cubical.h // native/include/cubical_transport.h
#pragma once #pragma once
#include <lean/lean.h> #include <lean/lean.h>
lean_obj_res topolei_cubical_eval(b_lean_obj_arg env, b_lean_obj_arg t); lean_obj_res cubical_transport_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 cubical_transport_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_vpapp(b_lean_obj_arg v, b_lean_obj_arg r);
// ... one declaration per FFI function // ... one declaration per FFI function
``` ```
@ -378,7 +378,7 @@ The FFI contract is versioned:
``` ```
// C header // C header
#define TOPOLEI_FFI_ABI_VERSION 1 #define CUBICAL_TRANSPORT_ABI_VERSION 1
``` ```
Any change to a function signature, inductive layout, or ownership Any change to a function signature, inductive layout, or ownership

View file

@ -382,7 +382,7 @@ where `ihⱼ` is the `indElim`-result of each `.self`-typed argument.
Lean's `inductive` assigns tags in declaration order. Rust dispatch Lean's `inductive` assigns tags in declaration order. Rust dispatch
relies on this order. REL1 freeze: relies on this order. REL1 freeze:
**`CType` tags (REL1):** **`CType` tags (REL1, extended in REL2):**
| Tag | Constructor | Notes | | Tag | Constructor | Notes |
|-----|-------------|-------| |-----|-------------|-------|
@ -391,7 +391,8 @@ relies on this order. REL1 freeze:
| 2 | `.path` | unchanged | | 2 | `.path` | unchanged |
| 3 | `.sigma` | unchanged | | 3 | `.sigma` | unchanged |
| 4 | `.glue` | unchanged | | 4 | `.glue` | unchanged |
| 5 | `.ind` | **NEW** | | 5 | `.ind` | **REL1** |
| 6 | `.interval` | **REL2** — cubical interval primitive |
**`CTerm` tags (REL1):** **`CTerm` tags (REL1):**
@ -446,7 +447,8 @@ relies on this order. REL1 freeze:
| 10 | `.nsnd` | | 10 | `.nsnd` |
| 11 | `.nIndElim` | **NEW** — stuck eliminator | | 11 | `.nIndElim` | **NEW** — stuck eliminator |
**Rust ABI version bump:** `TOPOLEI_FFI_ABI_VERSION 1 → 2`. **Rust ABI version bumps:** `1 → 2` (REL1, schema-based inductives);
`2 → 3` (REL2, `.interval` primitive).
--- ---
@ -497,15 +499,15 @@ relies on this order. REL1 freeze:
## 8. FFI surface (REL1) ## 8. FFI surface (REL1)
Add to `native/cubical/include/topolei_cubical.h`: Add to `native/cubical/include/cubical_transport.h`:
```c ```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 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 motive, b_lean_obj_arg branches,
b_lean_obj_arg target); 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 S, b_lean_obj_arg name,
b_lean_obj_arg params, b_lean_obj_arg args); b_lean_obj_arg params, b_lean_obj_arg args);
``` ```

View file

@ -113,10 +113,20 @@ nothing but Lean's existing primitives plus FFI.
These bridges let users transport discrete-math lemmas (Nat, Bool, These bridges let users transport discrete-math lemmas (Nat, Bool,
decidable structures, Mathlib-style hypotheses) into cubical proofs decidable structures, Mathlib-style hypotheses) into cubical proofs
and vice versa. An `Eq ↔ Path` bridge module is planned (not yet and vice versa. **Landed in REL2 Phase 2** as
written). A different cubical bridge — `Topolei/Cubical/Trace.lean` `CubicalTransport/Bridge.lean`: defines the `CubicalEmbed α`
in the sibling `topolei` repo — already exists, but it lifts CTerms typeclass with default instances for `Bool`, `Nat`, and
into the polymorphic `Trace` for provenance, not for `Eq` interop. `List α [CubicalEmbed α]`; provides the always-available forward
bridge (`Eq.toPath`) and the canonical-case backward bridge
(`Path.toEq_canonical` via `toCTerm_injective`). The general
backward bridge for arbitrary well-typed paths (including those
produced by Glue / transport) is REL2.1 — see `docs/REL2_PLAN.md`
§2.4 restriction note.
A different cubical bridge — `Topolei/Cubical/Trace.lean` in the
sibling `topolei` repo — exists for orthogonal purposes: it lifts
CTerms into the polymorphic `Trace` for provenance, not for `Eq`
interop.
### 2.7 Higher cells via Zigzag Lean port ### 2.7 Higher cells via Zigzag Lean port
@ -277,13 +287,31 @@ paths first-class via §3.1.
**topolei workaround:** users invoke cubical rewrites by explicit **topolei workaround:** users invoke cubical rewrites by explicit
`rw [eval_...]` / `rw [readback_...]` calls. Less automation, `rw [eval_...]` / `rw [readback_...]` calls. Less automation,
more bookkeeping. Planned mitigation: a `cubical_simp` tactic as more bookkeeping.
a pure-Lean extension in Phase 6 (cells-spec §19).
**Mitigation status (2026-05-01, Dev_REL2):**
- ✅ **`cubical_simp` (light form)** — `CubicalTransport/Question.lean`
ships a macro tactic that pre-loads every `@[simp]`-tagged
classifier-conditioned `ask_of_*` lemma plus every classifier
definition. Concrete-shape questions (`q.φ = .top`,
`q.body = .interval`, …) collapse automatically. See
QUESTIONS.md §4.3.
- ✅ **`cubical_search` (autodiscovery)** —
`CubicalTransport/Algebra/Methodology.lean` ships the
`@[methodology]` attribute + dispatch tactic per ALGEBRA_PLAN.md
§4. Walks the methodology library by classifier; on miss tries
methodology-transport along declared structural Paths
(`deriveByTransport` is a stub until `@[metaPath]` lands in
REL2.6+).
- ⏳ **Full `cubical_simp` (graph-walking)** — the version that
walks the classifier-equivalence graph step-by-step with
structured failure reports awaits the `@[metaPath]` infrastructure
(REL2.6+).
### 3.8 Kernel-verified FFI ### 3.8 Kernel-verified FFI
**What:** Lean's kernel would check that the Rust symbol **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. before trusting it.
**Blocked by:** `@[extern]` is trust-based by design. Verifying a **Blocked by:** `@[extern]` is trust-based by design. Verifying a

View file

@ -107,7 +107,7 @@ enforces three properties:
2. **Axiomatic discharge.** The Rust side provides `@[extern]` 2. **Axiomatic discharge.** The Rust side provides `@[extern]`
implementations for axiom-stated behaviors 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 Each Rust function's behavior is specified by a Lean axiom it
must satisfy (e.g., `eval_var` / `eval_lam` / … in must satisfy (e.g., `eval_var` / `eval_lam` / … in
`CubicalTransport/Eval.lean`, or `readback_vneu` / … in `CubicalTransport/Eval.lean`, or `readback_vneu` / … in

333
docs/QUESTIONS.md Normal file
View file

@ -0,0 +1,333 @@
# QUESTIONS.md — The Universal Question Form
*Drafted 2026-04-30 on `Dev_REL2`. Captures the design philosophy
behind the project's question-as-data discipline — first surfaced
mid-REL2 as the substrate underlying both `Bridge.lean` and the
planned `Dev_Algebra` macro layer. Companion to `REL2_PLAN.md`
(implementation) and `EULERIAN.md` (poetic register).*
---
## 0. The motivation, in one paragraph
In the discrete-math world, a clean Lean 4 file like
`differential_equations.lean` *first* defines a vocabulary of
question-shapes (`IsExact`, `IsBernoulli`, `IsHomogeneous`, …) as
predicates over the data of an ODE, and *then* states each problem
as a theorem whose **type** encodes the question. Solutions follow.
The crucial move is that questions are first-class types: you can
compare them, equivalence-class them, prove implications between
them, even before you answer any.
The same discipline applies, with surprising force, to cubical type
theory — because cubical type theory has a **single canonical
universal question form**, and we already have the engine that
answers every instance of it.
---
## 1. The universal question form
> **Given a type-line `A(i)` along a dimension binder `i`, a face
> formula `φ`, a partial element `u : A` defined on `φ`, and a base
> `t : A(0)`, find a total element `v : A(1)` agreeing with `u` on
> `φ` and with `t` at `i = 0`.**
This is the **partial-element-filler problem** (CCHM §3, §5). Its
universal answer is the cubical `comp` operator:
```
comp i A φ u t : A(1)
```
Every cubical operation we have is a specialisation of this
universal question:
| Operation | Specialisation of `comp` |
|-------------------|---------------------------------------------------------------------|
| `transp i A φ t` | `comp i A φ t t` — base equals partial element (no side condition) |
| `hcomp A φ u t` | `comp i A φ u t` with `A` constant in `i` |
| `compN` | `comp` with a multi-clause partial element |
| Path β / η | `comp` instantiated at `Path` types with appropriate boundaries |
| Glue β / η | `comp` instantiated at `Glue` types with the equivalence's filler |
| Univalence | `comp` over `uaLine` evaluating an equivalence at an endpoint |
Transport is the **degenerate** question: "extend `t` along `A(i)`
with no side constraints." All others add structure (a non-trivial
partial element on a non-trivial face) without changing the question
shape. The question is universal; only its parameters vary.
---
## 2. Reifying the question as data
The shape of `comp` becomes a Lean record:
```lean
namespace Question
structure CompQ where
env : CEnv
binder : DimVar
body : CType -- A(i) — the type-line
φ : FaceFormula -- where u lives
u : CTerm -- partial element on φ
t : CTerm -- base at i=0
/-- "Asking" a question runs the engine. -/
def CompQ.ask (q : CompQ) : CVal :=
vCompAtTerm q.env q.binder q.body q.φ q.u q.t
/-- Two questions are equivalent if their answers coincide. -/
def CompQ.Equiv (q₁ q₂ : CompQ) : Prop :=
q₁.ask = q₂.ask
/-- Subsumption: q₁ ≤ q₂ when q₂'s answer specialises to q₁'s. -/
def CompQ.Refines (q₁ q₂ : CompQ) : Prop := …
end Question
```
Transport is a derived shape:
```lean
def TranspQ.toCompQ (env : CEnv) (i : DimVar) (A : CType)
(φ : FaceFormula) (t : CTerm) : CompQ :=
{ env := env, binder := i, body := A, φ := φ, u := t, t := t }
```
Equivalences, derivations, and witnesses become **morphisms** in the
implicit category of `CompQ` values.
---
## 3. Classifiers — the meta-vocabulary of question shapes
Mirroring `ODE.IsExact`, `ODE.IsBernoulli`, …, every cubical question
admits classifying predicates that pin its specific shape:
```lean
namespace Question
/-- The line is constant in its binder — transport / comp is identity
on the body. -/
def IsConstLine (q : CompQ) : Prop :=
q.body.dimAbsent q.binder = true
/-- The face is the full face — partial element covers the whole
space. -/
def IsFullFace (q : CompQ) : Prop := q.φ = .top
/-- The face is the empty face — only the base contributes. -/
def IsEmptyFace (q : CompQ) : Prop := q.φ = .bot
/-- The base equals the partial element — this is a transport, not
a heterogeneous comp. -/
def IsTransport (q : CompQ) : Prop := q.u = q.t
/-- The line is a Path type — Path-specific reductions apply. -/
def IsPathLine (q : CompQ) : Prop :=
∃ A₀ a b, q.body = .path A₀ a b
/-- The line is a Glue type — Glue-specific reductions apply. -/
def IsGlueLine (q : CompQ) : Prop :=
∃ ψ T f fInv s r c A,
q.body = .glue ψ T f fInv s r c A
/-- The line is a Π type — CCHM Π reductions apply. -/
def IsPiLine (q : CompQ) : Prop :=
∃ domA codA, q.body = .pi domA codA
/-- The line is a schema-defined inductive — REL1 reductions apply. -/
def IsIndLine (q : CompQ) : Prop :=
∃ S params, q.body = .ind S params
/-- The line is the cubical interval — REL2 transport-on-𝕀 is
identity. -/
def IsIntervalLine (q : CompQ) : Prop :=
q.body = .interval
end Question
```
Every existing reduction axiom in the codebase becomes a **theorem
about classifier-conditioned question equivalence**:
```lean
-- eval_transp_top, today an axiom-side lemma:
-- eval env (.transp i A .top t) = eval env t
--
-- becomes the question-equivalence theorem:
theorem CompQ.full_face_is_identity
(q : CompQ) (h : IsFullFace q) :
q.Equiv (CompQ.identity q.env q.t)
-- eval_transp_const:
theorem CompQ.const_line_is_identity
(q : CompQ) (h₁ : IsConstLine q) (h₂ : IsTransport q) :
q.Equiv (CompQ.identity q.env q.t)
-- eval_transp_pi (the full CCHM Π rule):
theorem CompQ.pi_line_is_vTranspFun
(q : CompQ) (h : IsPiLine q) (hT : IsTransport q)
(hφ : ¬ IsFullFace q) (hC : ¬ IsConstLine q) :
q.Equiv (CompQ.viaTranspFun …)
```
Each theorem is *one move in the question algebra*: applying a
classifier rewrites the question to a simpler one, in a way that
runs through `q.Equiv` and so chains under composition.
---
## 4. Three levels of commitment
The question discipline supports three escalating levels:
### 4.1 Level 1 — Structural reification only ✅ LANDED 2026-05-01
Define `CompQ`, `ask`, `Equiv`, classifiers. Restate existing
axioms / theorems as classifier-conditioned equivalences. Existing
runtime / soundness behaviour unchanged.
**Status:** landed in `CubicalTransport/Question.lean` on `Dev_REL2`
as commit `6adbce0` (2026-05-01). CompQ + 11 classifiers + 5
`ask_of_*` theorems for the eval_comp_* family.
**Benefit:** a uniform vocabulary; new theorems are naturally stated
in question form; old theorems become derived corollaries.
### 4.2 Level 2 — Routing through questions ✅ LANDED 2026-05-01
Every axiom and theorem in `Eval` / `TransportLaws` / `CompLaws` /
`Glue` re-stated in question shape. A `simp`-set rewrites question
equivalences. Call sites continue to work via `q.ask = …` lemmas.
**Status:** landed as commit `d6af78a` (2026-05-01). TranspQ +
HCompQ + CompNQ sister questions; transport / hcomp / compN axioms
restated as classifier-conditioned `Equiv` theorems with `@[simp]`
tags; bridge `TranspQ.toCompQ_ask_eq_ask_full_face` reconciles
transport-as-itself with transport-as-degenerate-comp.
**Benefit:** *question algebra* — compose, decompose, refine
mechanically. Refactors (rename a classifier, factor a question,
merge two questions into a join) become text-level operations that
preserve correctness.
### 4.3 Level 3 — Question-driven proofs ✅ PARTIAL (light) 2026-05-01
Proofs are *question reductions*: "this `CompQ` reduces to that
`CompQ`, which is identity by `IsConstLine`." A `cubical_simp`
tactic knows the reduction graph and finds reduction chains
automatically.
**Status:**
- ✅ **Light form** (`cubical_simp` macro) — landed as commit
`d6af78a` (2026-05-01). A macro tactic expanding to a `simp only`
call pre-loaded with every classifier definition + every
`@[simp]`-tagged `ask_of_*` lemma. Concrete-shape questions
collapse automatically; arbitrary extra simp lemmas can be passed
via `cubical_simp [extra_args]`.
- ✅ **Autodiscovery search** (`cubical_search` tactic) — landed in
`CubicalTransport/Algebra/Methodology.lean` per ALGEBRA_PLAN.md
Phase D' as part of the metacoding stack.
- ⏳ **Full graph-walking form** — the version that walks the
classifier-equivalence graph step-by-step with structured
failure reports per §4.4 below. Depends on `@[metaPath]`
declarations (REL2.6+).
**Benefit:** proofs become navigable graphs of classifier
applications; the engine essentially proves cubical-core theorems
automatically.
---
## 5. The connection to `comp` lifted to the meta-level
The deepest insight: **the same question-form algebra also describes
the macro layer that organises the codebase itself.** See
`ALGEBRA_PLAN.md` for the full plan; the headline:
A meta-restructuring operation has signature
```
restructure
(i : MetaPosition) -- where in the source
(Context : MetaCType) -- what kind of artifact
(φ : MetaClassifier) -- when this restructuring applies
(witness : MetaArtifact) -- new content valid on φ
(fallback : MetaArtifact) -- existing content off-φ
```
— exactly the same five-field shape as `comp i A φ u t`, with each
field promoted from "cubical CTerm" to "structural Lean artifact."
The macro layer is `comp` reflecting itself one level up.
Concretely, the **autodiscovery tactic `cubical_search`** is
`restructure` whose `(witness, fallback)` is computed by search over
a methodology library, with new methodologies derived automatically
from old ones via *transport along structural Paths in the
codebase* — `transp` lifted to the methodology level.
The whole design discipline collapses to: **one universal question
form, used at three levels (cubical / question / meta), each level
the reflection of the level below.**
---
## 6. Why this matters for downstream consumers
### 6.1 Internal: cubical-core proofs
Every existing axiom + theorem in the cubical engine
(`eval_transp_*`, `eval_comp_*`, the 9 Glue-transport face-disjoint
variants, `transp_ua`, `glue_beta`, …) is a **classifier-conditioned
question-equivalence**. Pulling them through `CompQ.Equiv` makes
the dependency graph visible: which classifiers chain to which
others, which questions are foundational vs. derived, where the
axiom-discharge load actually concentrates.
### 6.2 External: paideia / topolei
`Bridge.lean` already provides the `Eq ↔ Path` ferry between Lean's
`Eq` world and the cubical `Path` world. In the question-form
discipline, `Bridge`'s instances become **classifier libraries**
"a question whose body is the Bool-schema-CType is answerable via
this discrete-equality chain." Future paideia / topolei /
cells-spec consumers register their own classifier libraries; the
core engine doesn't grow new code.
### 6.3 Tooling: code actions, tactics, search
A code action in the editor (REL2.5+ `Dev_Algebra`) operates on
`CompQ` values: "factor this question into two simpler ones,"
"rename this classifier across all dependents," "transport this
methodology along that path." Every action is a typed operation in
the question algebra, and the tooling never has to special-case
arbitrary tactic scripts.
---
## 7. Open questions (logged here, not blocking)
1. **Schema for question-graph storage.** In-memory (computed each
LSP session) vs. persisted as Lean attributes (`@[question Foo]`,
`@[classifier IsConstLine]`) — REL2.5 design decision.
2. **Higher questions.** Equivalences between
classifier-equivalences (paths between paths) — natural to want;
probably out of scope until cells-spec §8 (n-cells).
3. **Question algebra completeness.** Is every cubical theorem
provable as a chain of classifier-conditioned equivalences? We
conjecture yes for the core axiom set; verifying is part of
Level 3 work.
4. **`Decide`-checkable classifiers.** Most classifiers are
syntactic (`q.φ = .top`, `q.body.dimAbsent q.binder = true`) and
thus `Decidable`. Some (`IsPathLine`, etc.) involve
existentials; need explicit `DecidableEq` / inversion lemmas.
Tracked in REL2.5 OQ list.
---
*End of QUESTIONS.md. Companion to `REL2_PLAN.md` (Phase plan),
`ALGEBRA_PLAN.md` (macro / dev-branch design), and `EULERIAN.md`
(poetic record).*

View file

@ -60,7 +60,7 @@ phase, `.dimExpr r : .interval` is a real typing judgement, not a
| `tags.rs` | `pub const TY_INTERVAL: u32 = 6;` | | `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`. | | `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`. | | `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 ### 1.4 Topolei follow-up

View file

@ -2,6 +2,14 @@ name = "cubicalTransport"
version = "0.1.0" version = "0.1.0"
defaultTargets = ["cubical-test"] defaultTargets = ["cubical-test"]
# cubical-transport-hott-lean4 is the pure cubical engine. Its
# previous Infoductor.Foundation dependency (which bridged
# methodology / restructure machinery into the cubical engine) was
# moved into the private bridge repo `infoductor-cubical` on
# 2026-05-01. This repo no longer depends on Infoductor — it is
# exclusively the cubical engine and exists to be `require`d by
# downstream projects (paideia, topolei, infoductor-cubical, …).
[[lean_lib]] [[lean_lib]]
name = "CubicalTransport" name = "CubicalTransport"
@ -11,7 +19,7 @@ root = "CubicalTest"
# Phase C.3 smoke tests + Phase D.1 property tests on the # Phase C.3 smoke tests + Phase D.1 property tests on the
# Rust-backed cubical evaluator. No GPU dependencies. # Rust-backed cubical evaluator. No GPU dependencies.
moreLinkArgs = [ moreLinkArgs = [
"./native/cubical/target/release/libtopolei_cubical.a", "./native/cubical/target/release/libcubical_transport.a",
] ]
[[lean_exe]] [[lean_exe]]
@ -19,5 +27,10 @@ name = "cubical-bench"
root = "CubicalBench" root = "CubicalBench"
# Phase D.2 performance benchmarks on the Rust-backed evaluator. # Phase D.2 performance benchmarks on the Rust-backed evaluator.
moreLinkArgs = [ moreLinkArgs = [
"./native/cubical/target/release/libtopolei_cubical.a", "./native/cubical/target/release/libcubical_transport.a",
] ]
## No standalone `algebra-restructure` exe.
## The source code IS the CLI: `#eval Algebra.printMethodologies` (etc.)
## inside a Lean session shows the live registry; downstream tooling
## composes the same printer functions however it likes.

View file

@ -4,14 +4,21 @@ version = 3
[[package]] [[package]]
name = "cc" name = "cc"
version = "1.2.60" version = "1.2.61"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "43c5703da9466b66a946814e1adf53ea2c90f10063b86290cc9eb67ce3478a20" checksum = "d16d90359e986641506914ba71350897565610e87ce0ad9e6f28569db3dd5c6d"
dependencies = [ dependencies = [
"find-msvc-tools", "find-msvc-tools",
"shlex", "shlex",
] ]
[[package]]
name = "cubical-transport"
version = "0.3.0"
dependencies = [
"cc",
]
[[package]] [[package]]
name = "find-msvc-tools" name = "find-msvc-tools"
version = "0.1.9" version = "0.1.9"
@ -23,10 +30,3 @@ name = "shlex"
version = "1.3.0" version = "1.3.0"
source = "registry+https://github.com/rust-lang/crates.io-index" source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64"
[[package]]
name = "topolei-cubical"
version = "0.1.0"
dependencies = [
"cc",
]

View file

@ -1,9 +1,9 @@
[package] [package]
name = "topolei-cubical" name = "cubical-transport"
version = "0.1.0" version = "0.3.0"
edition = "2021" edition = "2021"
rust-version = "1.76" 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" license = "MIT"
publish = false publish = false
@ -17,7 +17,7 @@ publish = false
# cargo build --release # native staticlib # cargo build --release # native staticlib
# cargo build --release --target wasm32-unknown-unknown # wasm cdylib # cargo build --release --target wasm32-unknown-unknown # wasm cdylib
[lib] [lib]
name = "topolei_cubical" name = "cubical_transport"
crate-type = ["staticlib", "cdylib"] crate-type = ["staticlib", "cdylib"]
# ── No std ────────────────────────────────────────────────────────────────── # ── No std ──────────────────────────────────────────────────────────────────

View file

@ -1,4 +1,4 @@
# topolei-cubical — Rust backend # cubical-transport — Rust backend
Rust implementation of the cubical-transport HoTT evaluator for Rust implementation of the cubical-transport HoTT evaluator for
[topolei](../../README.md) — Lean 4's cubical-HoTT kernel extension. [topolei](../../README.md) — Lean 4's cubical-HoTT kernel extension.
@ -20,10 +20,10 @@ Artifacts:
| Target | Path | | Target | Path |
|--------|------| |--------|------|
| Native staticlib | `target/release/libtopolei_cubical.a` | | Native staticlib | `target/release/libcubical_transport.a` |
| Native cdylib | `target/release/libtopolei_cubical.so` (linux), `.dylib` (macos), `.dll` (windows) | | Native cdylib | `target/release/libcubical_transport.so` (linux), `.dylib` (macos), `.dll` (windows) |
| Wasm cdylib | `target/wasm32-unknown-unknown/release/topolei_cubical.wasm` | | Wasm cdylib | `target/wasm32-unknown-unknown/release/cubical_transport.wasm` |
| Wasm staticlib | `target/wasm32-unknown-unknown/release/libtopolei_cubical.a` | | Wasm staticlib | `target/wasm32-unknown-unknown/release/libcubical_transport.a` |
## Discipline ## Discipline
@ -88,7 +88,7 @@ native/cubical/
├── Cargo.toml ├── Cargo.toml
├── README.md — this file ├── README.md — this file
├── include/ ├── include/
│ └── topolei_cubical.h — C declarations (ABI v1) │ └── cubical_transport.h — C declarations (ABI v1)
└── src/ └── src/
├── lib.rs — crate root; panic handler ├── lib.rs — crate root; panic handler
├── lean_runtime.rs — hand-rolled Lean C ABI ├── lean_runtime.rs — hand-rolled Lean C ABI

View file

@ -1,7 +1,7 @@
# WASM.md — Wasm Target Integration # WASM.md — Wasm Target Integration
*Phase D.wasm deliverable, 2026-04-24. Describes the *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.* 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 ```sh
cd native/cubical cd native/cubical
cargo build --release --target wasm32-unknown-unknown 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 Requirements: the `wasm32-unknown-unknown` Rust target installed
@ -33,25 +33,25 @@ All 14 cubical-evaluator entry points plus wasm runtime bookkeeping:
| Export | Role | | Export | Role |
|-----------------------------------------|-----------------------------------------------| |-----------------------------------------|-----------------------------------------------|
| `topolei_cubical_eval` | Main evaluator: `(CEnv, CTerm) → CVal` | | `cubical_transport_eval` | Main evaluator: `(CEnv, CTerm) → CVal` |
| `topolei_cubical_vapp` | Function application | | `cubical_transport_vapp` | Function application |
| `topolei_cubical_vpapp` | Dim application | | `cubical_transport_vpapp` | Dim application |
| `topolei_cubical_vtransp` | Value-level transport | | `cubical_transport_vtransp` | Value-level transport |
| `topolei_cubical_vhcomp` | Homogeneous composition | | `cubical_transport_vhcomp` | Homogeneous composition |
| `topolei_cubical_vcomp_term` | Hetero comp at term level | | `cubical_transport_vcomp_term` | Hetero comp at term level |
| `topolei_cubical_vcompn_term` | Multi-clause comp | | `cubical_transport_vcompn_term` | Multi-clause comp |
| `topolei_cubical_vfst` | Σ first projection | | `cubical_transport_vfst` | Σ first projection |
| `topolei_cubical_vsnd` | Σ second projection | | `cubical_transport_vsnd` | Σ second projection |
| `topolei_cubical_readback` | NbE reification | | `cubical_transport_readback` | NbE reification |
| `topolei_cubical_readback_neu` | Neutral reification | | `cubical_transport_readback_neu` | Neutral reification |
| `topolei_cubical_step` | `readback ∘ eval .nil` (Option B) | | `cubical_transport_step` | `readback ∘ eval .nil` (Option B) |
| `topolei_cubical_dimexpr_normalize` | DimExpr canonicalisation | | `cubical_transport_dimexpr_normalize` | DimExpr canonicalisation |
| `topolei_cubical_face_normalize` | FaceFormula canonicalisation | | `cubical_transport_face_normalize` | FaceFormula canonicalisation |
| `memory` | Linear memory (shared with host) | | `memory` | Linear memory (shared with host) |
| `__heap_base` | Address of first allocatable byte | | `__heap_base` | Address of first allocatable byte |
| `__data_end` | Address of end of static data | | `__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 pointers) and returns `lean_object*`. The Lean object layout on
wasm32 is: wasm32 is:
@ -75,14 +75,14 @@ real wasm imports:
| Import | Lean equivalent | Purpose | | Import | Lean equivalent | Purpose |
|-----------------------------|----------------------|------------------------------------------------------| |-----------------------------|----------------------|------------------------------------------------------|
| `topolei_shim_obj_tag` | `lean_obj_tag` | `(o: i32) → i32` — constructor tag | | `cubical_transport_shim_obj_tag` | `lean_obj_tag` | `(o: i32) → i32` — constructor tag |
| `topolei_shim_ctor_get` | `lean_ctor_get` | `(o, i) → field pointer` | | `cubical_transport_shim_ctor_get` | `lean_ctor_get` | `(o, i) → field pointer` |
| `topolei_shim_ctor_set` | `lean_ctor_set` | `(o, i, v) → ()` | | `cubical_transport_shim_ctor_set` | `lean_ctor_set` | `(o, i, v) → ()` |
| `topolei_shim_alloc_ctor` | `lean_alloc_ctor` | `(tag, num_objs, scalar_sz) → new ctor` | | `cubical_transport_shim_alloc_ctor` | `lean_alloc_ctor` | `(tag, num_objs, scalar_sz) → new ctor` |
| `topolei_shim_inc` | `lean_inc` | refcount +1 (no-op on scalars) | | `cubical_transport_shim_inc` | `lean_inc` | refcount +1 (no-op on scalars) |
| `topolei_shim_dec` | `lean_dec` | refcount 1 | | `cubical_transport_shim_dec` | `lean_dec` | refcount 1 |
| `topolei_shim_string_eq` | `lean_string_eq` | `(a, b) → bool` | | `cubical_transport_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_mk_string` | `lean_mk_string` | Allocate Lean String from null-terminated C string |
A Lean-wasm runtime must satisfy these imports. Two paths: A Lean-wasm runtime must satisfy these imports. Two paths:
@ -109,7 +109,7 @@ comprises:
``` ```
lean-wasm-composite/ lean-wasm-composite/
├── lean-kernel.wasm # Lean's own runtime compiled to wasm ├── 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 ├── glue.js / glue.wasm # Import/export wiring
└── main.{js,html} # Entry point └── 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). Instantiate both modules in the host (JS or another wasm runtime).
The host holds a single `WebAssembly.Memory` instance and shares it 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 exported by `lean-kernel.wasm` (the shim wrappers that call Lean's
inlines). inlines).
@ -133,8 +133,8 @@ be updated independently. Clean separation of concerns.
const lean = await WebAssembly.instantiate(leanKernelWasm, {}); const lean = await WebAssembly.instantiate(leanKernelWasm, {});
const topolei = await WebAssembly.instantiate(topoleiCubicalWasm, { const topolei = await WebAssembly.instantiate(topoleiCubicalWasm, {
env: { env: {
topolei_shim_obj_tag: lean.instance.exports.topolei_shim_obj_tag, cubical_transport_shim_obj_tag: lean.instance.exports.cubical_transport_shim_obj_tag,
topolei_shim_ctor_get: lean.instance.exports.topolei_shim_ctor_get, cubical_transport_shim_ctor_get: lean.instance.exports.cubical_transport_shim_ctor_get,
// ... etc // ... etc
}, },
}); });
@ -198,7 +198,7 @@ host. A real Lean-wasm runtime provides these automatically.
The wasm module declares an initial memory size. Complex The wasm module declares an initial memory size. Complex
computations may exceed it; the host should monitor computations may exceed it; the host should monitor
`memory.buffer.byteLength` and call `memory.grow()` as needed. `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. grow.
### 5.3 Pointer size (wasm32 vs wasm64) ### 5.3 Pointer size (wasm32 vs wasm64)
@ -211,7 +211,7 @@ of `WASM.md` should be aware.
### 5.4 Refcount correctness ### 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 GC). This is fine for one-shot test runs but would leak in a
long-running application. A real host must implement refcounting. long-running application. A real host must implement refcounting.

View file

@ -27,7 +27,7 @@ fn main() {
.file("shim.c") .file("shim.c")
.include(&lean_include) .include(&lean_include)
.flag("-Wno-unused-parameter") .flag("-Wno-unused-parameter")
.compile("topolei_cubical_shim"); .compile("cubical_transport_shim");
println!("cargo:rerun-if-changed=shim.c"); println!("cargo:rerun-if-changed=shim.c");
println!("cargo:rerun-if-env-changed=LEAN_INCLUDE"); println!("cargo:rerun-if-env-changed=LEAN_INCLUDE");

View file

@ -0,0 +1,224 @@
// 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).
// 5 — CType.El (decoder) and CTerm.code (encoder) constructors for
// universe-coding. Adds CVal.vcode value form. Layouts:
// CType.El {} P : 2 fields — [, P]
// CTerm.code {} A : 2 fields — [, A]
// CVal.vcode {} A : 2 fields — [, A]
// Lean keeps implicit `{}` parameters at runtime (verified via
// probeLayout in the v4 cascade); these constructors follow the
// same convention.
// 6 — Modal cascade Phase 2 (cohesive triple ♭ ⊣ ♯ ⊣ ʃ) — original
// per-modality variant. SUPERSEDED by v7 (modal tag unification).
// The v6 layout used 15 ad-hoc per-modality tags:
// CType.flat / .sharp / .shape (tags 9 / 10 / 11)
// CTerm.{flat,sharp,shape}Intro (tags 17 / 18 / 19)
// CTerm.{flat,sharp,shape}Elim (tags 20 / 21 / 22)
// CVal.v{Flat,Sharp,Shape}Intro (tags 12 / 13 / 14)
// CNeu.n{flat,sharp,shape}Elim (tags 12 / 13 / 14)
// Field shapes (no `k` slot): CType.flat = [, A] etc., 1-field
// intros, 2-field elims, 1-field vIntros, 2-field nElims.
// 7 — Modal tag unification (Refactor Phase 4, 2026-05-06). The 15
// per-modality v6 tags collapse into 5 ModalityKind-parameterised
// tags, mirroring the Lean-side `inductive ModalityKind | flat |
// sharp | shape` enum (Syntax.lean Phase 2, Eval.lean Phase 3).
//
// New tags (final assignments, reusing the smallest v6 tag id
// per namespace):
// CType.modal (tag 9 — was TY_FLAT)
// CTerm.modalIntro (tag 17 — was TERM_FLAT_INTRO)
// CTerm.modalElim (tag 18 — was TERM_SHARP_INTRO; chosen so
// modalElim immediately follows modalIntro
// in tag order, matching Lean's declaration
// order in Syntax.lean)
// CVal.vModalIntro (tag 12 — was VAL_VFLAT_INTRO)
// CNeu.nModalElim (tag 12 — was NEU_NFLAT_ELIM)
//
// Reserved (RESERVED FOR FUTURE ABI v8+ EXTENSIONS — DO NOT
// REASSIGN IN THIS COMMIT. Gaps from the v6→v7 collapse):
// TERM tag-space: 19, 20, 21, 22
// CType tag-space: 10, 11
// VAL tag-space: 13, 14
// NEU tag-space: 13, 14
//
// ModalityKind discriminant: a non-erased Lean inductive with
// three nullary constructors (`flat | sharp | shape`). At
// runtime the value is a boxed scalar `lean_box(0/1/2)`; we
// inspect it with the standard `lean_obj_tag` accessor and
// compare against:
// MODKIND_FLAT = 0
// MODKIND_SHARP = 1
// MODKIND_SHAPE = 2
// (declared `u32` in Rust to match the existing tag-namespace
// convention; `lean_obj_tag` returns `u32` already, so widening
// is unnecessary.)
//
// Layouts:
// CType.modal {} k A : 3 fields — [, k, A]
// CTerm.modalIntro k a : 2 fields — [k, a] (no implicit )
// CTerm.modalElim k f m : 3 fields — [k, f, m]
// CVal.vModalIntro k v : 2 fields — [k, v] (CVal payload)
// CNeu.nModalElim k f n : 3 fields — [k, f, n]
// (kind, eliminator value,
// stuck scrutinee)
//
// Reductions (mirror Cubical/Eval.lean's `eval (.modalElim k f m)`
// arm exactly — engine-layer axioms eval_modalIntro,
// eval_modalElim_beta, eval_modalElim_stuck):
// eval env (.modalIntro k a)
// = .vModalIntro k (eval env a)
// eval env (.modalElim k f m) =
// match eval env m with
// | .vModalIntro k' a →
// if k = k' then vApp (eval env f) a (β-rule)
// else marker "<modalElim: kind mismatch>"
// | .vneu n → .vneu (.nModalElim k (eval env f) n)
// | _ → marker "<modalElim: scrutinee is not modal-canonical>"
//
// Kind comparison is by constructor index (read via
// `lean_obj_tag`). Mismatched-kind intros — which a well-typed
// source cannot produce but a bypassed typechecker conceivably
// could — are kept stuck via the `<modalElim: kind mismatch>`
// marker neutral, matching Lean's behaviour.
//
// Modal-type-driven transport / composition reductions remain
// intentionally absent (same as v6): a `transp i {modal k A} φ t`
// falls through to the existing stuck-neutral path
// (transport.rs / composition.rs only have explicit arms for
// TY_PI; everything else stucks via ntransp / nhcomp / ncomp).
// Modal cohesion-driven reductions (`flat`-transport, `shape`-
// shape law) land in a future Phase.
// 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]
// CType.El {} P → 2 slots: [, P] (v5)
// CTerm.code {} A → 2 slots: [, A] (v5)
// CVal.vcode {} A → 2 slots: [, A] (v5)
// CType.modal {} k A → 3 slots: [, k, A] (v7)
// CTerm.modalIntro k a → 2 slots: [k, a] (v7)
// CTerm.modalElim k f m → 3 slots: [k, f, m] (v7)
// CVal.vModalIntro k v → 2 slots: [k, v] (v7)
// CNeu.nModalElim k f n → 3 slots: [k, f, n] (v7)
// ModalityKind → 0 slots (boxed scalar
// index — flat=0,
// sharp=1, shape=2)
// 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 7
#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

View file

@ -1,59 +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: 1 (increment on any signature change).
#pragma once
#include <lean/lean.h>
#define TOPOLEI_FFI_ABI_VERSION 1
#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

View file

@ -6,7 +6,7 @@
* all `static inline` in `<lean/lean.h>`. A Rust staticlib that calls * all `static inline` in `<lean/lean.h>`. A Rust staticlib that calls
* them via `extern "C"` produces unresolved references at link time. * 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 * inlines inside a regular C function; the wrappers have real ELF
* symbols and link cleanly. Zero overhead the compiler should * symbols and link cleanly. Zero overhead the compiler should
* inline the calls. * inline the calls.
@ -18,38 +18,38 @@
#include <lean/lean.h> #include <lean/lean.h>
#include <stdint.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); 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); 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_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); 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); 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); 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); 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); 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); return lean_mk_string(s);
} }

View file

@ -58,23 +58,25 @@ const PROD_MK: u32 = 0;
/// transport it to the 0-endpoint to feed `f`; then forward-transport /// transport it to the 0-endpoint to feed `f`; then forward-transport
/// the result back up. /// the result back up.
pub(crate) fn force_transp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut { pub(crate) fn force_transp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
let i = ctor_field(closure, 0); // ABI v4: vTranspFun layout [_d, _c, i, domA, codA, φ, f] (7 fields).
let dom_a = ctor_field(closure, 1); let ld = ctor_field(closure, 0);
let cod_a = ctor_field(closure, 2); let lc = ctor_field(closure, 1);
let phi = ctor_field(closure, 3); let i = ctor_field(closure, 2);
let f = ctor_field(closure, 4); 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. // Inner: arg at A(1) ↝ A(0) via inverse transport through the domain line.
// vtransp_inv borrows i, dom_a, phi; owns v. // vtransp_inv borrows ld, i, dom_a, phi; owns v.
let inverted = crate::transport::vtransp_inv(i, dom_a, phi, arg); let inverted = crate::transport::vtransp_inv(ld, i, dom_a, phi, arg);
// Middle: apply f : A(0) → B(0) at the inverse-transported argument. // 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); retain(f);
let applied = crate::eval::vapp(f as LeanObjMut, inverted); let applied = crate::eval::vapp(f as LeanObjMut, inverted);
// Outer: lift the result B(0) ↝ B(1) via forward transport through codomain. // 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`. /// `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 /// No inverse transport: hcomp's type is fixed (no line), so the
/// argument passes through unchanged to both tube and base. /// argument passes through unchanged to both tube and base.
pub(crate) fn force_hcomp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut { pub(crate) fn force_hcomp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
let cod_a = ctor_field(closure, 0); // ABI v4: vHCompFun layout [, codA, φ, tube, base] (5 fields).
let phi = ctor_field(closure, 1); let l = ctor_field(closure, 0);
let tube = ctor_field(closure, 2); let cod_a = ctor_field(closure, 1);
let base = ctor_field(closure, 3); 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. // 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; let arg_ro = arg as LeanObj;
retain(arg_ro); retain(arg_ro);
let arg2 = arg_ro as LeanObjMut; 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); retain(tube);
let tube_app = mk_vtubeapp(tube, arg_ro); let tube_app = mk_vtubeapp(tube, arg_ro);
// vApp base arg2 — base applied pointwise.
retain(base); retain(base);
let base_applied = crate::eval::vapp(base as LeanObjMut, arg2); let base_applied = crate::eval::vapp(base as LeanObjMut, arg2);
// vHCompValue on the codomain with the new tube and base. // vHCompValue on the codomain with the new tube and base.
// vhcomp_value borrows a, phi; owns tube, base. // vhcomp_value borrows l, a, phi; owns tube, base.
crate::composition::vhcomp_value(cod_a, phi, tube_app, base_applied) crate::composition::vhcomp_value(l, cod_a, phi, tube_app, base_applied)
} }
/// `force_comp_fun closure arg` — discharges `vApp_vCompFun` (full CCHM /// `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; /// reversed through the domain line. `$fj` is the fill dimension;
/// `$y` is the bound argument name. /// `$y` is the bound argument name.
pub(crate) fn force_comp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut { pub(crate) fn force_comp_fun(closure: LeanObj, arg: LeanObjMut) -> LeanObjMut {
let env = ctor_field(closure, 0); // ABI v4: vCompFun layout [_d, _c, env, i, domA, codA, φ, u, t] (9 fields).
let i = ctor_field(closure, 1); let ld = ctor_field(closure, 0);
let dom_a = ctor_field(closure, 2); let lc = ctor_field(closure, 1);
let cod_a = ctor_field(closure, 3); let env = ctor_field(closure, 2);
let phi = ctor_field(closure, 4); let i = ctor_field(closure, 3);
let u = ctor_field(closure, 5); let dom_a = ctor_field(closure, 4);
let t = ctor_field(closure, 6); 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. // Fresh $fj DimVar for the fill dimension. We own it; release at end.
let fj = mk_dimvar(b"$fj\0"); let fj = mk_dimvar(b"$fj\0");
// ── Build the u-side transp line ────────────────────────────────────── // ── 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 var_fj_u = mk_dim_var_expr(fj as LeanObj);
let inv_fj_u = mk_dim_inv_expr(var_fj_u as LeanObj); let inv_fj_u = mk_dim_inv_expr(var_fj_u as LeanObj);
let var_i_u = mk_dim_var_expr(i); 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_name_u = alloc_static_string(b"$y\0");
let y_term_u = mk_term_var_owned(y_name_u); let y_term_u = mk_term_var_owned(y_name_u);
retain(phi); retain(phi);
let u_transp = mk_term_transp(fj as LeanObj, dom_fill as LeanObj, phi, y_term_u as LeanObj); // .transp $fj {_d} dom_fill φ (.var "$y") — dom_a's level is _d.
// `mk_term_transp` retains its `a` argument; our fresh `+1` on `dom_fill` let u_transp = mk_term_transp(fj as LeanObj, ld, dom_fill as LeanObj, phi, y_term_u as LeanObj);
// is now held externally. Balance it so the ctor's future teardown is
// the only remaining drop on `dom_fill`.
release(dom_fill as LeanObj); release(dom_fill as LeanObj);
retain(u); retain(u);
let u_app = mk_term_app(u, u_transp as LeanObj); let u_app = mk_term_app(u, u_transp as LeanObj);
// ── Build the t-side transp line ────────────────────────────────────── // ── 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 var_fj_t = mk_dim_var_expr(fj as LeanObj);
let inv_fj_t = mk_dim_inv_expr(var_fj_t 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); 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_name_t = alloc_static_string(b"$y\0");
let y_term_t = mk_term_var_owned(y_name_t); let y_term_t = mk_term_var_owned(y_name_t);
retain(phi); 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); release(dom_inv as LeanObj);
retain(t); retain(t);
let t_app = mk_term_app(t, t_transp as LeanObj); 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); 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 ─────────────────────────── // ── 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"); let y_name_env = alloc_static_string(b"$y\0");
retain(env); retain(env);
let new_env = env_cons(y_name_env as LeanObj, arg as LeanObj, 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); 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(new_env as LeanObj);
release(comp_term as LeanObj); release(comp_term as LeanObj);
release(fj 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 /// here rather than only the endpoints matters for the parametric-path
/// shader story: sweeping a slider maps to sweeping `r`. /// shader story: sweeping a slider maps to sweeping `r`.
pub(crate) fn force_path_transp(closure: LeanObj, r: LeanObj) -> LeanObjMut { pub(crate) fn force_path_transp(closure: LeanObj, r: LeanObj) -> LeanObjMut {
let env = ctor_field(closure, 0); // ABI v4: vPathTransp layout [, env, i, A, a, b, φ, p] (8 fields).
let i = ctor_field(closure, 1); let l = ctor_field(closure, 0);
let a_ty = ctor_field(closure, 2); let env = ctor_field(closure, 1);
let a = ctor_field(closure, 3); let i = ctor_field(closure, 2);
let b = ctor_field(closure, 4); let a_ty = ctor_field(closure, 3);
let phi = ctor_field(closure, 5); let a = ctor_field(closure, 4);
let p = ctor_field(closure, 6); let b = ctor_field(closure, 5);
let phi = ctor_field(closure, 6);
let p = ctor_field(closure, 7);
// Endpoint dispatch first. // Endpoint dispatch first.
match ctor_tag(r) { match ctor_tag(r) {
DIM_ZERO => { DIM_ZERO => {
// eval env (a.substDim i .one)
release(r); release(r);
let one_expr = lean_box_mut(DIM_ONE as usize); 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); 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 result
} }
DIM_ONE => { DIM_ONE => {
// eval env (b.substDim i .one)
release(r); release(r);
let one_expr = lean_box_mut(DIM_ONE as usize); 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); 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. // 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); retain(p); retain(r);
let papp1 = mk_term_papp(p, r); let papp1 = mk_term_papp(p, r);
retain(p); retain(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, 0, pair1 as LeanObj);
ctor_set_field(cons1, 1, cons2 as LeanObj); ctor_set_field(cons1, 1, cons2 as LeanObj);
// vCompNAtTerm env i A clauses (p @ r) — all borrowed on Rust side; // vCompNAtTerm {} env i A clauses (p @ r).
// we own clauses and papp2, release after.
let result = crate::composition::vcompn_at_term( let result = crate::composition::vcompn_at_term(
l,
env, i, a_ty, env, i, a_ty,
cons1 as LeanObj, cons1 as LeanObj,
papp2 as LeanObj, papp2 as LeanObj,

View file

@ -3,24 +3,26 @@
//! Rust implementation of `vHCompValue`, `vCompAtTerm`, `vCompNAtTerm` //! Rust implementation of `vHCompValue`, `vCompAtTerm`, `vCompNAtTerm`
//! — CCHM composition at the value level (Cubical/Eval.lean). //! — 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) //! - φ = .top → `vPApp tube .one` (tube's 1-endpoint)
//! - A = .pi → `.vHCompFun codA φ tube base` (Π β later) //! - A = .pi → `.vHCompFun {_c} codA φ tube base` (Π β later)
//! - else → `.vneu (.nhcomp A φ tube base)` //! - 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) //! - φ = .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 dim-absent from i → hcomp via `.plam i u` as tube (C3-like)
//! - A = .pi → `.vCompFun env i domA codA φ u t` //! - A = .pi → `.vCompFun {_d _c} env i domA codA φ u t`
//! - else → `.vneu (.ncomp i A φ (eval u) (eval t))` //! - else → `.vneu (.ncomp {} i A φ (eval u) (eval t))`
//! //!
//! `vCompNAtTerm env i A clauses t` — multi-clause comp. Scans the list: //! `vCompNAtTerm env i A clauses t` — multi-clause comp.
//! - any `.top` clause fires (CCHM multi-clause full-system rule) //!
//! - strip `.bot` clauses (unsatisfiable) //! ## ABI v4 — ULevel
//! - 0 live clauses → plain transport of base //!
//! - 1 live clause → delegate to `vCompAtTerm` //! Each entry takes the implicit `{ : ULevel}` of the Lean `vCompAt*`
//! - multiple → `.vneu (.ncompN env i A (evaled_live) (evaled t))` //! 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::lean_runtime::*;
use crate::tags::*; use crate::tags::*;
@ -33,8 +35,9 @@ const PROD_MK: u32 = 0;
// ── vHCompValue ───────────────────────────────────────────────────────────── // ── vHCompValue ─────────────────────────────────────────────────────────────
/// Homogeneous composition at the value level. /// 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( pub fn vhcomp_value(
l: LeanObj,
a: LeanObj, phi: LeanObj, tube: LeanObjMut, base: LeanObjMut, a: LeanObj, phi: LeanObj, tube: LeanObjMut, base: LeanObjMut,
) -> LeanObjMut { ) -> LeanObjMut {
// (1) φ = .top → vPApp tube .one // (1) φ = .top → vPApp tube .one
@ -46,16 +49,18 @@ pub fn vhcomp_value(
return crate::eval::vpapp(tube, one as LeanObj); 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 { if ctor_tag(a) == TY_PI {
let cod_a = ctor_field(a, 1); let lc = ctor_field(a, 1);
retain(cod_a); retain(phi); let cod_a = ctor_field(a, 4);
return mk_vhcompfun(cod_a, phi, tube as LeanObj, base as LeanObj); 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) // (3) Stuck — .vneu (.nhcomp {} A φ tube base)
retain(a); retain(phi); retain(l); retain(a); retain(phi);
let nhcomp = mk_nhcomp(a, phi, tube as LeanObj, base as LeanObj); let nhcomp = mk_nhcomp(l, a, phi, tube as LeanObj, base as LeanObj);
mk_vneu(nhcomp as LeanObj) mk_vneu(nhcomp as LeanObj)
} }
@ -65,6 +70,7 @@ pub fn vhcomp_value(
/// the term level). /// the term level).
/// All arguments borrowed; returns owned CVal. /// All arguments borrowed; returns owned CVal.
pub fn vcomp_at_term( pub fn vcomp_at_term(
l: LeanObj,
env: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj, env: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj,
u: LeanObj, t: LeanObj, u: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
@ -77,17 +83,18 @@ pub fn vcomp_at_term(
return result; 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 { if ctor_tag(phi) == FACE_BOT {
// Build the transp term. // ABI v4: TERM_TRANSP layout [i, , A, φ, t] (5 fields).
retain(i); retain(a); retain(l); retain(i); retain(a);
let bot = lean_box_mut(FACE_BOT as usize); 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, 0, i);
ctor_set_field(transp_term, 1, a); ctor_set_field(transp_term, 1, l);
ctor_set_field(transp_term, 2, bot as LeanObj); ctor_set_field(transp_term, 2, a);
ctor_set_field(transp_term, 3, bot as LeanObj);
retain(t); 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); let result = crate::eval::eval(env, transp_term as LeanObj);
release(transp_term as LeanObj); release(transp_term as LeanObj);
return result; return result;
@ -103,24 +110,28 @@ pub fn vcomp_at_term(
let tube_val = crate::eval::eval(env, plam_u as LeanObj); let tube_val = crate::eval::eval(env, plam_u as LeanObj);
release(plam_u as LeanObj); release(plam_u as LeanObj);
let base_val = crate::eval::eval(env, t); 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 { if ctor_tag(a) == TY_PI {
let dom_a = ctor_field(a, 0); let ld = ctor_field(a, 0);
let cod_a = ctor_field(a, 1); 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(env); retain(i);
retain(dom_a); retain(cod_a); retain(phi); retain(dom_a); retain(cod_a); retain(phi);
retain(u); retain(t); 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 u_val = crate::eval::eval(env, u);
let t_val = crate::eval::eval(env, t); let t_val = crate::eval::eval(env, t);
retain(i); retain(a); retain(phi); retain(l); retain(i); retain(a); retain(phi);
let ncomp = mk_ncomp(i, a, phi, u_val as LeanObj, t_val as LeanObj); let ncomp = mk_ncomp(l, i, a, phi, u_val as LeanObj, t_val as LeanObj);
mk_vneu(ncomp as LeanObj) mk_vneu(ncomp as LeanObj)
} }
@ -215,6 +226,7 @@ fn eval_clauses_rec(env: LeanObj, cur: LeanObj) -> LeanObjMut {
/// Multi-clause heterogeneous composition. /// Multi-clause heterogeneous composition.
pub fn vcompn_at_term( pub fn vcompn_at_term(
l: LeanObj,
env: LeanObj, i: LeanObj, a: LeanObj, env: LeanObj, i: LeanObj, a: LeanObj,
clauses: LeanObj, t: LeanObj, clauses: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
@ -233,16 +245,18 @@ pub fn vcompn_at_term(
match len { match len {
0 => { 0 => {
// No clauses — plain transport of base. // No clauses — plain transport of base via .transp i {} A .bot t.
release(live as LeanObj); release(live as LeanObj);
retain(i); retain(a); retain(l); retain(i); retain(a);
let bot = lean_box_mut(FACE_BOT as usize); 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, 0, i);
ctor_set_field(transp_term, 1, a); ctor_set_field(transp_term, 1, l);
ctor_set_field(transp_term, 2, bot as LeanObj); ctor_set_field(transp_term, 2, a);
ctor_set_field(transp_term, 3, bot as LeanObj);
retain(t); 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); let result = crate::eval::eval(env, transp_term as LeanObj);
release(transp_term as LeanObj); release(transp_term as LeanObj);
result result
@ -252,7 +266,7 @@ pub fn vcompn_at_term(
let head = ctor_field(live as LeanObj, 0); let head = ctor_field(live as LeanObj, 0);
let face = ctor_field(head, 0); let face = ctor_field(head, 0);
let body = ctor_field(head, 1); 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); release(live as LeanObj);
result result
} }
@ -260,9 +274,9 @@ pub fn vcompn_at_term(
// Stuck — produce ncompN with evaluated clause bodies. // Stuck — produce ncompN with evaluated clause bodies.
let evaled_clauses = eval_clause_bodies(env, live); let evaled_clauses = eval_clause_bodies(env, live);
let t_val = crate::eval::eval(env, t); 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( 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) mk_vneu(ncompn as LeanObj)
} }
} }

View file

@ -49,6 +49,12 @@ pub(crate) fn face_absent(i: LeanObj, phi: LeanObj) -> bool {
} }
/// True iff DimVar `i` does not appear in CTerm `t`. /// 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 { pub(crate) fn cterm_absent(i: LeanObj, t: LeanObj) -> bool {
match ctor_tag(t) { match ctor_tag(t) {
TERM_VAR => true, 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) cterm_absent(i, inner) && dim_expr_absent(i, r)
} }
TERM_TRANSP => { TERM_TRANSP => {
// Lean approximation: `.transp j A φ t` — A is ignored. // Lean approximation: A is ignored. Layout: [i, , A, φ, t].
let phi = ctor_field(t, 2); let phi = ctor_field(t, 3);
let body = ctor_field(t, 3); let body = ctor_field(t, 4);
face_absent(i, phi) && cterm_absent(i, body) face_absent(i, phi) && cterm_absent(i, body)
} }
TERM_COMP => { TERM_COMP => {
let phi = ctor_field(t, 2); // Layout: [i, , A, φ, u, t].
let u = ctor_field(t, 3); let phi = ctor_field(t, 3);
let body = ctor_field(t, 4); let u = ctor_field(t, 4);
let body = ctor_field(t, 5);
face_absent(i, phi) && cterm_absent(i, u) && cterm_absent(i, body) face_absent(i, phi) && cterm_absent(i, u) && cterm_absent(i, body)
} }
TERM_COMPN => { TERM_COMPN => {
let clauses = ctor_field(t, 2); // Layout: [i, , A, clauses, t].
let body = ctor_field(t, 3); let clauses = ctor_field(t, 3);
let body = ctor_field(t, 4);
cterm_absent_clauses(i, clauses) && cterm_absent(i, body) cterm_absent_clauses(i, clauses) && cterm_absent(i, body)
} }
TERM_GLUEIN => { TERM_GLUEIN => {
@ -113,6 +121,25 @@ pub(crate) fn cterm_absent(i: LeanObj, t: LeanObj) -> bool {
let inner = ctor_field(t, 0); let inner = ctor_field(t, 0);
cterm_absent(i, inner) cterm_absent(i, inner)
} }
// ABI v5: universe-code encoder. Same approximation as
// transp/comp — A (the CType payload) is not recursed into.
TERM_CODE => true,
// ABI v7: unified modal introduction — dim-absence preserved
// through the wrapper. Layout: [k, a]. The kind field is a
// ModalityKind (no dim binders inside). Mirrors Lean's
// CTerm.dimAbsent arm for `.modalIntro k a`.
TERM_MODAL_INTRO => {
let a = ctor_field(t, 1);
cterm_absent(i, a)
}
// ABI v7: unified modal elimination — check both the
// eliminator and the scrutinee. Layout: [k, f, m]. Mirrors
// Lean's CTerm.dimAbsent arm for `.modalElim k f m`.
TERM_MODAL_ELIM => {
let f = ctor_field(t, 1);
let m = ctor_field(t, 2);
cterm_absent(i, f) && cterm_absent(i, m)
}
_ => true, _ => true,
} }
} }
@ -140,39 +167,102 @@ fn cterm_absent_clauses(i: LeanObj, clauses: LeanObj) -> bool {
} }
/// True iff DimVar `i` does not appear in CType `A`. /// 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 { pub(crate) fn ctype_absent(i: LeanObj, a: LeanObj) -> bool {
match ctor_tag(a) { match ctor_tag(a) {
TY_UNIV => true, TY_UNIV => true, // [] alone — no dim binders inside.
TY_PI => { TY_PI => {
let x = ctor_field(a, 0); // Layout: [, ', var, A, B].
let y = ctor_field(a, 1); let x = ctor_field(a, 3);
let y = ctor_field(a, 4);
ctype_absent(i, x) && ctype_absent(i, y) ctype_absent(i, x) && ctype_absent(i, y)
} }
TY_PATH => { TY_PATH => {
let ty = ctor_field(a, 0); // Layout: [, A, a, b].
let x = ctor_field(a, 1); let ty = ctor_field(a, 1);
let y = ctor_field(a, 2); let x = ctor_field(a, 2);
let y = ctor_field(a, 3);
ctype_absent(i, ty) && cterm_absent(i, x) && cterm_absent(i, y) ctype_absent(i, ty) && cterm_absent(i, x) && cterm_absent(i, y)
} }
TY_SIGMA => { TY_SIGMA => {
let x = ctor_field(a, 0); // Layout: [, ', var, A, B].
let y = ctor_field(a, 1); let x = ctor_field(a, 3);
let y = ctor_field(a, 4);
ctype_absent(i, x) && ctype_absent(i, y) ctype_absent(i, x) && ctype_absent(i, y)
} }
TY_GLUE => { TY_GLUE => {
let phi = ctor_field(a, 0); // Layout: [, φ, T, f, fInv, sec, ret, coh, A].
let ty = ctor_field(a, 1); let phi = ctor_field(a, 1);
let f = ctor_field(a, 2); let ty = ctor_field(a, 2);
let finv = ctor_field(a, 3); let f = ctor_field(a, 3);
let sec = ctor_field(a, 4); let finv = ctor_field(a, 4);
let ret = ctor_field(a, 5); let sec = ctor_field(a, 5);
let coh = ctor_field(a, 6); let ret = ctor_field(a, 6);
let base = ctor_field(a, 7); let coh = ctor_field(a, 7);
let base = ctor_field(a, 8);
face_absent(i, phi) && ctype_absent(i, ty) && face_absent(i, phi) && ctype_absent(i, ty) &&
cterm_absent(i, f) && cterm_absent(i, finv) && cterm_absent(i, f) && cterm_absent(i, finv) &&
cterm_absent(i, sec) && cterm_absent(i, ret) && cterm_absent(i, sec) && cterm_absent(i, ret) &&
cterm_absent(i, coh) && ctype_absent(i, base) cterm_absent(i, coh) && ctype_absent(i, base)
} }
// Layout: [, S, params]; params is `List (Σ ' : ULevel, CType ')`.
TY_IND => {
let params = ctor_field(a, 2);
ctype_sigma_list_absent(i, params)
}
// 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)
}
// ABI v5: universe-code decoder `El P`. Layout: [, P].
// Recurse into the encoded CTerm payload `P`.
TY_EL => {
let p = ctor_field(a, 1);
cterm_absent(i, p)
}
// ABI v7: unified cohesive-modality former — recurse into the
// wrapped CType. Layout: [, k, A]. The ModalityKind field
// (index 1) carries no dim binders. Mirrors Lean
// CType.dimAbsent arm for `.modal k A`.
TY_MODAL => {
let inner = ctor_field(a, 2);
ctype_absent(i, inner)
}
_ => true, _ => true,
} }
} }
/// 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);
// 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);
}
_ => return true,
}
}
}

View file

@ -106,11 +106,13 @@ pub fn eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
vsnd(vinner) vsnd(vinner)
} }
TERM_TRANSP => { 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 i = ctor_field(t, 0);
let a = ctor_field(t, 1); let l = ctor_field(t, 1);
let phi = ctor_field(t, 2); let a = ctor_field(t, 2);
let body = ctor_field(t, 3); let phi = ctor_field(t, 3);
let body = ctor_field(t, 4);
// (1) φ = .top → eval env body (T1). // (1) φ = .top → eval env body (T1).
if ctor_tag(phi) == FACE_TOP { if ctor_tag(phi) == FACE_TOP {
@ -121,14 +123,16 @@ pub fn eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
return eval(env, body); return eval(env, body);
} }
// (3) A = .path A₀ a b → .vPathTransp closure. // (3) A = .path A₀ a b → .vPathTransp closure.
// ABI v4: path is [, A₀, a, b].
if ctor_tag(a) == TY_PATH { if ctor_tag(a) == TY_PATH {
let a0 = ctor_field(a, 0); let a_l = ctor_field(a, 0);
let ea = ctor_field(a, 1); let a0 = ctor_field(a, 1);
let eb = ctor_field(a, 2); let ea = ctor_field(a, 2);
retain(env); retain(i); retain(a0); let eb = ctor_field(a, 3);
retain(env); retain(i); retain(a_l); retain(a0);
retain(ea); retain(eb); retain(phi); retain(body); retain(ea); retain(eb); retain(phi); retain(body);
return crate::value::mk_vpathtransp( 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. // (4) A = .glue → delegate to the 9-axiom face dispatch.
if ctor_tag(a) == TY_GLUE { if ctor_tag(a) == TY_GLUE {
@ -136,24 +140,28 @@ pub fn eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
} }
// (5) Delegate to value-level vTransp. // (5) Delegate to value-level vTransp.
let vt = eval(env, body); let vt = eval(env, body);
crate::transport::vtransp(i, a, phi, vt) crate::transport::vtransp(l, i, a, phi, vt)
} }
TERM_COMP => { 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 i = ctor_field(t, 0);
let a = ctor_field(t, 1); let l = ctor_field(t, 1);
let phi = ctor_field(t, 2); let a = ctor_field(t, 2);
let u = ctor_field(t, 3); let phi = ctor_field(t, 3);
let base = ctor_field(t, 4); let u = ctor_field(t, 4);
crate::composition::vcomp_at_term(env, i, a, phi, u, base) let base = ctor_field(t, 5);
crate::composition::vcomp_at_term(l, env, i, a, phi, u, base)
} }
TERM_COMPN => { 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 i = ctor_field(t, 0);
let a = ctor_field(t, 1); let l = ctor_field(t, 1);
let clauses = ctor_field(t, 2); let a = ctor_field(t, 2);
let base = ctor_field(t, 3); let clauses = ctor_field(t, 3);
crate::composition::vcompn_at_term(env, i, a, clauses, base) let base = ctor_field(t, 4);
crate::composition::vcompn_at_term(l, env, i, a, clauses, base)
} }
TERM_GLUEIN => { TERM_GLUEIN => {
// .glueIn φ t a — face-priority dispatch. // .glueIn φ t a — face-priority dispatch.
@ -222,6 +230,86 @@ pub fn eval(env: LeanObj, t: LeanObj) -> LeanObjMut {
let args_val = eval_term_list(env, args_term); let args_val = eval_term_list(env, args_term);
mk_vctor(schema, name, params, args_val as LeanObj) mk_vctor(schema, name, params, args_val as LeanObj)
} }
TERM_CODE => {
// .code {} A — ABI v5 universe-code encoder.
// Layout: [, A] (2 fields). Evaluation lifts to .vcode.
let l = ctor_field(t, 0);
let a = ctor_field(t, 1);
retain(l); retain(a);
mk_vcode(l, a)
}
TERM_MODAL_INTRO => {
// .modalIntro k a — ABI v7: unified η-intro for the cohesive
// triple. Layout: [k, a] (2 fields, no implicit — the
// ULevel lives on the surrounding CType.modal, not here).
// eval env (.modalIntro k a) = .vModalIntro k (eval env a)
// Mirror of Cubical/Eval.lean axiom eval_modalIntro.
let k = ctor_field(t, 0);
let a = ctor_field(t, 1);
retain(k);
let va = eval(env, a);
mk_vmodal_intro(k, va as LeanObj)
}
TERM_MODAL_ELIM => {
// .modalElim k f m — ABI v7: unified modal eliminator.
// Layout: [k, f, m] (3 fields).
// eval env (.modalElim k f m) =
// match eval env m with
// | .vModalIntro k' a →
// if k = k' then vApp (eval env f) a (β-rule)
// else marker "<modalElim: kind mismatch>"
// | .vneu n → .vneu (.nModalElim k (eval env f) n)
// | _ → marker "<modalElim: scrutinee is not modal-canonical>"
// Mirror of Cubical/Eval.lean's `eval (.modalElim k f m)` arm
// and the engine-layer axioms eval_modalElim_beta /
// eval_modalElim_stuck.
let k = ctor_field(t, 0);
let f = ctor_field(t, 1);
let m = ctor_field(t, 2);
let vm = eval(env, m);
let vm_ro = vm as LeanObj;
match ctor_tag(vm_ro) {
VAL_VMODAL_INTRO => {
// Inspect the intro-value's kind (field 0) and
// compare against the eliminator's expected kind
// (field 0 of the .modalElim term). Both are
// `ModalityKind` objects; their constructor index
// (read via ctor_tag) is the discriminant.
let k_intro = ctor_field(vm_ro, 0);
if ctor_tag(k) == ctor_tag(k_intro) {
// β-reduce on matching kind.
let inner = ctor_field(vm_ro, 1);
retain(inner);
release(vm_ro);
let vf = eval(env, f);
vapp(vf, inner as LeanObjMut)
} else {
// Kind mismatch — preserved as a marker neutral
// matching Lean's `<modalElim: kind mismatch>`.
// A well-typed source cannot produce this shape;
// a bypassed typechecker conceivably could.
release(vm_ro);
stuck_marker(b"<modalElim: kind mismatch>\0")
}
}
VAL_VNEU => {
// Stuck: extract inner CNeu; build .nModalElim
// preserving the kind, the evaluated eliminator,
// and the stuck scrutinee neutral.
let inner_neu = ctor_field(vm_ro, 0);
retain(inner_neu);
release(vm_ro);
retain(k);
let vf = eval(env, f);
let nelim = mk_nmodal_elim(k, vf as LeanObj, inner_neu);
mk_vneu(nelim as LeanObj)
}
_ => {
release(vm_ro);
stuck_marker(b"<modalElim: scrutinee is not modal-canonical>\0")
}
}
}
TERM_INDELIM => { TERM_INDELIM => {
// .indElim S params motive branches target — β-reduce on a // .indElim S params motive branches target — β-reduce on a
// canonical vctor target; otherwise build .nIndElim stuck. // canonical vctor target; otherwise build .nIndElim stuck.
@ -386,8 +474,14 @@ pub fn vapp(f: LeanObjMut, a: LeanObjMut) -> LeanObjMut {
release(f_ro); release(f_ro);
result result
} }
VAL_VPLAM | VAL_VTUBEAPP | VAL_VPATHTRANSP | VAL_VPAIR => { VAL_VPLAM | VAL_VTUBEAPP | VAL_VPATHTRANSP | VAL_VPAIR | VAL_VCODE
| VAL_VMODAL_INTRO => {
// Ill-typed application; marker neutral per FFI_DESIGN §6. // Ill-typed application; marker neutral per FFI_DESIGN §6.
// ABI v7: the unified .vModalIntro is not a function either
// — mirror Lean `eval`'s explicit arm for `vModalIntro _ _`
// applied as a function (returns `<vApp: vModalIntro applied
// as function>` in the Lean source; we coalesce all
// non-function applications into one marker for FFI brevity).
release(f_ro); release(f_ro);
release(a as LeanObj); release(a as LeanObj);
stuck_marker(b"<vApp: non-function value applied>\0") stuck_marker(b"<vApp: non-function value applied>\0")

View file

@ -1,7 +1,7 @@
//! # ffi //! # ffi
//! //!
//! `#[no_mangle] pub extern "C"` exports for every `topolei_cubical_*` //! `#[no_mangle] pub extern "C"` exports for every `cubical_transport_*`
//! symbol declared in `Topolei/Cubical/FFI.lean`. //! symbol declared in `CubicalTransport/FFI.lean`.
//! //!
//! ## Phase A: stubs //! ## Phase A: stubs
//! //!
@ -14,7 +14,7 @@
//! //!
//! ## Why even stubs? //! ## 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 //! `FFI.lean` register the symbol names with Lean's linker. When the
//! Rust staticlib is linked into a Lean executable, the linker //! Rust staticlib is linked into a Lean executable, the linker
//! resolves these symbols to our stubs. Without stubs, linking //! resolves these symbols to our stubs. Without stubs, linking
@ -73,12 +73,12 @@ fn face_bot() -> LeanObjMut {
// ── Exports: evaluator (Phase B implemented) ─────────────────────────────── // ── Exports: evaluator (Phase B implemented) ───────────────────────────────
#[no_mangle] #[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) crate::eval::eval(env, t)
} }
#[no_mangle] #[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. // 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 both before forwarding so the caller's refcounts are preserved.
retain(f); retain(f);
@ -87,52 +87,68 @@ pub extern "C" fn topolei_cubical_vapp(f: LeanObj, a: LeanObj) -> LeanObjMut {
} }
#[no_mangle] #[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(v);
retain(r); retain(r);
crate::eval::vpapp(v as LeanObjMut, 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] #[no_mangle]
pub extern "C" fn topolei_cubical_vtransp( pub extern "C" fn cubical_transport_vtransp(
i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObj, l: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
retain(v); retain(v);
crate::transport::vtransp(i, a, phi, v as LeanObjMut) crate::transport::vtransp(l, i, a, phi, v as LeanObjMut)
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn topolei_cubical_vhcomp( pub extern "C" fn cubical_transport_vhcomp(
a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
retain(tube); retain(base); 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] #[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, env: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj,
u: LeanObj, t: LeanObj, u: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> 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] #[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, env: LeanObj, i: LeanObj, a: LeanObj,
clauses: LeanObj, t: LeanObj, clauses: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
crate::composition::vcompn_at_term(env, i, a, clauses, t) crate::composition::vcompn_at_term(l, env, i, a, clauses, t)
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn topolei_cubical_vfst(v: LeanObj) -> LeanObjMut { pub extern "C" fn cubical_transport_vfst(v: LeanObj) -> LeanObjMut {
retain(v); retain(v);
crate::eval::vfst(v as LeanObjMut) crate::eval::vfst(v as LeanObjMut)
} }
#[no_mangle] #[no_mangle]
pub extern "C" fn topolei_cubical_vsnd(v: LeanObj) -> LeanObjMut { pub extern "C" fn cubical_transport_vsnd(v: LeanObj) -> LeanObjMut {
retain(v); retain(v);
crate::eval::vsnd(v as LeanObjMut) 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) ────────────────────────────── // ── Exports: readback (Phase B.6 implemented) ──────────────────────────────
#[no_mangle] #[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) crate::readback::readback(v)
} }
#[no_mangle] #[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) crate::readback::readback_neu(n)
} }
// ── Exports: step ────────────────────────────────────────────────────────── // ── Exports: step ──────────────────────────────────────────────────────────
#[no_mangle] #[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. // FFI_DESIGN §8 Option B: step = readback ∘ eval .nil.
crate::readback::step(t) crate::readback::step(t)
} }
@ -162,11 +178,11 @@ pub extern "C" fn topolei_cubical_step(t: LeanObj) -> LeanObjMut {
// ── Real Phase B implementation: normalizers ─────────────────────────────── // ── Real Phase B implementation: normalizers ───────────────────────────────
#[no_mangle] #[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) crate::dim_expr::normalize(r)
} }
#[no_mangle] #[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) crate::face::normalize(phi)
} }

View file

@ -21,9 +21,9 @@ const LIST_CONS: u32 = 1;
const PROD_MK: u32 = 0; const PROD_MK: u32 = 0;
/// Construct the A-side witness for the constant-A case: /// 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( fn build_const_aside(
i: LeanObj, a: LeanObj, psi: LeanObj, i: LeanObj, l: LeanObj, a: LeanObj, psi: LeanObj,
phi: LeanObj, f: LeanObj, t: LeanObj, phi: LeanObj, f: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
// φ.substDim i .zero // φ.substDim i .zero
@ -37,20 +37,21 @@ fn build_const_aside(
ctor_set_field(unglue, 1, f); ctor_set_field(unglue, 1, f);
ctor_set_field(unglue, 2, t); ctor_set_field(unglue, 2, t);
// .transp i A ψ (.unglue …) // .transp i {} A ψ (.unglue …) — ABI v4: 5 fields [i, , A, ψ, body].
retain(i); retain(a); retain(psi); retain(i); retain(l); retain(a); retain(psi);
let transp = alloc_ctor(TERM_TRANSP, 4); let transp = alloc_ctor(TERM_TRANSP, 5);
ctor_set_field(transp, 0, i); ctor_set_field(transp, 0, i);
ctor_set_field(transp, 1, a); ctor_set_field(transp, 1, l);
ctor_set_field(transp, 2, psi); ctor_set_field(transp, 2, a);
ctor_set_field(transp, 3, unglue as LeanObj); ctor_set_field(transp, 3, psi);
ctor_set_field(transp, 4, unglue as LeanObj);
transp transp
} }
/// Construct the A-side witness for the varying-A case: /// 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( fn build_vara_aside(
i: LeanObj, a: LeanObj, psi: LeanObj, i: LeanObj, l: LeanObj, a: LeanObj, psi: LeanObj,
phi: LeanObj, f: LeanObj, t: LeanObj, phi: LeanObj, f: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
// Clause 1: (ψ, .unglue φ f t) // 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, 1, f);
ctor_set_field(unglue_base, 2, t); ctor_set_field(unglue_base, 2, t);
// .compN i A clauses base // .compN i {} A clauses base — ABI v4: 5 fields [i, , A, clauses, t].
retain(i); retain(a); retain(i); retain(l); retain(a);
let compn = alloc_ctor(TERM_COMPN, 4); let compn = alloc_ctor(TERM_COMPN, 5);
ctor_set_field(compn, 0, i); ctor_set_field(compn, 0, i);
ctor_set_field(compn, 1, a); ctor_set_field(compn, 1, l);
ctor_set_field(compn, 2, cons1 as LeanObj); ctor_set_field(compn, 2, a);
ctor_set_field(compn, 3, unglue_base as LeanObj); ctor_set_field(compn, 3, cons1 as LeanObj);
ctor_set_field(compn, 4, unglue_base as LeanObj);
compn compn
} }
@ -122,15 +124,15 @@ fn equiv_varies_in_i(
} }
/// Produce a structured stuck `ntransp` neutral for the glue-transport /// 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( fn stuck_neutral(
env: LeanObj, i: LeanObj, glue_ty: LeanObj, env: LeanObj, i: LeanObj, l: LeanObj, glue_ty: LeanObj,
psi: LeanObj, t: LeanObj, psi: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let t_val = crate::eval::eval(env, t); 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( 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) crate::value::mk_vneu(ntransp as LeanObj)
} }
@ -148,19 +150,21 @@ pub fn eval_transp_glue(
env: LeanObj, i: LeanObj, glue_ty: LeanObj, env: LeanObj, i: LeanObj, glue_ty: LeanObj,
psi: LeanObj, t: LeanObj, psi: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
// Unpack the .glue fields. // Unpack the .glue fields. ABI v4: glue layout is
let phi = ctor_field(glue_ty, 0); // [, φ, T, f, fInv, sec, ret, coh, A] (9 fields).
let _ty = ctor_field(glue_ty, 1); // T (fiber type) — used only for dim-absence let l = ctor_field(glue_ty, 0);
let f = ctor_field(glue_ty, 2); let phi = ctor_field(glue_ty, 1);
let finv = ctor_field(glue_ty, 3); let _ty = ctor_field(glue_ty, 2); // T (fiber type) — only for dim-absence
let sec = ctor_field(glue_ty, 4); let f = ctor_field(glue_ty, 3);
let ret = ctor_field(glue_ty, 5); let finv = ctor_field(glue_ty, 4);
let coh = ctor_field(glue_ty, 6); let sec = ctor_field(glue_ty, 5);
let a_ty = ctor_field(glue_ty, 7); 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). // (1) Varying equivalence → stuck (matches `_varEquiv` axiom).
if equiv_varies_in_i(i, f, finv, sec, ret, coh) { 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. // (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. // (4) Face-disjoint dispatch.
match (phi1_tag, a_is_const) { match (phi1_tag, a_is_const) {
(FACE_BOT, true) => { (FACE_BOT, true) => {
// _const_at_bot: eval (.transp i A ψ (.unglue (φ[i:=0]) f t)) let aside = build_const_aside(i, l, a_ty, psi, phi, f, t);
let aside = build_const_aside(i, a_ty, psi, phi, f, t);
let result = crate::eval::eval(env, aside as LeanObj); let result = crate::eval::eval(env, aside as LeanObj);
release(aside as LeanObj); release(aside as LeanObj);
result result
} }
(FACE_TOP, true) => { (FACE_TOP, true) => {
// _const_at_top: eval (.app fInv (.transp i A ψ (.unglue …))) let aside = build_const_aside(i, l, a_ty, psi, phi, f, t);
let aside = build_const_aside(i, a_ty, psi, phi, f, t);
let wrapped = wrap_with_finv(aside, finv); let wrapped = wrap_with_finv(aside, finv);
let result = crate::eval::eval(env, wrapped as LeanObj); let result = crate::eval::eval(env, wrapped as LeanObj);
release(wrapped as LeanObj); release(wrapped as LeanObj);
result result
} }
(FACE_BOT, false) => { (FACE_BOT, false) => {
// _varA_at_bot: eval (.compN i A [...] (.unglue (φ[i:=0]) f t)) let aside = build_vara_aside(i, l, a_ty, psi, phi, f, t);
let aside = build_vara_aside(i, a_ty, psi, phi, f, t);
let result = crate::eval::eval(env, aside as LeanObj); let result = crate::eval::eval(env, aside as LeanObj);
release(aside as LeanObj); release(aside as LeanObj);
result result
} }
(FACE_TOP, false) => { (FACE_TOP, false) => {
// _varA_at_top: eval (.app fInv (.compN …)) let aside = build_vara_aside(i, l, a_ty, psi, phi, f, t);
let aside = build_vara_aside(i, a_ty, psi, phi, f, t);
let wrapped = wrap_with_finv(aside, finv); let wrapped = wrap_with_finv(aside, finv);
let result = crate::eval::eval(env, wrapped as LeanObj); let result = crate::eval::eval(env, wrapped as LeanObj);
release(wrapped as LeanObj); release(wrapped as LeanObj);
@ -208,7 +208,7 @@ pub fn eval_transp_glue(
} }
_ => { _ => {
// _const_stuck or _varA_stuck. // _const_stuck or _varA_stuck.
stuck_neutral(env, i, glue_ty, psi, t) stuck_neutral(env, i, l, glue_ty, psi, t)
} }
} }
} }

View file

@ -33,7 +33,7 @@ pub type LeanObjMut = *mut core::ffi::c_void;
// //
// Most of Lean 4's object-manipulation primitives are `static inline` in // 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 // `<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. // These names link cleanly; the shim should inline to zero overhead.
// //
// For wasm targets, `build.rs` skips shim compilation; these symbols are // 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). // the Lean-wasm composite artifact).
unsafe extern "C" { unsafe extern "C" {
pub fn topolei_shim_inc(o: LeanObj); pub fn cubical_transport_shim_inc(o: LeanObj);
pub fn topolei_shim_dec(o: LeanObj); pub fn cubical_transport_shim_dec(o: LeanObj);
pub fn topolei_shim_obj_tag(o: LeanObj) -> u32; pub fn cubical_transport_shim_obj_tag(o: LeanObj) -> u32;
pub fn topolei_shim_ctor_get(o: LeanObj, idx: u32) -> LeanObj; pub fn cubical_transport_shim_ctor_get(o: LeanObj, idx: u32) -> LeanObj;
pub fn topolei_shim_ctor_set(o: LeanObjMut, idx: u32, val: LeanObj); pub fn cubical_transport_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 cubical_transport_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 cubical_transport_shim_string_cstr(s: LeanObj) -> *const c_char;
pub fn topolei_shim_mk_string(s: *const c_char) -> LeanObjMut; pub fn cubical_transport_shim_mk_string(s: *const c_char) -> LeanObjMut;
pub fn topolei_shim_string_eq(a: LeanObj, b: LeanObj) -> bool; pub fn cubical_transport_shim_string_eq(a: LeanObj, b: LeanObj) -> bool;
} }
// Aliases to keep call sites readable. The `lean_*` names in existing // Aliases to keep call sites readable. The `lean_*` names in existing
// code point at the shim wrappers; inlining reduces this to zero cost. // code point at the shim wrappers; inlining reduces this to zero cost.
#[inline(always)] #[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)] #[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)] #[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)] #[inline(always)]
pub unsafe fn lean_ctor_get(o: LeanObj, idx: u32) -> LeanObj { 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)] #[inline(always)]
pub unsafe fn lean_ctor_set(o: LeanObjMut, idx: u32, val: LeanObj) { 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)] #[inline(always)]
pub unsafe fn lean_alloc_ctor(tag: u32, num_objs: u32, scalar_bytes: u32) -> LeanObjMut { 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)] #[inline(always)]
pub unsafe fn lean_string_cstr(s: LeanObj) -> *const c_char { 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)] #[inline(always)]
pub unsafe fn lean_mk_string(s: *const c_char) -> LeanObjMut { 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)] #[inline(always)]
pub unsafe fn lean_string_eq(a: LeanObj, b: LeanObj) -> bool { 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) ──────────────────────── // ── 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) } unsafe { lean_ctor_get(o, idx) }
} }
/// Allocate a new constructor with the given tag and number of object /// Allocate a new constructor with the given tag and number of object
/// fields. Callers must `ctor_set_field` each slot before returning. /// fields. Callers must `ctor_set_field` each slot before returning.
#[inline] #[inline]

View file

@ -1,4 +1,4 @@
//! # topolei-cubical //! # cubical-transport
//! //!
//! Rust backend for Lean 4's cubical-transport HoTT evaluator. //! Rust backend for Lean 4's cubical-transport HoTT evaluator.
//! //!
@ -7,8 +7,8 @@
//! //!
//! ## Architecture //! ## Architecture
//! //!
//! This crate implements the `topolei_cubical_*` C symbols declared //! This crate implements the `cubical_transport_*` C symbols declared
//! in `Topolei/Cubical/FFI.lean`. Every function takes borrowed //! in `CubicalTransport/FFI.lean`. Every function takes borrowed
//! `lean_object*` arguments and returns an owned `lean_object*` //! `lean_object*` arguments and returns an owned `lean_object*`
//! result — see `FFI_DESIGN.md` for the full ABI contract. //! result — see `FFI_DESIGN.md` for the full ABI contract.
//! //!

View file

@ -110,44 +110,52 @@ pub(crate) fn mk_term_papp(t: LeanObj, r: LeanObj) -> LeanObjMut {
ctor 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] #[inline]
pub(crate) fn mk_term_transp(i: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj) -> LeanObjMut { pub(crate) fn mk_term_transp(
retain(i); retain(a); i: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj,
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,
) -> LeanObjMut { ) -> LeanObjMut {
retain(i); retain(a); retain(i); retain(l); retain(a);
let ctor = alloc_ctor(TERM_COMP, 5); let ctor = alloc_ctor(TERM_TRANSP, 5);
ctor_set_field(ctor, 0, i); ctor_set_field(ctor, 0, i);
ctor_set_field(ctor, 1, a); ctor_set_field(ctor, 1, l);
ctor_set_field(ctor, 2, phi); ctor_set_field(ctor, 2, a);
ctor_set_field(ctor, 3, u); ctor_set_field(ctor, 3, phi);
ctor_set_field(ctor, 4, t); ctor_set_field(ctor, 4, t);
ctor 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] #[inline]
pub(crate) fn mk_term_compn( 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 { ) -> LeanObjMut {
retain(i); retain(a); retain(i); retain(l); retain(a);
let ctor = alloc_ctor(TERM_COMPN, 4); let ctor = alloc_ctor(TERM_COMPN, 5);
ctor_set_field(ctor, 0, i); ctor_set_field(ctor, 0, i);
ctor_set_field(ctor, 1, a); ctor_set_field(ctor, 1, l);
ctor_set_field(ctor, 2, clauses); ctor_set_field(ctor, 2, a);
ctor_set_field(ctor, 3, t); ctor_set_field(ctor, 3, clauses);
ctor_set_field(ctor, 4, t);
ctor ctor
} }
@ -232,26 +240,41 @@ pub(crate) fn mk_term_indelim(
ctor ctor
} }
/// CType `.univ` — nullary scalar. /// `ULevel.zero` — nullary scalar (constructor index 0). ABI v4 helper.
#[inline] #[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] #[inline]
pub(crate) fn mk_ty_pi(a: LeanObj, b: LeanObj) -> LeanObjMut { pub(crate) fn mk_ty_univ(l: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TY_PI, 2); let ctor = alloc_ctor(TY_UNIV, 1);
ctor_set_field(ctor, 0, a); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, b);
ctor 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] #[inline]
pub(crate) fn mk_ty_path(a: LeanObj, x: LeanObj, y: LeanObj) -> LeanObjMut { pub(crate) fn mk_ty_pi(
let ctor = alloc_ctor(TY_PATH, 3); ld: LeanObj, lc: LeanObj, var: LeanObj, a: LeanObj, b: LeanObj,
ctor_set_field(ctor, 0, a); ) -> LeanObjMut {
ctor_set_field(ctor, 1, x); let ctor = alloc_ctor(TY_PI, 5);
ctor_set_field(ctor, 2, y); 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 ctor
} }
@ -356,60 +379,81 @@ pub fn readback(v: LeanObj) -> LeanObjMut {
mk_term_plam(i, body_term as LeanObj) mk_term_plam(i, body_term as LeanObj)
} }
VAL_VTRANSPFUN => { VAL_VTRANSPFUN => {
// .vTranspFun i domA codA φ f → .transp i (.pi domA codA) φ (readback f). // .vTranspFun {_d _c} i domA codA φ f → .transp i {_pi} (.pi "_" domA codA) φ (readback f).
let i = ctor_field(v, 0); // ABI v4 vTranspFun layout: [_d, _c, i, domA, codA, φ, f] (7 fields).
let dom_a = ctor_field(v, 1); let ld = ctor_field(v, 0);
let cod_a = ctor_field(v, 2); let lc = ctor_field(v, 1);
let phi = ctor_field(v, 3); let i = ctor_field(v, 2);
let f = ctor_field(v, 4); let dom_a = ctor_field(v, 3);
retain(dom_a); retain(cod_a); retain(phi); let cod_a = ctor_field(v, 4);
let pi_ty = mk_ty_pi(dom_a, cod_a); 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); let f_term = readback(f);
// pi_ty is freshly owned; mk_term_transp retains its `a` slot, // The pi-line lives at max(_d, _c); for readback we only need
// so our external `+1` on pi_ty must be released after the // *some* matching level — re-use _c as a representative (it's
// ctor stores its own retained reference. // the codomain level which is what transp reduces over). This
let result = mk_term_transp(i, pi_ty as LeanObj, phi, f_term as LeanObj); // 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); release(pi_ty as LeanObj);
result result
} }
VAL_VCOMPFUN => { VAL_VCOMPFUN => {
// .vCompFun env i domA codA φ u t → .comp i (.pi domA codA) φ u t. // .vCompFun {_d _c} env i domA codA φ u t → .comp i (.pi "_" domA codA) φ u t.
let i = ctor_field(v, 1); // ABI v4 vCompFun layout: [_d, _c, env, i, domA, codA, φ, u, t] (9 fields).
let dom_a = ctor_field(v, 2); let ld = ctor_field(v, 0);
let cod_a = ctor_field(v, 3); let lc = ctor_field(v, 1);
let phi = ctor_field(v, 4); let i = ctor_field(v, 3);
let u = ctor_field(v, 5); let dom_a = ctor_field(v, 4);
let t = ctor_field(v, 6); 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); retain(dom_a); retain(cod_a); retain(phi); retain(u); retain(t);
let pi_ty = mk_ty_pi(dom_a, cod_a); let var = alloc_static_string(b"_\0");
// pi_ty fresh → release after mk_term_comp's retain. let pi_ty = mk_ty_pi(ld, lc, var as LeanObj, dom_a, cod_a);
let result = mk_term_comp(i, pi_ty as LeanObj, phi, u, t); 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); release(pi_ty as LeanObj);
result result
} }
VAL_VHCOMPFUN => { VAL_VHCOMPFUN => {
// .vHCompFun codA φ tube base → .comp $rd_hcomp (.pi .univ codA) φ (readback tube) (readback base). // .vHCompFun {} codA φ tube base — ABI v4 layout [, codA, φ, tube, base] (5 fields).
let cod_a = ctor_field(v, 0); let l = ctor_field(v, 0);
let phi = ctor_field(v, 1); let cod_a = ctor_field(v, 1);
let tube = ctor_field(v, 2); let phi = ctor_field(v, 2);
let base = ctor_field(v, 3); let tube = ctor_field(v, 3);
retain(cod_a); retain(phi); let base = ctor_field(v, 4);
retain(l); retain(cod_a); retain(phi);
let fd = mk_dimvar(b"$rd_hcomp\0"); let fd = mk_dimvar(b"$rd_hcomp\0");
let univ = mk_ty_univ(); let univ = mk_ty_univ(mk_ulevel_zero() as LeanObj);
let pi_ty = mk_ty_pi(univ as LeanObj, cod_a); 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 tube_term = readback(tube);
let base_term = readback(base); let base_term = readback(base);
// fd and pi_ty are freshly owned; mk_term_comp retains both let l_for_comp = mk_ulevel_zero();
// i and a slots, so release our external `+1`s.
let result = mk_term_comp( let result = mk_term_comp(
fd as LeanObj, fd as LeanObj,
l_for_comp as LeanObj,
pi_ty as LeanObj, pi_ty as LeanObj,
phi, phi,
tube_term as LeanObj, tube_term as LeanObj,
base_term as LeanObj, base_term as LeanObj,
); );
release(l_for_comp as LeanObj);
release(fd as LeanObj); release(fd as LeanObj);
release(pi_ty as LeanObj); release(pi_ty as LeanObj);
release(l);
result result
} }
VAL_VTUBEAPP => { VAL_VTUBEAPP => {
@ -438,13 +482,15 @@ pub fn readback(v: LeanObj) -> LeanObjMut {
result result
} }
VAL_VPATHTRANSP => { VAL_VPATHTRANSP => {
// Two-arm dispatch on inner CTerm p. // .vPathTransp {} env i A a b φ p — ABI v4 layout
let i = ctor_field(v, 1); // [, env, i, A, a, b, φ, p] (8 fields).
let a_ty = ctor_field(v, 2); let l = ctor_field(v, 0);
let a = ctor_field(v, 3); let i = ctor_field(v, 2);
let b = ctor_field(v, 4); let a_ty = ctor_field(v, 3);
let phi = ctor_field(v, 5); let a = ctor_field(v, 4);
let p = ctor_field(v, 6); let b = ctor_field(v, 5);
let phi = ctor_field(v, 6);
let p = ctor_field(v, 7);
if ctor_tag(p) == TERM_PLAM { if ctor_tag(p) == TERM_PLAM {
// .plam j body — produce CCHM-shaped compN body. // .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, 0, pair1 as LeanObj);
ctor_set_field(cons1, 1, cons2 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); retain(body);
let compn = mk_term_compn( 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) mk_term_plam(j, compn as LeanObj)
} else { } else {
// Other cases: preserve .transp i (.path A a b) φ p form. // Other cases: preserve .transp i {} (.path A a b) φ p form.
retain(a_ty); retain(a); retain(b); retain(phi); retain(p); retain(l); retain(a_ty); retain(a); retain(b); retain(phi); retain(p);
let path_ty = mk_ty_path(a_ty, a, b); let path_ty = mk_ty_path(l, a_ty, a, b);
// path_ty fresh → release after mk_term_transp's retain. // Use as the level for the outer .transp as well (the path
let result = mk_term_transp(i, path_ty as LeanObj, phi, p); // 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); release(path_ty as LeanObj);
result result
} }
@ -528,6 +576,26 @@ pub fn readback(v: LeanObj) -> LeanObjMut {
retain(r); retain(r);
mk_term_dimexpr(r) mk_term_dimexpr(r)
} }
VAL_VCODE => {
// .vcode {} A → .code {} A. ABI v5: layout [, A].
let l = ctor_field(v, 0);
let a = ctor_field(v, 1);
retain(l); retain(a);
mk_term_code(l, a)
}
// ABI v7: unified modal-introduction value. Layout: [k, v]
// (2 fields). Mirrors Cubical/Readback.lean's axiom for
// `.vModalIntro k v ↦ .modalIntro k (readback v)`.
VAL_VMODAL_INTRO => {
let k = ctor_field(v, 0);
let inner = ctor_field(v, 1);
retain(k);
let inner_term = readback(inner);
let ctor = alloc_ctor(TERM_MODAL_INTRO, 2);
ctor_set_field(ctor, 0, k);
ctor_set_field(ctor, 1, inner_term as LeanObj);
ctor
}
_ => { _ => {
// Malformed — return a marker var. // Malformed — return a marker var.
let msg = unsafe { let msg = unsafe {
@ -560,50 +628,59 @@ pub fn readback_neu(n: LeanObj) -> LeanObjMut {
mk_term_papp(inner_term as LeanObj, r) mk_term_papp(inner_term as LeanObj, r)
} }
NEU_NTRANSP => { NEU_NTRANSP => {
let i = ctor_field(n, 0); // .ntransp {} i A φ v — ABI v4 layout [, i, A, φ, v] (5 fields).
let a = ctor_field(n, 1); let l = ctor_field(n, 0);
let phi = ctor_field(n, 2); let i = ctor_field(n, 1);
let v = ctor_field(n, 3); let a = ctor_field(n, 2);
let phi = ctor_field(n, 3);
let v = ctor_field(n, 4);
retain(phi); retain(phi);
let v_term = readback(v); 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 => { NEU_NCOMP => {
let i = ctor_field(n, 0); // .ncomp {} i A φ u t — ABI v4 layout [, i, A, φ, u, t] (6 fields).
let a = ctor_field(n, 1); let l = ctor_field(n, 0);
let phi = ctor_field(n, 2); let i = ctor_field(n, 1);
let u = ctor_field(n, 3); let a = ctor_field(n, 2);
let t = ctor_field(n, 4); let phi = ctor_field(n, 3);
let u = ctor_field(n, 4);
let t = ctor_field(n, 5);
retain(phi); retain(phi);
let u_term = readback(u); let u_term = readback(u);
let t_term = readback(t); 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 => { NEU_NHCOMP => {
let a = ctor_field(n, 0); // .nhcomp {} A φ tube base — ABI v4 layout [, A, φ, tube, base] (5 fields).
let phi = ctor_field(n, 1); let l = ctor_field(n, 0);
let tube = ctor_field(n, 2); let a = ctor_field(n, 1);
let base = ctor_field(n, 3); let phi = ctor_field(n, 2);
let tube = ctor_field(n, 3);
let base = ctor_field(n, 4);
retain(a); retain(phi); retain(a); retain(phi);
let fd = mk_dimvar(b"$rd_nhcomp\0"); let fd = mk_dimvar(b"$rd_nhcomp\0");
let tube_term = readback(tube); let tube_term = readback(tube);
let base_term = readback(base); let base_term = readback(base);
// fd fresh → release after mk_term_comp's retain on the `i` slot. // fd fresh → release after mk_term_comp's retain on the `i` slot.
let result = mk_term_comp( let result = mk_term_comp(
fd as LeanObj, a, phi, fd as LeanObj, l, a, phi,
tube_term as LeanObj, base_term as LeanObj, tube_term as LeanObj, base_term as LeanObj,
); );
release(fd as LeanObj); release(fd as LeanObj);
result result
} }
NEU_NCOMPN => { NEU_NCOMPN => {
let i = ctor_field(n, 1); // .ncompN {} env i A clauses t — ABI v4 layout
let a = ctor_field(n, 2); // [, env, i, A, clauses, t] (6 fields).
let clauses = ctor_field(n, 3); let l = ctor_field(n, 0);
let t = ctor_field(n, 4); 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 clauses_term = map_readback_clauses(clauses);
let t_term = readback(t); 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 => { NEU_NGLUEIN => {
let phi = ctor_field(n, 0); let phi = ctor_field(n, 0);
@ -648,6 +725,25 @@ pub fn readback_neu(n: LeanObj) -> LeanObjMut {
mk_term_indelim(schema, params, motive_term as LeanObj, mk_term_indelim(schema, params, motive_term as LeanObj,
branches_term as LeanObj, target_term as LeanObj) branches_term as LeanObj, target_term as LeanObj)
} }
// ABI v7: unified modal-elimination stuck neutral. Layout:
// [k, f, n] — field 0 is the `ModalityKind`, field 1 is the
// evaluated eliminator function (a CVal), field 2 is the stuck
// scrutinee (a CNeu). Mirrors Cubical/Readback.lean's axiom
// for `.nModalElim k f n ↦ .modalElim k (readback f)
// (readbackNeu n)`.
NEU_NMODAL_ELIM => {
let k = ctor_field(n, 0);
let f = ctor_field(n, 1);
let inner_neu = ctor_field(n, 2);
retain(k);
let f_term = readback(f);
let inner_term = readback_neu(inner_neu);
let ctor = alloc_ctor(TERM_MODAL_ELIM, 3);
ctor_set_field(ctor, 0, k);
ctor_set_field(ctor, 1, f_term as LeanObj);
ctor_set_field(ctor, 2, inner_term as LeanObj);
ctor
}
_ => { _ => {
let msg = unsafe { let msg = unsafe {
lean_mk_string(b"<readbackNeu: unknown CNeu>\0".as_ptr() as *const core::ffi::c_char) lean_mk_string(b"<readbackNeu: unknown CNeu>\0".as_ptr() as *const core::ffi::c_char)

View file

@ -299,37 +299,50 @@ fn mk_term_papp(t: LeanObj, r: LeanObj) -> LeanObjMut {
ctor ctor
} }
/// TERM_TRANSP carries `j {} A φ t` (5 fields, ABI v4).
/// Layout: [j, , A, φ, t]. `j`, `l`, `a` are retain-slots; rest consumed.
#[inline] #[inline]
fn mk_term_transp(j: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj) -> LeanObjMut { fn mk_term_transp(j: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, t: LeanObj) -> LeanObjMut {
retain(j); retain(a); retain(j); retain(l); retain(a);
let ctor = alloc_ctor(TERM_TRANSP, 4); let ctor = alloc_ctor(TERM_TRANSP, 5);
ctor_set_field(ctor, 0, j); ctor_set_field(ctor, 0, j);
ctor_set_field(ctor, 1, a); ctor_set_field(ctor, 1, l);
ctor_set_field(ctor, 2, phi); ctor_set_field(ctor, 2, a);
ctor_set_field(ctor, 3, t); ctor_set_field(ctor, 3, phi);
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, 4, t); ctor_set_field(ctor, 4, t);
ctor ctor
} }
/// TERM_COMP carries `j {} A φ u t` (6 fields, ABI v4).
/// Layout: [j, , A, φ, u, t]. `j`, `l`, `a` are retain-slots.
#[inline] #[inline]
fn mk_term_compn(j: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj) -> LeanObjMut { fn mk_term_comp(
retain(j); retain(a); j: LeanObj, l: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
let ctor = alloc_ctor(TERM_COMPN, 4); ) -> LeanObjMut {
retain(j); retain(l); retain(a);
let ctor = alloc_ctor(TERM_COMP, 6);
ctor_set_field(ctor, 0, j); ctor_set_field(ctor, 0, j);
ctor_set_field(ctor, 1, a); ctor_set_field(ctor, 1, l);
ctor_set_field(ctor, 2, clauses); ctor_set_field(ctor, 2, a);
ctor_set_field(ctor, 3, t); 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 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) mk_term_papp(ninner as LeanObj, ns as LeanObj)
} }
TERM_TRANSP => { 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 j = ctor_field(t, 0);
let a_cty = ctor_field(t, 1); let l = ctor_field(t, 1);
let phi = ctor_field(t, 2); let a_cty = ctor_field(t, 2);
let body = ctor_field(t, 3); let phi = ctor_field(t, 3);
let body = ctor_field(t, 4);
let nphi = face_subst_dim(i, r, phi); let nphi = face_subst_dim(i, r, phi);
let nbody = cterm_subst_dim(i, r, body); 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 => { TERM_COMP => {
// .comp j {} A φ u t — ABI v4 (6 fields). Layout: [j, , A, φ, u, t].
let j = ctor_field(t, 0); let j = ctor_field(t, 0);
let a_cty = ctor_field(t, 1); let l = ctor_field(t, 1);
let phi = ctor_field(t, 2); let a_cty = ctor_field(t, 2);
let u = ctor_field(t, 3); let phi = ctor_field(t, 3);
let body = ctor_field(t, 4); let u = ctor_field(t, 4);
let body = ctor_field(t, 5);
let nphi = face_subst_dim(i, r, phi); let nphi = face_subst_dim(i, r, phi);
let nu = cterm_subst_dim(i, r, u); let nu = cterm_subst_dim(i, r, u);
let nbody = cterm_subst_dim(i, r, body); 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 => { TERM_COMPN => {
// .compN j {} A clauses t — ABI v4 (5 fields).
// Layout: [j, , A, clauses, t].
let j = ctor_field(t, 0); let j = ctor_field(t, 0);
let a_cty = ctor_field(t, 1); let l = ctor_field(t, 1);
let clauses = ctor_field(t, 2); let a_cty = ctor_field(t, 2);
let body = ctor_field(t, 3); let clauses = ctor_field(t, 3);
let body = ctor_field(t, 4);
let nclauses = cterm_subst_dim_clauses(i, r, clauses); let nclauses = cterm_subst_dim_clauses(i, r, clauses);
let nbody = cterm_subst_dim(i, r, body); 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 => { TERM_GLUEIN => {
let phi = ctor_field(t, 0); let phi = ctor_field(t, 0);
@ -526,6 +545,43 @@ pub(crate) fn cterm_subst_dim(i: LeanObj, r: LeanObj, t: LeanObj) -> LeanObjMut
ctor_set_field(ctor, 4, new_target as LeanObj); ctor_set_field(ctor, 4, new_target as LeanObj);
ctor ctor
} }
TERM_CODE => {
// ABI v5: universe-code encoder. Layout: [, A].
// Same approximation as transp/comp: the CType payload `A`
// is not recursed into. Substitution is identity.
retain(t);
t as LeanObjMut
}
// ABI v7: unified modal introduction — recurse into the wrapped
// CTerm, preserving the modality kind. Layout: [k, a] (2 fields,
// no implicit ). Mirrors Lean's CTerm.substDim arm for
// `.modalIntro k a`.
TERM_MODAL_INTRO => {
let k = ctor_field(t, 0);
let a = ctor_field(t, 1);
retain(k);
let na = cterm_subst_dim(i, r, a);
let ctor = alloc_ctor(TERM_MODAL_INTRO, 2);
ctor_set_field(ctor, 0, k);
ctor_set_field(ctor, 1, na as LeanObj);
ctor
}
// ABI v7: unified modal elimination — recurse into both subterms,
// preserving the modality kind. Layout: [k, f, m] (3 fields).
// Mirrors Lean's CTerm.substDim arm for `.modalElim k f m`.
TERM_MODAL_ELIM => {
let k = ctor_field(t, 0);
let f = ctor_field(t, 1);
let m = ctor_field(t, 2);
retain(k);
let nf = cterm_subst_dim(i, r, f);
let nm = cterm_subst_dim(i, r, m);
let ctor = alloc_ctor(TERM_MODAL_ELIM, 3);
ctor_set_field(ctor, 0, k);
ctor_set_field(ctor, 1, nf as LeanObj);
ctor_set_field(ctor, 2, nm as LeanObj);
ctor
}
_ => { _ => {
// Unknown tag — preserve identity by retaining + boxing as // Unknown tag — preserve identity by retaining + boxing as
// raw object (no malformed-CTerm corruption). // raw object (no malformed-CTerm corruption).
@ -641,91 +697,171 @@ pub(crate) fn cterm_subst_dim_bool(i: LeanObj, b: bool, t: LeanObj) -> LeanObjMu
} }
// ── CType constructor helpers ────────────────────────────────────────────── // ── 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] #[inline]
fn mk_ty_univ() -> LeanObjMut { lean_box_mut(TY_UNIV as usize) } fn mk_ty_univ(l: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TY_UNIV, 1);
#[inline] ctor_set_field(ctor, 0, l);
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);
ctor ctor
} }
/// `.pi {_d _c} var A B` — 5 fields [_d, _c, var, A, B].
#[inline] #[inline]
fn mk_ty_path(a: LeanObj, x: LeanObj, y: LeanObj) -> LeanObjMut { fn mk_ty_pi(ld: LeanObj, lc: LeanObj, var: LeanObj, a: LeanObj, b: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TY_PATH, 3); let ctor = alloc_ctor(TY_PI, 5);
ctor_set_field(ctor, 0, a); ctor_set_field(ctor, 0, ld);
ctor_set_field(ctor, 1, x); ctor_set_field(ctor, 1, lc);
ctor_set_field(ctor, 2, y); ctor_set_field(ctor, 2, var);
ctor_set_field(ctor, 3, a);
ctor_set_field(ctor, 4, b);
ctor ctor
} }
/// `.path {} A a b` — 4 fields [, A, a, b].
#[inline] #[inline]
fn mk_ty_sigma(a: LeanObj, b: LeanObj) -> LeanObjMut { fn mk_ty_path(l: LeanObj, a: LeanObj, x: LeanObj, y: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TY_SIGMA, 2); let ctor = alloc_ctor(TY_PATH, 4);
ctor_set_field(ctor, 0, a); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, b); ctor_set_field(ctor, 1, a);
ctor_set_field(ctor, 2, x);
ctor_set_field(ctor, 3, y);
ctor 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
}
/// `.El {} P` — ABI v5 universe-code decoder. Layout: [, P].
#[inline]
fn mk_ty_el(l: LeanObj, p: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TY_EL, 2);
ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, p);
ctor
}
/// `.modal {} k A` — ABI v7 unified cohesive-modality former.
/// Layout: [, k, A] (3 fields). Replaces the v6 trio
/// `mk_ty_flat`/`mk_ty_sharp`/`mk_ty_shape`. `k` is a `ModalityKind`
/// runtime object (boxed-scalar for the nullary `flat`/`sharp`/`shape`
/// constructors); the field is consume-slot — caller must pass an
/// owned reference.
#[inline]
fn mk_ty_modal(l: LeanObj, k: LeanObj, a: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TY_MODAL, 3);
ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, k);
ctor_set_field(ctor, 2, a);
ctor
}
/// `.glue {} φ T f fInv sec ret coh A` — 9 fields.
#[inline] #[inline]
fn mk_ty_glue( fn mk_ty_glue(
l: LeanObj,
phi: LeanObj, t: LeanObj, phi: LeanObj, t: LeanObj,
f: LeanObj, finv: LeanObj, sec: LeanObj, ret: LeanObj, coh: LeanObj, f: LeanObj, finv: LeanObj, sec: LeanObj, ret: LeanObj, coh: LeanObj,
a: LeanObj, a: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(TY_GLUE, 8); let ctor = alloc_ctor(TY_GLUE, 9);
ctor_set_field(ctor, 0, phi); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, t); ctor_set_field(ctor, 1, phi);
ctor_set_field(ctor, 2, f); ctor_set_field(ctor, 2, t);
ctor_set_field(ctor, 3, finv); ctor_set_field(ctor, 3, f);
ctor_set_field(ctor, 4, sec); ctor_set_field(ctor, 4, finv);
ctor_set_field(ctor, 5, ret); ctor_set_field(ctor, 5, sec);
ctor_set_field(ctor, 6, coh); ctor_set_field(ctor, 6, ret);
ctor_set_field(ctor, 7, a); ctor_set_field(ctor, 7, coh);
ctor_set_field(ctor, 8, a);
ctor ctor
} }
// ── CType.substDim (Bool) ────────────────────────────────────────────────── // ── CType.substDim (Bool) ──────────────────────────────────────────────────
/// `CType.substDim i b A` — substitute dim `i` with Bool endpoint `b`. /// `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 { pub(crate) fn ctype_subst_dim_bool(i: LeanObj, b: bool, a: LeanObj) -> LeanObjMut {
match ctor_tag(a) { 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 => { TY_PI => {
let x = ctor_field(a, 0); let ld = ctor_field(a, 0);
let y = ctor_field(a, 1); 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 nx = ctype_subst_dim_bool(i, b, x);
let ny = ctype_subst_dim_bool(i, b, y); 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 => { TY_PATH => {
let ty = ctor_field(a, 0); let l = ctor_field(a, 0);
let x = ctor_field(a, 1); let ty = ctor_field(a, 1);
let y = ctor_field(a, 2); let x = ctor_field(a, 2);
let y = ctor_field(a, 3);
retain(l);
let nty = ctype_subst_dim_bool(i, b, ty); let nty = ctype_subst_dim_bool(i, b, ty);
let nx = cterm_subst_dim_bool(i, b, x); let nx = cterm_subst_dim_bool(i, b, x);
let ny = cterm_subst_dim_bool(i, b, y); 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 => { TY_SIGMA => {
let x = ctor_field(a, 0); let la = ctor_field(a, 0);
let y = ctor_field(a, 1); 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 nx = ctype_subst_dim_bool(i, b, x);
let ny = ctype_subst_dim_bool(i, b, y); 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 => { TY_GLUE => {
let phi = ctor_field(a, 0); let l = ctor_field(a, 0);
let ty = ctor_field(a, 1); let phi = ctor_field(a, 1);
let f = ctor_field(a, 2); let ty = ctor_field(a, 2);
let finv = ctor_field(a, 3); let f = ctor_field(a, 3);
let sec = ctor_field(a, 4); let finv = ctor_field(a, 4);
let ret = ctor_field(a, 5); let sec = ctor_field(a, 5);
let coh = ctor_field(a, 6); let ret = ctor_field(a, 6);
let base = ctor_field(a, 7); 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. // 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 b_expr: LeanObjMut = if b { mk_dim_one() } else { mk_dim_zero() };
let nphi = face_subst_dim(i, b_expr as LeanObj, phi); let nphi = face_subst_dim(i, b_expr as LeanObj, phi);
@ -737,53 +873,152 @@ pub(crate) fn ctype_subst_dim_bool(i: LeanObj, b: bool, a: LeanObj) -> LeanObjMu
let nret = cterm_subst_dim_bool(i, b, ret); let nret = cterm_subst_dim_bool(i, b, ret);
let ncoh = cterm_subst_dim_bool(i, b, coh); let ncoh = cterm_subst_dim_bool(i, b, coh);
let nbase = ctype_subst_dim_bool(i, b, base); 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, nf as LeanObj, nfinv as LeanObj,
nsec as LeanObj, nret as LeanObj, ncoh as LeanObj, nsec as LeanObj, nret as LeanObj, ncoh as LeanObj,
nbase as LeanObj) nbase as LeanObj)
} }
_ => mk_ty_univ(), // ABI v4: ind layout [, S, params].
TY_IND => {
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.
TY_INTERVAL => {
retain(a);
a as LeanObjMut
}
// 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)
}
// ABI v5: universe-code decoder. Recurse into the encoded CTerm
// payload via cterm_subst_dim_bool. Layout: [, P].
TY_EL => {
let l = ctor_field(a, 0);
let p = ctor_field(a, 1);
retain(l);
let new_p = cterm_subst_dim_bool(i, b, p);
mk_ty_el(l, new_p as LeanObj)
}
// ABI v7: unified cohesive-modality former — recurse into the
// wrapped CType, preserving the modality kind. Layout:
// [, k, A]. Mirrors Lean's CType.substDim arm for `.modal k A`
// (which is structural in `A`, leaving the kind alone).
TY_MODAL => {
let l = ctor_field(a, 0);
let k = ctor_field(a, 1);
let inner = ctor_field(a, 2);
retain(l); retain(k);
let new_inner = ctype_subst_dim_bool(i, b, inner);
mk_ty_modal(l, k, 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 (Σ : 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); // ⟨ℓ, A⟩
let tail = ctor_field(params, 1);
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);
cons
}
_ => {
retain(params);
params as LeanObjMut
}
} }
} }
// ── CType.substDimExpr ───────────────────────────────────────────────────── // ── CType.substDimExpr ─────────────────────────────────────────────────────
/// `CType.substDimExpr i r A` — substitute dim `i` with arbitrary DimExpr `r`. /// `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 { pub(crate) fn ctype_subst_dim_expr(i: LeanObj, r: LeanObj, a: LeanObj) -> LeanObjMut {
match ctor_tag(a) { 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 => { TY_PI => {
let x = ctor_field(a, 0); let ld = ctor_field(a, 0);
let y = ctor_field(a, 1); 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 nx = ctype_subst_dim_expr(i, r, x);
let ny = ctype_subst_dim_expr(i, r, y); 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 => { TY_PATH => {
let ty = ctor_field(a, 0); let l = ctor_field(a, 0);
let x = ctor_field(a, 1); let ty = ctor_field(a, 1);
let y = ctor_field(a, 2); let x = ctor_field(a, 2);
let y = ctor_field(a, 3);
retain(l);
let nty = ctype_subst_dim_expr(i, r, ty); let nty = ctype_subst_dim_expr(i, r, ty);
let nx = cterm_subst_dim(i, r, x); let nx = cterm_subst_dim(i, r, x);
let ny = cterm_subst_dim(i, r, y); 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 => { TY_SIGMA => {
let x = ctor_field(a, 0); let la = ctor_field(a, 0);
let y = ctor_field(a, 1); 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 nx = ctype_subst_dim_expr(i, r, x);
let ny = ctype_subst_dim_expr(i, r, y); 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 => { TY_GLUE => {
let phi = ctor_field(a, 0); let l = ctor_field(a, 0);
let ty = ctor_field(a, 1); let phi = ctor_field(a, 1);
let f = ctor_field(a, 2); let ty = ctor_field(a, 2);
let finv = ctor_field(a, 3); let f = ctor_field(a, 3);
let sec = ctor_field(a, 4); let finv = ctor_field(a, 4);
let ret = ctor_field(a, 5); let sec = ctor_field(a, 5);
let coh = ctor_field(a, 6); let ret = ctor_field(a, 6);
let base = ctor_field(a, 7); let coh = ctor_field(a, 7);
let base = ctor_field(a, 8);
retain(l);
let nphi = face_subst_dim(i, r, phi); let nphi = face_subst_dim(i, r, phi);
let nty = ctype_subst_dim_expr(i, r, ty); let nty = ctype_subst_dim_expr(i, r, ty);
let nf = cterm_subst_dim(i, r, f); let nf = cterm_subst_dim(i, r, f);
@ -792,11 +1027,83 @@ pub(crate) fn ctype_subst_dim_expr(i: LeanObj, r: LeanObj, a: LeanObj) -> LeanOb
let nret = cterm_subst_dim(i, r, ret); let nret = cterm_subst_dim(i, r, ret);
let ncoh = cterm_subst_dim(i, r, coh); let ncoh = cterm_subst_dim(i, r, coh);
let nbase = ctype_subst_dim_expr(i, r, base); 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, nf as LeanObj, nfinv as LeanObj,
nsec as LeanObj, nret as LeanObj, ncoh as LeanObj, nsec as LeanObj, nret as LeanObj, ncoh as LeanObj,
nbase as LeanObj) nbase as LeanObj)
} }
_ => mk_ty_univ(), TY_IND => {
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
}
// 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)
}
// ABI v5: universe-code decoder. Substitute via cterm_subst_dim
// on the CTerm payload. Layout: [, P].
TY_EL => {
let l = ctor_field(a, 0);
let p = ctor_field(a, 1);
retain(l);
let new_p = cterm_subst_dim(i, r, p);
mk_ty_el(l, new_p as LeanObj)
}
// ABI v7: unified cohesive-modality former — recurse into the
// wrapped CType, preserving the modality kind. Layout:
// [, k, A]. Mirrors Lean's CType.substDimExpr arm for
// `.modal k A`.
TY_MODAL => {
let l = ctor_field(a, 0);
let k = ctor_field(a, 1);
let inner = ctor_field(a, 2);
retain(l); retain(k);
let new_inner = ctype_subst_dim_expr(i, r, inner);
mk_ty_modal(l, k, new_inner as LeanObj)
}
_ => {
mk_ty_univ(lean_box_mut(0) as LeanObj)
}
}
}
/// 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); // ⟨ℓ, A⟩
let tail = ctor_field(params, 1);
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);
cons
}
_ => { retain(params); params as LeanObjMut }
} }
} }

View file

@ -24,14 +24,62 @@ pub const FACE_EQ1: u32 = 3;
pub const FACE_MEET: u32 = 4; pub const FACE_MEET: u32 = 4;
pub const FACE_JOIN: u32 = 5; pub const FACE_JOIN: u32 = 5;
// ── CType (Cubical/Syntax.lean) ──────────────────────────────────────────── // ── ModalityKind (Cubical/Syntax.lean — Refactor Phase 2, ABI v7) ─────────
//
// Level-erased enum tagging which arm of the cohesive triple `ʃ ⊣ ♭ ⊣ ♯`
// a unified modal constructor talks about. Replaces the v6 set of nine
// ad-hoc per-modality constructors.
//
// Lean inductive (zero-field arms — represented at runtime as boxed
// scalars `lean_box(<idx>)`):
//
// inductive ModalityKind | flat | sharp | shape
//
// `lean_obj_tag` returns the constructor index uniformly for both scalar
// and heap objects, so we read the kind by `ctor_tag(k)` and compare
// against the constants below — exactly the existing pattern used for
// `FACE_TOP`, `DIM_ZERO`, etc. These are `u32` (matching every other
// tag-namespace constant in this module) rather than `u8`: the runtime
// API surface is `ctor_tag(o) -> u32`, and no current call site benefits
// from a narrower type.
pub const TY_UNIV: u32 = 0; pub const MODKIND_FLAT: u32 = 0;
pub const TY_PI: u32 = 1; pub const MODKIND_SHARP: u32 = 1;
pub const TY_PATH: u32 = 2; pub const MODKIND_SHAPE: u32 = 2;
pub const TY_SIGMA: u32 = 3;
pub const TY_GLUE: u32 = 4; // ── CType (Cubical/Syntax.lean) ────────────────────────────────────────────
pub const TY_IND: u32 = 5; // REL1: schema-based inductive type //
// 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.
// 8 El — universe-code decoder (ABI v5): `El P`.
// 9 modal — unified cohesive-modality former (ABI v7): `modal k A`.
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
pub const TY_EL: u32 = 8; // ABI v5: universe-code decoder `El P`
// ABI v7: unified cohesive-modality former, `modal k A` where
// `k : ModalityKind`. Reuses tag id 9 (formerly `TY_FLAT` in v6).
//
// Reserved (gap from v6→v7 collapse, intentionally unassigned for
// future ABI v8+ extensions; do NOT reuse without bumping the version
// number again):
// 10 — was `TY_SHARP` (v6)
// 11 — was `TY_SHAPE` (v6)
pub const TY_MODAL: u32 = 9;
// ── CTerm (Cubical/Syntax.lean) ──────────────────────────────────────────── // ── CTerm (Cubical/Syntax.lean) ────────────────────────────────────────────
@ -51,6 +99,22 @@ pub const TERM_SND: u32 = 12;
pub const TERM_DIMEXPR: u32 = 13; // REL1: dim expression lifted to CTerm pub const TERM_DIMEXPR: u32 = 13; // REL1: dim expression lifted to CTerm
pub const TERM_CTOR: u32 = 14; // REL1: schema constructor application pub const TERM_CTOR: u32 = 14; // REL1: schema constructor application
pub const TERM_INDELIM: u32 = 15; // REL1: inductive eliminator pub const TERM_INDELIM: u32 = 15; // REL1: inductive eliminator
pub const TERM_CODE: u32 = 16; // ABI v5: universe-code encoder `code A`
// ABI v7: unified modal introduction, `modalIntro k a`. Reuses tag id
// 17 (formerly `TERM_FLAT_INTRO` in v6).
pub const TERM_MODAL_INTRO: u32 = 17;
// ABI v7: unified modal elimination, `modalElim k f m`. Reuses tag id
// 18 (formerly `TERM_SHARP_INTRO` in v6, but now hosting the unified
// modal-elim arm because Lean's declaration order in `Syntax.lean`
// places `modalElim` immediately after `modalIntro`).
//
// Reserved (gaps from v6→v7 collapse, intentionally unassigned for
// future ABI v8+ extensions):
// 19 — was `TERM_SHAPE_INTRO` (v6)
// 20 — was `TERM_FLAT_ELIM` (v6)
// 21 — was `TERM_SHARP_ELIM` (v6)
// 22 — was `TERM_SHAPE_ELIM` (v6)
pub const TERM_MODAL_ELIM: u32 = 18;
// ── CEnv (Cubical/Value.lean) ────────────────────────────────────────────── // ── CEnv (Cubical/Value.lean) ──────────────────────────────────────────────
@ -70,6 +134,14 @@ pub const VAL_VPATHTRANSP: u32 = 7;
pub const VAL_VPAIR: u32 = 8; pub const VAL_VPAIR: u32 = 8;
pub const VAL_VCTOR: u32 = 9; // REL1: canonical schema-ctor value pub const VAL_VCTOR: u32 = 9; // REL1: canonical schema-ctor value
pub const VAL_VDIMEXPR: u32 = 10; // REL1: lifted dim-expression value pub const VAL_VDIMEXPR: u32 = 10; // REL1: lifted dim-expression value
pub const VAL_VCODE: u32 = 11; // ABI v5: universe-code value `vcode A`
// ABI v7: unified modal introduction value, `vModalIntro k v`. Reuses
// tag id 12 (formerly `VAL_VFLAT_INTRO` in v6).
//
// Reserved (gaps from v6→v7 collapse):
// 13 — was `VAL_VSHARP_INTRO` (v6)
// 14 — was `VAL_VSHAPE_INTRO` (v6)
pub const VAL_VMODAL_INTRO: u32 = 12;
// ── CNeu (Cubical/Value.lean) ────────────────────────────────────────────── // ── CNeu (Cubical/Value.lean) ──────────────────────────────────────────────
@ -85,3 +157,10 @@ pub const NEU_NUNGLUE: u32 = 8;
pub const NEU_NFST: u32 = 9; pub const NEU_NFST: u32 = 9;
pub const NEU_NSND: u32 = 10; pub const NEU_NSND: u32 = 10;
pub const NEU_NINDELIM: u32 = 11; // REL1: stuck inductive eliminator pub const NEU_NINDELIM: u32 = 11; // REL1: stuck inductive eliminator
// ABI v7: unified stuck modal-eliminator neutral, `nModalElim k f n`.
// Reuses tag id 12 (formerly `NEU_NFLAT_ELIM` in v6).
//
// Reserved (gaps from v6→v7 collapse):
// 13 — was `NEU_NSHARP_ELIM` (v6)
// 14 — was `NEU_NSHAPE_ELIM` (v6)
pub const NEU_NMODAL_ELIM: u32 = 12;

View file

@ -4,26 +4,36 @@
//! `vTranspInv` (inverse transport via line reversal). Mirrors //! `vTranspInv` (inverse transport via line reversal). Mirrors
//! `Cubical/Transport.lean`. //! `Cubical/Transport.lean`.
//! //!
//! `vTransp i A φ v` dispatch (priority order): //! `vTransp i A φ v` dispatch (priority order):
//! //!
//! 1. `φ = .top` → return `v` unchanged (T1). //! 1. `φ = .top` → return `v` unchanged (T1).
//! 2. `CType.dimAbsent i A = true` → return `v` (T2 constant line). //! 2. `CType.dimAbsent i A = true` → return `v` (T2 constant line).
//! 3. `A = .pi domA codA` → return `.vTranspFun i domA codA φ v` //! 3. `A = .pi domA codA` → return `.vTranspFun { '} i domA codA φ v`
//! (full CCHM Π rule). //! (full CCHM Π rule). ' read from A.
//! 4. Otherwise → return `.vneu (.ntransp i A φ v)`. //! 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 //! — degenerates to identity when A is dim-absent (the reversed line is
//! also constant). //! 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::lean_runtime::*;
use crate::tags::*; use crate::tags::*;
use crate::value::*; use crate::value::*;
use crate::dim_absent::ctype_absent; use crate::dim_absent::ctype_absent;
/// `vTransp i A φ v` — value-level transport. /// `vTransp i A φ v` — value-level transport.
/// Takes borrowed `i`, `a`, `phi` and owned `v`. Returns owned `CVal`. /// Takes borrowed `l`, `i`, `a`, `phi` and owned `v`. Returns owned `CVal`.
pub fn vtransp(i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMut { pub fn vtransp(l: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMut {
// 1. Full face → identity. // 1. Full face → identity.
if ctor_tag(phi) == FACE_TOP { if ctor_tag(phi) == FACE_TOP {
return v; return v;
@ -34,23 +44,29 @@ pub fn vtransp(i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObjMut) -> LeanObjMu
return v; 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 { if ctor_tag(a) == TY_PI {
let dom_a = ctor_field(a, 0); let ld = ctor_field(a, 0);
let cod_a = ctor_field(a, 1); let lc = ctor_field(a, 1);
retain(i); retain(dom_a); retain(cod_a); retain(phi); let dom_a = ctor_field(a, 3);
return mk_vtranspfun(i, dom_a, cod_a, phi, v as LeanObj); 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. // 4. Stuck — produce a structured `ntransp` neutral. l is forwarded
retain(i); retain(a); retain(phi); // (the result level equals A's level).
let ntransp = mk_ntransp(i, a, phi, v as LeanObj); retain(l); retain(i); retain(a); retain(phi);
let ntransp = mk_ntransp(l, i, a, phi, v as LeanObj);
mk_vneu(ntransp 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. /// 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. // Build `(.inv (.var i))` DimExpr.
let var_i = { let var_i = {
retain(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); let a_reversed = crate::subst::ctype_subst_dim_expr(i, inv_var_i as LeanObj, a);
release(inv_var_i as LeanObj); release(inv_var_i as LeanObj);
// Transport along the reversed line. // 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); release(a_reversed as LeanObj);
result result
} }

View file

@ -2,13 +2,40 @@
//! //!
//! Helpers for constructing `CVal` / `CNeu` objects. Each builder //! Helpers for constructing `CVal` / `CNeu` objects. Each builder
//! owns the input fields (callers pre-retain borrowed data as needed). //! 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::lean_runtime::*;
use crate::tags::*; 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 ────────────────────────────────────────────────────────── // ── CVal builders ──────────────────────────────────────────────────────────
/// `.vlam env x body` — function closure. Takes ownership of all fields. /// `.vlam env x body` — function closure. Takes ownership of all fields.
/// No implicit ULevel — vlam is universe-monomorphic at the value level.
#[inline] #[inline]
pub(crate) fn mk_vlam(env: LeanObj, x: LeanObj, body: LeanObj) -> LeanObjMut { pub(crate) fn mk_vlam(env: LeanObj, x: LeanObj, body: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VLAM, 3); let ctor = alloc_ctor(VAL_VLAM, 3);
@ -45,65 +72,80 @@ pub(crate) fn mk_vpair(a: LeanObj, b: LeanObj) -> LeanObjMut {
ctor 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] #[inline]
pub(crate) fn mk_vtranspfun( pub(crate) fn mk_vtranspfun(
l: LeanObj, l2: LeanObj,
i: LeanObj, dom_a: LeanObj, cod_a: LeanObj, i: LeanObj, dom_a: LeanObj, cod_a: LeanObj,
phi: LeanObj, f: LeanObj, phi: LeanObj, f: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VTRANSPFUN, 5); let ctor = alloc_ctor(VAL_VTRANSPFUN, 7);
ctor_set_field(ctor, 0, i); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, dom_a); ctor_set_field(ctor, 1, l2);
ctor_set_field(ctor, 2, cod_a); ctor_set_field(ctor, 2, i);
ctor_set_field(ctor, 3, phi); ctor_set_field(ctor, 3, dom_a);
ctor_set_field(ctor, 4, f); ctor_set_field(ctor, 4, cod_a);
ctor_set_field(ctor, 5, phi);
ctor_set_field(ctor, 6, f);
ctor 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] #[inline]
pub(crate) fn mk_vpathtransp( pub(crate) fn mk_vpathtransp(
l: LeanObj,
env: LeanObj, i: LeanObj, a_ty: LeanObj, env: LeanObj, i: LeanObj, a_ty: LeanObj,
a: LeanObj, b: LeanObj, phi: LeanObj, p: LeanObj, a: LeanObj, b: LeanObj, phi: LeanObj, p: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VPATHTRANSP, 7); let ctor = alloc_ctor(VAL_VPATHTRANSP, 8);
ctor_set_field(ctor, 0, env); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, i); ctor_set_field(ctor, 1, env);
ctor_set_field(ctor, 2, a_ty); ctor_set_field(ctor, 2, i);
ctor_set_field(ctor, 3, a); ctor_set_field(ctor, 3, a_ty);
ctor_set_field(ctor, 4, b); ctor_set_field(ctor, 4, a);
ctor_set_field(ctor, 5, phi); ctor_set_field(ctor, 5, b);
ctor_set_field(ctor, 6, p); ctor_set_field(ctor, 6, phi);
ctor_set_field(ctor, 7, p);
ctor ctor
} }
/// `.ntransp i A φ v` — stuck transport neutral. /// `.ntransp {} i A φ v` — stuck transport neutral.
/// Layout: `[, i, A, φ, v]` (5 fields).
#[inline] #[inline]
pub(crate) fn mk_ntransp( pub(crate) fn mk_ntransp(
l: LeanObj,
i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObj, i: LeanObj, a: LeanObj, phi: LeanObj, v: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(NEU_NTRANSP, 4); let ctor = alloc_ctor(NEU_NTRANSP, 5);
ctor_set_field(ctor, 0, i); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, a); ctor_set_field(ctor, 1, i);
ctor_set_field(ctor, 2, phi); ctor_set_field(ctor, 2, a);
ctor_set_field(ctor, 3, v); ctor_set_field(ctor, 3, phi);
ctor_set_field(ctor, 4, v);
ctor ctor
} }
/// `.vHCompFun codA φ tube base` — Π-hcomp closure. /// `.vHCompFun {} codA φ tube base` — Π-hcomp closure.
/// Layout: `[, codA, φ, tube, base]` (5 fields).
#[inline] #[inline]
pub(crate) fn mk_vhcompfun( pub(crate) fn mk_vhcompfun(
l: LeanObj,
cod_a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj, cod_a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VHCOMPFUN, 4); let ctor = alloc_ctor(VAL_VHCOMPFUN, 5);
ctor_set_field(ctor, 0, cod_a); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, phi); ctor_set_field(ctor, 1, cod_a);
ctor_set_field(ctor, 2, tube); ctor_set_field(ctor, 2, phi);
ctor_set_field(ctor, 3, base); ctor_set_field(ctor, 3, tube);
ctor_set_field(ctor, 4, base);
ctor ctor
} }
/// `.vTubeApp tube arg` — point-wise applied tube `λj. (tube @ j) arg`. /// `.vTubeApp tube arg` — point-wise applied tube `λj. (tube @ j) arg`.
/// No implicit ULevel.
#[inline] #[inline]
pub(crate) fn mk_vtubeapp(tube: LeanObj, arg: LeanObj) -> LeanObjMut { pub(crate) fn mk_vtubeapp(tube: LeanObj, arg: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VTUBEAPP, 2); let ctor = alloc_ctor(VAL_VTUBEAPP, 2);
@ -112,61 +154,74 @@ pub(crate) fn mk_vtubeapp(tube: LeanObj, arg: LeanObj) -> LeanObjMut {
ctor 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] #[inline]
pub(crate) fn mk_vcompfun( pub(crate) fn mk_vcompfun(
l: LeanObj, l2: LeanObj,
env: LeanObj, i: LeanObj, dom_a: LeanObj, cod_a: LeanObj, env: LeanObj, i: LeanObj, dom_a: LeanObj, cod_a: LeanObj,
phi: LeanObj, u: LeanObj, t: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VCOMPFUN, 7); let ctor = alloc_ctor(VAL_VCOMPFUN, 9);
ctor_set_field(ctor, 0, env); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, i); ctor_set_field(ctor, 1, l2);
ctor_set_field(ctor, 2, dom_a); ctor_set_field(ctor, 2, env);
ctor_set_field(ctor, 3, cod_a); ctor_set_field(ctor, 3, i);
ctor_set_field(ctor, 4, phi); ctor_set_field(ctor, 4, dom_a);
ctor_set_field(ctor, 5, u); ctor_set_field(ctor, 5, cod_a);
ctor_set_field(ctor, 6, t); ctor_set_field(ctor, 6, phi);
ctor_set_field(ctor, 7, u);
ctor_set_field(ctor, 8, t);
ctor ctor
} }
/// `.nhcomp A φ tube base` — stuck hcomp neutral. /// `.nhcomp {} A φ tube base` — stuck hcomp neutral.
/// Layout: `[, A, φ, tube, base]` (5 fields).
#[inline] #[inline]
pub(crate) fn mk_nhcomp( pub(crate) fn mk_nhcomp(
l: LeanObj,
a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj, a: LeanObj, phi: LeanObj, tube: LeanObj, base: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(NEU_NHCOMP, 4); let ctor = alloc_ctor(NEU_NHCOMP, 5);
ctor_set_field(ctor, 0, a); ctor_set_field(ctor, 0, l);
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);
ctor_set_field(ctor, 1, a); ctor_set_field(ctor, 1, a);
ctor_set_field(ctor, 2, phi); ctor_set_field(ctor, 2, phi);
ctor_set_field(ctor, 3, u); ctor_set_field(ctor, 3, tube);
ctor_set_field(ctor, 4, t); ctor_set_field(ctor, 4, base);
ctor 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] #[inline]
pub(crate) fn mk_ncompn( pub(crate) fn mk_ncomp(
env: LeanObj, i: LeanObj, a: LeanObj, clauses: LeanObj, t: LeanObj, l: LeanObj,
i: LeanObj, a: LeanObj, phi: LeanObj, u: LeanObj, t: LeanObj,
) -> LeanObjMut { ) -> LeanObjMut {
let ctor = alloc_ctor(NEU_NCOMPN, 5); let ctor = alloc_ctor(NEU_NCOMP, 6);
ctor_set_field(ctor, 0, env); ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, i); ctor_set_field(ctor, 1, i);
ctor_set_field(ctor, 2, a); ctor_set_field(ctor, 2, a);
ctor_set_field(ctor, 3, clauses); ctor_set_field(ctor, 3, phi);
ctor_set_field(ctor, 4, t); 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 ctor
} }
@ -215,7 +270,7 @@ pub(crate) fn mk_nsnd(n: LeanObj) -> LeanObjMut {
} }
/// `.vctor S c params args` — canonical schema-constructor value (REL1). /// `.vctor S c params args` — canonical schema-constructor value (REL1).
/// Takes ownership of all four field handles. /// No implicit ULevel.
#[inline] #[inline]
pub(crate) fn mk_vctor( pub(crate) fn mk_vctor(
schema: LeanObj, name: LeanObj, params: LeanObj, args: LeanObj, schema: LeanObj, name: LeanObj, params: LeanObj, args: LeanObj,
@ -236,8 +291,81 @@ pub(crate) fn mk_vdimexpr(r: LeanObj) -> LeanObjMut {
ctor ctor
} }
/// `.vcode {} A` — universe-code value (ABI v5).
/// Layout: `[, A]` (2 fields). Lean keeps the implicit `{}` at
/// runtime per the v4 universe-stratification contract.
#[inline]
pub(crate) fn mk_vcode(l: LeanObj, a: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VCODE, 2);
ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, a);
ctor
}
/// `CType.El {} P` — universe-code decoder (ABI v5).
/// Layout: `[, P]` (2 fields). P is a CTerm of type `.univ`.
#[inline]
pub(crate) fn mk_ty_el(l: LeanObj, p: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TY_EL, 2);
ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, p);
ctor
}
/// `CTerm.code {} A` — universe-code encoder (ABI v5).
/// Layout: `[, A]` (2 fields). A is a CType at level .
#[inline]
pub(crate) fn mk_term_code(l: LeanObj, a: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(TERM_CODE, 2);
ctor_set_field(ctor, 0, l);
ctor_set_field(ctor, 1, a);
ctor
}
// ── ABI v7: unified cohesive-modality value/neutral builders ──────────────
//
// One intro value (`vModalIntro k v`) carrying a `ModalityKind` tag and
// the wrapped CVal payload; one stuck-elim neutral (`nModalElim k f n`)
// carrying the kind, the evaluated eliminator function (CVal) and the
// stuck scrutinee (CNeu). Replaces the v6 trio of per-modality
// builders (mk_vflat_intro / mk_vsharp_intro / mk_vshape_intro and
// mk_nflat_elim / mk_nsharp_elim / mk_nshape_elim).
//
// Lean keeps `ModalityKind` as a regular runtime object slot (it is a
// non-erased inductive); both the boxed-scalar form (`flat`/`sharp`/
// `shape` are nullary, so they live as `lean_box(0/1/2)`) and any
// future heap-payloaded extensions are stored uniformly. Callers must
// pass an OWNED `kind` reference — the constructor field consumes it.
//
// No implicit ULevel — modal intros and elims are CTerm/CVal-typed,
// not CType-typed (the modal's ULevel lives on the surrounding
// CType.modal, not here).
/// `.vModalIntro k v` — η-introduction value for modality `k` (ABI v7).
/// Layout: `[k, v]` (2 fields): the `ModalityKind` discriminant and the
/// wrapped CVal payload.
#[inline]
pub(crate) fn mk_vmodal_intro(k: LeanObj, v: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(VAL_VMODAL_INTRO, 2);
ctor_set_field(ctor, 0, k);
ctor_set_field(ctor, 1, v);
ctor
}
/// `.nModalElim k f n` — stuck modal-eliminator neutral (ABI v7).
/// Layout: `[k, f, n]` (3 fields): the `ModalityKind` discriminant, the
/// evaluated eliminator function, and the stuck scrutinee.
#[inline]
pub(crate) fn mk_nmodal_elim(k: LeanObj, f: LeanObj, n: LeanObj) -> LeanObjMut {
let ctor = alloc_ctor(NEU_NMODAL_ELIM, 3);
ctor_set_field(ctor, 0, k);
ctor_set_field(ctor, 1, f);
ctor_set_field(ctor, 2, n);
ctor
}
/// `.nIndElim S params motive branches target` — stuck eliminator /// `.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] #[inline]
pub(crate) fn mk_nindelim( pub(crate) fn mk_nindelim(
schema: LeanObj, params: LeanObj, motive: LeanObj, schema: LeanObj, params: LeanObj, motive: LeanObj,

View file

@ -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 // Proves the wasm ABI surface works by implementing a *minimal* subset of
// Lean's runtime in JS (bump allocator + object header layout) and // 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 __dirname = path.dirname(fileURLToPath(import.meta.url));
const wasmPath = path.resolve( const wasmPath = path.resolve(
__dirname, __dirname,
'../target/wasm32-unknown-unknown/release/topolei_cubical.wasm' '../target/wasm32-unknown-unknown/release/cubical_transport.wasm'
); );
// ── Lean object layout (wasm32) ──────────────────────────────────────────── // ── Lean object layout (wasm32) ────────────────────────────────────────────
@ -75,22 +75,22 @@ function setField(o, i, v) {
} }
const shim = { const shim = {
topolei_shim_obj_tag: getTag, cubical_transport_shim_obj_tag: getTag,
topolei_shim_ctor_get: getField, cubical_transport_shim_ctor_get: getField,
topolei_shim_ctor_set: setField, cubical_transport_shim_ctor_set: setField,
topolei_shim_alloc_ctor: (tag, num_objs, scalar_sz) => { cubical_transport_shim_alloc_ctor: (tag, num_objs, scalar_sz) => {
const size = HEADER_SIZE + num_objs * FIELD_SIZE + scalar_sz; const size = HEADER_SIZE + num_objs * FIELD_SIZE + scalar_sz;
const p = alloc(size); const p = alloc(size);
setHeader(p, tag, num_objs); setHeader(p, tag, num_objs);
return p; return p;
}, },
topolei_shim_inc: () => {}, // refcount — harness doesn't GC cubical_transport_shim_inc: () => {}, // refcount — harness doesn't GC
topolei_shim_dec: () => {}, cubical_transport_shim_dec: () => {},
topolei_shim_string_eq: (a, b) => { cubical_transport_shim_string_eq: (a, b) => {
// For tests that don't exercise strings; panic if called. // For tests that don't exercise strings; panic if called.
throw new Error('string_eq: harness does not implement string content comparison'); 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'); throw new Error('mk_string: harness does not implement string allocation');
}, },
}; };
@ -140,38 +140,38 @@ const tests = [];
// Scalar passthrough (no allocation). // Scalar passthrough (no allocation).
tests.push(['DimExpr.normalize(.zero) → .zero', tests.push(['DimExpr.normalize(.zero) → .zero',
() => instance.exports.topolei_cubical_dimexpr_normalize(scalarZero), () => instance.exports.cubical_transport_dimexpr_normalize(scalarZero),
scalarZero]); scalarZero]);
tests.push(['DimExpr.normalize(.one) → .one', tests.push(['DimExpr.normalize(.one) → .one',
() => instance.exports.topolei_cubical_dimexpr_normalize(scalarOne), () => instance.exports.cubical_transport_dimexpr_normalize(scalarOne),
scalarOne]); scalarOne]);
// Heap-object reductions. // Heap-object reductions.
tests.push(['DimExpr.normalize(.inv .zero) → .one', tests.push(['DimExpr.normalize(.inv .zero) → .one',
() => instance.exports.topolei_cubical_dimexpr_normalize(mkInv(scalarZero)), () => instance.exports.cubical_transport_dimexpr_normalize(mkInv(scalarZero)),
scalarOne]); scalarOne]);
tests.push(['DimExpr.normalize(.inv .one) → .zero', tests.push(['DimExpr.normalize(.inv .one) → .zero',
() => instance.exports.topolei_cubical_dimexpr_normalize(mkInv(scalarOne)), () => instance.exports.cubical_transport_dimexpr_normalize(mkInv(scalarOne)),
scalarZero]); scalarZero]);
tests.push(['DimExpr.normalize(.inv (.inv .zero)) → .zero', 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]); scalarZero]);
// FaceFormula scalar passthrough. // FaceFormula scalar passthrough.
tests.push(['FaceFormula.normalize(.bot) → .bot', 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)]); boxTag(FACE_BOT)]);
tests.push(['FaceFormula.normalize(.top) → .top', 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)]); boxTag(FACE_TOP)]);
// FaceFormula absorption laws. // FaceFormula absorption laws.
tests.push(['FaceFormula.normalize(.meet .top .bot) → .bot', 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))), mkFaceMeet(boxTag(FACE_TOP), boxTag(FACE_BOT))),
boxTag(FACE_BOT)]); boxTag(FACE_BOT)]);
tests.push(['FaceFormula.normalize(.meet .bot .top) → .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))), mkFaceMeet(boxTag(FACE_BOT), boxTag(FACE_TOP))),
boxTag(FACE_BOT)]); 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. // inv .zero normalizes to .one; inv .one normalizes to .zero.
// Our normalize recurses on meet's children, so result is .meet .one .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). // 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))); mkMeet(mkInv(scalarZero), mkInv(scalarOne)));
if (isScalar(result)) return `scalar 0x${result.toString(16)}`; if (isScalar(result)) return `scalar 0x${result.toString(16)}`;
const tag = getTag(result); const tag = getTag(result);
@ -195,7 +195,7 @@ tests.push(['DimExpr.normalize(.meet (.inv .zero) (.inv .one)) → .meet .one .z
// ── Run ──────────────────────────────────────────────────────────────────── // ── Run ────────────────────────────────────────────────────────────────────
let fails = 0; let fails = 0;
console.log('── Topolei cubical wasm harness ──'); console.log('── Cubical-transport wasm harness ──');
for (const [desc, fn, expected] of tests) { for (const [desc, fn, expected] of tests) {
try { try {
const got = fn(); const got = fn();