less prototype, less bad code implementation of CCHM type theory
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 

90 lines
2.1 KiB

{-# PRIMITIVE Type #-}
{-# PRIMITIVE Pretype #-}
I : Pretype
{-# PRIMITIVE Interval I #-}
i0 : I
i1 : I
{-# PRIMITIVE i0 #-}
{-# PRIMITIVE i1 #-}
iand : I -> I -> I
{-# PRIMITIVE iand #-}
ior : I -> I -> I
{-# PRIMITIVE ior #-}
inot : I -> I
{-# PRIMITIVE inot #-}
PathP : (A : I -> Pretype) -> A i0 -> A i1 -> Type
{-# PRIMITIVE PathP #-}
Path : {A : Pretype} -> A -> A -> Type
Path {A} = PathP (\i -> A)
refl : {A : Pretype} {x : A} -> Path x x
refl {A} {x} i = x
sym : {A : I -> Pretype} {x : A i0} {y : A i1} -> PathP A x y -> PathP (\i -> A (inot i)) y x
sym p i = p (inot i)
id : {A : Type} -> A -> A
id x = x
the : (A : Pretype) -> A -> A
the A x = x
iElim : {A : I -> Pretype} {x : A i0} {y : A i1} -> PathP A x y -> (i : I) -> A i
iElim p i = p i
Singl : (A : Type) -> A -> Type
Singl A x = (y : A) * Path x y
isContr : Type -> Type
isContr A = (x : A) * ((y : A) -> Path x y)
singContr : {A : Type} {a : A} -> isContr (Singl A a)
singContr {A} {a} = ((a, \i -> a), \y i -> (y.2 i, \j -> y.2 (iand i j)))
cong : {A : Type} {B : A -> Type} (f : (x : A) -> B x) {x : A} {y : A} (p : Path x y) -> PathP (\i -> B (p i)) (f x) (f y)
cong f p i = f (p i)
congComp : {A : Type} {B : Type} {C : Type}
{f : A -> B} {g : B -> C} {x : A} {y : A}
(p : Path x y)
-> Path (cong g (cong f p)) (cong (\x -> g (f x)) p)
congComp p = refl
congId : {A : Type} {x : A} {y : A}
(p : Path x y)
-> Path (cong (id {A}) p) p
congId p = refl
IsOne : I -> Type
{-# PRIMITIVE IsOne #-}
itIs1 : IsOne i1
{-# PRIMITIVE itIs1 #-}
isOneL : {i : I} {j : I} -> IsOne i -> IsOne (ior i j)
{-# PRIMITIVE isOneL #-}
isOneR : {i : I} {j : I} -> IsOne j -> IsOne (ior i j)
{-# PRIMITIVE isOneR #-}
Partial : I -> Type -> Pretype
{-# PRIMITIVE Partial #-}
PartialP : (phi : I) -> Partial phi Type -> Pretype
{-# PRIMITIVE PartialP #-}
Bool : Type
tt, ff : Bool
foo : (i : I) -> (j : I) -> Partial (ior (inot i) (ior i (iand i j))) Bool
foo i j = \ { (i = i0) -> tt, (i = i1) -> ff, (i = i1) && (j = i1) -> ff }
apPartial : {B : Type} {A : Type} -> (phi : I) -> (A -> B) -> Partial phi A -> Partial phi B
apPartial phi f p is1 = f (p is1)