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.

89 lines
2.1 KiB

  1. {-# PRIMITIVE Type #-}
  2. {-# PRIMITIVE Pretype #-}
  3. I : Pretype
  4. {-# PRIMITIVE Interval I #-}
  5. i0 : I
  6. i1 : I
  7. {-# PRIMITIVE i0 #-}
  8. {-# PRIMITIVE i1 #-}
  9. iand : I -> I -> I
  10. {-# PRIMITIVE iand #-}
  11. ior : I -> I -> I
  12. {-# PRIMITIVE ior #-}
  13. inot : I -> I
  14. {-# PRIMITIVE inot #-}
  15. PathP : (A : I -> Pretype) -> A i0 -> A i1 -> Type
  16. {-# PRIMITIVE PathP #-}
  17. Path : {A : Pretype} -> A -> A -> Type
  18. Path {A} = PathP (\i -> A)
  19. refl : {A : Pretype} {x : A} -> Path x x
  20. refl {A} {x} i = x
  21. sym : {A : I -> Pretype} {x : A i0} {y : A i1} -> PathP A x y -> PathP (\i -> A (inot i)) y x
  22. sym p i = p (inot i)
  23. id : {A : Type} -> A -> A
  24. id x = x
  25. the : (A : Pretype) -> A -> A
  26. the A x = x
  27. iElim : {A : I -> Pretype} {x : A i0} {y : A i1} -> PathP A x y -> (i : I) -> A i
  28. iElim p i = p i
  29. Singl : (A : Type) -> A -> Type
  30. Singl A x = (y : A) * Path x y
  31. isContr : Type -> Type
  32. isContr A = (x : A) * ((y : A) -> Path x y)
  33. singContr : {A : Type} {a : A} -> isContr (Singl A a)
  34. singContr {A} {a} = ((a, \i -> a), \y i -> (y.2 i, \j -> y.2 (iand i j)))
  35. 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)
  36. cong f p i = f (p i)
  37. congComp : {A : Type} {B : Type} {C : Type}
  38. {f : A -> B} {g : B -> C} {x : A} {y : A}
  39. (p : Path x y)
  40. -> Path (cong g (cong f p)) (cong (\x -> g (f x)) p)
  41. congComp p = refl
  42. congId : {A : Type} {x : A} {y : A}
  43. (p : Path x y)
  44. -> Path (cong (id {A}) p) p
  45. congId p = refl
  46. IsOne : I -> Type
  47. {-# PRIMITIVE IsOne #-}
  48. itIs1 : IsOne i1
  49. {-# PRIMITIVE itIs1 #-}
  50. isOneL : {i : I} {j : I} -> IsOne i -> IsOne (ior i j)
  51. {-# PRIMITIVE isOneL #-}
  52. isOneR : {i : I} {j : I} -> IsOne j -> IsOne (ior i j)
  53. {-# PRIMITIVE isOneR #-}
  54. Partial : I -> Type -> Pretype
  55. {-# PRIMITIVE Partial #-}
  56. PartialP : (phi : I) -> Partial phi Type -> Pretype
  57. {-# PRIMITIVE PartialP #-}
  58. Bool : Type
  59. tt, ff : Bool
  60. foo : (i : I) -> (j : I) -> Partial (ior (inot i) (ior i (iand i j))) Bool
  61. foo i j = \ { (i = i0) -> tt, (i = i1) -> ff, (i = i1) && (j = i1) -> ff }
  62. apPartial : {B : Type} {A : Type} -> (phi : I) -> (A -> B) -> Partial phi A -> Partial phi B
  63. apPartial phi f p is1 = f (p is1)