Chuangjie Xu 2012 (updated in February 2015, ported to TypeTopology in 2025)
\begin{code}
{-# OPTIONS --safe --without-K #-}
open import MLTT.Spartan
open import UF.FunExt using (naive-funext)
module C-Spaces.UsingFunExt.CartesianClosedness (fe : naive-funext π€β π€β) where
open import C-Spaces.Preliminaries.Sequence
open import C-Spaces.UniformContinuity
open import C-Spaces.Coverage
open import C-Spaces.UsingFunExt.Space
\end{code}
The terminal C-space:
\begin{code}
πSpace : Space
πSpace = π , P , cβ , cβ , cβ
where
P : (ββ β π) β Set
P p = π
cβ : β(x : π) β (Ξ» Ξ± β x) β P
cβ _ = β
cβ : β(t : ββ β ββ) β t β C β β(p : ββ β π) β p β P β p β t β P
cβ _ _ _ _ = β
cβ : β(p : ββ β π) β (Ξ£ \(n : β) β β(s : βFin n) β (p β (cons s)) β P) β p β P
cβ _ _ = β
continuous-unit : (A : Space) β Map A πSpace
continuous-unit A = unique-to-π , (Ξ» p _ β β)
\end{code}
Binary product of C-spaces:
\begin{code}
infixl 3 _β_
_β_ : Space β Space β Space
(X , P , pcβ , pcβ , pcβ) β (Y , Q , qcβ , qcβ , qcβ) = (X Γ Y) , R , rcβ , rcβ , rcβ
where
R : (ββ β X Γ Y) β Set
R r = ((prβ β r) β P) Γ ((prβ β r) β Q)
rcβ : β(w : X Γ Y) β (Ξ» Ξ± β w) β R
rcβ (x , y) = cβ , cβ
where
cβ : (Ξ» Ξ± β x) β P
cβ = pcβ x
cβ : (Ξ» Ξ± β y) β Q
cβ = qcβ y
rcβ : β(t : ββ β ββ) β t β C β β(r : ββ β X Γ Y) β r β R β r β t β R
rcβ t uc r rR = cβ , cβ
where
cβ : prβ β (r β t) β P
cβ = pcβ t uc (prβ β r) (prβ rR)
cβ : prβ β (r β t) β Q
cβ = qcβ t uc (prβ β r) (prβ rR)
rcβ : β(r : ββ β X Γ Y) β (Ξ£ \(n : β) β β(s : βFin n) β (r β (cons s)) β R) β r β R
rcβ r (n , prf) = cβ , cβ
where
cβ : prβ β r β P
cβ = pcβ (prβ β r) (n , (Ξ» s β prβ(prf s)))
cβ : prβ β r β Q
cβ = qcβ (prβ β r) (n , (Ξ» s β prβ(prf s)))
\end{code}
Exponential of C-spaces
\begin{code}
infixr 3 _β_
_β_ : Space β Space β Space
X β Y = Map X Y , R , rcβ , rcβ , rcβ
where
R : (ββ β Map X Y) β Set
R r = β(p : ββ β U X) β p β Probe X β β(t : ββ β ββ) β t β C β
(Ξ» Ξ± β (prβ β r)(t Ξ±)(p Ξ±)) β Probe Y
rcβ : β(Ο : Map X Y) β (Ξ» Ξ± β Ο) β R
rcβ (Ο , cΟ) p pP t uc = cΟ p pP
rcβ : β(t : ββ β ββ) β t β C β β(r : ββ β Map X Y) β r β R β r β t β R
rcβ t uc r rR p pP t' uc' = rR p pP (t β t') (Lemma[β-UC] t uc t' uc')
rcβ : β(r : ββ β Map X Y) β
(Ξ£ \(n : β) β β(s : βFin n) β (r β (cons s)) β R) β r β R
rcβ r (n , ps) p pP t uc = condβ Y (Ξ» Ξ± β (prβ β r)(t Ξ±)(p Ξ±)) (m , prf)
where
m : β
m = prβ (Theorem[Coverage-axiom] n t uc)
prf : β(s : βFin m) β (Ξ» Ξ± β (prβ β r)(t(cons s Ξ±))(p(cons s Ξ±))) β Probe Y
prf s = transport (Ξ» x β (Ξ» Ξ± β (prβ β r)(x Ξ±)(p(cons s Ξ±))) β Probe Y) eq claim
where
s' : βFin n
s' = prβ (prβ (Theorem[Coverage-axiom] n t uc) s)
t' : ββ β ββ
t' = prβ (prβ (prβ (Theorem[Coverage-axiom] n t uc) s))
uc' : t' β C
uc' = prβ (prβ (prβ (prβ (Theorem[Coverage-axiom] n t uc) s)))
ex : β Ξ± β t (cons s Ξ±) βΌ cons s' (t' Ξ±)
ex = prβ (prβ (prβ (prβ (Theorem[Coverage-axiom] n t uc) s)))
eq : cons s' β t' οΌ t β cons s
eq = (fe (Ξ» Ξ± β fe (ex Ξ±)))β»ΒΉ
psinP : (p β (cons s)) β Probe X
psinP = condβ X (cons s) (Lemma[cons-UC] s) p pP
claim : (Ξ» Ξ± β (prβ β r)(cons s' (t' Ξ±))(p(cons s Ξ±))) β Probe Y
claim = ps s' (p β (cons s)) psinP t' uc'
\end{code}
Universal properties of products and of exponentials
\begin{code}
continuous-pair : (X Y Z : Space)
β Map X Y β Map X Z β Map X (Y β Z)
continuous-pair X Y Z (f , cf) (g , cg) = (fg , cfg)
where
fg : U X β U (Y β Z)
fg x = (f x , g x)
cfg : continuous X (Y β Z) fg
cfg p pX = cf p pX , cg p pX
cprβ : (X Y : Space) β Map (X β Y) X
cprβ X Y = prβ , (Ξ» _ β prβ)
cprβ : (X Y : Space) β Map (X β Y) Y
cprβ X Y = prβ , (Ξ» _ β prβ)
continuous-prβ : (X Y Z : Space) β Map X (Y β Z) β Map X Y
continuous-prβ X Y Z (w , cw) = prβ β w , (Ξ» p pX β prβ (cw p pX))
continuous-prβ : (X Y Z : Space) β Map X (Y β Z) β Map X Z
continuous-prβ X Y Z (w , cw) = prβ β w , (Ξ» p pX β prβ (cw p pX))
continuous-Ξ» : (X Y Z : Space) β Map (X β Y) Z β Map X (Y β Z)
continuous-Ξ» X Y Z (f , cf) = g , cg
where
g : U X β U(Y β Z)
g x = h , ch
where
h : U Y β U Z
h y = f(x , y)
ch : continuous Y Z h
ch q qY = cf r rXY
where
r : ββ β U X Γ U Y
r Ξ± = (x , q Ξ±)
rXY : r β Probe (X β Y)
rXY = condβ X x , qY
cg : continuous X (Y β Z) g
cg p pX q qY t uct = cf r rXY
where
r : ββ β U X Γ U Y
r Ξ± = (p(t Ξ±) , q Ξ±)
rXY : r β Probe (X β Y)
rXY = condβ X t uct p pX , qY
continuous-app : (X Y Z : Space) β Map X (Y β Z) β Map X Y β Map X Z
continuous-app X Y Z (f , cf) (a , ca) = (fa , cfa)
where
fa : U X β U Z
fa x = prβ (f x) (a x)
cfa : continuous X Z fa
cfa p pX = cf p pX (a β p) (ca p pX) id Lemma[id-UC]
\end{code}
Arbitrary product of C-spaces
\begin{code}
β : {I : Set} β (I β Space) β Space
β {I} X = A , P , cβ , cβ , cβ
where
A : Set
A = (i : I) β U(X i)
Ο : (i : I) β A β U(X i)
Ο i a = a i
P : (ββ β A) β Set
P p = β(i : I) β (Ο i) β p β Probe (X i)
cβ : β(a : A) β (Ξ» Ξ± β a) β P
cβ a i = condβ (X i) (a i)
cβ : β(t : ββ β ββ) β t β C β β(p : ββ β A) β p β P β p β t β P
cβ t uc p pP i = condβ (X i) t uc ((Ο i) β p) (pP i)
cβ : β(p : ββ β A) β (Ξ£ \(n : β) β β(s : βFin n) β (p β (cons s)) β P) β p β P
cβ p (n , pr) i = condβ (X i) ((Ο i) β p) (n , Ξ» s β pr s i)
continuous-Ο : {I : Set} β (X : I β Space) β (i : I) β Map (β X) (X i)
continuous-Ο {I} X i = Ο , cts
where
Ο : U(β X) β U(X i)
Ο w = w i
cts : continuous (β X) (X i) Ο
cts p pX = pX i
universal-property-β :
{I : Set} β β(X : I β Space) β
β(Y : Space) β β(f : (i : I) β Map Y (X i)) β
Ξ£ \(g : Map Y (β X)) β
β(i : I) β β(y : U Y) β prβ(continuous-Ο X i)(prβ g y) οΌ prβ (f i) y
universal-property-β {I} X Y f = (g , cg) , (Ξ» _ _ β refl)
where
g : U Y β U(β X)
g y i = prβ (f i) y
cg : continuous Y (β X) g
cg q qY i = prβ (f i) q qY
\end{code}